       ASB,HEX        ;IO260 - 6/28/76 - 0530 HOUR
VERSN  EQU  120Q      ;VERSION = CAPITAL 'P'
; 
;  COMMON EQUATES - CM34 - 6/10/76 - 1315 HRS.
; 
FSTRAM EQU  110400Q   ;FAST RAM LOWER LIMIT 
;***************************************
; KBDCSW - KEYBOARD DATA COMM SWITCHES *
;***************************************
FULDUP EQU  200Q      ;HALF/FULL DUPLEX 
;************************************** 
; KBJMPR - KEYBOARD INTERFACE JUMPERS * 
;************************************** 
; 
;  JUMPERS SENSED AS 0' WHEN INSERTED 
; 
;  ALL JUMPERS ARE NORMALLY INSERTED
; 
CONDIS EQU 001Q     ;CONTROL CODE DISABLE 
;                     (0=DISABLED)
SPLDIS EQU 002Q     ;SPOW LATCH DISABLE 
;                     (0=DISABLED)
LINWRP EQU 004Q     ;COLUMN 80 AUTO CR,LF 
;                     (0=ENABLED) 
PAGSTR EQU 010Q     ;PAGE MODE STRAP
;                     (0=LINE-FIELD MODE) 
LFPOS  EQU 20Q      ;LINE FEED POSITION 
;                     (0 = POSITION LINE FEED 
;                         AT START OF NEXT I/O
;                         READ
;                      1 = PUT LINE FEED AT END 
;                         OF RECORD)
FSTSND EQU 40Q      ;9600 BAUD DATACOM SHIFT
;                     (0=9600 BAUD FOR ESC,E) 
HNDSHK EQU 100Q     ;BLOCK TRANSFER HANDSHAKE 
;                     (0 = FOLLOW DC2SND SETTING
;                      1 = SEND DC2 BEFORE DATA)
DC2SND EQU 200Q 
;                     (0 = SEND DC2 ON ENTER
;                          AND FUNCTION KEY IN
;                          BLOCK MODE 
;                      1 = INHIBIT ALL DC2
;                          HANDSHAKE) 
 
;****************************************** 
; KBJMP2 - SECOND SET OF KEYBOARD JUMPERS * 
;****************************************** 
AUTTRM EQU  1Q        ;AUTO TERMINATE ON "ENTER"
CLRTRM EQU  2Q        ;CLEAR TERMINATOR ON TRANSMI
NOTEST EQU  4Q        ;INHIBIT TERMINAL SELF-TEST 
EDTWRP EQU  10Q       ;INVERT SENSE OF EDIT WRAP
PRNTAL EQU  20Q       ;SEND ALL CODES TO PRINTER
DCJMP0 EQU  200Q      ;DATA COMM JUMPER 
;*****************************************
; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *
;*****************************************
DCJMP1 EQU  1Q        ;DATA COMM JUMPERS
DCJMP2 EQU  2Q              ;.
DCJMP3 EQU  4Q              ;.
DCJMP4 EQU  10Q             ;.
NODCST EQU  20Q       ;INHIBIT DATA COMM SELF-TEST
;                       (0 = DISABLED)
SETCH  EQU  40Q       ;TURN ON "CH" CONTROL LINE
;                       (0 = OFF, 1 = ON) 
CHEKCC EQU  100Q      ;MONITOR CC CONTROL LINE
;                       (1 = ENABLED) 
FRCPTY EQU  200Q      ;FORCE PARITY ON/NO IN CHECK
;                       (1 = ENABLED) 
;************************ 
; CMFLGS - COMMON FLAGS * 
;************************ 
BLKTRG EQU  1Q        ;BLOCK TRANSFER TRIGGER 
INSWRP EQU  2Q        ;INSERT WITH WRAP AROUND
FRCRST EQU  4Q        ;FORCE FULL TERMINAL RESET
DEFSKY EQU  10Q       ;DEFINE SOFT KEY MODE ENABLE
REMSET EQU  20Q       ;REMOTE MODE ENABLED
RCVMDE EQU  40Q       ;TERMINAL IN RECEIVE MODE 
;***********************
; ERRFLG - ERROR FLAGS *
;***********************
DCMERR EQU  1Q        ;DATACOM (1 = ERROR)
TESTOK EQU  2Q        ;SELF-TEST (0 = ERROR)
LDRCHK EQU  4Q        ;LOADER CHECKSUM (0 = ERROR)
;************************** 
; INTFLG - INTERRUPT FLAG * 
;************************** 
TMRINT EQU  3         ;TIMER INTERRUPT
 
;***********************************
; PRCCTL - PROCESSOR CONTROL FLAGS *
;***********************************
TMIACK EQU  0Q        ;ACKNOWLEDGE TIMER INTERRUPT
;                       (BIT 1 OFF) 
TMRON  EQU  1Q        ;SET TIMER ON 
TMIEN  EQU  2Q        ;RE-ENABLE TIMER INTERRUPT
DCIOFF EQU  20Q       ;DISABLE DATA COMM INTERRUPT
TMIOFF EQU  40Q       ;DISABLE TIMER INTERRUPTS 
POLL   EQU  100Q      ;POLL CTU INTERRUPTS
;V*V*V*V*  SET TO ZERO FOR ROM VERSION  *V*V*V*V* 
SETROM EQU  200Q      ;DISABLE (1)/ENABLE (0) ROM 
;*********************************
; MDFLG1 - TERMINAL MODE FLAGS 1 *
;*********************************
DSPFNC EQU  1Q        ;DISPLAY FUNCTIONS ENABLED
INSCHR EQU  2Q        ;INSERT CHARACTER ENABLED 
MEMLOK EQU  4Q        ;MEMORY LOCK ENABLED
FORMAT EQU  10Q       ;FORMAT MODE ENABLED
EDIT   EQU  20Q       ;EDIT MODE ENABLED
SELECT EQU  40Q       ;SELECT MODE ENABLED
RECORD EQU  100Q      ;RECORD MODE ENABLED
FORGN  EQU  200Q      ;FOREIGN MODE ENABLED 
;*********************************
; MDFLG2 - TERMINAL MODE FLAGS 2 *
;*********************************
CAPSLK EQU  1Q        ;CAPS LOCK ENABLED
BLKMDE EQU  2Q        ;BLOCK MODE ENABLED 
AUTOLF EQU  4Q        ;AUTO LF ENABLED
REMOTE EQU  10Q       ;REMOTE ENABLED 
WBSR   EQU  40Q       ;WRITE-BACKSPACE-READ MODE
;********************************************** 
; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * 
;********************************************** 
DECRDX EQU  10        ;DECIMAL NUMBERS
OCTRDX EQU  8         ;OCTAL NUMBERS
 
;*******************
; COMMON VARIABLES *
;*******************
INTVEC EQU  FSTRAM+145Q  ;CENTRAL INTERRUPT VECTOR
SCNVEC EQU  INTVEC+3  ;FOREIGN TERMINAL DISPLY SCA
; 
COMMON EQU  177777Q   ;UPPER LIMIT OF COMMON AREA 
CMBASE EQU  COMMON/256  ;MSB OF COMMON ADDRESSES
CMSTOR EQU  CMBASE*256  ;MSB ADJUSTMENT FACTOR
; 
DISPST EQU  COMMON-1  ;DISPLAY REFRESH START PTR
TRMTYP EQU  DISPST-1  ;TERMINAL TYPE NUMBER 
KBDCSW EQU  TRMTYP-1  ;KEYBOARD DATACOM SWITCHES
KBJMPR EQU  KBDCSW-1  ;KEYBOARD STRAPS
KBJMP2 EQU  KBJMPR-1    ;SET 2
KBJMP3 EQU  KBJMP2-1    ;SET 3
CMFLGS EQU  KBJMP3-1  ;COMMON FLAGS 
ERRFLG EQU  CMFLGS-1  ;ERROR FLAGS
INTFLG EQU  ERRFLG-1  ;INTERRUPT FLAG 
PRCCTL EQU  INTFLG-1  ;PROCESSOR CONTROL FLAGS
MDFLG1 EQU  PRCCTL-1  ;TERMINAL MODE FLAGS 1
MDFLG2 EQU  MDFLG1-1    ;AND 2
MSGPT1 EQU  MDFLG2-2  ;MESSAGE POINTERS 
MSGPT2 EQU  MSGPT1-2       ;. 
MSGPT3 EQU  MSGPT2-2       ;. 
MSGPT4 EQU  MSGPT3-2       ;. 
MSGPT5 EQU  MSGPT4-2       ;. 
MSGPT6 EQU  MSGPT5-2       ;. 
MSGPT7 EQU  MSGPT6-2       ;. 
MSGPT8 EQU  MSGPT7-2       ;. 
CTIVEC EQU  MSGPT8-2  ;CTU INTERRUPT VECTOR 
CTIJMP EQU  CTIVEC-1  ;JUMP CODE FOR VECTOR 
IODATA EQU  CTIJMP-2  ;ESQ SEQ PARM ACCUMULATOR 
IOCSGN EQU  IODATA-1  ;SIGN FOR PARAMETER 
IOPSGN EQU  IOCSGN-1  ;PARAMETER SIGN 
PARM1  EQU  IOPSGN-1  ;ESCAPE SEQUENCE PARAMETERS 
PARM2  EQU  PARM1-1        ;. 
PARM3  EQU  PARM2-1        ;. 
PARM4  EQU  PARM3-1        ;. 
PARM5  EQU  PARM4-1        ;. 
PARM6  EQU  PARM5-2        ;. 
RADIX  EQU  PARM6-1   ;RADIX OF PARAMETERS
RNGTA  EQU  RADIX-2   ;CHAR FUNCTION TABLE ADDRESS
ESCFLG EQU  RNGTA-1   ;ESCAPE SEQUENCE FLAG 
;                       = 0, NOT IN ESCAPE SEQ
;                       # 0, ESC SEQ IN PROGRESS
RSTTMR EQU  ESCFLG-1  ;SOFT RESET TIMER 
; * * * * * * * * * * * * * * * * * * * * * * * * 
;  END OF COMMON EQUATES                        * 
;^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^* 
 
;*********************************
; KEYBOARD ENTRY VECTOR POINTERS *
;*********************************
ZKBBAS EQU  44000Q    ;KEYBOARD START ADDRESS 
ZINIKB EQU  ZKBBAS+2  ;INITIALIZE KEYBOARD
ZGETKY EQU  ZINIKB+3  ;GET KEYBOARD KEY 
ZKBCTL EQU  ZGETKY+3  ;PERFORM KEYBOARD CONTROL 
ZKBMON EQU  ZKBCTL+3  ;MONITOR KEYBOARD 
ZSTMD1 EQU  ZKBMON+3  ;SET MODE 1 FLAGS 
ZCLMD1 EQU  ZSTMD1+3  ;CLEAR MODE 1 FLAGS 
ZBELL  EQU  ZCLMD1+3  ;SOUND THE BELL 
ZSTXMT EQU  ZBELL+3   ;TURN ON TRANSMIT LED 
ZCLXMT EQU  ZSTXMT+3  ;TURN OFF TRANSMIT LED
ZSTJPR EQU  ZCLXMT+3  ;SET JUMPERS ESC SEQ ROUTINE
ZSTLKY EQU  ZSTJPR+3  ;SET LATCHING KEYS ROUTINE
ZALPCK EQU  ZSTLKY+3  ;ALPHA KEY ENTRY CHECK
ZNUMCK EQU  ZALPCK+3  ;NUMERIC KEY ENTRY CHECK
; 
;  KEYBOARD CONSTANTS 
; 
FRSALT EQU  ZNUMCK+3  ;INITIAL ALTERNATE CHAR SET 
ALTOUT EQU  FRSALT+1  ;INITIAL ALTERNATE CHAR OUT 
; 
;  KEYBOARD CONTROL CALLS 
; 
LOCKKB EQU  1         ;LOCK KEYBOARD
UNLKKB EQU  2         ;UNLOCK KEYBOARD
RPTKEY EQU  3         ;REPEAT LAST KEY HIT
STBLMD EQU  4         ;SET PERMANENT BLOCK MODE 
STRTST EQU  5         ;START SELF-TEST
ENDTST EQU  6         ;END SELF-TEST
RSETKB EQU  7         ;RESET KEYBOARD 
CKIOKY EQU  8         ;CHECK FOR I/O CONTROL KEY
STPRPT EQU  9         ;STOP KEY REPEAT
CKBRKY EQU  10        ;CHECK FOR BREAK KEY DOWN 
SWCHAR EQU  11        ;SWITCH CHARACTER SET 
SETFRN EQU  12        ;UPDATE FOREIGN MODE
STCHST EQU  13        ;SET FOREIGN OUTPUT MODE
FRNMD1 EQU  14        ;SET FOREIGN MODE 1 
FRNMD2 EQU  15        ;SET FOREIGN MODE 2 
 
;*************************************************
; 
;        DATACOM CONSTANTS
; 
;*************************************************
ZDCBAS EQU  50000Q    ;DATACOM START ADDRESS
TRIGGR EQU  ZDCBAS+2  ;BLOCK TRANSFER TRIGGER 
RECSEP EQU  TRIGGR+1  ;RECORD SEPARATOR CHARACTER 
BLKTRM EQU  RECSEP+1  ;BLOCK TERMINATOR CHARACTER 
DCJMSK EQU  BLKTRM+1  ;DATA COMM JUMPER MASK
DCJMS2 EQU  DCJMSK+1  ;DATA COMM JUMPER MASK #2 
;*************************************************
; 
;        DATACOM ENTRY VECTOR POINTERS
; 
;*************************************************
ZINIDC EQU  ZDCBAS+10Q   ;INITIALIZE DATACOM
ZIN2DC EQU  ZINIDC+3  ;INITIALIZATION CONTINUATOR 
ZDCMON EQU  ZIN2DC+3  ;MONITORING ROUTINE 
ZDCCTL EQU  ZDCMON+3  ;MISC CONTROL FUNCTIONS 
ZDCTST EQU  ZDCCTL+3  ;SELF-TEST
ZGETDC EQU  ZDCTST+3  ;GET DC CHARACTER 
ZPUTDC EQU  ZGETDC+3  ;PUT DC CHARACTER 
ZGTBIN EQU  ZPUTDC+3  ;GET BINARY DC CHARACTER
ZSTBIN EQU  ZGTBIN+3  ;START BINARY OUTPUT
ZNDBIN EQU  ZSTBIN+3  ;END BINARY OUTPUT
ZDCINT EQU  ZNDBIN+3  ;DATACOM INTERRUPTS 
;*************************************************
; 
;        DATACOM CONTROL CALL CODES 
; 
;*************************************************
CLRTRG EQU  0         ;CLEAR BLOCK TRANSFER TRIGGE
SETTRG EQU  1         ;SET BLOCK TRANSFER TRIGGER 
RSETDC EQU  2         ;RESET DATACOM
SETREM EQU  3         ;SET REMOTE MODE
SETLCL EQU  4         ;SET LOCAL MODE 
PUTBRK EQU  5         ;OUTPUT BREAK SIGNAL
DISCNT EQU  6         ;MODEM DISCONNECT 
ENDBLK EQU  7         ;TERMINATE OUTPUT MESSAGE 
SETMON EQU  8         ;ENTER MONITOR MODE 
SETNRM EQU  9         ;ENTER NORMAL MODE
FSTBIN EQU  10        ;ENTER FAST BINARY OUT MODE 
SNDATN EQU  11        ;SEND ATTENTION CODE
SNDFCT EQU  12        ;SEND FUNCTION DATA 
PROMPT EQU  13        ;SEND PROMPT CODE 
 
;****************************** 
; ALTERNATE I/O ENTRY VECTORS * 
;****************************** 
ALTORG EQU  60000Q    ;ALTERNATE I/O START ADDRESS
ZINIAL EQU  ALTORG+2  ;INITIALIZATION ROUTINE 
ZIN2AL EQU  ZINIAL+3  ;INITIALIZATION CONTINUATOR 
ZINTAL EQU  ZIN2AL+3  ;INTERRUPT PROCESSOR
ZMONAL EQU  ZINTAL+3  ;MONITORING ROUTINE 
ZGETAL EQU  ZMONAL+3  ;INPUT ROUTINE
ZPUTAL EQU  ZGETAL+3  ;OUTPUT ROUTINE 
ZCTLAL EQU  ZPUTAL+3  ;CONTROL ROUTINE
ZSTAAL EQU  ZCTLAL+3  ;STATUS ROUTINE 
ZMSGAL EQU  ZSTAAL+3  ;ALTERNATE DEVICE NAME
 
;************************** 
; ASCII CHARACTER EQUATES * 
;************************** 
NULL   EQU  0Q        ;NULL 
LF     EQU  12Q       ;LINE FEED
FF     EQU  14Q       ;FORM FEED
CR     EQU  15Q       ;RETURN 
SO     EQU 016Q 
SI     EQU 017Q 
DC2    EQU  22Q       ;DEVICE CONTROL 2 
DC3    EQU  23Q       ;DEVICE CONTROL 3 
ESC    EQU  33Q       ;ESCAPE 
CTLLIM EQU  40Q       ;CONTROL CODE UPPER LIMIT 
ABLNK  EQU 040Q     ;ASCII BLANK
AMPSND EQU  46Q       ;(&) - AMPERSAND
QUOTE  EQU  47Q       ;(') - SINGLE QUOTE 
ARPARN EQU  51Q       ;[)] - RIGHT PARENTHESIS
PLUS   EQU  53Q       ;PLUS SIGN
COMMA  EQU  54Q       ;COMMA
MINUS  EQU  55Q       ;MINUS SIGN 
PERIOD EQU  56Q       ;(.) - PERIOD 
SLANT  EQU  57Q       ;(/) - SLANT
ZERO   EQU  60Q       ;ASCII ZERO 
TWO    EQU  62Q       ;ASCII TWO
THREE  EQU  63Q       ;ASCII THREE
FOUR   EQU  64Q       ;ASCII FOUR 
FIVE   EQU  65Q       ;ASCII FIVE 
SIX    EQU  66Q       ;ASCII SIX
SEVEN  EQU  67Q       ;ASCII SEVEN
; 
ATSIGN EQU  100Q      ;"AT" SIGN (@)
A      EQU  101Q      ;UPPER CASE A 
C      EQU  103Q      ;UPPER CASE C 
D      EQU  104Q      ;UPPER CASE D 
F      EQU  106Q      ;UPPER CASE F 
H      EQU  110Q      ;UPPER CASE H 
L      EQU  114Q      ;UPPER CASE L 
N      EQU  116Q      ;UPPER CASE N 
R      EQU  122Q      ;UPPER CASE R 
S      EQU  123Q      ;UPPER CASE S 
T      EQU  124Q      ;UPPER CASE T 
U      EQU  125Q      ;UPPER CASE U 
Y      EQU  131Q      ;UPPER CASE Y 
Z      EQU  132Q      ;UPPER CASE Z 
LFTBKT EQU  133Q      ;LEFT BRACKET 
ABCKSL EQU  134Q      ;(\) - BACK SLANT 
 
;*********************
; LOWER CASE EQUATES *
;*********************
SMALLA EQU  141Q      ;LOWER CASE A 
ALCC   EQU 143Q     ;ASCII LOWER CASE C 
SMALLD EQU  144Q      ;LOWER CASE D 
SMALLF EQU  146Q      ;LOWER CASE F 
SMALLI EQU  151Q      ;LOWER CASE I 
SMALLK EQU  153Q      ;LOWER CASE K 
SMALLP EQU  160Q      ;LOWER CASE P 
SMALLX EQU  170Q      ;LOWER CASE X 
LFTBRC EQU  173Q      ;LEFT BRACE 
VRTBAR EQU  174Q      ;VERTICAL BAR 
ADEL   EQU  177Q      ;DELETE (RUBOUT)
 
;************************ 
; DISPLAY FLAGS EQUATES * 
;************************ 
ENHLIM EQU  277Q      ;MAXIMUM ENHANCEMENT CODE 
STPR   EQU  300Q      ;START PROTECTED FIELD
ENDPR  EQU  301Q      ;END PROTECTED FIELD
XMONLY EQU  302Q      ;START TRANSMIT-ONLY FIELD
FILL   EQU  303Q      ;EOL FILL CHARACTER 
STPFLG EQU  304Q      ;NON-DISPLAYING TERMINATOR
ALPHA  EQU  305Q      ;ALPHABETIC ONLY
NUMBER EQU  306Q      ;NUMERIC ONLY 
ALPHNM EQU  307Q      ;ALPHANUMERIC FIELD 
SFKYAT EQU  310Q      ;SOFT KEY ATTRIBUTE FIELD 
; 
FLDSEP EQU  304Q      ;FIELD SEPARATOR FOR I/O BUF
EOL    EQU 314Q 
EOP    EQU 316Q 
LNKLIM EQU 320Q     ;LOWEST VALUE FOR A LINK
NUM2K  EQU  4000Q     ;NUMBER 2048 (2K) 
B15    EQU  100000Q   ;BIT 15 
JMP    EQU  303Q      ;JUMP INSTRUCTION CODE
RET    EQU  311Q      ;RETURN INSTRUCTION CODE
;************************ 
; MISCELLANEOUS EQUATES * 
;************************ 
MAXROW EQU  23        ;MAXIMUM ROW NUMBER 
MAXCOL EQU  79        ;MAXIMUM COLUMN NUMBER
SFTEND EQU  16        ;LAST SOFT KEY DEFINITION RO
BELLIM EQU  8         ;SPACE FROM RHTMGN FOR BELL 
BLKSM  EQU  17Q       ;BLOCK SIZE MASK
BLKSZ  EQU  16        ;BLOCK SIZE 
IOERRB EQU  40Q       ;I/O ERROR STATUS BIT 
REXMIT EQU  1Q        ;RE-TRANSMIT I/O FLAG 
BINXMT EQU  2         ;SEND BINARY DATA 
SFTDLY EQU  50        ;SOFT RESET PERIOD - .50 SEC
NOSIGN EQU  200Q      ;NO SIGN FLAG FOR INPUT DATA
 
;*********************
; I/O MODULE EQUATES *
;*********************
RESET  EQU  0Q        ;RESET TERMINAL VECTOR
RSTJMP EQU  1Q        ;VECTOR FOR RESTART "PCHL"
PROCSR EQU  160Q      ;PROCESSOR "OUT" PORT 
IOBASE EQU 200Q     ;I/O ADDRESS MSB'S
; 
;  KEYBOARD 
; 
IOKB   EQU  (3Q+IOBASE)*256;MODULE 11 BASE ADDRESS
IOKBCO EQU  IOKB+200Q  ;RESET KEY CONTROL 
RSTON  EQU  2Q         ;RESET ON
RSTOFF EQU  4Q         ;RESET OFF 
NMFCTK EQU  8         ;NUMBER OF FUNCTION KEYS
; 
;  CURSOR CONTROL 
; 
IODISP EQU  (7Q+IOBASE)*256;MODULE 13 BASE ADDRESS
IOCRCL EQU  IODISP+0  ;CURSOR COLUMN ADDRESS
IOCRRW EQU  IODISP+40Q  ;CURSOR ROW ADDRESS 
MAYEOP EQU  40Q       ;DMA ON, EOP IF DMA ROW = RO
MAYEOL EQU  100Q      ;DMA OFF, SKIP EOP IF ROWS =
DMAOFF EQU  140Q      ;DMA OFF
CRTOFF EQU  200Q      ;DISPLAY OFF
INVRS  EQU  202Q      ;INVERSE VIDEO ON 
NORMAL EQU  200Q      ;NORMAL VIDEO ON
; 
;  CARTRIDGE TAPE 
; 
IOCTU  EQU  (13Q+IOBASE)*256;MODULE 15 BASE ADDRES
IOCTCO EQU  IOCTU+0Q  ;COMMAND TO CTU 
IOCTSI EQU  IOCTU+0Q  ;STATUS FROM CTU
IOCTDO EQU  IOCTU+40Q  ;DATA TO CTU 
IOCTDI EQU  IOCTU+40Q  ;DATA FROM CTU 
 
; 
;  9866 PRINTER 
; 
IOPTR1 EQU  (15Q+IOBASE)*256;MODULE 16 BASE ADDRES
PTROT1 EQU  IOPTR1+40Q  ;PRINTER DATA OUT 
PTRST1 EQU  IOPTR1+0Q  ;PRINTER STATUS IN 
PTRCL1 EQU  IOPTR1+2Q  ;PRINTER CLEAR 
; 
;  RS-232 PRINTER 
; 
IOPTR2 EQU  (5Q+IOBASE)*256;MODULE 12 BASE ADDRESS
PTROT2 EQU  IOPTR2+100Q  ;INTERFACE CONTROL OUT 
PTRST2 EQU  IOPTR2+40Q  ;PRINTER STATUS IN
PTRDA2 EQU  IOPTR2+140Q  ;PRINTER DATA OUT
PTRCF2 EQU  IOPTR2+100Q  ;OPTION JUMPERS IN 
 
;****************** 
; PRINTER EQUATES * 
;****************** 
; 
;  RS-232 OPTION STRAPS 
; 
;     BITS 2-0   MEANING IF SET 
;     000        EXT BAUD RATE
;     001        110  " 
;     010        150  " 
;     011        300  " 
;     100       1200  " 
;     101       2400  " 
;     110       4800  " 
;     111       9600  " 
; 
;     BIT 3      PARITY SELECT
;       1        EVEN 
;       0        ODD
; 
;     BIT 4      PARITY INHIBIT 
;       1        NO PARITY
;       0        PARITY 
;     BITS 7-5   # OF FILLS 
;     000        HANDSHAKE DEVICE 
;     001        8
;     010        16 
;     011        24 
;     100        32 
;     101        40 
;     110        48 
;     111        56 
;*****************
; DRIVER EQUATES *
;*****************
PTDLY  EQU  1500      ;15 SECOND PRINTER TIME OUT 
;***********************
; 9866 PRINTER EQUATES *
;***********************
PTRDY1 EQU 1        ;PRINTER READY
PTRPO1 EQU 200Q     ;PRINTER OUT OF PAPER 
;*************************
; RS-232 PRINTER EQUATES *
;*************************
PTRDY2 EQU 2        ;PRINTER READY MASK 
PTRSB2 EQU 100Q     ;RS-232 SB LINE STROBE
PTROL2 EQU 40Q      ;PRINTER READY MASK 
PTRHD2 EQU 340Q     ;RS-232 HANDSHAKE PROTOCOL
PTRBD2 EQU 37Q      ;PARITY AND BAUD RATE MASK
 
;**************************** 
; VARIABLE SPACE ALLOCATION * 
;**************************** 
DSPLIM EQU  175777Q   ;DISPLAY UPPER LIMIT
LWDSP  EQU  150000Q/256  ;DISPLAY LOWER LIMIT 
IOBUF  EQU  176000Q 
IOBUFH EQU  IOBUF/256 
IOBUFL EQU  -IOBUFH*256+IOBUF 
IOBUF1 EQU  176000Q 
IOBUF2 EQU  176400Q 
DSPSTR EQU  177000Q+79  ;MESSAGE BUFFER 
PTRBLN EQU  256       ;PRINTER INPUT BUFFER SIZE
;***************************
; OPERATING SYSTEM STORAGE *
;***************************
STACK  EQU  FSTRAM+140Q  ;STACK AREA (96 BYTES) 
OPSTOR EQU  177720Q   ;VARIABLES STORAGE AREA 
BASEH  EQU  OPSTOR/256  ;MSB OF DATA PAGE ADDRESSE
BASE   EQU  BASEH*256  ;DATA PAGE BASE ADDRESS
BASEH2 EQU  BASEH-1   ;BASE VALUES FOR SECOND PAGE
BASE2  EQU  BASEH2*256  ;OF VARIABLES SPACE 
;***************************
; VARIABLE SUBROUTINE CALL *
;***************************
ECONTF EQU OPSTOR-3 ;JUMP SUBROUTINE
CNTFAD EQU  ECONTF+1  ;CHARACTER FUNCTION ADDRESS 
 
;*********************************************
; NORMAL/SOFT KEY SWAPPED DISPLAY PARAMETERS *
;*********************************************
TOPLIN EQU  ECONTF-2  ;LSB PART OF NEXT LINE
;                       POINTER IN TOP DISPLAY
;                       LINE
LSTLIN EQU  TOPLIN-2  ;POINTER TO LSB PART OF 
;                       NEXT LINE POINTER IN
;                       LAST LINE PROCESSED 
LSTCOL EQU  LSTLIN-1  ;COLUMN AND ROW POSITION OF 
LSTROW EQU  LSTCOL-1    ;LAST CHARACTER PROCESSED 
;                       (CORRESPONDS TO CHARACTER 
;                          GIVEN BY "CURADR") 
LSTDCD EQU  LSTROW-1  ;LAST DISPLAY CODE USED 
LSTFMT EQU  LSTDCD-1  ;LAST FORMAT CONTROL USED 
CURADR EQU  LSTFMT-2  ;ADDRESS OF LAST CHARACTER
;                       PROCESSED 
PROFLD EQU  CURADR-1  ;PROTECT STATE OF (CURADR)
;                       = -1, PROTECTED 
;                       # -1, NOT PROTECTED 
;************************ 
; CURRENT CURSOR VALUES * 
;************************ 
CURCOL EQU  PROFLD-1  ;CURRENT COLUMN AND ROW 
CURROW EQU  CURCOL-1    ;POSITION OF CURSOR 
LFTMGN EQU  CURROW-1  ;LEFT MARGIN SETTING
RHTMGN EQU  LFTMGN-1  ;RIGHT MARGIN SETTING 
NUMSWP EQU  ECONTF-RHTMGN  ;# OF SWAP VARIABLES 
SWPSTR EQU  RHTMGN-NUMSWP  ;SWAP BUFFER 
DSPTYP EQU  SWPSTR-1  ;DISPLAY CURRENTLY ENABLED
;                       0 = NORMAL DISPLAY
;                      -1 = SOFT KEY DISPLAY
;*****************************************
; FIXED DISPLAY PARAMETERS (NOT SWAPPED) *
;*****************************************
FRBLKS EQU  DSPTYP-2  ;FREE BLOCKS LIST HEAD
DSPBGN EQU  FRBLKS-2  ;LOW ADDRESS OF DISPLAY AREA
DSPEND EQU  DSPBGN-2  ;HIGH ADDR OF DISPLAY AREA
SFTKYS EQU  DSPEND-2  ;SOFT KEY DISPLAY START ADDR
CURFKY EQU  SFTKYS-2  ;CURRENT FUNCTION KEY CHAR
TLINO  EQU  CURFKY-1  ;TOP LINE ABSOLUTE ROW NUMBE
LLINE  EQU  TLINO-2   ;LAST DISPLAY LINE START ADD
FLINE  EQU  LLINE-2   ;POINTER TO LSB PART OF NEXT
;                       LINE POINTER IN FIRST 
;                       LINE OF NORMAL DISPLAY
 
;******************** 
; SCRATCH VARIABLES * 
;******************** 
TEMP1  EQU  FLINE-1 
TEMP   EQU  TEMP1-1   ;TEMPORARY STORAGE
CHARIN EQU  TEMP-1    ;CHARACTER FROM KEYBOARD
NCHAR  EQU  CHARIN-1  ;NUMBER OF CHARS TO BE ADDED
NROWS  EQU NCHAR-1  ;NO. OF ROWS TO BE ADDED
NBLKS  EQU NROWS-1  ;NO. OF BLOCKS TO BE ADDED
CHSAV  EQU NBLKS-1  ;SAVE AREA FOR CHAR 
;                     PRECEDING LINK
LNKSAV EQU CHSAV-2  ;LINK SAVE AREA 
EOLADR EQU LNKSAV-2 ;ADDR OF LAST EOL 
FRSTBL EQU EOLADR-2 ;FIRST BLOCK IN DISPL1
BLKFIL EQU FRSTBL-1 ;FILL FLAG FOR FNDCHR 
EOLMV  EQU BLKFIL-1 ;FLAG FOR EOLMOV
FILCHR EQU EOLMV-1  ;FILL CHAR SAVE FOR GTBLK 
BFSPCE EQU  147777Q   ;UPPER LIMIT OF BUFFER
LWBUF  EQU  130000Q/256  ;LOWER LIMIT 
BUFBGN EQU  FILCHR-2  ;LOW ADDR OF NON-DISPLY BUFF
BUFEND EQU  BUFBGN-2  ;HIGH ADDR FOR BUFFER 
;**************************************** 
;  STORAGE FOR CHARACTERS TO BE STORED  * 
;**************************************** 
FMTCTL EQU  BUFEND-1  ;FORMAT CONTROL TO BE ENTERE
DCHAR  EQU  FMTCTL-1  ;NEXT CHAR TO BE DISPLAYED
CHAR   EQU  DCHAR-1   ;CURRENT CHAR BEING PROCESSE
CHKRTN EQU  CHAR-2    ;CURRENT TYPE CHECK ROUTINE 
TMPCOL EQU  CHKRTN-1  ;COLUMN # STORAGE FOR RCADDR
;*********************************
; STORAGE FOR CURSOR POSITIONING *
;*********************************
COUNT  EQU  TMPCOL-1  ;NUMBER OF BYTES TO FILL
NMROLL EQU  COUNT-1   ;NUMBER OF LINES TO ROLL
ROLLCT EQU  NMROLL-1  ;ROLL COUNTER 
; 
NEWCOL EQU  PARM1     ;NEW COLUMN NUMBER
NEWROW EQU  PARM2     ;NEW ABSOLUTE ROW NUMBER
SCRNRW EQU  PARM3     ;NEW SCREEN ROW SETTING 
 
;***********************
; HORIZONTAL TAB TABLE *
;***********************
HTBLEN EQU  10        ;TABLE LENGTH (= 10 X 8)
HTBTBL EQU  ROLLCT-HTBLEN 
;***********************
; DISPLAY SEND STORAGE *
;***********************
CDSPEN EQU HTBTBL-1 ;CURRENT ENHANCEMENT IN 
ENHOUT EQU CDSPEN-1 ;LAST ENHANCEMENT OUT 
CALTST EQU ENHOUT-1 ;CURRENT ALTERNATE SET OUT
GETADR EQU  CALTST-2  ;CURRENT CHARACTER ADDRESS
;***************************
; FLAGS AND TABLE POINTERS *
;***************************
CHRSET EQU  GETADR-1  ;CURRENT ALTERNATE CHAR SET 
KBFCTK EQU  CHRSET-1  ;KEYBOARD FUNCTION CODE 
;*************************************************
MFLGS  EQU  KBFCTK-1  ;BLOCK TRANSFER PENDING FLAG
;*************************************************
SDC2   EQU  1Q*256    ;DC2 PENDING
SSTAT  EQU  2Q*256    ;TERMINAL STATUS PENDING
SSTAT2 EQU  4Q*256    ;TERMINAL STATUS 2 PENDING
SDVST  EQU  10Q*256   ;DEVICE STATUS PENDING
SCRSEN EQU  20Q*256   ;CURSOR SENSE PENDING 
SFCTKY EQU  40Q*256   ;FUNCTION KEY PENDING 
SENTER EQU  100Q*256  ;DISPLAY SEND PENDING 
SDVDUN EQU  200Q*256  ;DEVICE DONE PENDING
;*****************************************
MFLGS2 EQU  MFLGS-1   ;MAIN CODE MODE FLAGS 
;*****************************************
SDVREC EQU  1Q        ;DEVICE RECORD PENDING
SBINRY EQU  2Q        ;BINARY RECORD PENDING
RELSNS EQU  4Q        ;RELATIVE CURSOR SENSE
ESCINP EQU 10Q      ;ESC RECEIVED IN BLOCK MODE 
FRSOUT EQU  20Q       ;FIRST SOFT KEY DATA OUT
WRPDEL EQU  40Q       ;DELETE CHAR W/ WRAP AROUND 
WRPFLG EQU  100Q      ;LINE WRAP AROUND OCCURRED
NWRWST EQU  200Q      ;NEW ABSOLUTE ROW SET 
;**************************************** 
DFLGS  EQU  MFLGS2-1  ;DATA TRANSFER FLAGS
;**************************************** 
SDACOM EQU 001Q     ;DATACOM/KEYBOARD 
CNTXFR EQU  2Q        ;CONTINUE BUFFER TO DATA COM
NOSEND EQU  4Q        ;NO DISPLAY DATA TO SEND
FCTK2D EQU  20Q       ;FUNCTION KEY TO DISPLAY
KBDLOK EQU  100Q      ;KB LOCKED BY ESCAPE SEQUENC
XBF2DS EQU  200Q      ;I/O BUFFER TO DISPLAY MODE 
 
;********************************************** 
TRMFCT EQU  DFLGS-1   ;NON-DISPLAYING TERMINATOR
;********************************************** 
STPXFR EQU  -1        ;TERMINATE TRANSFER 
DELTRM EQU  0         ;DELETE TERMINATOR
IGNTRM EQU  1         ;IGNORE TERMINATOR
;****************************************** 
SPOWL  EQU  TRMFCT-1  ;SPACE OVERWRITE LATCH
;****************************************** 
SPOWON EQU  40Q       ;SPOW LATCH ON
SPOWOF EQU  377Q      ;SPOW LATCH OFF 
;*************************************************
MLKROW EQU  SPOWL-1   ;MEMORY LOCK ROW
MLKFLG EQU  MLKROW-1  ;MEMORY LOCK FLAG 
LCHAR  EQU  MLKFLG-1  ;LAST CHARACTER PROCESSED 
TCHAR  EQU  LCHAR-1   ;CURRENT TEST PATTERN CHAR
CRAFLG EQU  TCHAR-1   ;CURSOR ADVANCE FLAG
;*****************************
; POINTERS FOR BINARY LOADER *
;*****************************
LADDR  EQU  PARM6     ;BYTE ADDRESS PARAMETER 
LDATA  EQU  IODATA    ;INPUT DATA ACCUMULATOR 
LCHKSM EQU  PARM5     ;16-BIT CHECKSUM
 
;V*V*V*V*V*V*V*V*V*V*V*V*V*V*V*V*V*V
; 
;  CTU/IO EQUATES - 4/11/76 - 2255 HOURS
; 
; TAPE DISTANCE MEASUREMENT 
; ========================= 
; 
; AS OF 3/1/75, .017125" OF TAPE MOTION IS
; EQUIVALENT TO 1 TACH EDGE.  THE COUNT IS
; IN ERROR WHEN STARTING OR STOPPING BY 
; 1 TACH EDGE (STOPPING IN A GAP MAY CAUSE
; AN ERROR OF TWO TACH EDGES).
; 
;*******************************
CTSTAT EQU  CRAFLG-1  ;CTU STATUS 
;*******************************
TKI    EQU  200Q      ;TACH INTERRUPT 
RDY    EQU 100Q     ;BYTE READY 
GAP    EQU 40Q
HOL    EQU 20Q      ;TAPE HOLE
TAK    EQU 10Q      ;TACH (58.4 EDGES/IN) 
RIP    EQU 4Q       ;RECORD IN PROGRESS 
CIR    EQU  2Q        ;RIGHT CARTRIDGE INSERTED 
CIL    EQU  1Q        ;LEFT CARTRIDGE INSERTED
;******************************** 
IOFLGS EQU  CTSTAT-1  ;I/O FLAGS 1
;******************************** 
RDWOWT EQU  1Q        ;READ WITHOUT WAIT MODE 
USREAD EQU  2Q        ;READ KEY INITIATED READ
FILRED EQU  4Q        ;FILE READ
RECRWD EQU  10Q       ;RECORD DISPLAY AND REWIND
;                       OLD OUTPUT CTU (LOGGING)
RECINI EQU  20Q       ;START "RECORD" MODE
RECPGE EQU  40Q       ;FILE COPY FROM DISPLAY - 
;                       INHIBIT ROLL UP 
VERIFY EQU  200Q      ;"CTU2BF" PERFORMS VERIFY 
;******************************** 
IOFLG2 EQU  IOFLGS-1  ;I/O FLAGS 2
;******************************** 
EXTB2D EQU  1Q        ;EXTERNAL BUFFER TO DATA COM
XDS2BF EQU  40Q       ;TRANSFER DISPLAY TO BUFFER 
DSPBTM EQU  100Q      ;BOTTOM OF DISPLAY REACHED
ENDDSP EQU  200Q      ;END OF DISPLAY REACHED 
 
;******************************** 
UNIT0  EQU  IOFLG2-1  ;UNIT STATUS
;******************************** 
LPM    EQU    1Q      ;TAPE AT OR BEFORE LOAD POIN
LSTFWD EQU    2Q      ;TAPE LAST MOVED FORWARD
FPS    EQU    4Q      ;TAPE WRITE PROTECTED 
CMDEXC EQU   10Q      ;SUCCESSFUL COMMAND EXECUTIO
DBLHOL EQU   20Q      ;DOUBLE HOLE FOUND
BOT    EQU   40Q      ;TAPE PAST BOT HOLES
LP     EQU  100Q      ;TAPE PAST LP HOLE
EW     EQU  200Q      ;TAPE PAST EW HOLE
;*******************************************
CNTRL0 EQU  UNIT0-1   ;DATA TRANSFER FLAGS: * 
;*******************************************
EOF    EQU    1Q      ;END OF FILE
EVD    EQU    2Q      ;END OF VALID DATA
HRDERR EQU    4Q      ;HARD ERROR 
SFTERR EQU   10Q      ;SOFT ERROR 
HRDER1 EQU   20Q      ;INTERRUPT ERROR FLAG 
WRTERR EQU   40Q      ;WRITE ERROR
DATATR EQU  100Q      ;DATA RECORDED
EOFINH EQU  200Q      ;INHIBIT REPORTING EOF
;***********************************************
RELTAK EQU  CNTRL0-1  ;GAP LENGTH COUNTER 
ABSTAK EQU  RELTAK-2  ;ABSOLUTE TACH COUNTER
STRTAK EQU  40660Q    ;STARTING VALUE FOR COUNTER 
FILNUM EQU  ABSTAK-1  ;CURRENT FILE NUMBER
SFTCNT EQU  FILNUM-1  ;SOFT ERRORS PER PASS 
OTHER  EQU  SFTCNT-7  ;STORAGE FOR UNIT NOT SEL.
;*******************************************
CMND   EQU  OTHER-1   ;CURRENT CTU COMMAND: * 
;*******************************************
RUN    EQU 1Q       ;MOVE TAPE
FWD    EQU 2Q       ;FORWARD
FST    EQU 4Q       ;FAST 
REC    EQU 10Q      ;RECORD 
USL    EQU  20Q       ;SELECT LEFT UNIT 
GEN    EQU 40Q      ;GAP GENERATE 
ANR    EQU  100Q      ;LIGHT FOR RIGHT UNIT 
ANL    EQU  200Q      ;LIGHT FOR LEFT UNIT
;*****************************************
;  INPDEV, OUTDEV, BXSTAT - I/O DEVICES  *
;*****************************************
LFTCTU EQU    1Q      ;LEFT CARTRIDGE TAPE UNIT 
RGTCTU EQU    2Q      ;RIGHT CARTRIDGE TAPE UNIT
DISPLY EQU    4Q      ;DISPLAY
PRINTR EQU   10Q      ;PRINTER
ALTIO  EQU   20Q      ;ALTERNATE I/O
DATCOM EQU   40Q      ;DATA COMM
PTTPOK EQU  100Q      ;BUF AVAIL FOR PTTPLN ROUTIN
BUFBSY EQU  200Q      ;BUF HELD BY UNSPECIFIED DEV
 
SCNCNT EQU  CMND-1    ;NUM. OF KBSCAN PER CTU SCAN
CTBLNK EQU  SCNCNT-1  ;BLINK MASK FOR EJECT LIGHTS
CTBLTM EQU  CTBLNK-1  ;BLINK TIMER
CTBDLY EQU  40Q       ;BLINK DELAY
HOLCNT EQU  CTBLTM-1  ;HOLE COUNTER 
TPSTAL EQU  HOLCNT-1  ;TAPE STALL COUNTER 
;***************
; I/O VARIBLES *
;***************
IOCERR EQU  TPSTAL-1  ;I/O ERROR FLAG 
;                       0 = NO ERROR
;                      -1 = ERROR OCCURRED
INPDEV EQU  IOCERR-1  ;CURRENT INPUT DEVICE 
OUTDEV EQU INPDEV-1 ;CURRENT OUTPUT DEVICE
IOCDPT EQU OUTDEV-1 ;DEVICE FLAG POINTER
IOSTA3 EQU  IOCDPT-1  ;DEVICE STATUS BYTE 3 
IOSTA2 EQU  IOSTA3-1  ;DEVICE STATUS BYTE 2 
IOSTA1 EQU  IOSTA2-1  ;DEVICE STATUS BYTE 1 
IOSTA0 EQU  IOSTA1-1  ;DEVICE NUMBER FOR STATUS 
XFRLIM EQU  IOSTA0-1  ;TRANSFER LIMIT 
CMPLIM EQU  XFRLIM-1  ;COMPARE LIMIT
B2DBUF EQU  CMPLIM-9  ;BIN TO DECIMAL CONV BUFFER 
B2DBFL EQU  B2DBUF-BASE  ;LSB PART OF "B2DBUF"
B2DPTR EQU  B2DBUF-1  ;B2DBUF "GET" POINTER (LSB) 
B2DEND EQU B2DPTR-1 ;B2DBUF END POINTER 
; 
;  I/O CONTROL VARIABLES
; 
IOCDEV EQU  PARM1     ;DEVICE FLAG
IOCOUT EQU  PARM2     ;OUTPUT DEVICE ACCUMULATOR
IOCINP EQU  PARM3     ;INPUT DEVICE ACCUMULATOR 
IOCTYP EQU  PARM4     ;COMMAND MODIFIER FLAG
IOCMND EQU  PARM5     ;COMMAND TYPE FLAG
IOCCNT EQU  PARM6     ;DATA COUNT (2 BYTES) 
 
; 
;  I/O BUFFER INFORMATION STORAGE 
; 
B1STAT EQU  B2DEND-1  ;STATUS OF FIRST BUFFER 
B1TYPE EQU  B1STAT-1  ;TYPE (-1=NORM, 0=EOF, 1=EVD
B1LEN  EQU  B1TYPE-1  ;LENGTH OF RECORD 
B2STAT EQU  B1LEN-1   ;STATUS OF SECOND BUFFER
B2TYPE EQU  B2STAT-1  ;TYPE (-1=NORM, 0=EOF, 1=EVD
B2LEN  EQU  B2TYPE-1  ;LENGTH OF RECORD 
; 
;  STORAGE FOR CARTRIDGE TAPE INTERRUPT ROUTINES
; 
CTIADR EQU  B2LEN-2   ;ADDRESS (HAS SEVERAL USES) 
CTISPT EQU  CTIADR-2  ;POINTER TO BUFFER STATUS 
CTIBPT EQU  CTISPT-2  ;POINTER TO BUFFER
CTICNT EQU  CTIBPT-3  ;GENERAL COUNTERS 
CTITRL EQU  CTICNT-1  ;RE-READ COUNTER, HOLE CNTR 
CTICSM EQU  CTITRL-1  ;CHECKSUM COUNTER 
CTISTA EQU  CTICSM-1  ;COMMAND SOURCE FLAG
; 
;  STORAGE FOR READ AND RECORD
; 
NXTRED EQU  CTISTA-2  ;PTR INTO BUF FOR NEXT READ 
LSTRED EQU  NXTRED-2  ;PTR INTO BUF FOR READ REPEA
SWPCTU EQU  LSTRED-1  ;SWAP CTU IN LOGGING MODE 
;                       -1 = SWAP ENABLED 
;                        0 = DISABLED 
SAVINP EQU  SWPCTU-1  ;"INPDEV" SAVE FOR LOCAL RCR
SAVOUT EQU  SAVINP-1  ;SAVE OUTDEV DURING LCL READ
; 
;  DATA FOR FORMAT DISPLAY STORAGE
; 
ENDCOL EQU  SAVOUT-1  ;ENDING COLUMN AND ROW FOR
ENDROW EQU  ENDCOL-1    ;PREV NON-PROTECTED FIELD 
 
; 
;  EXTENDED MAIN CODE RAM AREA
; 
XTRASP EQU  177200Q 
;**************************************** 
DEVFLG EQU  XTRASP-1  ;DEVICE PRESENT FLAG
;**************************************** 
CTUIN  EQU  200Q      ;CTU CODE PRESENT 
ALTIN  EQU  100Q      ;ALTERNATE I/O PRESENT
;******************** 
; PRINTER VARIABLES * 
;******************** 
PTRINP EQU  40Q       ;ALLOW PRINTER INPUT
;*************************************************
PTRBBG EQU  DEVFLG-2  ;START OF PRINTER BUFFER
PTRSPT EQU  PTRBBG-2  ;LOAD POINTER 
PTRBPT EQU  PTRSPT-2  ;UNLOAD POINTER 
PTRABT EQU  PTRBPT-1  ;PRINTER ERROR FLAG 
;                       =  0, NO PRINTER ERROR
;                       = -1, PRINT ERROR OCCURRED
PTRFLG EQU  PTRABT-1  ;PRINTER TYPE FLAG
;                       = 0, NO PRINTER 
;                       = 1, PARALLEL INTERFACE 
;                       = 2, RS-232 INTERFACE 
 
       ORG  24000Q
CTSTRT EQU  $ 
       DB   VERSN     ;ROM PRESENT/VERSION FLAGS
       DB   CTSTRT/256  ;ADDRESS CHECK
; 
;  VECTORS TO I/O ROUTINES FOR MAIN CODE
; 
       JMP  GRNKEY
       JMP  REDKEY
       JMP  CTLRED
       JMP  RECKEY
       JMP  SELKEY
       JMP  CTUTST
       JMP  CONDTN
       JMP  RSTCTU
       JMP  IOCNTL
       JMP  IOSTGO
       JMP  IODNGO
       JMP  IORDGO
       JMP  RCRDGO
       JMP  BNRYGO
       JMP  CTDCDP
       JMP  CTMON 
       JMP  PTTPLN
       DW   TIDO0 
       JMP  RDABRT
       JMP  BSYCHK
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CTU INTERRUPT - CALLED AFTER POLLING IN
;        MAIN CODE
; 
;      ENTRY:  INTERRUPT - PSW,H PUSHED 
; 
;      EXIT :  RETURN FROM INTERRUPT
;              BITS FOR TAPES REMOVED SINCE LAST
;              CALL TO CTMON REMAIN OFF.  IF TACH 
;              INTERRUPT OCCURRED, ABSTAK IS DECD.
; 
; 
CTINTR EQU  $ 
       LDA  CTSTAT    ;GET OLD STATUS 
       ORI  -1-CIL-CIR  ;BITS CIL & CIR ARE ANDED,
       LXI  H,IOCTSI      ;OTHERS TAKEN FROM NEW
       ANA  M             ;STATUS WORD. 
       LXI  H,CTSTAT
       MOV  L,M       ;GET OLD STATUS 
       STA  CTSTAT    ;SAVE NEW STATUS
       XRA  L         ;HAS HOL STATUS CHANGED?
       ANI  HOL 
       CNZ  HOLCHK    ;YES - DECIDE WHAT TO DO
       MVI  L,TPSTAL  ;RESET TAPE STALL COUNTER 
       MVI  M,6 
       MVI  L,CTSTAT  ;TACH INTERRUPT?
       MOV  A,M 
       ORA  A 
       JP   CTI100    ;NO - 
       MVI  L,HOLCNT  ;YES - DECR HOLE CHECK COUNT
       DCR  M 
       JP   CTI020      ;COUNT OVERFLOWED?
       MVI  M,0         ;YES - RESET TO 0 
CTI020 EQU  $           ;COUNT = 0? 
       CZ   HOLCT0      ;YES - RUNOFF OR LP HOLE
       MVI  L,ABSTAK  ;INC ABSOLUTE TACH COUNT
       INR  M         ;CARY FROM LOW BYTE?
       JNZ  CTI040    ;NO - 
       INX  H         ;YES - INC HIGH BYTE
       INR  M 
CTI040 EQU  $ 
       MVI  L,CTSTAT  ;ROUTINES WANT H,L -> CTSTAT
CTI100 EQU  $ 
       LDA  UNIT0     ;ROUTINES WANT A = UNIT0
       CALL CTIJMP    ;PERFORM INTERRUPT ROUTINE
       POP  H         ;RESTORE REGISTERS
       POP  PSW 
       EI             ;RETURN FROM INTERRUPT
       RET
 
; 
;  "DO NOTHING" CTU INTERRUPT HANDLER 
; 
TIDO0  EQU  $ 
       LDA  IOCTDI    ;CLEAR POSSIBLE BYTE RDY INT
       MOV  A,M       ;GET CTU STATUS 
       CMA            ;ARE BOTH TACH INTERRUPT
       ANI  TKI+GAP     ;AND GAP SET? 
       RNZ            ;NO - QUIT
       MVI  L,RELTAK  ;YES - COUNT THE TACH EDGE
       INR  M 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      HOLCHK - HOLE STATUS HAS CHANGED - 
;         FIGURE OUT WHERE THE TAPE IS
; 
;      CALLED ONLY BY CTU INTERRUPT 
; 
;      ENTRY:  A = HOL
;              H = BASEH
;              L = OLD STATUS 
; 
;      EXIT :  H = BASEH
;              A,L DESTROYED
; 
HOLCHK EQU  $ 
       ANA  L         ;MOVING INTO OR OUT OF HOLE?
       MVI  L,HOLCNT    ;(GET POINTER TO COUNTER) 
       JNZ  HCK300    ;OUT -
;********************** 
;  HOLE JUST ENTERED  * 
;********************** 
       ORA  M         ;SECOND OF DOUBLE HOLE? 
       MVI  M,5         ;(SET COUNT FOR RUNOFF CHK
       LDA  CMND        ;(RE-ISSUE COMMAND) 
       STA  IOCTCO
       RZ             ;NO - SET UP TO CHECK OUT HO
;************************************** 
;  SECOND OF DOUBLE HOLE ENCOUNTERED  * 
;************************************** 
       MVI  A,DBLHOL  ;FLAG SAYS "2ND OF DBL HOLE"
;********************************** 
;  STUNT0 - SET FLAG(S) IN UNIT0  * 
;********************************** 
STUNT0 EQU  $ 
       LXI  H,UNIT0 
       ORA  M 
       MOV  M,A 
       RET
;*******************
;  HOLE JUST LEFT  *
;*******************
HCK300 EQU  $ 
       MVI  M,0       ;CLEAR COUNTER
       MVI  L,UNIT0 
       MOV  A,M       ;GET HOLE FLAGS 
       RLC            ;PAST EARLY WARNING?
       JNC  HCK400    ;NO - 
;************************ 
;  AFTER EARLY WARNING  * 
;************************ 
       CMC            ;YES - TURN OFF EW
       RAR
       MOV  M,A 
       CALL CHKFWD    ;WHICH DIRECTION? 
       RZ             ;REVERSE - RETURN 
       JMP  CTHNG1    ;FWD - HANG TIL TAPE REMOVED
;*************************
;  BEFORE EARLY WARNING  *
;*************************
HCK400 EQU  $ 
       ANI  LP+LP     ;PAST LOAD POINT? 
       CNZ  CHKFWD    ;YES - WHICH DIRECTION? 
       MVI  A,EW
       JNZ  STUNT0      ;FWD - SET EW AND QUIT
;**************************** 
;  AT OR BEFORE LOAD POINT  * 
;**************************** 
HCK500 EQU  $ 
       MOV  A,M       ;2ND OF DOUBLE HOLE?
       ANI  DBLHOL
       JNZ  HCK600    ;YES - SET FLAGS
       MVI  L,HOLCNT  ;NO - SET COUNT TO CHECK FOR
       MVI  M,12        ;DOUBLE HOLE
       RET
;**************************** 
;  JUST PASSED DOUBLE HOLE  * 
;**************************** 
HCK600 EQU  $ 
       XRA  M         ;CLEAR DOUBLE HOLE FLAG 
       ORI  LPM       ;SET "AT OR BEFORE LP"
       ANI  -1-LP-BOT ;SET "BEFORE BOT" 
       MOV  M,A 
       CALL CHKFWD    ;WHICH DIRECTION? 
       RZ             ;REVERSE - RET "BEFORE BOT" 
       MOV  A,M       ;FORWARD - RET "AFTER BOT"
       ORI  BOT 
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      HOLCT0 - HOLE CHECK COUNT WENT TO 0
; 
;      INTERPRETATION:  IN HOLE => RUNOFF 
;                       NOT IN HOLE => SINGLE HOLE
; 
;      CALLED ONLY BY CTU INTERRUPT 
; 
;      ENTRY:  A = CURRENT STATUS 
;              H = BASEH
; 
;      EXIT :  H = BASEH
;              A,L DESTROYED
; 
HOLCT0 EQU  $ 
       ANI  HOL       ;IN HOLE? 
       JNZ  CTHNG0    ;YES - HANG TIL TAPE REMOVED
;******************************** 
;  JUST PASSED LOAD POINT HOLE  * 
;******************************** 
       MVI  A,BOT+LP+LPM
       CALL STUNT0    ;SET FOR GOING FWD
       CALL CHKFWD    ;WHICH DIRECTION? 
       RNZ            ;FWD - RETURN 
       MOV  A,M       ;REV -
       ANI  -1-LP       ;MARK BEFORE LP 
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CTHANG - HANG UNTIL TAPE IS REMOVED
; 
;      ENTRY CTHNG0 - RUNOFF
; 
;      ENTRY CTHNG1 - RAN INTO END-OF-TAPE HOLE 
; 
;      EXIT :  C,Z
;              H = BASEH
;              A,L DESTROYED
; 
CTHNG0 EQU  $ 
       LXI  H,OFFMSG  ;GET RUNOFF MESSAGE 
       JMP  CTHANG
CTHNG1 EQU  $ 
       LXI  H,UETMSG  ;GET "UNEXPECTED END OF TP" 
CTHANG EQU  $ 
       PUSH H         ;SAVE MESSAGE POINTER 
       CALL STOPTP    ;STOP THE TAPE
       CALL ZBELL     ;RING THE BELL
       POP  H 
       CALL CARDI0    ;DISPLAY MESSAGE
       CALL GTCTBT    ;GET BIT FOR STALLED UNIT 
       CMA            ;TURN IT OFF IN CTSTAT SO 
       LXI  H,CTSTAT    ;SOFT RESET WILL CAUSE
       ANA  M           ;REWIND ATTEMPT 
       MOV  M,A 
CTH100 EQU  $ 
       CALL CTMON1    ;CHECK OTHER TAPE 
       CALL GTCTBT    ;GET BIT FOR THIS UNIT
       LXI  H,IOCTSI  ;HAS IT BEEN REMOVED? 
       ANA  M 
       JNZ  CTH100    ;NO - CONTINUE WAITING
       CALL RSTDSP    ;TAPE REMOVED - RESTORE DISP
       MVI  H,BASEH 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      RSTCTU - CTU SOFT RESET
; 
;      ENTRY:  INTERRUPTS DISABLED
; 
;      EXIT :  INTERRUPTS ENABLED 
;              ALL REGISTERS DESTROYED
; 
; 
RSTCTU EQU  $ 
       LXI  H,0       ;CLEAR TRANSFER FLAGS 
       SHLD IOFLG2
       CALL FREBFS    ;FREE I/O BUFFERS 
       CALL IOERCL    ;CLEAR ERROR (IOCERR <- S)
       LDA  CMND      ;GET LAST-ISSUED COMMAND
       PUSH PSW       ;SAVE IT
       CALL STOPTP    ;STOP TAPE, RESET LIGHTS, EI
       POP  PSW       ;RECALL COMMAND 
       RRC            ;WAS TAPE RUNNING WHEN RESET
       RNC            ;NO - RETURN
       RLC            ;YES - RESTORE COMMAND
       ANI  REC       ;WAS TAPE RECORDING?
       JZ   RCT120    ;NO - REWIND TO LP & EXIT 
;***************************************
;  CTU WAS RECORDING - TRY TO RECOVER  *
;***************************************
RCT020 EQU  $ 
       LDA  UNIT0     ;FINDING LOAD POINT?
       ANI  LPM 
       JNZ  RCT120    ;YES - JUST REWIND TO LOAD P
       LXI  H,2       ;BACKSPACE OVER A BAD RECORD
       CALL BAKSPR      ;AND A GOOD ONE 
       CNC  CHKLPM    ;FWD TO LOAD PT IF NOT THERE
       JC   USREXT    ;REPORT ANY ERRORS
       JZ   RCT100    ;AT LOAD POINT - DO NOT READ
       MVI  A,-1-DATATR 
       CALL CLRCT0    ;CLEAR "DATA RECORDED" FLAG 
       MVI  A,-1      ;SET XFR LIMIT TO ONE RECORD
       STA  XFRLIM
       CALL GTCTBT    ;GET BIT FOR THIS UNIT
       MOV  B,A 
       CALL CT2BUF    ;IF NOT AT LP, READ A RECORD
;                       (TO SET EOF CORRECTLY)
       JC   USREXT    ;REPORT ANY ERRORS
       SUB  A         ;NO ERROR - FREE BUFFER 
       STAX D 
RCT100 EQU  $ 
       MVI  A,DATATR  ;SET "DATA RECORDED" FLAG 
       CALL SETCT0
RCT120 EQU  $ 
       CALL RWDLP     ;REWIND TO LOAD POINT 
       JMP  USREXT    ;REPORT ANY ERRORS
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CTMON - MONITOR CARTRIDGE TAPE UNITS 
; 
;      LOOK FOR TAPES THAT HAVE BEEN INSERTED OR
;      REMOVED. 
;      CALLED BY WAIT LOOP. 
;      REWINDS NEW TAPES IFF UNIT IS NOT BUSY 
;      (I.E., RUN BIT OFF IN LAST COMMAND). 
;      TURNS OFF LIGHTS FOR ANY TAPE REMOVED SINCE
;      LAST CALL TO CTMON (OR SINCE CTU WAS LAST
;      FREE, IF IT IS NOW BUSY).
;      INPUTS STATUS IFF CTU IS NOT BUSY (PREVENTS
;      CLEARING AN UNACKNOWLEDGED INTERRUPT). 
; 
;      DESTROYS A,H,L 
; 
; 
CTMON  EQU  $ 
       MVI  A,-1-RECRWD  ;SHOULD SCREEN BE RECORDE
       CALL CLIOFS         ;& OLD OUT CTU REWOUND?
       CNZ  LOGRWD    ;YES - DO LOGGING REWIND
       CALL CTMON1    ;CHECK FOR REMOVED TAPES
       JC   USREXT    ;REPORT ANY ERRORS
       RNZ            ;RETURN IF TAPE RUNNING 
       LDA  IOCTSI    ;CIL,CIR=1 => TAPE INSERTED 
       MOV  H,A       ;H = NEW STATUS 
       MOV  A,L       ;GET OLD STATUS 
       CMA            ;CIL,CIR=1 => NO TAPE BEFORE
       ANA  H         ;CIL,CIR=1 => TAPE TO REWIND
       ANI  CIL+CIR   ;ANY TAPES TO REWIND TO LP? 
       MOV  H,A         ;(SAVE BITS IN H) 
       RZ             ;NO - RETURN
       PUSH B         ;YES - SAVE REGS FOR POSSIBL
       PUSH D           ;CALL TO USREDA 
       PUSH H 
       LDA  MDFLG1    ;DOING DATA LOGGING. . .
       ANI  EDIT
       LXI  H,SWPCTU
       ANA  M         ;. . .WITH CTU SWAP?
       CNZ  RECKEY    ;YES - GET AHEAD OF DATA
CTM020 EQU  $         ;WAIT FOR CTU TO FINISH 
       CALL CTMON1
       JNZ  CTM020
       POP  H         ;RESTORE REGISTERS
       POP  D 
       POP  B 
       MOV  A,H       ;RECALL STATUS
       ANI  CIL       ;LEFT TAPE JUST INSERTED? 
       JNZ  CTM040    ;YES -
       MVI  A,CIR     ;NO - RIGHT TAPE INSERTED 
CTM040 EQU  $ 
       MOV  H,A       ;SAVE BIT 
       ORA  L         ;SET BIT IN STATUS FOR NEW
       STA  CTSTAT      ;TAPE 
       MOV  A,H       ;RECALL BIT 
       CALL SELACT    ;SELECT TAPE INDICATED
       CALL IOERCL    ;CLEAR ERR FLG (IOCERR <- S)
       LXI  H,(BOT+LPM)*256;SET UNIT0 AND CNTRL0
       SHLD CNTRL0
       CALL RWDLP     ;REWIND TO LOAD POINT 
       JMP  USREXT    ;REPORT ANY ERRORS
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CTMON1 - CHECK FOR REMOVED TAPES 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  L = OLD STATUS 
;              C => ERROR, RUN ISSUED TO ABSENT TP
;              NC => NO SUCH ERROR
;              Z => TAPE NOT RUNNING
;              NZ => TAPE RUNNING 
;              A,H DESTROYED
; 
; 
CTMON1 EQU  $ 
       CALL GETSTA    ;GET STATUS 
       MOV  L,A       ;SAVE IN L-REG
       ANI  CIL       ;LEFT TAPE REMOVED? 
       CZ   LITOFL    ;YES - TURN OFF LIGHT 
       MOV  A,L       ;RECALL STATUS
       ANI  CIR       ;RIGHT TAPE REMOVED?
       CZ   LITOFR    ;YES - TURN OFF LIGHT 
       DI 
       LDA  CMND      ;GET CURRENT COMMAND
       ANI  RUN       ;RUN COMMAND ISSUED?
       LDA  TPSTAL      ;(GET CORRESPONDING TPSTAL
       EI 
       RZ             ;NO - RETURN NC, Z
       ORA  A         ;TPSTAL = 0 => NO INTERRUPTS
       RNZ            ;INTERRUPTS OK - RET NC, NZ 
       CALL STOPTP    ;STOP THE MOTOR 
       CALL CISCAN    ;TAPE INSERTED? 
       LXI  H,STALMS    ;(GET STALL MESSAGE)
       CNC  CTHANG    ;YES - REPORT STALL 
       LDA  CMND      ;WAS UNIT RECORDING?
       ANI  REC 
       JZ   CTM100    ;NO - RETURN
       MVI  A,WRTERR  ;YES - SET WRITE ERROR FLAG 
       CALL SETCT0
       CALL GTCTBT    ;CLEAR BITS FOR THIS
       CMA              ;UNIT IN I/O BUFFERS
       PUSH PSW 
       LXI  H,B1STAT
       ANA  M 
       MOV  M,A 
       MVI  L,B2STAT*256/256
       POP  PSW 
       ANA  M 
       MOV  M,A 
CTM100 EQU  $ 
       LDA  CTSTAT    ;RETURN L = STATUS
       MOV  L,A 
       SUB  A 
       STC            ;RETURN C, Z
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      LOGRWD - DO DATA LOGGING-MODE REWIND, I.E.,
;           RECORD EVERYTHING ON THE SCREEN FIRST,
;           AND MONITOR THE DATACOM BETWEEN 
;           OPERATIONS. 
; 
;      ENTRY:  SWPCTU CONTAINS BIT FOR CTU TO BE
;                REWOUND. 
;              OUTDEV HAS BEEN UPDATED. 
; 
;      EXIT :  SWPCTU = -1 (=> TAPE SWAP MODE)
;              A,H,L DESTROYED. 
; 
; 
LOGRWD EQU  $ 
       PUSH B         ;SAVE REGISTERS 
       PUSH D 
       CALL IOERCL    ;CLEAR ERR FLG (IOCERR <- S)
       CALL USREDA    ;GET EVERYTHING OFF SCREEN
       MVI  A,5       ;WRITE EOF ON OLD UNIT
       CALL LOG900
       MVI  A,6       ;WRITE EVD ON OLD UNIT
       CNC  LOG900
       MVI  A,0       ;REWIND OLD UNIT
       CNC  LOG900
       MVI  A,-1      ;RESTORE SWPCTU 
       STA  SWPCTU
       POP  D         ;RESTORE REGISTERS
       POP  B 
       JMP  USREXT    ;REPORT ANY ERRORS
;*********************************************
;  SUBROUTINE PERFORMS CONTROL FUNCTIONS ON  *
;      TAPE JUST FINISHED                    *
;*********************************************
LOG900 EQU  $ 
       STA  IOCTYP    ;SAVE FUNCTION FOR CTLCT
LOG910 EQU  $ 
       CALL GETDCM    ;MONITOR DATACOM
       JZ   LOG910    ;CHARS INPUT - KEEP MONITRNG
       CALL CTMON1    ;CTU BUSY?
       JNZ  LOG910    ;YES - WAIT 
       RC               ;(RETURN IF ANY ERRORS) 
       LDA  SWPCTU    ;NO - GET UNIT
       LXI  H,CTLTAB
       JMP  SETJMP    ;PERFORM FUNCTION 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GETSTA - GET CTU STATUS
; 
;      GET AND SAVE CTU STATUS, CLEARING
;      "CART. INSERTED" BITS FOR TAPES THAT HAVE
;      BEEN REMOVED.
; 
;      EXIT :  CTU NOT BUSY, A = NEW STATUS 
;              CTU RUNNING, A = OLD STATUS
; 
; 
GETSTA EQU  $ 
       LDA  CMND      ;TAPE BUSY? 
       ANI  RUN 
       LXI  H,CTSTAT    ;(GET OLD STATUS) 
       MOV  A,M 
       RNZ            ;YES - RETURN 
       LDA  IOCTSI    ;NO - GET NEW STATUS
       ORI  -1-CIL-CIR  ;"AND" BITS FOR TAPES,
       ANA  M             ;OTHERS FRM OLD STATUS
       MOV  M,A       ;SAVE STATUS
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      LITOFF - TURN OFF LIGHT ON SELECTED UNIT 
; 
;      READS UNIT FROM CURRENT CONTENTS OF "CMND" 
; 
;      EXIT  : A DESTROYED
; 
;      LITOFL - TURNS OFF LEFT LIGHT
;      LITOFR - TURNS OFF RIGHT LIGHT 
; 
; 
LITOFF EQU  $ 
       CALL GTCTBT    ;LEFT UNIT SELECTED?
       JZ   LITOFR    ;NO - TURN OFF RIGHT LIGHT
LITOFL EQU  $ 
       MVI  A,-1-ANL  ;SET UP MASK
       JMP  LOF010
LITOFR EQU  $ 
       MVI  A,-1-ANR  ;MASK FOR RIGHT LIGHT 
LOF010 EQU  $ 
       PUSH H         ;SAVE H,L 
       PUSH PSW       ;SAVE MASK
       LXI  H,CTBLNK  ;TURN OFF BLINKING
       DI             ;HOLD OFF INTERRUPTS
       ANA  M 
       MOV  M,A 
       POP  PSW       ;RETRIEVE MASK
       MVI  L,CMND-BASE  ;TURN OFF LIGHT IN "CMND"
       ANA  M 
       MOV  M,A 
       STA  IOCTCO    ;OUTPUT COMMAND TO HARDWARE 
       EI             ;LITOFF IS ONLY CALLED WITH 
;                       INTERRUPTS DISABLED 
       POP  H         ;RESTORE REGS 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      OUTCMD - ISSUE A COMMAND TO THE CTU
; 
;      OUTPUTS THE COMMAND AND SAVES IT IN CMND.
;      UNIT SELECT IS PRESERVED FROM OLD COMMAND
;      IF RUN BIT IS UNCHANGED, LIGHTS ARE UNCHNGD
;      "RUN" TURNED ON - SELECTED LIGHT TURNED OFF
;           BLINK TURNED ON.
;      "RUN" TURNED OFF - LIGHT TURNED ON, BLINK
;           TURNED OFF. 
; 
;      ENTRY OCM001 DOES NOT CLEAR LPM (AT OR 
;      BEFORE LOAD POINT) OR SET CMDEXC (COMMAND
;      EXECUTION OK). 
; 
;      ENTRY:  A = BITS RUN, FWD, FST, REC, GEN 
;                     TO BE TURNED ON 
;              H,L -> INTERRUPT ROUTINE 
; 
;      ENTRY OUTCM1 DOES NOT TAKE INTERRUPT 
;        ROUTINE PARAMETER
; 
;      EXIT :  H = BASEH
;              L DESTROYED
;              NC  (REQUIRED BY OTHER ROUTINES) 
; 
; 
OUTCMD EQU  $ 
       SHLD CTIVEC    ;SET UP INTERRUPT VECTOR
OUTCM1 EQU  $ 
       PUSH B 
       ANI  -1-USL-ANL-ANR  ;TURN OFF BITS SET BY 
       MOV  B,A         ;THIS ROUTINE - SAVE RESUL
       LXI  H,UNIT0 
       MOV  A,M       ;GET UNIT FLAGS 
       ANI  -1-LPM    ;ASSUME OPERATION WILL MOVE 
;                       TAPE BEYOND LP
       ORI  CMDEXC    ;ASSUME OPERATION WILL RUN
       MOV  M,A 
       JMP  OCM005
OCM000 EQU  $ 
       SHLD CTIVEC
OCM001 EQU  $         ;FAST OUTCMD ENTRY
       PUSH B         ;SAVE B,C 
       ANI  -1-USL-ANL-ANR  ;TURN OFF BITS SET BY 
       MOV  B,A         ;THIS ROUTINE - SAVE RESUL
OCM005 EQU  $ 
       LDA  CMND      ;GET OLD COMMAND
       MOV  C,A       ;SAVE IT
       ANI  USL+ANL+ANR  ;USE OLD LIGHTS AND UNIT 
       ORA  B         ;FORM NEW COMMAND 
       MOV  B,A       ;SAVE NEW COMMAND 
       XRA  C         ;SEE IF RUN BIT HAS CHANGED 
       ANI  RUN 
       MOV  A,B         ;(RECALL COMMAND) 
       JZ   OCM030    ;NO - QUIT
       ANI  USL       ;YES - GET BIT FOR LIGHT
       MVI  C,ANL       ;OF SELECTED UNIT 
       JNZ  OCM010
       MVI  C,ANR 
OCM010 EQU  $ 
       MOV  A,B       ;RECALL COMMAND 
       ORA  C         ;TURN ON SELECTED LIGHT 
       MOV  B,A       ;NOW CHECK RUN BIT
       ANI  RUN       ;RUN TURNED ON OR OFF?
       JNZ  OCM020    ;ON - DO NOT CHANGE MASK
       MVI  C,0       ;OFF - CLEAR MASK 
OCM020 EQU  $ 
       MVI  A,CTBDLY  ;RESET BLINK COUNTER
       STA  CTBLTM
       MOV  A,C       ;GET MASK 
       STA  CTBLNK    ;0 => NO BLINK
       XRA  B         ;NO RUN - LIGHT LEFT ON,
;                     RUN - LIGHT TURNED OFF
OCM030 EQU  $         ;RETURN 
       STA  CMND      ;SAVE IN CMND 
       STA  IOCTCO    ;OUTPUT TO CTU
       LXI  H,TPSTAL  ;RESET TAPE STALL COUNTER 
       MVI  M,6 
       POP  B         ;RESTORE B,C
       MVI  L,UNIT0   ;HAS DIRECTION CHANGED? 
       XRA  M 
       ANI  FWD 
       RZ             ;NO - RETURN
       XRA  M         ;YES - CHANGE LSTFWD
       MOV  M,A 
       MVI  L,ABSTAK    ;AND COMPLEMENT TACH COUNT
       MOV  A,M 
       CMA
       MOV  M,A 
       INX  H 
       MOV  A,M 
       CMA
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     RETSCN - SEE IF "RETURN" HAS BEEN HIT 
; 
;     RETSC0 - IF IN "RECORD" MODE, CHECK FOR 
;           RECORD KEY INSTEAD. 
; 
;     ENTRY:
; 
;      EXIT : NC,NZ => NO TERMINATOR
;             C,Z => TERMINATOR 
;              IOCERR=U 
;              A,L DESTROYED
; 
RETSC0 EQU  $ 
       LDA  MDFLG1    ;IN "RECORD" MODE?
       ANI  RECORD
       MVI  L,235Q
       JNZ  RSC005    ;YES - CHECK FOR RECORD KEY 
RETSCN EQU  $ 
       MVI  L,CR      ;NO - CHECK FOR RETURN
RSC005 EQU  $ 
       LDA  IOCERR    ;HAS CR ALREADY BEEN HIT? 
       CPI  U           ;'U' => YES 
       JZ   RSC020    ;YES - RETURN 
       PUSH B         ;NO - SAVE REGISTERS FOR CAL
       PUSH D           ;TO GETKY 
       CALL ZGETKY    ;ANY NEW KEYS HIT?
       POP  D 
       POP  B 
       RNZ            ;NO - RETURN
       CMP  L         ;TARGET KEY HIT?
       JNZ  RSC005    ;NO - CHECK FOR MORE INPUT
       MVI  A,STPRPT  ;YES - INHIBIT KEY REPEAT 
       CALL ZKBCTL
       MVI  A,U       ;SET "IOCERR" TO "U"
       STA  IOCERR      ;IOCERR=U => USER INTERRUP
RSC020 EQU  $         ;RETURN "USER INTERRUPT"
       STC              ;C => ERROR 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     GTCTBT - GET BIT FOR SELECTED CTU 
; 
;     ENTRY:  DON'T CARE
; 
;     EXIT :  A = BIT 
;            Z => RGTCTU
;            NZ => LFTCTU 
; 
; 
GTCTBT EQU  $ 
       LDA  CMND      ;WHICH UNIT IS SELECTED?
       ANI  USL       ;1 => LEFT, 0 => RIGHT
       MVI  A,LFTCTU
       RNZ            ;LEFT - RETURN
       MVI  A,RGTCTU
       RET
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CHKFWD - CHECK DIRECTION OF TAPE MOTION
; 
;      EXIT :  Z  => REV; A = 0 
;              NZ => FWD; A = FWD 
; 
CHKFWD EQU  $ 
       LDA  CMND
       ANI  FWD 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CISCAN - CHECK FOR CARTRIDGE INSERTED
; 
;      EXIT :  A,H,L DESTROYED
;              NC => TAPE INSERTED
;              C => NO TAPE 
; 
CISCAN EQU  $ 
       CALL GETSTA    ;GET STATUS 
       MOV  H,A       ;SAVE STATUS
       CALL GTCTBT    ;GET BIT FOR SELECTED UNIT
       ANA  H         ;IS IT INSERTED?
       RNZ            ;YES - RETURN 
       LXI  H,NTPMSG  ;NO - REPORT ERROR
       JMP  CTUERR
 
;*********************************
; CHKEOF - CHECK FOR END OF FILE *
;*********************************
; 
;  EXIT :  Z - NOT END OF FILE
;            A = 0
;          NZ - END OF FILE 
;            A DESTROYED
CHKEOF EQU  $ 
       LDA  CNTRL0    ;GET LOGICAL STATUS 
       ANI  EOF       ;MASK FOR END OF FILE FLAG
       RET            ;RETURN 
;******************************************** 
; CHKEW - CHECK FOR TAPE PAST EARLY WARNING * 
;******************************************** 
; 
;  EXIT :  NZ => TAPE PAST EARLY WARNING
;            A DESTROYED
;            H,L = ADDRESS OF END OF TAPE MESSAGE 
;          Z => NOT PAST EARLY WARNING
;            A = 0
; 
CHKEW  EQU  $ 
       LDA  UNIT0 
       ANI  EW
       RZ 
       LXI  H,EOTMSG
       JMP  CTUERR
 
;***************************************
; CHKEV0 - CHECK FOR END-OF-VALID-DATA *
;***************************************
; 
;  EXIT :  NZ - END-OF-VALID-DATA REACHED 
;            A DESTROYED
;            H,L = ADDRESS TO END-OF-DATA MESSAGE 
;          Z - NOT AT END-OF-VALID-DATA 
;            A = 0
; 
CHKEV0 EQU  $ 
       LDA  CNTRL0    ;GET LOGICAL STATUS 
       ANI  EVD       ;END-OF-DATA REACHED? 
       RZ             ;NO - RETURN
       LXI  H,EVDMSG  ;YES - SET END-OF-DATA MSG
       RET            ;RETURN 
;****************************************** 
; CHKEVD - CHECK FOR END-OF-VALID-DATA OR * 
;   LAST COMMAND WAS A RECORD OPERATION   * 
;****************************************** 
; 
;  EXIT :  NZ => CONDITION TRUE 
;            H,L = ADDRESS OF END OF DATA MESSAGE 
;          Z => CONDITION NOT TRUE
;            A = 0
; 
CHKEVD EQU  $ 
       LDA  CNTRL0
       ANI  EVD+DATATR
       RZ 
       LXI  H,EVDMSG
       JMP  CTUERR
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      STIOFS - SET FLAG(S) IN IOFLGS 
; 
;      ENTRY:  A = BITS TO BE SET 
; 
;      EXIT :  FLAGS SET, A = NEW IOFLGS
;              H,L -> IOFLGS
; 
STIOFS EQU  $ 
       LXI  H,IOFLGS
       ORA  M 
       MOV  M,A 
       RET
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CLIOFS - CLEAR FLAG(S) IN IOFLGS 
; 
;      ENTRY:  A = -1-FLAGS TO BE CLEARED 
; 
;      EXIT :  FLAGS CLEARED, A = NEW IOFLGS
;              Z => NO FLAGS CHANGED
;              NZ => AT LEAST ONE CLEARED 
;              H,L -> IOFLGS
; 
CLIOFS EQU  $ 
       LXI  H,IOFLGS
       ANA  M 
       CMP  M 
       MOV  M,A 
       RET
 
;***********************************************
; HARDWARE DRIVERS *****************************
;***********************************************
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      INTRWD - INTERRUPT DRIVEN REWIND 
; 
;      ENTRY:  H,L -> INTERRUPT ROUTINE TO BE 
;                USED AFTER BOT HOLES HAVE BEEN 
;                SEEN AND TAPE MOTION REVERSED
; 
;      EXIT :  ALL REGISTERS DESTROYED
; 
INTRWD EQU  $ 
       PUSH H         ;SAVE NEXT INTERRUPT ADDRESS
       CALL CISCAN    ;IS CARTRIDGE INSERTED? 
       RC             ;NO - REPORT ERROR
       MVI  A,5       ;SET SOFT COUNT TO 5
       STA  SFTCNT
       CALL REVEVD    ;RECORD EVD IF NEEDED 
       POP  H         ;RECALL INTERRUPT ADDRESS 
       RC             ;RETURN ON ERROR
       SHLD CTIADR    ;SAVE IN CTIADR 
       SUB  A         ;CLEAR A
       STA  CNTRL0    ;CLEAR CONTROL FLAGS
       INR  A 
       STA  FILNUM    ;INITIALIZE FILE COUNT
       MVI  A,CMDEXC  ;SET SUCCESSFUL EXECUTION BI
       CALL STUNT0
       LXI  H,TIRWD   ;GET INTERRUPT VECTOR 
       MVI  A,RUN+FST ;FAST REVERSE COMMAND 
       JMP  OCM000    ;ISSUE COMMAND AND EXIT 
; 
;  INTERRUPT SERVICE ROUTINE
; 
TIRWD  EQU  $ 
       ANI  BOT       ;BEFORE BEGINNING OF TAPE?
       RNZ            ;NO - CONTINUE WAITING
       CALL STOPTP    ;YES - STOP THE TAPE
       LHLD CTIADR    ;GET ADDRESS FOR NEXT INTR
       MVI  A,RUN+FWD+FST 
       JMP  OCM000    ;ISSUE FAST FORWARD COMMAND 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      RWDBOT - REWIND TO BEGINNING OF TAPE 
; 
;      INTERRUPT DRIVEN 
;      FIRST PART (CALL TO INTRWD) DESTROYS ALL RG
;      INTERRUPT ROUTINE DESTROYS NONE
; 
; 
RWDBOT EQU  $ 
       LXI  H,TIRWBT  ;GET INTERRUPT ROUTINE ADDR 
       JMP  INTRWD    ;SET UP REWIND AND RETURN 
; 
;      INTERRUPT ROUTINE - GO BACK OVER BOT HOLES 
;      AND QUIT 
; 
TIRWBT EQU  $ 
       ANI  BOT       ;AFTER BOT HOLES? 
       RZ             ;NO - CONTINUE WAITING
       CALL STOPTP    ;YES - STOP THE TAPE
       JMP  LITOFF    ;TURN OFF INDICATOR LIGHT 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      RWDLP - REWIND TO LOAD POINT 
; 
;      INTERRUPT DRIVEN - REWINDS THE SELECTED TAP
;      TO LOAD POINT
; 
; 
RWDLP  EQU  $ 
       LXI  H,TIRLP0  ;GET INTERRUPT ROUTINE ADDR 
       JMP  INTRWD    ;SET UP REWIND AND RETURN 
; 
;      INTERRUPT ROUTINE - WIND FORWARD TO LOAD PT
;      CALLED WHILE GOING BACK ACROSS BOT HOLES 
; 
TIRLP0 EQU  $ 
       ANI  BOT       ;PAST BEGINNING OF TAPE HOLE
       RZ             ;NO - CONTINUE WAITING
RLP100 EQU  $         ;ENTRY FOR CHKLPM 
       LXI  H,TIRLP1  ;SET UP FOR 2ND ROUTINE 
       MVI  A,RUN+FWD+REC+GEN 
       JMP  OCM000    ;START RECORDING GAP
; 
;      SECOND INTERRUPT ROUTINE - WATCHES FOR LP
;      HOLE.
; 
TIRLP1 EQU  $ 
       ANI  LP        ;AFTER LP HOLE? 
       RZ             ;NO - CONTINUE WAITING
       MOV  A,M       ;CARTRIDGE PROTECTED? 
       CMA              ;(NO RECORD => YES) 
       ANI  (RIP+FPS)/2 ;(BITS ARE SAME - REF BOTH
       ORI  BOT+LP+LPM+LSTFWD+CMDEXC
       STA  UNIT0     ;SET FOR AT LP, LAST MOVE FW
       MVI  L,RELTAK  ;SET RELATIVE TACH COUNTER
       MVI  M,-8        ;TO GENERATE LEADER 
       LXI  H,STRTAK  ;INITIALIZE ABSOLUTE TACH 
       SHLD ABSTAK      ;COUNTER
       LXI  H,TIRLP2  ;SET UP INTERRUPT TO GAP
       SHLD CTIVEC      ;OUT LEADER 
       RET
 
; 
;  THIRD INTERRUPT ROUTINE - GAP OUT LEADER 
; 
TIRLP2 EQU  $ 
       MOV  A,M       ;TEST TAPE STATUS 
       ORA  A 
       RP             ;IF NO TACH, RETURN 
       MVI  L,RELTAK  ;INCREMENT COUNTER
       INR  M         ;=0?
       RNZ            ;NO - RETURN
       JMP  STOPTP    ;YES - STOP TAPE AND EXIT 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CHKLPM - MOVE TO LOAD POINT IF BEFORE LP 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  A,H,L DESTROYED
;              C => ERROR 
;              NC => NO ERROR 
;                NZ => ALREADY THERE
;                Z => MOVED THERE 
CHKLPM EQU  $ 
       LDA  UNIT0     ;BEFORE LP? 
       ANI  LP
       RNZ            ;NO - RETURN
       CALL CISCAN    ;SELECTED TAPE INSERTED?
       RC             ;NO - RETURN ERROR
       CALL RLP100    ;START THE TAPE 
       LXI  H,LLPMSG  ;"LOCATING LOAD POINT"
       CALL CARDI0
LPM010 EQU  $         ;WAIT FOR TAPE TO STOP
       CALL RETSCN    ;LOOK FOR RETURN KEY
       CNC  CTMON1    ;NONE - IS TAPE FINISHED? 
       JNZ  LPM010    ;TAPE STILL RUNNING - WAIT
       JMP  RSTDSP    ;TAPE FINISHED - RESTORE DIS
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      ENDBAK - CONDITION TAPE ON SELECTED DRIVE
;        (WIND OUT TO END-OF-TAPE AND BACK) 
; 
;      THIS IS AN INTERRUPT DRIVEN ROUTINE. 
;      FIRST PART DESTROYS ALL REGISTERS. 
;      INTERRUPT ROUTINE DESTROYS NONE. 
; 
; 
ENDBAK EQU  $ 
       LXI  H,TIEBK   ;GET NEXT INTERRUPT ROUTINE 
       JMP  INTRWD    ;GO TO REWIND ROUTINE 
; 
;      INTERRUPT ROUTINE
;      WATCH 'TRIAL' SINGLE HOLES GO BY, THEN 
;      REWIND 
; 
TIEBK  EQU  $ 
       ANI  EW        ;BEYOND EARLY WARNING YET?
       RZ             ;NO - CONTINUE WAITING
       CALL STOPTP    ;YES - STOP THE TAPE
       PUSH B 
       PUSH D 
       CALL RWDBOT    ;SET UP THE REWIND
       POP  D         ;PREPARE TO EXIT
       POP  B 
       RET            ;DONE - RWDBOT HANDLES REST 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      STOPTP - STOP THE TAPE 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  TAKP0 INC'D BY TACH EDGES IN GAP 
;              CTIVEC -> "DO NOTHING" ROUTINE 
;              INTERRUPTS ENABLED 
;              Z  (REQ'D BY PUTCTU) 
;              NC (REQ'D BY RWDBOT) 
;              A,H,L DESTROYED
; 
;      ENTRY STPTP0:  CLEAR TACH COUNT FIRST
;      ENTRY STPTP1:  USE INTERRUPT VECTOR IN H,L 
; 
; 
STPTP0 EQU  $ 
       SUB  A 
       STA  RELTAK
STOPTP EQU  $ 
       LXI  H,TISTOP  ;SET UP STOP INTR ROUTINE 
STPTP1 EQU  $ 
       LDA  CMND      ;RE-ISSUE COMMAND W/O RUN BI
       ANI  -1-RUN
       CALL OCM000
       EI             ;ENABLE INTERRUPTS
STP100 EQU  $         ;WAIT FOR TAPE TO STOP
       LDA  TPSTAL    ;REQUIRES 50 MSEC W/O A CTU 
       ORA  A           ;INTERRUPT
       JNZ  STP100
       LXI  H,TIDO0   ;TAPE STOPPED 
       SHLD CTIVEC    ;SET UP "DO NOTHING" INT ROU
       RET
;********************************** 
;  "STOP TAPE" INTERRUPT ROUTINE  * 
;********************************** 
TISTOP EQU  $ 
       LDA  HOLCNT    ;CHECKING OUT HOLE? 
       ORA  A 
       MVI  L,CMND      ;(GET COMMAND)
       MOV  A,M 
       RAR              ;(CLEAR "RUN" BIT)
       RLC
       JZ   STP200    ;NO - USE STOP COMMAND
       ORI  RUN       ;YES - USE RUN COMMAND
STP200 EQU  $ 
       CMP  M         ;DESIRED COMMAND ISSUED?
       CNZ  OCM001    ;NO - ISSUE IT
       MVI  L,CTSTAT  ;"DO NOTHG" WANTS H,L->CTSTA
       JMP  TIDO0     ;INC TACH-GAP COUNT & QUIT
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GAPTST - TEST GAP LENGTH FOR FILE MARK 
; 
;      CALLED BY RECORD SPACE AND FILE SPACE -- 
;      INCREMENTS FILNUM BASED ON LENGTH OF LAST
;      GAP PROCESSED (GAP LENGTH IN RELTAK).
; 
;      EXIT :  A,H,L DESTROYED
;              NC => FILNUM CHANGED 
;                A = 0 => DECREMENTED 
;                A # 0 => INCREMENTED 
;              C => FILNUM UNCHANGED
; 
; 
GAPTST EQU  $ 
       LXI  H,CNTRL0  ;GET PTR TO TAPE FLAGS
       MOV  A,M 
       ANI  EVD       ;BACKED OVER EVD? 
       JNZ  GPT030    ;YES - MARK STATUS
       LDA  RELTAK    ;GET LENGTH OF LAST GAP 
       CPI  65        ;INTER-FILE MARK GAP? 
       JNC  GPT010    ;YES - ADJUST FILE COUNT
       CPI  35        ;NO - FILE MARK GAP?
       RC             ;NO - RETURN
       MOV  A,M       ;YES - CHANGE EOF STATUS
       XRI  EOF 
       MOV  M,A 
       RLC            ;EOF AND CMND[FWD] BOTH ON O
       MVI  L,CMND-BASE  ;BOTH OFF => NEW FILE
       XRA  M            ;ENTERED 
       ANI  FWD 
       STC
       RNZ
GPT010 EQU  $         ;ADJUST FILE NUMBER 
       MVI  L,FILNUM
       CALL CHKFWD    ;GOING FORWARD? 
       JZ   GPT020
       INR  M         ;YES - INCREMENT FILE COUNT 
       RET
GPT020 EQU  $ 
       DCR  M         ;NO - DECREMENT FILE COUNT
       RET
GPT030 EQU  $ 
       MVI  M,EOF     ;BACKED OVER EVD - SET EOF
       STC              ;AND CLEAR EVD
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      FWDSPC - SPACE FORWARD N RECORDS, RETURN 
;        WHEN SPACING IS FINISHED 
;      FWDSPX - SAME, BUT RET WHEN SPACING STARTED
;      FWDSP1 - CLEARS RELTAK AND SPACES ONE
;        CHECKS EVD, BUT NOT DATA RECORDED(DATATR)
; 
;      BAKSPW - SPACE BACK N RECORDS, POSITIONING 
;        TAPE FOR WRITE (I.E., RELTAK = LENGTH OF 
;        GAP FROM LAST RECORD) RETURN WHEN FINISHD
;      BAKSPX - SAME, BUT RET WHEN SPACING STARTED
;        IF LAST RECORD IS EOF, GO FORWARD OVER IT
;      BAKSPR - SPACE BACK N RECORDS, POSITIONING 
;        TAPE FOR READ (I.E., DON'T WORRY ABOUT 
;        GAP LENGTHS) 
; 
;      WHEN IN DOUBT, USE BAKSPW!!!!
; 
;      ENTRY:  A = NUMBER OF RECORDS TO SPACE 
;              UNIT SELECTED AND NOT RUNNING
;              H,L = NUMBER OF RECORDS
; 
;      EXIT :  C => ERROR 
;              NC => NO ERROR 
;              A,H,L DESTROYED
; 
FWDSP1 EQU  $ 
       SUB  A         ;CLEAR GAP-TACH COUNTER 
       STA  RELTAK
       LXI  H,1       ;SET FOR ONE RECORD 
       CALL FWDSPX    ;START SPACING
       RC             ;RETURN IF ERROR
FSP020 EQU  $           ;(ENTRY FOR BACKSPACE)
       CALL CTMON1    ;MONITOR TAPES
       JNZ  FSP020    ;LOOP IF TAPE RUNNING 
       RET            ;OTHERWISE, RETURN
 
FWDSPX EQU  $ 
       MOV  A,H 
       ORA  L         ;COUNT = 0? 
       RZ             ;YES - RETURN 
       SHLD CTICNT+1  ;NO - STORE COUNT IN CTICNT+
       SUB  A           ;AND CLEAR "MEASURE GAP"
       STA  CTICNT      ;FLAG 
       CALL CHKLPM    ;MOVE TAPE TO LP IF BEFORE L
       RC             ;RETURN ON ERROR
       CALL CHKEV0    ;AT END OF DATA?
       JNZ  CTUERR    ;YES - QUIT 
       CALL CHKEW     ;NO - PAST EARLY WARNING? 
       RC             ;YES - RETURN ERROR 
       MVI  A,RUN+FWD ;SLOW FORWARD COMMAND 
       JMP  RECSPC    ;GO TO SPACING ROUTINE
BAKSPW EQU  $ 
       MVI  A,-1      ;SET "MEASURE GAP" FLAG 
       JMP  BSP010
BAKSPR EQU  $ 
       MVI  A,0       ;CLEAR "MEASURE GAP" FLAG 
BSP010 EQU  $ 
       CALL BSP020    ;START SPACING
       JMP  FSP020
BAKSPX EQU  $ 
       MOV  A,L 
       DCR  A         ;SKIP ONE RECORD ONLY?
       ORA  H           ;(ADD IN MSB) 
       JNZ  BSP015    ;NO - CONTINUE
       CALL CHKEOF    ;AT END OF FILE?
       RNZ            ;YES - RETURN AT ONCE 
BSP015 EQU  $ 
       MVI  A,1       ;SET "BACK OVER EOF" FLAG 
BSP020 EQU  $ 
       STA  CTICNT    ;SET SKIP FLAG
       MOV  A,H       ;SKIP COUNT NON-ZERO? 
       ORA  L 
       RZ             ;NO - RETURN
       SHLD CTICNT+1  ;YES - STORE COUNT
       LDA  UNIT0     ;BEFORE LP? 
       ANI  LP
       RZ             ;YES - RETURN 
       SUB  A         ;NO - CLEAR GAP COUNTER 
       STA  RELTAK
       MVI  A,RUN     ;SLOW BACK COMMAND
;                     FALL INTO SPACING ROUTINE 
 
; 
;   SPACE OVER N RECORDS
; 
RECSPC EQU  $ 
       LHLD CTICNT+1  ;GET # OF RECORDS TO SKIP 
       PUSH B           ;(SAVE B,C) 
       LXI  B,-12     ;MORE THAN 12 RECORDS TO
       DAD  B           ;SKIP?
       POP  B           ;(RESTORE B,C AND SET 
       LXI  H,TIRSP0       ;INTR TO WAIT FOR DATA)
       JNC  OUTCMD    ;NO - ISSUE COMMAND AND EXIT
       ORI  FST       ;YES - USE HIGH SPEED SKIP
       JMP  OUTCMD    ;ISSUE COMMAND AND EXIT 
; 
;    WAIT FOR DATA - INTERRUPT ROUTINE
; 
TIRSP0 EQU  $ 
       ANI  LP        ;BEFORE LP? 
       JZ   STPTP0    ;YES - QUIT 
       MOV  A,M       ;GET STATUS 
       ANI  GAP       ;STILL IN GAP?
       JNZ  SRC600    ;YES - CHECK FOR EVD
; 
;    DATA FOUND - EVALUATE GAP
; 
       CALL GAPTST    ;CHECK GAP TYPE, AND UPDATE 
;                       EOF STATUS AND FILE NUMBER
RSP040 EQU  $           ;(ENTRY FOR FWD OVER EOF) 
       SUB  A         ;CLEAR GAP COUNTER
       STA  RELTAK
       LHLD CTICNT+1  ;BACKSPACING OVER FINAL GAP?
       MOV  A,H         ;(COUNT = 0 => YES) 
       ORA  L 
       LXI  H,TIRSP1  ;NO - SET INTERRUPT TO WAIT 
       SHLD CTIVEC      ;FOR GAP
       RNZ              ;AND EXIT 
       CALL STOPTP    ;YES - STOP THE TAPE
       MVI  A,1         ;SET COUNT TO 1 
       STA  CTICNT+1
       LXI  H,TIRSP0  ;WAIT FOR DATA INT ROUT 
       MVI  A,RUN+FWD   ;START SAPCING FORWARD
       JMP  OCM000
; 
;    WAIT FOR GAP - INTERRUPT ROUTINE 
; 
TIRSP1 EQU  $ 
       ANI  LP        ;BEFORE LP? 
       JZ   STPTP0    ;YES - QUIT 
       LDA  IOCTDI    ;CLEAR POSSIBLE BYTE READY
       MOV  A,M       ;GET STATUS 
       ANI  GAP       ;IN GAP YET?
       MVI  L,RELTAK    ;(GET POINTER TO TACH)
       JNZ  RSP110
       MVI  M,0       ;NO - CLEAR GAP LENGTH COUNT
       RET              ;AND RETURN 
RSP110 EQU  $         ;YES -
       INR  M         ;INCREMENT GAP LENGTH COUNT 
       MOV  A,M         ;(GAP >= 3 - ASSUME GAP)
       CPI  3           ;(GAP < 3 - ASSUME DROPOUT
       RC             ;GAP NOT YET 3 - RETURN 
       LXI  H,TIRSP0  ;GAP >= 3 - SET INTERRUPT TO
       SHLD CTIVEC      ;WAIT FOR DATA
       LHLD CTICNT+1  ;GET SKIP COUNTER 
       DCX  H         ;DECREMENT COUNT
       SHLD CTICNT+1  ;UPDATE COUNTER 
       MOV  A,H 
       ORA  A         ;SKIP COMPLETED?
       RNZ            ;NO - CONTINUE SKIPPING 
       ORA  L         ;BOTH MSB AND LSB = 0?
       JZ   RSP120    ;YES - TERMINATE SKIP 
       CPI  12        ;LESS THAN 12 MORE TO GO? 
       RNC            ;NO - CONTINUE HIGH SPEED 
       LDA  CMND      ;YES - CLEAR THE FAST BIT 
       ANI  -1-FST      ;TO START SLOW SKIP 
       JMP  OCM001    ;OUTPUT THE COMMAND AND EXIT
;****************************************** 
; SKIP COMPLETED - CHECK TERMINATION TYPE * 
;****************************************** 
RSP120 EQU  $ 
       LXI  H,CTICNT  ;GET SKIP FLAG
       ORA  M         ;WHAT TYPE ENDING?
       MVI  M,0         ;(CLEAR SKIP FLAG)
       JZ   STOPTP    ;NO ACTION - STOP TAPE & RET
       RM             ;BACK TO WRITE - SPC OVER GA
       CALL CHKEOF    ;AT END OF FILE?
       JNZ  RSP040    ;YES - SPACE OVER FILE MARK 
       MVI  A,EOFINH  ;NO - INHIBIT END OF FILE 
       JMP  SETCT0      ;REPORT AND EXIT
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      EVDBSP - BACKSPACE OVER EVD IF NEEDED
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  A,H,L DESTROYED
;              C => TAPE REMOVED
;              NC => NO ERROR 
;                TAPE STOPPED 
; 
; 
EVDBSP EQU  $ 
       CALL CHKEV0    ;AT END OF DATA MARK? 
       RZ             ;NO - RETURN
       LXI  H,1       ;YES - BACKSPACE ONE RECORD 
       CALL BAKSPW    ;BAKSPW WAITS UNTIL FINISHED
       JMP  CHKLPM    ;GO FWD IF EVD WAS ONLY THIN
;                       ON TAPE 
 
;************************************ 
; EOFC - RECORD AN EOF MARK ON TAPE * 
;************************************ 
EOFC   EQU $
       CALL GTIOB0    ;GET A BUFFER 
       RC             ;RETURN ON ERROR
       CALL GTCTBT    ;YES - GET BIT FOR THIS UNIT
       MOV  M,A       ;MARK BUFFER BUSY 
       MOV  B,A       ;BUF2CT WANTS BIT IN B-REG
       DCX  H         ;H,L -> TYPE
       MVI  M,0       ;MARK EOF 
       DCX  H         ;MARK LENGTH = 1
       MVI  M,1 
       INX  H 
       INX  H 
       XCHG           ;BUF2CT WANTS D,E -> STATUS 
       JMP  BUF2CT    ;BUF2CT HANDLES REST
 
;******************************************** 
; REVEVD - RECORD AN EVD ON A REVERSE TAPE  * 
;          COMMAND AFTER A RECORD OPERATION * 
; 
;      ENTRY:  B = INCREMENT FOR "IOCCNT" 
;              IF EVD NEEDED
; 
;      EXIT :  ALL REGISTERS DESTROYED
; 
REVEVD EQU $
       LDA  CNTRL0    ;GET TAPE STATUS
       ANI DATATR   ;WAS LAST CMND RECORD?
       RZ           ;NO - RETURN
       LXI  H,IOCCNT
       MOV A,M      ;FETCH SPACE COUNT
       ADD B        ;ADD IN INCREMENT 
       MOV M,A      ;STORE NEW COUNT
EVDWAT EQU  $         ;ENTRY TO WRITE EVD AND WAIT
       CALL EVDC      ;START RECORDING EVD
       RC             ;RETURN ON ERROR
REV010 EQU  $ 
       CALL CTMON1    ;TAPE STILL MOVING? 
       JNZ  REV010    ;YES - WAIT 
       RET            ;NO - RETURN
 
;************************************ 
; EVDC - RECORD AN EVD MARK ON TAPE * 
;************************************ 
EVDC   EQU  $         ;WAIT FOR A BUFFER
       CALL GTIOB0    ;GET A BUFFER 
       RC             ;RETURN ON ERROR
       CALL GTCTBT    ;GET BIT FOR SELECTED UNIT
       MOV  M,A       ;MARK BUFFER BUSY 
       MOV  B,A       ;BUF2CT TAKES UNIT IN B 
       DCX  H         ;BUF FREE - H,L -> TYPE 
       MVI  M,1       ;MARK EVD 
       INX  H         ;H,L -> STATUS
       XCHG           ;BUF2CT TAKES BUF PTR IN D,E
       JMP  BUF2CT    ;START THE WRITE
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      FILCMP - COMPARE FILNUM AND IOCCNT 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  Z  => SAME 
;              NZ => DIFFERENT
;                 C  => PRESENT < NEEDED
;                 NC => PRESENT > NEEDED
; 
; 
FILCMP EQU  $ 
       CALL CHKFWD    ;GOING FORWARD? 
FILCM1 EQU  $           ;(ENTRY TO AVOID FWD CHECK
       LDA  FILNUM      ;(GET PRESENT FILE COUNT) 
       JNZ  FCP100    ;YES - USE ACTUAL FILE COUNT
       INR  A         ;NO - TARGET IS PREVIOUS FIL
FCP100 EQU  $ 
       LXI  H,CTICNT+1  ;PTR TO NEEDED FILE COUNT 
       CMP  M         ;COMPARE
       RET
 
;***********************************************
; LOGICAL DRIVERS ******************************
;***********************************************
;*********************************
; SELECT UNIT INDICATED IN A-REG *
;*********************************
SELACT EQU  $ 
       RRC            ;RIGHT UNIT SELECTED? 
       JNC  SELRCT    ;YES - GO GET IT
;**************************** 
; SELLCT - SELECT LEFT UNIT * 
;**************************** 
SELLCT  EQU $ 
       CALL GTCTBT    ;UNIT ZERO (LEFT) SELECTED? 
       RNZ          ;YES - DON'T SWAP VARIABLES 
SELOPP EQU $
       PUSH B         ;SAVE REGISTERS 
       PUSH D 
       LXI  H,SFTCNT  ;BOTTOM OF ACTIVE LIST
       LXI  D,OTHER   ;BOTTOM OF RESERVE LIST 
       MVI  C,SFTCNT-OTHER  ;VARIABLE COUNT 
XCH050 EQU $
       MOV B,M      ;GET ACTIVE VAR.
       LDAX D         ;GET RESERVE VARIABLE 
       MOV  M,A       ;RESTORE RESERVE VARIABLE 
       MOV  A,B       ;SAVE ACTIVE VARIABLE 
       STAX D 
       INX  H         ;INCREMENT ACTIVE POINTER 
       INX  D         ;INCREMENT RESERVE POINTER
       DCR C        ;HAVE ALL VAR. BEEN SWAPPED?
       JNZ XCH050   ;NO - KEEP GOING
       MVI L,CMND 
       DI             ;STAY OUT OF INTERRUPT ROUT 
       MOV A,M
       XRI  USL       ;SWITCH UNITS 
       MOV M,A
       STA  IOCTCO    ;ISSUE COMMAND
       LDA  IOCTSI    ;CLEAR ANY BAD INTERRUPTS 
       LDA  IOCTDI
       EI             ;(CANNOT CHANGE UNITS UNDER 
;                       INTRRUPT) 
       POP  D         ;RESTORE REGISTERS
       POP  B 
       RET
;*****************************
; SELRCT - SELECT RIGHT UNIT *
;*****************************
SELRCT  EQU $ 
       CALL GTCTBT    ;UNIT ONE (RIGHT) SELECTED? 
       RZ           ;YES - DON'T SWAP VARIABLES 
       JMP SELOPP   ;SWAP VARIABLES 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      BSYCHK - CHECK IF CTU BUSY 
; 
;      THIS ROUTINE WAITS UNTIL CTU NOT BUSY OR 
;      USER INTERRUPT.  DISPLAYS "CTU BUSY" MESSAG
;      TAPES INSERTED DURING THE WAIT ARE REWOUND 
;      BEFORE BSYCHK RETURNS. 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  NC => CTU NOT BUSY 
;              C => USER INTERRUPTED
;              A,H,L DESTROYED
; 
; 
BSYCK0 EQU  $ 
       LDA  INPDEV    ;IS INPUT A TAPE? 
       ANI  -1-LFTCTU-RGTCTU
       RNZ            ;NO - RETURN NZ, NC 
BSYCHK EQU  $ 
       CALL CTMON1    ;CTU BUSY ("RUN" SET)?
       JZ   RSTDSP    ;NO - RETURN
BSY010 EQU  $         ;WAIT TIL NOT BUSY
       LXI  H,BSYMSG  ;PRINT BUSY MESSAGE 
       CALL CARDI0
       CALL RETSCN    ;RETURN KEY HIT?
       JC   RSTDSP    ;YES - RETURN 
       CALL CTMON1    ;MONITOR TAPES
       JNZ  BSY010    ;STILL RUNNING - WAIT 
       CALL CTMON     ;STOPPED - CHECK FOR NEW TAP
       JMP  BSYCHK    ;WAIT TIL NOT BUSY
 
;***********************************************
; CTU ENTRY POINTS FOR ESCAPE SEQUENCES ********
; AND USER INTERFACE                    ********
;***********************************************
;*****************************************
; CTUERR - ERROR RETURN FROM CTU DRIVERS *
;*****************************************
CTUERR EQU $
       LDA  UNIT0     ;TURN OFF "COMMAND COMPLETED
       ANI  -1-CMDEXC   ;BIT
       STA  UNIT0 
CTUER1 EQU $
       CALL IOFAIL    ;SET ERROR FLAG 
;********************************************** 
; SLTPMS - GET MESSAGE FOR SELECTED TAPE UNIT * 
;********************************************** 
SLTPMS EQU  $ 
       SHLD MSGPT1    ;STORE POINTER TO ERROR MSG 
       CALL GTCTBT    ;SET UP PTR TO UNIT MSG 
SLTPM1 EQU  $         ;ENTRY FOR CMPARE ROUTINE 
       LXI  H,OLTPMS    ;"LEFT TAPE" MESSAGE
       JNZ  CTUER2
       LXI  H,ORTPMS    ;"RIGHT TAPE" MESSAGE 
CTUER2 EQU  $ 
       SHLD MSGPT2
       LXI  H,EOPMSG  ;SET SECOND HALF TO NO
       SHLD MSGPT3      ;MESSAGE
       XRA A        ;SET A REG = 0
       STC
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CT2BUF - READ A CTU RECORD 
; 
;      ENTRY: D,E -> STATUS OF LAST BUFFER RETURND
;               (DON'T CARE FOR FIRST READ) 
;      EXIT : NC => SUCCESSFUL READ 
;               D,E -> NEW BUFFER STATUS
;             C => ERROR
;               IOCERR=U => USER INTERRUPTED
;               IOCERR=F => FAILURE 
;                 MSGPTX -> ERROR MSG 
;             KILLS ALL REGISTERS 
; 
LCT2BF EQU  $         ;PUT FLAG FOR UNIT IN B 
       MVI  B,LFTCTU
       JMP  CT2BUF
RCT2BF EQU  $ 
       MVI  B,RGTCTU
CT2BUF EQU  $ 
       LDA  CMND      ;GET COMMAND FOR READ INIT
       MOV  C,A 
       CALL CHGBUF    ;LOOK AT OTHER BUFFER 
       LDAX D         ;IS IT READY? 
       CMP  B           ;(STATUS=INPUT UNIT => YES
       JZ   C2B020    ;YES - START NEXT READ & EXI
       CALL CHGBUF    ;NO - IS FIRST BUF READY? 
       LDAX D 
       CMP  B 
       JZ   C2B020    ;YES - START NEXT READ
       CALL RDINIT    ;NO - SET UP READ 
       CNC  CTMON1    ;IF NO ERROR, MONITOR TAPES 
       JNC  CT2BUF    ;IF NO ERROR, CHECK AGAIN 
       RET
C2B020 EQU  $ 
       DCX  D         ;D,E -> TYPE
       LDAX D         ;A = RECORD TYPE
       INX  D 
       LXI  H,XFRLIM  ;H,L -> TRANSFER LIMIT
       CMP  M         ;LIMIT REACHED? 
       MVI  L,CMND-BASE  ;(GET CMND FOR INIT) 
       MOV  C,M 
       CM   RDINIT    ;NO-ATTEMPT TO INIT NEXT REA
       ORA  A         ;NC => LAST READ OK 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     RDINIT - START READING TAPE RECORD
; 
;     CALLED BY CT2BUF
; 
;     ENTRY: B=FLAG FOR UNIT (1=LFTCTU, 2=RGTCTU) 
;            C=TAPE COMMAND (CHECKED FOR RUN BIT) 
; 
;     EXIT : NC => NO ERROR, READ STARTED IF CTU
;              NOT BUSY AND BUFFER AVAILABLE
;            C => ERROR (NO TAPE OR HARD ERROR OR 
;              LAST FCN=RECORD OR EVD)
;              MSGPTX SET FOR ERROR MSG 
;            A,H,L DESTROYED
; 
; 
RDINIT EQU  $ 
       MOV  A,C       ;TAPE RUNNING?
       ANI  RUN 
       RNZ              ;YES-RETURN (NC=>NO ERROR)
       MOV  A,B       ;SELECT UNIT
       CALL SELACT
       CALL CISCAN    ;TAPE INSERTED? 
       CNC  CHKEVD    ;AT EVD OR DATA RECORDED? 
       RC             ;REPORT ANY ERROR 
       LXI  H,CNTRL0
       MOV  A,M       ;HARD ERROR?
       ANI  HRDER1
       JZ   RDI020    ;NO - CONTINUE INITIALIZATIO
       MOV  A,M       ;YES - CLEAR INTERRUPT FLAG 
       ANI  -1-HRDER1-SFTERR   ;SOFT ERROR
       ORI  HRDERR    ;SET HARD ERROR FLAG
       MOV  M,A 
       LXI  H,HRDMSG  ;ERROR MESSAGE
       JMP  CTUERR    ;REPORT ERROR AND EXIT
RDI020 EQU  $ 
       CALL CHKLPM    ;WIND TO LP IF NOT PAST LP
       RC             ;RETURN ON ERROR
;                     FALL INTO RDNEXT
 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
; 
;     RDNEXT - START READING NEXT TAPE RECORD 
; 
;     CALLED BY INTERRUPT ROUTINE AND RDINIT
; 
;     ENTRY: UNIT SELECTED
; 
;     EXIT : C,NZ => USER INTERRUPT 
;            NC => NO ERROR 
;              Z => READ STARTED
;              NZ => NO BUFFER AVAILABLE
;            A,H,L DESTROYED
; 
; 
RDNEXT EQU  $ 
       CALL RETSCN    ;CHECK FOR USER INTERRUPT 
       INR  A           ;(INSURE TNZ) 
       RC 
       CALL GTIOBF    ;BUFFER AVAILABLE?
       RNZ              ;NO - RETURN
       MVI  M,200Q    ;YES - MARK IT BUSY 
       SHLD CTISPT      ;STORE STATUS POINTER 
       SUB  A         ;CLEAR CONTROL FLAGS
       STA  CNTRL0
       MVI  A,9       ;EACH RECORD GETS (RE-TRYS) 
RDVERF EQU  $         ;ENTRY FOR VERIFY MODE
       STA  CTITRL
       MOV  A,L       ;GET POINTER TO FIRST BYTE
       CALL GETPT1
       SHLD CTIBPT      ;STORE POINTER
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     RDSTRT - SET UP RECORD READ 
; 
;     CALLED BY INTERRUPT ROUTINES VIA RDRTY
; 
;     ENTRY: CTISPT -> STATUS OF SELECTED BUFFER
;            CTIBPT -> FIRST BYTE 
; 
;     EXIT : NC (NO ERROR POSSIBLE) 
;            A,H,L DESTROYED
; 
; 
RDSTRT EQU  $ 
       LXI  H,GETPRM  ;SET STATUS=WAIT FOR PREAMBL
       SHLD CTIADR
       MVI  A,128     ;SET GAP COUNT-DOWN=128 (>4"
       STA  CTICNT
       LXI  H,TIGCT0  ;FIRST, WAIT FOR GAP
       MVI  A,RUN+FWD ;START TAPE RUNNING AND RET 
       CALL OUTCMD
       SUB  A         ;NC,Z => READ STARTED 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      WATGAP - WAIT FOR THE BEGINNING OF A GAP 
; 
;      THIS ROUTINE INSURES THAT POSTAMBLE BYTES
;      FROM ONE RECORD WILL NOT BE MISTAKEN FOR 
;      PREAMBLE BYTES OF THE NEXT.
; 
; 
TIGCT0 EQU  $ 
       MOV  A,M       ;GET STATUS 
       ANI  GAP       ;IN GAP?
       LDA  IOCTDI      ;(CLEAR BYTE READY) 
       RZ             ;NO - CONTINUE WAITING
       LXI  H,TIGCT1  ;YES - SET UP RECORD-READING
       SHLD CTIVEC      ;INTERRUPT ROUTINE
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GETCTU - INTERRUPT SERVICE ROUTINES FOR
;           CARTRIDGE TAPE READ 
; 
;      ENTRY (FIRST CALL):
;              CTIADR -> GETPRM (WAIT FOR PREAMBL)
;              CTICNT = 128 (COUNT FOR EVD GAP) 
;              CTISPT -> BUF STATUS 
;              CTIBPT -> FIRST BYTE OF BUFFER 
TIGCT1 EQU  $ 
       MOV  A,M       ;GET STATUS 
       RLC
       ADD  A         ;C=BYTE RDY, S=GAP
       JC   GCT010    ;BYTE READY - PROCESS 
       RP             ;NO GAP - ASSUME TACH & RET 
       LDA  CTIADR    ;TACH EDGE IN GAP - GET STAT
       CPI  GETPRM*256/256  ;WAITING FOR PREAMBLE?
       JNZ  RDRTRY    ;NO - ASSUME DROPOUT & RETRY
       MVI  L,CTICNT  ;YES -
       DCR  M         ;DECREMENT GAP LENGTH COUNT 
       RNZ            ;NOT ZERO - CONTINUE WAITING
       LHLD CTISPT    ;GET POINTER TO BUFFER STATU
       CALL GTCTBT    ;GET BIT FOR SELECTED UNIT
       MOV  M,A       ;MARK BUF READY 
       DCX  H         ;H,L -> TYPE
       MVI  M,1         ;1=EVD
       CALL STOPTP    ;STOP THE TAPE
       MVI  A,EVD     ;MARK TAPE AT EVD 
       STA  CNTRL0
       LDA  IOFLGS    ;VERIFY MODE? 
       ANI  VERIFY
       RZ             ;NO - RETURN
       CALL FREBFS    ;YES - CLEAR BUFFERS
       JMP  B2C105      ;AND REPORT ERROR 
GCT010 EQU  $         ;PROCESS BYTE 
       LDA  IOFLGS    ;CHECK FOR VERIFY MODE
       ANI  VERIFY
       LDA  IOCTDI    ;GET DATA 
       LHLD CTIADR    ;GO TO CORRECT SUBROUTINE 
       PCHL 
GETPRM EQU  $         ;GET PREAMBLE BYTE
       LXI  H,GETMSB  ;GET MSB NEXT 
       JMP  GCT100
GETMSB EQU  $ 
       STA  CTICSM    ;INIT CKSUM 
       LHLD CTISPT    ;SET RECORD TYPE
       DCX  H           ;H,L->TYPE
       JZ   GCT020    ;READ OR VERIFY?
       XRA  M         ;VERIFY - CHECK FOR HIGH BIT
;                         ON (FILE MARK) AND
;                         TYPE = -1 (DATA RECORD) 
       JP   RDRTRY      ;DIFFERENT TYPES - ERROR
       XRA  M           ;RESTORE MSB
       STA  CTICNT      ;SAVE IN CTICNT 
       JMP  GCT035      ;SET UP FOR LSB 
GCT020 EQU  $         ;READ - 
       MVI  M,377Q      ;NORMAL 
       ORA  A           ;(MSB=1 => FILE MARK) 
       JP   GCT030
       INR  M           ;FILE MARK
GCT030 EQU  $ 
       DCX  H         ;SAVE MSB (MINUS FILE MARK
       ANI  177Q        ;INDICATOR) IN LENGTH 
       MOV  M,A 
       CPI  2         ;IS MSB IN BOUNDS (<=1)?
       JP   RDRTRY      ;NO - RDRTRY
GCT035 EQU  $ 
       LXI  H,GETLSB  ;GET LSB NEXT 
       JMP  GCT100      ;YES - SET STATUS = GET LS
GETLSB EQU  $ 
       LHLD CTISPT    ;CHECK FOR VALID LENGTH 
       DCX  H 
       DCX  H         ;GET POINTER TO BUFFER LENGT
       JZ   GCT040    ;READ OR VERIFY MODE? 
       CMP  M         ;VERIFY - IS LSB SAME AS
       JNZ  RDRTRY      ;BUFFER LEN (NO => ERROR) 
       LXI  H,CTICNT    ;YES - SET H,L TO POINT TO
;                       THE MSB FOR THE NEXT TEST 
GCT040 EQU  $         ;READ - CHECK LENGTH > 0 AND
       ORA  A           ;LENGTH < 257 
       JZ   GCT060
       DCR  M         ;LSB # O, CHECK MSB 
       JZ   RDRTRY    ;LSB # O, MSB # O: ERROR
       MOV  M,A 
GCT050 EQU  $         ;NO-ERROR - SAVE LENGTH 
       STA  CTICNT
       LXI  H,CTICSM  ;UPDATE CHECKSUM
       ADD  M 
       MOV  M,A       ;SET STATUS = GET DATA
       LXI  H,GETDAT  ;GET DATA NEXT
       JMP  GCT100
GCT060 EQU  $         ;LSB = O; CHECK MSB 
       DCR  M         ;IF MSB=O,ERROR 
       JZ   GCT050    ;ELSE SET LEN=O, GET DATA 
       JMP  RDRTRY    ;ERROR - RETRY
GETDAT EQU  $ 
       LHLD CTIBPT    ;GET BUFFER POINTER 
       JZ   GCT070    ;READ OR VERIFY MODE? 
       CMP  M         ;VERIFY - SAME AS BYTE IN 
       JNZ  RDRTRY      ;BUFFER? NO => ERROR
GCT070 EQU  $ 
       MOV  M,A       ;STORE BYTE IN BUFFER 
       INX  H 
       SHLD CTIBPT
       LXI  H,CTICSM  ;UPDATE CHECKSUM
       ADD  M 
       MOV  M,A 
       MVI  L,CTICNT*256/256
       DCR  M         ;DECREMENT COUNT
       RNZ            ;MORE BYTES - RETURN
       LXI  H,GETCSM  ;GET CHECKSUM NEXT
GCT100 EQU  $         ;UPDATE STATUS FOR NEXT 
       SHLD CTIADR    ;SAVE ADDRESS OF NEXT SUBROU
       RET
GETCSM EQU  $ 
       LXI  H,CTICSM  ;GET RUNNING CHECKSUM 
       CMP  M         ;COMPARE WITH DATA
       JNZ  RDRTRY    ;NOT OK- RETRY
       LDA  IOFLGS    ;READ OR VERIFY MODE? 
       ANI  VERIFY
       JNZ  STPTP0    ;VERIFY - CLEAR TACH AND QUI
       CALL GTCTBT    ;GET BIT FOR SELECTED UNIT
       LHLD CTISPT
       MOV  M,A 
       DCX  H 
       MOV  A,M       ;FILE MARK? 
       ORA  A 
       JNZ  GCT320    ;NO - START NEXT READ 
       LHLD CTIBPT      ;YES-GET FILE NUMBER
       MVI  L,0 
       MOV  A,M       ;UPDATE CURRENT FILE NUMBER 
       INR  A 
       LXI  H,FILNUM
       MOV  M,A       ;SAVE IN RAM
       MVI  A,EOF     ;SET END OF FILE STATUS 
       CALL SETCT0
       SUB  A         ;0="FILE MARK" RECORD 
GCT320 EQU  $ 
       MVI  L,RELTAK*256/256
       MVI  M,0       ;CLEAR GAP-LENGTH COUNTER 
       MVI  L,XFRLIM  ;TRANSFER LIMIT REACHED?
       CMP  M 
       JP   STOPTP      ;YES - STOP TAPE & RETURN 
       LXI  H,TIDO0   ;SET UP "DO NOTHING" ROUTINE
       SHLD CTIVEC    ;TO COUNT GAP TACHS WHILE 
       EI             ;STARTING NEXT READ 
       CALL RDNEXT      ;NO - START NEXT RECORD 
       RZ             ;SUCCESSFUL RDINIT - RETURN 
       JMP  STOPTP    ;UNSUCCESSFUL - STOP TAPE 
RDRTRY EQU  $ 
       LXI  H,CTITRL  ;CTITRL=0 => FATAL ERROR (TO
       DCR  M           ;MANY RE-READS OF ONE REC)
       LXI  H,CNTRL0    ;(GET ERROR BITS) 
       MOV  A,M 
       JZ   GCT420    ;HARD ERROR - QUIT
       ORI  SFTERR    ;SOFT ERROR - SET BIT 
       MOV  M,A 
       CALL STOPTP    ;STOP THE CTU 
       CALL STRTRY    ;START THE RETRY (BACK 2 REC
;                       THEN FORWARD ONE) 
       RC             ;RETURN ON ERROR
       SUB  A         ;SET POINTER TO FIRST BYTE
       STA  CTIBPT      ;OF BUFFER
       JMP  RDSTRT    ;START THE RE-READ
GCT420 EQU  $         ;FATAL ERROR
       ANI  -1-SFTERR ;TURN OFF SOFT ERROR BIT
       ORI  HRDER1    ;SET HARD ERROR FLAG
       MOV  M,A 
       JMP  FWDSP1    ;CLEAR THE BAD RECORD 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      STRTRY - SET UP A READ/RECORD RETRY
; 
;      EXIT :  TAPE SPACED BACK TWO (TO GET OVER
;                SCRAPER) AND FORWARD ONE.
;              A,H,L DESTROYED
; 
; 
STRTRY EQU  $ 
       LDA  IOFLGS    ;VERIFY MODE? 
;************** 
; ROM BREAK 1 * 
;************** 
       JMP  ZBRK1C    ;GO TO NEXT ROM BLOCK 
       ORG  CTSTRT+4000Q
ZBRK1  EQU  $ 
       DB   VERSN     ;ROM PRESENT/VERSION FLAGS
       DB   ZBRK1/256 
ZBRK1C EQU  $ 
       ANI  VERIFY
       JNZ  SRT500    ;YES - DON'T TOUCH SFTCNT 
       LXI  H,SFTCNT  ;SFTCNT<-0 => DISPLAY "RETRY
       DCR  M           ;MSG (TOO MANY RETRIES ON 
       JNZ  SRT500      ;ONE PASS)
       INR  M         ;RESET SFTCNT TO 1 FOR NEXT 
       LXI  H,RTRYMS    ;RETRY
       CALL CARDI0    ;DISPLAY "RETRY"
SRT500 EQU  $ 
       LXI  H,2       ;BACKSPACE TWO RECORDS TO RU
       CALL BAKSPR      ;TAPE OVER SCRAPER
       CNC  CHKLPM    ;NO ERR - MOVE TO LP IF BEHN
       CNZ  FWDSP1    ;NO ERR, NO ADV TO LP - FWD 
       JMP  RSTDSP    ;RESTORE DISPLAY AND RETURN 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     BUF2CT - RECORD I/O BUFFER ON TAPE
; 
;     ENTRY: D,E -> BUFFER STATUS 
;            MDFLG2[WBSR]=1 => WRITE/BS/READ
; 
;     EXIT : D,E -> BUFFER STATUS 
;            NC => SUCCESS
;              BXSTAT[XXXCTU] CLEARED 
;              W/BS/R MODE => SUCCESSFUL WRITE
;              NOT W/BS/R => SUCCESSFUL WRITE INIT
;            C => FAILURE 
;            A,B,C,H,L DESTROYED
; 
; 
BF2LCT EQU  $         ;PUT UNIT SELECT FLAG IN B
       MVI  B,LFTCTU
       JMP  BUF2CT
BF2RCT EQU  $ 
       MVI  B,RGTCTU
BUF2CT EQU  $         ;WORKING ON THIS BUFFER?
       LDAX D 
       ANA  B 
       JZ   B2C015
       CALL WRINIT    ;THIS BUFFER NOT STARTED -
       CNC  CTMON1    ;CHECK TAPES ON NO ERROR
       JNC  BUF2CT    ;TRY AGAIN ON NO ERROR
       CALL SETCTW    ;WRITE ERROR - SET ERROR FLA
       STC            ;C => ERROR 
       RET
B2C015 EQU  $         ;BUFFER FINISHED - CHECK FOR
       LDA  CNTRL0      ;SUCCESSFUL COMPLETION
       ANI  WRTERR
       STC              ;(SET CARRY, IN CASE) 
       RNZ            ;RETURN ON ERROR
;***************************
;  SUCCESSFUL WRITE START  *
;***************************
       CMC            ;CLEAR ERROR FLAG 
       DCX  D         ;WHAT TYPE OF RECORD? 
       LDAX D           ;-1 => NORMAL 
       INX  D           ;0 => EOF 
       DCR  A           ;1 => EVD 
       RZ             ;EVD - DO NOT CHK FOR W/BS/R
       LDA  MDFLG2    ;WRITE/BS/READ MODE?
       ANI  WBSR
       RZ             ;NO - RETURN (NC => SUCCESS)
       MVI  C,9       ;YES - INIT ATTEMPTS COUNTER
B2C030 EQU  $         ;SEE IF RECORD IS DONE
       CALL CTMON1    ;TAPE STILL RUNNING?
       RC             ;RETURN ON STALL OR NO TAPE 
       JNZ  B2C030    ;STILL RUNNING - WAIT 
B2C040 EQU  $         ;WRITE FINISHED 
       LXI  H,1       ;BACKSPACE TO READ
       CALL BAKSPR
       MVI  A,VERIFY  ;PUT IN VERIFY MODE 
       CALL STIOFS
       MOV  H,D       ;COPY BUF STATUS POINTER
       MOV  L,E 
       MVI  A,2       ;ALLOW ONE RE-TRY 
       CALL RDVERF    ;START THE VERIFY 
B2C050 EQU  $         ;WAIT FOR VERIFY COMPLETION 
       CALL CTMON1    ;TAPE STOPPED YET?
       JNZ  B2C050    ;NO - CONTINUE WAITING
       PUSH PSW       ;YES - SAVE FLAGS 
       MVI  A,-1-VERIFY 
       CALL CLIOFS    ;TURN OFF VERIFY MODE 
       POP  PSW       ;RECALL FLAGS 
       RC             ;RETURN ON STALL OR NO TAPE 
       MVI  L,CNTRL0  ;WAS VERIFY SUCCESSFUL? 
       MOV  A,M         ;(HRDER1 = 0)?
       ANI  -1-HRDER1 
       CMP  M 
       JNZ  B2C100    ;NO - RE-RECORD 
       LDAX D         ;RELEASE BUFFER (CLEAR BIT
       ANI  -1-BUFBSY   ;IN BUF STATUS HOLDING BUF
       STAX D           ;FOR UNSPECIFIED UNIT)
       RET
;***********************************
;  WRITE ERROR - TRY RE-RECORDING  *
;***********************************
B2C100 EQU  $ 
       DCR  C         ;FATAL ERROR (8 RETRYS)?
       JNZ  B2C110    ;NO - INIT RE-RECORD
       ANI  -1-SFTERR ;YES - CLEAR SOFT ERROR BIT 
       ORI  DATATR+HRDERR+WRTERR  ;SET HARD ERROR 
       MOV  M,A         ;AND "DATA RECORDED" BITS 
B2C105 EQU  $         ;ENTRY FOR BAD EVD READ 
       LXI  H,WRFMSG  ;WRITE FAIL MESSAGE 
       JMP  CTUERR    ;REPORT ERROR 
;***********************
;  START RE-RECORDING  *
;***********************
B2C110 EQU  $ 
       MOV  M,A       ;TURN OFF CNTRL0 [HRDER1] 
       CALL STRTRY    ;BACKSP 2, FWDSP 1 FOR RETRY
       CNC  WRINIT    ;RETRY ON NO SPACING ERROR
       LXI  H,CNTRL0    ;(GET ERROR BITS) 
       MOV  A,M 
       JC   B2C150    ;ERROR IN WRINIT - QUIT 
       ORI  SFTERR+WRTERR  ;SUCCESSFUL WRINIT - 
       MOV  M,A       ;SET SOFT ERROR BITS
       JMP  B2C030    ;WAIT FOR COMPLETION
B2C150 EQU  $         ;ERROR IN WRINIT
       ORI  DATATR+WRTERR  ;SET ERROR BITS
       MOV  M,A 
       STC            ;C => ERROR 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     WRINIT - START WRITING TAPE RECORD
; 
;     ENTRY:  B=FLAG FOR UNIT (1=LFTCTU, 2=RGTCTU)
;             D,E -> BUFFER STATUS
; 
;     EXIT :  D,E -> BUFFER STATUS
;             NC => NO ERROR
;             C => ERROR
;               TAPE STOPPED
;               IOCERR=F
;               MSGPTX -> ERROR MESSAGE 
;             A,H,L DESTROYED 
; 
; 
WRINIT EQU  $ 
       LDA  CMND      ;IS TAPE RUNNING? 
       ANI  RUN         ;(RUN=1 => YES) 
       RNZ            ;YES - RET (NC => NO ERROR) 
       MOV  A,B       ;NO - SELECT UNIT 
       CALL SELACT
       CALL CISCAN    ;TAPE INSERTED? 
       RC             ;NO - RETURN ERROR
       LDA  UNIT0     ;TAPE WRITE PROTECTED?
       ANI  FPS 
       LXI  H,NRCMSG    ;(GET PROTECT MESSAGE)
       JNZ  CTUERR    ;YES - REPORT ERROR 
       CALL CHKLPM    ;MOVE TAPE TO LP IF BEFORE L
       RC             ;RETURN ON ERRORS 
;                     NO ERRORS - FALL INTO WRSTRT
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     WRSTRT - START WRITING A RECORD ON TAPE 
; 
;     ENTRY:  D,E -> BUFFER STATUS
;             UNIT SELECTED 
; 
;     EXIT :  D,E -> BUFFER STATUS
;             NC => NO ERROR
;               CTU RECORD IN PROGRESS
;             C => ERROR
;               TAPE STOPPED
;               IOCERR = F
;               MSGPTX -> ERROR MESSAGE(S)
;             A,H,L DESTROYED 
; 
; 
WRSTRT EQU  $ 
       CALL EVDBSP    ;BACK OVER EVD IF THERE 
       PUSH D         ;SAVE POINTER TO BUF STATUS 
       CALL GETPTR    ;GET PTR TO 1ST BYTE OF BUF 
       SHLD CTIBPT    ;SAVE IT FOR INTERRUPT ROUT 
       XCHG 
       SHLD CTISPT    ;SAVE STATUS PTR
       CALL GTCTBT    ;CLEAR BIT FOR THIS UNIT
       CMA              ;IN BUF STATUS
       ANA  M 
       ORI  BUFBSY      ;& SET GENERAL BUSY BIT 
       MOV  M,A 
       XCHG           ;D,E -> STATUS
       DCX  D         ;WHAT KIND OF RECORD? 
       LDAX D           ;-1=>NORM; 0=>EOF; 1=>EVD 
       ORA  A 
       JZ   WREOF     ;WRITE END OF FILE
       JP   WREVD     ;EVD - WRITE 11" GAP
WRNORM EQU  $ 
       MVI  D,DATATR  ;"DATA RECORDED, NOT AT EOF"
       MVI  E,25      ;SET GAP LENGTH FOR IRG 
       JMP  WRS020
WREOF  EQU  $ 
       LXI  D,FILNUM  ;INCREMENT FILE NUM ON THIS 
       LDAX D           ;TAPE 
       MOV  M,A       ;1ST BUF BYTE <- NEW FILE NU
       INR  A 
       STAX D 
       MVI  D,DATATR+EOF  ;"DATA RECORDED, AT EOF"
       MVI  E,50      ;SET GAP LENGTH FOR FILE MAR
       CALL CHKEOF    ;AT END OF FILE?
       JZ   WRS030    ;NO - DON'T CHECK FOR EW
WRS020 EQU  $ 
       CALL CHKEW     ;PAST EARLY WARNING?
       JNC  WRS030    ;NO - CONTINUE
       POP  D         ;YES -
       CALL STOPTP    ;STOP THE CTU 
       LDA  MDFLG1    ;DOING DATA LOGGING. . .
       ANI  EDIT
       LXI  H,SWPCTU  ;. . .AND SWAPPING CTU'S? 
       ANA  M 
       JNZ  WRS025    ;YES - SWAP UNITS 
       STAX D         ;RELEASE BUFFER FOR EVD WRIT
       CALL CHKEV0    ;AT END OF DATA MARK? 
       CZ   EVDWAT    ;NO - RECORD EVD AND WAIT 
       LXI  H,EOTMSG  ;REPORT END OF TAPE 
       JMP  CTUERR
; 
;  DATA LOGGING - SWAP CTU'S AT END OF TAPE 
; 
WRS025 EQU  $ 
       MVI  A,RECRWD  ;SET FLAG SO CTMON WILL 
       CALL STIOFS      ;REWIND THIS UNIT 
       MVI  L,OUTDEV  ;SAVE THIS UNIT NUMBER
       MOV  A,M         ;FOR REWIND 
       ANI  LFTCTU+RGTCTU 
       STA  SWPCTU      ;(BORROW SWPCTU)
       MOV  A,M       ;SWAP UNITS 
       XRI  LFTCTU+RGTCTU 
       MOV  M,A 
       MVI  L,IOCERR  ;-1 => TRY PUTIO AGAIN
       MVI  M,-1
       STC            ;SET ERROR FLAG 
       RET
WRS030 EQU  $ 
       LXI  H,CNTRL0
       MOV  A,M       ;GET CURRENT STATUS 
       ANI  EOF       ;AT END OF FILE?
       MOV  A,E         ;(GET GAP LENGTH) 
       JZ   WRS040
       ADD  A         ;YES - DOUBLE GAP LENGTH
WRS040 EQU  $ 
       MOV  M,D       ;STORE NEW STATUS 
       MVI  L,RELTAK-BASE 
       DI             ;MUST NOT MISS GAP TACH EDGE
       SUB  M         ;SUBTRACT CURRENT GAP LENGTH
       STA  CTICNT    ;DOWN-COUNTER FOR INT. ROUT.
       LXI  H,PUTPR2  ;WRITE 2ND PREAM BYTE ROUTIN
       SHLD CTIADR
       MVI  A,RUN+FWD+REC+GEN 
       LXI  H,TIPCT0  ;SET UP TO RECORD GAP, IF NO
       CALL OUTCMD      ;DOING SO ALREADY 
       EI 
       POP  D         ;D,E -> BUFFER STATUS ON EXI
       RET            ;OUTCMD SETS NC 
WREVD  EQU  $         ;WRITE AN EVD MARK
       CALL CHKEV0    ;ALREADY AT END OF DATA?
       CNZ  CTUERR    ;YES - REPORT ERROR 
       JC   WRS070      ;AND QUIT 
       CALL CHKEOF    ;AT END OF FILE?
       JNZ  WRS060    ;YES - WRITE EVD
       SUB  A         ;NO - SET UP BUF FOR EOF
       STAX D 
       DCX  D           ;MARK LENGTH = 1
       INR  A 
       STAX D 
       INX  D 
       INX  D           ;D,E -> STATUS FOR BUF2CT 
       PUSH B 
       CALL STOPTP      ;BUF2CT REQ'S STOPPED TAPE
       CALL GTCTBT      ;BUF2CT REQ'S B=UNIT
       MOV  B,A         ;(BUF2CT CKS EOF IF W/BS/R
       LDAX D         ;MARK BUFFER FOR THIS UNIT
       ORA  B 
       STAX D 
       CALL BUF2CT    ;GO WRITE THE EOF 
       POP  B 
       JC   WRS070    ;RETURN ON ERROR
WRS050 EQU  $         ;WAIT FOR EOF TO BE FINISHED
       CALL CTMON1      ;CHECK FOR REMOVED TAPES
       JC   WRS070    ;RETURN ON ERROR
       JNZ  WRS050      ;TAPE STILL RUNNING - WAIT
       DCX  D         ;RESTORE BUFFER TO EVD
       MVI  A,1         ;(1 = EVD)
       STAX D 
WRS060 EQU  $         ;RECORD EVD 
       INX  D         ;RELEASE BUFFER 
       LDAX D 
       ANI  -1-BUFBSY 
       STAX D 
       MVI  A,111     ;LOW BYTE OF EVD LENGTH 
       LXI  H,RELTAK
       DI             ;HOLD OFF TACH INTERRUPTS 
       SUB  M         ;SUBTRACT CURRENT GAP LENGTH
       MOV  L,A       ;H,L <- 11" EVD + 1.76" FILE
       MVI  H,1         ;MARK - .21" STOP DISTANCE
       SHLD CTIADR    ;USE CTIADR FOR DOWN COUNTER
       MVI  A,RUN+FWD+REC+GEN 
       LXI  H,TIWEVD  ;SET UP INTR ROUT AND START 
       CALL OUTCMD      ;IF NOT DOING SO ALREADY
       EI 
       MVI  A,EVD     ;MARK TAPE AT EVD 
       STA  CNTRL0
WRS070 EQU  $ 
       POP  D         ;D,E -> BUFFER STATUS 
       RET            ;RETURN - OUTCMD SETS NC
; 
;    INTERRUPT ROUTINE COUNTS EVD GAP 
; 
TIWEVD EQU  $ 
       MOV  A,M       ;TEST STATUS
       ORA  A 
       RP             ;RETURN ON NO TACH
       MVI  L,CTIADR  ;DECREMENT COUNTER
       DCR  M         ;GAP FINISHED?
       RNZ            ;NO - RETURN
       INX  H         ;H,L -> HIGH BYTE 
       DCR  M 
       RZ             ;NO - RETURN
       JMP  STOPTP    ;YES - STOP THE TAPE
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      PUTGAP - RECORD A GAP ON TAPE
; 
;      THE FOLLOWING INTERRUPT ROUTINE OUTPUTS A
;      GAP OF CTICNT TACH EDGES 
; 
; 
TIPCT0 EQU  $ 
       MVI  A,0       ;CLEAR BYTE READY, AND PREPA
       STA  IOCTDO      ;FOR 1ST PREAMBLE BYTE
       ORA  M         ;CHECK TACH 
       RP             ;NO TACH - RETURN 
       MVI  L,CTICNT  ;DECREMENT TACH COUNTER 
       DCR  M         ;=0?
       RNZ            ;NO - KEEP GENERATING GAP 
       LXI  H,TIPCT1  ;YES - GET CTU-WRITING ROUTI
       MVI  A,RUN+FWD+REC  ;TURN OFF GAP
       JMP  OUTCMD
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     PUTCTU - INTERRUPT SERVICE ROUTINES FOR CTU 
;          WRITE
; 
;     ENTRY (FIRST INTERRUPT):
;            CTIADR -> PUTPR1 (1ST PREAMBLE BYTE) 
;            CTICNT = LENGTH OF GAP IN TACH EDGES 
;            CTISPT -> BUF STATUS 
;            CTIBPT -> FIRST BYTE OF BUFFER 
; 
TIPCT1 EQU  $ 
       MOV  A,M       ;GET STATUS 
       ANI  RDY       ;READY FOR BYTE?
       RZ             ;NO - EXIT
       LHLD CTIADR    ;DECIDE WHICH BYTE TO WRITE 
       PCHL 
PUTPR2 EQU  $         ;SECOND PREAMBLE BYTE = 0 
       SUB  A           ;(FIRST BYTE WRITTEN BY 
       LXI  H,PUTPR3     ;PUTGAP) 
       JMP  PCT100
PUTPR3 EQU  $         ;THIRD PREAMBLE BYTE = 0
       SUB  A 
       LXI  H,PUTPR4
       JMP  PCT100
PUTPR4 EQU  $         ;FOURTH PREAMBLE BYTE = 200B
       MVI  A,200Q
       LXI  H,PUTMSB
       JMP  PCT100
PUTMSB EQU  $         ;WRITE RECORD LENGTH MSB
       LHLD CTISPT    ;H,L -> STATUS
       DCX  H         ;H,L -> TYPE
       DCX  H         ;H,L -> LENGTH
       MOV  A,M 
       ORA  A 
       MVI  A,0       ;LENGTH # 0 => MSB = 0
       JNZ  PCT020
       INR  A         ;LENGTH = 0 => 256 (MSB = 1)
PCT020 EQU  $ 
       INX  H         ;H,L->TYPE (-1=>NORM; O=>EOF
       CMP  M         ;C=>NORM; NC=>EOF 
       JC   PCT030
       ORI  200Q      ;HIGH BIT OF MSB ON =>-EOF
PCT030 EQU  $ 
       STA  CTICSM    ;START CHECKSUM COMPUTATION 
       LXI  H,PUTLSB  ;WRITE LSB NEXT 
       JMP  PCT100
PUTLSB EQU  $         ;WRITE RECORD LENGTH LSB
       LHLD CTISPT
       DCX  H 
       DCX  H         ;H,L -> LENGTH LSB
       LDA  CTICSM    ;ACCUMULATE CHECKSUM
       ADD  M 
       STA  CTICSM
       MOV  A,M       ;GET LENGTH LSB 
       STA  CTICNT    ;START BYTE COUNTER 
       LXI  H,PUTDAT  ;PUT DATA NEXT
       JMP  PCT100
PUTDAT EQU  $         ;WRITE A DATA BYTE
       LHLD CTIBPT    ;GET POINTER INTO BUFFER
       LDA  CTICSM    ;ACCUMULATE CHECKSUM
       ADD  M 
       STA  CTICSM
       MOV  A,M       ;GET BYTE 
       INX  H         ;POINT TO NEXT BYTE 
       SHLD CTIBPT    ;SAVE POINTER 
       LXI  H,CTICNT  ;COUNT DOWN 
       DCR  M         ;OUT OF BYTES YET?
       JNZ  PCT200    ;NO 
       LXI  H,PUTCSM  ;YES - WRITE CHECKSUM NEXT
PCT100 EQU  $         ;UPDATE POINTER TO SERVICE R
       SHLD CTIADR
PCT200 EQU  $         ;OUTPUT BYTE
       STA  IOCTDO
       RET
PUTCSM EQU  $         ;WRITE CHECKSUM 
       LDA  CTICSM    ;GET CHECKSUM 
       LXI  H,PUTPO1  ;PUT 1ST POSTAMBLE BYTE NEXT
       JMP  PCT100
PUTPO1 EQU  $         ;FIRST POSTAMBLE BYTE = 1 
       MVI  A,5       ;SET UP REST OF POSTAMBLE - 
       STA  CTICNT      ;3 BYTES "0" AND 2 TO MAKE
       LXI  H,PUTPOS    ;SURE THEY ARE OUT
       MVI  A,1       ;GET FIRST BYTE 
       JMP  PCT100
PUTPOS EQU  $         ;POSTAMBLE
       SUB  A         ;OUTPUT A "0" 
       STA  IOCTDO
       LXI  H,CTICNT  ;ALL FIVE BYTES OUT?
       DCR  M 
       RNZ            ;NO - WAIT FOR MORE 
       STA  RELTAK    ;CLEAR TACH-GAP COUNTER 
       LXI  H,TIDO0   ;SET UP "DO NOTHING" ROUTINE
       MVI  A,RUN+FWD+REC+GEN 
       CALL OUTCMD    ;START RECORDING GAP
       LDA  IOCTSI    ;CLEAR ANY PENDING INTERRUPT
       EI             ;ENABLE INTERRUPTS
       LDA  MDFLG2    ;WRITE/BS/READ MODE?
       ANI  WBSR
       JNZ  STOPTP    ;IF SO, QUIT
       PUSH D         ;SAVE D AND E 
       LHLD CTISPT    ;FREE THE BUFFER
       MOV  A,M 
       ANI  -1-BUFBSY 
       MOV  M,A 
       XCHG           ;D,E -> STATUS
       CALL GTCTBT    ;GET BIT FOR THIS CTU 
       MOV  L,A       ;SAVE TO TEST OTHER BUF 
       CALL CHGBUF    ;D,E -> STATUS FOR OPP BUF
       LDAX D         ;UNIT BIT SET => BUF READY
       ANA  L           ;FOR THIS UNIT TO RECORD
       CZ   STOPTP    ;BUF NOT READY - STOP TAPE
       CNZ  WRSTRT    ;BUF READY - START WRITING
       POP  D         ;RESTORE REGISTERS
       RNC            ;NO ERRORS - RETURN 
SETCTW EQU  $         ;ERROR - SET WRITE ERROR FLA
       MVI  A,WRTERR
;******************************** 
; SETCT0 - SET FLAG IN "CNTRL0" * 
;******************************** 
; 
;  ENTRY:  A = FLAG TO BE SET 
; 
;  EXIT :  A = NEW VALUE OF "CNTRL0"
;          H,L = CNTRL0 
; 
SETCT0 EQU  $ 
       LXI  H,CNTRL0
       ORA  M         ;ADD IN FLAG
       MOV  M,A       ;UPDATE FLAG VALUE
       RET            ;RETURN 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      EVDRED - READ BEYOND EVD 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  TAPE POSITIONED JUST BEYOND FIRST
;           DATA BLOCK AFTER EVD GAP
; 
;      COMMAND IGNORED IF NOT AT EVD OR RECORDING 
;      OR IF INPUT DEVICE IS NOT CTU. 
; 
; 
EVDRED EQU  $ 
       CALL BSYCK0    ;IS TAPE SELECTED AND FREE? 
       RC               ;RETURN ON USER INTERRUPT 
       RNZ              ;RETURN ON NOT SELECTED 
       LDA  INPDEV      ;(GET INPUT DEV FOR SELECT
       CALL SELACT    ;YES - SELECT UNIT
       CALL REVEVD    ;WRITE EVD IF RECORDING 
       CALL CHKEV0    ;AT EVD ALREADY?
       RZ             ;NO - RETURN
       CALL CHKEW     ;PAST EARLY WARNING?
       RC             ;YES - QUIT 
       LXI  H,TIEDR0  ;SET UP INTERRUPT ROUTINE 
       MVI  A,RUN+FWD ;RUN FORWARD
       CALL OUTCMD
EDR050 EQU  $ 
       CALL RETSCN    ;USER INTERRUPT?
       JC   STOPTP    ;YES - STOP TAPE AND QUIT 
       CALL CTMON1    ;IF NOT, TAPE ERROR?
       JNZ  EDR050    ;TAPE STILL RUNNING - WAIT
       RC             ;RETURN IF ANY ERRORS 
       MVI  A,-1-EVD  ;NO ERRORS - CLEAR EVD FLAG 
;********************************** 
; CLRCT0 - CLEAR FLAG IN "CNTRL0" * 
;********************************** 
; 
;  ENTRY:  A = -1-(FLAG TO BE CLEARED)
; 
;  EXIT :  A = NEW VALUE FOR "CNTRL0" 
;          H,L = CNTRL0 
; 
CLRCT0 EQU  $ 
       LXI  H,CNTRL0
       ANA  M         ;CLEAR THE FLAG BIT 
       MOV  M,A       ;STORE NEW VALUE
       RET            ;RETURN 
 
;****************************************** 
;  INTERRUPT ROUTINE - RUN TO END OF GAP  * 
;****************************************** 
TIEDR0 EQU  $ 
       MOV  A,M       ;GET CTSTAT 
       ANI  GAP       ;END OF GAP YET?
       RNZ            ;NO - CONTINUE WAITING
       LXI  H,TIEDR1  ;YES - SET UP ROUTINE TO
       SHLD CTIVEC      ;WAIT FOR GAP 
       RET
;*************************************************
;  INTERRUPT ROUTINE - RUN TO START OF NEXT GAP  *
;*************************************************
TIEDR1 EQU  $ 
       MOV  A,M       ;GET CTSTAT 
       ANI  GAP       ;START OF NEXT GAP YET? 
       RZ             ;NO - CONTINUE WAITING
       JMP  STPTP0    ;YES - QUIT 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      USRCMR - COMPARE ONE RECORD
;      USRCMF - COMPARE ONE FILE
;      USRCMA - COMPARE ALL DATA
;      (USER-INITIATED VERSIONS)
; 
;      ENTRY:  INPDEV, OUTDEV EACH INDICATE ONE 
;           DISTINCT DEVICE 
; 
;      EXIT :  ALL REGISTERS DESTROYED
; 
; 
USRCMR EQU  $         ;COMPARE ALL
       DCR  B           ;TRANSFER LIMIT = -1
USRCMF EQU  $         ;COMPARE FILE 
       DCR  B           ;TRANSFER LIMIT = 0 
USRCMA EQU  $         ;COMPARE ALL (LIMIT = 1)
       STC            ;C => COMPARE 
       JMP  XFRD2D
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CMPBFS - COMPARE I/O BUFFERS 
; 
;      ENTRY:  B = FILE # (USED FOR ERROR REPORT) 
;              C = REC #  (USED FOR ERROR REPORT) 
;              CMPLIM = LIMIT OF COMPARE
;              IOBUF1 AND IOBUF2 CONTAIN RECORDS
;                TO BE COMPARED 
; 
;      EXIT :  C => ERROR 
;                MESSAGE SET UP IN MSGPTX 
;                A-L DESTROYED
;              NC => RECORDS IDENTICAL
;                A = RECORD TYPE
;                A,D-L DESTROYED
; 
; 
CMPBFS EQU  $ 
       LXI  H,B1TYPE  ;H,L -> TYPE OF FIRST BUFFER
       LXI  D,B2TYPE  ;D,E -> TYEP OF SECOND BUFFE
       LDAX D         ;COMPARE BUFFER TYPES 
       CMP  M 
       JZ   CPB100    ;SAME - COMPARE CONTENTS
       JP   CPB010    ;BUF 2 GREATER
       XCHG           ;BUF 1 GREATER
CPB010 EQU  $         ;DIFF TYPES; D,E->GREATER 
       LDAX D         ;GET LARGER TYPE NUMBER 
       ORA  A         ;WHAT TYPE OF BOUNDARY? 
       LXI  H,EOFMSG    ;END OF FILE MESSAGE
       JZ   CPB040    ;EOF -
       LXI  H,EVDMSG  ;EVD -
CPB040 EQU  $ 
       SHLD MSGPT1    ;STORE ERROR TYPE 
       INX  D         ;D,E -> BUFFER STATUS 
       LDAX D         ;GET UNIT CAUSING ERROR 
       ANI  LFTCTU    ;WAS IT THE LEFT CTU? 
       CALL SLTPM1    ;SET UP MESSAGE 
       LDAX D         ;IS ERROR UNIT A CTU? 
       ANI  LFTCTU+RGTCTU 
       STC              ;(FLAG ERROR) 
       RNZ            ;YES - QUIT 
       LXI  H,ZMSGAL  ;NO - MUST BE ALTERNATE I/O 
       SHLD MSGPT2
       RET
CPB100 EQU  $         ;RECORDS SAME TYPE
       ORA  A         ;WHAT KIND OF RECORDS?
       RP             ;RETURN IF NOT DATA RECORDS 
CPB300 EQU  $         ;DATA RECORDS - 
       LDA  B1LEN     ;COMPARE LENGTHS
       LXI  H,B2LEN 
       CMP  M         ;ARE THEY THE SAME? 
       JZ   CPB350    ;YES - CHECK CONTENTS 
       LXI  H,DLRMSG  ;NO - REPORT ERROR
       SHLD MSGPT1    ;"DIFFERENT LENGTH RECORDS" 
       LXI  H,NULMSG  ;NO MESSAGE - ALLOWS FOLLOWN
       SHLD MSGPT2      ;TO HANDLE DIFF BYTES TOO 
CPB310 EQU  $         ;DECIDE WHETHER TO PRINT FIL
       LXI  H,EOPMSG    ;AND/OR RECORD NUMBERS
       SHLD MSGPT3    ;PUT AN END OF MSG IN EVERY 
       SHLD MSGPT5      ;POSSIBLE LOCATION
       SHLD MSGPT7
       LXI  H,B2DBUF  ;H,L -> BUF POSITION FOR NEX
;                       DIGITAL OUTPUT
       LDA  CMPLIM    ;WHAT IS THE COMPARE LIMIT? 
       ORA  A 
       JM   CPB330    ;ONE RECORD - PRINT NO MORE 
       JZ   CPB320    ;FILE - PRINT RECORD NUMBER 
       SHLD MSGPT6    ;ALL - PRINT FILE NUMBER, TO
       MOV  A,B       ;A <- FILE NUMBER 
       CALL DSPNUM
       XCHG           ;SAVE DIGIT PTR 
       LXI  H,FILMSG  ;", FILE" 
       SHLD MSGPT5
       XCHG           ;GET DIGIT PTR BACK 
CPB320 EQU  $         ;REPORT RECORD NUMBER 
       SHLD MSGPT4    ;POINTER TO DIGITS
       MOV  A,C       ;A <- RECORD NUMBER 
       CALL DSPNUM
       LXI  H,RECMSG  ;", RECORD" 
       SHLD MSGPT3
CPB330 EQU  $         ;RETURN 
       STC
       RET
CPB350 EQU  $         ;LENGTHS SAME, COMPARE CONTN
       LXI  H,IOBUF1  ;GET POINTERS TO BUFFERS
       LXI  D,IOBUF2
       PUSH B         ;SAVE B,C 
       LDA  B1LEN 
       MOV  C,A       ;C-REG USED AS DOWN-COUNTER 
CPB360 EQU  $         ;COMPARE ONE BYTE 
       LDAX D 
       CMP  M 
       INX  H         ;UPDATE POINTERS
       INX  D 
       JNZ  CPB370    ;DIFFERENT - REPORT ERROR 
       DCR  C         ;FINISHED?
       JNZ  CPB360    ;NO - TEST NEXT BYTE
       POP  B         ;IDENTICAL DATA RECORDS 
       MVI  A,-1      ;-1 => DATA RECORDS 
       RET
CPB370 EQU  $         ;REPORT DIFFERENT BYTES 
       LXI  H,DIFMSG  ;"DIFFERENCE IN BYTE" 
       SHLD MSGPT1
       LXI  H,DSPSTR+75 
       SHLD MSGPT2    ;POINT TO BYTE NUM DIGITS 
       MOV  A,E       ;LOW BYTE OF BUF PTR IS BYT 
       CALL DSPNUM    ;CONVERT BYTE NUM TO DECIMAL
       POP  B         ;RECALL FILE AND RECORD NUMS
       JMP  CPB310    ;REPORT FILE AND/OR RECORD #
 
;*************************
; ACCUMULATE UNIT STATUS *
;*************************
STLCT  EQU  $         ;GET STATUS FOR LEFT CTU
       MVI  B,LFTCTU  ;BIT FOR LEFT TAPE
       MVI  A,USL     ;LEFT TAPE SELECT 
       JMP  STCT
STRCT  EQU  $         ;GET STATUS FOR RIGHT CTU 
       MVI  B,RGTCTU
       SUB  A 
STCT   EQU  $ 
       LXI  H,CMND    ;IS THIS UNIT SELECTED? 
       XRA  M           ;(CHECK SELECT OF LAST CMD
       ANI  USL 
       MOV  A,M         ;(GET COMMAND)
       LXI  H,UNIT0     ;(AND POINTER TO STATUS)
       JZ   STC010    ;YES -
       MVI  L,(SFTCNT-1)*256/256;NO - GET PTR TO
;                       OTHER STATUS WORDS
       SUB  A 
STC010 EQU  $ 
       ANI  1         ;C<-1 => BUSY (UNIT SELECTED
       MOV  C,A         ;RUNNING) 
       MOV  D,M       ;D <- UNIT0 
       DCX  H 
       MOV  E,M       ;E <- CNTRL0
;*************************************************
;   B = 1 (LEFT CTU) OR 2 (RIGHT CTU)            *
;                                                *
;   C = 1 => BUSY;  C = 0 => NOT BUSY            *
;                                                *
;   D = UNIT0   () => NOT USED FOR STATUS        *
;      1 - LPM       10 - CMDEXC    100 - (LP)   *
;      2 - (LSTFWD)  20 - ----      200 - EW     *
;      4 - FPS       40 - (BOT)                  *
;                                                *
;   E = CNTRL0                                   *
;      1 - EOF       10 - SFTERR    100 - DATATR *
;      2 - EVD       20 - (HRDER1)  200 - ----   *
;      4 - HRDERR    40 - WRTERR                 *
;*************************************************
       MVI  L,IOSTA3
;*******************************
;  ACCUMULATE 3RD STATUS BYTE  *
;*******************************
       LDA  CTSTAT
       ANA  B         ;TAPE INSERTED? 
       JNZ  STC020
       MOV  M,A       ;NO - STAT3 = 0 
       DCX  H 
       MVI  M,1         ;STAT2 = 1  (BUSY)
       DCX  H 
       MOV  M,A         ;STAT1 = 0
       RET
STC020 EQU  $         ;YES -
       MVI  A,1       ;SET "TAPE INSERTED" = 1
       ORA  E 
       ANI  HRDERR+SFTERR+EVD+1 
       MOV  M,A 
       DCX  H 
;*******************************
;  ACCUMULATE 2ND STATUS BYTE  *
;*******************************
       MOV  A,D 
       ANI  FPS+CMDEXC
       ORA  C         ;ADD BUSY BIT 
       MOV  C,A       ;TEMPORARY STORAGE
       MOV  A,E       ;ANY ERRORS?
       ANI  HRDERR+SFTERR 
       JZ   STC030    ;NO - 
       MOV  A,E       ;YES - READ OR WRITE? 
       CMA
       ANI  WRTERR
       JZ   STC030    ;WRITE ERROR
       MVI  A,2       ;READ ERROR, SET BIT
STC030 EQU  $ 
       ORA  C 
       MOV  M,A 
       DCX  H 
;*******************************
;  ACCUMULATE 1ST STATUS BYTE  *
;*******************************
       MOV  A,D 
       ANI  LPM+EW
       RLC
       RLC
       MOV  C,A       ;TEMPORARY STORAGE
       MOV  A,E 
       ANI  EOF+WRTERR+EOFINH 
       JP   STC040    ;INHIBIT REPORTING EOF? 
       ANI  WRTERR    ;YES - TURN IT OFF
STC040 EQU  $ 
       RLC
       RLC
       RLC
       ORA  C 
       MOV  M,A 
       RET
 
;*******************************
; CONTROL FUNCTION ENTRY TABLE *
;*******************************
CTCTLT EQU $
       DW   RWDBOT    ;REWIND TO BEGINNING OF TAPE
       DW   SPCPRC  ;SPACE OVER P RECORDS 
       DW   SPCPFL  ;SPACE OVER FILES OR TO #P
       DW   SREVD   ;LOCATE EVD MARK
       DW   ENDBAK    ;CONDITION TAPE 
       DW   EOFC    ;RECORD FILE MARK 
       DW   EVDC    ;RECORD EVD MARK
       DW   TSTCTU  ;RELIABILITY TEST FOR CTU 
       DW   REMSPC  ;SPACE WITH NO EVD RECORDING
       DW   STWBSR    ;ENTER WRITE/BAKSPC/READ MOD
       DW   CLWBSR    ;EXIT WRITE/BAKSPC/READ MODE
;***********************************
; PERFORM CONTROL FUNCTIONS ON CTU *
;***********************************
CTLLCT EQU $
       CALL BSYCHK    ;CHECK WHETHER CTU BUSY 
       RC             ;RETURN ON USER INTERRUPT 
       CALL SELLCT   ;SELECT LEFT CTU 
CTLCT  EQU $
       MVI  A,CMDEXC  ;SET "COMMAND EXECUTED" BIT 
       CALL STUNT0
       LDA  IOCTYP    ;GET CONTROL CODE 
       LXI  H,CTCTLT  ;GET TABLE BASE ADDRESS 
       JMP INDJMP   ;PERFORM FUNCTION 
CTLRCT EQU $
       CALL BSYCHK    ;SEE WHETHER CTU IS BUSY
       RC             ;RETURN ON USER INTERRUPT 
       CALL SELRCT   ;SELECT RIGHT CTU
       JMP CTLCT
 
;***************************
; SPCPRC - SPACE P RECORDS *
;***************************
SPCPRC EQU $
       MVI B,1      ;SET TO INCREMENT IF NEED EVD 
       CALL REVEVD  ;RECORD EVD IF NEEDED 
REMSPC EQU  $         ;ESC SEQ SKIP W/O EVD 
       MVI  A,EOF+EVD  ;CLEAR ALL BUT EOF AND EVD 
       CALL CLRCT0    ;CLEAR EOF INHIBIT
       CALL CISCAN    ;TAPE INSERTED? 
       RC             ;NO - RETURN ERROR
       LDA  IOPSGN    ;WHICH DIRECTION? 
       ADD  A 
       LHLD IOCCNT      ;(GET NUMBER OF RECORDS)
       JM   SPC002
       CALL FWDSPX    ;FORWARD - START MOVEMENT 
       JMP  SPC005
SPC002 EQU  $ 
       CALL BAKSPX    ;BACKWARDS - START MOVEMENT 
SPC005 EQU  $ 
       RC             ;RETURN ON ERROR
       LXI  H,SKPMSG  ;SET SKIP LINES MESSAGE 
       CALL SLTPMS    ;SELECT TAPE UNIT MESSAGE 
;************************************************ 
;  WAIT FOR SPACING TO BE FINISHED - ENTRY FOR  * 
;    MONITORING HIGH-SPEED SEARCH               * 
;************************************************ 
SPCWAT EQU  $         ;ENTRY FOR MESSAGE UPDATE 
       LXI  H,CTISTA  ;SET COMMAND SOURCE FLAG
       MVI  M,-1        ;FOR KEYBOARD SOURCE
       LDA  DFLGS     ;GET DATA TRANSFER FLAGS
       ANI  SDACOM    ;COMMAND FROM KEYBOARD? 
       RZ             ;YES - RETURN 
SPCWT1 EQU  $           ;(ENTRY FOR FIND EVD) 
       MVI  M,0       ;NO - SET FOR DATA COMM IN
       CALL CARDIS    ;DISPLAY SPACE MESSAGE
SPC010 EQU  $ 
       CALL CTMON1    ;MONITOR TAPE DRIVES
       JC   RSTDSP    ;ERROR - QUIT 
       JZ   SPC020    ;'RUN' TURNED OFF - QUIT
       CALL RETSCN    ;RET PRESSED? 
       JNC  SPC010    ;NO - CONTINUE WAITING
       CALL STOPTP    ;YES - USER INTERRUPT 
       CALL FWDSP1    ;ADVANCE 1 REC TO END IN
;                       REASONABLE POSITION 
SPC020 EQU  $ 
       CALL RSTDSP    ;RESTORE DISPLAY
       LDA  IOCERR    ;'RUN' OFF, ANY ERROR?
       CPI  S 
       RZ             ;NO - RET 
       STC            ;YES - C => ERROR 
       RET
 
;***********************************
; TERMINATE SPACE/SEARCH OPERATION *
;***********************************
SPCEN1 EQU  $ 
       CALL CTUERR    ;CHECK FOR I/O ERROR
SPCEND EQU  $ 
       LDA  CTISTA    ;GET COMMAND SOURCE FLAG
       ORA  A         ;COMMAND FROM KEYBOARD? 
       RZ             ;NO - RETURN
       JMP  USREXT    ;YES - EXIT THRU USER EXIT
;***********************************************
; SPCPFL - SPACE OVER P FILES OR LOCATE FILE P *
;***********************************************
SPCPFL EQU $
       LHLD IOCCNT    ;GET PARAMETER VALUE
       LDA  IOPSGN    ;GET PARAMETER SIGN 
       ADD  A         ;NEGATIVE ADJUSTMENT? 
       JP   SPF100    ;NO - DO NOT DECREMENT
       CALL CHKEOF    ;AT END OF FILE?
       JNZ  SPF100    ;YES - DO NOT DECREMENT 
       ORA  L         ;NO - PARAMETER = 0?
       JZ   SPF100    ;YES - DO NOT DECREMENT 
       DCX  H         ;NO - DECREMENT PARAMETER 
SPF100 EQU $
       MVI  H,0       ;CLEAR HIGH BYTE
       SHLD IODATA    ;SAVE MODIFIED PARAM. VALUE 
       LXI  H,FILNUM
       MOV  B,M       ;GET CURRENT FILE COUNT 
       MVI  C,255     ;GET MAXIMUM FILE COUNT 
       LXI  D,CTICNT+1  ;TARGET ADDRESS 
       CALL CHKLIM  ;GET ABSOLUTE FILE COUNT
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      SEARCH - LOCATE A PARTICULAR FILE
; 
;      ENTRY:  CTICNT+1 = DESIRED FILE
; 
;      EXIT :  C => ERROR 
;              NC => NO ERROR 
; 
; 
SEARCH EQU  $ 
       CALL CISCAN    ;TAPE INSERTED? 
       RC             ;NO - RETURN ERROR
       LDA  CTICNT+1  ;IS COUNT ZERO OR ONE?
       SUI  2 
       JC   RWDLP     ;YES - REWIND TO LOAD POINT 
       MVI  A,3       ;SET FOR THREE RE-TRIES (IN 
       STA  CTICNT+2    ;CASE OF MISSING FILES) 
       ORA  A         ;TELL FILCMP FWD IS ON
       CALL FILCM1    ;PRESENT ? NEEDED 
       JC   SRC070
       JNZ  SRC050
       CALL CHKEOF    ;AT END OF FILE?
       RNZ              ;YES - RETURN 
SRC050 EQU  $         ;PRESENT >= NEEDED
       MVI  B,0         ;DON'T CHANGE IOCCNT
       LHLD CTICNT+1    ;SAVE DESIRED FILE AND
       PUSH H             ;RETRY COUNTER
       CALL REVEVD      ;WRITE EVD IF RECORDING 
       POP  H 
       SHLD CTICNT+1
       SUB  A           ;CLEAR GAP COUNTER
       STA  RELTAK
       MVI  B,RUN+FST   ;SET FOR FAST REVERSE 
       JMP  SRC080    ;START HIGH SPEED SEARCH
SRC070 EQU  $         ;PRESENT < NEEDED 
       CALL CHKLPM      ;ADVANCE TO LP IF NOT THER
       CNC  CHKEVD      ;RECORDING OR EVD?
       RC               ;REPORT ANY ERROR 
       MVI  B,RUN+FWD+FST  ;SEARCH FAST FORWARD 
SRC080 EQU  $ 
       CALL SRC100    ;START HIGH SPEED SEARCH
       JMP  SPCWAT    ;WAIT FOR SEARCH TO BE DONE,
;                       UPDATING MESSAGE
; 
;  START HIGH SPEED SEARCH
; 
SRC100 EQU  $ 
       MVI  A,-1-EOFINH 
       CALL CLRCT0    ;CLEAR EOF INHIBIT
       MOV  A,B       ;GET COMMAND
SRC110 EQU  $ 
       LXI  H,TISRC0  ;SET INTERRUPT TO COUNT GAP 
       CALL OUTCMD    ;ISSUE COMMAND
; 
;  SET UP SEARCHING MESSAGE 
; 
       LXI  H,LOCMSG  ;SET FIRST PART OF MESSAGE
       JMP  SLTPMS    ;SELECT MESSAGE FOR TAPE UNI
 
;*****************************************
;  COUNT GAP LENGTH - INTERRUPT ROUTINE  *
;*****************************************
TISRC0 EQU  $ 
       ANI  LP        ;BACKED PAST LP?
       JZ   SRC500    ;YES - RECOVER
       MOV  A,M       ;GET CTSTAT 
       ANI  GAP       ;FOUND DATA YET?
       JNZ  SRC600    ;NO - CHECK FOR EVD 
; 
;  DATA FOUND - PROCESS GAP 
; 
       LXI  H,TISRC1  ;SET UP INTERRUPT TO WAIT 
       SHLD CTIVEC      ;FOR GAP
       CALL GAPTST    ;UPDATE FILE STATUS & NUMBER
;                       BASED ON GAP LENGTH 
       LXI  H,RELTAK  ;CLEAR GAP COUNTER
       MVI  M,0 
       RC             ;NO FILE NUMBER CHANGE - RET
       CALL FILCMP    ;FILE CHANGE: REACHED TARGET
       RNZ            ;NO - RETURN
       CALL CHKFWD    ;YES - WHICH DIRECTION? 
       CNZ  SRC700    ;FWD - STOP TAPE AND GO BACK
       CALL STOPTP    ;REV - STOP THE TAPE
       SUB  A         ;SET TRANSFER LIMIT AT EOF
       STA  XFRLIM
       PUSH B         ;SAVE REGISTERS REQ'D FOR 
       PUSH D           ;CTU READ 
SRC310 EQU  $ 
       CALL GTCTBT    ;GET BIT FOR THIS UNIT
       MOV  B,A       ;UNIT BIT IN B-REG
       LHLD CTICNT+1  ;SAVE DESIRED FILE AND
       PUSH H           ;RETRY COUNTER
       CALL CT2BUF    ;READ A RECORD
       POP  H 
       SHLD CTICNT+1
       JC   SRC320    ;RETURN ON ERROR
       SUB  A         ;MARK BUFFER FREE 
       STAX D 
       DCX  D         ;D,E -> TYPE
       LDAX D 
       ORA  A         ;IS THIS A FILE MARK? 
       JNZ  SRC310    ;NO - GET NEXT RECORD 
       CALL FILCMP    ;YES - CORRECT FILE?
       JC   SRC310    ;PRESENT < NEEDED, CONTINUE 
;                       READING 
SRC320 EQU  $           ;(ENTRY FOR READ ERROR) 
       POP  D           ;(RESTORE REGISTERS)
       POP  B 
       RZ             ;PRESENT = NEEDED, RET
       RC               ;(READ ERROR EXIT)
       LXI  H,CTICNT+2
       DCR  M         ;PRESENT > NEEDED, RETRY? 
       LXI  H,FMSMSG    ;("FILE MISSING" MESSAGE) 
       JZ   SPCEN1    ;NO - REPORT ERROR AND QUIT 
       SUB  A         ;YES - CLEAR GAP COUNTER
       STA  RELTAK
       MVI  A,RUN+FST ;SEARCH FAST BACKWARD 
       LXI  H,TISRC0  ;SET INTERRUPT TO COUNT GAP 
       JMP  OUTCMD
; 
;  HIT LP HOLE - POSSIBLE MISSING FILE
; 
SRC500 EQU  $         ;RECOVER FROM HITTING LP
       CALL STPTP0    ;STOP THE TAPE
       SUB  A         ;CLEAR CONTROL BITS 
       STA  CNTRL0
       INR  A         ;SET AT FILE 1
       STA  FILNUM
       LXI  H,CTICNT+2
       DCR  M         ;RETRY? 
       LXI  H,FMSMSG    ;("FILE MISSING" MESSAGE) 
       JZ   SPCEN1    ;NO - REPORT ERROR AND EXIT 
       CALL CHKLPM    ;MOVE TO LOAD POINT 
       JC   SPCEND    ;EXIT ON ERROR
       MVI  A,RUN+FWD+FST  ;SEARCH FAST FORWARD 
       CALL SRC110    ;START SEARCH ROUTINE 
       LDA  CTISTA    ;GET COMMAND SOURCE FLAG
       ORA  A         ;COMMAND FROM DATA COMM?
       RNZ            ;NO - RETURN
       JMP  CARDIS    ;YES - DISPLAY SEARCH MESSAG
;*************************************
;  WAIT FOR GAP - INTERRUPT ROUTINE  *
;*************************************
TISRC1 EQU  $ 
       ANI  LP        ;BACKED PAST LP?
       JZ   SRC500    ;YES - RECOVER
       MOV  A,M       ;GET CTSTAT 
       ANI  GAP       ;IN GAP?
       RZ             ;NO - CONTINUE TO WAIT
       LXI  H,TISRC0  ;YES - SET UP INTERRUPT TO
       SHLD CTIVEC      ;COUNT GAP LENGTH 
       RET
 
;***********************************************
;  CHECK FOR EVD - SHARED BY SEARCH AND SPACE  *
;***********************************************
SRC600 EQU  $ 
       MVI  L,RELTAK  ;INCREMENT GAP COUNT
       INR  M         ;REACHED EVD LIMIT? 
       RP             ;NO - RETURN
       CALL CHKFWD    ;YES - GOING FORWARD? 
       RZ             ;NO - CONTINUE
       MVI  L,CNTRL0*256/256
       MVI  M,EVD     ;YES - MARK EVD STATUS
       CALL SRC700    ;STOP TAPE & GO BACK
       LXI  H,EVDMSG  ;REPORT END OF DATA 
       JMP  SPCEN1    ;REPORT ERROR AND EXIT
;*************************************************
;  STOP TAPE AND GO BACK OVER STOPPING DISTANCE  *
;  USED BY:  SEARCH AND SPACE, WHEN HITTING EVD  *
;            SEARCH, AFTER FAST FORWARD TO FILE  *
;*************************************************
SRC700 EQU  $ 
       LXI  H,0       ;CLEAR CTIADR TO COUNT TACH 
       SHLD CTIADR      ;WHILE STOPPING 
       LXI  H,TISRC2  ;SET UP INTERRUPT TO STOP 
;                       TAPE AND COUNT TACH 
       CALL STPTP1    ;STOP TAPE
       LXI  H,CTIADR  ;TAPE STOPPED - ADD A FEW 
       MOV  A,M         ;TACH EDGES TO BE SURE
       ADI  5 
       CMA            ;COMPLEMENT COUNT TO COUNT
       MOV  M,A         ;DOWN WHILE BACKING UP
       INX  H         ;GET HIGH BYTE
       MOV  A,M 
       ACI  0         ;ADD ANY CARRY FROM LOW BYTE
       CMA
       MOV  M,A 
       MVI  A,RUN     ;RETURN TO INITIAL POSITION 
       LXI  H,TISRC2
       CALL OUTCMD
SRC720 EQU  $         ;WAIT FOR TAPE TO FINISH
       CALL CTMON1    ;MONITOR TAPES
       JNZ  SRC720    ;WAIT IF STILL RUNNING
       RET
;*************************************************
;  DUAL-PURPOSE INTERUPT ROUTINE:                *
;    FORWARD:  COUNT TACH EDGES IN CTIADR        *
;    REVERSE:  COUNT TACH EDGES UNTIL CTIADR = 0,*
;                THEN STOP TAPE                  *
;*************************************************
TISRC2 EQU  $ 
       MOV  A,M       ;TEST CTSTAT
       ORA  A 
       RP             ;NO - RETURN
       MVI  L,CTIADR  ;YES - COUNT
       INR  M 
       RNZ            ;RETURN ON NO OVERFLOW
       INX  H         ;OVERFLOW - INC HIGH BYTE 
       INR  M         ;CTIADR = 0? (OCCURS ONLY IN
;                       REVERSE)
       RNZ            ;NO - RETURN
       JMP  STPTP0    ;YES - CLEAR RELTAK & RET 
 
;****************************** 
; SREVD - SEARCH FOR EVD MARK * 
;****************************** 
SREVD  EQU $
       LXI  H,-1      ;START SPACING MAX. DISTANCE
       CALL FWDSPX
       LXI  H,FEVDMS  ;GET "FIND EVD" MESSAGE 
       CALL SLTPMS    ;SET UP WITH UNIT MSG 
       LXI  H,CTISTA  ;SET UP FOR SPCWAT
       CALL SPCWT1    ;WAIT FOR TAPE TO STOP
       CALL CHKEV0    ;AT END OF VALID DATA?
       STC
       RZ             ;NO - RETURN ERROR
       CALL IOERCL    ;YES - CLEAR ERROR
       MVI  A,CMDEXC    ;AND SET "COMMAND EXECUTED
       JMP  STUNT0
       CALL CHKEV0    ;AT END OF VALID DATA?
       JNZ  IOERCL    ;YES - CLEAR ERROR AND RET
       STC            ;NO - RETURN ERROR
       RET
 
;***********************************
; TSTCTU - RELIABILITY TEST OF CTU *
;                                  *
;         EXIT: C => TEST FAILURE * 
;              NC => TEST SUCCESS * 
;***********************************
TSTCTU EQU  $ 
       LDA  MDFLG2    ;GET CURRENT MODE 
       MOV  B,A 
       PUSH B         ;SAVE MODE
       CALL STWBSR    ;SET WRITE/BACKSPACE/READ 
       CALL TCT005    ;DO TEST
       POP  B         ;RESTORE FORMER MODE
       MOV  A,B 
       STA  MDFLG2
       RET
TCT005 EQU  $ 
       CALL GTIOB0    ;GET I/O BUFFER 
       RC             ;RETURN ON ERROR
       DCX  H 
       DCX  H         ;H,L -> LENGTH
       MVI  M,0       ;0 => 256 
       INX  H         ;H,L => TYPE
       MVI  M,-1      ;-1 => NORMAL 
       INX  H         ;H,L -> STATUS
       CALL GTCTBT    ;GET FLAG FOR SELECTED UNIT 
       MOV  M,A 
       MOV  B,A       ;SAVE FOR BUF2CT
       XCHG           ;D,E -> STATUS
       CALL GETPTR    ;GET PTR TO 1ST BYTE OF BUF 
       MVI A,45Q    ;WORST CASE PATTERN 
TCT030 EQU  $ 
       MOV M,A      ;PUT BYTE IN BUFFER 
       XRI 177Q     ;ALTERNATE CHARACTER
       INR L        ;256 BYTES? 
       JNZ  TCT030    ;NO - CONTINUE
       CALL BUF2CT    ;RECORD BUFFER
       RC             ;RETURN ON ERROR
       LDA  CNTRL0  ;ANYTHING BUT RECORD
       ANI  EVD+HRDERR+SFTERR+EOF+WRTERR
       LXI  H,FAILMS    ;(GET FAIL MESSAGE) 
       JNZ  CTUERR    ;IF ERROR, RETURN 
       CALL EOFC    ;RECORD FILE MARK 
       RC             ;RETURN ON ERROR
       LDA  UNIT0     ;PAST EW HOLE?
       ANI  EW
       RZ             ;NO - QUIT
TCT050 EQU  $         ;YES - REWIND TAPE
       CALL RWDLP     ;START REWIND OPERATION 
TCT060 EQU  $         ;WAIT UNTIL REWIND FINISHED 
       CALL CTMON1    ;TAPE STILL RUNNING?
       RC               ;RETURN ON ERROR
       JNZ  TCT060    ;YES - WAIT 
       JMP  TCT005    ;LET GTIOBF & BUF2CT WAIT 
 
;***************************
; CONDTN - CONDITION TAPE  *
;***************************
CONDTN EQU  $ 
       CALL IOERCL    ;CLEAR ERROR (IOCERR <- S)
       MVI  A,4       ;CONTROL CODE FOR CONDITION 
       CALL USRNP0    ;GET DEVICE AND GO
       JMP  USREXT    ;QUIT 
 
;***********************************************
; KEY INTERPRETATION ***************************
;***********************************************
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GRNKEY - USER PRESSED GREEN KEY - PERFORM
;           I/O OPERATION 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  NC => NO ERROR 
;                IOCERR = S 
;              C => ERROR 
;                IOCERR = U => USER INTERRUPT 
;                IOCERR = F => FAILURE
; 
; 
GRN000 EQU  $         ;SOUND BELL FOR BAD KEY 
       CALL ZBELL 
GRNKEY EQU  $ 
       CALL CTMON     ;MONITOR THE TAPES
       CALL IOCCLR    ;CLEAR ALL I/O VARIABLES
       MVI  M,0       ;RESET ESCAPE FLAG
       CALL ZGETKY    ;ANY INPUT FROM KEYBOARD? 
       JNZ  GRNKEY    ;NO - CONTINUE WAITING
       CPI  CR        ;YES - IS IT A CR?
       RZ               ;YES - QUIT 
       ORA  A         ;IS IT NULL?
       JZ   GRN000      ;YES - REPORT ERROR 
;******************************** 
;  LOOK UP KEY IN VECTOR TABLE  * 
;******************************** 
       LXI  H,GRNTBL-3  ;BASE ADDRESS 
       LXI  B,3       ;DISTANCE BETWEEN ENTRIES 
GRN100 EQU  $ 
       DAD  B         ;POINT TO NEXT ENTRY
       CMP  M         ;IS KEY >= TABLE ENTRY? 
       JC   GRN100    ;NO - TRY NEXT ENTRY
       JNZ  GRN000    ;YES - IF NOT SAME, RING BEL
       INX  H         ;VALID COMMAND - GET VECTOR 
       MOV  E,M 
       INX  H 
       MOV  D,M 
       INR  B         ;ROUTINES WANT B = 1
       XCHG 
       RST  RSTJMP    ;DO INDIRECT CALL 
;******************************************** 
;  RETURN FOR USER INITIATED I/O FUNCTIONS  * 
;******************************************** 
USREXT EQU  $ 
       CC   FREBFS    ;FREE BUFFERS ON ERROR
       LDA  IOCERR    ;ANY ERROR? 
       CPI  S 
       RZ             ;NO - RETURN
       CPI  U         ;USER INTERRUPT?
       STC              ;(C => ERROR) 
       RZ             ;YES - QUIT 
;*********************************************
;  FAILURE - DISPLAY MESSAGE UNTIL CR REC'D  *
;*********************************************
       CALL CARDIS    ;DISPLAY MESSAGE
UTX100 EQU  $ 
       CALL CTMON1    ;CHECK FOR REMOVED TAPES
       CALL RETSCN    ;RETURN KEY PRESSED?
       JNC  UTX100      ;NO - CONTINUE WAITING
       JMP  RSTDSP      ;YES - RESTORE DISP & RET 
 
;************************************************ 
; 
;  TABLE FOR GREEN KEY FUNCTIONS
; 
;************************************************ 
GRNTBL EQU  $ 
       DB   377Q      ;CONTROL F1 (COPY ALL)
       DW   USRCMA      ;COMPARE TO END-OF-DATA 
       DB   372Q      ;TEST KEY 
       DW   CTUTST      ;PERFORM COMPLETE TEST
       DB   367Q      ;F8 
       DW   USRFFL      ;FIND FILE
       DB   366Q      ;F7 
       DW   USRSKP      ;SKIP LINES 
       DB   365Q      ;F6 
       DW   USREOF      ;MARK FILE
       DB   364Q      ;F5 
       DW   USRRWD      ;REWIND 
       DB   363Q      ;F4 
       DW   USRTED      ;TOGGLE EDIT MODE 
       DB   362Q      ;F3 
       DW   USRXFL      ;COPY LINE
       DB   361Q      ;F2 
       DW   USRXFF      ;COPY FILE
       DB   360Q      ;F1 
       DW   USRXFA      ;COPY ALL 
       DB   335Q      ;CONTROL F3 (COPY LINE) 
       DW   USRCMR      ;COMPARE LINE 
       DB   333Q      ;CONTROL F2 (COPY FILE) 
       DW   USRCMF      ;COMPARE FILE 
       DB   315Q      ;DELETE LINE
       DW   CLWBSR      ;CLR WRITE/BACKSP/READ MOD
       DB   314Q      ;INSERT LINE
       DW   STWBSR      ;SET WRITE/BACKSP/READ MOD
       DB   240Q      ;CONTROL READ 
       DW   EVDRED      ;READ BEYOND END-OF-DATA
       DB   230Q      ;ENTER KEY
       DW   DCTEST      ;DATACOM SELF-TEST
       DB   40Q       ;SPACE BAR
       DW   TPSTAT      ;DISPLAY FILE, INCHES 
       DB   0 
 
STWBSR EQU  $         ;SET WRITE/BS/READ MODE 
       LXI  H,MDFLG2
       MOV  A,M 
       ORI  WBSR
       MOV  M,A 
       RET
CLWBSR EQU  $         ;CLEAR WRITE/BS/READ MODE 
       LXI  H,MDFLG2
       MOV  A,M 
       ANI  -1-WBSR 
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CTUTST - DO COMPLETE TEST OF TERMINAL
;           INCLUDING TEST OF BOTH TAPE UNITS.
; 
;      TESTS LEFT CTU, THEN TESTS TERMINAL TWICE, 
;      THEN RIGHT CTU, THEN TERMINAL ONCE.
; 
; 
CTUTST EQU  $ 
       CALL IOERCL    ;CLEAR I/O ERROR FLAG 
       MVI  A,7       ;7 = CODE FOR TAPE TEST 
       STA  IOCTYP
       CALL CTLLCT    ;CONTROL ROUTINE FOR LEFT TA
       JC   CTT100    ;DISPLAY AND HANG ON ERROR
       CALL TEST      ;TEST TERMINAL
       CALL TEST      ;TEST TERMINAL
       CALL CTLRCT    ;CONTROL ROUT. FOR RIGHT TAP
       JNC  TEST      ;IF OK, RETEST TERMINAL & RE
CTT100 EQU  $ 
       LHLD MSGPT1    ;NOT OK - SET UP FOR HANGU0 
       JMP  HANGU0    ;DISPLAY MSG UNTIL HARD RESE
 
;**************************** 
; SELKEY - DEVICE SELECTION * 
;**************************** 
SELKEY EQU $
       LDA  MDFLG1    ;IN EDIT OR LOGGING MODE? 
       ANI  EDIT
       JNZ  ZBELL     ;YES - CAN'T CHANGE DEVICES 
       MVI  A,SELECT
       MVI  B,0 
       CALL ZSTMD1    ;TURN ON SELECT MODE
       CALL IOCCLR  ;CLEAR I/O STORAGE
       MVI M,0      ;RESET ESCAPE FLAG
SLK050 EQU $
       CALL CTMON     ;MONITOR TAPES
       CALL ZGETKY    ;ANY KEYBOARD INPUT?
       STA  CHARIN
       JNZ  SLK050    ;NO - CONTINUE SCANNING 
       CPI SLKYCD   ;IS IT THE SELECT KEY?
       JZ  SLK410   ;YES - ABORT DEVICE SELECT
       CPI  363Q      ;IS IT F4 (PRINTER INPUT)?
       JZ   SLK050    ;YES - IGNORE IT
       CALL CKDVKY  ;DEVICE KEY?
       JNZ SLK200   ;NO - TERMINATE PROCESSING
       MOV C,A      ;SAVE DEVICE FLAG 
       LDA  CHARIN  ;RECALL THE CHARACTER 
       LXI  H,IOCINP    ;(SET ADDRESS FOR INPUT)
       CPI  314Q      ;ALTERNATE I/O INPUT? 
       JZ   SLK150
       CPI  360Q      ;OTHER INPUT SPEC?
       JC   SLK130    ;NO - ALTERNATE I/O OUTPUT
       ANI  4Q        ;OTHER INPUT SPEC?
       JZ   SLK150    ;YES -
SLK130 EQU  $ 
       INX  H         ;NO - POINT TO OUTPUT 
SLK150 EQU  $ 
       MOV  A,C       ;RECALL DEVICE FLAG 
       ORA M        ;ACCUMULATE DEVICE FLAGS
       MOV M,A      ;SAVE FLAGS 
       JMP SLK050   ;GET NEXT CHAR. 
; 
;  NON-DEVICE KEY HIT - TERMINATE SELECTION MODE
; 
SLK200 EQU $
       CALL SETDEV    ;VALID ASSIGNMENT?
       CC   CTUERR    ;NO - FLAG ERROR
       MVI  A,RPTKEY
       CNC  ZKBCTL    ;YES - PUT CHAR BACK INTO IN
SLK410 EQU  $         ;ABORT ENTRY
       MVI  A,SELECT  ;TURN OFF LIGHT 
       CALL ZCLMD1
       JMP  USREXT    ;RETURN TO SYSTEM 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  SETDEV - SET DEVICE ASSIGNMENT 
; 
;      ENTRY:  IOCINP, IOCOUT CONTAIN NEW 
;                DEVICE ASSIGNMENTS 
; 
;      EXIT :  C => ERROR 
;                H,L -> APPROPRIATE ERROR MSG 
;              NC => NO ERROR 
;                INPDEV, OUTDEV UPDATED 
;              A DESTROYED
; 
SETDEV EQU $
       LXI  H,IOCINP  ;CHECK INPUT ASSIGNMENT 
       XRA A
       SUB M        ;ANY ASSIGNMENT?
       JZ  STD010   ;NO - CHECK OUTPUT ASSIGNMENT 
       ANA M        ;YES - MASK FOR RIGHTMOST BIT 
       CMP M        ;ONLY ONE ASSIGNMENT? 
       LXI  H,TMFMSG    ;(TOO MANY "FROM" DEVS) 
       STC
       RNZ            ;NO - RETURN FAIL 
       CPI  PRINTR      ;IS IT THE PRINTER? 
       STC
       RZ               ;YES - RETURN ERROR 
       STA  INPDEV      ;AND STORE IT 
; 
;  CHECK OUTPUT ASSIGNMENT
; 
STD010 EQU $
       LDA  IOCOUT    ;NEW OUTPUT ASSIGNMENT? 
       ORA  A 
       RZ           ;NO - RETURN SUCCESSFUL 
       STA  OUTDEV    ;YES - STORE IT 
       XRA A        ;SET Z TO TRUE
       RET          ;RETURN 
 
;*************************
;  CONTROL READ PRESSED  *
;*************************
CTLRED EQU  $ 
       LXI  H,MDFLG2  ;GET HARD MODE FLAGS
       MOV  A,M 
       ANI  REMOTE    ;REMOTE MODE ENABLED? 
       JZ   REDKEY    ;NO - DO NORMAL READ
       CALL IOERCL    ;YES - CLEAR I/O ERROR FLAG 
       MOV  A,M       ;RECALL HARD MODE FLAGS 
       CMA
       ANI  BLKMDE    ;IN BLOCK MODE? 
       CZ   GTMODE    ;YES - CHECK LINE/PAGE
       MVI  A,RDWOWT  ;IF NOT BLOCK, LINE, DO READ
       CNZ  STIOFS      ;WITHOUT WAIT 
       JMP  RED010    ;GO TO READ KEY ROUTINE 
 
;**************************** 
; REDKEY - READ KEY PRESSED * 
;**************************** 
REDKEY EQU  $ 
       CALL IOERCL    ;CLEAR I/O ERROR FLAG 
       LDA  MDFLG2    ;LOCAL MODE? (REMOTE UP OR
       ANI  REMOTE+BLKMDE  ;BLOCK DOWN?)
       XRI  REMOTE
       JNZ  RED100    ;YES - DO LOCAL FILE COPY 
;*****************************
;  REMOTE READ (TO DATACOM)  *
;*****************************
RED010 EQU  $ 
       LDA  KBDCSW    ;FULL DUPLEX? 
       ANI  FULDUP
       JZ   RED020    ;NO - 
       MVI  A,EXTB2D  ;YES - INHIBIT ECHO TO DISP 
RED020 EQU  $ 
       STA  IOFLG2
       SUB  A 
       STA  IOCTYP    ;ASCII XFR, NO BYTE COUNT 
       STA  XFRLIM    ;TRANSFER TO END OF FILE
       CALL BSYCK0    ;INPUT TAPE => WAIT TILL FRE
       RC             ;RETURN ON USER INTERRUPT 
       MVI  A,USREAD  ;SET USER READ FLAG 
       CALL STIOFS
       ANI  RDWOWT    ;READ W/O WAIT? 
       JNZ  IORDGO    ;YES - SEND IMMEDIATELY 
;************** 
; ROM BREAK 2 * 
;************** 
       JMP  ZBRK2C
       ORG  ZBRK1+4000Q 
ZBRK2  EQU  $ 
       DB   VERSN     ;ROM PRESENT/VERSION FLAGS
       DB   ZBRK2/256 
ZBRK2C EQU  $ 
       LXI  B,SDVREC
       JMP  SBLXFA
;**************************** 
;  LOCAL READ (TO DISPLAY)  * 
;**************************** 
RED100 EQU  $ 
       LDA  MDFLG1    ;CHECK FOR EDIT MODE
       ANI  EDIT
       JZ   RED120
       CALL CURPHD    ;EDIT - HOME DOWN 
       CALL FRECNT    ;ENOUGH BLOCKS? 
       RNZ            ;NO - RETURN
RED120 EQU  $ 
       LHLD OUTDEV    ;H <- INPUT DEVICE
       MVI  L,DISPLY  ;SET OUTPUT DEV = DISPLAY 
       SUB  A         ;SET FOR XFR TO END OF FILE 
       CALL XFR001    ;DO THE READ
       JMP  USREXT    ;REPORT ANY ERRORS AND RET
 
;****************************** 
; RECKEY - RECORD KEY PRESSED * 
;****************************** 
RECKEY EQU  $ 
       CALL IOERCL    ;CLEAR I/O ERROR FLAG 
       LXI  H,MDFLG1  ;IN EDIT MODE?
       MOV  A,M 
       ANI  EDIT
       JNZ  USREDA    ;YES - TERMINATE EDIT MODE
       MOV  A,M       ;NO - IN RECORD MODE? 
       ANI  RECORD
       JNZ  RCK700      ;YES - END RECORD MODE
       MVI  A,RECINI  ;SET "RECORD INIT" FLAG 
       CALL STIOFS
       LDA  MDFLG2      ;REMOTE?
       ANI  REMOTE
       MVI  A,RECORD      ;(SET UP TO BLINK RECORD
       MVI  B,-1           ;LED)
       JNZ  ZSTMD1      ;YES - GO INTO RECORD MODE
;*****************
;  LOCAL RECORD  *
;*****************
       CALL STRTBL    ;FIND START OF BLOCK
       LHLD OUTDEV    ;L <- OUTPUT DEVICE(S)
       MVI  H,DISPLY  ;SET INPUT = DISPLAY
       SUB  A         ;SET FOR XFR TO END OF DATA 
       INR  A 
       CALL XFR001    ;DO THE RECORD
;                       TO INITDG 
       JC   USREXT    ;QUIT ON ERROR
       CALL CHKFMT    ;IN FORMAT MODE?
       JZ   USREXT    ;NO - RETURN TO SYSTEM
       CALL CURPH     ;YES - HOME THE CURSOR AND
       CALL CLEARS      ;CLEAR UNPROTECTED FIELDS 
       JMP  USREXT    ;EXIT TO SYSTEM 
 
;****************** 
;  REMOTE RECORD  * 
;****************** 
; 
;  RECORDING IS TRIGGERED BY CHAR FROM DATACOM
;  OTHER THAN CR OR LF.  WHEN RECEIVED, SYSTEM
;  CALLS RCRDGO.
; 
RCRDGO EQU  $ 
       STA  CHAR      ;SAVE THE FIRST CHAR
       MVI  A,RECORD  ;TURN OFF LED BLINK 
       MVI  B,0 
       CALL ZSTMD1
RCK650 EQU  $ 
       CALL GTIOB0    ;GET BUFFER 
       JC   RCK700    ;TERMINATE MODE ON ERROR
       MVI  M,DATCOM  ;MARK BUF FOR DATACOM INPUT 
       DCX  H         ;H,L -> TYPE
       MVI  M,-1      ;ALL RECORDS ARE NORML (DATA
       DCX  H         ;H,L -> LENGTH
       MVI  M,0       ;INIT TO 0
       XCHG           ;D,E -> LENGTH
       CALL DC2BUF    ;GET RECORD FROM DATACOM
       JC   RCK700    ;QUIT RECORD MODE ON ERROR
       XCHG           ;DC2BUF RETURNS H,L -> LENGT
       INX  D         ;WANT D,E -> STATUS FOR 
       INX  D           ;PUTIO
       CALL PUTIO     ;OUTPUT RECORD
       JNC  RCK650    ;NO ERROR - GET NEXT RECORD 
RCK700 EQU  $         ;QUIT RECORD MODE 
       CALL FREBFS    ;FREE BUFFERS 
       MVI  A,RECORD  ;TURN OFF LED 
       CALL ZCLMD1
       JMP  USREXT    ;SET TRIG, REPORT ERRORS (IF
;                       ANY), QUIT
 
;***********************
; USRFFL - LOCATE FILE *
;***********************
USRFFL EQU  $ 
       LXI  H,LOCMSG  ;DISPLAY LOCATE FILE MESSAGE
       INR  B         ;SET FUNCTION CODE
       JMP  USS010    ;ACCUMULATE PARAMETER 
;****************************** 
; USRSKP - SPACE OVER RECORDS * 
;****************************** 
USRSKP EQU  $ 
       LXI  H,SKPMSG  ;DISPLAY SPACE MESSAGE
USS010 EQU  $ 
       MVI  A,DECRDX  ;SET RADIX TO DECIMAL 
       STA  RADIX 
       SHLD MSGPT1    ;SET PARAMETER MESSAGE
       LXI  H,M1MSG   ;SET DEFAULT PARAMETER = -1 
       SHLD MSGPT2
       LXI  H,IOCTYP  ;STORE FUNCTION TYPE CODE 
       MOV  M,B 
USS020 EQU  $ 
       CALL CARDIS    ;DISPLAY MESSAGE
USS030 EQU  $ 
       CALL CTMON     ;MONITOR TAPES
       CALL ZGETKY    ;ANY KEYBOARD INPUT?
       JNZ  USS030    ;NO - CONTINUE SCANNING 
       CPI  CR        ;RETURN KEY HIT?
       JZ   RSTDSP    ;YES - ABORT
       CALL USS300    ;DIGIT OR SIGN? 
       JNC  USS020    ;YES - DISPLAY MESSAGE AGAIN
       CALL CKDVKY    ;IS IT A DEVICE KEY?
       CNZ  ZBELL     ;NO - SOUND BELL
       JNZ  USS030      ;AND TRY ANOTHER KEY
IOSCTL EQU  $ 
       STA  IOCDEV  ;SAVE DEVICE CODE 
       LHLD IODATA  ;GET ACCUMULATED PARAMETER
       LDA  IOCSGN    ;ANY VALUE SPECIFIED? 
       ORA  A 
       JNZ  USS050    ;YES - STORE PARAMETER
       CMA            ;NO - SET DEFAULT OF -1 
       INX  H         ;MAGNITUDE = 1
; 
USS050 EQU  $ 
       STA  IOPSGN    ;STORE SIGN 
       SHLD IOCCNT    ;STORE MAGNITUDE
       CALL RSTDSP    ;RESTORE NORMAL DISPLAY 
       JMP  CTR025      ;AND PERFORM FUNCTION 
 
; 
;  PROCESS DIGIT OR SIGN KEYS 
; 
USS300 EQU  $ 
       CPI  PLUS      ;PLUS SIGN? 
       CZ   DCPLUS    ;YES - SET SIGN FLAG
       JZ   USS305      ;AND UPDATE MESSAGE 
       CPI MINUS    ;MINUS? 
       CZ   DCMNUS    ;YES - SET SIGN FLAG
       JZ   USS305      ;AND UPDATE MESSAGE 
       CPI ZERO     ;DIGIT? 
       RC           ;NO - RETURN
       CPI ZERO+10  ;DECIMAL DIGIT? 
       STA  CHAR        ;(SAVE CHARACTER IN CASE) 
       CMC              ;(INVERT SENSE OF COMPARE)
       RC             ;NO - RETURN
       CALL DCNUM     ;YES - ACCUMULATE THE DIGIT 
USS305 EQU  $         ;SET UP MESSAGE 
       LDA  IOCSGN    ;GET SIGN VALUE 
       ADD  A         ;ANY SIGN SPECIFIED?
       LXI  H,BLKMSG    ;(SET FOR BLANK MESSAGE)
       JZ   USS310    ;NO - ADD NO SIGN TO MESSAGE
       LXI  H,PLSMSG    ;(SET FOR PLUS MESSAGE) 
       JP   USS310    ;PLUS - DISPLAY PLUS SIGN 
       LXI  H,MNSMSG  ;MINUS - DISPLAY MINUS SIGN 
USS310 EQU  $ 
       SHLD MSGPT2    ;SET SIGN VALUE 
       LHLD IODATA    ;GET ACCUMULATED VALUE
       XCHG           ;PUT INTO D,E 
       LXI  H,B2DBUF  ;GET OUTPUT BUFFER ADDRESS
       SHLD MSGPT3    ;SET MESSAGE POINTER
       LDA  IOCTYP    ;GET COMMAND TYPE 
       DCR  A         ;SEARCH COMMAND?
       MOV  A,E         ;(PUT LSB INTO A-REG) 
       CNZ  BN2DE0    ;YES - DISPLAY ONE BYTE ONLY
       CZ   BN2DEC    ;NO - DISPLAY TWO BYTE VALUE
       MVI  M,EOP     ;ADD TERMINATOR CHARACTER 
       ORA  A         ;RETURN "NC" TO INDICATE
       RET              ;VALID DIGIT OR SIGN
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CKDVKY - CHECK FOR DEVICE KEY
; 
;      ENTRY:  A = KEY VALUE
; 
;      EXIT :  Z = T, DEVICE KEY
;                     A = DEVICE BIT
;              Z = F, NON-DEVICE KEY
;                     A DESTROYED 
;              H,L DESTROYED
; 
CKDVKY EQU $
       MVI  L,5       ;FIRST TEST FOR ALTERNATE I/
       CPI  314Q      ;INSERT LINE? 
       JZ   CKD100    ;YES -
       CPI  321Q      ;INSERT CHAR ON?
       JZ   CKD100    ;YES -
       CPI  322Q      ;INSERT CHAR OFF? 
       JZ   CKD100    ;YES -
       ANI 373Q     ;F1:=F1+F5, ETC.
       SUI 357Q     ;CHAR.-357B 
       MOV  L,A 
CKD100 EQU  $ 
       MVI  H,0 
       JMP DFNDV0   ;CHECK VALID DEVICE 
 
;****************************** 
; USRRWD - REWIND TAPE TO BOT * 
;****************************** 
USRRWD EQU $
       XRA A        ;SET CONTROL CODE 
       JMP USRNP0   ;GET UNIT SELECT
;**************************** 
; USREOF - RECORD FILE MARK * 
;**************************** 
USREOF EQU $
       MVI A,5      ;SET CONTROL CODE 
USRNP0 EQU $
       STA  IOCTYP    ;STORE CONTROL CODE 
USRNPM EQU $
       CALL CTMON     ;MONITOR TAPES
       CALL ZGETKY    ;ANY KEYBOARD INPUT?
       JNZ  USRNPM    ;NO - CONTINUE SCANNING 
       CPI CR       ;IS KEY RETURN? 
       RZ               ;YES - ABORT
       CALL CKDVKY  ;IS IT A DEVICE KEY?
       JZ  IOSCTL   ;YES - PERFORM FUNCTION 
       CALL ZBELL     ;NO - SOUND THE BELL
       JMP USRNPM   ;GET ANOTHER KEY
 
;**************************** 
; USRTED - TOGGLE EDIT MODE * 
;**************************** 
USRTED EQU  $ 
       LXI  H,MDFLG1  ;EDIT MODE ON?
       MOV  A,M 
       ANI  EDIT
       JZ   UTE030    ;NO - TURN ON EDIT
;***********************
;  TURN OFF EDIT MODE  *
;***********************
EDRST  EQU  $         ;ENTRY FOR CTU RESET
       MVI  A,EDIT    ;TURN OFF EDIT LIGHT
       CALL ZCLMD1
       LXI  H,SWPCTU  ;DATA LOGGING IN SWAP CTU'S 
       MOV  A,M         ;MODE?
       ORA  A 
       RZ             ;NO - RETURN
       MVI  M,0       ;YES - CLEAR SWPCTU 
       MVI  A,-1-RECRWD ;CLEAR PENDING REWIND 
       CALL CLIOFS
       MVI  L,OUTDEV    ;SET UP BOTH CTU'S AS 
       MOV  A,M           ;OUTPUT DEVICES 
       ORI  LFTCTU+RGTCTU 
       MOV  M,A 
       RET
;********************** 
;  TURN ON EDIT MODE  * 
;********************** 
UTE030 EQU  $ 
       MOV  A,M       ;FORMAT MODE? 
       ANI  FORMAT
       RNZ            ;YES - IGNORE EDIT REQUEST
       MVI  L,INPDEV  ;CHECK FOR INPUT/OUTPUT DEV 
       MOV  A,M         ;DUPLICATION
       ORI  DISPLY      ;(ADD DISPLAY AS INPUT DEV
       DCX  H           ;(GET OUTPUT DEVICES) 
       ANA  M         ;ANY DUPLICATION? 
       JNZ  IOFAI0    ;YES - REPORT FROM = TO 
       CALL MLKOFF    ;TURN OFF MEMORY LOCK 
       MVI  B,0       ;SET B FOR NO BLINK (LOCAL) 
       LDA  MDFLG2    ;LOCAL MODE?
       ANI  REMOTE
       JZ   UTE070    ;YES - TURN ON LIGHT & RET
;********************************************** 
;  SET UP REMOTE EDIT (ON-LINE DATA LOGGING)  * 
;********************************************** 
       LXI  H,OUTDEV  ;BOTH TAPES ON OUTPUT?
       MOV  A,M 
       CMA
       ANI  LFTCTU+RGTCTU 
       MVI  A,0         ;(SET A FOR "NO") 
       JNZ  UTE050    ;NO - 
       MOV  A,M       ;YES - USE ONLY LEFT TAPE 
       ANI  -1-RGTCTU 
       MOV  M,A 
       MVI  A,-1         ;AND SET SWPCTU = -1 
UTE050 EQU  $ 
       DCR  B         ;SET B FOR BLINKING (LOGGING
UTE070 EQU  $ 
       STA  SWPCTU    ;MARK SWPCTU ACCORDINGLY
UTE100 EQU  $ 
       MVI  A,EDIT    ;FLAG FOR SET ROUTINE 
       JMP  ZSTMD1
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      PTTPLN - OUTPUT TOP LINE OF DISPLAY MEMORY 
; 
;      ENTRY:  D,E -> (1ST CHAR IN LINE)+1
; 
;      EXIT :  LINE SENT TO ALL OUTPUT DEVICES
;              C => ERROR, LINE NOT OUTPUT
;              NC => NO ERROR 
;              A,B,H,L DESTROYED
; 
; 
PTP002 EQU  $ 
       LDA  INPDEV    ;ANY CHANCE FOR A BUF?
       ORI  DISPLY+DATCOM  ;(REQ'S BUF THAT IS NOT
       MOV  B,A         ;CLAIMED BY INPUT DEV, DIS
       ORA  M           ;OR DATA COMM)
       MVI  L,B2STAT
       ORA  M         ;DOES A BUF HAVE ANY OTHER
       CMP  B           ;BIT SET? 
       STC            ;NO - RETURN ERROR
       RZ 
PTTPLN EQU  $ 
       EI 
       CALL CTMON1    ;MONITOR TAPES
       CC   USREXT    ;REPORT ANY ERRORS
       DI             ;COMPETE WITH CTU FOR FREE B
       CALL GTIOBF    ;EITHER BUFFER FREE?
       JZ   PTP005    ;YES - CLAIM IT 
       MVI  A,PTTPOK  ;NO - IS BUF 2 AVAIL FOR THI
       CMP  M           ;ROUTINE? 
       JZ   PTP005    ;YES - CLAIM IT 
       MVI  L,B1STAT
       CMP  M         ;NO - HOW ABOUT BUF 1?
       JNZ  PTP002    ;NO - ANY CHANCE FOR A BUF? 
PTP005 EQU  $         ;BUFFER FOUND 
       MVI  M,DISPLY  ;MARK FOR OUTPUT TO DISPLAY 
       EI 
       PUSH D         ;SAVE PTR TO START OF LINE
       LDA  DFLGS     ;READ IN PROGRESS?
       ANI  XBF2DS
       CZ   IOERCL    ;NO - CLEAR ERROR FLAG
       PUSH H         ;SAVE STATUS POINTER
       MOV  A,L       ;GETPT1 TAKES ARG IN A
       CALL GETPT1    ;GET PTR TO START OF BUFFER 
PTP010 EQU  $         ;FILL BUFFER
       CALL NXTCHR    ;GET NEXT BYTE
       JNZ  PTP030    ;END OF LINE - OUTPUT IT
       CPI  FILL      ;FILL CHARACTER?
       JZ   PTP010      ;YES - GET NEXT BYTE
       CPI  STPFLG    ;NON-DISPLAYING TERMINATOR? 
       JZ   PTP010      ;YES - GET NEXT BYTE
       MOV  M,A       ;PUT BYTE IN BUF
       INR  L         ;INC POINTER
       JZ   PTP490    ;REPORT BUFFER OVERFLOW 
       CPI  EOL       ;WAS IT END OF LINE?
       JNZ  PTP010    ;NO - GET NEXT BYTE 
       DCR  L         ;YES - DELETE EOL FROM BUF
PTP020 EQU  $         ;FIND NEXT LINE POINTER 
       CALL NXTCHR      ;(NXTCHR RETURNS FILLS) 
       JZ   PTP020    ;NOT THERE YET - CONTINUE 
;******************************************** 
;  BUFFER FILLED, D,E -> NEXT LINE POINTER  * 
;******************************************** 
PTP030 EQU  $ 
       LDAX D         ;GET NEXT BYTE
       POP  D         ;D,E -> BUFFER STATUS 
       SUI  EOP       ;END OF PAGE? 
       JNZ  PTP040    ;NO - OUTPUT LINE 
       ADD  L         ;YES - ANY BYTES IN BUF?
       STC              ;(PREPARE FOR ERROR EXIT) 
       JZ   PTP220    ;NO - RELEASE BUF AND QUIT
PTP040 EQU  $         ;OUTPUT LINE
       DCR  L         ;IS LAST LINE A CR? 
       MVI  A,CR
       CMP  M 
       JZ   PTP050    ;YES - JUST APPEND LF 
       INR  L         ;NO - APPEND CR AND LF
       MOV  M,A 
PTP050 EQU  $         ;APPEND LINE FEED 
       INR  L         ;IS THERE ROOM FOR THE LF?
       JZ   PTP500    ;NO - REPORT BUFFER OVERFLOW
       MVI  M,LF      ;YES - INSERT IT
       INR  L         ;AND INCREMENT COUNT
;******************************************** 
;  (CR)LF APPENDED, MARK BUFFER FOR OUTPUT  * 
;******************************************** 
       DCX  D 
       DCX  D         ;D,E -> LENGTH
       MOV  A,L       ;L = LENGTH 
       STAX D 
       INX  D         ;D,E -> TYPE
       MVI  A,-1      ;-1 => DATA 
       STAX D 
       INX  D         ;D,E -> STATUS
;************************************************ 
;  IF LOCAL READ IN PROGRESS, OUTDEV <- SAVOUT  * 
;************************************************ 
       CALL PUTIO     ;OUTPUT BUFFER
       JNC  PTP220    ;NO ERROR - QUIT
       LDA  IOCERR    ;TIME TO SWAP CTU'S?
       CPI  177Q        ;(-1 => YES)
       CNC  IOERCL    ;YES - CLEAR ERROR FLAG...
       CNC  PUTIO      ;...AND TRY AGAIN
PTP220 EQU  $ 
       POP  D         ;D,E -> BLOCKS FOR RELEASE
       LDA  IOCERR    ;ANY ERRORS?
       CPI  F+1       ;(U IS NOT A VALID OUTPT ERR
       RNC            ;NO - RETURN NC => NO ERROR 
       JMP  USREXT    ;YES - RETURN C => CLR BUFS 
;***************************
;  REPORT BUFFER OVERFLOW  *
;***************************
PTP490 EQU  $ 
       POP  D 
PTP500 EQU  $ 
       LHLD BUFMSG    ;"BUFFER OVERFLOW" MESSAGE
       CALL IOFAI1    ;SET ERROR FLAG 
       JMP  PTP220    ;REPORT ERROR 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      USREDA - PERFORM EDIT MODE "RECORD"
; 
;      LOCAL:  COPY DISPLAY TO OUTPUT DEVICES,
;              COPY FILE FROM INPUT TO OUTPUT,
;              TERMINATE EDIT MODE. 
; 
;      REMOTE: COPY DISPLAY TO OUTPUT DEVICES,
;              STAY IN EDIT MODE. 
; 
;      NO PARAMETERS, DESTROYS ALL REGISTERS
; 
; 
USREDA EQU  $ 
       LDA  MDFLG2    ;REMOTE OR LOCAL? 
       ANI  REMOTE
       JZ   EDA500    ;LOCAL -
;***********************
;  DO REMOTE "RECORD"  *
;***********************
EDA100 EQU  $ 
       CALL GETDCM    ;MONITOR DATACOM: DATA REC'D
       JZ   EDA100    ;YES - CONTINUE MONITORING
       CALL PTBLK0    ;WRITE TOP LINE TO OUT DEV'S
       JNZ  EDA100    ;MORE TO DO - CONTINUE
       RC             ;RETURN ON PTBLKS ERROR 
       JMP  MLKOFF    ;FINISHED, NO ERRORS
;********************** 
;  DO LOCAL "RECORD"  * 
;********************** 
EDA500 EQU  $ 
       CALL CURPH     ;LET USER SEE WHAT'S GOING O
EDA520 EQU  $         ;RECORD SCREEN
       MVI  A,26      ;PUT CURSOR OFF SCREEN TO 
       STA  CURROW      ;AVOID PTBLK ERRORS 
       CALL RETSCN    ;USER INTERRUPT?
       JC   CURPH     ;YES - HOME UP AND RETURN 
       CALL PTBLK0    ;WRITE TOP LINE TO OUT DEV'S
       JNZ  EDA520    ;MORE LINES - CONTINUE
;********************************** 
;  ONLY ONE LINE LEFT ON DISPLAY  * 
;********************************** 
       RC             ;QUIT ON PTBLK ERROR
       CALL MLKOFF    ;TURN OFF MEMORY LOCK 
       CALL MLKSCH    ;GET LAST ROW (IF ANY)
       JZ   EDA550    ;NO UNLOCKED ROW
       DCX  H         ;UNLOCKED ROW - GET 1ST CHAR
       MOV  A,M 
       INX  H 
       CPI  EOL       ;IS IT A NULL ROW?
       XCHG             ;PTTPLN WANTS D,E -> LINE 
       CNZ  PTTPLN    ;NO - OUTPUT IT 
EDA550 EQU  $ 
       CALL CURPH     ;HOME CURSOR
       CALL CLEARL    ;DELETE TOP LINE (IF ANY) 
;*********************************
;  COPY REST OF INPUT TO OUTPUT  *
;*********************************
       LDA  INPDEV    ;GET INPUT DEVICE 
       CPI  DISPLY    ;IS IT DISPLAY? 
       JZ   USRTED    ;YES - TURN OFF EDIT & RETUR
       ANI  LFTCTU+RGTCTU 
       JZ   EDA600    ;INPUT NOT TAPE, CONTINUE 
       LXI  H,CTSTAT  ;IS INPUT TAPE INSERTED?
       ANA  M 
       JZ   USRTED    ;NO - QUIT
       MOV  H,A       ;SAVE INPUT UNIT
       CALL GTCTBT    ;GET BIT FOR SEL UNIT 
       CMP  H         ;IS INPUT UNIT SELECTED?
       LDA  CNTRL0    ;YES - GET BITS FOR SEL. UNI
       JZ   EDA580
       LDA  CNTRL0+OTHER-SFTCNT  ;NO - GET OTHER
EDA580 EQU  $ 
       ANI  EOF       ;TAPE AT EOF? 
       JNZ  USRTED    ;YES - QUIT 
EDA600 EQU  $           ;(ENTRY FOR OTHER DEVICES)
       MVI  B,0         ;(SET FOR XFR TO EOF) 
       CALL XFRD2D    ;NO - TRANSFER TO END OF FIL
       CNC  USRTED    ;NO ERRORS - TURN OFF EDIT
       JMP  USREXT    ;REPORT ANY ERRORS & RET
 
; 
; 
;  USRXFL - USER TRANSFER ONE RECORD
; 
USRXFL EQU $
       DCR B
; 
; 
;  USRXFF - USER TRANSFER TO END OF FILE MARK 
; 
USRXFF EQU $
       DCR B
; 
; 
;  USRXFA - USER TRANSFER TO EVD MARK 
; 
USRXFA EQU $
;                  FALL THROUGH TO USRXFR 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  USRXFR - USER INITIATED TRANSFER 
; 
;      ENTRY:  B = TRANSFER LIMIT 
; 
USRXFR EQU $
       ORA  A         ;NC => TRANSFER 
       JMP  XFRD2D    ;PERFORM TRANSFER 
 
;*******************
; DISPLAY MESSAGES *
;*******************
; 
MESSGE EQU  $         ;FOR CROSS REFERENCE
; 
SKPMSG EQU  $ 
       DB   INVRS,'SKIP LINES',0
LLPMSG EQU $
       DB   INVRS,'LOCATING LOAD POINT',0 
OFFMSG EQU  $ 
       DB   203Q,'RUNOFF',0 
UETMSG EQU  $ 
       DB   203Q,'ABORTED - ' 
EOTMSG EQU  $ 
       DB   INVRS,'END OF TAPE',0 
FEVDMS EQU  $ 
       DB   INVRS,'FIND ' 
EVDMSG EQU $
       DB   INVRS,'END OF DATA',0 
; 
NRCMSG EQU  $ 
       DB   INVRS,'DATA PROTECTED',0
; 
LOCMSG EQU  $ 
       DB   INVRS,'FIND FILE',0 
; 
FLINMS EQU  $ 
       DB   INVRS,'FILE NUMBER',200Q,' '
       DB   212Q,'INCHES LEFT',200Q,':  ',INVRS,0 
; 
HRDMSG EQU $
       DB   202Q,'READ '
FAILMS EQU  $         ;GENERAL FAIL MESSAGE 
       DB   INVRS,'FAIL',0
NTPMSG EQU $
       DB   INVRS,'NO TAPE',0 
INOMSG EQU $
       DB   202Q,'"FROM" DEVICE = "TO" DEVICE'
       DB   EOP 
TMTMSG EQU  $ 
       DB   202Q,'TOO MANY "TO" DEVICES',EOP
PREMSG EQU $
       DB   INVRS,'PRINT FAIL',EOP
 
RTRYMS EQU  $ 
       DB  202Q,'RETRY' 
EOPMSG EQU $
       DB  EOP
NLTPMS:DB   200Q
OLTPMS EQU $
       DB   ' ON LEFT DRIVE',0
NRTPMS:DB   200Q
ORTPMS EQU $
       DB   ' ON RIGHT DRIVE',0 
TMFMSG EQU  $ 
       DB   INVRS,'TOO MANY "FROM" DEVICES',EOP 
BSYMSG EQU  $ 
       DB   INVRS,'BUSY - WAITING',0
WRFMSG EQU  $ 
       DB   INVRS,'WRITE FAIL',0
NULMSG EQU  $ 
       DB   0 
EOFMSG EQU  $ 
       DB   INVRS,'END OF FILE',0 
DLRMSG EQU  $ 
       DB   202Q,'DIFFERENT LENGTH RECORDS',0 
DIFMSG EQU  $ 
       DB   202Q,'DIFFERENCE IN BYTE ',0
RECMSG EQU  $ 
       DB   ', RECORD ',0 
FILMSG EQU  $ 
       DB   ', FILE'
BLKMSG EQU  $ 
       DB   ' ',0 
STALMS EQU  $ 
       DB   203Q,'STALL',0
FMSMSG EQU  $ 
       DB   INVRS,'FILE MISSING',0
CONMSG EQU  $ 
       DB   INVRS,'CONFLICTING I/O',EOP 
; 
M1MSG  EQU  $ 
       DB   ' -1',EOP 
; 
PLSMSG EQU  $ 
       DB   ' +',0
; 
MNSMSG EQU  $ 
       DB   ' -',0
; 
COMAMS EQU  $ 
       DB   ',  ',INVRS,0 
 
; 
; DSPNUM - CONVERT NUMBER AND PLACE IN MEMORY 
; 
;          ENTRY: (H,L) = ADDRESS FOR CHARS.
;                A = NUMBER TO BE CONVERTED 
; 
;          EXIT: (H,L) = ADDRESS AFTER NUMBER 
; 
DSPNUM EQU  $ 
       PUSH B         ;SAVE REGISTER B-E
       PUSH D 
       CALL BN2DE0
       MVI  M,0       ;ADD NULL TO CONTINUE MESSAG
       INX  H         ;SET TO NEXT MESSAGE BYTE 
       POP  D         ;RESTORE REGITER B-E
       POP  B 
       RET            ;RETURN 
 
; 
;  CARDI0 - DISPLAY FIRST HALF OF MESSAGE ONLY
; 
;      ENTRY:  H,L = POINTER TO MESSAGE 
; 
CARDI0 EQU $
       CALL SLTPMS    ;GET MSG FOR SELECTED TAPE
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CARDIS - SET DISPLAY TO I/O MESSAGE
; 
;      ENTRY:  MSGPT1 = PTR TO 1ST HALF OF MSG
;              MSGPT3. . .MSGPT8 = PTRS TO REST OF
;                     MESSAGE 
; 
;      EXIT :  A,H,L DESTROYED
;              H = BASEH
; 
;  ONE TO EIGHT MESSAGE POINTERS MAY BE USED. 
;  ALL PARTS END IN '0' EXCEPT THE LAST, WHICH END
;  IN EOP.
; 
CARDIS EQU $
       STC            ;C => CLOBBER DISPLAY FIRST 
       PUSH B 
       PUSH D 
       CALL DSPMSG    ;DISPLAY MESSAGE
       POP  D 
       POP  B 
       RET
 
;***********************************************
; ESCAPE SEQUENCE CONTROL **********************
;***********************************************
;****************** 
; BINARY TRANSFER * 
;****************** 
CTDCDP EQU  $ 
       CALL IOERCL    ;CLEAR I/O ERROR FLAG 
       MVI  A,FSTBIN  ;SET DATACOM FOR FAST (9600)
       CALL DCMCTL      ;BINARY 
       CALL BSYCK0    ;INPUT TAPE => WAIT TILL FRE
       RC             ;RETURN ON USER INTERRUPT 
       MVI  A,-1-FILRED-USREAD-RDWOWT 
       CALL CLIOFS    ;CLEAR USER & FILE READ FLAG
       CNZ  RDABR1    ;IF NOT ZERO, ABORT READ
       CALL INTDS0    ;INPUT=DISPLAY => INITIALIZE
CTD050 EQU  $ 
       CALL GETIO     ;GET A RECORD 
       MVI  B,0         ;(SET B-REG FOR EXIT) 
       JC   CTD100    ;EXIT ON INPUT ERROR
       MVI  A,DATCOM  ;MARK FOR OUTPUT TO DATACOM 
       STAX D 
       DCX  D         ;GET RECORD TYPE
       LDAX D 
       ORA  A         ;DATA RECORD? 
       JP   CTD110    ;NO - EXIT
       DCX  D         ;BNR010 WANTS D,E->LENGTH 
       CALL GETPTR      ;AND H,L -> FIRST BYTE
       CALL BNR010    ;SEND THE RECORD
       MVI  B,0         ;(SET B-REG FOR EXIT) 
       JNC  CTD050    ;NO ERROR - GET NEXT RECORD 
;****************************************** 
;  I/O COMPLETED - SEND TWO-BYTE RECORD:  * 
;                      0, 0 => SUCCESS    * 
;                     -1,-1 => FAILURE    * 
;  RESTORE BAUD RATE AND RETURN           * 
;****************************************** 
CTD100 EQU  $         ;ERROR RETURN 
       DCR  B 
CTD110 EQU  $         ;SUCCESSFUL COMPLETION
       MOV  A,B 
       CALL XPUTD3    ;OUTPUT CHAR
       MOV  A,B 
       CALL XPUTD3    ;OUTPUT SECOND CHAR 
       CALL FREBFS    ;CLEAR BOTH BUFFERS 
       CALL ZNDBIN    ;RESET BAUD, GO TO ASCII
;                     SIGNAL END OF DATA BLOCK
 
       LIS
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      ENDATA - SIGNAL END OF DATA BLOCK
; 
; 
ENDATA EQU  $ 
       MVI  A,ENDBLK
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      DCMCTL - PERFORM DATACOM CONTROL FUNCTION
; 
; 
DCMCTL EQU  $ 
       CALL ZDCCTL    ;PERFORM CONTROL
       RNC            ;RETURN IF NO ERROR 
       JZ   ZBELL     ;RING AND RETURN IF NO MSG
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      DCERR - HANDLE DATACOM ERRORS
; 
;      ENTRY:  C,Z => NON-FATAL 
;              C,NZ => FATAL
;                H,L -> ERROR MESSAGE 
; 
;      EXIT :  NON-FATAL - JUMP TO IOFAIL 
;              FATAL - DISPLAY MESSAGE AND HANG 
; 
DCERR  EQU  $ 
       RZ             ;NON-FATAL - EXIT 
       JMP  HANGU0    ;DISPLAY MSG AND QUIT 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GTIOB0 - WAIT UNTIL A BUFFER IS FREE 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  C => CTU ERROR OR USER INTERRUPT 
;              NC => BUFFER FOUND 
;                H,L -> STATUS
;              A,H,L DESTROYED
; 
GTIOB0 EQU  $ 
       CALL CTMON1    ;MONITOR TAPES (C,Z => ERROR
       CNC  RETSC0    ;MONITOR KYBD  (C,Z => USER 
;                       INTERRUPT)
       CNC  GTIOBF    ;BUFFER FREE?  (Z => YES) 
       RZ             ;ERROR OR FREE BUFFER 
       JMP  GTIOB0    ;CONTINUE WAITING 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     GTIOBF - FIND AN EMPTY I/O BUFFER 
; 
;     ENTRY: DON'T CARE 
; 
;     EXIT : NC 
;            Z => SUCCESS 
;              H,L -> STATUS
;            NZ => BOTH BUFFERS BUSY
;              H,L DESTROYED
;            A DESTROYED
; 
GTIOBF EQU  $ 
       LXI  H,B1STAT  ;BUF 1 AVAILABLE? 
       MOV  A,M 
       ORA  A 
       RZ             ;YES - RETURN 
       MVI  L,B2STAT*256/256
       MOV  A,M       ;BUF 2 AVAILABLE? 
       ORA  A 
       RET
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      FREBFS - FREE BOTH I/O BUFFERS 
; 
;      ENTRY:  DON'T CARE 
; 
;      EXIT :  A = 0
; 
FREBFS EQU  $ 
       SUB  A 
       STA  B1STAT
       STA  B2STAT
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      CHGBUF - LOOK AT OTHER I/O BUFFER
; 
;      ENTRY:  D,E -> BXSTAT,TYPE,OR LEN
; 
;      EXIT :  D,E -> STAT OF OTHER BUFFER
;              A DESTROYED
; 
; 
CHGBUF EQU  $         ;LOOK AT OPPOSITE BUFFER
       MOV  A,E 
       CPI  B1LEN*256/256 
       LXI  D,B1STAT
       RC 
       LXI  D,B2STAT
       RET
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     GETPTR - GET POINTER TO 1ST BYTE OF I/O BUF 
; 
;     ENTRY: D,E -> I/O BUFFER STATUS, TYPE, LENGT
; 
;     ENTRY GETPT1: A = LOW BYTE OF POINTER 
; 
;     EXIT : H,L -> FIRST BYTE OF ASSOCIATED BUF
; 
; 
GETPTR EQU  $ 
       MOV  A,E 
GETPT1 EQU  $ 
       CPI  B1LEN*256/256 
       LXI  H,IOBUF1
       RNC
       LXI  H,IOBUF2
       RET
 
; 
;  I/O ENTRY TABLES 
; 
IOCTAB EQU  $-3 
; 
       DB  40Q,40Q  ;IGNORE BLANKS IN ESCAPE
       DW   IOC010+B15  ;SEQUENCE 
; 
       DB  53Q,53Q  ;+ - SET SIGN FLAG TO +1
       DW   DCPLUS+B15
       DB  55Q,55Q  ;- - SET SIGN FLAG TO -1
       DW   DCMNUS+B15
; 
       DB  60Q,71Q  ;DIGITS <0> TO <9>
       DW   DCNUM+B15 ;ACCUMULATE DECIMAL VALUE 
; 
       DB  102Q,106Q ;RANGE FROM <B> TO <F> 
       DW   IOCT20
       DB  142Q,146Q ;LOWER CASE CHAR RANGE 
       DW   IOCT20
; 
       DB  115Q,127Q ;RANGE FROM <M> TO <W> 
       DW   IOCT30
       DB  155Q,167Q ;LOWER CASE CHAR RANGE 
       DW   IOCT30
; 
       DB  136Q,136Q ;CHARACTER <^> 
       DW   IOC110+B15 ;PROCESS STATUS REQUEST
       DB  176Q,176Q ;LOWER CASE <^>
       DW   IOC110+B15
; 
       DB   0Q,377Q   ;CATCH-ALL RANGE
       DW   ESCEND+B15 ;GO TO ERROR ROUTINE 
 
; 
;  ENTRY LISTS
; 
IOCT20 EQU $
       DW   IOC020  ;B - SINGLE RECORD TRANSFER 
       DW   IOC030  ;C - CONTROL FUNCTION 
       DW   IOC080  ;D - DESTINATION DEVICE 
       DW   ESCEND  ;E - INVALID, FLAG ERROR
       DW   IOC050  ;F - SINGLE FILE TRANSFER 
; 
IOCT30 EQU $
       DW   IOC070  ;M - TRANSFER TO END OF DATA
       DW   ESCEND  ;N - INVALID, FLAG ERROR
       DW   ESCEND  ;O - INVALID, FLAG ERROR
       DW   IOC090  ;P - CONTROL PARAMETER
       DW   ESCEND  ;Q - INVALID, FLAG ERROR
       DW   IOC100  ;R - READ RECORD TO DATACOM 
       DW   IOC060  ;S - DEFINE SOURCE DEVICE 
       DW   ESCEND  ;T - INVALID, FLAG ERROR
       DW   IOC040  ;U - UNIT SPECIFIER 
       DW   ESCEND  ;V - INVALID, FLAG ERROR
       DW   IOC120  ;W - WRITE DATA FROM DATACOM
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOCNTL - I/O CONTROL 
; 
;      <ESC><&><LOWER CASE P> . . . 
; 
IOCNTL EQU $
       LXI  H,IOCTAB  ;SET ESCAPE SEQUENCE
       SHLD RNGTA       ;RANGE TABLE POINTER
IOCCLR EQU $
       LXI  H,IODATA+1  ;SET STARTING ADDRESS 
       MVI  C,11      ;SET NUMBER OF BYTES
; 
;  IOCCL1 - CLEAR RAM AREA
; 
;      ENTRY:  C = NUMBER OF BYTES TO BE CLEARED
;              H = BASEH
;              L = UPPER ADDRESS LIMIT
; 
;      EXIT :  H,L = ESCFLG 
; 
IOCCL1 EQU $
       XRA A        ;CLEAR TO ZERO
; 
IOC002 EQU $
       MOV M,A
       DCR L        ;DECREMENT ADDRESS
       DCR C        ;ALL LOCATIONS DONE?
       JNZ IOC002   ;NO - DO NEXT BYTE
IOC010 EQU  $ 
       MVI  L,ESCFLG
       MVI  M,2 
; 
;  IOERCL - CLEAR I/O ERROR FLAG
;      IOCERR=S => SUCCESS
; 
IOERCL EQU  $ 
       MVI  A,S 
       STA  IOCERR
       RET
 
;******************************** 
; I/O COMMAND TABLE AND EQUATES * 
;******************************** 
IOCMTB EQU  $-2 
       DW   XFRREC    ;1 - TRANSFER/COMPARE RECORD
       DW   XFREOF    ;2 - TRANSFER/COMPARE A FILE
       DW   XFREVD    ;3 - TRANSFER/COMPARE MEDIUM
       DW   CTRLIO    ;4 - I/O CONTROL
       DW   IOWRIT    ;5 - STORE DATACOM RECORD 
       DW   IOREAD    ;6 - READ RECORD TO DATA COM
       DW   IOSTAT    ;7 - GET I/O STATUS 
; 
IOBNUM EQU  1         ;TRANSFER/COMPARE A RECORD
IOFNUM EQU  2         ;TRANSFER/COMPARE A FILE
IOMNUM EQU  3         ;TRANSFER/COMPARE MEDIUM
IOCNUM EQU  4         ;EXECUTE I/O CONTROL
IOWNUM EQU  5         ;STORE RECORD FROM DATA COMM
IORNUM EQU  6         ;READ RECORD TO DATA COMM 
IOSNUM EQU  7         ;GET I/O STATUS 
 
; 
;  <M> - TRANSFER TO END OF DATA
; 
IOC070 EQU  $ 
       INR  B         ;COMMAND CODE = 3 
; 
;  <F> - SINGLE FILE TRANSFER 
; 
IOC050 EQU  $ 
       INR  B         ;COMMAND CODE = 2 
; 
;  <B> - SINGLE RECORD TRANSFER 
; 
IOC020 EQU $
;                   COMMAND CODE = 1
; 
       CALL CHKCMD  ;ANY PREVIOUS COMMAND?
       RNZ            ;YES - ABORT ESCAPE SEQUENCE
       MOV  M,B       ;NO - STORE COMMAND CODE
       LDA  IODATA    ;SAVE COMMAND MODIFIER FOR
       STA  IOCTYP      ;LATER ANALYSIS 
       JMP  IOCEX0    ;CLEAR PARM VALUE AND EXIT
 
; 
;  <R> - READ A RECORD TO THE DATACOM 
; 
IOC100 EQU  $ 
       INR  B         ;COMMAND CODE = 6 
       INR  B 
; 
;  <C> - CONTROL FUNCTION 
; 
IOC030 EQU  $ 
       INR  B         ;COMMAND CODE = 4 
       INR  B 
       INR  B 
; 
       CALL CHKCMD  ;ANY PREVIOUS COMMAND?
       RNZ            ;YES - ABORT ESCAPE SEQUENCE
       MOV M,B      ;NO - SET COMMAND CODE NUMBER 
       LDA  IODATA    ;FETCH LSB OF CURRENT PARAM 
       CPI  11        ;PARAM TOO BIG? 
       RP               ;YES - ABORT ESC SEQ
       STA  IOCTYP    ;SAVE IT FOR AN INDEX 
       LDA  IODATA+1
       ORA A        ;IS MSB ZERO? 
       RNZ            ;NO - ABORT ESCAPE SEQUENCE 
       JMP  IOCEX0    ;YES - CLEAR PARM AND EXIT
; 
;  <W> - STORE A RECORD FROM THE DATACOM
; 
IOC120 EQU $
       CALL CHKCMD  ;ANY PREVIOUS COMMAND?
       RNZ            ;YES - ABORT ESCAPE SEQUENCE
       MVI M,IOWNUM ;NO - SET COMMAND CODE NUMBER 
       LHLD IODATA    ;TRANSFER PARAMETER TO
       SHLD IOCCNT      ;COUNT FIELD
       LDA  IOCSGN    ;TRANSFER SIGN
       LXI  H,IOPSGN
       MOV  M,A 
       ORA  A         ;ANY PARAMETER RECEIVED?
       JNZ  IOCEX0    ;YES - CLEAR PARAM AND EXIT 
       MVI  M,200Q    ;NO - SET TO ABSOLUTE 0 
       JMP  IOCEX0    ;CLEAR PARAM AND EXIT 
 
; 
;  <P> - CONTROL PARAMETER
; 
IOC090 EQU  $ 
       LHLD IODATA    ;TRANSFER PARAMETER TO COUNT
       SHLD IOCCNT      ;FIELD
       LDA  IOCSGN    ;TRANSFER SIGN
       STA  IOPSGN
       JMP  IOCEX0    ;CLEAR PARMETER AND EXIT
; 
;  <U> - DEVICE SPECIFICATION 
; 
IOC040 EQU $
       CALL DFNDEV  ;IS IT A VALID DEVICE CODE? 
       RNZ            ;NO - ABORT ESCAPE SEQUENCE 
       STA  IOCDEV    ;PUT INTO DEVICE WORD 
       JMP IOCEX0   ;CLEAR PARM AND EXIT
; 
;  <D> - DEFINE DESTINATION DEVICE
; 
IOC080 EQU $
       INR B        ;INDEX TO IOCOUT
; 
;  <S> - DEFINE SOURCE DEVICE 
; 
IOC060 EQU $
       LDA  MDFLG1    ;IN EDIT MODE?
       ANI  EDIT
       RNZ            ;YES - ABORT ESCAPE SEQUENCE
       MOV A,B
       ADI IOCINP-1 ;ADD BASE VALUE 
       MOV C,A
       CALL DFNDEV  ;IS IT A VALID DEVICE CODE? 
       RNZ            ;NO - ABORT ESCAPE SEQUENCE 
       MOV L,C      ;YES - MERGE WITH EXISTING
       MVI  H,BASEH   ;GET IOCINP/OUT HIGH ADDR 
       ORA M        ;DEVICE WORD
       MOV M,A
       JMP IOCEX0   ;CLEAR PARM AND EXIT
 
; 
;  <^> - STATUS REQUEST 
; 
IOC110 EQU $
       CALL CHKCMD  ;ANY PREVIOUS COMMAND?
       RNZ            ;YES - ABORT ESCAPE SEQUENCE
       MVI M,IOSNUM ;SET COMMAND CODE NUMBER
       CALL DFNDEV  ;VALID DEVICE SPECIFIED?
       JNZ IOC115   ;NO - CHECK FOR NO SPEC 
       STA  IOCDEV    ;YES - STORE DEVICE CODE
       XRA A
; 
IOC115:ORA A        ;ANY DEVICE SPECIFIED?
       RNZ            ;YES - ERROR, ABORT SEQUENCE
;                   NO - CLEAR PARM AND EXIT
; 
;  CLEAR PARAMETER AND EXIT 
; 
IOCEX0 EQU $
       LXI  H,0       ;CLEAR THE PARAMETER
       SHLD IODATA
       SUB  A         ;CLEAR THE SIGN 
       STA  IOCSGN
       LDA  CHAR      ;FETCH THE CURRENT CHARACTER
       ANI 40Q      ;IS IT UPPER CASE?
       JZ   IOC130    ;YES - PROCESS COMMAND
       MVI  A,2       ;NO - RETURN TO ESC PROCESSO
       STA  ESCFLG
       RET
; 
;  UPPER CASE CHARACTER FOUND - EXECUTE COMMAND 
; 
IOC130 EQU  $ 
       LXI  H,IOPSGN  ;ANY PARAMETER REC'D? 
       ORA  M 
       JNZ  IOC140    ;YES -
       MVI  M,1       ;NO - SET TO DEFAULT OF +1
       MVI  L,IOCCNT
       INR  M 
IOC140 EQU  $ 
       CALL SETDEV  ;VALID DEVICE ASSIGNMENT? 
       RC             ;NO - TERMINATE ESCAPE SEQ
       CALL ESCEND    ;END ESCAPE SEQUENCE
       LDA  IOCMND    ;IS COMMAND A STATUS REQUEST
       CPI  IOSNUM
       MVI  A,-1-FILRED-USREAD-RDWOWT 
       CNZ  CLIOFS    ;IF NOT, CLEAR READ FLAGS 
       CNZ  RDABR1    ;IF ANY CLEARED, ABORT READ 
       LDA  DFLGS     ;ESC SEQ FROM DATACOM?
       ANI  SDACOM
       JNZ  IOC150
;********************************** 
;  PERFORM LOCAL ESCAPE SEQUENCE  * 
;********************************** 
       LDA  IOCMND    ;GET COMMAND CODE 
       ORA  A         ;ANY COMMAND EXCEPT DEV SEL?
       RZ             ;NO - RETURN IMMEDIATELY
       CPI  IOWNUM
       RNC            ;IGNORE READ, WRITE, STATUS 
       LXI  H,IOCMTB  ;GET TABLE BASE ADDRESS 
       CALL INDJMP    ;PERFORM FUNCTION 
       JMP  USREXT    ;REPORT ANY ERROR AND QUIT
;***********************************
;  PERFORM REMOTE ESCAPE SEQUENCE  *
;***********************************
IOC150 EQU  $ 
       LXI  B,-1-SDVDUN-SDC2-SDVREC-SBINRY
       CALL CLBLXF    ;CLEAR OUTPUT PENDING FLAGS 
       LXI  H,IOCMTB  ;GET TABLE BASE ADDRESS 
       LDA  IOCMND    ;GET COMMAND CODE 
       ORA  A         ;ANY COMMAND EXCEPT DEV SEL?
       RZ             ;NO - RETURN IMMEDIATELY
       CPI  IORNUM
       JNC  INDJMP    ;READ, STATUS DO NOT RET COD
       CALL INDJMP
       CC   FREBFS    ;FREE BUFFERS ON ERROR
       LDA  IOCERR    ;SAVE COMPLETION CODE 
       STA  IOCDPT
       LXI  B,SDVDUN  ;SET UP TO TRANSFER 
       JMP  SBLXFA
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CHKCMD - CHECK FOR PRIOR COMMAND 
; 
;      EXIT :  Z = T, NO PRIOR COMMAND
;                = F, COMMAND ALREADY GIVEN 
;              A = PRIOR COMMAND OR ZERO
; 
CHKCMD EQU $
       LXI  H,IOCMND  ;FETCH THE COMMAND WORD 
       MOV  A,M 
       ORA A        ;SET Z-FLAG 
       RET          ;RETURN 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  DFNDEV - DEFINE DEVICE FROM PARAMETER VALUE
; 
;      ENTRY:  H = BASEH
; 
;      EXIT :  Z = F, INVALID DEVICE CODE 
;                A = 0, NO CODE SPECIFIED 
;              Z = T, DEVICE CODE VALID 
;                A = DEVICE BIT SETTING 
;              B,L DESTROYED
; 
DFNDEV EQU $
       LHLD IODATA    ;FETCH PARAMETER VALUE
DFNDV0 EQU $
       MOV  A,L 
       ORA A        ;WAS IT ZERO? 
       JZ  DFN020   ;YES - CLEAR Z-FLAG AND EXIT
       ADD  H         ;ADD IN PARAMETER MSB 
       CMP  L         ;IS MSB ZERO? 
       RNZ          ;NO - ERROR RETURN
       MOV  B,A         ;(PUT IN B FOR FNDTB2)
       SUI  6         ;IS VALUE IN RANGE? 
       JC  FNDTB2   ;YES - SET DEVICE BIT 
DFN020 EQU $
       CPI  1         ;SET NZ (1 IS A VALID CODE) 
       RET          ;RETURN 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  XFRREC - TRANSFER ONE RECORD 
; 
;      ENTRY:  H = BASE 
; 
;      EXITS TO SYSTEM VIA "IODONE" OR "IOFAIL" 
; 
XFRREC EQU $
       DCR B
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  XFREOF - TRANSFER TO END OF FILE MARK
; 
XFREOF EQU $
       DCR B
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  XFREVD - TRANSFER TO END OF VALID DATA MARK
; 
XFREVD EQU $
       LDA  IOCTYP    ;GET COMMAND MODIFIER 
       RRC            ;SET FOR COMPARE OPERATION? 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  XFRD2D - TRANSFER FROM DEVICE TO DEVICE
;      OR COMPARE BETWEEN DEVICES 
; 
;      ENTRY :  C => COMPARE
;               NC => TRANSFER
;           XFRD2D :  B = TRANSFER LIMIT
;           XFR001 :  A = TRANSFER LIMIT
;                     H,L = INPUT, OUTPUT DEVICES 
; 
;      EXIT  :  NC => NO ERROR
;               C => ERROR
; 
; 
XFRD2D EQU  $ 
       LHLD OUTDEV    ;GET NORMAL INPUT,OUTPUT DEV
       MOV  A,B 
XFR001 EQU  $ 
       LXI  D,XFRFCN
       STA  CMPLIM
       JNC  XFR100    ;IF NOT COMPARE, SKIP 
;*********************************
;  SET UP FOR COMPARE OPERATION  *
;*********************************
       XCHG 
       LXI  H,TMTMSG  ;"TO MANY TO DEVICES" 
       SUB  A         ;MORE THAN ONE OUTPUT DEV?
       SUB  E 
       ANA  E 
       CMP  E 
       JNZ  IOFAI1    ;YES - REPORT ERROR 
       XCHG 
       MOV  A,L       ;IS OUTPUT DISPLAY? 
       CPI  DISPLY
       JNZ  XFR050    ;NO - 
       MOV  A,H       ;YES - SWAP INPUT & OUTPUT
       MOV  H,L 
       MOV  L,A 
XFR050 EQU  $ 
       MVI  A,-1      ;CMPLIM <- -1 => RECORD 
       LXI  B,400Q    ;B = FILE 1; C = RECORD 0 
       LXI  D,CMPFCN
;******************************** 
;  FINISHED SETTING UP COMPARE  * 
;******************************** 
XFR100 EQU  $ 
       STA  XFRLIM
       SHLD SAVOUT    ;SAVE INPUT,OUTPUT DEVICES
       MOV  A,H       ;INPUT = OUTPUT?
       ANA  L 
       JNZ  IOFAI0    ;YES - REORT ERROR
       MOV  A,H       ;ANY TAPES INVOLVED?
       ORA  L 
       ANI  LFTCTU+RGTCTU 
       CNZ  BSYCHK    ;YES - WAIT TILL NOT BUSY 
       RC             ;RETURN ON USER INTERRUPT 
       PUSH D         ;SAVE FUNCTION ADDRESS
;*************************************
;  DECIDE WHETHER TO INHIBIT ROLLUP  *
;*************************************
;                     INHIBIT ROLLUP IFF... 
       LDA  SAVINP      ;DISPLAY IS INPUT DEVICE
       CPI  DISPLY
       JNZ  XFR200
       PUSH B 
       MVI  A,-1-RECINI 
       CALL CLIOFS        ;(INITIALIZE DISPLAY IFF
       CZ   INTDSP         ;NOT DOING RECORD) 
       POP  B 
       LDA  CMPLIM      ;DOING FILE COPY, 
       ORA  A 
       CZ   CHKFMT      ;NON-FORMAT MODE
       MVI  A,RECPGE  ;INHIBIT ROLLUP 
       CZ   STIOFS
;***********************
;  PROCESS ONE RECORD  *
;***********************
XFR200 EQU  $         ;GET A RECORD FROM INPUT
       PUSH B           ;SAVE FILE AND REC COUNTER
       LDA  SAVINP      ;GET FIRST DEVICE 
       CALL GETIO1      ;GET A REC FROM THE DEVICE
       POP  B 
       JC   XFR500      ;EXIT ON ERROR
       DCX  D           ;D,E -> TYPE
       LDAX D           ;GET TYPE 
       INX  D 
       CPI  2           ;DISPLAY BOUNDARY?
       JP   XFR600      ;YES - GO CHECK IT OUT
XFR220 EQU  $         ;OUTPUT OR CMP THE RECORD 
       POP  H           ;H,L -> FUNCTION
       PUSH H 
       RST  RSTJMP    ; 
       JC   XFR500      ;EXIT ON ERROR
       DCX  D           ;D,E -> TYPE
       LDAX D           ;RECALL RECORD TYPE 
       INX  D 
XFR250 EQU  $ 
       LXI  H,CMPLIM  ;COMP REC TYPE TO XFR LIMIT 
       SUB  M           ;LIMIT REACHED? 
       JM   XFR200    ;NO - DO NEXT RECORD
       POP  H 
       ORA  A           ;YES - RETURN SUCCESS 
       RET
XFR500 EQU  $         ;ERROR EXIT 
       MVI  A,-1-RECPGE  ;CLEAR INHIBIT ROLLUP FLA
       CALL CLIOFS
       LDA  SAVINP    ;WAS INPUT DEVICE A TAPE? 
       ANI  LFTCTU+RGTCTU 
       CNZ  STOPTP    ;IF SO, STOP IT 
       POP  H 
       STC            ;RETURN C => ERROR
       RET
; 
;  DISPLAY BOUNDARY - 
;           NON-FORMAT MODE - DO NOT PASS BUF,
;                     JUST CHECK XFR LIMIT
;           FORMAT MODE - ONLY END OF DISP POSS,
;                     PASS IT 
; 
XFR600 EQU  $ 
       CALL CHKFMT    ;IN FORMAT MODE?
       JNZ  XFR650    ;YES - OUTPUT END OF FILE 
       SUB  A         ;NO - RELEASE BUFFER
       STAX D 
       DCX  D         ;GET RECORD TYPE
       LDAX D 
       INX  D 
       SUI  2         ;CONVERT TO NORMAL TYPE 
       JMP  XFR250    ;COMPARE WITH XFR LIMIT 
XFR650 EQU  $ 
       DCX  D         ;D,E -> TYPE
       SUB  A         ;SET TYPE = EOF 
       STAX D 
       INX  D 
       STA  CMPLIM    ;SET TRANSFER LIMIT TO EOF
       JMP  XFR220    ;OUTPUT THE BUFFER
;***********************************************
;  TRANSFER FUNCTION - WRITE RECORD TO OUTPUT  *
;      DEVICE                                  *
;***********************************************
XFRFCN EQU  $ 
       LDA  SAVOUT      ;GET OUTPUT DEVICE(S) 
       JMP  PUTIO1      ;OUTPUT THE RECORD
;***********************************************
;  COMPARE FUNCTION - READ RECORD FROM OUTPUT  *
;      DEVICE AND COMPARE WITH FIRST RECORD    *
;***********************************************
CMPFCN EQU  $ 
       INR  C         ;INCREMENT RECORD COUNT 
       ORA  A         ;FILE MARK RECORD?
       JM   CMP100    ;NO - DO NEXT RECORD
       INR  B         ;YES - INCREMENT FILE COUNT 
       MVI  C,0         ;AND CLEAR RECORD COUNT 
CMP100 EQU  $ 
       PUSH B 
       LDA  SAVOUT    ;GET SECOND DEVICE
       CALL GETIO1    ;GET A RECORD FROM THE DEVIC
       POP  B 
       RC             ;REPORT INPUT ERRORS
       PUSH D         ;SAVE A STATUS POINTER
       CALL CMPBFS    ;COMPARE THE RECORDS
       POP  D 
       JC   IOFAIL    ;ON DIFFERENCE, SET ERROR FL
       JMP  FREBFS    ;SUCCESS - FREE BUFFERS 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CTRLIO - PERFORM I/O CONTROL FUNCTION
; 
; 
;      EXITS TO SYSTEM VIA "ESCEND" 
; 
CTRLIO EQU $
       LXI  H,IOCDEV  ;FETCH DEVICE PARAMETER 
       MOV A,M
       ORA A        ;DEVICE SPECIFIED?
       JNZ CTR020   ;YES - EXECUTE FUNCTION 
       MVI L,IOCTYP ;NO - FETCH COMMAND CODE
       MOV A,M
       SUI 5        ;DOES COMMAND DEFAULT TO
       MVI L,INPDEV ;SOURCE DEVICE? 
       JC  CTR010   ;YES - EXECUTE FUNCTION 
       DCR L        ;NO - USE OUTPUT DEVICES
CTR010 EQU $
       MOV A,M      ;FETCH DEVICE FLAG SETTINGS 
       MVI L,IOCDEV ;SET FOR OBJECT DEVICE
       MOV M,A
; 
;  EXECUTE DEVICE CONTROL 
; 
CTR020 EQU $
       MVI  L,IOPSGN
       MOV  A,M       ;FETCH THE SIGN 
       ORA  A         ;VALUE SPECIFIED? 
       JNZ CTR025   ;YES - EXECUTE FUNCTION 
       MVI M,1      ;NO - SET DEFAULT TO +1 
       LXI  H,1 
       SHLD IOCCNT
CTR025 EQU $
       LXI  H,IOCDPT  ;INITIALIZE DEVICE FLAG 
       MVI  A,1 
; 
CTR030 EQU $
       MOV M,A      ;STORE DEVICE FLAG
       MVI L,IOCDEV ;COMPARE TO SELECTED DEVICES
       ANA M        ;DEVICE SELECTED? 
       JZ  CTR040   ;NO - TRY ANOTHER DEVICE
       LXI  H,CTLTAB  ;SET TABLE BASE ADDRESS 
       CALL SETJMP  ;PERFORM INDIRECT CALL
       RC             ;RETURN ON ERROR
;                   NO - TRY NEXT DEVICE
CTR040 EQU $
       LXI  H,IOCDPT  ;RECALL DEVICE POINTER
       MOV A,M
       RLC            ;ALL DEVICES SCANNED? 
       CMC
       RNC            ;YES - RETURN SUCCESS 
       JMP  CTR030    ;NO - DO NEXT 
 
;************** 
; ROM BREAK 3 * 
;************** 
       ORG  ZBRK2+4000Q 
ZBRK3  EQU  $ 
       DB   VERSN     ;ROM PRESENT/VERSION FLAGS
       DB   ZBRK3/256 
ZBRK3C EQU  $ 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      TPSTAT - DISPLAY CURRENT FILE AND INCHES 
;           LEFT FOR EACH TAPE
; 
;      ENTRY FROM IOCKEY (GREEN KEY)
; 
;      EXIT TO MAIN CODE
; 
;      DESTROYS ALL REGISTERS 
; 
TPSTAT EQU  $ 
       CALL BSYCHK    ;WAIT UNTIL TAPES FREE
       RC             ;RETURN ON USER INTERRUPT 
       LXI  H,NLTPMS
       SHLD MSGPT3
       LXI  H,COMAMS
       SHLD MSGPT4
       LXI  H,NRTPMS
       SHLD MSGPT6
       LXI  H,EOPMSG
       SHLD MSGPT7
       CALL SELLCT
       CALL GTIOB0    ;GET A BUFFER FOR COUNTS
       RC             ;RETURN ON USER INTERRUPT 
       CALL GETPTR    ;GET POINTER TO THE BUFFER
       SHLD MSGPT2
       CALL TPS100    ;GET ASCII FOR LEFT COUNTS
       XCHG           ;SAVE BUFFER POINTER WHILE
       CALL SELRCT      ;SWAPPING UNITS 
       XCHG 
       SHLD MSGPT5
       CALL TPS100    ;GET ASCII FOR RIGHT COUNT
       LXI  H,FLINMS  ;GET FIRST PART OF MESSAGE
       JMP  IOFAI1    ;MAKE SURE MESSAGE IS DISPLY
;*************************************************
;  IF TAPE IS INSERTED, DISPLAY FILE AND INCHES  *
;*************************************************
TPS100 EQU  $ 
       CALL GTCTBT    ;GET BIT FOR SELECTED UNIT
       MOV  B,A 
       LDA  CTSTAT    ;GET CURRENT STATUS 
       ANA  B         ;TAPE INSERTED? 
       JNZ  TPS120    ;YES -
       STA  FILNUM    ;NO - CLEAR FILE NUMBER 
       STA  ABSTAK      ;AND TACH COUNTER 
       STA  ABSTAK+1
;*********************************
;  CHANGE CURRENT FILE TO ASCII  *
;*********************************
TPS120 EQU  $ 
       LDA  FILNUM    ;GET CURRENT FILE NUMBER
       CALL BN2DE0    ;CONVERT TO ASCII 
       MVI  M,200Q    ;WRITE ' '
       INX  H 
       MVI  M,40Q 
       INX  H 
       MVI  M,212Q
       INX  H 
;*************************************
;  CHANGE TACH TO ASCII INCHES LEFT  *
;*************************************
       PUSH H         ;SAVE BUFFER POINTER
       SUB  A         ;INSURE THAT COUNTER IS NOT 
       CALL OCM001      ;INVERTED 
TPS130 EQU  $ 
       LHLD ABSTAK    ;H,L = TACH COUNT 
       MVI  A,-STRTAK/256+3+2 
;        3 = BOT-LP DISTANCE, 2 = MARGIN FOR ERROR
       CMP  H         ;HAS COUNT OVERFLOWED?
       JNC  TPS140    ;NO - 
       LXI  H,0       ;YES - DISPLAT "0"
TPS140 EQU  $ 
       LXI  D,-1      ;COUNT FOR RECORDS
       LXI  B,-29     ;29 TACHS/INCH
TPS160 EQU  $ 
       INX  D         ;INCREMENT COUNTER
       DAD  B         ;SUBTRACT TACHS FOR ONE REC 
       JC   TPS160    ;CONTINUE IF MORE TACHS 
       POP  H         ;RECALL LOC FOR ASCII 
       CALL BN2DEC    ;CONVERT COUNT TO ASCII 
       MVI  M,0       ;SIGNAL END OF MESSAGE
       INX  H 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOREAD - READ ONE RECORD TO DATACOM
; 
; 
; 
IOREAD EQU  $ 
       LXI  B,SDVREC  ;GET FLAG TO BE SET 
       LXI  H,IOFLG2  ;SET EXTERNAL READ FLAG 
       MVI  M,EXTB2D
       MVI  L,XFRLIM  ;SET DEFAULT LIMIT TO ONE 
       MVI  M,-1        ;RECORD 
       LDA  IOCTYP    ;GET COMMAND MODIFIER 
       ANI  FILRED+BINXMT 
       CPI  FILRED    ;FILE OR BINARY READ? 
       JC   SBLXF0    ;RECORD - SET PENDING FLAG
       STA  IOCTYP    ;FILE - TURN OFF RE-TRANSMIT
       MVI  M,0       ;SET XFER LIMIT FOR 1 FILE
       CALL GTMODE    ;PAGE MODE? 
       JZ   IRD010    ;NO - DON'T SET "RDWOWT"
       MVI  A,RDWOWT  ;YES - PERFORM FILE READ
IRD010 EQU  $           ;WITHOUT WAIT 
       ORI  FILRED    ;SET FILE READ FLAG 
       CALL STIOFS
       JMP  SBLXF0      ;TO "IORDGO" AFTER HANDSHK
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOSTAT - GET DEVICE STATUS 
; 
; 
;      RETURNS TO SYSTEM VIA "ESCEND" 
; 
IOSTAT EQU $
       LXI  B,SDVST   ;SET DEVICE STATUS PENDING
       CALL SBLXF0  ;FLAG 
       LDA  IOCDEV    ;FETCH DEVICE CODE
       ORA A        ;DEVICE SPECIFIED?
       JNZ IOS010   ;YES - GET ITS STATUS 
       LDA  INPDEV    ;NO - DEFAULT TO SOURCE 
IOS010 EQU $
       STA  IOSTA0    ;STORE DEVICE CODE
       LXI  H,STATTB  ;SET TABLE BASE ADDRESS 
       JMP  SETJMP    ;PERFORM INDIRECT JUMP
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOWRIT - WRITE DATACOM ONTO DEVICE 
; 
; 
;      READS ONE RECORD FROM THE DATACOM AND
;      STORES IT ON ALL DESTINATION DEVICES 
; 
;      DESTROYS ALL REGISTERS.
; 
IOWRIT EQU  $ 
       CALL GTIOB0    ;GET AN I/O BUFFER
       RC             ;RETURN ON ERROR
       MVI  M,DATCOM  ;MARK FOR INPUT FROM DATACOM
       DCX  H         ;H,L -> TYPE
       MVI  M,-1      ;TYPE = DATA RECORD 
       DCX  H         ;H,L -> LENGTH
       XCHG           ;D,E -> LENGTH
       LHLD IOCCNT    ;GET PARAMETER
       MOV  C,L       ;C IS USED AS COUNTER 
       MOV  A,L       ;ANY COUNT SPECIFIED? 
       STAX D         ;(SAVE COUNT IN BUFFER SIZE)
       ORA  H 
       JNZ  IOW020    ;YES - DO BINARY LOAD 
       CALL DC2BUF    ;NO - LOAD ASCII RECORD 
       RC             ;RETURN ON ERROR
       XCHG           ;D,E -> LENGTH
       JMP  IOW030    ;STORE THE RECORD 
;*********************************************
;  BINARY TYPE LOAD - LOAD 8-BIT CHARACTERS  *
;*********************************************
IOW020 EQU  $ 
       CALL GETPTR    ;GET POINTER TO 1ST BUF BYTE
IOW023 EQU  $ 
       PUSH H         ;SAVE REGS KILLED BY MONITOR
       CALL CTMON1    ;ANY CTU ERRORS?
       CNC  RETSCN    ;NO - RETURN KEY PRESSED? 
       POP  H         ;RESTORE REGISTERS
       RC             ;RETURN ON ERROR
IOW025 EQU  $ 
       CALL ZGTBIN    ;GET A BINARY BYTE
       JC   DCERR     ;QUIT ON DATACOM ERROR
       JNZ  IOW023    ;CHK CTU & TRY AGAIN ON WAIT
       MOV  M,A       ;STORE BYTE 
       INX  H         ;INCREMENT BUFFER POINTER 
       DCR  C         ;RECORD DONE? 
       JNZ  IOW025    ;NO - GET NEXT CHAR 
;*********************
;  STORE THE RECORD  *
;*********************
IOW030 EQU  $ 
       INX  D         ;WANT D,E -> STATUS 
       INX  D 
       JMP  PUTIO     ;OUTPUT TO ALL "OUT" DEVICES
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      DC2BUF - READ ASCII RECORD FROM DATACOM TO 
;           I/O BUFFER
; 
;      THIS ROUTINE LOADS AN I/O BUFFER WITH
;      NORMAL ASCII CHARACTERS FROM THE DATACOM 
;      (GETDC).  IT RETURNS WHEN A LF IS RECEIVED,
;      OR 256 BYTES HAVE BEEN RECEIVED, OR WHEN A 
;      DATACOM ERROR IS DETECTED. 
; 
;      ENTRY:  BUFFER STATUS SET
;              BUFFER TYPE = NORMAL (DATA) RECORD 
;              D,E -> BUFFER LENGTH (SET TO 0)
;              IOFLG2[RECINI] = 1 => 1ST CHAR FOR 
;                 BUFFER IS IN "CHAR" (RECORD-
;                 MODE INITIALIZATION). 
; 
;      EXIT :  IOFLG2[RECINI] = 0 
;      EXIT :  NC => NO ERROR 
;                H,L -> BUFFER LENGTH 
;                A,D,E DESTROYED
;              C => ERROR, OR USER INTERRUPT
;                A,D,E,H,L DESTROYED
; 
DC2BUF EQU  $ 
       MVI  A,-1-RECINI  ;TEST AND CLEAR RECINI 
       CALL CLIOFS    ;FIRST CHAR IN "CHAR"?
       LDA  CHAR      ;GET CHAR IF SO 
       PUSH PSW       ;SAVE FLAG AND CHAR 
       CALL GETPTR    ;GET POINTER TO BUFFER
       XCHG           ;D,E -> BUF; H,L -> LENGTH
       POP  PSW       ;RECALL FLAG AND CHAR 
       JNZ  DCB030    ;IF FIRST CHAR IN A, STORE I
DCB010 EQU  $ 
       PUSH H         ;SAVE REGS KILLED BY MONITOR
       CALL CTMON1    ;CHECK FOR CTU ERRORS 
       CNC  RETSC0    ;IF OK, MONITOR KYBD
       POP  H 
       RC             ;RET ON ERROR OR USER INTRUP
DCB020 EQU  $ 
       CALL ZGETDC    ;CHECK DATACOM FOR CHAR 
       JC   DCERR     ;PROCESS DATACOM ERRORS 
       JNZ  DCB010    ;WAIT - MON CTU & KYBD, RETR
DCB030 EQU  $         ;CHAR RECEIVED - STORE IT 
       STAX D 
       INX  D         ;INCREMENT BUF POINTER
       INR  M         ;INCREMENT LENGTH COUNTER 
       RZ             ;RETURN IF LENGTH = 256 
       CPI  LF
       RZ             ;RETURN IF LF 
       JMP  DCB020    ;GET NEXT CHARACTER 
 
;*********************************
;  ALTERNATE I/O DEVICE DRIVERS  *
;*********************************
BF2ALT EQU  $         ;BUFFER TO DEVICE 
       LXI  H,ZPUTAL
       JMP  ALT100
ALT2BF EQU  $         ;DEVICE TO BUFFER 
       LXI  H,ZGETAL
       JMP  ALT100
CTLALT EQU  $         ;DEVICE CONTROL 
       LXI  H,ZCTLAL
ALT100 EQU  $ 
       CALL IOFAIL    ;SET ERROR IN CASE DEVICE 
;                       ISN'T THERE 
       JMP  IORMGO
STALT  EQU  $         ;DEVICE STATUS
       LXI  H,ZSTAAL
       CALL IORMGO    ;EXECUTE CODE IF THERE
       RNC
       LXI  H,IOSTA1  ;CODE NOT THERE - CLEAR STAT
       SUB  A 
       MOV  M,A 
       INX  H 
       MOV  M,A 
       INX  H 
       MOV  M,A 
       RET
 
; 
;  DEVICE DRIVERS ENTRY TABLES
; 
;  BUFFER TO DEVICE 
; 
BF2DTB EQU $-2
       DW   BF2LCT  ;LEFT CARTRIDGE 
       DW   BF2RCT  ;RIGHT CARTRIDGE
       DW   BF2DSP  ;DISPLAY
       DW   BF2PRT  ;PRINTER
       DW   BF2ALT    ;ALTERNATE I/O
; 
;  DEVICE TO BUFFER 
; 
D2BFTB EQU $-2
       DW   LCT2BF  ;LEFT CARTRIDGE 
       DW   RCT2BF  ;RIGHT CARTRIDGE
       DW   DSP2BF  ;DISPLAY
       DW   PTR700    ;PRINTER - INVALID
       DW   ALT2BF    ;ALTERNATE I/O
; 
;  DEVICE CONTROL 
; 
CTLTAB EQU $-2
       DW   CTLLCT  ;LEFT CARTRIDGE 
       DW   CTLRCT  ;RIGHT CARTRIDGE
       DW   NOFNCT  ;DISPLAY
       DW   CTLPRT  ;PRINTER
       DW   CTLALT    ;ALTERNATE I/O
; 
;  DEVICE STATUS
; 
STATTB EQU $-2
       DW   STLCT   ;LEFT CARTRIDGE 
       DW   STRCT   ;RIGHT CARTRIDGE
       DW   IOSTX1  ;DISPLAY - CLEAR STATUS FLAG
       DW   STPRT   ;PRINTER
       DW   STALT     ;ALTERNATE I/O
; 
; 
NOFNCT:RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  GETIO - GET NEXT RECORD FROM SOURCE DEVICE 
; 
;      ENTRY GETIO1 REQ'S A = INPUT DEVICE
; 
;      EXIT :  C => ERROR 
;              NC => NO ERROR 
;                D,E -> BUFFER STATUS 
;                A,B,C,H,L DESTROYED
; 
GETIO  EQU $
       LDA  INPDEV    ;DEVICE INPUT FLAG => INDEX 
GETIO1 EQU  $ 
       MOV  B,A       ;SAVE DEVICE
       LXI  H,CONMSG    ;(PREPARE TO REPORT ANY ER
       LDA  DFLGS     ;WRITING TO DISPLAY FROM BUF
       ANI  XBF2DS
       JNZ  CTUERR    ;YES - REPORT CONFLICTING I/
       MOV  A,B       ;RECALL DEVICE
       LXI  H,D2BFTB  ;SET TABLE BASE ADDRESS 
       JMP SETJMP   ;PERFORM INDIRECT JUMP
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     PUTIO - PUT RECORD ON ALL "TO" DEVICES
; 
;     ENTRY: D,E -> BUFFER STATUS 
;            BUFFER STATUS, TYPE, LENGTH FILLED 
; 
;      ENTRY PUTIO1 REQ'S A = OUTPUT DEVICE(S)
; 
;     EXIT : A,B,C,H,L DESTROYED
;            NC => NO ERRORS
;              D,E -> SAME BUFFER STATUS
;            C => ERROR 
;              D,E DESTROYED
;              IOCERR=F => FAILURE
;                MSGPTX -> ERROR MESSAGE
;              IOCERR=U => USER INTRRUPT
; 
; 
PUTIO  EQU  $ 
       LDA  OUTDEV    ;NORMAL OUTPUT DEVICE(S)
PUTIO1 EQU  $ 
       STAX D         ;MARK BUFFER FOR OUTPUT 
       MOV  C,A       ;SAVE DEVICE(S) 
       MVI  B,1       ;START WITH UNIT 1 = LFTCTU 
PIO010 EQU  $ 
       LXI  H,BF2DTB  ;POINTER TO TRANSFER TABLE
       MOV  A,C       ;THIS DEVICE SELECTED?
       ANA  B 
       PUSH B         ;(SAVE CURRENT DEVICE FLAG) 
       CNZ  SETJMP    ;YES - PERFORM OUTPUT 
       POP  B         ;RECALL CURRENT DEVICE
       RC             ;RETURN ON I/O ERROR
       MOV  A,B 
       RLC            ;SELECT NEXT DEVICE 
       CMC              ;(GET CARRY SET RIGHT)
       RNC            ;RETURN IF FINISHED 
       MOV  B,A       ;SAVE DEVICE FLAG 
       JMP  PIO010    ;GO DO NEXT DEVICE
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  SETJMP - SET UP INDEXED INDIRECT JUMP
; 
;      ENTRY:  A = JUMP INDEX (BIT POSITION)
;              E = LSB OF TABLE BASE ADDRESS
; 
;      EXITS TO INDEXED ADDRESS 
; 
;      ON ENTRY TO INDEXED ROUTINE, H = BASEH 
;      ALL OTHER REGISTERS UNDEFINED
; 
; 
SETJMP EQU $
       ORA A        ;JUMP TO BASE ? 
       MVI  B,0         ;(SET BASE VALUE) 
       CNZ  BT2NUM    ;NO - CONVERT BIT TO NUMBER 
; 
;  INDJMP - INDEXED INDIRECT JUMP 
; 
;      ENTRY:  A = INDEX
;              H,L = TABLE BASE ADDRESS 
; 
;      EXIT :  B = 1
;              A,C DESTROYED
; 
; 
INDJMP EQU $
       ADD  A         ;DOUBLE INDEX 
       MOV  C,A 
       MVI  B,0       ;B,C = INDEX
       DAD  B         ;ADD INDEX TO BASE
       MOV  A,M       ;GET ADDRESS FROM TABLE 
       INX  H 
       MOV  H,M       ;GET HIGH ADDRESS 
       MOV  L,A       ;L <- LOW ADDRESS 
       MVI  B,1       ;PUT INDICATOR IN B 
       PCHL           ;GO THERE 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
;  BT2NUM - CONVERT BIT NUMBER TO DIGIT 
; 
;      ENTRY:  A = BIT TO BE LOCATED
;              B = BASE VALUE 
; 
;      EXIT :  A,B = BASE VALUE + BIT NUMBER
; 
BT2NUM EQU  $ 
       INR  B         ;INCREMENT COUNT
       RRC            ;SHIFT TO NEXT BIT
       JNC  BT2NUM    ;CONTINUE COUNT IF NO BIT 
       MOV  A,B 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOFAIL - ERROR IN ESCAPE SEQUENCE
; 
;      EXITS TO "ESCEND" THRU "IOEXIT"
; 
IOFAI0 EQU $
       LXI  H,INOMSG  ;SET IN=OUT MESSAGE 
IOFAI1 EQU  $ 
       SHLD MSGPT1
; 
IOFAIL EQU $
       MVI A,F
       STA  IOCERR
       STC            ;RETURN C => ERROR
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IORDGO - TRANSFER RECORD TO DATACOM
; 
;      ENTRY:  HANDSHAKE COMPLETED
;              IOCTYP = TRANSMISSION TYPE 
;                     0 = ASCII, NEXT BLOCK 
;                     1 = ASCII, LAST BLOCK 
;                     2 = BINARY, NEXT BLOCK
;                     3 = BINARY, LAST BLOCK
;              LSTRED -> START OF LAST BLOCK
;                   (0 => NO LAST BLOCK)
;              NXTRED -> START OF NEXT BLOCK
;                   (LSB=0 => GET NEW BUFFER FULL)
;              NOTE: ASCII XFR IS 1 FIELD (FORMAT 
;                     RECORD) OR 1 NORMAL RECORD. 
;                    BINARY XFR IS ALWAYS 1 RECORD
;                    BLOCKS STORED IN I/O BUFFERS.
; 
;      EXIT :  LSTRED, NXTRED UPDATED IF NEXT BLK 
;                   WAS REQUESTED 
;              ASCII XFR - BLOCK SENT 
;              BINARY XFR - BYTE COUNT SENT,
;                   MFLGS2[SBINRY] = 1
; 
; 
IORDGO EQU  $ 
       LXI  B,-1-SDVREC  ;CLEAR RECORD PENDING FLA
       CALL CLBLXF
       LDA  IOCTYP    ;GET TRANSMISSION TYPE
       ANI  REXMIT    ;RETRANSMIT LAST BLOCK? 
       JZ   IOR020    ;NO - GET NEXT READ POINTER 
       LHLD LSTRED    ;YES - GET LAST READ POINTER
       MOV  A,H       ;IS POINTER = 0?
       ORA  L           ;(YES => NO LAST BLOCK) 
       JZ   SDEOF     ;YES - OUTPUT "FILE MARK" 
       JMP  IOR100    ;NO - OUTPUT LAST BLOCK 
;*******************************
;  SET UP TO OUTPUT NEW BLOCK  *
;*******************************
IOR020 EQU  $ 
       LHLD NXTRED    ;GET NEXT POINTER 
       ORA  L         ;LSB = 0? 
       JNZ  IOR030    ;NO - OUTPUT NEXT FIELD OF
;                       CURRENT RECORD
       CALL INTDS0    ;INPUT=DISPLAY => INITIALIZE
       LDA  LSTRED+1  ;GET POINTER TO STATUS OF 
       CPI  IOBUF1/256  ;LAST BUFFER OUTPUT 
       LXI  D,B1STAT
       JZ   IOR025
       MVI  E,B2STAT*256/256
IOR025 EQU  $ 
       CALL GETIO     ;GET A NEW RECORD FROM THE
;                       INPUT DEVICE
       JC   SDEOF     ;ERROR - SEND "FILE MARK" 
       MVI  A,DATCOM  ;MARK FOR OUTPUT TO DATACOM 
       STAX D 
       CALL GETPTR    ;GET POINTER TO FIRST BYTE
IOR030 EQU  $ 
       SHLD LSTRED    ;STORE POINTER FOR REPEAT 
IOR100 EQU  $         ;GET TYPE POINTER FOR RECORD
       MOV  A,H 
       CPI  IOBUF1/256
       LXI  D,B1TYPE
       JZ   IOR110
       MVI  E,B2TYPE*256/256
IOR110 EQU  $ 
       LDAX D         ;TYPE OF RECORD?
       INR  A           ;(-1 => DATA) 
       JNZ  SDEOF     ;TERMINATOR - SEND FILE MARK
       LDA  IOCTYP    ;GET TYPE OF TRANSMIT 
       ANI  BINXMT    ;BINARY TRANSMIT? 
       JNZ  SDBYCT    ;YES - SEND BYTE COUNT
 
;******************************** 
;  SEND ASCII BLOCK TO DATACOM  * 
;******************************** 
       MOV  B,L       ;B <- # OF BYTES ALREADY SEN
       INX  D         ;SAVE POINTER TO BUF STATUS 
       PUSH D 
       DCX  D         ;D,E -> TYPE
       LXI  H,DFLGS   ;SET BUFFER TO DISPLAY BIT
       MOV  A,M 
       ORI  XBF2DS
       MOV  M,A 
;************************************************ 
;  DETERMINE WHETHER TO SEND INITIAL LINE FEED  * 
;************************************************ 
       LDA  IOFLGS    ;SEND LINE FEED FIRST IF... 
       ANI  USREAD      ;USER READ
       JZ   IOR210          ;(IOFLGS[USREAD] = 1) 
       LDA  KBJMPR      ;AND
       ANI  LFPOS       ;STRAP 'E' INSERTED 
;                           (KBJMPR[LFPOS] = 0) 
       CZ   SDAULF      ;AND AUTO LF DEPRESSED
;                           (MDFLG2[AUTOLF] = 1)
;******************************************** 
;  OUTPUT A BLOCK TO DATACOM (AND DISPLAY)  * 
;******************************************** 
IOR210 EQU  $ 
       MVI  C,-1      ;C = -1 => PASS CONTROL CODE
       LXI  H,IOR500  ;GET POINTER TO ROUTINE 
       SUB  A         ;Z => STRIP OFF TERM CRLF 
       CALL EXPBF1    ;OUTPUT THE BUFFER, EXPANDIN
;                       CONTROL CODES 
       JNC  IOR230    ;CONTINUE ON NO ERROR 
;***********************
;  ERROR - ABORT READ  *
;***********************
IOR220 EQU  $ 
       POP  D         ;D,E -> BUF STATUS
       SUB  A         ;FREE BUFFER
       STAX D 
       JMP  RDABRT    ;ABORT READ 
IOR230 EQU  $         ;INTERPRET EXPBUF RETURN
       ORA  A         ;TYPE OF TERMINATION? 
       JNZ  IOR270    ;FORMAT FIELD SEPARATOR - 
       XTHL           ;NEXT-TO-LAST CHAR
       MOV  A,M       ;MARK BUF OK FOR PTTPLN 
       ANI  -1-DATCOM 
       ORI  PTTPOK
       MOV  M,A 
       XTHL           ;RESTORE H,L -> ROUTINE 
       CALL EXPBF3    ;OUTPUT THE LAST CHARACTER
       JMP  IOR285    ;GO TO CLEAN UP ROUTINE 
;*****************************************
;  HANDLE FORMAT MODE SEPARATORS (304B)  *
;*****************************************
IOR270 EQU  $ 
       INX  D         ;SKIP FORMAT COUNT
       DCR  B 
       MOV  A,E       ;IS THIS PART OF HEADER?
       CPI  5           ;(FIRST FOUR BYTES) 
       DCR  A           ;(INSURE NC, NZ IF NOT) 
       CC   EXPBF2    ;YES - CONTINUE OUTPUTTING
IOR285 EQU  $ 
       JC   IOR220    ;ABORT ON ERROR 
       JZ   IOR230    ;CONTINUE ON BUF NOT EMPTY
       XCHG           ;END OF BLOCK 
       POP  D         ;RECALL TYPE POINTER
       MOV  A,L       ;BUFFER EXHAUSTED?
       ORA  A 
       JNZ  IOR300    ;NO - SEND TERMINATOR 
       STAX D 
 
; 
;*************************************************
;  TERMINATE THE READ BY SENDING THE FOLLOWING:  *
;                                                *
;      USER READ, STRAP E IN:    CR              *
;      USER READ, STRAP E OUT:   CR(LF)          *
;      REMOTE READ, BLOCK, PAGE: CR(LF)RS        *
;      REMOTE READ, OTHER:       CR(LF)          *
;                                                *
;  IF USER READ, HALF DUPLEX, NON-FORMAT MODE,   *
;      SEND CR(LF) TO DISPLAY                    *
;*************************************************
IOR300 EQU  $ 
       SHLD NXTRED    ;SAVE POINTER FOR NEXT READ 
       LDA  IOFLGS    ;USER READ? 
       ANI  USREAD
       JZ   IOR350    ;NO - TERMINATE REMOTE READ 
       LDA  KBJMPR    ;STRAP 'E' IN?
       CMA              ;(COMPLEMENT FLAGS) 
       ANI  LFPOS     ;LINE FEED AT START OF REC? 
       MVI  A,CR        ;(SET TO OUTPUT RETURN) 
       JNZ  IOR360    ;YES - OUTPUT RETURN ONLY 
       CALL SDCRLF    ;NO - OUTPUT CR(LF) 
       JMP  IOR380    ;TERMINATE OUTPUT BLOCK 
;************************ 
; TERMINATE REMOTE READ * 
;************************ 
IOR350 EQU  $ 
       CALL SDCRLF    ;SEND CR(LF)
       CALL GTMODE    ;PAGE MODE? 
       LDA  BLKTRM      ;(SET TO OUTPUT TERM CHAR)
IOR360 EQU  $ 
       CNZ  IOR400    ;YES - OUTPUT TERMINATOR
IOR380 EQU  $ 
       CALL CLXB2D    ;CLEAR BUFFER TO DISPLAY BIT
       MVI  L,IOFLGS
       MOV  A,M 
       ANI  RDWOWT    ;READ WITHOUT WAIT? 
       JNZ  IORDGO    ;YES - START ANOTHER READ 
       CALL ENDATA    ;NO - SIGNAL END OF DATA BLO
       LXI  B,SDVREC  ;SET TO ENABLE ANOTHER READ 
       MOV  A,M       ;GET IOFLGS 
       ANI  USREAD+FILRED  ;USER/FILE READ? 
       JNZ  SBLXF0    ;YES - ENABLE ANOTHER READ
       RET            ;RETURN 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      GENERAL OUTPUT TO DATACOM ROUTINE
; 
;      ECHOS TO DISPLAY IF USER READ, HALF DUPLEX 
; 
;      ENTRY IOR400, FOR READ TERMINATORS,
;      SUPRESSES ECHO IF IN FORMAT MODE 
; 
;      ENTRY:  A = CHAR 
; 
;      EXIT :  A,H,L DESTROYED
;             NC => NO ERROR
;             C => ERROR OCCURRED 
; 
IOR400 EQU  $ 
       MOV  L,A       ;SAVE A-REGISTER
       CALL CHKFMT    ;FORMAT MODE ENABLED? 
       MOV  A,L         ;(RECALL A-REGISTER)
       JZ   IOR550    ;NO - DON'T SUPPRESS ECHO 
       JMP  XPUTD3    ;YES - OUTPUT TERMINATOR ONL
IOR500 EQU  $ 
       CPI  LF        ;STRIP OUT LINE FEEDS 
       RZ 
IOR550 EQU  $ 
       PUSH B 
       PUSH D 
       MOV  C,A       ;CHINT WANTS BYTE IN C
       CALL XPUTD3    ;OUTPUT TO DATACOM
       JC   IOR570    ;QUIT ON ERROR
       LDA  IOFLG2    ;USER READ, HALF DUP? 
       ANI  EXTB2D
       CZ   XCHINT    ;YES - SEND TO DISPLAY
       CNC  GETDCM    ;IF NO ERROR, MONIT DATACOM 
IOR570 EQU  $ 
       POP  D 
       POP  B 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      SDBYCT - SEND BYTE COUNT TO DATACOM
; 
;      FIRST PART OF BINARY READ--ENTERED FROM
;      IORDGO (HANDSHAKE COMPLETED).
;      RETURNS TO WAIT LOOP, HAVING SET 
;      MFLGS2[SBINRY], WHICH TRIGGERS CALL TO 
; 
;      ENTRY:  D,E -> RECORD TYPE (IORDGO HANDLES 
;                NON-DATA RECORDS)
;              H,L -> FIRST BYTE OF RECORD
;              NC (REQ'D BY FIRST CALL TO XPUTDC) 
; 
;      EXIT :  4-BYTE COUNT AND TERMINATOR SENT 
;              MFLGS2[SBINRY] = 1 
;              NXTRED[0-4]=0
;                (=> NEXT READ WILL GET NEW REC)
; 
; 
SDBYCT EQU  $ 
       SUB  A         ;CLEAR NXTRED[0-4]
       STA  NXTRED
       MVI  A,60Q     ;SEND LEADING '0' 
       CALL XPUTD3    ;OUTPUT 1ST BYTE
       DCX  D         ;D,E -> BYTE COUNT
       LDAX D 
       SUB  L         ;SUBTRACT BYTES ALREADY SENT
;                       (BY ASCII READ OF FORMAT
;                        RECORD)
       MOV  B,A       ;SAVE BYTE COUNT
       SUI  1         ;IS COUNT = 0 (=> 256)? 
       MVI  A,60Q     ;IF NO (NC) - 2ND BYTE = '0'
       ACI  0         ;IF YES (C) - 2ND BYTE = '1'
       CALL XPUTD3    ;OUTPUT 2ND BYTE
       MOV  A,B       ;GET LENGTH 
       ANI  360Q      ;EXTRACT HIGH 4 BITS
       RRC            ;RIGHT JUSTIFY
       RRC
       RRC
       RRC
       ORI  60Q       ;MAKE IT AN ASCII CHAR
       CALL XPUTD3    ;OUTPUT 3RD BYTE
       MOV  A,B       ;GET LENGTH 
       ANI  17Q       ;EXTRACT LOW 4 BITS 
       ORI  60Q       ;MAKE IT AN ASCII CHAR
       CALL XPUTD3    ;OUTPUT 4TH BYTE
       CNC  SDTRM1    ;OUTPUT TERMINATOR
       JC   RDABRT    ;ABORT READ IF OUTPUT FAILED
       LDA  IOFLGS    ;GET I/O FLAGS
       ANI  RDWOWT    ;READ WITHOUT WAIT ENABLED? 
       JNZ  BNRYGO    ;YES - SEND BINARY NOW
       CALL ENDATA    ;NO - SIGNAL END OF DATA BLO
       LXI  B,SBINRY  ;SET BINARY RECORD PENDING
       JMP  SBLXF0
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  BNRYGO - SEND BINARY RECORD
; 
;      ENTRY:  BYTE COUNT SENT, 2ND HANDSHAKE DONE
;              LSTRED -> 1ST BYTE OF RECORD 
; 
;      EXIT :  RECORD SENT
;              BUFFER RELEASED
; 
; 
BNRYGO EQU  $ 
       LHLD LSTRED    ;GET POINTER TO FIRST BYTE
       MOV  A,H       ;GET POINTER TO LENGTH
       CPI  IOBUF1/256  ;DATA IN BUFFER 1?
       LXI  D,B1LEN     ;(SET FOR BUFFER 1 LENGTH)
       JZ   BNR005    ;YES - OUTPUT THE BUFFER
       MVI  E,B2LEN*256/256 
BNR005 EQU  $ 
       CALL ZSTBIN    ;SIGNAL START OF BINARY OUTP
       CALL BNR010    ;OUTPUT THE BINARY RECORD 
       JC   BNABRT    ;ABORT BINARY IF FAILURE
       CALL ZNDBIN    ;END BINARY OUTPUT MODE 
       JMP  IOR380    ;GO TO READ EXIT ROUTINE
;****************************** 
; BNR010 - OUTPUT BINARY DATA * 
;****************************** 
BNR010 EQU  $ 
       PUSH H         ;SAVE FIRST BYTE POINTER
       LXI  B,377Q-SBINRY-SDVREC
       CALL CLBLXF    ;CLEAR ALL PENDING XFRS 
       POP  H         ;RECALL FIRST BYTE POINTER
       LDAX D         ;GET RECORD LENGTH
       SUB  L         ;SUBTRACT BYTES ALREADY SENT
       RC             ;C => BUFFER OVERWRITTEN
       MOV  B,A       ;SAVE # OF BYTES LEFT 
BNR020 EQU  $ 
       MOV  A,M       ;GET THE DATA BYTE
       CALL XPUTD3    ;OUTPUT THE BINARY BYTE 
       RC             ;RETURN ON DATA COMM ERROR
       INX  H         ;INCREMENT TO NEXT BYTE 
       DCR  B         ;ALL BYTES DONE?
       JNZ  BNR020    ;NO - CONTINUE TRANSMITTING 
       INX  D         ;YES - RELEASE THE BUFFER 
       INX  D 
       SUB  A 
       STAX D         ;CLEAR BUFFER BUSY FLAG 
       RET            ;RETURN 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      SDEOF - SEND SPECIAL RECORD AS "READ"
;           RESPONSE
; 
;      SENT FOR END OF FILE, END OF DATA, I/O 
;           ERROR, REPEAT REQUEST WITH NO 
;           PREVIOUS READ.
; 
;      CHARACTERS SENT: 
;           USER READ                  CR(LF) 
;             (IF HALF DUPLEX, DISP GETS CR(LF))
;           REMOTE READ, PAGE, BLOCK   RS 
;           REMOTE READ, OTHER         RS CR(LF)
; 
;      RELEASES BOTH I/O BUFFERS. 
; 
; 
SDEOF  EQU  $ 
       CALL FREBFS    ;RELEASE I/O BUFFERS
       LDA  IOFLGS    ;GET I/O FLAGS
       CMA            ;COMPLEMENT THE FLAGS 
       ANI  USREAD    ;USER INITIATED READ? 
       JZ   SEF100    ;YES - SEND CR(LF)
       LDA  BLKTRM    ;NO - SEND BLOCK TERMINATOR 
       CALL XPUTD3      ;CHARACTER
       CALL GTMODE    ;BLOCK, PAGE? 
SEF100 EQU  $ 
       CZ   SDCRLF    ;NO - SEND CR(LF) 
SDEOF1 EQU  $         ;ENTRY FOR RDABRT 
       SUB  A 
       STA  NXTRED    ;NEXT READ WILL GET NEW REC 
       CALL ENDATA    ;SIGNAL END OF DATA BLOCK 
       MVI  A,-1-RDWOWT-FILRED
       CALL CLIOFS    ;CLEAR READ FLAGS 
       MVI  A,-1-USREAD 
       CALL CLIOFS    ;CLEAR USER READ FLAG 
       RZ             ;RETURN IF REMOTE READ
       JMP  USREXT    ;REPORT ANY ERRORS
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      RDABRT - ABORT USER READ OPERATION 
; 
;      ENTRY:  USER READ IN PROGRESS
;                 (IOFLGS[USREAD] = 1)
; 
;      EXIT :  READ ABORTED, TAPE BACKSPACED ONE
;                 RECORD FOR EACH PENDING BUFFER
;                 (IF TAPE IS INPUT DEVICE) 
;              A,B,C,H,L DESTROYED
; 
; 
BNABRT EQU  $         ;ABORT BINARY READ
       CALL ZNDBIN    ;END BINARY OUTPUT MODE 
RDABRT EQU  $ 
RDABR1 EQU  $         ;ABORT FOR NEW ESC SEQ
       MVI  A,U       ;FLAG USER INTERRUPT
       STA  IOCERR
       CALL SDEOF1    ;SEND END-OF-FILE 
       LDA  INPDEV    ;IS INPUT DEVICE A TAPE?
       ANI  LFTCTU+RGTCTU 
       JZ   RDA030    ;NO - QUIT
       ORI  DATCOM    ;YES - SET UP MASK TO TST FO
       MOV  C,A         ;BUFS  WAITING TO BE OUTPU
RDA005 EQU  $ 
       CALL CTMON1    ;WAIT UNTIL STOPPED 
       JNZ  RDA005
       MVI  B,0       ;B WILL COUNT FULL BUFFERS
       LDA  B1STAT    ;IS IOBUF1 FULL?
       ANA  C 
       JZ   RDA010    ;NO - 
       INR  B         ;YES - INCREMENT COUNT
RDA010 EQU  $ 
       LDA  B2STAT    ;IS IOBUF2 FULL?
       ANA  C 
       JZ   RDA020    ;NO - 
       INR  B         ;YES - INCREMENT COUNT
RDA020 EQU  $ 
       MOV  A,C       ;SELECT INPUT UNIT
       CALL SELACT
       MOV  L,B       ;RECALL NUMBER OF FULL
       MVI  H,0         ;BUFFERS
       CALL BAKSPW    ;BACKSPACE TO WRITE 
;*******************
; CLEAR READ FLAGS *
;*******************
RDA030 EQU  $ 
       CALL FREBFS    ;FREE BUFFERS 
       LXI  B,-1-SDVREC-SBINRY  ;CLEAR DEVICE 
       CALL CLBLXF      ;RECORD PENDING FLAGS 
CLXB2D EQU  $         ;CLEAR BUFFER TO DISPLAY BIT
       MVI  A,-1-XBF2DS 
       LXI  H,DFLGS 
       ANA  M 
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      XCHINT - INTERPRET CHAR, AND CHECK FOR 
;           MEMORY LOCKUP 
; 
;      ENTRY:  C = CHAR 
; 
;      EXIT :  C => ERROR, MEMORY LOCKED
;              NC => NO ERROR 
; 
; 
XCHINT EQU  $ 
       CALL CHINT 
       LDA  MLKFLG    ;MLKFLG <> 0 => LOCKUP
       ADI  377Q
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     BF2DSP - DISPLAY CONTENTS OF I/O BUFFER 
; 
;     ENTRY: D,E -> STATUS
; 
;     EXIT : D,E -> STATUS
;            STATUS BIT FOR DISPLAY CLEARED 
;              DESTROYS A,B,C,H,L 
; 
BF2DSP EQU  $ 
       LXI  H,DFLGS   ;SET BUFFER TO DISPLAY BIT
       MOV  A,M 
       ORI  XBF2DS
       MOV  M,A 
       PUSH D         ;SAVE D,E FOR RETURN
       DCX  D         ;D,E -> TYPE
       LDAX D 
       ORA  A         ;WHAT TYPE OF RECORD? 
       JP   B2D030    ;EOF OR EVD - QUIT
       MVI  C,-1      ;C = -1 => SEND CONTROL CODE
       LXI  H,B2D100  ;PTR TO ROUTINE FOR EACH BYT
       SUB  A         ;Z => STRIP OF TERM CRLF
       CALL EXPBF0    ;START OUTPUTTING BUFFER
       JC   B2D030    ;RETURN ON ERROR
B2D005 EQU  $ 
       ORA  A         ;TYPE OF RETURN?
       JNZ  B2D010    ;FORMAT FIELD SEPARATOR - 
       XTHL           ;NEXT-TO-LAST CHAR
       MOV  A,M       ;SET BUF AVAIL FOR PTTPLN 
       ANI  -1-DISPLY 
       ORI  PTTPOK
       MOV  M,A 
       XTHL 
       CALL EXPBF3    ;OUTPUT LAST CHARACTER
       JMP  B2D020    ;OUTPUT LAST CHAR 
 
; 
;  HANDLE FORMAT FIELD SEPARATORS 
; 
B2D010 EQU  $ 
       INX  D         ;SKIP FIELD PARAMETER 
       DCR  B 
       MVI  A,4       ;PART OF HEADER?
       CMP  E           ;(1ST FOUR BYTES) 
       PUSH H 
       CC   B2D200    ;NO - DISPLAY CR LF 
       POP  H 
       CALL EXPBF2    ;START NEXT FORMAT FIELD
B2D020 EQU  $ 
       JC   B2D030    ;RETURN ON ERROR
       JZ   B2D005    ;HANDLE ANY MORE FIELD SEP
; 
;  DECIDE WHETHER TO DO CR LF 
; 
       CALL B2D200    ;DISPLAY CR LF
B2D030 EQU  $ 
       POP  D         ;RECALL BUFFER STATUS PTR 
       PUSH PSW       ;SAVE ERROR (C) FLAG
       LDAX D         ;CLEAR DISPLAY BIT IN STATUS
       ANI  -1-DISPLY-PTTPOK
       STAX D 
       CALL CLXB2D    ;CLEAR BUFFER TO DISPLAY BIT
       POP  PSW       ;RECALL ERROR (C) FLAG
       RET
; 
;  ROUTINE HANDLES EACH BYTE
; 
B2D100 EQU  $ 
       CPI  LF        ;STRIP OUT LINE FEEDS 
       RZ 
B2D120 EQU  $ 
       PUSH B         ;CHINT KILLS ALL
       PUSH D 
       MOV  C,A       ;CHINT TAKES INPUT IN C 
       CALL XCHINT    ;DISPLAY BYTE 
       POP  D 
       POP  B 
       RET
; 
;  IF NON-FORMAT MODE, SEND CR LF TO DISPLAY
; 
B2D200 EQU  $ 
       CALL CHKFMT    ;FORMAT MODE? 
       RNZ            ;YES - QUIT 
       MVI  A,CR      ;NO - SEND CR 
       CALL B2D120      ;(SAVING REGISTERS) 
       MVI  A,LF        ;AND LF 
       JMP  B2D120
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      EXPBUF - PROCESS BUFFER OF DATA, 
;           EXPANDING CONTROL CODES 
; 
;      CALLED BY IORDGO (BUFFER TO DATACOM) 
;                BF2DSP (BUFFER TO DISPLAY) 
;                BF2PRT (BUFFER TO PRINTER) 
; 
;      INITIALIZATION:
;          ENTRY EXPBF0 - SKIP NO BYTES 
;          ENTRY EXPBF1 - SKIP FIRST (B-REG) BYTES
;              Z => DELETE TERMINATING CRLF 
;              NZ,NC => DO NOT DELETE 
;              C = 0 => SKIP CONTROL CODES
;              C =-1 => PASS CONTROL CODES
;              D,E -> BUF TYPE(MUST BE -1 => DATA)
;              H,L -> SUBROUTINE TO BE EXECUTED 
;                     FOR EACH BYTE PROCESSED:
;                     ENTRY:  A = BYTE
;                     EXIT :  NC => NO ERROR
;                             C => FATAL ERROR
;                             A,H,L DESTROYED 
; 
;      CONTINUATION - ENTRY EXPBF2: 
;              B = BYTES REMAINING
;              C-REG AS ABOVE 
;              D,E -> NEXT BYTE TO BE PROCESSED 
;              H,L -> SUBROUTINE
; 
;      EXIT :  C => FATAL ERROR 
;                A-E DESTROYED
;              NC => NO ERROR 
;                NZ => BUFFER EXHAUSTED 
;                  A-D DESTROYED
;                  E = 0
;                Z  => FIELD SEPARATOR FOUND
;                  A = 304B => FIELD SEPARATOR
;                  A = 0 => NEXT-TO-LAST CHAR 
;                  B = BYTES REMAINING
;                  C-REG AS ABOVE 
;                  D,E -> NXT BYTE TO BE PROCESSED
;              H,L -> SUBROUTINE
; 
;      A "NEXT-TO-LAST CHAR" RETURN IS GUARANTEED,
;      EVEN IF THE BUFFER IS EMPTY (ONLY CR LF).
;      IN THAT CASE, THE NEXT CALL RETURNS BUFFER 
;      EXHAUSTED. 
; 
EXPBF0 EQU  $ 
       MVI  B,0       ;B = 0 => SKIP NO BYTES 
EXPBF1 EQU  $ 
       PUSH H         ;SAVE ADDRESS 
       PUSH PSW       ;SAVE C => DO NOT DEL CRLF
       LHLD ALTOUT    ;CLEAR CURRENT ENHANCEMENT
       SHLD CALTST      ;AND ALTERNATE CHAR SET 
       CALL GETPTR    ;GET POINTER TO FIRST BYTE
       DCX  D         ;D,E -> LENGTH
       LDAX D         ;GET LENGTH 
       MOV  D,H 
       MOV  E,B       ;D,E -> FIRST BYTE TO PROCES
       MOV  L,A 
       DCR  L         ;H,L -> LAST BYTE 
       SUB  B         ;A = REMAINING BYTES
       MOV  B,A       ;B = COUNTER
       POP  PSW       ;RECALL C-BIT 
       JNZ  EXB010    ;NZ => DO NOT DELETE CRLF 
;******************************************** 
;  STRIP OFF TERMINATING CR LF, IF PRESENT  * 
;******************************************** 
       MOV  A,M       ;GET LAST CHAR
       SUI  LF        ;IS IT A LF?
       JNZ  EXB010    ;IF NOT, DON'T STRIP
       DCX  H         ;GET NEXT-TO-LAST CHAR
       MOV  A,M 
       SUI  CR        ;IS IT A CR?
       JNZ  EXB010    ;IF NOT, DON'T STRIP
       DCR  B         ;CR LF TERMINATES RECORD, 
       DCR  B           ;COUNT <- COUNT-2 
EXB010 EQU  $ 
       POP  H         ;H,L -> SUBROUTINE
       RZ             ;RETURN "NEXT-TO-LAST CHAR" 
;                       IF NO MORE CHARS
       MOV  A,B       ;ONLY ONE CHAR LEFT?
       DCR  A 
       RZ             ;YES - RET "PENULTIMATE CHAR
EXB020 EQU  $ 
       LDAX D         ;GET NEXT BYTE
       INX  D         ;ADVANCE POINTER
       DCR  B         ;DECREMENT COUNTER
       JZ   EXB030    ;LAST CHAR=FIELD SEP=> NO RE
       CPI  FLDSEP    ;IS IT A FIELD SEPARATOR? 
       RZ             ;YES - RETURN 
EXB030 EQU  $ 
       ORA  A         ;NO - IS IT A CONTROL CODE? 
       JM   EXB100    ;YES - EXPAND IT
       PUSH H         ;NO - SAVE SUBROUTINE ADDRES
       RST  1         ;PERFORM THE SUBROUTINE 
       POP  H         ;RESTORE SUBROUTINE ADDRESS 
EXB050 EQU  $         ;RE-ENTRY FOR ESCAPE SEQUENC
       RC             ;RETURN ON ERROR
 
;*********************************
; CONTINUE AFTER FIELD SEPARATOR *
;*********************************
EXPBF2 EQU  $ 
       MOV  A,B       ;ONLY ONE CHAR LEFT?
       DCR  A 
       RZ             ;YES - RET "PENULTIMATE CHAR
;***********************
;  CONTINUATION ENTRY  *
;***********************
EXPBF3 EQU  $ 
       MOV  A,B       ;ANY CHARS LEFT?
       ORA  A 
       JNZ  EXB020    ;YES - PROCESS NEXT BYTE
       MOV  E,A       ;YES - CLEAR E-REG
       INR  A         ;SET NZ => BUFFER EXHAUSTED 
       RET
;*************************
;  HANDLE CONTROL CODES  *
;*************************
EXB100 EQU  $ 
       ANA  C         ;PASS CONTROL CODES?
       JZ   EXB050    ;NO - CONTINUE
       PUSH B         ;SAVE REGISTERS 
       PUSH D 
       XCHG 
       MOV  C,A       ;EXPAND WANTS BYTE IN C & A 
       CALL EXPAND    ;EXPAND TO ESC SEQUENCE 
       XCHG           ;H,L -> SUBROUTINE
       LXI  D,B2DBUF  ;D,E -> FIRST CHAR OF ESC SE
       LDA  B2DEND    ;GET END POINTER
       STA  B2DPTR    ;CLEAR BUFFER 
       SUB  E 
       INR  A 
       MOV  B,A       ;B = NUMBER OF CHARS
       CALL EXPBF2    ;SEND ESC SEQUENCE
       CNC  EXPBF3      ;NO ERROR - SEND LAST CHAR
       POP  D         ;RESTORE REGISTERS
       POP  B 
       JMP  EXB050    ;CONTINUE 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      INTDSP - INITIALIZE DISPLAY FOR COPYING TO 
;           BUFFER
; 
;      SETS IOFLG2[ENDDSP] IF CURSOR IS BEYOND
;           END OF DISPLAY
; 
; 
INTDS0 EQU  $ 
       LDA  INPDEV    ;IS INPUT = DISPLAY?
       CPI  DISPLY
       RNZ            ;NO - RETURN
INTDSP EQU  $ 
       CALL INITDG    ;ANY CHARACTERS?
       RZ             ;YES - RETURN 
STNDSP EQU  $         ;SET END OF DISPLAY FLAG
       LXI  H,IOFLG2  ;NO - SET END-OF-DISPLAY
       MOV  A,M         ;FLAG 
       ORI  ENDDSP
       MOV  M,A 
       RET
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;     DSP2BF
; 
;     ENTRY: DON'T CARE 
; 
;     EXIT : NC => SUCCESS
;              D,E -> STATUS
;            C => ERROR 
;              D,E DESTROYED
;            A,B,H,L DESTROYED
; 
; 
DSP2BF EQU  $ 
       CALL GTIOB0    ;GET A BUFFER 
       RC             ;RETURN ON ERROR
       MVI  M,DISPLY  ;MARK FOR DISPLAY'S USE 
       DCX  H         ;H,L -> TYPE
;*************************************************
;  TEST FLAGS FOR END OF DISPLAY OR END OF PAGE  *
;      ON LAST CALL TO DSP2BF                    *
;*************************************************
       LXI  D,IOFLG2  ;SET XFR DISP TO BUFFER FLAG
       LDAX D 
       ORI  XDS2BF    ;DID LAST CALL FINISH DISP? 
       MVI  M,3         ;(MARK BUF FOR END OF DISP
       JM   D2B010    ;YES - QUIT 
       ADD  A         ;BOTTOM OF DISP PAGE? 
       RRC              ;(RESTORE IOFLGS) 
       JP   D2B020    ;NO - CONTINUE
       MVI  M,2       ;YES - MARK BUF FOR END OF P
D2B010 EQU  $ 
       ANI  -1-ENDDSP-DSPBTM-XDS2BF  ;CLEAR FLAGS 
       STAX D 
       DCX  H         ;H,L -> LENGTH
       MVI  M,1       ;1 IS DEFAULT 
       INX  H 
       INX  H 
       XCHG           ;D,E -> STATUS
       RET
;******************************** 
;  SET UP TO READ FROM DISPLAY  * 
;******************************** 
D2B020 EQU  $ 
       STAX D         ;SAVE IOFLG2
       DCX  H 
       XCHG           ;D,E -> LENGTH
       CALL CHKFMT    ;FORMAT MODE? 
       JNZ  D2B040
       LDA  CURROW    ;NO - IN LAST ROW?
       CPI  MAXROW
       JNZ  D2B030      ;NO - 
       MOV  A,M         ;YES - SET DSPBTM 
       ORI  DSPBTM
       MOV  M,A 
D2B030 EQU  $ 
       CALL GETPTR      ;GET POINTER TO 1ST BYTE
       MVI  M,-1        ;-1 => NO CHARS REC'D YET 
       JMP  D2B060
;*************************************************
;  WRITE HEADER FOR COPY FROM FORMATTED DISPLAY  *
;*************************************************
D2B040 EQU  $         ;YES - WRITE HEADER 
       CALL GETPTR    ;GET PTR TO 1ST BYTE OF BUF 
       MVI  M,FLDSEP  ;PUT SEPARATOR
       INR  L 
       LDA  ENDROW    ;CALCULATE NUMBER OF ROWS 
       MOV  B,A 
       LDA  CURROW
       MOV  C,A 
       LDA  TLINO 
       ADD  C 
       SUB  B 
       DCR  A         ;CURROW + TLINO - ENDROW - 1
       MOV  M,A 
       INR  L 
       MVI  M,FLDSEP  ;PUT SEPARATOR
       INR  L 
       LDA  CURCOL    ;WRITE CURRENT COLUMN 
       MOV  M,A 
       INR  L 
D2B060 EQU  $ 
       PUSH D         ;SAVE PTR TO LENGTH 
       XCHG 
D2B090 EQU  $         ;INSERT CHAR SET FOR FOREIGN
       MVI  A,STCHST    ;TERMINALS
       CALL ZKBCTL
       JNC  D2B100
;************************************** 
;  START FILLING BUFFER FROM DISPLAY  * 
;    D,E -> BUFFER                    * 
;************************************** 
D2B099 EQU  $ 
       STAX D 
       INR  E 
D2B100 EQU  $ 
       PUSH D         ;GETDSP KILLS ALL 
       CALL GETDSP
       POP  D 
       JC   D2B200    ;NO CHAR - HANDLE TERMINATOR
       CPI  LF        ;LINE FEED? 
       JNZ  D2B099    ;NO - PUT IN BUF, GET NXT CH
       CALL CHKFMT    ;YES - FORMAT MODE? 
       JNZ  D2B099      ;YES - PUT IN BUF, GET NEX
       LDA  CURCOL      ;NO - IS LF IN 1ST COLUMN?
       DCR  A 
       JZ   D2B100        ;YES - IGNORE LINE FEED 
       LXI  H,IOFLG2      ;NO - LF IS END OF REC
       MOV  A,M 
       ANI  -1-DSPBTM       ;LF CANNOT BE END OF
       MOV  M,A               ;DISPLAY PAGE 
       JMP  D2B440          ;APPEND LF AND QUIT 
;*******************************
;  HANDLE DISPLAY TERMINATORS  *
;*******************************
D2B200 EQU  $ 
       JM   D2B250    ;END OF DISPLAY 
       JNZ  D2B300    ;END OF ROW 
;*****************
;  END OF FIELD  *
;*****************
       LDA  CURROW    ;END OF ROW? (HAS ABS ROW NU
       LXI  H,TLINO     ;CHANGED?)
       ADD  M         ;CALCULATE ABS ROW NUMBER 
       LXI  H,ENDROW  ;SUBTRACT PREVIOUS ROW NUMBE
       SUB  M 
       JNZ  D2B300    ;YES - BUFFER FINISHED
       MVI  A,FLDSEP  ;NO - PUT FIELD SEPARATOR 
       STAX D 
       INR  E 
       LDA  CURCOL
       MVI  L,ENDCOL*256/256
       SUB  M         ;CURCOL-ENDCOL
       STAX D 
       INR  E 
       JMP  D2B090    ;GET MORE CHARACTERS
;*******************
;  END OF DISPLAY  *
;*******************
D2B250 EQU  $ 
       LHLD GETADR    ;WAS LAST CHAR BLOCK TERM?
       INX  H 
       LDA  BLKTRM
       CMP  M 
       JNZ  D2B270    ;NO - 
       STAX D         ;YES - PUT IT IN THE BUF
       INR  E 
D2B270 EQU  $ 
       CALL D2B600    ;ANY CHARS REC'D? 
       JNZ  D2B410    ;YES - ADD CR,LF AND RET DAT
D2B280 EQU  $ 
       POP  H         ;NO - RECALL PTR TO LENGTH
       MVI  M,0         ;SET LENGTH = 0 
       INX  H 
       MVI  M,3         ;MARK END OF DISPLAY
       JMP  D2B500    ;CLEAR DISP TO BUF FLG & QUI
;**************** 
;  END OF LINE  * 
;**************** 
D2B300 EQU  $ 
       LDA  GETADR    ;END OF DISPLAY, TOO? 
       ORA  A 
       CZ   D2B600    ;YES - IS THIS A NULL LINE? 
       JZ   D2B280      ;YES - RET END OF DISPLAY 
;                       NO - TREAT AS NORMAL REC, 
;                         ENDDSP SET BY D2B600
       LDA  IOFLG2
       ANI  DSPBTM    ;BOTTOM OF DISPLAY? 
       MVI  A,-1-RECPGE  ;IF SO, AND RECORDING FIL
       CNZ  CLIOFS         ;INHIBIT ROLLUP
       JNZ  D2B410    ;RECORDING PAGE - DO NOT LF 
       LDA  DSPTYP    ;SOFT KEY MODE? 
       ORA  A 
       CZ   CHKFMT    ;NO - FORMAT MODE?
       PUSH D 
       CZ   LNFEED    ;NO - DO LF 
D2B400 EQU  $ 
       POP  D 
D2B410 EQU  $ 
       CALL CHKFMT    ;FORMAT MODE? 
       JNZ  D2B420    ;YES - APPEND CR, LF
       DCR  E         ;NO - LAST CHAR CR? 
       LDAX D 
       INR  E 
       CPI  CR
       JZ   D2B440    ;YES - APPEND LF
D2B420 EQU  $         ;APPEND CR, LF
       MVI  A,CR
       STAX D 
       INR  E 
D2B440 EQU  $         ;APPEND LF
       MVI  A,LF
       STAX D 
       INR  E 
       POP  H         ;RECALL LENGTH PTR
       MOV  M,E       ;SAVE LENGTH
       INX  H 
       MVI  M,-1      ;MARK DATA RECORD 
D2B500 EQU  $ 
       INX  H         ;H,L -> STATUS
       XCHG           ;D,E -> STATUS
       LXI  H,IOFLG2  ;TURN OFF DISP TO BUF FLAG
       MOV  A,M 
       ANI  -1-XDS2BF 
       MOV  M,A 
       RET
;*************************************************
;  AT END OF DISP -                              *
;      NULL REC => RET NZ (END OF DISPLAY)       *
;      OTHER => SET ENDDSP & RET Z (DATA RECORD) *
;*************************************************
D2B600 EQU  $ 
       MOV  H,D       ;D,E -> BUFFER, SO SET UP 
       MVI  L,0         ;H,L -> FIRST CHAR
       MOV  A,M       ;IS 1ST CHAR -1?
       INR  A 
       RZ             ;YES => NULL RECORD, RET Z
       JMP  STNDSP    ;NO => SET ENDDSP, RET NZ 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IOSTGO - TRANSMIT DEVICE STATUS
; 
; 
;      RETURNS TO SYSTEM VIA "SDTERM" 
; 
IOSTGO EQU $
       MVI  A,ESC     ;OUTPUT ESCAPE
       CALL XPUTD3
       MVI  A,ABCKSL  ;OUTPUT BACK SLASH
       CALL XPUTD3
       MVI  A,SMALLP  ;OUTPUT SMALL P 
       CALL XPUTD3
       LXI  H,IOSTA0  ;GET DEVICE BIT 
       MOV  A,M 
       MVI  B,0 
       CALL BT2NUM    ;CONVERT TO NUMBER
       CALL IOS120    ;OUTPUT DEVICE
       CALL IOS100    ;OUTPUT 1ST STATUS BYTE 
       CALL IOS100    ;OUTPUT 2ND STATUS BYTE 
       CALL IOS100    ;OUTPUT 3RD STATUS BYTE 
; 
       CALL SDTERM  ;SEND THE TERMINATOR
; 
;  IOSTX1 - CLEAR DEVICE STATUS PENDING 
; 
IOSTX1 EQU $
       LXI  B,-1-SDVST-SDC2 
       JMP CLBLXF   ;CLEAR FLAG AND EXIT
; 
;  INCREMENT POINTER, GET A BYTE, AND OUTPUT IT 
; 
IOS100 EQU  $ 
       INX  H         ;POINT TO NEXT STATUS BYTE
       MOV  A,M       ;GET THE BYTE 
IOS120 EQU  $         ;ENTRY FOR OUTPUTTING DEVICE
       ORI  60Q       ;CONVERT TO ASCII DIGIT 
       JMP  XPUTD3    ;OUTPUT 
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  IODNGO - SEND OPERATION COMPLETED RESPONSE 
; 
;      ENTRY:  IOCDPT = COMPLETION TYPE (F,S,U) 
;              H = BASE 
; 
;      RETURNS TO SYSTEM VIA "SDTERM" 
; 
IODNGO EQU $
       LXI  B,-1-SDVDUN  ;CLEAR DEVICE DONE 
       CALL CLBLXF  ;PENDING FLAG 
       LDA  IOCDPT  ;FETCH COMPLETION TYPE
       CALL XPUTD3
       JMP  SDTERM    ;OUTPUT TERMINATOR
 
; 
; * * * * * * * * * * * * * * * * * * * * * * * * 
; 
;      BF2PRT - PRINT OUT CONTENTS OF BUFFER
; 
;      ENTRY:  D,E -> BUFFER STATUS 
; 
;      EXIT :  NC => NO ERROR 
;              C => ERROR 
;              D,E -> BUFFER STATUS 
;              A,B,C,H,L DESTROYED
; 
; 
BF2PRT EQU  $ 
       CALL PTRCHK    ;PRINTER CONNECTED? 
       RC             ;NO - RETURN
       PUSH D         ;SAVE PTR TO BUF STATUS 
       DCX  D         ;D,E -> TYPE
       LDAX D 
       INR  A         ;DATA RECORD? (= -1)
       JNZ  B2P100    ;NO - DO FORM FEED
       LDA  KBJMP2    ;YES - PASS CONTROL CODES?
       ANI  PRNTAL
       MVI  C,0         ;(SET FOR NOT PASSING)
       JZ   B2P010
       DCR  C 
B2P010 EQU  $ 
       LXI  H,B2P500  ;PTR TO PRINTOUT ROUTINE
       ORA  H         ;NC,NZ => DO NOT DELETE CRLF
       CALL EXPBF0    ;EXPAND BUFFER AND PRINT
B2P030 EQU  $ 
       JC   B2P300    ;EXIT ON ERROR
       JNZ  B2P200    ;EXIT ON BUFFER EXHAUSTED 
       ORA  A         ;NEXT-TO-LAST CHAR? 
       JZ   B2P080    ;YES - OUTPUT LAST
;***********************************
;  HANDLE FORMAT FIELD SEPARATORS  *
;***********************************
       LDAX D         ;GET FIELD PARAMETER
       ORA  A           ;=0?
       JZ   B2P070    ;YES - IGNORE 
       PUSH B 
       PUSH D 
       PUSH H 
       MOV  C,A       ;C <- COUNT 
       MVI  B,ABLNK   ;SET FOR PRINTING ASCII BLAN
       MOV  A,E         ;UNLESS THIS IS THE FIRST 
       DCR  A           ;FIELD SEPARATOR
       JNZ  B2P050
       MVI  B,LF        ;FIRST FIELD - PRINT LF'S 
B2P050 EQU  $ 
       CALL PTRCHR      ;PRINT
       POP  H 
       POP  D 
       POP  B 
       JC   B2P300    ;EXIT ON ERROR
B2P070 EQU  $ 
       INX  D         ;MOVE POINTER PAST COUNT
       DCR  B 
B2P080 EQU  $ 
       CALL EXPBF3    ;CONTINUE PRINTING
       JMP  B2P030    ;EVALUATE RESULTS 
;******************** 
;  PRINT FORM FEED  * 
;******************** 
B2P100 EQU  $ 
       MVI  A,FF
       CALL B2P500
;**************************** 
;  RELEASE BUFFER AND QUIT  * 
;**************************** 
B2P200 EQU  $ 
       POP  D         ;D,E -> STATUS
       LDAX D 
       ANI  -1-PRINTR 
       STAX D 
       RET            ;RET NC => NO ERROR 
;*****************
;  ERROR RETURN  *
;*****************
B2P300 EQU  $ 
       POP  D         ;D,E -> STATUS
       RET            ;IOEXIT CLEARS BUFS 
;*******************************
;  ROUTINE TO OUTPUT ONE BYTE  *
;*******************************
B2P500 EQU  $ 
       PUSH B 
       MVI  C,1       ;ONE REPETITION 
       MOV  B,A       ;BYTE IN B-REG
       PUSH D 
       CALL PTRCHR
       POP  D 
       POP  B 
       RET
 
;********************** 
; 9866 PRINTER DRIVER * 
;********************** 
; 
; 
; 
PRCHR1 EQU $
       LXI  H,PTDLY   ;SET TIMEOUT COUNTER
PTR110 EQU  $ 
       LDA PTRST1  ;INPUT STATUS
       ORA A        ;IS PRINTER OUT OF PAPER? 
       JP  PTR700   ;YES-TERMINATE
       RRC          ;IS PRINTER READY?
       MOV D,A      ;SAVE STATUS
       JC  PTR120   ;NO - CHECK TIMEOUT 
       MOV A,B      ;GET CHARACTER
       STA PTROT1  ;OUTPUT
       MOV A,D      ;GET STATUS 
       ANI  2         ;STROBE DATA? 
       RNZ            ;NO - QUIT
       LDA  PTRCL1    ;YES - OUTPUT STROBE
       RET              ;AND RETURN 
PTR120 EQU  $ 
       LDA  INTFLG    ;TIMER INTERRUPT? 
       SUI  TMRINT
       JNZ  PTR110    ;NO - CONTINUE WAITING
       STA  INTFLG    ;YES - CLEAR FLAG 
       DCX  H         ;DECREMENT TIMEOUT COUNTER
       MOV  A,H       ;TIME OUT?
       ORA  L 
       JZ  PTR700   ;YES-REPORT ERROR 
       JMP PTR110   ;CHECK STATUS AGAIN 
 
;************************ 
; RS-232 PRINTER DRIVER * 
;************************ 
; 
PRCHR2 EQU $
       LXI  H,PTDLY   ;SET TIMEOUT COUNTER
PTR630 EQU  $ 
       LDA PTRST2  ;INPUT STATUS
       ANI PTRDY2+PTROL2 ;IS PRINTER READY? 
       CPI PTRDY2 
       JNZ PTR640   ;NO-GO WAIT 
       LDA PTRCF2  ;READ IN CONFIG. STRAPS
       ANI PTRHD2   ;IS IT A HANDSHAKE DEVICE?
       JNZ PTR635   ;NO - OUTPUT THE CHARACTER
       LDA PTRST2  ;GET STATUS
       ANI PTRSB2   ;IS SB LINE SET/RDY?
       JZ  PTR640   ;NO-GO WAIT FOR PRINTER 
PTR635 EQU $
; 
       MOV A,B      ;GET CHARACTER
       STA PTRDA2  ;OUTPUT
       RET
PTR640 EQU  $ 
       LDA  INTFLG    ;TIMER INTERRUPT
       SUI  TMRINT
       JNZ  PTR630    ;NO - CONTINUE WAITING
       STA  INTFLG    ;YES - CLEAR FLAG 
       DCX  H         ;DECREMENT TIMEOUT COUNTER
       MOV  A,H       ;TIME OUT?
       ORA  L 
       JZ  PTR700   ;YES-REPORT ERROR 
       JMP PTR630   ;NO-GO CHECK STATUS 
 
; 
; * * * * * * * * * * * * * * * * * * * * 
; 
;      PTRCHR-OUTPUT A CHARACTER ROUTINE
; 
;      ENTRY:  D,E -> NEXT CHAR 
;             B=CHARACTER 
;             C=# OF TIMES TO REPEAT
; 
;      EXIT :  B = CHARACTER
;              C => ERROR 
;              NC => NO ERROR 
;              A,C,D,E,H,L
; 
; 
; 
; 
PTRCHR EQU $
       LDA  PTRFLG    ;GET PRINTER TYPE FLAG
       DCR  A         ;PRINTER 2 CONNECTED? 
       JNZ PTRC50   ;YES - GO TO PRINTER 2 DRIVER 
       LDA PTRST1  ;GET STATUS
       RRC          ;GET BIT 1
       RRC
       JNC  PTRC30    ;INVERT DATA? 
       MOV A,B      ;YES-GET CHARACTER
       CMA            ;INVERT IT
       MOV B,A      ;SAVE CHARACTER IN B REGISTER 
PTRC30 EQU  $ 
; 
;  LOGICAL DRIVER FOR PRINTER 1 - PARALLEL
; 
       CALL PRCHR1  ;OUTPUT CHARACTER 
       RC             ;ERROR EXIT 
       DCR C        ;IS THIS THE LAST ONE?
       JNZ  PTRC30    ;NO-GO DO IT AGAIN
       RET            ;YES - EXIT 
; 
;  LOGICAL DRIVER FOR PRINTER 2 - RS232 
; 
;      NOTE- NULL CHARACTER IS INSERTED AFTER 
;        EVERY CONTROL CODE (E.G., LF, FF, CR,
;        VT, ETC.) TO ALLOW PROPER OPERATION
;        FOR CENTRONICS BUSY LINE.
; 
PTRC50 EQU $
       LDAX D         ;GET NEXT CHAR
       MOV  D,A       ;SAVE IN D-REG
PTRC60 EQU  $ 
       CALL PRCHR2  ;OUTPUT CHARACTER 
       RC             ;ERROR EXIT 
       MVI  E,1       ;SET UP 1 NULL OUTPUT 
       MOV A,B      ;GET CHARACTER
       CPI 40Q      ;IS IT GREATER THAN 37B?
       JNC  PTRC90    ;YES - EXIT 
       CPI CR       ;NO-IS IT A CARRIAGE RET? 
       JNZ  PTRC70    ;NO - GO ADD FILL PAD 
       MOV  A,D       ;RECALL NEXT CHAR 
       CPI LF       ;IS NEXT CHARACTER A LF?
       JZ   PTRC80    ;YES - OUTPUT ONE NULL
PTRC70 EQU  $         ;NO - OUTPUT NULLS
       LDA PTRCF2  ;READ IN CONFIG. STRAPS
       ANI PTRHD2   ;IS IT A HANDSHAKE DEVICE?
       JZ   PTRC80    ;NO - OUTPUT ONE NULL 
       RAR          ;GET THE NUMBER OF FILLS
       RAR
       MOV  E,A       ;SET UP NULL COUNTER
PTRC80 EQU  $ 
       MVI B,0      ;SETUP NULL CHARACTER 
PTRC85 EQU  $ 
       CALL PRCHR2  ;OUTPUT THE CHARACTER 
       RC             ;ERROR EXIT 
       DCR  E         ;IS THIS THE LAST NULL? 
       JNZ  PTRC85    ;NO - GO DO IT AGAIN
       MVI B,LF     ;RESTORE B TO A LF
PTRC90 EQU  $         ;YES - COMPLETE 
; 
       DCR C        ;IS THIS THE LAST ONE?
       JNZ  PTRC60    ;NO - DO NEXT 
       RET          ;EXIT 
 
; 
;      PTRCHK-CHECKS FOR PRINTER ON-LINE
; 
;      ENTRY: A,B,C,D,E,L=DON'T CARE
; 
;      EXIT :  C => ERROR, NO PRINTER 
;              NC => NO ERROR 
;              A,H,L DESTROYED
; 
; 
PTRCHK EQU $
       LXI  H,PTRABT  ;GET PRINTER ERROR FLAG 
       XRA A        ;CLEAR A REGISTER 
       MOV M,A      ;CLEAR PRINTER ERROR FLAG 
       DCR L        ;GET PRINTER FLAG 
       ORA M        ;ANY PRINTERS CONNECTED?
       RNZ            ;YES - EXIT WITH NC 
; 
; 
;      DRIVER ERROR RETURN
; 
PTR700 EQU $
       LXI  H,PREMSG  ;SET PRINTER ERROR MESSAGE
       CALL CTUER1    ;REPORT ERROR (SETS C-BIT)
       LXI  H,PTRABT  ;SET PRINTER ERROR FLAG 
       MVI M,-1 
       RET          ;RETURN 
 
; 
;      STPRT -- PUTS STANDARD PRINTER STATUS
;               IN STAT1,STAT2,AND STAT3 FOR
;               SYSTEM USE
; 
; 
;      EXIT:    A,B,C,L DESTROYED 
;               D,E UNCHANGED; H=BASEH
;      REGISTER ALLOCATION
;               A=GENERAL 
;               B=PRINTER STATUS
;               C=STRAP STATUS (RS-232) 
; 
STPRT  EQU $
       XRA A        ;CLEAR A REGISTER 
       LXI  H,IOSTA1  ;CLEAR IOSTA1 
       MOV M,A
       INR L        ;SKIP OVER STAT 2 
       INR L        ;CLEAR STAT3
       MOV M,A
       LDA  PTRABT    ;GET PRINTER ERROR FLAG 
       ANI 10Q      ;MASK FOR ERROR STATUS
       XRI 10Q      ;SET PROPER VALUE 
       STA  IOSTA2    ;SET IOSTA2 VALUE 
       LDA  PTRFLG    ;GET PRINTER FLAG 
       RAR          ;IS IT DRIVER 2?
       JNC PTRS80   ;YES - BUILD RS-232 STATUS
; 
;      9866 STATUS
; 
       LDA PTRST1  ;GET PRINTER STATUS
       ORA A        ;IS PRINTER ON-LINE?
       JZ  PTRS10   ;NO-GO REPORT NO PRINTER
       MVI  L,IOSTA3  ;GET IOSTA3 POINTER 
       MVI M,1      ;SET ON-LINE BIT
       RLC          ;PRINTER OUT OF PAPER?
       JC  PTRS20   ;NO - CHECK READY STATUS
       MVI  L,IOSTA1  ;INSERT PAPER OUT 
       MVI M,2      ;SET PAPER OUT STATUS 
PTRS20 EQU $
       RRC
       RRC          ;PRINTER READY? 
       RNC          ;YES - RETURN 
PTRS10 EQU $        ;NO-SETUP PRINTER BUSY
       MVI A,1      ;INSERT PRINTER BUSY
       MVI  L,IOSTA2  ;IN IOSTA2
       ORA M        ;OR IN COMMAND REJECT 
       MOV M,A      ;AND SAVE STATUS
       RET
; 
;      RS-232 STATUS
; 
PTRS80 EQU $
       LDA PTRCF2  ;GET CONFIG. STRAPS
       MOV C,A      ;SAVE STRAP STATUS IN C 
       ANI PTRBD2   ;ISOLATE BAUD AND PARITY
       RAL          ;SETUP BAUD RATE FOR OUTPUT 
       MVI  L,IOSTA3  ;SAVE IT IN IOSTA3
       MOV M,A
       LDA PTRST2  ;GET PRINTER STATUS
       MOV B,A      ;SAVE PRINTER STATUS IN B 
       ANI PTRDY2+PTROL2 ;IS PRINTER READY? 
       CPI PTRDY2 
       JNZ PTRS10   ;NO-REPORT PRINTER BUSY 
       MVI A,1      ;SETUP PRINTER ON-LINE
       ORA M        ;OR IN BAUD RATE
       MOV M,A      ;SET ON-LINE BIT
       MOV A,C      ;GET CONFIGURATION STRAPS 
       ANI PTRHD2   ;IS IT A HANDSHAKE DEVICE?
       RNZ          ;NO-EXIT
       MOV A,B      ;GET STATUS 
       ANI PTRSB2   ;IS SB LINE SET/RDY?
       JZ  PTRS10   ;NO-GO REPORT BUSY
       RET
 
; 
;      CTLPRT-- OUTPUT STANDARD CONTROLS TO 
;               PRINTER 
; 
;               WHERE C IS DEFINED AS FOLLOWS:
;               0 - NOT DEFINED  (FF) 
;               1 - LINE FEED   (P=# OF LF'S) 
;               2 - TOP OF FORM  (FF) 
;               3 - NOT DEFINED  (FF) 
;               4 - NOT DEFINED  (FF) 
;               5 - END OF FILE  (FF) 
;               6 - END OF VALID (FF) 
;                   DATA
; 
; 
;      EXIT:    A,B,C,D,E,L DESTROYED 
;               H= BASEH
; 
; 
; 
CTLPRT EQU $
       CALL PTRCHK  ;IS A PRINTER ON-LINE 
       RC             ;NO - EXIT
       LXI  H,IOCCNT  ;SET UP NUM. OF LINE FEEDS
       MOV C,M
       MVI B,LF     ;GET ASCII LF 
       MVI L,IOCTYP ;GET TYPE OF CONTROL
       MOV D,M
       DCR D        ;IS IT A LF REQUEST?
       JZ  PTRCHR   ;YES-GO DO LINE FEEDS 
PRTX05 EQU $
       MVI C,1      ;SETUP FOR ONE CHARACTER
       MVI B,FF     ;SETUP FOR FORM FEED-FF 
       MVI  A,25      ;MOVE CURSOR OFF SCREEN 
       STA  IOCRRW
       JMP PTRCHR   ;GO OUTPUT CHARACTER
 
; 
;  EQUATES FROM MAIN CODE SECTION 
;    TO BE REMOVED WHEN CODE IS MERGED
;^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^
; 
ENTRCD EQU  230Q      ;ENTER KEY CODE 
SLKYCD EQU  236Q      ;SELECT KEY CODE
FNCLIM EQU  240Q      ;FUNCTION CODE UPPER LIMIT
TESTKY EQU  372Q      ;TEST KEY CODE
 
; 
;  COMMON ROUTINES - DUPLICATED FROM MAIN CODE
; 
; 
ZZZZZZ EQU  47775Q    ;SLEEP ROUTINE
; 
; 
; * * * * * * * * * * * * * * * * * * * * * * * 
; 
;  CHKFMT - CHECK FORMAT MODE 
; 
;      ENTRY:  H = BASEH
; 
;      EXIT :  Z = TRUE, NOT FORMAT MODE
;              Z = FALSE, FORMAT MODE 
;              A,L DESTROYED
; 
CHKFMT EQU $
       LDA  MDFLG1    ;GET TERMINAL MODE FLAGS
       ANI  FORMAT    ;MASK FOR FORMAT FLAG 
       RET          ;RETURN 
; 
;***************************
;  SEND CR(LF) TO DATACOM  *
;***************************
SDCRLF EQU  $ 
       MVI  A,CR      ;SEND THE CR
       CALL IOR400
;********************************** 
;  SEND LF IFF AUTO LF DEPRESSED  * 
;********************************** 
SDAULF EQU  $ 
       LDA  MDFLG2    ;AUTO LF DEPRESSED? 
       ANI  AUTOLF
       RZ             ;NO - RETURN
       MVI  A,LF      ;YES - SEND LF
       JMP  IOR400
 
; 
;  VECTORS INTO MAIN CODE 
; 
MANORG EQU  100Q
DSPMSG EQU  MANORG    ;DISPLAY A MESSAGE
RSTDSP EQU  DSPMSG+3  ;RESTORE NORMAL DISPLAY 
DCNUM  EQU  RSTDSP+3
DCPLUS EQU  DCNUM+3 
DCMNUS EQU  DCPLUS+3
ESCEND EQU  DCMNUS+3
CHKLIM EQU  ESCEND+3
CLBLXF EQU  CHKLIM+3
SBLXF0 EQU  CLBLXF+3
SBLXFA EQU  SBLXF0+3
STRTBL EQU  SBLXFA+3
CURPH  EQU  STRTBL+3
CURPHD EQU  CURPH+3 
FRECNT EQU  CURPHD+3
PTBLK0 EQU  FRECNT+3
CLEARL EQU  PTBLK0+3
CLEARS EQU  CLEARL+3
FNDTB2 EQU  CLEARS+3
SDTERM EQU  FNDTB2+3
SDTRM1 EQU  SDTERM+3  ;OUTPUT TERMINATOR ONLY 
XPUTD3 EQU  SDTRM1+3  ;TRANSMIT CHARACTER 
TEST   EQU  XPUTD3+3
CHINT  EQU  TEST+3
INITDG EQU  CHINT+3 
GETDSP EQU  INITDG+3
LNFEED EQU  GETDSP+3
EXPAND EQU  LNFEED+3
NXTCHR EQU  EXPAND+3
GETDCM EQU  NXTCHR+3
MLKSCH EQU  GETDCM+3
MLKOFF EQU  MLKSCH+3
HANGU0 EQU  MLKOFF+3
BUFMSG EQU  HANGU0+3
DCTEST EQU  BUFMSG+2
IORMGO EQU  DCTEST+3
BN2DEC EQU  IORMGO+3  ;CONVERT BINARY TO DECIMAL
BN2DE0 EQU  BN2DEC+3  ;CONVERT 1 BYTE BINARY TO DE
RCADRA EQU  BN2DE0+3  ;LOCATE CURRENT CURSOR POS
GTMODE EQU  RCADRA+3  ;CHECK FOR PAGE MODE
 
       END
