paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-30 11:57:24 +01: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

57
rtl/os2/sysheap.inc
View File

@ -69,23 +69,13 @@ begin
WriteLn ('Trying to grow heap by ', Size, ' to ', Int_HeapSize); WriteLn ('Trying to grow heap by ', Size, ' to ', Int_HeapSize);
{$ENDIF} {$ENDIF}
if UseHighMem then RC := DosAllocMem (P, Size, HeapAllocFlags);
RC := DosAllocMem (P, Size, $403)
else
RC := DosAllocMem (P, Size, 3);
if RC = 0 then if RC = 0 then
begin begin
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then if Int_HeapSize <> high (cardinal) then
WriteLn ('DosAllocMem returned memory at ', cardinal (P)); WriteLn ('DosAllocMem returned memory at ', cardinal (P));
{$ENDIF} {$ENDIF}
RC := DosSetMem (P, Size, $410);
if RC = 0 then
begin
{$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then
WriteLn ('New heap at ', cardinal (P));
{$ENDIF EXTDUMPGROW}
SysOSAlloc := P; SysOSAlloc := P;
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
if Int_HeapSize = high (cardinal) then if Int_HeapSize = high (cardinal) then
@ -96,23 +86,6 @@ begin
end end
else else
begin 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;
{$ENDIF EXTDUMPGROW}
RC := DosFreeMem (P);
SysOSAlloc := nil;
end;
end
else
begin
SysOSAlloc := nil; SysOSAlloc := nil;
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
if Int_HeapSize <> high (cardinal) then if Int_HeapSize <> high (cardinal) then
@ -131,18 +104,18 @@ end;
{$define HAS_SYSOSFREE} {$define HAS_SYSOSFREE}
procedure SysOSFree (P: pointer; Size: PtrInt); procedure SysOSFree (P: pointer; Size: PtrInt);
{$IFDEF EXTDUMPGROW}
var var
RC: cardinal; RC: cardinal;
{$ENDIF EXTDUMPGROW}
begin begin
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
WriteLn ('Trying to free memory!'); WriteLn ('Trying to free memory!');
WriteLn ('Total allocated memory is ', Int_HeapSize); WriteLn ('Total allocated memory is ', Int_HeapSize);
Dec (Int_HeapSize, Size); Dec (Int_HeapSize, Size);
RC :=
{$ENDIF EXTDUMPGROW} {$ENDIF EXTDUMPGROW}
RC := DosSetMem (P, Size, $20); DosFreeMem (P);
if RC = 0 then
begin
RC := DosFreeMem (P);
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
if RC <> 0 then if RC <> 0 then
begin begin
@ -150,15 +123,19 @@ begin
WriteLn ('Total allocated memory is ', Int_HeapSize); WriteLn ('Total allocated memory is ', Int_HeapSize);
end; end;
{$ENDIF EXTDUMPGROW} {$ENDIF EXTDUMPGROW}
end end;
{$IFDEF EXTDUMPGROW}
else
function ReadUseHighMem: boolean;
begin begin
WriteLn ('Error ', RC, ' in DosSetMem while trying to decommit memory!'); ReadUseHighMem := HeapAllocFlags and $400 = $400;
WriteLn ('Total allocated memory is ', Int_HeapSize);
end;
{$ENDIF EXTDUMPGROW}
end; 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 *) (* 4 .. detached (background) OS/2 process *)
ApplicationType: cardinal; 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 *) (* Is allocation of memory above 512 MB address limit allowed? Initialized *)
(* during initialization of system unit according to capabilities of the *) (* during initialization of system unit according to capabilities of the *)
(* underlying OS/2 version, can be overridden by user - heap is allocated *) (* 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 *) (* 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. *) (* 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 const
(* Are file sizes > 2 GB (64-bit) supported on the current system? *) (* Are file sizes > 2 GB (64-bit) supported on the current system? *)
@ -170,12 +180,6 @@ asm
decl %eax decl %eax
end {['EAX']}; end {['EAX']};
function args:pointer;assembler;
asm
movl argv,%eax
end {['EAX']};
function paramstr(l:longint):string; function paramstr(l:longint):string;
var p:^Pchar; var p:^Pchar;
@ -183,7 +187,7 @@ var p:^Pchar;
begin begin
if (l>=0) and (l<=paramcount) then if (l>=0) and (l<=paramcount) then
begin begin
p:=args; p:=argv;
paramstr:=strpas(p[l]); paramstr:=strpas(p[l]);
end end
else paramstr:=''; else paramstr:='';
@ -789,23 +793,4 @@ begin
{$IFDEF EXTDUMPGROW} {$IFDEF EXTDUMPGROW}
{ Int_HeapSize := high (cardinal);} { Int_HeapSize := high (cardinal);}
{$ENDIF EXTDUMPGROW} {$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. end.