Browse Source

+ Variables describing misc OS features added
+ Detection of GUI app
* Working directory for APPTYPE TOOL correct now
+ Exit code <> 0 written to, console for console apps, to system debugger (if installed) for GUI apps.
* Misc fixes

olle 21 years ago
parent
commit
5cdcf47d16
1 changed files with 370 additions and 276 deletions
  1. 370 276
      rtl/macos/system.pp

+ 370 - 276
rtl/macos/system.pp

@@ -54,6 +54,43 @@ var
   argv : ppchar;
   envp : ppchar;
 
+{*********************************}
+{**  MacOS specific functions    **}
+{*********************************}
+
+
+{*********************************}
+{**  Available features on macos **}
+{*********************************}
+
+
+  var
+    macosHasGestalt: Boolean;
+    macosHasWaitNextEvent: Boolean;
+    macosHasColorQD: Boolean;
+    macosHasFPU: Boolean;
+    macosSystemVersion: Integer;
+    macosHasSysDebugger: Boolean = false;
+    macosHasCFM: Boolean;
+
+    macosHasAppleEvents: Boolean;
+    macosHasAliasMgr: Boolean;
+
+
+    macosHasFSSpec: Boolean;
+    macosHasFindFolder: Boolean;
+    
+
+    macosHasScriptMgr: Boolean;
+    macosNrOfScriptsInstalled: Integer;
+    
+    macosHasAppearance: Boolean;
+    macosHasAppearance101: Boolean;
+    macosHasAppearance11: Boolean;
+    
+    macosBootVolumeVRefNum: Integer;
+    macosBootVolumeName: String[31];
+    
 {
  MacOS paths
  ===========
@@ -81,7 +118,8 @@ A MacOS application is assembled and linked by MPW (Macintosh
 Programmers Workshop), which nowadays is free to use. For info
 and download of MPW and MacOS api, see www.apple.com
 
-It can be linked to either a standalone application (using SIOW) or
+It can be linked to either a graphical user interface application,
+a standalone text only application (using SIOW) or
 to an MPW tool, this is entirely controlled by the linking step.
 
 It requires system 7 and CFM, which is always the case for PowerPC.
@@ -91,16 +129,18 @@ of efforts if it also uses CFM. This System.pp should, with
 minor modifications, probably work with m68k.
 
 Initial working directory is the directory of the application,
-or for an MPWTool, the MPW directory.
+or for an MPWTool, the working directory as set by the
+Directory command in MPW.
 
 Note about working directory. There is a facility in MacOS which
 manages a working directory for an application, initially set to
-the applictaions directory, or for an MPWTool, the tool's directory.
+the applications directory, or for an MPWTool, the tool's directory.
 However, this requires the application to have a unique application
 signature (creator code), to distinguish its working directory
 from working directories of other applications. Due to the fact
 that casual applications are anonymous in this sense (without an
-application signature), this facility will not work. Hence we
+application signature), this facility will not work. Also, this
+working directory facility is not present in Carbon. Hence we
 will manage a working directory by our self.
 
 
@@ -114,7 +154,7 @@ Then the path to the wd suddenly changes. This is AFAIK not in
 accordance with other OS's. Although this is a minor caveat,
 it is mentioned here. To overcome this the wd could be stored
 as a path instead, but this imposes translations from fullpath
-to directory id each time the filesystem is accessed.
+to directory ID each time the filesystem is accessed.
 
 The initial working directory for an MPWTool, as considered by
 FPC, is different from the MacOS working directory facility,
@@ -123,14 +163,9 @@ see above.
 
 Possible improvements:
 =====================
-TODO: Add check so that working directory cannot be removed. Alt ensure
-the nothing crashes if wd is removed.
 
-TODO: rmdir and erase does not differentiate between files and directories
-thus removing both of them.
+Perhaps handle readonly filesystems, as in sysunix.inc
 
-TODO: Check of the MacOS version (and prescence of CFM) to
-ensure it is a supported version. only needed for m68k.
 }
 
 {This implementation uses StdCLib, which is included in the MPW.}
@@ -283,11 +318,19 @@ Sys_ERANGE      = 34;   { Math result not representable }
 {$endif}
 
 
-{******************************************************}
+{*********************** Macutils *********************}
+
+{And also include the same utilities as in the macutils.pp unit.}
 
 var
-  {working directory}
-  curDirectorySpec: FSSpec;
+  {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}
@@ -316,77 +359,6 @@ begin
   end
 end;
 
-{Gives the path for a given file or directory. If parent is true, 
- a path to the directory, where the file or directory is located,
- is returned. Functioning even with System 6}
-function FSpGetFullPath (spec: FSSpec; var fullPathHandle: Mac_Handle;
-  parent: Boolean): OSErr;
-
-  var
-    res: OSErr;
-    pb: CInfoPBRec;
-
-begin
-  fullPathHandle:= NewHandle(0); { Allocate a zero-length handle }
-  if fullPathHandle = nil then
-    begin
-      FSpGetFullPath:= MemError;
-      Exit;
-    end;
-
-  if spec.parID = fsRtParID then { The object is a volume }
-    begin
-      if not parent then
-        begin
-          { Add a colon to make it a full pathname }
-          spec.name := Concat(spec.name, ':');
-
-          { We're done }
-          Munger(fullPathHandle, 0, nil, 0, @spec.name[1], Length(spec.name));
-          res := MemError;
-        end
-      else
-        res := noErr;
-    end
-  else
-    begin
-      { The object isn't a volume }
-
-      { Add the object name }
-      if not parent then
-        Munger(fullPathHandle, 0, nil, 0, @spec.name[1], Length(spec.name));
-
-      { Get the ancestor directory names }
-      pb.ioNamePtr := @spec.name;
-      pb.ioVRefNum := spec.vRefNum;
-      pb.ioDrParID := spec.parID;
-      repeat { loop until we have an error or find the root directory }
-        begin
-          pb.ioFDirIndex := -1;
-          pb.ioDrDirID := pb.ioDrParID;
-          res := PBGetCatInfoSync(@pb);
-          if res = noErr then
-            begin
-              { Append colon to directory name }
-              spec.name := Concat(spec.name, ':');
-
-              { Add directory name to fullPathHandle }
-              Munger(fullPathHandle, 0, nil, 0, @spec.name[1], Length(spec.name));
-              res := MemError;
-            end
-        end
-      until not ((res = noErr) and (pb.ioDrDirID <> fsRtDirID));
-    end;
-
-  if res <> noErr then
-    begin
-      DisposeHandle(fullPathHandle);
-      fullPathHandle:= nil;
-    end;
-
-  FSpGetFullPath := res;
-end;
-
 Procedure Errno2InOutRes;
 {
   Convert ErrNo error to the correct InOutRes value.
@@ -424,149 +396,11 @@ begin
   errno:=0;
 end;
 
-Function MacOSErr2RTEerr(err: OSErr): Integer;
-{ Converts MacOS specific error codes to the correct FPC error code.
-  All non zero MacOS errors shall correspond to a nonzero FPC error.}
-var
-  res: Integer;
-begin
-  if err = noErr then { Else it will go through all the cases }
-    res:= 0
-  else case err of
-    dirFulErr, { Directory full }
-    dskFulErr  { disk full }
-      :res:=101;
-    nsvErr     { no such volume }
-      :res:=3;
-    ioErr,     { I/O error (bummers) }
-    bdNamErr   { there may be no bad names in the final system! }
-      :res:=1; //TODO Exchange to something better
-    fnOpnErr   { File not open }
-      :res:=103;
-    eofErr,    { End of file }
-    posErr     { tried to position to before start of file (r/w) }
-      :res:=100;
-    mFulErr    { memory full (open) or file won't fit (load) }
-      :res:=1; //TODO Exchange to something better
-    tmfoErr    { too many files open}
-      :res:=4;
-    fnfErr     { File not found }
-      :res:=2;
-    wPrErr     { diskette is write protected. }
-      :res:=150;
-    fLckdErr   { file is locked }
-      :res:=5;
-    vLckdErr   { volume is locked }
-      :res:=150;
-    fBsyErr    { File is busy (delete) }
-      :res:=5;
-    dupFNErr   { duplicate filename (rename) }
-      :res:=5;
-    opWrErr    { file already open with with write permission }
-      :res:=5;
-    rfNumErr,  { refnum error }
-    gfpErr     { get file position error }
-      :res:=1; //TODO Exchange to something better
-    volOffLinErr   { volume not on line error (was Ejected) }
-      :res:=152;
-    permErr    { permissions error (on file open) }
-      :res:=5;
-    volOnLinErr{ drive volume already on-line at MountVol }
-      :res:=1; //TODO Exchange to something other      
-    nsDrvErr       { no such drive (tried to mount a bad drive num) }
-      :res:=1; //TODO Perhaps exchange to something better
-    noMacDskErr,   { not a mac diskette (sig bytes are wrong) }
-    extFSErr       { volume in question belongs to an external fs }
-      :res:=157; //TODO Perhaps exchange to something better
-    fsRnErr,   { file system internal error:during rename the old 
-                 entry was deleted but could not be restored. }
-    badMDBErr  { bad master directory block }
-      :res:=1; //TODO Exchange to something better
-    wrPermErr  { write permissions error }
-      :res:=5;
-    dirNFErr   { Directory not found }
-      :res:=3;
-    tmwdoErr   { No free WDCB available }
-      :res:=1; //TODO Exchange to something better
-    badMovErr  { Move into offspring error }
-      :res:=5;
-    wrgVolTypErr   { Wrong volume type error [operation not 
-                     supported for MFS] }
-      :res:=1; //TODO Exchange to something better
-    volGoneErr { Server volume has been disconnected. }
-      :res:=152;
-
-    diffVolErr         { files on different volumes }
-      :res:=17;
-    catChangedErr      { the catalog has been modified }
-                       { OR comment: when searching with PBCatSearch }
-      :res:=1; //TODO Exchange to something other      
-    afpAccessDenied,   {  Insufficient access privileges for operation  }
-    afpDenyConflict    {  Specified open/deny modes conflict with current open modes  }
-      :res:=5;
-    afpNoMoreLocks     {  Maximum lock limit reached  }
-      :res:=5;
-    afpRangeNotLocked, {  Tried to unlock range that was not locked by user  }
-    afpRangeOverlap    {  Some or all of range already locked by same user  }
-      :res:=1; //TODO Exchange to something better
-    afpObjectTypeErr   {  File/Directory specified where Directory/File expected  }
-      :res:=3;
-    afpCatalogChanged  { OR comment: when searching with PBCatSearch }
-      :res:=1; //TODO Exchange to something other      
-    afpSameObjectErr  
-      :res:=5; //TODO Exchange to something better
-
-    memFullErr { Not enough room in heap zone }
-      :res:=203;
-  else
-    res := 1; //TODO Exchange to something better
-  end;
-  MacOSErr2RTEerr:= res;
-end;
-
 Procedure OSErr2InOutRes(err: OSErr);
 begin
   InOutRes:= MacOSErr2RTEerr(err);
 end;
 
-function PathArgToFSSpec(s: string; var spec: FSSpec): Integer;
-var
-  err: OSErr;
-begin 
-  err:= FSMakeFSSpec(curDirectorySpec.vRefNum,
-      curDirectorySpec.parID, s, spec);
-
-  if err in [ noErr, fnfErr] then
-    PathArgToFSSpec:= 0
-  else
-    PathArgToFSSpec:= MacOSErr2RTEerr(err);  
-end;
-
-function PathArgToFullPath(s: string; var fullpath: AnsiString): Boolean;
-var
-  err: OSErr;
-  res: Integer;
-  spec: FSSpec;
-  pathHandle: Mac_Handle;
-begin
-  PathArgToFullPath:= false;
-  res:= PathArgToFSSpec(s, spec);
-  if res = 0  then
-    begin
-      err:= FSpGetFullPath(spec, pathHandle, false);
-      if err = noErr then
-        begin 
-          SetString(fullpath, pathHandle^, GetHandleSize(pathHandle));
-          DisposeHandle(pathHandle);
-          PathArgToFullPath:= true;
-        end
-      else
-        OSErr2InOutRes(err);
-    end
-  else
-    InOutRes:=res;
-end;
-
 function FSpLocationFromFullPath(fullPathLength: Integer;
   fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
 
@@ -636,25 +470,22 @@ begin
   getheapsize:= intern_heapsize ;
 end;
 
-{ function to allocate size bytes more for the program }
-{ must return the first address of new data space or nil if failed }
-function Sbrk(logicalSize: Longint): Mac_Ptr ;
-external 'InterfaceLib' name 'NewPtr'; {Directly mapped to NewPtr}
-
 {*****************************************************************************
       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 := sbrk(size);
+  result := NewPtr(size);
 end;
 
 {$define HAS_SYSOSFREE}
 
 procedure SysOSFree(p: pointer; size: ptrint);
 begin
-  fpmunmap(p, size);
+  DisposePtr(p);
 end;
 
 
@@ -687,18 +518,27 @@ begin
 end;
 
 procedure do_erase(p : pchar);
-{this implementation cannot distinguish between directories and files}
+
 var
-  s: AnsiString;
+  spec: FSSpec;
+  err: OSErr;
+  res: Integer;
+	
 begin
-  {$ifdef MACOS_USE_STDCLIB}
-  if not PathArgToFullPath(p, s) then
-    exit;
-  remove(PChar(s));
-  Errno2InoutRes;
-  {$else}
-  InOutRes:=1;
-  {$endif}
+  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);
@@ -706,9 +546,11 @@ var
   s1,s2: AnsiString;
 begin
   {$ifdef MACOS_USE_STDCLIB}
-  if not PathArgToFullPath(p1, s1) then
+  InOutRes:= PathArgToFullPath(p1, s1);
+  if InOutRes <> 0 then
     exit;
-  if not PathArgToFullPath(p2, s2) then
+  InOutRes:= PathArgToFullPath(p2, s2);
+  if InOutRes <> 0 then
     exit;
   c_rename(PChar(s1),PChar(s2));
   Errno2InoutRes;
@@ -740,11 +582,6 @@ begin
   len:= c_read(h, addr, len);
   Errno2InoutRes;
 
-  // TEMP BUGFIX Exchange CR to LF.
-  for i:= 0 to len-1 do
-    if SignedBytePtr(addr + i)^ = 13 then
-      SignedBytePtr(addr + i)^ := 10;
-
   do_read:= len;
 
   {$else}
@@ -788,12 +625,13 @@ end;
 function do_seekend(handle:longint):longint;
 begin
   {$ifdef MACOS_USE_STDCLIB}
-  lseek(handle, 0, SEEK_END);
+  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;
 
@@ -919,16 +757,20 @@ begin
    end
   else
     begin
-      if not PathArgToFullPath(p, s) then
+      InOutRes:= PathArgToFullPath(p, s);
+      if InOutRes <> 0 then
         exit;
       p:= PChar(s);
     end;
 
-  //TODO Perhaps handle readonly filesystems, as in sysunix.inc
 
   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
     filerec(f).handle:= fh
   else
@@ -1001,7 +843,7 @@ begin
     exit;
 
   res:= PathArgToFSSpec(s, spec); 
-  if res = 0 then
+  if (res = 0) or (res = 2) then
     begin
       err:= FSpDirCreate(spec, smSystemScript, createdDirID);
       OSErr2InOutRes(err);
@@ -1011,20 +853,27 @@ begin
 end;
 
 procedure rmdir(const s:string);[IOCheck];
-{this implementation cannot distinguish between directories and files}
+
 var
   spec: FSSpec;
   err: OSErr;
   res: Integer;
+	
 begin
   If (s='') or (InOutRes <> 0) then
     exit;
 
-  res:= PathArgToFSSpec(s, spec); 
-  if res = 0 then
+  res:= PathArgToFSSpec(s, spec);
+
+  if (res = 0) then
     begin
-      err:= FSpDelete(spec);
-      OSErr2InOutRes(err);
+      if IsDirectory(spec) then
+			  begin
+          err:= FSpDelete(spec);
+          OSErr2InOutRes(err);
+			  end
+			else
+			  InOutRes:= 20;
     end
   else
     InOutRes:=res;
@@ -1040,17 +889,17 @@ begin
     exit;
 
   res:= PathArgToFSSpec(s, spec); 
-  if res = 0 then
+  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 in [ noErr, fnfErr] then
+      if (err = noErr) or (err = fnfErr) then
         begin
-          curDirectorySpec:= newDirSpec;
-          curDirectorySpec.name:='';
+          workingDirectorySpec:= newDirSpec;
+          workingDirectorySpec.name:='';
           InOutRes:= 0;
         end
       else
@@ -1064,11 +913,13 @@ begin
 end;
 
 procedure getDir (DriveNr: byte; var Dir: ShortString);
+
 var
   pathHandle: Mac_Handle;
   pathHandleSize: Longint;
+
 begin
-  if FSpGetFullPath(curDirectorySpec, pathHandle, false) <> noErr then
+  if FSpGetFullPath(workingDirectorySpec, pathHandle, false) <> noErr then
     Halt(3);  {exit code 3 according to MPW}
 
   pathHandleSize:= GetHandleSize(pathHandle);
@@ -1107,13 +958,215 @@ procedure setup_arguments;
 procedure setup_environment;
          begin
          end;
+         
+     
+{ FindSysFolder returns the (real) vRefNum, and the DirID of the current
+system folder. It uses the Folder Manager if present, otherwise it falls
+back to SysEnvirons. It returns zero on success, otherwise a standard
+system error. }
+
+function FindSysFolder(var foundVRefNum: Integer; var foundDirID: Longint): OSErr;
+
+var
+  gesResponse: Longint;
+  envRec: SysEnvRec;
+  myWDPB: WDPBRec;
+  volName: String[34];
+  err: OSErr;
+
+begin
+  foundVRefNum := 0;
+  foundDirID := 0;
+  if  macosHasGestalt
+      and (Gestalt (FourCharCodeToLongword(gestaltFindFolderAttr), gesResponse) = noErr)
+      and BitIsSet (gesResponse, gestaltFindFolderPresent) then
+    begin { Does Folder Manager exist? }
+       err := FindFolder (kOnSystemDisk, FourCharCodeToLongword(kSystemFolderType),
+        kDontCreateFolder, foundVRefNum, foundDirID);
+    end
+  else
+    begin
+      { Gestalt can't give us the answer, so we resort to SysEnvirons }
+      err := SysEnvirons (curSysEnvVers, envRec);
+      if (err = noErr) then
+        begin
+          myWDPB.ioVRefNum := envRec.sysVRefNum;
+          volName := '';
+          myWDPB.ioNamePtr := @volName;
+          myWDPB.ioWDIndex := 0;
+          myWDPB.ioWDProcID := 0;
+          err := PBGetWDInfoSync (@myWDPB);
+          if (err = noErr) then
+            begin
+              foundVRefNum := myWDPB.ioWDVRefNum;
+              foundDirID := myWDPB.ioWDDirID;
+            end;
+          end;
+        end;
+  FindSysFolder:= err;
+end;
+
+procedure InvestigateSystem;
+
+  {$IFDEF CPUM68K}
+  const
+    _GestaltDispatch = $A0AD;
+    _WaitNextEvent = $A860;
+    _ScriptUtil = $A8B5;
+
+    qdOffscreenTrap = $AB1D;
+  {$ENDIF}
+
+  var
+    err: Integer;
+    response: Longint;
+    {$IFDEF CPUM68K}
+    environs: SysEnvRec;
+    {$ENDIF}
+
+  {Vi rŠknar med att man kšr pŒ minst system 6.0.5.  DŒ finns bŒde Gestalt och GDevice med.}
+  {Enligt Change Histrory Šr MacOS 6.0.5 mera konsistent mellan maskinmodellerna Šn fšregŒende system}
+
+begin
+  {$IFDEF CPUM68K}
+  macosHasGestalt := TrapAvailable(_GestaltDispatch);
+  {$ELSE}
+  macosHasGestalt := true;  {There is always Gestalt on PowerPC}
+  {$ENDIF}
+
+  if not macosHasGestalt then    (* If we don't have Gestalt, then we can't have any System 7 features  *)
+    begin
+      {$IFDEF CPUM68K}
+      {      Detta kan endast gŠlla pŒ en 68K maskin.}
+      macosHasScriptMgr := TrapAvailable(_ScriptUtil);
+
+      macosNrOfScriptsInstalled := 1; (* assume only Roman script, to start with  *)
+
+      err := SysEnvirons(1, environs);
+      if err = noErr then
+        begin
+          if environs.machineType < 0 then       { gammalt ROM}
+            macosHasWaitNextEvent := FALSE
+          else
+            macosHasWaitNextEvent := TrapAvailable(_WaitNextEvent);
+          macosHasColorQD := environs.hasColorQD;
+          macosHasFPU := environs.hasFPU;
+          macosSystemVersion := environs.systemVersion;
+        end
+      else
+        begin
+          macosHasWaitNextEvent := FALSE;
+          macosHasColorQD := FALSE;
+          macosHasFPU := FALSE;
+          macosSystemVersion := 0;
+        end;
+
+      macosHasSysDebugger := (LongintPtr(MacJmp)^ <> 0);
+
+      macosHasCFM := false;
+      macosHasAppleEvents := false;
+      macosHasAliasMgr := false;
+      
+      macosHasFSSpec := false;
+      macosHasFindFolder := false;
+      
+      macosHasAppearance := false;
+      macosHasAppearance101 := false;
+      macosHasAppearance11 := false;
+      {$IFDEF THINK_PASCAL}
+      if (macosHasScriptMgr) then
+        macosNrOfScriptsInstalled := GetEnvirons(smEnabled);
+      {$ELSE}
+      if (macosHasScriptMgr) then
+        macosNrOfScriptsInstalled := GetScriptManagerVariable(smEnabled);  {Gamla rutinnamnet var GetEnvirons.}
+      {$ENDIF}
+      {$ENDIF}
+    end
+  else
+    begin
+      macosHasScriptMgr := Gestalt(FourCharCodeToLongword(gestaltScriptMgrVersion), response) = noErr;  {Fšr att ta reda pŒ om script mgr finns.}
+      macosNrOfScriptsInstalled := 1; (* assume only Roman script, to start with  *)
+      macosHasWaitNextEvent := true;
+
+      if Gestalt(FourCharCodeToLongword(gestaltSystemVersion), response) = noErr then
+        macosSystemVersion := response
+      else
+        macosSystemVersion := 0;  {Borde inte kunna hŠnda.}
+
+      if Gestalt(FourCharCodeToLongword(gestaltOSAttr), response) = noErr then
+        macosHasSysDebugger := BitIsSet(response, gestaltSysDebuggerSupport)
+      else
+        macosHasSysDebugger := false;
+      
+      if Gestalt(FourCharCodeToLongword(gestaltQuickdrawVersion), response) = noErr then
+        macosHasColorQD := (response >= $0100)
+      else
+        macosHasColorQD := false;
+
+      if Gestalt(FourCharCodeToLongword(gestaltFPUType), response) = noErr then
+        macosHasFPU := (response <> gestaltNoFPU)
+      else
+        macosHasFPU := false;
+
+      if Gestalt(FourCharCodeToLongword(gestaltCFMAttr), response) = noErr then
+        macosHasCFM := BitIsSet(response, gestaltCFMPresent)
+      else
+        macosHasCFM := false;
+      
+      macosHasAppleEvents := Gestalt(FourCharCodeToLongword(gestaltAppleEventsAttr), response) = noErr;
+      macosHasAliasMgr := Gestalt(FourCharCodeToLongword(gestaltAliasMgrAttr), response) = noErr;
+    
+      if Gestalt(FourCharCodeToLongword(gestaltFSAttr), response) = noErr then
+        macosHasFSSpec := BitIsSet(response, gestaltHasFSSpecCalls)
+      else
+        macosHasFSSpec := false;
+      macosHasFindFolder := Gestalt(FourCharCodeToLongword(gestaltFindFolderAttr), response) = noErr;
+      
+      if macosHasScriptMgr then
+        begin
+          err := Gestalt(FourCharCodeToLongword(gestaltScriptCount), response);
+          if (err = noErr) then
+            macosNrOfScriptsInstalled := Integer(response);
+        end;
+
+      if (Gestalt(FourCharCodeToLongword(gestaltAppearanceAttr), response) = noErr) then
+        begin
+          macosHasAppearance := BitIsSet(response, gestaltAppearanceExists);
+          if Gestalt(FourCharCodeToLongword(gestaltAppearanceVersion), response) = noErr then
+            begin
+              macosHasAppearance101 := (response >= $101);
+              macosHasAppearance11 := (response >= $110);
+            end
+        end
+      else
+        begin
+          macosHasAppearance := false;
+          macosHasAppearance101 := false;
+          macosHasAppearance11 := false;
+        end;
+    end;
+end;
 
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
 
 Procedure system_exit;
+var
+  s: ShortString;
 begin
+  if StandAlone <> 0 then
+    if exitcode <> 0 then
+        begin
+          Str(exitcode,s);
+          if IsConsole then
+            Writeln( '### Program exited with exit code ' + s)
+          else if macosHasSysDebugger then
+            DebugStr('A possible error occured, exit code: ' + s + '. Type "g" and return to continue.')
+          else
+            {Be quiet}
+        end;
+      
   {$ifndef MACOS_USE_STDCLIB}
   if StandAlone <> 0 then
     ExitToShell;
@@ -1134,17 +1187,35 @@ begin
 end;
 
 var
-  pathHandle: Mac_Handle;
-
+  resHdl: Mac_Handle;
+  isFolder, hadAlias, leafIsAlias: Boolean;
+  dirStr: string[2];
+  err: OSErr;
+  dummySysFolderDirID: Longint;
+  
 begin
-  if false then //To save it from the dead code stripper
+  InvestigateSystem; {Must be first}
+	
+	{Check requred features for system.pp to work.}
+	if not macosHasFSSpec then
+	  Halt(3);  //exit code 3 according to MPW
+
+  if FindSysFolder(macosBootVolumeVRefNum, dummySysFolderDirID) <> noErr then
+    Halt(3);  //exit code 3 according to MPW
+
+  if GetVolumeName(macosBootVolumeVRefNum, macosBootVolumeName) <> noErr then
+    Halt(3);  //exit code 3 according to MPW
+
+  { To be set if this is a GUI or console application }
+  if StandAlone = 0 then
+    IsConsole := true {Its an MPW tool}
+  else
     begin
-      //Included only to make them available for debugging in asm.
-      Debugger;
-      DebugStr('');
+      resHdl:= Get1Resource(FourCharCodeToLongword('siow'),0);
+      IsConsole := (resHdl <> nil); {A SIOW app is also a console}
+      ReleaseResource(resHdl);
     end;
-  { To be set if this is a GUI or console application }
-  IsConsole := TRUE;
+    
   { To be set if this is a library and not a program  }
   IsLibrary := FALSE;
 
@@ -1152,14 +1223,30 @@ begin
   StackBottom := SPtr - StackLength;
 
   { Setup working directory }
-  if not GetAppFileLocation(curDirectorySpec) then
-    Halt(3);  //exit code 3 according to MPW
-
+  if StandAlone <> 0 then
+    begin
+      if not GetAppFileLocation(workingDirectorySpec) then
+        Halt(3);  //exit code 3 according to MPW
+    end
+  else
+    begin
+      { The fictive file x is used to make 
+        FSMakeFSSpec return a FSSpec to a file in the directory.
+        Then by clearing the name, the FSSpec then
+        points to the directory. It doesn't matter whether x exists or not.}
+      dirStr:= ':x';
+      err:= ResolveFolderAliases(0, 0, @dirStr, true, 
+           workingDirectorySpec, isFolder, hadAlias, leafIsAlias);
+      if (err <> noErr) and (err <> fnfErr) then
+        Halt(3);  //exit code 3 according to MPW
+    end;
+  
   { Setup heap }
-  MaxApplZone;
+  if StandAlone <> 0 then
+    MaxApplZone;
   if Mac_FreeMem - intern_heapsize < 30000 then
     Halt(3);  //exit code 3 according to MPW
-  theHeap:= Sbrk(intern_heapsize);
+  theHeap:= SysOSAlloc(intern_heapsize);
   if theHeap = nil then
     Halt(3);  //exit code 3 according to MPW
 
@@ -1184,7 +1271,14 @@ end.
 
 {
   $Log$
-  Revision 1.16  2004-06-17 16:16:13  peter
+  Revision 1.17  2004-06-21 19:23:34  olle
+    + Variables describing misc OS features added
+    + Detection of GUI app
+    * Working directory for APPTYPE TOOL correct now
+    + Exit code <> 0 written to, console for console apps, to system debugger (if installed) for GUI apps.
+    * Misc fixes
+
+  Revision 1.16  2004/06/17 16:16:13  peter
     * New heapmanager that releases memory back to the OS, donated
       by Micha Nelissen