← Back to branch summary

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

« back to all changes in this revision

Viewing changes to rtl/macos/sysfile.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/sysfile.inc
 
1
{
 
2
    $Id: sysfile.inc,v 1.4 2005/04/28 18:21:04 olle Exp $
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 2001-2005 by Free Pascal development team
 
5
 
 
6
    Low level file functions
 
7
 
 
8
    See the file COPYING.FPC, included in this distribution,
 
9
    for details about the copyright.
 
10
 
 
11
    This program is distributed in the hope that it will be useful,
 
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
14
 
 
15
 **********************************************************************}
 
16
 
 
17
{*****************************************************************************
 
18
                          Low Level File Routines
 
19
 ****************************************************************************}
 
20
 
 
21
function do_isdevice(handle:longint):boolean;
 
22
begin
 
23
  do_isdevice:=false;
 
24
end;
 
25
 
 
26
{ close a file from the handle value }
 
27
procedure do_close(h : longint);
 
28
var
 
29
  err: OSErr;
 
30
{Ignore error handling, according to the other targets, which seems reasonable,
 
31
because close might be used to clean up after an error.}
 
32
begin
 
33
  {$ifdef MACOS_USE_STDCLIB}
 
34
  c_close(h);
 
35
  errno:= 0;
 
36
  {$else}
 
37
  err:= FSClose(h);
 
38
  // OSErr2InOutRes(err);
 
39
  {$endif}
 
40
end;
 
41
 
 
42
procedure do_erase(p : pchar);
 
43
 
 
44
var
 
45
  spec: FSSpec;
 
46
  err: OSErr;
 
47
  res: Integer;
 
48
 
 
49
begin
 
50
  res:= PathArgToFSSpec(p, spec);
 
51
  if (res = 0) then
 
52
    begin
 
53
      if not IsDirectory(spec) then
 
54
        begin
 
55
          err:= FSpDelete(spec);
 
56
          OSErr2InOutRes(err);
 
57
        end
 
58
      else
 
59
        InOutRes:= 2;
 
60
    end
 
61
  else
 
62
    InOutRes:=res;
 
63
end;
 
64
 
 
65
procedure do_rename(p1,p2 : pchar);
 
66
var
 
67
  s1,s2: AnsiString;
 
68
begin
 
69
  {$ifdef MACOS_USE_STDCLIB}
 
70
  InOutRes:= PathArgToFullPath(p1, s1);
 
71
  if InOutRes <> 0 then
 
72
    exit;
 
73
  InOutRes:= PathArgToFullPath(p2, s2);
 
74
  if InOutRes <> 0 then
 
75
    exit;
 
76
  c_rename(PChar(s1),PChar(s2));
 
77
  Errno2InoutRes;
 
78
  {$else}
 
79
  InOutRes:=1;
 
80
  {$endif}
 
81
end;
 
82
 
 
83
function do_write(h:longint;addr:pointer;len : longint) : longint;
 
84
begin
 
85
  {$ifdef MACOS_USE_STDCLIB}
 
86
  do_write:= c_write(h, addr, len);
 
87
  Errno2InoutRes;
 
88
  {$else}
 
89
  InOutRes:=1;
 
90
  if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
 
91
    InOutRes:=0;
 
92
  do_write:= len;
 
93
  {$endif}
 
94
end;
 
95
 
 
96
function do_read(h:longint;addr:pointer;len : longint) : longint;
 
97
 
 
98
var
 
99
  i: Longint;
 
100
 
 
101
begin
 
102
  {$ifdef MACOS_USE_STDCLIB}
 
103
  len:= c_read(h, addr, len);
 
104
  Errno2InoutRes;
 
105
 
 
106
  do_read:= len;
 
107
 
 
108
  {$else}
 
109
  InOutRes:=1;
 
110
  if FSread(h, len, Mac_Ptr(addr)) = noErr then
 
111
    InOutRes:=0;
 
112
  do_read:= len;
 
113
  {$endif}
 
114
end;
 
115
 
 
116
function do_filepos(handle : longint) : longint;
 
117
 
 
118
var
 
119
  pos: Longint;
 
120
 
 
121
begin
 
122
  {$ifdef MACOS_USE_STDCLIB}
 
123
  {This returns the filepos without moving it.}
 
124
  do_filepos := lseek(handle, 0, SEEK_CUR);
 
125
  Errno2InoutRes;
 
126
  {$else}
 
127
  InOutRes:=1;
 
128
  if GetFPos(handle, pos) = noErr then
 
129
    InOutRes:=0;
 
130
  do_filepos:= pos;
 
131
  {$endif}
 
132
end;
 
133
 
 
134
procedure do_seek(handle,pos : longint);
 
135
begin
 
136
  {$ifdef MACOS_USE_STDCLIB}
 
137
  lseek(handle, pos, SEEK_SET);
 
138
  Errno2InoutRes;
 
139
  {$else}
 
140
  InOutRes:=1;
 
141
  if SetFPos(handle, fsFromStart, pos) = noErr then
 
142
    InOutRes:=0;
 
143
  {$endif}
 
144
end;
 
145
 
 
146
function do_seekend(handle:longint):longint;
 
147
begin
 
148
  {$ifdef MACOS_USE_STDCLIB}
 
149
  do_seekend:= lseek(handle, 0, SEEK_END);
 
150
  Errno2InoutRes;
 
151
  {$else}
 
152
  InOutRes:=1;
 
153
  if SetFPos(handle, fsFromLEOF, 0) = noErr then
 
154
    InOutRes:=0;
 
155
  {TODO Resulting file position is to be returned.}
 
156
  {$endif}
 
157
end;
 
158
 
 
159
function do_filesize(handle : longint) : longint;
 
160
 
 
161
var
 
162
  aktfilepos: Longint;
 
163
 
 
164
begin
 
165
  {$ifdef MACOS_USE_STDCLIB}
 
166
  aktfilepos:= lseek(handle, 0, SEEK_CUR);
 
167
  if errno = 0 then
 
168
    begin
 
169
      do_filesize := lseek(handle, 0, SEEK_END);
 
170
      Errno2InOutRes; {Report the error from this operation.}
 
171
      lseek(handle, aktfilepos, SEEK_SET);   {Always try to move back,
 
172
         even in presence of error.}
 
173
    end
 
174
  else
 
175
    Errno2InOutRes;
 
176
  {$else}
 
177
  InOutRes:=1;
 
178
  if GetEOF(handle, pos) = noErr then
 
179
    InOutRes:=0;
 
180
  do_filesize:= pos;
 
181
  {$endif}
 
182
end;
 
183
 
 
184
{ truncate at a given position }
 
185
procedure do_truncate (handle,pos:longint);
 
186
begin
 
187
  {$ifdef MACOS_USE_STDCLIB}
 
188
  ioctl(handle, FIOSETEOF, pointer(pos));
 
189
  Errno2InoutRes;
 
190
  {$else}
 
191
  InOutRes:=1;
 
192
  do_seek(handle,pos);  //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
 
193
  if SetEOF(handle, pos) = noErr then
 
194
    InOutRes:=0;
 
195
  {$endif}
 
196
end;
 
197
 
 
198
procedure do_open(var f;p:pchar;flags:longint);
 
199
{
 
200
  filerec and textrec have both handle and mode as the first items so
 
201
  they could use the same routine for opening/creating.
 
202
  when (flags and $100)   the file will be append
 
203
  when (flags and $1000)  the file will be truncate/rewritten
 
204
  when (flags and $10000) there is no check for close (needed for textfiles)
 
205
}
 
206
 
 
207
var
 
208
  scriptTag: ScriptCode;
 
209
  refNum: Integer;
 
210
 
 
211
  err: OSErr;
 
212
  res: Integer;
 
213
  spec: FSSpec;
 
214
 
 
215
  fh: Longint;
 
216
 
 
217
  oflags : longint;
 
218
  fullPath: AnsiString;
 
219
 
 
220
  finderInfo: FInfo;
 
221
 
 
222
begin
 
223
 
 
224
{ close first if opened }
 
225
  if ((flags and $10000)=0) then
 
226
   begin
 
227
     case filerec(f).mode of
 
228
       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
 
229
       fmclosed : ;
 
230
     else
 
231
      begin
 
232
        {not assigned}
 
233
        inoutres:=102;
 
234
        exit;
 
235
      end;
 
236
     end;
 
237
   end;
 
238
 
 
239
{ reset file handle }
 
240
  filerec(f).handle:=UnusedHandle;
 
241
 
 
242
  {$ifdef MACOS_USE_STDCLIB}
 
243
 
 
244
{ We do the conversion of filemodes here, concentrated on 1 place }
 
245
  case (flags and 3) of
 
246
   0 : begin
 
247
         oflags :=O_RDONLY;
 
248
         filerec(f).mode:=fminput;
 
249
       end;
 
250
   1 : begin
 
251
         oflags :=O_WRONLY;
 
252
         filerec(f).mode:=fmoutput;
 
253
       end;
 
254
   2 : begin
 
255
         oflags :=O_RDWR;
 
256
         filerec(f).mode:=fminout;
 
257
       end;
 
258
  end;
 
259
 
 
260
  if (flags and $1000)=$1000 then
 
261
    oflags:=oflags or (O_CREAT or O_TRUNC)
 
262
  else if (flags and $100)=$100 then
 
263
    oflags:=oflags or (O_APPEND);
 
264
 
 
265
{ empty name is special }
 
266
  if p[0]=#0 then
 
267
   begin
 
268
     case FileRec(f).mode of
 
269
       fminput :
 
270
         FileRec(f).Handle:=StdInputHandle;
 
271
       fminout, { this is set by rewrite }
 
272
       fmoutput :
 
273
         FileRec(f).Handle:=StdOutputHandle;
 
274
       fmappend :
 
275
         begin
 
276
           FileRec(f).Handle:=StdOutputHandle;
 
277
           FileRec(f).mode:=fmoutput; {fool fmappend}
 
278
         end;
 
279
     end;
 
280
     exit;
 
281
   end
 
282
  else
 
283
    begin
 
284
      InOutRes:= PathArgToFSSpec(p, spec);
 
285
      if (InOutRes = 0) or (InOutRes = 2) then
 
286
        begin
 
287
          err:= FSpGetFullPath(spec, fullPath, false);
 
288
          InOutRes:= MacOSErr2RTEerr(err);
 
289
        end;
 
290
      if InOutRes <> 0 then
 
291
        exit;
 
292
 
 
293
      p:= PChar(fullPath);
 
294
    end;
 
295
 
 
296
 
 
297
  fh:= c_open(p, oflags);
 
298
  if (fh = -1) and (errno = Sys_EROFS) and ((oflags and O_RDWR)<>0) then
 
299
    begin
 
300
      oflags:=oflags and not(O_RDWR);
 
301
      fh:= c_open(p, oflags);
 
302
    end;
 
303
  Errno2InOutRes;
 
304
  if fh <> -1 then
 
305
    begin
 
306
      if FileRec(f).mode in [fmoutput, fminout, fmappend] then
 
307
        begin
 
308
          {Change of filetype and creator is always done when a file is opened
 
309
          for some kind of writing. This ensures overwritten Darwin files will
 
310
          get apropriate filetype. It must be done after file is opened,
 
311
          in the case the file did not previously exist.}
 
312
 
 
313
          FSpGetFInfo(spec, finderInfo);
 
314
          finderInfo.fdType:= defaultFileType;
 
315
          finderInfo.fdCreator:= defaultCreator;
 
316
          FSpSetFInfo(spec, finderInfo);
 
317
        end;
 
318
      filerec(f).handle:= fh;
 
319
    end
 
320
  else
 
321
    filerec(f).handle:= UnusedHandle;
 
322
 
 
323
  {$else}
 
324
 
 
325
  InOutRes:=1;
 
326
 
 
327
  { reset file handle }
 
328
  filerec(f).handle:=UnusedHandle;
 
329
 
 
330
  res:= FSpLocationFromFullPath(StrLen(p), p, spec);
 
331
  if (res = noErr) or (res = fnfErr) then
 
332
    begin
 
333
      if FSpCreate(spec, defaultCreator, defaultFileType, smSystemScript) = noErr then
 
334
        ;
 
335
 
 
336
      if FSpOpenDF(spec, fsCurPerm, refNum) = noErr then
 
337
        begin
 
338
          filerec(f).handle:= refNum;
 
339
          InOutRes:=0;
 
340
        end;
 
341
    end;
 
342
 
 
343
  if (filerec(f).handle=UnusedHandle) then
 
344
    begin
 
345
      //errno:=GetLastError;
 
346
      //Errno2InoutRes;
 
347
    end;
 
348
  {$endif}
 
349
end;
 
350
 
 
351
 
 
352
{
 
353
   $Log: sysfile.inc,v $
 
354
   Revision 1.4  2005/04/28 18:21:04  olle
 
355
     * Set errno to zero after close
 
356
 
 
357
   Revision 1.3  2005/03/20 19:37:31  olle
 
358
     + Added optional path translation mechanism
 
359
 
 
360
   Revision 1.2  2005/02/14 17:13:30  peter
 
361
     * truncate log
 
362
 
 
363
   Revision 1.1  2005/02/07 21:30:12  peter
 
364
     * system unit updated
 
365
 
 
366
   Revision 1.1  2005/02/06 16:57:18  peter
 
367
     * threads for go32v2,os,emx,netware
 
368
 
 
369
   Revision 1.1  2005/02/06 13:06:20  peter
 
370
     * moved file and dir functions to sysfile/sysdir
 
371
     * win32 thread in systemunit
 
372
 
 
373
}
 
374