( 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)