IMPLEMENTATION MODULE IOSupport;
(*
        Title:          Support Module for IO system.
        Author:         D.R.Lamkin.

        History:

          23 May 84     Initial version.
          07 Aug 84     Stop deselecting VDU: so debug.WriteS messages work.
                        SelectFS now changes CurrentFS.
          09 Aug 84     FixFileExtension moved to File.
                        Input:, Output:, Error: added (though Error: is
                             not implemented yet).
                        Errors now imported from Errors.
          11 Aug 84     Control: added, Error: Implemented.
                        Errorcode etc Imported from Errors.
          13 Aug 84     Handling of Control: etc moved to Module IO
                        (since it is IO which allocates stream numbers)
          16 Aug 84     Definitions of lower level types moved to Here from IO
                        IOCurrentByte added and Implemented.
          20 Aug 84     Filing system selection routines moved to Filing.
          21 Aug 84     calls to File.PANOSGBPB added in filing
          23 Aug 84     Adjust BytesOutstanding to return value in Param.
          24 Aug 84     BBC Error -> errors.
          29 Aug 84     Changed to use PANOSFile throughout.
          31 Aug 84     Remove calls to Strings.
                        Remove unnecessary VAR's in proc args.
                        Change call to error routine.
          04 Oct 84     Printer blockwrite added
                        RS423 added but not yet complete
          11 Oct 84     Set FileEnd in status on endoffile.
          21 Oct 84     Buffering on Filing system I/O.
          09 Nov 84     Get BBC to default VDU Handler.
*)

(* Debug *)IMPORT Debug;

FROM SYSTEM IMPORT ADR, ADDRESS, REGISTER, WORD, TKCALL;

FROM TKCalls IMPORT TKbyte, TKwrch, TKrdch, TKword, TKsetVduHandler;

FROM String IMPORT LengthC, CopyLC, CopyCC,
                   FindC, AppendCC, EqualLC, EqualCC ;

FROM File IMPORT IsFilingSystem, FileHandle, OSFileArray, PANOSFile,
                 PANOSFind, PANOSClose, PANOSBget, PANOSBput,
                 PANOSFindOp, PANOSGBPB, PANOSArgs, OSGBPBArray;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;

FROM Store IMPORT XDeallocate;

FROM Error IMPORT ErrorCode, Facility, BBCError;

FROM Utils IMPORT ExtractElement, Capitalize;

FROM GlobalString IMPORT GetGlobalString;

FROM Error IMPORT IOFacilityErrors;

FROM BBC IMPORT OSByte;

TYPE Device =
   RECORD
      Name    :  ARRAY [0..9] OF CHAR;
      Proc    :  FindProc
   END;



VAR Devices          : ARRAY [0..9] OF Device;
    result           : INTEGER;





(* ========================================================================= *)

PROCEDURE Version( VAR String : ARRAY OF CHAR ) ;
BEGIN
   CopyLC( "IOSupport       0.01/39  09 Nov 84 17:44:00", String ) ;
END Version ;




(* ------------------------------------------------------------------------- *)

PROCEDURE Initialise();

BEGIN

Term.TermInit();

END Initialise;




(* ------------------------------------------------------------------------- *)

PROCEDURE IOError (Error: IOFacilityErrors) : INTEGER;

(* Produce a system error code from one of our local ones *)

BEGIN

RETURN ErrorCode (IOFacility, ORD (Error), "")

END IOError;




(* ------------------------------------------------------------------------- *)

PROCEDURE OS1Byte (Number: CARDINAL; Xparam: CARDINAL);

(* My own osbyte - for those calls I dont expect to fail *)

VAR flag: INTEGER;

BEGIN

flag := TKCALL (TKbyte, Number, Xparam)


END OS1Byte;




(* ------------------------------------------------------------------------- *)

PROCEDURE FindNotImplemented (Mode:   OpenType;
                              DName:  ARRAY OF CHAR;
                              DData:  ARRAY OF CHAR;
                              Ptr:    StreamBlockPtr) : INTEGER;

(* This procedure is provided to aid the lazy! *)

BEGIN

   RETURN IOError (NotImplemented)

END FindNotImplemented;




(* ------------------------------------------------------------------------- *)

PROCEDURE FindDevice (DName: ARRAY OF CHAR) : INTEGER;
(*
   Find the index of the device in the device name table.
   Return it or error code if not found
*)

VAR i: INTEGER;

BEGIN

(* Look down the device name table for the given device *)

FOR i := 0 TO HIGH(Devices) DO
   IF EqualCC (Devices[ i ].Name, DName) THEN
      RETURN i
   END;
END;

RETURN -1

END FindDevice;




(* ------------------------------------------------------------------------- *)

PROCEDURE CallDeviceFindStream (Mode: OpenType;
                                DName: ARRAY OF CHAR;
                                DData: ARRAY OF CHAR;
                                Sref: StreamBlockPtr) : INTEGER;
(*
   Call the FIND routine associated with the named device.
*)

VAR res, index: INTEGER;
    FileName : ARRAY [0..255] OF CHAR;
    Colon    : ARRAY [0..1] OF CHAR;
    
BEGIN

Colon [0] := ":";
Colon [1] := 0C;

Capitalize (DName);  (* Convert the device name to all UPPER case *)

index := FindDevice (DName);

IF index < 0 THEN
     (* Couldn't find the device
        Or it is a filing system
     *)
   IF IsFilingSystem (DName) THEN
        (* We Have a filing system - so call FS module find *)
      CopyCC (DName, FileName);
      IF LengthC (DName) # 0 THEN
         AppendCC (Colon, FileName);
      END;
      AppendCC (DData, FileName);
      res := Filing.Find1 (Mode, FileName , Sref)
   ELSE
      res := IOError (BadDeviceName)
   END
ELSE
     (*
        Call the simple device find procedure
     *)
   WITH Devices[ index ] DO
      res := Proc (Mode, DName, DData, Sref)
   END
END;



RETURN res;

END CallDeviceFindStream;




(* ------------------------------------------------------------------------- *)

PROCEDURE GetBuffer (Sref : StreamBlockPtr; Size : CARDINAL);

 (* Attempt to allocate a buffer for the given stream *)

BEGIN

WITH Sref^ DO
   NEW (BufferP);
   IF BufferP # NIL THEN (* Allocation was successful! *)
      ALLOCATE (BufferP^.Buffer, Size);
      IF BufferP^.Buffer = NIL THEN
         DISPOSE (BufferP);
      ELSE
         WITH BufferP^ DO
            Index       := 0;
            ValidBytes  := 0;
            FilePointer := 0;
            INCL (Status, HasBuffer);
         END;
      END;
   END;
END;

END GetBuffer;




(* ------------------------------------------------------------------------- *)

PROCEDURE FreeBuffer (Sref : StreamBlockPtr);
 (* If the given stream has a buffer allocated then free it *)
BEGIN

WITH Sref^ DO
   IF HasBuffer IN Status THEN
      XDeallocate (BufferP^.Buffer);
      DISPOSE (BufferP);
      EXCL (Status, HasBuffer);
   END;
END;

END FreeBuffer;



(****************************************************************************
 *                                                                          *
 *                                                                          *
 *                       Terminal Handling                                  *
 *                                                                          *
 *                                                                          *
 *                                                                          *
 ****************************************************************************)






MODULE Term;

(* Debug *)IMPORT Debug;

IMPORT ADR, ADDRESS, REGISTER, WORD, TKCALL;

IMPORT IOFacilityErrors;

IMPORT LengthC, EqualLC;

IMPORT  NewLineCH, CReturnCH,
        FormFeedCH, DeleteCH,
        EndOfFileCH,
        DeleteLine, BellCH,
        StreamBlock, StreamBlockPtr, IOFunction,
        StreamStatus, StreamStatusBits;

IMPORT OpenType, IOError, BBCError, OS1Byte, OSByte;

IMPORT TKbyte, TKwrch, TKword, TKrdch;


EXPORT QUALIFIED Find, TermInit;

                                                                                                                                       
TYPE Opens = SET OF OpenType;


CONST MaxLineLength = 256;


TYPE InputBuffer    = ARRAY [0..MaxLineLength-1] OF CHAR;
TYPE InputBufferRef = POINTER TO InputBuffer;

VAR InputLine:  RECORD
                  Line:       InputBufferRef;
                  Count:      CARDINAL;
                  Index:      CARDINAL;
                  LineBuffer: InputBuffer;
                END;

    TerminalByteHeld : BOOLEAN;
    TheByteHeld      : CHAR;




(* ------------------------------------------------------------------------- *)

PROCEDURE TermInit();

BEGIN

TerminalByteHeld := FALSE

END TermInit;




(* ------------------------------------------------------------------------- *)

PROCEDURE FilterChar (ch : CHAR) : BOOLEAN;
(* Return TRUE if the character should be filtered *)
BEGIN

IF (' ' <= ch) AND (ch <= "~") THEN
   RETURN FALSE
ELSE
   IF (ch = CReturnCH) OR
      (ch = NewLineCH) OR
      (ch = FormFeedCH) THEN
      RETURN FALSE
   ELSE
      RETURN TRUE
   END
END

END FilterChar;




(* ------------------------------------------------------------------------- *)

PROCEDURE RdCH(VAR ch : CHAR) : BOOLEAN;

VAR res : INTEGER;

BEGIN

res := TKCALL (TKrdch);

ch := CHAR (REGISTER (1) MOD 255);

IF res >= 0 THEN
   RETURN TRUE    (* Char read successfully *)
ELSE              (* Escape was pressed *)
   res := TKCALL (TKbyte, 7EH);  (* Aknowledge the escape *)
   RETURN FALSE
END

END RdCH;



(* ------------------------------------------------------------------------- *)

PROCEDURE ReadLine() : INTEGER;

(* Get a new line into the input buffer *)

VAR res:          INTEGER;
    OldFX3Status: CARDINAL;
    EndOfLine   : BOOLEAN;
    i           : CARDINAL;
    ch          : CHAR;

BEGIN

(* Switch on the vdu *)
res := TKCALL (TKbyte, 3, 4);
OldFX3Status := REGISTER (2); (* Remember old output status *)

WITH InputLine DO

   Index := 0;
   Count := 0;
   EndOfLine := FALSE;

   WHILE NOT EndOfLine DO

      IF NOT RdCH(ch) OR (ch = EndOfFileCH) THEN
         Count := 0;
         Index := 1;    (* To force readline when char next asked for *)
         RETURN IOError (EndFile)
      END;

      IF ch = CReturnCH THEN
         ch := NewLineCH
      END;

      IF NOT FilterChar (ch) THEN (* Not to be filtered so put in buffer *)
         Line^[Count] := ch;
         IF Count < MaxLineLength-1 THEN
            INC (Count)
         ELSE
            IF ch = NewLineCH THEN
                 INC (Count);
            ELSE
               ch := BellCH
            END
         END;

         (* Echo the character *)
         res := TKCALL (TKwrch, ch);
         IF ch = NewLineCH THEN
            res := TKCALL (TKwrch, CReturnCH)
         END
      ELSE
         IF ch = DeleteCH THEN
            IF Count > 0 THEN
               res := TKCALL (TKwrch, DeleteCH);
               DEC (Count)
            END
         ELSE
            IF ch = DeleteLine THEN
               FOR i := 1 TO Count DO
                  res := TKCALL (TKwrch, DeleteCH)
               END;
               Count := 0
            END
         END
      END;
      IF ch = NewLineCH THEN
         EndOfLine := TRUE
      END
   END
END;

(* Now get output back as it was *)
res := TKCALL (TKbyte, 3, OldFX3Status);

(* Line Successfully read *)

RETURN 0

END ReadLine;





(* ------------------------------------------------------------------------- *)

PROCEDURE DiscardLine ();
(* Discard the line in the line buffer *)

BEGIN

WITH InputLine DO

   Count := 0;
   Index := 1

END

END DiscardLine;




(* ------------------------------------------------------------------------- *)

PROCEDURE Reader (Step : BOOLEAN) : INTEGER;
(* The Filtered version *)

VAR res: INTEGER;

BEGIN

(* Get the next byte from the line buffer, filling it if necessary 
   If step is TRUE then step on line buffer pointer Else
    leave pointer so that next read will return the same byte
*)


WITH InputLine DO

   res := 0;

   IF Index >= Count THEN
      res := ReadLine()
   END;

   IF res >= 0 THEN
      res := INTEGER (Line^[ Index ]);
      IF Step THEN
         INC (Index)
      END
   END

END;

RETURN res

END Reader;



(* ------------------------------------------------------------------------- *)

PROCEDURE Writer (ch : CHAR) : INTEGER;
(* The Filtered Version *)

VAR res : INTEGER;

   PROCEDURE HexChar (n : CARDINAL) : CHAR;

   BEGIN

   IF n < 10 THEN
      RETURN CHAR (n + ORD ('0'))
   ELSE
      RETURN CHAR (n + ORD ('a') - 10)
   END;

   END HexChar;

BEGIN

IF NOT FilterChar (ch) THEN
   res :=TKCALL (TKwrch, ch);
   IF ch = NewLineCH THEN
      res := TKCALL (TKwrch, CReturnCH)
   END
ELSE
   res := TKCALL (TKwrch, '[');
   res := TKCALL (TKwrch, HexChar (CARDINAL (ch) DIV 16));
   res := TKCALL (TKwrch, HexChar (CARDINAL (ch) MOD 16));
   res := TKCALL (TKwrch, ']')
END;

RETURN res

END Writer;




(* ------------------------------------------------------------------------- *)

PROCEDURE RawReader (Step : BOOLEAN) : INTEGER;
(*
   The Unfiltered Version.
   If Step is FALSE then arrange for the byte to be stored
   so that the next (raw) read will return it
*)

VAR res : BOOLEAN;
    ch: CHAR;

BEGIN

(* Flush the line buffer and get a character from the keyboard *)

DiscardLine();

IF TerminalByteHeld THEN   (* The residue of a previous currentbyte *)
   TerminalByteHeld := FALSE;
   ch := TheByteHeld
ELSE
   res := RdCH (ch);   (* We dont care if escape is pressed *)
   IF NOT Step THEN
      TerminalByteHeld := TRUE;
      TheByteHeld      := ch
   END
END;

RETURN INTEGER (ch)

END RawReader;



(* ------------------------------------------------------------------------- *)

PROCEDURE RawWriter (ch : CHAR) : INTEGER;
(* The UnFiltered Version *)

BEGIN

RETURN TKCALL (TKwrch, ch);

END RawWriter;




(* ------------------------------------------------------------------------- *)

PROCEDURE ErrorReader (Step : BOOLEAN) : INTEGER;
(* Causes an error - removes need for mode check on stream *)

BEGIN

RETURN IOError (IllegalOperation)

END ErrorReader;




(* ------------------------------------------------------------------------- *)

PROCEDURE ErrorWriter (ch : CHAR) : INTEGER;
(* Causes an error - removes need for mode check on stream *)

BEGIN

RETURN IOError (IllegalOperation)

END ErrorWriter;




(* ------------------------------------------------------------------------- *)

PROCEDURE Find (Mode: OpenType; DName: ARRAY OF CHAR;
                DData: ARRAY OF CHAR; Sref: StreamBlockPtr)
                                             : INTEGER;
(*
   Set up a stream to the named device.
   StreamMode is type of open.
   DData is additional information ( which must be null for the terminal ).
   Sref is a pointer to a new stream control block ( which should be free).
*)

VAR OpensAllowed: Opens;
    RawData:      BOOLEAN;
    res:          INTEGER;

BEGIN


res := 0;

(* No device data is allowed for the moment *)

IF LengthC (DData) # 0 THEN
   res := IOError(BadDeviceData)
ELSE
   RawData := FALSE;
   IF EqualLC ("VDU", DName) THEN
      OpensAllowed := Opens{OpenOut}
   ELSIF EqualLC ("RAWVDU", DName) THEN
      OpensAllowed := Opens{OpenOut};
      RawData := TRUE
   ELSIF EqualLC ("KB", DName) THEN
      OpensAllowed := Opens{OpenIn};
   ELSIF EqualLC ("RAWKB", DName) THEN
      OpensAllowed := Opens{OpenIn};
      RawData := TRUE
   ELSIF EqualLC ("BBC", DName) THEN
      OpensAllowed := Opens{OpenIn,OpenOut,OpenUpdate};
      RawData := TRUE
   ELSIF EqualLC ("TT", DName) THEN
      OpensAllowed := Opens{OpenIn,OpenOut,OpenUpdate};
   ELSE (* We should never get here - data already screened! *)
      OpensAllowed := Opens{}
   END;

   IF Mode IN OpensAllowed THEN
      WITH Sref^ DO
         Proc := Operation;
         OpenMode := Mode;
         Status := StreamStatus {};

         (* Set up the reader and writer procs for this stream *)

         TermReader := ErrorReader;
         TermWriter := ErrorWriter;

         IF RawData THEN
            INCL (Status, Raw);
            IF (Mode=OpenIn) OR (Mode = OpenUpdate) THEN
               TermReader := RawReader
            END;
            IF (Mode=OpenOut) OR (Mode = OpenUpdate) THEN
               TermWriter := RawWriter
            END;
         ELSE
            IF (Mode=OpenIn) OR (Mode = OpenUpdate) THEN
               TermReader := Reader
            END;
            IF (Mode=OpenOut) OR (Mode = OpenUpdate) THEN
               TermWriter := Writer
            END;
         END;
      END
   ELSE
      res := IOError (BadOpenType)
   END
END;

RETURN res

END Find;





(* ------------------------------------------------------------------------- *)

PROCEDURE Operation(StreamRef: StreamBlockPtr; f: IOFunction; arg: WORD)
                                 : INTEGER;

(* Carry out an IO operation on the given stream *)

VAR res: INTEGER;
    Data  : POINTER TO ARRAY [0..100000] OF CHAR;
    Index : CARDINAL;
    resx, resy : CARDINAL;
    cbit  : BOOLEAN;

BEGIN

res := 0;

CASE f OF

   IOClose, IOFlushOut:
      (* No Action required *)

 | IOSelectInput:

      WITH StreamRef^ DO
         IF OpenMode = OpenOut THEN
            res := IOError (IllegalOperation)
         ELSE
            (* Input is allowed on this stream *)
            OS1Byte (2, 4)       (* Enable Keyboard, Disable RS423, Printer *)
         END
      END

 | IOSelectOutput:

      WITH StreamRef^ DO
         IF OpenMode = OpenIn THEN
            res := IOError (IllegalOperation)
         ELSE
            (* Output is allowed on this stream *)
            OS1Byte (3, 4); (* Enable VDU *)
         END
      END

 | IOSelectUpdate:

      WITH StreamRef^ DO
         IF OpenMode = OpenUpdate THEN
            OS1Byte (2, 4); (* Enable Keyboard, Disable RS423, Printer *)
            OS1Byte (3, 4); (* Enable VDU *)
         ELSE
            res := IOError (IllegalOperation)
         END
      END

 | IODeselect:

      WITH StreamRef^ DO
         IF (OpenMode=OpenOut) OR (OpenMode=OpenUpdate) THEN
(*          OS1Byte (3, 6);           (* Disable the VDU *)      *)
            OS1Byte (3, 4);           (* Enable the VDU *)
         END;
      END;



 | IORead:

      WITH StreamRef^ DO
         res := TermReader (TRUE);
         IF res < 0 THEN
            TermReader := ErrorReader;
            IF res = IOError (EndFile) THEN
               INCL (Status,FileEnd)
            END
         END
      END;

 | IOCurrentByte:

      WITH StreamRef^ DO
         res := TermReader (FALSE);
         IF res < 0 THEN
            TermReader := ErrorReader;
            IF res = IOError (EndFile) THEN
               INCL (Status,FileEnd)
            END
         END
      END;

 | IOWrite:

      WITH StreamRef^ DO
         res := TermWriter (CHAR (arg))
      END;

 | IOBlockRead:

      WITH StreamRef^ DO

         Index := 0;
         Data := ADDRESS (arg);
         LOOP
            IF Index >= CARDINAL (Param) THEN
               EXIT
            END;
            res := TermReader (TRUE);
            IF res >= 0 THEN
               Data^[Index] := CHAR (res);
               INC (Index);
               IF CHAR (res) = NewLineCH THEN
                  EXIT
               END
            ELSE
               EXIT
            END
         END;
         Param := WORD (Index)
      END;

 | IOBlockWrite:

      WITH StreamRef^ DO

         Index := 0;
         Data := ADDRESS (arg);
         WHILE (Index < CARDINAL (Param)) AND (res >= 0) DO
            res := TermWriter (Data^[Index]);
            INC (Index);
         END;

      END;

 | IOBytesOutstanding:

      WITH StreamRef^ DO

         IF StreamRef^.OpenMode = OpenOut THEN
            res := IOError (IllegalOperation)
         ELSE
            (*
               If the stream is RAW then read available in BBC buffer
                                    else use number in line buffer
            *)
            IF Raw IN Status THEN
               res := OSByte (resx, resy, cbit, 080H, 255, 0);
               Param := WORD (resx)
            ELSE
               WITH InputLine DO
                  Param := WORD (Count - Index)
               END
            END;
            res := 0
         END

      END;

ELSE
   res := IOError (IllegalOperation)
END;


RETURN res


END Operation;

(* ========================================================================= *)

BEGIN

(* Initialise to force the first readline *)

WITH InputLine DO
   Line := InputBufferRef (ADR (LineBuffer));
   Count := 0;
   Index := 1;
END;



END Term;



(****************************************************************************
 *                                                                          *
 *                                                                          *
 *                   Filing System Handling                                 *
 *                                                                          *
 *                                                                          *
 *                                                                          *
 ****************************************************************************)






MODULE Filing;

(* Debug *)IMPORT Debug;

IMPORT ADDRESS, ADR, REGISTER, WORD, TKCALL;

IMPORT IOFacilityErrors;

IMPORT FileHandle, PANOSFind, PANOSArgs, PANOSClose, PANOSFindOp, PANOSGBPB,
       PANOSBget, PANOSBput, OSGBPBArray, PANOSFile, OSFileArray;

IMPORT ExtractElement, Capitalize, GetGlobalString;

IMPORT  LengthC ;

IMPORT  StreamBlock, StreamBlockPtr, IOFunction,
        StreamStatus, StreamStatusBits,
        IOBuffer, IOBufferSize, GetBuffer, FreeBuffer;

IMPORT OpenType, IOError, BBCError;

IMPORT TKbyte, TKword ;

EXPORT QUALIFIED Find1;

TYPE Opens = SET OF OpenType;

CONST CloseFile              = 0;
      ReadFilePointer        = 0;
      WriteFilePointer       = 1;
      ReadFileLength         = 2;
      OSGBPBRead             = 4;
      OSGBPBWrite            = 2;
      OSGBPBWriteWithPointer = 1;
      BBCEndOfFile           = 01FEH;


   (* PANOSFile command values *)

      FileSave    = 0;
      FilePutCat  = 1;
      FilePutLoad = 2;
      FilePutExec = 3;
      FilePutAttr = 4;
      FileGetCat  = 5;
      FileDelete  = 6;
      FileLoad    = 0FFH;


(* ------------------------------------------------------------------------- *)

PROCEDURE FileSize (Handle : FileHandle) : INTEGER;

VAR
   res : INTEGER;
   data : CARDINAL;

BEGIN

   res := PANOSArgs (data, ReadFileLength, Handle);
   IF res < 0 THEN RETURN res END;
   RETURN INTEGER (data);
END FileSize;




(* ------------------------------------------------------------------------- *)

PROCEDURE  LoadFile (FileName : ARRAY OF CHAR;
                     Address : ADDRESS         ) : INTEGER;

(*
   Load the named file to the given address
   Assume that the area is clear!
*)

VAR
   FileInfo : OSFileArray;

BEGIN

   FileInfo[0] := CARDINAL(Address);
   FileInfo[1] := 0;  (* =0 => use given load address *)
   RETURN PANOSFile (FileLoad, FileName, FileInfo);

END LoadFile;






(* ------------------------------------------------------------------------- *)

PROCEDURE Find1 (Mode: OpenType; FileName: ARRAY OF CHAR;
                 Sref : StreamBlockPtr) : INTEGER;
(*
   Set up a stream to the named device.
   StreamMode is type of open.
   Filename is as its name implies.
   Sref is a pointer to a new stream control block ( which should be free).
   Check that the filing system is allowed (i.e. that its name is
   present in the list in IO$FileSystems) if not then return error.
*)

VAR res : INTEGER;
    filehandle : FileHandle;
    filelength : CARDINAL;
BEGIN
(* First Check that there is a filename *)

IF LengthC (FileName) = 0 THEN
   RETURN IOError (BadDeviceData)
END;

CASE Mode OF
   OpenIn:
      res := PANOSFind (filehandle, FileName, FindInput);
 | OpenOut:
      res := PANOSFind (filehandle, FileName, FindOutput);
 | OpenUpdate:
      res := PANOSFind (filehandle, FileName, FindUpdate);
ELSE
      res := IOError (ImplementationFail)
END;

IF res >= 0 THEN (* File was successfully Opened *)
   WITH Sref^ DO
      Proc := Operation1;
      OpenMode := Mode;
      Status := StreamStatus {};
   (* Now we set up the FSHandle and file handle in the control block *)
      Handle := filehandle;
   END;
   filelength := FileSize(filehandle);
   IF (Mode = OpenIn) AND (filelength <= IOBufferSize) THEN
      GetBuffer (Sref, filelength);
      IF HasBuffer IN Sref^.Status THEN
         IF LoadFile (FileName, Sref^.BufferP^.Buffer) < 0 THEN
            (* If the load fails then turn off buffering & let the
               non buffered code sort out the error! *)
            FreeBuffer (Sref);
         ELSE
            Sref^.BufferP^.ValidBytes := filelength;
            INCL (Sref^.Status, FileLoaded);
            IF PANOSClose (Sref^.Handle) < 0 THEN END;
         END;
      END;
   ELSE
      GetBuffer (Sref, IOBufferSize);
   END;

END;

RETURN res

END Find1;



(* ------------------------------------------------------------------------- *)

PROCEDURE ByteFromBuffer (Sref : StreamBlockPtr) : INTEGER;
   VAR res       : INTEGER;
       bytesread : CARDINAL;
       TheByte   : INTEGER;
       ParamBlock: OSGBPBArray;

BEGIN

WITH Sref^ DO
   IF (BufferP^.Index >= BufferP^.ValidBytes) THEN
      IF FileLoaded IN Status THEN (* We have all there is - so end of file *)
         RETURN BBCEndOfFile;
      ELSE
         (* Buffer empty so attempt to refil --
         Unless we loaded whole file at open time *)

         (* First update our filepointer & update our pointer *)
         res := FlushBuffer (Sref);
         ParamBlock[0] := CARDINAL(BufferP^.Buffer);
         ParamBlock[1] := IOBufferSize;
         res := PANOSGBPB (OSGBPBRead, Handle, ParamBlock);
         bytesread := IOBufferSize - ParamBlock[1];
         IF (res < 0) OR ((res = BBCEndOfFile) AND (bytesread = 0)) THEN
            RETURN res;
         END;
         BufferP^.ValidBytes := bytesread;
      END;
   END;
   (* There is data in the buffer *)

   TheByte := INTEGER (BufferP^.Buffer^[BufferP^.Index]);
   INC (BufferP^.Index);

END;

RETURN TheByte;


END ByteFromBuffer;





(* ------------------------------------------------------------------------- *)

PROCEDURE ByteToBuffer(Sref : StreamBlockPtr; TheByte : CARDINAL) : INTEGER;

   VAR res : INTEGER;

BEGIN

IF Sref^.BufferP^.Index >= IOBufferSize THEN
   (* We need to try and write out the buffer *)
   res := FlushBuffer (Sref)
END;   

IF res < 0 THEN RETURN res END;

Sref^.BufferP^.Buffer^[Sref^.BufferP^.Index] := CHAR (TheByte);
INC (Sref^.BufferP^.Index);

RETURN 0;

END ByteToBuffer;





(* ------------------------------------------------------------------------- *)

PROCEDURE FlushBuffer (Sref : StreamBlockPtr) : INTEGER;

(* Flush the IO Buffer for the given stream (if there is one)
   & update the file pointer *)

VAR res : INTEGER;
    ParamBlock: OSGBPBArray;

BEGIN

IF NOT (HasBuffer IN Sref^.Status) THEN RETURN 0 END;

res := 0;

WITH Sref^ DO
   IF OpenMode = OpenIn THEN
      (* Set the file pointer & set buffer data to zero *)
      INC (BufferP^.FilePointer, BufferP^.ValidBytes);
   ELSE
      (* Write out data, crank up the file pointer & zap buffer *)
      IF BufferP^.ValidBytes > BufferP^.Index THEN
         BufferP^.Index := BufferP^.ValidBytes;
      END;
      ParamBlock [0] := CARDINAL(BufferP^.Buffer);
      ParamBlock [1] := BufferP^.Index;
      ParamBlock [2] := BufferP^.FilePointer;
      res := PANOSGBPB (OSGBPBWriteWithPointer, Handle, ParamBlock);
      IF res < 0 THEN
         res := BBCError (res)
      ELSE
         res := 0;
      END;
      INC (BufferP^.FilePointer, BufferP^.Index);
   END;
   BufferP^.Index := 0;
   BufferP^.ValidBytes := 0;
END;

RETURN res;

END FlushBuffer;




(* ------------------------------------------------------------------------- *)

PROCEDURE Operation1(StreamRef: StreamBlockPtr; f: IOFunction; arg: WORD)
                                 : INTEGER;

(* Carry out an IO operation on the given stream *)

TYPE
    BuffT            = ARRAY [0..10000] OF CHAR;


VAR res, res1:       INTEGER;
    TKres:           INTEGER;
    filelength:      CARDINAL;
    temp:            CARDINAL;
    index:           CARDINAL;
    data:            CARDINAL;
    bytesnotreceived:CARDINAL;
    junk            :BOOLEAN;
    ParamBlock      :OSGBPBArray;
    Buff            :POINTER TO BuffT;
BEGIN

res := 0;

(* Make the correct filing system the active one if it is not already *)

CASE f OF

   IOClose:
      res1 := FlushBuffer (StreamRef);
      FreeBuffer (StreamRef);
      IF NOT (FileLoaded IN StreamRef^.Status) THEN
             (* IF file was osfiled in the it's already closed *)
         res := PANOSClose (StreamRef^.Handle);
      END;
      IF res1 < 0 THEN
         res := res1
      END;

 | IOSelectInput:

      IF StreamRef^.OpenMode = OpenOut THEN
         res := IOError (IllegalOperation)
      END


 | IOSelectOutput:

      IF StreamRef^.OpenMode = OpenIn THEN
         res := IOError (IllegalOperation)
      END


 | IOSelectUpdate:

      IF StreamRef^.OpenMode # OpenUpdate THEN
         res := IOError (IllegalOperation)
      END;


 | IODeselect:

      (* We do not need to do anything for deselection *)


 | IORead:

      IF StreamRef^.OpenMode = OpenOut THEN
         res := IOError (IllegalOperation)
      ELSE
         IF HasBuffer IN StreamRef^.Status THEN
            res := ByteFromBuffer (StreamRef)
         ELSE
            res := PANOSBget (StreamRef^.Handle);
         END;
         IF res = BBCEndOfFile THEN
            INCL (StreamRef^.Status, FileEnd); (* Flag File Ended *)
            res := IOError (EndFile)
         END
      END


 | IOWrite:

      IF StreamRef^.OpenMode = OpenIn THEN
         res := IOError (IllegalOperation)
      ELSE
         IF HasBuffer IN StreamRef^.Status THEN
            res := ByteToBuffer (StreamRef, CARDINAL (arg));
         ELSE
            res := PANOSBput (StreamRef^.Handle, CARDINAL (arg));
         END;
      END;

 | IOBlockRead:

      IF StreamRef^.OpenMode = OpenOut THEN
         res := IOError (IllegalOperation)
      ELSE
         IF FileLoaded IN StreamRef^.Status THEN
         (* We have all of the file in our buffer - so suck it out *)
            Buff := ADDRESS(arg);
            temp := CARDINAL (StreamRef^.Param);
            index := 0;
            WHILE (temp # 0) AND (res # INTEGER(BBCEndOfFile)) DO
               res := ByteFromBuffer (StreamRef);
               IF res # INTEGER(BBCEndOfFile) THEN
                  Buff^[index] := CHAR(res);
                  DEC(temp);
                  INC(index);
               END;
            END;
            StreamRef^.Param := WORD (index);
         ELSE
            res := FlushBuffer(StreamRef);
            ParamBlock [0] := CARDINAL (arg);
            ParamBlock [1] := CARDINAL (StreamRef^.Param);
            res := PANOSGBPB (OSGBPBRead, StreamRef^.Handle, ParamBlock);
            bytesnotreceived := ParamBlock [1];
            (* Calculate how many bytes read *)
            temp := CARDINAL (StreamRef^.Param) - bytesnotreceived;
            StreamRef^.Param := WORD (temp);
         END;
         IF res < 0 THEN
         res := BBCError (res)
         ELSE
            IF res = INTEGER (BBCEndOfFile) THEN
            INCL (StreamRef^.Status, FileEnd); (* Flag File Ended *)
               res := IOError (EndFile)
            ELSE
               res := 0;
            END;
         END;
         (* Now update the buffer file pointer (If any) *)
         IF HasBuffer IN StreamRef^.Status THEN
            INC (StreamRef^.BufferP^.FilePointer, temp);
         END;
      END;


 | IOBlockWrite:

      IF StreamRef^.OpenMode = OpenIn THEN
         res := IOError (IllegalOperation)
      ELSE
         res := FlushBuffer (StreamRef);
         ParamBlock [0] := CARDINAL (arg);
         ParamBlock [1] := CARDINAL (StreamRef^.Param);

         res := PANOSGBPB (OSGBPBWrite, StreamRef^.Handle, ParamBlock);
         IF res < 0 THEN
            res := BBCError (res)
         ELSE
            res := 0;
         END;
         (* Now set buffer file pointer (if any) *)
         IF HasBuffer IN StreamRef^.Status THEN
            INC (StreamRef^.BufferP^.FilePointer, CARDINAL (StreamRef^.Param));
         END;
      END;


 | IOWritePtr:

      data := CARDINAL (arg);
      WITH StreamRef^ DO
         IF HasBuffer IN Status THEN
            (* Is the new value of the pointer within out Buffer? *)
            (* If so then just adjust our buffer index            *)
            IF OpenMode # OpenIn THEN
              (* Set ValidBytes to be high water mark of data in the buffer *)
              IF BufferP^.Index > BufferP^.ValidBytes THEN
                 BufferP^.ValidBytes := BufferP^.Index;
              END;
            END;
            IF (BufferP^.FilePointer <= data) AND
               (data <(BufferP^.FilePointer+BufferP^.ValidBytes)) THEN
              BufferP^.Index := data - BufferP^.FilePointer;
            ELSE
               res := FlushBuffer (StreamRef);
               IF res >=0 THEN
                  BufferP^.FilePointer := data;
                  res := PANOSArgs (data, WriteFilePointer, Handle);
               END;
            END;
         ELSE
            res := PANOSArgs (data, WriteFilePointer, Handle);
         END;
      END;

 | IOReadPtr:

      IF HasBuffer IN StreamRef^.Status THEN
         data := StreamRef^.BufferP^.FilePointer + StreamRef^.BufferP^.Index;
      ELSE
         res := PANOSArgs(data, ReadFilePointer, StreamRef^.Handle);
         StreamRef^.Param := WORD (data);
      END;
      IF res < 0 THEN
         StreamRef^.Param := WORD (0)
      ELSE
         StreamRef^.Param := WORD (data);
      END;

 | IOBytesOutstanding:

      IF StreamRef^.OpenMode = OpenOut THEN
         res := IOError (IllegalOperation)
      ELSE
         res := PANOSArgs(filelength, ReadFileLength, StreamRef^.Handle);
         IF res >= 0 THEN
                       (* We got the extent OK now try to get the pointer *)
            IF HasBuffer IN StreamRef^.Status THEN
               temp := StreamRef^.BufferP^.FilePointer +
                               StreamRef^.BufferP^.Index;
            ELSE
               res := PANOSArgs(temp, ReadFilePointer, StreamRef^.Handle);
            END;
         END;
         IF res >= 0 THEN
            res := 0;
            StreamRef^.Param := WORD (filelength - temp)
                                (* The number of bytes remaining *)
         END
      END;

  | IOFlushOut:

      res := FlushBuffer(StreamRef);
ELSE

   res := IOError(IllegalOperation)

END;


RETURN res


END Operation1;




END Filing;





(****************************************************************************
 *                                                                          *
 *                                                                          *
 *                       Printer Handling                                   *
 *                                                                          *
 *                                                                          *
 *                                                                          *
 ****************************************************************************)






MODULE Printer;

(* Debug *)IMPORT Debug;

IMPORT ADR, ADDRESS, REGISTER, WORD, TKCALL;
IMPORT IOFacilityErrors;

IMPORT LengthC;

IMPORT  StreamBlock, StreamBlockPtr, IOFunction,
        StreamStatus, StreamStatusBits;

IMPORT OpenType, IOError, BBCError, OS1Byte;

IMPORT TKbyte, TKwrch, TKword;


EXPORT QUALIFIED Find2;

                                                                                                                                       

(* ------------------------------------------------------------------------- *)

PROCEDURE ClaimPrinter() : INTEGER;

VAR TKres, res : INTEGER;
    OldFX3Status: CARDINAL;

BEGIN

(* TKres := TKCALL (TKbyte, 3, 16);    (* Turn on vdu to handle VDU 2 *) *)
TKres := TKCALL (TKbyte, 3, 0);    (* Turn on vdu to handle VDU 2 *)
OldFX3Status := REGISTER (2);

res := TKCALL (TKwrch, 2);

(*
   Now see if the TKwrch succeeded - do an osbyte which is guarenteed to
   work - if it fails then we have an econet printer not listening.
*)

TKres := TKCALL (TKbyte, 0, 1);

IF res < 0 THEN
   res := IOError (PrinterNotAvailable)
ELSE
   res := 0
END;

(* Now put the output stream back to what it was *)

TKres := TKCALL (TKbyte, 3, OldFX3Status);

RETURN res

END ClaimPrinter;



(* ------------------------------------------------------------------------- *)

PROCEDURE ReleasePrinter();

VAR res : INTEGER;

BEGIN

(* OS1Byte (3, 16);    (* Turn on the vdu to handle the VDU 3 *) *)
OS1Byte (3, 0);    (* Turn on the vdu to handle the VDU 3 *)
res := TKCALL (TKwrch, 3);

END ReleasePrinter;



(* ------------------------------------------------------------------------- *)

PROCEDURE Find2 (Mode: OpenType; DName: ARRAY OF CHAR;
                DData: ARRAY OF CHAR; Sref: StreamBlockPtr)
                                             : INTEGER;
(*
   Set up a stream to the Printer.
   StreamMode is type of open.
   DData is additional information ( which must be null for the Printer ).
   Sref is a pointer to a new stream control block ( which should be free).
*)

VAR res : INTEGER;

BEGIN


res := 0;

(* No device data is allowed for the moment *)

IF LengthC (DData) # 0 THEN
   res := IOError(BadDeviceData)
ELSE
   IF Mode # OpenOut THEN  (* Printers can only Output! *)
      res := IOError (BadOpenType)
   ELSE
      res := ClaimPrinter();
      IF res >= 0 THEN
         WITH Sref^ DO
            Proc := Operation2;
            OpenMode := OpenOut;
            Status := StreamStatus {} 
         END
      ELSE
         res := IOError (PrinterNotAvailable)
      END
   END   
END;

RETURN res

END Find2;





(* ------------------------------------------------------------------------- *)

PROCEDURE Operation2(StreamRef: StreamBlockPtr; f: IOFunction; arg: WORD)
                                 : INTEGER;

(* Carry out an IO operation on the given stream *)

VAR TKres, res: INTEGER;
    Data  : POINTER TO ARRAY [0..100000] OF CHAR;
    Index : CARDINAL;

BEGIN

res := 0;

CASE f OF

   IOClose, IOFlushOut:

      ReleasePrinter();
      OS1Byte (3, 4);     (* Send to VDU only from now on *)

 | IOSelectOutput:

      OS1Byte (3, 26);

 | IOWrite:

      TKres := TKCALL (TKwrch, arg)

 | IOBlockWrite:

      WITH StreamRef^ DO

         Index := 0;
         Data := ADDRESS (arg);
         WHILE (Index < CARDINAL (Param)) AND (res >= 0) DO
            res := TKCALL (TKwrch, Data^[Index]);
            INC (Index);
         END;

      END;

ELSE
   res := IOError(IllegalOperation)

END;


RETURN res


END Operation2;




END Printer;


(****************************************************************************
 *                                                                          *
 *                                                                          *
 *                         RS423 Handling                                   *
 *                                                                          *
 *                                                                          *
 *                                                                          *
 ****************************************************************************)






MODULE RS423;

(* Debug *)IMPORT Debug;

IMPORT ADDRESS, ADR, REGISTER, WORD, TKCALL;
IMPORT IOFacilityErrors;

IMPORT LengthC;

IMPORT  StreamBlock, StreamBlockPtr, IOFunction,
        StreamStatus, StreamStatusBits;

IMPORT OpenType, IOError, BBCError, OS1Byte;

IMPORT TKbyte, TKwrch, TKword;


EXPORT QUALIFIED Find4;

                                                                                                                                       



(* ------------------------------------------------------------------------- *)

PROCEDURE Find4 (Mode: OpenType; DName: ARRAY OF CHAR;
                 DData: ARRAY OF CHAR; Sref: StreamBlockPtr)
                                             : INTEGER;
(*
   Set up a stream to the RS423.
   StreamMode is type of open.
   DData is additional information ( which must be null for RS423).
   Sref is a pointer to a new stream control block ( which should be free).
*)

VAR res : INTEGER;

BEGIN


res := 0;

(* No device data is allowed for the moment *)

IF LengthC (DData) # 0 THEN
   res := IOError(BadDeviceData)
ELSE
   WITH Sref^ DO
      Proc := Operation4;
      OpenMode := Mode;
      Status := StreamStatus {} 
   END   
END;

RETURN res

END Find4;





(* ------------------------------------------------------------------------- *)

PROCEDURE Operation4(StreamRef: StreamBlockPtr; f: IOFunction; arg: WORD)
                                 : INTEGER;

(* Carry out an IO operation on the given stream *)

   PROCEDURE WriteRS423 (ch : CHAR);
       (* Get char to rs423 - retrying until it is accepted *)

   VAR TKres : INTEGER;

   BEGIN

      LOOP
         TKres := TKCALL (TKbyte, 8AH, 2, ch);
         IF 0 IN BITSET (REGISTER (8)) THEN
            (* 32000 c-bit is reflection of BBC one *)
            (* so we arrange to try char again      *)
         ELSE
            EXIT
         END
      END

   END WriteRS423;


VAR TKres, res: INTEGER;
    Data  : POINTER TO ARRAY [0..100000] OF CHAR;
    Index : CARDINAL;


BEGIN

res := 0;

CASE f OF

   IOClose:
         (*
            To know how to leave the input status we must
            know if there are any other RS423 streams
         *)

 | IOFlushOut:

 | IOSelectInput:

      WITH StreamRef^ DO
         IF OpenMode = OpenOut THEN
            res := IOError (IllegalOperation)
         ELSE
            (* Input is allowed on this stream *)
            OS1Byte (2, 1);       (* Enable RS423 *)
         END
      END

 | IOSelectOutput:

      WITH StreamRef^ DO
         IF OpenMode = OpenIn THEN
            res := IOError (IllegalOperation)
         ELSE
         END
      END


 | IOSelectUpdate:

      WITH StreamRef^ DO
         IF OpenMode = OpenUpdate THEN
            OS1Byte (2, 1);
         ELSE
            res := IOError (IllegalOperation)
         END
      END

 | IODeselect:

      WITH StreamRef^ DO
         IF (OpenMode=OpenIn) OR (OpenMode=OpenUpdate) THEN
            OS1Byte (2,2)
         END
      END;


 | IOWrite:

      WriteRS423 (CHAR (arg));

 | IOBlockWrite:

      WITH StreamRef^ DO

         Index := 0;
         Data := ADDRESS (arg);
         WHILE (Index < CARDINAL (Param)) AND (res >= 0) DO
            WriteRS423 (Data^[Index]);
            INC (Index)
         END

      END;

ELSE
   res := IOError(IllegalOperation)

END;


RETURN res


END Operation4;




END RS423;





(****************************************************************************
 *                                                                          *
 *                                                                          *
 *                       Null Handling                                      *
 *                                                                          *
 *                                                                          *
 *                                                                          *
 ****************************************************************************)






MODULE Null;

(* Debug *)IMPORT Debug;

IMPORT ADR, REGISTER, WORD, TKCALL;

IMPORT IOFacilityErrors;

IMPORT  StreamBlock, StreamBlockPtr, IOFunction,
        StreamStatus, StreamStatusBits;

IMPORT OpenType, IOError, BBCError, OS1Byte;

IMPORT TKbyte, TKwrch, TKword;

IMPORT LengthC;


EXPORT QUALIFIED Find3;

                                                                                                                                       


(* ------------------------------------------------------------------------- *)

PROCEDURE Find3 (Mode: OpenType; DName: ARRAY OF CHAR;
                DData: ARRAY OF CHAR; Sref: StreamBlockPtr)
                                             : INTEGER;
(*
   Set up a stream to the Null device.
*)

VAR res : INTEGER;

BEGIN


res := 0;

(* No device data is allowed for the moment *)

IF LengthC (DData) # 0 THEN
   res := IOError(BadDeviceData)
ELSE
   WITH Sref^ DO
      Proc := Operation3;
      OpenMode := Mode;
      Status := StreamStatus {FileEnd}; (* Null always looks 'endoffile' *) 
   END
END;

RETURN res

END Find3;





(* ------------------------------------------------------------------------- *)

PROCEDURE Operation3(StreamRef: StreamBlockPtr; f: IOFunction; arg: WORD)
                                 : INTEGER;

(* Carry out an IO operation on the given stream *)

VAR res: INTEGER;

BEGIN

res := 0;

CASE f OF

   IOSelectInput:

      WITH StreamRef^ DO
         IF OpenMode = OpenOut THEN
            res := IOError (IllegalOperation)
         END
      END

 | IOSelectOutput:

      WITH StreamRef^ DO
         IF OpenMode = OpenIn THEN
            res := IOError (IllegalOperation)
         END
      END

 | IOSelectUpdate:

      WITH StreamRef^ DO
         IF OpenMode # OpenUpdate THEN
            res := IOError (IllegalOperation)
         END
      END
 
 | IORead,
   IOBlockRead:

      IF StreamRef^.OpenMode = OpenOut THEN
         res := IOError (IllegalOperation)
      ELSE
         res := IOError (EndFile)
      END

 | IOWrite,
   IOBlockWrite:

      IF StreamRef^.OpenMode = OpenIn THEN
         res := IOError (IllegalOperation)
      END

ELSE

END;


RETURN res


END Operation3;




END Null;


(* ========================================================================= *)




BEGIN

(* Set up the device name tables *)

WITH Devices[ 0 ] DO
   Name  := "RAWVDU";
   Proc  := Term.Find
END;

WITH Devices[ 1 ] DO
   Name  := "VDU";
   Proc  := Term.Find
END;

WITH Devices[ 2 ] DO
   Name  := "RAWKB";
   Proc  := Term.Find
END;

WITH Devices[ 3 ] DO
   Name  := "KB";
   Proc  := Term.Find
END;

WITH Devices[ 4 ] DO
   Name  := "BBC";
   Proc  := Term.Find
END;

WITH Devices[ 5 ] DO
   Name  := "TT";
   Proc  := Term.Find
END;

WITH Devices[ 6 ] DO
   Name  := "RS423";
   Proc  := RS423.Find4
END;

WITH Devices[ 7 ] DO
   Name  := "PRINTER";
   Proc  := Printer.Find2
END;

WITH Devices[ 8 ] DO
   Name  := "LP";
   Proc  := Printer.Find2
END;

WITH Devices[ 9 ] DO
   Name  := "NULL";
   Proc  := Null.Find3
END;


(* Make Sure that we have the proper VDU handler in the BBC *)


result := TKCALL(TKsetVduHandler,0);


END IOSupport.