mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:26:15 +02:00
+ added support for rudimentary heap
This commit is contained in:
parent
b924813d4a
commit
a6652bc306
@ -37,6 +37,9 @@ type
|
|||||||
|
|
||||||
{$else}
|
{$else}
|
||||||
|
|
||||||
|
{At the moment we do not support threadvars}
|
||||||
|
{$undef HASTHREADVAR}
|
||||||
|
|
||||||
{$I systemh.inc}
|
{$I systemh.inc}
|
||||||
|
|
||||||
{$I heaph.inc}
|
{$I heaph.inc}
|
||||||
@ -69,6 +72,17 @@ var
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
{Some MacOS API routines needed for internal use.
|
||||||
|
Note, because the System unit is the most low level, it should not
|
||||||
|
depend on any other units, and in particcular not the MacOS unit.}
|
||||||
|
|
||||||
|
function NewPtr(logicalSize: Longint): pointer ;
|
||||||
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
procedure Debugger;
|
||||||
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
|
||||||
{$ifdef MAC_SYS_RUNABLE}
|
{$ifdef MAC_SYS_RUNABLE}
|
||||||
|
|
||||||
procedure do_exit;[public,alias:'FPC_DO_EXIT'];
|
procedure do_exit;[public,alias:'FPC_DO_EXIT'];
|
||||||
@ -142,24 +156,31 @@ end;
|
|||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Heap Management
|
Heap Management
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
const
|
||||||
|
theHeapSize = 300000; //TODO: Use heapsize set by user.
|
||||||
|
|
||||||
|
var
|
||||||
|
{ Pointer to a block allocated with the MacOS Memory Manager, which
|
||||||
|
is used as the FPC heap }
|
||||||
|
theHeap: pointer;
|
||||||
|
|
||||||
{ first address of heap }
|
{ first address of heap }
|
||||||
function getheapstart:pointer;
|
function getheapstart:pointer;
|
||||||
begin
|
begin
|
||||||
getheapstart:=0;
|
getheapstart:= theHeap;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ current length of heap }
|
{ current length of heap }
|
||||||
function getheapsize:longint;
|
function getheapsize:longint;
|
||||||
begin
|
begin
|
||||||
getheapsize:=0;
|
getheapsize:= theHeapSize ;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ function to allocate size bytes more for the program }
|
{ function to allocate size bytes more for the program }
|
||||||
{ must return the first address of new data space or -1 if fail }
|
{ must return the first address of new data space or -1 if fail }
|
||||||
function Sbrk(size : longint):longint;
|
function Sbrk(size : longint):longint;
|
||||||
begin
|
begin
|
||||||
Sbrk:=-1;
|
Sbrk:=-1; //TODO: Allow heap increase.
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$I heap.inc}
|
{$I heap.inc}
|
||||||
@ -289,13 +310,17 @@ end;
|
|||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
Begin
|
Begin
|
||||||
{ To be set if this is a GUI or console application }
|
if false then //To save it from the dead code stripper
|
||||||
|
Debugger; //Included only to make it available for debugging
|
||||||
|
|
||||||
|
{ To be set if this is a GUI or console application }
|
||||||
IsConsole := TRUE;
|
IsConsole := TRUE;
|
||||||
{ To be set if this is a library and not a program }
|
{ To be set if this is a library and not a program }
|
||||||
IsLibrary := FALSE;
|
IsLibrary := FALSE;
|
||||||
StackBottom := SPtr - StackLength;
|
StackBottom := SPtr - StackLength;
|
||||||
ExitCode := 0;
|
ExitCode := 0;
|
||||||
{ Setup heap }
|
{ Setup heap }
|
||||||
|
theHeap:= NewPtr(theHeapSize);
|
||||||
InitHeap;
|
InitHeap;
|
||||||
{ Setup stdin, stdout and stderr }
|
{ Setup stdin, stdout and stderr }
|
||||||
OpenStdIO(Input,fmInput,StdInputHandle);
|
OpenStdIO(Input,fmInput,StdInputHandle);
|
||||||
@ -315,7 +340,10 @@ End.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.3 2002-10-23 15:29:09 olle
|
Revision 1.4 2002-11-28 10:58:02 olle
|
||||||
|
+ added support for rudimentary heap
|
||||||
|
|
||||||
|
Revision 1.3 2002/10/23 15:29:09 olle
|
||||||
+ added switch MAC_SYS_RUNABLE
|
+ added switch MAC_SYS_RUNABLE
|
||||||
+ added include of system.h etc
|
+ added include of system.h etc
|
||||||
+ added standard globals
|
+ added standard globals
|
||||||
|
Loading…
Reference in New Issue
Block a user