sysos.inc 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2001 by Free Pascal development team
  5. This file implements all the base types and limits required
  6. for a minimal POSIX compliant subset required to port the compiler
  7. to a new OS.
  8. See the file COPYING.FPC, included in this distribution,
  9. for details about the copyright.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. **********************************************************************}
  14. {*********************** MacOS API *********************}
  15. {This implementation uses StdCLib: }
  16. {$define MACOS_USE_STDCLIB}
  17. {Some MacOS API routines and StdCLib included for internal use:}
  18. {$I macostp.inc}
  19. {Note, because the System unit is the most low level, it should not
  20. depend on any other units, and thus the macos api must be accessed
  21. as an include file and not a unit.}
  22. {The reason StdCLib is used is that it can easily be connected
  23. to either SIOW or, in case of MPWTOOL, to MPW }
  24. {If the Apples Universal Interfaces are used, the qd variable is required
  25. to be allocated somewhere, so we do it here for the convenience to the user.}
  26. var
  27. qd: QDGlobals; cvar;
  28. {$ifdef MACOS_USE_STDCLIB}
  29. {************** API to StdCLib in MacOS ***************}
  30. {The reason StdCLib is used is that it can easily be connected
  31. to either SIOW or, in case of MPWTOOL, to MPW }
  32. {$endif}
  33. {*********************** Macutils *********************}
  34. {And also include the same utilities as in the macutils.pp unit.}
  35. var
  36. {emulated working directory}
  37. workingDirectorySpec: FSSpec; cvar;
  38. {The above variable is also declared in macutils.pp as external. Declared }
  39. {here to be available to macutils.inc and below in this file.}
  40. {$I macutils.inc}
  41. {******************************************************}
  42. function GetAppFileLocation (var spec: FSSpec): Boolean;
  43. {Requires >= System 7}
  44. var
  45. PSN: ProcessSerialNumber;
  46. info: ProcessInfoRec;
  47. appFileRefNum: Integer;
  48. appName: Str255;
  49. dummy: Mac_Handle;
  50. begin
  51. begin
  52. PSN.highLongOfPSN := 0;
  53. PSN.lowLongOfPSN := kCurrentProcess;
  54. info.processInfoLength := SizeOf(info);
  55. info.processName := nil;
  56. info.processAppSpec := @spec;
  57. if GetProcessInformation(PSN, info) = noErr then
  58. begin
  59. spec.name := '';
  60. GetAppFileLocation := true;
  61. end
  62. else
  63. GetAppFileLocation := false;
  64. end
  65. end;
  66. Procedure Errno2InOutRes;
  67. {
  68. Convert ErrNo error to the correct InOutRes value.
  69. It seems that some of the errno is, in macos,
  70. used for other purposes than its original definition.
  71. }
  72. begin
  73. if errno = 0 then { Else it will go through all the cases }
  74. exit;
  75. case Errno of
  76. Sys_ENFILE,
  77. Sys_EMFILE : Inoutres:=4;
  78. Sys_ENOENT : Inoutres:=2;
  79. Sys_EBADF : Inoutres:=6;
  80. Sys_ENOMEM,
  81. Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
  82. Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
  83. Sys_EAGAIN,
  84. Sys_ENOSPC : Inoutres:=101;
  85. Sys_ENOTDIR : Inoutres:=3;
  86. Sys_EPERM,
  87. Sys_EROFS,
  88. Sys_EEXIST,
  89. Sys_EISDIR,
  90. Sys_EINTR, //Happens when attempt to rename a file fails
  91. Sys_EBUSY, //Happens when attempt to remove a locked file
  92. Sys_EACCES,
  93. Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
  94. Sys_ENXIO : InOutRes:=152;
  95. Sys_ESPIPE : InOutRes:=156; //Illegal seek
  96. else
  97. InOutRes := Integer(errno);//TODO Exchange to something better
  98. end;
  99. errno:=0;
  100. end;
  101. Procedure OSErr2InOutRes(err: OSErr);
  102. begin
  103. InOutRes:= MacOSErr2RTEerr(err);
  104. end;
  105. {*****************************************************************************
  106. MacOS specific functions
  107. *****************************************************************************}
  108. var
  109. defaultCreator: OSType = $4D505320; {'MPS ' MPW Shell}
  110. //defaultCreator: OSType = $74747874; {'ttxt' Simple Text}
  111. defaultFileType: OSType = $54455854; {'TEXT'}
  112. procedure Yield;
  113. begin
  114. if StandAlone = 0 then
  115. SpinCursor(1);
  116. end;
  117. procedure SetDefaultMacOSFiletype(ftype: ShortString);
  118. begin
  119. if Length(ftype) = 4 then
  120. defaultFileType:= PLongWord(@ftype[1])^;
  121. end;
  122. procedure SetDefaultMacOSCreator(creator: ShortString);
  123. begin
  124. if Length(creator) = 4 then
  125. defaultCreator:= PLongWord(@creator[1])^;
  126. end;
  127. {
  128. $Log$
  129. Revision 1.2 2005-03-20 19:35:24 olle
  130. - removed FSpLocationFromFullPath
  131. Revision 1.1 2005/02/07 21:30:12 peter
  132. * system unit updated
  133. Revision 1.1 2005/02/06 16:57:18 peter
  134. * threads for go32v2,os,emx,netware
  135. Revision 1.1 2005/02/06 13:06:20 peter
  136. * moved file and dir functions to sysfile/sysdir
  137. * win32 thread in systemunit
  138. }