Memory manager support added

This commit is contained in:
2021-01-06 07:26:20 +03:00
parent 9bfe4f3559
commit c4cef5c849
6 changed files with 186 additions and 24 deletions

View File

@@ -54,8 +54,6 @@ var
FileSize: LongWord;
begin
HeapInit;
ExtractFileDirectory(AppPath, AppPath);
SetCurrentDirectory(AppPath);

View File

@@ -77,39 +77,37 @@ var
FileAttributes: TFileAttributes;
begin
HeapInit;
ExtractFileDirectory(AppPath, AppPath);
SetCurrentDirectory(AppPath);
GetFileAttributes(Picture1, FileAttributes);
BitmapFile1 := HeapAllocate(FileAttributes.Size);
GetMem(BitmapFile1, FileAttributes.Size);
ReadFile(Picture1, BitmapFile1^, FileAttributes.Size, 0, BytesRead);
with BitmapFile1^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding1 := (32 - biWidth * biBitCount mod 32) and not 32 div 8;
Image1 := Pointer(LongWord(BitmapFile1) + bfOffBits);
Image1 := PKolibriChar(BitmapFile1) + bfOffBits;
end;
GetFileAttributes(Picture2, FileAttributes);
BitmapFile2 := HeapAllocate(FileAttributes.Size);
GetMem(BitmapFile2, FileAttributes.Size);
ReadFile(Picture2, BitmapFile2^, FileAttributes.Size, 0, BytesRead);
with BitmapFile2^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding2 := (32 - biWidth * biBitCount mod 32) and not 32 div 8;
Image2 := Pointer(LongWord(BitmapFile2) + bfOffBits);
Image2 := PKolibriChar(BitmapFile2) + bfOffBits;
end;
GetFileAttributes(Picture3, FileAttributes);
BitmapFile3 := HeapAllocate(FileAttributes.Size);
GetMem(BitmapFile3, FileAttributes.Size);
ReadFile(Picture3, BitmapFile3^, FileAttributes.Size, 0, BytesRead);
with BitmapFile3^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding3 := (32 - biWidth * biBitCount mod 32) and not 32 div 8;
Image3 := Pointer(LongWord(BitmapFile3) + bfOffBits);
Image3 := PKolibriChar(BitmapFile3) + bfOffBits;
end;
with GetScreenSize do

View File

@@ -54,8 +54,6 @@ begin
end;
begin
HeapInit;
ScreenSize := GetScreenSize;
with ScreenSize do
@@ -65,8 +63,8 @@ begin
WndLeft := (Width - WndWidth) div 2;
WndTop := (Height - WndHeight) div 2;
Image := HeapAllocate(Width * Height * 3);
Preview := HeapAllocate(Width * Height * 3 div 4);
GetMem(Image, Width * Height * 3);
GetMem(Preview, Width * Height * 3 div 4);
GetScreenImage(Image^, 0, 0, Width, Height);
ResizeImage;

View File

@@ -70,8 +70,6 @@ var
FileSize: LongWord;
begin
HeapInit;
ExtractFileDirectory(AppPath, AppPath);
SetCurrentDirectory(AppPath);
@@ -79,9 +77,9 @@ begin
PointBitmapFile := LoadFile('point.bmp', FileSize);
WaitBitmapFile := LoadFile('wait.bmp', FileSize);
ArrowBitmap := Pointer(LongWord(ArrowBitmapFile) + ArrowBitmapFile.BitmapFileHeader.bfOffBits);
PointBitmap := Pointer(LongWord(PointBitmapFile) + PointBitmapFile.BitmapFileHeader.bfOffBits);
WaitBitmap := Pointer(LongWord(WaitBitmapFile) + WaitBitmapFile.BitmapFileHeader.bfOffBits);
ArrowBitmap := PKolibriChar(ArrowBitmapFile) + ArrowBitmapFile.BitmapFileHeader.bfOffBits;
PointBitmap := PKolibriChar(PointBitmapFile) + PointBitmapFile.BitmapFileHeader.bfOffBits;
WaitBitmap := PKolibriChar(WaitBitmapFile) + WaitBitmapFile.BitmapFileHeader.bfOffBits;
hArrowCursor := LoadCursorIndirect(ArrowBitmap^, 0, 0);
hPointCursor := LoadCursorIndirect(PointBitmap^, 12, 0);

View File

@@ -559,7 +559,7 @@ const
{68.10} {UNDEFINED}
{68.11} function HeapInit: LongWord; stdcall;
{68.12} function HeapAllocate(Bytes: LongWord): Pointer; stdcall;
{68.13} function HeapFree(MemPtr: Pointer): LongWord; stdcall;
{68.13} function HeapFree(MemPtr: Pointer): Boolean; stdcall;
{68.14} procedure WaitSignal(var Buffer: TSignalBuffer); stdcall;
{68.15} {UNDEFINED}
{68.16} function LoadDriver(Name: PKolibriChar): THandle; stdcall;
@@ -2540,7 +2540,7 @@ asm
pop ebx
end;
function HeapFree(MemPtr: Pointer): LongWord; stdcall;
function HeapFree(MemPtr: Pointer): Boolean; stdcall;
asm
push ebx
mov eax, 68

View File

@@ -121,6 +121,13 @@ type
{$ENDIF}
end;
PMemoryManager = ^TMemoryManager;
TMemoryManager = record
GetMem: function(Size: Integer): Pointer;
FreeMem: function(P: Pointer): Integer;
ReallocMem: function(P: Pointer; Size: Integer): Pointer;
end;
PTextBuf = ^TTextBuf;
TTextBuf = array[0..127] of KolibriChar;
@@ -143,6 +150,21 @@ procedure _StartExe(InitTable: PPackageInfo);
procedure ErrorMessage(Msg: PKolibriChar; Count: Integer);
function _FreeMem(P: Pointer): Integer;
function _GetMem(Size: Integer): Pointer;
function _ReallocMem(var P: Pointer; NewSize: Integer): Pointer;
procedure _FillChar(var Dest; Count: Cardinal; Value: Byte);
procedure Move(const Src; var Dst; Count: Integer);
procedure GetMemoryManager(var Value: TMemoryManager);
procedure SetMemoryManager(const Value: TMemoryManager);
function IsMemoryManagerSet: Boolean;
function SysFreeMem(P: Pointer): Integer;
function SysGetMem(Size: Integer): Pointer;
function SysReallocMem(P: Pointer; Size: Integer): Pointer;
var
Default8087CW: Word = $1332; // for Extended type
@@ -250,6 +272,10 @@ implementation
uses
SysInit;
const
ERROR_OUT_OF_MEMORY = 203;
ERROR_INVALID_POINTER = 204;
var
InitContext: TInitContext;
@@ -398,6 +424,142 @@ asm
POP EBX
end;
var
MemoryManager: TMemoryManager = (
GetMem: SysGetMem;
FreeMem: SysFreeMem;
ReallocMem: SysReallocMem
);
function _FreeMem(P: Pointer): Integer;
asm
TEST EAX, EAX
JZ @@exit
CALL MemoryManager.FreeMem
TEST EAX, EAX
JZ @@exit
MOV AL, ERROR_INVALID_POINTER
JMP _RunError
@@exit:
end;
function _GetMem(Size: Integer): Pointer;
asm
TEST EAX, EAX
JZ @@exit
CALL MemoryManager.GetMem
TEST EAX, EAX
JNZ @@exit
MOV AL, ERROR_OUT_OF_MEMORY
JMP _RunError
@@exit:
end;
function _ReallocMem(var P: Pointer; NewSize: Integer): Pointer;
begin
if P <> nil then
if NewSize <> 0 then
begin
Result := MemoryManager.ReallocMem(P, NewSize);
if Result = nil then
RunError(ERROR_OUT_OF_MEMORY);
end
else
begin
if MemoryManager.FreeMem(P) <> 0 then
RunError(ERROR_INVALID_POINTER);
Result := nil;
end
else
Result := MemoryManager.GetMem(NewSize);
P := Result;
end;
procedure GetMemoryManager(var Value: TMemoryManager);
begin
Value := MemoryManager;
end;
procedure SetMemoryManager(const Value: TMemoryManager);
begin
MemoryManager := Value;
end;
function IsMemoryManagerSet: Boolean;
begin
with MemoryManager do
Result := (@GetMem <> @SysGetMem) or (@FreeMem <> @SysFreeMem) or (@ReallocMem <> @SysReallocMem);
end;
function SysFreeMem(P: Pointer): Integer;
asm
PUSH EBX
MOV ECX, EAX
MOV EAX, 68
MOV EBX, 13
INT $40
POP EBX
DEC EAX
end;
function SysGetMem(Size: Integer): Pointer;
asm
PUSH EBX
MOV ECX, EAX
MOV EAX, 68
MOV EBX, 12
INT $40
POP EBX
end;
function SysReallocMem(P: Pointer; Size: Integer): Pointer;
asm
PUSH EBX
MOV ECX, EAX
MOV EAX, 68
MOV EBX, 20
INT $40
POP EBX
end;
procedure _FillChar(var Dest; Count: Cardinal; Value: Byte);
asm
TEST EDX, EDX
JZ @@exit
PUSH EDI
MOV EDI, EAX
MOV CH, CL
MOV EAX, ECX
SHL EAX, 16
MOV AX, CX
MOV ECX, EDX
SHR ECX, 2
REPNZ STOSD
MOVZX ECX, DL
AND CL, 3
REPNZ STOSB
POP EDI
@@exit:
end;
procedure Move(const Src; var Dst; Count: Integer);
var
I: Integer;
begin
if @Src <> @Dst then
if (PKolibriChar(@Src) > PKolibriChar(@Dst)) or (PKolibriChar(@Dst) > PKolibriChar(@Src) + Count) then
for I := 0 to Count - 1 do
PKolibriChar(@Dst)[I] := PKolibriChar(@Src)[I]
else
for I := Count - 1 downto 0 do
PKolibriChar(@Dst)[I] := PKolibriChar(@Src)[I];
end;
function Get8087CW: Word;
asm
PUSH 0
@@ -671,9 +833,17 @@ end;
initialization
asm // InitFPU
asm
// InitFPU
FNINIT
FLDCW Default8087CW
// HeapInit
PUSH EBX
MOV EAX, 68
MOV EBX, 11
INT $40
POP EBX
end;
AppPath := PPKolibriChar(32)^;