MODULE fsys;

FROM BFileIO IMPORT FindInput, FindOutput;

FROM Arguments IMPORT GetArg, ArgCount;

FROM SYSTEM IMPORT ADR, UNIXCALL;

FROM UnixSystem IMPORT System;

FROM UnixCalls IMPORT chdir, write,
                      link,
                      unlink;

FROM BStreams  IMPORT STREAM,
                      ErrorCode,
		      Success,
                      EndOfStream,
                      SysIn,
                      SysOut,
                      EndStream,
		      SelectInput,
                      SelectOutput,
		      Rewind,
                      Rdch,
                      Wrch;
                      
FROM BSCTermIO IMPORT FindSC,
                      SuspendSC,
                      NOTRANS;

TYPE STRING = ARRAY [0..200] OF CHAR;


VAR TT,
    InFile, 
    OutFile :STREAM;

    Inuse, Outuse :BOOLEAN;
   
PROCEDURE NoEcho;
BEGIN
   TT := FindSC (NOTRANS)
END NoEcho;

PROCEDURE ResetEcho;
BEGIN
   SuspendSC
END ResetEcho;


PROCEDURE WriteS (String :ARRAY OF CHAR);
VAR I:CARDINAL;
BEGIN
   I := 0;
   WHILE (I <= HIGH (String)) AND (ORD (String [I]) >= 32) DO
      Wrch (String [I]);
      I := I + 1
   END (* while *);
END WriteS;

PROCEDURE WriteLn;
BEGIN
   Wrch (CHR (13));
   Wrch (CHR (10))
END WriteLn;


PROCEDURE GET () :CHAR;
(*   return next ascii character   *)
VAR Ch :CHAR;
BEGIN
   REPEAT Ch := Rdch () UNTIL ((ORD(Ch) >= 32) AND (ORD(Ch) < 127))
                           OR (ORD(Ch)=27);
   RETURN (Ch)
END GET;

PROCEDURE ReadName (VAR File :STRING);
VAR I    :INTEGER;
    Ch   :CHAR;
BEGIN
   I := 0;
   Ch := GET ();
   WHILE ORD(Ch) <> 27 DO
      File [I] := Ch;
      I := I + 1;
      Ch := GET ()
   END (* while *);
   File [I] := CHR(0)
END ReadName;

PROCEDURE cat (File :ARRAY OF CHAR);
CONST
   maxents = 200;
TYPE
   FileName = ARRAY [0..13] OF CHAR;
VAR
   FD  :STREAM;
   I   :INTEGER;
   J   :[0..13];
   Dir :ARRAY [0..maxents] OF FileName;
   dot :FileName;
   each:[0..maxents];
   Node:CARDINAL;
   
PROCEDURE ReadIno (VAR Node :CARDINAL);
VAR
   c1, c2 :CARDINAL;
BEGIN
   c1 := ORD (Rdch ()); c2 := ORD (Rdch ());
   Node := c1 * 256 + c2
END ReadIno;

PROCEDURE ReadEnt (VAR F :FileName);
VAR
   I :[0..13];
   c :CHAR;
BEGIN
   FOR I := 0 TO 13 DO
      c := Rdch ();
      IF c = CHR(0) THEN c := CHR(32) END;
      F [I] := c
   END (* for *);
END ReadEnt;

BEGIN

   FOR J := 0 TO 13 DO
      dot [J] := CHR (0)
   END (* for *);
   dot [0] := ".";
   FD := FindInput (dot);
   
   SelectInput (FD);

   I := 0;
   LOOP
      ReadIno (Node);
      IF ErrorCode <> Success THEN EXIT END;
      ReadEnt (Dir [I]);
      IF Node <> 0 THEN I := I+1 END;
      IF I > maxents THEN EXIT END
   END (* LOOP *);
   
   FOR each := 0 TO I-1 DO
      IF Dir [each] [0] <> "." THEN
         WriteS (Dir [each]); WriteS ("      ")
      END
   END (* for *);
   WriteLn;
   
   SelectInput (SysIn);
   EndStream (FD);
   
   Wrch (CHR (27))
END cat;


PROCEDURE dir (File :ARRAY OF CHAR);
VAR Status :INTEGER;
BEGIN
   Status := UNIXCALL (chdir, ADR(File));
   IF Status <> 0 THEN WriteS ("*E06:Cannot change directory") END;
   Wrch (CHR (27))   
END dir;


PROCEDURE openin (File :ARRAY OF CHAR);
BEGIN
   clin;
   InFile := FindInput (File);
   IF ErrorCode <> Success THEN
      WriteS ("*E03:Cannot open input");
      Wrch (CHR (27));
      Inuse := FALSE;
      RETURN
   END;
   Inuse := TRUE;
   Wrch (CHR (27))
END openin;


PROCEDURE openout (File :ARRAY OF CHAR);
BEGIN
   clout;
   OutFile := FindOutput (File);
   IF ErrorCode <> Success THEN
      WriteS ("*E04:Cannot open output");
      Wrch (CHR (27));
      Outuse := FALSE;
      RETURN
   END;
   Outuse := TRUE;
   Wrch (CHR (27))
END openout;


PROCEDURE InfoInnards;

   PROCEDURE WriteHex (I :CARDINAL);
      PROCEDURE WriteHalf (I :CARDINAL);
         PROCEDURE WriteByte (I :CARDINAL);
            PROCEDURE WriteNib (I :CARDINAL);
            BEGIN
               Wrch (CHR (I+ORD("0")))
            END WriteNib;
         BEGIN
            WriteNib (I DIV 16);
            WriteNib (I MOD 16);
         END WriteByte;
      BEGIN
         WriteByte (I MOD 256);
         WriteByte (I DIV 256);
      END WriteHalf;
   BEGIN
      WriteHalf (I MOD 65536);
      WriteHalf (I DIV 65536);
   END WriteHex;

   PROCEDURE REMAINDER() :INTEGER;
   VAR
      Count :CARDINAL;
      Dummy :CHAR;
   BEGIN
      Count := 0;
      LOOP
         Dummy := Rdch ();
         IF ErrorCode <> Success THEN EXIT END;
         Count := Count+1
      END (* loop *);
      RETURN (Count)
   END REMAINDER;

VAR
   Magic,
   Bbc   :ARRAY [0..3] OF CHAR;
   C     :CHAR;
   I     :INTEGER;
BEGIN
   Magic := "????";
   Bbc   := "*bbc";
   
   FOR I := 0 TO 3 DO
      Magic [I] := Rdch ()
   END (* for *);
   
   FOR I := 0 TO 3 DO
      IF Magic [I] <> Bbc [I] THEN
         Rewind ();
         WriteHex (REMAINDER());    (* length    *)
         Rewind ();
         WriteS ("00000000");   (* Load addr *)
         WriteS ("????????");   (* Exec addr *)
         WriteS ("00000000");   (* Attributes *)
         RETURN
      END;
   END;
   
   WriteHex (REMAINDER() - 24);
   Rewind ();
   FOR I := 0 TO 3 DO C := Rdch () END;
   
   FOR I := 0 TO 23 DO
      C := Rdch (); Wrch (C)
   END (* for *);
END InfoInnards;


PROCEDURE load (File :ARRAY OF CHAR);
VAR Ch     :CHAR;
    C1, C2 :CARDINAL;
    I      :INTEGER;
    buf: ARRAY [0..511] OF CHAR;
    bufindex: CARDINAL;
    PROCEDURE Flush;
        VAR
            rc: INTEGER;
        BEGIN
            rc := UNIXCALL(write, 1, ADR(buf), bufindex);
            bufindex := 0;
        END Flush;
BEGIN
   IF Inuse THEN
      WriteS ("*E04:File already open for reading");
      Wrch (CHR (27));
      RETURN
   END;

   FOR I := 0 TO HIGH(File) DO
      IF ORD (File [I]) <= 32 THEN File [I] := CHR(0) END
   END (* for *);

   bufindex := 0;
   clin;
   InFile := FindInput (File);
   IF ErrorCode <> Success THEN
      WriteS ("*E03:Cannot open input ");
      WriteS (File);
      Wrch (CHR (27));
      Inuse := FALSE;
      RETURN
   END;
   
   Inuse := TRUE;

   Wrch (CHR (27)); (*for verify *)
   
   SelectInput (InFile);
   InfoInnards;
   SelectInput (SysIn);
   
   Wrch (CHR (27));
   
   REPEAT
      Ch := Rdch()
   UNTIL Ch = CHR(27);

   SelectInput (InFile);
   REPEAT
      Ch := Rdch ();
      IF ErrorCode <> Success THEN
         IF ErrorCode <> EndOfStream THEN
            SelectInput (SysIn);
            Inuse := FALSE;
            EndStream (InFile);
            WriteS ("*E01:Error reading file");
            Wrch (CHR (27));
            RETURN
         END;
         SelectInput (SysIn);
         Inuse := FALSE;
	 EndStream (InFile);
         IF bufindex>0 THEN
            Flush;
         END (* if *);
         Wrch (CHR (27));
         RETURN
      END;
      C1 := ORD (Ch) DIV 16; C2 := ORD (Ch) MOD 16;
      buf[bufindex] := CHR (C1 + ORD("0")); 
      buf[bufindex+1] := CHR (C2 + ORD("0"));
      INC(bufindex, 2);
      IF bufindex > HIGH(buf) THEN
        Flush;
      END (* if *);
   UNTIL FALSE
END load;


PROCEDURE save (File :ARRAY OF CHAR);
VAR
   Ch1, Ch2 :CHAR;
   C1, C2   :CARDINAL;
   Handshake:INTEGER;
   I        :CARDINAL;
BEGIN

   IF Outuse THEN
      WriteS ("*E04:File already open for writing");
      Wrch (CHR (27));
      RETURN
   END;


   FOR I := 0 TO HIGH(File) DO
      IF ORD (File [I]) <= 32 THEN File [I] := CHR(0) END
   END (* for *);


   clout;
   OutFile := FindOutput (File);

   IF ErrorCode <> Success THEN
      WriteS ("*E04:Cannot open output ");
      WriteS (File);
      Wrch (CHR (27));
      Outuse := FALSE;
      RETURN
   END;

   Outuse := TRUE;
   Wrch (CHR (27));

   SelectOutput (OutFile);

   Handshake := 0;
   
   REPEAT
      REPEAT Ch1 := GET () UNTIL ((Ch1 >= "0") AND (Ch1 <="?"))
                              OR (Ch1=CHR(27));
      IF Ch1 = CHR(27) THEN
         SelectOutput (SysOut);
         Outuse := FALSE;
         EndStream (OutFile);
         Wrch (CHR (27));
         RETURN
      END;
      
      REPEAT Ch2 := GET () UNTIL (Ch2 >= "0") AND (Ch2 <= "?")
                              OR (Ch2=CHR(27));

      IF Ch2 = CHR(27) THEN
         SelectOutput (SysOut);
         Outuse := FALSE;
         EndStream (OutFile);
         Wrch (CHR (27));
         RETURN
      END;

      C1 := ORD (Ch1) - ORD ("0"); C2 := ORD (Ch2) - ORD ("0");

      Wrch (CHR (C1*16 + C2));

      IF ErrorCode <> Success THEN
         SelectOutput (SysOut);
         WriteS ("*E02:Cannot write to file");
         Wrch (CHR (27));
         RETURN
      END;

      Handshake := Handshake+1;
      IF Handshake MOD 16 = 0 THEN
         SelectOutput (SysOut);
         Wrch (CHR (27));
         SelectOutput (OutFile)
      END

   UNTIL FALSE
   
END save;


PROCEDURE bget;
VAR Ch :CHAR;
    C1, C2 :CARDINAL;
BEGIN
IF NOT (Inuse) THEN Wrch (CHR (27)); RETURN; END;
   SelectInput (InFile);
   Ch := Rdch ();
   IF ErrorCode <> Success THEN
      IF ErrorCode <> EndOfStream THEN
         SelectInput (SysIn);
         WriteS ("*E01:Error reading file");
         Wrch (CHR (27));
         RETURN
      END;
      SelectInput (SysIn);
      Wrch (CHR (27));
      RETURN
   END;
   SelectInput (SysIn);
   C1 := ORD (Ch) DIV 16; C2 := ORD (Ch) MOD 16;
   Wrch (CHR (C1 + ORD("0"))); Wrch (CHR (C2 + ORD("0")))
END bget;


PROCEDURE bput (Ch1, Ch2 :CHAR);
VAR C1, C2 :CARDINAL;
BEGIN
IF NOT (Outuse) THEN Wrch (CHR (27)); RETURN; END;
   SelectOutput (OutFile);
   C1 := ORD (Ch1) - ORD ("0"); C2 := ORD (Ch2) - ORD ("0");
   Wrch (CHR (C1*16 + C2));
   IF ErrorCode <> Success THEN
      SelectOutput (SysOut);
      WriteS ("*E02:Cannot write to file");
      Wrch (CHR (27));
      RETURN
   END;
   SelectOutput (SysOut);
   Wrch (CHR (27))   
END bput;


PROCEDURE clin;
BEGIN
   IF Inuse THEN EndStream (InFile) END;
   Inuse := FALSE;
END clin;


PROCEDURE clout;
BEGIN
   IF Outuse THEN EndStream (OutFile) END;
   Outuse := FALSE
END clout;

PROCEDURE closein;
BEGIN
   clin;
   Wrch (CHR (27))
END closein;

PROCEDURE closeout;
BEGIN
   clout;
   Wrch (CHR (27))
END closeout;



PROCEDURE Info (File :ARRAY OF CHAR);
VAR Ch :CHAR;
    C1, C2 :CARDINAL;
    InFile :STREAM;
BEGIN
   InFile := FindInput (File);
   
   IF ErrorCode <> Success THEN
      WriteS ("*E03:Cannot open input ");
      WriteS (File);
      Wrch (CHR (27));
      RETURN
   END;
   
   Wrch (CHR (27)); (*for verify *)
   
   SelectInput (InFile);
   InfoInnards;
   SelectInput (SysIn);
   EndStream (InFile);
   
   Wrch (CHR (27));
   

END Info;


PROCEDURE Shell (Command :ARRAY OF CHAR);
VAR Status:INTEGER;
BEGIN
   Status := System (Command);
   Wrch (CHR (27))
END Shell;


PROCEDURE SetLib (File :ARRAY OF CHAR);
BEGIN
   Wrch (CHR (27))
END SetLib;


PROCEDURE delete (File :ARRAY OF CHAR);
VAR Status: INTEGER;
BEGIN
   Status := UNIXCALL (unlink, ADR(File));
   IF Status <> 0 THEN WriteS ("*E07:Cannot delete file") END;
   Wrch (CHR (27))
END delete;


PROCEDURE rename (File :ARRAY OF CHAR);
VAR Status,
    I,J      :INTEGER;
    From, To :STRING;
BEGIN
   I := 0; J := 0;
   WHILE File [I] = CHR(32) DO
      I := I+1
   END (* while *);
   LOOP
      From [J] := File [I];
      IF From [J] = CHR(0) THEN
         WriteS ("*E09:Rename ");
	 WriteS (From);
         WriteS (" to what?");
         Wrch (CHR (27));
         RETURN
      END;
      I := I+1;
      J := J+1;
      IF File [I] = CHR(32) THEN From [J] := CHR(0); EXIT END;
   END (* loop *);
   J := 0; I := I+1;
   LOOP
      To [J] := File [I];
      IF To [J] = CHR(0) THEN EXIT END;
      I := I+1;
      IF From [J] <> CHR(32) THEN J := J+1 END;
   END (* loop *);
   Status := UNIXCALL(link, ADR (From), ADR(To));
   IF Status <> 0 THEN
      WriteS ("*E07:Cannot rename ");
      WriteS (From); WriteS (" to "); WriteS (To);
      Wrch (CHR (27));
      RETURN
   END;
   Status := UNIXCALL(unlink, ADR(From));
   IF Status <> 0 THEN
      WriteS ("*E08:Cannot remove ");
      WriteS (From);
      Wrch (CHR (27));
      RETURN
   END;
   Wrch (CHR (27))
END rename;


PROCEDURE copy(File :ARRAY OF CHAR);
VAR Status,
    I,J      :INTEGER;
    C        :CHAR;
    From, To :STRING;
    Istream,
    Ostream  :STREAM;
BEGIN
   I := 0; J := 0;
   WHILE File [I] = CHR(32) DO
      I := I+1
   END (* while *);
   LOOP
      From [J] := File [I];
      IF From [J] = CHR(0) THEN
         WriteS ("*E09:Copy ");
	 WriteS (From);
         WriteS (" to where?");
         Wrch (CHR (27));
         RETURN
      END;
      I := I+1;
      J := J+1;
      IF File [I] = CHR(32) THEN From [J] := CHR(0); EXIT END;
   END (* loop *);
   J := 0; I := I+1;
   LOOP
      To [J] := File [I];
      IF To [J] = CHR(0) THEN EXIT END;
      I := I+1;
      IF From [J] <> CHR(32) THEN J := J+1 END;
   END (* loop *);
   Istream := FindInput (From);
   IF ErrorCode <> Success THEN
      WriteS ("*E09:Cannot read input");
      Wrch (CHR (27));
      RETURN
   END;
   Ostream := FindOutput (To);
   IF ErrorCode <> Success THEN 
      WriteS ("*E0A:Cannot write output");
      Wrch (CHR (27));
      EndStream (Istream);
      EndStream (Ostream);  (* Not needed? *)
      RETURN
   END;
   
   SelectInput (Istream);
   SelectOutput (Ostream);
   
   LOOP
      C := Rdch();
      IF ErrorCode <> Success THEN EXIT END;
      Wrch (C)
   END (* LOOP *);
   
   IF ErrorCode <> EndOfStream THEN
      SelectInput (SysIn);
      SelectOutput (SysOut);
      EndStream (Istream);
      EndStream (Ostream);
      WriteS ("*E0B:Error writing file - partially written!");
      Wrch (CHR(27));
      RETURN
   END;
   
   SelectInput (SysIn);
   SelectOutput (SysOut);
  
   EndStream (Istream);
   EndStream (Ostream);
   
   Wrch (CHR (27))
   
END copy;

PROCEDURE Abandon ();
VAR NewLang: STRING;
BEGIN
   clin ();
   clout ();
   Wrch (CHR (27))
END Abandon;


VAR Byte :CHAR;
    File :STRING;
    Len  :CARDINAL;
BEGIN

   NoEcho ();
   Inuse :=  FALSE;
   Outuse := FALSE;

   Wrch (CHR (27)); 
   IF ArgCount = 1 THEN
      WriteS ("*BASIC");
   ELSE
      GetArg (1, File, Len);
      Wrch ("*");
      WriteS (File)
   END;
   WriteLn;
      
   WHILE TRUE DO

      Byte := GET ();

      CASE Byte OF
      
      "0",
      "1",
      "2",
      "3",
      "4",
      "5",
      "6",
      "7",
      "8",
      "9",
      ":",
      ";",
      "<",
      "=",
      ">",
      "?":
      bput (Byte, GET ());
|          
      "!":
             bget ();
|         
     "C":
             ReadName (File); cat (File);
|
     "D":
             ReadName (File); dir (File);
|
     "L":
             ReadName (File); load (File);
|
     "S":
             ReadName (File); save (File);
|
     "I":
             ReadName (File); openin (File);
|
     "O":
             ReadName (File); openout (File);
|
     "{":
             closein ();
|
     "}":
             closeout ();
|
     "F":
             ReadName (File); Info (File);
|
     "A":
             Abandon ();
|
     "R":
             ReadName (File); SetLib (File);
|
     "X":
             ReadName (File); Shell (File);
|
     "M":
             ReadName (File); rename (File);
|
     "T":
             ReadName (File); copy (File);
|
     "K":
             ReadName (File); delete (File);
|
     ".":
             Abandon (); ResetEcho (); RETURN;
             
      ELSE
             Wrch (Byte);

      END (* case *);

   END (* while *);

END fsys.