← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/macos/sysos.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

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