* system unit updated

rtl/macos/Makefile

@@ -1754,4 +1754,4 @@ unixutil$(PPUEXT) : ../unix/unixutil.pp
 	$(COMPILER) ../unix/unixutil.pp $(REDIR)
 charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
 cmem$(PPUEXT) : $(INC)/cmem.pp system$(PPUEXT)
-ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp system$(PPUEXT)

rtl/macos/Makefile.fpc

@@ -151,5 +151,5 @@ unixutil$(PPUEXT) : ../unix/unixutil.pp
 charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
 
 cmem$(PPUEXT) : $(INC)/cmem.pp system$(PPUEXT)
-				
-ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp system$(PPUEXT)

rtl/macos/sysdir.inc

@@ -0,0 +1,134 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit for the Win32 API.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+procedure mkdir(const s:string);[IOCheck];
+var
+  spec: FSSpec;
+  createdDirID: Longint;
+  err: OSErr;
+  res: Integer;
+begin
+  If (s='') or (InOutRes <> 0) then
+    exit;
+
+  res:= PathArgToFSSpec(s, spec);
+  if (res = 0) or (res = 2) then
+    begin
+      err:= FSpDirCreate(spec, smSystemScript, createdDirID);
+      OSErr2InOutRes(err);
+    end
+  else
+    InOutRes:=res;
+end;
+
+procedure rmdir(const s:string);[IOCheck];
+
+var
+  spec: FSSpec;
+  err: OSErr;
+  res: Integer;
+
+begin
+  If (s='') or (InOutRes <> 0) then
+    exit;
+
+  res:= PathArgToFSSpec(s, spec);
+
+  if (res = 0) then
+    begin
+      if IsDirectory(spec) then
+        begin
+          err:= FSpDelete(spec);
+          OSErr2InOutRes(err);
+        end
+      else
+        InOutRes:= 20;
+    end
+  else
+    InOutRes:=res;
+end;
+
+procedure chdir(const s:string);[IOCheck];
+var
+  spec, newDirSpec: FSSpec;
+  err: OSErr;
+  res: Integer;
+begin
+  if (s='') or (InOutRes <> 0) then
+    exit;
+
+  res:= PathArgToFSSpec(s, spec);
+  if (res = 0) or (res = 2) then
+    begin
+      { 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.}
+      err:= FSMakeFSSpec (spec.vRefNum, spec.parID, ':'+spec.name+':x', newDirSpec);
+      if (err = noErr) or (err = fnfErr) then
+        begin
+          workingDirectorySpec:= newDirSpec;
+          workingDirectorySpec.name:='';
+          InOutRes:= 0;
+        end
+      else
+        begin
+          {E g if the directory doesn't exist.}
+          OSErr2InOutRes(err);
+        end;
+    end
+  else
+    InOutRes:=res;
+end;
+
+procedure getDir (DriveNr: byte; var Dir: ShortString);
+
+var
+  fullPath: AnsiString;
+  pathHandleSize: Longint;
+
+begin
+  if FSpGetFullPath(workingDirectorySpec, fullPath, false) <> noErr then
+    Halt(3);  {exit code 3 according to MPW}
+
+  if Length(fullPath) <= 255 then {because dir is ShortString}
+    InOutRes := 0
+  else
+    InOutRes := 1; //TODO Exchange to something better
+
+  dir:= fullPath;
+end;
+
+
+
+{
+  $Log$
+  Revision 1.1  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.1  2005/02/06 16:57:18  peter
+    * threads for go32v2,os,emx,netware
+
+  Revision 1.1  2005/02/06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/macos/sysfile.inc

@@ -0,0 +1,367 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Low leve file functions
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                          Low Level File Routines
+ ****************************************************************************}
+
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice:=false;
+end;
+
+{ close a file from the handle value }
+procedure do_close(h : longint);
+var
+  err: OSErr;
+{No error handling, according to the other targets, which seems reasonable,
+because close might be used to clean up after an error.}
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  c_close(h);
+  // Errno2InOutRes;
+  {$else}
+  err:= FSClose(h);
+  // OSErr2InOutRes(err);
+  {$endif}
+end;
+
+procedure do_erase(p : pchar);
+
+var
+  spec: FSSpec;
+  err: OSErr;
+  res: Integer;
+
+begin
+  res:= PathArgToFSSpec(p, spec);
+  if (res = 0) then
+    begin
+      if not IsDirectory(spec) then
+        begin
+          err:= FSpDelete(spec);
+          OSErr2InOutRes(err);
+        end
+      else
+        InOutRes:= 2;
+    end
+  else
+    InOutRes:=res;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+var
+  s1,s2: AnsiString;
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  InOutRes:= PathArgToFullPath(p1, s1);
+  if InOutRes <> 0 then
+    exit;
+  InOutRes:= PathArgToFullPath(p2, s2);
+  if InOutRes <> 0 then
+    exit;
+  c_rename(PChar(s1),PChar(s2));
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  {$endif}
+end;
+
+function do_write(h:longint;addr:pointer;len : longint) : longint;
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  do_write:= c_write(h, addr, len);
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
+    InOutRes:=0;
+  do_write:= len;
+  {$endif}
+end;
+
+function do_read(h:longint;addr:pointer;len : longint) : longint;
+
+var
+  i: Longint;
+
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  len:= c_read(h, addr, len);
+  Errno2InoutRes;
+
+  do_read:= len;
+
+  {$else}
+  InOutRes:=1;
+  if FSread(h, len, Mac_Ptr(addr)) = noErr then
+    InOutRes:=0;
+  do_read:= len;
+  {$endif}
+end;
+
+function do_filepos(handle : longint) : longint;
+
+var
+  pos: Longint;
+
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  {This returns the filepos without moving it.}
+  do_filepos := lseek(handle, 0, SEEK_CUR);
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  if GetFPos(handle, pos) = noErr then
+    InOutRes:=0;
+  do_filepos:= pos;
+  {$endif}
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  lseek(handle, pos, SEEK_SET);
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  if SetFPos(handle, fsFromStart, pos) = noErr then
+    InOutRes:=0;
+  {$endif}
+end;
+
+function do_seekend(handle:longint):longint;
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  do_seekend:= lseek(handle, 0, SEEK_END);
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  if SetFPos(handle, fsFromLEOF, 0) = noErr then
+    InOutRes:=0;
+  {TODO Resulting file position is to be returned.}
+  {$endif}
+end;
+
+function do_filesize(handle : longint) : longint;
+
+var
+  aktfilepos: Longint;
+
+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;
+  if GetEOF(handle, pos) = noErr then
+    InOutRes:=0;
+  do_filesize:= pos;
+  {$endif}
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+  {$ifdef MACOS_USE_STDCLIB}
+  ioctl(handle, FIOSETEOF, pointer(pos));
+  Errno2InoutRes;
+  {$else}
+  InOutRes:=1;
+  do_seek(handle,pos);  //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
+  if SetEOF(handle, pos) = noErr then
+    InOutRes:=0;
+  {$endif}
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  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
+  scriptTag: ScriptCode;
+  refNum: Integer;
+
+  err: OSErr;
+  res: Integer;
+  spec: FSSpec;
+
+  fh: Longint;
+
+  oflags : longint;
+  fullPath: AnsiString;
+
+  finderInfo: FInfo;
+
+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
+  else
+    begin
+      InOutRes:= PathArgToFSSpec(p, spec);
+      if (InOutRes = 0) or (InOutRes = 2) then
+        begin
+          err:= FSpGetFullPath(spec, fullPath, false);
+          InOutRes:= MacOSErr2RTEerr(err);
+        end;
+
+      if InOutRes <> 0 then
+        exit;
+
+      p:= PChar(fullPath);
+    end;
+
+
+  fh:= c_open(p, oflags);
+  if (fh = -1) and (errno = Sys_EROFS) and ((oflags and O_RDWR)<>0) then
+    begin
+      oflags:=oflags and not(O_RDWR);
+      fh:= c_open(p, oflags);
+    end;
+  Errno2InOutRes;
+  if fh <> -1 then
+    begin
+      if FileRec(f).mode in [fmoutput, fminout, fmappend] then
+        begin
+          {Change of filetype and creator is always done when a file is opened
+          for some kind of writing. This ensures overwritten Darwin files will 
+          get apropriate filetype. It must be done after file is opened,
+          in the case the file did not previously exist.}
+
+          FSpGetFInfo(spec, finderInfo);
+          finderInfo.fdType:= defaultFileType;
+          finderInfo.fdCreator:= defaultCreator;
+          FSpSetFInfo(spec, finderInfo);
+        end;
+      filerec(f).handle:= fh;
+    end
+  else
+    filerec(f).handle:= UnusedHandle;
+
+  {$else}
+
+  InOutRes:=1;
+
+  { reset file handle }
+  filerec(f).handle:=UnusedHandle;
+
+  res:= FSpLocationFromFullPath(StrLen(p), p, spec);
+  if (res = noErr) or (res = fnfErr) then
+    begin
+      if FSpCreate(spec, defaultCreator, defaultFileType, smSystemScript) = noErr then
+        ;
+
+      if FSpOpenDF(spec, fsCurPerm, refNum) = noErr then
+        begin
+          filerec(f).handle:= refNum;
+          InOutRes:=0;
+        end;
+    end;
+
+  if (filerec(f).handle=UnusedHandle) then
+    begin
+      //errno:=GetLastError;
+      //Errno2InoutRes;
+    end;
+  {$endif}
+end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/macos/sysheap.inc

@@ -0,0 +1,52 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if failed }
+function SysOSAlloc(size: ptrint): pointer;
+begin
+  result := NewPtr(size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+  DisposePtr(p);
+end;
+
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/macos/sysos.inc

@@ -0,0 +1,198 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*********************** MacOS API *********************}
+
+{This implementation uses StdCLib: }
+{$define MACOS_USE_STDCLIB}
+
+{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
+as an include file and not a unit.}
+
+{The reason StdCLib is used is that it can easily be connected
+to either SIOW or, in case of MPWTOOL, to MPW }
+
+{If the Apples Universal Interfaces are used, the qd variable is required
+to be allocated somewhere, so we do it here for the convenience to the user.}
+
+var
+  qd: QDGlobals; cvar;
+
+
+{$ifdef MACOS_USE_STDCLIB}
+
+{************** 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 }
+
+{$endif}
+
+
+{*********************** Macutils *********************}
+
+{And also include the same utilities as in the macutils.pp unit.}
+
+var
+  {emulated working directory}
+  workingDirectorySpec: FSSpec; cvar;
+  {Also declared in macutils.pp as external. Declared here to be available
+   to macutils.inc and below in this file.}
+
+{$I macutils.inc}
+
+{******************************************************}
+
+function GetAppFileLocation (var spec: FSSpec): Boolean;
+{Requires >= System 7}
+
+  var
+   PSN: ProcessSerialNumber;
+   info: ProcessInfoRec;
+   appFileRefNum: Integer;
+   appName: Str255;
+   dummy: Mac_Handle;
+
+begin
+  begin
+    PSN.highLongOfPSN := 0;
+    PSN.lowLongOfPSN := kCurrentProcess;
+    info.processInfoLength := SizeOf(info);
+    info.processName := nil;
+    info.processAppSpec := @spec;
+    if GetProcessInformation(PSN, info) = noErr then
+      begin
+        spec.name := '';
+        GetAppFileLocation := true;
+      end
+    else
+      GetAppFileLocation := false;
+  end
+end;
+
+Procedure Errno2InOutRes;
+{
+  Convert ErrNo error to the correct InOutRes value.
+  It seems that some of the errno is, in macos,
+  used for other purposes than its original definition.
+}
+
+begin
+  if errno = 0 then { Else it will go through all the cases }
+    exit;
+  case Errno of
+   Sys_ENFILE,
+   Sys_EMFILE : Inoutres:=4;
+   Sys_ENOENT : Inoutres:=2;
+    Sys_EBADF : Inoutres:=6;
+   Sys_ENOMEM,
+   Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
+   Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
+   Sys_EAGAIN,
+   Sys_ENOSPC : Inoutres:=101;
+  Sys_ENOTDIR : Inoutres:=3;
+    Sys_EPERM,
+    Sys_EROFS,
+   Sys_EEXIST,
+   Sys_EISDIR,
+    Sys_EINTR,  //Happens when attempt to rename a file fails
+    Sys_EBUSY,  //Happens when attempt to remove a locked file
+   Sys_EACCES,
+   Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
+    Sys_ENXIO : InOutRes:=152;
+   Sys_ESPIPE : InOutRes:=156; //Illegal seek
+  else
+    InOutRes := Integer(errno);//TODO Exchange to something better
+  end;
+  errno:=0;
+end;
+
+Procedure OSErr2InOutRes(err: OSErr);
+begin
+  InOutRes:= MacOSErr2RTEerr(err);
+end;
+
+function FSpLocationFromFullPath(fullPathLength: Integer;
+  fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
+
+var
+  alias: AliasHandle;
+  res: OSErr;
+  wasChanged: Boolean;
+  nullString: Str32;
+
+begin
+  nullString:= '';
+  res:= NewAliasMinimalFromFullPath(fullPathLength,
+             fullPath, nullString, nullString, alias);
+  if res = noErr then
+    begin
+      res:= ResolveAlias(nil, alias, spec, wasChanged);
+      DisposeHandle(Mac_Handle(alias));
+    end;
+  FSpLocationFromFullPath:= res;
+end;
+
+{*****************************************************************************
+                              MacOS specific functions
+*****************************************************************************}
+var
+  defaultCreator: OSType =  $4D505320; {'MPS '   MPW Shell}
+  //defaultCreator: OSType =  $74747874; {'ttxt'   Simple Text}
+  defaultFileType: OSType = $54455854; {'TEXT'}
+
+procedure Yield;
+
+begin
+  if StandAlone = 0 then
+    SpinCursor(1);
+end;
+
+procedure SetDefaultMacOSFiletype(ftype: ShortString);
+
+begin
+  if Length(ftype) = 4 then
+    defaultFileType:= PLongWord(@ftype[1])^;
+end;
+
+procedure SetDefaultMacOSCreator(creator: ShortString);
+
+begin
+  if Length(creator) = 4 then
+    defaultCreator:= PLongWord(@creator[1])^;
+end;
+
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/macos/sysosh.inc

@@ -0,0 +1,46 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = Int64;
+{$else CPU64}
+  THandle = Longint;
+{$endif CPU64}
+
+     PRTLCriticalSection = ^TRTLCriticalSection;
+     TRTLCriticalSection = record
+       Locked: boolean
+     end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/macos/system.pp

@@ -20,14 +20,6 @@ interface
 { include system-independent routine headers }
 {$I systemh.inc}
 
-{Platform specific information}
-type
-{$ifdef CPU64}
-  THandle = Int64;
-{$else CPU64}
-  THandle = Longint;
-{$endif CPU64}
-
 const
  LineEnding = #13;
  LFNSupport = true;
@@ -38,9 +30,6 @@ const
 
  maxExitCode = 65535;
 
-{ include heap support headers }
-{$I heaph.inc}
-
 const
 { Default filehandles }
   UnusedHandle    : Longint = -1;
@@ -187,171 +176,6 @@ Perhaps handle readonly filesystems, as in sysunix.inc
 {$I system.inc}
 
 
-{*********************** MacOS API *********************}
-
-{This implementation uses StdCLib: }
-{$define MACOS_USE_STDCLIB}
-
-{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
-as an include file and not a unit.}
-
-{The reason StdCLib is used is that it can easily be connected
-to either SIOW or, in case of MPWTOOL, to MPW }
-
-{If the Apples Universal Interfaces are used, the qd variable is required
-to be allocated somewhere, so we do it here for the convenience to the user.}
-
-var
-  qd: QDGlobals; cvar;
-
-
-{$ifdef MACOS_USE_STDCLIB}
-
-{************** 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 }
-
-{$endif}
-
-
-{*********************** Macutils *********************}
-
-{And also include the same utilities as in the macutils.pp unit.}
-
-var
-  {emulated working directory}
-  workingDirectorySpec: FSSpec; cvar;
-  {Also declared in macutils.pp as external. Declared here to be available
-   to macutils.inc and below in this file.}
-
-{$I macutils.inc}
-
-{******************************************************}
-
-function GetAppFileLocation (var spec: FSSpec): Boolean;
-{Requires >= System 7}
-
-  var
-   PSN: ProcessSerialNumber;
-   info: ProcessInfoRec;
-   appFileRefNum: Integer;
-   appName: Str255;
-   dummy: Mac_Handle;
-
-begin
-  begin
-    PSN.highLongOfPSN := 0;
-    PSN.lowLongOfPSN := kCurrentProcess;
-    info.processInfoLength := SizeOf(info);
-    info.processName := nil;
-    info.processAppSpec := @spec;
-    if GetProcessInformation(PSN, info) = noErr then
-      begin
-        spec.name := '';
-        GetAppFileLocation := true;
-      end
-    else
-      GetAppFileLocation := false;
-  end
-end;
-
-Procedure Errno2InOutRes;
-{
-  Convert ErrNo error to the correct InOutRes value.
-  It seems that some of the errno is, in macos,
-  used for other purposes than its original definition.
-}
-
-begin
-  if errno = 0 then { Else it will go through all the cases }
-    exit;
-  case Errno of
-   Sys_ENFILE,
-   Sys_EMFILE : Inoutres:=4;
-   Sys_ENOENT : Inoutres:=2;
-    Sys_EBADF : Inoutres:=6;
-   Sys_ENOMEM,
-   Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
-   Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
-   Sys_EAGAIN,
-   Sys_ENOSPC : Inoutres:=101;
-  Sys_ENOTDIR : Inoutres:=3;
-    Sys_EPERM,
-    Sys_EROFS,
-   Sys_EEXIST,
-   Sys_EISDIR,
-    Sys_EINTR,  //Happens when attempt to rename a file fails
-    Sys_EBUSY,  //Happens when attempt to remove a locked file
-   Sys_EACCES,
-   Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
-    Sys_ENXIO : InOutRes:=152;
-   Sys_ESPIPE : InOutRes:=156; //Illegal seek
-  else
-    InOutRes := Integer(errno);//TODO Exchange to something better
-  end;
-  errno:=0;
-end;
-
-Procedure OSErr2InOutRes(err: OSErr);
-begin
-  InOutRes:= MacOSErr2RTEerr(err);
-end;
-
-function FSpLocationFromFullPath(fullPathLength: Integer;
-  fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
-
-var
-  alias: AliasHandle;
-  res: OSErr;
-  wasChanged: Boolean;
-  nullString: Str32;
-
-begin
-  nullString:= '';
-  res:= NewAliasMinimalFromFullPath(fullPathLength,
-             fullPath, nullString, nullString, alias);
-  if res = noErr then
-    begin
-      res:= ResolveAlias(nil, alias, spec, wasChanged);
-      DisposeHandle(Mac_Handle(alias));
-    end;
-  FSpLocationFromFullPath:= res;
-end;
-
-{*****************************************************************************
-                              MacOS specific functions
-*****************************************************************************}
-var
-  defaultCreator: OSType =  $4D505320; {'MPS '   MPW Shell}
-  //defaultCreator: OSType =  $74747874; {'ttxt'   Simple Text}
-  defaultFileType: OSType = $54455854; {'TEXT'}
-
-procedure Yield;
-
-begin
-  if StandAlone = 0 then
-    SpinCursor(1);
-end;
-
-procedure SetDefaultMacOSFiletype(ftype: ShortString);
-
-begin
-  if Length(ftype) = 4 then
-    defaultFileType:= PLongWord(@ftype[1])^;
-end;
-
-procedure SetDefaultMacOSCreator(creator: ShortString);
-
-begin
-  if Length(creator) = 4 then
-    defaultCreator:= PLongWord(@creator[1])^;
-end;
-
-
 {*****************************************************************************
                               ParamStr/Randomize
 *****************************************************************************}
@@ -379,486 +203,6 @@ begin
 end;
 
 
-{*****************************************************************************
-      OS Memory allocation / deallocation
- ****************************************************************************}
-
-{ function to allocate size bytes more for the program }
-{ must return the first address of new data space or nil if failed }
-function SysOSAlloc(size: ptrint): pointer;
-begin
-  result := NewPtr(size);
-end;
-
-{$define HAS_SYSOSFREE}
-
-procedure SysOSFree(p: pointer; size: ptrint);
-begin
-  DisposePtr(p);
-end;
-
-
-{ include standard heap management }
-{$I heap.inc}
-
-{*****************************************************************************
-                          Low Level File Routines
- ****************************************************************************}
-
-function do_isdevice(handle:longint):boolean;
-begin
-  do_isdevice:=false;
-end;
-
-{ close a file from the handle value }
-procedure do_close(h : longint);
-var
-  err: OSErr;
-{No error handling, according to the other targets, which seems reasonable,
-because close might be used to clean up after an error.}
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  c_close(h);
-  // Errno2InOutRes;
-  {$else}
-  err:= FSClose(h);
-  // OSErr2InOutRes(err);
-  {$endif}
-end;
-
-procedure do_erase(p : pchar);
-
-var
-  spec: FSSpec;
-  err: OSErr;
-  res: Integer;
-
-begin
-  res:= PathArgToFSSpec(p, spec);
-  if (res = 0) then
-    begin
-      if not IsDirectory(spec) then
-        begin
-          err:= FSpDelete(spec);
-          OSErr2InOutRes(err);
-        end
-      else
-        InOutRes:= 2;
-    end
-  else
-    InOutRes:=res;
-end;
-
-procedure do_rename(p1,p2 : pchar);
-var
-  s1,s2: AnsiString;
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  InOutRes:= PathArgToFullPath(p1, s1);
-  if InOutRes <> 0 then
-    exit;
-  InOutRes:= PathArgToFullPath(p2, s2);
-  if InOutRes <> 0 then
-    exit;
-  c_rename(PChar(s1),PChar(s2));
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  {$endif}
-end;
-
-function do_write(h:longint;addr:pointer;len : longint) : longint;
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  do_write:= c_write(h, addr, len);
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
-    InOutRes:=0;
-  do_write:= len;
-  {$endif}
-end;
-
-function do_read(h:longint;addr:pointer;len : longint) : longint;
-
-var
-  i: Longint;
-
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  len:= c_read(h, addr, len);
-  Errno2InoutRes;
-
-  do_read:= len;
-
-  {$else}
-  InOutRes:=1;
-  if FSread(h, len, Mac_Ptr(addr)) = noErr then
-    InOutRes:=0;
-  do_read:= len;
-  {$endif}
-end;
-
-function do_filepos(handle : longint) : longint;
-
-var
-  pos: Longint;
-
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  {This returns the filepos without moving it.}
-  do_filepos := lseek(handle, 0, SEEK_CUR);
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  if GetFPos(handle, pos) = noErr then
-    InOutRes:=0;
-  do_filepos:= pos;
-  {$endif}
-end;
-
-procedure do_seek(handle,pos : longint);
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  lseek(handle, pos, SEEK_SET);
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  if SetFPos(handle, fsFromStart, pos) = noErr then
-    InOutRes:=0;
-  {$endif}
-end;
-
-function do_seekend(handle:longint):longint;
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  do_seekend:= lseek(handle, 0, SEEK_END);
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  if SetFPos(handle, fsFromLEOF, 0) = noErr then
-    InOutRes:=0;
-  {TODO Resulting file position is to be returned.}
-  {$endif}
-end;
-
-function do_filesize(handle : longint) : longint;
-
-var
-  aktfilepos: Longint;
-
-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;
-  if GetEOF(handle, pos) = noErr then
-    InOutRes:=0;
-  do_filesize:= pos;
-  {$endif}
-end;
-
-{ truncate at a given position }
-procedure do_truncate (handle,pos:longint);
-begin
-  {$ifdef MACOS_USE_STDCLIB}
-  ioctl(handle, FIOSETEOF, pointer(pos));
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  do_seek(handle,pos);  //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
-  if SetEOF(handle, pos) = noErr then
-    InOutRes:=0;
-  {$endif}
-end;
-
-procedure do_open(var f;p:pchar;flags:longint);
-{
-  filerec and textrec have both handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  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
-  scriptTag: ScriptCode;
-  refNum: Integer;
-
-  err: OSErr;
-  res: Integer;
-  spec: FSSpec;
-
-  fh: Longint;
-
-  oflags : longint;
-  fullPath: AnsiString;
-
-  finderInfo: FInfo;
-
-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
-  else
-    begin
-      InOutRes:= PathArgToFSSpec(p, spec);
-      if (InOutRes = 0) or (InOutRes = 2) then
-        begin
-          err:= FSpGetFullPath(spec, fullPath, false);
-          InOutRes:= MacOSErr2RTEerr(err);
-        end;
-
-      if InOutRes <> 0 then
-        exit;
-
-      p:= PChar(fullPath);
-    end;
-
-
-  fh:= c_open(p, oflags);
-  if (fh = -1) and (errno = Sys_EROFS) and ((oflags and O_RDWR)<>0) then
-    begin
-      oflags:=oflags and not(O_RDWR);
-      fh:= c_open(p, oflags);
-    end;
-  Errno2InOutRes;
-  if fh <> -1 then
-    begin
-      if FileRec(f).mode in [fmoutput, fminout, fmappend] then
-        begin
-          {Change of filetype and creator is always done when a file is opened
-          for some kind of writing. This ensures overwritten Darwin files will 
-          get apropriate filetype. It must be done after file is opened,
-          in the case the file did not previously exist.}
-
-          FSpGetFInfo(spec, finderInfo);
-          finderInfo.fdType:= defaultFileType;
-          finderInfo.fdCreator:= defaultCreator;
-          FSpSetFInfo(spec, finderInfo);
-        end;
-      filerec(f).handle:= fh;
-    end
-  else
-    filerec(f).handle:= UnusedHandle;
-
-  {$else}
-
-  InOutRes:=1;
-
-  { reset file handle }
-  filerec(f).handle:=UnusedHandle;
-
-  res:= FSpLocationFromFullPath(StrLen(p), p, spec);
-  if (res = noErr) or (res = fnfErr) then
-    begin
-      if FSpCreate(spec, defaultCreator, defaultFileType, smSystemScript) = noErr then
-        ;
-
-      if FSpOpenDF(spec, fsCurPerm, refNum) = noErr then
-        begin
-          filerec(f).handle:= refNum;
-          InOutRes:=0;
-        end;
-    end;
-
-  if (filerec(f).handle=UnusedHandle) then
-    begin
-      //errno:=GetLastError;
-      //Errno2InoutRes;
-    end;
-  {$endif}
-end;
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{ #26 is not end of a file in MacOS ! }
-
-{$i text.inc}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-procedure mkdir(const s:string);[IOCheck];
-var
-  spec: FSSpec;
-  createdDirID: Longint;
-  err: OSErr;
-  res: Integer;
-begin
-  If (s='') or (InOutRes <> 0) then
-    exit;
-
-  res:= PathArgToFSSpec(s, spec);
-  if (res = 0) or (res = 2) then
-    begin
-      err:= FSpDirCreate(spec, smSystemScript, createdDirID);
-      OSErr2InOutRes(err);
-    end
-  else
-    InOutRes:=res;
-end;
-
-procedure rmdir(const s:string);[IOCheck];
-
-var
-  spec: FSSpec;
-  err: OSErr;
-  res: Integer;
-
-begin
-  If (s='') or (InOutRes <> 0) then
-    exit;
-
-  res:= PathArgToFSSpec(s, spec);
-
-  if (res = 0) then
-    begin
-      if IsDirectory(spec) then
-        begin
-          err:= FSpDelete(spec);
-          OSErr2InOutRes(err);
-        end
-      else
-        InOutRes:= 20;
-    end
-  else
-    InOutRes:=res;
-end;
-
-procedure chdir(const s:string);[IOCheck];
-var
-  spec, newDirSpec: FSSpec;
-  err: OSErr;
-  res: Integer;
-begin
-  if (s='') or (InOutRes <> 0) then
-    exit;
-
-  res:= PathArgToFSSpec(s, spec);
-  if (res = 0) or (res = 2) then
-    begin
-      { 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.}
-      err:= FSMakeFSSpec (spec.vRefNum, spec.parID, ':'+spec.name+':x', newDirSpec);
-      if (err = noErr) or (err = fnfErr) then
-        begin
-          workingDirectorySpec:= newDirSpec;
-          workingDirectorySpec.name:='';
-          InOutRes:= 0;
-        end
-      else
-        begin
-          {E g if the directory doesn't exist.}
-          OSErr2InOutRes(err);
-        end;
-    end
-  else
-    InOutRes:=res;
-end;
-
-procedure getDir (DriveNr: byte; var Dir: ShortString);
-
-var
-  fullPath: AnsiString;
-  pathHandleSize: Longint;
-
-begin
-  if FSpGetFullPath(workingDirectorySpec, fullPath, false) <> noErr then
-    Halt(3);  {exit code 3 according to MPW}
-
-  if Length(fullPath) <= 255 then {because dir is ShortString}
-    InOutRes := 0
-  else
-    InOutRes := 1; //TODO Exchange to something better
-
-  dir:= fullPath;
-end;
-
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
@@ -1191,9 +535,7 @@ begin
   { Reset IO Error }
   InOutRes:=0;
   errno:=0;
-(* This should be changed to a real value during *)
-(* thread driver initialization if appropriate.  *)
-  ThreadID := 1;
+  InitSystemThreads;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}
@@ -1212,7 +554,10 @@ end.
 
 {
   $Log$
-  Revision 1.28  2005-02-01 20:22:49  florian
+  Revision 1.29  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.28  2005/02/01 20:22:49  florian
     * improved widestring infrastructure manager
 
   Revision 1.27  2005/01/24 18:51:23  olle

rtl/macos/systhrd.inc

@@ -0,0 +1,42 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Peter Vreman,
+    member of the Free Pascal development team.
+
+    Linux (pthreads) threading support implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+  { This should be changed to a real value during
+    thread driver initialization if appropriate. }
+  ThreadID := 1;
+  SetNoThreadManager;
+end;
+
+{
+  $Log$
+  Revision 1.1  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.1  2005/02/06 16:57:18  peter
+    * threads for go32v2,os,emx,netware
+
+  Revision 1.1  2005/02/06 12:16:52  peter
+    * bsd thread updates
+
+  Revision 1.1  2005/02/06 11:20:52  peter
+    * threading in system unit
+    * removed systhrds unit
+
+}
+

rtl/morphos/Makefile

@@ -245,103 +245,103 @@ endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-sunos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),sparc-sunos)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconst sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_LOADERS+=prt0
@@ -1968,7 +1968,6 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
 		   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
-systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
 math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)

rtl/morphos/Makefile.fpc

@@ -7,7 +7,7 @@ main=rtl
 
 [target]
 loaders=prt0
-units=$(SYSTEMUNIT) systhrds objpas macpas strings \
+units=$(SYSTEMUNIT) objpas macpas strings \
       dos \
       sysutils classes math typinfo varutils \
       charset ucomplex getopts matrix \
@@ -123,8 +123,6 @@ classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
                    sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
         $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
 
-systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
-
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
 

rtl/morphos/sysdir.inc

@@ -0,0 +1,110 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit for the Win32 API.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+var
+  tmpStr : array[0..255] of char;
+  tmpLock: LongInt;
+begin
+  checkCTRLC;
+  if (s='') or (InOutRes<>0) then exit;
+  tmpStr:=PathConv(s)+#0;
+  tmpLock:=dosCreateDir(@tmpStr);
+  if tmpLock=0 then begin
+    dosError2InOut(IoErr);
+    exit;
+  end;
+  UnLock(tmpLock);
+end;
+
+procedure rmdir(const s : string);[IOCheck];
+var
+  tmpStr : array[0..255] of Char;
+begin
+  checkCTRLC;
+  if (s='.') then InOutRes:=16;
+  If (s='') or (InOutRes<>0) then exit;
+  tmpStr:=PathConv(s)+#0;
+  if not dosDeleteFile(@tmpStr) then
+    dosError2InOut(IoErr);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+var
+  tmpStr : array[0..255] of Char;
+  tmpLock: LongInt;
+  FIB    : PFileInfoBlock;
+begin
+  checkCTRLC;
+  If (s='') or (InOutRes<>0) then exit;
+  tmpStr:=PathConv(s)+#0;
+  tmpLock:=0;
+
+  { Changing the directory is a pretty complicated affair }
+  {   1) Obtain a lock on the directory                   }
+  {   2) CurrentDir the lock                              }
+  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+  if tmpLock=0 then begin
+    dosError2InOut(IoErr);
+    exit;
+  end;
+
+  FIB:=nil;
+  new(FIB);
+
+  if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
+    tmpLock:=CurrentDir(tmpLock);
+    if MOS_OrigDir=0 then begin
+      MOS_OrigDir:=tmpLock;
+      tmpLock:=0;
+    end;
+  end;
+
+  if tmpLock<>0 then Unlock(tmpLock);
+  if assigned(FIB) then dispose(FIB);
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+var tmpbuf: array[0..255] of char;
+begin
+  checkCTRLC;
+  Dir:='';
+  if not GetCurrentDirName(tmpbuf,256) then
+    dosError2InOut(IoErr)
+  else
+    Dir:=strpas(tmpbuf);
+end;
+
+
+
+{
+  $Log$
+  Revision 1.1  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.1  2005/02/06 16:57:18  peter
+    * threads for go32v2,os,emx,netware
+
+  Revision 1.1  2005/02/06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/morphos/sysfile.inc

@@ -0,0 +1,334 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Low leve file functions
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                  MorphOS File-handling Support Functions
+*****************************************************************************}
+type
+  { AmigaOS does not automatically close opened files on exit back to  }
+  { the operating system, therefore as a precuation we close all files }
+  { manually on exit.                                                  }
+  PFileList = ^TFileList;
+  TFileList = record { no packed, must be correctly aligned }
+    handle : LongInt;      { Handle to file    }
+    next   : PFileList;    { Next file in list }
+  end;
+
+var
+  MOS_fileList: PFileList; public name 'MOS_FILELIST'; { List pointer to opened files }
+
+{ Function to be called at program shutdown, to close all opened files }
+procedure CloseList(l: PFileList);
+var
+  tmpNext   : PFileList;
+  tmpHandle : LongInt;
+begin
+  if l=nil then exit;
+
+  { First, close all tracked files }
+  tmpNext:=l^.next;
+  while tmpNext<>nil do begin
+    tmpHandle:=tmpNext^.handle;
+    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;
+    l:=l^.next;
+    dispose(tmpNext);
+  end;
+end;
+
+{ Function to be called to add a file to the opened file list }
+procedure AddToList(var l: PFileList; h: LongInt); alias: 'ADDTOLIST'; [public];
+var
+  p     : PFileList;
+  inList: Boolean;
+begin
+  inList:=False;
+  if l<>nil then begin
+    { if there is a valid filelist, search for the value }
+    { in the list to avoid double additions }
+    p:=l;
+    while (p^.next<>nil) and (not inList) do
+      if p^.next^.handle=h then inList:=True
+                           else p:=p^.next;
+    p:=nil;
+  end else begin
+    { if the list is not yet allocated, allocate it. }
+    New(l);
+    l^.next:=nil;
+  end;
+
+  if not inList then begin
+    New(p);
+    p^.handle:=h;
+    p^.next:=l^.next;
+    l^.next:=p;
+  end;
+end;
+
+{ Function to be called to remove a file from the list }
+procedure RemoveFromList(var l: PFileList; h: LongInt); alias: 'REMOVEFROMLIST'; [public];
+var
+  p     : PFileList;
+  inList: Boolean;
+begin
+  if l=nil then exit;
+
+  inList:=False;
+  p:=l;
+  while (p^.next<>nil) and (not inList) do
+    if p^.next^.handle=h then inList:=True
+                         else p:=p^.next;
+
+  if p^.next<>nil then begin
+    dispose(p^.next);
+    p^.next:=p^.next^.next;
+  end;
+end;
+
+
+{****************************************************************************
+                        Low level File Routines
+               All these functions can set InOutRes on errors
+****************************************************************************}
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+  if (handle<=0) then exit;
+
+  RemoveFromList(MOS_fileList,handle);
+  { Do _NOT_ check CTRL_C on Close, because it will conflict
+    with System_Exit! }
+  if not dosClose(handle) then
+    dosError2InOut(IoErr);
+end;
+
+procedure do_erase(p : pchar);
+begin
+  checkCTRLC;
+  if not dosDeleteFile(p) then
+    dosError2InOut(IoErr);
+end;
+
+procedure do_rename(p1,p2 : pchar);
+begin
+  checkCTRLC;
+  if not dosRename(p1,p2) then
+    dosError2InOut(IoErr);
+end;
+
+function do_write(h:longint; addr: pointer; len: longint) : longint;
+var dosResult: LongInt;
+begin
+  checkCTRLC;
+  do_write:=0;
+  if (len<=0) or (h<=0) then exit;
+
+  dosResult:=dosWrite(h,addr,len);
+  if dosResult<0 then begin
+    dosError2InOut(IoErr);
+  end else begin
+    do_write:=dosResult;
+  end;
+end;
+
+function do_read(h:longint; addr: pointer; len: longint) : longint;
+var dosResult: LongInt;
+begin
+  checkCTRLC;
+  do_read:=0;
+  if (len<=0) or (h<=0) then exit;
+
+  dosResult:=dosRead(h,addr,len);
+  if dosResult<0 then begin
+    dosError2InOut(IoErr);
+  end else begin
+    do_read:=dosResult;
+  end
+end;
+
+function do_filepos(handle : longint) : longint;
+var dosResult: LongInt;
+begin
+  checkCTRLC;
+  do_filepos:=-1; 
+  if (handle<=0) then exit;
+
+  { Seeking zero from OFFSET_CURRENT to find out where we are }
+  dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
+  if dosResult<0 then begin
+    dosError2InOut(IoErr);
+  end else begin
+    do_filepos:=dosResult;
+  end;
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+  checkCTRLC;
+  if (handle<=0) then exit;
+
+  { Seeking from OFFSET_BEGINNING }
+  if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
+    dosError2InOut(IoErr);
+end;
+
+function do_seekend(handle:longint):longint;
+var dosResult: LongInt;
+begin
+  checkCTRLC;
+  do_seekend:=-1;
+  if (handle<=0) then exit;
+
+  { Seeking to OFFSET_END }
+  dosResult:=dosSeek(handle,0,OFFSET_END);
+  if dosResult<0 then begin
+    dosError2InOut(IoErr);
+  end else begin
+    do_seekend:=dosResult;
+  end
+end;
+
+function do_filesize(handle : longint) : longint;
+var currfilepos: longint;
+begin
+  checkCTRLC;
+  do_filesize:=-1;
+  if (handle<=0) then exit;  
+
+  currfilepos:=do_filepos(handle);
+  { We have to do this twice, because seek returns the OLD position }
+  do_filesize:=do_seekend(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,currfilepos)
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+  checkCTRLC;
+  if (handle<=0) then exit;
+
+  { Seeking from OFFSET_BEGINNING }
+  if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
+    dosError2InOut(IoErr);
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  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)
+}
+var
+  handle   : LongInt;
+  openflags: LongInt;
+  tmpStr   : array[0..255] of Char;
+begin
+  tmpStr:=PathConv(strpas(p))+#0;
+
+  { 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
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+    end;
+  end;
+
+  { reset file handle }
+  filerec(f).handle:=UnusedHandle;
+
+  { convert filemode to filerec modes }
+  { READ/WRITE on existing file }
+  { RESET/APPEND                }
+  openflags:=MODE_OLDFILE;
+  case (flags and 3) of
+    0 : filerec(f).mode:=fminput;
+    1 : filerec(f).mode:=fmoutput;
+    2 : filerec(f).mode:=fminout;
+  end;
+
+  { rewrite (create a new file) }
+  if (flags and $1000)<>0 then openflags:=MODE_NEWFILE;
+
+  { empty name is special }
+  if p[0]=#0 then begin
+    case filerec(f).mode of
+      fminput :
+        filerec(f).handle:=StdInputHandle;
+      fmappend,
+      fmoutput : begin
+        filerec(f).handle:=StdOutputHandle;
+        filerec(f).mode:=fmoutput; {fool fmappend}
+      end;
+    end;
+    exit;
+  end;
+
+  handle:=Open(@tmpStr,openflags);
+  if handle=0 then begin
+    dosError2InOut(IoErr);
+  end else begin
+    AddToList(MOS_fileList,handle);
+    filerec(f).handle:=handle;
+  end;
+
+  { append mode }
+  if ((Flags and $100)<>0) and 
+      (FileRec(F).Handle<>UnusedHandle) then begin
+    do_seekend(filerec(f).handle);
+    filerec(f).mode:=fmoutput; {fool fmappend}
+  end;
+end;
+
+function do_isdevice(handle:longint):boolean;
+begin
+  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
+     (handle=StdErrorHandle) then
+    do_isdevice:=True
+  else
+    do_isdevice:=False;
+end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/morphos/sysheap.inc

@@ -0,0 +1,49 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+  result:=AllocPooled(MOS_heapPool,size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+  FreePooled(MOS_heapPool,p,size);
+end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/morphos/sysos.inc

@@ -0,0 +1,155 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           MorphOS structures
+*****************************************************************************}
+
+{$include execd.inc}
+{$include timerd.inc}
+{$include doslibd.inc}
+
+
+{*****************************************************************************
+                           MorphOS functions
+*****************************************************************************}
+
+{ exec.library functions }
+
+{$include execf.inc}
+{$include doslibf.inc}
+
+
+{*****************************************************************************
+                    System Dependent Structures/Consts
+*****************************************************************************}
+
+const
+  CTRL_C           = 20;      { Error code on CTRL-C press }
+
+{ Used for CTRL_C checking in I/O calls }
+procedure checkCTRLC;
+begin
+  if BreakOn then begin
+    if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
+      { Clear CTRL-C signal }
+      SetSignal(0,SIGBREAKF_CTRL_C);
+      Halt(CTRL_C);
+    end;
+  end;
+end;
+
+
+{ Converts a MorphOS dos.library error code to a TP compatible error code }
+{ Based on 1.0.x Amiga RTL }
+procedure dosError2InOut(errno: LongInt);
+begin
+  case errno of
+    ERROR_BAD_NUMBER,
+    ERROR_ACTION_NOT_KNOWN,
+    ERROR_NOT_IMPLEMENTED : InOutRes := 1;
+
+    ERROR_OBJECT_NOT_FOUND : InOutRes := 2;
+    ERROR_DIR_NOT_FOUND :  InOutRes := 3;
+    ERROR_DISK_WRITE_PROTECTED : InOutRes := 150;
+    ERROR_OBJECT_WRONG_TYPE : InOutRes := 151;
+
+    ERROR_OBJECT_EXISTS,
+    ERROR_DELETE_PROTECTED,
+    ERROR_WRITE_PROTECTED,
+    ERROR_READ_PROTECTED,
+    ERROR_OBJECT_IN_USE,
+    ERROR_DIRECTORY_NOT_EMPTY : InOutRes := 5;
+
+    ERROR_NO_MORE_ENTRIES : InOutRes := 18;
+    ERROR_RENAME_ACROSS_DEVICES : InOutRes := 17;
+    ERROR_DISK_FULL : InOutRes := 101;
+    ERROR_INVALID_RESIDENT_LIBRARY : InoutRes := 153;
+    ERROR_BAD_HUNK : InOutRes := 153;
+    ERROR_NOT_A_DOS_DISK : InOutRes := 157;
+
+    ERROR_NO_DISK,
+    ERROR_DISK_NOT_VALIDATED,
+    ERROR_DEVICE_NOT_MOUNTED : InOutRes := 152;
+
+    ERROR_SEEK_ERROR : InOutRes := 156;
+
+    ERROR_LOCK_COLLISION,
+    ERROR_LOCK_TIMEOUT,
+    ERROR_UNLOCK_ERROR,
+    ERROR_INVALID_LOCK,
+    ERROR_INVALID_COMPONENT_NAME,
+    ERROR_BAD_STREAM_NAME,
+    ERROR_FILE_NOT_OBJECT : InOutRes := 6;
+   else
+    InOutres := errno;
+  end;
+end;
+
+
+{ Converts an Unix-like path to Amiga-like path }
+function PathConv(path: string): string; alias: 'PATHCONV'; [public];
+var tmppos: longint;
+begin
+  { check for short paths }
+  if length(path)<=2 then begin
+    if (path='.') or (path='./') then path:='' else
+    if path='..' then path:='/' else
+    if path='*' then path:='#?';
+  end else begin
+    { convert parent directories }
+    tmppos:=pos('../',path);
+    while tmppos<>0 do begin
+      { delete .. to have / as parent dir sign }
+      delete(path,tmppos,2); 
+      tmppos:=pos('../',path);
+    end;
+    { convert current directories }
+    tmppos:=pos('./',path);
+    while tmppos<>0 do begin
+      { delete ./ since we doesn't need to sign current directory }
+      delete(path,tmppos,2);
+      tmppos:=pos('./',path);
+    end;
+    { convert wildstart to #? }
+    tmppos:=pos('*',path);
+    while tmppos<>0 do begin
+      delete(path,tmppos,1);
+      insert('#?',path,tmppos);
+      tmppos:=pos('*',path);
+    end;
+  end;
+  PathConv:=path;
+end;
+
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/morphos/sysosh.inc

@@ -0,0 +1,46 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = Int64;
+{$else CPU64}
+  THandle = Longint;
+{$endif CPU64}
+
+     PRTLCriticalSection = ^TRTLCriticalSection;
+     TRTLCriticalSection = record
+       Locked: boolean
+     end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-07 21:30:12  peter
+     * system unit updated
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/morphos/system.pp

@@ -28,11 +28,6 @@ interface
 
 {$I systemh.inc}
 
-type
-  THandle = LongInt;
-
-{$I heaph.inc}
-
 const
   LineEnding = #10;
   LFNSupport = True;
@@ -76,126 +71,6 @@ implementation
 {$I system.inc}
 
 
-{*****************************************************************************
-                           MorphOS structures
-*****************************************************************************}
-
-{$include execd.inc}
-{$include timerd.inc}
-{$include doslibd.inc}
-
-
-{*****************************************************************************
-                           MorphOS functions
-*****************************************************************************}
-
-{ exec.library functions }
-
-{$include execf.inc}
-{$include doslibf.inc}
-
-
-{*****************************************************************************
-                    System Dependent Structures/Consts
-*****************************************************************************}
-
-const
-  CTRL_C           = 20;      { Error code on CTRL-C press }
-
-
-{*****************************************************************************
-                  MorphOS File-handling Support Functions
-*****************************************************************************}
-type
-  { AmigaOS does not automatically close opened files on exit back to  }
-  { the operating system, therefore as a precuation we close all files }
-  { manually on exit.                                                  }
-  PFileList = ^TFileList;
-  TFileList = record { no packed, must be correctly aligned }
-    handle : LongInt;      { Handle to file    }
-    next   : PFileList;    { Next file in list }
-  end;
-
-var
-  MOS_fileList: PFileList; public name 'MOS_FILELIST'; { List pointer to opened files }
-
-{ Function to be called at program shutdown, to close all opened files }
-procedure CloseList(l: PFileList);
-var
-  tmpNext   : PFileList;
-  tmpHandle : LongInt;
-begin
-  if l=nil then exit;
-
-  { First, close all tracked files }
-  tmpNext:=l^.next;
-  while tmpNext<>nil do begin
-    tmpHandle:=tmpNext^.handle;
-    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;
-    l:=l^.next;
-    dispose(tmpNext);
-  end;
-end;
-
-{ Function to be called to add a file to the opened file list }
-procedure AddToList(var l: PFileList; h: LongInt); alias: 'ADDTOLIST'; [public];
-var
-  p     : PFileList;
-  inList: Boolean;
-begin
-  inList:=False;
-  if l<>nil then begin
-    { if there is a valid filelist, search for the value }
-    { in the list to avoid double additions }
-    p:=l;
-    while (p^.next<>nil) and (not inList) do
-      if p^.next^.handle=h then inList:=True
-                           else p:=p^.next;
-    p:=nil;
-  end else begin
-    { if the list is not yet allocated, allocate it. }
-    New(l);
-    l^.next:=nil;
-  end;
-
-  if not inList then begin
-    New(p);
-    p^.handle:=h;
-    p^.next:=l^.next;
-    l^.next:=p;
-  end;
-end;
-
-{ Function to be called to remove a file from the list }
-procedure RemoveFromList(var l: PFileList; h: LongInt); alias: 'REMOVEFROMLIST'; [public];
-var
-  p     : PFileList;
-  inList: Boolean;
-begin
-  if l=nil then exit;
-
-  inList:=False;
-  p:=l;
-  while (p^.next<>nil) and (not inList) do
-    if p^.next^.handle=h then inList:=True
-                         else p:=p^.next;
-
-  if p^.next<>nil then begin
-    dispose(p^.next);
-    p^.next:=p^.next^.next;
-  end;
-end;
-
-
 {*****************************************************************************
                        Misc. System Dependent Functions
 *****************************************************************************}
@@ -226,64 +101,6 @@ begin
   haltproc(ExitCode);
 end;
 
-{ Converts a MorphOS dos.library error code to a TP compatible error code }
-{ Based on 1.0.x Amiga RTL }
-procedure dosError2InOut(errno: LongInt);
-begin
-  case errno of
-    ERROR_BAD_NUMBER,
-    ERROR_ACTION_NOT_KNOWN,
-    ERROR_NOT_IMPLEMENTED : InOutRes := 1;
-
-    ERROR_OBJECT_NOT_FOUND : InOutRes := 2;
-    ERROR_DIR_NOT_FOUND :  InOutRes := 3;
-    ERROR_DISK_WRITE_PROTECTED : InOutRes := 150;
-    ERROR_OBJECT_WRONG_TYPE : InOutRes := 151;
-
-    ERROR_OBJECT_EXISTS,
-    ERROR_DELETE_PROTECTED,
-    ERROR_WRITE_PROTECTED,
-    ERROR_READ_PROTECTED,
-    ERROR_OBJECT_IN_USE,
-    ERROR_DIRECTORY_NOT_EMPTY : InOutRes := 5;
-
-    ERROR_NO_MORE_ENTRIES : InOutRes := 18;
-    ERROR_RENAME_ACROSS_DEVICES : InOutRes := 17;
-    ERROR_DISK_FULL : InOutRes := 101;
-    ERROR_INVALID_RESIDENT_LIBRARY : InoutRes := 153;
-    ERROR_BAD_HUNK : InOutRes := 153;
-    ERROR_NOT_A_DOS_DISK : InOutRes := 157;
-
-    ERROR_NO_DISK,
-    ERROR_DISK_NOT_VALIDATED,
-    ERROR_DEVICE_NOT_MOUNTED : InOutRes := 152;
-
-    ERROR_SEEK_ERROR : InOutRes := 156;
-
-    ERROR_LOCK_COLLISION,
-    ERROR_LOCK_TIMEOUT,
-    ERROR_UNLOCK_ERROR,
-    ERROR_INVALID_LOCK,
-    ERROR_INVALID_COMPONENT_NAME,
-    ERROR_BAD_STREAM_NAME,
-    ERROR_FILE_NOT_OBJECT : InOutRes := 6;
-   else
-    InOutres := errno;
-  end;
-end;
-
-{ Used for CTRL_C checking in I/O calls }
-procedure checkCTRLC;
-begin
-  if BreakOn then begin
-    if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
-      { Clear CTRL-C signal }
-      SetSignal(0,SIGBREAKF_CTRL_C);
-      Halt(CTRL_C);
-    end;
-  end;
-end;
-
 { Generates correct argument array on startup }
 procedure GenerateArgs;
 var
@@ -393,42 +210,6 @@ begin
   end;
 end;
 
-{ Converts an Unix-like path to Amiga-like path }
-function PathConv(path: string): string; alias: 'PATHCONV'; [public];
-var tmppos: longint;
-begin
-  { check for short paths }
-  if length(path)<=2 then begin
-    if (path='.') or (path='./') then path:='' else
-    if path='..' then path:='/' else
-    if path='*' then path:='#?';
-  end else begin
-    { convert parent directories }
-    tmppos:=pos('../',path);
-    while tmppos<>0 do begin
-      { delete .. to have / as parent dir sign }
-      delete(path,tmppos,2); 
-      tmppos:=pos('../',path);
-    end;
-    { convert current directories }
-    tmppos:=pos('./',path);
-    while tmppos<>0 do begin
-      { delete ./ since we doesn't need to sign current directory }
-      delete(path,tmppos,2);
-      tmppos:=pos('./',path);
-    end;
-    { convert wildstart to #? }
-    tmppos:=pos('*',path);
-    while tmppos<>0 do begin
-      delete(path,tmppos,1);
-      insert('#?',path,tmppos);
-      tmppos:=pos('*',path);
-    end;
-  end;
-  PathConv:=path;
-end;
-
-
 
 {*****************************************************************************
                              ParamStr/Randomize
@@ -469,332 +250,6 @@ begin
 end;
 
 
-{*****************************************************************************
-      OS Memory allocation / deallocation
- ****************************************************************************}
-
-function SysOSAlloc(size: ptrint): pointer;
-begin
-  result:=AllocPooled(MOS_heapPool,size);
-end;
-
-{$define HAS_SYSOSFREE}
-
-procedure SysOSFree(p: pointer; size: ptrint);
-begin
-  FreePooled(MOS_heapPool,p,size);
-end;
-
-{$I heap.inc}
-
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-procedure mkdir(const s : string);[IOCheck];
-var
-  tmpStr : array[0..255] of char;
-  tmpLock: LongInt;
-begin
-  checkCTRLC;
-  if (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
-  tmpLock:=dosCreateDir(@tmpStr);
-  if tmpLock=0 then begin
-    dosError2InOut(IoErr);
-    exit;
-  end;
-  UnLock(tmpLock);
-end;
-
-procedure rmdir(const s : string);[IOCheck];
-var
-  tmpStr : array[0..255] of Char;
-begin
-  checkCTRLC;
-  if (s='.') then InOutRes:=16;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
-  if not dosDeleteFile(@tmpStr) then
-    dosError2InOut(IoErr);
-end;
-
-procedure chdir(const s : string);[IOCheck];
-var
-  tmpStr : array[0..255] of Char;
-  tmpLock: LongInt;
-  FIB    : PFileInfoBlock;
-begin
-  checkCTRLC;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
-  tmpLock:=0;
-
-  { Changing the directory is a pretty complicated affair }
-  {   1) Obtain a lock on the directory                   }
-  {   2) CurrentDir the lock                              }
-  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
-  if tmpLock=0 then begin
-    dosError2InOut(IoErr);
-    exit;
-  end;
-
-  FIB:=nil;
-  new(FIB);
-
-  if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
-    tmpLock:=CurrentDir(tmpLock);
-    if MOS_OrigDir=0 then begin
-      MOS_OrigDir:=tmpLock;
-      tmpLock:=0;
-    end;
-  end;
-
-  if tmpLock<>0 then Unlock(tmpLock);
-  if assigned(FIB) then dispose(FIB);
-end;
-
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-var tmpbuf: array[0..255] of char;
-begin
-  checkCTRLC;
-  Dir:='';
-  if not GetCurrentDirName(tmpbuf,256) then
-    dosError2InOut(IoErr)
-  else
-    Dir:=strpas(tmpbuf);
-end;
-
-
-{****************************************************************************
-                        Low level File Routines
-               All these functions can set InOutRes on errors
-****************************************************************************}
-
-{ close a file from the handle value }
-procedure do_close(handle : longint);
-begin
-  if (handle<=0) then exit;
-
-  RemoveFromList(MOS_fileList,handle);
-  { Do _NOT_ check CTRL_C on Close, because it will conflict
-    with System_Exit! }
-  if not dosClose(handle) then
-    dosError2InOut(IoErr);
-end;
-
-procedure do_erase(p : pchar);
-begin
-  checkCTRLC;
-  if not dosDeleteFile(p) then
-    dosError2InOut(IoErr);
-end;
-
-procedure do_rename(p1,p2 : pchar);
-begin
-  checkCTRLC;
-  if not dosRename(p1,p2) then
-    dosError2InOut(IoErr);
-end;
-
-function do_write(h:longint; addr: pointer; len: longint) : longint;
-var dosResult: LongInt;
-begin
-  checkCTRLC;
-  do_write:=0;
-  if (len<=0) or (h<=0) then exit;
-
-  dosResult:=dosWrite(h,addr,len);
-  if dosResult<0 then begin
-    dosError2InOut(IoErr);
-  end else begin
-    do_write:=dosResult;
-  end;
-end;
-
-function do_read(h:longint; addr: pointer; len: longint) : longint;
-var dosResult: LongInt;
-begin
-  checkCTRLC;
-  do_read:=0;
-  if (len<=0) or (h<=0) then exit;
-
-  dosResult:=dosRead(h,addr,len);
-  if dosResult<0 then begin
-    dosError2InOut(IoErr);
-  end else begin
-    do_read:=dosResult;
-  end
-end;
-
-function do_filepos(handle : longint) : longint;
-var dosResult: LongInt;
-begin
-  checkCTRLC;
-  do_filepos:=-1; 
-  if (handle<=0) then exit;
-
-  { Seeking zero from OFFSET_CURRENT to find out where we are }
-  dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
-  if dosResult<0 then begin
-    dosError2InOut(IoErr);
-  end else begin
-    do_filepos:=dosResult;
-  end;
-end;
-
-procedure do_seek(handle,pos : longint);
-begin
-  checkCTRLC;
-  if (handle<=0) then exit;
-
-  { Seeking from OFFSET_BEGINNING }
-  if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
-    dosError2InOut(IoErr);
-end;
-
-function do_seekend(handle:longint):longint;
-var dosResult: LongInt;
-begin
-  checkCTRLC;
-  do_seekend:=-1;
-  if (handle<=0) then exit;
-
-  { Seeking to OFFSET_END }
-  dosResult:=dosSeek(handle,0,OFFSET_END);
-  if dosResult<0 then begin
-    dosError2InOut(IoErr);
-  end else begin
-    do_seekend:=dosResult;
-  end
-end;
-
-function do_filesize(handle : longint) : longint;
-var currfilepos: longint;
-begin
-  checkCTRLC;
-  do_filesize:=-1;
-  if (handle<=0) then exit;  
-
-  currfilepos:=do_filepos(handle);
-  { We have to do this twice, because seek returns the OLD position }
-  do_filesize:=do_seekend(handle);
-  do_filesize:=do_seekend(handle);
-  do_seek(handle,currfilepos)
-end;
-
-{ truncate at a given position }
-procedure do_truncate (handle,pos:longint);
-begin
-  checkCTRLC;
-  if (handle<=0) then exit;
-
-  { Seeking from OFFSET_BEGINNING }
-  if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
-    dosError2InOut(IoErr);
-end;
-
-procedure do_open(var f;p:pchar;flags:longint);
-{
-  filerec and textrec have both handle and mode as the first items so
-  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)
-}
-var
-  handle   : LongInt;
-  openflags: LongInt;
-  tmpStr   : array[0..255] of Char;
-begin
-  tmpStr:=PathConv(strpas(p))+#0;
-
-  { 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
-        inoutres:=102; {not assigned}
-        exit;
-      end;
-    end;
-  end;
-
-  { reset file handle }
-  filerec(f).handle:=UnusedHandle;
-
-  { convert filemode to filerec modes }
-  { READ/WRITE on existing file }
-  { RESET/APPEND                }
-  openflags:=MODE_OLDFILE;
-  case (flags and 3) of
-    0 : filerec(f).mode:=fminput;
-    1 : filerec(f).mode:=fmoutput;
-    2 : filerec(f).mode:=fminout;
-  end;
-
-  { rewrite (create a new file) }
-  if (flags and $1000)<>0 then openflags:=MODE_NEWFILE;
-
-  { empty name is special }
-  if p[0]=#0 then begin
-    case filerec(f).mode of
-      fminput :
-        filerec(f).handle:=StdInputHandle;
-      fmappend,
-      fmoutput : begin
-        filerec(f).handle:=StdOutputHandle;
-        filerec(f).mode:=fmoutput; {fool fmappend}
-      end;
-    end;
-    exit;
-  end;
-
-  handle:=Open(@tmpStr,openflags);
-  if handle=0 then begin
-    dosError2InOut(IoErr);
-  end else begin
-    AddToList(MOS_fileList,handle);
-    filerec(f).handle:=handle;
-  end;
-
-  { append mode }
-  if ((Flags and $100)<>0) and 
-      (FileRec(F).Handle<>UnusedHandle) then begin
-    do_seekend(filerec(f).handle);
-    filerec(f).mode:=fmoutput; {fool fmappend}
-  end;
-end;
-
-function do_isdevice(handle:longint):boolean;
-begin
-  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
-     (handle=StdErrorHandle) then
-    do_isdevice:=True
-  else
-    do_isdevice:=False;
-end;
-
-{*****************************************************************************
-                          UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{$I text.inc}
-
-
 { MorphOS specific startup }
 procedure SysInitMorphOS;
 var self: PProcess;
@@ -869,9 +324,7 @@ begin
   InOutRes:=0;
 { Arguments }
   GenerateArgs;
-(* This should be changed to a real value during *)
-(* thread driver initialization if appropriate.  *)
-  ThreadID := 1;
+  InitSystemThreads;
 {$ifdef HASVARIANT}
   initvariantmanager;
 {$endif HASVARIANT}
@@ -882,7 +335,10 @@ end.
 
 {
   $Log$
-  Revision 1.30  2005-02-01 20:22:49  florian
+  Revision 1.31  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.30  2005/02/01 20:22:49  florian
     * improved widestring infrastructure manager
 
   Revision 1.29  2005/01/12 08:03:42  karoly

rtl/morphos/systhrd.inc

@@ -0,0 +1,42 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Peter Vreman,
+    member of the Free Pascal development team.
+
+    Linux (pthreads) threading support implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+  { This should be changed to a real value during
+    thread driver initialization if appropriate. }
+  ThreadID := 1;
+  SetNoThreadManager;
+end;
+
+{
+  $Log$
+  Revision 1.1  2005-02-07 21:30:12  peter
+    * system unit updated
+
+  Revision 1.1  2005/02/06 16:57:18  peter
+    * threads for go32v2,os,emx,netware
+
+  Revision 1.1  2005/02/06 12:16:52  peter
+    * bsd thread updates
+
+  Revision 1.1  2005/02/06 11:20:52  peter
+    * threading in system unit
+    * removed systhrds unit
+
+}
+

rtl/morphos/systhrds.pp

@@ -1,65 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by the Free Pascal development team.
-
-    MorphOS threading support implementation
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{$mode objfpc}
-{$define dynpthreads}
-
-unit systhrds;
-
-interface
-
-{
-  uses
-    unixtype;
-}
-{ Posix compliant definition }
-  
-{$WARNING FIX ME!!! Dummy type definition}
-  type
-     PRTLCriticalSection = ^TRTLCriticalSection;
-     TRTLCriticalSection = LongInt; 
-
-{ Include generic thread interface }
-{$i threadh.inc}
-
-implementation
-
-{*****************************************************************************
-                             Generic overloaded
-*****************************************************************************}
-
-{ Include generic overloaded routines }
-{$i thread.inc}
-
-{ Include OS independent Threadvar initialization }
-{$ifdef HASTHREADVAR}
-{$i threadvr.inc}
-{$endif HASTHREADVAR}
-
-Procedure InitSystemThreads;
-
-begin
-  SetNoThreadManager;
-end;
-
-initialization
-  InitSystemThreads;
-end.
-{
-  $Log$
-  Revision 1.1  2005-01-30 02:25:27  karoly
-    + initial dummy implementation
-
-}