?? qmm.dpr
字號(hào):
//////////////////////////////////////////////
// //
// Qmm 2.01a //
// //
// Shared quick memory manager unit //
// //
// Copyright (c) 2001, Andrew Driazgov //
// e-mail: andrey@asp.tstu.ru //
// //
// Last updated: February 15, 2002 //
// //
//////////////////////////////////////////////
library Qmm;
{$Q-}
uses Windows;
{$R *.RES}
type
PEntryPoint = ^TEntryPoint;
TEntryPoint = packed record
Address: LongWord;
Space: LongWord;
AdrLeft: PEntryPoint;
AdrRight: PEntryPoint;
SpLeft: PEntryPoint;
SpRight: PEntryPoint;
end;
PEFreeArr = ^TEFreeArr;
TEFreeArr = array[0..$7FFFFF] of PEntryPoint;
TQMemHeapStatus = record
TotalAddrSpace: Cardinal;
TotalCommitted: Cardinal;
TotalUncommitted: Cardinal;
TotalAllocated: Cardinal;
TotalFree: Cardinal;
MaxFreeBlock: Cardinal;
CountOfFreeBlocks: Cardinal;
Overhead: Cardinal;
end;
const
MaxECount = $10000; // MaxECount := (Value+$3FFF) and $FFFFC000;
var
lpCriticalSection:_RTL_CRITICAL_SECTION;
ListLeft: PEntryPoint;
ListRight: PEntryPoint;
EFreeCount: Integer;
EFreeArr: PEFreeArr;
SizeTable: array[0..30] of PEntryPoint;
StartAddr: LongWord;
SpaceBegin: LongWord;
IntQMemIsInstalled: Boolean = False;
function GetNormalSize(Size: Integer): Integer;
asm
ADD EAX,3
TEST EAX,$FFFFFFE0
JE @@sm
BSR ECX,EAX
MOV EAX,2
SHL EAX,CL
RET
@@sm: MOV EAX,32
end;
function GetRegionOfSize(Size: Integer): Pointer;
asm
BSF ECX,EAX
LEA EDX,[ECX*4+SizeTable]
MOV ECX,[EDX]
TEST ECX,ECX
JE @@nx
MOV EAX,ECX
MOV ECX,[ECX].TEntryPoint.SpRight
MOV [EDX],ECX
TEST ECX,ECX
JE @@qm
XOR EDX,EDX
MOV [ECX].TEntryPoint.SpLeft,EDX
@@qm: RET
@@nx: MOV EDX,EAX
MOV EAX,ListLeft
TEST EAX,EAX
JE @@qt
@@lp: CMP EDX,[EAX].TEntryPoint.Space
JLE @@qt
MOV EAX,[EAX].TEntryPoint.AdrRight
TEST EAX,EAX
JNE @@lp
@@qt:
end;
function IntBitTest(P: Pointer; Index: Integer): Boolean;
asm
BT [EAX],EDX
SETC AL
end;
procedure IntBitSet(P: Pointer; Index: Integer);
asm
BTS [EAX],EDX
end;
function IntFreeBitScanForward(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
MOV ECX,[EAX+EDX*4]
NOT ECX
AND EBX,ECX
SUB ESI,EDX
JE @@nq
TEST EBX,EBX
JNE @@ne
INC EDX
DEC ESI
JE @@xx
@@lp: MOV EBX,[EAX+EDX*4]
NOT EBX
TEST EBX,EBX
JNE @@ne
INC EDX
DEC ESI
JNE @@lp
@@xx: MOV EBX,[EAX+EDX*4]
NOT EBX
@@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
JNC @@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 IntFreeBitScanReverse(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
MOV ECX,[EAX+ESI*4]
NOT ECX
AND EDI,ECX
SUB EDX,ESI
JE @@nq
TEST EDI,EDI
JNE @@ne
NEG EDX
DEC ESI
DEC EDX
JE @@xx
@@lp: MOV EDI,[EAX+ESI*4]
NOT EDI
TEST EDI,EDI
JNE @@ne
DEC ESI
DEC EDX
JNE @@lp
@@xx: MOV EDI,[EAX+ESI*4]
NOT EDI
@@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
JNC @@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 IntSetBits(P: Pointer; FirstBit, LastBit: Integer);
asm
PUSH EDI
PUSH ESI
PUSH EBX
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
SUB ESI,EDX
JE @@xx
OR [EAX+EDX*4],EBX
INC EDX
DEC ESI
JE @@ne
MOV EBX,$FFFFFFFF
@@lp: MOV [EAX+EDX*4],EBX
INC EDX
DEC ESI
JNE @@lp
@@xx: AND EDI,EBX
@@ne: OR [EAX+EDX*4],EDI
POP EBX
POP ESI
POP EDI
RET
@@ut: SUB ECX,EDX
JS @@qt
@@uk: BTS [EAX],EDX
INC EDX
DEC ECX
JNS @@uk
@@qt: POP EBX
POP ESI
POP EDI
end;
procedure DelFromSizeTable(E: PEntryPoint);
asm
MOV EDX,[EAX].TEntryPoint.SpLeft
TEST EDX,EDX
JNE @@nx
MOV EDX,[EAX].TEntryPoint.Space
BSF ECX,EDX
LEA EDX,[ECX*4+SizeTable]
CMP EAX,[EDX]
JNE @@qt
MOV ECX,[EAX].TEntryPoint.SpRight
MOV [EDX],ECX
TEST ECX,ECX
JE @@qt
XOR EDX,EDX
MOV [ECX].TEntryPoint.SpLeft,EDX
@@qt: RET
@@nx: MOV ECX,[EAX].TEntryPoint.SpRight
MOV [EDX].TEntryPoint.SpRight,ECX
TEST ECX,ECX
JE @@qx
MOV [ECX].TEntryPoint.SpLeft,EDX
@@qx:
end;
function ExtGetMem(Size: Integer): Pointer;
label
99;
var
E: PEntryPoint;
I,J: Integer;
begin
try
EnterCriticalSection(lpCriticalSection);
Size := GetNormalSize(Size);
E := GetRegionOfSize(Size);
if E <> nil then
begin
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
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;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -