paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 09:07:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* high memory not used by default - incompatible to 64-bit FS calls

Browse Source 
git-svn-id: trunk@6722 -
This commit is contained in:
Tomas Hajny 2007-03-04 23:09:18 +00:00
parent 3c581e3f42
commit ee539c3a94
2 changed files with 37 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
rtl/os2/sysheap.inc
View File

@ -69,47 +69,20 @@ begin
WriteLn ('Trying to grow heap by ', Size, ' to ', Int_HeapSize);
{$ENDIF}
if UseHighMem then
RC := DosAllocMem (P, Size, $403)
else
RC := DosAllocMem (P, Size, 3);
RC := DosAllocMem (P, Size, HeapAllocFlags);
if RC = 0 then
begin
{$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then
WriteLn ('DosAllocMem returned memory at ', cardinal (P));
if Int_HeapSize <> high (cardinal) then
WriteLn ('DosAllocMem returned memory at ', cardinal (P));
{$ENDIF}
RC := DosSetMem (P, Size, $410);
if RC = 0 then
begin
SysOSAlloc := P;
{$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then
WriteLn ('New heap at ', cardinal (P));
{$ENDIF EXTDUMPGROW}
SysOSAlloc := P;
{$IFDEF EXTDUMPGROW}
if Int_HeapSize = high (cardinal) then
Int_HeapSize := Size
else
Inc (Int_HeapSize, Size);
{$ENDIF EXTDUMPGROW}
end
if Int_HeapSize = high (cardinal) then
Int_HeapSize := Size
else
begin
{$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then
begin
WriteLn ('Error ', RC, ' in DosSetMem while trying to commit memory!');
{ if Int_HeapSize = high (cardinal) then
WriteLn ('No allocated memory comitted yet!')
else
}
WriteLn ('Total allocated memory is ', Int_HeapSize);
end;
Inc (Int_HeapSize, Size);
{$ENDIF EXTDUMPGROW}
RC := DosFreeMem (P);
SysOSAlloc := nil;
end;
end
else
begin
@ -131,34 +104,38 @@ end;
{$define HAS_SYSOSFREE}
procedure SysOSFree (P: pointer; Size: PtrInt);
{$IFDEF EXTDUMPGROW}
var
RC: cardinal;
{$ENDIF EXTDUMPGROW}
begin
{$IFDEF EXTDUMPGROW}
WriteLn ('Trying to free memory!');
WriteLn ('Total allocated memory is ', Int_HeapSize);
Dec (Int_HeapSize, Size);
RC :=
{$ENDIF EXTDUMPGROW}
RC := DosSetMem (P, Size, $20);
if RC = 0 then
begin
RC := DosFreeMem (P);
DosFreeMem (P);
{$IFDEF EXTDUMPGROW}
if RC <> 0 then
begin
WriteLn ('Error ', RC, ' during memory deallocation (DosFreeMem)!');
WriteLn ('Total allocated memory is ', Int_HeapSize);
end;
{$ENDIF EXTDUMPGROW}
end
{$IFDEF EXTDUMPGROW}
else
if RC <> 0 then
begin
WriteLn ('Error ', RC, ' in DosSetMem while trying to decommit memory!');
WriteLn ('Error ', RC, ' during memory deallocation (DosFreeMem)!');
WriteLn ('Total allocated memory is ', Int_HeapSize);
end;
{$ENDIF EXTDUMPGROW}
end;
function ReadUseHighMem: boolean;
begin
ReadUseHighMem := HeapAllocFlags and $400 = $400;
end;
procedure WriteUseHighMem (B: boolean);
begin
if B then
HeapAllocFlags := HeapAllocFlags or $400
else
HeapAllocFlags := HeapAllocFlags and not ($400);
end;

39
rtl/os2/system.pas
View File

@ -127,12 +127,22 @@ var
(* 4 .. detached (background) OS/2 process *)
ApplicationType: cardinal;
const
HeapAllocFlags: cardinal = $53; (* Compatible to VP/2 *)
(* mfPag_Commit or mfObj_Tile or mfPag_Write or mfPag_Read *)
function ReadUseHighMem: boolean;
procedure WriteUseHighMem (B: boolean);
(* Is allocation of memory above 512 MB address limit allowed? Initialized *)
(* during initialization of system unit according to capabilities of the *)
(* underlying OS/2 version, can be overridden by user - heap is allocated *)
(* for all threads, so the setting isn't declared as a threadvar and *)
(* should be only changed at the beginning of the main thread if needed. *)
UseHighMem: boolean;
property
UseHighMem: boolean read ReadUseHighMem write WriteUseHighMem;
(* UseHighMem is provided for compatibility with 2.0.x. *)
const
(* Are file sizes > 2 GB (64-bit) supported on the current system? *)
@ -170,12 +180,6 @@ asm
decl %eax
end {['EAX']};
function args:pointer;assembler;
asm
movl argv,%eax
end {['EAX']};
function paramstr(l:longint):string;
var p:^Pchar;
@ -183,7 +187,7 @@ var p:^Pchar;
begin
if (l>=0) and (l<=paramcount) then
begin
p:=args;
p:=argv;
paramstr:=strpas(p[l]);
end
else paramstr:='';
@ -789,23 +793,4 @@ begin
{$IFDEF EXTDUMPGROW}
{ Int_HeapSize := high (cardinal);}
{$ENDIF EXTDUMPGROW}
RC := DosAllocMem (P, 4096, $403);
if RC = 87 then
(* Using of high memory address space (> 512 MB) *)
(* is not supported on this system. *)
UseHighMem := false
else
begin
UseHighMem := true;
if RC <> 0 then
begin
Str (RC, ErrStr);
ErrStr := 'Error during heap initialization (DosAllocMem - ' + ErrStr + ')!!'#13#10;
if IsConsole then
DosWrite (2, @ErrStr [1], Length (ErrStr), RC);
HandleError (204);
end
else
DosFreeMem (P);
end;
end.