-- Copyright (C) 1986  by Xerox Corporation. All rights reserved. 
-- CIOLibImpl.mesa
-- NFS		19-May-86 15:30:40
-- MEW		23-May-86 17:08:01

-- Implementation of C I/O Library for tajo (uses MFile and MStream).

DIRECTORY
  Ascii USING [CR, NUL, SP, TAB],
  BucketAlloc USING [Alloc, Free],
  CIOLib USING [
    ClientDataObject, EOF, failure, FilePtr, seekCur, seekEnd, seekSet, success],
  CRuntime USING [
    EnterStream, EnterStreamGlobally, GetStderr, GetStdin, GetStdout, RemoveStream,
    SetStderr, SetStdin, SetStdout, StopIfUserAborted, z],
  CString USING [
    CString, CStringToLongString, IncrBPointer, ReadByte, ReadChar, ToBytePointer,
    ToWordPointer, WriteByte, WriteChar],
  Environment USING [Block],
  Inline USING [DBITAND],
  MFile USING [Acquire, AcquireTemp, Delete, Error, Handle, Release, Rename],
  MStream USING [
    Create, EndOf, Error, GetLength, Handle, ReadOnly, ReadWrite, WriteOnly],
  Stream USING [
    Byte, Block, Delete, DeleteProcedure, EndOfStream, GetBlock, GetByteProcedure,
    GetChar, GetPosition, GetProcedure, Handle, InvalidOperation, PutBlock,
    PutByte, PutByteProcedure, PutChar, PutProcedure, SendNow, SetPosition,
    SetPositionProcedure];

CIOLibImpl: PROGRAM
  IMPORTS BucketAlloc, CRuntime, CString, Inline, MFile, MStream, Stream
  EXPORTS CIOLib =
  {

  OPEN CIOLib;

  z: UNCOUNTED ZONE = CRuntime.z;

  String: TYPE = CString.CString;

  fopen: PUBLIC PROCEDURE [filename, type: String] RETURNS [FilePtr] = {
    h: Stream.Handle;
    CRuntime.StopIfUserAborted[];
    h ← fopenInternal[filename, type];
    IF h = NIL THEN RETURN[NIL];
    RETURN[CRuntime.EnterStream[sH: h]];
    };

  fopenInternal: PROCEDURE [filename, type: String] RETURNS [Stream.Handle] = {
    OPEN CString;
    h: Stream.Handle ← NIL;
    file: LONG STRING;
    c: CHAR;
    -- skip leading spaces.
    WHILE ((c ← ReadChar[filename]) = Ascii.SP) OR (c = Ascii.TAB) DO
      filename ← IncrBPointer[filename];
      ENDLOOP;
    file ← CStringToLongString[filename, z];
    {
    ENABLE MStream.Error => {h ← NIL; CONTINUE; };
    SELECT ReadChar[type] FROM
      'r => {
        type ← IncrBPointer[type];
        SELECT ReadChar[type] FROM
          Ascii.NUL => h ← MStream.ReadOnly[file, []];
          'b => h ← MStream.ReadOnly[file, []];
          '+ => {
            type ← IncrBPointer[type];
            SELECT ReadChar[type] FROM
              Ascii.NUL => {h ← MStream.ReadWrite[file, [], text]};
              'b => h ← MStream.ReadWrite[file, [], binary];
              ENDCASE;
            };
          ENDCASE;
        };
      'w => {
        type ← IncrBPointer[type];
        SELECT ReadChar[type] FROM
          Ascii.NUL => {h ← MStream.WriteOnly[file, [], text]};
          'b => h ← MStream.WriteOnly[file, [], binary];
          '+ => {
            type ← IncrBPointer[type];
            SELECT ReadChar[type] FROM
              Ascii.NUL => {h ← MStream.ReadWrite[file, [], text]};
              'b => h ← MStream.ReadWrite[file, [], binary];
              ENDCASE;
            };
          ENDCASE;
        };
      'a => {
        type ← IncrBPointer[type];
        SELECT ReadChar[type] FROM
          Ascii.NUL => {
            h ← MStream.WriteOnly[file, [], text];
            Stream.SetPosition[h, MStream.GetLength[h]];
            };
          'b => {
            h ← MStream.WriteOnly[file, [], binary];
            Stream.SetPosition[h, MStream.GetLength[h]];
            };
          '+ => {
            type ← IncrBPointer[type];
            SELECT ReadChar[type] FROM
              Ascii.NUL => {
                h ← MStream.ReadWrite[file, [], text];
                Stream.SetPosition[h, MStream.GetLength[h]];
                Stream.SetPosition[h, MStream.GetLength[h]];
                };
              'b => {
                h ← MStream.ReadWrite[file, [], binary];
                Stream.SetPosition[h, MStream.GetLength[h]];
                };
              ENDCASE;
            };
          ENDCASE;
        };
      ENDCASE;
    };  --enable 
    z.FREE[@file];
    RETURN[h];
    };

  fclose: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [INTEGER] = {
    sh: Stream.Handle;
    CRuntime.StopIfUserAborted[];
    IF stream = NIL THEN RETURN[failure];
    sh ← stream↑;  -- Copy stream handle because RemoveStream makes stream↑ NIL.
    IF sh = NIL THEN RETURN[failure];
    IF CRuntime.RemoveStream[sh].canDeleteStream THEN Stream.Delete[sh];
    RETURN[success];
    };

  freopen: PUBLIC PROCEDURE [filename, type: String, stream: FilePtr]
    RETURNS [FilePtr] = {
    sh: Stream.Handle;
    CRuntime.StopIfUserAborted[];
    IF stream = NIL THEN RETURN[NIL];
    sh ← stream↑;  -- Copy stream handle because RemoveStream makes stream↑ NIL.
    IF CRuntime.RemoveStream[sh].canDeleteStream THEN Stream.Delete[sh];
    stream↑ ← fopenInternal[filename, type];
    IF stream↑ = NIL THEN RETURN[NIL];
    CRuntime.EnterStreamGlobally[stream↑];
    RETURN[stream];
    };

  unlink: PUBLIC PROCEDURE [path: String] RETURNS [INTEGER] = {
    retVal: INTEGER ← success;
    mPath: LONG STRING ← CString.CStringToLongString[path, z];
    {
    file: MFile.Handle;
    file ← MFile.Acquire[mPath, delete, [] ! MFile.Error => GOTO Failed];
    MFile.Delete[file ! MFile.Error => GOTO Failed];
    EXITS Failed => retVal ← failure;
    };
    z.FREE[@mPath];
    RETURN[retVal];
    };

  fflush: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [INTEGER] = {
    outcome: INTEGER ← success;
    IF stream = NIL OR stream↑ = NIL THEN RETURN[failure];
    CRuntime.StopIfUserAborted[];
    Stream.SendNow[stream↑ ! MStream.Error => {outcome ← failure; CONTINUE}; ];
    RETURN[outcome]};

  rename: PUBLIC PROCEDURE [old, new: String] RETURNS [INTEGER] = {
    h: MFile.Handle ← NIL;
    outcome: INTEGER ← success;
    oldName: LONG STRING;
    newName: LONG STRING;
    CRuntime.StopIfUserAborted[];
    oldName ← CString.CStringToLongString[old, z];
    newName ← CString.CStringToLongString[new, z];
    {
    ENABLE MFile.Error => {outcome ← failure; CONTINUE; };
    h ← MFile.Acquire[oldName, rename, []];
    MFile.Rename[h, newName ! MFile.Error => CONTINUE];
    MFile.Release[h];
    };
    z.FREE[@oldName];
    z.FREE[@newName];
    RETURN[outcome]};

  tmpfile: PUBLIC PROCEDURE RETURNS [FilePtr] = {
    h: MStream.Handle ← NIL;
    CRuntime.StopIfUserAborted[];
    h ← MStream.Create[
      MFile.AcquireTemp[binary ! MFile.Error => CONTINUE; ], [] !
      MStream.Error => CONTINUE; ];
    RETURN[IF h = NIL THEN NIL ELSE CRuntime.EnterStream[sH: h]];
    };

  -- character i/o

  fgetc: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [INTEGER] = {
    c: INTEGER;
    CRuntime.StopIfUserAborted[];
    IF stream = NIL OR stream↑ = NIL THEN RETURN[EOF];
    c ← LOOPHOLE[Stream.GetChar[
      stream↑ !
      MStream.Error, Stream.EndOfStream => {c ← LOOPHOLE[EOF]; CONTINUE}]];
    RETURN[c]};

  fputc: PUBLIC PROCEDURE [c: INTEGER, stream: FilePtr] RETURNS [INTEGER] = {
    CRuntime.StopIfUserAborted[];
    IF stream = NIL OR stream↑ = NIL THEN RETURN[EOF];
    Stream.PutChar[
      stream↑, LOOPHOLE[c] ! MStream.Error, MFile.Error => {c ← EOF; CONTINUE}; ];
    RETURN[c]};

  -- The function ungetc pushes a character back into the stream without changing
  -- the associated file.  This is accomplished by temporarily replacing the 
  -- procedures of the stream object.  The replacement procedures return the 
  -- pushed back character as the first byte of input, and then restore the 
  -- original procedures.  The client data field of the strem object is used to
  -- cache the pushed back character, the original procedures, and the original
  -- client data pointer. 

  ungetc: PUBLIC PROCEDURE [c: INTEGER, stream: FilePtr] RETURNS [INTEGER] = {
    saveClientData: LONG POINTER;
    CRuntime.StopIfUserAborted[];
    IF stream = NIL OR stream↑ = NIL OR c = EOF THEN RETURN[EOF];  -- Won't push back EOF
    {
    ENABLE Stream.InvalidOperation => CONTINUE;
    Stream.SetPosition[
      stream↑, Stream.GetPosition[stream↑] - 1 ! MStream.Error => GOTO RetEOF];
    };
    saveClientData ← stream.clientData;
    stream.clientData ← BucketAlloc.Alloc[SIZE[ClientDataObject]];
    LOOPHOLE[stream.clientData, LONG POINTER TO ClientDataObject]↑ ← [
      saveClientData, LOOPHOLE[c], 0, stream.getByte, stream.putByte,
      stream.setPosition, stream.delete, stream.get, stream.put];
    stream.getByte ← GetPushedBackByte;
    stream.putByte ← RestoreStreamAndPut;
    stream.setPosition ← RestoreStreamAndSet;
    stream.delete ← RestoreStreamAndDelete;
    stream.get ← NewGetBlock;
    stream.put ← RestoreStreamAndPutBlock;
    RETURN[c];
    EXITS RetEOF => RETURN[EOF];
    };

  -- The following record type is used after the ungetc function is called to
  -- store the pushed back character, the original stream procedures, and the 
  -- original client data.  It is declared machine dependent to insure that the
  -- original client data is the first field, so that clients can still access it
  -- (but with an extra dereference).

  ClientDataObject: TYPE = CIOLib.ClientDataObject;
  << MACHINE DEPENDENT RECORD[
  oldClientData:LONG POINTER,
  c:Stream.Byte,
  blank:Stream.Byte, -- to fill up word --
  oldGetByteProc:Stream.GetByteProcedure,
  oldPutByteProc:Stream.PutByteProcedure,
  oldSetPositionProc:Stream.SetPositionProcedure,
  oldDeleteProc:Stream.DeleteProcedure,
  oldGetProc:Stream.GetProcedure,
  oldPutProc:Stream.PutProcedure];>>

  RestoreStream: PROCEDURE [sH: Stream.Handle, advance: BOOLEAN] = {
    -- Puts the original procedures and client data back in the stream object. --
    saveClientData: LONG POINTER TO ClientDataObject ← sH.clientData;
    sH.getByte ← saveClientData.oldGetByteProc;
    sH.putByte ← saveClientData.oldPutByteProc;
    sH.setPosition ← saveClientData.oldSetPositionProc;
    sH.delete ← saveClientData.oldDeleteProc;
    sH.get ← saveClientData.oldGetProc;
    sH.put ← saveClientData.oldPutProc;
    sH.clientData ← saveClientData.oldClientData;
    BucketAlloc.Free[@saveClientData, SIZE[ClientDataObject]];
    IF advance THEN {
      ENABLE Stream.InvalidOperation => CONTINUE;
      Stream.SetPosition[sH, Stream.GetPosition[sH] + 1];
      };
    };

  GetPushedBackByte: Stream.GetByteProcedure = {
    saveByte: Stream.Byte ← LOOPHOLE[sH.clientData, LONG POINTER TO
      ClientDataObject].c;
    RestoreStream[sH, TRUE];
    RETURN[saveByte];
    };

  RestoreStreamAndSet: Stream.SetPositionProcedure = {
    RestoreStream[sH, FALSE]; Stream.SetPosition[sH, position]; };

  RestoreStreamAndDelete: Stream.DeleteProcedure = {
    RestoreStream[sH, FALSE]; Stream.Delete[sH]; };

  RestoreStreamAndPut: PUBLIC Stream.PutByteProcedure = {
    RestoreStream[sH, FALSE]; Stream.PutByte[sH, byte]; };

  NewGetBlock: Stream.GetProcedure = {
    -- Restores the stream only if  block.startIndex < block.stopIndexPlusOne. --
    IF block.startIndex = block.stopIndexPlusOne THEN
      RETURN[bytesTransferred: 0, why: normal, sst: 0];
    IF block.startIndex < block.stopIndexPlusOne THEN {
      block.blockPointer[block.startIndex] ← LOOPHOLE[sH.clientData, LONG POINTER
        TO ClientDataObject].c;
      block.startIndex ← block.startIndex + 1;
      RestoreStream[sH, TRUE];
      };
    [bytesTransferred, why, sst] ← Stream.GetBlock[sH, block];
    bytesTransferred ← bytesTransferred + 1;
    };

  RestoreStreamAndPutBlock: Stream.PutProcedure = {
    RestoreStream[sH, FALSE]; Stream.PutBlock[sH, block, endRecord]; };

  -- direct i/o
  fread: PUBLIC PROCEDURE [ptr: String, size, count: CARDINAL, iop: FilePtr]
    RETURNS [itemsRead: INTEGER ← 0] = {
    ENABLE MStream.Error, Stream.EndOfStream => CONTINUE;
    block: Stream.Block;
    CRuntime.StopIfUserAborted[];
    IF iop = NIL OR iop↑ = NIL OR size = 0 THEN RETURN[0];
    IF ~IsBytePtr[ptr.pointer] THEN ptr ← CString.ToBytePointer[ptr.pointer];
    IF WordAligned[ptr] THEN
      block ← [
        blockPointer: CString.ToWordPointer[ptr], startIndex: 0,
        stopIndexPlusOne: count * size]
    ELSE {
      block ← [
        blockPointer: CString.ToWordPointer[ptr], startIndex: 1,
        stopIndexPlusOne: (count * size) + 1];
      };
    itemsRead ← Stream.GetBlock[iop↑, block].bytesTransferred / size;
    };

  fwrite: PUBLIC PROCEDURE [ptr: String, size, count: CARDINAL, iop: FilePtr]
    RETURNS [itemsWritten: INTEGER ← 0] = {
    ENABLE MStream.Error, Stream.EndOfStream => CONTINUE;
    block: Stream.Block;
    CRuntime.StopIfUserAborted[];
    IF iop = NIL OR iop↑ = NIL THEN RETURN[0];
    IF ~IsBytePtr[ptr.pointer] THEN ptr ← CString.ToBytePointer[ptr.pointer];
    IF WordAligned[ptr] THEN
      block ← [
        blockPointer: CString.ToWordPointer[ptr], startIndex: 0,
        stopIndexPlusOne: count * size]
    ELSE {
      block ← [
        blockPointer: CString.ToWordPointer[ptr], startIndex: 1,
        stopIndexPlusOne: (count * size) + 1];
      };
    Stream.PutBlock[iop↑, block];
    itemsWritten ← count;
    };

  WordAligned: PROCEDURE [ptr: String] RETURNS [BOOLEAN] = INLINE {
    RETURN[ptr.whichByte = 0]; };

  IsBytePtr: PROCEDURE [ptr: LONG UNSPECIFIED] RETURNS [BOOLEAN] = INLINE {
    hiBit: LONG CARDINAL = 20000000000B; RETURN[Inline.DBITAND[ptr, hiBit] # 0]; };

  -- string i/o (These procedures adapted from C code)
  fgets: PUBLIC PROCEDURE [s: CString.CString, n: INTEGER, stream: FilePtr]
    RETURNS [CString.CString] = {
    OPEN CString;
    c: INTEGER;
    s2: String ← s;
    WHILE ((n ← n.PRED) > 0) AND ((c ← fgetc[stream]) >= 0) DO
      WriteByte[c, s2];
      s2 ← IncrBPointer[s2];
      IF c = Ascii.CR.ORD THEN EXIT;
      ENDLOOP;
    IF c < 0 AND s = s2 THEN s.pointer ← NIL ELSE WriteChar[Ascii.NUL, s2];
    RETURN[s];
    };

  gets: PUBLIC PROCEDURE [s: CString.CString] RETURNS [CString.CString] = {
    OPEN CString;
    c: INTEGER;
    s2: String ← s;
    in: FilePtr = CRuntime.GetStdin[];
    WHILE ((c ← fgetc[in]) # Ascii.CR.ORD) AND (c >= 0) DO
      WriteByte[c, s2]; s2 ← IncrBPointer[s2]; ENDLOOP;
    IF c < 0 AND s = s2 THEN s.pointer ← NIL ELSE WriteChar[Ascii.NUL, s2];
    RETURN[s];
    };

  fputs: PUBLIC PROCEDURE [s: CString.CString, stream: FilePtr]
    RETURNS [c: INTEGER ← 0] = {
    OPEN CString;
    block: Environment.Block;
    length: CARDINAL ← 0;
    s2: String ← s;
    IF stream = NIL OR stream↑ = NIL THEN RETURN[EOF];
    WHILE ReadByte[s2] # 0 DO
      length ← length + 1; s2 ← IncrBPointer[s2]; ENDLOOP;
    block ← [ToWordPointer[s], s.whichByte, s.whichByte + length];
    stream↑.PutBlock[block! MStream.Error, MFile.Error => {c ← EOF; CONTINUE}; ];
    RETURN[c]
    };

  puts: PUBLIC PROCEDURE [s: CString.CString] RETURNS [val: INTEGER] = {
    OPEN CString;
    s2: String ← s;
    out: FilePtr = CRuntime.GetStdout[];
    val ← fputs[s, out];
    RETURN[IF val = 0 THEN fputc[Ascii.CR.ORD, out] ELSE val];
    };

  -- random access functions
  fseek: PUBLIC PROCEDURE [stream: FilePtr, offset: LONG INTEGER, ptrname: INTEGER]
    RETURNS [INTEGER] = {
    OPEN Stream, MStream;
    outcome: INTEGER ← success;
    CRuntime.StopIfUserAborted[];
    IF stream = NIL OR stream↑ = NIL THEN RETURN[failure];
    {
    ENABLE
      MStream.Error, Stream.InvalidOperation => {outcome ← failure; CONTINUE; };
    SELECT ptrname FROM
      seekSet => SetPosition[stream↑, offset];
      seekCur => SetPosition[stream↑, offset + GetPosition[stream↑]];
      seekEnd =>
        SetPosition[
          stream↑, offset + LOOPHOLE[MStream.GetLength[stream↑], LONG INTEGER]]  -- won't work for files longer than LAST[LONG INTEGER] --
      ENDCASE => outcome ← failure;
    };  -- enable
    RETURN[outcome]};

  ftell: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [p: LONG INTEGER] = {
    -- Return value -1 if invalid stream --
    CRuntime.StopIfUserAborted[];
    IF stream = NIL OR stream↑ = NIL THEN p ← -1
    ELSE
      p ← Stream.GetPosition[
        stream↑ ! MStream.Error, Stream.InvalidOperation => {p ← -1; CONTINUE; }]};

  rewind: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [INTEGER] = {
    RETURN[fseek[stream, 0, seekSet]]; };

  -- stream status
  feof: PUBLIC PROCEDURE [stream: FilePtr] RETURNS [INTEGER] = {
    -- Return value 0 if invalid stream --
    True: INTEGER = 1;
    False: INTEGER = 0;
    CRuntime.StopIfUserAborted[];
    {
    IF stream = NIL OR stream↑ = NIL THEN RETURN[False];
    IF MStream.EndOf[stream↑ ! MStream.Error => GOTO RetFalse; ] THEN RETURN[True]
    ELSE RETURN[False];
    EXITS RetFalse => RETURN[False];
    };
    };

  --  standard streams
  GetStdin: PUBLIC PROCEDURE RETURNS [sH: FilePtr] = {sH ← CRuntime.GetStdin[]; };

  GetStdout: PUBLIC PROCEDURE RETURNS [sH: FilePtr] = {
    sH ← CRuntime.GetStdout[]; };

  GetStderr: PUBLIC PROCEDURE RETURNS [sH: FilePtr] = {
    sH ← CRuntime.GetStderr[]; };

  SetStdin: PUBLIC PROCEDURE [sH: FilePtr] RETURNS [INTEGER ← 0] = {
    CRuntime.SetStdin[sH]; };

  SetStdout: PUBLIC PROCEDURE [sH: FilePtr] RETURNS [INTEGER ← 0] = {
    CRuntime.SetStdout[sH]; };

  SetStderr: PUBLIC PROCEDURE [sH: FilePtr] RETURNS [INTEGER ← 0] = {
    CRuntime.SetStderr[sH]; };


  }.