Files64.Mod 41 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393
  1. (* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
  2. MODULE Files64; (* pjm *)
  3. (** Aos file system base. *)
  4. IMPORT SYSTEM, Files, Streams := Streams64, KernelLog, Modules, Kernel, Commands;
  5. CONST
  6. (** Volume & file flags *)
  7. ReadOnly* = Files.ReadOnly;
  8. (** Volume flags *)
  9. Removable* = Files.Removable;
  10. Boot* = Files.Boot;
  11. (** File flags *)
  12. Directory* = Files.Directory;
  13. Hidden* = Files.Hidden;
  14. System* = Files.System;
  15. Archive* = Files.Archive;
  16. Temporary* = Files.Temporary;
  17. Ok* = Files.Ok;
  18. (*
  19. (* Volume level errors *)(* as Files.Mod *)
  20. ReadOnlyError = 2901; (* Tried to modify read-only volume. Causes HALT *)
  21. VolumeFull = 2902; (* Tried to allocate block on full volume. Causes HALT *)
  22. InvalidAdr = 2903; (* Block address outside of volume. Causes HALT *)
  23. *)
  24. (* File level errors *)
  25. VolumeReadOnly* = Files.VolumeReadOnly; (** Cannot modify read-only volume *)
  26. FsNotFound* = Files.FsNotFound; (** File system not found *)
  27. FileAlreadyExists* = Files.FileAlreadyExists; (** File already exists *)
  28. BadFileName* = Files.BadFileName; (** Bad file name *)
  29. FileNotFound* = Files.FileNotFound; (** File not found *)
  30. (* Enumerate flags. *)
  31. EnumSize* = Files.EnumSize;
  32. EnumTime* = Files.EnumTime;
  33. PrefixLength* = Files.PrefixLength; (** maximum length of a file system prefix. *)
  34. NameLength* = Files.NameLength; (** maximum length of a file name. *)
  35. Trace = FALSE;
  36. WriteError = 2907;
  37. DefaultWriterSize = 4096;
  38. DefaultReaderSize = 4096;
  39. PathDelimiter* = "/"; (** Path delimiter *)
  40. BufferSize = 32 * 1024; (* Buffersize for file copy operation *)
  41. SetSize = MAX(SET) + 1;
  42. (* file system behaviour flags *)
  43. NeedsPrefix* = Files.NeedsPrefix; (* if no prefix given, then this file system cannot handle it, to prevent file systems from being in the search path *)
  44. TYPE
  45. (** All record fields are read-only for users, and read-write for extenders. *)
  46. FileName* = Files.FileName;
  47. (** A rider points to some location in a file, where reading and writing will be done. *)
  48. Rider* = RECORD (** not shareable between multiple processes *)
  49. (* the rider must be a record, otherwise the Oberon text system will not work *)
  50. eof*: BOOLEAN; (** has end of file been passed *)
  51. res*: LONGINT; (** leftover byte count for ReadBytes/WriteBytes *)
  52. (** private fields for implementors *)
  53. apos*: HUGEINT;
  54. bpos*: LONGINT;
  55. hint*: Hint;
  56. file*: File;
  57. fs*: FileSystem;
  58. END;
  59. TYPE
  60. (** Reader for buffered reading of a file via Streams.Read* procedures. See OpenReader. *)
  61. Reader* = OBJECT (Streams.Reader) (** not sharable between multiple processes *)
  62. VAR
  63. file : File;
  64. r: Rider;
  65. PROCEDURE Receive(VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT);
  66. BEGIN
  67. file.ReadBytes(r, buf, ofs, size);
  68. len := size - r.res;
  69. IF len >= min THEN res := Streams.Ok ELSE res := Streams.EOF (* end of file *) END
  70. END Receive;
  71. PROCEDURE CanSetPos*() : BOOLEAN;
  72. BEGIN
  73. RETURN TRUE;
  74. END CanSetPos;
  75. PROCEDURE SetPos*(pos : HUGEINT);
  76. BEGIN
  77. file.Set(r, pos);
  78. Reset;
  79. received := pos; (* this effects that Streams.Reader.Pos() returns the correct location in the file *)
  80. END SetPos;
  81. PROCEDURE &InitFileReader*(file : File; pos: HUGEINT);
  82. BEGIN
  83. ASSERT(file # NIL);
  84. SELF.file := file;
  85. file.Set(r, pos);
  86. received := pos; (* this effects that Streams.Reader.Pos() returns the correct location in the file *)
  87. InitReader(SELF.Receive, DefaultReaderSize);
  88. END InitFileReader;
  89. END Reader;
  90. TYPE
  91. (** Writer for buffered writing of a file via Streams.Write* procedures. See OpenWriter. *)
  92. Writer* = OBJECT (Streams.Writer) (** not sharable between multiple processes *)
  93. VAR
  94. file : File;
  95. r: Rider;
  96. PROCEDURE Send(CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
  97. BEGIN
  98. r.file.WriteBytes(r, buf, ofs, len);
  99. IF propagate THEN r.file.Update END;
  100. IF r.res = 0 THEN res := Streams.Ok ELSE res := WriteError (* not all bytes written *) END
  101. END Send;
  102. PROCEDURE CanSetPos*() : BOOLEAN;
  103. BEGIN
  104. RETURN TRUE;
  105. END CanSetPos;
  106. PROCEDURE SetPos*(pos : HUGEINT);
  107. BEGIN
  108. Update;
  109. file.Set(r, pos);
  110. Reset;
  111. END SetPos;
  112. PROCEDURE Pos*(): HUGEINT;
  113. BEGIN
  114. Update;
  115. RETURN file.Pos(r)
  116. END Pos;
  117. PROCEDURE &InitFileWriter*(file: File; pos: HUGEINT);
  118. BEGIN
  119. ASSERT(file # NIL);
  120. SELF.file := file;
  121. file.Set(r, pos);
  122. InitWriter(SELF.Send, DefaultWriterSize);
  123. END InitFileWriter;
  124. END Writer;
  125. Prefix* = Files.Prefix;
  126. Hint* = Files.Hint; (** for use by file system implementors. *)
  127. Bytes2 = ARRAY 2 OF CHAR;
  128. Bytes4 = ARRAY 4 OF CHAR;
  129. Bytes8 = ARRAY 8 OF CHAR;
  130. TYPE
  131. (** Volume is the base type of all volumes. It provides operations on an abstract array of file system data blocks of blockSize bytes, numbered from 1 to size. It is mainly used by file system implementations. *)
  132. Volume* = Files.Volume; (** shareable *)
  133. TYPE
  134. FileSystem* = OBJECT (** shareable *)
  135. VAR
  136. next: FileSystem; (* list of known file systems *)
  137. prefix*: Prefix; (** mount prefix *)
  138. desc*: ARRAY 32 OF CHAR; (** description of file system *)
  139. vol*: Volume; (** underlying volume, if any (a boot FS must have a volume) *)
  140. flags*: SET; (* flags like propagate prefix / can process files without prefix *)
  141. (** Create a new file with the specified name. End users use Files.New instead. *)
  142. PROCEDURE New0*(name: ARRAY OF CHAR): File;
  143. BEGIN HALT(301) END New0; (* abstract *)
  144. (** Open an existing file. The same file descriptor is returned if a file is opened multiple times. End users use Files.Old instead. *)
  145. PROCEDURE Old0*(name: ARRAY OF CHAR): File;
  146. BEGIN HALT(301) END Old0; (* abstract *)
  147. (** Delete a file. res = 0 indicates success. End users use Files.Delete instead. *)
  148. PROCEDURE Delete0*(name: ARRAY OF CHAR; VAR key, res: LONGINT);
  149. BEGIN HALT(301) END Delete0; (* abstract *)
  150. (** Rename a file. res = 0 indicates success. End users use Files.Rename instead. *)
  151. PROCEDURE Rename0*(old, new: ARRAY OF CHAR; f: File; VAR res: LONGINT);
  152. BEGIN HALT(301) END Rename0; (* abstract *)
  153. (** Enumerate canonical file names. mask may contain * wildcards. For internal use only. End users use Enumerator instead. *)
  154. PROCEDURE Enumerate0*(mask: ARRAY OF CHAR; flags: SET; enum: Enumerator);
  155. BEGIN HALT(301) END Enumerate0; (* abstract *)
  156. (** Return the unique non-zero key of the named file, if it exists. *)
  157. PROCEDURE FileKey*(name: ARRAY OF CHAR): LONGINT;
  158. BEGIN HALT(301) END FileKey; (* abstract *)
  159. (** Create a new directory structure. May not be supported by the actual implementation.
  160. End users use Files.CreateDirectory instead.*)
  161. PROCEDURE CreateDirectory0*(name: ARRAY OF CHAR; VAR res: LONGINT);
  162. BEGIN res := -1 (* not supported *)
  163. END CreateDirectory0;
  164. (** Remove a directory. If force=TRUE, any subdirectories and files should be automatically deleted.
  165. End users use Files.RemoveDirectory instead. *)
  166. PROCEDURE RemoveDirectory0*(name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT);
  167. BEGIN res := -1 (* not supported *)
  168. END RemoveDirectory0;
  169. (** Finalize the file system. *)
  170. PROCEDURE Finalize*;
  171. BEGIN (* see note in Volume.Finalize *)
  172. vol := NIL
  173. END Finalize;
  174. (* default implementation using an enumerator *)
  175. PROCEDURE Has*(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
  176. VAR enum: Enumerator; time, date: LONGINT; size: HUGEINT;
  177. BEGIN
  178. NEW(enum);
  179. enum.Open(name,{});
  180. IF enum.HasMoreEntries() & enum.GetEntry(fullName, flags, time, date, size) THEN
  181. RETURN TRUE
  182. ELSE
  183. RETURN FALSE
  184. END;
  185. END Has;
  186. (* GC
  187. PROCEDURE Purge*(f: File); (* race! *)
  188. BEGIN HALT(301) END Purge; (* by default not allowed to purge files *)
  189. *)
  190. END FileSystem;
  191. FileSystemTable* = POINTER TO ARRAY OF FileSystem;
  192. TYPE
  193. File* = OBJECT (** sharable *)
  194. VAR
  195. (** private fields for implementors *)
  196. flags*: SET; (** (read-only!) file-specific flags, i.e. Directory. *)
  197. key*: LONGINT; (* unique id for registered file, never 0 *)
  198. fs*: FileSystem; (* file system containing file *)
  199. (** Position a Rider at a certain position in a file. Multiple Riders can be positioned at different locations in a file. A Rider cannot be positioned beyond the end of a file. *)
  200. PROCEDURE Set*(VAR r: Rider; pos: HUGEINT);
  201. BEGIN HALT(301) END Set; (* abstract *)
  202. (** Return the offset of a Rider positioned on a file. *)
  203. PROCEDURE Pos*(VAR r: Rider): HUGEINT;
  204. BEGIN HALT(301) END Pos; (* abstract *)
  205. (** Read a byte from a file, advancing the Rider one byte further. R.eof indicates if the end of the file has been passed. *)
  206. PROCEDURE Read*(VAR r: Rider; VAR x: CHAR);
  207. BEGIN HALT(301) END Read; (* abstract *)
  208. (** Read a sequence of len bytes into the buffer x at offset ofs, advancing the Rider. Less bytes will be read when reading over the end of the file. r.res indicates the number of unread bytes. x must be big enough to hold all the bytes. *)
  209. PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF CHAR; ofs, len: LONGINT);
  210. BEGIN HALT(301) END ReadBytes; (* abstract *)
  211. (** Write a byte into the file at the Rider position, advancing the Rider by one. *)
  212. PROCEDURE Write*(VAR r: Rider; x: CHAR);
  213. BEGIN HALT(301) END Write; (* abstract *)
  214. (** Write the buffer x containing len bytes (starting at offset ofs) into a file at the Rider position. *)
  215. PROCEDURE WriteBytes*(VAR r: Rider; CONST x: ARRAY OF CHAR; ofs, len: LONGINT);
  216. BEGIN HALT(301) END WriteBytes; (* abstract *)
  217. (** Return the current length of a file. *)
  218. PROCEDURE Length*(): HUGEINT;
  219. BEGIN HALT(301) END Length; (* abstract *)
  220. (** Return the time (t) and date (d) when a file was last modified. *)
  221. PROCEDURE GetDate*(VAR t, d: LONGINT);
  222. BEGIN HALT(301) END GetDate; (* abstract *)
  223. (** Set the modification time (t) and date (d) of a file. *)
  224. PROCEDURE SetDate*(t, d: LONGINT);
  225. BEGIN HALT(301) END SetDate; (* abstract *)
  226. (** Get file attributes. *)
  227. PROCEDURE GetAttributes*(): SET;
  228. BEGIN HALT(301) END GetAttributes; (* abstract *)
  229. (** Set file attributes. *)
  230. PROCEDURE SetAttributes*(flags: SET);
  231. BEGIN HALT(301) END SetAttributes; (* abstract *)
  232. (** Return the canonical name of a file. *)
  233. PROCEDURE GetName*(VAR name: ARRAY OF CHAR);
  234. BEGIN HALT(301) END GetName; (* abstract *)
  235. (** Register a file created with New in the directory, replacing the previous file in the directory with the same name. The file is automatically updated. End users use Files.Register instead. *)
  236. PROCEDURE Register0*(VAR res: LONGINT);
  237. BEGIN HALT(301) END Register0; (* abstract *)
  238. (** Flush the changes made to a file from its buffers. Register0 will automatically update a file. *)
  239. PROCEDURE Update*;
  240. BEGIN HALT(301) END Update; (* abstract *)
  241. (*
  242. Usually, in Oberon a file is not closed explicitly but by a call to finalizers by the garbage colloector.
  243. However, for systems running in a host environment such as WinAos or UnixAos, explicitly closing a file may release files/handles that otherwise are blocked by the system.
  244. Close is not necessarily implemented by a file system, therefore a call to Close may or may not have any effect.
  245. Implementers of Close have to make sure that a call to close does not possibly contradict with file finalization.
  246. *)
  247. PROCEDURE Close*;
  248. BEGIN
  249. (* abstract, potentially empty *)
  250. END Close;
  251. END File;
  252. TYPE
  253. Enumerator* = OBJECT (** not shareable *)
  254. VAR
  255. r: Rider; (* data is stored in an anonymous file, because it is potentially very long *)
  256. adding: BOOLEAN; (* prevent user calls of PutEntry *)
  257. size-: LONGINT; (** total number of entries *)
  258. (** Open an enumerator and enumerate the files that match mask. *)
  259. PROCEDURE Open*(mask: ARRAY OF CHAR; flags: SET);
  260. BEGIN
  261. r.file := New("");
  262. r.file.Set(r, 0);
  263. size := 0;
  264. adding := TRUE;
  265. Enumerate(mask, flags, SELF);
  266. adding := FALSE;
  267. r.file.Set(r, 0)
  268. END Open;
  269. (** reset the enumerator to the first entry *)
  270. PROCEDURE Reset*;
  271. BEGIN
  272. r.file.Set(r, 0)
  273. END Reset;
  274. (** returns TRUE if the enumerator contains more entries *)
  275. PROCEDURE HasMoreEntries*(): BOOLEAN;
  276. BEGIN
  277. RETURN r.file.Pos(r) < r.file.Length()
  278. END HasMoreEntries;
  279. (** Get one entry from the enumerator. *)
  280. PROCEDURE GetEntry*(VAR name: ARRAY OF CHAR; VAR flags: SET; VAR time, date: LONGINT; size: HUGEINT): BOOLEAN;
  281. VAR len, temp: LONGINT;
  282. BEGIN
  283. ReadNum(r, len);
  284. IF ~r.eof THEN
  285. name[len] := 0X; (* index check *)
  286. r.file.ReadBytes(r, name, 0, len);
  287. ReadSet(r, flags); ReadNum(r, time); ReadNum(r, date); ReadHInt(r, size);
  288. ASSERT(~r.eof)
  289. END;
  290. RETURN ~r.eof
  291. END GetEntry;
  292. (** Close the enumerator. *)
  293. PROCEDURE Close*;
  294. BEGIN
  295. (*r.fs.Purge(r.file);*)
  296. r.hint := NIL; r.file := NIL; r.fs := NIL
  297. END Close;
  298. (** For internal use only. *)
  299. PROCEDURE PutEntry*(VAR name: ARRAY OF CHAR; flags: SET; time, date: LONGINT; size:HUGEINT);
  300. VAR len: LONGINT;
  301. BEGIN
  302. ASSERT(adding);
  303. INC(SELF.size);
  304. len := 0; WHILE name[len] # 0X DO INC(len) END;
  305. WriteNum(r, len); r.file.WriteBytes(r, name, 0, len);
  306. WriteSet(r, flags); WriteNum(r, time); WriteNum(r, date); WriteHInt(r, size)
  307. END PutEntry;
  308. END Enumerator;
  309. TYPE
  310. (* FinalizedCollection enumerator searching for a file by (fs,key). *)
  311. FileSearcher = OBJECT
  312. VAR fs: FileSystem; key: LONGINT; found: File;
  313. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  314. BEGIN
  315. WITH f: File DO
  316. IF (f.fs = fs) & (f.key = key) THEN
  317. found := f; cont := FALSE
  318. END
  319. END
  320. END EnumFile;
  321. END FileSearcher;
  322. TYPE
  323. (** Parameters passed to volume and file system generator commands. The str field contains a generic parameter string from the mount command. The vol field returns the new volume from volume generators and passes the volume parameter to file system generators. The prefix field contains the mount prefix, mainly for file system generators to add themselves with Files.Add. *)
  324. Parameters* = Files.Parameters;
  325. FileSystemFactory* = PROCEDURE(context : Parameters);
  326. VAR
  327. fsroot: FileSystem; (* list of known file systems *)
  328. files: Kernel.FinalizedCollection; (* all open files - cleaned up by GC *)
  329. seacher: FileSearcher; (* enumerator shared by various procedures, protected with module EXCLUSIVE *)
  330. fileClipboard : File; (* contains the pointer to the file in the clipboard opened with Copy *)
  331. (** Buffered reading and writing. *)
  332. (** Open a reader on a file at the specified position. *)
  333. PROCEDURE OpenReader*(VAR b: Reader; f: File; pos: HUGEINT);
  334. BEGIN
  335. IF b = NIL THEN
  336. NEW(b, f, pos)
  337. ELSE
  338. b.InitFileReader(f,pos)
  339. END;
  340. END OpenReader;
  341. (** Open a writer on a file at the specified position. Remember to call Streams.Update before registering or closing the file! *)
  342. PROCEDURE OpenWriter*(VAR b: Writer; f: File; pos: HUGEINT);
  343. BEGIN
  344. NEW(b, f, pos)
  345. END OpenWriter;
  346. (** File name prefix support. *)
  347. (** Split fullname = ( prefix ":" name ) into prefix and name *)
  348. PROCEDURE SplitName*(fullname: ARRAY OF CHAR; VAR prefix, name: ARRAY OF CHAR);
  349. VAR i, j, len: LONGINT;
  350. BEGIN
  351. i := 0; WHILE (fullname[i] # ":") & (fullname[i] # 0X) DO INC(i) END;
  352. IF (fullname[i] # ":") OR (i >= LEN(prefix)) THEN
  353. COPY("", prefix); COPY(fullname, name);
  354. ELSE
  355. j := 0; WHILE j # i DO prefix[j] := fullname[j]; INC(j) END;
  356. prefix[j] := 0X;
  357. j := 0; INC(i); len := LEN(name)-1;
  358. WHILE (j < len) & (fullname[i] # 0X) DO name[j] := fullname[i]; INC(j); INC(i) END;
  359. name[j] := 0X
  360. END
  361. END SplitName;
  362. (** Join prefix and name to fullname = ( prefix ":" name ) *)
  363. PROCEDURE JoinName*(prefix, name: ARRAY OF CHAR; VAR fullname: ARRAY OF CHAR);
  364. VAR i, j, len: LONGINT;
  365. BEGIN
  366. len := LEN(fullname)-1;
  367. i := 0; WHILE (i < len) & (prefix[i] # 0X) DO fullname[i] := prefix[i]; INC(i) END;
  368. IF (i < len) THEN fullname[i] := ":"; INC(i) END;
  369. j := 0; WHILE (i < len) & (name[j] # 0X) DO fullname[i] := name[j]; INC(i); INC(j) END;
  370. fullname[i] := 0X
  371. END JoinName;
  372. (** Split a pathname at the last PathDelimiter or ":" into path and filename = ( {path (PathDelimiter|":")} filename ) *)
  373. PROCEDURE SplitPath*(pathname: ARRAY OF CHAR; VAR path, name: ARRAY OF CHAR);
  374. VAR i,j,len: LONGINT;
  375. BEGIN
  376. i := 0; j := -1;
  377. WHILE pathname[i] # 0X DO
  378. IF (pathname[i] = PathDelimiter) OR (pathname[i] = ":") THEN j := i END;
  379. INC(i)
  380. END;
  381. i := 0; len := LEN(path)-1;
  382. WHILE (i < len) & (i < j) DO path[i] := pathname[i]; INC(i) END; path[i] := 0X;
  383. IF pathname[i] = ":" THEN path[i] := ":"; path[i+1] := 0X; END; (* fof for correct splitting of filenames such as c:test into c: and test*)
  384. INC(j); i := 0; len := LEN(name)-1;
  385. WHILE (i < len) & (pathname[j] # 0X) DO name[i] := pathname[j]; INC(i); INC(j) END;
  386. name[i] := 0X
  387. END SplitPath;
  388. (** Join path and file name = ( path PathDelimiter name ) *)
  389. PROCEDURE JoinPath*(path, name: ARRAY OF CHAR; VAR pathname: ARRAY OF CHAR);
  390. VAR i,j,len: LONGINT;
  391. BEGIN
  392. len := LEN(pathname)-1;
  393. i := 0; WHILE (i < len) & (path[i] # 0X) DO pathname[i] := path[i]; INC(i) END;
  394. IF ((i = 0) OR (pathname[i-1] # PathDelimiter)) & (i < len) THEN pathname[i] := PathDelimiter; INC(i) END;
  395. j := 0; WHILE (i < len) & (name[j] # 0X) DO pathname[i] := name[j]; INC(i); INC(j) END;
  396. pathname[i] := 0X
  397. END JoinPath;
  398. (** Split a filename at the last '.' into name and extension = ( name "." extension ) *)
  399. PROCEDURE SplitExtension*(filename: ARRAY OF CHAR; VAR name, extension: ARRAY OF CHAR);
  400. VAR i,j,len: LONGINT;
  401. BEGIN
  402. i := 0; j := -1;
  403. WHILE filename[i] # 0X DO
  404. IF filename[i] = "." THEN j := i END;
  405. INC(i)
  406. END;
  407. IF (j = -1) THEN (* no extension *)
  408. COPY(filename, name); COPY("", extension)
  409. ELSE
  410. i := 0; len := LEN(name)-1;
  411. WHILE (i < len) & (i < j) DO name[i] := filename[i]; INC(i) END; name[i] := 0X;
  412. INC(j); i := 0; len := LEN(extension)-1;
  413. WHILE (i < len) & (filename[j] # 0X) DO extension[i] := filename[j]; INC(i); INC(j) END;
  414. extension[i] := 0X
  415. END
  416. END SplitExtension;
  417. (** Join name and extension = ( name "." extension ) *)
  418. PROCEDURE JoinExtension*(name, extension: ARRAY OF CHAR; VAR filename: ARRAY OF CHAR);
  419. VAR i,j,len: LONGINT;
  420. BEGIN
  421. len := LEN(filename)-1;
  422. i := 0; WHILE (i < len) & (name[i] # 0X) DO filename[i] := name[i]; INC(i) END;
  423. IF ((i = 0) OR (filename[i-1] # ".")) & (i < len) THEN filename[i] := "."; INC(i) END;
  424. j := 0; IF extension[0] = "." THEN INC(j) END;
  425. WHILE (i < len) & (extension[j] # 0X) DO filename[i] := extension[j]; INC(i); INC(j) END;
  426. filename[i] := 0X
  427. END JoinExtension;
  428. (** Append the path delimiter to path if path does not contain one *)
  429. PROCEDURE ForceTrailingDelimiter*(VAR path: ARRAY OF CHAR);
  430. VAR i: LONGINT;
  431. BEGIN
  432. i := 0; WHILE path[i] # 0X DO INC(i) END;
  433. IF (i = 0) OR (path[i-1] # PathDelimiter) THEN
  434. path[i] := PathDelimiter;
  435. path[i+1] := 0X
  436. END
  437. END ForceTrailingDelimiter;
  438. (** File system list support. *)
  439. PROCEDURE WriteFS(fs: FileSystem);
  440. BEGIN
  441. IF Trace THEN
  442. IF fs.vol # NIL THEN KernelLog.String(fs.vol.name); KernelLog.Char(" ") END;
  443. KernelLog.String(fs.desc)
  444. END
  445. END WriteFS;
  446. (** Add file system at end of list, with specified prefix, which must be unique. *)
  447. PROCEDURE Add*(fs: FileSystem; prefix: ARRAY OF CHAR);
  448. VAR p, c: FileSystem;
  449. BEGIN {EXCLUSIVE}
  450. IF Trace THEN
  451. KernelLog.Enter; KernelLog.String("Files: Adding "); WriteFS(fs); KernelLog.Exit
  452. END;
  453. COPY(prefix, fs.prefix);
  454. p := NIL; c := fsroot;
  455. WHILE c # NIL DO
  456. ASSERT((c # fs) & (c.prefix # fs.prefix)); (* duplicate insertion not allowed *)
  457. p := c; c := c.next
  458. END;
  459. IF p = NIL THEN fsroot := fs ELSE p.next := fs END;
  460. fs.next := NIL
  461. END Add;
  462. PROCEDURE DeleteFS(fs: FileSystem);
  463. VAR p, c: FileSystem;
  464. BEGIN
  465. p := NIL; c := fsroot;
  466. WHILE c # fs DO p := c; c := c.next END; (* fs must be in list *)
  467. IF p = NIL THEN fsroot := c.next ELSE p.next := c.next END;
  468. c.next := NIL
  469. END DeleteFS;
  470. (** Promote fs to the start of the list. *)
  471. PROCEDURE Promote*(fs: FileSystem);
  472. BEGIN {EXCLUSIVE}
  473. DeleteFS(fs);
  474. fs.next := fsroot; fsroot := fs
  475. END Promote;
  476. (** Remove the file system and finalize it. *)
  477. PROCEDURE Remove*(fs: FileSystem);
  478. VAR
  479. enum: OBJECT
  480. VAR count: LONGINT; fs: FileSystem;
  481. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  482. BEGIN
  483. WITH f: File DO
  484. IF f.fs = fs THEN INC(count); f.Update(); f.fs := NIL END
  485. (* if Update procedure calls back to this module deadlock can result *)
  486. END
  487. END EnumFile;
  488. END;
  489. BEGIN {EXCLUSIVE}
  490. IF Trace THEN
  491. KernelLog.Enter; KernelLog.String("Files: Removing "); WriteFS(fs); KernelLog.Exit
  492. END;
  493. NEW(enum); enum.count := 0; enum.fs := fs;
  494. files.Enumerate(enum.EnumFile);
  495. IF enum.count # 0 THEN
  496. KernelLog.Enter; KernelLog.String("Files: "); KernelLog.Int(enum.count, 1);
  497. KernelLog.String(" open files");
  498. IF fs.vol # NIL THEN
  499. KernelLog.String(" on "); KernelLog.String(fs.vol.name)
  500. END;
  501. KernelLog.Exit
  502. END;
  503. fs.Finalize(); (* potential deadlock *)
  504. DeleteFS(fs)
  505. END Remove;
  506. (* Find the file system with specified prefix. *)
  507. PROCEDURE FindFS(prefix: ARRAY OF CHAR): FileSystem;
  508. VAR fs: FileSystem;
  509. BEGIN
  510. fs := fsroot; WHILE (fs # NIL) & (fs.prefix # prefix) DO fs := fs.next END;
  511. RETURN fs
  512. END FindFS;
  513. (** Find file system with specified prefix. *)
  514. PROCEDURE This*(prefix: ARRAY OF CHAR): FileSystem;
  515. BEGIN {EXCLUSIVE}
  516. RETURN FindFS(prefix)
  517. END This;
  518. (** Get a list of file systems. *)
  519. PROCEDURE GetList*(VAR list: FileSystemTable);
  520. VAR fs: FileSystem; n, i: LONGINT;
  521. BEGIN {EXCLUSIVE}
  522. fs := fsroot; n := 0;
  523. WHILE (fs # NIL) DO fs := fs.next; INC(n) END;
  524. IF n # 0 THEN
  525. NEW(list, n);
  526. fs := fsroot;
  527. FOR i := 0 TO n-1 DO
  528. list[i] := fs; fs := fs.next
  529. END
  530. ELSE
  531. list := NIL
  532. END
  533. END GetList;
  534. (* GC
  535. PROCEDURE Collect(f: ANY);
  536. BEGIN
  537. WITH f: File DO
  538. IF (f.fs # NIL) & (f.fs.vol # NIL) & ~(ReadOnly IN f.fs.vol.flags) THEN
  539. IF ~f.fs.Registered(f) THEN f.fs.Purge(f) END
  540. END
  541. END
  542. END Collect;
  543. *)
  544. (* Find file in open file list, or open and add it. *)
  545. PROCEDURE OpenOld(enum: FileSearcher; fs: FileSystem; VAR fname: ARRAY OF CHAR): File;
  546. VAR f: File; key: LONGINT;
  547. BEGIN
  548. f := NIL;
  549. IF (fs # NIL) & (fname # "") THEN
  550. key := fs.FileKey(fname);
  551. IF key # 0 THEN f := FindOpenFile(enum, fs, key) END;
  552. IF f = NIL THEN (* not found *)
  553. f := fs.Old0(fname);
  554. IF f # NIL THEN
  555. ASSERT(f.key # 0); (* key must be set *)
  556. files.Add(f, NIL);
  557. (* GC
  558. Heaps.RegisterFinalizer(f, Collect); (* to do: use one finalizer for ordering *)
  559. *)
  560. END
  561. END
  562. END;
  563. RETURN f
  564. END OpenOld;
  565. (** Open an existing file, searching through the mounted file system list if no prefix is specified. *)
  566. PROCEDURE Old*(name: ARRAY OF CHAR): File;
  567. VAR fs: FileSystem; f: File; prefix: Prefix; fname: FileName;
  568. BEGIN {EXCLUSIVE}
  569. f := NIL;
  570. SplitName(name, prefix, fname);
  571. IF prefix = "" THEN
  572. fs := fsroot;
  573. WHILE (fs # NIL) & (f = NIL) DO
  574. IF ~(NeedsPrefix IN fs.flags) THEN (* fof *)
  575. f := OpenOld(seacher, fs, fname);
  576. END;
  577. fs := fs.next
  578. END
  579. ELSE
  580. f := OpenOld(seacher, FindFS(prefix), fname)
  581. END;
  582. RETURN f
  583. END Old;
  584. (** Create a new file. If no prefix is specified, create the file on the first file system in the mounted list. *)
  585. PROCEDURE New*(name: ARRAY OF CHAR): File;
  586. VAR fs: FileSystem; f: File; prefix: Prefix; fname: FileName;
  587. BEGIN {EXCLUSIVE}
  588. f := NIL; SplitName(name, prefix, fname);
  589. IF prefix = "" THEN
  590. fs := fsroot; (* use default file system *)
  591. IF fname = "" THEN (* anonymous file on unspecified file system *)
  592. WHILE (fs # NIL) & ((fs.vol = NIL) OR (fs.vol.flags * {Boot,ReadOnly} # {Boot})) DO
  593. fs := fs.next (* find a writable boot file system *)
  594. END;
  595. IF fs = NIL THEN fs := fsroot END (* none found, relapse to default *)
  596. END
  597. ELSE
  598. fs := FindFS(prefix);
  599. END;
  600. IF fs # NIL THEN
  601. IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
  602. f := fs.New0(fname);
  603. (* GC
  604. IF f # NIL THEN
  605. Heaps.RegisterFinalizer(f, Collect)
  606. END
  607. *)
  608. END
  609. END;
  610. RETURN f
  611. END New;
  612. (** Delete a file. res = 0 indicates success. *)
  613. PROCEDURE Delete*(VAR name: ARRAY OF CHAR; VAR res: LONGINT);
  614. VAR fs: FileSystem; f: File; key: LONGINT; prefix: Prefix; fname: FileName;
  615. BEGIN {EXCLUSIVE}
  616. SplitName(name, prefix, fname);
  617. IF prefix = "" THEN fs := fsroot ELSE fs := FindFS(prefix) END;
  618. IF fs # NIL THEN
  619. IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
  620. fs.Delete0(fname, key, res);
  621. IF key # 0 THEN
  622. LOOP (* remove all occurances of file (fs,key) from collection. *)
  623. f := FindOpenFile(seacher, fs, key);
  624. IF f = NIL THEN EXIT END;
  625. files.Remove(f)
  626. END
  627. END
  628. ELSE
  629. res := VolumeReadOnly (* can not modify read-only volume *)
  630. END
  631. ELSE
  632. res := FsNotFound (* file system not found *)
  633. END
  634. END Delete;
  635. (* copies the file with the given name to the fileClipboard *)
  636. PROCEDURE Copy*(name: ARRAY OF CHAR; VAR res: LONGINT);
  637. VAR file: File;
  638. BEGIN
  639. res := -1;
  640. file := Old(name);
  641. IF file = NIL THEN RETURN END;
  642. fileClipboard := file;
  643. res := 0;
  644. END Copy;
  645. (* pastes the fileClipboard into the file with the given name if it doesn't exist already *)
  646. PROCEDURE Paste*(name: ARRAY OF CHAR; VAR res: LONGINT);
  647. VAR writer : Writer;
  648. reader : Reader;
  649. file : File;
  650. chunk : ARRAY 4096 OF CHAR;
  651. len : LONGINT;
  652. BEGIN
  653. IF fileClipboard = NIL THEN RETURN END;
  654. IF Old(name) # NIL THEN res := FileAlreadyExists; (* File already exists *)
  655. ELSE
  656. file := New(name);
  657. IF file = NIL THEN res := BadFileName; RETURN END; (* Bad Filename *)
  658. NEW(writer, file, 0);
  659. NEW(reader, fileClipboard, 0);
  660. WHILE (reader.res = Streams.Ok) DO
  661. reader.Bytes(chunk, 0, LEN(chunk), len);
  662. writer.Bytes(chunk, 0, len);
  663. END;
  664. writer.Update;
  665. Register(file);
  666. res := 0;
  667. END;
  668. END Paste;
  669. (**
  670. * Make a copy of a file
  671. * @param source: Prefix, path and name of file to be copied
  672. * @param destination: Prefix, path and name of file to be created
  673. * @param overwrite: @in: Overwrite existing files? @out: Has an existing file been overwritten?
  674. * @param res: @out: Result code
  675. *)
  676. PROCEDURE CopyFile*(source, destination : ARRAY OF CHAR; VAR overwrite : BOOLEAN; VAR res : LONGINT);
  677. VAR
  678. sprefix, dprefix : Prefix;
  679. sname, dname, dpath, dfilename: FileName;
  680. sPos, dPos : Rider;
  681. sfs, dfs : FileSystem;
  682. sfile, dfile : File;
  683. buffer : ARRAY BufferSize OF CHAR;
  684. i : HUGEINT;
  685. BEGIN
  686. SplitName(source, sprefix, sname);
  687. SplitName(destination, dprefix, dname);
  688. BEGIN {EXCLUSIVE}
  689. IF sprefix = "" THEN sfs := fsroot; ELSE sfs := FindFS(sprefix); END;
  690. IF dprefix = "" THEN dfs := fsroot; ELSE dfs := FindFS(dprefix); END;
  691. IF (sfs # NIL) & (dfs # NIL) THEN (* We found the file system *)
  692. IF (dfs.vol = NIL) OR ~(ReadOnly IN dfs.vol.flags) THEN (* We may write to the target volume *)
  693. sfile := OpenOld(seacher, sfs, sname);
  694. IF sfile # NIL THEN (* We found the source file *)
  695. SplitName(dname, dpath, dfilename);
  696. IF (dfilename # "") THEN
  697. dfile := OpenOld(seacher, dfs, dname);
  698. IF (dfile = NIL) OR overwrite THEN (* We may write to the target file *)
  699. IF dfile # NIL THEN overwrite := TRUE; ELSE overwrite := FALSE; END;
  700. IF overwrite THEN
  701. dfile.GetName(dname);
  702. SplitName(dname, dprefix, dname);
  703. END;
  704. dfile := dfs.New0(dname);
  705. IF dfile # NIL THEN (* We could create the target file *)
  706. res := Ok;
  707. ELSE res := BadFileName;
  708. END;
  709. ELSE res := FileAlreadyExists;
  710. END;
  711. ELSE res := BadFileName;
  712. END;
  713. ELSE res := FileNotFound;
  714. END;
  715. ELSE res :=VolumeReadOnly;
  716. END;
  717. ELSE res := FsNotFound;
  718. END;
  719. END;
  720. IF res # Ok THEN RETURN END;
  721. (* copy file content *)
  722. sfile.Set(sPos, 0); dfile.Set(dPos, 0);
  723. i := 0;
  724. WHILE i < (sfile.Length() DIV BufferSize) DO
  725. sfile.ReadBytes(sPos, buffer, 0, BufferSize);
  726. dfile.WriteBytes(dPos, buffer, 0, BufferSize);
  727. INC(i);
  728. END;
  729. sfile.ReadBytes(sPos, buffer, 0, LONGINT( sfile.Length() MOD BufferSize));
  730. dfile.WriteBytes(dPos, buffer, 0, LONGINT(sfile.Length() MOD BufferSize));
  731. dfile.Update;
  732. Register(dfile); (* Will enter exclusive region *)
  733. END CopyFile;
  734. (** Rename a file. res = 0 indicates success. *)
  735. PROCEDURE Rename*(CONST old, new: ARRAY OF CHAR; VAR res: LONGINT);
  736. VAR
  737. key: LONGINT; ofs, nfs: FileSystem; f: File; pold, pnew: Prefix;
  738. fold, fnew: FileName;
  739. BEGIN {EXCLUSIVE}
  740. SplitName(old, pold, fold);
  741. SplitName(new, pnew, fnew);
  742. IF pold = "" THEN ofs := fsroot ELSE ofs := FindFS(pold) END;
  743. IF pnew = "" THEN nfs := fsroot ELSE nfs := FindFS(pnew) END;
  744. IF (nfs # NIL) & (ofs = nfs) THEN
  745. IF (nfs.vol = NIL) OR ~(ReadOnly IN nfs.vol.flags) THEN
  746. key := nfs.FileKey(fold);
  747. IF key # 0 THEN f := FindOpenFile(seacher, nfs, key) ELSE f := NIL END;
  748. nfs.Rename0(fold, fnew, f, res)
  749. ELSE
  750. res := VolumeReadOnly (* can not modify read-only volume *)
  751. END
  752. ELSE
  753. res := FsNotFound (* file system not found *)
  754. END
  755. END Rename;
  756. (** Register a file created with New in the directory, replacing the previous file in the directory with the same name. The file is automatically closed. *)
  757. PROCEDURE Register*(f: File);
  758. VAR res: LONGINT;
  759. BEGIN {EXCLUSIVE}
  760. IF f # NIL THEN
  761. f.Register0(res);
  762. IF res = 0 THEN (* if register went ok (first time register) *)
  763. ASSERT(f.key # 0);
  764. files.Add(f, NIL)
  765. END
  766. END
  767. END Register;
  768. (** Create a directory structure. Directories are automatically registered. res=0 indicates success.
  769. Use Files.RemoveDirectory to delete a directory *)
  770. PROCEDURE CreateDirectory*(path: ARRAY OF CHAR; VAR res: LONGINT);
  771. VAR prefix: Prefix; fs: FileSystem; fpath: FileName;
  772. BEGIN {EXCLUSIVE}
  773. SplitName(path, prefix, fpath);
  774. IF prefix = "" THEN fs := fsroot
  775. ELSE fs := FindFS(prefix)
  776. END;
  777. IF fs # NIL THEN fs.CreateDirectory0(fpath, res)
  778. ELSE res := -1
  779. END
  780. END CreateDirectory;
  781. (** Remove a directory. res=0 indicates success. If force=TRUE, any files and subdirectories are automatically deleted. *)
  782. PROCEDURE RemoveDirectory*(path: ARRAY OF CHAR; force: BOOLEAN; VAR res: LONGINT);
  783. VAR prefix: Prefix; fs: FileSystem; f: File; key: LONGINT; fpath: FileName;
  784. BEGIN {EXCLUSIVE}
  785. SplitName(path, prefix, fpath);
  786. IF prefix = "" THEN fs := fsroot ELSE fs := FindFS(prefix) END;
  787. IF fs # NIL THEN
  788. IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
  789. fs.RemoveDirectory0(fpath, force, key, res);
  790. IF key # 0 THEN
  791. LOOP (* remove all aoccurances of file (fs,key) from collection. *)
  792. f := FindOpenFile(seacher, fs, key);
  793. IF f = NIL THEN EXIT END;
  794. files.Remove(f)
  795. END
  796. END
  797. ELSE
  798. res := VolumeReadOnly (* can not modify read-only volume *)
  799. END
  800. ELSE
  801. res := FsNotFound (* file system not found *)
  802. END
  803. END RemoveDirectory;
  804. (* Enumerates files matching mask *)
  805. PROCEDURE Enumerate(VAR mask: ARRAY OF CHAR; flags: SET; enum: Enumerator);
  806. VAR
  807. fs: FileSystem; ft: FileSystemTable; i: LONGINT;
  808. prefix: Prefix; fmask: FileName;
  809. BEGIN
  810. SplitName(mask, prefix, fmask);
  811. IF prefix = "" THEN
  812. GetList(ft);
  813. IF ft # NIL THEN
  814. (* FIX: deadlock possible if fs containing anonymous file does not allow concurrent Enumerate and Write *)
  815. FOR i := 0 TO LEN(ft^)-1 DO
  816. IF ~(NeedsPrefix IN ft[i].flags) THEN
  817. ft[i].Enumerate0(fmask, flags, enum)
  818. END;
  819. END
  820. END
  821. ELSE
  822. fs := This(prefix);
  823. IF fs # NIL THEN fs.Enumerate0(fmask, flags, enum) END
  824. END
  825. END Enumerate;
  826. PROCEDURE Exists*(CONST fileName: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
  827. VAR
  828. fs: FileSystem; ft: FileSystemTable; i: LONGINT;
  829. prefix: Prefix;
  830. BEGIN
  831. IF prefix = "" THEN
  832. GetList(ft);
  833. IF ft # NIL THEN
  834. (* FIX: deadlock possible if fs containing anonymous file does not allow concurrent Enumerate and Write *)
  835. FOR i := 0 TO LEN(ft^)-1 DO
  836. IF ~(NeedsPrefix IN ft[i].flags) THEN
  837. IF ft[i].Has(fileName, fullName, flags) THEN RETURN TRUE END;
  838. END;
  839. END
  840. END
  841. ELSE
  842. fs := This(prefix);
  843. RETURN fs.Has(fileName, fullName, flags);
  844. END;
  845. RETURN FALSE;
  846. END Exists;
  847. (* add a search path to the system *)
  848. PROCEDURE AddSearchPath*(context: Commands.Context);
  849. VAR cmd: ARRAY 32 OF CHAR; msg: ARRAY 256 OF CHAR; res: LONGINT;
  850. BEGIN
  851. (* preliminary implementation until we know how to solve this generically *)
  852. IF Modules.ModuleByName("HostFiles64") # NIL THEN
  853. cmd := "HostFiles64.AddSearchPath";
  854. END;
  855. IF cmd # "" THEN
  856. Commands.Activate(cmd, context, {Commands.Wait}, res, msg);
  857. IF res # 0 THEN context.error.String(msg); context.error.Ln; END;
  858. END
  859. END AddSearchPath;
  860. (* add a search path to the system *)
  861. PROCEDURE SetWorkPath*(context: Commands.Context);
  862. VAR cmd: ARRAY 32 OF CHAR; msg: ARRAY 256 OF CHAR; res: LONGINT;
  863. BEGIN
  864. (* preliminary implementation until we know how to solve this generically *)
  865. IF Modules.ModuleByName("HostFiles64") # NIL THEN
  866. cmd := "HostFiles64.SetWorkPath";
  867. END;
  868. IF cmd # "" THEN
  869. Commands.Activate(cmd, context, {Commands.Wait}, res, msg);
  870. IF res # 0 THEN context.error.String(msg); context.error.Ln; END;
  871. END
  872. END SetWorkPath;
  873. (* Find an open file. *)
  874. PROCEDURE FindOpenFile(enum: FileSearcher; fs: FileSystem; key: LONGINT): File;
  875. BEGIN (* not exported, because of possible race condition *)
  876. enum.fs := fs; enum.key := key; enum.found := NIL;
  877. files.Enumerate(enum.EnumFile);
  878. RETURN enum.found
  879. END FindOpenFile;
  880. (** Portable routines to read the standard Oberon types. DEPRECATED, use Streams instead. *)
  881. PROCEDURE ReadSInt*(VAR r: Rider; VAR x: SHORTINT);
  882. BEGIN
  883. r.file.Read(r, SYSTEM.VAL(CHAR, x))
  884. END ReadSInt;
  885. PROCEDURE ReadInt*(VAR r: Rider; VAR x: INTEGER);
  886. BEGIN
  887. r.file.ReadBytes(r, SYSTEM.VAL(Bytes2, x), 0, 2)
  888. END ReadInt;
  889. PROCEDURE ReadLInt*(VAR r: Rider; VAR x: LONGINT);
  890. BEGIN
  891. r.file.ReadBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
  892. END ReadLInt;
  893. PROCEDURE ReadHInt*(VAR r: Rider; VAR x: HUGEINT);
  894. BEGIN
  895. r.file.ReadBytes(r, SYSTEM.VAL(Bytes8, x), 0, SIZEOF(HUGEINT))
  896. END ReadHInt;
  897. PROCEDURE ReadSet*(VAR r: Rider; VAR x: SET);
  898. CONST Size = SIZEOF (SET);
  899. TYPE Bytes = ARRAY Size OF CHAR;
  900. BEGIN
  901. r.file.ReadBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
  902. END ReadSet;
  903. PROCEDURE ReadBool*(VAR r: Rider; VAR x: BOOLEAN);
  904. VAR ch: CHAR;
  905. BEGIN
  906. r.file.Read(r, ch); x := ch # 0X
  907. END ReadBool;
  908. PROCEDURE ReadReal*(VAR r: Rider; VAR x: REAL);
  909. BEGIN
  910. r.file.ReadBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
  911. END ReadReal;
  912. PROCEDURE ReadLReal*(VAR r: Rider; VAR x: LONGREAL);
  913. BEGIN
  914. r.file.ReadBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
  915. END ReadLReal;
  916. PROCEDURE ReadString*(VAR r: Rider; VAR x: ARRAY OF CHAR);
  917. VAR i: LONGINT; ch: CHAR; f: File;
  918. BEGIN
  919. i := 0; f := r.file;
  920. LOOP
  921. f.Read(r, ch); x[i] := ch; INC(i);
  922. IF ch = 0X THEN EXIT END;
  923. IF i = LEN(x) THEN
  924. x[i-1] := 0X;
  925. REPEAT f.Read(r, ch) UNTIL ch = 0X;
  926. EXIT
  927. END
  928. END
  929. END ReadString;
  930. (* Reads a number in compressed format. *)
  931. PROCEDURE ReadNum*(VAR r: Rider; VAR x: LONGINT);
  932. VAR ch: CHAR; n, y: LONGINT; f: File;
  933. BEGIN
  934. n := 0; y := 0; f := r.file;
  935. f.Read(r, ch);
  936. WHILE ch >= 80X DO
  937. INC(y, LSH(LONG(ORD(ch)) - 128, n)); INC(n, 7);
  938. f.Read(r, ch)
  939. END;
  940. x := ASH(LSH(LONG(ORD(ch)), 25), n-25) + y
  941. END ReadNum;
  942. (** Portable routines to write the standard Oberon types. DEPRECATED, used Streams instead. *)
  943. PROCEDURE WriteSInt*(VAR r: Rider; x: SHORTINT);
  944. BEGIN
  945. r.file.Write(r, SYSTEM.VAL(CHAR, x))
  946. END WriteSInt;
  947. PROCEDURE WriteInt*(VAR r: Rider; x: INTEGER);
  948. BEGIN
  949. r.file.WriteBytes(r, SYSTEM.VAL(Bytes2, x), 0, 2)
  950. END WriteInt;
  951. PROCEDURE WriteLInt*(VAR r: Rider; x: LONGINT);
  952. BEGIN
  953. r.file.WriteBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
  954. END WriteLInt;
  955. PROCEDURE WriteHInt*(VAR r: Rider; x: HUGEINT);(*TODO HUGEINT *)
  956. BEGIN
  957. r.file.WriteBytes(r, SYSTEM.VAL(Bytes8, x), 0, SIZEOF(HUGEINT))
  958. END WriteHInt;
  959. PROCEDURE WriteSet*(VAR r: Rider; x: SET);
  960. CONST Size = SIZEOF (SET);
  961. TYPE Bytes = ARRAY Size OF CHAR;
  962. BEGIN
  963. r.file.WriteBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
  964. END WriteSet;
  965. PROCEDURE WriteBool*(VAR r: Rider; x: BOOLEAN);
  966. BEGIN
  967. IF x THEN r.file.Write(r, 1X) ELSE r.file.Write(r, 0X) END
  968. END WriteBool;
  969. PROCEDURE WriteReal*(VAR r: Rider; x: REAL);
  970. BEGIN
  971. r.file.WriteBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
  972. END WriteReal;
  973. PROCEDURE WriteLReal*(VAR r: Rider; x: LONGREAL);
  974. BEGIN
  975. r.file.WriteBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
  976. END WriteLReal;
  977. PROCEDURE WriteString*(VAR r: Rider; x: ARRAY OF CHAR);
  978. VAR i: LONGINT;
  979. BEGIN
  980. i := 0; WHILE x[i] # 0X DO INC(i) END;
  981. r.file.WriteBytes(r, x, 0, i+1)
  982. END WriteString;
  983. (* Writes a number in a compressed format. *)
  984. PROCEDURE WriteNum*(VAR r: Rider; x: LONGINT);
  985. VAR f: File;
  986. BEGIN
  987. f := r.file;
  988. WHILE (x < - 64) OR (x > 63) DO
  989. f.Write(r, CHR(x MOD 128 + 128)); x := x DIV 128
  990. END;
  991. f.Write(r, CHR(x MOD 128))
  992. END WriteNum;
  993. (** Help procedures. *)
  994. (** Append first string to second string, truncating on overflow. *)
  995. PROCEDURE AppendStr*(from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
  996. VAR i, j, m: LONGINT;
  997. BEGIN
  998. j := 0; WHILE to[j] # 0X DO INC(j) END;
  999. m := LEN(to)-1;
  1000. i := 0; WHILE (from[i] # 0X) & (j # m) DO to[j] := from[i]; INC(i); INC(j) END;
  1001. to[j] := 0X
  1002. END AppendStr;
  1003. (** Append unsigned integer to string in ASCII format. *)
  1004. PROCEDURE AppendInt*(x: LONGINT; VAR to: ARRAY OF CHAR);
  1005. VAR i, m: LONGINT;
  1006. BEGIN
  1007. ASSERT(x >= 0);
  1008. i := 0; WHILE to[i] # 0X DO INC(i) END;
  1009. IF x # 0 THEN
  1010. m := 1000000000;
  1011. WHILE x < m DO m := m DIV 10 END;
  1012. REPEAT
  1013. to[i] := CHR(48 + (x DIV m) MOD 10); INC(i);
  1014. m := m DIV 10
  1015. UNTIL m = 0
  1016. ELSE
  1017. to[i] := "0"; INC(i)
  1018. END;
  1019. to[i] := 0X
  1020. END AppendInt;
  1021. (** Get the dev#part string from the stream *)
  1022. PROCEDURE GetDevPart*(arg : Streams.Reader; VAR deviceName : ARRAY OF CHAR; VAR partition : LONGINT);
  1023. VAR i : LONGINT; ch : CHAR;
  1024. BEGIN
  1025. arg.SkipWhitespace;
  1026. deviceName := ""; partition := 0;
  1027. i := 0;
  1028. ch := arg.Peek();
  1029. WHILE (i < LEN(deviceName)-1) & (ch > " ") & (ch # "#") & (ch # ",") & (arg.res = Streams.Ok) DO
  1030. arg.Char(ch); (* consume ch *)
  1031. deviceName[i] := ch; INC(i);
  1032. ch := arg.Peek();
  1033. END;
  1034. deviceName[i] := 0X;
  1035. IF (ch = "#") THEN
  1036. arg.Char(ch); (* consume "#" *)
  1037. arg.Int(partition, FALSE);
  1038. ELSE
  1039. partition := 0;
  1040. END;
  1041. END GetDevPart;
  1042. (* Clean up file systems when shutting down or unloading module. *)
  1043. PROCEDURE FSCleanup;
  1044. VAR ft: FileSystemTable; i: LONGINT;
  1045. BEGIN
  1046. GetList(ft);
  1047. IF ft # NIL THEN
  1048. FOR i := 0 TO LEN(ft^)-1 DO Remove(ft[i]) END
  1049. END
  1050. END FSCleanup;
  1051. (* debugging *)
  1052. (*
  1053. PROCEDURE ShowList*;
  1054. VAR
  1055. enum: OBJECT
  1056. VAR i: LONGINT;
  1057. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  1058. VAR name: FileName;
  1059. BEGIN
  1060. WITH f: File DO
  1061. KernelLog.Int(i, 1); KernelLog.Char(" ");
  1062. (*KernelLog.String(f.fs.prefix); KernelLog.Char(" ");*)
  1063. KernelLog.Address(SYSTEM.VAL(ADDRESS, f)); KernelLog.Char(" ");
  1064. KernelLog.Int(f.key, 1); KernelLog.Char(" ");
  1065. KernelLog.Int(f.Length(), 1); KernelLog.Char(" ");
  1066. f.GetName(name);
  1067. KernelLog.String(name); KernelLog.Ln;
  1068. INC(i)
  1069. END
  1070. END EnumFile;
  1071. END;
  1072. BEGIN
  1073. NEW(enum); enum.i := 0; KernelLog.Ln;
  1074. files.Enumerate(enum.EnumFile)
  1075. END ShowList;
  1076. *)
  1077. BEGIN
  1078. fsroot := NIL; NEW(seacher); NEW(files);
  1079. Modules.InstallTermHandler(FSCleanup)
  1080. END Files64.
  1081. (**
  1082. Notes:
  1083. o A typical code pattern for reading a file is:
  1084. VAR f: Files.File; r: Files.Reader; ch: CHAR;
  1085. f := Files.Old(filename); (* open an existing file *)
  1086. IF f # NIL THEN
  1087. Files.OpenReader(r, f, 0); (* open a buffer on the file *)
  1088. LOOP
  1089. ch := r.Get(); (* read a character from the buffer *)
  1090. IF r.res # Streams.Ok THEN EXIT END; (* end-of-file, or other error *)
  1091. "do something with ch"
  1092. END
  1093. END
  1094. o A typical code pattern for writing a file is:
  1095. VAR f: Files.File; w: Files.Writer; ch: CHAR;
  1096. f := Files.New(filename); (* create a new file (not visible yet) *)
  1097. IF f # NIL THEN
  1098. Files.OpenWriter(w, f, 0); (* open a buffer on the file *)
  1099. WHILE "not done" DO
  1100. "assign ch"
  1101. w.Char(ch) (* write a character to the buffer (if the buffer is full, it is written to the file) *)
  1102. END;
  1103. w.Update; (* write the last buffer to the file *)
  1104. Files.Register(f) (* enter the file in the directory *)
  1105. o See the Streams module for more procedures operating on Reader and Writer buffers, e.g. ReadRawInt, WriteRawInt, etc.
  1106. o Never use an exported identifier with a name ending in "0", unless you are implementing a file system.
  1107. o Never use an exported identifier that is documented as "private".
  1108. o File system implementations must implement the FileKey procedure to assign a unique key value to every file in the file system. The key is used by the Files module to ensure that the Old procedure returns an existing file if it is already open. The key need not be persistent, but must stay unique during a whole session (between mount and unmount). The 0 key is reserved to indicate non-existent files.
  1109. *)
  1110. (*
  1111. On-the-fly GC by bsm
  1112. In order to be non-leaking, a file system must provide the following:
  1113. - FileSystem.Purge -- to reclaim blocks of an open (being closed) file
  1114. - FileSystem.Registered -- reports if a particular open file is registered in the file directory
  1115. The following procedures need to be modified to purge file blocks when appropriate.
  1116. - FileSystem.Register0 -- if an entry to a file, F, which is not open is replaced, purge F.
  1117. - FileSystem.Rename0 -- same as register.
  1118. - FileSystem.Delete0 -- if the entry being deleted refers to a file, F, which is not open, purge F.
  1119. *)
  1120. (*
  1121. Lock order: Files, File, FileSystem
  1122. *)
  1123. Files.File
  1124. Files.File
  1125. Files.Rider
  1126. Files.Reader
  1127. Files.Writer
  1128. Files.Old
  1129. Files.Old
  1130. Files.Set
  1131. Files.OpenReader
  1132. Files.OpenWriter
  1133. Files.ReadNum
  1134. Streams.ReadRawNum
  1135. Files.ReadInt
  1136. Streams.ReadRawInt
  1137. Files.ReadLInt
  1138. Streams.ReadRawLInt
  1139. Files.ReadString
  1140. Streams.ReadRawString
  1141. Files.ReadBytes
  1142. Streams.ReadBytes [add 0 ofs parameter, and len parameter]
  1143. Files.Read(
  1144. Streams.Read(
  1145. Files.ReadBool
  1146. Streams.ReadRawBool
  1147. Files.WriteInt
  1148. Streams.WriteRawInt
  1149. Files.Write(
  1150. Streams.Write(
  1151. Files.WriteBytes
  1152. Streams.WriteBytes [add 0 ofs parameter]