📄 qmemory.pas
字号:
J := E^.Address-StartAddr;
I := J;
Inc(J,Size);
I := LongWord(I) shr 16;
Dec(J);
J := LongWord(J) shr 16;
if I = J then
begin
if not IntBitTest(Pointer(StartAddr),I) then
begin
if VirtualAlloc(Pointer(StartAddr+LongWord(I) shl 16), $10000,
MEM_COMMIT, PAGE_READWRITE) = nil then
begin
Result := nil;
goto 99;
end;
IntBitSet(Pointer(StartAddr),I);
end;
end else
begin
I := IntFreeBitScanForward(Pointer(StartAddr),I,J);
if I >= 0 then
begin
J := IntFreeBitScanReverse(Pointer(StartAddr),I,J);
if VirtualAlloc(Pointer(StartAddr+LongWord(I) shl 16),
LongWord(J-I+1) shl 16, MEM_COMMIT, PAGE_READWRITE) = nil then
begin
Result := nil;
goto 99;
end;
IntSetBits(Pointer(StartAddr),I,J);
end;
end;
with E^ do
begin
Result := Pointer(Address+4);
PInteger(Address)^ := Size;
I := Integer(Space)-Size;
if I = 0 then
begin
EFreeArr^[EFreeCount] := E;
Inc(EFreeCount);
if AdrLeft <> nil then
AdrLeft^.AdrRight := AdrRight
else
ListLeft := AdrRight;
if AdrRight <> nil then
AdrRight^.AdrLeft := AdrLeft
else
ListRight := AdrLeft;
end else
begin
DelFromSizeTable(E);
Space := I;
Inc(Address,Size);
SpLeft := nil;
end;
end;
end else
Result := nil;
99:
finally
if IsMultiThread then
LeaveCriticalSection(lpCriticalSection);
end;
end;
function SearchPointerPlace(P: Pointer): PEntryPoint;
asm
MOV EDX,EAX
MOV EAX,ListRight
TEST EAX,EAX
JE @@qt
@@lp: CMP EDX,[EAX].TEntryPoint.Address
JAE @@qt
MOV EAX,[EAX].TEntryPoint.AdrLeft
TEST EAX,EAX
JNE @@lp
@@qt:
end;
procedure SetInSizeTable(E: PEntryPoint; L: LongWord);
asm
BSF ECX,EDX
LEA EDX,[ECX*4+SizeTable]
MOV ECX,[EDX]
MOV [EDX],EAX
MOV [EAX].TEntryPoint.SpRight,ECX
TEST ECX,ECX
JE @@qt
MOV [ECX].TEntryPoint.SpLeft,EAX
@@qt:
end;
function IntFreeMem(P: Pointer): Integer;
label
99;
var
E,E1: PEntryPoint;
J: LongWord;
begin
Dec(LongWord(P),4);
if (LongWord(P)<SpaceBegin) or
(PLongWord(P)^+LongWord(P)>LongWord(EFreeArr)) then
begin
Inc(LongWord(P),4);
Result := OldMemManager.FreeMem(P);
Exit;
end;
try
if IsMultiThread then
EnterCriticalSection(lpCriticalSection);
E := SearchPointerPlace(P);
if E <> nil then
begin
J := E^.Address+E^.Space;
if LongWord(P) <= J then
begin
if LongWord(P) = J then
begin
J := PLongWord(P)^;
if E <> ListRight then
begin
Inc(LongWord(P),J);
E1 := E^.AdrRight;
if LongWord(P) >= E1.Address then
begin
if LongWord(P) = E1.Address then
begin
DelFromSizeTable(E1);
Inc(J,E^.Space);
EFreeArr^[EFreeCount] := E;
Inc(EFreeCount);
DelFromSizeTable(E);
with E1^ do
begin
Dec(Address,J);
Inc(Space,J);
AdrLeft := E^.AdrLeft;
if AdrLeft <> nil then
AdrLeft^.AdrRight := E1
else
ListLeft := E1;
SpLeft := nil;
end;
Result := 0;
end else
Result := -1;
goto 99;
end;
end;
DelFromSizeTable(E);
Inc(E^.Space,J);
E^.SpLeft := nil;
Result := 0;
end else
Result := -1;
goto 99;
end;
E := E^.AdrRight;
end else
E := ListLeft;
if E <> nil then
begin
J := PLongWord(P)^;
Inc(J,LongWord(P));
with E^ do
if J >= Address then
begin
if J = Address then
begin
DelFromSizeTable(E);
Address := LongWord(P);
Inc(Space,PLongWord(P)^);
SpLeft := nil;
Result := 0;
end else
Result := -1;
goto 99;
end;
end;
if EFreeCount > 0 then
begin
Dec(EFreeCount);
E1 := EFreeArr^[EFreeCount];
with E1^ do
begin
Address := LongWord(P);
Space := PLongWord(P)^;
AdrRight := E;
if E <> nil then
begin
AdrLeft := E^.AdrLeft;
E^.AdrLeft := E1;
end else
begin
AdrLeft := ListRight;
ListRight := E1;
end;
if AdrLeft <> nil then
AdrLeft^.AdrRight := E1
else
ListLeft := E1;
SetInSizeTable(E1,Space);
SpLeft := nil;
end;
Result := 0;
end else
Result := -1;
99:
finally
if IsMultiThread then
LeaveCriticalSection(lpCriticalSection);
end;
end;
procedure IntCopyMem(Source, Dest: Pointer; L: Cardinal);
asm
PUSH EBX
SUB EDX,4
SHR ECX,5
JMP @@fs
@@lp: MOV EBX,[EAX]
MOV [EDX],EBX
@@fs: MOV EBX,[EAX+4]
MOV [EDX+4],EBX
MOV EBX,[EAX+8]
MOV [EDX+8],EBX
MOV EBX,[EAX+12]
MOV [EDX+12],EBX
MOV EBX,[EAX+16]
MOV [EDX+16],EBX
MOV EBX,[EAX+20]
MOV [EDX+20],EBX
MOV EBX,[EAX+24]
MOV [EDX+24],EBX
MOV EBX,[EAX+28]
MOV [EDX+28],EBX
ADD EAX,32
ADD EDX,32
DEC ECX
JNE @@lp
@@qt: POP EBX
end;
function IntReallocMem(P: Pointer; Size: Integer): Pointer;
label
99;
var
E,E1: PEntryPoint;
J,K: Integer;
begin
Dec(LongWord(P),4);
if (LongWord(P)<SpaceBegin) or
(PLongWord(P)^+LongWord(P)>LongWord(EFreeArr)) then
begin
Inc(LongWord(P),4);
Result := OldMemManager.ReallocMem(P,Size);
Exit;
end;
Size := GetNormalSize(Size);
J := PInteger(P)^;
if Size = J then
begin
Result := Pointer(LongWord(P)+4);
Exit;
end;
try
if IsMultiThread then
EnterCriticalSection(lpCriticalSection);
E := SearchPointerPlace(P);
if E <> nil then
begin
if LongWord(P) < E^.Address+E^.Space then
begin
Result := nil;
goto 99;
end;
E := E^.AdrRight;
end else
E := ListLeft;
if E <> nil then
with E^ do
if LongWord(J)+LongWord(P) >= Address then
begin
if LongWord(J)+LongWord(P) = Address then
begin
if Size <= J+Integer(Space) then
begin
if Size > J then
begin
J := (Address-StartAddr) shr 16;
K := (LongWord(P)+LongWord(Size)-StartAddr-1) shr 16;
if J = K then
begin
if not IntBitTest(Pointer(StartAddr),J) then
begin
if VirtualAlloc(Pointer(StartAddr+LongWord(J) shl 16), $10000,
MEM_COMMIT, PAGE_READWRITE) = nil then
begin
Result := nil;
goto 99;
end;
IntBitSet(Pointer(StartAddr),J);
end;
end else
begin
J := IntFreeBitScanForward(Pointer(StartAddr),J,K);
if J >= 0 then
begin
K := IntFreeBitScanReverse(Pointer(StartAddr),J,K);
if VirtualAlloc(Pointer(StartAddr+LongWord(J) shl 16),
LongWord(K-J+1) shl 16, MEM_COMMIT, PAGE_READWRITE) = nil then
begin
Result := nil;
goto 99;
end;
IntSetBits(Pointer(StartAddr),J,K);
end;
end;
end;
DelFromSizeTable(E);
Inc(Integer(Space),PInteger(P)^-Size);
PInteger(P)^ := Size;
if Space <> 0 then
begin
Address := LongWord(P)+LongWord(Size);
SpLeft := nil;
end else
begin
EFreeArr^[EFreeCount] := E;
Inc(EFreeCount);
if AdrLeft <> nil then
AdrLeft^.AdrRight := AdrRight
else
ListLeft := AdrRight;
if AdrRight <> nil then
AdrRight^.AdrLeft := AdrLeft
else
ListRight := AdrLeft;
end;
Result := Pointer(LongWord(P)+4);
end else
begin
Result := IntGetMem(Size-4);
if Result <> nil then
begin
IntCopyMem(P,Result,PLongWord(P)^);
Inc(LongWord(P),4);
IntFreeMem(P);
end;
end;
end else
Result := nil;
goto 99;
end;
if Size > J then
begin
Result := IntGetMem(Size-4);
if Result <> nil then
begin
IntCopyMem(P,Result,J);
Inc(LongWord(P),4);
IntFreeMem(P);
end;
end
else if EFreeCount > 0 then
begin
Dec(EFreeCount);
E1 := EFreeArr^[EFreeCount];
with E1^ do
begin
Address := LongWord(P)+LongWord(Size);
Space := PLongWord(P)^-LongWord(Size);
AdrRight := E;
if E <> nil then
begin
AdrLeft := E^.AdrLeft;
E^.AdrLeft := E1;
end else
begin
AdrLeft := ListRight;
ListRight := E1;
end;
if AdrLeft <> nil then
AdrLeft^.AdrRight := E1
else
ListLeft := E1;
SpLeft := nil;
end;
PInteger(P)^ := Size;
Result := Pointer(LongWord(P)+4);
end else
Result := nil;
99:
finally
if IsMultiThread then
LeaveCriticalSection(lpCriticalSection);
end;
end;
function IntSetBitScanForward(P: Pointer; FirstBit, LastBit: Integer): Integer;
asm
PUSH EBX
PUSH ESI
PUSH EDI
LEA ESI,[EDX+8]
CMP ECX,ESI
JL @@ut
MOV EBX,$FFFFFFFF
MOV ESI,ECX
MOV EDI,$0000001F
AND ECX,EDI
AND ESI,$FFFFFFE0
SUB EDI,ECX
SHR ESI,5
MOV ECX,EDI
MOV EDI,EBX
SHR EDI,CL
MOV ECX,EDX
AND EDX,$FFFFFFE0
AND ECX,$0000001F
SHR EDX,5
SHL EBX,CL
AND EBX,[EAX+EDX*4]
SUB ESI,EDX
JE @@nq
TEST EBX,EBX
JNE @@ne
INC EDX
DEC ESI
JE @@xx
@@lp: OR EBX,[EAX+EDX*4]
JNE @@ne
INC EDX
DEC ESI
JNE @@lp
@@xx: MOV EBX,[EAX+EDX*4]
@@nq: AND EBX,EDI
JE @@zq
@@ne: BSF ECX,EBX
@@qt: SHL EDX,5
LEA EAX,[ECX+EDX]
POP EDI
POP ESI
POP EBX
RET
@@ut: SUB ECX,EDX
JS @@zq
@@uk: BT [EAX],EDX
JC @@iq
INC EDX
DEC ECX
JNS @@uk
@@zq: MOV EAX,$FFFFFFFF
POP EDI
POP ESI
POP EBX
RET
@@iq: MOV EAX,EDX
POP EDI
POP ESI
POP EBX
end;
function IntSetBitScanReverse(P: Pointer; FirstBit, LastBit: Integer): Integer;
asm
PUSH EBX
PUSH ESI
PUSH EDI
LEA ESI,[EDX+8]
CMP ECX,ESI
JL @@ut
MOV EBX,$FFFFFFFF
MOV ESI,ECX
MOV EDI,$0000001F
AND ECX,EDI
AND ESI,$FFFFFFE0
SUB EDI,ECX
SHR ESI,5
MOV ECX,EDI
MOV EDI,EBX
SHR EDI,CL
MOV ECX,EDX
AND EDX,$FFFFFFE0
AND ECX,$0000001F
SHR EDX,5
SHL EBX,CL
AND EDI,[EAX+ESI*4]
SUB EDX,ESI
JE @@nq
TEST EDI,EDI
JNE @@ne
NEG EDX
DEC ESI
DEC EDX
JE @@xx
@@lp: OR EDI,[EAX+ESI*4]
JNE @@ne
DEC ESI
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -