BCPLIO  TITLE   "Z80 BCPL Run Time System  -  Section BCPLIO"
        GET     "HEADER"
        GET     "SCBHDR"
        LAYOUT
;  This sections contains all the standard BCPL I/O functions.  It relies on
;  the module "INITIO" to initialise all the I/O devices, and define the
;  names of those streams which can be opened.
        LAYOUT
        REF     GETVEC
        REF     FREEVEC

G.RDCH  EQU     2*54                    ;  Global number of "rdch"
G.UNRD  EQU     2*55                    ;  Global number of "unrdch"
G.WRCH  EQU     2*56                    ;  Global number of "wrch"
G.FNDI  EQU     2*59                    ;  Global number of "findinput"
G.FNDO  EQU     2*60                    ;  Global number of "findoutput"
G.SELI  EQU     2*61                    ;  Global number of "selectinput"
G.SELO  EQU     2*62                    ;  Global number of "selectoutput"
G.ENDR  EQU     2*63                    ;  Global number of "endread"
G.ENDW  EQU     2*64                    ;  Global number of "endstream"
G.INPT  EQU     2*65                    ;  Global number of "input"
G.OUPT  EQU     2*66                    ;  Global number of "output"
G.BUFI  EQU     2*88                    ;  Global number of "bufferedinput"
G.BUFO  EQU     2*89                    ;  Global number of "bufferedoutput"
G.INTI  EQU     2*90                    ;  Global number of "interactiveinput"
G.INTO  EQU     2*91                    ;  Global number of "interactiveoutput"
G.TSTB  EQU     2*92                    ;  Global number of "testbreak"
G.ENDS  EQU     2*93                    ;  Global number of "endstream"
G.MAXG  EQU     2*150                   ;  Highest referenced global
        LAYOUT
        RELOCATABLE

        ORG     0

BCPLIO  DEFB    'BCPL'                  ;  Entry flag for BCPL module
        DEFW    BCPLIOE-BCPLIO          ;  Length of module in bytes
        LAYOUT
;  FINDINPUT
;  ---------
;
;    scb  :=  findinput( name )


        ALIGN

FNDI    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        ADD     HL,HL                   ;  Get byte pointer to name
        LD      E,(IY-26)               ;  Low byte of IOLIST
        LD      D,(IY-25)               ;  High byte of IOLIST
        EX      DE,HL                   ;  Swap the arguments
        CALL    FIND                    ;  Find the name in the list

;  When we return from "FIND", HL either contains a pointer to the OPEN
;  routines for the relevant name, or zero on failure.

        LD      A,H                     ;  High byte of result
        OR      L                       ;  Is it zero ?
        RET     Z                       ;  Return result if so

;  If we come here, then there is a handler.  We should allocate a vector to
;  hold the SCB, and then call the relevant routine.

        PUSH    HL                      ;  Save pointer to entry
        PUSH    DE                      ;  Save pointer to name

        LD      HL,S.UPB                ;  Size of SCB
        CALL    GETVEC                  ;  Allocate the storage
        JP      Z,FNDI0                 ;  Successful return

;  If we drop through here, then we have been unable to allocate storage for
;  the SCB, and so should return an error result.

        LD      (IY-108),A              ;  Low byte of error code
        LD      (IY-107),0              ;  High byte of error code

        POP     DE                      ;  Restore name
        POP     DE                      ;  Restore entry
        RET                             ;  And return

;  If we come here, then we have allocated storage for the SCB, and we should
;  call the relevant routine.

FNDI0   POP     DE                      ;  Restore pointer to name
        EX      (SP),IX                 ;  Get pointer to handlers
        LD      C,(IX+0)                ;  Low byte of "findinput"
        LD      B,(IX+1)                ;  High byte of "findinput"

        PUSH    HL                      ;  Save pointer to SCB
        POP     IX                      ;  Store in IX
        CALL    CALLBC                  ;  Call the "findinput" routine
        POP     IX                      ;  Restore IX
        RET                             ;  And return
        LAYOUT
;  FINDOUTPUT
;  ----------
;
;    scb  :=  findoutput( name )


        ALIGN

FNDO    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        ADD     HL,HL                   ;  Get byte pointer to name
        LD      E,(IY-26)               ;  Low byte of IOLIST
        LD      D,(IY-25)               ;  High byte of IOLIST
        EX      DE,HL                   ;  Swap the arguments
        CALL    FIND                    ;  Find the name in the list

;  When we return from "FIND", HL either contains a pointer to the OPEN
;  routines for the relevant name, or zero on failure.

        LD      A,H                     ;  High byte of result
        OR      L                       ;  Is it zero ?
        RET     Z                       ;  Return result if so

;  If we come here, then there is a handler.  We should allocate a vector to
;  hold the SCB, and then call the relevant routine.

        PUSH    HL                      ;  Save pointer to entry
        PUSH    DE                      ;  Save pointer to name

        LD      HL,S.UPB                ;  Size of SCB
        CALL    GETVEC                  ;  Allocate the storage
        JP      Z,FNDO0                 ;  Successful return

;  If we drop through here, then we have been unable to allocate storage for
;  the SCB, and so should return an error result.

        LD      (IY-108),A              ;  Low byte of error code
        LD      (IY-107),0              ;  High byte of error code

        POP     DE                      ;  Restore name
        POP     DE                      ;  Restore entry
        RET                             ;  And return

;  If we come here, then we have allocated storage for the SCB, and we should
;  call the relevant routine.

FNDO0   POP     DE                      ;  Restore pointer to name
        EX      (SP),IX                 ;  Get pointer to handlers
        LD      C,(IX+2)                ;  Low byte of "findoutput"
        LD      B,(IX+3)                ;  High byte of "findoutput"

        PUSH    HL                      ;  Save pointer to SCB
        POP     IX                      ;  Store in IX
        CALL    CALLBC                  ;  Call the "findoutput" routine
        POP     IX                      ;  Restore IX
        RET                             ;  And return
        LAYOUT
;  RDCH
;  ----
;
;      ch  :=  rdch()


        ALIGN

RDCH    PUSH    HL                      ;  Save return link
        LD      L,(IY-24)               ;  Low byte of CIS
        LD      H,(IY-23)               ;  High byte of CIS
        LD      A,H                     ;  Is there a stream ?
        OR      L                       ;  Sets 'Z' if not
        JP      Z,RDCH0                 ;  No, so error

;  If we drop through here, then we have a current input stream, and so
;  we can attempt to read a character.

        PUSH    HL                      ;  Save pointer to SCB
        EX      (SP),IX                 ;  And store in an index register

        BIT     F.BUF,(IX+S.FLAG)       ;  Are we in buffered mode ?
        JP      Z,RDCH2                 ;  No, so read binary character

;  If we drop through here, then we are in buffered mode, and so we
;  should look in the buffer for the character.

        LD      E,(IX+S.POS)            ;  Load POS field
        LD      A,(IX+S.END)            ;  Load END field
        CP      E                       ;  Are they equal ?
        JP      NZ,RDCH3                ;  No, so can read from buffer

;  If we drop through here, then there are no characters in the buffer for us
;  and so we should call the "BUFREAD" routine to replenish the buffer.
;  If the "EOF" flag is set, then  we have hit "end of file" already on
;  this stream, and so we should return "end of stream character".

        BIT     F.EOF,(IX+S.FLAG)       ;  Has EOF been hit already ?
        JP      Z,RDCH1                 ;  No, so carry on

;  If we drop through here, then we have already hit end of file.  We
;  return "endstreamch".

        LD      HL,ENDCH                ;  End of stream character

        POP     IX                      ;  Restore IX
        RET                             ;  And return

;  If we come here, then we have not hit end of file, and so we can call the
;  BUFREAD function to replenish the buffer for us.

RDCH1   LD      C,(IX+S.BUFR+0)         ;  Low byte of BUFREAD
        LD      B,(IX+S.BUFR+1)         ;  High byte of BUFREAD
        CALL    CALLBC                  ;  Call the routine

;  When we return from that function, the A register contains the number of
;  characters which have been read into the buffer.  Check to see if it is
;  zero, and if that is the case, set the "EOF" flag, and return end of
;  stream.

        OR      A                       ;  Zero characters in buffer ?
        JP      NZ,RDCH4                ;  No, so all is well

;  If we drop through, then we have failed to replenish the buffer, so set
;  the "EOF" flag, and return.

        SET     F.EOF,(IX+S.FLAG)       ;  Set the EOF bit
        LD      HL,ENDCH                ;  End of stream character

        POP     IX                      ;  Restore IX
        RET                             ;  And return

;  If we come here, then the buffer replenish was successful, and so we
;  can store the new END value, and join the common code.

RDCH4   LD      (IX+S.END),A            ;  Save END value
        LD      E,0                     ;  Set current POS value

;  When we reach here, we are guaranteed of a character in the buffer, so
;  we should read it and return it.

RDCH3   PUSH    IX                      ;  Save pointer to SCB
        POP     HL                      ;  And store in HL
        LD      BC,S.BUFF               ;  Load buffer offset
        ADD     HL,BC                   ;  Get pointer to buffer

        LD      D,0                     ;  High byte of POS
        ADD     HL,DE                   ;  Get pointer to character
        INC     E                       ;  Increment the POS field
        LD      (IX+S.POS),E            ;  And store it in the SCB

        LD      L,(HL)                  ;  Low byte of character
        LD      H,0                     ;  High byte of character

        POP     IX                      ;  Restore IX
        RET                             ;  And return

;  If we come here, then we are not in buffered mode, and so we should
;  call the BINREAD routine directly.

RDCH2   LD      C,(IX+S.BINR+0)         ;  Load low byte of routine
        LD      B,(IX+S.BINR+1)         ;  Load high byte of routine
        CALL    CALLBC                  ;  Enter the routine

;  When we exit from that routine, the character read is already in HL,
;  so all that is necessary is to restore IX, and return.

        POP     IX                      ;  Restore IX
        RET

;  We come here if there is no selected input stream.  Not a lot
;  we can do, other than enter the debugger.

RDCH0   ERRTRAP                         ;  Call DEBUG
        RET                             ;  And return
        LAYOUT
;  WRCH
;  ----
;
;      wrch( ch )


        ALIGN

WRCH    PUSH    HL                      ;  Save return link
        EXX                             ;  Get argument register set
        PUSH    HL                      ;  Save character to be written

        LD      L,(IY-22)               ;  Low byte of COS
        LD      H,(IY-21)               ;  High byte of COS
        LD      A,H                     ;  Is there a stream ?
        OR      L                       ;  Sets 'Z' if not
        JP      Z,WRCH0                 ;  No, so error

;  If we drop through here, then we have a current output stream, and so
;  we can attempt to write a character.

        EX      (SP),HL                 ;  Swap character and SCB pointer
        EX      (SP),IX                 ;  Get SCB into an index register
        PUSH    HL                      ;  And store the character again

        BIT     F.BUF,(IX+S.FLAG)       ;  Are we in buffered mode ?
        JP      Z,WRCH1                 ;  No, so write binary character

;  If we drop through here, then we are in buffered mode, and so we
;  should write the character into the buffer.

        LD      E,(IX+S.POS)            ;  Load POS field
        LD      A,(IX+S.END)            ;  Load END field
        CP      E                       ;  Are they equal ?
        JP      NZ,WRCH2                ;  No, so can write to buffer

;  If we drop through here, then there is no room in the buffer for us
;  and so we should call the "BUFWRITE" routine to flush the buffer.

        LD      C,(IX+S.BUFW+0)         ;  Low byte of BUFWRITE
        LD      B,(IX+S.BUFW+1)         ;  High byte of BUFWRITE
        CALL    CALLBC                  ;  Call the routine

        LD      (IX+S.END),S.SIZE       ;  Save END value
        LD      E,0                     ;  Set current POS value

;  When we reach here, we are guaranteed of room in the buffer to store our
;  character.

WRCH2   PUSH    IX                      ;  Save SCB pointer
        POP     HL                      ;  And store in HL
        LD      BC,S.BUFF               ;  Offset of buffer
        ADD     HL,BC                   ;  Add into HL

        LD      D,0                     ;  High byte of POS
        ADD     HL,DE                   ;  Get pointer to character
        INC     E                       ;  Increment the POS field
        LD      (IX+S.POS),E            ;  And store it in the SCB

        POP     BC                      ;  Get character
        LD      (HL),C                  ;  Store in the buffer

;  The character has been stored in the buffer, but it is possible that
;  we are in interactive mode, and the character given is a record
;  terminator.

        BIT     F.INT,(IX+S.FLAG)       ;  Are we interactive ?
        JP      Z,WRCH3                 ;  No, so return now

        LD      HL,STARN                ;  Load '*N' character
        OR      A                       ;  Clear carry flag
        SBC     HL,BC                   ;  Is is the same ?
        JP      Z,WRCH4                 ;  Yes, so flush buffer

        LD      HL,STARE                ;  Load '*E' character
        OR      A                       ;  Clear carry flag
        SBC     HL,BC                   ;  Is is the same ?
        JP      Z,WRCH4                 ;  Yes, so flush buffer

;  If we drop through here, then we have no need to flush the buffer at
;  all.

        JP      WRCH3                   ;  Return

;  If we come here, then we must flush the buffer, since we have a line
;  terminator in our hands.

WRCH4   LD      A,E                     ;  Load buffer length into A
        LD      C,(IX+S.BUFW+0)         ;  Low byte of BUFWRITE
        LD      B,(IX+S.BUFW+1)         ;  High byte of BUFWRITE
        CALL    CALLBC                  ;  Call the routine

        LD      (IX+S.END),S.SIZE       ;  Save END value
        LD      (IX+S.POS),0            ;  Save POS value

;  When we come here, there is nothing more to be done, other than to
;  restore IX and return.

WRCH3   POP     IX                      ;  Restore IX
        RET                             ;  And return

;  If we come here, then we are not in buffered mode, and so we should
;  call the BINWRITE routine directly.

WRCH1   POP     HL                      ;  Restore character to be written
        LD      C,(IX+S.BINW+0)         ;  Load low byte of routine
        LD      B,(IX+S.BINW+1)         ;  Load high byte of routine
        CALL    CALLBC                  ;  Enter the routine

;  When we exit from that routine, all we need to do is restore IX and
;  return.

        POP     IX                      ;  Restore IX
        RET

;  We come here if there is no selected output stream.  Not a lot
;  we can do, other than enter the debugger.

WRCH0   POP     HL                      ;  Restore character to be written
        ERRTRAP                         ;  Call DEBUG
        RET                             ;  And return
        LAYOUT
;  UNRDCH
;  ------
;
;    bool  :=  unrdch()


        ALIGN

UNRD    PUSH    HL                      ;  Save return address
        LD      L,(IY-24)               ;  Low byte of CIS
        LD      H,(IY-23)               ;  High byte of CIS
        LD      A,H                     ;  Is there a stream ?
        OR      L                       ;  Sets 'Z' if not
        JP      Z,UNRD0                 ;  No, so error

;  If we drop through here, then there is a stream, and so we should
;  look to see if we can "unread" a character.  This is only true if:
;
;    a)  Not EOF already
;    b)  Buffered mode
;    c)  POS > 0

        BIT     F.EOF,(HL)              ;  End of file already ?
        JP      NZ,UNRD1                ;  Yes, so error
        BIT     F.BUF,(HL)              ;  Buffered mode ?
        JP      Z,UNRD1                 ;  No, so error

;  If we drop through here, then we must look at the POS field of the SCB,
;  and that will tell us whether we can unread a character or not.

        LD      DE,S.POS                ;  Offset of POS field
        ADD     HL,DE                   ;  Get pointer to POS field
        LD      A,(HL)                  ;  And load POS
        OR      A                       ;  Is it zero ?
        JP      Z,UNRD1                 ;  Yes, so cannot unread

        DEC     A                       ;  Decrement POS
        LD      (HL),A                  ;  And store it in the SCB

        LD      HL,#XFFFF               ;  TRUE result
        RET                             ;  And return

;  If we come here, then there has been some error along the line, and
;  we should return FALSE.

UNRD1   LD      HL,0                    ;  FALSE result
        RET                             ;  And return

;  If we come here, then there was no input SCB in the first place.  We
;  should moan about this by calling the debugger.

UNRD0   ERRTRAP                         ;  Call the debugger
        RET                             ;  And return
        LAYOUT
;  ENDREAD
;  -------
;
;    endread()


        ALIGN

ENDR    PUSH    HL                      ;  Save return address
        LD      L,(IY-24)               ;  Low byte of CIS
        LD      H,(IY-23)               ;  High byte of CIS
        JP      ENDS0                   ;  Call "endstream"
        LAYOUT
;  ENDWRITE
;  --------
;
;    endwrite()


        ALIGN

ENDW    PUSH    HL                      ;  Save return address
        LD      L,(IY-22)               ;  Low byte of COS
        LD      H,(IY-21)               ;  High byte of C)S
        JP      ENDS0                   ;  Call "endstream"
        LAYOUT
;  ENDSTREAM
;  ---------
;
;    endstream( scb )


        ALIGN

ENDS    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set

ENDS0   LD      A,H                     ;  High byte of SCB
        OR      L                       ;  is there a stream ?
        RET     Z                       ;  No, so return

;  If we come here, then there is a stream to close.  Call the "close"
;  function, and then "freevec" the SCB.

        PUSH    HL                      ;  Save pointer to SCB
        EX      (SP),IX                 ;  And store in an index register

        LD      C,(IX+S.CLSE+0)         ;  Low byte of CLOSE
        LD      B,(IX+S.CLSE+1)         ;  High byte of CLOSE
        CALL    CALLBC                  ;  Call the function

        EX      (SP),IX                 ;  Restore IX
        POP     HL                      ;  Get SCB pointer in HL
        CALL    FREEVEC                 ;  Free the vector

        RET                             ;  And return
        LAYOUT
;  SELECTINPUT
;  -----------
;
;    selectinput( scb )


        ALIGN

SELI    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      A,H                     ;  High byte of scb
        OR      L                       ;  Is there a stream ?
        RET     Z                       ;  No, so return

        BIT     F.IN,(HL)               ;  Is this an input stream ?
        JP      Z,SELI0                 ;  No, so error

        LD      (IY-24),L               ;  Store low byte
        LD      (IY-23),H               ;  Store high byte
        RET                             ;  And return

;  If we come here, then this is an invalid input stream.  Call the debugger
;  and return.

SELI0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  SELECTOUTPUT
;  ------------
;
;    selectoutput( scb )


        ALIGN

SELO    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      A,H                     ;  High byte of scb
        OR      L                       ;  Is there a stream ?
        RET     Z                       ;  No, so return

        BIT     F.OUT,(HL)              ;  Is this an output stream ?
        JP      Z,SELO0                 ;  No, so error

        LD      (IY-22),L               ;  Store low byte
        LD      (IY-21),H               ;  Store high byte
        RET                             ;  And return

;  If we come here, then this is an invalid output stream.  Call the debugger
;  and return.

SELO0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  INPUT
;  -----
;
;    x  :=  input()


        ALIGN

INPT    PUSH    HL                      ;  Save return address
        LD      L,(IY-24)               ;  Low byte of CIS
        LD      H,(IY-23)               ;  High byte of CIS
        RET                             ;  And return
        LAYOUT
;  OUTPUT
;  ------
;
;    x  :=  output()


        ALIGN

OUPT    PUSH    HL                      ;  Save return address
        LD      L,(IY-22)               ;  Low byte of COS
        LD      H,(IY-21)               ;  High byte of COS
        RET                             ;  And return
        LAYOUT
;  BUFFEREDINPUT
;  -------------
;
;    bufferedinput( bool )


        ALIGN

BUFI    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      E,(IY-24)               ;  Low byte of CIS
        LD      D,(IY-23)               ;  High byte of CIS

        LD      A,D                     ;  High byte of scb
        OR      E                       ;  Is there an scb ?
        JP      Z,BUFI0                 ;  No, so error

        EX      DE,HL                   ;  Swap argument and scb
        LD      A,D                     ;  High byte of argument
        OR      E                       ;  Is the argument FALSE ?
        JP      Z,BUFI1                 ;  Yes, so reset the flag

        SET     F.BUF,(HL)              ;  Set the "buffered" flag
        RET                             ;  And return

BUFI1   RES     F.BUF,(HL)              ;  Reset the "buffered" flag
        RET                             ;  And return

BUFI0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  BUFFEREDOUTPUT
;  --------------
;
;    bufferedoutput( bool )


        ALIGN

BUFO    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      E,(IY-22)               ;  Low byte of COS
        LD      D,(IY-21)               ;  High byte of COS

        LD      A,D                     ;  High byte of scb
        OR      E                       ;  Is there an scb ?
        JP      Z,BUFO0                 ;  No, so error

        EX      DE,HL                   ;  Swap argument and scb
        LD      A,D                     ;  High byte of argument
        OR      E                       ;  Is the argument FALSE ?
        JP      Z,BUFO1                 ;  Yes, so reset the flag

        SET     F.BUF,(HL)              ;  Set the "buffered" flag
        RET                             ;  And return

BUFO1   RES     F.BUF,(HL)              ;  Reset the "buffered" flag
        RET                             ;  And return

BUFO0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  INTERACTIVEINPUT
;  ----------------
;
;    interactiveinput( bool )


        ALIGN

INTI    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      E,(IY-24)               ;  Low byte of CIS
        LD      D,(IY-23)               ;  High byte of CIS

        LD      A,D                     ;  High byte of scb
        OR      E                       ;  Is there an scb ?
        JP      Z,INTI0                 ;  No, so error

        EX      DE,HL                   ;  Swap argument and scb
        LD      A,D                     ;  High byte of argument
        OR      E                       ;  Is the argument FALSE ?
        JP      Z,INTI1                 ;  Yes, so reset the flag

        SET     F.INT,(HL)              ;  Set the "interactive" flag
        RET                             ;  And return

INTI1   RES     F.INT,(HL)              ;  Reset the "interactive" flag
        RET                             ;  And return

INTI0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  INTERACTIVEOUTPUT
;  -----------------
;
;    interactiveoutput( bool )


        ALIGN

INTO    PUSH    HL                      ;  Save return address
        EXX                             ;  Get argument register set
        LD      E,(IY-22)               ;  Low byte of COS
        LD      D,(IY-21)               ;  High byte of COS

        LD      A,D                     ;  High byte of scb
        OR      E                       ;  Is there an scb ?
        JP      Z,INTO0                 ;  No, so error

        EX      DE,HL                   ;  Swap argument and scb
        LD      A,D                     ;  High byte of argument
        OR      E                       ;  Is the argument FALSE ?
        JP      Z,INTO1                 ;  Yes, so reset the flag

        SET     F.INT,(HL)              ;  Set the "interactive" flag
        RET                             ;  And return

INTO1   RES     F.INT,(HL)              ;  Reset the "interactive" flag
        RET                             ;  And return

INTO0   ERRTRAP                         ;  Enter the debugger
        RET                             ;  And return
        LAYOUT
;  TESTBREAK
;  ---------
;
;      bool  :=  testbreak( scb )


        ALIGN

TSTB    PUSH    HL                      ;  Save return link
        EXX                             ;  Get argument register set
        
        LD      A,H                     ;  Have we been given an SCB
        OR      L                       ;  Sets Z flag if not
        JP      Z,TSTB0                 ;  Oh dear - no SCB

        BIT     F.BRK,(HL)              ;  Check the BREAK bit
        RES     F.BRK,(HL)              ;  Clear the BREAK bit

;  When we arrive here, the Z flag represents the inversion of the BREAK
;  state.  We have to turn this bit into a BCPL boolean value.  We know 
;  that the 'C' flag is zero, because of the OR above ...

        JP      Z,TSTB1                 ;  Bit not set, so don't set carry
        SCF                             ;  Set carry flag otherwise

TSTB1   SBC     HL,HL                   ;  Set HL to TRUE or FALSE
        RET                             ;  And return

TSTB0   ERRTRAP                         ;  Error state
        RET                             ;  And return
        LAYOUT
;  FIND
;  ----
;
;    Internal routine called from "findinput" and "findoutput".  The arguments
;    on entry are:
;
;        HL     Pointer to IOLIST
;        DE     Pointer to open name
;
;    On return, the result in HL is a pointer to the handlers for the name
;    given, or zero on failure.


FIND    LD      C,(HL)                  ;  Low byte of string pointer
        INC     HL                      ;  Increment list pointer
        LD      B,(HL)                  ;  High byte of string pointer
        INC     HL                      ;  Increment list pointer

        LD      A,B                     ;  High byte of entry
        OR      C                       ;  End of the list ?
        JP      NZ,FIND0                ;  No, so compare strings

        LD      HL,0                    ;  Set zero result
        RET                             ;  And return

;  If we come here, then we must examine this entry.  DE points to the name
;  given to us by the user, and BC points to the name in the IOLIST.  Call
;  COMPARE to see if the names match.

FIND0   CALL    COMPARE                 ;  Compare the names
        RET     Z                       ;  Return if equal compare

        INC     HL                      ;  + 1
        INC     HL                      ;  + 2
        INC     HL                      ;  + 3
        INC     HL                      ;  + 4
        JP      FIND                    ;  Go round again
        LAYOUT
;  COMPARE
;  -------
;
;    Compare the two strings pointed to by DE and BC, and return with the
;    Z flag set if the strings compare positively.  The strings must either
;    match exactly.


COMPARE LD      A,(BC)                  ;  Load the IOLIST length
        OR      A                       ;  Is it zero ?
        RET     Z                       ;  Null string matches everything

        EX      DE,HL                   ;  Get user name in HL
        CP      (HL)                    ;  Compare with given length
        JP      Z,COMP0                 ;  Equal, so straight comparison

;  If we drop through here, the IOLIST entry is longer than the one given,
;  and so the strings cannot match at all.  Return an error result.

        EX      DE,HL                   ;  Get user name back in DE
        RET                             ;  Z flag is already reset

;  If we come here, then the strings are of equal length, and so we should
;  do a straight comparison of the strings.

COMP0   PUSH    HL                      ;  Save pointer to user string

COMP1   INC     HL                      ;  Increment user pointer
        INC     BC                      ;  Increment IOLIST pointer
        PUSH    AF                      ;  Save character count

        OR      A                       ;  End of strings ?
        JP      Z,COMP2                 ;  Yes, so return

        LD      A,(BC)                  ;  Load IOLIST character
        CP      (HL)                    ;  Are they equal ?
        JP      NZ,COMP2                ;  No, so return

        POP     AF                      ;  Restore character count
        DEC     A                       ;  Decrement count
        JP      COMP1                   ;  And continue comparing

;  When we come here, we have finished comparing.  The Z flag is already
;  set up for the correct result.

COMP2   POP     HL                      ;  Restore character count
        POP     HL                      ;  Restore user pointer
        EX      DE,HL                   ;  And put it back in DE
        RET                             ;  Return
        LAYOUT
;  CALLBC
;  ------
;
;     Provide the function of a "CALL (BC)" instruction.

CALLBC  PUSH    BC                      ;  Save entry point on stack
        RET                             ;  And enter routine
        LAYOUT
        ALIGN

        DEFW    0                       ;  End of global list
        DEFW    G.RDCH,RDCH             ;  Entry of RDCH
        DEFW    G.UNRD,UNRD             ;  Entry of UNRDCH
        DEFW    G.WRCH,WRCH             ;  Entry of WRCH
        DEFW    G.FNDI,FNDI             ;  Entry of FINDINPUT
        DEFW    G.FNDO,FNDO             ;  Entry of FINDOUTPUT
        DEFW    G.SELI,SELI             ;  Entry of SELECTINPUT
        DEFW    G.SELO,SELO             ;  Entry of SELECTOUTPUT
        DEFW    G.ENDR,ENDR             ;  Entry of ENDREAD
        DEFW    G.ENDW,ENDW             ;  Entry of ENDWRITE
        DEFW    G.INPT,INPT             ;  Entry of INPUT
        DEFW    G.OUPT,OUPT             ;  Entry of OUTPUT
        DEFW    G.BUFI,BUFI             ;  Entry of BUFFEREDINPUT
        DEFW    G.BUFO,BUFO             ;  Entry of BUFFEREDOUTPUT
        DEFW    G.INTI,INTI             ;  Entry of INTERACTIVEINPUT
        DEFW    G.INTO,INTO             ;  Entry of INTERACTIVEOUTPUT
        DEFW    G.TSTB,TSTB             ;  Entry of TESTBREAK
        DEFW    G.ENDS,ENDS             ;  Entry of ENDSTREAM
        DEFW    G.MAXG                  ;  HRG
        LAYOUT
BCPLIOE END


