( FILE: 7OSI2 - works with MSDOS 3.3 - but based on original CP/M
      8 July 88 -- MFB )

( *** See below about argument on stack when 7OSI LOADed *** )

(
The programs in this file provide the interface between
4th/86 and the io system on which 4th/86 is running. A summary of
user callable programs follows:

ADDFCBS    - add file blocks. TOS = size, addr
OPEN       - open file. TOS = access type, filename addr
CLOSE      - close file. TOS = file block addr or 0 for all
READ       - read file. TOS = file block, buffer, count
WRITE      - write file. TOS = file block, buffer, count
INITIO     - initialize io interface
QUIT       - return to operating system monitor
GETCHR     - read console for character
GETLIN     - read console for line
GETSTS     - check console for character
GETCLI     - read command line tail
PUTCHR     - character to console
PUTLIN     - line to console

File accesses are managed in file blocks.  These are controlled
by 7OSI.  When a file is opened, it is dynamically assigned
a file block.  When the file is closed, the file block is
released to be used in accessing other files.  When INITIO
is executed, four file blocks are set up for system/user use.
The number of available blocks can be increased via 
ADDFCBS. The constant FCBSIZE is the size needed for a file
block.  A file block looks like:

Displacement    Description
  0             0 -> block is free; 1 -> open for read
                2 -> open for write
  1             Address of next file block or 0 for last
  3             Buffer pointer ( 0 to RECSIZE)
  5             Operating system file block
  RECOFS        Physical record buffer ( RECSIZE bytes)
  FCBSIZE       One byte past file block

Note that although the words in 7OSI provide limited
sequential file IO,  after a file has been opened,  direct
access to the o.s. fcb ( file block +5) can be used for 
additional functions.

When 7OSI is loaded, the TOS should contain 0 for
"non-interlocked" IO or non 0 for inter-locked IO.  The
value is removed from the stack when 7OSI is loaded.

Use non-interlocked in single task systems (or in muti-task
systems where only one task makes IO calls).  Use interlocked
in systems where different tasks can make IO calls
asynchronously.

Note that interlocked IO is for CP/M 2.0 or later.


****** CP/M Notes: *******
 The byte at file block + 5 is the disk for the file.
 The FCB passed to BDOS starts at FCB + 6.
 The first byte of the CPM FCB contains either drive code
 (A=1,B=2,...) or 0 (default). The byte at +5 contains
 drive code (A=0,B=1,...) obtained from filename or from
 location 4 (default).
)

(
***********************************************************
*                                                         *
*                 Constants and variables                 *
*                                                         *
***********************************************************
)

1 ( flag) 2 ( link) 2 ( pointer) 1 ( disk) 36 ( cpm fcb)
+ + + + CONST RECOFS ( offset to physical record buffer)

4 CONST NUMFCBS

128 CONST RECSIZE

'' RECOFS '' RECSIZE + CONST FCBSIZE

'' FCBSIZE '' NUMFCBS * BLOCK SYSFCB ( NUMFCBS system file blocks)

( ***** Note. If the number of fcbs in SYSFCB is
  changed here, then be sure to make change in INITIO.)
   
11 BLOCK %DTMP

( %DTMP is used by read and write as follows:
  %DTMP + 0: FCB address
        + 2: Callers data buffer address
        + 4: No. bytes to read or write
        + 6: Actual no. read
        + 8: Error status
        +10: 0 = read, 1 = write
)

(
***********************************************************
*                                                         *
*                  Supporting words                       *
*                                                         *
***********************************************************
)

( MON1 and MON2 - CP/M BDOS interface)

CODE MON2 ( CALL BDOS TOS=FUNCTION, NOS=DATA)
H POP, D POP, B PUSH, C L MOV, 5 CALL,
H 0 MVI, ( MFB) L A MOV, ( HL=RETURNED VALUE) B POP, ;PUSH

CODE MON1 ( LIKE MON2 BUT WITHOUT RETURNED VALUE)
H POP, D POP, B PUSH, C L MOV, 5 CALL, ( MFB) H 0 LXI, B POP, ;

( %UPC - validate filename char and convert it to up case)
( return 0 if invalid)

: %UPC
  DUP 33 < OVER "?" = OR OVER 122 > OR IF ( illegal char)
    DROP 0
  THEN
  DUP 95 > IF ( lower case)
    32 - ( convert to upper)
  THEN ;


: %PFNERR  ( PARSE FILE NAME ERROR )
  DROP 0 6 POKE ;

: PFN  ( PARSE FILE NAME INTO FILE CONTROL BLOCK )
  ( initialize cpm fcb)
  4 B@ 15 AND OVER B!  ( DEFAULT DISK NUMBER )
  0 OVER 1+ B! 
  32 11 3 PICK 2+ FILL  ( BLANK FILE NAME AND EXTENSION )
  0 21 3 PICK 13 + FILL  ( ZERO REMAINDER OF FCB )
  1 0 0 0 6 PICK DUPB@ SWAP 1+  
  ( STACK=STR-ADR,FCB-ADR,LEGAL,PER-FOUND,XTNSION-CNT
    ,NAME-CNT,STR-CNT,STR-PTR )
  OVER 1 > IF  ( STRING HAS 2 OR MORE CHARS )
    DUP 1+ B@ 58 = IF  ( 2ND CHAR IS A :, IE 1ST CHAR IS
    DISK )
      DUPB@ %UPC DUP "A" >= OVER "Q" < AND IF ( DISK IS LEGAL )
        "A" - 8 PICK OVER OVER B!
        SWAP 1+ SWAP 1+ B! ( DISK INTO FCB )
        SWAP 2 -  ( STR-CNT=STR-CNT-2 )
        SWAP 2+  ( STR-PTR=STR-PTR+2 )
      ELSE  ( DISK IS NOT LEGAL ) 
        %PFNERR  ( INDICATE NOT LEGAL )
      THEN
    THEN
  THEN
  BEGIN
  OVER 0> 7 PICK AND IF  ( STR-CNT>0 AND LEGAL )
    DUPB@ %UPC DUP  ( TWO COPIES OF CURRENT CHAR )
    7 PICK IF  ( XTENSION IS BEING PROCESSED )
      IF  ( CUR CHAR IS ALPHANUMERIC )
        5 PICK DUP 2 > IF  ( XTENSION IS TOO LONG )
          %PFNERR  ( INDICATE NOT LEGAL )
        ELSE ( XTENSION IS NOT TOO LONG )
          1+ DUP 6 POKE  ( XTENSION-CNT=XTENSION-CNT+1 )
          9 PICK + 9 + B!  ( ADD CHAR TO THE XTENSION )
        THEN
      ELSE  ( CUR CHAR IS NOT ALPHANUMERIC )
        %PFNERR  ( INDICATE NOT LEGAL )
      THEN
    ELSE  ( FILE NAME IS BEING PROCESSED )
      "." = IF  ( PERIOD FOUND, IE END OF FILE NAME )
        DROP 1 5 POKE  ( INDICATE PERIOD FOUND )
      ELSE  ( NOT PERIOD. PROCESS FILE NAME CHAR )
        4 PICK DUP 7 > IF  ( FILE NAME IS TOO LONG )
          DROP %PFNERR  ( INDICATE NOT LEGAL )
        ELSE  ( FILE NAME IS NOT TOO LONG )
          1+ DUP 5 POKE  ( NAME-CNT=NAME-CNT+1 )
          9 PICK + 1+ B!  ( ADD CHAR TO FILE NAME )
        THEN
      THEN
    THEN
    SWAP 1 - SWAP  ( STR-CNT=STR-CNT-1 )
    1+  ( STR-PTR=STR-PTR+1 )
    0  ( CONTINUE LOOPING )
  ELSE  ( STR-CNT=0 OR NOT LEGAL )
    5 KILL  ( STACK REDUCED TO LEGAL ) IF ( LEGAL)
      DROP DROP 0 ( SUCCESS FLAG)
    ELSE
      DROP DROP 1 ( ERR FLAG)
    THEN
    1  ( STOP LOOPING )
  THEN
  END  ;

( Multitask interlocking)

DUP IFTRUE  ( if m.t. interlocking desired)

5 BLOCK IOFLAG   ( interlock semaphore)

: LOCKIO
(  IOFLAG WAIT  ) ( wait for current io done) ;
 
: UNLOCKIO
(  IOFLAG SIGNAL ) ( signal our io complete) ; 

OTHERWISE ( no interlock case)

: LOCKIO ; ( dummies)

: UNLOCKIO ;

ENDIF ( end of conditional compile of IOFLAG LOCKIO UNLOCKIO )

  
( %DIOSET - select disk, set dma for pending disk op, and
            return cpm fcb addr.  TOS = DMA addr,
            NOS = file block addr)

: %DIOSET ( fblkadr dmaadr -- cpmfcbadr)
  26 MON1 ( set dma) 6 + ;

( %IBUFS - add file blocks. On entry, TOS = size of a
           memory block and NOS is its addr.
           %IBUFS creates linked file blocks within
           this memory. The last one has a link of 0.
           This is used by ADDFCBS and by INITIO.
           Note: there must be room for at least one block.)

: %IBUFS
  BEGIN
    FCBSIZE - DUP FCBSIZE >= IF ( room for more after this one)
      OVER FCBSIZE + ( link to next)
    ELSE
      0 ( link terminator)
    THEN
    3 PICK 1+ ! ( store link)
    SWAP 0 OVER B! ( mark block as free)
    FCBSIZE + ( addr to next) SWAP
    DUP FCBSIZE < ( exit if not room for another)
  END
  DROP DROP ;


(
********************************************************
*                                                      *
*                     ADDFCBS                          *
*                                                      *
********************************************************

Entry:   TOS = size of memory for new buffers.
         NOS = address of memory for new buffers.

Exit:    Input parameters have been removed from stack.
)

: ADDFCBS
  LOCKIO
  DUP FCBSIZE >= IF ( room for at least one)
    OVER SYSFCB
    BEGIN ( link old fcbs to new)
      1+ DUP@ DUP IF ( not last)
        SWAP DROP 0 ( continue)
      ELSE
        DROP ! ( link to new fcbs)
        1 ( exit)
      THEN
    END
    %IBUFS ( install new buffers)
  ELSE ( buffer space too small)
    DROP DROP ( drop inputs)
  THEN
  UNLOCKIO
;


(
********************************************************
*                                                      *
*                     OPEN file                        *
*                                                      *
********************************************************

Entry:  TOS = access type ( 1 for read, 2 for write)
        NOS = address of filename

Exit:   Input parameters are dropped and
        TOS = Error code
        NOS = address of file block ( or 0 if error)

Error codes:    0 - No error
                1 - File not found ( read files only)
                2 - No space ( write files only)
                3 - No file blocks available 
                4 - File is write protected ( write file only)
                5 - Bad access code ( not 1 or 2)
                6 - Bad file name
)

: OPEN
  LOCKIO ( interlock)
  DUP 2 = OVER 1 = OR IF ( valid access type)
    SYSFCB ( first file block in list)
    BEGIN ( find a free file block, then open file)
      DUPB@ IF ( not free)
        1+ @ ( link) DUP IF ( another possibility)
          0 ( continue loop flag)
        ELSE ( no available file blocks)
          3 KILL 0 3 ( no file blocks error)
          1 ( exit loop flag)
        THEN
      ELSE ( found an unused file block)
        SWAP OVER B! ( mark as used with access code)
        0 OVER 3 + ! ( init buffer pointer)
        SWAP OVER 5 + PFN IF ( filename error)
          0 SWAP B! ( free fcb) 0 6  ( exit with error)
        ELSE ( filename OK)
          DUP 80H %DIOSET 15 MON2 ( open) 255 = IF ( not found)
            DUPB@ 1 = IF ( access = read)
              0 SWAP B! ( release file block)
              0 1  ( exit loop with not found error)
            ELSE ( access = write)
              ( make file)
              DUP 80H %DIOSET 22 MON2 255 = IF ( no room)
                0 SWAP B! ( release file block)
                0 2  ( exit with no space error)
              ELSE ( successful make file)
                0  ( exit with no error)
              THEN
            THEN
          ELSE ( file found)
            DUPB@ 1 = IF ( access = read)
              0  ( exit with no error)
            ELSE ( access = write and file exists)
              DUP 15 + B@ 80H AND IF ( file read/only)
                0 SWAP B! ( release file block)
                0 4  ( exit with write prot. err)
              ELSE
                DUP 80H %DIOSET 19 MON1 ( delete file)
                DUP 80H %DIOSET 22 MON1 ( make file)
                0  ( exit with no error)
              THEN
            THEN
          THEN
        THEN
        1 ( exit begin...end)
      THEN
    END
  ELSE ( access code error)
    DROP DROP 0 5 ( return err result)
  THEN
  UNLOCKIO
;


(
********************************************************
*                                                      *
*                  CLOSE file(s)                       *
*                                                      *
********************************************************

Entry:   TOS = address of file block or 0 to close all

Exit:    Input parameter is removed and
         TOS = 0 if no error or address of last file
               block that an error occurred on during
               CLOSE ( note that file(s) are considered
               closed regardless of errors).
)

: %CLOSE  ( close 1 file, TOS = fcb addr)
  0 SWAP ( result is NOS)
  DUPB@ 2 = IF ( file was opened for write)
    DUP 3 + @ IF ( any bytes in buffer)
      1AH OVER 3 + @ RECSIZE OVER - SWAP RECOFS +
      4 PICK + FILL ( fill with ctrl-z's)
      DUP DUP RECOFS + %DIOSET 21 MON2 ( write) IF ( error)
        SWAP DROP DUP ( NOS is error indicator)
      THEN
    THEN
    DUP 80H %DIOSET 16 MON2 ( close) 255 = IF ( error)
      SWAP DROP DUP ( set error)
    THEN
  THEN
  0 SWAP B! ( file block released)
  ( TOS is zero if no err)
;


: CLOSE ( close 1 or all)
  LOCKIO DUP IF ( only one to close)
    %CLOSE
  ELSE ( close all)
    ( 0 on TOS can be error accum)
    SYSFCB ( first file block in list)
    BEGIN ( loop to close all)
      DUP %CLOSE DUP IF ( error on this file)
        2 POKE ( set err) DUP ( for drop)
      THEN
      DROP
      1+ @ DUP 0= ( loop if another fcb)
    END
    DROP
  THEN
  UNLOCKIO
;

(
********************************************************
*                                                      *
*          Supporting words for READ and WRITE         *
*                                                      *
********************************************************
)

( %DIO# - asm lang subroutine for read or write. On
  entry: C is 20 for read or 21 for write. HL is
  dma addr. %DTMP is set up properly. On exit: Read
  or write has been performed and A is result status)


CODE %DIO# ( asm lang disk setup)
  B PUSH, ( save function)
  XCHG, C 26 MVI, 5 CALL, ( set dma)
  '' %DTMP LHLD, D 6 LXI, D DAD, XCHG, ( addr of cpm fcb)
  B POP, ( r/w function) 5 JMP, ( ret thru bdos) ;NOTHREAD ASM

( %RWCOM ( read/write common) Does read or write work.
  Entry: TOS = 0 for read or 1 for write. Next 3 stack
  entries are like input to READ or WRITE ( see below).
  Exit: ( if read) TOS = error code and NOS = no. read
        ( if write) TOS = error code.)

: %RWCOM
  LOCKIO :EXIT ( asm lang for speed)
  H POP, A L MOV, '' %DTMP 10 + STA, ( 0=read, 1=write)
  H POP, '' %DTMP SHLD, XCHG, ( de=fcb adr)
  ( H POP, ) '' %DTMP 2+ popw, ( SHLD,)
  ( H POP, ) '' %DTMP 4 + popw, ( SHLD,)
  B PUSH, ( save 4th pc)
  H 0 LXI, '' %DTMP 6 + SHLD, '' %DTMP 8 + SHLD,
  XCHG, ( hl=fcb adr)
  A INR, M CMP, IFNZ  ( file modes don't match)
    H 3 LXI, '' %DTMP 8 + SHLD, ( exit with error 3)
  ELSE ( properly opened file)
    H INX, H INX, H INX, 
    ( E M MOV, H INX, D M MOV, ( buf ptr)) mov-de[hl], h inx,
    A D MOV, E ORA, IFNZ ( any bytes in buffer)
      H '' RECSIZE LXI, A L MOV, E SUB, C A MOV,
      A H MOV, D SBB, B A MOV, ( bc = recsize - buf ptr)
      '' %DTMP 4 + LHLD, ( count) A L MOV, C SUB,
      A H MOV, B SBB, IFC ( no. bytes in buf > count)
        C L MOV, B H MOV,
      THEN
      ( now bc = no. bytes to move)
      H '' %DTMP 4 + LXI, A M MOV, C SUB, M A MOV,
      H INX, A M MOV, B SBB, M A MOV, ( count updated)
      H INX, 
      ( M C MOV, H INX, M B MOV, ( actual updated)) mov-[hl]bc, h inx,
      L E MOV, H D MOV, B DAD, D PUSH, XCHG,
      H 0 '' RECSIZE - LXI, D DAD, IFC
        XCHG, ( de=0 cause all of buffer to be used)
      THEN
      '' %DTMP LHLD, H INX, H INX, H INX,
      ( M E MOV, H INX, M D MOV, ( buffer pointer updated)) 
      mov-[hl]de, h inx,
      XCHG, DI, XTHL, EI, ( mfb) D DAD, ( save upd., add cur)
      D '' RECOFS 4 - LXI, D DAD,
      ( hl is current buffer addr)
      XCHG, '' %DTMP 2+ LHLD, ( hl is user buffer)
      '' %DTMP 10 + LDA, A ORA, IFZ ( if read)
        XCHG, ' MOVE# CALL, ( move to user)
        XCHG, ( hl = new data addr) D POP, ( dump)
      ELSE ( write call)
        ' MOVE# CALL, ( move to record buffer)
        DI, XTHL, EI, ( mfb) A L MOV, H ORA, IFZ ( complete record ready)
          ( note that de must be at buffer + recsize)
          H 0 '' RECSIZE - LXI, D DAD, C 21 MVI,
          ' %DIO# CALL, ( write) A ORA, IFNZ ( error)
            H 0 LXI, '' %DTMP 4 + SHLD, ( count=0)
            H 2 LXI, '' %DTMP 8 + SHLD, ( error=2)
          THEN
        THEN
        H POP, ( user's addr)
      THEN
      '' %DTMP 2+ SHLD, ( user addr updated)
    THEN

  ( now read as many full records as possible)

    BEGIN ( while count >= recsize)
      '' %DTMP 4 + LHLD, ( count)
      D 0 '' RECSIZE - LXI, ( de = -recsize)
      D DAD, IFC ( count >= recsize)
        '' %DTMP 2+ LHLD, ( dma addr)
        '' %DTMP 10 + LDA, 20 ADI, C A MOV, ( rd or write)
        ' %DIO# CALL, A ORA, IFNZ ( end of file or err)
          H 0 LXI, '' %DTMP 4 + SHLD, ( count=0)
          '' %DTMP 10 + LDA, A ORA, IFNZ ( this is write)
            H 2 LXI, '' %DTMP 8 + SHLD, ( full error)
          THEN
          ( note, loop will be exited since cy = 0)
        ELSE ( not eof)
          H '' %DTMP 2+ LXI, D '' RECSIZE LXI,
( trubl)
          ( A M MOV, E ADD, M A MOV, H INX,
          A M MOV, D ADC, M A MOV, H INX, ( user addr updated))
	add-[bx]de, h inx, h inx,
          ( A M MOV, E SUB, M A MOV, H INX,
          A M MOV, D SBB, M A MOV, H INX, ( count updated))
	sub-[bx]de, h inx, h inx,
          ( A M MOV, E ADD, M A MOV, H INX,
          A M MOV, D ADC, M A MOV, ( actual updated))
	add-[bx]de, h inx, h inx,
          STC, ( continue loop flag)
        THEN
      THEN
    ENDNC

    ( buffer any partial record)

    '' %DTMP 4 + LHLD, ( count)
    A H MOV, L ORA, IFNZ ( count <> 0)
      H PUSH, ( save count)
      '' %DTMP LHLD, ( fcb) D '' RECOFS LXI,
      D DAD, ( hl = record buffer addr)
      '' %DTMP 10 + LDA, A ORA, IFZ ( read)
        C 20 MVI, ' %DIO# CALL, ( read rec to buffer)
        B POP, ( count) 
          ( MMFB A ORA, IFZ ( not eof) )
         1 CPI, IFNZ ( MMFB)
          '' %DTMP 6 + LHLD, B DAD,
          '' %DTMP 6 + SHLD, ( actual updated)
          '' %DTMP LHLD, H INX, H INX, H INX,
          M C MOV, H INX, M B MOV, ( buffer pointer updated)
          D '' RECOFS 4 - LXI, D DAD, ( source addr)
          XCHG, '' %DTMP 2+ LHLD, ( dest) XCHG,
          ' MOVE# CALL,
        THEN
      ELSE ( write call)
        B POP, B PUSH, ( count)
        XCHG, '' %DTMP 2+ LHLD, ( data adr)
        ' MOVE# CALL, B POP,
        '' %DTMP LHLD, H INX, H INX, H INX,
        M C MOV, H INX, M B MOV, ( buffer pointer updated)
      THEN
    THEN
  THEN

  ( fix up result and exit)

  B POP, ( 4th pc)
  '' %DTMP 10 + LDA, A ORA, IFZ ( read call)
    '' %DTMP 6 + LHLD, H PUSH, ( actual no. read)
  THEN
  '' %DTMP 8 + LHLD, H PUSH, ( error status)
  :ENTER UNLOCKIO ;

(
********************************************************
*                                                      *
*                     READ file                        *
*                                                      *
********************************************************

Entry:  TOS = address of file block of file open for input
        NOS = address of buffer for read data
        3OS = max number of bytes to read

Exit:   Input parameters removed from stack and
        TOS = error code or 0 for no error
        NOS = number of bytes actually read

Error codes:   0  -  no error
               1  -  read error
               2  -  not used
               3  -  file not open or not open for input

***** error 1 not used in CP/M
)

: READ
  0 %RWCOM ; ( read call to rwcom)


(
********************************************************
*                                                      *
*                    WRITE to file                     *
*                                                      *
********************************************************

Entry:   TOS = address of file block
         NOS = address of data to write
         3OS = number of bytes to write

Exit:    Input parameters removed from stack and
         TOS = 0 for no error, otherwise error code

Error Codes:   0 - No error
               1 - Write error
               2 - No space available
               3 - File block not opened for output

***** Note: for CP/M, only errors 2 and 3 are returned.
*****       Write, select, and write protected errors are
*****       trapped by BDOS.

)

: WRITE
  1 %RWCOM ( write call to %rwcom) ;


DUP 0= IFTRUE ( big chunck for single task io systems)

(
*********************************************************
*                                                       *
*                    Console Input                      *
*                 for single task IO                    *
*           GETCHR, GETLIN, GETSTS and GETCLI           *
*                                                       *
*********************************************************
)

( note that the dummies LOCKIO and UNLOCKIO are referenced
  for consistency )

( GETCHR returns next character entered from console on TOS)

: GETCHR
  LOCKIO
  0 1 MON2 UNLOCKIO ; ( get char from CPM)

( GETLIN gets a line from system, using system line edit
  facilities. On entry, TOS is address of a line buffer
  and first byte of buffer is max input length.  On exit,
  addr is removed from stack and second byte of the buffer
  contains number of chars read.  The rest of buffer contains
  the string with out a terminator.
  Max of 255 chars can be requested.
)

: GETLIN
  DUPB@ IF ( max is > 0)
     LOCKIO 10 MON1 UNLOCKIO
  ELSE ( max=0)
     0 SWAP 1+ B! ( return null string)
  THEN ;


( GETSTS returns 0 if no chars are available at console,
  otherwise 1 if console char is ready.

)

: GETSTS
  LOCKIO 0 11 MON2 UNLOCKIO ;

( GETCLI returns tail of command line in o.s. that
  invoked 4th/86 ( up to 127 chars ).  On entry,
  TOS is address of 128 byte buffer.  On exit, addr is
  removed and buffer contains string ( 1st byte is length).
  A terminator character is not included.
)
 
: GETCLI
  80H SWAP OVER B@ 127 AND 1+ MOVE ;

(
**********************************************************
*                                                        *
*                    Console output                      *
*                  for single task IO                    *
*                   PUTCHR & PUTLIN                      *
*                                                        *
**********************************************************
)

( PUTCHR outputs char on TOS to console )

: PUTCHR
  LOCKIO 2 MON1 UNLOCKIO ;

( PUTLIN outputs string addressed by TOS to console)

: PUTLIN
  DUPB@ ( counter) DUP IF ( not null string)
    BEGIN 
      1 - SWAP ( dec count) 1+ ( inc pointer)
      DUPB@ PUTCHR ( char out)
      SWAP DUP 0= ( test for done)
    END
  THEN
  DROP DROP ;


OTHERWISE  ( big chunk for m.t. io systems)


(
************************************************************
*                                                          *
*                 Console Input and Output                 *
*                 for multi-tasks using IO                 *
*                                                          *
************************************************************

The entry points in this code work just like the single task
IO entry points with the following exceptions:

    Only ctrl-p, ctrl-8, rubout, and ctrl-x supported for
      line editing.
    Rubout works like ctrl-h (backspace instead of echo)
    Ctrl-c not seen by CP/M BDOS
    Tabs are never expanded

These words work effectively when one or more of the following
is true:

    Keyboard task is lowest priority and other tasks execute
      in small increments between WAITs.
    BIOS keyboard handler is interrupt driven and the input
      is buffered.

For uncompromising m.t. terminal handler, implement the
following (or similar) words:


() 66 BLOCK KEYBUF ( circular buffer, 1st byte inptr, next outptr)
() 5 BLOCK KEYFLAG ( semaphore)
() CODE KEYINT#  ( keyboard int., save char in circle buffer)
()  ' SAVE# CALL,
()  ' KBPORT IN, 7FH ANI, C A MOV, ( input char in C)
()  H '' KEYBUF LXI, A M MOV, ( inptr)
()  A INR, 3FH ANI, H INX, M CMP, IFNZ ( circle buf not full)
()    H DCX, M A MOV, ( new inptr)
()    L ADD, L A MOV, IFC H INR, THEN H INX, H INX,
()     ( hl -> into buf)
()     M C MOV, ( buffer char)
()     H '' KEYFLAG LXI, ' ISIGNAL# CALL ( signal task)
()   THEN
()   ' DISPATCH# JMP, ( exit int) ;NOTHREAD
() 
() CODE DEQUE ( remove next char from circle buffer)
()   DI, H '' KEYBUF 1+ LXI, A M MOV,
()   A INR, 3FH ANI, M A MOV, A DCR, 3FH ANI,
()   L ADD, L A MOV, IFC H INR, THEN H INX,
()   L M MOV, ( char) H 0 MVI, EI, ( mfb) ;PUSH
() 
() CODE INITKEYINT  ( called from INITIO or equiv)
()   DI, :ENTER
()   0 KEYFLAG INITCV  ( init counting semaphore)
()   ( ... )  ( set up interrupt vector to KEYINT#: sys dependent)
()   :EXIT EI, ( mfb) ;
()
() in glgc:
()   DROP LOCKIO FFH 6 MON2 UNLOCKIO DUP 
() is replaced with:
()   KEYFLAG WAIT DEQUE
() 
() in getsts:
()   FFH 6 LOCKIO MON2 UNLOCKIO 1CBUF B!
() is replaced with:
()   KEYFLAG @ 0> IF ( signaled)
()     KEYFLAG WAIT DEQUE
()   ELSE
()     0
()   THEN
()  1CBUF B!

)

 
: GETCLI ( THIS WORD IS SAME AS S.T.)
  80H SWAP OVER B@ 127 AND 1+ MOVE ;

1 BLOCK CTRLPFLAG
1 BLOCK 1CBUF ( one character buffer)

: GLGC ( get char without echo used by getlinep and getchrp)
        ( return tos = next character input from console)
  1CBUF B@ 0 1CBUF B! DUP 0= IF ( nothing in one char buffer)
    BEGIN ( loop until character obtained)
      DROP LOCKIO FFH 6 MON2 UNLOCKIO DUP 
    END 
  THEN ;


: GETSTS
  1CBUF B@ 0= IF ( no char in one char buffer)
    FFH 6 LOCKIO MON2 UNLOCKIO 1CBUF B! ( get stat from BDOS)
  THEN
  1CBUF B@ DUP IF
    13H = IF ( ctrl s?)
      0 1CBUF B! GLGC DUP 13H = IF
        DROP 0
      ELSE
        1CBUF B! 1
      THEN
    ELSE
      1
    THEN
  THEN ;

2 BLOCK COLCNT

: PC1
  CTRLPFLAG B@ IF ( list console flag set)
    DUP 5 LOCKIO MON1 UNLOCKIO ( list char)
  THEN
  1 COLCNT +! 6 LOCKIO MON1 UNLOCKIO ;

: PUTCHR
  GETSTS IF  ( handle ctrl-esses)
    1CBUF B@ 13H = IF
      0 1CBUF B!  BEGIN GETSTS END
      1CBUF B@ 13H = IF  0 1CBUF B!  THEN
    THEN
  THEN
  DUP 9 = IF ( tab)
    DROP 7 COLCNT @ 7 AND DO 32 PC1 LOOP
  ELSE
    DUP PC1 13 = IF 0 COLCNT ! THEN
  THEN ;

: PUTLIN
  DUPB@ ( counter) DUP IF ( not null string)
    BEGIN 
      1 - SWAP ( dec count) 1+ ( inc pointer)
      DUPB@ PUTCHR ( char out)
      SWAP DUP 0= ( test for done)
    END
  THEN
  DROP DROP ;


: GETCHR
  GLGC DUP PUTCHR ;  

: BKSP ( USED BY GETLIN)
  DUP IF ( ANY CHARS IN BUFFER)
    " \8\\32\\8\" PUTLIN
    OVER B@ 32 < IF ( CONTROL CHARACTER)
      " \8\\32\\8\" PUTLIN
    THEN
    1- SWAP 1- SWAP
  THEN ;

: GETLIN ( INPUT LINE, TOS: BUFFER ADDR)
  DUPB@ SWAP 1+ SWAP
  OVER 0 ( TS: CURCNT,CURBUFPTR,MAXCNT,BUFADR)
  BEGIN
    GLGC DUP 13 = IF ( CR OR LF)
      PUTCHR 4 PICK B! 3 KILL 1 ( EXIT LOOP)
    ELSE
      DUP 8 = OVER 127 = OR IF ( BKSPC OR DEL)
        DROP BKSP 0 ( CONTINUE LOOP)
      ELSE
        DUP 24 = IF ( LINE DELETE)
          DROP BEGIN
            BKSP DUP 0=
          END
          0 ( CONTINUE LOOP)
        ELSE
          DUP 10H = IF ( ctrl-p)
            DROP CTRLPFLAG B@ 0= CTRLPFLAG B! ( toggle flag)
            0 ( continue loop)
          ELSE ( OTHER CHARACTER)
            OVER 5 PICK < IF ( ROOM FOR CHAR)
              DUP 4 PICK 1+ B! ( PUT IN BUFFER)
              DUP 32 < IF ( CTRL CHAR)
                5EH PUTCHR 64 +
              THEN
              PUTCHR 1+ SWAP 1+ SWAP ( FIX PTR & CNT)
            ELSE
              DROP ( DROP CHAR)
            THEN
            0 ( CONTINUE LOOP)
          THEN
        THEN
      THEN
    THEN
  END ;

ENDIF ( end of cond compile for sing/mult task io)


(
**********************************************************
*                                                        *
*                      INITIO                            *
*                                                        *
**********************************************************

INITIO has no input or output.  It must be executed once
only before the system io words are used.
)

DUP ( of m.t. interlock flag on tos)

: INITIO
  SYSFCB FCBSIZE NUMFCBS * %IBUFS ( initialize file blocks)
  IFTRUE ( compile next lines only if m.t. interlock)
(    1 IOFLAG INITCV  ( init IO interlock semaphore))
    0 1CBUF B! ( clear 1 character buffer)
    0 CTRLPFLAG B! ( clear list console output flag)
    0 COLCNT ! ( column counter)
  ENDIF
;

(
**********************************************************
*                                                        *
*                     QUIT                               *
*                                                        *
**********************************************************

Exit 4th/86. Quit has no input.
)

: QUIT
  0 CLOSE ( close all files) :EXIT 0 JMP, ( warm boot) ;

DROP ( IO interlock flag that was input to LOAD of 7OSI)