paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 14:40:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* compiler defined HEAP and HEAPSIZE removed

Browse Source
This commit is contained in:
peter 2004-10-25 15:38:59 +00:00
parent e7459f5466
commit 869b0ecc85
15 changed files with 161 additions and 447 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/beos/system.pp
View File

@ -143,18 +143,6 @@ var myheapstart:pointer;
heap_handle:longint;
zero:longint;
{ first address of heap }
function getheapstart:pointer;
begin
getheapstart:=myheapstart;
end;
{ current length of heap }
function getheapsize:longint;
begin
getheapsize:=myheapsize;
end;
{ function to allocate size bytes more for the program }
{ must return the first address of new data space or nil if fail }
function Sbrk(size : longint):pointer;
@ -177,7 +165,7 @@ begin
end;
{*****************************************************************************
OS Memory allocation / deallocation
OS Memory allocation / deallocation
****************************************************************************}
function SysOSAlloc(size: ptrint): pointer;
@ -550,7 +538,10 @@ begin
end.
{
$Log$
Revision 1.16 2004-09-18 11:18:44 hajny
Revision 1.17 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.16 2004/09/18 11:18:44 hajny
* handle type changed to thandle in do_isdevice
Revision 1.15 2004/09/03 19:25:32 olle

28
rtl/bsd/osmain.inc
View File

@ -80,29 +80,6 @@ Begin
randseed:=longint(Fptime(nil));
End;
{*****************************************************************************
Heap Management
*****************************************************************************}
var
_HEAP : longint;external name 'HEAP';
_HEAPSIZE : longint;external name 'HEAPSIZE';
{$ifndef SYSTEM_HAS_GETHEAPSTART}
function getheapstart:pointer;
begin
getheapstart := @_HEAP;
end;
{$endif}
{$ifndef SYSTEM_HAS_GETHEAPSIZE}
function getheapsize:longint;
begin
getheapsize := _HEAPSIZE;
end;
{$endif}
{*****************************************************************************
Low Level File Routines
@ -593,7 +570,10 @@ end;
{
$Log$
Revision 1.15 2004-07-17 15:20:55 jonas
Revision 1.16 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.15 2004/07/17 15:20:55 jonas
* don't use O_CREATE when opening a file for appending (fixes tw1744)
Revision 1.14 2004/05/16 18:51:20 peter

19
rtl/emx/system.pas
View File

@ -289,7 +289,7 @@ function sbrk(size:longint):pointer;
var
L: longword;
begin
WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
WriteLn ('Trying to grow heap by ', Size);
{$IFDEF CONTHEAP}
WriteLn ('BrkLimit is ', BrkLimit);
{$ENDIF CONTHEAP}
@ -323,18 +323,6 @@ asm
end {['eax', 'edx']};
{$ENDIF DUMPGROW}
function getheapstart:pointer;assembler;
asm
movl heap_base,%eax
end {['EAX']};
function getheapsize:longint;assembler;
asm
movl heap_brk,%eax
end {['EAX']};
function SysOSAlloc (Size: ptrint): pointer;
begin
SysOSAlloc := Sbrk (Size);
@ -1333,7 +1321,10 @@ begin
end.
{
$Log$
Revision 1.28 2004-09-18 11:12:49 hajny
Revision 1.29 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.28 2004/09/18 11:12:49 hajny
* handle type changed to thandle in do_isdevice
Revision 1.27 2004/09/03 19:25:41 olle

9
rtl/inc/heap.inc
View File

@ -1329,13 +1329,16 @@ begin
freelist_var := nil;
freeoslist := nil;
freeoslistcount := 0;
internal_heapsize := GetHeapSize;
internal_memavail := internal_heapsize;
internal_heapsize := 0;
internal_memavail := 0;
end;
{
$Log$
Revision 1.36 2004-08-10 18:58:36 jonas
Revision 1.37 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.36 2004/08/10 18:58:36 jonas
* changed formatting to conform to the rest of the compiler/rtl
* fixed SysMaxAvail so it also looks at the free fixed size blocks

24
rtl/inc/heaptrc.pp
View File

@ -722,6 +722,12 @@ var
edata : longword; external name 'edata';
{$endif go32v2}
{$ifdef linux}
var
etext: ptruint; external name '_etext';
edata : ptruint; external name '_edata';
{$endif}
procedure CheckPointer(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public, alias : 'FPC_CHECKPOINTER'];
var
@ -766,6 +772,19 @@ begin
goto _exit;
{$endif win32}
{$ifdef linux}
{ inside stack ? }
asm
movl %ebp,get_ebp
end;
if (ptruint(p)>get_ebp) and
(ptruint(p)<$c0000000) then //todo: 64bit!
goto _exit;
{ inside data ? }
if (ptruint(p)>=ptruint(@etext)) and (ptruint(p)<ptruint(@edata)) then
goto _exit;
{$endif linux}
{ first try valid list faster }
{$ifdef EXTRA}
@ -1138,7 +1157,10 @@ finalization
end.
{
$Log$
Revision 1.34 2004-10-24 20:01:41 peter
Revision 1.35 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.34 2004/10/24 20:01:41 peter
* saveregisters calling convention is obsolete
Revision 1.33 2004/09/21 14:49:29 peter

29
rtl/linux/osmain.inc
View File

@ -82,30 +82,6 @@ Begin
End;
{*****************************************************************************
Heap Management
*****************************************************************************}
var
_HEAP : longint;external name 'HEAP';
_HEAPSIZE : longint;external name 'HEAPSIZE';
{$ifndef SYSTEM_HAS_GETHEAPSTART}
function getheapstart:pointer;
begin
getheapstart := @_HEAP;
end;
{$endif}
{$ifndef SYSTEM_HAS_GETHEAPSIZE}
function getheapsize:longint;
begin
getheapsize := _HEAPSIZE;
end;
{$endif}
{*****************************************************************************
Low Level File Routines
*****************************************************************************}
@ -589,7 +565,10 @@ end;
{
$Log$
Revision 1.20 2004-08-04 19:27:09 florian
Revision 1.21 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.20 2004/08/04 19:27:09 florian
* fixed floating point and integer exception handling on sparc/linux
Revision 1.19 2004/05/31 20:25:04 peter

103
rtl/macos/system.pp
View File

@ -35,7 +35,7 @@ const
DriveSeparator = ':';
PathSeparator = ','; {Is used in MPW and OzTeX}
FileNameCaseSensitive = false;
maxExitCode = 65535;
{ include heap support headers }
@ -65,7 +65,7 @@ var
{To be called at regular intervals, for lenghty tasks.
Yield might give time for other tasks to run under the cooperative
multitasked macos. For an MPW Tool, it also spinns the cursor.}
procedure Yield;
{To set mac file type and creator codes, to be used for files created
@ -94,23 +94,23 @@ procedure SetDefaultMacOSCreator(creator: ShortString);
macosHasFSSpec: Boolean;
macosHasFindFolder: Boolean;
macosHasScriptMgr: Boolean;
macosNrOfScriptsInstalled: Integer;
macosHasAppearance: Boolean;
macosHasAppearance101: Boolean;
macosHasAppearance11: Boolean;
macosBootVolumeVRefNum: Integer;
macosBootVolumeName: String[31];
{
MacOS paths
===========
MacOS directory separator is a colon ":" which is the only character not
allowed in filenames.
allowed in filenames.
A path containing no colon or which begins with a colon is a partial path.
E g ":kalle:petter" ":kalle" "kalle"
All other paths are full (absolute) paths. E g "HD:kalle:" "HD:"
@ -195,8 +195,8 @@ Perhaps handle readonly filesystems, as in sysunix.inc
{Some MacOS API routines and StdCLib included for internal use:}
{$I macostp.inc}
{Note, because the System unit is the most low level, it should not
depend on any other units, and thus the macos api must be accessed
{Note, because the System unit is the most low level, it should not
depend on any other units, and thus the macos api must be accessed
as an include file and not a unit.}
{The reason StdCLib is used is that it can easily be connected
@ -378,30 +378,9 @@ begin
randseed:= Cardinal(TickCount);
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
var
{ Pointer to a block allocated with the MacOS Memory Manager, which
is used as the initial FPC heap. }
theHeap: Mac_Ptr;
intern_heapsize : longint;external name 'HEAPSIZE';
{ first address of heap }
function getheapstart:pointer;
begin
getheapstart:= theHeap;
end;
{ current length of heap }
function getheapsize:longint;
begin
getheapsize:= intern_heapsize ;
end;
{*****************************************************************************
OS Memory allocation / deallocation
OS Memory allocation / deallocation
****************************************************************************}
{ function to allocate size bytes more for the program }
@ -453,7 +432,7 @@ var
spec: FSSpec;
err: OSErr;
res: Integer;
begin
res:= PathArgToFSSpec(p, spec);
@ -627,7 +606,7 @@ var
fullPath: AnsiString;
finderInfo: FInfo;
begin
// AllowSlash(p);
@ -700,12 +679,12 @@ begin
if InOutRes <> 0 then
exit;
p:= PChar(fullPath);
if FileRec(f).mode in [fmoutput, fminout, fmappend] then
begin
{Since opening of an existing file will not change filetype and creator,
{Since opening of an existing file will not change filetype and creator,
it is set here. Otherwise overwritten darwin files will not get filetype
TEXT. This is not done when only opening file for reading.}
FSpGetFInfo(spec, finderInfo);
@ -790,7 +769,7 @@ begin
If (s='') or (InOutRes <> 0) then
exit;
res:= PathArgToFSSpec(s, spec);
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
err:= FSpDirCreate(spec, smSystemScript, createdDirID);
@ -806,7 +785,7 @@ var
spec: FSSpec;
err: OSErr;
res: Integer;
begin
If (s='') or (InOutRes <> 0) then
exit;
@ -836,10 +815,10 @@ begin
if (s='') or (InOutRes <> 0) then
exit;
res:= PathArgToFSSpec(s, spec);
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
{ The fictive file x is appended to the directory name to make
{ The fictive file x is appended to the directory name to make
FSMakeFSSpec return a FSSpec to a file in the directory.
Then by clearing the name, the FSSpec then
points to the directory. It doesn't matter whether x exists or not.}
@ -873,8 +852,8 @@ begin
if Length(fullPath) <= 255 then {because dir is ShortString}
InOutRes := 0
else
InOutRes := 1; //TODO Exchange to something better
InOutRes := 1; //TODO Exchange to something better
dir:= fullPath;
end;
@ -904,8 +883,8 @@ procedure setup_arguments;
procedure setup_environment;
begin
end;
{ FindSysFolder returns the (real) vRefNum, and the DirID of the current
system folder. It uses the Folder Manager if present, otherwise it falls
back to SysEnvirons. It returns zero on success, otherwise a standard
@ -1012,10 +991,10 @@ begin
macosHasCFM := false;
macosHasAppleEvents := false;
macosHasAliasMgr := false;
macosHasFSSpec := false;
macosHasFindFolder := false;
macosHasAppearance := false;
macosHasAppearance101 := false;
macosHasAppearance11 := false;
@ -1043,7 +1022,7 @@ begin
macosHasSysDebugger := BitIsSet(response, gestaltSysDebuggerSupport)
else
macosHasSysDebugger := false;
if Gestalt(FourCharCodeToLongword(gestaltQuickdrawVersion), response) = noErr then
macosHasColorQD := (response >= $0100)
else
@ -1058,16 +1037,16 @@ begin
macosHasCFM := BitIsSet(response, gestaltCFMPresent)
else
macosHasCFM := false;
macosHasAppleEvents := Gestalt(FourCharCodeToLongword(gestaltAppleEventsAttr), response) = noErr;
macosHasAliasMgr := Gestalt(FourCharCodeToLongword(gestaltAliasMgrAttr), response) = noErr;
if Gestalt(FourCharCodeToLongword(gestaltFSAttr), response) = noErr then
macosHasFSSpec := BitIsSet(response, gestaltHasFSSpecCalls)
else
macosHasFSSpec := false;
macosHasFindFolder := Gestalt(FourCharCodeToLongword(gestaltFindFolderAttr), response) = noErr;
if macosHasScriptMgr then
begin
err := Gestalt(FourCharCodeToLongword(gestaltScriptCount), response);
@ -1112,7 +1091,7 @@ begin
else
{Be quiet}
end;
{$ifndef MACOS_USE_STDCLIB}
if StandAlone <> 0 then
ExitToShell;
@ -1138,10 +1117,10 @@ var
dirStr: string[2];
err: OSErr;
dummySysFolderDirID: Longint;
begin
InvestigateSystem; {Must be first}
{Check requred features for system.pp to work.}
if not macosHasFSSpec then
Halt(3); //exit code 3 according to MPW
@ -1161,7 +1140,7 @@ begin
IsConsole := (resHdl <> nil); {A SIOW app is also a console}
ReleaseResource(resHdl);
end;
{ To be set if this is a library and not a program }
IsLibrary := FALSE;
@ -1176,26 +1155,21 @@ begin
end
else
begin
{ The fictive file x is used to make
{ The fictive file x is used to make
FSMakeFSSpec return a FSSpec to a file in the directory.
Then by clearing the name, the FSSpec then
points to the directory. It doesn't matter whether x exists or not.}
dirStr:= ':x';
err:= ResolveFolderAliases(0, 0, @dirStr, true,
err:= ResolveFolderAliases(0, 0, @dirStr, true,
workingDirectorySpec, isFolder, hadAlias, leafIsAlias);
workingDirectorySpec.name:='';
if (err <> noErr) and (err <> fnfErr) then
Halt(3); //exit code 3 according to MPW
end;
{ Setup heap }
if StandAlone <> 0 then
MaxApplZone;
if Mac_FreeMem - intern_heapsize < 30000 then
Halt(3); //exit code 3 according to MPW
theHeap:= NewPtr(intern_heapsize);
if theHeap = nil then
Halt(3); //exit code 3 according to MPW
InitHeap;
SysInitExceptions;
@ -1225,7 +1199,10 @@ end.
{
$Log$
Revision 1.23 2004-10-19 19:56:59 olle
Revision 1.24 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.23 2004/10/19 19:56:59 olle
* Interface to StdLibC moved from system to macostp
Revision 1.22 2004/09/30 19:58:42 olle

94
rtl/morphos/system.pp
View File

@ -4,11 +4,11 @@
Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.
System unit for MorphOS/PowerPC
Uses parts of the Commodore Amiga/68k port by Carl Eric Codere
Uses parts of the Commodore Amiga/68k port by Carl Eric Codere
and Nils Sjoholm
MorphOS port was done on a free Pegasos II/G4 machine
MorphOS port was done on a free Pegasos II/G4 machine
provided by Genesi S.a.r.l. <www.genesi.lu>
See the file COPYING.FPC, included in this distribution,
@ -28,7 +28,7 @@ interface
{$I systemh.inc}
type
type
THandle = LongInt;
{$I heaph.inc}
@ -62,10 +62,10 @@ var
MOS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
MOS_origDir : LongInt; { original directory on startup }
MOS_ambMsg : Pointer;
MOS_ambMsg : Pointer;
MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
MOS_ConHandle: LongInt;
argc: LongInt;
argv: PPChar;
envp: PPChar;
@ -121,7 +121,7 @@ var
{ Function to be called at program shutdown, to close all opened files }
procedure CloseList(l: PFileList);
var
var
tmpNext : PFileList;
tmpHandle : LongInt;
begin
@ -131,13 +131,13 @@ begin
tmpNext:=l^.next;
while tmpNext<>nil do begin
tmpHandle:=tmpNext^.handle;
if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle)
if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle)
and (tmpHandle<>StdErrorHandle) then begin
dosClose(tmpHandle);
end;
tmpNext:=tmpNext^.next;
end;
{ Next, erase the linked list }
while l<>nil do begin
tmpNext:=l;
@ -279,7 +279,7 @@ begin
end;
end;
{ Generates correct argument array on startup }
{ Generates correct argument array on startup }
procedure GenerateArgs;
var
argvlen : longint;
@ -318,7 +318,7 @@ begin
argv[0][length(temp)]:=#0;
{ check if we're started from Ambient }
if MOS_ambMsg<>nil then
if MOS_ambMsg<>nil then
begin
argc:=0;
exit;
@ -408,7 +408,7 @@ function paramstr(l : longint) : string;
var
s1: String;
begin
paramstr:='';
paramstr:='';
if MOS_ambMsg<>nil then exit;
if l=0 then begin
@ -430,39 +430,12 @@ end;
{*****************************************************************************
Heap Management
*****************************************************************************}
var
int_heap : LongInt; external name 'HEAP';
int_heapsize : LongInt; external name 'HEAPSIZE';
{ first address of heap }
function getheapstart:pointer;
begin
getheapstart:=@int_heap;
end;
{ current length of heap }
function getheapsize:longint;
begin
getheapsize:=int_heapsize;
end;
{ function to allocate size bytes more for the program }
{ must return the first address of new data space or nil if fail }
function Sbrk(size : longint):pointer;
begin
Sbrk:=AllocPooled(MOS_heapPool,size);
end;
{*****************************************************************************
OS Memory allocation / deallocation
OS Memory allocation / deallocation
****************************************************************************}
function SysOSAlloc(size: ptrint): pointer;
begin
result := sbrk(size);
result := AllocPooled(MOS_heapPool,size);
end;
{$define HAS_SYSOSFREE}
@ -560,7 +533,7 @@ begin
FIB:=nil;
new(FIB);
if (Examine(alock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
alock := CurrentDir(alock);
if MOS_OrigDir=0 then begin
@ -594,7 +567,7 @@ end;
procedure do_close(handle : longint);
begin
RemoveFromList(MOS_fileList,handle);
{ Do _NOT_ check CTRL_C on Close, because it will conflict
{ Do _NOT_ check CTRL_C on Close, because it will conflict
with System_Exit! }
if not dosClose(handle) then
dosError2InOut(IoErr);
@ -618,9 +591,9 @@ function do_write(h:longint; addr: pointer; len: longint) : longint;
var dosResult: LongInt;
begin
checkCTRLC;
do_write:=0;
if len<=0 then exit;
do_write:=0;
if len<=0 then exit;
dosResult:=dosWrite(h,addr,len);
if dosResult<0 then begin
dosError2InOut(IoErr);
@ -633,9 +606,9 @@ function do_read(h:longint; addr: pointer; len: longint) : longint;
var dosResult: LongInt;
begin
checkCTRLC;
do_read:=0;
if len<=0 then exit;
do_read:=0;
if len<=0 then exit;
dosResult:=dosRead(h,addr,len);
if dosResult<0 then begin
dosError2InOut(IoErr);
@ -649,7 +622,7 @@ var dosResult: LongInt;
begin
checkCTRLC;
do_filepos:=0;
{ Seeking zero from OFFSET_CURRENT to find out where we are }
dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
if dosResult<0 then begin
@ -672,7 +645,7 @@ var dosResult: LongInt;
begin
checkCTRLC;
do_seekend:=0;
{ Seeking to OFFSET_END }
dosResult:=dosSeek(handle,0,OFFSET_END);
if dosResult<0 then begin
@ -752,7 +725,7 @@ begin
buffer[length(path)]:=#0;
{ close first if opened }
if ((flags and $10000)=0) then
if ((flags and $10000)=0) then
begin
case filerec(f).mode of
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
@ -781,10 +754,10 @@ begin
if (flags and $1000)<>0 then openflags := 1006;
{ empty name is special }
if p[0]=#0 then
if p[0]=#0 then
begin
case filerec(f).mode of
fminput :
fminput :
filerec(f).handle:=StdInputHandle;
fmappend,
fmoutput : begin
@ -794,9 +767,9 @@ begin
end;
exit;
end;
i:=Open(buffer,openflags);
if i=0 then
if i=0 then
begin
dosError2InOut(IoErr);
end else begin
@ -879,7 +852,7 @@ begin
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
{ * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
StdErrorHandle:=StdOutputHandle;
// OpenStdIO(StdErr,fmOutput,StdErrorHandle);
@ -918,7 +891,10 @@ end.
{
$Log$
Revision 1.19 2004-09-03 19:26:15 olle
Revision 1.20 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.19 2004/09/03 19:26:15 olle
+ added maxExitCode to all System.pp
* constrained error code to be below maxExitCode in RunError et. al.
@ -971,7 +947,7 @@ end.
Revision 1.3 2004/05/01 15:09:47 karoly
* first working system unit (very limited yet)
Revision 1.2  2004/04/08 06:28:29  karoly
Revision 1.2  2004/04/08 06:28:29  karoly
* first steps to have a morphos system unit
Revision 1.1 2004/02/13 07:19:53 karoly

23
rtl/netware/system.pp
View File

@ -251,24 +251,6 @@ end;
Heap Management
*****************************************************************************}
var
heap : longint;external name 'HEAP';
intern_heapsize : longint;external name 'HEAPSIZE';
{ first address of heap }
function getheapstart:pointer;
assembler;
asm
leal HEAP,%eax
end ['EAX'];
{ current length of heap }
function getheapsize:longint;
assembler;
asm
movl intern_HEAPSIZE,%eax
end ['EAX'];
{$ifdef autoHeapRelease}
const HeapInitialMaxBlocks = 32;
@ -985,7 +967,10 @@ Begin
End.
{
$Log$
Revision 1.27 2004-09-26 19:25:49 armin
Revision 1.28 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.27 2004/09/26 19:25:49 armin
* exiting threads at nlm unload
Revision 1.26 2004/09/17 18:29:07 armin

21
rtl/netwlibc/system.pp
View File

@ -242,22 +242,6 @@ end;
Heap Management
*****************************************************************************}
var
int_heap : pointer;external name 'HEAP';
int_heapsize : longint;external name 'HEAPSIZE';
{ first address of heap }
function getheapstart:pointer;
begin
getheapstart := int_heap;
end;
{ current length of heap }
function getheapsize:longint;
begin
getheapsize := int_heapsize;
end;
{$ifdef autoHeapRelease}
const HeapInitialMaxBlocks = 32;
@ -1194,7 +1178,10 @@ Begin
End.
{
$Log$
Revision 1.4 2004-09-26 19:23:34 armin
Revision 1.5 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.4 2004/09/26 19:23:34 armin
* exiting threads at nlm unload
* renamed some libc functions

106
rtl/os2/system.pas
View File

@ -487,98 +487,10 @@ function DosFreeMem (P: pointer): cardinal; cdecl;
external 'DOSCALLS' index 304;
var
{ Int_Heap_End: pointer;}
Int_Heap: pointer;
{$IFNDEF VER1_0}
external name 'HEAP';
{$ENDIF VER1_0}
Int_HeapSize: cardinal; external name 'HEAPSIZE';
HighMemSupported: boolean;
{ PreviousHeap: cardinal;
AllocatedMemory: cardinal;
Int_Heap : Pointer;
Int_heapSize : longint;
function GetHeapSize: longint;
begin
GetHeapSize := PreviousHeap + longint (Int_Heap_End) - longint (Int_Heap);
end;
}
function GetHeapSize: longint; assembler;
asm
movl Int_HeapSize, %eax
end ['EAX'];
(*
function Sbrk (Size: longint): pointer;
var
P: pointer;
RC: cardinal;
const
MemAllocBlock = 4 * 1024 * 1024;
begin
{ $IFDEF DUMPGROW}
WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
{ $ENDIF}
// commit memory
RC := DosSetMem (Int_Heap_End, Size, $13);
if RC <> 0 then
( * Not enough memory was allocated - let's try to allocate more
(4 MB steps or as much as requested if more than 4 MB needed). * )
begin
if Size > MemAllocBlock then
begin
RC := DosAllocMem (P, Size, 3);
if RC = 0 then Inc (AllocatedMemory, Size);
end
else
begin
RC := DosAllocMem (P, MemAllocBlock, 3);
if RC = 0 then Inc (AllocatedMemory, MemAllocBlock);
end;
if RC = 0 then
begin
PreviousHeap := GetHeapSize;
Int_Heap := P;
Int_Heap_End := P;
RC := DosSetMem (Int_Heap_End, Size, $13);
end
else
begin
Sbrk := nil;
{ $IFDEF DUMPGROW}
WriteLn ('Error ', RC, ' during additional memory allocation!');
WriteLn ('Total allocated memory is ', cardinal (AllocatedMemory), ', ',
GetHeapSize, ' committed.');
{ $ENDIF DUMPGROW}
Exit;
end;
end;
if RC <> 0 then
begin
{ $IFDEF DUMPGROW}
WriteLn ('Error ', RC, ' while trying to commit more memory!');
WriteLn ('Current memory object starts at ', cardinal (Int_Heap),
' and committed until ', cardinal (Int_Heap_End));
WriteLn ('Total allocated memory is ', cardinal (AllocatedMemory), ', ',
GetHeapSize, ' committed.');
{ $ENDIF DUMPGROW}
Sbrk := nil;
end
else
begin
Sbrk := Int_Heap_End;
{ $IFDEF DUMPGROW}
WriteLn ('New heap at ', cardinal (Int_Heap_End));
{ $ENDIF DUMPGROW}
Inc (Int_Heap_End, Size);
end;
end;
*)
{$IFDEF DUMPGROW}
{$DEFINE EXTDUMPGROW}
{$ENDIF DUMPGROW}
@ -589,8 +501,7 @@ var
RC: cardinal;
begin
{$IFDEF EXTDUMPGROW}
WriteLn ('Trying to grow heap by ', Size, ' to ', Int_HeapSize
+ cardinal (Size));
WriteLn ('Trying to grow heap by ', Size);
{$ENDIF}
if HighMemSupported then
@ -663,12 +574,6 @@ begin
{$ENDIF EXTDUMPGROW}
end;
function GetHeapStart: pointer;
begin
GetHeapStart := Int_Heap;
end;
{$i heap.inc}
@ -1621,7 +1526,10 @@ begin
end.
{
$Log$
Revision 1.74 2004-09-18 11:12:09 hajny
Revision 1.75 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.74 2004/09/18 11:12:09 hajny
* handle type changed to thandle in do_isdevice
Revision 1.73 2004/09/11 19:43:11 hajny

31
rtl/posix/sysposix.inc
View File

@ -108,30 +108,6 @@ Begin
End;
{*****************************************************************************
Heap Management
*****************************************************************************}
var
_HEAP : longint;external name 'HEAP';
_HEAPSIZE : longint;external name 'HEAPSIZE';
{$ifndef SYSTEM_HAS_GETHEAPSTART}
function getheapstart:pointer;
begin
getheapstart := @_HEAP;
end;
{$endif}
{$ifndef SYSTEM_HAS_GETHEAPSIZE}
function getheapsize:longint;
begin
getheapsize := _HEAPSIZE;
end;
{$endif}
{*****************************************************************************
Low Level File Routines
*****************************************************************************}
@ -450,7 +426,7 @@ var
begin
{$ifdef usegetcwd}
sys_getcwd(@tmp[1],255);
dir:=tmp;
dir:=tmp;
{$else}
dir:='';
thedir:='';
@ -655,7 +631,10 @@ End.
*)
{
$Log$
Revision 1.7 2002-11-14 12:18:03 marco
Revision 1.8 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.7 2002/11/14 12:18:03 marco
* fixed sys_time call to (NIL)
Revision 1.6 2002/10/27 17:21:29 marco

43
rtl/template/system.pp
View File

@ -112,48 +112,14 @@ begin
randseed:=0;
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
{ first address of heap }
function getheapstart:pointer;{assembler;
asm
leal HEAP,%eax
end ['EAX'];}
begin
getheapstart:=0;
end;
{ current length of heap }
function getheapsize:longint;{assembler;
asm
movl HEAPSIZE,%eax
end ['EAX'];}
begin
getheapsize:=0;
end;
{ function to allocate size bytes more for the program }
{ must return the first address of new data space or nil if fail }
function Sbrk(size : longint):pointer;{assembler;
asm
movl size,%eax
pushl %eax
call ___sbrk
addl $4,%esp
end;}
begin
Sbrk:=nil;
end;
{*****************************************************************************
OS Memory allocation / deallocation
OS Memory allocation / deallocation
****************************************************************************}
function SysOSAlloc(size: ptrint): pointer;
begin
result := sbrk(size);
// code to allocate memory block
end;
// If the OS is capable of freeing memory, define HAS_SYSOSFREE and implement
@ -320,7 +286,10 @@ Begin
End.
{
$Log$
Revision 1.12 2004-09-03 19:26:57 olle
Revision 1.13 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.12 2004/09/03 19:26:57 olle
+ added maxExitCode to all System.pp
* constrained error code to be below maxExitCode in RunError et. al.

38
rtl/watcom/system.pp
View File

@ -827,27 +827,14 @@ begin
randseed:=hl*$10000+ lo(regs.realecx);
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
var int_heapsize:longint; external name 'HEAPSIZE';
int_heap:pointer; external name 'HEAP';
function getheapstart:pointer;
begin
getheapstart:=int_heap;
end;
function getheapsize:longint;
begin
getheapsize:=int_heapsize;
end;
OS Memory allocation / deallocation
****************************************************************************}
function ___sbrk(size:longint):pointer;cdecl; external name '___sbrk';
function Sbrk(size : longint):pointer;assembler;
function SysOSAlloc(size: ptrint): pointer;assembler;
asm
{$ifdef SYSTEMDEBUG}
cmpb $1,accept_sbrk
@ -865,20 +852,10 @@ asm
{$endif}
end;
{*****************************************************************************
OS Memory allocation / deallocation
****************************************************************************}
function SysOSAlloc(size: ptrint): pointer;
begin
result := sbrk(size);
end;
{$define HAS_SYSOSFREE}
{ define HAS_SYSOSFREE}
procedure SysOSFree(p: pointer; size: ptrint);
begin
fpmunmap(p, size);
end;
{ include standard heap management }
@ -1554,7 +1531,10 @@ End.
{
$Log$
Revision 1.15 2004-09-03 19:27:16 olle
Revision 1.16 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.15 2004/09/03 19:27:16 olle
+ added maxExitCode to all System.pp
* constrained error code to be below maxExitCode in RunError et. al.

21
rtl/win32/system.pp
View File

@ -265,22 +265,6 @@ end;
stdcall;external 'kernel32' name 'HeapSize';
{$ENDIF}
var
heap : longint;external name 'HEAP';
intern_heapsize : longint;external name 'HEAPSIZE';
function getheapstart:pointer;
assembler;
asm
leal HEAP,%eax
end ['EAX'];
function getheapsize:longint;
assembler;
asm
movl intern_HEAPSIZE,%eax
end ['EAX'];
{*****************************************************************************
OS Memory allocation / deallocation
@ -1622,7 +1606,10 @@ end.
{
$Log$
Revision 1.61 2004-09-03 19:27:25 olle
Revision 1.62 2004-10-25 15:38:59 peter
* compiler defined HEAP and HEAPSIZE removed
Revision 1.61 2004/09/03 19:27:25 olle
+ added maxExitCode to all System.pp
* constrained error code to be below maxExitCode in RunError et. al.