← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/morphos/sysfile.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/morphos/sysfile.inc
1
1
{
2
 
    $Id: sysfile.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
3
2
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 2001 by Free Pascal development team
 
3
    Copyright (c) 2005 by Free Pascal development team
5
4
 
6
 
    Low leve file functions
 
5
    Low level file functions
7
6
 
8
7
    See the file COPYING.FPC, included in this distribution,
9
8
    for details about the copyright.
14
13
 
15
14
 **********************************************************************}
16
15
 
 
16
{ Enable this for file handling debug }
 
17
{DEFINE MOSFPC_FILEDEBUG}
 
18
 
17
19
{*****************************************************************************
18
20
                  MorphOS File-handling Support Functions
19
21
*****************************************************************************}
23
25
  { manually on exit.                                                  }
24
26
  PFileList = ^TFileList;
25
27
  TFileList = record { no packed, must be correctly aligned }
26
 
    handle : LongInt;      { Handle to file    }
27
 
    next   : PFileList;    { Next file in list }
 
28
    handle   : LongInt;      { Handle to file     }
 
29
    next     : PFileList;    { Next file in list  }
 
30
    buffered : boolean;      { used buffered I/O? }
28
31
  end;
29
32
 
30
33
var
81
84
  if not inList then begin
82
85
    New(p);
83
86
    p^.handle:=h;
 
87
    p^.buffered:=False;
84
88
    p^.next:=l^.next;
85
89
    l^.next:=p;
86
 
  end;
 
90
  end
 
91
{$IFDEF MOSFPC_FILEDEBUG}
 
92
  else 
 
93
    RawDoFmt('FPC_FILE_DEBUG: Error! Trying add filehandle a filehandle twice: $%lx !'+#10,@h,pointer(1),nil);
 
94
{$ENDIF}
 
95
  ;
87
96
end;
88
97
 
89
98
{ Function to be called to remove a file from the list }
90
 
procedure RemoveFromList(var l: PFileList; h: LongInt); alias: 'REMOVEFROMLIST'; [public];
 
99
function RemoveFromList(var l: PFileList; h: LongInt): boolean; alias: 'REMOVEFROMLIST'; [public];
91
100
var
92
 
  p     : PFileList;
93
 
  inList: Boolean;
 
101
  p      : PFileList;
 
102
  inList : Boolean;
 
103
  tmpList: PFileList;
94
104
begin
95
 
  if l=nil then exit;
 
105
  inList:=False;
 
106
  if l=nil then begin
 
107
    RemoveFromList:=inList;
 
108
    exit;
 
109
  end;
96
110
 
97
 
  inList:=False;
98
111
  p:=l;
99
112
  while (p^.next<>nil) and (not inList) do
100
113
    if p^.next^.handle=h then inList:=True
101
114
                         else p:=p^.next;
102
 
 
103
 
  if p^.next<>nil then begin
 
115
  
 
116
  if inList then begin
 
117
    tmpList:=p^.next^.next;
104
118
    dispose(p^.next);
105
 
    p^.next:=p^.next^.next;
 
119
    p^.next:=tmpList;
 
120
  end
 
121
{$IFDEF MOSFPC_FILEDEBUG}
 
122
  else 
 
123
    RawDoFmt('FPC_FILE_DEBUG: Error! Trying to remove not existing filehandle: $%lx !'+#10,@h,pointer(1),nil);
 
124
{$ENDIF}
 
125
  ;
 
126
 
 
127
  RemoveFromList:=inList;
 
128
end;
 
129
 
 
130
{ Function to check if file is in the list }
 
131
function CheckInList(var l: PFileList; h: LongInt): pointer; alias: 'CHECKINLIST'; [public];
 
132
var
 
133
  p      : PFileList;
 
134
  inList : Pointer;
 
135
  tmpList: PFileList;
 
136
  
 
137
begin
 
138
  inList:=nil;
 
139
  if l=nil then begin
 
140
    CheckInList:=inList;
 
141
    exit;
106
142
  end;
 
143
 
 
144
  p:=l;
 
145
  while (p^.next<>nil) and (inList=nil) do
 
146
    if p^.next^.handle=h then inList:=p^.next
 
147
                         else p:=p^.next;
 
148
 
 
149
{$IFDEF MOSFPC_FILEDEBUG}
 
150
  if inList=nil then
 
151
    RawDoFmt('FPC_FILE_DEBUG: Warning! Check for not existing filehandle: $%lx !'+#10,@h,pointer(1),nil);
 
152
{$ENDIF}
 
153
 
 
154
  CheckInList:=inList;
107
155
end;
108
156
 
109
157
 
115
163
{ close a file from the handle value }
116
164
procedure do_close(handle : longint);
117
165
begin
118
 
  if (handle<=0) then exit;
119
 
 
120
 
  RemoveFromList(MOS_fileList,handle);
121
 
  { Do _NOT_ check CTRL_C on Close, because it will conflict
122
 
    with System_Exit! }
123
 
  if not dosClose(handle) then
124
 
    dosError2InOut(IoErr);
 
166
  if RemoveFromList(MOS_fileList,handle) then begin
 
167
    { Do _NOT_ check CTRL_C on Close, because it will conflict
 
168
      with System_Exit! }
 
169
    if not dosClose(handle) then
 
170
      dosError2InOut(IoErr);
 
171
  end;
125
172
end;
126
173
 
127
174
procedure do_erase(p : pchar);
 
175
var
 
176
  tmpStr: array[0..255] of Char;
128
177
begin
 
178
  tmpStr:=PathConv(strpas(p))+#0;
129
179
  checkCTRLC;
130
 
  if not dosDeleteFile(p) then
 
180
  if not dosDeleteFile(@tmpStr) then
131
181
    dosError2InOut(IoErr);
132
182
end;
133
183
 
134
184
procedure do_rename(p1,p2 : pchar);
 
185
{ quite stack-effective code, huh? :) damn path conversions... (KB) }
 
186
var
 
187
  tmpStr1: array[0..255] of Char;
 
188
  tmpStr2: array[0..255] of Char;
135
189
begin
 
190
  tmpStr1:=PathConv(strpas(p1))+#0;
 
191
  tmpStr2:=PathConv(strpas(p2))+#0;
136
192
  checkCTRLC;
137
 
  if not dosRename(p1,p2) then
 
193
  if not dosRename(@tmpStr1,@tmpStr2) then
138
194
    dosError2InOut(IoErr);
139
195
end;
140
196
 
141
 
function do_write(h:longint; addr: pointer; len: longint) : longint;
 
197
function do_write(h: longint; addr: pointer; len: longint) : longint;
142
198
var dosResult: LongInt;
143
199
begin
144
200
  checkCTRLC;
145
201
  do_write:=0;
146
202
  if (len<=0) or (h<=0) then exit;
147
203
 
 
204
{$IFDEF MOSFPC_FILEDEBUG}
 
205
  if not ((h=StdOutputHandle) or (h=StdInputHandle) or
 
206
     (h=StdErrorHandle)) then CheckInList(MOS_fileList,h);
 
207
{$ENDIF}
 
208
 
148
209
  dosResult:=dosWrite(h,addr,len);
149
210
  if dosResult<0 then begin
150
211
    dosError2InOut(IoErr);
153
214
  end;
154
215
end;
155
216
 
156
 
function do_read(h:longint; addr: pointer; len: longint) : longint;
 
217
function do_read(h: longint; addr: pointer; len: longint) : longint;
157
218
var dosResult: LongInt;
158
219
begin
159
220
  checkCTRLC;
160
221
  do_read:=0;
161
222
  if (len<=0) or (h<=0) then exit;
162
223
 
 
224
{$IFDEF MOSFPC_FILEDEBUG}
 
225
  if not ((h=StdOutputHandle) or (h=StdInputHandle) or
 
226
     (h=StdErrorHandle)) then CheckInList(MOS_fileList,h);
 
227
{$ENDIF}
 
228
 
163
229
  dosResult:=dosRead(h,addr,len);
164
230
  if dosResult<0 then begin
165
231
    dosError2InOut(IoErr);
168
234
  end
169
235
end;
170
236
 
171
 
function do_filepos(handle : longint) : longint;
 
237
function do_filepos(handle: longint) : longint;
172
238
var dosResult: LongInt;
173
239
begin
174
240
  checkCTRLC;
175
241
  do_filepos:=-1;
176
 
  if (handle<=0) then exit;
177
 
 
178
 
  { Seeking zero from OFFSET_CURRENT to find out where we are }
179
 
  dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
180
 
  if dosResult<0 then begin
181
 
    dosError2InOut(IoErr);
182
 
  end else begin
183
 
    do_filepos:=dosResult;
 
242
  if CheckInList(MOS_fileList,handle)<>nil then begin
 
243
 
 
244
    { Seeking zero from OFFSET_CURRENT to find out where we are }
 
245
    dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
 
246
    if dosResult<0 then begin
 
247
      dosError2InOut(IoErr);
 
248
    end else begin
 
249
      do_filepos:=dosResult;
 
250
    end;
 
251
 
184
252
  end;
185
253
end;
186
254
 
187
 
procedure do_seek(handle,pos : longint);
 
255
procedure do_seek(handle, pos: longint);
188
256
begin
189
257
  checkCTRLC;
190
 
  if (handle<=0) then exit;
191
 
 
192
 
  { Seeking from OFFSET_BEGINNING }
193
 
  if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
194
 
    dosError2InOut(IoErr);
 
258
  if CheckInList(MOS_fileList,handle)<>nil then begin
 
259
 
 
260
    { Seeking from OFFSET_BEGINNING }
 
261
    if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
 
262
      dosError2InOut(IoErr);
 
263
 
 
264
  end;
195
265
end;
196
266
 
197
 
function do_seekend(handle:longint):longint;
 
267
function do_seekend(handle: longint):longint;
198
268
var dosResult: LongInt;
199
269
begin
200
270
  checkCTRLC;
201
271
  do_seekend:=-1;
202
 
  if (handle<=0) then exit;
203
 
 
204
 
  { Seeking to OFFSET_END }
205
 
  dosResult:=dosSeek(handle,0,OFFSET_END);
206
 
  if dosResult<0 then begin
207
 
    dosError2InOut(IoErr);
208
 
  end else begin
209
 
    do_seekend:=dosResult;
210
 
  end
 
272
  if CheckInList(MOS_fileList,handle)<>nil then begin
 
273
 
 
274
    { Seeking to OFFSET_END }
 
275
    dosResult:=dosSeek(handle,0,OFFSET_END);
 
276
    if dosResult<0 then begin
 
277
      dosError2InOut(IoErr);
 
278
    end else begin
 
279
      do_seekend:=dosResult;
 
280
    end;
 
281
 
 
282
  end;
211
283
end;
212
284
 
213
285
function do_filesize(handle : longint) : longint;
215
287
begin
216
288
  checkCTRLC;
217
289
  do_filesize:=-1;
218
 
  if (handle<=0) then exit;
219
 
 
220
 
  currfilepos:=do_filepos(handle);
221
 
  { We have to do this twice, because seek returns the OLD position }
222
 
  do_filesize:=do_seekend(handle);
223
 
  do_filesize:=do_seekend(handle);
224
 
  do_seek(handle,currfilepos)
 
290
  if CheckInList(MOS_fileList,handle)<>nil then begin
 
291
 
 
292
    currfilepos:=do_filepos(handle);
 
293
    { We have to do this twice, because seek returns the OLD position }
 
294
    do_filesize:=do_seekend(handle);
 
295
    do_filesize:=do_seekend(handle);
 
296
    do_seek(handle,currfilepos);
 
297
 
 
298
  end;
225
299
end;
226
300
 
227
301
{ truncate at a given position }
228
 
procedure do_truncate (handle,pos:longint);
 
302
procedure do_truncate(handle, pos: longint);
229
303
begin
230
304
  checkCTRLC;
231
 
  if (handle<=0) then exit;
232
 
 
233
 
  { Seeking from OFFSET_BEGINNING }
234
 
  if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
235
 
    dosError2InOut(IoErr);
 
305
  if CheckInList(MOS_fileList,handle)<>nil then begin
 
306
 
 
307
    { Seeking from OFFSET_BEGINNING }
 
308
    if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
 
309
      dosError2InOut(IoErr);
 
310
 
 
311
  end;
236
312
end;
237
313
 
238
314
procedure do_open(var f;p:pchar;flags:longint);
308
384
  end;
309
385
end;
310
386
 
311
 
function do_isdevice(handle:longint):boolean;
 
387
function do_isdevice(handle: longint): boolean;
312
388
begin
313
389
  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
314
390
     (handle=StdErrorHandle) then
317
393
    do_isdevice:=False;
318
394
end;
319
395
 
320
 
 
321
 
{
322
 
   $Log: sysfile.inc,v $
323
 
   Revision 1.2  2005/02/14 17:13:30  peter
324
 
     * truncate log
325
 
 
326
 
   Revision 1.1  2005/02/07 21:30:12  peter
327
 
     * system unit updated
328
 
 
329
 
   Revision 1.1  2005/02/06 16:57:18  peter
330
 
     * threads for go32v2,os,emx,netware
331
 
 
332
 
   Revision 1.1  2005/02/06 13:06:20  peter
333
 
     * moved file and dir functions to sysfile/sysdir
334
 
     * win32 thread in systemunit
335
 
 
336
 
}
337