diff --git a/fpPS4.lpi b/fpPS4.lpi
index 94aea83..9d6492f 100644
--- a/fpPS4.lpi
+++ b/fpPS4.lpi
@@ -31,7 +31,7 @@
-
+
@@ -324,6 +324,7 @@
+
@@ -345,10 +346,12 @@
+
+
@@ -390,6 +393,7 @@
+
@@ -398,6 +402,7 @@
+
@@ -407,6 +412,10 @@
+
+
+
+
diff --git a/kernel/mm.txt b/kernel/mm.txt
new file mode 100644
index 0000000..e6d5b5e
--- /dev/null
+++ b/kernel/mm.txt
@@ -0,0 +1,332 @@
+
+int sceKernelMapDirectMemory
+ (void **virtualAddrDest,qword length,int protections,int flags,qword physicalAddr,
+ qword alignment)
+
+{
+ int iVar1;
+ ulong in_stack_00000000;
+
+ pthread_once((pthread_once_t *)&_mem_init_ctl,_mem_init);
+ iVar1 = _sceKernelMapDirectMemory
+ (_direct_pool_id,virtualAddrDest,length,protections,flags,physicalAddr,alignment
+ ,in_stack_00000000);
+ return iVar1;
+}
+
+int _sceKernelMapDirectMemory
+ (uint pool_id,void **virtualAddrDest,qword length,int protections,int flags,
+ qword physicalAddr,qword alignment,ulong param_8)
+
+{
+ int last;
+ int *perror;
+ uint _flags;
+ dword *poffset;
+ void *adr;
+ qword align;
+ int ret1;
+ uint _len;
+
+ pthread_once((pthread_once_t *)&_mem_init_ctl,_mem_init);
+ ret1 = L'\x80020016';
+ if (pool_id < 3) {
+ adr = *virtualAddrDest;
+ if ((((_direct_pool_id == 1) && ((DAT_01084c7c & 2) == 0)) &&
+ (((long)physicalAddr < 0x3000000000 || (0x301fffffff < physicalAddr)))) &&
+ (((flags & 0x400U) == 0 && (0x24fffff < DAT_01059790)))) {
+ ret1 = sceKernelMapDirectMemory2
+ (virtualAddrDest,length,-1,protections,flags,physicalAddr,alignment);
+ return ret1;
+ }
+ if (((((flags & 0xff9ffb6fU) == 0) && ((protections & 0xffffffc8U) == 0)) &&
+ (_len = (uint)length,
+ (((uint)adr | (uint)alignment | (uint)physicalAddr | _len) & 0x3fff) == 0)) &&
+ ((~-alignment & alignment) == 0)) {
+ _flags = flags & 0xfffffbff;
+ if (((flags & 0x10U) != 0) && (adr == (void *)0x0)) {
+ if (0x16fffff < DAT_01059790) {
+ return L'\x80020016';
+ }
+ _flags = flags & 0xfffffbef;
+ puts("[WARNING] map(addr=0, flags=MAP_FIXED)");
+ }
+ if (adr == (void *)0x0) {
+ if (param_8 >> 0x1e == 0x20) {
+ adr = (void *)0x880000000;
+ }
+ else {
+ adr = (void *)((ulong)((DAT_01084c7c & 2) == 0) << 0x21);
+ }
+ }
+ align = 0x4000;
+ if (0x4000 < alignment) {
+ align = alignment;
+ }
+ last = flsl(align);
+ if (last + -1 < 31) {
+ poffset = &DAT_01059578;
+ if (0x301fffffff < physicalAddr) {
+ poffset = DWORD_ARRAY_01059570 + (int)pool_id;
+ }
+ if ((long)physicalAddr < 0x3000000000) {
+ poffset = DWORD_ARRAY_01059570 + (int)pool_id;
+ }
+ adr = mmap(adr,length,protections,_flags | (last + -1) * 0x1000000 | MAP_SHARED,*poffset,physicalAddr);
+ if (adr == MAP_FAILED) {
+ perror = (int *)__error();
+ last = *perror;
+ ret1 = last + -0x7ffe0000;
+ if (last == 0) {
+ ret1 = last;
+ }
+ }
+ else {
+ *virtualAddrDest = adr;
+ ret1 = 0;
+ }
+ }
+ }
+ }
+ return ret1;
+}
+
+int sceKernelMapDirectMemory2
+ (void **virtualAddrDest,qword length,int memoryType,int protections,int flags,
+ qword physicalAddr,qword alignment)
+
+{
+ int last;
+ void *adr;
+ int *perror;
+ int ret1;
+ qword align;
+
+ pthread_once((pthread_once_t *)&_mem_init_ctl,_mem_init);
+ ret1 = L'\x8002002d';
+ if ((((_direct_pool_id == 1) && ((DAT_01084c7c & 2) == 0)) &&
+ (ret1 = -0x7ffdffea, (flags & 0x1f000000U) == 0)) &&
+ (((alignment & 0x3fff) == 0 && ((~-alignment & alignment) == 0)))) {
+ align = 0x4000;
+ if (0x4000 < alignment) {
+ align = alignment;
+ }
+ last = flsl(align);
+ if (last + -1 < 31) {
+ adr = (void *)sys_mmap_dmem(*virtualAddrDest,length,memoryType,protections,
+ (last + -1) * 0x1000000 | flags,physicalAddr);
+ if (adr == MAP_FAILED) {
+ perror = (int *)__error();
+ last = *perror;
+ ret1 = last + -0x7ffe0000;
+ if (last == 0) {
+ ret1 = last;
+ }
+ }
+ else {
+ *virtualAddrDest = adr;
+ ret1 = 0;
+ }
+ }
+ }
+ return ret1;
+}
+
+int sceKernelMapFlexibleMemory(void **virtualAddrDest,qword length,int protections,int flags)
+
+{
+ int iVar1;
+ undefined in_stack_00000000;
+ undefined7 in_stack_00000001;
+
+ iVar1 = _sceKernelMapFlexibleMemory
+ (virtualAddrDest,length,protections,flags,
+ CONCAT71(in_stack_00000001,in_stack_00000000));
+ return iVar1;
+}
+
+int _sceKernelMapFlexibleMemory
+ (void **virtualAddrDest,qword length,int protections,int flags,ulong param)
+
+{
+ int *perror;
+ int ret1;
+ void *adr;
+ int err;
+
+ ret1 = -0x7ffdffea;
+ if (((0x3fff < length) && ((length & 0x3fff) == 0)) &&
+ ((flags & 0xffbfff6fU | protections & 0xffffffc8U) == 0)) {
+ adr = *virtualAddrDest;
+ if (((flags & 0x10U) != 0) && (adr == (void *)0x0)) {
+ if (0x16fffff < DAT_01059790) {
+ return L'\x80020016';
+ }
+ flags = flags & 0xffffffef;
+ puts("[WARNING] map(addr=0, flags=MAP_FIXED)");
+ }
+ if (adr == (void *)0x0) {
+ if (param >> 0x1e == 0x20) {
+ adr = (void *)0x880000000;
+ }
+ else {
+ adr = (void *)((ulong)((DAT_01084c7c & 2) == 0) << 0x21);
+ }
+ }
+ adr = (void *)mmap(adr,length,protections,flags | MAP_ANON,-1,0);
+ if (adr == MAP_FAILED) {
+ perror = (int *)__error();
+ err = *perror;
+ ret1 = err + -0x7ffe0000;
+ if (err == 0) {
+ ret1 = err;
+ }
+ }
+ else {
+ *virtualAddrDest = adr;
+ ret1 = 0;
+ }
+ }
+ return ret1;
+}
+
+int sceKernelReserveVirtualRange(void **addr,size_t len,int flags,size_t alignment)
+
+{
+ int last;
+ int *perror;
+ size_t align;
+ int ret1;
+ void *adr;
+
+ ret1 = -0x7ffdffea;
+ if ((((flags & 0xffbfff6fU) == 0) &&
+ (adr = *addr, (((uint)adr | (uint)alignment | (uint)len) & 0x3fff) == 0)) &&
+ ((~-alignment & alignment) == 0)) {
+ align = 0x4000;
+ if (0x4000 < alignment) {
+ align = alignment;
+ }
+ last = flsl(align);
+ if (last + -1 < 0x1f) {
+ if (((flags & 0x10U) != 0) && (adr == (void *)0x0)) {
+ if (0x16fffff < DAT_01059790) {
+ return -0x7ffdffea;
+ }
+ flags = flags & 0xffffffef;
+ puts("[WARNING] map(addr=0, flags=MAP_FIXED)");
+ }
+ adr = (void *)mmap(adr,len,0,(last + -1) * 0x1000000 | flags | MAP_VOID | MAP_SHARED,-1,0);
+ if (adr == MAP_FAILED) {
+ perror = (int *)__error();
+ last = *perror;
+ ret1 = last + -0x7ffe0000;
+ if (last == 0) {
+ ret1 = last;
+ }
+ }
+ else {
+ *addr = adr;
+ ret1 = 0;
+ }
+ }
+ }
+ return ret1;
+}
+
+int sceKernelMprotect(void *addr,size_t len,int prot)
+
+{
+ int ret1;
+ int *perror;
+ int err;
+
+ ret1 = mprotect(addr,len,prot);
+ if (ret1 < 0) {
+ perror = (int *)__error();
+ err = *perror;
+ ret1 = err + -0x7ffe0000;
+ if (err == 0) {
+ ret1 = err;
+ }
+ }
+ return ret1;
+}
+
+int sceKernelMsync(void *addr,size_t len,int flags)
+
+{
+ int ret1;
+ int *perror;
+ int err;
+
+ ret1 = msync(addr,len,flags);
+ if (ret1 < 0) {
+ perror = (int *)__error();
+ err = *perror;
+ ret1 = err + -0x7ffe0000;
+ if (err == 0) {
+ ret1 = err;
+ }
+ }
+ return ret1;
+}
+
+int sceKernelMmap(void *addr,size_t len,int prot,int flags,int fd,size_t offset,void **res)
+
+{
+ int iVar1;
+ int err;
+ void *adr;
+ int *perror;
+
+ adr = mmap(addr,len,prot,flags,fd,offset);
+ if (adr != MAP_FAILED) {
+ *res = adr;
+ return 0;
+ }
+ perror = (int *)__error();
+ iVar1 = *perror;
+ err = iVar1 + -0x7ffe0000;
+ if (iVar1 == 0) {
+ err = iVar1;
+ }
+ return err;
+}
+
+int sceKernelMunmap(void *addr,size_t len)
+
+{
+ int ret1;
+ int *perror;
+ int err;
+
+ ret1 = munmap(addr,len);
+ if (ret1 < 0) {
+ perror = (int *)__error();
+ err = *perror;
+ ret1 = err + -0x7ffe0000;
+ if (err == 0) {
+ ret1 = err;
+ }
+ }
+ return ret1;
+}
+
+int sceKernelReleaseFlexibleMemory(void *addr,size_t len)
+
+{
+ int ret2;
+ int ret1;
+
+ ret1 = -0x7ffdffea;
+ if ((((uint)addr | (uint)len) & 0x3fff) == 0) {
+ ret2 = madvise(addr,len,MADV_FREE);
+ ret1 = -0x7ffdffea;
+ if (ret2 != -1) {
+ ret1 = 0;
+ }
+ }
+ return ret1;
+}
+
diff --git a/kernel/mm_adr_direct.pas b/kernel/mm_adr_direct.pas
new file mode 100644
index 0000000..3f70be1
--- /dev/null
+++ b/kernel/mm_adr_direct.pas
@@ -0,0 +1,1063 @@
+unit mm_adr_direct;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ g23tree,
+ bittype;
+
+{
+ Direct node:
+ [
+ offset 12..39:28
+ size 12..39:28
+ free 0..0 :1
+ mtype 0..6 :7
+
+ addr 12..39:28
+ ]
+}
+
+type
+ TDirectAdrNode=packed object
+ private
+ //free: [Size] |[Offset]
+ //alloc: [Offset]
+ Function GetOffset:QWORD; inline;
+ Procedure SetOffset(q:qword); inline;
+ Function GetSize:QWORD; inline;
+ Procedure SetSize(q:qword); inline;
+ Function GetAddr:Pointer; inline;
+ Procedure SetAddr(p:Pointer); inline;
+ Function GetIsFree:Boolean; inline;
+ Procedure SetIsFree(b:Boolean); inline;
+ public
+ F:bitpacked record
+ Offset:bit28;
+ Size :bit28;
+ Free :bit1;
+ mtype :bit7;
+ addr :DWORD;
+ end;
+ property Offset:QWORD read GetOffset write SetOffset;
+ property Size:QWORD read GetSize write SetSize;
+ property addr:Pointer read GetAddr write SetAddr;
+ property IsFree:Boolean read GetIsFree write SetIsFree;
+ end;
+
+type
+ TDirectAdrFreeCompare=object
+ function c(const a,b:TDirectAdrNode):Integer; static;
+ end;
+ TDirectAdrAllcCompare=object
+ function c(const a,b:TDirectAdrNode):Integer; static;
+ end;
+
+ TMemoryUnmapCb=procedure(addr:Pointer;Size:QWORD);
+
+ TDirectManager=class
+ private
+ type
+ TFreePoolNodeSet=specialize T23treeSet;
+ TAllcPoolNodeSet=specialize T23treeSet;
+
+ var
+ Flo,Fhi:QWORD;
+
+ FFreeSet:TFreePoolNodeSet;
+ FAllcSet:TAllcPoolNodeSet;
+ public
+ property lo:QWORD read Flo;
+ property hi:QWORD read Fhi;
+
+ Constructor Create(_lo,_hi:QWORD);
+ private
+ procedure _Insert(const key:TDirectAdrNode);
+ Function _FetchFree_a(Size,Align:QWORD;var R:TDirectAdrNode):Boolean;
+ Function _FetchFree_s(ss,se,Size,Align:QWORD;var R:TDirectAdrNode):Boolean;
+ Function _FetchNode_m(mode:Byte;cmp:QWORD;var R:TDirectAdrNode):Boolean;
+ Function _Find_m(mode:Byte;var R:TDirectAdrNode):Boolean;
+
+ procedure _Merge(key:TDirectAdrNode);
+ procedure _Devide(Offset,Size:QWORD;var key:TDirectAdrNode);
+ procedure _Unmap(addr:Pointer;Size:QWORD);
+ public
+ var
+ OnMemoryUnmapCb:TMemoryUnmapCb;
+
+ Function Alloc_any(Size,Align:QWORD;mtype:Byte;var AdrOut:QWORD):Integer;
+ Function Alloc_search(ss,se,Size,Align:QWORD;mtype:Byte;var AdrOut:QWORD):Integer;
+ Function Query(Offset:QWORD;next:Boolean;var ROut:TDirectAdrNode):Integer;
+ Function QueryMType(Offset:QWORD;var ROut:TDirectAdrNode):Integer;
+ Function CheckedAvailable(ss,se,Align:QWORD;var AdrOut,SizeOut:QWORD):Integer;
+ Function CheckedAlloc(Offset,Size:QWORD):Integer;
+ Function CheckedMMap(Offset,Size:QWORD):Integer;
+ Function CheckedRelease(Offset,Size:QWORD):Integer;
+ Function Release(Offset,Size:QWORD):Integer;
+ Function mmap(Offset,Size:QWORD;addr:Pointer):Integer;
+ Function mmap2(Offset,Size:QWORD;addr:Pointer;mtype:Byte):Integer;
+ Function unmap(Offset,Size:QWORD):Integer;
+
+ procedure Print;
+ end;
+
+implementation
+
+const
+ ENOENT= 2;
+ ENOMEM=12;
+ EACCES=13;
+ EBUSY =16;
+ EINVAL=22;
+
+//
+
+function TDirectAdrFreeCompare.c(const a,b:TDirectAdrNode):Integer;
+begin
+ //1 FSize
+ Result:=Integer(a.F.Size>b.F.Size)-Integer(a.F.Size0) then Exit;
+ //2 FOffset
+ Result:=Integer(a.F.Offset>b.F.Offset)-Integer(a.F.Offsetb.F.Offset)-Integer(a.F.Offset=Offset) then
+ begin
+ FEndN:=key.Offset+key.Size;
+ FEndO:=Offset+Size;
+ if (FEndO<=FEndN) then
+ begin
+ R:=key;
+ FAllcSet.delete(key);
+ FFreeSet.erase(It);
+ Exit(True);
+ end;
+ end;
+ until not It.Next;
+end;
+
+function ia(addr:Pointer;Size:qword):Pointer; inline;
+begin
+ if (addr=nil) then
+ begin
+ Result:=nil;
+ end else
+ begin
+ Result:=addr+Size;
+ end;
+end;
+
+const
+ M_LE=0;
+ M_BE=1;
+
+ C_UP=2;
+ C_DW=4;
+
+ C_LE=6;
+ C_BE=8;
+
+Function TDirectManager._FetchNode_m(mode:Byte;cmp:QWORD;var R:TDirectAdrNode):Boolean;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key,rkey:TDirectAdrNode;
+begin
+ Result:=false;
+
+ key:=R;
+
+ Case (mode and 1) of
+ M_LE:It:=FAllcSet.find_le(key);
+ M_BE:It:=FAllcSet.find_be(key);
+ else
+ Exit;
+ end;
+
+ if (It.Item=nil) then Exit;
+
+ rkey:=It.Item^;
+
+ if (rkey.IsFree <>key.IsFree ) then Exit;
+ if (rkey.F.mtype<>key.F.mtype) then Exit;
+
+ Case (mode and (not 1)) of
+ C_UP:
+ begin
+ if (ia(rkey.addr,rkey.Size)<>key.addr) then Exit;
+ if ((rkey.Offset+rkey.Size)<>cmp ) then Exit;
+ end;
+ C_DW:
+ begin
+ if (rkey.addr <>key.addr) then Exit;
+ if (rkey.Offset<>cmp ) then Exit;
+ end;
+
+ C_LE:if ((rkey.Offset+rkey.Size)FOffset) then //prev save
+ begin
+ key.Size:=Offset-FOffset;
+ _Merge(key);
+ end;
+
+ if (FEndO>FEndN) then //next save
+ begin
+ key.Offset:=FEndN;
+ key.Size :=FEndO-FEndN;
+ key.addr :=ia(Faddr,(FEndN-FOffset));
+
+ _Merge(key);
+ end else
+ if (FEndO<>FEndN) then //tunc size
+ begin
+ Size:=FEndO-Offset;
+ end;
+
+ //new save
+ key.Offset :=Offset;
+ key.Size :=Size;
+ key.addr :=ia(Faddr,(Offset-FOffset));
+end;
+
+procedure TDirectManager._Unmap(addr:Pointer;Size:QWORD);
+begin
+ if (addr=nil) then Exit;
+ if (OnMemoryUnmapCb=nil) then Exit;
+ OnMemoryUnmapCb(addr,Size);
+end;
+
+Function TDirectManager.Alloc_any(Size,Align:QWORD;mtype:Byte;var AdrOut:QWORD):Integer;
+var
+ key:TDirectAdrNode;
+ Offset:QWORD;
+begin
+ Result:=0;
+ if (Size=0) or (Align=0) then Exit(EINVAL);
+
+ key:=Default(TDirectAdrNode);
+
+ if _FetchFree_a(Size,Align,key) then
+ begin
+ Offset:=System.Align(key.Offset,Align);
+
+ _Devide(Offset,Size,key);
+
+ //new save
+ key.IsFree :=False;
+ key.F.mtype:=mtype;
+ key.addr :=nil;
+ _Merge(key);
+
+ AdrOut:=key.Offset;
+ Result:=0;
+ end else
+ begin
+ Result:=ENOMEM;
+ end;
+end;
+
+Function TDirectManager.Alloc_search(ss,se,Size,Align:QWORD;mtype:Byte;var AdrOut:QWORD):Integer;
+var
+ key:TDirectAdrNode;
+ Offset:QWORD;
+begin
+ Result:=0;
+ if (Size=0) or (Align=0) then Exit(EINVAL);
+ if (ssFhi) then Exit(EINVAL);
+ if (seFhi) then Exit(EINVAL);
+ if (senil) do
+ begin
+ key:=It.Item^;
+ Offset:=System.Align(key.Offset,Align);
+ if (se>=Offset) then
+ begin
+ Size:=key.Size-(Offset-key.Offset);
+ AdrOut :=Offset;
+ SizeOut:=Size;
+ Exit(0);
+ end;
+ It.Next
+ end;
+end;
+
+Function TDirectManager.CheckedAlloc(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TDirectAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TDirectAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if (Offset>=key.Offset) then
+ begin
+ if not key.IsFree then
+ begin
+ Exit(ENOMEM);
+ end;
+ end;
+
+ if (key.Offset>=FEndO) then Break;
+
+ It.Next;
+ end;
+end;
+
+Function TDirectManager.CheckedMMap(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TDirectAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TDirectAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if (Offset>=key.Offset) then
+ begin
+ if key.IsFree then
+ begin
+ Exit(EACCES);
+ end;
+ if (key.addr<>nil) then
+ begin
+ Exit(EBUSY);
+ end;
+ end;
+
+ if (key.Offset>=FEndO) then Break;
+
+ It.Next;
+ end;
+end;
+
+Function TDirectManager.CheckedRelease(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TDirectAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=ENOENT;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TDirectAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if not key.IsFree then
+ begin
+ if (key.Offset>=FEndO) then Break;
+ Result:=0;
+ Break;
+ end;
+
+ It.Next;
+ end;
+end;
+
+Function TDirectManager.Release(Offset,Size:QWORD):Integer;
+var
+ key:TDirectAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+
+ function _map:Boolean;
+ begin
+ Result:=False;
+
+ //new save
+ key.IsFree :=True;
+ key.F.mtype:=0;
+ key.addr :=nil;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Exit(True);
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+ procedure _skip; inline;
+ begin
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TDirectAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ _Unmap(key.addr,key.Size);
+
+ if _map then Break;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ _Unmap(key.addr,key.Size);
+
+ if _map then Break;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+Function TDirectManager.mmap(Offset,Size:QWORD;addr:Pointer):Integer;
+var
+ key:TDirectAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+
+ function _map:Boolean;
+ begin
+ Result:=False;
+
+ //new save
+ key.IsFree :=False;
+ key.addr :=addr;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Exit(True);
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+ procedure _skip; inline;
+ begin
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TDirectAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ if _map then Break;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ if _map then Break;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+Function TDirectManager.mmap2(Offset,Size:QWORD;addr:Pointer;mtype:Byte):Integer;
+var
+ key:TDirectAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+
+ function _map:Boolean;
+ begin
+ Result:=False;
+
+ //new save
+ key.IsFree :=False;
+ key.F.mtype:=mtype;
+ key.addr :=addr;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Exit(True);
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+ procedure _skip; inline;
+ begin
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end;
+
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TDirectAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ if _map then Exit;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ if _map then Exit;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ _skip;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+Function TDirectManager.unmap(Offset,Size:QWORD):Integer;
+begin
+ Result:=mmap(Offset,Size,nil);
+end;
+
+function _alloc_str(IsFree:Boolean):RawByteString;
+begin
+ Case IsFree of
+ True :Result:='FREE';
+ FAlse:Result:='ALLC';
+ end;
+end;
+
+procedure TDirectManager.Print;
+var
+ key:TDirectAdrNode;
+ It:TAllcPoolNodeSet.Iterator;
+begin
+ It:=FAllcSet.cbegin;
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ Writeln(HexStr(key.Offset,10),'..',
+ HexStr(key.Offset+key.Size,10),':',
+ HexStr(key.Size,10),'#',
+ HexStr(qword(key.addr),10),'#',
+ _alloc_str(key.IsFree),'#',
+ key.F.mtype);
+
+ It.Next;
+ end;
+end;
+
+procedure itest;
+var
+ test:TDirectManager;
+ addr:array[0..5] of qword;
+begin
+ test:=TDirectManager.Create(0,$180000000-1);
+
+ test.Alloc_any(4*1024,1,0,addr[0]);
+ Writeln(HexStr(addr[0],16));
+
+ test.Alloc_any(4*1024,1,0,addr[1]);
+ Writeln(HexStr(addr[1],16));
+
+ test.Alloc_any(4*1024,1,0,addr[2]);
+ Writeln(HexStr(addr[2],16));
+
+ test.Alloc_any(4*1024,1,0,addr[3]);
+ Writeln(HexStr(addr[3],16));
+
+ test.Alloc_any(4*1024,1,0,addr[4]);
+ Writeln(HexStr(addr[4],16));
+
+ test.Alloc_any(4*1024,1,0,addr[5]);
+ Writeln(HexStr(addr[5],16));
+
+ writeln;
+ test.Print;
+ writeln;
+
+ test.Release(addr[0],4*1024);
+ test.Release(addr[2],4*1024);
+ //test.Release(addr[4],4*1024);
+
+ writeln;
+ test.Print;
+ writeln;
+
+ //writeln(test.CheckedRelease(addr[1],4*1024*2));
+
+ //test.Release(addr[1],4*1024*2);
+
+ //test.Release(addr[0],4*1024);
+ //test.Release(addr[2],4*1024);
+ //test.Release(addr[1],4*1024);
+
+ //test.Release(addr[0],4*1024);
+ //test.Release(addr[1],4*1024);
+ //test.Release(addr[2],4*1024);
+ //test.Release(addr[2],4*1024);
+
+ //writeln(test.CheckedRelease(addr[1],4*1024));
+ //writeln(test.CheckedRelease(addr[2],4*1024));
+
+ //test.Release(addr[3]+4*1024,4*1024);
+
+ test.Release(addr[4],4*1024);
+
+ writeln(test.CheckedMmap(addr[1],4*1024));
+
+ test.mmap(addr[0],4*1024*6,Pointer(4*1024));
+
+ writeln(test.CheckedMmap(addr[1],4*1024));
+
+ writeln;
+ test.Print;
+ writeln;
+
+ test.Release(addr[0],4*1024*6);
+
+ writeln;
+ test.Print;
+ writeln;
+
+ //test.Alloc_any(4*1024,1,0,addr[0]);
+ //Writeln(HexStr(addr[0],16));
+ //
+ //test.Alloc_any(4*1024,1,0,addr[1]);
+ //Writeln(HexStr(addr[1],16));
+ //
+ //test.Alloc_any(4*1024,1,0,addr[2]);
+ //Writeln(HexStr(addr[2],16));
+
+ readln;
+end;
+
+initialization
+ //itest;
+
+end.
+
+
+
+
diff --git a/kernel/mm_adr_pool.pas b/kernel/mm_adr_pool.pas
new file mode 100644
index 0000000..97aa235
--- /dev/null
+++ b/kernel/mm_adr_pool.pas
@@ -0,0 +1,739 @@
+unit mm_adr_pool;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ g23tree,
+ bittype,
+ spinlock;
+
+{
+ Free pool node:
+ [
+ offset 12..39:28
+ size 12..39:28
+ free 0..1 :1
+ Ext 0..6 :7
+ ]
+}
+
+type
+ TPoolAdrNode=packed object
+ private
+ //free: [Size] |[Offset]
+ //alloc: [Offset]
+ Function GetOffset:QWORD; inline;
+ Procedure SetOffset(q:qword); inline;
+ Function GetSize:QWORD; inline;
+ Procedure SetSize(q:qword); inline;
+ Function GetIsFree:Boolean; inline;
+ Procedure SetIsFree(b:Boolean); inline;
+ public
+ F:bitpacked record
+ Offset:bit28;
+ Size :bit28;
+ Free :bit1;
+ Ext :bit7;
+ end;
+ property Offset:QWORD read GetOffset write SetOffset;
+ property Size:QWORD read GetSize write SetSize;
+ property IsFree:Boolean read GetIsFree write SetIsFree;
+ end;
+
+type
+ TPoolAdrFreeCompare=object
+ function c(const a,b:TPoolAdrNode):Integer; static;
+ end;
+ TPoolAdrAllcCompare=object
+ function c(const a,b:TPoolAdrNode):Integer; static;
+ end;
+
+ TPoolManager=class
+ private
+ type
+ TFreePoolNodeSet=specialize T23treeSet;
+ TAllcPoolNodeSet=specialize T23treeSet;
+
+ var
+ Flo,Fhi:QWORD;
+
+ FFreeSet:TFreePoolNodeSet;
+ FAllcSet:TAllcPoolNodeSet;
+ public
+ property lo:QWORD read Flo;
+ property hi:QWORD read Fhi;
+
+ Constructor Create(_lo,_hi:QWORD);
+ private
+ procedure _Insert(const key:TPoolAdrNode);
+ Function _FetchFree_a(Size,Align:QWORD;var R:TPoolAdrNode):Boolean;
+ Function _FetchFree_s(ss,se,Size,Align:QWORD;var R:TPoolAdrNode):Boolean;
+ Function _FetchNode_a(mode:Byte;var R:TPoolAdrNode):Boolean;
+ Function _FetchNode_m(mode:Byte;cmp:QWORD;var R:TPoolAdrNode):Boolean;
+ Function _Find_m(mode:Byte;var R:TPoolAdrNode):Boolean;
+
+ procedure _Merge(key:TPoolAdrNode);
+ procedure _Devide(Offset,Size:QWORD;var key:TPoolAdrNode);
+ public
+ Function Alloc_any(Size,Align:QWORD;ext:Byte;var AdrOut:QWORD):Integer;
+ Function Alloc_search(ss,se,Size,Align:QWORD;ext:Byte;var AdrOut:QWORD):Integer;
+ Function CheckedAvailable(ss,se,Align:QWORD;var AdrOut,SizeOut:QWORD):Integer;
+ Function CheckedAlloc(Offset,Size:QWORD):Integer;
+ Function CheckedRelease(Offset,Size:QWORD):Integer;
+ Function Release(Offset,Size:QWORD):Integer;
+
+ procedure Print;
+ end;
+
+implementation
+
+const
+ ENOENT= 2;
+ ENOMEM=12;
+ EINVAL=22;
+
+//
+
+function TPoolAdrFreeCompare.c(const a,b:TPoolAdrNode):Integer;
+begin
+ //1 FSize
+ Result:=Integer(a.F.Size>b.F.Size)-Integer(a.F.Size0) then Exit;
+ //2 FOffset
+ Result:=Integer(a.F.Offset>b.F.Offset)-Integer(a.F.Offsetb.F.Offset)-Integer(a.F.Offset=Offset) then
+ begin
+ FEndN:=key.Offset+key.Size;
+ FEndO:=Offset+Size;
+ if (FEndO<=FEndN) then
+ begin
+ R:=key;
+ FAllcSet.delete(key);
+ FFreeSet.erase(It);
+ Exit(True);
+ end;
+ end;
+ until not It.Next;
+end;
+
+const
+ M_LE=0;
+ M_BE=1;
+
+ C_UP=2;
+ C_DW=4;
+
+ C_LE=6;
+ C_BE=8;
+
+//alloc: [Offset]
+Function TPoolManager._FetchNode_a(mode:Byte;var R:TPoolAdrNode):Boolean;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key,rkey:TPoolAdrNode;
+begin
+ Result:=false;
+
+ key:=R;
+
+ Case mode of
+ M_LE:It:=FAllcSet.find_le(key);
+ M_BE:It:=FAllcSet.find_be(key);
+ else
+ Exit;
+ end;
+
+ if (It.Item=nil) then Exit;
+
+ rkey:=It.Item^;
+
+ if (rkey.IsFree<>key.IsFree) then Exit;
+ if (rkey.F.Ext <>key.F.Ext ) then Exit;
+
+ R:=rkey;
+ FAllcSet.erase(It);
+ FFreeSet.delete(rkey);
+ Result:=True;
+end;
+
+Function TPoolManager._FetchNode_m(mode:Byte;cmp:QWORD;var R:TPoolAdrNode):Boolean;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key,rkey:TPoolAdrNode;
+begin
+ Result:=false;
+
+ key:=R;
+
+ Case (mode and 1) of
+ M_LE:It:=FAllcSet.find_le(key);
+ M_BE:It:=FAllcSet.find_be(key);
+ else
+ Exit;
+ end;
+
+ if (It.Item=nil) then Exit;
+
+ rkey:=It.Item^;
+
+ if (rkey.IsFree<>key.IsFree) then Exit;
+ if (rkey.F.Ext <>key.F.Ext ) then Exit;
+
+ Case (mode and (not 1)) of
+ C_UP:if ((rkey.Offset+rkey.Size)<>cmp) then Exit;
+ C_DW:if (rkey.Offset<>cmp) then Exit;
+
+ C_LE:if ((rkey.Offset+rkey.Size)FOffset) then //prev save
+ begin
+ key.Size:=Offset-FOffset;
+ _Merge(key);
+ end;
+
+ if (FEndO>FEndN) then //next save
+ begin
+ key.Offset:=FEndN;
+ key.Size :=FEndO-FEndN;
+ _Merge(key);
+ end else
+ if (FEndO<>FEndN) then //tunc size
+ begin
+ Size:=FEndO-Offset;
+ end;
+
+ //new save
+ key.Offset:=Offset;
+ key.Size :=Size;
+end;
+
+Function TPoolManager.Alloc_any(Size,Align:QWORD;ext:Byte;var AdrOut:QWORD):Integer;
+var
+ key:TPoolAdrNode;
+ Offset:QWORD;
+begin
+ Result:=0;
+ if (Size=0) or (Align=0) then Exit(EINVAL);
+
+ key:=Default(TPoolAdrNode);
+
+ if _FetchFree_a(Size,Align,key) then
+ begin
+ Offset:=System.Align(key.Offset,Align);
+
+ _Devide(Offset,Size,key);
+
+ //new save
+ key.IsFree:=False;
+ key.F.Ext :=ext;
+ _Merge(key);
+
+ AdrOut:=key.Offset;
+ Result:=0;
+ end else
+ begin
+ Result:=ENOMEM;
+ end;
+end;
+
+Function TPoolManager.Alloc_search(ss,se,Size,Align:QWORD;ext:Byte;var AdrOut:QWORD):Integer;
+var
+ key:TPoolAdrNode;
+ Offset:QWORD;
+begin
+ Result:=0;
+ if (Size=0) or (Align=0) then Exit(EINVAL);
+ if (ssFhi) then Exit(EINVAL);
+ if (seFhi) then Exit(EINVAL);
+ if (senil) do
+ begin
+ key:=It.Item^;
+ Offset:=System.Align(key.Offset,Align);
+ if (se>=Offset) then
+ begin
+ Size:=key.Size-(Offset-key.Offset);
+ AdrOut :=Offset;
+ SizeOut:=Size;
+ Exit(0);
+ end;
+ It.Next
+ end;
+end;
+
+Function TPoolManager.CheckedAlloc(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TPoolAdrNode;
+ FEndN,FEndO:QWORD;
+begin
+ Result:=ENOMEM;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ key:=Default(TPoolAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ if (It.Item<>nil) then
+ begin
+ key:=It.Item^;
+
+ FEndN:=key.Offset+key.Size;
+
+ if key.IsFree then
+ if (Offset>=key.Offset) then
+ begin
+ FEndO:=Offset+Size;
+ FEndN:=key.Offset+key.Size;
+
+ if (FEndN>=FEndO) then
+ begin
+ Result:=0;
+ end;
+ end;
+
+ end;
+end;
+
+Function TPoolManager.CheckedRelease(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TPoolAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=ENOENT;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TPoolAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if not key.IsFree then
+ begin
+ if (key.Offset>=FEndO) then Break;
+ Result:=0;
+ Break;
+ end;
+
+ It.Next;
+ end;
+end;
+
+Function TPoolManager.Release(Offset,Size:QWORD):Integer;
+var
+ key:TPoolAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TPoolAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ //new save
+ key.IsFree :=True;
+ key.F.ext :=0;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ //new save
+ key.IsFree :=True;
+ key.F.ext :=0;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+function _alloc_str(IsFree:Boolean):RawByteString;
+begin
+ Case IsFree of
+ True :Result:='FREE';
+ FAlse:Result:='ALLC';
+ end;
+end;
+
+procedure TPoolManager.Print;
+var
+ key:TPoolAdrNode;
+ It:TAllcPoolNodeSet.Iterator;
+begin
+ It:=FAllcSet.cbegin;
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ Writeln(HexStr(key.Offset,10),'..',
+ HexStr(key.Offset+key.Size,10),':',
+ HexStr(key.Size,10),'#',
+ _alloc_str(key.IsFree),'#',
+ key.F.Ext);
+
+ It.Next;
+ end;
+end;
+
+procedure itest;
+var
+ test:TPoolManager;
+ addr:array[0..3] of qword;
+begin
+ test:=TPoolManager.Create($7FFFFC000,$FFFFFFFFF);
+
+ test.Alloc_any(4*1024,1,0,addr[0]);
+ Writeln(HexStr(addr[0],16));
+
+ test.Alloc_any(4*1024,1,0,addr[1]);
+ Writeln(HexStr(addr[1],16));
+
+ test.Alloc_any(4*1024,1,0,addr[2]);
+ Writeln(HexStr(addr[2],16));
+
+ test.Alloc_any(4*1024,1,0,addr[3]);
+ Writeln(HexStr(addr[3],16));
+
+ writeln;
+ test.Print;
+ writeln;
+
+ test.Release(addr[0],4*1024);
+ test.Release(addr[1],4*1024);
+
+ writeln;
+ test.Print;
+ writeln;
+
+ writeln(test.CheckedRelease(addr[1],4*1024*2));
+
+ test.Release(addr[1],4*1024*2);
+
+ //test.Release(addr[0],4*1024);
+ //test.Release(addr[2],4*1024);
+ //test.Release(addr[1],4*1024);
+
+ //test.Release(addr[0],4*1024);
+ //test.Release(addr[1],4*1024);
+ //test.Release(addr[2],4*1024);
+ //test.Release(addr[2],4*1024);
+
+ //writeln(test.CheckedRelease(addr[1],4*1024));
+ //writeln(test.CheckedRelease(addr[2],4*1024));
+
+ writeln(test.CheckedRelease(addr[3]+4*1024,4*1024));
+ test.Release(addr[3]+4*1024,4*1024);
+
+ writeln;
+ test.Print;
+ writeln;
+
+ test.Alloc_any(4*1024,1,0,addr[0]);
+ Writeln(HexStr(addr[0],16));
+
+ test.Alloc_any(4*1024,1,0,addr[1]);
+ Writeln(HexStr(addr[1],16));
+
+ test.Alloc_any(4*1024,1,0,addr[2]);
+ Writeln(HexStr(addr[2],16));
+
+ readln;
+end;
+
+initialization
+ //itest
+
+end.
+
+
+
+
diff --git a/kernel/mm_adr_virtual.pas b/kernel/mm_adr_virtual.pas
new file mode 100644
index 0000000..05c0a25
--- /dev/null
+++ b/kernel/mm_adr_virtual.pas
@@ -0,0 +1,1099 @@
+unit mm_adr_virtual;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Windows,
+ Classes,
+ SysUtils,
+ g23tree,
+ bittype,
+ sys_types;
+
+{
+ alloc/free node:
+ [
+ offset 12..39:28
+ size 12..39:28
+ free 0..0 :1
+ prot 0..6 :7
+
+ addr 12..39:28 ->[direct addr]
+ reserv 0..0 :1
+ direct 0..0 :1
+ stack 0..0 :1
+ polled 0..0 :1
+ align :4
+
+ block Pointer ->[alloc bloc]
+ ]
+
+ alloc block:
+ [
+ offset 12..39:28
+ size 12..39:28
+ btype 0..7:8 = free/private/mapped/gpu
+
+ used 12..39:28
+ ]
+}
+
+const
+ BT_FREE=0;
+ BT_PRIV=1;
+ BT_GPUM=2;
+ BT_FMAP=3;
+
+type
+ PVirtualAdrBlock=^TVirtualAdrBlock;
+ TVirtualAdrBlock=packed object
+ private
+ Function GetOffset:QWORD; inline;
+ Procedure SetOffset(q:QWORD); inline;
+ Function GetSize:QWORD; inline;
+ Procedure SetSize(q:QWORD); inline;
+ Function GetUsed:QWORD; inline;
+ Procedure SetUsed(q:QWORD); inline;
+ public
+ F:bitpacked record
+ Offset:bit28;
+ Size :bit28;
+ btype :bit8;
+ used :DWORD;
+ end;
+ property Offset:QWORD read GetOffset write SetOffset;
+ property Size:QWORD read GetSize write SetSize;
+ property Used:QWORD read GetUsed write SetUsed;
+ function Commit(_offset,_size:QWORD;prot:Integer):Integer;
+ function Free(_offset,_size:QWORD):Integer;
+ end;
+
+ TVirtualAdrNode=packed object
+ private
+ //free: [Size] |[Offset]
+ //alloc: [Offset]
+ Function GetOffset:QWORD; inline;
+ Procedure SetOffset(q:QWORD); inline;
+ Function GetSize:QWORD; inline;
+ Procedure SetSize(q:QWORD); inline;
+ Function GetAddr:Pointer; inline;
+ Procedure SetAddr(p:Pointer); inline;
+ Function GetIsFree:Boolean; inline;
+ Procedure SetIsFree(b:Boolean); inline;
+ public
+ F:bitpacked record
+ Offset:bit28;
+ Size :bit28;
+ Free :bit1;
+ prot :bit7;
+ addr :bit28;
+ reserv:bit1;
+ direct:bit1;
+ stack :bit1;
+ polled:bit1;
+ align :bit4;
+ end;
+ block:PVirtualAdrBlock;
+ property Offset:QWORD read GetOffset write SetOffset;
+ property Size:QWORD read GetSize write SetSize;
+ property addr:Pointer read GetAddr write SetAddr;
+ property IsFree:Boolean read GetIsFree write SetIsFree;
+ Function cmp_merge(const n:TVirtualAdrNode):Boolean;
+ end;
+
+type
+ TVirtualAdrFreeCompare=object
+ function c(const a,b:TVirtualAdrNode):Integer; static;
+ end;
+ TVirtualAdrAllcCompare=object
+ function c(const a,b:TVirtualAdrNode):Integer; static;
+ end;
+
+ TVirtualManager=class
+ private
+ type
+ TFreePoolNodeSet=specialize T23treeSet;
+ TAllcPoolNodeSet=specialize T23treeSet;
+
+ var
+ Flo,Fhi:QWORD;
+
+ FFreeSet:TFreePoolNodeSet;
+ FAllcSet:TAllcPoolNodeSet;
+ public
+ property lo:QWORD read Flo;
+ property hi:QWORD read Fhi;
+
+ Constructor Create(_lo,_hi:QWORD);
+ private
+ procedure _Insert(const key:TVirtualAdrNode);
+ Function _FetchFree_s(ss,Size,Align:QWORD;var R:TVirtualAdrNode):Boolean;
+ Function _FetchNode_m(mode:Byte;cmp:QWORD;var R:TVirtualAdrNode):Boolean;
+ Function _Find_m(mode:Byte;var R:TVirtualAdrNode):Boolean;
+
+ procedure _Merge(key:TVirtualAdrNode);
+ procedure _Devide(Offset,Size:QWORD;var key:TVirtualAdrNode);
+ public
+ Function Alloc_flex(ss,Size,Align:QWORD;prot:Byte;var AdrOut:QWORD):Integer;
+ Function check_fixed(Offset,Size:QWORD;btype,flags:Byte):Integer;
+ Function mmap_flex(Offset,Size:QWORD;prot,flags:Byte):Integer;
+ Function CheckedAlloc(Offset,Size:QWORD):Integer;
+ Function CheckedMMap(Offset,Size:QWORD):Integer;
+ Function Release(Offset,Size:QWORD):Integer;
+ //Function mmap(Offset,Size:QWORD;addr:Pointer):Integer;
+ Function mmap2(Offset,Size:QWORD;addr:Pointer;mtype:Byte):Integer;
+
+ procedure Print;
+ end;
+
+implementation
+
+uses
+ mmap;
+
+const
+ ENOENT= 2;
+ ENOMEM=12;
+ EACCES=13;
+ EBUSY =16;
+ EINVAL=22;
+ ENOSYS=78;
+
+//
+
+function NewAdrBlock(Offset,Size:QWORD;prot:Integer;btype:Byte;fd:Integer;offst:size_t):PVirtualAdrBlock;
+var
+ FShift :QWORD;
+ FOffset:QWORD;
+ FSize :QWORD;
+ err :Integer;
+begin
+ Result:=nil;
+
+ FOffset:=AlignDw(Offset,GRANULAR_PAGE_SIZE);
+ FShift :=Offset-FOffset;
+ FSize :=AlignUp(FShift+Size,GRANULAR_PAGE_SIZE);
+
+ case btype of
+ BT_PRIV,
+ BT_GPUM:
+ begin
+ err:=_VirtualReserve(Pointer(FOffset),FSize,prot);
+ if (err<>0) then Exit;
+ end;
+ BT_FMAP:
+ begin
+ if (offst0) then Exit;
+ end;
+ else
+ Exit;
+ end;
+
+ Result:=AllocMem(SizeOf(TVirtualAdrBlock));
+ if (Result=nil) then Exit;
+
+ Result^.F.btype :=btype;
+ Result^.Offset :=FOffset;
+ Result^.Size :=FSize;
+end;
+
+//
+
+function TVirtualAdrFreeCompare.c(const a,b:TVirtualAdrNode):Integer;
+begin
+ //1 FSize
+ Result:=Integer(a.F.Size>b.F.Size)-Integer(a.F.Size0) then Exit;
+ //2 FOffset
+ Result:=Integer(a.F.Offset>b.F.Offset)-Integer(a.F.Offsetb.F.Offset)-Integer(a.F.Offset=_size);
+ Used:=Used-_size;
+ Result:=_VirtualDecommit(Pointer(_offset),_size);
+end;
+
+//
+
+Function TVirtualAdrNode.GetOffset:QWORD; inline;
+begin
+ Result:=QWORD(F.Offset) shl 12;
+end;
+
+Procedure TVirtualAdrNode.SetOffset(q:QWORD); inline;
+begin
+ F.Offset:=DWORD(q shr 12);
+ Assert(GetOffset=q);
+end;
+
+Function TVirtualAdrNode.GetSize:QWORD; inline;
+begin
+ Result:=QWORD(F.Size) shl 12;
+end;
+
+Procedure TVirtualAdrNode.SetSize(q:QWORD); inline;
+begin
+ F.Size:=DWORD(q shr 12);
+ Assert(GetSize=q);
+end;
+
+Function TVirtualAdrNode.GetAddr:Pointer; inline;
+begin
+ Result:=Pointer(QWORD(F.addr) shl 12);
+end;
+
+Procedure TVirtualAdrNode.SetAddr(p:Pointer); inline;
+begin
+ F.addr:=DWORD(QWORD(p) shr 12);
+ Assert(GetAddr=p);
+end;
+
+Function TVirtualAdrNode.GetIsFree:Boolean; inline;
+begin
+ Result:=Boolean(F.Free);
+end;
+
+Procedure TVirtualAdrNode.SetIsFree(b:Boolean); inline;
+begin
+ F.Free:=Byte(b);
+end;
+
+Function TVirtualAdrNode.cmp_merge(const n:TVirtualAdrNode):Boolean;
+begin
+ Result:=False;
+ if (F.prot <>n.F.prot ) then Exit;
+ if (F.reserv<>n.F.reserv) then Exit;
+ if (F.direct<>n.F.direct) then Exit;
+ if (F.stack <>n.F.stack ) then Exit;
+ if (F.polled<>n.F.polled) then Exit;
+ if (block <>n.block ) then Exit;
+ Result:=True;
+end;
+
+///
+
+Constructor TVirtualManager.Create(_lo,_hi:QWORD);
+var
+ key:TVirtualAdrNode;
+begin
+ Assert(_lo<_hi);
+
+ Flo:=_lo;
+ Fhi:=_hi;
+
+ key:=Default(TVirtualAdrNode);
+ key.IsFree:=True;
+ key.Offset:=_lo;
+ key.Size :=(_hi-_lo+1);
+
+ _Insert(key);
+end;
+
+procedure TVirtualManager._Insert(const key:TVirtualAdrNode);
+begin
+ if key.IsFree then
+ begin
+ if (key.block=nil) then
+ begin
+ FFreeSet.Insert(key);
+ end else
+ begin
+ case key.block^.F.btype of
+ BT_PRIV,
+ BT_GPUM:FFreeSet.Insert(key);
+ else;
+ end;
+ end;
+ end;
+ FAllcSet.Insert(key);
+end;
+
+//free: [Size] |[Offset]
+Function TVirtualManager._FetchFree_s(ss,Size,Align:QWORD;var R:TVirtualAdrNode):Boolean;
+var
+ It:TFreePoolNodeSet.Iterator;
+ key:TVirtualAdrNode;
+ Offset:QWORD;
+begin
+ Result:=false;
+ key:=Default(TVirtualAdrNode);
+ key.Offset:=ss;
+ key.Size :=Size;
+ It:=FFreeSet.find_be(key);
+ if (It.Item=nil) then Exit;
+ repeat
+ key:=It.Item^;
+ Offset:=System.Align(key.Offset,Align);
+ if (Offset+Size)<=(key.Offset+key.Size) then
+ begin
+ R:=key;
+ FAllcSet.delete(key);
+ FFreeSet.erase(It);
+ Exit(True);
+ end;
+ until not It.Next;
+end;
+
+function ia(addr:Pointer;Size:qword):Pointer; inline;
+begin
+ if (addr=nil) then
+ begin
+ Result:=nil;
+ end else
+ begin
+ Result:=addr+Size;
+ end;
+end;
+
+const
+ M_LE=0;
+ M_BE=1;
+
+ C_UP=2;
+ C_DW=4;
+
+ C_LE=6;
+ C_BE=8;
+
+Function TVirtualManager._FetchNode_m(mode:Byte;cmp:QWORD;var R:TVirtualAdrNode):Boolean;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key,rkey:TVirtualAdrNode;
+begin
+ Result:=false;
+
+ key:=R;
+
+ Case (mode and 1) of
+ M_LE:It:=FAllcSet.find_le(key);
+ M_BE:It:=FAllcSet.find_be(key);
+ else
+ Exit;
+ end;
+
+ if (It.Item=nil) then Exit;
+
+ rkey:=It.Item^;
+
+ if (rkey.IsFree <>key.IsFree ) then Exit;
+
+ Case (mode and (not 1)) of
+ C_UP:
+ begin
+ if not rkey.cmp_merge(key) then Exit;
+ if (ia(rkey.addr,rkey.Size)<>key.addr) then Exit;
+ if ((rkey.Offset+rkey.Size)<>cmp ) then Exit;
+ end;
+ C_DW:
+ begin
+ if not rkey.cmp_merge(key) then Exit;
+ if (rkey.addr <>key.addr) then Exit;
+ if (rkey.Offset <>cmp ) then Exit;
+ end;
+
+ C_LE:if ((rkey.Offset+rkey.Size)FOffset) then //prev save
+ begin
+ key.Size:=Offset-FOffset;
+ _Merge(key);
+ end;
+
+ if (FEndO>FEndN) then //next save
+ begin
+ key.Offset:=FEndN;
+ key.Size :=FEndO-FEndN;
+ key.addr :=ia(Faddr,(FEndN-FOffset));
+
+ _Merge(key);
+ end else
+ if (FEndO<>FEndN) then //tunc size
+ begin
+ Size:=FEndO-Offset;
+ end;
+
+ //new save
+ key.Offset :=Offset;
+ key.Size :=Size;
+ key.addr :=ia(Faddr,(Offset-FOffset));
+end;
+
+Function TVirtualManager.Alloc_flex(ss,Size,Align:QWORD;prot:Byte;var AdrOut:QWORD):Integer;
+var
+ key:TVirtualAdrNode;
+ Offset:QWORD;
+ block:PVirtualAdrBlock;
+begin
+ Result:=0;
+ if (Size=0) or (Align=0) then Exit(EINVAL);
+ if (ssFhi) then Exit(EINVAL);
+
+ key:=Default(TVirtualAdrNode);
+
+ if _FetchFree_s(ss,Size,Align,key) then
+ begin
+ Offset:=System.Align(key.Offset,Align);
+
+ _Devide(Offset,Size,key);
+
+ if (key.block<>nil) then
+ begin
+ block:=key.block;
+ Case block^.F.btype of
+ BT_FMAP:
+ begin
+ _Insert(key); //ret
+ Assert(false,'map flex to file');
+ Exit(ENOSYS);
+ end;
+ else;
+ end;
+ end else
+ begin
+ block:=NewAdrBlock(key.Offset,key.Size,prot,BT_PRIV,-1,0);
+ if (block=nil) then
+ begin
+ _Merge(key); //ret
+ Assert(False);
+ Exit(ENOSYS);
+ end;
+ end;
+
+ block^.Commit(key.Offset,key.Size,prot);
+ if _isgpu(prot) then //mark to gpu
+ begin
+ block^.F.btype:=BT_GPUM;
+ end;
+
+ //new save
+ key.IsFree :=False;
+ key.F.prot :=prot;
+ key.F.addr :=0;
+ key.F.reserv:=0;
+ key.F.direct:=0;
+ key.F.stack :=0;
+ key.F.polled:=0;
+ key.block :=block;
+ _Merge(key);
+
+ AdrOut:=key.Offset;
+ Result:=0;
+ end else
+ begin
+ Result:=ENOMEM;
+ end;
+end;
+
+Function TVirtualManager.check_fixed(Offset,Size:QWORD;btype,flags:Byte):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TVirtualAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TVirtualAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if (Offset>=key.Offset) then
+ begin
+ if key.IsFree then
+ begin
+ if (key.block<>nil) then
+ begin
+ Case btype of
+ BT_PRIV,
+ BT_GPUM:
+ begin
+ Case key.block^.F.btype of
+ BT_PRIV,
+ BT_GPUM:;
+ else
+ Exit(ENOSYS); //file map not valid for any devide
+ end;
+ end;
+ else
+ Exit(ENOSYS);
+ end;
+ end;
+ end else
+ begin
+ if (flags and MAP_NO_OVERWRITE)<>0 then
+ begin
+ Exit(ENOMEM);
+ end;
+ end;
+ end;
+
+ if (key.Offset>=FEndO) then Break;
+
+ It.Next;
+ end;
+end;
+
+Function TVirtualManager.mmap_flex(Offset,Size:QWORD;prot,flags:Byte):Integer;
+var
+ key:TVirtualAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+ btype:Byte;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ if _isgpu(prot) then
+ begin
+ btype:=BT_GPUM;
+ end else
+ begin
+ btype:=BT_PRIV;
+ end;
+
+ Result:=check_fixed(Offset,Size,btype,flags);
+ if (Result<>0) then Exit;
+
+ repeat
+
+ key:=Default(TVirtualAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ if (key.block=nil) then
+ begin
+ key.block:=NewAdrBlock(key.Offset,key.Size,prot,btype,-1,0);
+ if (key.block=nil) then
+ begin
+ _Merge(key); //ret
+ Assert(False);
+ Exit(ENOSYS);
+ end;
+ end;
+
+ key.block^.Commit(key.Offset,key.Size,prot);
+
+ //new save
+ key.IsFree :=False;
+ key.F.prot :=prot;
+ key.F.addr :=0;
+ key.F.reserv:=0;
+ key.F.direct:=0;
+ key.F.stack :=0;
+ key.F.polled:=0;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ //addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ //new save
+ key.IsFree :=False;
+ //key.addr :=addr;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ //addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ //addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ //addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+Function TVirtualManager.CheckedAlloc(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TVirtualAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TVirtualAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if (Offset>=key.Offset) then
+ begin
+ if not key.IsFree then
+ begin
+ Exit(ENOMEM);
+ end;
+ end;
+
+ if (key.Offset>=FEndO) then Break;
+
+ It.Next;
+ end;
+end;
+
+Function TVirtualManager.CheckedMMap(Offset,Size:QWORD):Integer;
+var
+ It:TAllcPoolNodeSet.Iterator;
+ key:TVirtualAdrNode;
+ FEndO:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ FEndO:=Offset+Size;
+
+ key:=Default(TVirtualAdrNode);
+ key.Offset:=Offset;
+
+ It:=FAllcSet.find_le(key);
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ if (Offset>=key.Offset) then
+ begin
+ if key.IsFree then
+ begin
+ Exit(EACCES);
+ end;
+ if (key.addr<>nil) then
+ begin
+ Exit(EBUSY);
+ end;
+ end;
+
+ if (key.Offset>=FEndO) then Break;
+
+ It.Next;
+ end;
+end;
+
+Function TVirtualManager.Release(Offset,Size:QWORD):Integer;
+var
+ key:TVirtualAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TVirtualAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ //new save
+ key.IsFree :=True;
+ key.F.prot :=0;
+ //key.F.ntype:=NT_FREE;
+ key.addr :=nil;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ //new save
+ key.IsFree :=True;
+ key.F.prot :=0;
+ //key.F.ntype:=NT_FREE;
+ key.addr :=nil;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+Function TVirtualManager.mmap2(Offset,Size:QWORD;addr:Pointer;mtype:Byte):Integer;
+var
+ key:TVirtualAdrNode;
+ FEndN,FEndO:QWORD;
+ FSize:QWORD;
+begin
+ Result:=0;
+ if (Size=0) then Exit(EINVAL);
+ if (OffsetFhi) then Exit(EINVAL);
+
+ repeat
+
+ key:=Default(TVirtualAdrNode);
+ key.IsFree:=False;
+ key.Offset:=Offset;
+
+ if _FetchNode_m(M_LE or C_LE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(Offset,Size,key);
+
+ //new save
+ key.IsFree :=False;
+ //key.F.mtype:=mtype;
+ key.addr :=addr;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _FetchNode_m(M_BE or C_BE,Offset,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ _Devide(key.Offset,FEndN-key.Offset,key);
+
+ //new save
+ key.IsFree :=False;
+ //key.F.mtype:=mtype;
+ key.addr :=addr;
+ _Merge(key);
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_LE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ if _Find_m(M_BE,key) then
+ begin
+ FEndN:=Offset+Size;
+ FEndO:=key.Offset+key.Size;
+
+ if (FEndO>=FEndN) then Break;
+
+ FSize:=FEndO-Offset;
+
+ addr :=ia(addr,FSize);
+ Offset:=Offset+FSize;
+ Size :=Size -FSize;
+ end else
+ begin
+ Break;
+ end;
+
+ until false;
+end;
+
+function _alloc_str(IsFree:Boolean):RawByteString;
+begin
+ Case IsFree of
+ True :Result:='FREE';
+ FAlse:Result:='ALLC';
+ end;
+end;
+
+procedure TVirtualManager.Print;
+var
+ key:TVirtualAdrNode;
+ It:TAllcPoolNodeSet.Iterator;
+begin
+ It:=FAllcSet.cbegin;
+ While (It.Item<>nil) do
+ begin
+ key:=It.Item^;
+
+ Writeln(HexStr(key.Offset,10),'..',
+ HexStr(key.Offset+key.Size,10),':',
+ HexStr(key.Size,10),'#',
+ HexStr(qword(key.addr),10),'#',
+ _alloc_str(key.IsFree),'#');
+
+ It.Next;
+ end;
+end;
+
+procedure itest;
+var
+ test:TVirtualManager;
+ addr:array[0..5] of qword;
+begin
+ test:=TVirtualManager.Create(0,$180000000-1);
+
+
+end;
+
+initialization
+ //itest;
+
+end.
+
+
+
+
diff --git a/kernel/ps4_libkernel.pas b/kernel/ps4_libkernel.pas
index 5f793fc..0ad3127 100644
--- a/kernel/ps4_libkernel.pas
+++ b/kernel/ps4_libkernel.pas
@@ -975,9 +975,14 @@ begin
//mmap
lib^.set_proc($A4EF7A4F0CCE9B91,@ps4_sceKernelGetDirectMemorySize);
+ lib^.set_proc($AD35F0EB9C662C80,@ps4_sceKernelAllocateDirectMemory);
+ lib^.set_proc($07EBDCD803B666B7,@ps4_sceKernelAllocateMainDirectMemory);
lib^.set_proc($0B47FB4C971B7DA7,@ps4_sceKernelAvailableDirectMemorySize);
lib^.set_proc($047A2E2D0CE1D17D,@ps4_sceKernelDirectMemoryQuery);
- lib^.set_proc($AD35F0EB9C662C80,@ps4_sceKernelAllocateDirectMemory);
+ lib^.set_proc($042F8E1B99BDF9BC,@ps4_sceKernelGetDirectMemoryType);
+ lib^.set_proc($8705523C29A9E6D3,@ps4_sceKernelCheckedReleaseDirectMemory);
+ lib^.set_proc($301B88B6F6DAEB3F,@ps4_sceKernelReleaseDirectMemory);
+
lib^.set_proc($2FF4372C48C86E00,@ps4_sceKernelMapDirectMemory);
lib^.set_proc($98BF0D0C7F3A8902,@ps4_sceKernelMapNamedFlexibleMemory);
lib^.set_proc($21620105D4C78ADE,@ps4_sceKernelMapFlexibleMemory);
diff --git a/kernel/ps4_map_mm.pas b/kernel/ps4_map_mm.pas
index 653278b..f26ff60 100644
--- a/kernel/ps4_map_mm.pas
+++ b/kernel/ps4_map_mm.pas
@@ -9,6 +9,10 @@ uses
g23tree,
RWLock,
sys_types,
+ mmap,
+ mm_adr_direct,
+ mm_adr_virtual,
+ mm_adr_pool,
Classes,
SysUtils;
@@ -37,57 +41,24 @@ User area : 0x0010 0000 0000 - 0x00FC 0000 0000 Size: 0x00EC 0000 0000
System reserved area: 0x00FC 0000 0000 - 0x00FF FFFF FFFF Size: 0x0003 FFFF FFFF (15GB)
}
+var
+ DirectManager:TDirectManager;
+
Const
SCE_KERNEL_MAIN_DMEM_SIZE=$180000000; //6GB
- // CPU
- SCE_KERNEL_PROT_CPU_READ =$01;
- SCE_KERNEL_PROT_CPU_WRITE=$02;
- SCE_KERNEL_PROT_CPU_RW =(SCE_KERNEL_PROT_CPU_READ or SCE_KERNEL_PROT_CPU_WRITE);
- SCE_KERNEL_PROT_CPU_EXEC =$04;
- SCE_KERNEL_PROT_CPU_ALL =(SCE_KERNEL_PROT_CPU_RW or SCE_KERNEL_PROT_CPU_EXEC);
-
-// GPU
- SCE_KERNEL_PROT_GPU_READ =$10;
- SCE_KERNEL_PROT_GPU_WRITE=$20;
- SCE_KERNEL_PROT_GPU_RW =(SCE_KERNEL_PROT_GPU_READ or SCE_KERNEL_PROT_GPU_WRITE);
- SCE_KERNEL_PROT_GPU_ALL =SCE_KERNEL_PROT_GPU_RW;
-
- SCE_KERNEL_MAP_FIXED =$0010;
- SCE_KERNEL_MAP_NO_OVERWRITE=$0080;
- SCE_KERNEL_MAP_DMEM_COMPAT =$0400;
- SCE_KERNEL_MAP_NO_COALESCE =$400000;
-
- SCE_KERNEL_WB_ONION = 0;
- SCE_KERNEL_WC_GARLIC = 3;
- SCE_KERNEL_WB_GARLIC =10;
-
- MAP_ANONYMOUS=1;
- MAP_ANON =MAP_ANONYMOUS;
- MAP_SHARED =2;
- MAP_PRIVATE =4;
- MAP_POPULATE =8;
- MAP_NORESERVE=16;
- MAP_FIXED =32;
-
- PROT_NONE = 0;
- PROT_READ = 1;
- PROT_WRITE = 2;
- PROT_EXEC = 4;
-
- MAP_FAILED =Pointer(-1);
-
type
pSceKernelDirectMemoryQueryInfo=^SceKernelDirectMemoryQueryInfo;
SceKernelDirectMemoryQueryInfo=packed record
start:QWORD;
__end:QWORD;
- memoryType:Integer;
- __align:Integer;
+ mType:Integer;
+ align:Integer;
end;
const
SCE_KERNEL_VIRTUAL_RANGE_NAME_SIZE=32;
+ SCE_KERNEL_DMQ_FIND_NEXT=1;
SCE_KERNEL_VQ_FIND_NEXT=1;
type
@@ -111,12 +82,6 @@ type
function ps4_sceKernelGetDirectMemorySize:Int64; SysV_ABI_CDecl;
function ps4_getpagesize:Integer; SysV_ABI_CDecl;
-function ps4_sceKernelDirectMemoryQuery(
- offset:QWORD;
- flags:Integer;
- info:pSceKernelDirectMemoryQueryInfo;
- infoSize:QWORD):Integer; SysV_ABI_CDecl;
-
function ps4_sceKernelAllocateDirectMemory(
searchStart:QWORD;
searchEnd:QWORD;
@@ -125,6 +90,12 @@ function ps4_sceKernelAllocateDirectMemory(
memoryType:Integer;
physicalAddrDest:PQWORD):Integer; SysV_ABI_CDecl;
+function ps4_sceKernelAllocateMainDirectMemory(
+ length:QWORD;
+ alignment:QWORD;
+ memoryType:Integer;
+ physicalAddrDest:PQWORD):Integer; SysV_ABI_CDecl;
+
function ps4_sceKernelAvailableDirectMemorySize(
searchStart:QWORD;
searchEnd:QWORD;
@@ -132,6 +103,23 @@ function ps4_sceKernelAvailableDirectMemorySize(
physAddrOut:PQWORD;
sizeOut:PQWORD):Integer; SysV_ABI_CDecl;
+function ps4_sceKernelDirectMemoryQuery(
+ offset:QWORD;
+ flags:Integer;
+ info:pSceKernelDirectMemoryQueryInfo;
+ infoSize:QWORD):Integer; SysV_ABI_CDecl;
+
+function ps4_sceKernelGetDirectMemoryType(
+ start:QWORD;
+ memoryTypeOut:PInteger;
+ regionStartOut:PQWORD;
+ regionEndOut:PQWORD):Integer; SysV_ABI_CDecl;
+
+function ps4_sceKernelCheckedReleaseDirectMemory(start,len:QWORD):Integer; SysV_ABI_CDecl;
+function ps4_sceKernelReleaseDirectMemory(start,len:QWORD):Integer; SysV_ABI_CDecl;
+
+//mapping
+
function ps4_sceKernelMapDirectMemory(
virtualAddrDest:PPointer;
length:QWORD;
@@ -262,65 +250,9 @@ begin
Result:=(x and (x - 1))=0;
end;
-function _isgpu(prot:LongInt):Boolean; inline;
+function fastIntLog2(i:QWORD):QWORD; inline;
begin
- Result:=prot and (SCE_KERNEL_PROT_GPU_READ or SCE_KERNEL_PROT_GPU_WRITE)<>0;
-end;
-
-function __map_sce_prot_page(prot:LongInt):DWORD;
-begin
- Result:=0;
- if (prot=0) then Exit(PAGE_NOACCESS);
-
- if (prot and SCE_KERNEL_PROT_CPU_EXEC)<>0 then
- begin
- if (prot and (SCE_KERNEL_PROT_CPU_WRITE or SCE_KERNEL_PROT_GPU_WRITE) )<>0 then
- begin
- Result:=PAGE_EXECUTE_READWRITE;
- end else
- if (prot and (SCE_KERNEL_PROT_CPU_READ or SCE_KERNEL_PROT_GPU_READ) )<>0 then
- begin
- Result:=PAGE_EXECUTE_READ;
- end else
- begin
- Result:=PAGE_EXECUTE;
- end;
- end else
- if (prot and (SCE_KERNEL_PROT_CPU_WRITE or SCE_KERNEL_PROT_GPU_WRITE) )<>0 then
- begin
- Result:=PAGE_READWRITE;
- end else
- begin
- Result:=PAGE_READONLY;
- end;
-end;
-
-function __map_mmap_prot_page(prot:LongInt):DWORD;
-begin
- Result:=0;
- if (prot=PROT_NONE) then Exit(PAGE_NOACCESS);
-
- if (prot and PROT_EXEC)<>0 then
- begin
- if (prot and PROT_WRITE)<>0 then
- begin
- Result:=PAGE_EXECUTE_READWRITE;
- end else
- if (prot and PROT_READ)<>0 then
- begin
- Result:=PAGE_EXECUTE_READ;
- end else
- begin
- Result:=PAGE_EXECUTE;
- end;
- end else
- if (prot and PROT_WRITE)<>0 then
- begin
- Result:=PAGE_READWRITE;
- end else
- begin
- Result:=PAGE_READONLY;
- end;
+ Result:=BsfQWORD(i);
end;
function str_mem_type(memoryType:Integer):RawByteString;
@@ -523,7 +455,7 @@ type
FLock:TRWLock;
FDirectSize:QWORD;
- FDirectAdrSet:TDirectAdrSet;
+ //FDirectAdrSet:TDirectAdrSet;
FMapBlockSet:TBlockSet;
@@ -564,7 +496,7 @@ var
block:PBlockBig;
begin
Result:=nil;
- base:=VirtualAllocAlign(addr,len,alignment,MEM_COMMIT or MEM_RESERVE,__map_sce_prot_page(prot));
+ base:=VirtualAllocAlign(addr,len,alignment,MEM_COMMIT or MEM_RESERVE,__map_prot_page(prot));
if (base=nil) then Exit;
block:=AllocMem(SizeOf(TBlockBig));
if (block=nil) then
@@ -593,7 +525,7 @@ var
i,c:Byte;
begin
Result:=nil;
- base:=VirtualAllocAlign(addr,GRANULAR_PAGE_SIZE,alignment,MEM_COMMIT or MEM_RESERVE,__map_sce_prot_page(prot));
+ base:=VirtualAllocAlign(addr,GRANULAR_PAGE_SIZE,alignment,MEM_COMMIT or MEM_RESERVE,__map_prot_page(prot));
if (len<>GRANULAR_PAGE_SIZE) then
begin
VirtualFree(base+len,GRANULAR_PAGE_SIZE-len,MEM_DECOMMIT);
@@ -764,7 +696,7 @@ begin
_map_64k_block_d(block);
Result:=block^.pAddr+(b*LOGICAL_PAGE_SIZE);
- Result:=VirtualAlloc(Result,len,MEM_COMMIT,__map_sce_prot_page(prot));
+ Result:=VirtualAlloc(Result,len,MEM_COMMIT,__map_prot_page(prot));
end;
end;
@@ -1044,7 +976,7 @@ begin
Case _pblock^.bType of
BT_DIRECT_BIG:
begin
- if VirtualAlloc(curr,LOGICAL_PAGE_SIZE,MEM_COMMIT,__map_sce_prot_page(prot))=nil then Exit(False);
+ if VirtualAlloc(curr,LOGICAL_PAGE_SIZE,MEM_COMMIT,__map_prot_page(prot))=nil then Exit(False);
curr:=curr+LOGICAL_PAGE_SIZE;
if (direct<>INVALID_DIRECT) then
begin
@@ -1053,7 +985,7 @@ begin
end;
BT_PHYSIC_BIG:
begin
- if VirtualAlloc(curr,PHYSICAL_PAGE_SIZE,MEM_COMMIT,__map_sce_prot_page(prot))=nil then Exit(False);
+ if VirtualAlloc(curr,PHYSICAL_PAGE_SIZE,MEM_COMMIT,__map_prot_page(prot))=nil then Exit(False);
curr:=curr+PHYSICAL_PAGE_SIZE;
if (direct<>INVALID_DIRECT) then
begin
@@ -1062,7 +994,7 @@ begin
end;
BT_DIRECT_64K:
begin
- if VirtualAlloc(curr,LOGICAL_PAGE_SIZE,MEM_COMMIT,__map_sce_prot_page(prot))=nil then Exit(False);
+ if VirtualAlloc(curr,LOGICAL_PAGE_SIZE,MEM_COMMIT,__map_prot_page(prot))=nil then Exit(False);
i:=Get16kBlockCount(curr-_pblock^.pAddr);
_unmap_64k_block_d(PBlock64k(_pblock));
PBlock64k(_pblock)^.nodes[i].direct:=direct;
@@ -1194,7 +1126,7 @@ function __mprotect(addr:Pointer;len:size_t;prot:Integer):Integer;
Var
newprotect,oldprotect:DWORD;
begin
- newprotect:=__map_mmap_prot_page(prot);
+ newprotect:=__map_prot_page(prot);
oldprotect:=0;
if not VirtualProtect(addr,len,newprotect,oldprotect) then
@@ -1312,7 +1244,225 @@ begin
Result:=PHYSICAL_PAGE_SIZE;
end;
-//function sceKernelReleaseDirectMemory(physicalAddr:Pointer;length:Int64):Int64; cdecl;
+function _test_mtype(mtype:Integer):Boolean; inline;
+begin
+ Case mtype of
+ SCE_KERNEL_WB_ONION ,
+ SCE_KERNEL_WC_GARLIC,
+ SCE_KERNEL_WB_GARLIC:Result:=True;
+ else
+ Result:=False;
+ end;
+end;
+
+//direct
+
+function _sceKernelAllocateDirectMemory(
+ searchStart:QWORD;
+ searchEnd:QWORD;
+ length:QWORD;
+ alignment:QWORD;
+ memoryType:Integer;
+ physicalAddrDest:PQWORD):Integer;
+begin
+ Result:=EINVAL;
+
+ Writeln('srchd:',HexStr(searchStart,10),'..',HexStr(searchEnd,10),' len:',HexStr(length,10));
+ Writeln('align:',HexStr(alignment,10),' ','mType:',str_mem_type(memoryType));
+
+ if (physicalAddrDest=nil) or (length=0) or (searchEnd<=searchStart) then Exit;
+
+ if (searchEnd>SCE_KERNEL_MAIN_DMEM_SIZE) then Exit;
+
+ if (alignment=0) then alignment:=LOGICAL_PAGE_SIZE;
+
+ if not IsAlign(length ,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(alignment,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsPowerOfTwo(alignment) then Exit;
+ if (fastIntLog2(alignment)>31) then Exit;
+
+ if not _test_mtype(memoryType) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.Alloc_search(searchStart,searchEnd,length,alignment,Byte(memoryType),physicalAddrDest^);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+end;
+
+function _sceKernelAllocateMainDirectMemory(
+ length:QWORD;
+ alignment:QWORD;
+ memoryType:Integer;
+ physicalAddrDest:PQWORD):Integer;
+begin
+ Result:=EINVAL;
+
+ Writeln('srchm: len:',HexStr(length,10));
+ Writeln('align:',HexStr(alignment,10),' ','mType:',str_mem_type(memoryType));
+
+ if (physicalAddrDest=nil) or (length=0) then Exit;
+
+ if (alignment=0) then alignment:=LOGICAL_PAGE_SIZE;
+
+ if not IsAlign(length ,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(alignment,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsPowerOfTwo(alignment) then Exit;
+ if (fastIntLog2(alignment)>31) then Exit;
+
+ if not _test_mtype(memoryType) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.Alloc_any(length,alignment,Byte(memoryType),physicalAddrDest^);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+end;
+
+function _sceKernelAvailableDirectMemorySize(
+ searchStart:QWORD;
+ searchEnd:QWORD;
+ alignment:QWORD;
+ physAddrOut:PQWORD;
+ sizeOut:PQWORD):Integer;
+var
+ FAdrOut,FSizeOut:QWORD;
+begin
+ Result:=EINVAL;
+
+ if (physAddrOut=nil) or (sizeOut=nil) or (searchEnd<=searchStart) then Exit;
+
+ if (searchEnd>SCE_KERNEL_MAIN_DMEM_SIZE) then Exit;
+
+ if (alignment=0) then alignment:=LOGICAL_PAGE_SIZE;
+
+ if not IsAlign(searchStart,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(searchEnd ,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(alignment ,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsPowerOfTwo(alignment) then Exit;
+ if (fastIntLog2(alignment)>31) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.CheckedAvailable(searchStart,searchEnd,alignment,FAdrOut,FSizeOut);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+
+ if (Result=0) then
+ begin
+ if (physAddrOut<>nil) then
+ begin
+ physAddrOut^:=FAdrOut;
+ end;
+ if (sizeOut<>nil) then
+ begin
+ sizeOut^:=FSizeOut;
+ end;
+ end;
+end;
+
+function _sceKernelDirectMemoryQuery(
+ offset:QWORD;
+ flags:Integer;
+ info:pSceKernelDirectMemoryQueryInfo;
+ infoSize:QWORD):Integer;
+var
+ ROut:TDirectAdrNode;
+begin
+ Result:=EINVAL;
+
+ if (info=nil) or (infoSize<>SizeOf(SceKernelDirectMemoryQueryInfo)) then Exit;
+
+ if not IsAlign(offset,LOGICAL_PAGE_SIZE) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.Query(offset,(flags=SCE_KERNEL_DMQ_FIND_NEXT),ROut);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+
+ if (Result<>0) then
+ begin
+ info^:=Default(SceKernelDirectMemoryQueryInfo);
+ info^.start:=ROut.Offset;
+ info^.__end:=ROut.Offset+ROut.Size;
+ info^.mType:=ROut.F.mtype;
+ end;
+end;
+
+function _sceKernelGetDirectMemoryType(
+ start:QWORD;
+ memoryTypeOut:PInteger;
+ regionStartOut:PQWORD;
+ regionEndOut:PQWORD):Integer;
+var
+ ROut:TDirectAdrNode;
+begin
+ Result:=EINVAL;
+
+ if (memoryTypeOut=nil) then Exit;
+ if (regionStartOut=nil) then Exit;
+ if (regionEndOut=nil) then Exit;
+
+ start:=AlignDw(start,PHYSICAL_PAGE_SIZE);
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.QueryMType(start,ROut);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+
+ if (Result<>0) then
+ begin
+ memoryTypeOut ^:=ROut.F.mtype;
+ regionStartOut^:=ROut.Offset;
+ regionEndOut ^:=ROut.Offset+ROut.Size;
+ end;
+end;
+
+function _sceKernelCheckedReleaseDirectMemory(start,len:QWORD):Integer;
+begin
+ Result:=EINVAL;
+
+ if not IsAlign(start,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(len ,LOGICAL_PAGE_SIZE) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.CheckedRelease(start,len);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+end;
+
+function _sceKernelReleaseDirectMemory(start,len:QWORD):Integer;
+begin
+ Result:=EINVAL;
+
+ if not IsAlign(start,LOGICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(len ,LOGICAL_PAGE_SIZE) then Exit;
+
+ _sig_lock;
+ rwlock_wrlock(PageMM.FLock);
+
+ Result:=DirectManager.Release(start,len);
+
+ rwlock_unlock(PageMM.FLock);
+ _sig_unlock;
+end;
+
+//
function ps4_sceKernelAllocateDirectMemory(
searchStart:QWORD;
@@ -1321,103 +1471,44 @@ function ps4_sceKernelAllocateDirectMemory(
alignment:QWORD;
memoryType:Integer;
physicalAddrDest:PQWORD):Integer; SysV_ABI_CDecl;
-var
- It:TDirectAdrSet.Iterator;
- Adr,Tmp:TBlock;
- m1,m2:Pointer;
begin
- Writeln('srch:',HexStr(searchStart,16),'..',HexStr(searchEnd,16),' len:',HexStr(length,16));
- Writeln('align:',HexStr(alignment,16),' ','mType:',str_mem_type(memoryType));
+ Result:=_sceKernelAllocateDirectMemory(
+ searchStart,
+ searchEnd,
+ length,
+ alignment,
+ memoryType,
+ physicalAddrDest);
- if (physicalAddrDest=nil) or (length=0) or (searchEnd<=searchStart) then Exit(SCE_KERNEL_ERROR_EINVAL);
-
- if (searchEnd>SCE_KERNEL_MAIN_DMEM_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
-
- if (alignment=0) then alignment:=LOGICAL_PAGE_SIZE;
-
- if not IsAlign(length ,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
- if not IsAlign(alignment,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
- if not IsPowerOfTwo(alignment) then Exit(SCE_KERNEL_ERROR_EINVAL);
-
- Adr.pAddr:=AlignUp(Pointer(searchStart),alignment);
- Adr.nSize:=length;
- Adr.bType:=memoryType;
-
- Result:=0;
-
- _sig_lock;
- rwlock_wrlock(PageMM.FLock);
-
- if ((PageMM.FDirectSize+Adr.nSize)>SCE_KERNEL_MAIN_DMEM_SIZE) then
+ if (Result<>0) then
begin
- rwlock_unlock(PageMM.FLock);
- _sig_unlock;
- Exit(SCE_KERNEL_ERROR_EAGAIN);
+ Writeln(StdErr,'[WARN]:sceKernelAllocateDirectMemory:',Result);
end;
+ _set_errno(Result);
- repeat
-
- if ((QWORD(Adr.pAddr)+Adr.nSize)>SCE_KERNEL_MAIN_DMEM_SIZE) then
- begin
- Result:=SCE_KERNEL_ERROR_EAGAIN;
- Break;
- end;
-
- Tmp.pAddr:=Adr.pAddr+Adr.nSize-1;
- Tmp.nSize:=0;
- Tmp.bType:=0;
-
- It:=PageMM.FDirectAdrSet.find_le(Tmp);
- if (It.Item=nil) then Break;
-
- Tmp:=It.Item^;
- m1:=Tmp.pAddr+Tmp.nSize;
-
- if (Adr.pAddr>=m1) then Break;
-
- m1:=AlignUp(m1,alignment);
- m2:=Adr.pAddr+alignment;
-
- if (m1>m2) then
- Adr.pAddr:=m1
- else
- Adr.pAddr:=m2;
-
- if (Adr.pAddr>=Pointer(searchEnd)) then
- begin
- Result:=SCE_KERNEL_ERROR_EAGAIN;
- Break;
- end;
-
- until false;
-
- if (Result=0) then
- begin
- PageMM.FDirectSize:=PageMM.FDirectSize+Adr.nSize;
- PageMM.FDirectAdrSet.Insert(Adr);
- physicalAddrDest^:=QWORD(Adr.pAddr);
- end;
-
- rwlock_unlock(PageMM.FLock);
- _sig_unlock;
-
- Result:=0;
+ Result:=px2sce(Result);
end;
-{
-SCE_KERNEL_MAP_FIXED
- 0x0010
- Fix map destination to *addr
+function ps4_sceKernelAllocateMainDirectMemory(
+ length:QWORD;
+ alignment:QWORD;
+ memoryType:Integer;
+ physicalAddrDest:PQWORD):Integer; SysV_ABI_CDecl;
+begin
+ Result:=_sceKernelAllocateMainDirectMemory(
+ length,
+ alignment,
+ memoryType,
+ physicalAddrDest);
-SCE_KERNEL_MAP_NO_OVERWRITE
- 0x0080
- Prohibit mapping when an area that is being used is included between *addr and *addr+len
+ if (Result<>0) then
+ begin
+ Writeln(StdErr,'[WARN]:sceKernelAllocateMainDirectMemory:',Result);
+ end;
+ _set_errno(Result);
-SCE_KERNEL_MAP_NO_COALESCE
- 0x400000
- Instruct sceKernelVirtualQuery() not to merge neighboring areas
-
- }
+ Result:=px2sce(Result);
+end;
function ps4_sceKernelAvailableDirectMemorySize(
searchStart:QWORD;
@@ -1425,130 +1516,127 @@ function ps4_sceKernelAvailableDirectMemorySize(
alignment:QWORD;
physAddrOut:PQWORD;
sizeOut:PQWORD):Integer; SysV_ABI_CDecl;
-var
- It:TDirectAdrSet.Iterator;
- offset,size:QWORD;
- Tmp:TBlock;
begin
- if (physAddrOut=nil) or (sizeOut=nil) or (searchEnd<=searchStart) then Exit(SCE_KERNEL_ERROR_EINVAL);
+ Result:=_sceKernelAvailableDirectMemorySize(
+ searchStart,
+ searchEnd,
+ alignment,
+ physAddrOut,
+ sizeOut);
- if (searchEnd>SCE_KERNEL_MAIN_DMEM_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
+ if (Result<>0) then
+ begin
+ Writeln(StdErr,'[WARN]:sceKernelAvailableDirectMemorySize:',Result);
+ end;
+ _set_errno(Result);
- if (alignment=0) then alignment:=LOGICAL_PAGE_SIZE;
-
- if not IsAlign(searchStart,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
- if not IsAlign(searchEnd ,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
- if not IsAlign(alignment ,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
- if not IsPowerOfTwo(alignment) then Exit(SCE_KERNEL_ERROR_EINVAL);
-
- physAddrOut^:=0;
- sizeOut^ :=0;
-
- offset:=0;
-
- Result:=0;
- _sig_lock;
- rwlock_wrlock(PageMM.FLock);
-
- repeat
-
- Tmp.pAddr:=AlignUp(Pointer(offset),alignment);
- Tmp.nSize:=0;
- Tmp.bType:=0;
-
- It:=PageMM.FDirectAdrSet.find_be(Tmp);
-
- if (It.Item=nil) then //nothing to be
- begin
- size:=searchEnd-offset;
- if (size=0) then
- begin
- Result:=SCE_KERNEL_ERROR_EAGAIN;
- Break;
- end else
- begin
- physAddrOut^:=offset;
- sizeOut^ :=size;
- Break;
- end;
- end;
-
- Tmp:=It.Item^;
-
- size:=QWORD(Tmp.pAddr)-offset;
-
- if (size<>0) then
- begin
- physAddrOut^:=offset;
- sizeOut^ :=size;
- Break;
- end;
-
- offset:=QWORD(Tmp.pAddr)+Tmp.nSize;
-
- if (offset>=searchEnd) then
- begin
- Result:=SCE_KERNEL_ERROR_EAGAIN;
- Break;
- end;
-
- until false;
-
- rwlock_unlock(PageMM.FLock);
- _sig_unlock;
-
- Result:=0;
+ Result:=px2sce(Result);
end;
-const
- SCE_KERNEL_DMQ_FIND_NEXT=1;
-
function ps4_sceKernelDirectMemoryQuery(
offset:QWORD;
flags:Integer;
info:pSceKernelDirectMemoryQueryInfo;
infoSize:QWORD):Integer; SysV_ABI_CDecl;
-var
- It:TDirectAdrSet.Iterator;
- Tmp:TBlock;
begin
- if (info=nil) or (infoSize<>SizeOf(SceKernelDirectMemoryQueryInfo)) then Exit(SCE_KERNEL_ERROR_EINVAL);
+ Result:=_sceKernelDirectMemoryQuery(
+ offset,
+ flags,
+ info,
+ infoSize);
- if not IsAlign(offset,LOGICAL_PAGE_SIZE) then Exit(SCE_KERNEL_ERROR_EINVAL);
-
- info^:=Default(SceKernelDirectMemoryQueryInfo);
-
- Tmp:=Default(TBlock);
- Tmp.pAddr:=Pointer(offset);
-
- Result:=0;
-
- _sig_lock;
- rwlock_wrlock(PageMM.FLock);
-
- if (flags=SCE_KERNEL_DMQ_FIND_NEXT) then
+ if (Result<>0) then
begin
- It:=PageMM.FDirectAdrSet.find_be(Tmp);
+ Writeln(StdErr,'[WARN]:sceKernelDirectMemoryQuery:',Result);
+ end;
+ _set_errno(Result);
+
+ Result:=px2sce(Result);
+end;
+
+function ps4_sceKernelGetDirectMemoryType(
+ start:QWORD;
+ memoryTypeOut:PInteger;
+ regionStartOut:PQWORD;
+ regionEndOut:PQWORD):Integer; SysV_ABI_CDecl;
+
+begin
+ Result:=_sceKernelGetDirectMemoryType(
+ start,
+ memoryTypeOut,
+ regionStartOut,
+ regionEndOut);
+
+ if (Result<>0) then
+ begin
+ Writeln(StdErr,'[WARN]:sceKernelGetDirectMemoryType:',Result);
+ end;
+ _set_errno(Result);
+
+ Result:=px2sce(Result);
+end;
+
+function ps4_sceKernelCheckedReleaseDirectMemory(start,len:QWORD):Integer; SysV_ABI_CDecl;
+begin
+ Result:=_sceKernelCheckedReleaseDirectMemory(start,len);
+
+ if (Result<>0) then
+ begin
+ Writeln(StdErr,'[WARN]:sceKernelCheckedReleaseDirectMemory:',Result);
+ end;
+ _set_errno(Result);
+
+ Result:=px2sce(Result);
+end;
+
+function ps4_sceKernelReleaseDirectMemory(start,len:QWORD):Integer; SysV_ABI_CDecl;
+begin
+ Result:=_sceKernelReleaseDirectMemory(start,len);
+
+ if (Result<>0) then
+ begin
+ Writeln(StdErr,'[WARN]:sceKernelReleaseDirectMemory:',Result);
+ end;
+ _set_errno(Result);
+
+ Result:=px2sce(Result);
+end;
+
+//mapping
+
+//flag:MAP_VOID fd=-1 //reserve
+//flag:MAP_ANON fd=-1 //flex
+//flag:MAP_SHARED fd=/dev/dmem%d offset=physicalAddr //direct
+
+function __mmap(addr:Pointer;len,align:size_t;prot,flags:Integer;fd:Integer;offset:size_t;var res:Pointer):Integer;
+begin
+ Result:=EINVAL;
+
+ if not IsAlign(addr ,PHYSICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(len ,PHYSICAL_PAGE_SIZE) then Exit;
+ if not IsAlign(offset,PHYSICAL_PAGE_SIZE) then Exit;
+
+ if (flags and MAP_VOID)<>0 then //reserved
+ begin
+ Assert(false);
end else
+ if (flags and MAP_ANON)<>0 then //flex
begin
- It:=PageMM.FDirectAdrSet.find(Tmp);
+ Assert(false);
+ end else
+ if (flags and MAP_SHARED)<>0 then
+ begin
+ if (fd=-1) then Exit;
+ if (fd=0) then //direct
+ begin
+ Assert(false);
+ end else
+ begin //file
+ Assert(false);
+ end;
end;
- if (It.Item=nil) then
- begin
- Result:=SCE_KERNEL_ERROR_EACCES;
- end else
- begin
- Tmp:=It.Item^;
- info^.start:=QWORD(Tmp.pAddr);
- info^.__end:=QWORD(Tmp.pAddr)+Tmp.nSize;
- info^.memoryType:=Integer(Tmp.bType);
-
- end;
-
- rwlock_unlock(PageMM.FLock);
- _sig_unlock;
end;
function ps4_sceKernelMapDirectMemory(
@@ -1611,8 +1699,6 @@ begin
Result:=0;
end;
-//sceKernelCheckedReleaseDirectMemory
-
function ps4_sceKernelMapNamedFlexibleMemory(
virtualAddrDest:PPointer;
length:QWORD;
@@ -1802,7 +1888,7 @@ begin
Exit;
end;
- protect:=__map_mmap_prot_page(prot);
+ protect:=__map_prot_page(prot);
SetLastError(0);
@@ -1882,8 +1968,14 @@ begin
_sig_unlock;
end;
+var
+ res:Pointer;
+
initialization
+ DirectManager:=TDirectManager.Create(0,SCE_KERNEL_MAIN_DMEM_SIZE-1);
PageMM.init;
+ __mmap(nil,4*1024,4*1024,0,0,0,0,res);
+
end.
diff --git a/rtl/mmap.pas b/rtl/mmap.pas
new file mode 100644
index 0000000..ea92ec5
--- /dev/null
+++ b/rtl/mmap.pas
@@ -0,0 +1,249 @@
+unit mmap;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Windows;
+
+const
+ // CPU
+ SCE_KERNEL_PROT_CPU_READ =$01;
+ SCE_KERNEL_PROT_CPU_WRITE=$02;
+ SCE_KERNEL_PROT_CPU_RW =(SCE_KERNEL_PROT_CPU_READ or SCE_KERNEL_PROT_CPU_WRITE);
+ SCE_KERNEL_PROT_CPU_EXEC =$04;
+ SCE_KERNEL_PROT_CPU_ALL =(SCE_KERNEL_PROT_CPU_RW or SCE_KERNEL_PROT_CPU_EXEC);
+
+ // GPU
+ SCE_KERNEL_PROT_GPU_READ =$10;
+ SCE_KERNEL_PROT_GPU_WRITE=$20;
+ SCE_KERNEL_PROT_GPU_RW =(SCE_KERNEL_PROT_GPU_READ or SCE_KERNEL_PROT_GPU_WRITE);
+ SCE_KERNEL_PROT_GPU_ALL =SCE_KERNEL_PROT_GPU_RW;
+
+ SCE_KERNEL_MAP_FIXED =$0010;
+ SCE_KERNEL_MAP_NO_OVERWRITE=$0080;
+ SCE_KERNEL_MAP_DMEM_COMPAT =$0400;
+ SCE_KERNEL_MAP_NO_COALESCE =$400000;
+
+ SCE_KERNEL_WB_ONION = 0;
+ SCE_KERNEL_WC_GARLIC = 3;
+ SCE_KERNEL_WB_GARLIC =10;
+
+ //mmap
+ PROT_NONE =$00; // no permissions
+ PROT_READ =$01; // pages can be read
+ PROT_WRITE =$02; // pages can be written
+ PROT_EXEC =$04; // pages can be executed
+ PROT_CPU_READ =PROT_READ;
+ PROT_CPU_WRITE =PROT_WRITE;
+ PROT_CPU_ALL =$07;
+ PROT_GPU_READ =$10;
+ PROT_GPU_WRITE =$20;
+ PROT_GPU_ALL =$30;
+
+
+ MAP_SHARED =$0001; // share changes
+ MAP_PRIVATE =$0002; // changes are private
+ MAP_FIXED =$0010; // map addr must be exactly as requested
+ MAP_NO_OVERWRITE=$0080;
+ MAP_VOID =$0100; // reserve
+
+ MAP_RENAME =$0020; // Sun: rename private pages to file
+ MAP_NORESERVE =$0040; // Sun: don't reserve needed swap area
+ MAP_HASSEMAPHORE=$0200; // region may contain semaphores
+ MAP_STACK =$0400; // region grows down, like a stack
+ MAP_NOSYNC =$0800; // page to but do not sync underlying file
+
+ MAP_FILE =$0000; // map from file (default)
+ MAP_ANON =$1000; // allocated from memory, swap space
+ MAP_ANONYMOUS =MAP_ANON; // For compatibility.
+ MAP_SYSTEM =$2000;
+ MAP_ALLAVAILABLE=$4000;
+
+ MAP_SELF =$00080000; // map decryped SELF file
+
+ MAP_ALIGNMENT_BIT =24;
+ MAP_ALIGNMENT_MASK=$1f000000;
+ MAP_ALIGNMENT_MUL =$01000000; //1 shl 24
+
+ MAP_FAILED =Pointer(-1);
+
+function _isgpu(prot:Integer):Boolean; inline;
+function __map_prot_page(prot:Integer):DWORD;
+function __map_prot_file(prot:Integer):DWORD;
+
+function _VirtualAlloc (Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+function _VirtualReserve (Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+function _VirtualCommit (Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+function _VirtualDecommit(Addr:Pointer;dwSize:PTRUINT):Integer;
+function _VirtualFree (Addr:Pointer):Integer;
+function _VirtualMmap (Addr:Pointer;len:size_t;prot,fd:Integer;offst:size_t):Integer;
+function _VirtualUnmap (addr:Pointer):Integer;
+
+implementation
+
+const
+ FILE_MAP_EXECUTE=$0020;
+
+function _isgpu(prot:Integer):Boolean; inline;
+begin
+ Result:=prot and (SCE_KERNEL_PROT_GPU_READ or SCE_KERNEL_PROT_GPU_WRITE)<>0;
+end;
+
+function __map_prot_page(prot:Integer):DWORD;
+begin
+ Result:=0;
+ if (prot=PROT_NONE) then Exit(PAGE_NOACCESS);
+
+ if (prot and PROT_EXEC)<>0 then
+ begin
+ if (prot and (PROT_WRITE or SCE_KERNEL_PROT_GPU_WRITE))<>0 then
+ begin
+ Result:=PAGE_EXECUTE_READWRITE;
+ end else
+ if (prot and (PROT_READ or SCE_KERNEL_PROT_GPU_READ))<>0 then
+ begin
+ Result:=PAGE_EXECUTE_READ;
+ end else
+ begin
+ Result:=PAGE_EXECUTE;
+ end;
+ end else
+ if (prot and (PROT_WRITE or SCE_KERNEL_PROT_GPU_WRITE))<>0 then
+ begin
+ Result:=PAGE_READWRITE;
+ end else
+ begin
+ Result:=PAGE_READONLY;
+ end;
+end;
+
+function __map_prot_file(prot:Integer):DWORD;
+begin
+ Result:= 0;
+ if (prot=PROT_NONE) then Exit;
+ if (prot and PROT_READ) <>0 then Result:=Result or FILE_MAP_READ;
+ if (prot and PROT_WRITE)<>0 then Result:=Result or FILE_MAP_WRITE;
+ if (prot and PROT_EXEC) <>0 then Result:=Result or FILE_MAP_EXECUTE;
+end;
+
+function _VirtualAlloc(Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+begin
+ Result:=0;
+ if (Addr=nil) then Exit(-1);
+ Addr:=VirtualAlloc(Addr,dwSize,MEM_COMMIT or MEM_RESERVE,__map_prot_page(prot));
+ if (Addr<>nil) then Exit;
+ Result:=GetLastError;
+end;
+
+function _VirtualReserve(Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+begin
+ Result:=0;
+ if (Addr=nil) then Exit(-1);
+ Addr:=VirtualAlloc(Addr,dwSize,MEM_RESERVE,__map_prot_page(prot));
+ if (Addr<>nil) then Exit;
+ Result:=GetLastError;
+end;
+
+function _VirtualCommit(Addr:Pointer;dwSize:PTRUINT;prot:Integer):Integer;
+var
+ new:Pointer;
+begin
+ Result:=0;
+ if (Addr=nil) then Exit(-1);
+ new:=VirtualAlloc(Addr,dwSize,MEM_COMMIT,__map_prot_page(prot));
+ if (new<>nil) then
+ begin
+ Assert(new=Addr);
+ Exit;
+ end;
+ Result:=GetLastError;
+end;
+
+function _VirtualDecommit(Addr:Pointer;dwSize:PTRUINT):Integer;
+begin
+ Result:=0;
+ if (Addr=nil) then Exit(-1);
+ if (dwSize=0) then Exit;
+ if not VirtualFree(Addr,dwSize,MEM_DECOMMIT) then
+ begin
+ Result:=GetLastError;
+ end;
+end;
+
+function _VirtualFree(Addr:Pointer):Integer;
+begin
+ Result:=0;
+ if (Addr=nil) then Exit(-1);
+ if not VirtualFree(Addr,0,MEM_RELEASE) then
+ begin
+ Result:=GetLastError;
+ end;
+end;
+
+function _get_osfhandle(fd:Integer):THandle; cdecl; external 'msvcrt';
+
+function MapViewOfFileEx(hFileMappingObject:HANDLE;
+ dwDesiredAccess:DWORD;
+ dwFileOffsetHigh:DWORD;
+ dwFileOffsetLow:DWORD;
+ dwNumberOfBytesToMap:SIZE_T;
+ lpBaseAddress:LPVOID):LPVOID; stdcall; external 'kernel32' name 'MapViewOfFileEx';
+
+function _VirtualMmap(Addr:Pointer;len:size_t;prot,fd:Integer;offst:size_t):Integer;
+Var
+ fm,h:THandle;
+ dwFileOffsetLow,dwFileOffsetHigh,protect,desiredAccess,dwMaxSizeLow,dwMaxSizeHigh:DWORD;
+ maxSize:size_t;
+begin
+ if (Addr=nil) then Exit(-1);
+
+ h:=_get_osfhandle(fd);
+ if (h=INVALID_HANDLE_VALUE) then
+ begin
+ Exit(GetLastError);
+ end;
+
+ maxSize:=offst+len;
+
+ dwFileOffsetLow :=DWORD(offst and $FFFFFFFF);
+ dwFileOffsetHigh:=DWORD(offst shr 32);
+ dwMaxSizeLow :=DWORD(maxSize and $FFFFFFFF);
+ dwMaxSizeHigh :=DWORD(maxSize shr 32);
+
+ protect :=__map_prot_page(prot);
+ desiredAccess:=__map_prot_file(prot);
+
+ fm:=CreateFileMapping(h,nil,protect,dwMaxSizeHigh,dwMaxSizeLow,nil);
+ if (fm=0) then
+ begin
+ Exit(GetLastError);
+ end;
+
+ addr:=MapViewOfFileEx(fm,desiredAccess,dwFileOffsetHigh,dwFileOffsetLow,len,addr);
+
+ CloseHandle(fm);
+
+ if (addr=nil) then
+ begin
+ Exit(GetLastError);
+ end;
+end;
+
+function _VirtualUnmap(addr:Pointer):Integer;
+begin
+ if (Addr=nil) then Exit(-1);
+ if UnmapViewOfFile(addr) then
+ begin
+ Result:=0;
+ end else
+ begin
+ Result:=GetLastError;
+ end;
+end;
+
+end.
+
+
+