OberonCore

MODULE System:Files;

IMPORT
  SYSTEM, System:Kernel, System:Strings, System:Log;

TYPE
  OpenMode* = EMPTY EXTENSIBLE RECORD;
  shared* = EMPTY RECORD (OpenMode);
  exclusive* = EMPTY RECORD (OpenMode);

TYPE
  (* error codes for `Locator` and such; `NIL` is "ok" *)
  FileError* = EMPTY EXTENSIBLE RECORD;
  badName* = EMPTY RECORD (FileError);
  notFound* = EMPTY RECORD (FileError);
  fileExists* = EMPTY RECORD (FileError);
  writeProtected* = EMPTY RECORD (FileError);
  accessDenied* = EMPTY RECORD (FileError);
  notSupported* = EMPTY RECORD (FileError);
  tooBig* = EMPTY RECORD (FileError);
  ioError* = EMPTY RECORD (FileError);
  diskFull* = EMPTY RECORD (ioError); (* `ioError` may be returned instead *)

CONST
  (* attribute bits *)
  directory* = 0;
  readOnly* = 1;
  hidden* = 2;

TYPE
  Offset* = REAL;
  Size* = REAL;

  FileDate* = RECORD
    year*, month*, day*, hour*, minute*, second*: INTEGER;
  END;

  (* it is extensible, because some file systems may return additional info here *)
  FileInfo* = EXTENSIBLE RECORD
    name*: STRING; (* full, with extension, but without any path *)
    length*: Size;
    attr*: SET;
    mdate*: FileDate; (* modified; may be the same as created *)
    cdate*: FileDate; (* created; may be the same as modified *)
  END;

TYPE
  Locator* = POINTER TO ABSTRACT RECORD
    res*: FileError;
  END;

  (* should never return the same locator. may return `NIL` on error.
   * the caller should always check new locator's `.res` field for errors!
   * to duplicate the existing locator, use empty path.
   * always set `loc.res`. *)
  PROCEDURE (loc: Locator) This* (IN path: STRING): Locator, NEW, ABSTRACT;
  (* may return NIL if there is no such thing as "path" for this locator.
   * returned path (if not empty) should be usable to recreate the locator. *)
  PROCEDURE (loc: Locator) Path* (): STRING, NEW, ABSTRACT;
  (* may return NIL if there is no such thing as "real path" for this locator *)
  PROCEDURE (loc: Locator) RealPath* (): STRING, NEW, ABSTRACT;

  PROCEDURE (loc: Locator) New* (): File, NEW, ABSTRACT;
  PROCEDURE (loc: Locator) Old* (IN name: STRING; mode: OpenMode): File, NEW, ABSTRACT;

  (* optional operation; may set "notSupported" error *)
  PROCEDURE (loc: Locator) Delete* (IN name: STRING), NEW, EXTENSIBLE;
  BEGIN loc.res := notSupported; END Delete;

  (* optional operation; may set "notSupported" error *)
  PROCEDURE (loc: Locator) Rename* (IN old, new: STRING), NEW, EXTENSIBLE;
  BEGIN loc.res := notSupported; END Rename;

  (* this doesn't touch the `newloc.res` *)
  PROCEDURE (loc: Locator) Move* (IN old: STRING; newloc: Locator; new: STRING), NEW, EXTENSIBLE;
  BEGIN loc.res := notSupported; END Move;

  (* doesn't touch `.res` of any locator *)
  PROCEDURE (loc: Locator) SamePath* (otherloc: Locator): BOOLEAN, NEW, ABSTRACT;

  (* doesn't touch `.res`. do not compare names directly! *)
  PROCEDURE (loc: Locator) SameName* (IN name0, name1: STRING): BOOLEAN, NEW, ABSTRACT;

  (* may return `NIL`, if iteration is not supported. may also return `old`.
   * theck `.res` field to see if the iteration is failed.
   * if `name` is not empty string, return reader with info about that name (or `NIL`/`old`).
   * in case of error may return `old`, but it will be marked as invalid. *)
  PROCEDURE (loc: Locator) NewReader* (IN name: STRING; old: LocReader): LocReader, NEW, ABSTRACT;


TYPE
  LocReader* = POINTER TO ABSTRACT RECORD END;

  (* return `FALSE` if there are no more items *)
  PROCEDURE (it: LocReader) Read* (OUT fi: FileInfo): BOOLEAN, NEW, ABSTRACT;


TYPE
  File* = POINTER TO ABSTRACT RECORD END;

  (* we'll force-flush data of important files on writing *)
  PROCEDURE (f: File) Important* (), NEW, EMPTY;
  PROCEDURE (f: File) Length* (): Size, NEW, ABSTRACT;
  (* HALT on error *)
  PROCEDURE (f: File) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
  (* HALT on error *)
  PROCEDURE (f: File) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
  (* write buffers; doesn't fsync for non-important files *)
  PROCEDURE (f: File) Flush* (), NEW, EMPTY;
  PROCEDURE (f: File) Register* (IN name: STRING; OUT res: FileError), NEW, ABSTRACT;
  (* this should not be called, ever! hence the long and ugly name;
   * note that opening the same file several times will return THE SAME file object, and
   * closing it will be disasterous. please, rely on GC for proper file closing. *)
  PROCEDURE (f: File) ForceCloseFile* (), NEW, ABSTRACT;
  (* legacy 32-bit API with error checking *)
  PROCEDURE (f: File) Length32* (): INTEGER, NEW;
  VAR l: Size;
  BEGIN l := f.Length(); ASSERT(l >= 0); ASSERT(l <= MAX(INTEGER)); RETURN (l AS INTEGER);
  END Length32;


TYPE
  Reader* = POINTER TO ABSTRACT RECORD
    eof-: BOOLEAN; (* immediately valid *)
  END;

  PROCEDURE (r: Reader) Base* (): File, NEW, ABSTRACT;
  PROCEDURE (r: Reader) Pos* (): Offset, NEW, ABSTRACT;
  PROCEDURE (r: Reader) SetPos* (pos: Offset), NEW, ABSTRACT;
  (* return number of bytes read. may be less than requested.
   * HALT on error. never return negative result.
   * if `count` is 0, this checks if the data is ready, and this is the
   * only case when the result is always 0. you need to check `eof` field in this case.
   * `eof` field is set to `TRUE` or `FALSE` according to the result. *)
  PROCEDURE (r: Reader) ReadBuff- (adr: SYSTEM.ADDRESS; count: INTEGER): INTEGER, NEW, ABSTRACT;
  (* legacy 32-bit API with error checking *)
  PROCEDURE (r: Reader) Pos32* (): INTEGER, NEW;
  VAR ofs: Offset;
  BEGIN ofs := r.Pos(); ASSERT(ofs >= 0); ASSERT(ofs <= MAX(INTEGER)); RETURN (ofs AS INTEGER);
  END Pos32;

  PROCEDURE (r: Reader) ReadByte* (OUT x: CHAR), NEW;
  BEGIN VOID:r.ReadBuff(SYSTEM.ADR(x), 1); END ReadByte;

  PROCEDURE (r: Reader) ReadBytes* (VAR x: ARRAY OF CHAR), NEW;
  VAR
    rd, left: INTEGER;
    adr: SYSTEM.ADDRESS;
  BEGIN
    left := LEN(x); ASSERT(left > 0);
    adr := SYSTEM.ADR(x[0]);
    WHILE left # 0 DO
      rd := r.ReadBuff(adr, left);
      ASSERT(rd # 0, "file reading error");
      ASSERT((rd >= 0) & (rd <= left));
      DEC(left, rd);
      INC(adr, rd);
    END WHILE
    ASSERT(left = 0, "file reading error");
  END ReadBytes;

  (* return number of bytes read. may be less than requested. *)
  PROCEDURE (r: Reader) ReadData* (VAR x: ARRAY OF CHAR): INTEGER, NEW;
  BEGIN ASSERT(LEN(x) > 0); RETURN r.ReadBuff(SYSTEM.ADR(x[0]), LEN(x)); END ReadData;

  (* custom readers may implement faster version of this *)
  PROCEDURE (r: Reader) ReadLn* (): STRING, NEW, EXTENSIBLE;
  VAR
    res: STRING;
    ch: CHAR;
  BEGIN
    r.ReadByte(^ch);
    IF r.eof THEN RETURN NIL; END IF
    REPEAT
      CAT(@res, ch);
      r.ReadByte(^ch);
    UNTIL r.eof OR (ch = 0AX);
    RETURN res;
  END ReadLn;


TYPE
  Writer* = POINTER TO ABSTRACT RECORD END;

  PROCEDURE (w: Writer) Base* (): File, NEW, ABSTRACT;
  PROCEDURE (w: Writer) Pos* (): Offset, NEW, ABSTRACT;
  PROCEDURE (w: Writer) SetPos* (pos: Offset), NEW, ABSTRACT;
  (* always write the requested number of bytes. failure to write `count` bytes is error.
   * HALT on error. *)
  PROCEDURE (w: Writer) WriteBuff- (adr: SYSTEM.ADDRESS; count: INTEGER), NEW, ABSTRACT;

  (* legacy 32-bit API with error checking *)
  PROCEDURE (w: Writer) Pos32* (): INTEGER, NEW;
  VAR ofs: Offset;
  BEGIN ofs := w.Pos(); ASSERT(ofs >= 0); ASSERT(ofs <= MAX(INTEGER)); RETURN (ofs AS INTEGER);
  END Pos32;

  PROCEDURE (w: Writer) WriteByte* (x: CHAR), NEW;
  BEGIN w.WriteBuff(SYSTEM.ADR(x), 1); END WriteByte;

  PROCEDURE (w: Writer) WriteBytes* (IN x: ARRAY OF CHAR), NEW;
  BEGIN ASSERT(LEN(x) > 0); w.WriteBuff(SYSTEM.ADR(x[0]), LEN(x)); END WriteBytes;

  (* custom writers may implement faster version of this *)
  PROCEDURE (w: Writer) Write* (IN s: STRING), NEW;
  BEGIN IF s # NIL THEN w.WriteBuff(SYSTEM.ADR(s[0]), LEN(s)); END IF
  END Write;

  (* custom writers may implement faster version of this *)
  PROCEDURE (w: Writer) WriteLn* (IN s: STRING), NEW;
  BEGIN
    IF s # NIL THEN w.WriteBuff(SYSTEM.ADR(s[0]), LEN(s)); END IF
    w.WriteByte(0AX);
  END WriteLn;


TYPE
  Driver* = POINTER TO ABSTRACT RECORD END;

  (* return `NIL` for unsupported path *)
  PROCEDURE (d: Driver) This* (IN path: STRING): Locator, NEW, ABSTRACT;
  (* return `NIL` if cannot create a temp file *)
  PROCEDURE (d: Driver) Temp* (): File, NEW, EXTENSIBLE;
  BEGIN RETURN NIL; END Temp;


(* check if `name` is a good file name -- without path and such *)
PROCEDURE IsGoodName* (IN name: STRING): BOOLEAN;
  PROCEDURE IsGoodChar (ch: CHAR): BOOLEAN;
  BEGIN RETURN (ORD(ch) >= 32) & (ch # '/') & (ch # '\') & (ch # ':') & (ch # ';') & (ch # 7FX);
  END IsGoodChar;
VAR pos, len: INTEGER;
BEGIN
  len := LEN(name);
  IF len = 0 THEN RETURN FALSE; END IF
  WHILE (pos # len) & IsGoodChar(name[pos]) DO INC(pos); END WHILE
  IF pos # len THEN RETURN FALSE; END IF
  pos := 0;
  WHILE (pos # len) & (name[pos] = '.') DO INC(pos); END WHILE
  RETURN (pos # len);
END IsGoodName;


(******** driver list ********)

TYPE
  DriverItem- = POINTER TO RECORD
    next-: DriverItem;
    driver-: Driver;
  END;


VAR
  drivers-: DriverItem;


PROCEDURE RegisterDriver* (d: Driver);
VAR
  drivers: GLOBAL;
  di: DriverItem;
BEGIN ASSERT(d # NIL);
  NEW(di); di.driver := d; di.next := drivers; drivers := di;
END RegisterDriver;


(******** high-level API ********)

(* abort if all drivers rejected the path.
 * may return locator with `.res` field set on driver error. *)
PROCEDURE This* (IN path: STRING): Locator;
VAR
  drivers: GLOBAL;
  di: DriverItem;
  loc, rloc: Locator;
BEGIN
  di := drivers;
  WHILE (di # NIL) & (loc = NIL) DO
    loc := di.driver.This(path);
    (* we may get a locator with error here; keep trying, but remember it *)
    IF (loc # NIL) & (loc.res # NIL) THEN
      IF rloc # NIL THEN rloc := loc; END IF
      loc := NIL;
    END IF
    di := di.next;
  END WHILE
  (* return locator with error, if we got one *)
  IF loc = NIL THEN
    IF rloc = NIL THEN HALT("cannot create locator for path '" ~ path ~ "'"); END IF
    loc := rloc;
  END IF
  RETURN loc;
END This;


(* abort on error *)
PROCEDURE Temp* (): File;
VAR
  drivers: GLOBAL;
  di: DriverItem;
  fl: File;
BEGIN
  di := drivers;
  WHILE (di # NIL) & (fl = NIL) DO
    fl := di.driver.Temp();
    di := di.next;
  END WHILE
  ASSERT(fl # NIL, "cannot create temp file");
  RETURN fl;
END Temp;


BEGIN
  IF Kernel.hostOS IS Kernel.NixLikeOS THEN
    IF Kernel.LoadMod("System:Nix:Files") # 0 THEN
      HALT("cannot load host Files implementation");
    END IF
  ELSE HALT("no host 'Files' implementation for this OS");
  END IF
END System:Files.

parsing complete in 0.0109 seconds (2,086,312 bytes alloced)
compiling complete in 0.0447 seconds
memory used: nodes/types: 3,663,269; code: 103,604/1,048,576; data: 52,436; names: 18,072; types: 16,817
store optimisations: 349 (0 immediates)
ERROR(<wtf?>:1:0): cannot open source file for module `System:Shitdoze:Dates`
ERROR(<wtf?>:1:0): cannot open source file for module `System:Shitdoze:Files`
parsing complete in 0.0173 seconds (6,930,285 bytes alloced)
compiling complete in 0.00248 seconds
memory used: nodes/types: 7,040,725; code: 104,404/1,048,576; data: 235,164; names: 18,072; types: 179,934
store optimisations: 4 (0 immediates)
WARNING: cannot load queued module `System:Shitdoze:Files`!
WARNING: cannot load queued module `System:Shitdoze:Dates`!
parsing complete in 0.000921 seconds (7,231,485 bytes alloced)
compiling complete in 0.00477 seconds
memory used: nodes/types: 7,297,749; code: 120,084/1,048,576; data: 239,180; names: 18,072; types: 180,961
store optimisations: 53 (0 immediates)
glx: failed to create dri3 screen
failed to load driver: nouveau
glx: failed to create dri3 screen
failed to load driver: nouveau
FATAL: shader program linking failed!
ERROR:
TRAP in module `test_sgl1`, line 224: OpenGL ERROR