1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
| unit SmartMem;
interface
type
TMem = packed array of byte;
SmartPtr = record
Ptr :Pointer;
Reserved :TMem;
end;
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr); overload;
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr); overload;
procedure MEMFree(var Anchor:SmartPtr);
implementation
type
PDynRec= ^TDynRec;
TDynRec= record
RC : Integer;
Length: integer;
end;
PDynAr = ^TDynAr;
TDynAr = packed record
Mem : TDynRec;
Bytes : array[0..0]of byte;
end;
const
DYNOFFSET = SizeOf(TDynRec);
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
begin
MEMFree(Anchor);
GetMem(PByte(Result),Size + DYNOFFSET);
with Anchor,PDynAr(Result)^ do
begin
Mem.RC := 1;
Mem.Length := Size;
Result := @Bytes;
Ptr := Result;
Pointer(Reserved):= Result;
end;
end;
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
begin
Result := MEMGet(Size,Anchor);
FillChar(Pointer(Anchor.Reserved)^,Size,0);
end;
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr);
begin
P := Pointer(Anchor.Reserved);
if Size = 0 then
MEMFree(Anchor)
else if P = nil then
P := MEMGet(Size,Anchor)
else begin
Dec(Integer(P),DYNOFFSET);
ReallocMem(PByte(P),Size + DYNOFFSET);
with Anchor,PDynAr(P)^ do
begin
Mem.Length := Size;
P := @Bytes;
Ptr := P;
Pointer(Reserved):= P;
end;
end;
end;
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr);
begin
Anchor.Ptr := Pointer(Anchor.Reserved);
MEMRealloc(Anchor.Ptr,Size,Anchor);
end;
procedure MEMFree(var Anchor:SmartPtr);
begin
if Pointer(Anchor.Reserved) <> nil then
begin
Dec(Integer(Anchor.Reserved),DYNOFFSET);
FreeMem(PByte(Anchor.Reserved));
Pointer(Anchor.Reserved) := nil;
end;
end;
end. |
Partager