freepascal.compiler/rtl/macos/sysos.inc

{
    $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

}