|
a |
|
b/FileSystem.MRI.mi |
|
|
1 |
IMPLEMENTATION MODULE FileSystem;
|
|
|
2 |
|
|
|
3 |
(*------------------------------------------------------------------------*)
|
|
|
4 |
(* Implementation einer Dateisystemschittstelle f"ur Modula-2 *)
|
|
|
5 |
(* (MtC, MOCKA, XDS M2, GM2). *)
|
|
|
6 |
(* Implementation of a file system interface for Modula-2 *)
|
|
|
7 |
(* (MtC, MOCKA, XDS M2, GM2). *)
|
|
|
8 |
(*------------------------------------------------------------------------*)
|
|
|
9 |
(* Letzte Aenderung: *)
|
|
|
10 |
(* *)
|
|
|
11 |
(* 91, MRi: Erstellen der ersten Version fuer JPI M2 *)
|
|
|
12 |
(* 13.05.93, MRi: Erstellen der ersten Version (MtC) *)
|
|
|
13 |
(* 06.01.98, MRi: Anpassungen an Mocka. *)
|
|
|
14 |
(* 28.11.14, MRi: Anpassungen an XDS / GM2 *)
|
|
|
15 |
(* 08.01.15, MRi: Ersetzen des Aufrufs von stat durch fstat *)
|
|
|
16 |
(* 25.02.16, MRi: Einfuehrung der Prozedur IsOpen *)
|
|
|
17 |
(* 31.10.16, MRi: RdBinObj & WrBinObj eingefuehrt *)
|
|
|
18 |
(* 19.01.18, MRi: Prozedur Rewindn und OpenLargeFiel, Felder IsLarge und *)
|
|
|
19 |
(* OpenModes eingefuehrt. Unterstuetzung von *)
|
|
|
20 |
(* Dateien > 2**31-1 hinzugefuegt. *)
|
|
|
21 |
(*------------------------------------------------------------------------*)
|
|
|
22 |
(* Offene Punkte *)
|
|
|
23 |
(* *)
|
|
|
24 |
(* - Prozeduren Lookup und Rewrite durchsehen - eventuell kann dass *)
|
|
|
25 |
(* Loeschen und Wiederanlegen eine Datei bei "create" als *)
|
|
|
26 |
(* OS/2 Relikt entfallen. *)
|
|
|
27 |
(* - UseStat = TRUE resultiert in einem Fehler unter XDS *)
|
|
|
28 |
(* Auf Linux64 mit GM2 laeuft es nach Korrektur der Definition des *)
|
|
|
29 |
(* Stat-RECORDS. *)
|
|
|
30 |
(*------------------------------------------------------------------------*)
|
|
|
31 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
|
|
32 |
(*------------------------------------------------------------------------*)
|
|
|
33 |
|
|
|
34 |
(* $Id: FileSystem.mod,v 1.2 2016/11/22 22:21:35 mriedl Exp mriedl $ *)
|
|
|
35 |
|
|
|
36 |
FROM SYSTEM IMPORT TSIZE,BYTE,ADR,CAST;
|
|
|
37 |
FROM UnixLib IMPORT open,lseek,open64,lseek64,
|
|
|
38 |
close,read,write,unlink,Stat,fstat,chmod,sync,
|
|
|
39 |
LockExclusive,LockUnlock,LockNoblock,flock;
|
|
|
40 |
IMPORT UnixLib; (* SIGNED *)
|
|
|
41 |
IMPORT fslength;
|
|
|
42 |
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
|
|
|
43 |
IMPORT StringsLib;
|
|
|
44 |
FROM Errors IMPORT Fehler,Fehlerflag,ErrOut,FatalError;
|
|
|
45 |
IMPORT Errors;
|
|
|
46 |
|
|
|
47 |
(*--------------------------- Lokale Objekte --------------------------------*)
|
|
|
48 |
|
|
|
49 |
TYPE OpenModeRec = RECORD (* Eingef"ugt 28.11.14 *)
|
|
|
50 |
CASE : INTEGER OF
|
|
|
51 |
| 1: openmode : OpenMode;
|
|
|
52 |
| 2: int : INTEGER; (* avoid type cast *)
|
|
|
53 |
ELSE
|
|
|
54 |
END;
|
|
|
55 |
END;
|
|
|
56 |
|
|
|
57 |
AccessModeRec = RECORD
|
|
|
58 |
CASE : INTEGER OF
|
|
|
59 |
| 1: accessmode : AccessMode;
|
|
|
60 |
| 2: int : INTEGER; (* s.o. *)
|
|
|
61 |
ELSE
|
|
|
62 |
END;
|
|
|
63 |
END;
|
|
|
64 |
|
|
|
65 |
CONST MaxOpenFiles = 36; (* _POSIX_OPEN_MAX *)
|
|
|
66 |
MaxDateiNamenLaenge = 255; (* _POSIX_PATH_MAX *)
|
|
|
67 |
SeekCur = 2;
|
|
|
68 |
Debug = FALSE;
|
|
|
69 |
UseStat = FALSE; (* TRUE fuer GM2 64 bit, XDS auf 32 bit *)
|
|
|
70 |
|
|
|
71 |
VAR DateiNamen : ARRAY [0..MaxOpenFiles-1] OF POINTER TO
|
|
|
72 |
ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
73 |
Geoeffnet : ARRAY [0..MaxOpenFiles-1] OF BOOLEAN;
|
|
|
74 |
IsLarge : ARRAY [0..MaxOpenFiles-1] OF BOOLEAN;
|
|
|
75 |
(*
|
|
|
76 |
* Fuer Zukuenftige Nutzung um bei ReWrite die Oeffnungsmodi
|
|
|
77 |
* beruecksichtigen zu k"onnen.
|
|
|
78 |
*)
|
|
|
79 |
OpenModes : ARRAY [0..MaxOpenFiles-1] OF UnixLib.SIGNED;
|
|
|
80 |
|
|
|
81 |
PROCEDURE StoreFileName(f : File; (* Kanalnummer *)
|
|
|
82 |
Name : ARRAY OF CHAR); (* Dateiname *)
|
|
|
83 |
|
|
|
84 |
(*-----------------------------------------------------------------*)
|
|
|
85 |
(* Speichert die Dateinamen aller ge\"offneten Dateien in dem *)
|
|
|
86 |
(* globalen Zeigerfeld Dateinamen. *)
|
|
|
87 |
(*-----------------------------------------------------------------*)
|
|
|
88 |
|
|
|
89 |
BEGIN
|
|
|
90 |
IF (DateiNamen[f] # NIL) OR Geoeffnet[f] THEN
|
|
|
91 |
IF Debug THEN
|
|
|
92 |
Errors.WriteString("Kanalnummer (StoreFileName) : ");
|
|
|
93 |
Errors.WriteCard(VAL(CARDINAL,f));
|
|
|
94 |
IF Geoeffnet[f] THEN Errors.WriteString(" Kanal geoeffnet !"); END;
|
|
|
95 |
IF DateiNamen[f] # NIL THEN
|
|
|
96 |
Errors.WriteString(" Dateiname nicht NIL !");
|
|
|
97 |
Errors.WriteLn;
|
|
|
98 |
Errors.WriteString(" Dateiname = ");
|
|
|
99 |
Errors.WriteString(DateiNamen[f]^);
|
|
|
100 |
Errors.WriteLn;
|
|
|
101 |
END;
|
|
|
102 |
Errors.WriteLn;
|
|
|
103 |
END;
|
|
|
104 |
ErrOut("in FileSystem.StoreFileName !");
|
|
|
105 |
END;
|
|
|
106 |
NEW(DateiNamen[f]);
|
|
|
107 |
IF (DateiNamen[f] = NIL) THEN
|
|
|
108 |
FatalError("Kein Freispeicher vorhanden (FileSystem.StoreFileName) !");
|
|
|
109 |
END;
|
|
|
110 |
IF Debug THEN
|
|
|
111 |
Errors.WriteString("StoreFileName : Datei (1) `"); Errors.WriteString(Name);
|
|
|
112 |
Errors.WriteChar("'"); Errors.WriteLn;
|
|
|
113 |
END;
|
|
|
114 |
StringsLib.Copy(DateiNamen[f]^,Name);
|
|
|
115 |
IF Debug THEN
|
|
|
116 |
Errors.WriteString("StoreFileName : Datei (2) `");
|
|
|
117 |
Errors.WriteString(DateiNamen[f]^);
|
|
|
118 |
Errors.WriteChar("'"); Errors.WriteLn;
|
|
|
119 |
END;
|
|
|
120 |
END StoreFileName;
|
|
|
121 |
|
|
|
122 |
PROCEDURE RemoveFileName(f : File); (* Kanalnummer *)
|
|
|
123 |
|
|
|
124 |
BEGIN
|
|
|
125 |
IF (DateiNamen[f] = NIL) OR (DateiNamen[f]^[0] = 0C) THEN
|
|
|
126 |
Fehlerflag:=
|
|
|
127 |
"Fehler in FileSystem.RemoveFileName !";
|
|
|
128 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
129 |
Fehler:=TRUE; RETURN;
|
|
|
130 |
ELSE
|
|
|
131 |
IF Debug THEN
|
|
|
132 |
Errors.WriteString("Dateiname #"); Errors.WriteString(DateiNamen[f]^);
|
|
|
133 |
Errors.WriteChar("#"); Errors.WriteLn;
|
|
|
134 |
END;
|
|
|
135 |
DISPOSE(DateiNamen[f]);
|
|
|
136 |
DateiNamen[f]:=NIL; (* MR, 15.02.2015 *)
|
|
|
137 |
END;
|
|
|
138 |
END RemoveFileName;
|
|
|
139 |
|
|
|
140 |
PROCEDURE IstZulaessigeKanalnummer(f : File) : BOOLEAN;
|
|
|
141 |
|
|
|
142 |
BEGIN
|
|
|
143 |
RETURN NOT ((f < 0) OR (f >= MaxOpenFiles));
|
|
|
144 |
END IstZulaessigeKanalnummer;
|
|
|
145 |
|
|
|
146 |
(*--------------------------- Globale Objekte --------------------------------*)
|
|
|
147 |
|
|
|
148 |
PROCEDURE GetFileName( f : File; (* Kanalnummer *)
|
|
|
149 |
VAR Name : ARRAY OF CHAR); (* Dateiname *)
|
|
|
150 |
|
|
|
151 |
BEGIN
|
|
|
152 |
IF NOT Geoeffnet[f] THEN
|
|
|
153 |
Name[0] := 0C;
|
|
|
154 |
ELSE
|
|
|
155 |
StringsLib.Copy(Name,DateiNamen[f]^);
|
|
|
156 |
END;
|
|
|
157 |
END GetFileName;
|
|
|
158 |
|
|
|
159 |
PROCEDURE IsOpen(f : File) : BOOLEAN;
|
|
|
160 |
|
|
|
161 |
BEGIN
|
|
|
162 |
IF (f < MaxOpenFiles) THEN
|
|
|
163 |
RETURN Geoeffnet[f];
|
|
|
164 |
ELSE
|
|
|
165 |
RETURN FALSE;
|
|
|
166 |
END;
|
|
|
167 |
END IsOpen;
|
|
|
168 |
|
|
|
169 |
PROCEDURE Lookup(VAR f : File;
|
|
|
170 |
Name : ARRAY OF CHAR;
|
|
|
171 |
creat : BOOLEAN;
|
|
|
172 |
OpenMask : OpenMode);
|
|
|
173 |
|
|
|
174 |
CONST debug = FALSE;
|
|
|
175 |
|
|
|
176 |
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
177 |
err : INTEGER;
|
|
|
178 |
OM : OpenModeRec;
|
|
|
179 |
OMloc : OpenModeRec;
|
|
|
180 |
islarge : BOOLEAN;
|
|
|
181 |
AccMode : UnixLib.modeT;
|
|
|
182 |
omode : UnixLib.SIGNED;
|
|
|
183 |
BEGIN
|
|
|
184 |
Fehler := FALSE;
|
|
|
185 |
IF (StringsLib.Length(Name) = 0) THEN
|
|
|
186 |
Fehlerflag:="Dateiname leer (FileSystem.Lookup) !";
|
|
|
187 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
188 |
Fehler:=TRUE; f:=-1;
|
|
|
189 |
RETURN;
|
|
|
190 |
END;
|
|
|
191 |
StringsLib.Copy(DName,Name); (* Wegen m"oglicherweise fehlendem 0C *)
|
|
|
192 |
|
|
|
193 |
IF debug THEN
|
|
|
194 |
Errors.WriteString(" Oeffnen/Erzeuge ... ");
|
|
|
195 |
Errors.WriteString(Name);
|
|
|
196 |
Errors.WriteLn;
|
|
|
197 |
END;
|
|
|
198 |
IF (openLARGEFILE IN OpenMask) THEN
|
|
|
199 |
IF debug THEN
|
|
|
200 |
Errors.WriteString("Oeffne eine 64 Bit Datei ... ");
|
|
|
201 |
Errors.WriteLn;
|
|
|
202 |
END;
|
|
|
203 |
islarge := TRUE;
|
|
|
204 |
ELSE
|
|
|
205 |
islarge := FALSE;
|
|
|
206 |
END;
|
|
|
207 |
|
|
|
208 |
(* "Offnen oder Erzeugen der Datei. *)
|
|
|
209 |
|
|
|
210 |
OM.openmode:=OpenMask;
|
|
|
211 |
|
|
|
212 |
IF creat THEN
|
|
|
213 |
OMloc.int:=0;
|
|
|
214 |
INCL(OMloc.openmode,openRDONLY);
|
|
|
215 |
IF islarge THEN
|
|
|
216 |
IF debug THEN
|
|
|
217 |
Errors.WriteString(" Datei 64 bit, oeffnen fuer test ... ");
|
|
|
218 |
Errors.WriteLn;
|
|
|
219 |
END;
|
|
|
220 |
INCL(OMloc.openmode,openLARGEFILE);
|
|
|
221 |
OMloc.int := ((OMloc.int + 0) DIV 2); (* Shift *)
|
|
|
222 |
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
|
|
|
223 |
f := open64(ADR(DName),OMloc.int,AccMode);
|
|
|
224 |
ELSE
|
|
|
225 |
IF debug THEN
|
|
|
226 |
Errors.WriteString(" Datei 32 bit, oeffnen fuer test ... ");
|
|
|
227 |
Errors.WriteLn;
|
|
|
228 |
END;
|
|
|
229 |
OMloc.int := ((OMloc.int + 0) DIV 2); (* Shift *)
|
|
|
230 |
f := open(ADR(DName),OMloc.int);
|
|
|
231 |
END;
|
|
|
232 |
|
|
|
233 |
IF debug THEN
|
|
|
234 |
IF (f = -1) THEN
|
|
|
235 |
Errors.WriteString(" Datei nicht vorhanden ... ");
|
|
|
236 |
Errors.WriteLn;
|
|
|
237 |
END;
|
|
|
238 |
END;
|
|
|
239 |
|
|
|
240 |
IF (f # -1) THEN (* Datei vorhanden, also L"oschen. *)
|
|
|
241 |
IF debug THEN
|
|
|
242 |
Errors.WriteString(" Datei vorhanden, also Loeschen ... ");
|
|
|
243 |
Errors.WriteLn;
|
|
|
244 |
END;
|
|
|
245 |
f := close(f);
|
|
|
246 |
f := unlink(ADR(DName));
|
|
|
247 |
IF (f = -1) THEN (* Datei nicht zu l"oschen ! *)
|
|
|
248 |
Fehler:=TRUE;
|
|
|
249 |
Fehlerflag:="Zugriff verweigert (FileSystem.Lookup) !";
|
|
|
250 |
fslength.SetErrFlag(Fehlerflag);
|
|
|
251 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
252 |
RETURN;
|
|
|
253 |
END;
|
|
|
254 |
END;
|
|
|
255 |
|
|
|
256 |
(* Datei (neu) anlegen. *)
|
|
|
257 |
IF debug THEN
|
|
|
258 |
Errors.WriteString(" Datei (neu) anlegen ... ");
|
|
|
259 |
Errors.WriteLn;
|
|
|
260 |
END;
|
|
|
261 |
INCL(OM.openmode,openCREAT);
|
|
|
262 |
IF islarge THEN
|
|
|
263 |
INCL(OM.openmode,openLARGEFILE);
|
|
|
264 |
(* Shift von OpenMask wegen "uberz"ahligem Bit 28.11.2014 *)
|
|
|
265 |
OM.int := ((OM.int + 0) DIV 2);
|
|
|
266 |
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
|
|
|
267 |
f := open64(ADR(DName),OM.int,AccMode);
|
|
|
268 |
ELSE
|
|
|
269 |
(* Shift von OpenMask wegen "uberz"ahligem Bit 28.11.2014 *)
|
|
|
270 |
OM.int := ((OM.int + 0) DIV 2);
|
|
|
271 |
f := open(ADR(DName),OM.int);
|
|
|
272 |
END;
|
|
|
273 |
omode := OM.int;
|
|
|
274 |
err := chmod(ADR(DName),CAST(INTEGER,defaultAccess));
|
|
|
275 |
|
|
|
276 |
ELSE (* "Offnen zum Lesen, Schreiben etc. *)
|
|
|
277 |
IF debug THEN
|
|
|
278 |
Errors.WriteString(" Datei Oeffen zum Lesen, Schreieb ... ");
|
|
|
279 |
Errors.WriteLn;
|
|
|
280 |
END;
|
|
|
281 |
IF islarge THEN
|
|
|
282 |
INCL(OM.openmode,openLARGEFILE);
|
|
|
283 |
OM.int := ((OM.int + 0) DIV 2);
|
|
|
284 |
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
|
|
|
285 |
f := open64(ADR(DName),OM.int,AccMode);
|
|
|
286 |
ELSE
|
|
|
287 |
OM.int := ((OM.int + 0) DIV 2);
|
|
|
288 |
f := open(ADR(DName),OM.int);
|
|
|
289 |
omode := OM.int;
|
|
|
290 |
END;
|
|
|
291 |
END;
|
|
|
292 |
|
|
|
293 |
IF (f = -1) THEN
|
|
|
294 |
IF creat THEN
|
|
|
295 |
Fehlerflag:="Fehler bei Erstellen der Datei '";
|
|
|
296 |
ELSE
|
|
|
297 |
Fehlerflag:="Fehler bei Oeffnen der Datei '";
|
|
|
298 |
END;
|
|
|
299 |
IF debug THEN
|
|
|
300 |
ErrOut(Fehlerflag);
|
|
|
301 |
END;
|
|
|
302 |
StringsLib.Append(Fehlerflag,DName);
|
|
|
303 |
StringsLib.Append(Fehlerflag,"' (FileSystem.Lookup) !");
|
|
|
304 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
305 |
Fehler:=TRUE; RETURN;
|
|
|
306 |
ELSIF (f >= MaxOpenFiles) THEN
|
|
|
307 |
Fehlerflag:="Zuviele geoeffnete Dateien (FileSystem.Lookup) !";
|
|
|
308 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
309 |
Fehler:=TRUE; f:=-1; RETURN;
|
|
|
310 |
ELSE (* Eintagen in die Liste der ge"offneten Dateien. *)
|
|
|
311 |
StoreFileName(f,DName);
|
|
|
312 |
Geoeffnet[f] := TRUE;
|
|
|
313 |
IsLarge [f] := islarge;
|
|
|
314 |
OpenModes[f] := omode; (* Speicher den Modus des Oeffnens *)
|
|
|
315 |
(* Sperren gegen Beschreiben durch andere Prozesse. *)
|
|
|
316 |
(* lockf(f,1,MAX(LONGINT)); *)
|
|
|
317 |
END;
|
|
|
318 |
END Lookup;
|
|
|
319 |
|
|
|
320 |
PROCEDURE OpenLargeFile(VAR f : File;
|
|
|
321 |
name : ARRAY OF CHAR;
|
|
|
322 |
creat : BOOLEAN);
|
|
|
323 |
|
|
|
324 |
VAR OpenMask : OpenMode;
|
|
|
325 |
BEGIN
|
|
|
326 |
OpenMask:=OpenMode{openRDWR,openLARGEFILE};
|
|
|
327 |
IF creat THEN INCL(OpenMask,openRDWR); END;
|
|
|
328 |
Lookup(f,name,creat,OpenMask);
|
|
|
329 |
END OpenLargeFile;
|
|
|
330 |
|
|
|
331 |
PROCEDURE ReWrite(VAR f : File);
|
|
|
332 |
|
|
|
333 |
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
334 |
islarge : BOOLEAN;
|
|
|
335 |
flag : UnixLib.SIGNED;
|
|
|
336 |
AccMode : UnixLib.modeT;
|
|
|
337 |
BEGIN
|
|
|
338 |
Fehler:=FALSE;
|
|
|
339 |
IF NOT Geoeffnet[f] THEN
|
|
|
340 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.ReWrite) ";
|
|
|
341 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
342 |
Fehler := TRUE; f:=-1; RETURN;
|
|
|
343 |
END;
|
|
|
344 |
|
|
|
345 |
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
|
|
|
346 |
IF Debug THEN
|
|
|
347 |
Errors.WriteString("ReWrite, Dateiname : "); Errors.WriteString(DName);
|
|
|
348 |
Errors.WriteChar("#"); Errors.WriteLn;
|
|
|
349 |
Errors.WriteString("ReWrite, Kanalnummer : "); Errors.WriteInt(f);
|
|
|
350 |
Errors.WriteLn;
|
|
|
351 |
END;
|
|
|
352 |
|
|
|
353 |
islarge := IsLarge[f]; (* War die Datei als "large" geoeffnet ? *)
|
|
|
354 |
|
|
|
355 |
Close(f); (* Schlie3en und neu"offnen mit Abschneiden. *)
|
|
|
356 |
|
|
|
357 |
(* Hier fehlt die ermittlung, in welchem Modus die Datei urspr"unglich *)
|
|
|
358 |
(* ge"offnet wurde (z.B. openRDONLY). *)
|
|
|
359 |
|
|
|
360 |
IF islarge THEN
|
|
|
361 |
flag := ((CAST(UnixLib.SIGNED,
|
|
|
362 |
OpenMode{openRDWR,openTRUNC,openLARGEFILE}) + 0
|
|
|
363 |
) DIV 2);
|
|
|
364 |
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
|
|
|
365 |
f := open64(ADR(DName),flag,AccMode);
|
|
|
366 |
ELSE
|
|
|
367 |
flag := ((CAST(INTEGER,OpenMode{openRDWR,openTRUNC}) + 0) DIV 2);
|
|
|
368 |
f := open(ADR(DName),flag);
|
|
|
369 |
END;
|
|
|
370 |
IF Debug THEN
|
|
|
371 |
Errors.WriteString("ReWrite, Kanalnummer (neu) : ");
|
|
|
372 |
Errors.WriteInt(f); Errors.WriteLn;
|
|
|
373 |
END;
|
|
|
374 |
IF (f = -1) THEN
|
|
|
375 |
Fehlerflag:=" Dateioeffnungsfehler (FileSystem.ReWrite) !";
|
|
|
376 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
377 |
Fehler:=TRUE; RETURN;
|
|
|
378 |
ELSIF (f >= MaxOpenFiles) THEN
|
|
|
379 |
Fehlerflag:="Zuviele geoeffnete Dateien (FileSystem.ReWrite) !";
|
|
|
380 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
381 |
Fehler:=TRUE; f:=-1; RETURN;
|
|
|
382 |
ELSE (* Eintagen in die Liste der ge"offneten Dateien. *)
|
|
|
383 |
StoreFileName(f,DName);
|
|
|
384 |
Geoeffnet[f] := TRUE;
|
|
|
385 |
IsLarge[f] := islarge;
|
|
|
386 |
(*
|
|
|
387 |
* OpenModes[f] := flag;
|
|
|
388 |
*)
|
|
|
389 |
(* Sperren gegen Beschreiben durch andere Prozesse. *)
|
|
|
390 |
(* lockf(f,1,MAX(LONGINT)); *)
|
|
|
391 |
END;
|
|
|
392 |
IF Debug THEN
|
|
|
393 |
Errors.WriteString("ReWrite, Dateiname : #"); Errors.WriteString(DName);
|
|
|
394 |
Errors.WriteChar("#"); Errors.WriteLn;
|
|
|
395 |
Errors.WriteString("Dateiname (eingetragener) : `");
|
|
|
396 |
Errors.WriteString(DateiNamen[f]^); Errors.WriteChar("'"); Errors.WriteLn;
|
|
|
397 |
END;
|
|
|
398 |
END ReWrite;
|
|
|
399 |
|
|
|
400 |
PROCEDURE Exists(DName : ARRAY OF CHAR) : BOOLEAN;
|
|
|
401 |
|
|
|
402 |
VAR datei : File;
|
|
|
403 |
interim : BOOLEAN;
|
|
|
404 |
BEGIN
|
|
|
405 |
interim:=CheckIO;
|
|
|
406 |
CheckIO:=FALSE;
|
|
|
407 |
Lookup(datei,DName,FALSE,OpenReadOnly);
|
|
|
408 |
CheckIO:=interim;
|
|
|
409 |
IF (datei = -1) THEN
|
|
|
410 |
RETURN FALSE;
|
|
|
411 |
ELSE
|
|
|
412 |
Close(datei);
|
|
|
413 |
RETURN TRUE;
|
|
|
414 |
END;
|
|
|
415 |
END Exists;
|
|
|
416 |
|
|
|
417 |
PROCEDURE Close(VAR f : File);
|
|
|
418 |
|
|
|
419 |
BEGIN
|
|
|
420 |
IF NOT Geoeffnet[f] THEN
|
|
|
421 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Close) !";
|
|
|
422 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
423 |
Fehler:=TRUE; f:=-1;
|
|
|
424 |
RETURN;
|
|
|
425 |
END;
|
|
|
426 |
RemoveFileName(f); (* Reihenfolge beachten ! *)
|
|
|
427 |
Geoeffnet[f] := FALSE;
|
|
|
428 |
IsLarge [f] := FALSE;
|
|
|
429 |
(* unlockf(f); (* Sperre freigeben *) *)
|
|
|
430 |
f := close(f);
|
|
|
431 |
IF (f < 0) THEN
|
|
|
432 |
ErrOut("Fehler in FileSystem.Close !");
|
|
|
433 |
END;
|
|
|
434 |
END Close;
|
|
|
435 |
|
|
|
436 |
PROCEDURE CloseAll();
|
|
|
437 |
|
|
|
438 |
VAR f : File;
|
|
|
439 |
i : INTEGER;
|
|
|
440 |
BEGIN
|
|
|
441 |
FOR i:=3 TO MaxOpenFiles-1 DO
|
|
|
442 |
f:=VAL(File,i);
|
|
|
443 |
IF Geoeffnet[f] THEN Close(f); END;
|
|
|
444 |
END;
|
|
|
445 |
END CloseAll;
|
|
|
446 |
|
|
|
447 |
PROCEDURE Delete( Name : ARRAY OF CHAR;
|
|
|
448 |
VAR f : File);
|
|
|
449 |
|
|
|
450 |
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
451 |
|
|
|
452 |
BEGIN
|
|
|
453 |
Fehler:=FALSE;
|
|
|
454 |
|
|
|
455 |
GetFileName(f,DName);
|
|
|
456 |
IF (StringsLib.Compare(DName,Name) # StringsLib.equal) OR NOT Geoeffnet[f] THEN
|
|
|
457 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Delete) !";
|
|
|
458 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
459 |
Fehler:=TRUE; RETURN;
|
|
|
460 |
ELSE
|
|
|
461 |
Close(f);
|
|
|
462 |
f := unlink(ADR(Name));
|
|
|
463 |
IF (f = -1) THEN
|
|
|
464 |
Fehlerflag:=" Zugriff verweiget (FileSystem.Delete) !";
|
|
|
465 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
466 |
Fehler:=TRUE; RETURN;
|
|
|
467 |
END;
|
|
|
468 |
END;
|
|
|
469 |
END Delete;
|
|
|
470 |
|
|
|
471 |
PROCEDURE Length( f : File;
|
|
|
472 |
VAR Len : LONGCARD);
|
|
|
473 |
|
|
|
474 |
VAR StatPuf : Stat;
|
|
|
475 |
DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
476 |
error : INTEGER;
|
|
|
477 |
|
|
|
478 |
BEGIN
|
|
|
479 |
Fehler:=FALSE;
|
|
|
480 |
IF NOT IstZulaessigeKanalnummer(f) THEN
|
|
|
481 |
FatalError(" Unzulassige Kanalnummer (FileSystem.Length) !");
|
|
|
482 |
END;
|
|
|
483 |
IF NOT Geoeffnet[f] THEN
|
|
|
484 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Length) !";
|
|
|
485 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
486 |
Fehler:=TRUE; RETURN;
|
|
|
487 |
END;
|
|
|
488 |
IF NOT UseStat THEN (* Viel zu kompliziert, fstat ist einfacher *)
|
|
|
489 |
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
|
|
|
490 |
fslength.FileLength(Len,error,DName);
|
|
|
491 |
ELSE
|
|
|
492 |
(* error := stat(ADR(DName),StatPuf); *)
|
|
|
493 |
error := fstat(f,StatPuf);
|
|
|
494 |
END;
|
|
|
495 |
IF (error = -1) THEN
|
|
|
496 |
(* Fehlerflag := strerror(errno); *)
|
|
|
497 |
Fehlerflag:="Dateilaenge nicht ermittelbar (FileSystem.Length) !";
|
|
|
498 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
499 |
Fehler:=TRUE; Len:=MAX(LONGCARD);
|
|
|
500 |
END;
|
|
|
501 |
IF UseStat THEN
|
|
|
502 |
Len := StatPuf.stSize;
|
|
|
503 |
END;
|
|
|
504 |
END Length;
|
|
|
505 |
|
|
|
506 |
PROCEDURE GetPos( f : File;
|
|
|
507 |
VAR Pos : LONGCARD);
|
|
|
508 |
|
|
|
509 |
VAR IPos : LONGINT;
|
|
|
510 |
|
|
|
511 |
BEGIN
|
|
|
512 |
Fehler:=FALSE;
|
|
|
513 |
IF (IsLarge[f]) THEN
|
|
|
514 |
Fehlerflag:="Datei benoetigt 64 Bit Dateizeiger (FileSystem.GetPos)";
|
|
|
515 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
516 |
Fehler:=TRUE; RETURN;
|
|
|
517 |
END;
|
|
|
518 |
IPos := VAL(LONGINT,lseek(f,0,SeekCur));
|
|
|
519 |
IF (IPos = -1) THEN
|
|
|
520 |
Fehlerflag:=" Fehler in FileSystem.GetPos";
|
|
|
521 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
522 |
Fehler:=TRUE; Pos:=MAX(LONGCARD);
|
|
|
523 |
RETURN;
|
|
|
524 |
END;
|
|
|
525 |
Pos := VAL(LONGCARD,IPos);
|
|
|
526 |
END GetPos;
|
|
|
527 |
|
|
|
528 |
PROCEDURE SetPos(VAR f : File;
|
|
|
529 |
Pos : LONGCARD);
|
|
|
530 |
|
|
|
531 |
VAR IPos : LONGINT;
|
|
|
532 |
BEGIN
|
|
|
533 |
Fehler:=FALSE;
|
|
|
534 |
IF NOT Geoeffnet[f] THEN
|
|
|
535 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.SetPos) !";
|
|
|
536 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
537 |
Fehler:=TRUE; RETURN;
|
|
|
538 |
END;
|
|
|
539 |
IF (IsLarge[f]) THEN
|
|
|
540 |
Fehlerflag:="Datei benoetigt 64 Bit Dateizeiger (FileSystem.SetPos)";
|
|
|
541 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
542 |
Fehler:=TRUE; RETURN;
|
|
|
543 |
END;
|
|
|
544 |
IPos := VAL(LONGINT,lseek(f,Pos,0));
|
|
|
545 |
IF (IPos = -1) THEN
|
|
|
546 |
Fehlerflag:=" SetPos nicht moeglich (FileSystem.SetPos) !";
|
|
|
547 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
548 |
Fehler:=TRUE;
|
|
|
549 |
END;
|
|
|
550 |
END SetPos;
|
|
|
551 |
|
|
|
552 |
PROCEDURE Rewind(VAR f : File);
|
|
|
553 |
|
|
|
554 |
VAR whence : UnixLib.SIGNED;
|
|
|
555 |
pos : UnixLib.FilePtr64;
|
|
|
556 |
BEGIN
|
|
|
557 |
IF (IsLarge[f]) THEN
|
|
|
558 |
whence := 0; (* SEEK_SET *)
|
|
|
559 |
pos := 0;
|
|
|
560 |
pos := lseek64(f,pos,whence);
|
|
|
561 |
IF (pos # 0) THEN
|
|
|
562 |
ErrOut("Fehler beim Zurueckstellen der Datei (FileSystem.Rewind");
|
|
|
563 |
END;
|
|
|
564 |
ELSE
|
|
|
565 |
SetPos(f,0);
|
|
|
566 |
END;
|
|
|
567 |
END Rewind;
|
|
|
568 |
|
|
|
569 |
PROCEDURE ReadNBytes( f : File;
|
|
|
570 |
VAR Ziel : ARRAY OF BYTE;
|
|
|
571 |
n : CARDINAL;
|
|
|
572 |
VAR m : CARDINAL);
|
|
|
573 |
|
|
|
574 |
VAR nbyte : INTEGER;
|
|
|
575 |
BEGIN
|
|
|
576 |
nbyte := read(f,ADR(Ziel),n);
|
|
|
577 |
IF (nbyte = -1) THEN
|
|
|
578 |
fslength.SetErrFlag(Fehlerflag);
|
|
|
579 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
580 |
Fehler:=TRUE; m:=0;
|
|
|
581 |
RETURN;
|
|
|
582 |
END;
|
|
|
583 |
m := VAL(CARDINAL,ABS(nbyte));
|
|
|
584 |
END ReadNBytes;
|
|
|
585 |
|
|
|
586 |
PROCEDURE WriteNBytes( f : File;
|
|
|
587 |
VAR Quelle : ARRAY OF BYTE;
|
|
|
588 |
n : CARDINAL;
|
|
|
589 |
VAR m : CARDINAL);
|
|
|
590 |
|
|
|
591 |
VAR nbytes : INTEGER;
|
|
|
592 |
BEGIN
|
|
|
593 |
Fehler:=FALSE;
|
|
|
594 |
nbytes := write(f,ADR(Quelle),n);
|
|
|
595 |
IF (nbytes = -1) THEN
|
|
|
596 |
Fehlerflag:=" Schreiben nicht moeglich (FileSystem.WriteNBytes) !";
|
|
|
597 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
598 |
Fehler:=TRUE; m := 0; RETURN;
|
|
|
599 |
END;
|
|
|
600 |
m := VAL(CARDINAL,nbytes);
|
|
|
601 |
END WriteNBytes;
|
|
|
602 |
|
|
|
603 |
PROCEDURE RdBinObj( Ein : File;
|
|
|
604 |
VAR A : ARRAY OF BYTE;
|
|
|
605 |
N : CARDINAL;
|
|
|
606 |
VAR ifehl : INTEGER);
|
|
|
607 |
|
|
|
608 |
CONST BlockSize = 16*1024;
|
|
|
609 |
BlockLen = BlockSize DIV TSIZE(BYTE);
|
|
|
610 |
|
|
|
611 |
VAR NBytes,NBlocks,rest : CARDINAL;
|
|
|
612 |
iblk,ii,nbytes : CARDINAL;
|
|
|
613 |
BEGIN
|
|
|
614 |
ifehl:=0;
|
|
|
615 |
IF (N > HIGH(A)+1) THEN
|
|
|
616 |
ifehl:=2;
|
|
|
617 |
Fehler:= TRUE; Fehlerflag:="Feld A zu klein (RdBinObj)";
|
|
|
618 |
ErrOut(Fehlerflag);
|
|
|
619 |
RETURN;
|
|
|
620 |
END;
|
|
|
621 |
NBytes := N*TSIZE(BYTE);
|
|
|
622 |
NBlocks := NBytes DIV BlockSize;
|
|
|
623 |
rest := NBytes MOD BlockSize;
|
|
|
624 |
ii:=0;
|
|
|
625 |
IF (NBlocks > 0) THEN
|
|
|
626 |
iblk:=1;
|
|
|
627 |
REPEAT
|
|
|
628 |
ReadNBytes(Ein,(*ADR*)A[ii],BlockSize,nbytes);
|
|
|
629 |
Fehler:= (nbytes # BlockSize);
|
|
|
630 |
INC(iblk); INC(ii,BlockLen);
|
|
|
631 |
UNTIL (iblk > NBlocks) OR Fehler;
|
|
|
632 |
END;
|
|
|
633 |
IF NOT Fehler AND (rest > 0) THEN
|
|
|
634 |
ReadNBytes(Ein,(*ADR*)A[ii],rest,nbytes);
|
|
|
635 |
Fehler:= (nbytes # rest);
|
|
|
636 |
END;
|
|
|
637 |
IF Fehler THEN
|
|
|
638 |
ifehl:=1;
|
|
|
639 |
Fehlerflag:="Keine ausreichende Zahl Bytes einlesbar (RdBinObj)";
|
|
|
640 |
ErrOut(Fehlerflag);
|
|
|
641 |
END;
|
|
|
642 |
END RdBinObj;
|
|
|
643 |
|
|
|
644 |
PROCEDURE WrBinObj( Aus : File;
|
|
|
645 |
VAR A : ARRAY OF BYTE;
|
|
|
646 |
N : CARDINAL;
|
|
|
647 |
VAR ifehl : INTEGER);
|
|
|
648 |
|
|
|
649 |
CONST BlockSize = 16*1024;
|
|
|
650 |
BlockLen = BlockSize DIV TSIZE(BYTE);
|
|
|
651 |
|
|
|
652 |
VAR NBytes,NBlocks,rest : CARDINAL;
|
|
|
653 |
iblk,ii,nbytes : CARDINAL;
|
|
|
654 |
BEGIN
|
|
|
655 |
ifehl:=0;
|
|
|
656 |
IF (N > HIGH(A)+1) THEN
|
|
|
657 |
ifehl:=2;
|
|
|
658 |
Fehler:= TRUE; Fehlerflag:="Feld A zu klein (WrBinObj)";
|
|
|
659 |
ErrOut(Fehlerflag);
|
|
|
660 |
RETURN;
|
|
|
661 |
END;
|
|
|
662 |
NBytes := N*TSIZE(BYTE);
|
|
|
663 |
NBlocks := NBytes DIV BlockSize;
|
|
|
664 |
rest := NBytes MOD BlockSize;
|
|
|
665 |
ii:=0;
|
|
|
666 |
IF (NBlocks > 0) THEN
|
|
|
667 |
iblk:=1;
|
|
|
668 |
REPEAT
|
|
|
669 |
WriteNBytes(Aus,(*ADR*)A[ii],BlockSize,nbytes);
|
|
|
670 |
Fehler:= (nbytes # BlockSize);
|
|
|
671 |
INC(iblk); INC(ii,BlockLen);
|
|
|
672 |
UNTIL (iblk > NBlocks) OR Fehler;
|
|
|
673 |
END;
|
|
|
674 |
IF NOT Fehler AND (rest # 0) THEN
|
|
|
675 |
WriteNBytes(Aus,(*ADR*)A[ii],rest,nbytes);
|
|
|
676 |
Fehler:= (nbytes # rest);
|
|
|
677 |
END;
|
|
|
678 |
IF Fehler THEN
|
|
|
679 |
ifehl:=1;
|
|
|
680 |
Fehlerflag:="Keine ausreichende Zahl Bytes einlesbar (WrBinObj)";
|
|
|
681 |
ErrOut(Fehlerflag);
|
|
|
682 |
END;
|
|
|
683 |
END WrBinObj;
|
|
|
684 |
|
|
|
685 |
(*============== Unix - spezifische Routinen. ==============*)
|
|
|
686 |
|
|
|
687 |
PROCEDURE ChMod(VAR f : File;
|
|
|
688 |
Modus : AccessMode);
|
|
|
689 |
|
|
|
690 |
VAR err : INTEGER;
|
|
|
691 |
DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
|
|
|
692 |
Mode : AccessModeRec;
|
|
|
693 |
|
|
|
694 |
BEGIN
|
|
|
695 |
Fehler:=FALSE;
|
|
|
696 |
IF NOT Geoeffnet[f] THEN
|
|
|
697 |
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.ChMod) !";
|
|
|
698 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
699 |
Fehler:=TRUE; f:=-1; RETURN;
|
|
|
700 |
END;
|
|
|
701 |
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
|
|
|
702 |
Mode.accessmode:=Modus;
|
|
|
703 |
err := chmod(ADR(DName),Mode.int);
|
|
|
704 |
IF (err = -1) THEN (* Zugriff verweigert ? *)
|
|
|
705 |
Fehlerflag:=" Datei nicht gefunden (FileSystm.ChMod) !";
|
|
|
706 |
IF CheckIO THEN ErrOut(Fehlerflag); END;
|
|
|
707 |
Fehler:=TRUE; RETURN;
|
|
|
708 |
END;
|
|
|
709 |
END ChMod;
|
|
|
710 |
|
|
|
711 |
PROCEDURE Lock(VAR f : File);
|
|
|
712 |
|
|
|
713 |
VAR err,lex,lnb,lock : INTEGER;
|
|
|
714 |
tmp : BITSET;
|
|
|
715 |
BEGIN
|
|
|
716 |
(* Folgendes Konstrukt ist n"otig, da CAST(TYPE,CONST) bei einigen *)
|
|
|
717 |
(* "Ubersetzern nicht m"oglich. *)
|
|
|
718 |
lex := LockExclusive;
|
|
|
719 |
lnb := LockNoblock;
|
|
|
720 |
tmp := CAST(BITSET,lex) + CAST(BITSET,lnb);
|
|
|
721 |
lock := CAST(INTEGER,tmp);
|
|
|
722 |
err := flock(f,lock);
|
|
|
723 |
IF (err # 0) THEN
|
|
|
724 |
fslength.SetErrFlag(Fehlerflag);
|
|
|
725 |
ErrOut(Fehlerflag);
|
|
|
726 |
END;
|
|
|
727 |
END Lock;
|
|
|
728 |
|
|
|
729 |
PROCEDURE UnLock(VAR f : File);
|
|
|
730 |
|
|
|
731 |
VAR err : INTEGER;
|
|
|
732 |
BEGIN
|
|
|
733 |
err := flock(f,LockUnlock);
|
|
|
734 |
IF (err # 0) THEN
|
|
|
735 |
fslength.SetErrFlag(Fehlerflag);
|
|
|
736 |
ErrOut(Fehlerflag);
|
|
|
737 |
END;
|
|
|
738 |
END UnLock;
|
|
|
739 |
|
|
|
740 |
PROCEDURE Sync();
|
|
|
741 |
|
|
|
742 |
BEGIN
|
|
|
743 |
sync();
|
|
|
744 |
END Sync;
|
|
|
745 |
|
|
|
746 |
VAR i : CARDINAL;
|
|
|
747 |
(* dummy : File; *)
|
|
|
748 |
BEGIN
|
|
|
749 |
FOR i:=0 TO MaxOpenFiles-1 DO
|
|
|
750 |
Geoeffnet[i]:=FALSE;
|
|
|
751 |
IsLarge [i]:=FALSE;
|
|
|
752 |
DateiNamen[i]:=NIL;
|
|
|
753 |
(* OpenModes[i] := VAL(UnixLib.SIGNED,0); *)
|
|
|
754 |
END;
|
|
|
755 |
|
|
|
756 |
Input :=0;
|
|
|
757 |
Output:=1;
|
|
|
758 |
StdErr:=2;
|
|
|
759 |
NEW(DateiNamen[Input ]);
|
|
|
760 |
NEW(DateiNamen[Output]);
|
|
|
761 |
NEW(DateiNamen[StdErr]);
|
|
|
762 |
Geoeffnet[Input ] := TRUE; DateiNamen[Input ]^ := "Input";
|
|
|
763 |
Geoeffnet[Output] := TRUE; DateiNamen[Output]^ := "Output";
|
|
|
764 |
Geoeffnet[StdErr] := TRUE; DateiNamen[StdErr]^ := "StdErr";
|
|
|
765 |
|
|
|
766 |
(* Wenn TRUE, kann es zu kaskadierenden Fehermeldungen im Modul *)
|
|
|
767 |
(* Streams kommen. *)
|
|
|
768 |
|
|
|
769 |
CheckIO := TRUE;
|
|
|
770 |
|
|
|
771 |
FINALLY
|
|
|
772 |
|
|
|
773 |
CheckIO := FALSE;
|
|
|
774 |
CloseAll();
|
|
|
775 |
|
|
|
776 |
END FileSystem.
|