Browse Source

+ filehandling complete
+ heaphandling complete
+ support for random
* filehandling now uses filedecriptors in StdCLib
* other minor changes
- removed DEFINE MAC_SYS_RUNNABLE

olle 22 years ago
parent
commit
19e0c3eb31
1 changed files with 456 additions and 132 deletions
  1. 456 132
      rtl/macos/system.pp

+ 456 - 132
rtl/macos/system.pp

@@ -17,50 +17,29 @@ unit System;
 
 
 interface
 interface
 
 
-{If MAC_SYS_RUNABLE is defined, this file can be included in a
- 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}
-
+{ include system-independent routine headers }
 {$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;
 
 
+{ include heap support headers }
+{$I heaph.inc}
+
 const
 const
-  UnusedHandle    = 0;
-  StdInputHandle  = 0;
-  StdOutputHandle = 0;
-  StdErrorHandle  = 0;
+{ Default filehandles }
+  UnusedHandle    : Longint = -1;
+  StdInputHandle  : Longint = 0;
+  StdOutputHandle : Longint = 1;
+  StdErrorHandle  : Longint = 2;
 
 
-  sLineBreak : string[1] = LineEnding;
+  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,11 +78,12 @@ 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;
       name: Str63;
       name: Str63;
-    end;
+   end;
   FSSpecPtr = ^FSSpec;
   FSSpecPtr = ^FSSpec;
   AliasHandle = Mac_Handle;
   AliasHandle = Mac_Handle;
   ScriptCode = Integer;
   ScriptCode = Integer;
@@ -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,46 +158,170 @@ 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}
+{$else}
 
 
-procedure do_exit;[public,alias:'FPC_DO_EXIT'];
+{**************** 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 }
 
 
-begin
-end;
+{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 fpc_initializeunits;[public,alias:'FPC_INITIALIZEUNITS'];
+type
+  size_t = Longint;
+  off_t = Longint;
+  C_int = Longint;
+  C_short = Integer;  
+  C_long = Longint;  
+  C_unsigned_int = Cardinal;
 
 
-begin
-end;
+var
+  errno: C_int; external name 'errno';
+  MacOSErr: C_short; external name 'MacOSErr';
 
 
-{$else}
+const
+  _IOFBF = $00;
+  _IOLBF = $40;
+  _IONBF = $04;
 
 
-{$I system.inc}
 
 
-{*********************** ??????? *************}
+  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.
 
 
-procedure SysInitStdIO;
-begin
-end;
 
 
-{*****************************************************************************}
+  SEEK_SET = 0;
+  SEEK_CUR = 1;
+  SEEK_END = 2;
 
 
-procedure setup_arguments;
-begin
-end;
+  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
 
 
-procedure setup_environment;
-begin
-end;
+  TIOFLUSH = $00007408;	      // discard unread input.  arg is ignored
 
 
-{*****************************************************************************
-                         System Dependent Exit code
-*****************************************************************************}
-Procedure system_exit;
-begin
-  ExitToShell;
-end;
+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;
 
 
 {*****************************************************************************
 {*****************************************************************************
                               ParamStr/Randomize
                               ParamStr/Randomize
@@ -213,31 +338,26 @@ end;
 function paramstr(l : longint) : string;
 function paramstr(l : longint) : string;
 begin
 begin
   {if (l>=0) and (l+1<=argc) then
   {if (l>=0) and (l+1<=argc) then
-   paramstr:=strpas(argv[l])
+    paramstr:=strpas(argv[l])
   else}
   else}
-   paramstr:='';
+    paramstr:='';
 end;
 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;
-  sysrealintr($21,regs);
-  hl:=regs.realedx and $ffff;
-  randseed:=hl*$10000+ (regs.realecx and $ffff);}
-  randseed:=0;
+  randseed:= Cardinal(TickCount);
 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
-       All these functions can set InOutRes on errors
+{*****************************************************************************
+                          Low Level File Routines
  ****************************************************************************}
  ****************************************************************************}
 
 
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice:=false;
+end;
+
 { close a file from the handle value }
 { close a file from the handle value }
-procedure do_close(handle : longint);
+procedure do_close(h : longint);
 begin
 begin
+  {$ifdef MACOS_USE_STDCLIB}
+  C_close(h);
+  Errno2InOutRes;
+  {$else}
   InOutRes:=1;
   InOutRes:=1;
-  if handle = UnusedHandle then exit;
-  if FSClose(handle) = noErr then
-    InOutRes:=0;	//TODO: Is this right ?	
+  if FSClose(h) = noErr then
+    InOutRes:=0;
+  {$endif}
 end;
 end;
 
 
 procedure do_erase(p : pchar);
 procedure do_erase(p : pchar);
 begin
 begin
-  InOutRes:=1;
+  {$ifdef MACOS_USE_STDCLIB}
+  remove(p);
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;  
+  {$endif}
 end;
 end;
 
 
 procedure do_rename(p1,p2 : pchar);
 procedure do_rename(p1,p2 : pchar);
 begin
 begin
-  InOutRes:=1;
+  {$ifdef MACOS_USE_STDCLIB}
+  c_rename(p1,p2);
+  Errno2InoutRes;
+  {$else}
+  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
+  {$ifdef MACOS_USE_STDCLIB}
+  len:= C_read(h, pointer(addr), len);
+  Errno2InoutRes;
+
+  // 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;
+
+  {$else}
   InOutRes:=1;
   InOutRes:=1;
-  if h = UnusedHandle then exit;
   if FSread(h, len, Mac_Ptr(addr)) = noErr then
   if FSread(h, len, Mac_Ptr(addr)) = noErr then
-    InOutRes:=0;	//TODO: Is this right ?	
+    InOutRes:=0;	
   do_read:= len;
   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 truncate/rewritten
-  when (flags and $1000) there is no check for close (needed for textfiles)
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  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'}
@@ -402,7 +681,7 @@ begin
 
 
   res:= FSpLocationFromFullPath(StrLen(p), p, spec);
   res:= FSpLocationFromFullPath(StrLen(p), p, spec);
   if (res = noErr) or (res = fnfErr) then
   if (res = noErr) or (res = fnfErr) then
-    begin
+   begin
       if FSpCreate(spec, creator, fileType, smSystemScript) = noErr then
       if FSpCreate(spec, creator, fileType, smSystemScript) = noErr then
         ;
         ;
 
 
@@ -410,7 +689,7 @@ begin
         begin
         begin
           filerec(f).handle:= refNum;
           filerec(f).handle:= refNum;
           InOutRes:=0;
           InOutRes:=0;
-        end;
+   end;
     end;
     end;
 
 
   if (filerec(f).handle=UnusedHandle) then
   if (filerec(f).handle=UnusedHandle) then
@@ -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;
+         begin
+         end;
+
+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
   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 }
+    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 }
-  theHeap:= NewPtr(theHeapSize);
+
+  { Setup heap }
+  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 }
-(*  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);*)
-{ Setup environment and arguments }
+  SysInitStdIO;
+
+  { Setup environment and arguments }
   Setup_Environment;
   Setup_Environment;
-  Setup_Arguments;
-{ Reset IO Error }
+  setup_arguments;
+  { Reset IO Error }
   InOutRes:=0;
   InOutRes:=0;
-
-{$endif}
-
-End.
+  errno:=0;
+{$ifdef HASVARIANT}
+  initvariantmanager;
+{$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
@@ -523,4 +847,4 @@ End.
 
 
   Revision 1.1  2002/10/02 21:34:31  florian
   Revision 1.1  2002/10/02 21:34:31  florian
     * first dummy implementation
     * first dummy implementation
-}
+}