浏览代码

osheap: new very small heap manager which only acts as a thin layer above an OS provided heap API. mainly aimed for small and embedded systems

git-svn-id: trunk@49145 -
Károly Balogh 4 年之前
父节点
当前提交
caa2735203
共有 2 个文件被更改,包括 126 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 125 0
      rtl/inc/osheap.inc

+ 1 - 0
.gitattributes

@@ -11113,6 +11113,7 @@ rtl/inc/objcbase.pp svneol=native#text/plain
 rtl/inc/objcnf.inc svneol=native#text/plain
 rtl/inc/objpas.inc svneol=native#text/plain
 rtl/inc/objpash.inc svneol=native#text/plain
+rtl/inc/osheap.inc svneol=native#text/plain
 rtl/inc/pagemem.pp svneol=native#text/plain
 rtl/inc/psabieh.inc svneol=native#text/plain
 rtl/inc/psabiehh.inc svneol=native#text/plain

+ 125 - 0
rtl/inc/osheap.inc

@@ -0,0 +1,125 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2021 by the Free Pascal development team.
+
+    OS heap manager for small targets
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ 
+  The OS heap manager is a small heap manager for smaller targets with an
+  operating system. It's similar in comcept to the "cmem" memory manager
+  for systems with libc support, but it aims systems that have a direct
+  heap management API (Sinclair QL, AmigaOS, MacOS Classic, some
+  embedded systems, etc), but not necessarily libc. It's also designed
+  to be included in the System unit directly, unlike cmem.
+
+  The main advantage is that it's much smaller than the regular heap
+  manager, and it's a thinner layer towards the OS as well, therefore it
+  can be slightly faster on resource constrained systems. 
+
+  The disadvantage is that it may not be well suited for bigger Pascal
+  programs that rely heavily on consistent heap performance, as the
+  properties of the OS heap manager like alignment and size constraints,
+  and allocation time are also directly exposed towards the Pascal code.
+  Additionally, querying the heap status is not supported.
+
+  Its main difference to tinyheap is that it can release the allocated
+  memory back to the system, therefore it suits systems that can run more
+  than one software in parallel better.
+
+  OSHeap needs SysOSAlloc and SysOSFree implemented in the system-specific
+  code, and nothing else.
+}
+
+    function SysGetMem(Size: ptruint): pointer;
+      begin
+        Inc(size,sizeof(size));
+        result := SysOSAlloc(size);
+        if assigned(result) then
+          begin
+            pptruint(result)[0] := size;
+            Inc(result,sizeof(size));
+          end;
+      end;
+
+    function SysFreeMem(p: Pointer): ptruint;
+      begin
+        if assigned(p) then
+          begin
+            Dec(p,sizeof(ptruint));
+            SysOSFree(p,pptruint(p)[0]);
+          end;
+        result := 0;
+      end;
+
+    function SysFreeMemSize(p: Pointer; Size: Ptruint): ptruint;
+      begin
+        result := SysFreeMem(p);
+      end;
+
+    function SysMemSize(p: pointer): ptruint;
+      begin
+        Dec(p,sizeof(ptruint));
+        result:=pptruint(p)[0]-sizeof(ptruint);
+      end;
+
+    function SysTryResizeMem(var p: pointer; size: ptruint) : boolean;
+      begin
+        result := false;
+      end;
+
+    function SysAllocMem(size: ptruint): pointer;
+      begin
+        result := SysGetMem(size);
+        if not assigned(result) then
+          FillChar(result^,SysMemSize(result),0);
+      end;
+
+    function SysReAllocMem(var p: pointer; size: ptruint):pointer;
+      var
+        oldsize: ptruint;
+      begin
+        result := nil;
+        if assigned(p) then
+          begin
+            oldsize := SysMemSize(p);
+            if size <> oldsize then
+              begin
+                if size > 0 then
+                  begin
+                    result := SysGetMem(size);
+                    if assigned(result) then
+                      begin
+                        if size < oldsize then
+                          oldsize := size;
+                        Move(p^,result^,oldsize);
+                      end;
+                  end;
+                SysFreeMem(p);
+              end
+            else
+              result := p;
+          end
+        else
+          result := SysGetMem(size);
+
+        p := result;
+      end;
+
+    function SysGetFPCHeapStatus : TFPCHeapStatus;
+      begin
+        FillChar(result,sizeof(result),0);
+      end;
+
+    function SysGetHeapStatus : THeapStatus;
+      begin
+        FillChar(result,sizeof(result),0);
+      end;