+ filehandling complete

+ heaphandling complete
  + support for random
  * filehandling now uses filedecriptors in StdCLib
  * other minor changes
  - removed DEFINE MAC_SYS_RUNNABLE
This commit is contained in:
olle 2003-09-12 12:45:15 +00:00
parent 615792ffe9
commit 19e0c3eb31

View File

@ -17,50 +17,29 @@ unit System;
interface interface
{If MAC_SYS_RUNABLE is defined, this file can be included in a { include system-independent routine headers }
runnable program, but it then lacks lot of features. If not defined
it tries to be faithful to a real system.pp, but it may not be
able to assemble and link. The switch is only temporary, and only for
use when system.pp is developed.}
{$Y-}
{$ifdef MAC_SYS_RUNABLE}
type
integer = -32768 .. 32767;
byte =0..255;
shortint=-128..127;
word=0..65535;
longint=+(-$7FFFFFFF-1)..$7FFFFFFF;
pchar=^char;
{$else}
{At the moment we do not support threadvars}
{$undef HASTHREADVAR}
{$I systemh.inc} {$I systemh.inc}
{$I heaph.inc}
{Platform specific information} {Platform specific information}
const const
LineEnding = #13; LineEnding = #13;
LFNSupport = true; LFNSupport = true;
DirectorySeparator = ':'; DirectorySeparator = ':';
DriveSeparator = ':'; DriveSeparator = ':';
PathSeparator = ';'; PathSeparator = ','; // Is used in MPW
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
const { include heap support headers }
UnusedHandle = 0; {$I heaph.inc}
StdInputHandle = 0;
StdOutputHandle = 0;
StdErrorHandle = 0;
sLineBreak : string[1] = LineEnding; const
{ Default filehandles }
UnusedHandle : Longint = -1;
StdInputHandle : Longint = 0;
StdOutputHandle : Longint = 1;
StdErrorHandle : Longint = 2;
sLineBreak = LineEnding;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR; DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR;
var var
@ -68,10 +47,16 @@ var
argv : ppchar; argv : ppchar;
envp : ppchar; envp : ppchar;
{$endif}
implementation implementation
{$define MACOS_USE_STDCLIB}
{ include system independent routines }
{$I system.inc}
{*********************** MacOS API *************}
{TODO: Perhaps the System unit should check the MacOS version to {TODO: Perhaps the System unit should check the MacOS version to
ensure it is a supported version. } ensure it is a supported version. }
@ -85,6 +70,7 @@ with FPC types.}
type type
SignedByte = shortint; SignedByte = shortint;
SignedBytePtr = ^SignedByte;
OSErr = Integer; OSErr = Integer;
OSType = Longint; OSType = Longint;
Mac_Ptr = pointer; Mac_Ptr = pointer;
@ -92,6 +78,7 @@ type
Str31 = string[31]; Str31 = string[31];
Str32 = string[32]; Str32 = string[32];
Str63 = string[63]; Str63 = string[63];
Str255 = string[255];
FSSpec = record FSSpec = record
vRefNum: Integer; vRefNum: Integer;
parID: Longint; parID: Longint;
@ -113,12 +100,26 @@ external 'InterfaceLib';
procedure DisposeHandle(hdl: Mac_Handle); procedure DisposeHandle(hdl: Mac_Handle);
external 'InterfaceLib'; external 'InterfaceLib';
function Mac_FreeMem: Longint;
external 'InterfaceLib' name 'FreeMem';
procedure Debugger; procedure Debugger;
external 'InterfaceLib'; external 'InterfaceLib';
procedure DebugStr(s: Str255);
external 'InterfaceLib';
procedure ExitToShell; procedure ExitToShell;
external 'InterfaceLib'; external 'InterfaceLib';
procedure SysBeep(dur: Integer);
external 'SysBeep';
function TickCount: Longint;
external 'InterfaceLib';
{$ifndef MACOS_USE_STDCLIB}
function FSpOpenDF(spec: FSSpec; permission: SignedByte; function FSpOpenDF(spec: FSSpec; permission: SignedByte;
var refNum: Integer): OSErr; var refNum: Integer): OSErr;
external 'InterfaceLib'; external 'InterfaceLib';
@ -157,47 +158,171 @@ function ResolveAlias(fromFile: FSSpecPtr; alias: AliasHandle;
var target: FSSpec; var wasChanged: Boolean):OSErr; var target: FSSpec; var wasChanged: Boolean):OSErr;
external 'InterfaceLib'; external 'InterfaceLib';
{$ifdef MAC_SYS_RUNABLE}
procedure do_exit;[public,alias:'FPC_DO_EXIT'];
begin
end;
procedure fpc_initializeunits;[public,alias:'FPC_INITIALIZEUNITS'];
begin
end;
{$else} {$else}
{$I system.inc} {**************** API to StdCLib in MacOS *************}
{The reason StdCLib is used is that it can easily be connected
to either SIOW or, in case of MPWTOOL, to MPW }
{*********************** ??????? *************} {The prefix C_ or c_ is used where names conflicts with pascal
keywords and names. Suffix Ptr is added for pointer to a type.}
procedure SysInitStdIO; type
begin size_t = Longint;
off_t = Longint;
C_int = Longint;
C_short = Integer;
C_long = Longint;
C_unsigned_int = Cardinal;
var
errno: C_int; external name 'errno';
MacOSErr: C_short; external name 'MacOSErr';
const
_IOFBF = $00;
_IOLBF = $40;
_IONBF = $04;
O_RDONLY = $00; // Open for reading only.
O_WRONLY = $01; // Open for writing only.
O_RDWR = $02; // Open for reading & writing.
O_APPEND = $08; // Write to the end of the file.
O_RSRC = $10; // Open the resource fork.
O_ALIAS = $20; // Open alias file.
O_CREAT = $100; // Open or create a file.
O_TRUNC = $200; // Open and truncate to zero length.
O_EXCL = $400; // Create file only; fail if exists.
O_BINARY = $800; // Open as a binary stream.
O_NRESOLVE = $4000; // Don't resolve any aliases.
SEEK_SET = 0;
SEEK_CUR = 1;
SEEK_END = 2;
FIOINTERACTIVE = $00006602; // If device is interactive
FIOBUFSIZE = $00006603; // Return optimal buffer size
FIOFNAME = $00006604; // Return filename
FIOREFNUM = $00006605; // Return fs refnum
FIOSETEOF = $00006606; // Set file length
TIOFLUSH = $00007408; // discard unread input. arg is ignored
function C_open(path: PChar; oflag: C_int): C_int;
external 'StdCLib' name 'open';
function C_close(filedes: C_int): C_int;
external 'StdCLib' name 'close';
function C_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
external 'StdCLib' name 'write';
{??? fread returns only when n items has been read. Does not specifically
return after newlines, so cannot be used for reading input from the console.}
function C_read(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
external 'StdCLib' name 'read';
function lseek(filedes: C_int; offset: off_t; whence: C_int): off_t;
external 'StdCLib' name 'lseek';
function ioctl(filedes: C_int; cmd: C_unsigned_int; arg: pointer): C_int;
external 'StdCLib' name 'ioctl';
function remove(filename: PChar): C_int;
external 'StdCLib';
function c_rename(old, c_new: PChar): C_int;
external 'StdCLib' name 'rename';
procedure c_exit(status: C_int);
external 'StdCLib' name 'exit';
var
{Is set to nonzero for MPWTool, zero otherwise.}
StandAlone: C_int; external name 'StandAlone';
CONST
Sys_EPERM = 1; { No permission match }
Sys_ENOENT = 2; { No such file or directory }
Sys_ENORSRC = 3; { Resource not found *}
Sys_EINTR = 4; { System service interrupted *}
Sys_EIO = 5; { I/O error }
Sys_ENXIO = 6; { No such device or address }
Sys_E2BIG = 7; { Insufficient space for return argument * }
Sys_ENOEXEC = 8; { File not executable * }
Sys_EBADF = 9; { Bad file number }
Sys_ECHILD = 10; { No child processes }
Sys_EAGAIN = 11; { Resource temporarily unavailable * }
Sys_ENOMEM = 12; { Not enough space * }
Sys_EACCES = 13; { Permission denied }
Sys_EFAULT = 14; { Illegal filename * }
Sys_ENOTBLK = 15; { Block device required }
Sys_EBUSY = 16; { Device or resource busy }
Sys_EEXIST = 17; { File exists }
Sys_EXDEV = 18; { Cross-device link }
Sys_ENODEV = 19; { No such device }
Sys_ENOTDIR = 20; { Not a directory }
Sys_EISDIR = 21; { Is a directory }
Sys_EINVAL = 22; { Invalid parameter * }
Sys_ENFILE = 23; { File table overflow }
Sys_EMFILE = 24; { Too many open files }
Sys_ENOTTY = 25; { Not a typewriter }
Sys_ETXTBSY = 26; { Text file busy }
Sys_EFBIG = 27; { File too large }
Sys_ENOSPC = 28; { No space left on device }
Sys_ESPIPE = 29; { Illegal seek }
Sys_EROFS = 30; { Read-only file system }
Sys_EMLINK = 31; { Too many links }
Sys_EPIPE = 32; { Broken pipe }
Sys_EDOM = 33; { Math argument out of domain of func }
Sys_ERANGE = 34; { Math result not representable }
{ Note * is slightly different, compared to rtl/sunos/errno.inc}
{$endif}
{******************************************************}
Procedure Errno2InOutRes;
{
Convert ErrNo error to the correct Inoutres value
}
Begin
if errno = 0 then { Else it will go through all the cases }
exit;
//If errno<0 then Errno:=-errno;
case Errno of
Sys_ENFILE,
Sys_EMFILE : Inoutres:=4;
Sys_ENOENT : Inoutres:=2;
Sys_EBADF : Inoutres:=6;
Sys_ENOMEM,
Sys_EFAULT : Inoutres:=217;
Sys_EINVAL : Inoutres:=218;
Sys_EPIPE,
Sys_EINTR,
Sys_EIO,
Sys_EAGAIN,
Sys_ENOSPC : Inoutres:=101;
Sys_ENOTDIR : Inoutres:=3;
Sys_EROFS,
Sys_EEXIST,
Sys_EISDIR,
Sys_EACCES : Inoutres:=5;
Sys_ETXTBSY : Inoutres:=162;
else
InOutRes := Integer(errno);
end;
errno:=0;
end; end;
{*****************************************************************************}
procedure setup_arguments;
begin
end;
procedure setup_environment;
begin
end;
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}
Procedure system_exit;
begin
ExitToShell;
end;
{***************************************************************************** {*****************************************************************************
ParamStr/Randomize ParamStr/Randomize
*****************************************************************************} *****************************************************************************}
@ -221,23 +346,18 @@ end;
{ set randseed to a new pseudo random value } { set randseed to a new pseudo random value }
procedure randomize; procedure randomize;
begin begin
{regs.realeax:=$2c00; randseed:= Cardinal(TickCount);
sysrealintr($21,regs);
hl:=regs.realedx and $ffff;
randseed:=hl*$10000+ (regs.realecx and $ffff);}
randseed:=0;
end; end;
{***************************************************************************** {*****************************************************************************
Heap Management Heap Management
*****************************************************************************} *****************************************************************************}
const
theHeapSize = 300000; //TODO: Use heapsize set by user.
var var
{ Pointer to a block allocated with the MacOS Memory Manager, which { Pointer to a block allocated with the MacOS Memory Manager, which
is used as the FPC heap } is used as the initial FPC heap. }
theHeap: Mac_Ptr; theHeap: Mac_Ptr;
intern_heapsize : longint;external name 'HEAPSIZE';
{ first address of heap } { first address of heap }
function getheapstart:pointer; function getheapstart:pointer;
@ -248,107 +368,189 @@ end;
{ current length of heap } { current length of heap }
function getheapsize:longint; function getheapsize:longint;
begin begin
getheapsize:= theHeapSize ; getheapsize:= intern_heapsize ;
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;
var
p: Mac_Ptr;
begin begin
Sbrk:=-1; //TODO: Allow heap increase. p:= NewPtr(size);
if p = nil then
Sbrk:= -1 //Tell its failed
else
Sbrk:= longint(p)
end; end;
{ include standard heap management }
{$I heap.inc} {$I heap.inc}
{**************************************************************************** {*****************************************************************************
Low level File Routines Low Level File Routines
All these functions can set InOutRes on errors
****************************************************************************} ****************************************************************************}
{ close a file from the handle value } function do_isdevice(handle:longint):boolean;
procedure do_close(handle : longint);
begin begin
do_isdevice:=false;
end;
{ close a file from the handle value }
procedure do_close(h : longint);
begin
{$ifdef MACOS_USE_STDCLIB}
C_close(h);
Errno2InOutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if handle = UnusedHandle then exit; if FSClose(h) = noErr then
if FSClose(handle) = noErr then InOutRes:=0;
InOutRes:=0; //TODO: Is this right ? {$endif}
end; end;
procedure do_erase(p : pchar); procedure do_erase(p : pchar);
begin begin
{$ifdef MACOS_USE_STDCLIB}
remove(p);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
{$endif}
end; end;
procedure do_rename(p1,p2 : pchar); procedure do_rename(p1,p2 : pchar);
begin begin
{$ifdef MACOS_USE_STDCLIB}
c_rename(p1,p2);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
{$endif}
end; end;
function do_write(h,addr,len : longint) : longint; function do_write(h,addr,len : longint) : longint;
begin begin
{$ifdef MACOS_USE_STDCLIB}
do_write:= C_write(h, pointer(addr), len);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if h = UnusedHandle then exit;
if FSWrite(h, len, Mac_Ptr(addr)) = noErr then if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
do_write:= len; do_write:= len;
{$endif}
end; end;
function do_read(h,addr,len : longint) : longint; function do_read(h,addr,len : longint) : longint;
var
i: Longint;
begin begin
InOutRes:=1; {$ifdef MACOS_USE_STDCLIB}
if h = UnusedHandle then exit; len:= C_read(h, pointer(addr), len);
if FSread(h, len, Mac_Ptr(addr)) = noErr then Errno2InoutRes;
InOutRes:=0; //TODO: Is this right ?
// TEMP BUGFIX Exchange CR to LF.
for i:= 0 to len-1 do
if SignedBytePtr(ord(addr) + i)^ = 13 then
SignedBytePtr(ord(addr) + i)^ := 10;
do_read:= len; do_read:= len;
{$else}
InOutRes:=1;
if FSread(h, len, Mac_Ptr(addr)) = noErr then
InOutRes:=0;
do_read:= len;
{$endif}
end; end;
function do_filepos(handle : longint) : longint; function do_filepos(handle : longint) : longint;
var var
pos: Longint; pos: Longint;
begin begin
{$ifdef MACOS_USE_STDCLIB}
{This returns the filepos without moving it.}
do_filepos := lseek(handle, 0, SEEK_CUR);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if handle = UnusedHandle then exit;
if GetFPos(handle, pos) = noErr then if GetFPos(handle, pos) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
do_filepos:= pos; do_filepos:= pos;
{$endif}
end; end;
procedure do_seek(handle,pos : longint); procedure do_seek(handle,pos : longint);
begin begin
{$ifdef MACOS_USE_STDCLIB}
lseek(handle, pos, SEEK_SET);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if handle = UnusedHandle then exit;
if SetFPos(handle, fsFromStart, pos) = noErr then if SetFPos(handle, fsFromStart, pos) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
{$endif}
end; end;
function do_seekend(handle:longint):longint; function do_seekend(handle:longint):longint;
begin begin
{$ifdef MACOS_USE_STDCLIB}
lseek(handle, 0, SEEK_END);
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if handle = UnusedHandle then exit;
if SetFPos(handle, fsFromLEOF, 0) = noErr then if SetFPos(handle, fsFromLEOF, 0) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
{$endif}
end; end;
function do_filesize(handle : longint) : longint; function do_filesize(handle : longint) : longint;
var var
pos: Longint; aktfilepos: Longint;
begin begin
{$ifdef MACOS_USE_STDCLIB}
aktfilepos:= lseek(handle, 0, SEEK_CUR);
if errno = 0 then
begin
do_filesize := lseek(handle, 0, SEEK_END);
Errno2InOutRes; {Report the error from this operation.}
lseek(handle, aktfilepos, SEEK_SET); {Always try to move back,
even in presence of error.}
end
else
Errno2InOutRes;
{$else}
InOutRes:=1; InOutRes:=1;
if handle = UnusedHandle then exit;
if GetEOF(handle, pos) = noErr then if GetEOF(handle, pos) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
do_filesize:= pos; do_filesize:= pos;
{$endif}
end; end;
{ truncate at a given position } { truncate at a given position }
procedure do_truncate (handle,pos:longint); procedure do_truncate (handle,pos:longint);
begin begin
{$ifdef MACOS_USE_STDCLIB}
ioctl(handle, FIOSETEOF, pointer(pos));
Errno2InoutRes;
{$else}
InOutRes:=1; InOutRes:=1;
do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?) do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
if SetEOF(handle, pos) = noErr then if SetEOF(handle, pos) = noErr then
InOutRes:=0; //TODO: Is this right ? InOutRes:=0;
{$endif}
end; end;
{$ifndef MACOS_USE_STDCLIB}
function FSpLocationFromFullPath(fullPathLength: Integer; function FSpLocationFromFullPath(fullPathLength: Integer;
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr; fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
@ -366,17 +568,18 @@ begin
begin begin
res:= ResolveAlias(nil, alias, spec, wasChanged); res:= ResolveAlias(nil, alias, spec, wasChanged);
DisposeHandle(Mac_Handle(alias)); DisposeHandle(Mac_Handle(alias));
end; end;
FSpLocationFromFullPath:= res; FSpLocationFromFullPath:= res;
end; end;
{$endif}
procedure do_open(var f;p:pchar;flags:longint); procedure do_open(var f;p:pchar;flags:longint);
{ {
filerec and textrec have both handle and mode as the first items so filerec and textrec have both handle and mode as the first items so
they could use the same routine for opening/creating. they could use the same routine for opening/creating.
when (flags and $10) the file will be append when (flags and $100) the file will be append
when (flags and $100) the file will be truncate/rewritten when (flags and $1000) the file will be truncate/rewritten
when (flags and $1000) there is no check for close (needed for textfiles) when (flags and $10000) there is no check for close (needed for textfiles)
} }
var var
@ -386,11 +589,87 @@ var
refNum: Integer; refNum: Integer;
res: OSErr; res: OSErr;
const fh: Longint;
oflags : longint;
Const
fsCurPerm = 0; fsCurPerm = 0;
smSystemScript = -1; smSystemScript = -1;
begin begin
// AllowSlash(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin
case filerec(f).mode of
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
fmclosed : ;
else
begin
{not assigned}
inoutres:=102;
exit;
end;
end;
end;
{ reset file handle }
filerec(f).handle:=UnusedHandle;
{$ifdef MACOS_USE_STDCLIB}
{ We do the conversion of filemodes here, concentrated on 1 place }
case (flags and 3) of
0 : begin
oflags :=O_RDONLY;
filerec(f).mode:=fminput;
end;
1 : begin
oflags :=O_WRONLY;
filerec(f).mode:=fmoutput;
end;
2 : begin
oflags :=O_RDWR;
filerec(f).mode:=fminout;
end;
end;
if (flags and $1000)=$1000 then
oflags:=oflags or (O_CREAT or O_TRUNC)
else if (flags and $100)=$100 then
oflags:=oflags or (O_APPEND);
{ empty name is special }
if p[0]=#0 then
begin
case FileRec(f).mode of
fminput :
FileRec(f).Handle:=StdInputHandle;
fminout, { this is set by rewrite }
fmoutput :
FileRec(f).Handle:=StdOutputHandle;
fmappend :
begin
FileRec(f).Handle:=StdOutputHandle;
FileRec(f).mode:=fmoutput; {fool fmappend}
end;
end;
exit;
end;
fh:= C_open(p, oflags);
//TODO Perhaps handle readonly filesystems, as in sysunix.inc
Errno2InOutRes;
if fh <> -1 then
filerec(f).handle:= fh
else
filerec(f).handle:= UnusedHandle;
{$else}
InOutRes:=1; InOutRes:=1;
//creator:= $522A6368; {'MPS ' -- MPW} //creator:= $522A6368; {'MPS ' -- MPW}
//creator:= $74747874; {'ttxt'} //creator:= $74747874; {'ttxt'}
@ -418,12 +697,9 @@ begin
//errno:=GetLastError; //errno:=GetLastError;
//Errno2InoutRes; //Errno2InoutRes;
end; end;
{$endif}
end; end;
function do_isdevice(handle:longint):boolean;
begin
do_isdevice:=false;
end;
{***************************************************************************** {*****************************************************************************
@ -450,17 +726,17 @@ end;
{***************************************************************************** {*****************************************************************************
Directory Handling Directory Handling
*****************************************************************************} *****************************************************************************}
procedure mkdir(const s : string);[IOCheck]; procedure mkdir(const s:string);[IOCheck];
begin begin
InOutRes:=1; InOutRes:=1;
end; end;
procedure rmdir(const s : string);[IOCheck]; procedure rmdir(const s:string);[IOCheck];
begin begin
InOutRes:=1; InOutRes:=1;
end; end;
procedure chdir(const s : string);[IOCheck]; procedure chdir(const s:string);[IOCheck];
begin begin
InOutRes:=1; InOutRes:=1;
end; end;
@ -475,38 +751,86 @@ end;
SystemUnit Initialization SystemUnit Initialization
*****************************************************************************} *****************************************************************************}
Begin procedure setup_arguments;
if false then //To save it from the dead code stripper begin
Debugger; //Included only to make it available for debugging end;
{ To be set if this is a GUI or console application } procedure setup_environment;
begin
end;
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}
Procedure system_exit;
begin
{$ifndef MACOS_USE_STDCLIB}
if StandAlone <> 0 then
ExitToShell;
{$else}
c_exit(exitcode); //exitcode is only utilized by an MPW tool
{$endif}
end;
procedure SysInitStdIO;
begin
{ Setup stdin, stdout and stderr }
{$ifdef MACOS_USE_STDCLIB}
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
{$endif }
end;
begin
if false then //To save it from the dead code stripper
begin
//Included only to make them available for debugging in asm.
Debugger;
DebugStr('');
end;
{ 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;
StackLength := InitialStkLen;
StackBottom := SPtr - StackLength; StackBottom := SPtr - StackLength;
ExitCode := 0;
{ Setup heap } { Setup heap }
theHeap:= NewPtr(theHeapSize); if Mac_FreeMem - intern_heapsize < 30000 then
Halt(3);
theHeap:= NewPtr(intern_heapsize);
if theHeap = nil then
Halt(3); //According to MPW
InitHeap; InitHeap;
{ Setup stdin, stdout and stderr } SysInitStdIO;
(* OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle); { Setup environment and arguments }
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);*)
{ Setup environment and arguments }
Setup_Environment; Setup_Environment;
Setup_Arguments; setup_arguments;
{ Reset IO Error } { Reset IO Error }
InOutRes:=0; InOutRes:=0;
errno:=0;
{$endif} {$ifdef HASVARIANT}
initvariantmanager;
End. {$endif HASVARIANT}
end.
{ {
$Log$ $Log$
Revision 1.5 2003-01-13 17:18:55 olle Revision 1.6 2003-09-12 12:45:15 olle
+ filehandling complete
+ heaphandling complete
+ support for random
* filehandling now uses filedecriptors in StdCLib
* other minor changes
- removed DEFINE MAC_SYS_RUNNABLE
Revision 1.5 2003/01/13 17:18:55 olle
+ added support for rudimentary file handling + added support for rudimentary file handling
Revision 1.4 2002/11/28 10:58:02 olle Revision 1.4 2002/11/28 10:58:02 olle