mirror of
https://github.com/vapaamies/KolibriOS.git
synced 2025-09-22 15:13:49 +02:00
Memory manager support added
This commit is contained in:
@@ -54,8 +54,6 @@ var
|
||||
FileSize: LongWord;
|
||||
|
||||
begin
|
||||
HeapInit;
|
||||
|
||||
ExtractFileDirectory(AppPath, AppPath);
|
||||
SetCurrentDirectory(AppPath);
|
||||
|
||||
|
@@ -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
|
||||
|
@@ -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;
|
||||
|
@@ -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);
|
||||
|
@@ -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
|
||||
|
172
Lib/System.pas
172
Lib/System.pas
@@ -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)^;
|
||||
|
Reference in New Issue
Block a user