1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
{
This file is part of the Free Pascal run time library.
Main OS dependant body of the system unit, loosely modelled
after POSIX. *BSD version (Linux version is near identical)
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.
**********************************************************************}
Procedure Do_Close(Handle:thandle);
var
res: cint;
Begin
repeat
res:=Fpclose(cint(Handle));
until (res<>-1) or (geterrno<>ESysEINTR);
End;
Procedure Do_Erase(p: pchar; pchangeable: boolean);
var
fileinfo : stat;
Begin
{ verify if the filename is actually a directory }
{ if so return error and do nothing, as defined }
{ by POSIX }
if Fpstat(p,fileinfo)<0 then
begin
Errno2Inoutres;
exit;
end;
if FpS_ISDIR(fileinfo.st_mode) then
begin
InOutRes := 2;
exit;
end;
if Fpunlink(p)<0 then
Errno2Inoutres
Else
InOutRes:=0;
End;
{ truncate at a given position }
procedure do_truncate (handle:thandle;fpos:longint);
begin
{ should be simulated in cases where it is not }
{ available. }
If Fpftruncate(handle,fpos)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
end;
Procedure Do_Rename(p1,p2:pchar; p1changeable, p2changeable: boolean);
Begin
If Fprename(p1,p2)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
var j : cint;
Begin
repeat
Do_Write:=Fpwrite(Handle,addr,len);
j:=geterrno;
until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Write<0 Then
Begin
Errno2InOutRes;
Do_Write:=0;
End
else
InOutRes:=0;
End;
Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
var j:cint;
Begin
repeat
Do_Read:=Fpread(Handle,addr,len);
j:=geterrno;
until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Read<0 Then
Begin
Errno2InOutRes;
Do_Read:=0;
End
else
InOutRes:=0;
End;
function Do_FilePos(Handle: thandle):Int64;
Begin
do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
If Do_FilePos<0 Then
Errno2InOutRes
else
InOutRes:=0;
End;
Procedure Do_Seek(Handle:thandle;Pos:Int64);
Begin
If Fplseek(Handle, pos, SEEK_SET)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Function Do_SeekEnd(Handle:thandle):Int64;
begin
Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
If Do_SeekEnd<0 Then
Errno2Inoutres
Else
InOutRes:=0;
end;
Function Do_FileSize(Handle:thandle):Int64;
var
Info : Stat;
Ret : Longint;
Begin
Ret:=Fpfstat(handle,info);
If Ret=0 Then
Do_FileSize:=Info.st_size
else
Do_FileSize:=0;
If Ret<0 Then
Errno2InOutRes
Else
InOutRes:=0;
End;
Procedure Do_Open(var f; p: pchar; flags: longint; pchangeable: boolean);
{
FileRec and textrec have both Handle and mode as the first items so
they could use the same routine for opening/creating.
when (flags and $100) the file will be append
when (flags and $1000) the file will be truncate/rewritten
when (flags and $10000) there is no check for close (needed for textfiles)
}
const
{ read/write permission for everyone }
MODE_OPEN = S_IWUSR OR S_IRUSR OR
S_IWGRP OR S_IRGRP OR
S_IWOTH OR S_IROTH;
var
oflags : cint;
Begin
{ close first if opened }
if ((flags and $10000)=0) then
begin
case FileRec(f).mode of
fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
fmclosed : ;
else
begin
inoutres:=102; {not assigned}
exit;
end;
end;
end;
{ reset file Handle }
FileRec(f).Handle:=UnusedHandle;
{ We do the conversion of filemodes here, concentrated on 1 place }
case (flags and 3) of
0 : begin
oflags :=O_RDONLY;
FileRec(f).mode:=fminput;
end;
1 : begin
oflags :=O_WRONLY;
FileRec(f).mode:=fmoutput;
end;
2 : begin
oflags :=O_RDWR;
FileRec(f).mode:=fminout;
end;
end;
if (flags and $1000)=$1000 then
oflags:=oflags or (O_CREAT or O_TRUNC)
else
if (flags and $100)=$100 then
oflags:=oflags or (O_APPEND);
{ empty name is special }
if p[0]=#0 then
begin
case FileRec(f).mode of
fminput :
FileRec(f).Handle:=StdInputHandle;
fminout, { this is set by rewrite }
fmoutput :
FileRec(f).Handle:=StdOutputHandle;
fmappend :
begin
FileRec(f).Handle:=StdOutputHandle;
FileRec(f).mode:=fmoutput; {fool fmappend}
end;
end;
exit;
end;
{ real open call }
repeat
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
until (FileRec(f).Handle<>-1) or (geterrno<>ESysEINTR);
if (FileRec(f).Handle<0) and
(getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
begin
Oflags:=Oflags and not(O_RDWR);
repeat
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
until (FileRec(f).Handle<>-1) or (geterrno<>ESysEINTR);
end;
If Filerec(f).Handle<0 Then
Errno2Inoutres
else
InOutRes:=0;
End;
|
