📄 qmm.dpr
字号:
function ExtFreeMem(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
Result := 1;
Exit;
end;
try
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
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 ExtReallocMem(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
LongWord(Result) := $FFFFFFFF;
Exit;
end;
Size := GetNormalSize(Size);
J := PInteger(P)^;
if Size = J then
begin
Result := Pointer(LongWord(P)+4);
Exit;
end;
try
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(Space,PLongWord(P)^-LongWord(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 := ExtGetMem(Size-4);
if Result <> nil then
begin
IntCopyMem(P,Result,PLongWord(P)^);
Inc(LongWord(P),4);
ExtFreeMem(P);
end;
end;
end else
Result := nil;
goto 99;
end;
if Size > J then
begin
Result := ExtGetMem(Size-4);
if Result <> nil then
begin
IntCopyMem(P,Result,J);
Inc(LongWord(P),4);
ExtFreeMem(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
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
DEC EDX
JNE @@lp
@@xx: MOV EDI,[EAX+ESI*4]
@@nq: AND EDI,EBX
JE @@zq
@@ne: BSR ECX,EDI
@@qt: SHL ESI,5
LEA EAX,[ECX+ESI]
POP EDI
POP ESI
POP EBX
RET
@@ut: SUB EDX,ECX
JG @@zq
@@uk: BT [EAX],ECX
JC @@iq
DEC ECX
INC EDX
JNG @@uk
@@zq: MOV EAX,$FFFFFFFF
POP EDI
POP ESI
POP EBX
RET
@@iq: MOV EAX,ECX
POP EDI
POP ESI
POP EBX
end;
procedure IntResetBits(P: Pointer; FirstBit, LastBit: Integer);
asm
PUSH EDI
PUSH ESI
PUSH EBX
LEA ESI,[EDX+8]
CMP ECX,ESI
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -