dCR EE DC0065 SAVED 2:10 PM WED., 17 SEPT, 1986 PRd@C0065EE8C&KY36C@&DC14F@@&PT774 t%ITL80t%RTERD"%..MAP" %DCLVA"%VAADD" XITL80"&GNCRA" &GNCRB"(&AMROM#\T&IO260$0 &MPTS24:nITL80 A(PASS1 BP PASS2 Bp:PASS3 C*@@ ASB,HEX ;KY36C - 6/25/76 - 1500 HRS. ; ; 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 TRANSMINOTEST EQU 4Q ;INHIBIT TERMINAL SELF-TEST EDTWRP EQU 10Q ;INVERT SENSE OF EDIT WRAPPRNTAL EQU 20Q ;SEND ALL CODES TO PRINTERDCJMP0 EQU 200Q ;DATA COMM JUMPER ;*****************************************; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *;*****************************************DCJMP1 EQU 1Q ;DATA COMM JUMPERSDCJMP2 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 AROUNDFRCRST EQU 4Q ;FORCE FULL TERMINAL RESETDEFSKY EQU 10Q ;DEFINE SOFT KEY MODE ENABLEREMSET EQU 20Q ;REMOTE MODE ENABLEDRCVMDE 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 INTERRUPTDCIOFF EQU 20Q ;DISABLE DATA COMM INTERRUPTTMIOFF 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 ENABLEDINSCHR EQU 2Q ;INSERT CHARACTER ENABLED MEMLOK EQU 4Q ;MEMORY LOCK ENABLEDFORMAT EQU 10Q ;FORMAT MODE ENABLEDEDIT EQU 20Q ;EDIT MODE ENABLEDSELECT EQU 40Q ;SELECT MODE ENABLEDRECORD EQU 100Q ;RECORD MODE ENABLEDFORGN EQU 200Q ;FOREIGN MODE ENABLED ;*********************************; MDFLG2 - TERMINAL MODE FLAGS 2 *;*********************************CAPSLK EQU 1Q ;CAPS LOCK ENABLEDBLKMDE EQU 2Q ;BLOCK MODE ENABLED AUTOLF EQU 4Q ;AUTO LF ENABLEDREMOTE EQU 10Q ;REMOTE ENABLED WBSR EQU 40Q ;WRITE-BACKSPACE-READ MODE;********************************************** ; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * ;********************************************** DECRDX EQU 10 ;DECIMAL NUMBERSOCTRDX EQU 8 ;OCTAL NUMBERS  ;******************* ; COMMON VARIABLES * ;******************* INTVEC EQU FSTRAM+145Q ;CENTRAL INTERRUPT VECTORSCNVEC EQU INTVEC+3 ;FOREIGN TERMINAL DISPLY SCA; COMMON EQU 177777Q ;UPPER LIMIT OF COMMON AREA CMBASE EQU COMMON/256 ;MSB OF COMMON ADDRESSESCMSTOR EQU CMBASE*256 ;MSB ADJUSTMENT FACTOR; DISPST EQU COMMON-1 ;DISPLAY REFRESH START PTRTRMTYP EQU DISPST-1 ;TERMINAL TYPE NUMBER KBDCSW EQU TRMTYP-1 ;KEYBOARD DATACOM SWITCHESKBJMPR EQU KBDCSW-1 ;KEYBOARD STRAPSKBJMP2 EQU KBJMPR-1 ;SET 2KBJMP3 EQU KBJMP2-1 ;SET 3CMFLGS EQU KBJMP3-1 ;COMMON FLAGS ERRFLG EQU CMFLGS-1 ;ERROR FLAGSINTFLG EQU ERRFLG-1 ;INTERRUPT FLAG PRCCTL EQU INTFLG-1 ;PROCESSOR CONTROL FLAGSMDFLG1 EQU PRCCTL-1 ;TERMINAL MODE FLAGS 1MDFLG2 EQU MDFLG1-1 ;AND 2MSGPT1 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 PARAMETERSRNGTA EQU RADIX-2 ;CHAR FUNCTION TABLE ADDRESSESCFLG EQU RNGTA-1 ;ESCAPE SEQUENCE FLAG ; = 0, NOT IN ESCAPE SEQ; # 0, ESC SEQ IN PROGRESSRSTTMR EQU ESCFLG-1 ;SOFT RESET TIMER ; * * * * * * * * * * * * * * * * * * * * * * * * ; END OF COMMON EQUATES * ;^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*  ;*************************************************;  ; DATACOM CONSTANTS ; ;*************************************************ZDCBAS EQU 50000Q ;DATACOM START ADDRESSTRIGGR 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 MASKDCJMS2 EQU DCJMSK+1 ;DATA COMM JUMPER MASK #2 ;*************************************************; ; DATACOM ENTRY VECTOR POINTERS; ;*************************************************ZINIDC EQU ZDCBAS+10Q ;INITIALIZE DATACOMZIN2DC EQU ZINIDC+3 ;INITIALIZATION CONTINUATOR ZDCMON EQU ZIN2DC+3 ;MONITORING ROUTINE ZDCCTL EQU ZDCMON+3 ;MISC CONTROL FUNCTIONS ZDCTST EQU ZDCCTL+3 ;SELF-TESTZGETDC EQU ZDCTST+3 ;GET DC CHARACTER ZPUTDC EQU ZGETDC+3 ;PUT DC CHARACTER ZGTBIN EQU ZPUTDC+3 ;GET BINARY DC CHARACTERZSTBIN EQU ZGTBIN+3 ;START BINARY OUTPUTZNDBIN EQU ZSTBIN+3 ;END BINARY OUTPUTZDCINT EQU ZNDBIN+3 ;DATACOM INTERRUPTS ;*************************************************; ; DATACOM CONTROL CALL CODES ; ;*************************************************CLRTRG EQU 0 ;CLEAR BLOCK TRANSFER TRIGGESETTRG EQU 1 ;SET BLOCK TRANSFER TRIGGER RSETDC EQU 2 ;RESET DATACOMSETREM EQU 3 ;SET REMOTE MODESETLCL EQU 4 ;SET LOCAL MODE PUTBRK EQU 5 ;OUTPUT BREAK SIGNALDISCNT EQU 6 ;MODEM DISCONNECT ENDBLK EQU 7 ;TERMINATE OUTPUT MESSAGE SETMON EQU 8 ;ENTER MONITOR MODE SETNRM EQU 9 ;ENTER NORMAL MODEFSTBIN EQU 10 ;ENTER FAST BINARY OUT MODE SNDATN EQU 11 ;SEND ATTENTION CODESNDFCT EQU 12 ;SEND FUNCTION DATA PROMPT EQU 13 ;SEND PROMPT CODE  ;************************** ; MAIN CODE ENTRY VECTORS * ;************************** MNCDBS EQU 100QZDSPMS EQU MNCDBS ;DISPLAY MESSAGEZRSTDS EQU ZDSPMS+3 ;RESTORE NORMAL DISPLAY ZDCNUM EQU ZRSTDS+3 ;ACCUMULATE DIGIT FOR ESC SEZDCPLS EQU ZDCNUM+3 ;ADD IN PLUS SIGN ZDCMNS EQU ZDCPLS+3 ;ADD IN MINUS SIGNZESCND EQU ZDCMNS+3 ;TERMINATE ESCAPE SEQUENCE;**************************************** ; KBFLGS - KEYBOARD ROUTINE LOCAL FLAGS * ;**************************************** KBLOCK EQU 1Q ;KEYBOARD DISABLEDPERMBM EQU 2Q ;PERMANENT BLOCK MODE RPTKY EQU 10Q ;REPEAT LAST KEY HIT;************************************** ; KBLEDS - LOCAL KEYBOARD LED EQUATES * ;************************************** DSFLED EQU 1Q ;DISPLAY FUNCTIONSICHLED EQU 2Q ;INSERT CHARACTER MLKLED EQU 4Q ;MEMORY LOCKXMTLED EQU 10Q ;TRANSMIT LED EDTLED EQU 20Q ;EDIT MODESELLED EQU 40Q ;SELECT MODERECLED EQU 100Q ;RECORD MODEBELLED EQU 200Q ;BELL   ;************************ ; MISCELLANEOUS EQUATES * ;************************ RPTDLY EQU 6 ;REPEAT DELAY (50 MSEC) SRTDLY EQU 51 ;SHORT START DELAY (500 MSECLNGDLY EQU 91 ;LONG START DELAY (900 MSEC); BLKDLY EQU 30 ;LED BLINK DELAY (30X10 MSECBLKSET EQU 377Q ;BLINK SET FLAG ; NUMCOL EQU 13 ;# OF KEYBOARD COLUMNS - 1REMBIT EQU 3 ;REMOTE FLAG BIT NUMBER ;************************** ; ASCII CHARACTER EQUATES * ;************************** BKSPCE EQU 10Q ;ASCII BACKSPACE CONTROL CODTAB EQU 11Q ;ASCII TAB CONTROL CODE CTLMSK EQU 37Q ;MASK FOR CONTROL CODES CPSADJ EQU 40Q ;CAPS LOCK ADJUSTMENT FACTORPLUS EQU 53Q ;(+) - PLUS SIGNSLANT EQU 57Q ;(/) - SLANTZERO EQU 60Q ;ASCII ZERO ABLNK EQU 40Q ;ASCII BLANKUPRLIM EQU 100Q ;UPPER CASE LOWER LIMIT A EQU 101Q ;UPPER CASE A Z EQU 132Q ;UPPER CASE Z LWRLIM EQU 140Q ;LOWER CASE CHAR LOWER LIMITDEL EQU 177Q ;DELETE CHARACTER ( = RUBOUT; B15 EQU 100000Q ;BIT 15 CONSTANT ;  ; FUNCTION ESCAPE CODES ; CLRTAB EQU 262Q ;2 - CLEAR TABCLRTBS EQU 263Q ;3 - CLEAR ALL TABS SETLMG EQU 264Q ;4 - SET LEFT MARGINSETRMG EQU 265Q ;5 - SET RIGHT MARGIN ENHNCF EQU 377Q ;DISPLAY ENHANCEMENT FUNCTIOCURRHT EQU 303Q ;C - CURSOR RIGHT CURLFT EQU 304Q ;D - CURSOR LEFTHOMEDN EQU 306Q ;F - HOME DOWNCLSCRN EQU 312Q ;J - CLEAR SCREEN CLRLNE EQU 313Q ;K - CLEAR LINE IWRPON EQU 316Q ;N - INSERT CHAR W/WRAP ONDCHWRP EQU 317Q ;O - DELETE CHAR W/WRAPAROUNDELCHR EQU 320Q ;P - DELETE CHARACTER ICHRON EQU 321Q ;Q - INSERT CHARACTER ONICHROF EQU 322Q ;R - INSERT CHARACTER OFF NEXTPG EQU 325Q ;U - NEXT PAGEFMTONF EQU 327Q ;W - FORMAT MODE ON FMTOFF EQU 330Q ;X - FORMAT MODE OFFDSPFON EQU 331Q ;Y - DISPLAY FUNCTIONS ON ENDPRF EQU 333Q ;[ - END PROTECTED FIELDSTPRF EQU 335Q ;] - START PROTECTED FIELD; LOWER CASEHOMEUP EQU 350Q ;H - HOME UP TO UNPROTECT BACKTB EQU 351Q ;I - BACK TAB SETSFK EQU 352Q ;J - SET SOFT KEY DEFINE ON MLKON EQU 354Q ;L - MEMORY LOCK ON F1FUNC EQU 360Q ;P - F1 FUNCTION CODE MNMDON EQU 371Q ;Y - MONITOR MODE ONTEST EQU 372Q ;Z - SELF-TESTSTXMOF EQU 373Q ;[ - START TRANSMIT ONLY;  ; EXTERNAL FUNCTION CODES ; ENTRCD EQU 230Q ;ENTER KEYDFNCOF EQU 232Q ;DISPLAY FUNCTIONS OFFRDKYCD EQU 234Q ;READ KEY CONDTN EQU 237Q ;CONDITION TAPE CTRDKY EQU 240Q ;CONTROL READ KEY EXFNLM EQU 241Q ;EXTERNAL FUNCTION UPPER LIM ; ; KEYBOARD SLOW RAM EQUATES; KBSRAM EQU 177440Q ;UPPER LIMIT OF SLOW RAM AREKBSBSE EQU (KBSRAM-1)/256;MSB OF SLOW RAM AREA KBSSTR EQU KBSBSE*256 ;MSB ADJUSTMENT FACTORKBBUF2 EQU KBSRAM-14 ;ACTIVE KEYS STATE TABLE KBFLGS EQU KBBUF2-1 ;KEYBOARD FLAGS KBJ1MS EQU KBFLGS-1 ;JUMPER ALTER INHIBIT MASK -; SET TO 1 IF NOT TO BE ; ALTERED BY ESCAPE SEQUENCEKBCHAR EQU KBJ1MS-1 ;REPEATING KEY CHARACTERBLKFLG EQU KBCHAR-1 ;LED BLINK FLAG KBKNSV EQU BLKFLG-1 ;REPEATING KEY NUMBER KBLEDS EQU KBKNSV-1 ;STATE OF KEYBOARD LED'SLEDSAV EQU KBLEDS-1 ;SAVE AREA FOR LED VALUES ; ; KEYBOARD FAST ACCESS RAM EQUATES ; KBFRAM EQU FSTRAM+400Q ;UPPER LIMIT OF FAST RAM KBFBSE EQU (KBFRAM-1)/256;MSB OF FAST RAM AREA KBFSTR EQU KBFBSE*256 ;MSB ADJUSTMENT FACTOR; KBBUF EQU KBFRAM-14 ;COLUMN STATE TABLE BUFFER KBBUFL EQU KBBUF-KBFSTR ;LSB OF STATE TABLE ADDRKBBFPT EQU KBBUF-2 ;KEYBOARD STATE TABLE POINTEKEYCOL EQU KBBFPT-2 ;KEYBOARD COLUMN ADDRESSBLKTMR EQU KEYCOL-1 ;BLINK DELAY TIMERKBTIMR EQU BLKTMR-1 ;KEY REPEAT TIMER KEYBLN EQU 40 ;KEY BUFFER LENGTHKEYBUF EQU KBTIMR-KEYBLN ;KEY BUFFER; EACH TWO BYTE ENTRY IN THE; KEY BUFFER REPRESENTS ONE ; OR MORE KEY TRANSITIONS.; THE MSB IS THE KEYBOARD ; COLUMN NUMBER AND THE LSB,; THE BITS CHANGED. KEYBFL EQU KEYBUF-KBFSTR ;LSB OF KEY BUFFER ADDRKBPTPT EQU KEYBUF-2 ;KEY BUFFER PUT POINTER KBGTPT EQU KBPTPT-2 ;KEY BUFFER GET POINTER  ; ; EQUATES TO SPECIFIC COLUMNS IN STATE TABLE ; KBCTSH EQU KBBUF2 ;CONTROL AND SHIFT KEYS CTLKEY EQU 1Q ;CONTROL KEY BITLSHFKY EQU 10Q ;LEFT SHIFT KEY RSHFKY EQU 20Q ;RIGHT SHIFT KEY; TSTROW EQU KBBUF2+5 ;TEST KEY ROW TSTCOL EQU 1Q ;TEST KEY BIT ; IOKYRW EQU KBBUF2+9 ;I/O CONTROL KEY ROWIOKYCL EQU 1Q ;I/O CONTROL (GOLD) KEY ENTCOL EQU 2Q ;ENTER KEY; BRKYRN EQU 13 ;BREAK KEY ROW NUMBER BRKCOL EQU 1Q ;BREAK KEY; ; EQUATES TO SPECIFIC KEY NUMBERS; RMKYNM EQU 10Q ;REMOTE CLKYNM EQU 20Q ;CAPS LOCKALKYNM EQU 40Q ;AUTO LINE FEED BMKYNM EQU 100Q ;BLOCK MODE   ;********************* ; I/O MODULE EQUATES * ;********************* IOBASE EQU 200Q ;I/O ADDRESS MSB'SIOKB EQU (3Q+IOBASE)*256;MODULE 11 BASE ADDRESSIOKBSW EQU IOKB+16Q ;KEYBOARD JUMPERS INIOKBDC EQU IOKB+17Q ;DATACOM SWITCHES INIOKBS2 EQU IOKB+200Q ;KEYBOARD JUMPERS 2 IN IOKBS3 EQU IOKB+240Q ;KEYBOARD JUMPERS 3 IN ; IOKBLD EQU IOKB+0Q ;SET KEYBOARD LED'S IOKBCO EQU IOKB+200Q ;RESET KEY CONTROL RSTON EQU 2Q ;ENABLE RESET KEYRSTOFF EQU 4Q ;DISABLE RE@@SET KEY IOKBCL EQU IOKB+40Q ;OUTPUT LAST COLUMN STATE  ; ;***************************; START OF KEYBOARD CODE *;*************************** ORG 44000Q ;START OF KEYBOARD CODE KBBASE EQU $ ;REGION (2K) DB 120Q ;SET ROM PRESENT INDICATORS  DB KBBASE/256 ;  ; KEYBOARD ENTRY VECTOR ;  JMP INITKB ;KEYBOARD INITIALIZATION JMP GTKEY ;GET KEYBOARD KEY  JMP KBCTL ;PERFORM KEYBOARD CONTROL  JMP KBMON ;MONITOR KEYBOARD  JMP SETMD1 ;SET MODE 1 FLAGS  JMP CLRMD1 ;CLEAR MODE 1 FLAGS  JMP BELL ;SOUND THE KEYBOARD BELL JMP SETXMT ;SET TRANSMIT LED  JMP CLRXMT ;CLEAR TRANSMIT LED  JMP STJMPR ;SET JUMPER ESC SEQ ROUTINE  JMP STLKYS ;SET LATCHING KEYS ESC SEQ JMP ALPCHK ;CHECK FOR ALPHA KEY ENTRY JMP NUMCHK ;CHECK FOR NUMERIC KEY ENTRY;  ; KEYBOARD CONSTANTS ; FRSALT:DB 20Q ;INITIAL ALT CHAR SET = SET ALTOUT:DB 0Q ;INITIAL ALT CHAR SET OUT =  ; ; LOWER CASE ASCII TRANSLATION TABLE ; LWRASC EQU $  DB 000Q,033Q,011Q,000Q ;COLUMN 0 DB 000Q,061Q,064Q,010Q  DB 206Q,061Q,161Q,172Q ;COLUMN 1 DB 015Q,062Q,065Q,134Q  DB 203Q,062Q,167Q,170Q ;COLUMN 2 DB 135Q,063Q,066Q,364Q  DB 200Q,063Q,145Q,143Q ;COLUMN 3 DB 072Q,304Q,323Q,365Q  DB 204Q,064Q,162Q,166Q ;COLUMN 4 DB 073Q,350Q,301Q,366Q  DB 372Q,065Q,164Q,142Q ;COLUMN 5 DB 154Q,303Q,325Q,367Q  DB 305Q,066Q,171Q,040Q ;COLUMN 6 DB 153Q,326Q,312Q,202Q  DB 201Q,067Q,165Q,156Q ;COLUMN 7 DB 152Q,302Q,261Q,320Q  DB 205Q,070Q,151Q,155Q ;COLUMN 8 DB 150Q,324Q,262Q,315Q  DB 233Q,230Q,157Q,054Q ;COLUMN 9 DB 147Q,056Q,071Q,314Q  DB 234Q,071Q,160Q,056Q ;COLUMN 10  DB 146Q,060Q,070Q,363Q  DB 235Q,060Q,100Q,057Q ;COLUMN 11  DB 144Q,000Q,067Q,362Q  DB 236Q,055Q,133Q,000Q ;COLUMN 12  DB 163Q,000Q,000Q,361Q  DB 231Q,136Q,137Q,000Q ;COLUMN 13  DB 141Q,000Q,000Q,360Q  ;  ; UPPER CASE ASCII TABLE ; UPRASC EQU $  DB 000Q,033Q,011Q,000Q ;COLUMN 0 DB 000Q,061Q,064Q,010Q  DB 206Q,041Q,121Q,132Q ;COLUMN 1 DB 015Q,062Q,065Q,174Q  DB 203Q,042Q,127Q,130Q ;COLUMN 2 DB 175Q,063Q,066Q,364Q  DB 200Q,043Q,105Q,103Q ;COLUMN 3 DB 052Q,304Q,323Q,365Q  DB 204Q,044Q,122Q,126Q ;COLUMN 4 DB 053Q,350Q,301Q,366Q  DB 372Q,045Q,124Q,102Q ;COLUMN 5 DB 114Q,303Q,325Q,367Q  DB 305Q,046Q,131Q,040Q ;COLUMN 6 DB 113Q,326Q,312Q,202Q  DB 201Q,047Q,125Q,116Q ;COLUMN 7 DB 112Q,302Q,261Q,320Q  DB 205Q,050Q,111Q,115Q ;COLUMN 8 DB 110Q,324Q,262Q,315Q  DB 233Q,230Q,117Q,074Q ;COLUMN 9 DB 107Q,056Q,071Q,314Q  DB 234Q,051Q,120Q,076Q ;COLUMN 10  DB 106Q,060Q,070Q,363Q  DB 235Q,060Q,140Q,077Q ;COLUMN 11  DB 104Q,000Q,067Q,362Q  DB 236Q,075Q,173Q,000Q ;COLUMN 12  DB 123Q,000Q,000Q,361Q  DB 231Q,176Q,177Q,000Q ;COLUMN 13  DB 101Q,000Q,000Q,360Q  ;*****************************************; ALTERNATE FUNCTION KEY FUNCTIONS TABLE *;*****************************************; ; NORMAL FUNCTION CODES FOLLOWED BY ALTERNATES ; NRMFCT EQU $  DB RDKYCD ;READ KEY  DB CTRDKY ;CONTROL READ KEY  DB CLRTAB ;CLEAR TAB DB CLRTBS ;CLEAR ALL TABS  DB CURLFT ;CURSOR LEFT DB SETLMG ;SET LEFT MARGIN DB CURRHT ;CURSOR RIGHT  DB SETRMG ;SET RIGHT MARGIN  DB CLSCRN ;CLEAR SCREEN  DB CLRLNE ;CLEAR LINE  DB DELCHR ;DELETE CHARACTER  DB CHECK1 ;ADDITIONAL CHECK 1  DB NEXTPG ;NEXT PAGE DB CHECK2 ;ADDITIONAL CHECK 2  DB HOMEUP ;HOME UP DB HOMEDN ;HOME DOWN DB TEST ;SELF-TEST DB CONDTN ;CONDITION TAPE  DB F1FUNC ;F1 KEY  DB ENHNCF ;START DISPLAY ENHANCEMENT DB F1FUNC+1 ;F2 KEY  DB ENDPRF ;END PROTECTED FIELD DB F1FUNC+2 ;F3 KEY  DB STPRF ;START PROTECTED FIELD DB F1FUNC+3 ;F4 KEY  DB FMTONF ;FORMAT MODE ON  DB F1FUNC+4 ;F5 KEY  DB FMTOFF ;FORMAT MODE OFF DB F1FUNC+5 ;F6 KEY  DB STXMOF ;START TRANSMIT-ONLY FIELD; NUMALT EQU ($-NRMFCT)/2;# OF ALTERNATE FUNCTIONS CHECK1 EQU 1 ;EXTRA CHECK 1 FLAG CHECK2 EQU 2 ;EXTRA CHECK 2 FLAG  ; ; INTERNAL FUNCTIONS VECTOR TABLE; FNCTAB EQU $  DW CKMLOK ;200 - MEMORY LOCK DW CKDSFN ;201 - DISPLAY FUNCTIONS DW CKICHR ;202 - INSERT CHARACTER  DW STCPLK ;203 - CAPS LOCK DW STAULF ;204 - AUTO LF DW STBLKM ;205 - BLOCK MODE  DW STRMMD ;206 - SET REMOTE MODE; FNBASE EQU 200Q ;FUNCTION LOWER LIMIT FNCLIM EQU 207Q ;FUNCTION CODE UPPER LIMIT ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; INITKB - INITIALIZE KEYBOARD ;  ; ENTRY: DON'T CARE ;  ; EXIT : A DESTROYED ; NC = NO ERRORS ; C = ERROR DETECTED ; B,C = POINTER TO ERROR MESSAGE ; INITKB EQU $  LDA IOKBSW ;GET KEYBOARD STRAP SETTINGS STA KBJMPR ;AND STORE THEM  LDA IOKBS2 STA KBJMP2 LDA IOKBS3 STA KBJMP3  LDA IOKBDC ;GET AND STORE THE DATA  STA KBDCSW ;COMM SWITCHES; INITK0 EQU $  LXI H,KBBUF+NUMCOL  SHLD KBBFPT ;INITIALIZE STATE TABLE  LXI H,IOKB+NUMCOL ;POINTERS SHLD KEYCOL  LXI H,KEYBUF+KEYBLN-1  SHLD KBGTPT ;INITIALIZE TRANSITION SHLD KBPTPT ;BUFFER POINTERS;  XRA A ;CLEAR THE LEDS ON THEINITK1 EQU $ ;KEYBOARD  STA IOKBLD  RET ;RETURN C = FALSE  ;***********************************; GTKEY - GET A KEYBOARD CHARACTER *;***********************************;  ; ENTRY: DON'T CARE ; ; EXIT : Z - KEYBOARD INPUT PRESENT ; A = KEYBOARD CHARACTER CODE; NZ - NO KEYBOARD INPUT ; A = 0, NO KEY HIT (OR NULL CHAR) ; A # 0, KEYBOARD LOCKED (A IS ; KEYBOARD CHARACTER CODE) ; B,C,D,E DESTROYED; ; KEY VALUES IN THE RANGE 260-376 (OCTAL); REPRESENT TWO CHARACTER ESCAPE SEQUENCES ; GENERATED FROM FUNCTION KEYS. THE SECOND; CHARACTER IS OBTAINED BY MASKING OUT THE  ; HIGH ORDER BIT. ; ; KEY VALUES IN THE RANGE 230-241 (OCTAL); REPRESENT INTERNAL FUNCTION KEYS AS; FOLLOWS: ; ; 230 - ENTER KEY PRESSED ; 231 - BREAK KEY PRESSED ; 232 - DISPLAY FUNCTIONS OFF ; 233 - I/O CONTROL KEY PRESSED ; 234 - READ KEY PRESSED; 235 - RECORD KEY PRESSED; 236 - SELECT KEY PRESSED; 237 - CONDITION TAPE FUNCTION ; GTKEY EQU $  PUSH H ;SAVE H AND L  CALL STRTS1 ;ENABLE RESET KEY  LDA KBFLGS ;GET KEYBOARD FLAGS  ANI RPTKY ;REPEAT LAST KEY HIT?  JNZ GTK040 ;YES - RE-ISSUE THE KEY  LHLD KBGTPT ;NO - FETCH BUFFER GET PTRGTK005 EQU $  LDA KBPTPT ;GET LSB OF PUT POINTER  CMP L ;BUFFER EMPTY? JNZ GTK100 ;NO - PROCESS KEYBOARD INPUT CALL KBMON1 ;YES - LOOK FOR STATE CHANGEGTK010 EQU $  LHLD KBGTPT ;GET KEY BUFFER POINTERS LDA KBPTPT  CMP L ;BUFFER EMPTY? JNZ GTK100 ;NO - PROCESS KEYBOARD INPUTGTK020 EQU $  LDA IOKBDC ;YES - UPDATE SETTINGS OF  STA KBDCSW ;KEYBOARD DATACOM SWITCHES ;************************** ; CHECK FOR REPEATING KEY * ;**************************  LXI H,KBTIMR ;GET THE REPEAT DELAY TIMER  MOV A,M  DCR A ;TIME TO REPEAT? JNZ GTK060 ;NO - EXIT NO KEY HIT  MVI M,RPTDLY ;YES - RESET COUNTERGTK030 EQU $  LDA KBCHAR ;RECALL THE KEYBOARD CHAR  JMP GTKYX1 ;RETURN KEY HIT  ;********************** ; REPEAT LAST KEY HIT * ;********************** GTK040 EQU $  LXI H,KBFLGS ;CLEAR REPEAT FLAG CMA ;CONVERT BIT TO CLEAR MASK ANA M ;CLEAR REPEAT KEY FLAG MOV M,A ;UPDATE FLAGS  JMP GTK030 ;RE-ISSUE THE KEY CODE ;************************ ; NO KEY CHANGES - EXIT * ;************************ GTK060 EQU $  ORI 377Q ;SET NC, NZ  POP H ;RESTORE H,L RET ; ; KEYBOARD STATE CHANGE IN BUFFER; GTK100 EQU $  MVI D,0 ;SET D FOR MSB = 0 MOV E,M ;GET KEYBOARD COLUMN NUMBER  DCX H ;(D = 0) MOV C,M ;GET NEW STATE VALUE PUSH H ;SAVE BUFFER ADDRESS LXI H,KBBUF2 ;COMPUTE LOCATION OF DAD D ;STATE TABLE BYTE  MOV A,M  XRA C ;ANY MORE CHANGES? JNZ GTK130 ;YES - GO PROCESS CHANGES  POP H ;NO - ADVANCE TO NEXT  MVI A,KEYBFL ;BUFFER ENTRY  CMP L ;REACHED START OF BUFFER?  JNZ GTK120 ;NO - MOVE TO NEXT BYTE  MVI L,KEYBFL+KEYBLN ;YES - RESET POINTER GTK120 EQU $  DCX H ;MOVE TO NEXT BYTE SHLD KBGTPT ;UPDATE GET POINTER  JMP GTK005 ;CHECK FOR MORE CHANGES ;********************************************** ; KEYBOARD CHANGE FOUND - DETERMINE NEW STATE * ;********************************************** GTK130 EQU $  INX SP ;POP OFF TOP OF STACK  INX SP MOV C,A ;EXTRACT RIGHTMOST CHANGED XRA A ;BIT SUB C  ANA C  MOV B,A ;SAVE CHANGED BIT IN B-REG XRA M ;COMPUTE NEW STATE AND MOV M,A ;UPDATE STATE TABLE  ANA B ;WAS KEY RELEASED? JNZ GTK200 ;NO - EXTRACT KEY CODE CALL GTKYNM ;YES - COMPUTE KEY NUMBER  CMP M ;WAS THE KEY REPEATING?  JNZ GTK150 ;NO - CHECK FOR LATCH RELEAS MOV A,D ;CLEAR THE REPEAT TIMER  STA KBTIMR  JMP GTK010 ;TRY FOR ANOTHER KEY ; ; NON-REPEATING KEY RELEASED - CHECK FOR  ; LATCHING KEY RELEASE ; GTK150 EQU $  CPI BMKYNM ;BLOCK MODE KEY? JZ GTK160 ;YES - RESET BLOCK MODE  JP GTK010 ;NOT LATCHING KEY - TRY AGAI CPI ALKYNM ;AUTO LF KEY?  JZ GTK170 ;YES - RESET AUTO LF FLAG  CPI CLKYNM ;CAPS LOCK KEY JZ GTK180 ;YES - RESET CAPS LOCK FLAG  SUI RMKYNM ;REMOTE KEY? JNZ GTK010 ;NO - TRY FOR ANOTHER KEY  STA KBTIMR ;YES - CLEAR REPEAT TIMER  MVI A,REMOTE ;AND CLEAR REMOTE FLAG JMP GTK190 ; ; BLOCK MODE KEY RELEASED - RESET BLOCK MODE FLAG; GTK160 EQU $  LDA KBFLGS ;GET KEYBOARD FLAGS  ANI PERMBM ;SET FOR PERMANENT BLOCK MDE JNZ GTK010 ;YES - TRY FOR ANOTHER KEY MVI A,BLKMDE ;NO - CLEAR BLOCK MODE FLAG  JMP GTK190 ; ; AUTO LF KEY RELEASED - RESET AUTO LF FLAG; GTK170 EQU $  MVI A,AUTOLF ;SET FLAG BIT TO BE CLEARED  JMP GTK190 ;CLEAR THE FLAG AND RETURN; ; CAPS LOCK KEY RELEASE - RESET CAPS LOCK FLAG ; GTK180 EQU $  MVI A,CAPSLK ;SET FLAG BIT TO BE CLEARED ; GTK190 EQU $  CMA ;CONVERT TO CLEAR MASK LXI H,MDFLG2 ;CLEAR FLAG FROM TERMINAL  ANA M ;MODE FLAGS 2  MOV M,A ;UPDATE FLAGS  JMP GTK010 ;TRY FOR ANOTHER KEY ; ; NEW KEY IS PRESSED DOWN - COMPUTE KEY CODE ; GTK200 EQU $  LXI H,KBTIMR ;CLEAR THE REPEAT TIMER  MOV M,D  CALL GTKYNM ;COMPUTE KEY NUMBER  MOV M,A ;UPDATE CURRENT REPEATING KE LDA KBCTSH ;GET CONTROL/SHIFT KEY COLUM ANI LSHFKY+RSHFKY ;SHIFT KEY DOWN LXI H,LWRASC ;(SET FOR LOWER CASE TABLE JZ GTK210 ;YES - GET THE KEY CODE  LXI H,UPRASC ;NO - USE UPPER CASE TABLE; ; EXTRACT KEY CODE FROM TABLE; GTK210 EQU $ ;(D = 0, E = KEY NUMBER) DAD D ;INDEX TABLE BY KEY NUMBER MOV B,M ;FETCH THE TABLE VALUE MOV A,B  ORA A ;ANY KEY CODE? JZ GTK010 ;NO - TRY FOR ANOTHER KEY  JM GTK300 ;PROCESS FUNCTION CODE IF S= LDA KBCTSH ;(GET CONTROL/SHIFT COLUMN ANI CTLKEY ;CONTROL KEY PRESSED?  JZ GTK220 ;NO - CHECK CAPS LOCK  MOV A,B ;YES - MOVE CHARACTER TO A CPI BKSPCE ;IS IT THE BACKSPACE KEY?  JZ GTK215 ;YES - CHANGE TO BACK TAB  CPI TAB ;IS IT THE TAB KEY?  JZ GTK215 ;YES - CHANGE TO BACK TAB  CPI UPRLIM ;IS CHARACTER ALPHABETIC?  JM GTK230 ;NO - RETURN UNALTERED CHAR  ANI CTLMSK ;YES - MASK FOR CONTROL CODE JMP GTK230 ;RETURN KEY HIT ; ; CONTROL-BACKSPACE/TAB - CHANGE TO BACK TAB ; GTK215 EQU $  MVI A,BACKTB ;RETURN BACK TAB CODE  JMP GTK230  ; ; CONTROL KEY UP - CHECK FOR CAPS LOCK ; GTK220 EQU $  LDA MDFLG2 ;GET TERMINAL MODE FLAGS 2 ANI CAPSLK ;CAPS LOCK SET?  MOV A,B ;(PUT KEY CODE IN A-REG) JZ GTK230 ;NO - RETURN KEY HIT CPI LWRLIM ;IS KEY LOWER CASE?  JM GTK230 ;NO - RETURN KEY HIT CPI DEL ;IS KEY = DELETE (RUBOUT)? JZ GTK230 ;YES - RETURN KEY HIT  SUI CPSADJ ;NO - ADJUST TO UPPER CASE; ; RETURN WITH LONG REPEAT DELAY; GTK230 EQU $  LXI H,KBTIMR ;SET KEYBAORD REPEAT TIMER MVI M,LNGDLY ;FOR LONG START DELAY ;  ; GTKYX1 - RETURN KEY HIT ; GTKYX1 EQU $  STA KBCHAR ;SAVE THE CHARACTER FOR RPT  MOV L,A ;SAVE CHARACTER IN L-REGISTE LDA KBFLGS ;GET KEYBOARD FLAGS  ANI KBLOCK ;KEYBOARD LOCKED?  MOV A,L ;(RECALL KEYBOARD CHAR)  JNZ GTK240 ;YES - RETURN NO KEY HIT POP H ;NO - RESTORE H,L  RET ;RETURN Z TRUE; ; RETURN NO KEY HIT FOR LOCKED KEYBOARD; GTK240 EQU $  LXI H,KBTIMR ;CLEAR THE REPEAT TIMER  MOV M,D  POP H ;RECALL H,L  RET ;RETURN Z FALSE  ;*********************************************; FUNCTION KEY - CHECK FOR CONTROL EXCHANGES *;*********************************************GTK300 EQU $  CPI FNCLIM ;INTERNAL FUNCTION CODE? JM GTK400 ;YES - PROCESS INTERNAL CODE LDA KBCTSH ;NO - GET CONTROL/SHIFT COLM ANI CTLKEY ;CONTROL KEY DOWN? JNZ GTK310 ;YES - CHE@@CK FOR ALTERNATES  LDA KBJMP2 ;NO - GET KEYBOARD JUMPERS 2 ANI EDTWRP ;EDIT WRAP AROUND REVERSED?  MOV A,B ;(RECALL FUNCTION CODE)  JZ GTK350 ;NO - RETURN NORMAL CODE CPI DELCHR ;IS IT DELETE CHARACTER? JNZ GTK350 ;NO - RETURN NORMAL CODE MVI A,DCHWRP ;YES - USE DELETE WRAPAROUND JMP GTK350 ;SET THE FUNCTION CODE ;*****************************************; CONTROL KEY DOWN - CHECK FOR ALTERNATE *; FUNCTIONS *;*****************************************GTK310 EQU $  MOV A,B ;RECALL THE FUCNTION CODE  LXI H,NRMFCT ;SET INITIAL TABLE ADDRESSES MVI C,NUMALT ;SET NUMBER OF ALTERNATES ; GTK320 EQU $  CMP M ;FUNCTION FOUND? INX H ;(ADVANCE TO ALT CODE) JZ GTK330 ;YES - GET ITS ALTERNATE INX H ;NO - STEP TO NEXT ENTRY DCR C ;TABLE EXHAUSTED?  JNZ GTK320 ;NO - TRY NEXT VALUE JMP GTK350 ;YES - USE NORMAL FUNCTION;************************************************ ; FUNCTION WITH ALTERNATE FOUND - USE ALTERNATE * ;************************************************ GTK330 EQU $  MOV A,M ;GET THE ALTERNATE FUNCTION  CPI CHECK1 ;FURTHER CHECKING REQUIRED?  JZ GTK380 ;YES - GO DO IT  CPI CHECK2  JZ GTK370 ;YES - GO DO IT ; NO - SET FUNCTION CODE ;******************** ; SET FUNCTION CODE * ;******************** GTK350 EQU $  CALL SETRPT ;SET THE REPEAT RATE JMP GTKYX1 ;RETURN KEY HIT  ; ; TOGGLE SOFT KEY/NORMAL DISPLAY ; GTK370 EQU $  LDA CMFLGS ;GET COMMON FLAGS  ANI DEFSKY ;SOFT KEY DEFINE ACTIVE? MVI A,SETSFK ;(SET CODE FOR SOFT KEYS)  JZ GTK350 ;NO - RETURN NORMAL CODE INR A ;YES - RETURN CODE TO RESTOR JMP GTK350 ;NORMAL DISPLAY ; ; DELETE CHARACTER AND CONTROL KEY DOWN; GTK380 EQU $  LDA KBJMP2 ;GET KEYBOARD JUMPERS 2  ANI EDTWRP ;EDIT WRAP AROUND REVERSED?  MOV A,B ;(RECALL NORMAL CODE)  JNZ GTK350 ;YES - RETURN NORMAL CODE  MVI A,DCHWRP ;NO - RETURN WRAP AROUND COD JMP GTK350  ;*****************************; PROCESS INTERNAL FUNCTIONS *;*****************************GTK400 EQU $  SUI FNBASE ;COMPUTE FUNCTION INDEX  ADD A  MOV E,A ;PUT INTO E (D = 0)  LXI H,FNCTAB ;GET POINTER TO FUNCTION DAD D ;ROUTINE MOV A,M  INX H  MOV H,M  MOV L,A  PCHL ;PERFORM FUNCTION ; ; MEMORY LOCK; CKMLOK EQU $  LDA MDFLG1 ;GET TERMINAL MODE FLAGS ANI MEMLOK ;MEMORY LOCK ON? MVI A,MLKON ;(SET TURN ON ESCAPE CODE) JZ GTKYX1 ;NO - RETURN TURN ON CODE  INR A ;YES - RETURN TURN OFF CODE  JMP GTKYX1 ;  ; DISPLAY FUNCTIONS ; CKDSFN EQU $  LDA MDFLG1 ;GET TERMINAL MODE FLAGS 1 ANI DSPFNC ;DISPLAY FUNCTIONS ON? JNZ GTK410 ;YES - TURN OFF DISPLAY FUNC LDA KBCTSH ;NO - GET CONTROL/SHIFT COLM ANI CTLKEY ;CONTROL KEY DOWN? MVI A,DSPFON ;(SET CODE FOR DSP FNCT ON JZ GTKYX1 ;NO - TURN DISPLAY FUNCTIONS MVI A,MNMDON ;YES - SET TO TURN ON MONITO JMP GTKYX1 ;MODE ; GTK410 EQU $  MVI A,DFNCOF ;RETURN DISPLAY FUNCTIONS  JMP GTKYX1 ;OFF CODE  ;  ; INSERT CHARACTER ; CKICHR EQU $  LDA MDFLG1 ;GET TERMINAL MODE FLAGS ANI INSCHR ;INSERT CHARACTER ON?  MVI A,ICHROF ;(SET OFF ESCAPE CODE) JNZ GTKYX1 ;YES - RETURN OFF CODE LDA KBJMP2 ;NO - GET KEYBOARD JUMPERS 2 ANI EDTWRP ;REVERSE SENSE OF EDIT WRAP? JZ CKC010 ;NO - USE NORMAL SENSE MVI A,377Q ;YES - INVERT SENSE OF CTLCKC010 EQU $  LXI H,KBCTSH ;GET CONTROL/SHIFT COLUMN  XRA M ;SET FOR PROPER SENSE  ANI CTLKEY ;USE ALTERNATE CODE? MVI A,ICHRON ;(SET TURN ON ESCAPE CODE) JZ GTKYX1 ;NO - RETURN NORMAL ON CODE  MVI A,IWRPON ;YES - RETURN WRAP AROUND ON JMP GTKYX1 ; ; SET CAPS LOCK; STCPLK EQU $  MVI A,CAPSLK ;SET FLAG BIT TO BE SET  JMP GTK450 ;SET THE FLAG AND EXIT;  ; SET AUTO LINE FEED ; STAULF EQU $  MVI A,AUTOLF ;SET FLAG BIT TO BE SET  JMP GTK450 ;SET THE FLAG AND EXIT;  ; SET BLOCK MODE ; STBLKM EQU $  MVI A,BLKMDE ;SET FLAG BIT TO BE SET  JMP GTK450 ;SET FLAG AND EXIT;  ; SET REMOTE MODE ; STRMMD EQU $  MVI A,REMOTE ;SET FLAG BIT TO BE SET ; GTK450 EQU $  LXI H,MDFLG2  ORA M ;SET THE FLAG  MOV M,A ;UPDATE THE FLAGS  XRA A ;CLEAR KEY NUMBER SAVE WORD  STA KBKNSV  JMP GTK010 ;TRY FOR ANOTHER KEY ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; KBMON - MONITOR KEYBOARD ;  ; ENTRY: DON'T CARE ; ; EXIT : ALL REGISTERS DESTROYED; KBMON EQU $  LXI H,KBTIMR ;DECREMENT THE REPEAT  MOV A,M ;KEY TIMER DCR A ;TIMER ACTIVE? JM KBM010 ;NO - DON'T UPDATE TIMER JZ KBM010 ;TIME OUT - DON'T UPDATE MOV M,A ;YES - UPDATE TIMER KBM010 EQU $  INX H ;DECREMENT BLINK TIMER DCR M ;TIME TO BLINK LEDS? LDA KBLEDS ;(GET CURRENT LED STATE) JP KBM020 ;NO - SET LED'S ONLY MOV B,A ;SAVE CURRENT STATE IN B-REG MVI M,BLKDLY ;YES - RESET TIMER LDA BLKFLG ;GET LED BLINK FLAG  XRA B ;SET NEW LED VALUES  STA KBLEDS ;STORE NEW VALUES KBM020 EQU $  EI ;RE-ENABLE INTERRUPTS  STA IOKBLD ;SET KEYBOARD LED'S  ;  ; CHECK FOR NEW KEY HIT ; KBMON1 EQU $  DI ;DISABLE INTERRUPTS  LHLD KEYCOL ;GET CURRENT KEY COLUMNN XCHG ;IN D,E  LHLD KBBFPT ;GET STATE TABLE POINTER MOV A,M ;GET PREVIOUS STATE  MOV B,A ;SAVE IT IN B-REGISTER STA IOKBCL ;SET HYSTERESIS FOR DETECTOR LDAX D ;GET NEW STATE XRA B ;ANY CHANGES?  JNZ KBM100 ;YES - PROCESS NEW STATE DCX H ;NO - DECREMENT TO NEXT COL  DCR E ;ALL COLUMNS DONE? JP KBM030 ;NO - CHECK NEXT COLUMN  MVI E,NUMCOL ;YES - RESET COLUMN POINTERS MVI L,KBBUFL+NUMCOL KBM030 EQU $  MOV A,M ;GET PREVIOUS STATE  MOV B,A  STA IOKBCL ;SET HYSTERESIS  LDAX D ;GET NEW STATE XRA B ;ANY CHANGES?  JNZ KBM100 ;YES - PROCESS NEW STATE DCX H ;NO - DECREMENT TO NEXT COL  DCR E ;ALL COLUMNS DONE? JP KBM040 ;NO - EXIT MVI E,NUMCOL ;YES - RESET COLUMN POINTERS MVI L,KBBUFL+NUMCOL KBM040 EQU $  SHLD KBBFPT ;SAVE COLUMN POINTERS  XCHG  SHLD KEYCOL  EI ;RE-ENABLE INTERRUPTS  RET ;RETURN  ; ; KEYBOARD STATE CHANGE - ADD CHANGE TO BUFFER ; KBM100 EQU $  SHLD KBBFPT ;SAVE COLUMN POINTERS  XCHG  SHLD KEYCOL  MOV C,L ;PUT COLUMN NUMBER IN C  LHLD KBPTPT ;GET PUT POINTER MOV M,C ;STORE COLUMN NUMBER DCX H ;DECREMENT TO NEXT POSITION  XRA B ;RESTORE NEW STATE MOV M,A ;STORE NEW STATE IN BUFFER MOV B,A ;SAVE CHANGED BITS IN B-REG  MVI A,KEYBFL  CMP L ;REACHED END OF BUFFER?  JNZ KBM110 ;NO - CHECK FOR BUFFER FULL  MVI L,KEYBFL+KEYBLN ;YES - RESET POINTER KBM110 EQU $  DCX H ;DECREMENT TO NEXT POSITION  LDA KBGTPT  CMP L ;BUFFER FULL?  JZ KBM120 ;YES - DON'T UPDATE POINTERS SHLD KBPTPT ;NO - UPDATE POINTERS  XCHG  MOV M,B ;UPDATE STATE TABLE KBM120 EQU $  EI ;RE-ENABLE INTERRUPTS  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ;  ; GTKYNM - GET KEY NUMBER ; ; ENTRY: B = KEY BIT IN COLUMN; E = COLUMN NUMBER; ; EXIT : A = E = KEY NUMBER ; L = KBKNSV-KBSTOR; GTKYNM EQU $  MOV A,E ;MULTIPLY COLUMN NUMBER  RLC ;BY 8  RLC RLC MOV E,A ;PUT PRODUCT INTO E  DCR E ;ADJUST TO INITIAL VALUE MOV A,B ;PUT KEY BIT IN A ;  ; ADD IN BIT NUMBER ; GTN010 EQU $  INR E ;INCREMENT COUNT RRC ;BIT FOUND?  JNC GTN010 ;NO - CONTINUE COUNTING  MOV A,E ;YES - PUT RESULT IN A LXI H,KBKNSV ;SET H,L TO REPEATING KEY #  RET ;RETURN  ;********************************************** ; SETRPT - SET REPEAT TIMER FOR FUNCTION KEYS * ;********************************************** ; ENTRY: A = KEYBOARD CHARACTER ; ; EXIT : KBTIMR = DELAY FOR REPEAT ; B,H,L DESTROYED ; SETRPT EQU $  LXI H,KBTIMR ;SET H,L TO REPEAT TIMER MVI B,LNGDLY ;SET B FOR LONG DELAY TIME CPI ENTRCD ;ENTER KEY?  JZ STR020 ;YES - SET FOR LONG DELAY  CPI EXFNLM ;EXTERNAL FUNCTION?  RM ;YES - SET NO REPEAT MOV M,B ;SET FOR LONG START DELAY  CPI 301Q ;CURSOR CONTROL? RM ;NO - RETURN LONG DELAY  CPI 305Q JM STR010 ;YES - SET SHORT DELAY CPI 323Q ;ROLL UP OR ROLL DOWN? RM ;NO - RETURN LONG DELAY  CPI 325Q RP ;NO - RETURN LONG DELAY STR010 EQU $ ;YES - SET FOR SHORT REPEAT  MVI B,SRTDLY ;START DELAYSTR020 EQU $  MOV M,B ;SET REPEAT TIMER  RET ;RETURN  ;******************************************** ; KBCTL - PERFORM KEYBOARD CONTROL FUNCTION * ;******************************************** ; ; ENTRY: A = CONTROL CODE ; ; EXIT : DETERMINED BY INDIVIDUAL CONTROL  ; ROUTINES ; GENERALLY D-L REGISTERS ARE SAVED; AND A-C DESTROYED; KBCTL EQU $  CPI KBCTLM+1 ;CONTROL CODE WITHIN RANGE?  RNC ;NO - EXIT IMMEDIATELY PUSH H ;YES - SAVE THE WORKING  PUSH D ;REGISTERS ADD A ;DOUBLE THE PARAMETER VALUE  MOV E,A ;COMPUTE CONTROL VECTOR  MVI D,0 ;LOCATION  LXI H,KBCTAB-2  DAD D  MOV E,M ;FETCH THE CONTROL VECTOR  INX H  MOV H,M  MOV L,E  POP D ;RECALL D AND E  PCHL ;GO TO CONTROL ROUTINE;  ; CONTROL VECTORS ; KBCTAB EQU $  DW LOKKBD ;1 - LOCK KEYBOARD DW UNLKBD ;2 - UNLOCK KEYBOARD DW RPTKEY ;3 - REPEAT LAST KEY HIT DW STBLMD ;4 - SET PERMANENT BLOCK MOD DW STRTST ;5 - SELF-TEST START DW ENDTST ;6 - SELF-TEST END DW RSETKB ;7 - RESET KEYBOARD  DW CKIOKY ;8 - CHECK FOR I/O KEY DW STPRPT ;9 - STOP KEY REPEAT DW CKBRKY ;10 - CHECK FOR BREAK KEY ;******************************** ; UNSUPPORTED CONTROL FUNCTIONS * ;******************************** ; DFAD SWCHAR 11 - SWITCH CHARACTER SET ; DFAD SETFRN 12 - UPDATE FOREIGN MODE; DFAD STCHST 13 - SET FOREIGN MODE OUTPUT; DFAD FRNMD1 14 - SET FOREIGN MODE 1 ; DFAD FRNMD2 15 - SET FOREIGN MODE 2 ; ZSTRTS EQU 5 ;SELF-TEST START CONTROLKBCTLM EQU 10 ;KEYBOARD CONTROL LIMIT  ; ; LOKKBD - LOCK THE KEYBOARD ; LOKKBD EQU $  XRA A ;CLEAR THE REPEAT TIMER  STA KBTIMR LDA KBFLGS  ANI 377Q-RPTKY ;CLEAR REPEAT KEY FLAG ORI KBLOCK ;AND SET LOCKED FLAG STA KBFLGS ; KBCTX1 EQU $  POP H ;RESTORE H AND L RET ;RETURN ; ; UNLKBD - UNLOCK KEYBOARD ; UNLKBD EQU $  MVI A,377Q-KBLOCK ;CLEAR KEYBOARD LXI H,KBFLGS ;CLEAR KEYBOARD FLAG ANA M  MOV M,A  POP H ;RESTORE H AND L RET ;RETURN ; ; STBLMD - SET PERMANENT BLOCK MODE; STBLMD EQU $  LXI H,KBFLGS ;SET PERMANENT BLOCK MODE  MOV A,M ;FLAG  ORI PERMBM  MOV M,A  LXI H,MDFLG2 ;SET BLOCK MODE FLAG MOV A,M  ORI BLKMDE  MOV M,A  MVI A,HNDSHK+DC2SND  STA KBJ1MS ;SET JUMPER INHIBIT MASK MVI L,KBJMPR-CMSTOR  ORA M ;SET JUMPERS TO INHIBIT  MOV M,A ;ALL TOP LEVEL HANDSHAKE POP H ;RESTORE H AND L RET ;RETURN  ; ; RPTKEY - REPEAT LAST KEY HIT ; RPTKEY EQU $  MVI A,RPTKY ;SET REPEAT KEY FLAG LXI H,KBFLGS ;SET KEYBOARD FLAG ORA M  MOV M,A  POP H ;RESTORE H AND L RET ;RETURN ;***************************; STRTST - SELF-TEST START *;***************************STRTST EQU $  LXI H,KBLEDS ;GET CURRENT LED'S STATE MOV A,M  CPI 377Q-BELLED ;ALL LIGHTS ON ALREADY? JZ KBCTX1 ;YES - DON'T CHANGE LED'S STA LEDSAV ;NO - SAVE CURRENT LED STAT MVI A,377Q-BELLED  MOV M,A ;FORCE ALL LED'S ON  STA IOKBLD  MVI L,CMFLGS-CMSTOR  MOV A,M ;TURN FORCE FULL RESET ORI FRCRST ;FLAG  MOV M,A  POP H ;RESTORE H AND LSTRTS1 EQU $ ;ENABLE RESET KEY  MVI A,RSTON STA IOKBCO  RET ;RETURN   ;************************* ; ENDTST - END SELF-TEST * ;************************* ENDTS0 EQU $ ;CHECK FOR SOFT RESET IN LXI H,KBLEDS ;PROGRESS  MOV A,M ;GET CURRENT LED SETTINGS  CPI 377Q-BELLED ;SOFT RESET IN PROGRESS?  RNZ ;NO - RETURN PUSH H ;YES - RESET LED'SENDTST EQU $  LXI H,CMFLGS  MOV A,M ;TURN OFF FORCE FULL RESET ANI 377Q-FRCRST ;FLAG MOV M,A  LDA LEDSAV ;RESTORE LED STATE STA KBLEDS ;************************** ; * "KBMON" WILL RESTORE *; * KEYBOARD LED'S WHEN *; * TIMER INTERRUTS OCCURS *; ************************** POP H ;RESTORE H AND L RET ;RETURN  ;*****************************************; RSETKB - RESET KEYBOARD FOR SOFT RESET *;*****************************************RSETKB EQU $  C@@ALL INITK0 ;INITIALIZE BUFFER POINTERS  LXI H,KBBUF ;TRANSFER VALUES FROM "REAL  LXI D,KBBUF2 ;TIME" STATE TABLE TO  MVI C,NUMCOL+1 ;CURRENTLY ACTIVE TABLE ; RSK010 EQU $  MOV A,M  STAX D  INX H  INX D  DCR C ;ALL ENTRIES DONE? JNZ RSK010 ;NO - CONTINUE TRANSFER ;  ; CLEAR KEYBOARD FLAGS ;  LXI H,KBFLGS ;YES - UNLOCK THE KEYBOARD MOV A,M  ANI 377Q-KBLOCK-RPTKY  MOV M,A  MVI L,KBLEDS-KBSSTR  MOV A,M ;TURN OFF RECORD, SELECT AND ANI 377Q-RECLED-SELLED-DSFLED  MOV M,A ;FUNCTIONS LED'S MVI L,BLKFLG-KBSSTR  MOV A,M ;STOP RECORD, SELECT AND ANI 377Q-RECLED-SELLED-DSFLED  MOV M,A ;FUNCTIONS BLINKING  LXI H,MDFLG1  MOV A,M ;TURN OFF RECORD, SELECT AND ANI 377Q-RECORD-SELECT-DSPFNC ;DISPLAY  MOV M,A ;FUNCTIONS MODE FLAGS  XRA A  STA INTFLG ;CLEAR INTERRUPT FLAG  STA KBTIMR ;STOP KEY REPEAT LXI H,CMFLGS ;CLEAR THE REMOTE SET FLAG MOV A,M ;TO FORCE DATA COMM RESET  ANI 377Q-REMSET  MOV M,A  CALL BELL ;SOUND THE BELL  JMP STRTST ;TURN ON ALL LED'S AND EXIT  ;*********************************************; CKIOKY - CHECK FOR I/O CONTROL (GREEN) KEY *;*********************************************; ; EXIT : Z - I/O CONTROL KEY NOT PRESSED; NZ - I/O CONTROL KEY PRESSED  ; A-E DESTROYED ; CKIOKY EQU $  LDA KBCHAR ;GET CURRENT KEYBOARD CHAR MOV H,A ;SAVE CHARACTER IN H-REGISTE; (CHARACTER RESTORED IN H; ON RETURN FROM "CKBRK1")  CALL CKBRK1 ;CLEAR KEYBOARD BUFFER LDA IOKYRW ;NO - GET I/O CNTRL KEY ROW  ANI IOKYCL ;I/O CONTROL KEY DOWN? JZ KBCTX1 ;NO - EXIT MVI A,LNGDLY ;YES - RESTORE REPEAT TIMER  STA KBTIMR  MOV A,H ;RESTORE ORIGINAL KEYBOARD LXI H,KBCHAR ;CHARACTER MOV M,A  CPI TEST ;CURRENT KEY = TEST? LDA IOKYRW ;(SET FOR ALTERNATE SELF-  LXI D,ENTCOL*256+ENTRCD ;TEST CHECK)  JZ CKI010 ;YES - CHECK FOR ENTER KEY LDA TSTROW ;NO - CHECK FOR TEST KEY LXI D,TSTCOL*256+TEST ; ; CHECK FOR ALTERNATING SELF-TEST; CKI010 EQU $  CMA ;INVERT KEYBOARD ROW SETTING ANA D ;OTHER SELF-TEST KEY DOWN? JNZ KBCTX1 ;NO - EXIT MOV M,E ;YES - SET ALTERNATE TEST KE ORA E ;SET Z FALSE POP H ;RESTORE H AND L RET ;RETURN Z FALSE ;***************************; STPRPT - STOP KEY REPEAT *;***************************STPRPT EQU $  XRA A ;ZERO REPEAT TIMER STA KBTIMR  POP H ;RESTORE H AND L RET ;RETURN  ;***************************; CHECK FOR BREAK KEY DOWN *;***************************; ; EXIT : Z - BREAK KEY NOT DOWN ; NZ - BREAK KEY DOWN; CKBRKY EQU $  POP H ;POP OFF H AND L XRA A ;CHECK HARDWARE LATCHES  STA IOKBCL ;FOR BREAK KEY DOWN  LDA IOKB+BRKYRN  ANI BRKCOL ;BREAK KEY DOWN? RZ ;NO - RETURN FAIL CKBRK1 EQU $ ;YES - CLEAR KEYBOARD BUFFERCKB010 EQU $  CALL GTKEY ;ANY KEY HIT?  INR A ;(ADJUST FOR LOCKED KEYBD) JNZ CKB010 ;YES - CONTINUE UNTIL NONENZEXIT EQU $ ;NON-ZERO EXIT INR A ;NO - FORCE Z-FALSE  RET ;RETURN NZ ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; SETMD1 - SET MODE 1 FLAGS; ; ENTRY: A = FLAG BIT TO BE SET ; B = 377B, BLINK ASSOCIATED LED ; = 0, DON'T BLINK LED ; ; EXIT : A,C DESTROYED; ASSOCIATED LED, IF ANY, IS SET ON; SETMD1 EQU $  PUSH H ;SAVE H,L  MOV C,A ;SAVE BIT TO BE SET  LXI H,MDFLG1  ORA M ;SET THE FLAG  MOV M,A ;STORE UPDATED FLAGS CALL FNDLED ;LOCATE ASSOCIATED LED MOV C,A ;SAVE LED BIT  DI ;DISABLE INTERRUPTS  ORA M ;ADD BIT TO LED CONTROL WORD MOV M,A ;STORE NEW CONTROL WORD  EI ;RE-ENABLE INTERRUPTS  MOV A,C ;RECALL LED BIT  LXI H,BLKFLG ;SET H,L TO BLINK FLAG INR B ;SET LED BLINKING? JZ ST1010 ;YES - SET BLINK BIT CMA ;NO - SET A TO CLEAR MASK  ANA M ;CLEAR BLINK FLAG  JMP ST1020 ;GO UPDATE BLINK FLAG ; ST1010 EQU $  ORA M ;SET BLINK BITST1020 EQU $  MOV M,A  DI ;DISABLE INTERRUPTS  CALL ENDTS0 ;CHECK SOFT RESET IN PROGRES ORA M ;TURN ALL BLINKING LED'S ON  MOV M,A  EI ;RE-ENABLE INTERRUPTS  POP H ;RESTORE H,L RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; CLRMD1 - CLEAR MODE 1 FLAG ; ; ENTRY: A = FLAG BIT TO BE CLEARED ; ; EXIT : A,C DESTROYED; ASSOCIATED LED, IF ANY, IS SET OFF ; ; INTERRUPT SYSTEM IS DISABLED AND ENABLED ; AGAIN; CLRMD1 EQU $  PUSH H ;SAVE H,L  MOV C,A ;SAVE BIT TO BE CLEARED  LXI H,MDFLG1  CMA ;COMPLEMENT TO GET CLEAR MAS ANA M ;CLEAR THE BIT MOV M,A  CALL FNDLED ;LOCATE ASSOCIATED LED CMA ;COMPLEMENT TO GET CLEAR MAS MOV C,A ;SAVE CLEAR PATTERN  LXI H,BLKFLG ;CLEAR BLINK FLAG IN CASE  ANA M ;LED WAS BLINKING  MOV M,A  DI ;DISABLE INTERRUPTS  CALL ENDTS0 ;CHECK SOFT RESET IN PROGRES ANA C ;CLEAR LED BIT MOV M,A  EI ;ENABLE INTERRUPTS POP H ;RESTORE H,L RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FNDLED - FIND LED BIT ASSOCIATED WITH ; MODE 1 FLAGS ; ; ENTRY: C = MODE 1 FLAG BIT TO BE USED ; ; EXIT : A = ASSOCIATED LED BIT ; ; H,L = KBLEDS ; FNDLED EQU $  MOV A,C ;PUT BIT INTO A  LXI H,LEDTAB-1 ;SET INITIAL TABLE ADDRESS; FLD010 EQU $  INX H ;ADVANCE TO NEXT TABLE ENTRY RRC ;BIT FOUND?  JNC FLD010 ;NO - GO TO NEXT ENTRY MOV A,M ;YES - GET TABLE ENTRY LXI H,KBLEDS ;SET H,L TO LED CONTROL WORD RET ;RETURN ;  ; LED ASSOCIATION TABLE ; LEDTAB EQU $ ;BIT FUNCTION DB DSFLED ;0 - DISPLAY FUNCTIONS  DB ICHLED ;1 - INSERT CHARACTER DB MLKLED ;2 - MEMORY LOCK  DB 0 ;3 - FORMAT MODE  DB EDTLED ;4 - EDIT MODE  DB SELLED ;5 - SELECT MODE  DB RECLED ;6 - RECORD MODE  DB 0 ;7 - UNUSED ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; BELL - SOUND THE KEYBOARD BELL ;  ; ENTRY: DON'T CARE ;  ; EXIT : A DESTROYED ; Z FALSE ; BELL EQU $  LDA KBLEDS ;GET CURRENT LED SETTINGS  ORI BELLED ;ADD CONTROL TO SOUND BELL STA IOKBLD ;SOUND THE BELL  RET ;RETURN ;******************************** ; SETXMT - TURN ON TRANSMIT LED * ;******************************** ;  ; EXIT : Z = TRUE ; SETXMT EQU $  MVI A,XMTLED ;SET TRANSMIT LED BIT  LXI H,KBLEDS ;SET H,L TO LED STATE WORD ORA M ;ADD TRANSMIT LED BIT  MOV M,A ;UPDATE LED STATE  CMP A ;SET Z TRUE  RET ;RETURN ;*********************************; CLRXMT - TURN OFF TRANSMIT LED *;*********************************CLRXMT EQU $  LXI H,KBLEDS  MOV A,M ;GET CURRENT LED SETTINGS  CPI 377Q-BELLED ;SET FOR TEST MODE? RZ ;YES - RETURN  ANI 377Q-XMTLED ;NO - CLEAR TRANSMIT  MOV M,A ;LED RET ;RETURN  ;***********************************************; STJMPR - SET KEYBOARD JUMPER ESCAPE SEQUENCE *;***********************************************STJMPR EQU $  LHLD KBJMP2 ;INITIALIZE PARAMETER VALUES SHLD PARM2 LDA KBJMP3 STA PARM3  LXI H,STJTAB ;SET ESC SEQ RANGE TABLE ADD;********************************************** ; SET RANGE TABLE AND CLEAR INPUT ACCUMULATOR * ;********************************************** STJMP1 EQU $  MVI A,DECRDX ;SET INPUT RADIX AS DECIMAL  STA RADIX  SHLD RNGTA ;SET NEW RANGE TABLE VALUESTJMP2 EQU $  LXI H,0 ;CLEAR INPUT ACCUMULATOR SHLD IODATA STJMP3 EQU $ ;CONTINUE ESCAPE SEQUENCE  MVI A,2 ;SET ESC SEQ FLAG TO INDICAT STA ESCFLG ;ESC SEQ IN PROGRESS RET ;RETURN TO WAIT LOOP ;*************************************; PARAMETER RECEIVED - SET ITS VALUE *;*************************************; ; ENTRY: B = 1; C = INPUT CHARACTER ; H = BASEH ; STJ100 EQU $ ;ENTRY FOR INPUTS P-Z  DCR B ;SET ADJUSTMENT FACTORSTJ110 EQU $ ;ENTRY FOR INPUTS J-N  DCR B ;SET ADJUSTMENT FACTORSTJ120 EQU $ ;ENTRY FOR INPUTS A-H  MOV A,C ;PUT INPUT CHAR IN A-REG ANI 377Q-40Q ;FORCE TO UPPER CASE VALUE SUI A+1 ;SET TO RANGE 0-23 ADD B ;ADD IN ADJUSTMENT FOR; MISSING LETTERS (I, O) CALL STPARM ;SET THE PARAMETER MOV A,C ;RECALL INPUT CHARACTER  ANI 40Q ;IS IT UPPER CASE? JNZ STJMP2 ;NO - CLEAR INPUT ACCUMULATO; AND CONTINUE ESCAPE SEQ ;  LXI D,PARM1 ;NO - SET KEYBOARD STRAPS  LXI H,KBJMPR ;(D,E=SOURCE; H,L=DEST)  LDA KBJ1MS ;GET INHIBIT MASK  CALL STBITS ;SET JUMPER 1 VALUES;  LDA DCJMS2 ;GET JUMPER 2 INHIBIT MASK CALL STBITS ;SET JUMPER 2 VALUES;  LDA DCJMSK ;GET JUMPER 3 INHIBIT MASK JMP STBITS ;SET JUMPER 3 VALUES AND EXI ;*****************************************; SET JUMPER ESCAPE SEQUENCE RANGE TABLE *;*****************************************STJTAB EQU $-3  DB 101Q,110Q ;UPPER CASE -  DW STJ120+B15 ;SET APPROPRIATE PARAMETER;  DB 112Q,116Q ;UPPER CASE -  DW STJ110+B15 ;SET APPROPRIATE PARAMETER;  DB 120Q,132Q ;UPPER CASE

-  DW STJ100+B15 ;SET APPROPRIATE PARAMETER;  DB 141Q,150Q ;LOWER CASE -  DW STJ120+B15 ;SET APPROPRIATE PARAMETER;  DB 152Q,156Q ;LOWER CASE -  DW STJ110+B15 ;SET APPROPRIATE PARAMETER;  DB 160Q,172Q ;LOWER CASE

-  DW STJ100+B15 ;SET APPROPRIATE PARAMETER;*************************************************; STKTAB - SET LATCHING KEYS ESC SEQ RANGE TABLE *;*************************************************STKTAB EQU $-3  DB 40Q,40Q ;SPACE DW STJMP3+B15 ;IGNORE ;  DB 60Q,61Q ;NUMBERS <0> AND <1> DW ZDCNUM+B15 ;ACCUMULATE INPUT VALUE ;  DB 101Q,103Q ;UPPER CASE -  DW STK020+B15 ;SET APPROPRIATE PARAMETER;  DB 122Q,122Q ;UPPER CASE  DW STK010+B15 ;SET REMOTE FLAG;  DB 141Q,143Q ;LOWER CASE -  DW STK020+B15 ;SET APPROPRIATE PARAMETER;  DB 162Q,162Q ;LOWER CASE  DW STK010+B15 ;SET REMOTE FLAG;  DB 0Q,177Q ;ALL OTHER CODES DW ZESCND+B15 ;ABORT ESCAPE SEQUENCE ;*********************************************; STLKYS - SET LATCHING KEYS ESCAPE SEQUENCE *;*********************************************STLKYS EQU $  LDA MDFLG2 ;INITIALIZE PARAMETER VALUE  STA PARM1  LXI H,STKTAB ;PUT RANGE TABLE ADDR IN H,L JMP STJMP1 ;EXIT TO WAIT LOOP;**************************************** ; REMOTE FLAG PARAMETER - SET BIT VALUE * ;**************************************** STK010 EQU $  MVI A,REMBIT ;PUT BIT NUMBER IN A-REGISTE JMP STK050 ;SET THE BIT VALUE;************************************************ ; INPUT PARAMETER RECEIVED - SET PARAMETER MASK * ;************************************************ STK020 EQU $  LXI H,PARM1 ;SET H,L TO PARAMETER ADDRES MVI A,A+2 ;COMPUTE BIT INDEX:  SUB C ;=2, =1, =0; STK050 EQU $  CALL STPAR1 ;SET PARAMETER MASK  MOV A,C ;RECALL INPUT CHARACTER  ANI 40Q ;UPPER CASE CHARACTER? JNZ STJMP2 ;NO - CLEAR ACCUMULATOR AND ; CONTINUE ESCAPE SEQUENCE LXI D,PARM1 ;YES - SET LATCHING KEYS LXI H,MDFLG2 ;(D,E=SOURCE; H,L=DEST)  LDAX D ;GET INPUT PARAMETER LDA KBFLGS ;EXTRACT INHIBIT MASK  ANI PERMBM ;(PERMANENT BLOCK MODE) ; FALL INTO EVALUATION ROUTINE; AND EXIT ;*********************************************; STBITS - SET FLAG BITS FROM PARAMETER MASK *;*********************************************; ; ENTRY: A = CHANGE INHIBIT MASK; BIT SET TO 1 TO INHIBIT CHANGES; D,E = INPUT PARAMETER; H,L = WORD TO BE SET ;  ; EXIT : A,B DESTROYED ; (H,L) UPDATED ; STBITS EQU $  CMA ;INVERT INHIBIT MASK MOV B,A ;SAVE INHIBIT MASK LDAX D ;GET PARAMETER VALUE XRA M ;EXTRACT CHANGES TO SETTINGS ANA B ;MASK OUT INHIBITED CHANGES  XRA M ;ALTER APPROPRIATE BITS  MOV M,A ;UPDATE CURRENT SETTINGS DCX D ;INCREMENT TO NEXT VALUES  DCX H  RET ;RETURN  ;****************************** ; STPARM - SET PARAMETER MASK * ;****************************** ; ; ENTRY: A = BIT/WORD INDEX  ; H = BASEH ; IODATA = PARAMETER VALUE ; ; EXIT : PARAMETER WORD MASK SET ; A,B,L DESTROYED ; STPARM EQU $  MOV B,A ;SAVE INDEX IN B-REGISTER  ANI 370Q ;MASK OUT 3 LEASE SIGNIFICAN RRC ;BITS AND DIVIDE BY 8 TO RRC ;DETERMINE WORD INDEX (0-2 RRC CMA ;SET TO NEGATIVE INDEX INR A  ADI PARM1-CMSTOR ;COMPUTE JUMPER WORD ADD MOV L,A ;PUT LSB INTO L (H = BASEH) ;*******************************; DETERMINE BIT TO BE MODIFIED *;******************************* MOV A,B ;RECALL CHARACTER INDEX STPAR1 EQU $  A@@NI 7Q ;EXTRACT BIT NUMBER  MOV B,A  MVI A,200Q ;SET INITIAL BIT LOCATION ; STP010 EQU $  RLC ;ROTATE ONE BIT LEFT DCR B ;BIT POSITION FOUND? JP STP010 ;NO - CONTINUE ROTATING  MOV B,A ;YES - SAVE BIT MASK IN B ;************************************************ ; DETERMINE WHETHER BIT IS TO BE SET OR CLEARED * ;************************************************  XCHG ;SAVE WORD ADDRESS IN D,E  LHLD IODATA ;GET PARAMETER VALUE MOV A,L  ORA H ;BIT TO BE SET?  XCHG ;(RESTORE H,L) MOV A,B ;(RECALL BIT TO MODIFY)  JZ STP020 ;NO - SET PARM BIT TO CLEAR  ORA M ;YES - ADD BIT TO PARAMETER  MOV M,A ;SET PARAMETER RET ;RETURN   ;************************* ; CLEAR BIT IN PARAMETER * ;************************* STP020 EQU $  CMA ;SET TO CLEAR MASK ANA M ;CLEAR BIT FROM PARAMETER  MOV M,A ;SET PARAMETER RET ;RETURN  ;****************************************** ; ALPCHK - CHECK FOR ALPHA TYPE CHARACTER * ;****************************************** ALPCHK EQU $  CPI ABLNK ;IS CHARACTER A BLANK? RZ ;YES - RETURN OK (Z TRUE)  ANI 377Q-40Q ;NO - FORCE TO UPPER CASE  CPI A ;IS IT ABOVE LETTER A? RM ;NO - RETURN FAIL (Z FALSE)  CPI Z ;IS IT Z OR ABOVE  RP ;YES - RETURN (Z TRUE IF =)  CMP A ;NO - SET Z TRUE RET ;RETURN GOOD (Z TRUE) ;******************************************** ; NUMCHK - CHECK FOR NUMERIC TYPE CHARACTER * ;******************************************** NUMCHK EQU $  CPI ABLNK ;IS CHARACTER A BLANK? RZ ;YES - RETURN OK (Z TRUE)  CPI PLUS ;BELOW PLUS? RC ;YES - RETURN FAIL CPI SLANT ;SLANT CHARACTER?  JZ NZEXIT ;YES - RETURN FAIL CPI ZERO+9 ;NINE OR BELOW?  RP ;NO - RETURN (Z TRUE IF =) CMP A ;YES - SET Z TRUE  RET ;RETURN  ENDUI A+1 ;SET TO RANGE 0-23 ADD B ;ADD IN ADJUSTMENT FOR; MISSING LETTERS (I, O) CALL STPARM ;SET THE PARAMETER MOV A,C ;RECALL INPUT CHARACTER  ANI 40Q ;IS IT UPPER CASE? JNZ STJMP2 ;NO - CLEAR INPUT ACCUMULATO; AND CONTINUE ESCAPE SEQ ;  LXI D,PARM1 ;NO - SET KEYBOARD STRAPS  LXI H,KBJMPR ;(D,E=SOURCE; H,L=DEST)  LDA KBJ1MS ;GET INHIBIT MASK  CALL STBITS ;SET JUMPER 1 VALUES;  LDA DCJMS2 ;GET JUMPER 2 INHIBIT MASK CALL STBITS ;SET JUMPER 2 VALUES;  LDA DCJMSK ;GET JUMPER 3 INHIBIT MASK JMP STBITS ;SET JUMPER 3 VALUES AND EXI ;*****************************************; SET JUMPER ESCAPE SEQUENCE RANGE TABLE *;*****************************************STJTAB EQU $-3  DB 101Q,110Q ;UPPER CASE -  DW STJ120+B15 ;SET APPROPRIATE PARAMETER;  DB 112Q,116Q ;UPPER CASE -  DW STJ110+B15 ;SET APPROPRIATE PARAMETER;  DB 120Q,132Q ;UPPER CASE

-  DW STJ100+B15 ;SET APPROPRIATE PARAMETER;  DB 141Q,150Q ;LOWER CASE -  DW STJ120+B15 ;SET APPROPRIATE PARAMETER;  DB 152Q,156Q ;LOWER CASE -  DW STJ110+B15 ;SET APPROPRIATE PARAMETER;  DB 160Q,172Q ;LOWER CASE

-  DW STJ100+B15 ;SET APPROPRIATE PARAMETER;*************************************************; STKTAB - SET LATCHING KEYS ESC SEQ RANGE TABLE *;*************************************************STKTAB EQU $-3  DB 40Q,40Q ;SPACE DW STJMP3+B15 ;IGNORE ;  DB 60Q,61Q ;NUMBERS <0> AND <1> DW ZDCNUM+B15 ;ACCUMULATE INPUT VALUE ;  DB 101Q,103Q ;UPPER CASE -  DW STK020+B15 ;SET APPROPRIATE PARAMETER;  DB 122Q,122Q ;UPPER CASE  DW STK010+B15 ;SET REMOTE FLAG;  DB 141Q,143Q ;LOWER CASE -  DW STK020+B15 ;SET APPROPRIATE PARAMETER;  DB 162Q,162Q ;LOWER CASE  DW STK010+B15 ;SET REMOTE FLAG;  DB 0Q,177Q ;ALL OTHER CODES DW ZESCND+B15 ;ABORT ESCAPE SEQUENCE ;*********************************************; STLKYS - SET LATCHING KEYS ESCAPE SEQUENCE *;*********************************************STLKYS EQU $  LDA MDFLG2 ;INITIALIZE PARAMETER VALUE  STA PARM1  LXI H,STKTAB ;PUT RANGE TABLE ADDR IN H,L JMP STJMP1 ;EXIT TO WAIT LOOP;**************************************** ; REMOTE FLAG PARAMETER - SET BIT VALUE * ;**************************************** STK010 EQU $  MVI A,REMBIT ;PUT BIT NUMBER IN A-REGISTE JMP STK050 ;SET THE BIT VALUE;************************************************ ; INPUT PARAMETER RECEIVED - SET PARAMETER MASK * ;************************************************ STK020 EQU $  LXI H,PARM1 ;SET H,L TO PARAMETER ADDRES MVI A,A+2 ;COMPUTE BIT INDEX:  SUB C ;=2, =1, =0; STK050 EQU $  CALL STPAR1 ;SET PARAMETER MASK  MOV A,C ;RECALL INPUT CHARACTER  ANI 40Q ;UPPER CASE CHARACTER? JNZ STJMP2 ;NO - CLEAR ACCUMULATOR AND ; CONTINUE ESCAPE SEQUENCE LXI D,PARM1 ;YES - SET LATCHING KEYS LXI H,MDFLG2 ;(D,E=SOURCE; H,L=DEST)  LDAX D ;GET INPUT PARAMETER LDA KBFLGS ;EXTRACT INHIBIT MASK  ANI PERMBM ;(PERMANENT BLOCK MODE) ; FALL INTO EVALUATION ROUTINE; AND EXIT ;*********************************************; STBITS - SET FLAG BITS FROM PARAMETER MASK *;*********************************************; ; ENTRY: A = CHANGE INHIBIT MASK; BIT SET TO 1 TO INHIBIT CHANGES; D,E = INPUT PARAMETER; H,L = WORD TO BE SET ;  ; EXIT : A,B DESTROYED ; (H,L) UPDATED ; STBITS EQU $  CMA ;INVERT INHIBIT MASK MOV B,A ;SAVE INHIBIT MASK LDAX D ;GET PARAMETER VALUE XRA M ;EXTRACT CHANGES TO SETTINGS ANA B ;MASK OUT INHIBITED CHANGES  XRA M ;ALTER APPROPRIATE BITS  MOV M,A ;UPDATE CURRENT SETTINGS DCX D ;INCREMENT TO NEXT VALUES  DCX H  RET ;RETURN  ;****************************** ; STPARM - SET PARAMETER MASK * ;****************************** ; ; ENTRY: A = BIT/WORD INDEX  ; H = BASEH ; IODATA = PARAMETER VALUE ; ; EXIT : PARAMETER WORD MASK SET ; A,B,L DESTROYED ; STPARM EQU $  MOV B,A ;SAVE INDEX IN B-REGISTER  ANI 370Q ;MASK OUT 3 LEASE SIGNIFICAN RRC ;BITS AND DIVIDE BY 8 TO RRC ;DETERMINE WORD INDEX (0-2 RRC CMA ;SET TO NEGATIVE INDEX INR A  ADI PARM1-CMSTOR ;COMPUTE JUMPER WORD ADD MOV L,A ;PUT LSB INTO L (H = BASEH) ;*******************************; DETERMINE BIT TO BE MODIFIED *;******************************* MOV A,B ;RECALL CHARACTER INDEX STPAR1 EQU $  A ASB,HEX ;DC14F - 6/27/76 - 1000 HRS. ;**** THIS IS THE ROM VERSION *********** ; ; 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 TRANSMINOTEST EQU 4Q ;INHIBIT TERMINAL SELF-TEST EDTWRP EQU 10Q ;INVERT SENSE OF EDIT WRAPPRNTAL EQU 20Q ;SEND ALL CODES TO PRINTERDCJMP0 EQU 200Q ;DATA COMM JUMPER ;*****************************************; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *;*****************************************DCJMP1 EQU 1Q ;DATA COMM JUMPERSDCJMP2 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 AROUNDFRCRST EQU 4Q ;FORCE FULL TERMINAL RESETDEFSKY EQU 10Q ;DEFINE SOFT KEY MODE ENABLEREMSET EQU 20Q ;REMOTE MODE ENABLEDRCVMDE 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 INTERRUPTDCIOFF EQU 20Q ;DISABLE DATA COMM INTERRUPTTMIOFF 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 ENABLEDINSCHR EQU 2Q ;INSERT CHARACTER ENABLED MEMLOK EQU 4Q ;MEMORY LOCK ENABLEDFORMAT EQU 10Q ;FORMAT MODE ENABLEDEDIT EQU 20Q ;EDIT MODE ENABLEDSELECT EQU 40Q ;SELECT MODE ENABLEDRECORD EQU 100Q ;RECORD MODE ENABLEDFORGN EQU 200Q ;FOREIGN MODE ENABLED ;*********************************; MDFLG2 - TERMINAL MODE FLAGS 2 *;*********************************CAPSLK EQU 1Q ;CAPS LOCK ENABLEDBLKMDE EQU 2Q ;BLOCK MODE ENABLED AUTOLF EQU 4Q ;AUTO LF ENABLEDREMOTE EQU 10Q ;REMOTE ENABLED WBSR EQU 40Q ;WRITE-BACKSPACE-READ MODE;********************************************** ; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * ;********************************************** DECRDX EQU 10 ;DECIMAL NUMBERSOCTRDX EQU 8 ;OCTAL NUMBERS  ;******************* ; COMMON VARIABLES * ;******************* INTVEC EQU FSTRAM+145Q ;CENTRAL INTERRUPT VECTORSCNVEC EQU INTVEC+3 ;FOREIGN TERMINAL DISPLY SCA; COMMON EQU 177777Q ;UPPER LIMIT OF COMMON AREA CMBASE EQU COMMON/256 ;MSB OF COMMON ADDRESSESCMSTOR EQU CMBASE*256 ;MSB ADJUSTMENT FACTOR; DISPST EQU COMMON-1 ;DISPLAY REFRESH START PTRTRMTYP EQU DISPST-1 ;TERMINAL TYPE NUMBER KBDCSW EQU TRMTYP-1 ;KEYBOARD DATACOM SWITCHESKBJMPR EQU KBDCSW-1 ;KEYBOARD STRAPSKBJMP2 EQU KBJMPR-1 ;SET 2KBJMP3 EQU KBJMP2-1 ;SET 3CMFLGS EQU KBJMP3-1 ;COMMON FLAGS ERRFLG EQU CMFLGS-1 ;ERROR FLAGSINTFLG EQU ERRFLG-1 ;INTERRUPT FLAG PRCCTL EQU INTFLG-1 ;PROCESSOR CONTROL FLAGSMDFLG1 EQU PRCCTL-1 ;TERMINAL MODE FLAGS 1MDFLG2 EQU MDFLG1-1 ;AND 2MSGPT1 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 PARAMETERSRNGTA EQU RADIX-2 ;CHAR FUNCTION TABLE ADDRESSESCFLG EQU RNGTA-1 ;ESCAPE SEQUENCE FLAG ; = 0, NOT IN ESCAPE SEQ; # 0, ESC SEQ IN PROGRESSRSTTMR EQU ESCFLG-1 ;SOFT RESET TIMER ; * * * * * * * * * * * * * * * * * * * * * * * * ; END OF COMMON EQUATES * ;^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*  ;*******************************; DCSTAT - DATACOM STATUS BITS *;*******************************DCDP EQU 1Q ;DATA PRESENT DCTBE EQU 002Q ;TRANSMIT BUFFER EMPTYDCOE EQU 004Q ;OVERRUN ERRORDCPE EQU 010Q ;PARITY ERROR ; ; ; THE FOLLOWING ARE INTERPRETED AS 0 = ON AND; 1 = OFF; DCCF EQU 20Q ;CF - RECEIVED CARRIERDCCB EQU 40Q ;CB - CLEAR TO SEND DCSB EQU 100Q ;SB - SECONDARY RECEIVED DAT; DCCC EQU 200Q ;CC - DATA SET READY? ;  ;************************* ; DCFLGS - DATACOM FLAGS * ;************************* DCCA EQU 1 ;REQUEST TO SEND (0 = SET)TRNMOD EQU 2 ;TRANSPARENT MODE BINMOD EQU 4 ;BINARY MODEGOBIN EQU 10Q ;GO TO BINARY MODE ON ENQ-ACFB9600 EQU 20Q ;FAS@@T BINARY MODE MCMOD EQU 40Q ;MAIN CHANNEL (0 = ENABLED) SPECHO EQU 100Q ;ECHO SUPPRESS (1 = ENABLED)FORPAR EQU 200Q ;FORCE PARITY MODE  ;********************* ; I/O MODULE EQUATES * ;********************* IOBASE EQU 200Q ;I/O ADDRESS MSB'SPROCSR EQU 160Q ;PROCESSOR PORT ;***********; KEYBOARD *;***********IOKB EQU (3Q+IOBASE)*256;MODULE 11 BASE ADDRESSIOKBLD EQU IOKB+0Q ;SET KEYBOARD LED'S;********** ; DATACOM * ;********** IODC EQU (1Q+IOBASE)*256;MODULE 10 BASE ADDRESS;  ; INPUT ADDRESSES ; IODCDI EQU IODC+0Q ;DATACOM DATA INIODCST EQU IODC+40Q ;DATACOM STATUS INIODCS2 EQU IODC+41Q ;STATUS W/TBE = THRE AND TREIODCPC EQU IODC+100Q ;DATACOM STRAPS IN DCCTL2 EQU IODC+140Q ;ALTERNATE DATACOM CONTROL ;  ; OUTPUT ADDRESSES ; IODCCT EQU IODC+100Q ;DATACOM CONTROL OUT IODCDO EQU IODC+140Q ;DATACOM DATA OUT;  ; DATACOM CONTROL BITS ; B9600 EQU 16Q ;9600 BAUDDCSA EQU 100Q ;TURN ON SECONDARY TRANSMIT DCOP EQU 0 ;ODD PARITY DCEP EQU 20Q ;EVEN PARITYDCNP EQU 40Q ;NO PARITY; CDOFF EQU 10Q ;TURN OFF CD (USE W/DCCTL2) DCCH EQU 200Q ;CH BIT IN CONTROLBAUDPT EQU 076Q ;BAUD RATE/PARITY MASK ; ; KEYBOARD ENTRY VECTOR POINTERS ; ZKBBAS EQU 44000Q ;KEYBOARD START ADDRESS ZINIKB EQU ZKBBAS+2 ;INITIALIZE KEYBOARDZGETKY 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 ;SET TRANSMIT LED ZCLXMT EQU ZSTXMT+3 ;CLEAR TRANSMIT LED   ;************************ ; MISCELLANEOUS EQUATES * ;************************ JMP EQU 303Q ;"JMP" CODE ;************************** ; ASCII CHARACTER EQUATES * ;************************** ANULL EQU 0Q ;NULL SOH EQU 1Q ;START OF HEADERSTX EQU 2Q ;START OF TEXTETX EQU 3Q ;END OF TEXTEOT EQU 4Q ;END OF TRANSMISSIONLF EQU 12Q ;LINE FEEDCR EQU 15Q ;CARRIAGE RETURNENQ EQU 5Q ACK EQU 6Q DC2 EQU 22Q ;DEVICE CNTL 2ACAN EQU 30Q ;CANCEL LINERS EQU 36Q ;RECORD SEPARATOR ADEL EQU 177Q ;DELETE (RUBOUT);************************** ; DISPLAY CONTROL EQUATES * ;************************** NORMAL EQU 200Q ;START NORMAL VIDEO INVRS EQU 202Q ;START INVERSE VIDEOEOL EQU 314Q ;END OF LINE FLAG EOP EQU 316Q ;END OF PAGE FLAG ;************************** ; DATACOM LOCAL VARIABLES * ;**************************  DCSTOR EQU FSTRAM+300Q DCBASE EQU DCSTOR/256 DCSTAT EQU DCSTOR-1 ;DATACOM STATUS BITSDCBPTR EQU DCSTAT-2 ;DATACOM BUFFER UNLOAD PTRDCSPTR EQU DCBPTR-2 ;DATACOM LOAD POINTER DCBFBG EQU DCSPTR-2 ;START ADDR OF DATACOM BUFFEDCFLGS EQU DCBFBG-1 ;CONTAINS FOLLOWING FLAGS:DCMVEC EQU DCFLGS-2 ;DATACOM MONITOR VECTOR DCMJMP EQU DCMVEC-1 ;JUMP CODE FOR VECTOR XMTDLY EQU DCMJMP-1 ;LIMIT FOR XMIT TURNAROUNDDCDLAY EQU XMTDLY-1 ;DELAY FOR SIGNAL SETTLINGDCTEX EQU DCDLAY-2 ;TURNAROUND EXIT ADDRESSTPARIT EQU DCTEX-1 ;SELF TEST, PARITYTMOCNT EQU TPARIT-1 ;SELF TEST, TIME OUT COUNTERFPMASK EQU TMOCNT-1 ;FORCE PARITY MASK ENDCHR EQU FPMASK-1 ;END OF DATA CHAR FOR MCDCCT EQU ENDCHR-1 ;CONTROL WD FOR CH,CA,NP; DCBFSZ EQU 96 ;DATACOM BUFFER SIZEGPASYC EQU 200Q ;GENARAL PURPOSE ASYNC FLAG  ; ; NEW STRAPPING OPTIONS WHEN 202C MAIN CHANNEL ; PROTOCOL IS DESIRED. THESE STRAPS ARE ; AVAILABLE FROM THE NEW KEYBOARD I/F AND; ARE SWITCHES R - Z WHICH ARE CURRENTLY; NOT USED BY THE FIRMWARE FOR DATACOM.; SBSTRP EQU 200Q ;(R) 0 = ENABLE CIRCUIT ASSURANCE ; (SB); 1 = DISABLE CIRCUIT ASSURANCE ; STXSTP EQU 1Q ;(S) 0 = USE STX FOR STRT OF DATA ; 1 = NO START OF DATA CHAR ; ETXSTP EQU 2Q ;(T) 0 = USE EOT FOR END OF DATA; 1 = USE ETX FOR END OF DATA ; ; MNCHAN EQU 3Q ;00 = NON-MAIN CHANNEL PROTCL ; 01 = MAIN CHNL W/O SD,ED = EOT; 10 = MAIN CHNL W/STX AS SD, ; 11 = MAIN CHNL W/ETX AS ED; CBKSTP EQU 4Q ;(U) 0 = ENABLE CPU BREAK ON SB ; 1 = DISABLE CPU BREAK ; CFSTRP EQU 10Q ;(V) 0 = ENABLE CF DETECT ; 1 = DISABLE CF DETECT ; ;NODCST EQ 20B (W) 0 = ENABLE DC SELF TEST ; 1 = DISABLE DC SELF TEST; ;SETCH EQU 40B (X) 0 = SET CH OFF; 1 = SET CH ON ; ;CHEKCC EQ 100B (Y) 0 = USE CB FOR XMIT LED ; 1 = USE CC FOR XMIT LED ; ;FRCPTY EQ 200B (Z) 0 = DISABLE FORCE PARITY; 1 = ENABLE FORCE PARITY ; ; ;   ORG 50000Q ;START IN ITS OWN BLOCK ;  DB 'P' ;VALID ROM ID  DB 50000Q/256 TRIGGR:DB 021Q ;DC1 FOR TRANSFER TRIGGER RECSEP:DB 037Q ;US FOR RECORD SEPARATORBLKTRM:DB 036Q ;RS FOR BLOCK TERMINATORDCJMSK:DB 003Q ;DATA COMM JUMPER ALTER ; INHIBIT MASK - SET TO 1 ; IN APPROPRIATE BIT (0-7); TO INHIBIT ALTERATION OF; JUMPERS S-Z BY ESCAPE ; SEQUENCE; SET TO INHIBIT S,TDCJMK2:DB 000Q ;STRAP R DB 00Q ;  ; DATACOM ENTRY VECTORS ;  JMP INITDC ;INITIALIZE DATACOM JMP INI2DC ;INITIALIZATION CONTINUATOR JMP DCMJMP ;GO TO MONITOR ROUTINE JMP DCCTL ;PERFORM CONTROL FUNCTIONS JMP DCTST ;DATACOOM SELF TEST  JMP GETDC ;GET A DATACOM CHARACTER JMP PUTDC ;OUTPUT A CHARACTER TO DATAC JMP GETBIN ;GET A BINARY BYTE XRA A  RET DB 0Q ;NOOP START BINARY ROUTINE JMP TRMBIN ;TERMINATE BINARY OUTPUT; ; DATACOM CONTROL CALL CODES ; CLRTRG EQU 0 ;CLEAR BLOCK TRANSFER TRIGGESETTRG EQU 1 ;SET BLOCK TRANSFER TRIGGER RSETDC EQU 2 ;RESET DATACOMSETREM EQU 3 ;SET REMOTE MODESETLCL EQU 4 ;SET LOCAL MODE PUTBRK EQU 5 ;OUTPUT BREAK SIGNALDISCNT EQU 6 ;MODEM DISCONNECT ENDBLK EQU 7 ;SEND ED IF MAIN CHANNELSETMON EQU 8 ;ENTER MONITOR MODE SETNRM EQU 9 ;ENTER NORMAL MODEPROMPT EQU 13 ;SEND DC2 PROMPT ; ;*******************************; DATACOM INTERRUPT PROCESSING *;*******************************DCINTR EQU $ PUSH PSW ;SAVE A,FLAGS  PUSH B ;SAVE B,C  LDA IODCST ;GET DATA COMM STATUS  MOV B,A ;SAVE STATUS IN B  ANI DCDP ;DATA PRESENT? JZ INT170 ;NO - EXIT PUSH H ;YES - SAVE H,L  LXI H,IODCDI ;GET DATA FROM DATA COMM MOV C,M ;INTO C-REGISTER LDA DCFLGS ;CURRENT MODE? MOV L,A ;SAVE DCFLGS ANI TRNMOD+BINMOD  JNZ INT020 ;TRANSPARENT OR BINARY - JUM MOV A,C ;ASCII - HANDLE PARITY ANI 177Q ;REMOVE PARITY BIT JZ INT160 ;RETURN IF NULL  CPI ADEL  JZ INT160 ;IGNORE RUBOUTS  MOV A,B ;GET PARITY BIT  ANI DCPE ;PARITY ERROR? JZ INT020 ;NO JMP  MOV A,L ;GET DCFLGS  ANI FORPAR ;IS FORCE PARITY IN EFFECT?  JZ INT050 ;NO - JMP PE ERRORINT020 EQU $ ;CHECK FOR BUFFER OVERWRITE  MOV A,B ;RECALL STATUS ANI DCOE ;OVERWRITE?  JZ INT100 ;NO - STORE CHAR;************************************************ ; DATA COMM ERROR - STORE ALL ONES AND SET FLAG * ;************************************************ INT050 EQU $ ;DATACOM ERROR MVI C,377Q ;STORE ALL ONES  LXI H,ERRFLG ;SET ERROR FLAG  MOV A,M  ORI DCMERR  MOV M,A  ;************************************** ; STORE CHARACTER IN DATA COMM BUFFER * ;************************************** INT100 EQU $ LHLD DCSPTR ;GET THE LOAD POINTER  LDA DCBFBG ;GET LSB OF BUFFER START ADD CMP L ;REACHED START OF BUFFER?  JNZ INT130 ;NO - STORE THE CHARACTER  MOV A,L ;YES - SET TO BUFFER END + 1 ADI DCBFSZ  MOV L,A  MOV A,H  ACI 0  MOV H,A ; INT130 EQU $  DCX H ;DECREMENT TO NEXT LOCATION  SHLD DCSPTR ;STORE THE NEW POINTER VALUE LDA DCBPTR ;FETCH THE UNLOAD POINTER  CMP L ;BUFFER OVERFLOW?  JZ INT050 ;YES - STORE ALL ONES  MOV M,C ;NO - STORE THE NEW CHARACTE;*******; EXIT *;*******INT160 EQU $ POP H ;RESTORE REGISTERS ANDINT170 EQU $  POP B ;PROCESSOR STATUS  POP PSW EI ;RE-ENABLE INTERRUPTS  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * ; ; PUTDC - DATACOM OUTPUT ROUTINE ; ; ENTRY: A = CHAR TO BE OUTPUT; NC - NORMAL CHAR ; C - LAST CHAR IN BLOCK;  ; EXIT : A DESTROYED ; NC - NO ERRORS DETECTED; Z - CHARACTER ACCEPTED  ; NZ - WAIT ; C - DATACOM ERROR; Z - TRANSMIT MODE, NO ERROR MSG; PUTDC EQU $  PUSH H  MOV L,A ;SAVE CHAR IN L  LDA DCCT ;READ CONTROL WD MOV H,A ;SAVE CONTROL IN H LDA DCFLGS ;READ FLAGS  RRC ;TERMINAL IN RECEIVE?  JNC PDC004 ;NO, JMP LXI H,ERRFLG  MOV A,M  ORI DCMERR  MOV M,A  POP H  SUB A  STC RET ;C,Z => ERROR, NO MESSAGE PDC004 EQU $  ANI FB9600-GOBIN ;FASTBIN ? MVI A,B9600+DCNP ;SET FASTBIN MODE  JNZ PDC005 ;YES, JUMP LDA KBDCSW ;READ SWITCHES ANI BAUDPT ;CLEAR H/F AND CA BITSPDC005 EQU $  ORA H ;SET COMMAND WORD  STA IODCCT ;OUTPUT COMMAND WORD TO DC LDA IODCST ;INPUT DATACOM STATUS ANI DCTBE ;IS TRANSMIT BUFFER EMPTY? JNZ PDC020 ;YES, GO OUTPUT THE CHAR  PUSH B  PUSH D  CALL DCMON ;AVOID EXTERNAL HANG POP D  POP B  POP H  SUB A  INR A  RET ;NC,NZ => WAITPDC020 EQU $ ;OUTPUT CHARACTER  LDA FPMASK ;READ FORCE PARITY MASK  ORA L ;OR WITH CHAR  STA IODCDO ;OUTPUT THE CHAR LDA DCFLGS ;NOT BINARY/,  MOV H,A ;SAVE FLAGS  ANI BINMOD+MCMOD ;AND MC ? JZ PDC030 ;YES, PDC025 EQU $ ; NO, RETURN => NC,Z  POP H  CMP A  RETPDC030 EQU $  LDA ENDCHR ;IS CHAR ED CHAR?  CMP L  JZ PDC070 ;YES, JMP  MOV A,H ;RECALL DCFLGS ANI TRNMOD ;TRANSPARENT?  JNZ PDC025 ;RETURN ON TRANSPARENT MODE  MOV A,L ;IS IT LAST CHAR OF BLOCK? CPI ACK ;CHAR ACK? JZ PDC060 ;YES, RESPOND OUT  LDA KBJMPR ;FETCH KEYBOARD JUMPER A-H ANI PAGSTR ;PAGE MODE?  JNZ PDC040 ;YES, CHECK FOR DC2 OR RS PDC035 EQU $  MOV A,L ;NO, CHECK FOR CR OR LF  CPI CR ;IS IT CR? JZ PDC050 ;YES, CHK TO SEND END OF DAT CPI LF ;IS IT LF? JZ PDC055 ;YES, CHK TO SEND END OF DAT POP H  CMP A ;NONE OF THE ABOVE, RETURN RETPDC040 EQU $  MOV A,L  CPI DC2 ;IS IT DC2?  JZ PDC060 ;YES, SEND END OF DATA LDA MDFLG2 ;GET MODE FLAGS  ANI BLKMDE ;ARE WE IN BLOCK MODE? JZ PDC035 ;NO -  MOV A,L ;RESTORE CHAR  CPI RS ;IS IT RS? JZ PDC060 ;YES, SEND END OF DATA POP H  CMP A ;NONE OF THE ABOVE, RETURN RETPDC050 EQU $  LDA MDFLG2 ;AUTO LF KEY UP? ANI AUTOLF  JZ PDC060 ;YES, SEND END OF DATAPDC052:POP H  CMP A  RETPDC055 EQU $  LDA MDFLG2 ;AUTO LF KEY DOWN? ANI AUTOLF  JZ PDC052 ;NO, RETURN PDC060 EQU $  LDA ENDCHR ;GET END OF DATA CHAR  CALL PUTDC ;AND TRANSMIT  JC PDC060 JNZ PDC060  POP H  RETPDC070 EQU $  MVI A,ADEL ;ALLOW ENOUGH TIME TO MAKE ORA A  CALL PUTDC ;SURE END OF DATA HAS  JC PDC070 ;BEEN TRANSMITTED  JNZ PDC070 PDC080:MVI A,ADEL CALL PUTDC JC PDC080 JNZ PDC080  PUSH B  CALL DCM110 ;GO TO RECEIVE STATE POP B  POP H  XRA A  RET ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; STRTBN - SET BINARY OUTPUT MODE;  ; ENTRY: DON'T CARE ;  ; EXIT : DON'T CARE ; STRTBN EQU $ STB010 EQU $  LDA IODCST ;READ DC STATUS  ANI DCTBE ;XMIT BUFF EMPTY?  JZ STB010 ;NO, WAIT  LDA DCCT ;READ CONTROL WD ORI DCNP ;SET NO PARITY STA DCCT ;SET NEW CONTROL WD  XRA A ;SET RETURN INDICATORS STA FPMASK ;CLEAR FORCE PARITY  RET ; ; INITDC - INITIALIZE DATACOM; INITDC EQU $ LXI B,DCBFSZ ;SET BUFFER REQUIREMENTS RET ;RETURN TO GET BUFFER ; ; DATACOM INITIALIZATION CONTINUATOR ; INI2DC EQU $  XCHG ;PUT BUFFER START IN H AND L SHLD DCBFBG ;STORE BUFFER START ADDRESS RSTDCB EQU $  LDA IODCPC ;READ GP DC PROG. STRAPS ANI GPASYC ;GP ASYNC BOARD IN?  LDA KBJMP3 ;GET STRAPS FOR 202 PRTCL  MOV H,A ;OPTIONS JNZ RST005 ;YES GP CARD IN  ANI 377Q-CHEKCC ;NO, INHIBIT CC LED MONITO STA KBJMP3 ;STORE STRAPS SETTINGSRST005:ANI ETXSTP ;USE ETX?  MVI A,ETX ;USE ETX JNZ RST006 ;YES  MVI A,EOT ;USE EOTRST006 EQU $  STA ENDCHR ;STORE ED CHAR MOV A,H ;RESTORE JMPERS  ANI SETCH ;IS CH SET?  MVI A,DCCH ;SET CH OFF  JZ RST007 ;NO  XRA A ;SET CH ONRST007 EQU $  STA DCCT ;SET CONTROL WORD  MOV A,H ;RESTORE JUMPERSRSTSRM EQU $  ANI MNCHAN ;MAIN CHANNEL? MVI L,0  JNZ RST010 ;YES,  MVI L,MCMOD ;SET NOT MAIN CHANNEL RST010:MOV A,H ;RESTORE JUMPERS ANI FRCPTY ;SET FORCE PARITY  STA FPMASK RST020:ORA L ;SET FP AND MC STA DCFLGS  LDA DCCT ;READ CONTROL WD ANI DCCH ;CLEAR EXCEPT CH STA DCCT ;RESTORE MOV H,A ;SAVE @@DCCT LDA KBDCSW ;READ DC SWITCHES  ANI BAUDPT ;MASK OUT H/F  ORA H ;SET CONTROL WORD  STA IODCCT ;OUTPUT DC CONTROLS  MVI A,JMP ;SET JUMP OP CODE  STA DCMJMP ;STORE OP  LXI H,DCMON ;SET INITIAL DATA COMM SHLD DCMVEC ;MONITOR VECTOR  LDA IODCST ;SET INITIAL DATA COMM STATU STA DCSTAT  MVI A,1 ;SET THE BLOCK TRANSFER  CALL DCCTL ;TRIGGERRSTDC1 EQU $ LHLD DCBFBG ;SET LOAD AND UNLOAD POINTER SHLD DCSPTR ;EQUAL TO EACH OTHER SHLD DCBPTR  RET ; ; * * * * * * * * * * * * * * * * * * * * * * * ; ; GETDC - GET DATA (7 BITS) FROM DATA COM;  ; ENTRY: DON'T CARE ; ; EXIT : NC - NO ERRORS DETECTED; Z - CHARACTER AVAILABLE; A = CHARACTER ; NZ - WAIT ; A DESTROYED; C - DATACOM ERROR; A DESTROYED; Z - NO ERROR MESSAGE ; NZ - DISPLAY ERROR MESSAGE ; B,C -> ERROR MESSAGE ; GETDC EQU $  PUSH H  LXI H,DCFLGS ;FETCH DATACOM FLAGS DI  MOV A,M  ANI 377Q-BINMOD ;TURN OFF BINARY  MOV M,A  ANI FORPAR ;FORCE PARITY ON?  STA FPMASK ;SET FPMASK  MOV A,M ;RESTORE AGDC001 EQU $  EI  ANI SPECHO+TRNMOD ;IGNORE ECHO FROM DATACO CPI SPECHO ;IS SPECHO ON WITHOUT TRANS? JNZ GDC005 ;NO CHECK FOR CHAR MOV A,M ;GET FLAGS AGAIN  ANI BINMOD+DCCA  CPI DCCA ;NOT BIN AND REC ? JNZ GDC002 ;NO - RETURN WAIT STATUS LDA KBJMP3 ;GET SWITCH SETTINGS ANI STXSTP ;TEST FOR SD CHAR  JNZ GDC002 ;NO CONTINUE WAIT  CALL GDC004 ;YES - CHK FOR STRT OF DATA  JC GDC002 ;NO CHAR, CONTINUE WAIT  JNZ GDC002 ;NO CHAR, CONTINUE WAIT  CPI STX ;WAS CHR STX ? JNZ GDC002 ;NO, CONTINUE WAITING  LXI H,DCFLGS ;YES,TURN OFF ECHO SUPPRESS  DI  MOV A,M  ANI 377Q-SPECHO  MOV M,A  EI ;  ; NO DATA - EXIT WAIT ; GDC002 EQU $  POP H ;RESTORE H,L ORI 1 ;SET NC,NZ EI  RET ;RETURN WAITGDC004 EQU $  PUSH H ;SAVE H AND L GDC005 EQU $  DI  LHLD DCBPTR ;GET THE UNLOAD ADDRESS  LDA DCSPTR ;GET THE LSB OF THE LOAD PTR CMP L ;ANY CHARACTERS IN BUFFER? JNZ GDC007 ;YES - GET ONE; NO - CHECK FOR DATA COMM LDA IODCST ;DATA IN ANI DCDP ;DATA PRESENT? JZ GDC002 ;NO - EXIT CALL DCINTR ;YES - GET THE CHARACTER EI ;RE-ENABLE INTERRUPTS  JMP GDC005 ;GET CHAR FROM INPUT BUFFER  ; ; GET CHARACTER FROM INPUT BUFFER; GDC007 EQU $  LDA DCBFBG ;FETCH LSB OF BUFFER START CMP L ;AT BEGINNING OF BUFFER? JNZ GDC008 ;NO - GET THE NEXT CHARACTER ADI DCBFSZ ;YES - WRAP AROUND TO END OF MOV L,A ;BUFFER  MOV A,H  ACI 0  MOV H,A ; GDC008 EQU $  DCX H ;DECREMENT TO NEXT CHARACTER SHLD DCBPTR ;STORE NEW POINTER EI  MOV A,M ;GET THE INPUT BYTE  MOV L,A ;SAVE IT IN THE L-REGISTER CPI 377Q ;POSSIBLE ERROR BYTE?  JNZ GDC010 ;NO - CHECK FOR NORMAL MODE  LDA ERRFLG ;YES - GET ERROR FLAG  ANI DCMERR ;ERROR IN INPUT? JZ GDC010 ;NO - PROCESS CHARACTER  POP H ;YES - RESTORE H,L CMP A ;RETURN ERROR WITH NO MESSAG STC ;(C, Z)  RET ;RETURN ;  ; PROCESS CHARACTER ; GDC010 EQU $  LDA DCFLGS ;GET DATACOM FLAGS MOV H,A ;SAVE FLAGS  ANI BINMOD ;BINARY MODE?  JNZ GDC050 ;YES - DON'T CHECK FOR  MOV A,L  ANI 177Q ;MASK OUT PARITY BIT MOV L,A ;SAVE CURRENT CHAR MOV A,H ;RECALL FLAGS  ANI MCMOD ;MAIN CHANNEL? JNZ GDC015 ;NO, DO NOT CK ED CHAR LDA ENDCHR ;GET ED CHAR CMP L  JNZ GDC015 ;NO, CONTINUE  MOV A,H ;RECALL STRAPS ANI TRNMOD ;TRANSPARENT?  JNZ GDC014 ;YES JMP LDA KBJMP3 ;READ STRAPS ANI CFSTRP ;CF DETECT ENABLED ? JNZ GDC012 ;NO, GO TO XMIT STATE  LXI H,DCFLGS ;GET DCFLGS ADDR DI  MOV A,M ;GET FLAGS ORI SPECHO ;SET SUPPRESS ECHO MOV M,A ;STORE NEW FLAGS EI  JMP GDC002 ;GO EXIT ON WAIT DROP CFGDC012:PUSH B ;SAVE B,C  CALL DCM030 ;YES, GO TO TRANSMIT STATE POP B  POP H  ORI 1  RET; GDC014 EQU $  PUSH B  CALL DCM030  POP B  POP H  LDA ENDCHR ;GET ED CHAR  CMP A  RET; GDC015 EQU $  MOV A,H ;RECALL FLAGS  ANI TRNMOD+SPECHO ;TRANSPARENT OR WAITING  JNZ GDC050 ;YES, JMP  MOV A,L ;RECALL CHAR CPI ENQ ;IS IT AN ? POP H ;RESTORE H,L JZ GDC020 ;YES - RESPOND WITH  CMP A ;NO - RETURN CHARACTER RET ;(NC, Z) ; ; WAIT FOR LINE TURNAROUND BEFORE SENDING ; GDC020 EQU $  CALL GDC004 ;CHECK FOR END OF DATA LDA DCFLGS ;GET THE DATACOM FLAGS ANI DCCA ;TRANSMIT MODE (CA = 1)? JNZ GDC020 ;NO - WAIT FOR TURNAROUND GDC030 EQU $ ;YES - SEND ACK  MVI A,ACK  ORA A ;NC => NORMAL CHAR CALL PUTDC  JC GDC030 ;ERROR - TRY AGAIN JNZ GDC030 ;WAIT - TRY AGAIN  LDA DCFLGS ;SEE IF ENQ-ACK SHOULD CAUSE CMA ;CHANGE TO BINARY MODE ANI GOBIN  RNZ ;NO - RET WITH NC,NZ => WAIT DI  LDA DCFLGS ;YES - TOGGLE GOBIN AND BINM XRI GOBIN+BINMOD STA DCFLGS  EI  XRA A ;CLEAR FP MASK STA FPMASK  INR A  RET; ; BINARY OR TRANSPARENT - RETURN CHARACTER ; GDC050 EQU $  MOV A,L ;(PUT CHARACTER IN A-REG)  POP H  CMP A ;RETURN CHARACTER  RET ;(NC, Z) ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; GETBIN - GET A BINARY BYTE ;  ; ENTRY: DON'T CARE ; ; EXIT : SAME AS GETDC, ABOVE ; GETBIN EQU $  PUSH H  LXI H,DCFLGS  MOV A,M ;LOAD DC FLAGS ANI BINMOD ;ALREADY IN BINARY MODE? DI  MOV A,M  JNZ GDC001 ;YES - GET BYTE AND RETURN ORI GOBIN ;NO - SET FLAG TO GO TO BIN  MOV M,A  EI  POP H  CALL GETDC ;EMPTY BUF/DO ENQ-ACK HANDSH ORI 1 ;NC,NZ => WAIT RET ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; DCMON - NORMAL DATA COMM MONITOR ROUTINE ;  ; ENTRY: DON'T CARE ; ; EXIT : ALL REGISTERS DESTROYED; ; THIS ROUTINE MONITORS THE RS232-C CONTROL; LINES CLEAR TO SEND (CB,106), RECEIVE CARRIER; (CF,109), AND SECONDARY RECEIVE DATA (SB,122). ; ; THE DATA SET READY LINE (CC, 107) IS MONITORED ; WHEN THE GP ASYNC DC CARD IS USED AND; IF THE CHEKCC IS ENABLE THE TRANSMIT LED IS; TURNED ON WHEN CC IS HIGH, OFF WHEN LOW, ELSE; IF THE CHEKCC IS DISABLED, THEN; ; THE TRANSMIT LIGHT IS TURNED ON WHEN CB (106); IS HIGH (DCCB=0), AND OFF, WHEN CB (106) IS; LOW (DCCB=1).; ; IF CIRCUIT ASSURANCE IS ENABLED AND IN RECEIVE ; STATE, TRANSITION TO TRANSMIT, IS ENABLED ONLY ; AFTER DROP IN BOTH CB, AND SB HAS BEEN DETECTED; WITHIN 2.6 SECS, ELSE RETURN TO RECEIVE STATE. ; ; IF CIRCUIT ASSURANCE IS DISABLED TRANSITION; WILL OCCUR AFTER A DROP IN CB. ; ; IF CPU BREAK IS ENABLED AND IN TRANSMIT STATE, ; IF SB DROPS, THE CPU HAS ENABLED BREAK.IF BREAK; HAS OCCURED AND CF DETECT IS DISABLED, SEND ED ; CHAR AND SET CA LOW, ELSE SET CA LOW . ; ; IF CARRIER DETECT CF IS ENABLE IN RECEIVE STATE; WITH A DROP IN CF DETECTED THEN GO TO TRANSMIT ; STATE. IF CARRIER DETECT IS DISABLED, AND MAIN ; CHANNEL, THEN TURN LINE AROUND AFTER ED CHAR.; ; DCMON EQU $  LDA DCCT ;READ CONTROL WD MOV D,A ;SAVE CH,NP,CA LDA DCFLGS ;GET DATA COMM FLAGS ANI FB9600 ;FAST BINARY?  MVI A,B9600+DCNP ;SET FASTBIN JNZ DCM002 ;YES,  LDA KBDCSW ;READ DCSW ANI BAUDPT ;CLEAR H/F AND CA BITSDCM002:ORA D ;KEYBOARD DATACOM SWITCHES STA IODCCT ;SET BAUD RATE AND PARITY  LDA IODCST ;GET CURRENT DATA COMM STATU MOV C,A ;SAVE IT IN C  LXI H,DCSTAT  MOV B,M ;GET PREVIOUS STATUS AND MOV M,A ;SAVE NEW STATUS LDA KBJMP3 ;READ STRAPS MOV E,A ;SAVE IN E ANI CHEKCC ;MONITOR CC ?  JZ DCM005 ;NO USE CB LDA IODCS2 ;READ 2ND STATUS ANI DCCC ;IS CC HIGH ?  JMP DCM010 ;GO TO SET LEDDCM005:MOV A,C ;RECALL STATUS ANI DCCB ;IS CB HIGH (DCCB = 0)? DCM010:CZ ZSTXMT ;YES - TURN ON TRANSMIT LED  CNZ ZCLXMT ;NO - TURN OFF TRANSMIT LED  MOV A,D ;IN 202 RECEIVE MODE (CA = 0 RRC ;DCCA = 1)?  MOV A,E ;RECALL STRAPS JNC DCM100 ;NO - CHECK FOR DROP IN SB ; ; IN RECEIVE MODE (DCCA = 1 => CA = 0) - CHECK ; FOR DROP IN CF TO GO TO TRANSMIT MODE; IF CARRIER DETECT IS ENABLED ;  ANI CFSTRP ;CARRIER DETECT ENABLED?  RNZ ;NO , IGNORE CF  MOV A,B ;PUT CURRENT STATUS IN A XRA C ;EXTRACT CHANGED BITS  ANI DCCF ;DID RECEIVE CARRIER (CF)  ANA C ;DROP (DCCF -> 1)? RZ ;NO - RETURNDCM030 EQU $  LXI H,DCFLGS ;YES - PREPARE TO GO INTO  DI  MOV A,M ;TRANSMIT MODE ORI SPECHO ;SET FLAG TO IGNORE INPUT  MOV M,A ;FROM DATA COMM  EI  XRA A ;CLEAR TRANSMIT TURN AROUND  STA XMTDLY ;TIME LIMIT  MVI A,1 DCM040 EQU $  MVI B,0 ;SET TO TURN ON CA LXI H,DCM050 ;SET CLEAN-UP ROUTINE  JMP DCTURN ;DO TURN AROUND ; ; CHECK FOR TRANSMIT TURN AROUND COMPLETION; DCM050 EQU $  LDA IODCST ;GET CURRENT STATUS  STA DCSTAT ;UPDATE STATUS MOV B,A  ANI DCCB ;IS CB ON? (=0)  JNZ DCM055 ;NO, CONTINUE WAIT LDA KBJMP2 ;MONITOR SB? ANI SBSTRP  JNZ DCM060 ;NO, GO TO TRANSMIT STATE  MOV A,B ;YES, IS SB ON? (=0) ANI DCSB JZ DCM060 ;YES,GO TO TRANSMIT STATE DCM055 EQU $  LXI H,XMTDLY ;TURN AROUND TIME LIMIT  DCR M ;EXCEEDED? JZ DCM110 ;YES - REVERT TO RECEIVE MOD RET ;NO - RETURN (CONTINUE WAIT); ; TURN AROUND COMPLETED - SET FOR TRANSMIT MODE; DCM060 EQU $ ;SET TRANSMIT MODE CA  LXI H,DCFLGS  DI  MOV A,M  ANI 377Q-DCCA  MOV M,A  LXI H,DCCT ;SET CONTROL WD ADDR MOV A,M ;READ WD ANI DCCH+DCNP ;SET CA LOW MOV M,A ;SET NEW WD  LXI H,DCMON ;SET MONITOR VECTOR TO SHLD DCMVEC ;REGULAR MONITOR ROUTINE LXI H,CMFLGS  MOV A,M  ORI BLKTRG ;SET BLOCK TRANSFER TRIGGER  MOV M,A  EI  LDA KBJMP3 ;MAIN CHANNEL PROTOCOL?  MOV B,A  ANI MNCHAN  RZ ;NO, RETURN  MOV A,B ;YES, SEND START OF DATA?  ANI STXSTP  RNZ ;NO, RETURN DCM070 EQU $  LDA DCFLGS ;READ FLAGS  ANI TRNMOD ;TRANSPARENT?  RNZ ;YES - RETURNDCM075 EQU $  MVI A,STX ;SET STX AS SD CALL PUTDC JC DCM075 JNZ DCM075  RET ;RETURN  ; ; IN TRANSMIT MODE (DCCA = 0 => CA = 1) - CHECK; FOR DROP IN SB TO GO TO RECEIVE MODE ; DCM100 EQU $  ANI CBKSTP  RNZ MOV A,B  XRA C ;EXTRACT CHANGED BITS  ANI DCSB ;DID SECONDARY RECEIVED DATA ANA C ;(SB) DROP (DCSB -> 1)?  RZ ;NO - RETURN MOV A,E  ANI MNCHAN ;MAIN CHANNEL? JZ DCM110 ;NO, DCM105 EQU $  LDA ENDCHR ;OUTPUT ED CHAR  CALL PUTDC JC DCM105 JNZ DCM105  RET; DCM110 EQU $ ;YES - GO TO RECEIVE MODE  LXI H,CMFLGS  DI  MOV A,M ;CLEAR BLOCK TRANSFER TRIGGE ANI 377Q-BLKTRG  MOV M,A  MVI B,DCCA ;SET TO TURN OFF CA  LXI H,DCFLGS ;SET CA IN "DCFLGS" TO MOV A,M ;INHIBIT TRANSMISSION  ORA B ;OF DATA MOV M,A  LXI H,DCCT ;SET CONTROL WD ADDR MOV A,M  ORI DCCA ;SET CA  MOV M,A  EI  MVI A,1 ;SET SETTLING TIME (10 MSEC) LXI H,DCM150 ;SET CLEAN-UP ROUTINE  JMP DCTURN ;DO TURN AROUND ; ; TURN AROUND DONE - SET FOR RECEIVE MODE; DCM150 EQU $  LXI H,DCMON ;SET MONITOR VECTOR TO SHLD DCMVEC ;REGULAR MONITOR ROUTINE DI  LHLD DCBFBG ;SET DATA COMM BUFFER  SHLD DCSPTR ;POINTERS  SHLD DCBPTR  EI  LDA IODCST ;READ STATUS STA DCSTAT ;UPDATE STATUS LDA KBJMP3 ;MAIN CHANNEL PROTOCOL?  MOV B,A  ANI MNCHAN  MOV A,B  JZ DCM160 ;NO, RESET ECHO SUPPRESS ANI STXSTP ;YES,WAIT FOR STRT OF DATA?  RZ ;YES, RETURN NOWDCM160 EQU $  LXI H,DCFLGS ;SET DATA COMM FLAGS TO  DI  MOV A,M ;ACCEPT DATA COMM INPUT  ANI 377Q-SPECHO  MOV M,A  EI  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; DCTURN - TURN LINE AROUND FOR 202; ; ENTRY: A = SIGNAL SETTLING TIME ; B = SETTING FOR CA ; H,L = TURN AROUND EXIT ROUTINE ; ; EXIT : A,B,H,L DESTROYED; DCTURN EQU $  STA DCDLAY ;SET SIGNAL SETTLING DELAY SHLD DCTEX ;SET DATA COMM EXIT ROUTINE  LXI H,DCDCNT ;SET MONITOR JUMP FOR DELAY  SHLD DCMVEC ;CONTINUATOR LDA DCCT ;READ CONTROL WD ANI 377Q-DCCA ;SET CLEAR  ORA B ;MASK WITH DCCA  MOV B,A ;SAVE IN BDCT010 EQU $  LDA KBDCSW ;ADD DESIRED CA SETTING WITH ANI BAUDPT ;CLEAR H/F AND CA BITS@@ ORA B ;KEYBOARD DATACOM SWITCHES STA IODCCT ;SET DATA COMM INTERFACE RET ;RETURN ; ; TURN AROUND CONTINUATOR - CHECK FOR TIME OUT ; DCDCNT EQU $  LXI H,DCDLAY  DCR M ;SETTLING TIME COMPLETED?  RNZ ;NO - RETURN LHLD DCTEX ;YES - GET CLEAN UP ROUTINE  SHLD DCMVEC ;ADDRESS AND GO DO IT  PCHL  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; DCCTL - PERFORM CONTROL FUNCTIONS; ; ENTRY: A = CONTROL PARAMETER; B,C = CONTROL VARIABLES (AS NEEDED);  ; EXIT : A DESTROYED ; NC - NO DATACOM ERRORS DETECTED; Z - CONTROL PERFORMED; NZ - INVALID CONTROL REQUEST ; C - DATACOM ERROR DETECTED ; Z - NO ERROR MESSAGE ; NZ - DISPLAY ERROR MESSAGE ; B,C = POINTER TO ERROR MESSAGE ; DCCTL EQU $  CPI PROMPT ;IS CONTROL CALL PROMPT? JZ SNDDC2 ;YES, JMP  RNC ;IF GREATER RET INVALID CNTL PUSH H ;SAVE THE WORKING REGISTERS  PUSH D  ADD A ;DOUBLE THE PARAMETER VALUE  MOV E,A ;COMPUTE CONTROL VECTOR  MVI D,0 ;LOCATION  LXI H,DCCTAB  DAD D  MOV E,M ;FETCH THE CONTROL VECTOR  INX H  MOV D,M  XCHG  POP D ;RECALL D AND E  PCHL ;GO TO CONTROL ROUTINE;  ; CONTROL VECTORS ; DCCTAB EQU $ DW CLBLTR ;0 - CLEAR BLOCK XFR TRIGGER DW STBLTR ;1 - SET BLOCK XFR TRIGGER DW RSTDCM ;2 - RESET DATACOM DW STRMTE ;3 - SET REMOTE MODE DW STLOCL ;4 - SET LOCAL MODE  DW BREAK ;5 - OUTPUT BREAK SIGNAL DW DSCNCT ;6 - MODEM DISCONNECT  DW SNDTRM ;7 - SEND ED IF MAIN CHAN  DW ENTMON ;8 - ENTER MONITOR MODE  DW RETNRM ;9 - RETURN TO NORMAL OPER DW FSTBIN ;10 - FAST BINARY 9600 BAUD DW GDC002 ;11 - NO OP DW GDC002 ;12 - NO OP; DFAD SNDDC2 13 - SEND DC2 ; ; CLBLTR - CLEAR BLOCK TRANSFER TRIGGER; CLBKTX EQU $  PUSH H ;ENTRY FOR SEND DC2 ROUTINE CLBLTR EQU $  MVI A,377Q-BLKTRG ;SET FLAG TO BE CLEARED LXI H,CMFLGS ;SET H,L TO COMMON FLAGS ANA M ;MASK OUT THE FLAG MOV M,A ;STORE UPDATED VALUEDCCTX1 EQU $  POP H ;RESTORE H AND L CMP A ;SET NC AND Z  RET ;RETURN ; ; ; ; STBLTR - SET BLOCK TRANSFER TRIGGER; STBLTR EQU $  LDA DCFLGS ;GET THE DATACOM FLAGS ANI DCCA ;IN 202 RECEIVE MODE?  JNZ DCCTX1 ;YES - RETURN WO/SETTING FLA MVI A,BLKTRG ;NO - SET THE BLOCK TRANSFER LXI H,CMFLGS ;TRIGGER ORA M  MOV M,A  JMP DCCTX1 ;RETURN ;  ; RSTDCM - RESET DATACOM ; RSTDCM EQU $  CALL RSTDCB ;RESET DATACOM FLAGS AND PTR JMP DCCTX1 ;RETURN ; ; STRMTE - SET REMOTE MODE ; STRMTE EQU $  DI  LDA KBJMP3 ;READ DC JUMPERS MOV H,A ;SAVE IN H CALL RSTSRM ;DO PARTIAL RESET  EI  JMP DCCTX1 ;RETURN ;  ; STLOCL - SET LOCAL MODE ; STLOCL EQU DCCTX1 ;NO FUNCTION ; ; BREAK - OUTPUT BREAK SIGNAL; BREAK EQU $  CALL CHKDCM ;MAKE SURE DATA COMM IS IDLE LDA DCCT ;READ CONTROL WD ORI DCSA ;ADD IN BREAK BIT  MOV H,A ;SAVE CONTROL BYTE LDA KBDCSW ;READ SWITCHES ANI BAUDPT ;CLEAR H/F AND CA BITSBRK005 EQU $  ORA H  STA IODCCT ;SET INTERFACE TO BREAK  LXI H,BRK050 ;SET BREAK EXIT AND BREAK  MVI A,21 ;TIME (210 MSEC)BRK010 EQU $  STA DCDLAY ;SET DELAY INTERVAL  SHLD DCTEX ;SET EXIT ROUTINE  LXI H,DCDCNT ;SET MONITOR VECTOR TO SHLD DCMVEC ;DELAY CONTINUATOR CALL CHKDCM ;WAIT UNTIL DELAY IS COMPLET EI ;ENABLE INTERRUPT  JMP DCCTX1 ;RETURN SUCCESSFUL; ;  ; DISCONNECT EXIT ROUTINE ; DSC100 EQU $  LDA DCCTL2 ;SET CD BACK ON  ; BREAK EXIT ROUTINE ; BRK050 EQU $  LDA DCCT ;READ CONTROL WD MOV H,A ;SAVE CONTROL BYTE LDA KBDCSW ;READ SWITCHES ANI BAUDPT ;CLEAR H/F AND CA BITSBRK100 EQU $  ORA H  STA IODCCT  LXI H,DCMON ;RESTORE MONITOR VECTOR  SHLD DCMVEC  RET ;RETURN ; ; DSCNCT - MODEM DISCONNECT; DSCNCT EQU $  CALL CHKDCM ;MAKE SURE DATA COMM IS IDLE LDA DCCTL2+CDOFF ;TURN OFF DATA TERMINAL  MVI A,101 ;READY (CD) FOR ONE SECOND LXI H,DSC100 ;SET EXIT ROUTINE ADDRESS  JMP BRK010 ;SET MONITOR ROUTINE JUMP  ; ; TRMBIN - TERMINATE BINARY OUTPUT ; TRMBIN EQU $  PUSH H  LXI H,DCFLGS ;CLEAR FAST BINARY DI  MOV A,M  ANI 377Q-FB9600  MOV M,A  EI  ANI FORPAR ;SET FP MASK STA FPMASK TRM005:LDA IODCPC ;GET DATA COMM PROGRAM STRAP ANI GPASYC ;IS IT THE GP ASYNC BOARD? JZ TRM015 ;NO TRM010 EQU $ ;YES - DROP REQUEST TO SEND  LDA IODCS2 ;GET AUXILARY STATUS ANI DCTBE ;TRANSMIT BUFFER EMPTY?  JZ TRM010 ;NO - CONTINUE MAITING CALL CHKDCM ;MAKE SURE DATA COMM IS IDLE MVI A,1 ;DELAY FOR 10 MSECTRM012 EQU $  LXI H,TRM020 ;SET EXIT  JMP BRK010 ;SET MONITOR JUMP ADDRESS ; TRM015 EQU $  LDA IODCST ;READ STATUS  ANI DCTBE ;IS XMIT BUFFER EMPTY?  JZ TRM015 ;NO  CALL CHKDCM ;CHECK DATA COMM IDLE MVI A,10 ;SET DELAY 100 MSEC JMP TRM012 ; ; CONTINUATION FOR BINARY TERMINATE; TRM020 EQU $  LXI H,DCCT ;SET DCCT ADDR MOV A,M ;GET CONTROL WD  ANI DCCH+DCCA ;CLEAR NO PARITY MOV M,A ;SET NORMAL  ORI DCCA ;SET REQ TO SEND OFF MOV H,A  LDA KBDCSW ;TURN OFF REQUEST TO SEND  ANI BAUDPT ;CLEAR H/F AND CA BITSTRM030 EQU $  ORA H  STA IODCCT  MVI A,1 ;SET FOR 10 MSEC INTERVAL  LXI H,BRK050 ;EXIT VIA "BRK050" STA DCDLAY SHLD DCTEX  LXI H,DCDCNT ;SET TO DELAY ROUTINE  SHLD DCMVEC  RET ;RETURN TO TIMER INTERRUPT ; ; ENTMON - ENTER MONITOR MODE; ENTMON EQU $  MVI A,TRNMOD ;SET TRANSPARENT MODE  LXI H,DCFLGS ;FLAG  DI  ORA M  MOV M,A ;UPDATE FLAG SETTING EI  XRA A  STA FPMASK  JMP DCCTX1 ;RETURN ; ; RETNRM - RETURN TO NORMAL MODE ; RETNRM EQU $  MVI A,377Q-TRNMOD ;CLEAR TRANSPARENT MOD LXI H,DCFLGS  DI  ANA M  MOV M,A ;UPDATE FLAG SETTINGS  EI  ANI FORPAR  STA FPMASK ;SET FP MASK JMP DCCTX1 ;RETURN ; ; FSTBIN - FAST BINARY ROUTINE GOTO 9600 BAUD; FSTBIN EQU $  LDA KBJMPR ;READ JUMPER A-H ANI FSTSND ;IS FAST SEND ENABLED? JZ FST010 ;NO RETURN LXI H,DCFLGS ;GET FLAGS DI  MOV A,M  ORI FB9600 ;SET FLAG FOR FAST BIN MOV M,A ;STORE NEW FLAG  EI FST010:CALL STRTBN ;SET BINARY OUTPUT MODE  JMP DCCTX1 ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; CHKDCM - WAIT FOR MONITOR TO CLEAR ;  ; ENTRY: DON'T CARE ; ; EXIT : DCMVEC = DCMON ; H-L DESTROYED; INTERRUPTS DISABLEDCHKDCM EQU $  LXI H,DCMON ;GET NORMAL MONITOR ADDRESS  DI ;DISABLE INTERRUPTS  LDA DCMVEC ;GET CURRENT MONITOR VECTOR  CMP L ;IS IT THE NORMAL ROUTINE? JNZ CKD020 ;NO - TRY AGAIN  LDA DCMVEC+1  CMP H ;DOES MSB MATCH? RZ ;YES - RETURN CKD020 EQU $ ;NO - TRY AGAIN  EI ;RE-ENABLE INTERRUPTS  JMP CHKDCM ;CHECK AGAIN ; ;***********************************************;  ; SNDDC2 - SEND DC2 ;  ; ENTRY: DON'T CARE ;  ; EXIT : A DESTROYED ; ; SNDDC2 EQU $  CALL CLBKTX ;GO TO CLEAR BLOCK TRIGGERSND010 EQU $  MVI A,DC2 ;SET DC2 AS CHAR CALL PUTDC ;OUTPUT DC2  RC ;RETURN ON DC ERROR  JNZ SND010  LDA KBJMPR ;READ KB JUMPERS CMA ;REVERSE SENSE OF BITS ANI PAGSTR ;PAGE STRAP IN ? RZ ;NO - RETURNSND020 EQU $  MVI A,CR ;SET CR AS CHAR  CALL PUTDC ;OUTPUT CR RC ;RETURN ON DC ERROR  JNZ SND020  LDA MDFLG2 ;READ MODE ANI AUTOLF ;AUTO LF KEY DOWN? RZ ;NO RETURNSND030 EQU $  MVI A,LF ;SET LF AS CHAR  CALL PUTDC ;OUTPUT LF RC ;RETURN ON DC ERROR  JNZ SND030  RET ;EXIT  ; ;****************************************** ; ; SNDTRM - SEND ED CHAR IF MAIN CHANNEL; ; SNDTRM EQU $  LDA DCFLGS ;READ FLAGS  ANI MCMOD+DCCA ;MAIN CHANNEL?  JNZ DCCTX1 ;NO RETURN JMP PDC060 ;SEND ED CHAR  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; DCTST - DATACOM SELF-TEST;  ; ENTRY: DON'T CARE ; ; EXIT : NC - SELF-TEST SUCCESSFUL; C - SELF-TEST FAILED ; H,L = SELF-TEST MESSAGE; OTHER REGS. DESTROYED; DCTST EQU $  ;******************* ; DISALLOW DATACOM * ; INTERRUPTS * ;******************* LDA KBJMP3 ANI NODCST JNZ SFT600  LXI H,PRCCTL ;PROCESSOR CONTROL FLAG  DI  MOV A,M  ORI DCIOFF ;DON'T LET TIMER ROUTINE MOV M,A ;REENABLE DATACOM INT. OUT PROCSR ;DISABLE DATACOM INT.  EI ;  LXI H,TMOUT ;GIVE CONTROL TO TIMEOUT SHLD DCMVEC ;ROUTINE ON TIMER INTS. ;********** ; DATACOM * ; ALIVE? * ;**********  SUB A ;RAISE REQUEST TO SEND STA IODCCT  MVI B,DCCB ;CHECK FOR CLEAR TO SEND MOV C,B  CALL STATCH ;CHECK DATA COM STATUS LXI H,STCACB ;ERROR MESSAGE POINTER JZ SFT400 ;INDICATE FAILURE  ;***************; CHECK DATA *; SEND RECEIVE *; LOOP *;*************** MVI A,DCNP ;SET INITIAL PARITY - NONESFT130 EQU $  STA TPARIT  MVI B,B9600 ;9600 BAUD ADD B ;COMBINE BAUD RATE AND PARIT STA IODCCT ;SET THEM LDA IODCDI ;CLEAR DATA IN REGISTER  MVI D,0 ;INITIALIZE TO FIRST CHAR ; SEND CHARACTERSFT170 EQU $  MVI B,DCTBE ;WAIT TILL XMIT BUFER MT MVI C,0  CALL STATCH  LXI H,STDATA ;IN CASE OF FAIL JZ SFT400 ;FAILURE MOV A,D  STA IODCDO ;SEND DATA MVI B,DCDP ;WAIT UNTIL DATA PRESENT MVI C,0  CALL STATCH  JZ SFT400 ;FAILED-NO CHAR REC'D  LDA IODCDI ;GET CHARACTER MOV B,A ;SAVE ; CHECK PARITYSFT200 EQU $  LDA IODCST ;DATACOM STATUS  MOV C,A ;SAVE  ANI DCPE ;PARITY ERROR BIT SET? LXI H,STPARE ;PARITY ERROR MSG PTR  JNZ SFT400 ;YES, ERROR ; OVERRUN ERROR? MOV A,C ;STATUS  ANI DCOE ;CHECK BIT LXI H,STOVRE ;MSG POINTER JNZ SFT400 ;ERROR ; CHECK CHARACTER  MOV A,B ;DATACOM CHARACTER CMP D ;SAME AS SENT? LXI H,STDATA ;ERROR POINTER JNZ SFT400 ; DO NEXT CHARACTER  INR D ;BUMP TO NEXT CHARACTER  JZ SFT260 ;WAS 8 BIT TEST, DONE  JP SFT170 ;.LE. 177B LDA TPARIT ;NO PARITY?  CPI DCNP JZ SFT170 ;YES, USE 8 BITS;  ; DO NEXT PARITY SETTING ; SFT260 EQU $  LDA TPARIT  CPI DCNP JZ SFT280 ;NO PARITY, USE ODD NEXT CPI DCOP ;ODD PARITY  JNZ SFT300 ;NO, MUST BE DONE  MVI A,DCEP ;DO EVEN PARITY  JMP SFT130 SFT280 EQU $  MVI A,DCOP ;ODD PARITY  JMP SFT130  ;*************; TEST OTHER *; BAUD RATES *;*************SFT300 EQU $  MVI D,7 ;BAUD COUNTER SFT320 EQU $  DCR D ;DO NEXT BAUD RATE JZ SFT340 ;ALL BAUD RATES TESTED MOV A,D ;FORMAT CONTROL WORD RLC ;SHIFT TO BITS 1-3 MVI B,DCNP ;NO PARITY ADD B  STA IODCCT ;SET NO PARITY AND BAUD  SUB A  STA IODCDO ;SEND NULL MVI B,DCDP  MVI C,0  CALL STATCH ;WAIT FOR DATA LXI H,STDATA ;ERROR MSG JZ SFT400 ;NO DATA RECEIVED  LDA IODCDI ;GET DATA  ORA A ;IS IT ZERO? JNZ SFT400 ;NO, ERROR MVI A,377Q ;SEND ALL ONES STA IODCDO CALL STATCH  JZ SFT400 ;ERROR LDA IODCDI ;CHECK DATA  INR A  JNZ SFT400 ;NOT 377, ERROR  JMP SFT320 ;DO NEXT BAUD RATE ;******** ; TEST * ; LINES * ;******** SFT340 EQU $  LXI D,LINTBL ;TABLE OF PATTERNSSFT360 EQU $  LDAX D ;GET DATACOM CONTROL WORD  INR A ;END?  JZ SFT380 ;DONE, ALL TESTS PASSED  DCR A ;RESTORE A ; SET DATACOM CONTROL STA IODCCT  MVI B,DCCB ;CHECK CB  INX D ;BUMP TO NEXT TABLE ENTRY  LDAX D  MOV C,A  CALL STATCH LXI H,STCB  JZ SFT400 ;CB ERROR  MVI B,DCCF ;CHECK CF  INX D  LDAX D  MOV C,A  CALL STATCH LXI H,STCACF  JZ SFT400 ;ERROR MVI B,DCSB ;CHECK SB  INX D  LDAX D  MOV C,A  CALL STATCH LXI H,STBKSB  JZ SFT400 ;ERROR;  INX D ;BUMP TO NEXT TEST SET JMP SFT360  ;***************; REPORT FINAL *; STATUS BACK *;***************; ; GOOD STATUS ; SFT380 EQU $  LXI H,STGOOD ;GOOD STATUS ANA A ;CLEAR CARRY JMP SFT520 ;FINISH ; ; ERRORS; SFT400 EQU $  SHLD MSGPT4 ;SET FAIL MSG  LXI H,STFAIL ;FAIL LITERAL  STC ;SET CARRY TO INDICATE ERROR;*********; RETURN *;*********SFT520 EQU $  PUSH PSW ;SAVE FLAGS  SHLD MSGPT3 ;SET MESSAGE TYPE  MVI B,DCDP ;CLEAR CHARACTER INPUT BUFFE MVI C,0 @@ CALL STATCH LDA IODCDI ;  LXI H,DCMON ;RESET DC MONITOR ADDRESS  SHLD DCMVEC  LXI H,PRCCTL ;PRECESSOR CONTROL FLAG  DI  MOV A,M  ANI 377Q-DCIOFF ;ENABLE DATACOM INTS. MOV M,A  EI  POP PSW  SFT530:LXI H,STSFTS SHLD MSGPT2  LXI H,DCTYPE ;SET DATACOM TYPE MESSAGE  RET SFT600:LXI H,STDISA SHLD MSGPT3 JMP SFT530  ;***************************; TIMING ROUTINE *; THIS IS CALLED ON *; EVERY TIMER INTERRUPT *; AND DECREMENTS A COUNTER *; *; ENTRY: DON'T CARE *; EXIT: H,L,FLAGS *; CHANGED *;***************************TMOUT EQU $  LXI H,TMOCNT ;COUNTER DCR M  RET ;*****************************; CHECK DATACOM STATUS *; AND WATCH FOR TIMEOUT *; *; ENTRY: B= BIT IN STATUS *; TO BE EXAMINED *; *; C= B IF WE WANT BIT *; TO TURN ZERO *; C= 0 IF WE WANT BIT *; TO EQUAL ONE *; --SO EXCLUSIVE OR OF *; STATUS AND C REG IS *; NON ZERO WHEN BIT *; BECOMES THE VALUE *; WE ARE LOOKING FOR *; *; EXIT: A= 0 IF BIT DID NOT *; TURN BY 400 MS *; A .NE. 0 OTHERWISE *; OTHER REGS. SAVED *;*****************************STATCH EQU $  MVI A,20 STA TMOCNT ;INITIALIZE COUNTER ; EXAMINE STATUSSTW100 EQU $  LDA IODCST  ANA B ;GET BIT DESIRED XRA C ;BIT IN RIGHT STATE? RNZ; TIME OUT YET?  LDA TMOCNT ;TIME OUT COUNTER  ORA A ;ZERO? JNZ STW100 ;NO  RET ;YES, NEVER FOUND RIGHT STAT ;************ ; SELF TEST * ; LITERALS * ;************ DCTYPE EQU $  DB 'BASIC DATA COMM'  DB EOL,0 STSFTS EQU $  DB 'SELF TEST ',0 STGOOD EQU $  DB 'OK',EOP STDISA EQU $  DB 'ERROR 0 (DISABLED)',EOPSTFAIL EQU $  DB 'ERROR ',0 STDATA EQU $  DB '3 (LOST CHAR)',EOP STPARE EQU $  DB '2 (PARITY)',EOPSTOVRE EQU $  DB '3 (OVERRUN)',EOP STCACB EQU $  DB '1 (NO CB)',EOP STCB EQU $  DB '4 (CB)',EOP STCACF EQU $  DB '4 (CF)',EOP STBKSB EQU $  DB '5 (SB)',EOP  ;****************************** ; DATACOM LINE TEST PATTERNS * ; * ; 4 BYTES/ENTRY-TEST * ; 1ST = DATACOM CONTROL BYTE * ; 2ND = CB WORD * ; 3RD = CF WORD * ; 4TH = SB WORD * ; THESE LAST 3 BYTES GO TO * ; C REG WHEN STATCH CALLED * ;****************************** LINTBL EQU $  DB 0 ;NOT CA = 0, BRK = 0 DB DCCB ;NOT CB = 0  DB DCCF ;NOT CF = 0  DB 0 ;NOT SB = 1 ;  DB 1 ;NOT CA = 1, BRK = 0 DB 0 ;NOT CB = 1  DB 0 ;NOT CF = 1  DB DCSB ;NOT SB = 0 ;  DB 101Q ;CA = 1, BRK = 1 DB 0 ;NOT CB = 1  DB 0 ;NOT CF = 1  DB 0 ;NOT SB = 1 ;  DB 377Q ;END OF TABLE   ENDIODCCT ;SET THEM LDA IODCDI ;CLEAR DATA IN REGISTER  MVI D,0 ;INITIALIZE TO FIRST CHAR ; SEND CHARACTERSFT170 EQU $  MVI B,DCTBE ;WAIT TILL XMIT BUFER MT MVI C,0  CALL STATCH  LXI H,STDATA ;IN CASE OF FAIL JZ SFT400 ;FAILURE MOV A,D  STA IODCDO ;SEND DATA MVI B,DCDP ;WAIT UNTIL DATA PRESENT MVI C,0  CALL STATCH  JZ SFT400 ;FAILED-NO CHAR REC'D  LDA IODCDI ;GET CHARACTER MOV B,A ;SAVE ; CHECK PARITYSFT200 EQU $  LDA IODCST ;DATACOM STATUS  MOV C,A ;SAVE  ANI DCPE ;PARITY ERROR BIT SET? LXI H,STPARE ;PARITY ERROR MSG PTR  JNZ SFT400 ;YES, ERROR ; OVERRUN ERROR? MOV A,C ;STATUS  ANI DCOE ;CHECK BIT LXI H,STOVRE ;MSG POINTER JNZ SFT400 ;ERROR ; CHECK CHARACTER  MOV A,B ;DATACOM CHARACTER CMP D ;SAME AS SENT? LXI H,STDATA ;ERROR POINTER JNZ SFT400 ; DO NEXT CHARACTER  INR D ;BUMP TO NEXT CHARACTER  JZ SFT260 ;WAS 8 BIT TEST, DONE  JP SFT170 ;.LE. 177B LDA TPARIT ;NO PARITY?  CPI DCNP JZ SFT170 ;YES, USE 8 BITS;  ; DO NEXT PARITY SETTING ; SFT260 EQU $  LDA TPARIT  CPI DCNP JZ SFT280 ;NO PARITY, USE ODD NEXT CPI DCOP ;ODD PARITY  JNZ SFT300 ;NO, MUST BE DONE  MVI A,DCEP ;DO EVEN PARITY  JMP SFT130 SFT280 EQU $  MVI A,DCOP ;ODD PARITY  JMP SFT130  ;*************; TEST OTHER *; BAUD RATES *;*************SFT300 EQU $  MVI D,7 ;BAUD COUNTER SFT320 EQU $  DCR D ;DO NEXT BAUD RATE JZ SFT340 ;ALL BAUD RATES TESTED MOV A,D ;FORMAT CONTROL WORD RLC ;SHIFT TO BITS 1-3 MVI B,DCNP ;NO PARITY ADD B  STA IODCCT ;SET NO PARITY AND BAUD  SUB A  STA IODCDO ;SEND NULL MVI B,DCDP  MVI C,0  CALL STATCH ;WAIT FOR DATA LXI H,STDATA ;ERROR MSG JZ SFT400 ;NO DATA RECEIVED  LDA IODCDI ;GET DATA  ORA A ;IS IT ZERO? JNZ SFT400 ;NO, ERROR MVI A,377Q ;SEND ALL ONES STA IODCDO CALL STATCH  JZ SFT400 ;ERROR LDA IODCDI ;CHECK DATA  INR A  JNZ SFT400 ;NOT 377, ERROR  JMP SFT320 ;DO NEXT BAUD RATE ;******** ; TEST * ; LINES * ;******** SFT340 EQU $  LXI D,LINTBL ;TABLE OF PATTERNSSFT360 EQU $  LDAX D ;GET DATACOM CONTROL WORD  INR A ;END?  JZ SFT380 ;DONE, ALL TESTS PASSED  DCR A ;RESTORE A ; SET DATACOM CONTROL STA IODCCT  MVI B,DCCB ;CHECK CB  INX D ;BUMP TO NEXT TABLE ENTRY  LDAX D  MOV C,A  CALL STATCH LXI H,STCB  JZ SFT400 ;CB ERROR  MVI B,DCCF ;CHECK CF  INX D  LDAX D  MOV C,A  CALL STATCH LXI H,STCACF  JZ SFT400 ;ERROR MVI B,DCSB ;CHECK SB  INX D  LDAX D  MOV C,A  CALL STATCH LXI H,STBKSB  JZ SFT400 ;ERROR;  INX D ;BUMP TO NEXT TEST SET JMP SFT360  ;***************; REPORT FINAL *; STATUS BACK *;***************; ; GOOD STATUS ; SFT380 EQU $  LXI H,STGOOD ;GOOD STATUS ANA A ;CLEAR CARRY JMP SFT520 ;FINISH ; ; ERRORS; SFT400 EQU $  SHLD MSGPT4 ;SET FAIL MSG  LXI H,STFAIL ;FAIL LITERAL  STC ;SET CARRY TO INDICATE ERROR;*********; RETURN *;*********SFT520 EQU $  PUSH PSW ;SAVE FLAGS  SHLD MSGPT3 ;SET MESSAGE TYPE  MVI B,DCDP ;CLEAR CHARACTER INPUT BUFFE MVI C,0 Ԁ.OԀV../\gCAPABILITY ERRORgOP CODE ERR gILLEGAL STATUSONRUITENOP gӈwx@wۃ8/wՙggggggo_/g/ïg  PP a'Z/MhFYdh`Z`;_hheke)$ i.L&`i;Mi3L0i7'(% Xk&r~h|`'\Yi+i4si8i9i5i6i:i<ߛ!i*&$_.NMy)@<_['L&MXLMMkG%kO$Lf$$$$$$$ $_AP@$### ki-cki2i/kki0kki1_c(# dNa((Ef^[H270Y00000 001,YQ_52_44444444444444444443!333m333333 33 3 3pY5KIW>>,EED=;[8N;8888 87776IMJ VERSION 0 VERSN1 EQU 121Q ;Q => VERSION 1 ; ; NOTE: THE SECOND ROM WAS RE-ORDERED TO FIX; A BUG, SO ONLY THAT ROM HAS VERSION NUMBER 1.; ; ; COMMON EQUATES - CM35 - 6/27/76 - 1830 HOURS ; 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 TRANSMINOTEST EQU 4Q ;INHIBIT TERMINAL SELF-TEST EDTWRP EQU 10Q ;INVERT SENSE OF EDIT WRAPPRNTAL EQU 20Q ;SEND ALL CODES TO PRINTERDCJMP0 EQU 200Q ;DATA COMM JUMPER ;*****************************************; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *;*****************************************DCJMP1 EQU 1Q ;DATA COMM JUMPERSDCJMP2 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 AROUNDFRCRST EQU 4Q ;FORCE FULL TERMINAL RESETDEFSKY EQU 10Q ;DEFINE SOFT KEY MODE ENABLEREMSET EQU 20Q ;REMOTE MODE ENABLEDRCVMDE 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 INTERRUPTDCIOFF EQU 20Q ;DISABLE DATA COMM INTERRUPTTMIOFF EQU 40Q ;DISABLE TIMER INTERRUPTS POLL EQU 100Q ;POLL CTU INTERRUPTSSETROM EQU 200Q ;DISABLE (1)/ENABLE (0) ROM ;*********************************; MDFLG1 - TERMINAL MODE FLAGS 1 *;*********************************DSPFNC EQU 1Q ;DISPLAY FUNCTIONS ENABLEDINSCHR EQU 2Q ;INSERT CHARACTER ENABLED MEMLOK EQU 4Q ;MEMORY LOCK ENABLEDFORMAT EQU 10Q ;FORMAT MODE ENABLEDEDIT EQU 20Q ;EDIT MODE ENABLEDSELECT EQU 40Q ;SELECT MODE ENABLEDRECORD EQU 100Q ;RECORD MODE ENABLEDFORGN EQU 200Q ;FOREIGN MODE ENABLED ;*********************************; MDFLG2 - TERMINAL MODE FLAGS 2 *;*********************************CAPSLK EQU 1Q ;CAPS LOCK ENABLEDBLKMDE EQU 2Q ;BLOCK MODE ENABLED AUTOLF EQU 4Q ;AUTO LF ENABLEDREMOTE EQU 10Q ;REMOTE ENABLED WBSR EQU 40Q ;WRITE-BACKSPACE-READ MODE;********************************************** ; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * ;********************************************** DECRDX EQU 10 ;DECIMAL NUMBERSOCTRDX EQU 8 ;OCTAL NUMBERS  ;******************* ; COMMON VARIABLES * ;******************* INTVEC EQU FSTRAM+145Q ;CENTRAL INTERRUPT VECTORSCNVEC EQU INTVEC+3 ;FOREIGN TERMINAL DISPLY SCA; COMMON EQU 177777Q ;UPPER LIMIT OF COMMON AREA CMBASE EQU COMMON/256 ;MSB OF COMMON ADDRESSESCMSTOR EQU CMBASE*256 ;MSB ADJUSTMENT FACTOR; DISPST EQU COMMON-1 ;DISPLAY REFRESH START PTRTRMTYP EQU DISPST-1 ;TERMINAL TYPE NUMBER KBDCSW EQU TRMTYP-1 ;KEYBOARD DATACOM SWITCHESKBJMPR EQU KBDCSW-1 ;KEYBOARD STRAPSKBJMP2 EQU KBJMPR-1 ;SET 2KBJMP3 EQU KBJMP2-1 ;SET 3CMFLGS EQU KBJMP3-1 ;COMMON FLAGS ERRFLG EQU CMFLGS-1 ;ERROR FLAGSINTFLG EQU ERRFLG-1 ;INTERRUPT FLAG PRCCTL EQU INTFLG-1 ;PROCESSOR CONTROL FLAGSMDFLG1 EQU PRCCTL-1 ;TERMINAL MODE FLAGS 1MDFLG2 EQU MDFLG1-1 ;AND 2MSGPT1 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 PARAMETERSRNGTA EQU RADIX-2 ;CHAR FUNCTION TABLE ADDRESSESCFLG EQU RNGTA-1 ;ESCAPE SEQUENCE FLAG ; = 0, NOT IN ESCAPE SEQ; # 0, ESC SEQ IN PROGRESSRSTTMR 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 KEYBOARDZGETKY 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 LEDZSTJPR EQU ZCLXMT+3 ;SET JUMPERS ESC SEQ ROUTINEZSTLKY EQU ZSTJPR+3 ;SET LATCHING KEYS ROUTINEZALPCK EQU ZSTLKY+3 ;ALPHA KEY ENTRY CHECKZNUMCK 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 KEYBOARDUNLKKB EQU 2 ;UNLOCK KEYBOARDRPTKEY EQU 3 ;REPEAT LAST KEY HITSTBLMD EQU 4 ;SET PERMANENT BLOCK MODE STRTST EQU 5 ;START SELF-TESTENDTST EQU 6 ;END SELF-TESTRSETKB EQU 7 ;RESET KEYBOARD CKIOKY EQU 8 ;CHECK FOR I/O CONTROL KEYSTPRPT EQU 9 ;STOP KEY REPEATCKBRKY EQU 10 ;CHECK FOR BREAK KEY DOWN SWCHAR EQU 11 ;SWITCH CHARACTER SET SETFRN EQU 12 ;UPDATE FOREIGN MODESTCHST EQU 13 ;SET FOREIGN OUTPUT MODEFRNMD1 EQU 14 ;SET FOREIGN MODE 1 FRNMD2 EQU 15 ;SET FOREIGN MODE 2  ;*************************************************;  ; DATACOM CONSTANTS ; ;*************************************************ZDCBAS EQU 50000Q ;DATACOM START ADDRESSTRIGGR 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 MASKDCJMS2 EQU DCJMSK+1 ;DATA COMM JUMPER MASK #2 ;*************************************************; ; DATACOM ENTRY VECTOR POINTERS; ;*************************************************ZINIDC EQU ZDCBAS+10Q ;INITIALIZE DATACOMZIN2DC EQU ZINIDC+3 ;INITIALIZATION CONTINUATOR ZDCMON EQU ZIN2DC+3 ;MONITORING ROUTINE ZDCCTL EQU ZDCMON+3 ;MISC CONTROL FUNCTIONS ZDCTST EQU ZDCCTL+3 ;SELF-TESTZGETDC EQU ZDCTST+3 ;GET DC CHARACTER ZPUTDC EQU ZGETDC+3 ;PUT DC CHARACTER ZGTBIN EQU ZPUTDC+3 ;GET BINARY DC CHARACTERZSTBIN EQU ZGTBIN+3 ;START BINARY OUTPUTZNDBIN EQU ZSTBIN+3 ;END BINARY OUTPUTZDCINT EQU ZNDBIN+3 ;DATACOM INTERRUPTS ;*************************************************; ; DATACOM CONTROL CALL CODES ; ;*************************************************CLRTRG EQU 0 ;CLEAR BLOCK TRANSFER TRIGGESETTRG EQU 1 ;SET BLOCK TRANSFER TRIGGER RSETDC EQU 2 ;RESET DATACOMSETREM EQU 3 ;SET REMOTE MODESETLCL EQU 4 ;SET LOCAL MODE PUTBRK EQU 5 ;OUTPUT BREAK SIGNALDISCNT EQU 6 ;MODEM DISCONNECT ENDBLK EQU 7 ;TERMINATE OUTPUT MESSAGE SETMON EQU 8 ;ENTER MONITOR MODE SETNRM EQU 9 ;ENTER NORMAL MODEFSTBIN EQU 10 ;ENTER FAST BINARY OUT MODE SNDATN EQU 11 ;SEND ATTENTION CODESNDFCT EQU 12 ;SEND FUNCTION DATA PROMPT EQU 13 ;SEND PROMPT CODE  ;****************************** ; ALTERNATE I/O ENTRY VECTORS * ;****************************** ALTORG EQU 60000Q ;ALTERNATE I/O START ADDRESSZINIAL EQU ALTORG+2 ;INITIALIZATION ROUTINE ZIN2AL EQU ZINIAL+3 ;INITIALIZATION CONTINUATOR ZINTAL EQU ZIN2AL+3 ;INTERRUPT PROCESSORZMONAL EQU ZINTAL+3 ;MONITORING ROUTINE ZGETAL EQU ZMONAL+3 ;INPUT ROUTINEZPUTAL EQU ZGETAL+3 ;OUTPUT ROUTINE ZCTLAL EQU ZPUTAL+3 ;CONTROL ROUTINEZSTAAL EQU ZCTLAL+3 ;STATUS ROUTINE ZMSGAL EQU ZSTAAL+3 ;ALTERNATE DEVICE NAME ;************************** ; ASCII CHARACTER EQUATES * ;************************** NULL EQU 0Q ;NULL LF EQU 12Q ;LINE FEEDFF EQU 14Q ;FORM FEEDCR 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 BLANKAMPSND EQU 46Q ;(&) - AMPERSANDQUOTE EQU 47Q ;(') - SINGLE QUOTE ARPARN EQU 51Q ;[)] - RIGHT PARENTHESISPLUS EQU 53Q ;PLUS SIGNCOMMA EQU 54Q ;COMMAMINUS EQU 55Q ;MINUS SIGN PERIOD EQU 56Q ;(.) - PERIOD SLANT EQU 57Q ;(/) - SLANTZERO EQU 60Q ;ASCII ZERO TWO EQU 62Q ;ASCII TWOTHREE EQU 63Q ;ASCII THREEFOUR EQU 64Q ;ASCII FOUR FIVE EQU 65Q ;ASCII FIVE SIX EQU 66Q ;ASCII SIXSEVEN 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 P EQU 120Q ;UPPER CASE P 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 FIELDENDPR EQU 301Q ;END PROTECTED FIELDXMONLY EQU 302Q ;START TRANSMIT-ONLY FIELDFILL EQU 303Q ;EOL FILL CHARACTER STPFLG EQU 304Q ;NON-DISPLAYING TERMINATORALPHA EQU 305Q ;ALPHABETIC ONLYNUMBER EQU 306Q ;NUMERIC ONLY ALPHNM EQU 307Q ;ALPHANUMERIC FIELD SFKYAT EQU 310Q ;SOFT KEY ATTRIBUTE FIELD ; FLDSEP EQU 304Q ;FIELD SEPARATOR FOR I/O BUFEOL EQU 314Q EOP EQU 316Q LNKLIM EQU 320Q ;LOWEST VALUE FOR A LINKNUM2K EQU 4000Q ;NUMBER 2048 (2K) B15 EQU 100000Q ;BIT 15 JMP EQU 303Q ;JUMP INSTRUCTION CODERET EQU 311Q ;RETURN INSTRUCTION CODE ;************************ ; MISCELLANEOUS EQUATES * ;************************ MAXROW EQU 23 ;MAXIMUM ROW NUMBER MAXCOL EQU 79 ;MAXIMUM COLUMN NUMBERSFTEND EQU 16 ;LAST SOFT KEY DEFINITION ROBELLIM EQU 8 ;SPACE FROM RHTMGN FOR BELL BLKSM EQU 17Q ;BLOCK SIZE MASKBLKSZ EQU 16 ;BLOCK SIZE IOERRB EQU 10Q ;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 SECNOSIGN EQU 200Q ;NO SIGN FLAG FOR INPUT DATA  ;********************* ; I/O MODULE EQUATES * ;********************* RESET EQU 0Q ;RESET TERMINAL VECTORRSTJMP 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 ADDRESSIOKBCO EQU IOKB+200Q ;RESET KEY CONTROL RSTON EQU 2Q ;RESET ONRSTOFF EQU 4Q ;RESET OFF NMFCTK EQU 8 ;NUMBER OF FUNCTION KEYS;  ; CURSOR CONTROL ; IODISP EQU (7Q+IOBASE)*256;MODULE 13 BASE ADDRESSIOCRCL EQU IODISP+0 ;CURSOR COLUMN ADDRESSIOCRRW EQU IODISP+40Q ;CURSOR ROW ADDRESS MAYEOP EQU 40Q ;DMA ON, EOP IF DMA ROW = ROMAYEOL EQU 100Q ;DMA OFF, SKIP EOP IF ROWS =DMAOFF EQU 140Q ;DMA OFFCRTOFF 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 ADDRESIOCTCO EQU IOCTU+0Q ;COMMAND TO CTU IOCTSI EQU IOCTU+0Q ;STATUS FROM CTUIOCTDO EQU IOCTU+40Q ;DATA TO CTU IOCTDI EQU IOCTU+40Q ;DATA FROM CTU  ; ; 9866 PRINTER ; IOPTR1 EQU (15Q+IOBASE)*256;MODULE 16 BASE ADDRESPTROT1 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 ADDRESSPTROT2 EQU IOPTR2+100Q ;INTERFACE CONTROL OUT PTRST2 EQU IOPTR2+40Q ;PRINTER STATUS INPTRDA2 EQU IOPTR2+140Q ;PRINTER DATA OUTPTRCF2 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 READYPTRPO1 EQU 200Q ;PRINTER OUT OF PAPER  ;************************* ; RS-232 PRINTER EQUATES * ;************************* PTRDY2 EQU 2 ;PRINTER READY MASK PTRSB2 EQU 100Q ;RS-232 SB LINE STROBEPTROL2 EQU 40Q ;PRINTER READY MASK PTRHD2 EQU 340Q ;RS-232 HANDSHAKE PROTOCOLPTRBD2 EQU 37Q ;PARITY AND BAUD RATE MASK ;**************************** ; VARIABLE SPACE ALLOCATION * ;**************************** DSPLIM EQU 175777Q ;DISPLAY UPPER LIMITLWDSP 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 ADDRESSEBASE EQU BASEH*256 ;DATA PAGE BASE ADDRESSBASEH2 EQU BASEH-1 ;BASE VALUES FOR SECOND PAGEBASE2 EQU BASEH2*256 ;OF VARIABLES SPACE ;***************************; VARIABLE SUBROUTINE CALL *;***************************ECONTF EQU OPSTOR-3 ;JUMP SUBROUTINECNTFAD 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; LINELSTLIN 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 SETTINGRHTMGN 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 HEADDSPBGN EQU FRBLKS-2 ;LOW ADDRESS OF DISPLAY AREADSPEND EQU DSPBGN-2 ;HIGH ADDR OF DISPLAY AREASFTKYS EQU DSPEND-2 ;SOFT KEY DISPLAY START ADDRCURFKY EQU SFTKYS-2 ;CURRENT FUNCTION KEY CHARTLINO EQU CURFKY-1 ;TOP LINE ABSOLUTE ROW NUMBELLINE EQU TLINO-2 ;LAST DISPLAY LINE START ADDFLINE 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 STORAGECHARIN EQU TEMP-1 ;CHARACTER FROM KEYBOARDNCHAR EQU CHARIN-1 ;NUMBER OF CHARS TO BE ADDEDNROWS EQU NCHAR-1 ;NO. OF ROWS TO BE ADDEDNBLKS EQU NROWS-1 ;NO. OF BLOCKS TO BE ADDEDCHSAV EQU NBLKS-1 ;SAVE AREA FOR CHAR ; PRECEDING LINKLNKSAV EQU CHSAV-2 ;LINK SAVE AREA EOLADR EQU LNKSAV-2 ;ADDR OF LAST EOL FRSTBL EQU EOLADR-2 ;FIRST BLOCK IN DISPL1BLKFIL EQU FRSTBL-1 ;FILL FLAG FOR FNDCHR EOLMV EQU BLKFIL-1 ;FLAG FOR EOLMOVFILCHR EQU EOLMV-1 ;FILL CHAR SAVE FOR GTBLK BFSPCE EQU 147777Q ;UPPER LIMIT OF BUFFERLWBUF EQU 130000Q/256 ;LOWER LIMIT BUFBGN EQU FILCHR-2 ;LOW ADDR OF NON-DISPLY BUFFBUFEND EQU BUFBGN-2 ;HIGH ADDR FOR BUFFER ;**************************************** ; STORAGE FOR CHARACTERS TO BE STORED * ;**************************************** FMTCTL EQU BUFEND-1 ;FORMAT CONTROL TO BE ENTEREDCHAR EQU FMTCTL-1 ;NEXT CHAR TO BE DISPLAYEDCHAR EQU DCHAR-1 ;CURRENT CHAR BEING PROCESSECHKRTN 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 FILLNMROLL EQU COUNT-1 ;NUMBER OF LINES TO ROLLROLLCT EQU NMROLL-1 ;ROLL COUNTER ; NEWCOL EQU PARM1 ;NEW COLUMN NUMBERNEWROW EQU PARM2 ;NEW ABSOLUTE ROW NUMBERSCRNRW 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 OUTGETADR 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 PENDINGSSTAT EQU 2Q*256 ;TERMINAL STATUS PENDINGSSTAT2 EQU 4Q*256 ;TERMINAL STATUS 2 PENDINGSDVST EQU 10Q*256 ;DEVICE STATUS PENDINGSCRSEN 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 PENDINGSBINRY EQU 2Q ;BINARY RECORD PENDINGRELSNS EQU 4Q ;RELATIVE CURSOR SENSEESCINP EQU 10Q ;ESC RECEIVED IN BLOCK MODE FRSOUT EQU 20Q ;FIRST SOFT KEY DATA OUTWRPDEL EQU 40Q ;DELETE CHAR W/ WRAP AROUND WRPFLG EQU 100Q ;LINE WRAP AROUND OCCURREDNWRWST 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 COMNOSEND EQU 4Q ;NO DISPLAY DATA TO SENDSKPTRM EQU 10Q ;SKIP BLOCK TERMINATORFCTK2D EQU 20Q ;FUNCTION KEY TO DISPLAYKBDLOK EQU 100Q ;KB LOCKED BY ESCAPE SEQUENCXBF2DS EQU 200Q ;I/O BUFFER TO DISPLAY MODE  ;********************************************** TRMFCT EQU DFLGS-1 ;NON-DISPLAYING TERMINATOR;********************************************** STPXFR EQU -1 ;TERMINATE TRANSFER DELTRM EQU 0 ;DELETE TERMINATORIGNTRM EQU 1 ;IGNORE TERMINATOR;****************************************** SPOWL EQU TRMFCT-1 ;SPACE OVERWRITE LATCH;****************************************** SPOWON EQU 40Q ;SPOW LATCH ONSPOWOF EQU 377Q ;SPOW LATCH OFF ;*************************************************MLKROW EQU SPOWL-1 ;MEMORY LOCK ROWMLKFLG EQU MLKROW-1 ;MEMORY LOCK FLAG LCHAR EQU MLKFLG-1 ;LAST CHARACTER PROCESSED TCHAR EQU LCHAR-1 ;CURRENT TEST PATTERN CHARCRAFLG 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 40QHOL EQU 20Q ;TAPE HOLETAK 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 READFILRED EQU 4Q ;FILE READRECRWD EQU 10Q ;RECORD DISPLAY AND REWIND; OLD OUTPUT CTU (LOGGING)RECINI EQU 20Q ;START "RECORD" MODERECPGE 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 COMXDS2BF EQU 40Q ;TRANSFER DISPLAY TO BUFFER DSPBTM EQU 100Q ;BOTTOM OF DISPLAY REACHEDENDDSP EQU 200Q ;END OF DISPLAY REACHED  ;******************************** UNIT0 EQU IOFLG2-1 ;UNIT STATUS;******************************** LPM EQU 1Q ;TAPE AT OR BEFORE LOAD POINLSTFWD EQU 2Q ;TAPE LAST MOVED FORWARDFPS EQU 4Q ;TAPE WRITE PROTECTED CMDEXC EQU 10Q ;SUCCESSFUL COMMAND EXECUTIODBLHOL EQU 20Q ;DOUBLE HOLE FOUNDBOT EQU 40Q ;TAPE PAST BOT HOLESLP EQU 100Q ;TAPE PAST LP HOLEEW EQU 200Q ;TAPE PAST EW HOLE;*******************************************CNTRL0 EQU UNIT0-1 ;DATA TRANSFER FLAGS: * ;*******************************************EOF EQU 1Q ;END OF FILEEVD EQU 2Q ;END OF VALID DATAHRDERR EQU 4Q ;HARD ERROR SFTERR EQU 10Q ;SOFT ERROR HRDER1 EQU 20Q ;INTERRUPT ERROR FLAG WRTERR EQU 40Q ;WRITE ERRORDATATR EQU 100Q ;DATA RECORDED;***********************************************RELTAK EQU CNTRL0-1 ;GAP LENGTH COUNTER ;****************************************** ABSTAK EQU RELTAK-2 ;ABSOLUTE TACH COUNTER;****************************************** STRTAK EQU 40137Q ;STARTING VALUE ;*************************************************FILNUM EQU ABSTAK-1 ;CURRENT FILE NUMBERSFTCNT 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 TAPEFWD 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 UNITDISPLY EQU 4Q ;DISPLAYPRINTR EQU 10Q ;PRINTERALTIO EQU 20Q ;ALTERNATE I/ODATCOM EQU 40Q ;DATA COMMBUFBSY EQU 200Q ;BUF HELD BY UNSPECIFIED DEV SCNCNT EQU CMND-1 ;NUM. OF KBSCAN PER CTU SCANCTBLNK EQU SCNCNT-1 ;BLINK MASK FOR EJECT LIGHTSCTBLTM EQU CTBLNK-1 ;BLINK TIMERCTBDLY EQU 40Q ;BLINK DELAYHOLCNT 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 OCCURREDINPDEV EQU IOCERR-1 ;CURRENT INPUT DEVICE OUTDEV EQU INPDEV-1 ;CURRENT OUTPUT DEVICEIOCDPT EQU OUTDEV-1 ;DEVICE FLAG POINTERIOSTA3 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 LIMITB2DBUF 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 FLAGIOCOUT EQU PARM2 ;OUTPUT DEVICE ACCUMULATORIOCINP EQU PARM3 ;INPUT DEVICE ACCUMULATOR IOCTYP EQU PARM4 ;COMMAND MODIFIER FLAGIOCMND EQU PARM5 ;COMMAND TYPE FLAGIOCCNT 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=EVDB1LEN EQU B1TYPE-1 ;LENGTH OF RECORD B2STAT EQU B1LEN-1 ;STATUS OF SECOND BUFFERB2TYPE EQU B2STAT-1 ;TYPE (-1=NORM, 0=EOF, 1=EVDB2LEN 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 CT@@ ISPT-2 ;POINTER TO BUFFERCTICNT 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 REPEASWPCTU EQU LSTRED-1 ;SWAP CTU IN LOGGING MODE ; -1 = SWAP ENABLED ; 0 = DISABLED SAVINP EQU SWPCTU-1 ;"INPDEV" SAVE FOR LOCAL RCRSAVOUT EQU SAVINP-1 ;SAVE OUTDEV DURING LCL READ; ; DATA FOR FORMAT DISPLAY STORAGE; ENDCOL EQU SAVOUT-1 ;ENDING COLUMN AND ROW FORENDROW 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 * ;******************** PTRBBG EQU DEVFLG-2 ;START OF PRINTER BUFFERPTRSPT 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 OCCURREDPTRFLG EQU PTRABT-1 ;PRINTER TYPE FLAG; = 0, NO PRINTER ; = 1, PARALLEL INTERFACE ; = 2, RS-232 INTERFACE  ;******************************** ; ENTRY VECTORS TO I/O ROUTINES * ;******************************** ; ; KEYBOARD INITIATED FUNCTIONS ; IOORG EQU 24000Q ;START OF I/O CODEIOCKEY EQU IOORG+2 ;I/O CONTROL KEYREDKEY EQU IOCKEY+3 ;READ KEY CTLRED EQU REDKEY+3 ;CONTROL READ KEY RECKEY EQU CTLRED+3 ;RECORD KEY SELKEY EQU RECKEY+3 ;SELECT KEY TSTCTU EQU SELKEY+3 ;CTU SELF-TESTCONDTN EQU TSTCTU+3 ;CONDITION CARTRIDGE TAPESRSTCTU EQU CONDTN+3 ;SOFT RESET FOR CTU ; ; EXTERNALLY INITIATED FUNCTIONS ; IOCNTL EQU RSTCTU+3 ;I/O CONTROL ESCAPE SEQUENCEIOSTGO EQU IOCNTL+3 ;SEND DEVICE STATUS IODNGO EQU IOSTGO+3 ;SEND COMPLETION CODE IORDGO EQU IODNGO+3 ;SEND I/O RECORDRCRDGO EQU IORDGO+3 ;START REMOTE RECORD FUNCTIOBNRYGO EQU RCRDGO+3 ;SEND BINARY DATA CTDCDP EQU BNRYGO+3 ;SEND BINARY FILE  ;******************** ; INTERNAL ROUTINES * ;******************** CTMON EQU CTDCDP+3 ;MONITOR CARTRIDGE DRIVES PTTPLN EQU CTMON+3 ;PUT TOP LINE ONTO I/O DEV'SDO0CTI EQU PTTPLN+3 ;INITIAL CTU INTERRUPT VECTORDABRT EQU DO0CTI+2 ;ABORT USER INITIATED READBSYCHK EQU RDABRT+3 ;WAIT UNTIL TAPE I/O DONE CTINTR EQU BSYCHK+3 ;CTU INTERRUPT ROUTINE  ;******************** ; TERMINAL START-UP * ;********************  ORG 0QBEGIN EQU $  DB VERSN ;ROM PRESENT FLAGS DB BEGIN/256 ;(= MOV D,B; NOP)  DI ;DISABLE INTERRUPTS  MVI A,SETROM+TMIEN+TMRON JMP GO ;GO TO START UP ROUTINE ;*****************************; FIRMWARE INVOKED INTERRUPT *;***************************** PCHL ;USE AS PCHL SUBROUTINE CALL ORG BEGIN+20Q ;************************** ; TOP PLANE INTERRUPT 20B * ;**************************  PUSH PSW ;SAVE A-REGISTER AND FLAGS ORA A ;CLEAR C-FLAG  MVI A,TWO ;SET INTERRUPT CODE  JMP INTRPT ;HANDLE UNKNOWN INTERRUPTS ORG BEGIN+30Q ;****************** ; TIMER INTERRUPT * ;******************  PUSH PSW ;SAVE A-REGISTER, FLAGS  PUSH B ;AND REGISTER B AND C  MVI A,THREE ;SET INTERRUPT CODE  JMP TMINTR ;CONTINUE TIMER ROUTINE  ORG BEGIN+40Q ;********************** ; DATA COMM INTERRUPT * ;**********************  PUSH PSW ;SAVE A-REGISTER AND FLAGS MVI A,FOUR ;SET INTERRUPT CODE  JMP DCMINT ;CONTINUE INTERRUPT PROCESS  ORG BEGIN+50Q ;*********************** ; I/O DEVICE INTERRUPT * ;***********************  PUSH PSW ;SAVE A-REG, STATUS  PUSH H ;AND H,L MVI A,FIVE ;SET INTERRUPT CODE  JMP IOINTR ;CONTINUE I/O ROUTINE  ORG BEGIN+60Q  ;************************** ; TOP PLANE INTERRUPT 60B * ;**************************  PUSH PSW ;SAVE A-REGISTER AND FLAGS ORA A ;CLEAR THE C-FLAG  MVI A,SIX ;SET INTERRUPT CODE  JMP INTRPT ;HANDLE UNKNOWN INTERRUPTS ORG BEGIN+70Q ;*********************** ; TEST POINT INTERRUPT * ;***********************  PUSH PSW ;SAVE A-REGISTER AND FLAGS ORA A ;CLEAR THE C-FLAG  MVI A,SEVEN ;SET INTERRUPT CODE  JMP INTRPT ;HANDLE UNKNOWN INTERRUPTS ORG BEGIN+100Q  ;******************************** ; VECTORS TO MAIN CODE ROUTINES * ;******************************** ZDSPMS:JMP DSPMSG ;DISPLAY MESSAGE JMP RSTDSP ;RESTORE NORMAL DISPLAY  JMP DCNUM ;ACCUMULATE DIGIT AND SIGN JMP DCPLUS ;FOR PARAMETERIZED ESCAPE  JMP DCMNUS ;SEQUENCES JMP ESCEND ;TERMINATE ESCAPE SEQUENCE JMP CHKLIM JMP CLBLXF JMP SBLXF0  JMP SBLXFA ;KEYBOARD INITIATED BLK XFR  JMP STRTBL ;START BLOCK RECORD  JMP CURPH ;HOME CURSOR (-XMIT ONLY)  JMP CURPHD ;CURSOR HOME DOWN  JMP FRECNT ;CHECK NUMBER OF FREE BLOCKS JMP PTBLK ;RELEASE BLOCKS FROM DISPLAY JMP CLEARL ;CLEAR LINE  JMP CLEARS ;CLEAR DISPLAY FROM CURSOR JMP FNDTB2 ;SET BIT N (B-REG = N) JMP SDTERM ;SEND TERMINATORS  JMP SDTRM1 ;SEND TERMINATOR ONLY  JMP XPUTDC ;TRANSMIT CHARACTER IN A-REG JMP TRMTST ;TERMINAL SELF-TEST  JMP CHINT0 ;EXECUTE CHARACTER FUNCTION  JMP INITD0 ;INIT FOR DISPLAY GET  JMP GETDSP ;GET DISPLAY BYTE  JMP LNFEED ;DO LINE FEED  JMP EXPAND ;EXPAND DISPLAY CONTROL CHAR JMP NXTCHR ;GET NEXT DISPLAY CHARACTER  JMP GETDCM ;PROCESS DATA COMM INPUT JMP MLKSC0 ;LOCATE FIRST UNLOCKED ROW JMP MLKOF0 ;TURN OFF MEMORY LOCK  JMP HANGU0 ;HANG TERMINAL ON FATAL ERRO DW BUFMSG ;BUFFER OVERFLOW MESSAGE JMP DCTEST ;DATA COMM SELF-TEST JMP IORMGO ;EXECUTE CODE FROM OPTION RO JMP BN2DEC ;CONVERT BINARY TO DECIMAL JMP BN2DE0 ;CONVERT SINGLE BYTE TO DEC  JMP RCADRA ;LOCATE CURSOR LOCATION  JMP GTMODE ;CHECK FOR PAGE MODE ;*************************************; TERMINAL RESET - START UP TERMINAL *;*************************************GO EQU $  OUT PROCSR ;SET INITIAL PROCESSOR STATE STA PRCCTL ;SET PROCESSOR STATE LXI SP,STACK ;SET STACK POINTER LDA ECONTF  CPI JMP ;FIRST TURN ON? ;************************************************  JNZ INIT ;YES - INITIALIZE TERMINAL;************************************************  LDA CMFLGS ;NO - GET COMMON FLAGS ANI FRCRST ;FORCE FULL RESET? JNZ INIT ;YES - INITIALIZE TERMINAL LXI H,RSTTMR ;NO - GET SOFT RESET TIMER ORA M ;FULL RESET ACTIVE?  JZ GO010 ;NO - START SOFT RESET CPI SFTDLY ;STILL IN SOFT RESET START? ; (CAUSED BY CONTACT BOUNCE) JNZ INIT ;NO - DO FULL RESET GO010 EQU $ ;YES - RESTART SOFT RESET  MVI M,SFTDLY ;NO - SET 0.5 SEC TIME OUT ;**************** ; DO SOFT RESET * ;**************** GO1 EQU $ ;ENTRY FOR SOFT RESET  STA DFLGS ;CLEAR DATA TRANSFER FLAGS MVI A,RSETKB  CALL ZKBCTL ;RESET THE KEYBOARD  MVI A,RSETDC  CALL DCMCT1 ;RESET THE DATA COMM LXI H,RSTCTU ;RESET CARTRDIGE TAPES CALL IORMGO ;IF CTU CODE PRESENT CALL RSTDSP ;RESTORE NORMAL DISPLAY  EI ;ENABLE INTERRUPTS JMP START ;RESTART THE WAIT LOOP ;*********************************************; INIT - DO COMPLETE TERMINAL INITIALIZATION *;*********************************************INIT EQU $  XRA A ;CLEAR TO ZERO STA ECONTF ;CLEAR "JMP" TO FORCE FULL; RESET  LXI H,FSTRAM ;SET FIRST ADDRESSINI010 EQU $  MOV M,A ;SET BYTE TO ZERO  INR L ;ALL BYTES DONE? JNZ INI010 ;NO - CLEAR NEXT BYTE ;  ; CLEAR SLOW RAM AREA ;  MOV E,L ;SET E = 0 FOR 256 BYTES MVI H,IOBUF1/256 ;SET START ADDRESSINI020 EQU $  CALL CLRAL1 ;CLEAR A 256 BYTE SECTION  CMP H ;ALL SECTIONS CLEARED? JNZ INI020 ;NO - CONTINUE CLEARING ;***************************; LOCATE NON-DISPLAY SPACE *;*************************** LXI H,BFSPCE ;SET UPPER BOUNDARY ADDRESS  SHLD BUFEND ;OF NON-DISPLAY BUFFER ARE MVI B,LWBUF ;SET B TO MSB OF LOWER LIMIT CALL FNDRAM  SHLD BUFBGN ;STORE BUFFER START ADDRESS ;  ; LOCATE DISPLAY SPACE ;  LXI H,DSPLIM ;SET UPPER BOUNDARY ADDRESS  SHLD DSPEND ;OF DISPLAY AREA MVI B,LWDSP ;SET B TO MSB OF LOWER LIMIT CALL FNDRAM  SHLD DSPBGN ;STORE DISPLAY START ADDRESS ;********************************************** ; INITIALIZE PROCESSOR BOARD STATE, KEYBOARD, * ; AND DATA COMM * ;**********************************************  MVI A,SETROM+TMIEN+TMRON STA PRCCTL ;ENABLE ROM'S AND TIMER  MVI A,RET ;PUT RETURN CODE INTO  STA INTVEC ;INTERRUPT VECTOR AND  STA SCNVEC ;DISPLAY SCAN VECTOR; ********************************* ; * INTERRUPTS ARE ENABLED BY THE * ; * DISPLAY ROUTINES USED DURING * ; * INITIALIZATION OF SOFT KEYS * ; *********************************  CALL ZINIKB ;SET JUMPERS AND DC SWITCHES CALL ZINIDC ;FETCH BUFFER REQUIREMENTS CALL GETBUF ;ALLOCATE BUFFER SPACE CALL ZIN2DC ;COMPLETE DATA COMM INIT JC HANGU0 ;(PROCESS ERROR IF ANY) ;******************************** ; SET DEFAULT I/O CONFIGURATION * ;********************************  LXI H,1*256+2 ;OUTPUT = RIGHT CTU (2) SHLD OUTDEV ;INPUT = LEFT CTU (1) LHLD DO0CTI ;SET INITIAL CARTRIDGE TAPE  SHLD CTIVEC ;INTERRUPT VECTOR  MVI A,JMP ;SET JUMP COMMAND FOR  STA CTIJMP ;CTU INTERRUPT VECTOR ;*******************************************; IDENTIFY OPTION I/O INCLUDED IN TERMINAL *;******************************************* LXI H,ZINIAL ;INITIALIZE ALTERNATE I/O  CALL IORMGO ;DEVICE  MVI A,0 ;(SET FOR NO ALTERNATE I/O JC INI110 ;BYPASS INIT IF NO ALT I/O CALL GETBUF ;ELSE, ALLOCATED BUFFER  CALL ZIN2AL ;AND CONTINUE INIT MVI A,ALTIN ;SET ALT I/O PRESENT BITINI110 EQU $  MOV B,A ;SAVE ALTERNATE I/O STATUS LXI H,IOORG ;SET I/O START ADDRESS CALL IORMG1 ;DOES I/O CODE EXIST?  MOV A,B ;(GET CURRENT I/O OPTIONS) JNZ INI130 ;NO - DON'T SET I/O BIT  ORI CTUIN ;ELSE SET CTU PRESENT BIT  LXI H,TRMTYP ;SET TERM TYPE TO INDICATE INR M ;I/O CODE INCLUDEDINI130 EQU $  STA DEVFLG ;SET I/O OPTIONS FLAG  ;**************************************** ; GENERATE FREE BLOCKS LIST FOR DISPLAY * ;****************************************  LHLD DSPEND ;COMPUTE ADDRESS OF HIGHEST  LXI D,1-BLKSZ ;ADDRESSED DISPLAY BLOCK  DAD D  MOV A,L ;COMPUTE ADDRESS OF LSB PART ORI BLKSM ;OF PREVIOUS LINE POINTER  MOV L,A ;IN HIGHEST ADDRESSED  DCX H ;DISPLAY BLOCK MVI M,0 ;SET IT TO ZERO TO INDICATE  DCX H ;END OF FREE LIST  XCHG ;SET NEXT BLOCK LINK OF  LHLD DSPBGN ;LOWEST ADDRESSED DISPLAY  MOV M,E ;BLOCK TO POINT TO MSB INX H ;PART OF NEXT LINE LINK IN MOV M,D ;HIGHEST BLOCK XCHG ;SWAP HIGH AND LOW ADDRESSES INX D ;ADJUST LOW ADDR TO LOW LIMI; FOR LINKING DISPLAY BLOCKS DCX H ;SET FREE BLOCKS HEAD TO LSB SHLD FRBLKS ;PART OF NEXT LINE POINTER; IN HIGHEST BLOCK SUI BLKSZ-2 ;SET B,L TO ADDRESS OF MSB MOV B,H ;PART OF NEXT BLOCK POINTE MOV L,A ;IN HIGHEST DISPLAY BLOCK   ;******************** ; CHAIN FREE BLOCKS * ;******************** ; ; B,A = ADDRESS OF UPPER BYTE IN NEXT LOWER BLOCK; D,E = LOWER LIMIT OF DISPLAY AREA; H,L = ADDRESS OF MSB PART OF NEXT BLOCK LINK  ; IN CURRENT BLOCK ; INI210 EQU $  MOV A,L ;COMPUTE ADDRESS OF UPPERMOS SUI 2 ;BYTE IN NEXT LOWER BLOCK  JNC INI220  DCR B INI220 EQU $  MOV M,B ;LINK CURRENT BLOCK TO NEXT  DCX H ;LOWER BLOCK MOV M,A  SUI BLKSZ-2 ;SET H,L TO ADDRESS OF MSB MOV L,A ;PART OF NEXT BLOCK LINK I MOV H,B ;NEXT LOWER BLOCK  SUB E ;COMPARE AGAINST LOWER LIMIT MOV A,B  SBB D ;DISPLAY AREA EXHAUSTED? JNC INI210 ;NO - CONTINUE LINKING BLOCK; YES - SET UP INITIAL DISPLAY ; ; SET UP INITIAL SOFT KEYS DISPLAY ;  CALL INITDS ;START A NEW DISPLAY LIST  DCX H ;SET SOFT KEY START ADDRESS  SHLD SFTKYS ;TO FIRST CHARACTER  MVI A,CRTOFF ;SET CURRENT AND LAST ROW  STA CURROW ;TO CONTROL FOR DISPLAY OF STA LSTROW ;  ; SET UP KEY DEFINITIONS ;  LXI B,DSPSTR-1  LXI H,ATBLIN ;TRANSFER ATTRIBUTE LINE CALL MOVCHR  MVI C,NMFCTK ;SET NUMBER OF KEYS TO DEFIN;  ; BUILD ATTRIBUTE LINE ; INI310 EQU $  MVI A,ZERO+9 ;COMPUTE FUNCTION KEY NUMBER SUB C  STA DSPSTR-ATBLEN+2 ;  ; BUILD DEFINITION LINE ;  MVI A,SMALLX ;COMPUTE CHAR AFTER  SUB C ;(LOWER CASE

-)  LXI H,DSPSTR-CHRLOC  MOV M,A ;SET DATA CHARACTER  MVI L,DSPSTR-ATBLEN-BASE2  PUSH B ;TRANSFER SOFT KEY DEFINITIO CALL XMS2DS ;TO DISPLAY MEMORY POP B  DCR C ;ALL KEYS DEFINED? JNZ INI310 ;NO - DO NEXT KEY  ;*********************************************; SOFT KEYS DONE - SET INITIAL DISPLAY STATE *;********************************************* XRA A ;CLEAR LAST LINE POINTER STA LLINE  DCR A ;SET DISPLAY TYPE TO SOFT  STA DSPTYP ;KEY DISPLAY CALL CURPH ;HOME THE CURSOR CALL SWAP ;SAVE SOFT KEY PARAMETERS @@ ;***********************************; INITIALIZE FIRST LINE OF DISPLAY *;*********************************** CALL INITDS ;START A NEW DISPLAY LIST  ;************************* ; INITIALIZE I/O DEVICES * ;************************* ; ; PRINTER INITIALIZATION ROUTINE ; ; CHECK FOR 9866 PRINTER FIRST ;  LDA PTRST1 ;GET STATUS FROM 9866 PCA  ORA A ;IS INTERFACE INSTALLED? JZ PTRI10 ;NO - LOOK FOR RS-232 PRNTR  LDA PTRCL1 ;YES - CLEAR THE PRINTER MVI A,1 ;SET PRINTER FLAG FOR  JMP PTR120 ;9866 PRINTER (= 1) ; ; RS-232 PRINTER 2 ; PTRI10 EQU $ LDA PTRST2 ;GET STATUS FROM RS-232 PCA  ORA A ;IS RS-232 PCA INSTALLED?  JZ PTR120 ;NO - SET FOR NO PRINTER;  LDA PTRCF2 ;YES - GET CONFIG. STRAPS  ANI PTRBD2 ;ISOLATE BAUD AND PARITY RAL ;ADJUST FOR CONTROL OUTPUT STA PTROT2 ;SET BOARD TO CONFIGURATION  MVI A,2 ;SET FLAG FOR RS-232 PRINTER; PTR120 EQU $  STA PTRFLG ;SET PRINTER FLAG  LXI H,TRMRDY ;DISPLAY "TERMINAL READY"  CALL DSPMS1 ;MESSAGE MVI A,JMP ;SET JUMP COMMAND FOR  STA ECONTF ;CHARACTER FUNCTION VECTOR ;*******************************************; INITIALIZE FLAGS AND RANGE TABLE ADDRESS *;*******************************************START EQU $  CALL ESCEND ;RESET NORMAL RANGE TABLE  LDA FRSALT ;SET INITIAL ALTERNATE STA CHRSET ;CHARACTER SET CALL CRADV1 ;CLEAR CURSOR ADVANCE FLAG DCR A ;CLEAR SPOW LATCH  STA SPOWL  ; ; WAIT LOOP; WTLOOP EQU $  LXI SP,STACK ;SET STACK POINTER CALL GETDC1 ;SET DISPLAY CURSOR ;**************************** ; CHECK FOR DATA COMM INPUT * ;**************************** WTL010 EQU $  CALL GETDCM ;GET DATA COMM INPUT IF ANY ;***************************; CHECK FOR KEYBOARD INPUT *;*************************** LDA MFLGS2 ;GET MODE FLAGS  ANI ESCINP ;ESCAPE SEQUENCE LOCK OUT? JNZ WTL020 ;YES - IGNORE KEYBOARD LDA DFLGS ;NO - GET DATA TRANSFER FLAG ANI FCTK2D ;FUNCTION KEY TO DISPLAY?  CNZ GTFCTK ;YES - GET FUNCTION KEY CHAR JNZ WTL200 ;PROCESS IF AVAILABLE  CALL ZGETKY ;ANY KEYBOARD INPUT? JZ WTL200 ;YES - PROCESS IT ; ; IF KEYBOARD LOCKED, A = CHARACTER HIT, IF ANY  ; OTHERWISE A = 377B ;  CPI CR ;RETURN KEY HIT? JNZ WTL020 ;NO - CHECK CTU & DISPATCHER LDA IOFLGS ;USER READ OR FILE READ  ANI USREAD+FILRED ;PENDING? CNZ RDABRT ;YES - ABORT READ KEY  ;****************************************** ; CHECK CTU'S AND PENDING BLOCK TRANSFERS * ;****************************************** WTL020 EQU $  LXI H,SCNCNT ;DECREMENT SCAN COUNT  DCR M ;11 SCANS DONE?  JP WTL010 ;NO - RESTART DO NOTHING LOO MVI M,10 ;YES - RESET SCAN COUNT  CALL SCNVEC ;DO OPTIONAL DISPLAY SCAN  CALL IOCTMN ;MONITOR TAPE DRIVES CALL DSPTCH ;CHECK PENDING BLOCK XFRS  JMP WTL010 ;RESTART DO NOTHING LOOP ; ; KEY HIT - CHECK FOR FUNCTION KEY ; WTL200 EQU $  STA CHARIN ;SAVE KEYBOARD CHARACTER MOV C,A ;SAVE THE BYTE IN C-REGISTER MVI A,377Q-SDACOM  CALL CLRDFL ;CLEAR DATA COMM INPUT FLAG  LDA CMFLGS ;GET COMMON FLAGS  CMA ;BOTH RECEIVE MODE FLAG SET  ANI RCVMDE+REMSET ;AND REMOTE ENABLED?  JNZ WTL205 ;NO - PROCESS KEYBOARD INPUT CALL ZBELL ;YES - SOUND BELL AND  JMP WTL010 ;IGNORE KEY ; WTL205 EQU $  XRA A ;NO - PROCESS THE KEY  MOV D,A ;(SET A,D = 0) ORA C ;FUNCTION KEY? JP WTL300 ;NO - PROCESS ASCII KEY  CPI FNCLIM ;TABLE FUNCTION? JP WTL210 ;NO - CHECK FOR F1-F8  SUI FNCLWR ;COMPUTE TABLE INDEX ADD A  MOV E,A ;COMPUTE TABLE ADDRESS LXI H,FNCTAB ;(D = 0) DAD D  CALL CHAIN ;GET THE FUNCTION ADDRESS  RST RSTJMP ;G0 PERFORM FUNCTION JMP WTLOOP ;RESTART WAIT LOOP;  ; CHECK FOR F1-F8 KEY ; WTL210 EQU $  CPI F1CODE ;IS THE KEY F1-F8? JC WTL250 ;NO - EXPAND ESCAPE SEQUENCE CPI F8CODE+1  JNC WTL250 ;NO - EXPAND ESCAPE SEQUENCE CALL CHKSFK ;SOFT KEY MODE?  CZ FCTKEY ;NO - PROCESS FCT KEY  JMP WTLOOP ;RESTART WAIT LOOP  ;************************ ; PROCESS FUNCTION KEYS * ;************************ WTL250 EQU $  MVI C,ESC ;SET ESCAPE AS INPUT CHAR WTL260 EQU $  CALL LOCLI0 ;PROCESS KEYBOARD INPUT  LXI H,CHARIN ;RECALL KEYBOARD INPUT MOV A,M  CPI ENHNCF ;DISPLAY ENHANCEMENT CODE? JZ WTL270 ;YES - EXPAND INTO AMPERSAND CPI STFOR1 ;ENTER FOREIGN MODE CONTROL? JZ WTL280 ;YES - CONTINUE SEQUENCE CPI STFOR2 ;COMPLETE FOREIGN MODE SET?  JZ WTL290 ;YES - SET ENDING SEQUENCE ANI 177Q ;NO - MASK OUT UPPER BIT CMP M ;FUNCTION COMPLETED? JZ WTLOOP ;YES - RESTART WAIT LOOP MOV M,A ;NO - SET NEW KEYBOARD CHAR  MOV C,A  JMP WTL260 ;PERFORM THE DESIRED FUNCTON; WTL270 EQU $  MVI M,ESCLWD ;SET - AS MVI C,AMPSND ;CURRENT KEYBOARD CHARACTE JMP WTL260 ;PROCESS AMPERSAND; WTL280 EQU $  DCR M ;SET TO NEXT STEP CODE MVI C,ARPARN ;ENTER RIGHT PARENTHESIS JMP WTL260 ;PROCESS RIGHT PARENTHESIS; WTL290 EQU $  MVI M,ESCSO ;SET - AS CURRENT MVI C,C ;KEYBOARD CHARACTER  JMP WTL260 ;PROCESS LETTER  ; ; DISPLAYABLE CHARACTER - CHECK FOR APPROACHING ; END OF LINE WARNING ; WTL300 EQU $  CPI CTLLIM ;CONTROL CODE? JC WTL310 ;YES - DON'T LOOK FOR BELL LDA DFLGS ;NO - GET DATA TRANSFER FLAG ANI FCTK2D ;PROCESSING FUNCTION KEY OR  CZ CHKFMS ;FORMAT/SOFT KEY MODE? JNZ WTL310 ;YES - SKIP BELL COLUMN CHEC LDA ESCFLG ;NO - GET ESCAPE SEQ FLAG  ORA A ;CURRENTLY IN ESCAPE SEQ?  JNZ WTL310 ;YES - DON'T LOOK FOR BELL LDA CURCOL ;NO - GET CURRENT COLUMN LXI H,RHTMGN ;COMPARE TO RIGHT MARGIN SUB M ;CLOSE ENOUGH TO RIGHT MARGI ADI BELLIM ;TO SOUND BELL?  CZ ZBELL ;YES - SOUND BELL ;***************************; PROCESS THE KEY FUNCTION *;***************************WTL310 EQU $  CALL LOCLIN ;PERFORM LOCAL INPUT ROUTINE LDA CHARIN ;RECALL KEYBOARD INPUT CHAR  CPI CR ;WAS IT A RETURN?  JNZ WTLOOP ;NO - RESTART WAIT LOOP  LDA MDFLG2 ;YES - GET MODE FLAGS  ANI AUTOLF ;AUTO LINE FEED ENABLED? JZ WTLOOP ;NO - RESTART WAIT LOOP  MVI L,1 ;YES - DELAY 10 MILLISECONDS CALL DELAY ;THEN SEND LINE FEED MVI A,LF JMP WTL200 ;FAKE LINE FEED FROM KEYBOAR  ;************************ ; S U B R O U T I N E S * ;************************ ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; CHINT - INTERPRET INPUT CHARACTER; ; ENTRY: C = INPUT CHARACTER; ; EXIT : Z - FAST STORE USED; NZ - FULL PROCESSING USED; A-E,L DESTROYED;  ; TRY FAST STORE FIRST ; CHINT0 EQU $ ;ENTRY FOR I/O INPUT LXI H,MFLGS2 ;SET H,L TO MODE FLAGS 2 MOV A,C ;PUT INPUT CHAR IN A-REG CPI LF ;CHARACTER = LINE FEED?  JNZ CHI000 ;NO - CHECK FOR CR/DC3 MOV A,M ;YES - GET MODE FLAGS 2  ORI WRPFLG ;TURN ON WRAP FLAG CMP M ;WRAP FLAG ALREADY ON? JZ CHINT ;YES - EXECUTE LINE FEED MOV M,A ;NO - SET WRAP FLAG  RET ;AND IGNORE LINE FEED ; CHI000 EQU $  CPI CR ;CHARACTER = RETURN? JZ CHINT1 ;YES - DON'T SET WRAP FLAG CPI DC3 ;CHARACTER = DC3?  JZ CHINT ;YES - DON'T SET WRAP FLAG MOV A,M ;NO - SET WRAP FLAG  ORI WRPFLG  MOV M,A ;UPDATE MODE FLAGS 2CHINT EQU $  LXI H,CRAFLG  MOV B,M ;WAS LAST CHARACTER FUNCTION DCR B ;A CURSOR ADVANCE? JM CHI100 ;NO - DO FULL PROCESSING MOV M,B ;YES - CLEAR FLAG  MOV A,C ;PUT INPUT CHARACTER IN A-RE CPI CTLLIM ;IS CHARACTER A CONTROL CODE JM CHI050 ;YES - CHECK FOR DISPLAY FCT; NO - DO FAST STORE ;  ; FAST STORE PROCESSING ; CHI010 EQU $  MVI L,SPOWL-BASE  MOV B,M ;GET THE SPOW LATCH IN B-REG LHLD CURADR ;GET LAST CHAR DONE ADDRESS  MOV A,M ;GET LAST CHARACTER DONE ORA A ;IS IT ASCII?  JM CHI100 ;NO - DO FULL PROCESSING DCX H ;YES - GET NEXT CHARACTER  MOV A,M  ORA A ;IS IT ASCII?  JP CHI020 ;YES - OVERLAY EXISTING CHAR CPI EOL ;IS IT EOL?  JNZ CHI100 ;NO - DO FULL PROCESSING MOV B,A ;YES - SAVE EOL AND CLEAR  DCX H ;SPOW LATCH COMPARE  MOV A,M ;GET NEXT CHARACTER  CPI FILL ;IS IT AN END OF LINE FILL?  JNZ CHI100 ;NO - DO FULL PROCESSING LDA CURROW ;YES - ADD CHAR TO DISPLAY ORI MAYEOL ;SET DMA OFF WITH EOL SKIP DI ;DISABLE INTERRUPTS  STA IOCRRW ;TURN OFF DMA  MVI A,RSTOFF ;DISABLE RESET KEY STA IOKBCO  MOV M,B ;STORE NEW EOL INX H ;SET TO OLD EOL ADDRESS  ; ; ADD CHARACTER TO DISPLAY ; CHI020 EQU $  MOV A,C ;RECALL THE INPUT CHARACTER  CMP B ;STORE INHIBITED BY SPOW?  JZ CHI030 ;YES - BYPASS STORE  MOV M,C ;NO - STORE THE BYTECHI030 EQU $  CALL DISLN1 ;TURN DISPLAY BACK ON  SHLD CURADR ;STORE NEW CURRENT ADDRESS LXI H,LSTCOL ;INCREMENT LSTCOL  INR M  CALL CURADV ;ADVANCE CURSOR ;**************************************** ; CHINT2 - SET CURSOR COLUMN ON DISPLAY * ;**************************************** ;  ; EXIT : Z TRUE ; A DESTROYED ; CHINT2 EQU $  CMP A  LDA CURCOL ;GET CURRENT COLUMN NUMBER STA IOCRCL ;SET DISPLAY CURSOR COLUMN RET ;RETURN ; ; CONTROL CODE - CHECK FOR DISPLAY FUNCTIONS ; CHI050 EQU $  CALL CKDSPF ;DISPLAY FUNCTIONS ENABLED?  JZ CHI100 ;NO - DO FULL PROCESSING MOV A,C ;YES - RECALL INPUT CHARACTE CPI CR ;IS IT RETURN CHARACTER? JZ CHI100 ;YES - DO FULL PROCESSING  CPI ESC ;IT IT AN ESCAPE?  JNZ CHI010 ;NO - DO FAST PROCESSING; YES - DO FULL PROCESSING ;  ; FULL PROCESSING ; CHINT1 EQU $ CHI100 EQU $  MOV H,C  MOV L,C ;SET "CHAR" AND "DCHAR" TO SHLD CHAR ;CURRENT CHARACTER CALL CRADV1 ;CLEAR CURADV FLAG;*******************************; DETERMINE CHARACTER FUNCTION *;******************************* LHLD RNGTA ;GET CURRENT RANGE TABLE ADD;****************************** ; ADVANCE TO NEXT TABLE ENTRY * ;****************************** CHI110 EQU $  INX H  INX H  INX H ;*************************************; COMPARE CHARACTER TO CURRENT RANGE *;************************************* MOV A,C ;PUT CHARACTER IN A-REGISTER SUB M ;CHARACTER >= LOWER BOUND? INX H ;(SET H,L TO UPPER BOUND)  JC CHI110 ;NO - ADVANCE TO NEXT ENTRY  RLC ;YES - DOUBLE DIFFERENCE AND MOV B,A ;SAVE VALUE IN B-REGISTER  MOV A,M ;GET UPPER BOUND CMP C ;CHARACTER <= UPPER BOUND? JC CHI110 ;NO - ADVANCE TO NEXT ENTRY ;***********************************************; CHARACTER FUNCTION FOUND - GET FUNCTION ADDR *;*********************************************** INX H  MOV E,M ;PUT ADDRESS ENTRY IN  INX H ;A (= MSB), E (= LSB)  MOV A,M  ANI 177Q ;MASK OUT HIGH ORDER BIT MOV D,A ;(PUT NEW MSB INTO D-REG)  SUB M ;USE INDEX TABLE?  JNZ CHI200 ;NO - USE AS FUNCTON ADDRESS MOV L,B ;YES - PUT DIFFERENCE IN H,L MOV H,A ;(A = 0) DAD D ;COMPUTE TABLE ADDRESS MOV E,M ;GET INDEX TABLE VALUE INX H  MOV D,M  ;*****************************; PERFORM CHARACTER FUNCTION *;*****************************CHI200 EQU $  XCHG  SHLD CNTFAD ;SET FUNCTION ADDRESS  MVI B,1 ;SET INITIAL FUNCTION INDEX  MVI H,BASEH ;SET H TO DATA PAGE  MVI A,RSTOFF ;DISABLE RESET KEY STA IOKBCO ;*********************************************** CALL ECONTF ;EXECUTE CHARACTER FUNCTION ;*********************************************** CALL DISLN3 ;RE-ENABLE RESET KEY CALL CKDSPF ;DISPLAY FUNCTIONS ENABLED?  JNZ CHI270 ;YES - DON'T END ESCAPE SEQ' LXI H,ESCFLG ;NO - CHECK ESCAPE FLAG  MOV B,M  DCR B ;ESCAPE SEQUENCE IN PROGRESS JM CHI270 ;NO - DON'T CHANGE ESC FLAG  MOV M,B ;YES - UPDATE ESCAPE COUNTER CZ ESCEND ;RESET RANGE TABLE POINTER; COUNTER BECAME ZERO CHI270 EQU $  LDA CHAR ;SAVE THE LAST CHARACTER STA LCHAR ;PROCESSED CMP H ;SET Z FALSE RET ;RETURN  ;********************************************** ; CHECK CONTROL CODES FOR BLOCK TERMINATOR OR * ; BLOCK TRANSFER TRIGGER * ;********************************************** ; ; ENTRY: C = INPUT CHARACTER; CHKCTL EQU $  LDA BLKTRM ;GET BLOCK TERMINATOR CHAR CMP C ;INPUT = BLOCK TERMINATOR? JZ SFKYDS ;YES - DISPLAY INPUT LDA DFLGS ;GET TRANSFER FLAGS  ANI SDACOM ;INPUT FROM DATA COMM? RZ ;NO - DO NOTHING LDA TRIGGR ;IS INPUT CHARACTER THE  CMP C ;BLOCK TRANSFER TRIGGER? RNZ ;NO - DO NOTHING; CHKCT1 EQU $ ;SET BLOCK TRANSFER TRIGGER  MVI A,SETTRG ;GO TO DATA COMM ROUTINE TO  JMP DCMCTL ;SET BLOCK TRANSFER TRIGGE ;******************************************** ; DSPTCH - DISPATCH PENDING BLOCK TRANSFERS * ;******************************************** DSPTCH EQU $  LDA CMFLGS ;GET COMMON FLAGS  @@ ANI BLKTRG ;BLOCK TRANSFER TRIGGER SET? RZ ;NO - RETURN LDA MFLGS ;YES - RELEASE ANY PENDING LXI H,DSPTAB ;BLOCK TRANSFERS MVI C,NMPNDG ; DSP010 EQU $  RRC ;TRANSFER PENDING BIT SET? JC DSP020 ;YES - GO DO TRANSFER  INX H ;NO - CHECK NEXT BIT INX H ;INCREMENT FUNCTION TABLE AD DCR C ;ALL BITS CHECKED? JNZ DSP010 ;NO - CONTINUE CHECKING ;  LDA MFLGS2 ;YES - CHECK 2ND SET OF FLAG RRC ;DEVICE RECORD PENDING?  JC IORDGO ;YES - SEND I/O RECORD RRC ;BINARY DATA PENDING?  JC BNRYGO ;YES - TRANSMIT THE DATA RET ;NO - RETURN;********************************************** ; PENDING BIT FOUND - GO TO TRANSMIT FUNCTION * ;********************************************** DSP020 EQU $  CALL CHAIN ;GET TRANSMIT FUNCTION ADDR  PCHL ;GO TO THE FUNCTION ; DSPTAB EQU $  DW DC2GO ;SEND DC2  DW STATGO ;SEND TERMINAL STATUS  DW STA2GO ;SEND TERMINAL STATUS 2  DW IOSTGO ;SEND I/O STATUS DW CRSNGO ;SEND CURSOR ADDRESS DW FKEYGO ;SEND FUNCTION KEY DATA  DW DPSGO ;SEND DISPLAY DATA DW IODNGO ;SEND I/O TERMINATION CODE;  NMPNDG EQU ($-DSPTAB)/2  ;****************************** ; ESCAPE CHARACTER PROCESSING * ;****************************** ESCAPE EQU $ LDA DFLGS  ANI SDACOM ;DATA FROM DATACOM?  JZ ESC010 ;NO - DON'T LOCK KEYBOARD  LDA MDFLG2 ;YES - GET MODE FLAGS  ANI BLKMDE ;BLOCK MODE? MVI A,ESCINP ;(PUT IGNORE FLAG IN A-REG CNZ SETMF2 ;YES - SET IGNORE KEYBD FLAGESC010 EQU $  CALL CHKSFK ;SOFT KEY MODE?  LXI H,ESCTAB ;(SET FOR NORMAL ESC TABLE JZ ESCAP0 ;NO - SET RANGE TABLE  LXI H,SESCTB ;YES - USE SOFT KEY TABLE ;***********************************************; ESCAP0 - SET RANGE TABLE FOR ESCAPE SEQUENCE *;***********************************************; ; ENTRY: A = RADIX (BASE) FOR DIGIT PARAMETERS; H,L = ADDRESS OF NEW RANGE TABLE ;  ; EXIT : H,L = ESCFLG ; ; ESCAPA - USE DECIMAL RADIX ; ESCAPA EQU $  MVI A,DECRDX ;SET RADIX FOR BASE 10 DIGITESCAP0 EQU $  STA RADIX ;SET PARAMETER RADIX SHLD RNGTA ;SET NEW RANGE TABLEESCAPB EQU $ ;ENTRY TO CLEAR ACCUMULATOR  LXI H,IOCSGN ;CLEAR OUT THE PARAMETER MVI E,3 ;ACCUMULATOR AREA  CALL CLRAL1 ESCAP1 EQU $  LXI H,ESCFLG ;SET FLAG TO RESET AFTER MVI M,2 ;FOLLOWING CHARACTER RET ;RETURN  ;*********************************************; ESCEND - END OF ESCAPE SEQUENCE PROCESSING *;*********************************************ESCEND EQU $  LXI H,RTABLE ;SET FOR NORMAL RANGE TABLE  CALL CHKSFK ;SOFT KEY MODE?  JZ ESCEN1 ;NO - USE NORMAL TABLE LXI H,DFSTB0 ;YES - USE SOFT KEY TABLE ESCEN1 EQU $  SHLD RNGTA ;RESET RANGE TABLE POINTER XRA A ;CLEAR ESCAPE FLAG AND STA ESCFLG ;ESCAPE KEYBOARD LOCKOUT MVI A,377Q-ESCINP ;FLAG;************************************ ; CLRMF2 - CLEAR FLAG BIT IN MFLGS2 * ;************************************ ; ; ENTRY: A = 377B - FLAG BIT TO BE CLEARED; ; EXIT : A = UPDATED MFLGS2 VALUE  ; H,L = MFLGS2 ; CLRMF2 EQU $  LXI H,MFLGS2  ANA M ;CLEAR THE FLAG BIT  MOV M,A ;STORE NEW SETTINGS  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FNDRAM - LOCATE END OF RAM SPACE ; ; ENTRY: B = MSB OF RAM SPACE LOWER LIMIT ; H,L = ADDR OF UPPER BOUNDARY ; ; EXIT : H,L = ADDRESS OF LOWER BOUNDARY ; A DESTROYED ; FNDRAM EQU $  XRA A  MOV L,A ;SET ADDRESS'S LSB TO ZERO MOV M,A ;SET RAM LOCATION TO ZERO  CMP M ;ALL ZEROES STORED?  JNZ FRM010 ;NO - RAM LIMIT FOUND  DCR M ;YES - TRY TO SET TO ALL ONE INR M ;ALL ONES STORED?  JNZ FRM010 ;NO - RAM LIMIT FOUND  MOV A,H ;YES - MOVE TO NEXT 1K SUI 4  MOV H,A  CMP B ;RAM LIMIT REACHED?  JP FNDRAM ;NO - TRY NEXT 1K ; ; RAM LIMIT FOUND - RETURN LOW BOUNDARY; FRM010 EQU $ MOV A,H ;ADJUST H,L TO TRUE LOWER  ADI 4 ;BOUNDARY  ANI 374Q ;MASK FOR 1K START ADDRESS MOV H,A  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; GETBUF - GET BUFFER SPACE; ; ENTRY: B,C = LENGTH OF BUFFER REQUIRED; ; EXIT : A,H,L DESTROYED; P - BUFFER SPACE ALLOCATAED; D,E = BUFFER START ADDRESS ; M - BUFFER SPACE NOT ALLOCATED ; D,E DESTROYED; ; THIS ROUTINE ALLOCATES A CONTIGUOUS AREA OF; RAM. THE BUFFER SPACE MAY NOT START ON A; 256 BYTE PAGE BOUNDARY.; GETBUF EQU $ LHLD BUFEND ;GET CURRENT BUFFER END AND  LXI D,BUFBGN+1 ;ADDRESS OF BEGIN PTR'S MS CALL GTB100 ;ENOUGH SPACE? JM GTB010 ;NO - TRY DISPLAY AREA SHLD BUFEND ;YES - STORE NEW BUFFER END GTB005 EQU $  XCHG ;SET D,E TO LOW ADDRESS  INX D ;OF BUFFER RET ;RETURN ; ; NOT ENOUGH NON-DISPLAY RAM - TRY DISPLAY AREA; GTB010 EQU $  LHLD DSPEND ;GET CURRENT DISPLAY END AND LXI D,DSPBGN+1 ;ADDR OF BEGIN PTR'S MSB CALL GTB100 ;ENOUGH SPACE? SHLD DSPEND ;(STORE NEW DISPLAY END) JP GTB005 ;YES - RETURN BUFFER ADDRESS LXI H,BUFMSG ;NO - REPORT ERROR JMP HANGU0 ; ; GTB100 - CHECK FOR AVAILABLE SPACE ; GTB100 EQU $  MOV A,L ;SUBTRACT DESIRED SPACE  SUB C ;FROM END OF REGION  MOV L,A  MOV A,H  SBB B  MOV H,A  XCHG ;COMPARE NEW MSB OF END TO CMP M ;MSB OF BEGINNING  XCHG ;PUT NEW END ADDRESS IN H,L  RET ;RETURN (P = ENOUGH) ;****************************************** ; GETDCM - PROCESS DATA COMM INPUT IF ANY * ;****************************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : NC ; NZ - DATA COMM INPUT BUFFER EMPTY; Z - EXIT ON FULL INPUT PROCESSING; ALL REGISTERS DESTROYED; GETDCM EQU $  LDA MDFLG2 ;GET HARD MODE FLAGS ANI REMOTE ;REMOTE MODE ENABLED?  LDA CMFLGS ;(GET COMMON FLAGS)  JZ GDC100 ;NO - IGNORE DATA COMM ANI REMSET ;WAS REMOTE ON BEFORE? CZ ENTREM ;NO - SET REMOTE MODE  ;********************** ; GET DATA COMM INPUT * ;********************** GDC010 EQU $  CALL ZGETDC ;ANY DATA COMM INPUT?  JC GDC050 ;(PROCESS ERROR IF ANY)  RNZ ;NO - RETURN MOV C,A ;YES - SAVE INPUT INTO C-REG;************************** ; PROCESS DATA COMM INPUT * ;************************** GDC020 EQU $  CALL SETDF0 ;SET DATA COMM INPUT FLAG  LDA MDFLG1 ;GET SOFT MODE FLAGS ANI RECORD ;RECORD MODE ENABLED?  JZ GDC030 ;NO - PROCESS THE INPUT  MOV A,C ;YES - LOOK FOR RECORD TRIGG CPI CR ;INPUT = RETURN? JZ GDC030 ;YES - PROCESS THE CHARACTER CPI LF ;IS IT LINE FEED?  JNZ RCRDGO ;NO - EXECUTE RECORD FUNCTIOGDC030 EQU $ ;YES - PROCESS THE CHARACTER CALL CHINT ;PERFORM INPUT PROCEDURE JZ GDC010 ;FAST STORE - DO SHORT LOOP ; GETDC1 EQU $ ;SET THE DISPLAY CURSOR  CALL DISLN1 ;SET DISPLAY CURSOR ROW AND  JMP CHINT2 ;COLUMN AND EXIT Z-TRUE  ;******************************** ; PROCESS DATA COMM INPUT ERROR * ;******************************** GDC050 EQU $  JNZ HANGU0 ;REPORT AND HANG IF FATAL  CALL CKDSPF ;DISPLAY FUNCTIONS ENABLED?  CZ ESCEND ;NO - FORCE ESC SEQ ABORT  MVI C,ADEL ;FORCE RUBOUT CHARACTER TO JMP GDC020 ;BE DISPLAYED ;*******************************************; NOT IN REMOTE MODE - SET TO LOCAL IF NOT *; IN LOCAL MODE ALREADY *;*******************************************GDC100 EQU $  ANI REMSET ;FIRST TIME IN LOCAL?  CNZ ENTLCL ;YES - SET TO LOCAL MODE INR A ;FORCE Z FALSE RET ;RETURN NO DATA COMM INPUT ;********************************** ; GTBLK - GET A NEW DISPLAY BLOCK * ;********************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : Z - NO BLOCKS AVAILABLE (MEMORY LOCKED); ALL REGISTERS DESTROYED; NZ - BLOCK ALLOCATED ; B,A = H,L = ADDRESS OF CHARACTER ; PRECEDING NEXT BLOCK LINK IN BLOCK ; C,D,E DESTROYED; GTBLKF EQU $ ;GET BLOCK FOR SINGLE CHAR I MVI A,FILL ;SET FILL CHARACTER TO FILL ; GTBLK EQU $  STA FILCHR ;SAVE FILL CHARACTER LHLD FRBLKS ;GET POINTER TO FIRST  XCHG ;FREE BLOCK IN D,E MOV A,E ;PUT LSB OF LINK IN A-REG  ORA A ;ANY BLOCKS AVAILABLE? CZ PTBLK ;NO - RELEASE BLOCKS JZ MLOCK ;AND FORCE MEMORY LOCK ON  ANI 377Q-BLKSM ;COMPUTE ADDRESS OF  MOV L,A ;NEXT BLOCK LINK MOV H,D  MOV A,M ;GET LSB OF NEXT BLOCK LINK  MOV C,A ;SAVE LSB IN C-REGISTER  CMA ;END OF LINE LINK (LOWER ANI BLKSM ;FOUR BITS # ALL ONES)?  JZ GBL100 ;NO - RELEASE NEXT BLOCK;*****************************; RELEASE LAST BLOCK OF LINE *;***************************** INX D ;SET H,L TO LSB PART OF PREV INX D ;LINE LINK MOV L,E  CALL CHAIN ;GET PREV LINE ADDR IN H,L SHLD FRBLKS ;SET AS NEW FREE BLOCKS HEAD MOV B,D ;PUT CURRENT BLOCK ADDRESS MOV A,E ;IN B,A  JMP GBL200 ;FILL BLOCK WITH FILL CHARS  ;*****************************; RELEASE NEXT BLOCK OF LINE *;*****************************GBL100 EQU $  INX H ;GET MSB OF NEXT BLOCK LINK  MOV B,M  DCX H ;RESTORE H,L TO ADDRESS OF; OF LSB PART IN FIRST BLOCK MOV A,C ;COMPUTE ADDRESS OF NEXT ANI 377Q-BLKSM ;BLOCK LINK IN SECOND BLOC MOV C,A  LDAX B ;TRANSFER NEXT BLOCK LINK OF MOV M,A ;SECOND BLOCK TO NEXT BLOC INX B ;LINK IN FIRST BLOCK INX H  LDAX B  MOV M,A  MOV A,C ;SET A-REGISTER FOR "BLNKFL";*******************************************; FILL BLOCK WITH SPECIFIED FILL CHARACTER *;*******************************************; ; B,A = ANY ADDRESS IN BLOCK ; FILCHR = CHARACTER TO FILL BLOCK WITH; GBL200 EQU $  ORI BLKSM ;SET H,L TO ADDRESS OF LAST  MOV L,A ;DISPLAY CHARACTER POSITIO MOV H,B ;IN BLOCK  MVI C,BLKSZ-3 ;SET FILL COUNT LDA FILCHR ;GET THE FILL CHARACTER GBL210 EQU $  MOV M,A ;STORE THE FILL CHARACTER  DCX H ;MOVE TO NEXT BYTE DCR C ;BLOCK FILL COMPLETED? JNZ GBL210 ;NO - CONTINUE FILLING MOV M,A ;YES - WRITE LAST PAD  MOV A,L ;SET B,A TO EXIT ADDRESS ORA A ;SET NZ  RET ;RETURN  ;**************************** ; GTNWLN - START A NEW LINE * ;**************************** ; ; ENTRY: LLINE = ADDRESS OF PREVIOUS LINE ; ; EXIT : NZ - NO BLOCKS AVAILABLE (MEMORY LOCK) ; ALL REGISTERS DESTROYED; Z - LINE ALLOCATED ; H,L = ADDR OF FIRST CHAR IN NEW LINE ; LLINE = ADDR OF LSB PART OF NEXT LINE; POINTER IN THE NEW LINE ; A-E DESTROYED ; ; NEW LINE IS LINKED TO PREVIOUS LINE IF PREVIOUS; LINE EXISTS (I.E., LSB OF PREV LINE ADDR # 0); GTNWLN EQU $  MVI A,STPR ;SET LAST FORMAT CONTROL COD STA LSTFMT ;TO START PROTECT  CALL GTBLKF ;GET A BLOCK FROM FREE LIST  JZ NZEXIT ;RETURN NZ IF NO BLOCKS  XCHG ;D,E = NEW BLOCK ADDRESS LHLD LLINE ;GET ADDRESS OF PREVIOUS XCHG ;LINE IN D,E ORI BLKSM ;COMPUTE ADDRESS OF LSB PART SUI 2 ;OF NEXT LINE LINK DCX H ;STORE ADDRESS INTO NEXT MOV M,B ;BLOCK LINK  DCR L ;(USE DCR TO AVOID CARRY)  MOV M,A  ADI 2 ;SET ADDRESS TO MSB PART OF  MOV L,A ;PREVIOUS LINE LINK  MOV M,D ;SET PREVIOUS LINE LINK TO DCX H ;POINT TO OLD LINE MOV M,E  DCX H  MVI M,EOP ;SET NEXT LINE LINK TO "EOP" DCX H  XRA A ;SET TERMINATOR (LSB = 0)  MOV M,A  SHLD LLINE ;STORE NEW LAST LINE ADDRESS DCX H  CALL STCHR1 ;SET FIRST DISPLAY CHARACTER ;*******************************************; LINK NEW LINE BACK TO PREVIOUS LAST LINE *;******************************************* ORA E ;PREVIOUS LINE EXIST (LSB#0) RZ ;NO - RETURN XCHG ;YES - LINK NEW LINE TO  MOV M,E ;PREVIOUS LINE INX H  MOV M,D  XCHG ;RESTORE H,L CMP A ;SET Z TRUE  RET ;RETURN  ;*****************************************; INITDS - SET UP INITIAL DISPLAY VALUES *;*****************************************; ; EXIT : H,L = ADDRESS OF THE LSB PART OF THE ; NEXT LINE POINTER IN THE INITIAL  ; DISPLAY BLOCK ; A DESTROYED ; ; THIS ROUTINE ALLOCATES THE INITIAL LINE OF ; THE DISPLAY AND INITIALIZES THE DISPLAY; PARAMETERS:; ; DISPST,CURADR = ADDRESS OF THE FIRST DISPLAY; CHARACTER IN THE INITIAL DISPLAY BLOCK ; ; LSTLIN,FLINE,TOPLIN = ADDRESS OF THE LSB; PART OF THE NEXT LINE POINTER IN THE ; INITIAL DISPLAY BLOCK; ; RHTMGN = MAXCOL (= 79) ; INITDS EQU $  CALL GTNWLN ;GET INITIAL DISPLAY BLOCK SHLD DISPST ;SET THE DISPLAY POINTER SHLD CURADR ;AND THE CURRENT CHAR ADDR INX H  SHLD LSTLIN ;SET THE CURRENT LINE  SHLD FLINE ;PARAMETERS  SHLD TOPLIN  MVI A,MAXCOL ;INITIALIZE THE RIGHT MARGIN STA RHTMGN ;TO THE LAST COLUMN  RET ;RETURN  ;************************************ ; LOCLIN - PROCESS LOCAL DATA ENTRY * ;************************************ ; ; ENTRY: C = INPUT CHARACTER@@; (CHARIN) = KEYBOARD INPUT CODE ; ; EXIT : ALL REGISTERS DESTROYED; ; THIS ROUTINE PROCESSES INPUT CHARACTERS FROM ; KEYBOARD. THE ROUTINE DETERMINES WHETHER OR ; NOT THE CHARACTER SHOULD BE TRANSMITTED OR  ; PROCESSED LOCALLY ; ; LOCLI0 - PROCESS FUNCTIONAL KEY INPUT; LOCLI0 EQU $  LDA KBJMPR ;GET KEYBOARD JUMPERS A-H  ANI CONDIS ;DISPLAY ALL FUNCTIONS OR  CZ CKDSPF ;DISPLAY FUNCTIONS ENABLED JZ LCI050 ;NO - PROCESS LOCALLY ONLY;******************************************** ; TRANSMIT CODE IF IN REMOTE CHARACTER MODE * ;******************************************** LOCLIN EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? JNZ LCI050 ;YES - PROCESS LOCALLY ONLY  LDA MDFLG2 ;NO - GET HARD MODE FLAGS  ANI REMOTE+BLKMDE  XRI REMOTE ;REMOTE AND NOT BLOCK MODE?  JNZ LCI050 ;NO - PROCESS LOCALLY ONLY MOV A,C ;YES - RECALL THE INPUT  CALL XPUTDC ;OUTPUT THE CHARACTER  RC ;(RETURN IF OUTPUT ERROR)  LDA KBDCSW ;GET THE DATA COMM SWITCHES  ANI FULDUP ;FULL DUPLEX?  RNZ ;YES - RETURN ; NO - PROCESS INPUT LOCALLY;**************************** ; PROCESS THE INPUT LOCALLY * ;**************************** ; ; INPUT CHARACTER IN C-REGISTER; LCI050 EQU $  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JNZ CHINT1 ;YES - FORCE FULL PROCESSING JMP CHINT ;NO - 1ST TRY FAST PROCESSIN ;***********************************************; PTBLK - RELEASE A LINE TO THE FREE LIST FROM *; THE DISPLAY LIST *;***********************************************;  ; ENTRY: DON'T CARE ; ; EXIT : Z - LINE NOT RELEASED; NC - MEMORY LOCKED ; C - OUTPUT FAILED FOR EDIT MODE; ALL REGISTERS DESTROYED; NZ - LINE RELEASED ; D,E = ADDRESS OF FIFTH BYTE FROM  ; A = E ; B,C,H,L DESTROYED; PTBLK EQU $  CALL CHKMLK ;MEMORY LOCK ENABLED?  JZ MLOCK ;YES - FLAG MEMORY FULL  CALL PTB100 ;SWITCH DISPLAY PARAMETERS; IF IN SOFT KEY MODE  LDA NROWS ;GET NUMBER OF ROWS NEEDED ORA A ;NEW ROWS BEING ADDED? CZ CKEDIT ;NO - EDIT MODE? JNZ PTB200 ;YES - RELEASE TOP LINE  LHLD LSTLIN ;NO - GET CURRENT LINE ADDR  ORA M ;CURRENTLY IN THE LAST LINE  JZ PTB200 ;YES - RELEASE TOP LINE ; NO - RELEASE BOTTOM LINE ;****************************** ; RELEASE LAST LINE OF MEMORY * ; UPDATE LAST LINE POINTER * ;******************************  LHLD LLINE ;GET LAST LINE ADDRESS INX H ;GET PREVIOUS LINE ADDRESS INX H  MOV E,M  INX H  MOV D,M XCHG  SHLD LLINE ;SET PREV LINE AS LAST LINE ;*****************************; STORE EOP IN NEW LAST LINE *;***************************** MVI M,0 ;SET TERMINATOR CODE IN  INX H ;NEW LAST LINE MVI M,EOP  DCX D ;SET D,E TO POINT TO LSB PAR DCX D ;NEXT LINE POINTER IN OLD  DCX D ;LAST LINE JMP PTB300 ;ADD LINE TO FREE LIST;*****************************************; PTB100 - SET PROPER DISPLAY PARAMETERS *;*****************************************PTB090 EQU $ ;I/O OUTPUT FAIL EXIT  CALL MLK010 ;CLEAR ROWS ALLOCATED FLAGPTB100 EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? STC ;(SET C-FLAG FOR I/O FAIL) JNZ SWAP1 ;YES - SWAP DISPLAY PARMS  RET ;NO - RETURN NOP ;"NOP'S" FOR PATCH TO "PT772 NOP ;*******************************; RELEASE FIRST LINE OF MEMORY *;*******************************PTB200 EQU $ LHLD TOPLIN ;GET TOP LINE ADDRESS  INX H ;SET FOR PREVIOUS LINE INX H ;ADDRESS MOV A,M ORA A ;TOP LINE = FIRST LINE?  JNZ PTB220 ;FIRST LINE IS NOT TOP LINE ;********************************************** ; TOP LINE OF DISPLAY IS FIRST LINE OF MEMORY * ; DO ROLL-UP * ;**********************************************  LXI H,CURROW  LDA MLKROW ;USER WORKING IN FIRST CMP M ;UNLOCKED ROW? CNZ ROLLUP ;NO - ROLL UP DISPLAY  JZ MLOCK0 ;ROLL UP FAIL - LOCK MEMORY  LXI H,CURROW ;DECREMENT CURSOR ROW  MOV B,M  DCR B JM PTB220 ;DON'T STORE IF ROW = 0  MOV M,B;*****************************; ADVANCE FIRST LINE POINTER *;*****************************PTB220 EQU $  LHLD FLINE ;GET ADDRESS OF FIRST DISPLA XCHG ;LINE  CALL CKEDIT ;EDIT MODE ENABLED?  CNZ PTTPLN ;YES - TRY TO OUTPUT LINE  JC PTB090 ;OUTPUT FAILED - RETURN FAIL XCHG ;PUT ADDRESS BACK INTO D,E MOV E,M ;GET ADDRESS OF NEW FIRST  INX H ;FIRST LINE  MOV D,M  INX D ;SET TO NEXT LINE POINTER  XCHG  SHLD FLINE ;STORE AS NEW FIRST LINE;*********************************************; CLEAR PREVIOUS LINE PNTR IN NEW FIRST LINE *;********************************************* INX H ;ADVANCE TO PREVIOUS LINE  INX H ;POINTER MVI M,0 ;ZERO LSB TO FLAG AS TOP LIN DCX D ;SET D,E TO LSB OF NEXT LINE; POINTER IN LINE TO BE ; RELEASED ;****************************** ; RELEASE LINE * ; D,E = START ADDRESS OF LINE * ;****************************** PTB300 EQU $  PUSH D ;SAVE REGISTERS D,E  CALL PTB100 ;RESTORE PROPER DISPLAY PARM POP D ;RESTORE D,E ;*********************************; PUTLIN - ADD LINE TO FREE LIST *;*********************************; ; ENTRY: D,E = ADDRESS OF NEXT LINE FIELD'S LSB ; OF LINE TO BE RELEASED ;  ; EXIT : D,E UNCHANGED ; A = E ; Z FALSE ; H,L DESTROYED ; FREE BLOCKS LIST UPDATED TO INCLUDE ; RELEASE LINE ; PUTLIN EQU $  CALL MLKOF ;RESET MEMORY LOCKED FLAG  LHLD FRBLKS ;GET CURRENT FREE BLOCKS HEA XCHG ;SET H,L TO MSB PART OF NEXT SHLD FRBLKS ;SET FREE BLOCKS POINTER TO  MOV A,L ;RELEASED LINE INX H ;PUT PREVIOUS FREE BLOCKS  INX H ;HEAD INTO PREVIOUS LINE MOV M,E ;POINTER OF RELEASED LINE  INR L ;(USE INR TO FORCE NZ) MOV M,D  XCHG ;RELEASED LINE ADDRESS IN D, MOV E,A ;SET A = E RET ;RETURN  ;*********************************************; RCADRA - LOCATE CURRENT CURSOR POSITION *; IF POSITION EXIST - DON'T EXTEND DISPLAY *;*********************************************;  ; ENTRY: DON'T CARE ;  ; EXIT : SEE "RCADDR" ; RCADRA EQU $  CALL CRADV1 ;CLEAR CURSOR ADVANCE FLAG MVI A,IGNTRM ;SET TO IGNORE NON-DISPLAYIN STA TRMFCT ;TERMINATOR RCADRB EQU $  MVI A,377Q ;SET "BLKFIL" TO INHIBIT STA BLKFIL ;LINE EXTENSION  JMP RCADR2 ;LOCATE CURSOR POSITION ;****************************************** ; LOCATE ADDR CORRESPONDING TO ROW/COLUMN * ; DO NOT ADD ROWS IF ROW DOES NOT EXIST * ;****************************************** RCADR1 EQU $  XRA A ;SET TO LOCATE COLUMN 0  STA CURCOL ;IN DESIRED ROW RCADR2 EQU $  LDA CURCOL ;GET THE CURRENT COLUMN RCADR3 EQU $  LXI H,NROWS ;SET "NROWS" TO INHIBIT  MVI M,377Q ;BUILDING OF NEW ROWS  CALL RCADR0 ;FIND CHARACTER ADDRESS  LXI H,NROWS ;RESET BUILD INHIBIT FLAGS MVI M,0 ;WITHOUT CHANGING PROCESSO MVI L,BLKFIL-BASE ;FLAGS  MVI M,0  RET ;RETURN  ;************************************************ ; RCADR4 - GET ADDRESS OF FIRST CHARACTER AFTER * ; AFTER PREVIOUS ROW AND COLUMN * ;************************************************ ; ; ENTRY: CURROW = CURRENT ROW ; CURCOL = CURRENT COLUMNN ; ; EXIT : Z - CHARACTER FOUND; C = COLUMN NUMBER; D,E = CHARACTER ADDRESS; IF FORMAT MODE ENABLED ; B = -1, CHARACTER PROTECTED; # -1, CHARACTER NOT PROTECTED; OTHERWISE, B DESTROYED ; A,H,L DESTROYED; NZ - CHARACTER NOT FOUND ; ALL REGISTERS DESTROYED; RCADR4 EQU $ LDA CURCOL ;GET CURRENT COLUMN NUMBER DCR A ;SET FOR PREVIOUS COLUMN CALL RCADR3 ;DOES CHARACTER EXIST  RNZ ;NO - RETURN MOV C,A ;YES - SAVE COLUMN FOUND IN  INR C ;ADVANCE TO NEXT COLUMN  CALL NXTCHR ;GET NEXT CHARACTER  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE MOV B,A ;(SET B TO INDICATE NOT ; PROTECTED IF NOT FORMAT); NEXT STATEMENT RETURNS)  RZ ;NO - RETURN ; ; FORMAT MODE - SEE IF NEXT ASCII CHAR PROTECTED ;  CALL CKPROT ;PREVIOUS CHAR PROTECTED?  JZ RCA440 ;YES - SEE IF NEXT CHAR UNPR;******************************** ; LAST CHAR WAS UNPROTECTED * ; SEE IF NEXT CHAR IS PROTECTED * ;********************************  CALL FNDCH0 ;IS NEXT CHARACTER PROTECTED JNZ RCA440 ;YES - SEE IF NEXT IS UNPROT LHLD CURADR ;NO - RECALL CURRENT CHAR  XCHG ;ADDRESS AND PUT INTO D,E RC4010 EQU $  CALL NXTCHR ;GET NEXT DISPLAY CHARACTER  MVI B,0 ;SET B FOR NOT PROTECTED JMP RCA460 ;EXIT CHARACTER FOUND ;***********************************; PROTECT CHAR FOUND *; SEE IF SUBSEQUENT UNPROTECT CHAR *;***********************************RCA440 EQU $ LXI H,ENDPR*256+XMONLY ;IS NEXT CHARACTER CALL FNDCH ;AN UNPROTECT OR XMIT ONLY JNZ RC4010 ;YES - RETURN UNPROTECTED  MVI B,-1 ;NO - RETURN CHAR PROTECTED RCA460 EQU $ LXI H,CURCOL  MOV C,M ;RECALL CURSOR COLUMN ; ; ZRETRN - RETURN WITH Z-FLAG TRUE ; ZRETRN EQU $  XRA A ;SET ZERO FLAG RET ;RETURN  ;*************************************************; RCADDR - DETERMINE LOCATION OF ASCII CHARACTER *; AT SPECIFIED ROW AND COLUMN OF DISPLAY LIST *;*************************************************; ; ENTRY: CURROW,CURCOL = DESIRED ROW/COLUMN ; LSTROW,LSTCOL = LAST ROW/COLUMN DONE ; CURADR = ADDRESS CORRESPONDING TO; LSTROW, LSTCOL ; LSTLIN = ADDRESS OF LINE CORRESPONDING  ; TO LSTROW ; NROWS = 0, BUILD NEW ROWS AS NEEDED; # 0, DON'T BUILD NEW ROWS; BLKFIL = 0, EXTEND LINE AS NEEDED; # 0, DON'T EXTEND LINE; ; EXIT : Z - CHARACTER FOUND; A,B,C,L DESTROYED; NZ - CHARACTER NOT FOUND ; M - ROWS NOT BUILT ; E = NUMBER OF ROWS NEEDED; P - ROW LOCATED; A = COLUMN NUMBER FOUND; B = ROW NUMBER FOUND ; C = NUMBER OF CHARACTERS NEEDED; D,E = ADDRESS OF LAST CHARACTER FOUND ; H = BASEH ; ; LSTROW,LSTCOL,LSTLIN,CURADR ARE UPDATED; TO THE LAST CHARACTER FOUND. ; RCADDR EQU $  LDA CURCOL ;GET DESIRED COLUMN NUMBERRCADR0 EQU $  STA TMPCOL ;SAVE DESIRED COLUMN NUMBER  LDA CURROW ;GET THE DESIRED ROW NUMBER  LHLD LSTROW ;GET LAST ROW AND COLUMN DON MOV B,H ;PUT LAST COLUMN IN B-REG  SUB L ;MOVED TO A NEW ROW? LHLD LSTLIN ;(GET LAST LINE DONE ADDR) JZ RCA240 ;YES - LOCATE COLUMN;************************** ; ROW HAS CHANGED * ; LOCATE START OF NEW ROW * ;**************************  MOV E,A ;SAVE COUNT  ORA A ;SET FLAGS JP RCA140 ;ROW IS AHEAD OF THIS ROW  ;**************************** ; ROW IS BEFORE CURRENT ROW * ; SEARCH BACK * ;**************************** RCA120 EQU $ INX H ;SET ADDRESS TO PREVIOUS INX H ;LINE POINTER  CALL CHAIN ;GET ADDRESS OF PREVIOUS ROW INR E ;ROW FOUND?  JNZ RCA120 ;NO - CONTINUE BACKING UP  JMP RCA220 ;YES - SET NEW ROW;****************************** ; ROW IS AHEAD OF CURRENT ROW * ; SEARCH AHEAD * ;****************************** RCA130 EQU $  CALL CHAIN ;GET ADDRESS OF NEXT ROW INX H ;SET TO NEXT LINE PTR ADDRES DCR E ;ROW FOUND?  JZ RCA220 ;YES - LOCATE COLUMNRCA140 EQU $ ;NO - CHECK FOR ANOTHER ROW  MOV A,M ;GET LSB OF NEXT ROW POINTER ORA A ;DOES NEXT ROW EXIST?  JNZ RCA130 ;YES - CHECK FOR ROW FOUND ;******************** ; ROW NOT IN MEMORY * ; CREATE NEW ROW * ;******************** RCA200 EQU $ CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JNZ NZEXIT ;YES - DO NOT BUILD ROWS LXI H,NROWS ;NO - GET BUILD FLAG ORA M ;INHIBIT ROW BUILD?  RNZ ;YES - RETURN (A = 377B) MOV M,E ;NO - STORE # OF ROWS NEEDED ;****************************** ; GET NEW ROW AND LINK TO OLD * ;****************************** RCA210 EQU $  CALL GTNWLN ;ADD A LINE TO THE DISPLAY RNZ ;RETURN FAIL IF MEMORY LOCKE LXI H,NROWS ;DECREMENT # OF ROWS NEEDED  DCR M ;ALL NEEDED ROWS ALLOCATED?  JNZ RCA210 ;NO - GET ANOTHER ROW ;************************************ ; ALL REQUIRED ROWS HAVE BEEN ADDED * ;************************************  LHLD LLINE ;GET START ADDRESS OF ROW RCA220 EQU $ ;UPDATE LOCATE COLUMN  CALL LSTLUP ;SET "LSTLIN" TO NEW ROW LDA TMPCOL ;RECALL COLUMN TO BE FOUND MOV C,A ;PUT COLUMN NUMBER INTO C-RE JMP RCA245 ;GO LOCATE THE COLUMN  ;**************************** ; CURRENT ROW = DESIRED ROW * ; CHECK COLUMN * ;**************************** RCA240 EQU $  LDA TMPCOL ;GET THE DESIRED COLUMN  MOV C,A ;PUT IT INTO THE C-REGISTER  SUB B ;COLUMN WANTED >= LAST DONE? JP RCA250 ;YES - SCAN FORWARD ;****************************************** ; DESIRED COLUMN LESS THAN CURRENT COLUMN * ; START SEARCH AT BEGINNING OF ROW * ;******************************************  CALL LSTLU1 ;SET LINE START PARAMETERS; (PUTS H,L @@INTO D,E) RCA245 EQU $  MVI A,IGNTRM ;SET FUNCTION FLAG TO IGNORE STA TRMFCT ;NON-DISPLAYING TERMINATOR JMP RCA255 ;GO LOCATE COLUMN ;*******************************************; DESIRED COLUMN AT OR PAST CURRENT COLUMN *; START SEARCH AT CURRENT COLUMN *;*******************************************RCA250 EQU $ MOV C,A ;SAVE # OF COLUMNS TO ADVANC LHLD CURADR ;GET ADDR OF LAST CHAR DONE  XCHG  INR B ;DOES LSTCOL = -1? JNZ RCA260 ;NO  DCR C ;DECREMENT COLUMN COUNT RCA255 EQU $ DCX D ;SET TO NEXT DISPLAY BYTE  ;**************************** ; ROW HAS BEEN FOUND * ; SEARCH FOR DESIRED COLUMN * ;**************************** RCA260 EQU $ LXI H,DISPST ;SET FOR NO CHARACTER MATCH  CALL FNDCHR ;DOES CHARACTER EXIST? MVI A,DELTRM ;SET FUNCTION FLAG TO DELETE STA TRMFCT ;NON-DISPLAYING TERMINATOR CZ EOLMV0 ;NO - TRY TO MOVE EOL  XCHG ;SET NEW CURRENT CHAR ADDRES SHLD CURADR  XCHG  LXI H,CURROW  MOV B,M ;GET DESIRED ROW AND COLUMN  LDA TMPCOL  DCR C ;CONVERT TO COLUMN FOUND JM RCA270  SUB CRCA270 EQU $ MOV L,B ;UPDATE LAST ROW AND COLUMN  MOV H,A ;DONE  SHLD LSTROW  MVI H,BASEH ;SET H TO DATA PAGE  INR C ;RESTORE ZERO FLAG RET ;RETURN  ;*****************************; TIMER INTERRUPT PROCESSING *;*****************************; ; ENTRY: "PSW" AND B,C PUSHED ; A = INTERRUPT CODE ; TMINTR EQU $ CALL INTVEC ;TRY ALTERNATE INTERRUPT LDA PRCCTL ;GET PROCESSOR STATE PUSH D ;SAVE REMAINING REGISTERS  PUSH H  ANI 377Q-TMIEN  OUT PROCSR ;ACKNOWLEDGE TIMER INTERRUPT ORI TMIEN  OUT PROCSR ;RE-ENABLE THE TIMER LXI H,RSTTMR ;DECREMENT SOFT RESET DELAY  MOV A,M ;TIMER DCR A ;COUNTING DOWN?  JM TMI010 ;NO - DON'T UPDATE TIMER MOV M,A ;YES - STORE NEW VALUE MVI A,ENDTST ;(SET FOR RESET LED'S) CZ ZKBCTL ;RESET LED'S IF TIME DONE TMI010 EQU $  MVI L,TPSTAL-BASE ;DECREMENT TAPE STALLED MOV A,M ;COUNTER DCR A ;STALL LIMIT REACHED?  JM TMI020 ;YES - DON'T UPDATE COUNTER  MOV M,A ;NO - STORE NEW VALUE TMI020 EQU $  MVI L,CTBLTM-BASE ;DECREMENT BLINK TIMER  DCR M ;TIME OUT? JNZ TMI100 ;NO - EXIT MVI M,CTBDLY ;YES - RESET TIMER INX H  MOV A,M ;GET CTU BLINK MASK  MVI L,CMND-BASE  XRA M ;TOGGLE BLINKING LIGHTS  MOV M,A ;UPDATE LIGHT STATE  STA IOCTCO ;SET CTU LIGHTS  ;*****************************************; PERFORM KEYBOARD AND DATA COMM MONITOR *; ROUTINES *;*****************************************TMI100 EQU $  LXI H,INTFLG ;GET INTERRUPT FLAG  MVI A,TMRINT+1 ;TIMER INTERRUPT ALREADY CMP M ;IN PROGRESS?  JZ TMI110 ;YES - DON'T DO MONITOR CALL MOV M,A ;NO - SET IN-PROGRESS FLAG LDA DEVFLG ;GET DEVICE FLAGS  ADD A ;ALTERNATE I/O INSTALLED?  CM ZMONAL ;YES - MONITOR ALT DEVICE  CALL ZKBMON  DI ;*************************** CALL ZDCMON ;* KEYBOARD MONITOR ROUTINE ; * RE-ENABLES INTERRUPTS *; **************************** LXI H,INTFLG ;SET INTERUPT CODE TO  DCR M ;INDICATE TIMER INTERRUPT TMI110 EQU $  POP H ;RESTORE CONTENTS OF POP D ;ALL REGISTERS AND POP B ;ALL CONDITION FLAGS POP PSW  EI ;RE-ENABLE INTERRUPTS  RET ;RETURN TO NORMAL PROCESSING ;************************** ; R O M B R E A K 1 * ;**************************  ORG BEGIN+4000Q ZBRK1 EQU $  DB VERSN1 ;ROM PRESENT FLAGS DB ZBRK1/256  ;*****************************************; BINOCT - CONVERT BINARY TO OCTAL ASCII *;*****************************************; ; ENTRY: A = DIGIT TO BE CONVERTED; H,L = ADDRESS OF OUTPUT BUFFER'S ; HIGH ORDER BYTE; ; EXIT : H,L = H,L(ENTRY)+4  ; A-C DESTROYED ; ; FIRST BYTE IS SET TO BLANK. THE NEXT THREE; BYTES CONTAIN THE ASCII OCTAL EQUIVALENT OF; THE INPUT VALUE. THE FIFTH BYTE IS SET TO ; ZERO (NULL). ; BINOCT EQU $  MVI M,ABLNK ;SET FIRST BYTE TO BLANK INX H  MVI B,3 ;SET B TO NUMBER OF DIGITS RLC ;ROTATE DOWN TWO HIGH ORDER  RLC ;BITS  MOV C,A ;SAVE VALUE IN C-REGISTER  ANI 3Q ;MASK OUT TWO HIGH ORDER BITBNO010 EQU $  ANI 7Q ;MASK OUT NEXT THREE BITS  ORI ZERO ;ADD IN ASCII ADJUSTMENT MOV M,A ;STORE ASCII CHARACTER INX H ;INCREMENT TO NEXT BYTE  MOV A,C ;RECALL INPUT  RLC ;ROTATE TO NEXT THREE BITS  RLC RLC MOV C,A ;SAVE VALUE  DCR B ;ALL BITS DONE?  JNZ BNO010 ;NO - SET NEXT BYTE  MOV M,B ;YES - STORE NULL IN BUFFER  RET ;RETURN  ;********************************** ; BN2DE0 - CONVERT SINGLE BYTE TO * ; ASCII DECIMAL * ;********************************** ; ; ENTRY: A = BYTE TO BE CONVERTED ; H,L = ADDRESS OF OUTPUT BUFFER'S ; HIGH ORDER ADDRESS ; ; EXIT : NZ ; H,L = H,L(ENTRY)+3  ; A-E DESTROYED ; BN2DE0 EQU $  SHLD LNKSAV ;SAVE BUFFER ADDRESS LXI H,B2D200 ;SET OUTPUT ROUTINE TO BUFFEBN2DE1 EQU $ ;STORE ROUTINE SHLD CNTFAD ;SET OUTPUT ROUTINE ADDRESS BN2DE2 EQU $ ;ENTRY FOR "ASCOUT"  MOV E,A ;CHANGE INPUT INTO DOUBLE  MVI D,0 ;BYTE VALUE  MVI C,1 ;SET ZERO SUPPRESS FLAG  JMP B2D050 ;GO TO CONVERT ROUTINE ;*************************************************; BN2DEC - CONVERT DOUBLE WORD BINARY TO DECIMAL *;*************************************************; ; ENTRY: D,E = BINARY VALUE ; H,L = ADDRESS OF HIGH ORDER BYTE IN ; BUFFER ; ; EXIT : H,L = H,L(ENTRY)+5  ; A-E DESTROYED ; LNKSAV DESTROYED ; ; THE FIRST FIVE BYTES OF THE BUFFER CONTAIN THE ; ASCII DECIMAL VALUE. THE SIXTH BYTE IS SET TO ; ZERO (NULL). LEADING ZEROES ARE BLANKED ; BN2DEC EQU $  SHLD LNKSAV ;SAVE BUFFER ADDRESS LXI H,B2D200 ;SET OUTPUT ROUTINE TO BUFFE SHLD CNTFAD ;STORE ROUTINE MVI C,1 ;SET ZERO SUPPRESS FLAG  LXI H,-10000  CALL B2D100 ;EXTRACT 10,000'S VALUE  LXI H,-1000  CALL B2D100 ;EXTRACT 1,000'S VALUEB2D050 EQU $  LXI H,-100  CALL B2D100 ;EXTRACT 100'S VALUE LXI H,-10  CALL B2D100 ;EXTRACT 10'S VALUE  MOV A,E ;CONVERT UNITS DIGIT TO  ORI ZERO ;ASCII AND STORE IN  DCR C ;SET C TO FORCE ZERO STORE JMP ECONTF ;GO TO OUTPUT ROUTINE  ;*******************************; B2D100 - EXTRACT RADIX VALUE *;*******************************; ; ENTRY: C = 0, SUPPRESS ZERO ; < 0, DON'T SUPPRESS ZEROES ; D,E = VALUE TO BE CONVERTED ; H,L = -RADIX ; LNKSAV = CURRENT BUFFER ADDRESS; ; EXIT : C < 0, CHARACTER STORED; = 0, ZERO SUPPRESSED ; (LNKSAV) = (LNKSAV)+1; A-C, H,L DESTROYED ; B2D100 EQU $  MVI B,ZERO-1 ;SET INITIAL ASCII VALUE XCHG ;EXCHANGE RADIX AND INPUT B2D110 EQU $  INR B ;INCREMENT ASCII VALUE DAD D ;SUBTRACT RADIX  JC B2D110 ;CONTINUE IF INPUT>RADIX MOV A,L ;ADD BACK RADIX TO EXTRACT SUB E ;REMAINDER MOV E,A ;SAVE REMAINDER IN D,E MOV A,H  SBB D  MOV D,A  MOV A,B ;GET CONVERTED VALUE JMP ECONTF ;GO TO OUTPUT ROUTINE ;************************************************ ; B2D200 - STORE DECIMAL VALUE FOR INTERNAL USE * ;************************************************ ; ; ENTRY: A = CONVERTED VALUE; B2D200 EQU $  CPI ZERO ;CONVERTED VALUE = ZERO? JNZ B2D210 ;NO - STORE THE DIGIT  DCR C ;NON-ZERO CHAR ALREADY DONE? JM B2D220 ;YES - STORE THE DIGIT INR C ;NO - RESTORE ZERO FLAG  RET ;AND EXIT B2D210 EQU $  DCR C ;CLEAR ZERO SUPPRESS FLAG B2D220 EQU $  LHLD LNKSAV ;GET BUFFER POINTER  MOV M,A ;STORE CONVERTED VALUE INX H ;INCREMENT BUFFER POINTER  MVI M,0 ;SET NEXT BYTE TO NULL SHLD LNKSAV ;STORE NEW POINTER VALUE RET ;RETURN  ;*********************************; CALCULATE CHECKSUM *; *; ENTRY: *; (H,L) = ADDRESS OF AREA *; TO BE CHECKSUMED *; *; D = NO. BYTES IN AREA/256 *; WE ASSUME THE AREA BEGINS ON A *; 256 BYTE BOUNDARY, I.E., L=0. *; CALL CHKSUM *; EXIT: *; A = CHECKSUM *; ALL OTHER REGS. UNCHANGED *; FLAGS DESTROYED *;*********************************CHKSUM EQU $  PUSH D ;SAVE REGISTER D-H PUSH H  XRA A ;ZERO SUM CSU100 EQU $  ADD M ;ADD BYTE  ACI 0 ;ADD CARRY INR L ;BUMP ADDRESS POINTER  JNZ CSU100 ;ADD NEXT BYTE;  INR H ;FINISHED A 256 BYTE BLOCK DCR D  JNZ CSU100 ;DO NEXT 256 BYTES;  INX B ;INCREMENT TO NEXT STORE ADD MOV D,A ;SAVE CHECKSUM IN D-REGISTER POP H ;RECALL STARTING ADDRESS MOV A,H  CPI 170000Q/256 ;LAST RAM BLOCK?  JNZ CSU110 ;NO - EXIT MOV C,L ;YES - SET B,C TO FIRST ; CHECKSUM STORE ADDRESSCSU110 EQU $  MOV A,D ;PUT CHECKSUM BACK INTO A-RE POP D ;RESTORE D,E RET ;RETURN  ;******************************************** ; CLEAR - RESET TERMINAL BY ESCAPE SEQUENCE * ;******************************************** CLEAR EQU $  CALL IOBSYC ;WAIT UNTIL TAPES NOT BUSY MVI A,FRCRST ;SET FLAG TO FORCE FULL  CALL STCMFL ;TERMINAL RESET  MVI A,CRTOFF ;TURN OFF THE DISPLAY  STA IOCRRW  RST RESET ;GO DO TERMINAL RESET  ;********************************************** ; DISPL1 - ADD ENOUGH BLOCKS TO REACH DESIRED * ; COLUMN * ;********************************************** ; ; ENTRY: C = NUMBER OF CHARACTERS NEEDED - 1; D,E = LOCATION OF EOL IN LINE; ; EXIT : A = 0, NOT ENOUGH BLOCKS (MEMORY LOCK)  ; B-L DESTROYED ; A # 0, MEMORY ALLOCATED; D,E = FIRST CHAR ADDR IN NEW BLOCKS; B,C,H,L DESTROYED; ; IF ONLY ONE CHARACTER IS TO BE ADDED, THE; CHARACTER IS ADDED TO THE LINE. OTHERWISE, ALL; REQUIRED BLOCKS ARE ADDED TO THE LINE AND THE; LINE IS FILLED WITH BLANKS UP TO THE DESIRED  ; CHARACTER ONLY. ; DISPL1 EQU $ INR C ;MOVE EOL IF NECESSARY CALL EOLMOV  DCR C JM DIS220 ;CHARACTER POSITION FOUND  LXI H,NCHAR ;SAVE NUMBER OF CHARACTERS MOV M,C ;TO BE ADDED - 1DISPL2 EQU $  XCHG  SHLD EOLADR ;SAVE EOL ADDRESS  DCR C ;SINGLE CHARACTER ADDED? JM DIS400 ;YES - DO FAST EXTEND  MVI A,ABLNK ;NO - GET A DISPLAY BLOCK  CALL GTBLK ;FILLED WITH BLANKS  RZ ;RETURN IF MEMORY LOCKED XCHG ;PUT BLOCK ADDRESS IN D,E  ORI BLKSM ;COMPUTE HIGH ADDR OF BLOCK  MOV C,A ;SAVE ADDRESS OF FIRST NEW PUSH B ;BLOCK ADDED LDA NCHAR ;GET # OF CHARS TO BE ADDED  MVI B,0 ;INITIALIZE COUNT DIS120 EQU $ INR B ;INCREMENT COUNT SUI BLKSZ-2 ;SUB. NO. OF CHARS IN BLOCK  JP DIS120 ;JUMP IF MORE BLOCKS NEEDED  STA COUNT ;SAVE LAST CHAR BLOCK POS  DCR B ;SINGLE BLOCK? JZ DIS160 ;YES  ;***************************; MULTIPLE BLOCKS REQUIRED *;*************************** LXI H,NBLKS ;SAVE BLOCK COUNT  MOV M,B ;************************ ; GET SUBSEQUENT BLOCKS * ;************************  PUSH D ;SAVE ADDRESS OF LAST BLOCK DIS140 EQU $  MVI A,ABLNK ;GET A DISPLAY BLOCK FILLED  CALL GTBLK ;WITH BLANKS XCHG ;PUT BLOCK ADDRESS IN D,E  POP H ;RECALL ADDRESS OF LAST BLOC JZ DIS240 ;EXIT IF MEMORY LOCKED PUSH D ;SAVE NEW LINE ADDRESS DCX H ;LINK NEW BLOCK TO PREVIOUS  ORI BLKSM MOV M,B ;MSB'S  DCX H  MOV M,A ;STORE LSB LXI H,NBLKS  DCR M ;ALL BLOCKS ALLOCATED? JNZ DIS140 ;NO - GET ANOTHER BLOCK  POP PSW ;YES - POP THE STACK ;*****************************; ALL BLOCKS HAVE BEEN ADDED *;*****************************DIS160 EQU $  LDA COUNT ;COMPUTE NUMBER OF BYTES CMA ;TO FILL INR A  MOV C,A ;SAVE IN C ADD E ;GET FIRST FILL ADDR DCR A ;SET FIRST LSB FILL ADDRESS  MOV L,A ;PUT LSB INTO L  MOV H,D ;GET MSB FROM D  MVI B,EOL ;SET "EOL" CHARACTER LDA CURCOL ;GET CURRENT COLUMN  CPI MAXCOL ;CHAR ADDED TO LAST COLUMN?  JNZ DIS170 ;NO - SET "EOL" CHARACTER  LDA DCHAR ;YES - GET CHARACTER STORED  ORA A ;IS IT ASCII?  JP DIS175 ;YES - DON'T ADD "EOL"; NO - SET "EOL" CHARACTER;********************************************** ; FILL UNUSED PART OF BLOCK WITH "FILL" CODES * ;********************************************** DIS170 EQU $  MOV M,B ;STORE FILL/EOL CHARACTER DIS175 EQU $  DCX H ;GO TO NEXT BYTE DCR C ;ALL UNUSED BYTES FILLED?  MVI B,FILL ;(SET "FILL" CODE) JNZ DIS170 ;NO - SET NEXT BYTE ;************************** ; WRITE LINK TO NEXT LINE * ;************************** DIS180 EQU $ LHLD LSTLIN ;GET ADDR CURRENT LINE XCHG  DCX H ;STORE AS NEXT BLOCK POINTER MOV M,D @@ DCX H  INX D ;POINT TO NEXT LINE POINTER  MOV M,E  ;***************************; LINK NEW BLOCK(S) TO OLD *;*************************** POP D ;RECALL FIRST NEW BLOCK ADDR LDA NCHAR ;GET # OF CHARS ADDED - 1  ORA A ;DOES NEW CHAR REPLACE EOL?  LDA DCHAR ;(DEFAULT TO ADD 1 CHAR) JZ DIS210 ;YES - OVERWRITE EOL MVI A,ABLNK ;NO - STORE BLANK OVER EOLDIS210 EQU $  MOV B,A ;SAVE CHARACTER TO BE STORED LHLD EOLADR ;RECALL EOL ADDRESS  LDA CURROW  ORI MAYEOL ;SET FOR POSSIBLE EOL SKIP DI ;DISABLE INTERRUPTS  STA IOCRRW ;TURN OFF DISPLAY DMA  MOV M,B ;OVERWRITE EOL DCX H  MOV M,D ;CHANGE NEXT BLOCK LINK TO DCX H ;POINT TO NEW BLOCKS MOV M,E  CALL DISLN1 ;TURN DISPLAY BACK ON  ORA H ;SET Z-FALSE RET ;RETURN ;*****************************; EOL MOVE SATISFIED REQUEST *; CHECK FOR SINGLE CHARACTER *;*****************************DIS220 EQU $ DCR A ;SINGLE CHARACTER? STA NCHAR ;(SET NCHAR) RNZ ;NO - RETURN LDA DCHAR ;YES - GET THE CHARACTER STAX D ;STORE THE CHARACTER RET ;RETURN ;***************************; ALL BLOCKS NOT AVAILABLE *; INITIALIZE END OF LINE *;***************************DIS240 EQU $ MVI M,EOL ;STORE AN EOL  XCHG ;PUT ADDRESS INTO D,E  JMP DIS180  ;**************************** ; SINGLE CHARACTER ADDITION * ;**************************** DIS400 EQU $  CALL GTBLKF ;GET A DISPLAY BLOCK RZ ;RETURN IF MEMORY LOCKED MOV D,H ;SAVE BLOCK ADDRESS IN D,E MOV E,L  ORI BLKSM ;PUT AN EOL AT THE FIRST MOV L,A ;DISPLAY CHARACTER MVI M,EOL ;LOCATION IN THE BLOCK PUSH H ;SAVE ADDRESS OF BLOCK JMP DIS180 ;LINK BLOCK TO DISPLAY ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; EOLMOV - MOVE EOL IN A BLOCK ; ; ENTRY: C = NUMBER OF BYTES NEEDED ; D,E = ADDRESS OF EXISTING EOL; ; EXIT : A = NUMBER OF CHARACTERS ADDED ; C = 0, CHARACTER FOUND ; D,E = ADDRESS OF CHARACTER ; C = NUMBER OF CHARACTERS NEEDED; D,E = ADDRESS OF LAST BYTE IN BLK ; H = BASEH ; B,L DESTROYED; ; EOLMV0 - MOVE ONLY IF UNPROTECTED; EOLMV0 EQU $  LDA BLKFIL ;GET BLOCK FILL INHIBIT FLAG INR A ;BLOCK FILL INHIBITED OR CNZ CKPROT ;CURSOR IN PROTECTED FIELD RZ ;YES - RETURN ; EOLMOV EQU $  MOV A,E ;COMPUTE NUMBER OF BYTES ANI BLKSM ;AVAILABLE IN BLOCK  SUI 2 ;(DELETE BYTES FOR LINK) RZ ;RETURN IF NONE AVAILABLE  XCHG ;PUT CURRENT ADDRESS IN H,L  CMP C ;ENOUGH CHARACTERS?  MOV B,A ;(SET B TO FILL BLOCK) LXI D,EOL*256+MAYEOL ;(SET FOR PARTIAL ; LINE EXTENSION)  JM ELM100 ;NO - BLANK REST OF BLOCK  MOV B,C ;YES - BLANK WHAT'S NEEDED LDA CURCOL ;GET CURRENT COLUMN POSITION CPI MAXCOL ;ADDING TO LAST COLUMN?  JNZ ELM100 ;NO - NEED EOL AT LINE END LDA DCHAR ;YES - GET NEW CHARACTER ORA A ;IS IT ASCII? JM ELM100 ;NO - NEED EOL AT LINE END MVI D,FILL ;YES - DON'T NEED EOL  ;  ; FILL THE BLOCK ; ELM100 EQU $  MOV A,C ;COMPUTE NUMBER OF ADDITIONA SUB B ;BYTES NEEDED  MOV C,A ;SAVE IT IN C FOR RETURN LDA CURROW ;SET CONTROL TO TURN OFF DMA ORA E  MOV E,B ;SAVE NUMBER OF BYTES ADDED  DI ;DISABLE INTERRUPTS  STA IOCRRW ;TURN OFF DMA ; ELM110 EQU $  MVI M,ABLNK ;FILL BLOCK WITH BLANKS  DCX H ;MOVE TO NEXT BYTE DCR B ;FILL COMPLETED? JNZ ELM110 ;NO - DO NEXT BYTE MOV M,D ;YES - ADD EOL OR EOL FILL CALL DISLN1 ;TURN DISPLAY BACK ON  XRA A ;CLEAR A-REGISTER  ORA C ;ALL CHARACTERS DONE?  JNZ ELM130 ;NO - RETURN ADDRESS OF EOL  INX H ;YES - RETURN ADDR OF LAST CELM130 EQU $  MOV A,E ;PUT # OF CHARS DONE IN A-RE XCHG ;PUT CHARACTER ADDRESS IN D, LXI H,EOLMV ;(SET H TO DATA PAGE)  MVI M,1 ;SET EOLMV FLAG  RET ;RETURN   ;******************* ; LD - LINE DELETE * ;******************* LINDEL EQU $ CALL CHKFMS ;FORMAT MODE?  CZ RCADR1 ;FIND LINE IF NOT  RNZ ;LINE NOT FOUND  LHLD LSTLIN ;GET ADDR OF LAST LINE DONE  MOV A,M ;GET PREVIOUS LINE'S LSB ORA A ;ANY PREVIOUS LINES? JZ LID050 ;NO - DO CLEAR LINE ONLY CALL LINDL0 ;YES - DELETE CURRENT LINE;************************************** ; UPDATE LSTLIN AND CURADR TO ADDRESS * ; OF NEXT LINE * ;**************************************  MOV H,B ;PUT NEW LINE ADDRESS INTO MOV L,C ;H,L CALL BACKT5 ;UPDATE CURRENT LINE AND ADD CALL LININ0 ;GO UPDATE TOP LINE IF NEEDE JMP PUTLIN ;ADD LINE TO FREE LISTLID050 EQU $  CALL CLEARL ;CLEAR THE LINE  JMP CURPRT ;SET CURSOR AT LEFT MARGIN ;***************************************; LINDL0 - RMOVE LINE FROM LINKED LIST *;***************************************; ; ENTRY: H,L = ADDRESS OF NEXT LINE FIELD ; (LSB) OF LINE TO BE DELETED; ; EXIT : B,C = ADDRESS OF LSB PORTION OF; NEXT LINE POINTER IN NEW LINE; D,E = H,L(ENTRY)  ; A,H,L DESTROYED ; LINDL0 EQU $  MOV E,L ;SAVE ADDRESS OF LINE TO BE  MOV D,H ;DELETED IN D,E  MOV C,M ;GET ADDRESS OF NEXT LINE  INX H  MOV B,M  INX H ;GET ADDRESS OF PREVIOUS LIN MOV A,M  INX H  MOV H,M  ORA A ;DOES PREVIOUS LINE EXIST? JNZ LID200 ;YES - LINK 2 LINES TOGETHER;************************************** ; FIRST LINE DELETED - UPDATE FLINE * ;**************************************  MOV H,B ;MOVE NEW CURRENT LINE TO H, MOV L,C  INX H ;SET ADDR TO NEXT LINE FIELD SHLD FLINE  JMP LID300 ;SET NEW PREV LINE POINTER ;****************************************** ; UPDATE NEXT LINE FIELD IN PREVIOUS LINE * ;****************************************** LID200 EQU $ MOV L,A ;PUT LSB INTO L-REGISTER INX H ;SET TO MSB OF NEXT LINE FLD CALL DISLNK ;SET NEW NEXT LINE LINK TO; CURRENT ROW ;***************************************; SET PREVIOUS LINE FIELD IN NEXT LINE *;*************************************** MOV A,L ;SAVE PREV LINE ADDR'S LSBLID300 EQU $  INX B ;INCREMENT TO NEXT LINE PTR  PUSH B ;SAVE ADDRESS  INX B ;SET ADDRESS TO PREVIOUS INX B ;LINE FIELD  STAX B ;STORE LSB VALUE INX B  MOV A,H  STAX B ;STORE MSB VLAUE POP B ;RESTORE CONTENTS OF B,C RET ;RETURN   ;******************* ; LI - LINE INSERT * ;******************* LININS EQU $ CALL CHKFMS ;FORMAT MODE?  CZ RCADR1 ;FIND LINE IF NOT  RNZ ;RETURN IF LINE NOT FOUND  CALL GTBLKF ;GET BLOCK FOR NEW LINE  RZ ;RETURN IF NOT AVAILABLE;******************************** ; STORE LINK AT END OF NEW LINE * ;********************************  ADI BLKSZ-5 ;GET ADDR OF NEXT LINE FIELD DCR L MOV M,H ;STORE LINK MSB'S  DCR L MOV M,A ;STORE LINK LSB'S  SUI 2 ;STORE EOL IN NEW LINE MOV L,A CALL STCHR1 ;SET FIRST DISPLAY CHARACTER;*********************************************; ADJUST LSTLIN AND CURADR PNTRS TO NEW LINE *;********************************************* SHLD CURADR ;SET CURADR TO 1ST CHAR  INX H ;SET TO NEXT LINE POINTER  MOV A,L ;PUT LSB INTO A-REGISTER XCHG  LHLD LSTLIN ;GET CURRENT LINE ADDRESS  XCHG  SHLD LSTLIN ;SET NEW CURRENT LINE ADDRES CALL LININ1 ;ADD LINE TO DISPLAY LIST ;**************************** ; UPDATE TOPLIN IF ROW ZERO * ;**************************** LININ0 EQU $  CALL LSTLU2 ;SET INITIAL LINE STATE  CALL CURPRT ;SET CURSOR TO LEFT MARGIN XRA A ;SET LAST COLUMN DONE TO STA LSTCOL ;ZERO  LXI H,CURROW ;GET CURRENT ROW NUMBER  ORA M ;DID TOP ROW CHANGE? RNZ ;NO - RETURN JMP TOPUP1 ;YES - UPDATE TOP LINE VALUE ;****************************************** ; LININ1 - ADD LINE TO LINK LIST * ; ENTRY: D,E=NEXT PAGE FIELD ADDR IN LINE * ; BEFORE WHICH NEW LINE IS * ; TO BE INSERTED * ; A,B=NEXT PAGE FIELD ADDR OF LINE * ; TO BE INSERTED ; EXIT : C,B = A,B(ENTRY) ; D-L DESTROYED;****************************************** LININA EQU $  MOV A,E ;PUT ROLLED LINE ADDRESS INT MOV B,D ;B,A XCHG ;PUT CHAR ADDRESS INTO D,ELININ1 EQU $  MOV L,E ;UPDATE PREV LINE PTR  MOV H,D ;IN NEXT LINE  INX H ;SET ADDRESS TO PREVIOUS INX H ;LINE POINTER  MOV C,M ;GET ADDR OF PREV LINE MOV M,A ;STORE ADDR OF NEW LINE  INX H  MOV D,M MOV M,B;******************************** ; UPDATE NEXT/PREVIOUS POINTERS * ; IN NEW LINE * ;********************************  MOV L,A ;GET ADDR OF NEXT LINE FIELD MOV A,H MOV H,B DCR E ;SKIP OVER POINTERS  MOV M,E ;STORE NEXT LINE LSB'S INX H  MOV M,A ;STORE NEXT LINE MSB'S INX H  MOV M,C ;STORE PREV LINE LSB'S INX H  MOV M,D ;STORE PREV LINE MSB'S ;******************************** ; SEE IF NEW LINE IS FIRST LINE * ;********************************  MOV A,C ;GET PREV LINE LSB'S ORA A ;SET FLAGS MOV A,L ;(PUT LSB OF ADDR IN A-REG)  JZ LII200 ;JUMP IF NEW LINE IS; FIRST LINE;*********************************; NEW LINE IS NOT FIRST LINE *; LINK PREVIOUS LINE TO NEW LINE *;********************************* SUI 4 ;GET ADDR OF NEW LINE DATA MOV L,C ;GET ADDR OF NEXT PAGE FIELD MOV H,D ;OF PREVIOUS LINE  MOV C,A ;NEW LINE'S LSB TO C INX H ;SET TO MSB PART OF FIELD  CALL DISLNK ;LINK PREV LINE TO NEW LINE  INR C RET ;RETURN  ;************************* ; NEW LINE IS FIRST LINE * ;************************* LII200 EQU $ SUI 3 ;GET ADDR OF NEXT PAGE FIELD MOV C,A ;PUT LSB INTO C-REGISTER MOV L,A ;SET NEW FIRST LINE POINTER  SHLD FLINE  RET ;RETURN   ;********************** ; LINE FEED PROCESSOR * ;********************** CONDLF EQU $ LDA KBJMPR ;GET THE STRAP SETTINGS  ANI LINWRP ;WRAP AROUND ENABLED?  RZ ;YES - LF NOT REQUIREDLNFEED EQU $ LXI H,SPOWL ;CLEAR SPOW LATCH  MVI M,SPOWOF  MVI L,CURROW-BASE ;GET CURSOR ROW MOV A,M CPI MAXROW ;IS CURSOR IN BOTTOM ROW?  JZ LNF100 ;YES - ROLL UP THE DISPLAY INR A ;NO - MOVE CURSOR TO NEXT RO MOV M,A ;STORE NEW ROW NUMBER  STA IOCRRW ;SET SCREEN CURSORLNF100 EQU $  CZ ROLLUP ;(ROLL UP IF AT BOTTOM) ; ; BUILD FIRST BLOCK OF NEW ROW IF NECESSARY;  LDA MFLGS ;GET BLOCK XFR PENDING FLAGS ANI SENTER/256 ;ENTER PENDING?  RNZ ;YES - DO NOT BUILD NEW ROW  LDA IOFLG2 ;NO - GET I/O FLAGS  ANI XDS2BF ;DISPLAY TO I/O BUFFER?  RNZ ;YES - DO NOT BUILD NEW ROW ; ; ACQUIRE MEMORY FOR EDIT MODE IF NEEDED ;  MVI A,-1 ;LOCATE BEGINNING OF NEW CALL RCADR0 ;ROW CALL CKEDIT ;CHECK FOR SUFFICIENT FREE CNZ FRECNT  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; LSTLUP - UPDATE "LSTLIN" ; ; ENTRY: H,L = ADDRESS TO BE STORED ; ; EXIT : D,E = LSTLIN = H,L(ENTRY); A,H,L DESTROYED ; LSTDCD = 0 ; PROFLD SET TO INDICATE PROTECTED; FIELD OF FORMAT MODE ENABLED ; LSTLUP EQU $  SHLD LSTLIN ;SET NEW "LSTLIN" VALUE LSTLU1 EQU $  XCHG ;PUT "LSTLIN" VALUE INTO D,ELSTLU2 EQU $  XRA A ;CLEAR LAST DISPLAY CODE STA LSTDCD  MVI A,STPR ;INITIALIZE LAST FORMAT  STA LSTFMT ;CONTROL CODE TO "STPR"  CALL CHKFMS ;FORMAT MODE?  RZ ;NO - RETURN MVI A,-1 ;YES - SET PROTECT FLAG TO STA PROFLD ;INDICATE PROTECTED FIELD  LXI H,ZRETRN ;INITIALIZE FIELD CHECKING SHLD CHKRTN ;ROUTINE RET  ;****************** ; MEMORY LOCK OFF * ;****************** MLKOF0 EQU $  LDA MLKROW ;GET MEMORY LOCK ROW ORA A ;SET FOR FULL LOCK OUT?  JNZ MLKOF ;NO - CLEAR LOCK OUT ONLY MLKOFF EQU $ ;YES - TURN OFF MEMORY LOCK  LXI H,0 ;SET MEMORY LOCK ROW AND SHLD MLKFLG ;FLAG TO ZERO  MVI A,MEMLOK ;TURN OFF MEMORY LOCK  JMP ZCLMD1 ;FLAG  ;***************** ; MEMORY LOCK ON * ;***************** MLKON EQU $  LDA CURROW ;GET CURRENT CURSOR ROW  ORA A ;SET FOR OVERFLOW INHIBIT? JNZ MLO005 ;NO - SET MEMORY LOCK ROW  CALL CKEDIT ;EDIT MODE?  RNZ ;YES - DON'T ALLOW LOCK OUT MLO005 EQU $ ;NO - SET MEMORY LOCK ROW  STA MLKROW MLO010 EQU $  MVI A,MEMLOK ;TURN MEMORY LOCK FLAG MVI B,0 ;ON AND DON'T BLINK LED  LXI H,MLKFLG ;(CLEAR THE MEMORY LOCK  MOV M,B ;FLAG)  JMP ZSTMD1  ;********************************** ; MLKSCH - LOCATE MEMORY LOCK ROW * ;********************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : Z - MEMORY LOCK ROW NOT FOUND; A,C,H,L DESTROYED; NZ - MEMORY LOCK ROW FOUND ; H,L = ADDRESS OF LAST LOCK ROW ; (POINTS TO LSB OF NEXT LINE ; @@ POINTER) ; A,C DESTROYED ; MLKSC0 EQU $ ;LOCATE FIRST UNLOCKED ROW LDA MLKROW ;GET MEMORY LOCK ROW ORA A ;SET FOR PARTIAL SCREEN LOCK LHLD TOPLIN ;(SET FOR TOP DISPLAY LINE JZ NZEXIT ;NO - RETURN FOUND (NZ) ; YES - LOCATE MEMORY LOCK ROWMLKSCH EQU $  LDA MLKROW ;GET MEMORY LOCK ROW ORA A ;SET FOR PARTIAL SCREEN LOCK RZ ;NO - RETURN ;***************** ; SEARCH FOR ROW * ;*****************  LHLD TOPLIN ;GET TOP LINE ADDRESS MLKSC1 EQU $ ;LOCATE LINE (A-REG) MOV C,A ;PUT LINE NUMBER IN C-REG MLS120 EQU $  CALL CHAIN ;GET ADDRESS OF NEXT LINE  ORA A ;DOES NEXT LINE EXIST? RZ ;NO - RETURN FAIL (Z)  INX H ;YES - SET TO NEXT LINE PTR  DCR C ;ALL LINES FOUND?  JNZ MLS120 ;NO - DO NEXT LINE; NZEXIT EQU $  ORI 377Q ;SET NZ, S RET ;RETURN(ZERO FLAG FALSE) ;*********************************************; MLOCK - TURN ON MEMORY LOCK FULL CONDITION *;*********************************************;  ; ENTRY: DON'T CARE ; ; EXIT : A = 0; Z = T; MLKTMR = -1 (377B) ; MLOCK0 EQU $  CALL PTB100 ;RESTORE PROPER DISPLAY PARMMLOCK EQU $  LXI H,MLKFLG ;SET H,L TO MEMORY LOCK FLAG ORA M ;MEMORY ALREADY LOCKED?  JNZ MLK010 ;YES - DON'T SOUND BELL  MVI A,MEMLOK ;NO - FORCE MEMORY LOCK ON MVI B,377Q ;AND BLINKING  MOV M,B ;SET MEMORY LOCK FLAG  CALL ZSTMD1 MLOCK1 EQU $ ;SOUND BELL AND RETURN A = 0 CALL ZBELL ;SOUND THE BELL MLK010 EQU $  XRA A ;SET Z-FLAG  LXI H,NROWS ;(SET H TO DATA PAGE)  MOV M,A ;CLEAR NROWS FOR RCADDR  RET ;RETURN (A = 0, Z= T)  NOP ;NOP FOR PATCH TO "PT772"  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; MOVCHR - MOVE CHARACTER STRING ; ; ENTRY: H,L = SOURCE POINTER ; B,C = DESTINATION POINTER; ; EXIT : B,C = NEXT STORAGE LOCATION; H,L = END OF SOURCE STRING ; Z - TERMINATED BY A NULL BYTE; NZ - TERMINATED BY AN EOP; MOVCHR EQU $  MOV A,M ;GET DATA BYTE ORA A ;IS IT A NULL? RZ ;YES - RETURN (Z - TRUE) STAX B ;NO - STORE THE BYTE INX H ;INCREMENT TO NEXT SOURCE BY DCX B ;DECREMENT TO NEXT DEST BYTE CPI EOP ;WAS LAST BYTE AN EOP? JNZ MOVCHR ;NO - DO NEXT BYTE ORA A ;YES - SET Z-FALSE RET ;RETURN  ;************ ; NEXT PAGE * ;************ NEXTPG EQU $ MVI A,MAXROW+1 ;COMPUTE NUMBER OF LINES MVI L,MLKROW ;TO ROLL UP  SUB M  CALL NXT100 NXT040 EQU $  LDA MLKROW ;SET CURRENT CURSOR POSITION STA CURROW ;TO MEMORY LOCK ROW AND  CALL CURPRT ;LEFT MARGIN CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JNZ FLDSR ;YES - TAB TO NEXT FIELD RET ;NO - RETURN ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; NXTPG1 - ROLL UP N LINES ; ; ENTRY: A = NUMBER OF ROWS TO ROLL UP ; H = BASEH ; ; EXIT : C = NUMBER OF LINES ROLLED ; H,L = NMROLL+; A,B,D,E DESTROYEDNXT100 EQU $NXTPG1 EQU $ MOV C,A ;PUT ROLL PARAMETER IN C-REG MVI L,ROLLCT ;SAVE ROLL PARAMETER MOV M,C  INX H NXT110 EQU $  MOV M,C  CALL ROLLUP ;ROLL UP SUCCESSFUL? LXI H,ROLLCT ;(RECALL ROLL COUNT) MOV C,M  JZ NXT120 ;NO - EXIT DCR C ;ALL LINES DONE? JNZ NXT110 ;NO - ROLL UP ANOTHER LINE; YES - EXIT (C = 0);*********************************************; TERMINATE ROLL UP - RETURN NUMBER OF LINES *; ROLLED *;*********************************************NXT120 EQU $  INX H ;GET NUMBER OF LINES TO BE MOV A,M ;ROLLED UP SUB C ;COMPUTE ACTUAL NUMBER DONE  MOV C,A ;RETURN VALUE IN C-REGISTER  RET ;RETURN  ;*****************************************; GET ADDRESS OF NEXT *; RAM BLOCK. *; ENTRY: *; E, BIT 7 = 0, 4K INCREMENTS *; = 1, 256 *; *; BIT 0 = 0, IN NON-DISPLAY RAM *; = 1, DISPLAY RAM *; *; H = 0 IF FIRST ENTRY OF ROUTINE *; *; CALL NXSBLK *; *; EXIT: *; (H,L) = ADDRESS OF NEXT *; BLOCK *; A = 0 IF END OF MEMORY *; E SET TO INDICATE APPROP. RAM *; OTHER REGS. UNCHANGED, FLAGS ARE. *;*****************************************NXSBLK EQU $  PUSH B  XRA A  CMP H ;H = 0?  JNZ NXB100 ;NO - ADVANCE TO NEXT BLOCK  LHLD BUFBGN ;IS THERE ANY NON DISPLAY NXB060 EQU $  LDA BUFEND+1 ;MEMORY? CMP H  JNC NXB200 ;YES, EXIT LHLD DSPBGN ;NO, USE DISPLAY MEMORY  INR E ;INDICATE DISPLAY MEMORY JMP NXB200 ;EXIT NXB100 EQU $  ORA E ;INCREMENT BY 4K (BIT 7 = 0) LXI B,10000Q ;(SET FOR 4K INCREMENT)  JP NXB150 ;YES - COMPUTE NEXT BLOCK AD MVI B,256/256 ;NO - INCREMENT BY 256 ONLYNXB150 EQU $  DAD B ;BUMP POINTER  RRC ;TESTING NON-DISPLAY AREA? JNC NXB060 ;YES - CHECK UPPER BOUNDARY NXB200 EQU $  MOV A,H ;IF WE WENT OVER TOP OF ; MEMORY H,= 0 POP B  RET ;********************************************** ; NXTCHR - GET NEXT CHARACTER IN DISPLAY LIST * ;********************************************** ; ; ENTRY: D,E = ADDRESS OF CURRENT CHARACTER ; ; EXIT : Z = T, CHARACTER IS NOT AN EOL LINK; A = DISPLAY CHARACTER; D,E = ADDRESS OF CHARACTER ; F, NEXT CHARACTER IS EOL LINK; A DESTROYED; D,E = ADDRESS OF NEXT LINE LINK; NXTCH0 EQU $  XCHG ;PUT POINTER INTO D,E NXTCHR EQU $  DCX D ;GET THE NEXT DISPLAY  LDAX D ;CHARACTER CPI LNKLIM ;IS IT A LINK? JC NCH010 ;NO - EXIT XCHG ;YES - GET NEW ADDRESS DCX H ;GET LSB OF LINK MOV L,M  MOV H,A  XCHG ;PUT ADDRESS INTO D,E  MOV A,E ;PUT LSB INTO A-REGISTER CMA ;END OF LINE LINK (LOWER FOU ANI BLKSM ;BITS NOT ALL ONES)? RNZ ;YES - RETURN Z FALSE  LDAX D ;NO - GET THE DATA BYTE ; NCH010 EQU $  CMP A ;SET Z TRUE  RET ;RETURN  ;**************************** ; PAROUT - SEND STATUS BITS * ;**************************** ; ; ENTRY: A = PARITY BITS TO BE SENT ;  ; EXIT : A-E DESTROYED ; PAROT4 EQU $ ;ROTATE DOWN 4 BITS FIRST  RRCPAROT3 EQU $ RRCPAROT2 EQU $ RRCPAROT1 EQU $ RRCPAROUT EQU $ ANI 17Q ;GET BITS 0-3  ADI ZERO ;ADD IN ZERO BASE TO FORCE PUSH H ;DISPLAYABLE CHARACTER CALL ECONTF ;PERFORM OUTPUT FUNCTION POP H ;RESTORE H,L RET ;RETURN   ;**************** ; PREVIOUS PAGE * ;**************** PREVPG EQU $ MVI A,-MAXROW-1  MVI L,MLKROW ;COMPUTE NUMBER OF ROWS TO ADD M ;ROLL DOWN CALL PRV100 JMP NXT040 ; ; PRVPG1 - ROLL DOWN FOR CURSOR POSITIONING; ; ENTRY: H,L = CURROW+; PRVPG1 EQU $ MVI M,0 ;SET CURRENT ROW TO ZERO; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; PRV100 - ROLL DOWN N LINES ; ; ENTRY: A = -NUMBER OF LINES TO ROLL DOWN ; H = BASEH ; ; EXIT : A-L DESTROYED; ; PRV100 EQU $ STA ROLLCT ;SAVE THE ROLL COUNTPRV110 EQU $  CALL ROLLDN ;LINE ROLLED DOWN? LXI H,ROLLCT ;(SET H TO DATA PAGE)  RZ ;NO - RETURN INR M ;ALL LINES DONE? JNZ PRV110 ;NO - DO ANOTHER LINE  RET ;YES - RETURN  ;************************************** ; ROLLDN - ROLL DISPLAY DOWN ONE LINE * ;************************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : NZ - ROLL DOWN SUCCESSFUL; Z - ROLL DOWN FAILED ; ALL REGISTERS DESTROYED; ROLLDN EQU $ CALL MLKSCH JZ RLD080 ;************************ ; MEMORY LOCK ROLL DOWN * ;************************  XCHG ;LAST LOCKED LINE ADDR TO D, LHLD TOPLIN ;GET TOP LINE ADDRESS  INX H ;SET ADDRESS TO PREVIOUS LIN INX H ;POINTER CALL CHAIN ;GET PREVIOUS LINE'S ADDRESS ORA A ;PREVIOUS LINE EXIST?  RZ ;NO - RETURN PUSH D ;YES - ROLL DOWN THE LINE  CALL LINDL0 ;DELETE 1ST LINE ABOVE DISP  LXI H,TLINO ;DECREMENT TOP LINE  DCR M ;NUMBER  POP H ;RECALL LAST LOCKED LINE ADD CALL LININA ;ADD LINE BELOW LOCKED LINES LDA MLKROW ;GET LOCK ROW NUMBER DCR A ;ADJUST FOR COMPARE  LXI H,LSTROW ;COMPARE TO LAST ROW DONE  CMP M ;DID IT ROLL DOWN? JM RLD090 ;YES - UPDATE DISPLAY PTRS ORA H ;NO - FORCE NZ AND EXIT  RET ;RETURN   ;******************* ; NORMAL ROLL DOWN * ;******************* RLD080 EQU $ LDA MLKROW ;GET MEMORY LOCK ROW ORA A ;IS IT ZERO? JZ RLD085 ;YES - DO NORMAL ROLL DOWN LXI H,CURROW ;NO - TRY TO ALLOCATE LINES  MOV B,M ;TO MEMORY LOCK ROW  MOV M,A  PUSH B ;SAVE CURRENT ROW NUMBER MVI A,-1 ;(SET FOR COLUMN ZERO) CALL RCADR0 ;IS MEMORY AVAILABLE?  POP B ;(RESTORE CURRENT ROW  MOV A,B ;NUMBER)  STA CURROW  RNZ ;NO - RETURN FAIL  JMP ROLLDN ;YES - RETRY MEMORY LOCK ROL; ; DISPLAY NOT LOCKED - DO NORMAL ROLL DOWN ; RLD085 EQU $  LHLD TOPLIN ;GET TOP LINE ADDRESS  INX H ;SET TO PREVIOUS LINE  INX H ;ADDRESS ORA M ;ANY PREVIOUS LINES? RZ ;NO - DON'T DO ROLL DOWN; YES - ROLL ONE LINE DOWN;*****************************; TOP LINE IS NOT FIRST LINE *; ADVANCE POINTERS *;***************************** MVI D,-1 ;FLAG TO DECREMENT TLINO CALL TOPUPD ;UPDATE TOP LINE POINTERS  MVI L,LSTROW-BASE ;GET LAST ROW PROCESSEDRLD090 EQU $ MOV A,M INR A ;INCREMENT CPI MAXROW+1  JNZ STOREA ;NOT ROLL OFF - STORE ROW  LHLD LSTLIN ;GET ADDR OF LAST LINE DONE  INX H ;SET TO PREVIOUS LINE  INX H ;ADDRESS JMP ROL200  ;************************************ ; ROLLUP - ROLL UP DISPLAY ONE LINE * ;************************************ ROLLUP EQU $ CALL MLKSCH JZ ROL080 ;********************** ; MEMORY LOCK ROLL-UP * ;**********************  MOV A,M ;IS THERE A NEXT LINE? ORA A RZ ;NO - DON'T DO ROLL UP CALL LINDL0 ;YES - REMOVE FIRST UNLOCKED LXI H,TLINO ;LINE  INR M ;INCREMENT TOP LINE NUMBER LHLD TOPLIN ;GET TOP DISPLAY LINE ADDRES LDA MLKROW ;FORCE END-OF-PAGE IF DISPLA ORI MAYEOP ;IS CURRENTLY REFRESHING STA IOCRRW ;MEMORY LOCK BOUNDARY ROW  CALL LININA ;ADD LINE ABOVE DISPLAY  LDA MLKROW ;GET LOCK ROW NUMBER LXI H,LSTROW ;GET LAST ROW PROCESSED  SUB M ;DID IT ROLL UP? JM ROL090 ;YES - UPDATE LINE POINTER RNZ ;NO - RETURN (Z = FALSE) MOV M,A ;SAME - FORCE LAST ROW = 0ROL100 EQU $  MVI L,TOPLIN ;SET CURRENT LINE TO TOP LINE ROL200 EQU $ MOV E,MROLUP2 EQU $ INR L MOV D,M; ; ROLUP3 - UPDATE LSTLIN AND CURADR; ROLUP3 EQU $  XCHG ;SET LSTLIN TO NEW ROWROLUPC EQU $  CALL LSTLUP  XCHG ;PUT NEW ROW ADDRESS INT H,L DCX H ;SET TO LSB OF NEXT LINE PTR SHLD CURADR ;SET CURADR TO TOP LINE  XCHG ;RESTORE D,E AND H,L XRA A ;SET LAST COLUMN PROCESSED STA LSTCOL ;DONE TO ZERO  ORA E ;SET Z-FLAG FALSE  RET ;RETURN   ;***************** ; NORMAL ROLL-UP * ;***************** ROL080 EQU $ LHLD TOPLIN ;GET TOP LINE ADDRESS  ORA M ;IS TOP LINE LAST LINE?  RZ ;YES - RETURN, DON'T ROLL UP MVI D,1 ;NO - SET D TO INCREMENT; "TLINO"  INR A ;SET LSB TO NEXT LINE POINTE;**************************** ; TOP LINE IS NOT LAST LINE * ; ADVANCE POINTERS * ;**************************** ROLUP1 EQU $ CALL TOPUPD ;UPDATE TOP LINE POINTERS  LXI H,LSTROW ;GET LAST ROW # PROCESSED ROL090 EQU $  MOV C,M DCR C ;DECREMENT JM ROL100 ;LINE ROLLED OFF SCREEN  MOV M,C ;STORE UPDATED LSTROW  ORA H ;SET Z-FLAG TO FALSE RET  ;****************** ; CHAR SET SELECT * ;****************** SCHRST EQU $ LXI H,CHRSTB ;SET FOR CHARACTER SET SELEC JMP ESCAP0 ; ; SET NEW ALTERNATE CHARACTER SET; SCHST1 EQU $  MOV A,C ;PUT INPUT CHARACTER IN A-RE ANI 17Q ;EXTRACT CHARACTER SET NUMBE RLC ;SHIFT TO POSITION FOR RLC ;ALTERNATE CHARCTER SET  RLC RLC STA CHRSET ;STORE CHAR SET SELECT CTL RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; SFKYOF - PUT NORMAL DISPLAY ON SCREEN;  ; ENTRY: DON'T CARE ; ; EXIT : ALL REGISTERS DESTROYED; SFKYOF EQU $  CALL CHKSFK ;NORMAL DISPLAY ENABLED? RZ ;YES - RETURN  MVI A,377Q-DEFSKY ;NO - SWAP DISPLAY  CALL CLCMFL ;CLEAR SOFT KEY MODE FLAG  CALL CKDSPF ;DISPLAY FUNCTIONS ENABLED?  JNZ SFO010 @@ ;YES - DON'T RESET RANGE TBL LXI H,RTABLE ;NO - RESTORE NORMAL SHLD RNGTA ;CHARACTER FUNCTION TABLE  JMP SFO010 ;TURN ON NORMAL DISPLAY  ;****************************************** ; SFKYON - PUT SOFT KEY DISPLAY ON SCREEN * ;****************************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : NZ ; ALL REGISTERS DESTROYED; SFKYON EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? RNZ ;YES - RETURN  MVI A,DEFSKY ;NO - SWAP DISPLAY CALL STCMFL ;SET SOFT KEY MODE FLAG ;  ; EXCHANGE DISPLAY ; SFO010 EQU $  CALL SWAP ;SWAP DISPLAY PARAMETERS CALL RSTDSP ;TURN ON THE DISPLAY CALL FLDSRX ;RESCAN LINE TO SET PROPER JMP RCADRA ;FIELD ATTRIBUTE;********************************************** ; SFKYDS - DISPLAY CHARACTER IN SOFT KEY MODE * ;********************************************** ; ; ENTRY: DCHAR = CHARACTER TO BE DISPLAYED; ; EXIT : IF CHARACTER FROM KEYBOARD,; CHARACTER IS ADDED TO DISPLAY; OTHERWISE, NORMAL DISPLAY IS RESTORED; SFKYDS EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? JZ DSPCHR ;NO - USE NORMAL ROUTINE CALL DCXB2D ;INPUT FROM KEYBOARD?  CNZ SFKYOF ;NO - SWAP DISPLAY JNZ DSPCHR ;AND USE NORMAL ROUTINE  JMP FDESC1 ;YES - DISPLAY CHARACTER; AND KILL "CURADV" FLAG  ;********************** ; SFTRST - SOFT RESET * ;********************** SFTRST EQU $  CALL IOBSYC ;WAIT UNTIL CTU'S FREE DI ;DISABLE INTERRUPTS  MVI A,1 ;SET RESET TIMER FOR ONE STA RSTTMR ;SECOND ONLY JMP GO1 ;DO SOFT RESET  ;***************** ; SO - SHIFT OUT * ;***************** SHFTOT EQU $ CALL CHKSFK ;DEFINE SOFT KEY MODE? RNZ ;YES - DON'T SWITCH CHAR SET LDA CHRSET ;GET CURRENT ALT CHAR SET SHFT1 EQU $  MOV B,A ;PUT NEW CHAR SET IN B-REG MVI A,SWCHAR ;SET CHARACTER SWITCH IN CALL ZKBCTL ;KEYBOARD FOR POSSIBLE; FOREIGN MODE ENABLE  MOV A,B ;RECALL NEW CHARACTER SET SHFT2 EQU $ ;ENTRY FOR SELF-TEST MVI B,17Q ;SET MASK TO SAVE DISPLAY ; ENHANCEMENT BITS JMP DISPC1 ;ADD CODE TO DISPLAY ;**************** ; SI - SHIFT IN * ;**************** SHFTIN EQU $ CALL CHKSFK ;DEFINE SOFT KEY MODE? RNZ ;YES - DON'T SWITCH CHAR SET XRA A ;SET FOR BASE CHARACTER  JMP SHFT1 ;SET CODE  ;********************************** ; STATUS - RETURN TERMINAL STATUS * ;********************************** STATUS EQU $  LXI B,SSTAT ;SET BLOCK TRANSFER FOR  JMP SBLXF0 ;FOR TERMINAL STATUS;************************************ ; STATGO - TRANSMIT TERMINAL STATUS * ;************************************ STATGO EQU $  LXI B,-1-SSTAT  CALL CLBLXF ;CLEAR STATUS PENDING FLAG MVI B,ABCKSL ;SEND -<\>  CALL ESCOUT  LXI H,XPUTDC ;SET OUTPUT ROUTINE ADDRESS  CALL STAPAR ;OUTPUT STATUS BITS  LXI H,ERRFLG ;CLEAR DATA COMM ERROR FLAG  MOV A,M  ANI 377Q-DCMERR  MOV M,A  JMP SDTERM ;SEND TERMINATOR AND RETURN  ;****************************** ; STAPAR - OUTPUT STATUS BITS * ;****************************** ; ; ENTRY: H,L = ADDRESS OF OUTPUT ROUTINE; ; EXIT : CNTFAD = ADDRESS OF OUTPUT ROUTINE ; ALL REGISTERS DESTROYED; STAPAR EQU $  SHLD CNTFAD ;SET OUTPUT ROUTINE VECTOR;  ; OUTPUT SIZE OF RAM ;  LDA DSPBGN+1 ;COMPUTE NUMBER OF 256-BYTE  CMA ;RAM BLOCKS IN DISPLAY INR A ;AREA  CALL PAROT2 ;TRANSMIT MEMORY SIZE IN K'S; ; OUTPUT KEYBOARD INTERFACE STRAP SETTINGS ;  LDA KBJMPR ;TRANSMIT STRAPS A-D MOV L,A ;SAVE JUMPER VALUES  CALL PAROUT  MOV A,L ;RECALL JUMPER VALUES  CALL PAROT4 ;TRANSMIT STRAPS E-H; ; OUTPUT LATCHING KEYS STATUS;  LDA MDFLG2 ;GET TERMINAL MODE FLAGS 2 ANI CAPSLK+BLKMDE+AUTOLF ;EXTRACT BITS  ORI 10Q ;ADD BIT 3 TO INDICATE 2645  CALL PAROUT ;SEND LATCHING KEY STATUS ; ; OUTPUT TERMINAL (2640) TRANSFER PENDING FLAGS;  LHLD MFLGS2 ;GET TERMINAL MODE FLAGS MOV A,H ;MASK FOR SECONDARY STATUS ANI SSTAT2/256 ;PENDING BIT RRC ;SHIFT BIT INTO STATUS RRC ;RESPONSE POSITION RRC MOV B,A  MOV A,H ;GET OTHER DISPLAY RELATED ANI (SENTER+SFCTKY+SCRSEN)/256;XFR BITS  ORA B ;ADD IN SECONDARY STATUS CALL PAROT4 ;SEND TRANSFER PENDING BITS  ; ; OUTPUT ERROR CONDITION FLAGS ;  MVI B,0 ;SET FOR NO I/O ERROR  LDA IOCERR ;GET I/O ERROR FLAG  CPI F ;I/O ERROR OCCURRED? JNZ STA010 ;NO - GET OTHER ERROR FLAGS  MVI B,IOERRB ;YES - SET I/O ERROR BITSTA010 EQU $  NOP ;INSTR. DELETED TO FIX BUG LDA ERRFLG ;GET THE ERROR FLAGS ORA B ;MERGE WITH EXISTING BITS  CALL PAROUT ;TRANSMIT ERROR STATUS; ; OUTPUT DEVICE TRANSFER PENDING FLAGS ;  MOV A,H ;GET TERMINAL MODE 1 FLAGS RLC ;PUT I/O DONE FLAG IN C-FLAG MOV A,L ;GET TERMNAL MODE 2 FLAGS  RAL ;ADD IN I/O DONE FLAG  MOV B,A ;SAVE TEMPORARY RESULTS  MOV A,H ;RECALL TERMINAL MODE 1 FLAG RRC ;PUT DEVICE STATUS INTO  RRC ;C-FLAG  RRC RRC MOV A,B ;RECALL ACCUMULATED BITS RAL ;ADD IN DEVICE STATUS  JMP PAROUT ;SEND DEVICE XFR PENDING BIT ;******************************************** ; STCHR1 - SET INITIAL DISPLAY CHARACTER IN * ; NEW DISPLAY BLOCK * ;******************************************** ; ; ENTRY: H,L = ADDRESS OF FIRST DISPLAY  ; IN BLOCK ; ; EXIT : A = 0 ; H,L UNCHANGED ; STCHR1 EQU $  LDA MDFLG1 ;GET SOFT MODE FLAGS ANI FORGN ;FOREIGN MODE ENABLED? MVI A,EOL ;(SET TO STORE EOL)  JZ STC010 ;NO - STORE EOL ONLY DCX H ;YES - STORE EOL AND DISPLAY MOV M,A ;CONTROL BYTE TO CAUSE LDA FRSALT ;FOREIGN CHARACTER SET TO  ORI 200Q ;BE DISPLAYED  INX H STC010 EQU $  MOV M,A ;STORE FIRST DISPLAY CHAR  XRA A ;CLEAR A-REGISTER  RET ;RETURN  ;************************************ ; TEST - PERFORM TERMINAL SELF TEST * ;************************************ TEST EQU $  CALL CKEDIT ;EDIT MODE ENABLED?  RNZ ;YES - DON'T DO SELF-TEST  MVI A,CKIOKY  CALL ZKBCTL ;I/O CONTROL KEY DOWN ALSO?  LXI H,TSTCTU ;(SET FOR CTU SELF-TEST) JNZ IORMGO ;YES - DO CTU SELF-TEST ; NO - DO TERMINAL SELF-TEST; ; PERFORM TERMINAL SELF-TEST ; TRMTST EQU $  LDA KBJMP2 ;GET KEYBOARD JUMPERS 2  ANI NOTEST ;SELF-TEST INHIBITED LXI H,NOTSMS ;(SET MESSAGE ADDRESS) JNZ DSPMS1 ;YES - DISPLAY MSG AND EXIT  LDA DFLGS ;GET DATA TRANSFER FLAGS ANI XBF2DS ;DATA FROM I/O BUFFER  JNZ DSPMS1 ;YES - DON'T DO SELF-TEST  CALL IOBSYC ;WAIT UNTIL CTU'S IDLE DI ;DISABLE INTERRUPTS  MVI A,STRTST ;SET KEYBOARD FOR SELF-TEST  CALL ZKBCTL ;START-UP   ;********************* ; ROM TEST * ; * ; CALCULATE CHECKSUM * ; FOR EACH 2K ROM * ;*********************  LXI H,-NUM2K ;SET FOR START ADDRESS = 0; TST010 EQU $  LXI D,NUM2K ;INCREMENT START ADDR BY 2K  DAD D ; ; IS CURRENT ADDRESS A ROM? ;  MOV A,H ;PUT MSB INTO A-REGISTER CPI 134000Q/256-1 ;ADDRESS > 48K? JNC TST050 ;YES - GO TO NEXT TEST CPI 100000Q/256 ;IN I/O SPACE?  JZ TST010 ;YES - GO TO NEXT ROM BLOCK  CPI 104000Q/256  JZ TST010 ;YES - GO TO NEXT ROM BLOCK  CALL IORMG1 ;DOES THE ROM EXIST? JZ TST020 ;YES - CHECK THE ROM XRA A ;NO - CHECK FOR NO ROM ORA L ;ROM INSTALLED?  JZ TST010 ;NO - GO TO NEXT ROM MOV A,H ;YES - REPORT POSSIBLE JMP TST030 ;MISPLACED ROM ;********************* ; CALCULATE CHECKSUM * ;********************* TST020 EQU $  DCX H ;RESTORE START ADDRESS MVI D,NUM2K/256 ;SET TO SUM 2K SPACE  CALL CHKSUM ;CALCULATE CHECKSUM  INR A ;= 377 ?;********************************************  JZ TST010 ;YES - DO NEXT ROM BLOCK;********************************************  XRA A ;NO - REPORT BAD ROMTST030 EQU $  LXI D,ROMERR ;SET ROM ERROR MESSAGE ADDR  MOV C,A ;SAVE EXPECTED VALUE MOV B,M ;GET VALUE FOUND MOV A,H ;CONVERT ROM ADDRESS TO  RRC ;ROM NUMBER (0,2,4,...)  RRC MOV L,A ;SET AS ERROR ADDRESS  MVI H,0  MOV A,C ;RECALL EXPECTED VALUE JMP TST600 ;REPORT ERROR  ;****************************** ; RAM TEST * ; * ; CALCULATE CHECKSUM ON * ; EACH 4K BLOCK. * ; TEST EACH 256 BYTE SECTION * ; RECHECK CHECKSUM. * ;****************************** ; ; E = 0; TST050 EQU $  MVI A,CRTOFF ;TURN OFF VIDEO  STA IOCRRW  LXI H,IOBUF ;SET H,L TO I/O BUFFER #1  CALL CLRAL1 ;CLEAR THE I/O BUFFER  MOV B,H ;SET B,C = IOBUF2  MOV C,L ;(H,L = IOBUF2)  MVI D,10000Q/256 ;SET D,E FOR 4K INCREMEN MOV H,E ;SET H TO 0 TO INDICATE STAR STAX B ;SET CHECKSUM FOR LAST; BLOCK TO ZERO ;******************************************** ; CALCULATE CHECKSUM FOR EACH RAM BLOCK AND * ; STORE CHECKSUM IN "IOBUF2" * ;******************************************** TST060 EQU $  CALL NXSBLK ;GET NEXT BLOCK ADDRESS  CALL CHKSUM ;COMPUTE CHECKSUM  STAX B ;STORE CHECKSUM VALUE  JNZ TST060 ;CONTINUE IF NOT LAST BLOCK  ; ; CHECK EACH 256 BYTE RAM SECTION ;  MOV E,L ;SET E TO ZERO TO INDICATE; TESTING OF FAST RAM AREA MVI H,FSTRAM/256 ;START OF FAST RAM (L=0)TST090 EQU $ ; ; TEST THE RAM IN THE FOLLOWING STEPS ; ; 1. SAVE THE SECTION'S CONTENTS LXI B,IOBUF ;I/O BUFFER TST100 EQU $  MOV A,M ;BYTE TO BE SAVED  STAX B  INR C ;SET TO NEXT SAVE ADDRESS ; 2 SET EACH BYTE = MSB .XOR. LSB OF ADDR MOV A,L  XRA H  MOV M,A  INR L ;ALL BYTES DONE? JNZ TST100 ;NO - DO THE NEXT BYTE; 3. WAIT ; APPROX 2 MS, 5000 CLOCK CYCLES TST115 EQU $  MOV A,A ;NO OP INR L  JNZ TST115 ; 4. CHECK EACH MEMORY LOCATION  ; COMPLEMENT IT  MOV D,L ;D = 0, COUNTER  DCR L ;L= 377BTST120 EQU $  MOV A,L ;CALCULATE EXPECTED VALUE  XRA H  CMP M ;SAME AS BEFORE? JNZ TST510 ;NO - REPORT ERROR WITH ; EXPECTED/FOUND BYTES CMA MOV M,A ;SET COMPLEMENT  DCR L  DCR D ;DONE WITH THIS SECTION? JNZ TST120 ;NO ; 5. WAIT AGAIN ; APPROX 2 MS, 5000 CLOCK CYCLES TST125 EQU $  MOV A,A ;NO OP DCR L  JNZ TST125 ;LOOP FOR 256 TIMES  ; 6. CHECK VALUES. RESTORE ORIGINAL VALUE ; B,C = IOBUF; TST130 EQU $  MOV A,L  XRA H  CMA CMP M ;SAME AS BEFORE? JNZ TST510 ;NO - REPORT ERROR WITH ; EXPECTED/FOUND BYTES LDAX B  MOV M,A ;RESTORE INX B  INR L ;BLOCK COMPLETED?  JNZ TST130 ;NO - DO NEXT BYTE;***************************; DONE WITH THIS SECTION. *; DO NEXT? *;*************************** INR E ;IF E = 0, WE JUST TESTED  DCR E ;FAST RAM  JNZ TST140  MOV H,E ;H=0, INDICATE START MVI E,200 ;BIT 7 = 1 MEANS 256; BYTE INCREMENTS ; TST140 EQU $  CALL NXSBLK ;GET NEXT BLOCK ADDRESS  ORA A ;LAST BLOCK DONE?  JNZ TST090 ;NO, TEST NEXT ;***************************; CHECK ORIGINAL CHECKSUMS *;***************************; ; B,C = IOBUF2 ;  MOV E,C ;SET E TO ZERO MVI H,IOBUF/256 ;SET H TO I/O BUFFER #1 CALL CLRAL1 ;CLEAR THE I/O BUFFER ; (H,L) = IOBUF2, TOP HALF OF I/O BUFFER  MVI D,10000Q/256 ;SET D,E FOR 4K INCREMEN MOV A,M ;GET CHECKSUM FOR TOP BLOCK  MOV M,E ;SET STORE BYTE TO ZERO  PUSH PSW ;SAVE TOP BLOCK CHECKSUM MOV H,E ;SET H TO 0 TO INDICATE STAR;***********************************************; RE-CALCULATE CHECKSUM FOR EACH RAM BLOCK AND *; COMPARE TO INITIAL STORED VALUE *;***********************************************TST150 EQU $  CALL NXSBLK ;GET NEXT BLOCK ADDRESS  CALL CHKSUM ;COMPUTE CHECKSUM FOR BLOCK  MOV L,A ;SAVE COMPUTED VALUE IN L-RE JZ TST160 ;LAST BLOCK - CHECK 1ST VALU LDAX B ;RECALL ORIGINAL CHECKSUM  SUB L ;DO CHECKSUMS MATCH? MOV L,A ;(SET L TO ZERO IF TRUE) JZ TST150 ;YES - GO TO NEXT BLOCK  JMP TST500 ;NO - REPORT ERROR; TST160 EQU $  POP PSW ;RECALL 1ST STORED CHECKSUM  SUB L ;DO CHECKSUMS MATCH? JNZ TST500 ;NO - REPORT ERROR  ;*********************** ; DISPLAY TEST PATTERN * ;***********************  CALL ZBELL ;SOUND THE BELL  MVI A,300Q ;SET INITIAL CHARACTER SETTST200 EQU $  SUI 20Q ;SET TO NEXT CHARACTER SET PUSH PSW ;SAVE CURRENT ENHANCEMENT  XRA A ;SET CHARACTER TO NULL STA TCHAR TST220 EQU $  CALL CRRET ;DO CR  CALL CONDLF ;DO LF IF WRAPAROUND DISABLED  POP PSW ;RECALL CURRENT ENHANCEMENT  PUSH PSW ;AND SAVE IT AGAIN CALL SHFT2 ;PUT ENHANCEMENT ON DISPLAY TST240 EQU $  LDA TCHAR ;GET CURRENT ENHANCEMENT COD STA DCHAR ;STORE CHAR FOR DISPLAY  ANI 7 ;EVERY 8 CHARS INSERT 2 BLNKS  CPI 4 ;TIME TO ADD TWO BLANKS? CZ @@ CURAD2 ;YES - ADVANCE CURSOR TWICE  CALL DSPCHR ;DISPLAY THE CHARACTER LXI H,TCHAR  INR M ;INCREMENT DISPLAY CHARACTER MOV A,M ;GET NEW CHARACTER CPI 64  JZ TST220 ;IF 64 THEN NEW LINE ORA A ;ALL CHARACTERS DONE?  JP TST240 ;NO - CONTINUE CALL CRLF ;YES - DOUBLE SPACE BETWEEN  POP PSW ;CHARACTER SETS  CPI 200Q ;ALL CHARACTER SETS DONE?  JNZ TST200 ;NO - CONTINUE DISPLAY ;****************************** ; DISPLAY ENHANCEMENT PATTERN * ;******************************  PUSH PSW ;SAVE ENHANCEMENT CODE CALL CONDLF ;DO LF IF WRAPAROUND DISABLETST420 EQU $  POP PSW ;RECALL CURRENT ENHANCEMENT  PUSH PSW ;SAVE ENHANCEMENT AGAIN  SUI 100Q ;COMPUTE ASCII DISPLAY CODE  CALL DSPTST ;DISPLAY THE CHARACTER POP PSW ;RECALL CURRENT ENHANCEMENT  INR A ;INCREMENT ENHANCEMENT CPI 220Q ;LAST ENHANCEMENT DONE?  JZ TST440 ;YES - DISPLAY STATUS  PUSH PSW ;NO - SAVE ENHANCEMENT CODE  CALL DISPC0 ;ADD ENHANCEMENT TO DISPLAY  JMP TST420 ;DISPLAY ASCII DISPLAY CODE ; TST440 EQU $  XRA A  CALL DISPC0 ;RETURN TO NORMAL VIDEO  CALL CURAD2 ;ADVANCE CURSOR TWICE ;************************** ; DISPLAY TERMINAL STATUS * ;**************************  LXI H,ERRFLG ;SET ERROR FLAG TO MOV A,M ;SELF-TEST SUCCESSFUL  ORI TESTOK  MOV M,A  LXI H,DSPTST ;SET H,L TO OUTPUT ROUTINE CALL STAPAR ;DISPLAY TERMINAL STATUS CALL CURADV ;PUT SPACE BETWEEN STATUS  CALL STA2G2  CALL CRLF CALL CRLF ;********************** ; TERMINATE SELF-TEST * ;**********************  MVI A,ENDTST ;RESTORE KEYBOARD LED'S  CALL ZKBCTL  EI ;RE-ENABLE INTERRUPTS  JMP CRADV1 ;RESET CURSOR ADVANCE FLAG TST500 EQU $ ;REPORT RAM ERROR  XRA A ;SET Z TRUE FOR ADDRESS ONLY MOV L,A ;FORCE L-REGISTER TO BE ZEROTST510 EQU $  MOV B,M ;PUT VALUE FOUND INTO B-REG  LXI D,RAMERR ;SET D,E TO ERROR MESSAGE ;**************************** ; REPORT ROM/RAM TEST ERROR * ;**************************** ; ; ENTRY: D,E = ADDRESS AT WHICH ERROR OCCURRED; H,L = ERROR MESSAGE ADDRESS; Z - DISPLAY ERROR ADDRESS ONLY ; NZ - DISPLAY PARAMETERS ALSO ; A = EXPECTED VALUE ; (H,L) = VALUE FOUND; TST600 EQU $  XCHG ;(H,L) = MESSAGE ADDRESS; (D,E) = ERROR ADDRESS  PUSH H ;SAVE THE MESSAGE ADDRESS  LXI H,ERREOP ;SET EOP FOR SHORT MESSAGE SHLD MSGPT4  JZ TST610 ;Z - SHOW ADDRESS ONLY LXI H,IOBUF2 ;SET BUFFER ADDRESS  SHLD MSGPT4  PUSH B ;SAVE VALUE FOUND  CALL BINOCT ;CONVERT BINARY TO OCTAL POP PSW ;RECALL VALUE FOUND  CALL BINOCT ;CONVERT BINARY TO OCTAL MVI M,EOP ;TERMINATE WITH "EOP" TST610 EQU $  LXI H,IOBUF2+16 ;CONVERT FAILURE ADDRESS  SHLD MSGPT3  CALL BN2DEC ;CONVERT TO DECIMAL ASCII  LXI H,RXMERR ;SET REST OF LITERAL SHLD MSGPT2  LDA DFLGS ;GET DATA TRANSFER FLAGS ANI SDACOM ;TEST FROM DATA COMM?  POP H ;(RECALL MESSAGE ADDRESS)  JZ HANGU0 ;NO - SHOW MESSAGE AND HANG  RST 0 ;YES - RESET THE TERMINAL   ;****************** ; MESSAGE STORAGE * ;****************** BUFMSG EQU $  DB 'BUFFER OVERFLOW',EOP ; ROMERR EQU $  DB 'ROM',0 ; RAMERR EQU $  DB 'RAM',0 ; INERMS EQU $  DB 'I/O' ; RXMERR EQU $  DB ' ERROR ',0 ; LDRMSG EQU $  DB 'LOADER' ERREOP EQU $  DB EOP ; NOTSMS EQU $  DB 'NO TEST',EOP ; NODRVR EQU $  DB 'NO DEVICE DRIVER',EOP; TRMRDY EQU $  DB 'TERMINAL READY',EOP ;************************************ ; TOPUPD - UPDATE TOP LINE POINTERS * ;************************************ TOPUPD EQU $ INX H ;PUT THE MSB INTO THE  MOV B,M ;B-REGISTER  MOV C,A ;SAVE TOP LINE'S LSB IN C-RE LXI H,TLINO ;UPDATE TOP LINE NUMBER  MOV A,D ORA A ;IS TLINO TO BE RESET? JZ TOP100 ;YES  ADD M ;NO - INCREMENT OR DECREMENTTOP100 EQU $ MOV M,A ;STORE UPDATED TLINOTOPUP1 EQU $  MOV H,B ;SET NEW TOP LINE POINTER  MOV L,C  SHLD TOPLIN  LDA CMFLGS ;GET COMMON FLAGS  ANI DEFSKY ;SOFT KEY DEFINE MODE? RNZ ;YES - DON'T CHANGE SCREEN LXI H,DISPST+1 ;GET DISPLAY START ADDRESS DCX B ;SET TO FIRST CHAR ADDRESS;************************************** ; DISLNK - STORE LINK IN DISPLAY AREA * ;************************************** ; ; ENTRY: B,C = LINK TO BE STORED; H,L = STORE ADDRESS FOR MSB PART ; ; EXIT : H,L = LSB OF STORE ADDRESS  ; A DESTROYED ; INTERRUPTS ENABLED ; DISLNK EQU $  MVI A,DMAOFF ;SET TO TURN OFF THE DMA DI ;DISABLE INTERRUPTS  STA IOCRRW ;TURN OFF DMA  MOV M,B ;STORE LINK'S MSB  DCX H  MOV M,C ;STORE LINK'S MSB DISLN1 EQU $ ;SET CURSOR ROW POSITION LDA CURROW ;TURN DMA BACK ON WITHDISLN2 EQU $  STA IOCRRW ;CURRENT CURSOR ROW ADDRESDISLN3 EQU $  EI ;RE-ENABLE INTERRUPTS DISLN4 EQU $ ;RE-ENABLE RESET KEY MVI A,RSTON STA IOKBCO  RET ;RETURN  ;*******************************; TYPSET - SET TYPE DEFINITION *;*******************************TYPSET EQU $  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RNZ ;YES - DO SET TYPE LDA DCHAR ;NO - COMPUTE TYPE DEFINITIO ADI ALPHA-ZERO-6 ;CHARACTER JMP DISPC1 ;ADD CHARACTER TO DISPLAY ;************************************ ; SFKCHK - SOFT KEY ATTRIBUTE CHECK * ;************************************ SFKCHK EQU $  ANI 377Q-40Q ;FORCE INPUT TO UPPER CASE LHLD CURADR ;RECALL CHARACTER ADDRESS  MOV M,A ;STORE UPPER CASE VALUE  CPI N ;NORMAL ATTRIBUTE SET? RZ ;YES - RETURN SUCCESSFUL CPI L ;LOCAL ATTRIBUTE SET?  RZ ;YES - RETURN SUCCESSFUL CPI T ;TRANSMIT ONLY SET?  RZ ;YES - RETURN SUCCESSFUL MOV M,B ;NO - RESTORE ORIGINAL RET ;ATTRIBUTE AND RETURN NZ ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; XMS2DS - TRANSFER MESSAGE TO NORMAL DISPLAY; ; ENTRY: H,L = POINTER TO MESSAGE ; ; EXIT : A-L DESTROYED; Z - TERMINATED BY A NULL BYTE; NZ - TERMINATED BY AN EOP; XMD000 EQU $  CALL DSPTST ;DISPLAY ASCII CHARACTER AND; ADVANCE CURSORXMD010 EQU $  POP H ;RESTORE H AND L INX H ;MOVE TO NEXT BYTE; PROCESS THE NEXT BYTE XMS2DS EQU $  MOV A,M ;SET THE SOURCE BYTE ORA A ;IS IT A NULL BYTE?  RZ ;YES - RETURN (Z - TRUE) CPI EOP ;IS IT END OF PAGE FLAG? JZ XMD030 ;YES - EXIT  PUSH H ;NO - SAVE H,L CPI EOL ;IS IT AN END OF LINE? JZ XMD020 ;YES - START A NEW LINE  ORA A ;IS CHARACTER ASCII? JP XMD000 ;YES - DISPLAY IT  MVI B,0 ;NO - FORCE ENHANCEMENT CODE CALL DISPC2 ;TO BE STORED AS IS  JMP XMD010 ;GO TO NEXT BYTE; ; EOL CODE - TERMINATE THE LINE; XMD020 EQU $  CALL CRLF ;PERFORM RETURN AND LINE FEE JMP XMD010 ;DO NEXT BYTE ; ; EOP CODE - TERMINATE LINE AND EXIT ; XMD030 EQU $  CALL CRLF ;PUT CURSOR IN NEXT LINE ORA H ;SET Z FALSE RET ;RETURN TEMINATED BY EOP ;******************************************** ; CARRET - PERFORM DISPLAY FUNCTIONS RETURN * ;******************************************** CARRET EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? JZ CAR010 ;NO - DO NORMAL PROCESSING;************************** ; R O M B R E A K 2 * ;**************************  JMP ZBRK2C ;GO TO NEXT ROM BLOCK  ORG ZBRK1+4000Q ZBRK2 EQU $  DB VERSN ;ROM PRESENT FLAGS DB ZBRK2/256 ZBRK2C EQU $ ;************************************************  CALL DCXB2D ;DATA FROM KEYBOARD? JZ DSPCHR ;YES - DISPLAY RETURN CODE CALL SFKYOF ;NO - RESTORE NORMAL DISPLAYCAR010 EQU $  LXI H,CRLF ;SET NORMAL ROUTINE EXIT JMP DSPCH0 ;DISPLAY THE CHARACTER ;***********************************************; CHKLIM - CHECK PARAMETER BOUNDARY CONDITIONS *;***********************************************; ; ENTRY: B = CURRENT VALUE; C = MAXIMUM ALLOWABLE VALUE; D,E = ADDRESS OF PARAMETER TO BE SET ; IODATA = PARAMETER VALUE (2 BYTES) ; IOPSGN = -1, NEGATIVE ADJUSTMENT ; = 0, ABSOLUTE VALUE; = +1, POSITIVE ADJUSTMENT ; ; EXIT : NEW VALUE IN WORD ADDRESSED BY D,E ; A,C,H,L DESTROYED; ; THIS ROUTINE SET THE NEW VALUE BY EITHER ; OR ABSOLUTE ADJUST WITHING THE LIMITS OF ; ZERO AND THE MAXIMUM ALLOWABLE AS SPECIFIED ; THE C-REGISTER ON ENTRY ; ; THE LARGEST MAXIMUM VALUE IS 255 ; CHKLI0 EQU $  LDA IOCSGN ;SET PARAMETER SIGN TO STA IOPSGN ;INPUT SIGN CHKLIM EQU $  LDA IODATA+1 ;GET MSB OF INPUT VALUE  ORA A ;MAXIMUM EXCEEDED? LDA IOPSGN ;(GET PARAMETER SIGN)  JZ CHK050 ;NO - CONTINUE EVALUATION  ADD A ;NEGATIVE ADJUSTMENT?  JP CHK070 ;NO - SET TO MAXIMUM VALUE; ; DEFAULT TO MINIMUM VALUE (0) ; CHK010 EQU $ ;SET TO ZERO XRA A STAX D ;STORE NEW VALUE RET ;RETURN  ; ; PARAMETER < 256, EVALUATE FOR RELATIVE AMOUNT; CHK050 EQU $ LXI H,IODATA ;SET H,L TO GET INPUT VALUE  ADD A ;RELATIVE POSITIONING? MOV A,B ;(LOAD CURRENT VALUE)  JM CHK160 ;MINUS - SUBTRACT INPUT  JNZ CHK150 ;PLUS - ADD INPUT  MOV A,M ;NONE - ABSOLUTE ASSIGNMENT ;  ; CHECK UPPER LIMIT + 1 ; CHK060 EQU $  STAX D ;STORE ASSIGNED VALUE  CMP C ;MAXIMUM EXCEEDED? RC ;NO - RETURNCHK070 EQU $ ;YES - USE MAXIMUM VALUE MOV A,C  ;************************ ; STORE PARAMETER VALUE * ;************************ CHK100 EQU $  STAX D ;STORE PARAMETER VALUE RET ;RETURN ; ; POSITIVE ADJUSTMENT - ADD INPUT; CHK150 EQU $ ADD M ;OVERFLOW? JNC CHK060 ;NO - USE SPECIFIED VALUE  JMP CHK070 ;YES - USE MAXIMUM VALUE; ; NEGATIVE ADJUSTMENT - SUBTRACT INPUT ; CHK160 EQU $ SUB M ;UNDERFLOW?  JC CHK010 ;YES - USE ZERO  STAX D ;NO - USE COMPUTED VALUE RET ;RETURN  ;***********************************************; CKDSPF - CHECK FOR DISPLAY FUNCTIONS ENABLED *;***********************************************CKDSPF EQU $  LDA MDFLG1 ;GET SOFT MODE FLAGS ANI DSPFNC ;MASK FOR DISPLAY FUNCTIONS  RET ;FLAG AND RETURN;***************************************; CKEDIT - CHECK FOR EDIT MODE ENABLED *;***************************************CKEDIT EQU $  LDA MDFLG1 ;GET SOFT MODE FLAGS ANI EDIT ;MASK FOR EDIT FLAG AND  RET ;RETURN ;************************************** ; GTMODE - DETERMINE MODE OF TERMINAL * ; Z = TRUE IF CHARACTER MODE * ; Z = FALSE IF PAGE MODE * ;************************************** GTMOD1 EQU $  LDA IOFLG2 ;GET I/O FLAGS ANI XDS2BF ;DISPLAY TO BUFFER TRANSFER? RNZ ;YES - RETURN PAGE MODE GTMODE EQU $ ;NO - CHECK REAL PAGE MODE LDA MDFLG2 ;GET TERMINAL MODE FLAGS 2 ANI BLKMDE ;BLOCK MODE ENABLED? RZ ;NO - RETURN (Z=TRUE) ; ; CKLNMD - CHECK LINE MODE ; ; EXIT : Z = TRUE, LINE MODE; = FALSE, PAGE MODE ; A,L DESTROYED; CKLNMD EQU $ LDA KBJMPR ;GET THE STRAP SETTINGS  ANI PAGSTR ;SET Z-FLAG  RET ;RETURN  ;*******************************************; CKPROT - CHECK PROTECT STATUS OF CURRENT *; CURSOR LOCATION *;*******************************************CKPROT EQU $  LDA PROFLD ;GET PROTECT FLAG  INR A ;SET Z-FLAG (-1 => PROTECTED RET ;RETURN ;*****************************************; CKRMTE - CHECK FOR REMOTE MODE ENABLED *;*****************************************CKRMTE EQU $  LDA CMFLGS ;GET COMMON FLAGS  ANI REMSET ;MASK FOR REMOTE FLAG  RET ;RET (NZ => YES; Z => NO)  ;*********************************************; CLBLXF - CLEAR BLOCK TRANSFER PENDING FLAG *;*********************************************; ; ENTRY: B = 377B-(FLAG TO CLEAR FROM MFLGS); C = 377B-(FLAG TO CLEAR FROM MFLGS2) ;  ; EXIT : H = BASEH ; A,B,L DESTROYED ; ; CLEARS THE SPECIFIED TRANSFER PENDING FLAG ; FROM "MFLGS". IF NO OTHER TRANSFER IS PENDING,; THEN THE KEYBOARD IS UNLOCKED. OTHERWISE, ; THE NEXT TRANSFER PENDING IS SET UP. ; CLBLXF EQU $  LHLD MFLGS2 ;GET TRANSFER PENDING FLAGS  MOV A,B  ANA H ;CLEAR FLAG FROM "MFLGS" MOV H,A  MOV A,C  ANA L ;CLEAR FLAG FROM "MFLGS2"  MOV L,A  SHLD MFLGS2 ;STORE NEW FLAG VALUES ANI SBINRY+SDVREC  ORA H ;ANY MORE TRANSFER PENDING?  LXI B,0 ;(SET FOR NULL FLAGS SET)  JNZ SBLXF0 ;YES - SET UP NEXT BLOCK XFR CALL KBEN ;NO - RE-ENABLE KEYBOARD; ; CLRXON - CLEAR BLOCK TRANSFER TRIGGER; CLRXON EQU $  MVI A,CLRTRG ;CLEAR BLOCK TRANSFER TRIGGE CALL DCMCTL ;PERFORM DATACOM CONTROL STC ;SET C-FLAG TRUE AND RET ;RETURN  ;********************************************** ; CLEARS - CLEAR DISPLAY FROM CURSOR POSITION * ;********************************************** CLEARS EQU $ ;CLEAR UNPROTECTED FIELDS  MVI A,377Q-SDACOM ;ONLY BY CLEARING DATA  CALL CLRDFL ;COMM INPUT FLAG CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JNZ@@ CLS100 ;YES - CLEAR FIELDS ONLY CALL CLEARL ;CLEAR LINE FROM CURSOR  RM ;RETURN IF LINE NOT FOUND  LHLD LSTLIN ;GET CURRENT LINE ADDRESS  MOV A,M ;GET THE LSB VALUE ORA A ;NEXT LINE EXIST (LSB # 0)?  RZ ;NO - RETURN PUSH H ;YES - ADD SUCCEEDING LINES  MVI M,0 ;TO FREE BLOCKS LIST INX H ;SET NEXT LINE POINTER TO  MOV D,M ;INDICATE NO NEXT LINE MVI M,EOP  MOV E,A ;SET D,E TO TOP NEXT LINE  LHLD FRBLKS ;GET CURRENT FREE BLOCKS HEA XCHG ;SET PREVIOUS LINE POINTER INX H ;IN FIRST SUCCEEDING LINE  INX H ;TO CURRENT FREE BLOCKS  INX H ;HEAD  MOV M,E  INX H  MOV M,D  LHLD LLINE ;SET FREE BLOCKS HEAD TO SHLD FRBLKS ;CURRENT LAST LINE POP H ;SET LAST LINE ADDRESS TO  SHLD LLINE ;CURRENT LINE  ;******************* ; MEMORY RELEASED * ; CLEAR LOCK FLAGS * ;******************* MLKOF EQU $ LDA MDFLG1  ANI MEMLOK ;MEMORY LOCK ENABLED?  RZ ;NO - RETURN JMP MLO010 ;YES - SET LED ON WO/BLINKIN ;***************************************; FORMAT MODE CLEAR SCREEN FROM CURSOR *;***************************************CLS100 EQU $  CP RCADR4 ;LOCATE CHAR IF FORMAT MODE  RM ;RETURN IF NOT FOUND OR IN; SOFT KEY DEFINE MODE JNZ CLS110 ;PAST EOL - START AT NEXT FL INR B ;CURSOR IN UNPROTECTED FIELD JNZ CLS130 ;YES - CLEAR REST OF FIELD;******************************** ; CURSOR IN PROTECTED FIELD * ; TAB TO NEXT UNPROTECTED FIELD * ;******************************** CLS110 EQU $ CALL FLDSR ;SEARCH TO NEXT FIELD  RZ ;NO MORE FIELDS - RETURN LDAX D ;GET END PROTECT CHARACTERCLS120 EQU $  STA LSTFMT ;SET LAST FORMAT CODE  DCX D ;SKIP OVER "ENDPR" CHAR ;************************** ; CLEAR UNPROTECTED FIELD * ;************************** CLS130 EQU $ CALL CLER01 ;CLEAR FIELD CPI EOP ;TERMINATION AT END OF PAGE? RZ ;YES - RETURN ;************************************ ; SEARCH FOR NEXT UNPROTECTED FIELD * ;************************************  DCX D ;ADJUST ADDRESS TO NEXT CHARCLS200 EQU $  INX D ;ADJUST ADDRESS TO PREV CHARCLS210 EQU $  CALL NXTCHR ;GET NEXT CHARACTER  JNZ CLS200 ;SKIP OVER EOL LINK  CPI ENDPR ;NEW FIELD?  JZ CLS120 ;YES - CLEAR IT  CPI EOP ;END OF DISPLAY? RZ ;YES - RETURN  CPI STPFLG ;NON-DISPLAYING TERMINATOR?  CZ CHRDL2 ;YES - DELETE IT JMP CLS210 ;CONTINUE SEARCH ;************************** ; CLRALL - CLEAR ALL TABS * ;************************** ;  ; ENTRY: H = BASEH ; CLRALL EQU $  MVI L,HTBTBL-BASE ;SET ADDRESS AND NUMBER MVI E,HTBLEN ;OF BYTES TO BE CLEARED ;***************************************; CLRAL1 - SET A REGION OF RAM TO ZERO *;***************************************; ; ENTRY: E = NUMBER OF BYTES IN REGION; H,L = LOW ADDRESS OF REGION;  ; EXIT : A,E = 0 ; H,L = H,L(ENTRY) + E ; CLRAL1 EQU $  XRA A ;SET A TO ZEROCLA010 EQU $  MOV M,A ;SET BYTE TO ZERO  INX H ;ADVANCE TO NEXT BYTE  DCR E ;ALL BYTES DONE? JNZ CLA010 ;NO - DO NEXT BYTE RET ;YES - RETURN  ;**************************************** ; CURPHD - HOME DOWN TO FIRST COLUMN OF * ; FIRST LINE BEYOND END OF MEMORY * ;**************************************** CURPHD EQU $  CALL CHKSFK ;DEFINE SOFT KEY MODE? RNZ ;YES - IGNORE HOME DOWN  CALL CURPRT ;NO - RETURN TO LEFT MARGIN ;************************** ; MOVE CURSOR TO NEXT ROW * ;************************** HDC100 EQU $  LDA LSTROW  CPI MAXROW ;IS LAST ROW DONE AT BOTTOM? CZ ROLLUP ;YES - ROLL UP THE DISPLAY LHLD LSTLIN ;GET CURRENT ROW ADDRESS MOV A,M ;GET LSB OF NEXT LINE POINTE ORA A ;IS THERE A NEXT ROW?  JZ HDC200 ;NO - TERMINATE HOME DOWN  MOV E,A ;YES - SET E TO NEXT LINE  INR E ;POINTER OF NEXT LINE  CALL ROLUP2 ;SET "LSTLIN" AND "CURADR" LXI H,LSTROW ;TO NEXT LINE  INR M ;INCREMENT LAST ROW DONE JMP HDC100 ;****************** ; LAST LINE FOUND * ; SET ROW  ;****************** HDC200 EQU $  CALL NXTCH0 ;GET 1ST CHAR OF LAST ROW  CPI EOL ;LAST ROW EMPTY? LDA LSTROW ;(GET LAST ROW POSITION) JZ HDC210 ;YES - SET CURRENT ROW = LAS INR A ;NO - SET TO NEXT ROW HDC210 EQU $  STA CURROW ;SET CURRENT ROW NUMBER  RET ;RETURN  ;*******************************; CURPOS - CURSOR POSITIONING *; INITIAL ENTRY POINT *;*******************************CURPOS EQU $ LDA CURCOL ;SET NEW COLUMN DEFAULT TO STA NEWCOL ;CURRENT COLUMN POSITION MVI A,377Q-NWRWST  CALL CLRMF2 ;CLEAR NEW ROW SET FLAG  MVI L,SCRNRW-BASE ;PRESET RELATIVE ROW  MVI M,-1 ;PARAMETER TO -1 LXI H,CRPTAB ;SET RANGE TABLE FOR CURSOR  JMP ESCAPA ;POSITIONING ;*********************************; NEW COLUMN POSITION IS DEFINED *;*********************************CURPO1 EQU $  MVI C,MAXCOL ;SET MAXIMUM VALUE AND LXI D,NEWCOL ;PARAMETER TO BE SET MVI L,CURCOL-BASE ;"CHKLIM" MOV B,M JMP CRP025 ;EVALUATE THE PARAMETER  ;*********************** ; SCREEN ROW SPECIFIED * ;*********************** CURPO2 EQU $  MVI C,MAXROW ;SET MAXIMUM VALUE AND LXI D,SCRNRW ;PARAMETER TO BE SET MVI L,CURROW-BASE ;"CHKLIM" MOV B,M JMP CRP025 ;EVALUATE THE PARAMETER ;****************************** ; NEW ROW POSITION IS DEFINED * ;****************************** CURPO3 EQU $  LDA MLKROW ;GET MEMORY LOCK ROW ORA A ;MEMORY LOCK ENABLED?  JNZ CRP050 ;YES - IGNORE PARAMETER  MVI A,NWRWST ;NO - SET NEW ROW SET  CALL SETMF2 ;FLAG  MVI C,255 ;SET MAXIMUM VALUE AND LXI D,NEWROW ;PARAMETER TO BE SET LDA CURROW ;COMPUTE CURRENT ABSOLUTE  MVI L,TLINO ;ROW ADDRESS ADD M  MOV B,A ;PUT IT INTO B-REGISTER CRP025 EQU $  CALL CHKLI0 ;EVALUATE INPUT PARAMETER CRP050 EQU $  LDA CHAR ;RECALL THE INPUT CHARACTER  ANI 40Q ;IS IT AN UPPER CASE CHAR? JNZ ESCAPB ;NO - CONTINUE ESC SEQUENCE ; YES - POSITION CURSOR  ;*****************************; EXECUTE COMPLETED SEQUENCE *;***************************** LDA SCRNRW ;GET SCREEN ROW PARAMETER  ORA A ;WAS SCREEN ROW ADDRESS SET? JM CRP200 ;NO - SET ABSOLUTE ROW ADDR  STA CURROW ;YES - SET NEW SCREEN ROW ;***************************; SET ABSOLUTE ROW ADDRESS *;***************************CRP200 EQU $  CM CRP500 ;FIND LOCATION OF NEW ROW ;  ; SET COLUMN ADDRESS ;  LDA NEWCOL ;GET NEW COLUMN ADDRESS ;****************************** ; LOCATE ADDRESS OF CHARACTER * ;****************************** CURPO4 EQU $  STA CURCOL ;STORE NEW COLUMN ADDRESS  CALL RCADDR ;FIND CHARACTER  RZ ;CHARACTER FOUND - RETURN ;********************************** ; CHARACTER NOT CURRENTLY STORED * ; BUILD LINE OVER TO NEW POSITION * ;**********************************  MVI L,DCHAR ;SET UP BLANK FOR NEW POS. MVI M,ABLNK  JMP DISPL0 ;BUILD BLOCKS  ;***********************************; LOCATE NEW ABSOLUTE ROW LOCATION *;***********************************CRP500 EQU $  LDA MFLGS2 ;GET TERMINAL MODE FLAGS ANI NWRWST ;NEW ABSOLUTE ROW SET? RZ ;NO - RETURN LDA NEWROW ;GET NEW ROW VALUE MVI L,TLINO ;SUBTRACT ROW CORRESP. SUB M ;TO TOP OF PAGE  MVI L,CURROW  JC PRVPG1 ;LOCATE PREVIOUS ROW PAGE  CPI MAXROW+1  MOV M,A ;SET NEW ROW RC ;RETURN IF SAME PAGE;****************************** ; ROW IS AFTER BOTTOM OF PAGE * ; ROLL DISPLAY UP * ;******************************  MVI M,MAXROW ;SET ROW SUI MAXROW ;SET ROLL COUNT STR010 EQU $  CALL NXTPG1 ;ROLL DISPLAY UP MOV A,M ;GET NUMBER OF ROWS TO ROLL  SUB C ;SUBTRACT ROWS ROLLED  RZ ;RETURN IF ROLL COMPLETE MOV M,A ;SAVE NUMBER OF ROW TO ROLL  XRA A ;(SET TO FIND COLUMN 0)  CALL RCADR0 ;BUILD NEW ROWS  RNZ ;RETURN IF OUT OF MEMORY LDA NMROLL ;GET # OF ROWS TO ROLL JMP STR010 ;ROLL AGAIN ;*********************************; CURSEN - CURSOR POSITION SENSE *;*********************************; ; RLCRSN - SCREEN RELATIVE CURSOR SENSE; RLCRSN EQU $ MVI A,RELSNS ;SET RELATIVE SENSE FLAG CALL SETMF2  JMP CUR100 ;GO SET CURSOR SENSE FLAG ; ; CURSEN - ABSOLUTE CURSOR SENSE ; CURSEN EQU $  MVI A,377Q-RELSNS  CALL CLRMF2 ;CLEAR RELATIVE SENSE FLAGCUR100 EQU $  LXI B,SCRSEN ;SET UP BLOCK TRANSFER JMP SBLXF0 ;FOR CURSOR SENSE PENDING  CRSNGO EQU $  LXI B,-1-SCRSEN ;CLEAR CURSOR SENSE CALL CLBLXF ;PENDING FLAG  MVI B,AMPSND ;SEND -<&>  CALL ESCOUT  MVI A,SMALLA ;TRANSMIT LOWER CASE A CALL XPUTDC ;*********************** ; OUTPUT CURSOR COLUMN * ;***********************  LXI H,XPUTDC ;SEND NUMBER TO DATA COMM  LDA CURCOL ;GET CURRENT CURSOR COLUMN CALL BN2DE1 ;CONVERT AND TRANSMIT VALUE  MVI A,ALCC ;TRANSMIT LOWER CASE C CALL XPUTDC ;******************** ; OUTPUT CURSOR ROW * ;********************  LDA MFLGS2 ;GET TERMINAL MODE FLAGS ANI RELSNS ;SCREEN RELATIVE SENSING?  LDA CURROW ;(GET CURSOR ROW NUMBER) MVI B,Y ;(SET DEFAULT PARAMETER) JNZ CRS100 ;YES - OUTPUT SCREEN ADDRESS LXI H,TLINO ;NO - COMPUTE ABSOLUTE ADD M ;ROW NUMBER  MVI B,R ;SET ABSOLUTE PARAMETER CHAR ;************************* ; TRANSMIT ROW PARAMETER * ;************************* ; ; A = ROW VALUE; B = ROW PARAMETER LETTER ; CRS100 EQU $  PUSH B ;SAVE ROW PARAMETER LETTER CALL BN2DE2 ;CONVERT AND TRANSMIT VALUE  POP PSW ;RECALL ROW PARAMETER LETTER CALL XPUTDC ;TRANSMIT ROW PARAMETER CHAR; FALL INTO "SDTERM";************************************ ; SDTERM - SEND BLOCK TERMINATOR *; RS IF PAGE MODE, OTHERWISE CR(LF) * ;************************************ SDTERM EQU $  CALL SDTRM1 ;SEND TERMINATORSDTER1 EQU $  CALL CLRXON ;CLEAR BLOCK TERMINATOR  MVI A,ENDBLK ;TELL DATA COMM THAT LAST  JMP DCMCTL ;CHARACTER IN BLOCK IS OUT ;  ; DC2GO - OUTPUT DC2 ; DC2GO EQU $ LXI H,MFLGS  MOV A,M ;CLEAR DC2 PENDING FLAG  ANI (-1-SDC2)/256  MOV M,A  MVI A,PROMPT ;TELL DATA COMM ROUTINE TO JMP DCMCTL ;SEND PROMPT CODE ;***************************************; DCMINT - DATA COMM INTERRUPT ROUTINE *;***************************************;  ; ENTRY: PSW "PUSHED" ; A = INTERRUPT CODE ; DCMINT EQU $  CALL INTVEC ;CHECK ALTERNATE INTERRUPT POP PSW ;RESTORE PSW AND A-REGISTER  JMP ZDCINT ;EXECUTE NORMAL DATA COMM ; INTERRUPT ROUTINE  ;********************************** ; BRKDC - EXECUTE DATA COMM BREAK * ;********************************** BRKDC EQU $  MVI A,PUTBRK ;EXECUTE DATACOM BREAK JMP DCMCTL ;CONTROL; ; DISMDM - DISCONNECT MODEM; DISMDM EQU $  MVI A,DISCNT ;EXECUTE MODEM DISCONNECT ;********************************************** ; DCMCTL - PERFORM DATA COMM CONTROL FUNCTION * ;********************************************** ; ; ENTRY: A = FUNCTION TYPE NUMBER ; ; EXIT : Z - FUNCTION PERFORMED ; NZ - FUNCTION NOT PERFORMED; DCMCTL EQU $  PUSH PSW ;SAVE A-REGISTER CALL CKRMTE ;REMOTE MODE ENABLED?  JNZ DCC010 ;YES - PERFORM FUNCTION  POP PSW ;NO - RESTORE A-REGISTER INR A ;FORCE NZ  RET ;RETURN ; DCC010 EQU $  POP PSW ;RESTORE A-REGISTER DCMCT1 EQU $ ;ENTRY TO FORCE DATA COMM CT CALL ZDCCTL ;EXECUTE FUNCTION  RNC ;SUCCESSFUL - RETURNDCERR EQU $ ;PROCESS DATA COMM ERROR JZ ZBELL ;NOT FATAL - SOUND BELL ;*****************************; DISPLAY TEST FAIL MESSAGES *;*****************************HANGU0 EQU $  CALL DSPMS0 ;DISPLAY THE ERROR MESSAGE MVI A,FRCRST ;SET TO FORCE FULL RESET CALL STCMFL ;IF RESET KEY HIT ; HNG010 EQU $  CALL DISLN4 ;RE-ENABLE RESET ONLY  JMP HNG010 ;HANG TERMINAL; ************************* ; * RESET KEY MUST BE HIT * ; * TO RESTORE TERMINAL * ; * OPERATION * ; *************************  ;*******************************************; DCNUM - ACCUMULATE PARAMETER FOR ESC SEQ *;*******************************************;  ; EXIT : Z TRUE ; DCNUM EQU $  LXI H,IOCSGN ;GET THE CURRENT SIGN  MOV A,M ;VALUE ORA A ;HAS ANY SIGN BEEN SET?  JNZ DCN005 ;YES - DON'T CHANGE IT MVI M,NOSIGN ;NO - SET NO SIGN FLAGDCN005 EQU $  LDA CHAR ;GET INPUT CHARACTER SUI ZERO ;EXTRACT BINARY VALUE  MOV E,A ;PUT VALUE IN E-REGISTER MVI D,0 ;SET MSB TO ZERO LDA RADIX ;GET RADIX OF NUMBER LHLD IODATA ;GET ACCUMULATOR XCHG ;PUT ACCUMULATOR IN D,E ; DCN010 EQU $  DAD D ;ACCUMULATE NEW VALUE  DCR A ;RADIX ADJUSTMENT COMPLETED? JNZ DCN010 ;NO - CONTINUE ADDING  SHLD IODATA ;YES - STORE NEW VALUE JMP ESCAP1 ;CONTINUE ESCAPE SEQUENCE ;******************************************** ; DCPLUS - PLUS SIGN RECEIVED FOR PARAMETER * ;******************************************** DCPLUS EQU $  MVI B,1 ;SET B-REG TO SIGN VALUE JMP DCM010 ;SET SIGN FLAG;*************@@********************************; DCMNUS - MINUS SIGN RECEIVED FOR PARAMETER *;*********************************************DCMNUS EQU $  MVI B,-1DCM010 EQU $  LXI H,IOCSGN ;GET CURRENT SIGN VALUE  MOV A,M  ORA A ;SIGN SET ALREADY? JNZ ESCEND ;YES - ABORT ESCAPE SEQUENCE MOV M,B ;NO - SET SIGN VALUE JMP ESCAP1 ;CONTINUE ESCAPE SEQUENCE  ;***************************************; DCTEST - EXECUTE DATA COMM SELF-TEST *;***************************************DCTEST EQU $  CALL CKRMTE ;REMOTE MODE ENABLED?  RZ ;NO - DON'T DO SELF-TEST CALL ZDCTST ;CALL DATA COMM SELF-TEST  JC HANGU0 ;HANG TERMINAL IF FATAL ERRO JMP DSPMS1 ;DISPLAY MESSAGE AND EXIT ; IF SELF-TEST SUCCESSFUL ;*****************************************; DCXB2D - SEE IF SOURCE OF CHARACTER IS *; DATA COMM OR I/O BUFFER *;*****************************************; ; EXIT : Z - INPUT IS NOT FROM DATA COMM OR I/O ; NZ - INPUT IS FROM DATA COMM OR I/O ; A DESTROYED ; DCXB2D EQU $  LDA DFLGS ;GET DATA TRANSFER FLAGS ANI SDACOM+XBF2DS ;SET Z-FLAG RET ;RETURN  ;****************************** ; DELAY0 - PAUSE FOR 1 SECOND * ;****************************** DELAY0 EQU $  MVI A,MAXROW+1 ;REMOVE CURSOR AND CALL DISLN2 ;RE-ENABLE RESET KEY MVI L,100 ;DELAY FOR 1 SECOND ;******************************** ; DELAY - DELAY 10 MILLISECONDS * ; TIMES COUNT IN L * ;******************************** DELAY EQU $  MVI A,SETROM  OUT PROCSR ;RESET THE TIMER LDA PRCCTL ;RESTORE PROCESSOR STATE OUT PROCSR ; DLY010 EQU $  XRA A ;CLEAR THE INTERRUPT FLAG  STA INTFLG DLY020 EQU $  HLT ;SLEEP UNTIL INTERRUPTED LDA INTFLG ;GET INTERRUPT FLAG  CPI TMRINT ;TIMER INTERRUPT?  JNZ DLY020 ;NO - CONTINUE WAITING DCR L ;ENOUGH TIMER INTERRUPTS?  JNZ DLY010 ;NO - CONTINUE TIMING  RET ;YES - RETURN  ;***************************; - SEND FUNCTION DATA *;***************************SNDCD2 EQU $  LDA IODATA ;GET ACCUMULATED VALUE MOV B,A ;PUT CODE INTO B-REGISTER  MVI A,SNDFCT ;SET DATA COMM CONTROL CODE  CALL DCMCTL ;PERFORM FUNCTION  RNZ ;EXIT IF FUNCTION NOT DONE; OTHERWISE, SEND SCREEN DATA ;***************; DISPLAY SEND *;***************DPSEND EQU $  MVI A,CKIOKY  CALL ZKBCTL ;I/O CONTROL KEY DOWN ALSO?  JNZ DCTEST ;YES - DO DATA COMM SELF-TES LDA CMFLGS ;GET COMMON FLAGS  ANI REMSET ;REMOTE ENABLED? LXI D,(RCKYCD-ENTRCD)*2;(SET KEY INDEX)  JZ IOKEYS ;NO - PERFORM RECORD COMMAND LXI B,SENTER ;YES - SET XFR PENDING FLAG  LDA MDFLG2 ;NO - GET TERMINAL MODE FLAG ANI BLKMDE ;BLOCK MODE ENABLED? JZ DPS200 ;NO - DO CHARACTER MODE STAR CALL CHKSFK ;SOFT KEY MODE?  JNZ DPS220 ;YES - DON'T SET TERMINATOR  LDA KBJMP2 ;YES - GET KEYBOARD JUMPERS  ANI AUTTRM ;AUTO TERMINATE ENABLED? JZ DPS220 ;NO - DO DON'T MOVE CURSOR CALL STTERM ;YES - SET NON-DISPLAYING ; TERMINATOR RZ ;EXIT IF NOT SUCCESSFUL ;*****************************************; FIRST TRANSMIT CHARACTER LOCATED - SET *; TRANSFER PENDING FLAG *;*****************************************DPS100 EQU $  LXI B,SENTER ;SET B,C XFR PENDING FLAG  JMP SBLXF1 ;FOR BLOCK MODE TRANSFER ;****************************************** ; AUTO TERMINATOR JUMPER NOT REMOVED - DO * ; NORMAL DATA ENTRY FROM DISPLAY * ;****************************************** DPS200 EQU $  LDA KBJMPR ;GET KEYBOARD JUMPERS 1  ANI HNDSHK+DC2SND  XRI HNDSHK ;HANDSHAKE ENABLED?  CNZ CHKCT1 ;NO - SET BLOCK TRIGGER DPS210 EQU $  CALL SBLXFA ;SET TRANSFER PENDING FLAGDPS215 EQU $  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RNZ ;YES - DON'T MOVE CURSOR JMP CRRET1 ;NO - PUT CURSOR AT BEGINNIN; OF LINE (A = 0) ; ; SET KEYBOARD BLOCK TRANSFER; DPS220 EQU $  CALL SBLXF1 ;SET BLOCK MODE XFR PENDING  LDA MFLGS ;GET TRANSFER PENDING FLAGS  ANI SDC2/256 ;DC2 TO BE SENT? RNZ ;YES - DON'T MOVE CURSOR CALL CKLNMD ;LINE MODE?  JZ DPS215 ;YES - SET CURSOR IN LINE ;**************************************** ; DPSEN1 - HOME CURSOR FOR TRANSMISSION * ;**************************************** DPSEN1 EQU $  CALL XMOHME ;HOME CURSOR CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RNZ ;YES - RETURN  JMP CRRET1 ;NO - SET CURSOR TO COLUMN 0 ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; DPSGO - SEND DISPLAY TO DATACOM; ; ENTRY: CURCOL,CURROW SET TO STARTING ; LOCATION ; ; EXIT : ALL REGISTERS DESTROYED; DPSGO EQU $  CALL INITDG ;INIT DISPLAY GET ROUTINE  JNZ DSG200 ;TERMINATE IF NO CHARACTERS  MVI A,STPXFR ;SET TERMINATOR FUNCTION TO  STA TRMFCT ;TERMINATE TRANSFER DSG010 EQU $  MVI A,STCHST ;SET CHARACTER SET FOR CALL ZKBCTL ;FOREIGN TERMINALS?  CC XPUTDC ;YES - OUTPUT SI/SO ; ; OUTPUT CHARACTERS FROM DISPLAY ; DSG020 EQU $  CALL GETDSP ;ANY CHARACTER?  JC DSG100 ;NO - CHECK TERMINATION  CALL XPUTDC ;YES - TRANSMIT THE CHARACTE JNC DSG020 ;CONTINUE IF NO DATA COMM ER JMP DSG230 ;ELSE, TERMINATE OUTPUT ; ; NON-CHARACTER FOUND - CHECK TERMINATION; DSG100 EQU $  JM DSG200 ;END OF DISPLAY - TERMINATE  MOV B,A ;SAVE EXIT STATUS  CALL GTMODE ;PAGE MODE ENABLED?  JZ DSG210 ;NO - END WITH CR(LF)  CALL CHKFMT ;FORMAT MODE?  JZ DSG110 ;NO - SEND CR AND LF LDA RECSEP ;YES - END WITH RECORD CALL XPUTDC ;SEPARATOR JMP DSG010 ;CONTINUE THRU DISPLAY ; ; EOL FOR NON-FORMAT PAGE MODE - SEND CR AND LF; DSG110 EQU $  MVI A,CR ;SEND RETURN CALL XPUTDC ;AND CALL SDTRM3 ;LINE FEED CALL CHKSFK ;SOFT KEY DEFINE MODE? CZ LNFEED ;NO - DO LINE FEED CALL DISLN1 ;SET DISPLAY CURSOR ROW  JMP DSG010 ;CONTINUE THRU DISPLAY; ; END OF DISPLAY - SEND TERMINATOR ; DSG200 EQU $  LDA BLKTRM ;SEND BLOCK TERMINATOR CALL XPUTDC ;CHARACTER CALL GTMODE ;PAGE MODE?  JZ DSG220 ;NO - SEND CR(LF)  JMP DSG225 ;YES - CLEAR XFR PENDING FLA;****************************************** ; NON-PAGE MODE TERMINATION - SEND CR(LF) * ;****************************************** DSG210 EQU $  CALL CHKFMS ;FORMAT/SOFT KEY MODE? JNZ DSG220 ;YES - DON'T DO LINE FEED  LDA MDFLG2 ;NO - GET SOFT MODE FLAGS  ANI AUTOLF ;AUTO LINE FEED ENABLED? CNZ LNFEED ;YES - DO LINE FEED  ;************************* ; SEND CR(LF) TERMINATOR * ;************************* DSG220 EQU $  CALL SDTRM1 ;SEND CR(LF)DSG225 EQU $  CALL SDTER1 ;MARK END OF OUTPUT BLOCK  XRA A ;RESET TERMINATOR FUNCTION STA TRMFCT ;TO DELETE TERMINATOR DSG230 EQU $  LXI B,-1-SENTER  CALL CLBLXF ;CLEAR ENTER PENDING FLAG  JMP CRADV1 ;CLEAR CURSOR ADVANCE FLAG; AND EXIT ;***************************************; A2OUTB - PUT BYTE INTO OUTPUT BUFFER *;***************************************; ENTRY: A = BYTE TO BE OUTPUT;  ; EXIT : H = BASEH ; B2DEND = B2DEND + 1 ; D,E,L DESTROYED ;  ; ECOUTB - OUTPUT ; ; ENTRY: B = SECOND CHARACTER IN ESCAPE SEQ ; ECOUTB EQU $  MVI A,ESC ;SET A TO ESC  CALL A2OUTB ;PUT ESC INTO OUTPUT BUFFER B2OUTB EQU $  MOV A,B ;PUT SECOND CHAR INTO A-REG ; FALL INTO OUTPUT ROUTINE; A2OUTB EQU $  LXI H,B2DEND  INR M ;INCREMENT TO NEXT POSITION  MOV L,M ;GET NEW ADDRESS MOV M,A ;STORE THE BYTE  RET ;RETURN  ;**************************** ; ENTLCL - ENTER LOCAL MODE * ;**************************** ENTLCL EQU $  CALL CKEDIT ;EDIT MODE ENABLED?  JZ ENL100 ;NO - GO INTO LOCAL MODE MVI A,REMOTE ;YES - INHIBIT TRANSITION TO LXI H,MDFLG2 ;LOCAL MODE  ORA M ;FORCE REMOTE FLAG ON  MOV M,A  RET ;RETURN ; ENL100 EQU $  MVI A,SETLCL ;SET DATACOM FOR LOCAL CALL DCMCTL ;OPERATION MVI A,377Q-REMSET ;CLEAR REMOTE MODE FLAG;****************************** ; CLCMFL - CLEAR COMMON FLAGS * ;****************************** ; ; ENTRY: A = 377B-FLAG BIT TO BE CLEARED;  ; EXIT : A,H,L DESTROYED ; CLCMFL EQU $  LXI H,CMFLGS  ANA M ;CLEAR THE FLAG BIT  MOV M,A ;STORE THE NEW SETTINGS  RET ;RETURN  ; ; ENTREM - ENTER REMOTE MODE ; ENTREM EQU $  CALL CKEDIT ;EDIT MODE ENABLED?  JZ ENR100 ;NO - GO INTO REMOTE MODE  MVI A,377Q-REMOTE ;YES - INHIBIT  LXI H,MDFLG2 ;TRANSITION TO REMOTE MODE ANA M ;FORCE REMOTE FLAG OFF MOV M,A  RET ;RETURN ; ENR100 EQU $  SUB A ;CLEAR THE DATA PENDING  STA MFLGS ;FLAGS MVI A,377Q-SBINRY-SDVREC CALL CLRMF2 ;CLEAR BINARY RECORD PENDING MVI A,SETREM ;SET DATACOM FOR REMOTE  CALL DCMCT1 ;OPERATION MVI A,REMSET ;SET REMOTE MODE FLAG ;**************************** ; STCMFL - SET COMMON FLAGS * ;**************************** ; ; ENTRY: A = FLAG BIT TO BE SET ;  ; EXIT : A,H,L DESTROYED ; STCMFL EQU $  LXI H,CMFLGS  ORA M ;ADD BIT TO "CMFLGS" MOV M,A ;STORE NEW SETTINGS  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FCTKEY - FUNCTION KEY PRESSED (F1-F8); ; ENTRY: C = FUNCTION KEY CODE (360-367B) ; ; EXIT : DFLGS(FCTK2D) = 1, FUNCTION KEY; DATA TO BE USED AS NORMAL; KEYBOARD CHARACTERS; DFLGS(FCTK2D) = 0; MFLGS(SFCTKY) = 0, KEY WAS ; INTERPRETED LOCALLY ONLY ; MFLGS(SFCTKY) = 1, DATA WAITING; FOR BLOCK TRANSFER TRIGGER TO; SEND TO CPU; ALL REGISTERS DESTROYED; FCTKEY EQU $  MOV A,C ;COMPUTE NUMBER OF LINES TO  ADD A ;SEARCH: SUI FCTADJ ;2*(FUNCTION NUMBER) - 1 LXI H,SFTKYS  CALL MLKSC1 ;LOCATE THE ATTRIBUTE LINE; ; DEFINITION FOUND - PERFORM FUNCTION;  MOV A,L ;COMPUTE LOCATION OF SUI ATBLOC ;ATTRIBUTE CODE  MOV E,A  MOV D,H  CALL CHAIN ;GET ADDRESS OF DATA LINE  SHLD CURFKY ;SAVE FIRST CHARACTER ADDRES; TO FORCE SKIP OVER "ENDPR" LDAX D ;GET ATTRIBUTE CODE  CPI N ;NORMAL MODE?  JC FCT200 ;< - DO LOCAL ONLY MVI A,FCTK2D ;(SET DATA XFR FLAG) JZ SETDFL ;YES - SET NORMAL KEY XFR  CALL GTMODE ;> - SET BLOCK TRANSFER  LXI B,SFCTKY ;FOR FUNCTION KEY  JZ SBLXFA ;SET FLAG FOR NOT PAGE MODE  JMP SBLXF1 ;ELSE SET FOR PAGE XFR ;********************************** ; PERFORM LOCAL ONLY KEY FUNCTION * ;********************************** FCT200 EQU $  CALL GTFCTK ;GET FUNCTION KEY DATA RZ ;NONE LEFT - RETURN FCT210 EQU $  STA CHARIN ;SAVE FUNCTION KEY CHARACTER CALL CHINT ;PROCESS DATA LOCALLY  LDA CHARIN ;RECALL FUNCTION CHARACTER CPI CR ;IS IT A RETURN? JNZ FCT200 ;NO - DO THE NEXT BYTE LDA MDFLG2 ;YES - GET HARD MODE FLAGS ANI AUTOLF ;AUTO LINE FEED ENABLED? JZ FCT200 ;NO - DO NEXT FUNCTION BYTE  MVI C,LF ;YES - PERFORM LINE FEED JMP FCT210 ;FUNCTION  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FKEYGO - TRANSMIT FUNCTION KEY ;  ; ENTRY: DON'T CARE ; ; EXIT : MFLGS1(SFCTKY) = 0 ; ALL REGISTERS DESTROYED; FKEYGO EQU $  LXI B,-1-SFCTKY ;CLEAR FUNCTION KEY CALL CLBLXF ;PENDING FLAG  LDA DFLGS ;GET DATA TRANSFER FLAGS ANI FCTK2D ;OPERATE AS NORMAL KEY?  RNZ ;YES - RETURN TO WAIT LOOP; ; TRANSMIT FUNCTION KEY DATA ; FKG010 EQU $  CALL GTFCTK ;GET NEXT FUNCTION KEY CHAR  JZ SDTERM ;SEND TERMINATOR IF NO MORE ; DATA LXI H,BLKTRM  CMP M ;BLOCK TERMINATOR CHARACTER? JZ SDTERM ;YES - OUTPUT TERMINATOR CALL XPUTDC ;NORMAL DATA - TRANSMIT IT JMP FKG010 ;DO NEXT CHARACTER ; ; MNMDON - MONITOR MODE ON ; MNMDON EQU $  MVI A,SETMON ;SET DATACOM MONITOR CALL DCMCTL ;MODE  RNZ ;DON'T MONITOR IF NOT SET  MVI B,377Q ;SET TO BLINK LED  JMP FDO100 ;SET FUNCTION TABLE ;*****************************************; FDISON - TURN ON FUNCTION DISABLE MODE *;*****************************************FDISON EQU $ MVI B,0 ;SET FOR NO BLINK FDO100 EQU $  MVI A,DSPFNC ;TURN ON DISPLAY FUNCTIONS CALL ZSTMD1 ;FLAG  LXI H,FDISTB ;SET H,L TO NEW RANGE TABLE  JMP ESCEN1 ;SET RANGE TABLE AND EXIT ;*************************************; FDISOF - TURN OFF FUNCTION DISABLE *;*************************************FDISOF EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? JZ FOF010 ;NO - DO NORMAL PROCESSING CALL DCXB2D ;INPUT FROM KEYBOARD?  CNZ SFKYOF ;NO - RESTORE NORMAL DISPLAYFOF010 EQU $  CALL FDESC1 ;DISPLAY INPUT CHARACTER LDA LCHAR  CPI ESC ;WAS THE LAST CHAR ?  RNZ ;NO - RETURN; YES - TURN OFF DISPLAY FCTS DFCTOF EQU $  MVI A,SETNRM ;RESTORE DATACOM TO  CALL ZDCCTL ;NORMAL MODE CALL ESCEND ;YES - TURN OFF DISABLE MODE MVI A,DSPFNC ;TURN OFF DISPLAY FUNCTIONS  JMP ZCLMD1 ;FLAG ;************************** ; FUNCTION DISABLE ESCAPE * ;************************** FDESC EQU $  CALL CHKSFK ;SOFT KEY DEFINE M@@ODE? JZ FDESC1 ;NO - DO NORMAL PROCESSING CALL DCXB2D ;INPUT FROM KEYBOARD?  CNZ SFKYOF ;NO - RESTORE NORMAL DISPLAYFDESC1 EQU $  CALL DSPCHR ;DISPLAY THE ESCAPE CODE JMP CRADV1 ;RESET CURSOR ADVANCE FLAG T; FORCE ANALYSIS OF NEXT; INPUT CHARACTER FOR Z  ;******************************************** ; FUNCTION TABLE FOR TERMINAL FUNCTION KEYS * ;******************************************** FNCTAB EQU $  DW DPSEND ;230 - ENTER KEY DW BRKDC ;231 - BREAK KEY DW DFCTOF ;232 - DISPLAY FUNCTIONS OFF DW IOKEYS ;233 - I/O CONTROL KEY DW IOKEYS ;234 - READ KEY  DW IOKEYS ;235 - RECORD KEY  DW IOKEYS ;236 - SELECT KEY  DW IOKEYS ;237 - CONDITION TAPES DW IOKEYS ;240 - (CONTROL) READ KEY ; ENTRCD EQU 230Q ;ENTER KEY CODE RCKYCD EQU 235Q ;RECORD KEY CODESLKYCD EQU 236Q ;SELECT KEY CODECTRDKY EQU 240Q ;CONTROL READ KEY CODEFNCLWR EQU 230Q ;FUNCTION CODE LOWER LIMITFNCLIM EQU 241Q ;FUNCTION CODE UPPER LIMIT; ESCSO EQU 216Q ;- CODEESCLWD EQU 344Q ;- CODEF1CODE EQU 360Q ;F1 CODEF8CODE EQU 367Q ;F8 CODEFCTAD1 EQU F1CODE*2 ;FUNCTION CODE ADJUSTMENT FCTADJ EQU -FCTAD1/256*256+FCTAD1-1 ;FACTOR STFOR2 EQU 375Q ;SET FOREIGN MODE STEP 2STFOR1 EQU 376Q ;SET FOREIGN MODE STEP 1ENHNCF EQU 377Q ;ENHANCE DISPLAY FUNCTION ;********************************** ; FUNCTION ADDRESSES FOR I/O KEYS * ;********************************** IOKYTB EQU $  DW IOCKEY ;I/O CONTROL KEY DW REDKEY ;READ KEY  DW RECKEY ;RECORD KEY  DW SELKEY ;SELECT KEY  DW CONDTN ;CONDITION TAPES DW CTLRED ;(CONTROL) READ KEY  ; ; DISPLAY STRINGS FOR SOFT KEY DISPLAY ; ATBLIN EQU $  DB EOL,ABLNK,ESC,ENDPR ;  DB EOL,STPR ATB010 EQU $  DB 'T',SFKYAT,ENDPR,' ' DB NORMAL,'0',146Q,INVRS,0 ATBLOC EQU $-ATB010-1 ;ATTRIBUTE LOCATION IN BLKATBLEN EQU $-ATBLIN-1 ;ATTRIBUTE LINE LENGTHCHRLOC EQU 2 ;CHARACTER LOCATION IN STRIN ;********************************************** ; FNDTAB - FIND TAB MASK * ; EXIT: L,H = ADDR OF BYTE CONTAINING TAB BIT * ; A = MASK FOR TAB BIT * ;********************************************** FNDTAB EQU $ LDA CURCOL ;GET CURSOR COLUMN MOV B,A ;SAVE IN BFNDTB1 EQU $ ANI 370Q ;MASK OFF 3 LSB'S  RRC ;RIGHT-ADJUST MSB'S  RRC RRC ADI HTBTBL ;ADD BASE OF TAB TABLE MOV L,A ;SAVE IN L MOV A,B ;GET CURSOR COLUMN ANI 7 ;GET 3 LSB'S MOV B,A ;SAVE IN B INR B ;ADJUST BIT NUMBER ;********************* ; FNDTB2 - SET BIT N * ;********************* ; ; ENTRY: B = BIT NUMBER TO BE SET ; ; EXIT : A = BYTE WITH BIT N SET; B = 0; FNDTB2 EQU $  MVI A,200Q ;SET BIT 7 OF A FTB100 EQU $ RLC ;SHIFT LEFT 1 POSITION DCR B ;DECREMENT BIT COUNT JNZ FTB100 ;CONTINUE IF NOT DONE  RET ;RETURN   ;******************* ; EXIT FORMAT MODE * ;******************* FORMOF EQU $ MVI A,FORMAT ;SET BIT TO BE CLEARED STA PROFLD ;SET PROTECT FLAG FOR UNPROT JMP ZCLMD1 ;CLEAR FORMAT MODE FLAG  ;*********************************************; FRECNT - CHECK THE NUMBER OF FREE BLOCKS *; *; EXIT: Z=F, NOT ENOUGH FREE BLOCKS *; Z=T, ENOUGH FREE BLOCKS *;*********************************************FRECNT EQU $ MVI B,25 ;SET DESIRED NUMBER OF BLOCK LXI D,FRBLKS-2 ;SET TO FREE LIST HEADFRC010 EQU $  XCHG ;SET H,L TO ADDRESS OF LSB INX H ;PART OF PREVIOUS LINE INX H ;POINTER MOV A,M ;GET LSB OF NEXT LINE LINK ORA A ;ANY MORE FREE BLOCKS? JZ FRC100 ;NO - TRY TO GET MORE  DCR B ;ENOUGH FREE BLOCKS? RZ ;YES - RETURN SUCCESSFUL CALL CHAIN ;NO - GET NEXT LINE ADDRESS  MOV D,H ;SAVE NEXT LINE ADDRESS IN MOV E,L ;D,EFRC050 EQU $  ANI 360Q ;COMPUTE ADDRESS OF NEXT MOV L,A ;BLOCK LINK  MOV A,M ;GET THE LSB OF THE LINK CMA ;A IS IT AN EOL LINK (LOWER  ANI BLKSM ;FOUR BITS NOT ALL ONES)?  JNZ FRC010 ;NO - GO TO THE NEXT LINE  DCR B ;ENOUGH FREE BLOCKS FOUND? RZ ;YES - RETURN SUCCESSFUL CALL CHAIN ;NO - GO TO THE NEXT BLOCK JMP FRC050 ;CHECK FOR END OF LINE;*******************************************; NOT ENOUGH FREE BLOCKS - TRY TO GET MORE *;*******************************************FRC100 EQU $  CALL PTBLK ;REMOVE A LINE FROM DISPLAY  JNZ FRECNT ;RECOUNT IF LINE FREED INR A ;(FORCE NZ)  RET ;RETURN FAIL OTHERWISE ;********************************************** ; FRNCT1 - FOREIGN MODE CONTROL 1 (-"<") * ;********************************************** FRNCT1 EQU $  MVI A,FRNMD1 ;SET KEYBOARD FOREIGN MODE 1 JMP ZKBCTL ;********************************************** ; FRNCT2 - FOREIGN MODE CONTROL 2 (-">") * ;********************************************** FRNCT2 EQU $  MVI A,FRNMD2 ;SET KEYBOARD FOREIGN MODE 2 JMP ZKBCTL  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; GTFCTK - GET FUNCTION KEY;  ; ENTRY: DON'T CARE ; ; EXIT : NZ - FUNCTION KEY CHAR AVAILABLE ; A = C = FUNCTION KEY CHARACTER ; Z - NO FUNCTION KEY CHAR AVAILABLE ; DFLGS(FCTK2D) = 0; A DESTROYED; D-L DESTROYED; GTFCTK EQU $  LHLD CURFKY ;GET LAST FUNCTION KEY; CHARACTER ADDRESS  CALL NXTCH0 ;GET THE NEXT CHARACTER  JNZ GTF010 ;EOL LINK - DO EOL EXIT  XCHG  SHLD CURFKY ;STORE NEW ADDRESS CPI ADEL+1 ;IS CHARACTER ASCII? MOV C,A ;(PUT DATA IN C-REGISTER)  RM ;YES - RETURN ; ; EOL FOUND - CLEAR FCTK2D FLAG; GTF010 EQU $  MVI A,377Q-FCTK2D  CALL CLRDFL ;CLEAR FLAG FROM FLAG WORD CMP A ;SET Z TRUE  RET ;RETURN  ;***************************; HTBSET - TAB SET ROUTINE *;***************************HTBSET EQU $ CALL FNDTAB ;GET TABLE ENTRY FOR COLUMN  ORA M ;SET TAB MOV M,A RET ;RETURN ;*****************************; HTBCLR - TAB CLEAR ROUTINE *;*****************************HTBCLR EQU $ CALL FNDTAB ;GET TABLE ENTRY FOR COLUMN  XRI 377Q ;COMPLEMENT MASK ANA M ;CLEAR TAB MOV M,A RET ;RETURN  ;******************************************** ; IOBNGO - FAST BINARY READ ESCAPE SEQUENCE * ;******************************************** IOBNGO EQU $  LXI H,CTDCDP ;EXECUTE FAST BINARY READ  JMP IORMGO ;IF I/O ROM PRESENT ;*****************************; IOBSYC - WAIT FOR CTU IDLE *;*****************************IOBSYC EQU $  LXI H,BSYCHK ;GO TO CTU BUSY CHECK  CALL IORMGO ;ROUTINE LDA CMND ;GET CURRENT CTU COMMAND ANI RUN ;TAPE STILL RUNNING? RZ ;NO - RETURN STA IOCERR ;YES - CLEAR "IOCERR"  JMP IOBSYC ;CONTINUE WAITING ;***************************************; IOCTGO - I/O CONTROL ESCAPE SEQUENCE *;***************************************IOCTGO EQU $  LXI H,IOCNTL ;EXECUTE I/O CONTROL ESCAPE  JMP IORMGO ;SEQ IF I/O ROM PRESENT ;***********************************; IOCTMN - MONITOR CARTRIDGE TAPES *;***********************************IOCTMN EQU $  LXI H,CTMON ;GET MONITOR ADDRESS JMP IORMGO ;EXECUTE IF CODE PRESENT ;*********************** ; IOKEYS - I/O KEY HIT * ;*********************** ;  ; ENTRY: D,E = KEY INDEX ; IOKEYS EQU $  LXI H,IOKYTB-6  DAD D ;COMPUTE KEY FUNCTION ADDRES CALL CHAIN ;EXECUTE KEY FUNCTION IF I/O; ROM PRESENT  ;*******************************************; IORMGO - PERFORM FUNCTION IF OPTION ROMS *; ARE PRESENT *;*******************************************; ; ENTRY: H,L = VECTOR TO BE ENTERED ; ; EXIT : NC - FUNCTION EXECUTED ; REGISTERS SET ACCORDING TO FUNCTION; C - FUNCTION NOT EXECUTED ; A DESTROYED ; IORMGO EQU $  PUSH H ;PUT FUNCTION ADDR ON STACK  MVI L,0 ;CHECK ROM START LOCATION  CALL IORMG1 ;DOES ROM EXIST? RZ ;YES - EXECUTE FUNCTION  LXI H,NODRVR ;NO - SET ERROR MESSAGE TO SHLD MSGPT1 ;"NO DEVICE DRIVER"  POP H ;RESTORE STACK STC ;RETURN FUNCTION NOT RET ;EXECUTED (C-TRUE);******************************************** ; IORMG1 - CHECK FOR PRESENCE OF OPTION ROM * ;******************************************** ; ; ENTRY: H,L = ROM STARTING ADDRESS ;  ; EXIT : Z => ROM EXIST ; H,L = H,L(ENTRY)+1 ; NZ => ROM ABSENT  ; A DESTROYED ; H,L = H,L(ENTRY) => ROM ABSENT ; H,L = H,L(ENTRY)+1 => WRONG ROM; IORMG1 EQU $  MOV A,M ;GET FIRST ROM BYTE  ANI 360Q ;CHECK UPPER 4 BITS ONLY CPI P ;IS IT AN UPPER CASE P?  RNZ ;NO - RETURN ROM ABSENT  INX H ;YES - CHECK SECOND BYTE MOV A,M ;SECOND BYTE OF ROM SHOULD CMP H ;EQUAL HIGH ORDER EIGHT  RET ;BITS IN ITS PROPER ADDRES; RANGE  ;************************************ ; IOINTR - I/O INTERRUPT PROCESSING * ;************************************ ; ; ENTRY: "PSW" AND H,L PUSHED ; A = INTERRUPT CODE ; IOINTR EQU $  CALL INTVEC ;CHECK ALTERNATE INTERRUPT LDA PRCCTL ;GET CURRENT PROCESSOR STATE ORI POLL ;POLL THE I/O BOARDS TO FIND OUT PROCSR ;OUT WHO INTERRUPTED LXI H,IOCRCL ;DO DUMMY I/O READ TO GET  MOV L,M ;POLL RESPONSE ANI 377Q-POLL  OUT PROCSR ;RESTORE PROCESSOR STATE LDA DEVFLG ;GET POLL DEVICE FLAG  ANA L ;DEVICE DRIVER PRESENT?  JM CTINTR ;CTU - DO CTU ROUTINE  ADD A ;ALTERNATE I/O INTERRUPT?  JM ZINTAL ;YES - GO CHECK INTERRUPT ;****************************************** ; INVALID DEVICE INTERRUPT - REPORT ERROR * ;******************************************  MOV A,L ;RECALL POLL RESPONSE  MVI B,ATSIGN ;COMPUTE ERROR CODE  ORA A ;ANY DEVICE INTERRUPTED? JZ IOI020 ;NO - DON'T LOOK FOR BIT; YES - DETERMINE DEVICEIOI010 EQU $  INR B ;INCREMENT ERROR CODE  RLC ;DEVICE TYPE FOUND?  JNC IOI010 ;NO - CONTINUE LOOKINGIOI020 EQU $ ;YES - SET ERROR CODE  MOV A,B ; FALL INTO ERROR REPORTER ;*********************************************; INTERR - REPORT INVALID INTERRUPT OCCURRED *;*********************************************; ; ENTRY: A = ERROR CODE (ASCII CHARACTER) ; INTERR EQU $  LXI H,IODATA ;SET ERROR CODE FOR ERROR  SHLD MSGPT2 ;MESSAGE MOV M,A  INX H  MVI M,EOP  LXI H,INERMS ;REPORT INTERRUPT ERROR  XRA A ;STOP ANY CTU MOTION STA IOCTCO  JMP HANGU0 ;AND HANG TERMINAL;*****************************************; INTRPT - PROCESS UNEXPECTED INTERRUPTS *;*****************************************;  ; ENTRY: "PSW" PUSHED ; A = INTERRUPT CODE  ; C-FLAG CLEARED ; INTRPT EQU $  CALL INTVEC ;ANY INTERRUPT HANDLER?  JNC INTERR ;NO - REPORT ERROR POP PSW ;YES - RESTORE PSW EI ;RE-ENABLE INTERRUPTS  RET ;RETURN TO INTERRUPTED CODE  ;************************************ ; IOINTR - I/O INTERRUPT PROCESSING * ;************************************  ;****************** ; KEYBOARD ENABLE * ;****************** KBEN EQU $ LDA DFLGS  ANI KBDLOK ;KEYBOARD LOCKED BY ESC SEQ? RNZ ;YES - DO NOT UNLOCK KEYBOARD ; KBEN1 EQU $ MVI A,UNLKKB ;UNLOCK THE KEYBOARD CALL ZKBCTL  MVI A,377Q-KBDLOK ;CLEAR LOCKED FLAG ; ; CLRDFL - CLEAR DATA TRANSFER FLAGS ; ; ENTRY: A = FLAGS TO BE CLEARED; CLRDFL EQU $  LXI H,DFLGS  ANA M ;MASK OUT FLAGS ; ; STOREA - STORE VALUE N A-REG AND RETURN; ; ENTRY: A = VALUE TO BE STORED ; H,L = LOCATION TO BE STORED IN ; STOREA EQU $ MOV M,A ;STORE UPDATED VALUE RET ;RETURN  ;**************** ; KEYBOARD LOCK * ;**************** KBLOK0 EQU $ MVI A,KBDLOK ;SET ESCAPE SEQUENCE LOCK  CALL SETDFL ;FLAG ; KBLOK EQU $ MVI A,LOCKKB ;LOCK THE KEYBOARD JMP ZKBCTL  ;*****************************; ESC & LOWER CASE B *; BINARY LOADER *; A SET ADDRESS = DIGITS *; C COMPARE CHECKSUM *; D STORE BYTE *; INCREMENT ADDRESS *; E CALL ADDRESS *; DIGITS 1,2,3,4, OR 5 *;*****************************LOADR EQU $ ;INITIAL ENTRY MVI A,MAXROW+1  STA CURROW ;SET CURSOR OFF THE SCREEN LXI H,LDRMSG  CALL DSPMS0 ;DISPLAY THE LOADER MESSAGE LOADR1 EQU $ ;ENTRY TO NOT DISPLAY MESSAG LXI H,0 ;CLEAR CHECKSUM ACCUMULATOR  SHLD LCHKSM  MVI A,FRCRST ;SET FORCE RESET FLAG  CALL STCMFL LDR0 EQU $ LDA CHAR ;RECALL INPUT CHARACTER  ANI 40Q ;IS IT UPPER CASE? MVI A,377Q-FRCRST  JZ CLCMFL ;YES - CLEAR FORCE RESET AND; EXIT ESCAPE SEQUENCE LXI H,LDRTAB ;NO - SET LOADER FUNCTION  MVI A,OCTRDX ;SET FOR OCTAL RADIX JMP ESCAP0 ; ; - ADDRESS PARAMETER - SET ADDRESS; LDR3 EQU $ LHLD LDATA ;GET ACCUMULATED DATA SHLD LADDR ;SET AS LOAD ADDRESS  XCHG ;PUT VALUE INTO D,E LDR035 EQU $ LHLD LCHKSM ;ACCUMULATE CHECKSUM DAD D  SHLD LCHKSM  JMP LDR0 ;RETURN TO SYSTEM  ; ; - DATA BYTE PARAMETER - STORE DATA BYTE; LDR4 EQU $ MVI L,LDATA-BASE  MOV E,M @@ ;GET ACCUMULATED DATA  LHLD LADDR ;GET LOAD ADDRESS  MOV M,E ;STORE THE BYTE  MVI D,0 ;ZERO MSB FOR CHECKSUM INX H ;INCREMENT AND STORE NEW SHLD LADDR ;LOAD ADDRESS  JMP LDR035 ;ACCUMULATE CHECKSUM;***********************************************; - EXECUTE ENTERED CODE, WAIT UNTIL CTU'S *; STOPPED BEFORE EXECUTING CODE *;***********************************************LDR060 EQU $  CALL DISLN4 ;RE-ENABLE RESET KEY CALL ZGETDC ;PURGE DATA COMM INPUT CC DCERR ;PROCESS ERROR IF ANY  LDA CMND ;GET CTU COMMAND ANI RUN ;CTU'S RUNNING?  JNZ LDR060 ;YES - CONTINUE WAITING  MVI A,CRTOFF ;NO - TURN OFF THE DISPLAY STA IOCRRW  DI ;DISABLE INTERRUPTS  LHLD LADDR ;GET LOAD ADDRESS  PCHL ;START EXECUTION THERE;  ; - CHECKSUM ENTRY ; LDR10 EQU $ ;CHECKSUM ENTRY  LXI H,ERRFLG ;DEFAULT TO GOOD CHECKSUM  MOV A,M  ORI LDRCHK  MOV M,A ;SET ERROR FLAGS LHLD LDATA ;GET USER SPECIFIED CHECKSUM XCHG  LXI H,LCHKSM  MOV A,E ;COMPARE TO CALCULATED XRA M ;CHECKSUM  MOV C,A  INX H  MOV A,D  XRA M  ORA C ;DO CHECKSUMS MATCH? JZ LDR0 ;YES - RETURN NORMAL RST RESET ;NO - RESET TERMINAL ;****************************************** ; PARAMETERIZED SEQUENCES INITIAL CONTROL * ;****************************************** PRMSEQ EQU $  LXI H,PRMTAB ;SET RANGE TABLE FOR JMP ESCAPA ;PARAMETERIZED ESC SEQUENC  ;**************** ; START PROTECT * ;**************** PRSTRT EQU $ MVI B,STPR ;STORE START PROTECT CONTROL JMP PRO100 ;FLAG  ;**************** ; TRANSMIT-ONLY * ;**************** STRXMO EQU $  MVI A,XMONLY ;STORE TRANSMIT-ONLY CONTROL JMP PRO010 ;FLAG ;************** ; END PROTECT * ;************** PREND EQU $ MVI A,ENDPR ;STORE END PROTECT CONTROL; ; MAKE SURE PREVIOUS CHAR IS DEFINED PROTECTED ; PRO010 EQU $  STA PARM1 ;SAVE CONTROL FLAG LDA CURCOL ;GET THE CURRENT COLUMN  DCR A ;SET TO FIND PREVIOUS COLUMN CALL RCADR0 ;PREVIOUS COLUMN PRESENT?  JM ZBELL ;NO - SOUND BELL AND RETURN  LDA LSTFMT ;YES - RECALL LAST FORMAT CT CPI STPR ;WAS IT A START PROTECT? CNZ PRSTRT ;NO - ENTER STPR LDA PARM1 ;RECALL FORMAT CONTROL FLAG  MOV B,A ;TO BE STORED ; ; ENTER THE FORMAT CONTROL FLAG; PRO100 EQU $ CALL CHKFMS ;FORMAT MODE?  RNZ ;YES - TERMINATE MOV A,B ;NO - ADD CHAR TO DISPLAY  PUSH PSW ;SAVE THE CONTROL CODE CALL DISPC1 ;(DISPC1 DESTROYS "LSTFMT" POP PSW ;RECALL CONTROL CODE STA LSTFMT ;NEW ENTRY RET ; ; ENTREN - ENABLE ENTER VIA ESCAPE SEQUENCE; ENTREN EQU $  LXI B,SENTER ;SET DISPLAY SEND PENDING ; FALL INTO "SBLXF0";********************************************** ; SBLXF0 - SET BLOCK TRANSFER FLAG FOR ESCAPE * ; SEQUENCE INITIATED BLOCK TRANSFERS * ;********************************************** ; ; ENTRY: B = FLAG TO BE SET IN "MFLGS"; C = FLAG TO BE SET IN "MFLGS2" ; ; EXIT : ALL REGISTERS DESTROYED; X-ON AND DC2 PENDING FLAGS ARE SET ; ACCORDING TO THE SETTINGS OF G AND H ; SBLXF0 EQU $  CALL CLRXON ;CLEAR BLOCK TRANSFER TRIGGE; ; SBLXFA - DETERMINE DC2 HANDSHAKE MODE FOR; NON-BLOCK MODE KEYBOARD INITIATED BLOCK; TRANSFERS; SBLXFA EQU $ LDA KBJMPR ;GET THE STRAP SETTINGS  ANI HNDSHK ;DC2 ON ALL BLOCK TRANSFERS? JZ SBL010 ;NO - DO NOT SET DC2 FLAG ; YES - FALL INTO "SBLXF1" ;************************************************ ; SBLXF1 - SET BLOCK TRANSFER FLAG FOR KEYBOARD * ; INITIATED BLOCK TRANSFERS * ;************************************************ ; ; ENTRY: B = FLAG TO BE SET IN "MFLGS"; C = FLAG TO BE SET IN "MFLGS2" ; SBLXF1 EQU $  LDA KBJMPR ;GET THE STRAP SETTINGS  ANI DC2SND ;INHIBIT DC2 HANDSHAKE?  MVI A,SDC2/256 ;(SET DC2 PENDING FLAG)  JZ SBL020 ;NO - SET DC2 PENDING FLAG CALL CHKCT1 ;YES - SET BLOCK TRANSFER ; TRIGGER TO CAUSE IMMEDIATE; TRANSMISSION OF DATASBL010 EQU $ MOV A,B ;PUT FLAG INTO A-REGISTER SBL020 EQU $  ORA B ;ADD IN OPTIONAL DC2 FLAG  MOV B,A ;SAVE FLAGS IN B-REGISTER  CALL CKRMTE ;REMOTE MODE ENABLED?  RZ ;NO - DON'T SET BLOCK XFR  LXI H,MFLGS ;YES - SET DATA PENDING  MOV A,B ;FLAGS ORA M  MOV M,A  DCX H  MOV A,C  ORA M ;SET FLAG IN "MFLGS2"  MOV M,A  JMP KBLOK ;DISABLE THE KEYBOARD  ;*************************************; SDTRM1 - SEND TERMINATOR CHARACTER *;*************************************;  ; EXIT : A DESTROYED ; SDTRM1 EQU $  CALL GTMODE ;PAGE MODE?  LDA BLKTRM ;(GET BLOCK TERMINATOR)  JNZ XPUTDC ;YES - SEND BLOCK TERM ONLY SDTRM2 EQU $ ;NO - SEND CR(LF)  MVI A,CR CALL XPUTDC ;TRANSMIT RETURN LDA MDFLG2  ANI AUTOLF ;AUTO LINE FEED ENABLED? RZ ;NO - RETURNSDTRM3 EQU $  MVI A,LF ;YES - TRANSMIT LINE FEED  JMP XPUTDC  ;********************************** ; SETDFL - SET DATA TRANSFER FLAG * ;********************************** ; ; ENTRY: A = FLAG BIT TO BE SET ;  ; EXIT : H = BASEH ; A,L DESTROYED ; SETDF0 EQU $ ;SET DATA COMM INPUT FLAG  MVI A,SDACOM ;SET FLAG BIT TO BE SET SETDFL EQU $  LXI H,DFLGS  ORA M ;MERGE FLAG BIT TO EXISTING  MOV M,A ;FLAGS RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; SETLFT,SETRHT - SET LEFT AND RIGHT MARGINS ;  ; ENTRY: H = BASEH ; CURCOL = CURSOR COLUMN POSITION; ; EXIT : LFTMGN,RHTMGN SET APPROPRIATELY; SETLFT EQU $  CALL CHKFMT ;FORMAT MODE?  RNZ ;YES - DON'T SET MARGIN  LDA RHTMGN ;NO - GET THE RIGHT MARGIN MVI L,CURCOL-BASE  CMP M ;CURSOR AFTER RIGHT MARGIN?  JM DSPCH1 ;YES - DON'T SET MARGIN  MOV A,M ;NO - SET NEW LEFT MARGIN  STA LFTMGN  RET ;RETURN ; SETRHT EQU $  CALL CHKFMT ;FORMAT MODE?  RNZ ;YES - DON' SET MARGIN LDA CURCOL ;GET CURRENT CURSOR COLUMN MVI L,LFTMGN-BASE  CMP M ;BEFORE LEFT MARGIN? JM DSPCH1 ;YES - DON'T SET MARGIN  DCX H ;NO - SET NEW RIGHT MARGIN MOV M,A  RET ;RETURN  ;********************************** ; SETMF2 - SET FLAG BIT IN MFLGS2 * ;********************************** ; ; ENTRY: A = FLAG BIT TO BE SET ; ; EXIT : A = UPDATED MFLGS2 VALUE  ; H,L = MFLGS2 ; SETMF2 EQU $  LXI H,MFLGS2  ORA M ;ADD BIT TO MFLGS2 MOV M,A ;STORE NEW SETTINGS  RET ;RETURN  ;*****************************************; SETTRM - SET NON-DISPLAYING TERMINATOR *;*****************************************SETTRM EQU $  MVI A,IGNTRM ;SET TO IGNORE NON-DISPLAYIN STA TRMFCT ;TERMINATORS MVI A,STPFLG ;ADD NON-DISPLAYING  CALL DISPC2 ;TERMINATOR TO DISPLAY JMP FLDSRX ;SET "LSTCOL" TO MAXCOL+1 ; TO FORCE LINE RE-SCAN TO; INHIBIT DELETION OF NEW ; NON-DISPLAYING TERMINATOR  ;**************************************** ; SNDCDE - SEND ATTENTION/FUNCTION CODE * ;**************************************** SNDCDE EQU $  LDA DFLGS ;GET DATA TRANSFER FLAGS ANI SDACOM ;COMMAND FROM DATA COMM? RNZ ;YES - IGNORE IT LXI H,SNDCTB ;SET TO ACCUMULATE OCTAL MVI A,OCTRDX ;CODE CHARACTER  JMP ESCAP0 ;**************************** ; - SEND ATTENTION CODE * ;**************************** SNDCD1 EQU $  LDA IODATA ;GET ACCUMULATED VALUE MOV B,A ;PUT CODE INTO B-REGISTER  MVI A,SNDATN ;SET DATA COMM CONTROL CODE  JMP DCMCTL ;PERFORM FUNCTION  ;***********************************************; STRTBL - SET FIRST DISPLAY OUT CHARACTER FOR *; BLOCK STORE *;***********************************************;  ; ENTRY: DON'T CARE ; ; EXIT : CURCOL,CURROW = STARTING POSITION; ; IF THE AUTO TERMINATOR STRAP (J) IS OUT, A ; TERMINATOR IS PLACED AHEAD OF THE CURRENT; CURSOR POSITION AND A REVERSE SCAN IS MADE ; FOR THE FIRST TERMINATOR BEFORE THE CURRENT; CURSOR POSITION. OTHERWISE, THE CURSOR IS ; PLACED AT THE HOME POSITION; STRTBL EQU $  CALL STRTB1 ;SET CURSOR START POSITION JMP INITDG ;SET UP DISPLAY GET ROUTINE ; STRTB1 EQU $  LDA KBJMP2 ;GET KEYBOARD JUMPERS 2  ANI AUTTRM ;AUTO TERMINATOR ENABLED?  JZ XMOHME ;NO - HOME THE CURSOR ;*******************************; STTERM - SET AUTO TERMINATOR *;*******************************; ; EXIT : Z => AUTO TERMINATOR NOT SET ; NZ => AUTO TERMINATOR SET; STTERM EQU $  CALL CHKMLK ;MEMORY LOCK ENABLED?  JZ STB010 ;YES - CHECK FOR FREE BLOCKS CALL CHKFMT ;FORMAT MODE ENABLED?  JZ STB050 ;NO - ADD TERMINATORSTB010 EQU $ ;YES - CHECK FOR FREE BLOCKS LDA FRBLKS ;GET LSB OF FREE BLOCKS PTR  ORA A ;ANY FREE BLOCKS?  JZ MLOCK ;NO - FORCE MEMORY LOCK ON ;****************************************** ; SPACE AVAILABLE - STORE NON-DISPLAYING * ; TERMINATOR AT CURRENT CURSOR POSITION * ;****************************************** STB050 EQU $  CALL SETTRM ;STORE TERMINATOR  LDA BLKTRM ;GET BLOCK TERMINATOR CHAR MOV L,A ;SET PARAMETERS FOR REVERSE  MVI H,STPFLG ;SEARCH FOR PREV TERMINATO CALL BACKT1 ;IS THER A PREV TERMINATOR?  JNZ STB080 ;NO - HOME THE CURSOR  CALL RCADRA ;DOES THE CHARACTER EXIST? CNZ CRLF ;NO - START AT NEXT LINESTB060 EQU $  MVI A,377Q-NOSEND  CALL CLRDFL ;CLEAR NO DATA FLAG  ORI SKPTRM ;SET TO SKIP INITIAL BLOCK MOV M,A ;TERMINATOR CHARACTER  RET ;RETURN NZ ;*******************************************; NO PREVIOUS TERMINATOR - HOME THE CURSOR *;*******************************************STB080 EQU $  LHLD CURROW ;SAVE THE CURRENT ROW AND  PUSH H ;COLUMN VALUES CALL DPSEN1 ;HOME CURSOR FOR TRANSMISSIO LHLD CURROW ;GET NEW ROW AND COLUMN  POP B ;RECALL OLD ROW AND COLUMN MOV A,H ;COMPARE TO HOME ROW AND SUB B ;COLUMN  MOV B,A  MOV A,L  SUB C  ORA B ;DID CURSOR MOVE?  JNZ STB060 ;YES - SET FOR DATA PRESENT  MVI A,NOSEND ;NO - SET FOR NO DATA  JMP SETDFL ;RETURN  ;****************************** ; XPUTDC - TRANSMIT CHARACTER * ;****************************** ; ; ENTRY: A = CHARACTER TO BE TRANSMITTED; ; EXIT : NC - TRANSMIT SUCCESSFUL ; C - TRANSMIT FAILED ; A DESTROYED ; ESCOUT EQU $ ;OUTPUT AN ESCAPE CODE MVI A,ESC CALL XPUTDC  MOV A,B ;FOLLOWED BY CHAR IN B-REG; XPUTDC EQU $  ORA A ;SET C-FLAG FALSE  PUSH PSW ;SAVE THE FLAGS AND A-REG  CALL CKRMTE ;REMOTE MODE ENABLED?  JZ XPD005 ;NO - EXITXPD001 EQU $  POP PSW ;YES - RECALL THE CHARACTER  PUSH PSW ;SAVE CONTENTS OF A AND FLAG CALL ZPUTDC ;TRANSMIT THE CHAR IN A-REG  JC XPD050 ;ERROR - REPORT IT JNZ XPD010 ;WAIT - TRY AGAIN XPD005 EQU $  POP PSW ;DONE - RECALL FLAGS AND CHA RET ;RETURN ; TRANSFER TRIGGER (SETS; FLAG TRUE);*************************************; WAIT FOR DATACOM - RETRY OPERATION *;*************************************XPD010 EQU $  PUSH H ;SAVE THE REGISTERS  PUSH D  PUSH B  CALL IOCTMN ;MONITOR CARTRIDGE TAPES MVI A,CKBRKY ;LOOK FOR A BREAK KEY HIT  CALL ZKBCTL ;BREAK KEY HIT?  POP B ;(RESTORE REGISTERS) POP D  POP H  JZ XPD001 ;NO - TRY TO OUTPUT AGAIN  CALL BRKDC ;YES - BREAK DATA COMM; FALL INTO ERROR EXIT ROUTINE ;****************************************** ; DATA COMM ERROR DETECTED - REPORT ERROR * ;****************************************** XPD050 EQU $  INX SP ;RESTORE STACK LEVEL WITHOUT INX SP ;AFFECTING THE FLAGS JNZ HANGU0 ;FATAL - HANG THE TERMINAL CALL ZBELL ;NON-FATAL - SOUND BELL  STC ;RETURN FAIL (C-FLAG = TRUE) RET ;****************************************** ; XMOHME - HOME CURSOR INCLUDING TRANSMIT * ; ONLY FIELDS * ;****************************************** XMOHME EQU $  CALL SETDF0 ;SET DATA COMM INPUT FLAG ; TO ENABLE TRANSMIT ONLY ; FIELDS JMP CURPH1 ;HOME THE CURSOR ;************************** ; R O M B R E A K 3 * ;**************************  ORG ZBRK2+4000Q ZBRK3 EQU $  DB VERSN ;ROM PRESENT FLAGS DB ZBRK3/256  ;*************************************; BACKT1 - LOCATE PREVIOUS CHARACTER *;*************************************; ; ENTRY: IODATA = CHARS TO FIND (2 BYTES) ; CURCOL,CURROW = CURRENT CURSOR POSITION; ; EXIT : Z - CHARACTER FOUND; DISPLAY AND CURSOR SET TO CHARACTER; POSITION IN DISPLAY MEMORY - ALL ; DISPLAY PARAMETERS UPDATED ; NZ - CHARACTER NOT FOUND ; DISPLAY UNCHANGED; ALL REGISTERS DESTROYED; BACKT0 EQU $ ;LOOK FOR PREVIOUS FIELD LXI H,ENDPR*256+ENDPR BACKT1 EQU $  SHLD LCHKSM ;SAVE CHARACTERS TO BE FOUND XRA A ;CLEAR ROLL COUNT  STA ROLLCT  LHLD CURROW ;SAVE THE CURRENT STATE OF SHLD LDATA ;THE DISPLAY LHLD LSTLIN SHLD LADDR  MVI A,IGNTRM ;SET TO IGNORE NON-DIS@@PLAYIN STA TRMFCT ;TERMINATOR  CALL RCADR1 ;DOES THE CURRENT LINE EXITS LDA LDATA+1 ;(RECALL CURRENT COLUMN) JP BKT230 ;YES - SEARCH FOR PREV FIELD LDA CURROW ;NO - LOCATE LAST LINE LXI H,MLKROW ;CURRENT ROW LESS THAN CMP M ;MEMORY LOCK ROW?  JP BKT300 ;NO - LOOK FOR UNLOCKED LINEBKT210 EQU $ ;YES - START FROM LAST LINE  CALL CURPHD  LDA LSTROW ;FORCE TO LAST ALLOCATED STA CURROW ;ROW ;************************************ ; LOCATE THE LAST FIELD IN THE LINE * ;************************************ BKT220 EQU $  MVI A,MAXCOL ;SET SEARCH LIMIT BKT230 EQU $  STA TMPCOL ;SAVE THE SEARCH LIMIT LHLD LSTLIN ;GET SEARCH START ADDRESS  XCHG ;PUT ADDRESS IN D,E  LHLD LCHKSM ;RECALL CHARS TO BE FOUND  CALL FNDLST ;ANY FIELDS IN LINE? JP BKT400 ;YES - SET DISPLAY TO FIELD  LDA MLKROW ;NO - SEE IF TOP UNLOCKED  LXI H,CURROW ;LINE HAS BEEN REACHED CMP M ;REACHED MEMORY LOCK ROW?  JZ BKT310 ;YES - CONTINUE ABOVE DISPLA LDA ROLLCT  ORA M ;ROLL COUNT AND ROW = ZERO?  JZ BKT500 ;YES - NO PREVIOUS FIELD IN ; LOCKED AREA, RESTORE DISPL DCR M ;NO - MOVE TO PREVIOUS ROW MVI L,ROLLCT  MOV A,M ;GET ROLL COUNT  ORA A ;SEARCHING ABOVE DISPLAY?  JZ BKT240 ;NO - DON'T INCREMENT COUNT  INR M ;ROLL OVERFLOW?  JZ BKT500 ;YES - RESTORE DISPLAYBKT240 EQU $ ;NO - LOOK TO PREVIOUS LINE  LHLD LSTLIN ;RECALL CURRENT LINE ADDR BKT250 EQU $  INX H ;GET ADDRESS OF PREVIOUS INX H ;LINE  CALL CHAIN ;GET PREVIOUS LINE ADDRESS ORA A ;DOES PREVIOUS LINE EXIST? JZ BKT500 ;NO - RESTORE DISPLAY  SHLD LSTLIN ;YES - SAVE ADDRESS OF LINE  JMP BKT220 ;LOCATE LAST FIELD IN LINE ; ; ROW NOT FOUND AND CURSOR BELOW MEMORY LOCK ; LINE - LOCATE LAST LINE TO START ; BKT300 EQU $  SUB E ;(E = # OF ROWS TO LAST LN CMP M ;LAST ROW BELOW LOCKED AREA? JP BKT210 ;YES - START AT LAST LINE  MOV A,M ;NO - SEARCH ABOVE DISPLAY STA CURROW ;SET "CURROW" TO MEM LOCK RO LXI H,CURROW ;SET H,L -> "CURROW"; ; NO PREVIOUS FIELDS ON DISPLAY - LOOK ABOVE DISP; BKT310 EQU $  DCR M ;DECREMENT ROW NUMBER  MVI L,ROLLCT-BASE  INR M ;INCREMENT ROLL COUNT  LHLD TOPLIN ;GET TOP DISPLAY LINE ADDR JMP BKT250 ;LOOK FOR PREVIOUS ROW ; ; FIELD FOUND - SET DISPLAY; BKT400 EQU $  LHLD LADDR ;RESTORE VALUE OF LSTLIN XCHG ;AND SAVE ADDRESS OF LHLD LSTLIN ;LINE WHERE FIELD IS SHLD LADDR  XCHG  SHLD LSTLIN  LDA TMPCOL ;COMPUTE COLUMN LOCATION SUB B  STA CURCOL LDA ROLLCT  ORA A ;ROW ABOVE DISPLAY?  JZ BKT450 ;NO - EXIT; ; ROW ABOVE DISPLAY ROLL IT DOWN ; BKT410 EQU $  MVI A,-MAXROW-1 ;COMPUTE NUMBER OF LINES  LXI H,MLKROW ;TO ROLL FOR ONE PAGE  ADD M  STA ROLLCT ;SAVE ROLL COUNTBKT420 EQU $  CALL ROLLDN ;ROLL DOWN ONE LINE  JZ BKT430 ;ROLL FAIL - CHECK FOR FIELD LXI H,CURROW  INR M ;INCREMENT ROW NUMBER  MVI L,ROLLCT  INR M ;PAGE COMPLETED? JNZ BKT420 ;NO - CONTINUE ROLLING LDA CURROW MVI L,MLKROW  SUB M ;IS DESIRED ROW ON SCREEN? JM BKT410 ;NO - ROLL DOWN ANOTHER PAGE JMP BKT450 ;YES - EXIT ; ; ROLL FAILED - CHECK FOR FIELD ON SCREEN; BKT430 EQU $  LDA CURROW ;GET CURRENT ROW NUMBER  LXI H,MLKROW ;SUBTRACT MEMRY LOCK RWS SUB M ;IS FIELD ON SCREEN? JM BKT510 ;NO - RESTORE DISPLAY, ROLL ; DOWN FAILED BECAUSE OF NO ; MEMORY TO FILL TO MEMORY; LOCK LINE  ; ; FIELD ON SCREEN - SET SCREEN VALUES; BKT450 EQU $  LDA CURROW ;SET LAST ROW VALUE TO STA LSTROW ;ROW FOUND XRA A ;SET LAST COL DONE TO ZERO STA LSTCOL  LHLD LADDR ;SET ADDRESSES TO LOCATIONBACKT5 EQU $  SHLD LSTLIN ;OF FIELD  DCX H ;SET CURADR TO CORRESPOND  SHLD CURADR  RET ;RETURN ; ; FIELD NOT FOUND - RESTORE DISPLAY; BKT500 EQU $  LHLD LADDR ;RESTORE LAST LINE ADDRESS  SHLD LSTLIN BKT510 EQU $  LHLD LDATA ;RESTORE CURRENT ROW AND  SHLD CURROW ;COLUMN ORI 377Q ;SET Z FALSE RET ;RETURN NOT FOUND (NZ)  ;********************* ; BKTAB - BACK TAB * ;********************* BKTAB EQU $  CALL CHKFM0 ;FORMAT/SOFT KEY DEFINE MODE JNZ BACKT0 ;YES - LOCATE PREVIOUS FIELD LDA CURCOL ;NO - FIND PREVIOUS SET TAB  DCR A ;START AT PREVIOUS COLUMN  MVI L,LFTMGN-BASE  CMP M ;WHERE IS CURSOR?  JZ CURPO4 ;AT MARGIN - SET DISPLAY JP BKT100 ;AFTER MARGIN - FIND PREV TA; ; CURSOR AT BEGINNING OF LINE - LOCATE TAB IN ; PREVIOUS LINE ;  LDA MLKROW ;GET MEMORY LOCK ROW MVI L,CURROW  CMP M ;CURRENT ROW = LOCK ROW? JNZ BKT010 ;NO - MOVE CURSOR UP ONE ROW CALL ROLLDN ;YES - ROLL DOWN ONE LINE  RZ ;CAN'T ROLL DOWN - EXIT  JMP BKT050 ;GO LOCATE LAST TAB SET ; ; CURSOR NOT AT TOP OF FREE AREA - MOVE UP 1 LINE; BKT010 EQU $  MOV A,M ;GET CURRENT ROW NUMBER  ORA A ;ROW = 0 RZ ;YES - DON'T BACK TAB WHEN; CURSOR IS LOCATED IN ROW; ZERO AND DISPLAY LOCK ON DCR M ;NO - DECREMENT ROW NUMBER ; ; PREVIOUS ROW LOCATED - LOCATE LAST TAB SET ; BKT050 EQU $  LDA HTBTBL+9 ;GET LAST TAB ENTRY  ANI 200Q ;LAST TAB SET? MVI A,MAXCOL ;(SET FOR LAST COLUMN-1) JZ BKT060 ;NO - LOCATE LAST TAB  INR A ;YES - SET FOR LAST COLUMN # MOV C,A  MVI L,RHTMGN-BASE  CMP M ;RIGHT MARGIN = LAST COLUMN? JZ CURPO4 ;YES - SET CURSOR TO LAST COBKT060 EQU $ ;NO - SET TO MAXCOL-1 AND  DCR A ;LOCATE PREVIOUS TAB; ; LOCATE PREVIOUS TAB (A = CURRENT COLUMN - 1) ; BKT100 EQU $  INR A ;RESTORE CURRENT COLUMN  MOV B,A ;SAVE IT ORI 7Q ;SET TO COLUMN CORRESPOINDIN; TO LAST BIT OF TAB BYTE  MVI L,LFTMGN-BASE  SUB M ;COMPUTE NUMBER OF CHARS MOV C,A ;TO SEARCH MOV A,B ;RECALL CURRENT COLUMN CALL FNDTB1 ;GET BYTE MASK AND; CORRESPONDING TABLE BYTE DCR A ;SET FOR MASK TO MASK OFF  ANA M ;SUCCEEDING TABS; ; LOCATE PREVIOUS TAB SETTING; BKT110 EQU $  MVI B,8 ;INITIALIZE BIT COUNT BKT120 EQU $  RLC ;TAB SET?  JNC BKT150 ;NO - BACK UP ANOTHER COLUMN; ; TAB LOCATED - SET CURSOR (C = TAB COLUMN); BKT130 EQU $  MOV E,A ;SAVE A-REGISTER MOV A,C ;PUT COLUMN NUMBER IN A-REG  PUSH H ;SAVE H AND L  LHLD RHTMGN ;GET MARGIN SETTINGS ADD H ;COMPUTE TAB COLUMN LOCATION INR L ;IS TAB LOCATION BEYOND LEFT CMP L ;MARGIN? POP H ;(RESTORE H AND L) JM CURPO4 ;NO - LOCATE TAB AND RETURN  MOV A,E ;YES - RECALL A-REGISTER ;****************************** ; CONTINUE SCANNING BACKWARDS * ;****************************** BKT150 EQU $  DCR C ;COLUMN ZERO REACHED?  JZ BKT130 ;YES - SET CURSOR COLUMN DCR B ;BYTE DONE?  JNZ BKT120 ;NO - CONTINUE TO NEXT COLUM DCX H ;YES - GET NEXT BYTE MOV A,M  JMP BKT110 ;CHECK BYTE FOR TAB SET  ;*****************************************; CHAIN - SET H,L TO POINTER FROM MEMORY *;*****************************************; ; ENTRY: H,L = ADDRESS OF POINTER ; ; EXIT : A = LSB OF POINTER ; H,L = POINTER VALUE; CHAIN0 EQU $  XCHG ;PUT ADDRESS INTO H,L CHAIN1 EQU $  MOV A,L ;COMPUTE LOCATION OF NEXT  ANI 377Q-BLKSM ;BLOCK POINTER IN BLOCK  MOV L,A ;GET THE NEXT BLOCK ADDRESS CHAIN EQU $  MOV A,M ;GET LSB OF POINTER  INX H  MOV H,M ;PUT MSB INTO H-REGISTER MOV L,A ;PUT LSB INTO L-REGISTERNOFNCT EQU $ ;(NON-FUNCTION FOR ESC SEQ RET ;RETURN  ;*************************************************; CHKFMS - CHECK FORMAT AND SOFT KEY DEFINE MODE *;*************************************************;  ; ENTRY: DON'T CARE ; ; EXIT : Z - NEITHER MODE ENABLED  ; A = 0 ; NZ - MODE ENABLED; A = -1, SOFT KEY MODE ENABLED; A > 0, FORMAT MODE ONLY ENABLED ; CHKFM0 EQU $  MVI L,SPOWL ;TURN OF SPOW LATCH FIRST  MVI M,SPOWOF CHKFMS EQU $ LDA DSPTYP ;GET DISPLAY TYPE FLAG ORA A ;SOFT KEY DISPLAY ON?  RNZ ;YES - RETURN CHKFMT EQU $  LDA MDFLG1 ;NO - GET MODE FLAGS ANI FORMAT ;MASK FOR FORMAT FLAG AND  RET ;RETURN  ;*****************************************; CHKMLK - CHECK FOR MEMORY LOCK ENABLED *;*****************************************;  ; ENTRY: DON'T CARE ; ; EXIT : Z => MEMORY LOCK ENABLED ; NZ => MEMORY LOCK NOT ENABLED ; A,H,L DESTROYED ; CHKMLK EQU $  LDA MDFLG1 ;GET SOFT MODE FLAGS CMA ;MEMORY LOCK ENABLED FOR FUL ANI MEMLOK ;LOCKOUT IF MEMORY LOCK SE LXI H,MLKROW ;AND MEMORY LOCK ROW = 0 ORA M  RET ;RETURN ;***********************************; CHKSFK - CHECK FOR SOFT KEY MODE *;***********************************;  ; EXIT : Z - NORMAL MODE ; A = 0 ; NZ - SOFT KEY DEFINE MODE ; A DESTROYED ; CHKSFK EQU $  LDA DSPTYP ;GET DISPLAY TYPE FLAG ORA A ;SET Z FALSE IF SOFT KEY RET ;ON AND RETURN  ;************************ ; CD - CHARACTER DELETE * ;************************ DELWRP EQU $ ;DELETE WITH WRAP AROUND CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE MVI A,WRPDEL ;(PUT WRAP FLAG IN A-REG)  CZ SETMF2 ;NO - SET WRAP AROUND FLAG; CHRDEL EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? JZ CHD010 ;NO - DO DELETE  LDA CURROW ;YES - GET CURSOR ROW  RRC ;IN DATA LINE? RNC ;NO - RETURNCHD010 EQU $ ;YES - DO DELETE XRA A ;ZERO SAVE AREA  STA CHSAV  CALL CHD000 ;DELETE A CHARACTER  LDA CHSAV ;RECALL THE DELETED CHARACTE ORA A ;WAS IT A DISPLAY CONTROL? JM CHRDEL ;YES - CONTINUE DELETING;******************************************** ; ADJUST FOR CHARACTERS BEYOND RIGHT MARGIN * ;********************************************  LXI H,CURCOL LDA RHTMGN  CMP M ;CURSOR BEYOND RIGHT MARGIN? RC ;YES - DON'T CHECK WRAP  MOV B,M ;NO - SAVE CURRENT COLUMN  MOV M,A ;SET COLUMN TO RIGHT MARGIN  MOV D,A ;SAVE RIGHT MARGIN VALUE MVI L,MDFLG1-BASE  MOV C,M ;SAVE SOFT MODE FLAGS STATE  PUSH B ;AND CURRENT COLUMN  MOV A,C ;FORCE THE INSERT CHARACTER  ANI 377Q-INSCHR ;MODE OFF MOV M,A  ;*******************************************; DELETE PERFORMED - CHECK FOR WRAP AROUND *;******************************************* LXI H,MFLGS2 ;GET TERMINAL MODE FLAGS MOV A,M ;MASK OUT DELETE WRAP FLAG ANI 377Q-WRPDEL  CMP M ;DELETE WRAP AROUND ENABLED? JZ CHD050 ;NO - EXIT MOV M,A ;YES - UPDATE MODE FLAGS;******************************************** ; TRANSFER A CHRACTER UP FROM THE NEXT LINE * ;******************************************** CHD020 EQU $  MVI A,ABLNK ;PRESET DELETED CHARACTER  STA CHSAV ;TO A BLANK  LXI H,CURROW ;SET TO DELETE FIRST INR M ;CHARACTER AT LEFT MARGIN  INX H ;FROM NEXT ROW LDA LFTMGN  MOV M,A  CALL RCADR4 ;CHARACTER EXIST?  CZ CHRDL1 ;YES - DELETE IT LXI H,CURROW ;RESTORE ROW NUMBER AND SET  DCR M ;COLUMN TO RIGHT MARGIN  INX H  LDA RHTMGN  MOV M,A  LDA CHSAV ;GET THE DELETED CHARACTER CPI ABLNK ;BLANK CHARACTER DELETED?  JZ CHD050 ;YES - EXIT  MVI B,0 ;NO - SET TO FORCE ENHANCE CALL DISPC2 ;DISPLAY THE CHARACTER LDA CHSAV ;RECALL THE DELETED CHARACTE ORA A ;WAS IT ASCII? JM CHD020 ;NO - TRANSFER ANOTHER BYTE ;******************************************** ; EXIT - RESTORE CURSOR COLUMN AND "MDFLG1" * ;******************************************** CHD050 EQU $  POP B ;RECALL ORIGINAL VALUES  LXI H,CURCOL  MOV M,B ;RESTORE CURSOR COLUMN MVI L,MDFLG1-BASE  MOV M,C ;RESTORE "MDFLG1"  RET ;RETURN  CHD000 EQU $ CALL RCADR4 ;DOES CHARACTER EXIST? RNZ ;NO - RETURN CALL CHD500 ;SKIP OVER SINGLE DISPLAY ; ENHANCEMENT CODE CALL CHKFMT ;FORMAT MODE?  JZ CHD100 ;NO - DELETE THE CHARACTER INR B ;CURSOR IN PROTECTED FIELD?  RZ ;YES - RETURN ;******************************** ; CHRDL1 - DELETE ONE CHARACTER * ;******************************** ; ; ENTRY: C = CHARACTER COLUMN POSITION; D,E = ADDRESS OF CHAR TO BE DELETED; ; EXIT : ALL REGISTERS DESTROYED; CHSAV = CHARACTER DELETED (UNCHANGED ; IF A CHARACTER HAS NOT BEEN DELETED) ; CHRDL1 EQU $ CHD100 EQU $  LDAX D ;GET CHARACTER TO BE DELETED CPI EOL ;IS IT EOL?  RZ ;YES - RETURN  STA CHSAV ;SAVE THE DELETED CHARACTER  MOV H,D ;H,L = ADDR OF CHAR TO FILL  MOV L,E ;D,E = ADDR OF CHAR TO MOVE ;******************************************** ; MOVE CHARACTERS DOWN TO PREVIOUS POSITION * ;******************************************** CHD110 EQU $  CALL NXTCHR ;GET T@@HE NEXT CHARACTER  JNZ CHD210 ;EOL LINK - TERMINATE DELETE MOV B,A ;SAVE CHARACTER IN B-REGISTE CPI ENHLIM+1 ;ASCII OR ENHANCEMENT CODE?  JC CHD120 ;YES - SEE IF PAST MARGIN ;*********************************************; FORMAT CONTROL CODE FOUND - CHECK FUNCTION *;********************************************* CPI EOL ;END OF LINE?  JZ CHD250 ;YES - TERMINATE DELETE  CPI FILL ;END OF LINE FILL? JZ CHD200 ;YES - TERMINATE DELETE  CALL CHD400 ;FORMAT MODE & DELETE ASCII? JZ CHD120 ;NO - MOVE NEW CHARACTER MOV A,B ;YES - GET CHAR TO BE MOVED  CPI STPR ;IS IT START PROTECT?  JZ CLER02 ;YES - CLEAR REST OF FIELD; AND TERMINATE DELETE CPI ALPHA ;TYPE DEFINITION?  JP CHD110 ;YES - SKIP OVER CHARACTER ;***************************************; CHARACTER TO BE MOVED - CHECK MARGIN *;***************************************CHD120 EQU $  LDA RHTMGN  CMP C ;CHAR FROM BEYOND MARGIN?  JNZ CHD130 ;NO - CONTINUE DELETE  LDA CHSAV ;YES - GET DELETED CHARACTER ORA A ;IS IT ASCII?  MVI M,ABLNK ;(SET BLANK BY DEFAULT)  RP ;YES - TERMINATE DELETE ; NO - PUT CHAR INTO PREV CHAR;*************************************************; MOVE CHARACTER INTO PREVIOUS CHARACTER POSITON *;*************************************************CHD130 EQU $  MOV M,B ;REPLACE PREVIOUS CHARACTER  MOV A,B  ORA A ;IS CHARACTER ASCII? JM CHD140 ;NO - ADVANCE TO NEXT CHAR INR C ;YES - INCREMENT COLUMN # CHD140 EQU $  CALL NXTCH0 ;GET THE NEXT CHARACTER  CPI ALPHA ;TYPE DEFINITION?  JC CHD150 ;NO - CONTINUE MOVING CHARS  CALL CHD400 ;FORMAT MODE & DELETE ASCII? CNZ NXTCHR ;YES - ADVANCE TO NEXT CHAR CHD150 EQU $  XCHG ;RESTORE REGISTER POSITIONS  JMP CHD110 ;MOVE NEXT CHARACTER ;***********************************************; END OF LINE FILL CHARACTER FOUND - CLEAR THE *; REST OF THE LINE *;***********************************************CHD200 EQU $  CALL CHAIN0 ;GET END OF LINE LINK IN H,L XCHG ;EXCHANGE H,L AND D,E ;*********************************************; END OF LINE LINK FOUND - CLEAR THE REST OF *; THE LINE *;*********************************************CHD210 EQU $  CALL CHD400 ;FORMAT MODE & DELETE ASCII? XCHG ;(SET D,E TO LAST CHAR ADD DCX H ;H,L TO LSB OF NEXT LINE ; LINK) JNZ CHD260 ;YES - CLEAR REST OF FIELD; TO LSB OF NEXT LINE LINK LDA CHSAV ;RECALL DELETED CHARACTER  ORA A ;WAS IT ASCII? JP CHD260 ;YES - END LINE WITH EOL MVI A,FILL ;NO - END LINE WITH FILL JMP CLERL1 ;CLEAR REST OF LINE  ;*****************************************; EOL FOUND - CLEAR THE REST OF THE LINE *;*****************************************CHD250 EQU $  CALL CHAIN0 ;GET EOL LINK IN H,L DCX H ;SET TO LSB OF NEXT LINE LINCHD260 EQU $ ;CLEAR THE REST OF THE LINE  MVI A,EOL ;TERMINATING WITH AN EOL JMP CLERL1 ;*********************************************; CHD400 - CHECK FOR FORMAT MODE ENABLED AND *; DISPLAYABLE ASCII CHARACTER DELETED *;*********************************************; ; EXIT : NZ - FORMAT MODE AND DELETE ASCII; Z - NOT FORMAT MODE OR NON-DISPLAY  ; CODE DELETED ; CHD400 EQU $  LDA CHSAV ;GET CHARACTER DELETED ORA A ;IS IT DISPAYABLE ASCII  JP CHKFMT ;YES - CHECK FOR FORMAT MODE XRA A ;NO - RETURN Z RET ;***********************************************; CHD500 - CHECK FOR DISPLAY EHANCEMENT DELETE *;***********************************************; ; ENTRY: D,E = CHARACTER TO BE DELETED; ; EXIT : D,E = ACTUAL CHARACTER TO DELETE  ; A,L DESTROYED ; CHD500 EQU $  LDAX D ;GET CHARACTER TO BE DELETED ADD A ;DISPLAY ENHANCEMENT CODE? RNC ;ASCII - LET IT BE DELETED RM ;FORMAT CONTROL - DELETE IT  MVI L,2 ;YES - LOOK FOR POSSIBLE PUSH D ;DOUBLE EHANCEMENT CODE CHD510 EQU $  CALL NXTCHR ;GET THE NEXT CHARACTER  JNZ CHD515 ;EXIT IF EOL LINK  ADD A ;ENHANCEMENT CODE? JNC CHD520 ;ASCII - CHECK FOR SCAN DONE JM CHD510 ;FORMAT CONTROL - CONTINUECHD515 EQU $  POP D ;YES - DELETE ENHANCEMENT  RET;********************************************** ; ASCII CHARACTER FOUND - CHECK FOR SCAN DONE * ;********************************************** CHD520 EQU $  DCR L ;NEXT ASCII CHARACTER FOUND? JNZ CHD510 ;NO - CONTINUE SCAN ;*******************************************; NEXT ASCII CHARACTER OR EOL LINK FOUND - *; DON'T DELETE DISPLAY ENHANCEMENT CODE *;******************************************* POP D ;RECALL ORIGINAL ADDRESS JMP NXTCHR ;SET TO DELETE NEXT CHAR ;******************************************** ; CHRDL2 - DELETE CHARACTER W/REGISTER SAVE * ;******************************************** ; ; ENTRY: C = CHARACTER COLUMN POSITION; D,E = ADDRESS OF CHAR TO BE DELETED; ; EXIT : B,C = B,C(ENTRY) ; D,E = D,E(ENTRY) + 1  ; A,H,L DESTROYED ; CHRDL2 EQU $  PUSH B ;SAVE REGISTERS B,C  PUSH D ;AND D,E CALL CHRDL1 ;DELETE THE CHARACTER  POP D ;RESTORE REGISTER D,E  POP B ;AND B,C INX D ;INCREMENT D,E RET ;RETURN  ;**************************** ; CHRINS - INSERT CHARACTER * ;**************************** ; ; ENTRY: A = CHARACTER TO BE INSERTED ; CURROW,CURCOL = DISPLAY POSITION WHERE ; INSERT IS TO BE DONE ; ; EXIT : A = 0, INSERT NOT DONE ; A # 0, INSERT PERFORMED ; DCHAR DESTROYED ; B-L DESTROYED ; ; CHARACTER IS INSERTED IMMEDIATELY AHEAD OF THE ; CHARACTERS LOCATED AT THE SPECIFIED ROW AND ; COLUMN POSITIONS ; CHRINS EQU $  STA DCHAR ;SAVE CHAR TO BE INSERTED  MVI A,377Q ;INHIBIT LINE EXTENSION  STA BLKFIL  CALL RCADR4 ;DOES DISPLAY POSITION EXIST JNZ DISPLA ;NO - TRY TO EXTEND LINE; YES - INSERT THE CHARACTER ;***********************************************; CRI100 - ENTRY TO STORE CHARACTER FOR INSERT *; CHARACTER MODE *;***********************************************; ; ENTRY: C = COLUMN NUMBER; D,E = ADDR WHERE INSERT IS TO BE MADE ; H = BASEH ; CRI100 EQU $  CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JZ DIS092 ;YES - TAB TO NEXT FIELDCRI104 EQU $ MVI L,DCHAR-BASE  MOV B,M ;GET CHAR TO BE INSERTED XCHG ;PUT CHAR ADDRESS INTO H,LCRI110 EQU $ MOV A,B ;IS THIS CONTROL CODE? ORA A JM CRI120 ;YES - DON'T COUNT COLUMN  INR C ;INCREMENT COLUMN CRI120 EQU $ MOV A,M ;GET CHAR IN CURRENT ADDR  MOV M,B ;STORE NEW CHAR  MOV B,A ;SAVE OLD CHAR IN B  DCX H ;MOVE TO NEXT CHARACTER  MVI A,MAXCOL+1  CMP C ;STORE DONE AT END OF LINE?  JZ CRI305 ;YES - TERMINATE INSERT  LDA RHTMGN ;GET RIGHT MARGIN COLUMN INR A ;WAS THE LAST STORE DONE CMP C ;AT THE RIGHT MARGIN?  JZ CRI300 ;YES - TERMINATE INSERT  ;********************************** ; PROCESS NEXT CHARACTER OF BLOCK * ;********************************** CRI140 EQU $  MOV A,M ;GET THE NEXT CHARACTER  CPI ENHLIM+1 ;ASCII OR DISPLAY CONTROL? JC CRI110 ;YES - MOVE THE BYTE CPI LNKLIM ;IS IT A LINK BYTE?  JNC CRI200 ;YES - MOVE TO NEXT BLOCK  CPI EOL ;IS IT END OF LINE?  JZ CRI158 ;YES - ADD LAST CHAR TO LINE CPI FILL ;END OF LINE FILL CHARACTER? JZ CRI159 ;YES - ADD BYTE TO END LDA DCHAR ;NO - FIELD CHECK CHARACTER  ORA A ;IS ADDED CHARACTER ASCII? JM CRI110 ;NO - CONTINUE INSERT MOVE CALL CHKFMS ;FORMAT MODE ENABLED?  JZ CRI110 ;NO - CONTINUE INSERT  MOV A,M ;YES - RECALL THE BYTE CPI STPR ;IS CHARACTER A START PROT?  JZ CRI150 ;YES - CHECK INSERT TYPE CPI ALPHA ;FIELD TYPE DEFINITION?  JM CRI110 ;NO - CONTINUE INSERT  DCX H ;YES - ADVANCE TO NEXT BYTE  JMP CRI140 ;LOOK TO NEXT CHARACTER  ;*************************************; END OF FIELD - ASCII CODE INSERTED *;*************************************CRI150 EQU $  MOV A,B ;GET CHAR WHICH ROLLED OFF ORA A ;IS IT ASCII?  JP CRI154 ;YES - DELETE PREV CONTROLS CRI152 EQU $ ;NO - BACK UP ANOTHER CHAR CALL CRI500 ;IS PREVIOUS CHARACTER ASCII JM CRI152 ;NO - CONTINUE BACKING UP  MVI M,200Q ;YES - TEMPORARILY REPLACE; ASCII WITH DUMMY CONTROLCRI154 EQU $  CALL CRI500 ;PREVIOUS CHARACTER ASCII? JM CRI154 ;N0 - CONTINUE BACKING UP  DCX H ;MOVE TO NEXT CHARACTER  JMP CLER02 ;CLEAR REST OF FIELD ;*****************************; EOL FOUND *; ADD LAST CHARACTER TO LINE *;*****************************CRI158 EQU $ MOV A,B ;GET CHARACTER ORA A ;IS THIS CONTROL CHAR? JM CRI160 ;YES - ADD CHAR  MOV A,C ;NO - CHAR IS ASCII  CPI MAXCOL ;IS THIS MAX COLUMN? JNZ CRI170 ;NO - ADD CHARCRI159 EQU $ MOV M,B ;ASCII CHARACTER INSERTED TO ORA A ;MAXIMUM COLUMN - OVERLAY  RET ;EOL AND RETURN NZ;************************** ; EOL CANNOT BE OVERLAYED * ; ADD NEW CHAR TO LINE * ;************************** CRI160 EQU $ DCR CCRI170 EQU $ XCHG ;PUT H,L INTO D,E CRI180 EQU $ LXI H,DCHAR ;SAVE CHARACTER TO BE ADDED  MOV M,B  MVI L,CURCOL-BASE  MOV B,M ;GET CURRENT CURSOR COLUMN PUSH B ;AND SAVE IT MOV M,C ;SET "CURCOL" TO INSERT COL  MVI C,0 ;SET # OF CHARS NEEDED TO 1 ; (VALUE IN C IS ONE LESS) CALL DISPL1 ;BUILD NECESSARY BLOCKS  POP B ;RESTORE ORIGINAL CURSOR LXI H,CURCOL ;COLUMN NUMBER MOV M,B  RET ;RETURN (A=MEMORY LOCK STATE)  ;********************************** ; LINK FOUND - MOVE TO NEXT BLOCK * ;********************************** CRI200 EQU $  SHLD LNKSAV ;SAVE CURRENT BLOCK ADDRESS  DCX H ;GET THE LSB OF THE LINK MOV A,M  CMA ;IS IT AN EOL LINK (LOWER  ANI BLKSM ;FOUR BITS NOT ALL ONES)?  JNZ CRI240 ;YES - EXTEND THE LINE CALL CHAIN ;NO - GET NEXT BLOCK ADDRESS JMP CRI140 ;CONTINUE INSERT CHARACTER ;********************* ; NEW BLOCK REQUIRED * ;********************* CRI240 EQU $ MOV A,B ;SAVE CHARACTER BEING MOVED  STA TEMP INX H ;GET THE LAST CHARACTER OF INX H ;THE CURRENT BLOCK TO BE MOV B,M ;STORED AGAIN IN THE SAME  XCHG ;LOCATION BY "DISPL1"  DCR C ;GET COLUMN # OF PREV CHAR CALL CRI180 ;ADD BLOCK ORA A ;IS MEMORY LOCKED? JZ CRI260 ;YES - BLOCK NOT ADDED LDA TEMP ;NO - RECALL CHAR TO BE ADDE STAX D ;PUT CHARACTER IN NEW BLOCK ; (OVERWRITE EOL)  RET ;RETURN ;*********************************; BLOCK NOT AVAILABLE *; WRITE EOL AT END OF LAST BLOCK *;*********************************CRI260 EQU $ LHLD EOLADR ;GET ADR OF CHR BEFORE LNK MVI M,EOL ;WRITE EOL RET ;RETURN  ;*******************************************; RIGHT MARGIN OR END OF LINE REACHED - *; TERMINATE AND OPTIONALLY PUSH CHARACTERS *; TO THE NEXT LINE (WRAP AROUND) *;*******************************************CRI300 EQU $  LDA DCHAR ;GET THE INSERTED CHARACTER  ORA A ;IS IT ASCII?  JM CRI140 ;NO - CONTINUE INSERTING MOV A,C ;YES - RECALL ENDING COLUMN CRI305 EQU $  STA PARM5 ;SAVE ENDING COLUMN NUMBER SHLD LNKSAV ;SAVE ENDING CHARACTER ADDR  XCHG ;PUT ENDING ADDRESS IN D,E CALL INITD1 ;INIT CHAR BUFFER POINTERS INX D ;GET ADDRESS OF NEXT EXCESS  CALL NXTCHR ;CHARACTER XCHG  SHLD PARM6 ;ARE WE AT AN EOL LINK?  MOV A,B ;(PUT 1ST EXCESS CHAR IN A JZ CRI320 ;NO - ACCUMULATE EXCESS  CALL A2OUTB ;YES - SAVE FIRST EXCESS CHA ORA A ;IS IT ASCII?  JP CRI330 ;YES - CHECK FOR INSERT WRAP RET ;NO - RETURN; ; ACCUMULATE THE EXCESS CHARACTERS; CRI310 EQU $  LHLD PARM6 ;RECALL EXCESS CHAR ADDRESS  XCHG ;PUT ADDRESS INTO D,E  MVI A,-1 ;SET DELETED CHAR TO -1  STA CHSAV  MVI C,MAXCOL+1 ;FORCE DELETE PAST MARGIN  CALL CHRDL1 ;DELETE ONE EXCESS CHARACTER LDA CHSAV ;RECALL THE DELETED CHARACTE MOV B,A ;SAVE THE CHARACTER IN B-REG INR B ;ANY CHARACTER DELETED?  RZ ;NO - RETURN (A#0)CRI320 EQU $ ;YES - ACCUMULATE EXCESS CALL A2OUTB ;PUT DELETED CHAR INTO BUFFE ORA A ;WAS DELETED CHARACTER ASCII JM CRI310 ;NO - CONTINUE ACCUMULATING  LDA PARM5 ;RECALL ENDING COLUMN NUMBER CPI MAXCOL+1 ;TERMINATE ON LAST COLUMN? LHLD LNKSAV ;(RECALL ENDING CHAR ADDR) XCHG  MVI A,FILL ;(SET FOR FILL PAD)  CZ CLERL0 ;YES - CLEAR REST OF LINE  ; ; EXCESS CHARACTERS ACCUMULATED - CHECK FOR WRAP; CRI330 EQU $  LDA CMFLGS ;GET THE COMMON FLAGS  CMA ;COMPLEMENT FLAGS  ANI INSWRP ;WRAP AROUND ENABLED?  RNZ ;NO - RETURN (A#0) LDA CURCOL ;YES - GET THE CURRENT COLUM MOV B,A ;SAVE VALUE IN B-REGISTER  LDA RHTMGN  CMP B ;CURSOR BEYOND RIGHT MARGIN? RC ;YES - RETURN  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RNZ ;YES - RETURN  PUSH B ;N@@O - SAVE CURRENT COLUMN AN LXI H,CURROW ;INCREMENT TO NEXT ROW INR M  LHLD LSTLIN ;CHECK TO SEE IF NEXT LINE MOV E,M ;IS FULL (I.E., NO "EOL" INX H ;BEFORE RIGHT MARGIN)  MOV D,M  INR E ;DOES NEXT LINE EXIST? DCR E ;(LSB # 0)?  JZ CRI400 ;NO - ADD CHAR TO NEW LINE INX D ;YES - START FROM BEGINNING  LDA RHTMGN ;OF LINE TO RIGHT MARGIN CALL FNDLS0 ;NEXT LINE FULL? JP CRI400 ;NO - ADD OVERFLOW CHARACTER; TO NEXT LINE CALL LININS ;YES - INSERT A LINE JZ CRI450 ;EXIT IF MEMORY LOCKED ; ; INSERT CHARACTERS INTO NEXT LINE ; CRI400 EQU $  LXI H,B2DEND ;GET BUFFER POINTER  MOV A,M  CPI B2DBFL-1 ;ALL BYTES DONE? JZ CRI450 ;YES - EXIT  DCR M ;NO - UPDATE BUFFER POINTER  MOV L,A ;PUT LSB INTO L  LDA LFTMGN ;SET TO INSERT CHARACTER AT  STA CURCOL ;LEFT MARGIN MOV A,M ;GET CHARACTER TO INSERT CALL CHRINS ;INSERT CHARACTER  ORA A ;INSERT SUCCESSFUL?  JNZ CRI400 ;YES - DO NEXT BYTE ; ; ALL CHARACTERS INSERTED - EXIT ; CRI450 EQU $  LXI H,CURROW  DCR M ;RESTORE THE ROW NUMBER  POP PSW ;RECALL THE COLUMN NUMBER  INX H  MOV M,A ;RESTORE COLUMN NUMBER INR A ;FORCE A # 0 RET ;RETURN  ;********************************** ; CRI500 - GET PREVIOUS CHARACTER * ;********************************** ; ; ENTRY: H,L = CURRENT CHARACTER ADDRESS; LNKSAV = ADDRESS OF MSB PART OF NEXT ; BLOCK LINK IN PREVIOUS BLOCK ; ; EXIT : A = PREVIOUS CHARACTER ; H,L = ADDRESS OF PREVIOUS CHARACTER; P - CHARACTER IS ASCII ; M - CHARACTER IS NON-DISPLAY CONTROL ; CRI500 EQU $  INX H ;MOVE TO PREVIOUS CHARACTER  MOV A,L ;IN BLOCK  ANI BLKSM ;PREVIOUS CHARACTER IN BLOCK JNZ CRI510 ;YES - GET IT  LHLD LNKSAV ;NO - GET PREV BLOCK ADDRESS INX H ;SET TO LAST CHARACTER ADDR CRI510 EQU $  MOV A,M ;GET THE PREVIOUS CHARACTER  ORA A ;SET FLAGS FOR ASCII OR NOT  RET ;ASCII AND RETURN   ;********************** ; CLEARL - CLEAR LINE * ;********************** ;  ; ENTRY: DON'T CARE ; ; EXIT : A = -1, ROW NOT FOUND; = 0, CHARACTER FOUND AND CLEAR DONE ; > 0, COLUMN PAST EOL, CLEAR NOT DONE; CLEARL EQU $  CALL RCADR4 ;DOES ROW EXIST? RNZ ;NO - RETURN CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JZ CLERLA ;NO - DO NORMAL CLEAR LINE JP CLL400 ;FORMAT MODE - CLEAR FIELD;********************************************** ; SOFT KEY DEFINE MODE - CLEAR DATA ROWS ONLY * ;**********************************************  LDA CURROW ;GET CURSOR ROW  RRC ;IN DATA LINE (ODD ROW #)? RNC ;NO - INHIBIT CLEAR  LDAX D ;GET FIRST CHARACTER CPI ENDPR ;END PROTECT?  CZ NXTCHR ;YES - SKIP TO 1ST ASCII CHACLERLA EQU $  CALL CHKSFK ;SOFT KEY DEFINE MODE? MVI A,SETFRN ;(SET CONTROL CODE)  CZ ZKBCTL ;NO - UPDATE FOREIGN MODE  MVI A,EOL ;CLEAR LINE WITH "EOL" ENDIN ;****************************** ; CLERL0 - CLEAR REST OF LINE * ;****************************** ; ; ENTRY: A = TERMINATOR CHARACTER ; D,E = CLEAR STARTING ADDRESS ;  ; EXIT : SEE "CLEARL" ; CLERL0 EQU $  LHLD LSTLIN ;GET CURRENT LINE ADDRESS CLERL1 EQU $  STA FILCHR ;SAVE TERMINATOR CHARACTER MOV B,H ;SET B,C TO ADDRESS OF NEXT  MOV C,L ;LINE POINTER'S LSB  MOV A,E ;SET H,L TO ADDRESS OF NEXT  ANI 377Q-BLKSM ;BLOCK LINK IN CURRENT MOV L,A ;BLOCK MOV H,D MOV A,M ;GET NEXT BLOCK  INX B ;SET B,C TO MSB OF NEXT LINE MOV M,C ;POINTER INX H  MOV C,M  MOV M,B  MOV B,L ;SAVE LSB OF LINK'S MSB ADDR MOV H,C  MOV L,A  PUSH H ;SAVE ADDRESS OF NEXT BLOCK  ;*****************************************; INSERT FILL CHARS BETWEEN LINK AND EOL *;***************************************** MOV A,E ;COMPUTE NO. OF FILLS  ANI BLKSM SUI 2 ;LESS THAN 2?  JM CLL160 ;YES - RELEASE THE BLOCK MOV E,B ;SET H,L TO ADDRESS OF MSB XCHG ;PART OF NEXT BLOCK POINTECLL120 EQU $ INX H ;ADVANCE TO NEXT BYTE  MVI M,FILL ;STORE FILL CHARACTER  DCR A ;ALL BYTES DONE? JP CLL120 ;NO - CONTINUE FILLING LDA FILCHR ;YES - GET AND STORE FINAL MOV M,A ;FILL CHARACTER ;******************************** ; RELEASE EXCESS DISPLAY BLOCKS * ;******************************** CLL160 EQU $  POP D ;RECALL ADDRESS OF NEXT BLOC MOV A,E  CMA ;IS THE LINK AN EOL LINK ANI BLKSM ;(LOW 4 BITS NOT ALL ONES) JNZ CLL310 ;YES - EXIT  DCX D ;NO - ADD BLOCKS TO FREE LIS DCX D ;SET ADDRESS TO LSB OF NEXT  DCX D ;LINE FIELD IN FIRST BLOCK CALL PUTLIN ;ADD BLOCKS TO FREE LISTCLL310 EQU $ XRA A ;SET ZERO FLAG FOR CLEARS  RET ;RETURN  ;************************************** ; CLEAR LINE FUNCTION FOR FORMAT MODE * ;************************************** CLL400 EQU $  INR B ;CURSOR IN PROTECTED FIELD?  RZ ;YES - RETURN, DON'T DO CLEA;*********************************************; CLEAR UNPROTECTED FIELD *; D,E = ADDRESS OF FIRST ASCII CHAR IN FIELD *;*********************************************CLER01 EQU $ XCHG CLER02 EQU $  XCHG ;PUT CHARACTER ADDR INTO D,E INX D ;SET TO PREVIOUS CHARACTERCLL510 EQU $  CALL NXTCHR ;GET THE NEXT CHARACTER  JNZ CLL580 ;CHECK EXIT IF EOL LINK  ADD A ;ASCII?  JC CLL540 ;NO - CONTINUE MVI A,ABLNK ;YES - STORE BLANK STAX D  INR C ;INCREMENT COLUMN  JMP CLL510 ;TRY NEXT CHARACTER  ;********************** ; NON-ASCII CHARACTER * ;********************** CLL540 EQU $ JM CLL550 ;NOT DSPLY CNTRL - CHECK MORE ;********************************** ; DELETE DISPLAY ENHANCEMENT CHAR * ;********************************** CLL544 EQU $  CALL CHRDL2 ;DELETE ENHANCEMENT CODE JMP CLL510 ;CONTINUE CLEARING ;*******************************; NOT ASCII OR DISPLAY CONTROL *;*******************************CLL550 EQU $  RAR ;RESTORE CHARACTER CPI FILL ;END OF LINE FILL? JZ CLL510 ;YES - GO TO NEXT CHARACTER  CPI STPR ;START PROTECT?  RZ ;YES - TERMINATE CLEAR CPI STPFLG+1 ;FORMAT CONTROL CODE?  JC CLL544 ;YES - DELETE IT JMP CLL510 ;NO - GO TO NEXT CHARACTER ;********************* ; LINK FOUND * ; MOVE TO NEXT BLOCK * ;********************* CLL580 EQU $  LDAX D ;GET NEXT LINE LINK'S MSB  CPI EOP ;END OF DISPLAY LIST?  RZ ;YES - RETURN  CALL FLDSR2 ;CONTINUATION FIELD? JZ CLL510 ;YES - CONTINUE CLEAR  XRA A ;NO - TERMINATE CLEAR AND  RET ;RETURN END ON END OF FIEL ;***************************; DSPMSG - DISPLAY MESSAGE *;***************************; ; ENTRY: NC - ADD MESSAGE TO NORMAL DISPLAY ; C - REPLACE DISPLAY WITH MESSAGE ; MSGPT1-MSGPT8 = POINTERS TO MESSAGE ; SECTIONS ; ; EXIT : ALL REGISTERS DESTROYED; DSPMS0 EQU $ ;SET C-FLAG TO FORCE DISPLAY STC ;REPLACEMENT BY MESSAGE DSPMS1 EQU $  SHLD MSGPT1 ;SET MESSAGE POINTER 1DSPMSG EQU $  JNC DSM500 ;ADD MESSAGE TO DISPLAY  LXI B,DSPSTR ;SET DESTINATION POINTER LXI H,MSGPT1+1 ;SET INITIAL TABLE POINTER; ; TRANSFER MESSAGE TO MESSAGE BUFFER ; DSM010 EQU $  MOV D,M ;GET POINTER TO MESSAGE  DCX H  MOV E,M  DCX H ;SET TO NEXT POINTER XCHG ;PUT POINTER INTO H,L  CALL MOVCHR ;XFR MESSAGE PART TO BUFFER  XCHG ;PUT POINTER TO TABLE IN H,L JZ DSM010 ;DO NEXT PART IF NOT EOP END LXI H,DSPSTR ;SET DISPLAY POINTER TO  SHLD DISPST ;MESSAGE AREA  MVI A,MAXROW+1 ;REMOVE CURSOR FROM DISPLA STA IOCRRW  RET ;RETURN  ; ; ADD MESSAGE TO NORMAL DISPLAY; DSM500 EQU $  CALL SFKYOF ;FORCE NORMAL DISPLAY ON LXI H,MSGPT1+1 ;SET INITIAL TABLE POINTERDSM510 EQU $  MOV D,M ;GET POINTER TO MESSAGE  DCX H  MOV E,M  DCX H ;SET TO NEXT POINTER PUSH H ;SAVE TABLE POINTER  XCHG ;PUT MESSAGE POINTER IN H,L  CALL XMS2DS ;XFR MESSAGE TO THE DISPLAY  POP H ;RECALL TABLE POINTER  JZ DSM510 ;DO NEXT PART IF NOT EOP END; FALL INTO "RSTDSP" TO ; FORCE DISPLAY ON;********************************** ; RSTDSP - RESTORE NORMAL DISPLAY * ;********************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : PROCESSOR FLAGS UNCHANGED ; H,L DESTROYED ; RSTDSP EQU $  LHLD TOPLIN ;GET TOP LINE ADDRESS  DCX H ;SET TO FIRST CHAR ADDRESS SHLD DISPST ;SET DISPLAY START POINTER JMP DISLN1 ;SET THE DISPLAY CURSOR  ;*****************************; FORMON - ENTER FORMAT MODE *;*****************************FORMON EQU $  CALL CKEDIT ;EDIT MODE?  RNZ ;YES - INHIBIT FORMAT MODE LXI H,MAXCOL ;NO - SET MARGINS TO ENDS OF SHLD RHTMGN ;DISPLAY MVI A,FORMAT ;TURN ON FORMAT MODE FLAG  CALL ZSTMD1 ; SET CURSOR TO FIRST ; UNPROTECTED FIELD ; ;***********************************; CURPH - CURSOR POINTER HOME (UP) *;***********************************CURPH EQU $ MVI A,377Q-SDACOM ;CLEAR DATACOM INPUT  CALL CLRDFL ;FLAG TO DISABLE TRANSMIT-; ONLY FIELDS ; CURPH1 EQU $  CALL CURPRT ;SET CURSOR TO LEFT MARGIN CALL CHKSFK ;SOFT KEY MODE?  JNZ HUP060 ;YES - SET CURSOR ONLY STA TLINO ;NO - SET TOP LINE # TO ZERO DCR A ;RESET SPOW LATCH  STA SPOWL  CALL MLKSCH ;DISPLAY AREA LOCKED?  JZ HUP100 ;NO - HOME TO FIRST LINE; ; DISPLAY LOCK ON - CHANGE ONLY UNLOCKED LINES ;  MOV D,H ;SAVE ADDRESS OF LSB PART OF MOV E,L ;NEXT LINE POINTER IN FIRS INX H ;UNLOCKED LINE INX H ;GET ADDRESS OF LAST LOCKED  MOV C,M ;ROW INX H  MOV B,M  LHLD TOPLIN ;GET PTR TO TOP DSPLY LINE INX H ;GET ADDRESS OF FIRST LINE INX H ;ABOVE TOP DISPLAY LINE  MOV A,M  ORA A ;ANY LINES ABOVE DISPLAY?  JZ HUP050 ;NO - POSITION CURSOR ONLY ; ; LINK SPLIT PARTS TOGETHER;  MVI M,0 ;ZERO PREV LINE PTR OF TOP L INX H  MOV H,M ;SET H,L TO FIRST LINE ABOVE MOV L,A ;DISPLAY DCX D ;SET ITS NEXT LINE POINTER T MOV M,E ;FIRST CHARACTER OF FIRST  INX H ;UNLOCKED LINE MOV M,D  XCHG ;SET PREVIOUS LINE POINTER O INX H ;FIRST UNLOCKED LINE TO  INX H ;FIRST LINE ABOVE DISPLAY  INX H  MOV M,A  INX H  MOV M,D  LHLD FLINE ;REPLACE CONTENTS OF FLINE XCHG ;WITH VALUES FROM TOPLIN LHLD TOPLIN SHLD FLINE  MOV H,D ;SET PREVIOUS LINE POINTER O MOV L,E ;CURRENT TOP LINE TO POINT INX H ;TO LAST LOCKED ROW  INX H  MOV M,C  INX H  MOV M,B  MOV H,B ;SET H,L TO MSB PART OF NEXT MOV L,C ;LINE POINTER IN LAST  INX H ;LOCKED ROW  MOV B,D ;SET NEXT LINE POINTER TO  MOV C,E ;POINT TO FIRST CHARACTER  DCX B ;OF LINE POINTED BY FLINE  CALL DISLNK ; ; DISPLAY SET FOR DISPLAY LOCK HOME - SET CURSOR ; HUP050 EQU $  CALL ROLUP3 ;SET "LSTLIN" AND "CURADR" CALL CHKFMT ;FORAMT MODE?  XRI FORMAT ;(REVERSE RESULT OF TEST)  JZ HUP110 ;YES - LOCATE FIRST FIELD ; STARTING IN LOCKED REGION ; (A = 0)  LDA MLKROW ;NO - SET CURSOR TO FIRST  STA CURROW ;UNLOCKED ROW  STA LSTROW  RET ;RETURN  ; ; DEFINE SOFT KEYS HOME UP ; HUP060 EQU $  XRA A ;SET CURSOR ROW TO ZERO  STA CURROW STA LSTROW  LHLD SFTKYS ;SET "CURADR" AND "LSTLIN" INX H ;TO FIRST SOFT KEY LINE  CALL ROLUPC  JMP FLDSR1 ;LOCATE FIRST FIELD ; ; DISPLAY NOT LOCKED - SET TOPLIN TO FLINE ; HUP100 EQU $  LDA MLKROW ;SET CURSOR TO 1ST UNLK RWHUP110 EQU $  STA CURROW ;SET NEW CURRENT ROW XRA A  STA LSTROW ;SET LAST ROW DONE TO ZERO MOV D,A ;SET D=0 TO FLAG TLINO UPDAT LXI H,FLINE  MOV A,M ;SET TOP LINE POINTER TO CALL ROLUP1 ;FIRST DISPLAY LINE  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RZ ;NO - RETURN; YES - FALL INTO "FLDSR1" TO ; FIND FIRST UNPROTECTED; FIELD  ;******************************************** ; FLDSR - LOCATE THE NEXT UNPROTECTED FIELD * ;******************************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : NZ - FIELD FOUND ; D,E = ADDRESS OF "ENDPR" ; CURADR,CURCOL,CURROW,LSTLIN,LSTCOL ; LSTROW UPDATE TO CORRESPOND TO  ; FIELD FOUND ; Z - FIELD NOT FOUND; ALL REGISTERS DESTROYED; FLDSR1 EQU $ ;LOOK FOR NEXT UNPROTECT LXI H,NEWROW ;INITIALIZE ROW COUNT MVI M,0 ;TO ZERO MVI L,CURCOL-BASE ;GET CURRENT COLUMN MOV C,M ;POSITION JMP FSR100 FLDSR EQU $ XRA A ;ZERO NUMBER OF ROWS ROLLED  STA NEWROW  CALL RCADRB ;DOES CURSOR ROW EXIST?  JM ZRETRN ;N@@O - RETURN ZERO  MOV C,A ;YES - SAVE LAST COLUMN FOUN CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JZ FSR100 ;YES - LOOK FOR NEXT UNPROTC;*******************************************; CURSOR IS IN UNPROTECTED FIELD *; SEARCH FOR START OF NEXT PROTECTED FIELD *;*******************************************FSR080 EQU $ LXI H,STPR*256+STPR  CALL FNDCU1 ;ANY MORE FIELDS IN LINE?  JZ FSR120 ;NO - GO TO NEXT LINE ;*********************************************; ADVANCE CURSOR TO START OF PROTECTED FIELD *;********************************************* MVI A,MAXCOL+1 ;COMPUTE NEW COLUMN  SUB C MOV C,A ;SAVE COLUMN IN C ;************************************ ; CURSOR IS IN PROTECTED FIELD * ; SEARCH FOR NEXT UNPROTECTED FIELD * ; IN THIS LINE * ;************************************ FSR100 EQU $ CALL FNDCHU ;ANY MORE FIELDS IN LINE?  JNZ FSR200 ;YES - SET CURSOR AND DISPLA  ;************************* ; NO MORE FIELDS IN LINE * ; MOVE TO NEXT LINE * ;************************* FSR120 EQU $ CPI STPFLG ;NON-DISPLAYING TERMINATOR?  JZ FSR140 ;YES - RETURN FAIL MOV C,H ;NO - SAVE TERMINATOR CHAR CALL CHAIN0 ;GET NEXT BLOCK LINK MOV A,M ;GET NEXT LINE LINK'S MSB  DCX H  MOV L,M ;PUT LSB INTO L-REGISTER CPI EOP ;END OF DISPLAY FOUND? JZ FSR140 ;YES - EXIT FIELD NOT FOUND  MOV H,A ;NO - SAVE ADDRESS OF NEW  SHLD LNKSAV ;LINE  XCHG  LXI H,NEWROW ;INCREMENT ROW NUMBER  INR M  XRA A STA LSTDCD ;CLEAR LAST DISPLAY CODE STA TEMP MOV A,C ;GET LAST TERMINATOR CHAR  MVI C,0 ;SET COLUMN TO ZERO  CPI STPR ;LOOKING FOR START PROTECT?  JNZ FSR100 ;NO - CONTINUE UNPROTECT FIN; YES - SEE IF CONTINUE UNPROT;**************************************** ; SEARCH FOR PROTECTED FIELD * ; CHECK FOR CONTINUED UNPROTECTED FIELD * ;****************************************  CALL FLDSR2 ;FIRST CHAR AN "ENDPR" LDA TEMP ;(SET NEW LSTDCD VALUE)  STA LSTDCD  JZ FSR080 ;YES - LOOK FOR START PROTEC JMP FSR100 ;NO - LOOK FOR NEXT UNPROTEC;******************************** ; SET LSTCOL PAST END OF LINE * ; TO CAUSE LINE TO BE RESCANNED * ;******************************** FLDSRX EQU $ FSR140 EQU $ ;(Z TRUE)  LXI H,LSTCOL MVI M,MAXCOL+1  RET ;RETURN  ;************************** ; UNPROTECTED FIELD FOUND * ; SET NEW CURSOR POSITION * ;************************** FSR200 EQU $ MVI A,MAXCOL+1 ;COMPUTE NEW COLUMN  SUB C CALL CRRET1 ;SET CURRENT CURSOR LOCATION STA LSTCOL ;AND LAST CURSOR VALUE XCHG ;STORE NEW CURRENT ADDRESS SHLD CURADR  SHLD LADDR ;SAVE FIELD ADDRESS IN; CASE ROLL UP NEEDED  XCHG ;RESTORE D,E AND H,L ;************************* ; COMPUTE NEW CURSOR ROW * ;*************************  LDA NEWROW ;GET NEW ABSOLUTE ROW NUMBER ORA A ;HAS ROW CHANGED?  JZ FSR360 ;NO - RETURN LXI H,CURROW ;YES - CALCULATE NEW ADD M ;ROW NUMBER FSR240 EQU $ MVI C,MAXROW+1 ;IS NEW ROW ON CURRENT PAGE? CMP C JC FSR340 ;YES  ;***************************************; NEW CURSOR ROW IS ON NEW PAGE *; ROLL DISPLAY UP TO GET ROW ON SCREEN *;*************************************** SUB C ;DECREMENT ROLL COUNT BY ONE LXI H,MLKROW ;PAGE  ADD M ;ADJUST FOR LOCKED DISPLAY MOV D,A ;SAVE RESULT FOR STORAGE MOV A,C ;COMPUTE NUMBER OF LINES TO  SUB M ;ROLL FOR ONE PAGE MOV E,A ;SAVE THE VALUE FOR STORAGE  XCHG ;PUT VALUES INTO H,L SHLD ROLLCT ;STORE ROLL PARAMETERS; ; ROLL UP ONE PAGE OF LINES; FSR300 EQU $  CALL ROLLUP ;ROLLUP ONE LINE LXI H,ROLLCT  DCR M ;PAGE ROLLED UP? JNZ FSR300 ;NO - DO ANOTHER LINE  INX H ;YES - GET NUMBER OF ROWS  MOV A,M ;TO UNPROTECTED FIELD AND  JMP FSR240 ;CHECK TO SEE IF ON SCREEN;*************; UPDATE ROW *;*************FSR340 EQU $  STA CURROW ;SET NEW ROW NUMBER  LHLD CURROW ;SET LAST ROW AND COLUMN DON SHLD LSTROW ;CURRENT ROW AND COLUMN  LHLD LNKSAV ;SET "LSTLIN" TO CURRENT ROW INX H ;ADDRESS SHLD LSTLIN  LHLD LADDR ;SET "CURADR" TO ADDRESS OF  SHLD CURADR ;FIRST CHAR IN NEW FIELD XCHG ;PUT CURRENT ADDRESS INTO D,FSR360 EQU $  CPI D ;SET Z-FALSE (D >= 320)  JMP DISLN1 ;GO SET DISPLAY CURSOR ROW ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FLDSR2 - DETERMINE PROTECT SENSE OF NEXT ; CHARACTER; ; ENTRY: D,E = NEXT CHARACTER ADDRESS ; ; EXIT : Z - CONTINUATION OF FORMAT FIELD ; NZ - NOT A CONTINUATION; D,E = ADDRESS OF CHARACTER  ; H = BASEH ; TEMP = NEW ENHANCEMENT CODE IF ANY ; A,L DESTROYED; FS2000 EQU $  STA TEMP ;STORE NEW DISPLAY CONTROLFLDSRB EQU $ FS2005 EQU $  DCX D ;SET ADDRESS TO NEXT CHAR FLDSR2 EQU $ INX D ;SET ADDRESS TO PREV CHAR  CALL NXTCHR ;GET NEXT CHARACTER  JNZ FLDSR2 ;SKIP OVER LINKS ADD A ;ASCII OR DISPLAY CONTROL? JNC NZEXIT ;ASCII - RETURN NOT CONTINUE RAR ;(RESTORE DATA BYTE) JP FS2000 ;DISPLAY CONTROL - IGNORE IT CPI STPFLG ;TERMINATOR OR TYPE DEFINE?  JP FS2005 ;YES - SKIP TO NEXT CHARACTE LXI H,LSTFMT ;COMPARE AGAINST LAST FORMAT CMP M ;CONTROL AND RETURN  RET ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FNDCH - SEE IF NEXT CHAR IS FORMAT CONTROL BYTE; ; ENTRY: TERMINAL IS IN FORMAT MODE ; D,E = START ADDRESS; H,L = CHARACTERS TO LOOK FOR ; ; EXIT : Z - CHARACTER NOT FOUND; NZ - CHARACTER FOUND ; D,E = ADDRESS OF ENDING CHARACTER; A,B,C,L,TEMP DESTROYED ; ; FNDCH0 - SEE IF NEXT CHARACTER IS PROTECTED; FNDCH0 EQU $  LXI H,STPR*256+STPR ;SET COMPARE CHARS FNDCH EQU $  MVI A,IGNTRM ;SET TO IGNORE NON-DISPLAYIN STA TRMFCT ;TERMINATOR  LDA PROFLD ;SAVE PROTECTED FIELD  PUSH PSW ;STATUS  MVI C,0 ;SET FOR NEXT CHARACTER ONLY CALL FCR400 ;LOCATE THE NEXT CHARACTER MVI A,DELTRM ;RESTORE FLAG TO DELETE NON- STA TRMFCT ;DISPLAYING TERMINATOR POP B ;RESET PROTECT STATUS TO BE  MOV A,B ;CONSISTENT WITH CHARACTER STA PROFLD ;POINTED TO BY "CURADR"  RET ;RETURN  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; FNDCHU - LOCATE NEXT UNPROTECTED FIELD ; CONTROL BYTE IN CURRENT LINE ; ; ENTRY: TERMINAL IS IN FORMAT MODE ; B = DON'T CARE ; C = CURRENT COLUMN NUM8ER; D,E = START ADDRESS; ; EXIT : Z - CHARACTER NOT FOUND; NZ - CHARACTER FOUND ; C = NUMBER OF CHARS TO END OF LINE ; D,E = ADDRESS OF ENDING CHARACTER; PROFLD SET AS DEFINED; A,B,L DESTROYED; FNDCHU EQU $  CALL DCXB2D ;DATA COMM OR I/O BUFF INPUT LXI H,ENDPR*256+ENDPR ;(SET "ENDPR" ONLY) JZ FNDCU1 ;NO - SKIP XMIT ONLY FIELDS  MVI L,XMONLY ;YES - LOOK FOR "XMONLY" ALS; ; LOCATE THE FORMAT CONTROL CHARACTER; FNDCU1 EQU $  MVI A,MAXCOL ;COMPUTE NO. OF CHARS  SUB C ;TO SEARCH MOV C,AFCR400 EQU $ CALL FNDCHR ;LOOK FOR SPECIFIED CHARS  RZ ;RETURN IF EOL ENCOUNTERED XRA A ;OTHERWISE, SET FLAG TO  ORA C ;SHOW IF CHARACTER FOUND RET ;************************************** ; FNDCHR - LOCATE SPECIFIED CHARACTER * ;************************************** ; ; ENTRY: C = NUMBER OF COLUMNS TO SEARCH; D,E = STARTING ADDRESS ; H,L = CHARACTERS TO LOOK FOR ; (VALID FOR FORMAT MODE ONLY) ; ; EXIT : Z - CHARACTER NOT FOUND; NZ - CHARACTER FOUND ; C = NUMBER OF CHARACTERS LEFT; (= 0, IF CHARACTER FOUND); D,E = ADDRESS OF TERMINATING CHARACTER ; "EOLMV" SET TO ZERO; "PROFLD" SET IF IN FORMAT MODE ; "LSTFMT" UPDATED IF A FORMAT CONTROL ; CHARACTER IS ENCOUNTERED ; FNDCHR EQU $  XRA A  STA EOLMV  INX D ;SET TO PREV CHAR ADDRESS  INR C ;ADJUST CHARACTER COUNT  INR C FCR005 EQU $  DCR C ;COLUMN FOUND? JZ NZEXIT ;YES - RETURN CHARACTER FOUN;  ; SEARCH DISPLAY LIST ; FCR010 EQU $  CALL NXTCHR ;GET THE NEXT CHARACTER  JNZ FCR260 ;EOL LINK - EXIT NOT FOUND ADD A ;IS IT ASCII?  JNC FCR005 ;YES - DECREMENT COLUMN COUN;************************************************ ; NON-ASCII CHARACTER - DETERMINE CHAR FUNCTION * ;************************************************  RAR ;RESTORE CHARACTER JM FCR100 ;NOT DISPLAY CTL - CHECK MOR STA LSTDCD ;UPDATE CURRENT DISPLAY CODE JMP FCR010 ;CONTINUE SEARCHING  ; ; FORMAT CONTROL CHARACTER - CHECK FOR ENDING; FCR100 EQU $  CPI EOL ;END OF LINE?  RZ ;YES - RETURN  CPI EOP ;END OF DISPLAY? RZ ;YES - RETURN  CPI STPFLG ;NON-DISPLAYING TERMINATOR?  JZ FCR200 ;YES - DETERMINE ITS FUNCTIO CPI ALPHA ;TYPE DEFINITION?  JP FCR150 ;YES - SET CHECK FUNCTION  CPI XMONLY+1 ;FORMAT CONTROL? JP FCR010 ;NO - CONTINUE SEARCHING PUSH H ;YES - RESET CHECK ROUTINE LXI H,ZRETRN ;ADDRESS SHLD CHKRTN  POP H ;RESTORE CHECK CHARACTERS  STA LSTFMT ;SET CURRENT FORMAT CONTROL  MOV B,A ;SAVE CONTROL CHARACTER  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JZ FCR010 ;NO - CONTINUE SEARCHING MOV A,B ;RECALL CHARACTER  SBI STPR+1 ;COMPUTE "PROFLD" VALUE  STA PROFLD ;(= -1 FOR PROTECTED)  MOV A,B ;RECALL CHARACTER  CMP H ;TERMINATOR FOUND? JZ FCR110 ;YES - EXIT  CMP L  JNZ FCR010 ;NO - CONTINUE SEARCHINGFCR110 EQU $  ORA A ;SET Z FALSE RET ;RETURN ; ; TYPE DEFINITION FOUND - SET CHECK ROUTINE; FCR150 EQU $  PUSH H ;SAVE TERMINATOR CHARACTERS  LXI H,ZALPCK ;SET H,L FOR ALPHA CHECK JZ FCR160 ;SET ALPHA CHECK IF ALPHA  LXI H,ZNUMCK ;SET H,L FOR NUMERIC CHECK SUI NUMBER+1 ;NUMERIC FIELD?  JM FCR160 ;YES - SET CHECK ROUTINE ADD LXI H,ZRETRN ;NO - SET H,L FOR ALPHANUM JZ FCR160 ;SET ROUTINE ADDR IF = ZERO  LXI H,SFKCHK ;ELSE, SET FOR SOFT KEYSFCR160 EQU $  SHLD CHKRTN ;SET CHECK ROUTINE ADDRESS POP H ;RECALL TERMINATOR CHARACTER JMP FCR010 ;CONTINUE SEARCHING  ;********************************************** ; NON-DISPLAYING TERMINATOR FOUND - DETERMINE * ; AND PERFORM ITS FUNCTION * ;********************************************** FCR200 EQU $  LDA TRMFCT ;GET THE FUNCTION FLAG ORA A ;WHAT FUNCTION?  JM FCR250 ;-1 - TERMINATE TRANSFER JNZ FCR010 ;+1 - IGNORE IT  CALL CHRDL2 ;0 - DELETE IT  JMP FCR010 ;CONTINUE CHARACTER SEARCH;  ; TERMINATE TRANSFER ; FCR250 EQU $  LDAX D ;PUT CHARACTER BACK IN A-REGFCR260 EQU $  CMP A ;SET Z-FLAG TRUE RET ;RETURN CHARACTER NOT FOUND  ;***********************************************; FNDLST - LOCATE LAST CHARACTER TYPE AHEAD OF *; CURRENT CHARACTER *;***********************************************; ; ENTRY: A = NUMBER OF COLUMNS TO SEARCH; D,E = ADDRESS OF CHARACTER BEFORE; BEFORE FIRST CHARACTER TO LOOK AT; H,L = CHARACTERS TO BE FOUND ; ; EXIT : P - CHARACTER FOUND; B = NUMBER OF CHARACTERS FROM CURRENT ; CHARACTER ; M - CHARACTER NOT FOUND ; B DESTROYED ; A,C,D,E DESTROYED; FNDLS0 EQU $  INR A ;ADJUST SEARCH COUNT LXI H,EOL*256+EOL ;SET TO LOOK FOR "EOL" ; FNDLST EQU $  MOV C,A ;PUT SEARCH COUNT IN C-REG MVI B,377Q ;PRESET B FOR FAIL RETURN  DCR A ;ANY COLUMNS TO SEARCH?  RM ;NO - RETURN NONE FOUND FLS010 EQU $  CALL NXTCHR ;GET THE NEXT CHARACTER  CMP H ;DOES IT MATCH DESIRED CHARS JZ FLS020 ;YES - SAVE LOCATION OF CHAR CMP L  JNZ FLS030 ;NO - GO TO NEXT CHARACTERFLS020 EQU $  MOV B,C ;SAVE LOCATION OF CHAR IN B FLS030 EQU $  ORA A ;IS CURRENT CHAR ASCII?  JM FLS050 ;NO - CHECK FOR TERMINATION  DCR C ;SEARCH COMPLETE? FLS035 EQU $  JNZ FLS010 ;NO - CHECK NEXT CHARACTERFLS040 EQU $  XRA A ;CLEAR A-REGISTER  ORA B ;SET FLAGS FOR RETURN  RET ;RETURN ;********************************************** ; NON-ASCII CHARACTER - CHECK FOR TERMINATION * ;********************************************** FLS050 EQU $  CPI EOL ;IS IT AN EOL? JZ FLS040 ;YES - EXIT  CPI EOP ;IS IT AN EOP? JMP FLS035 ;GO CHECK RESULT ;***********************************; HTAB - SKIP TO NEXT TAB POSITION *;***********************************HTAB EQU $  CALL CHKFM0 ;FORMAT/SOFT KEY DEFINE MODE JNZ HTB200 ;YES - LOCATE NEXT FIELD MVI L,CURCOL-BASE ;NO - LOCATE NEXT TAB MOV B,M ;SET POSITION  INR B ;START FROM NEXT COLUMN  MVI A,MAXCOL ;COMPUTE NUMBER OF COLUMNS SUB B ;TO END OF LINE  JM CRLF ;GO TO START OF NEXT LINE IF; ALREADY AT END OF LINE ORI 7 ;MOVE TO COL CORRESP. TO; START OF BYTE  MOV C,A ;SAVE IN C MOV A,B CALL FNDTB1 ;GET TABLE ENTRY FOR COLUMN  DCR A ;MASK OFF BITS FOR CMA ;PREVIOUS COLUMNS  ANA M;*******************@@************* ; CHECK NEXT COLUMN FOR SET TAB * ;******************************** HTB100 EQU $ MVI B,8 ;GET BIT COUNT JZ HTB140 ;NO BITS SET IN BYTEHTB120 EQU $  RRC ;TAB BIT SET?  JNC HTB130 ;NO - TRY NEXT COLUMN ;*****************************; TAB IS SET - UPDATE CURCOL *;*****************************HTB160 EQU $  MOV E,A ;SAVE A-REGISTER MVI A,MAXCOL+7 ;COMPUTE COLUMN OF LOCATIO SUB C ;OF TAB  SUB B SHLD LNKSAV ;SAVE CURRENT TABLE ADDRESS  LHLD RHTMGN ;GET RIGHT AND LEFT MARGINS  CMP L ;TAB BEYOND RIGHT MARGIN?  JP CRLF ;YES - DO CR, LF INR A ;NO - ADJUST TO PROPER VALUE CMP H ;TAB BEYOND LEFT MARGIN? JNC CURPO4 ;YES - LOCATE TAB LOCATION MOV A,E ;NO - RESTORE A-REGISTER LHLD LNKSAV ;RECALL TAB TABLE ADDRESS ; LOOK FOR ANOTHER TAB ;************************************ ; TAB NOT FOUND - CHECK NEXT COLUMN * ;************************************ HTB130 EQU $ ;NO - TRY NEXT COLUMN  DCR B ;ALL BITS EXAMINED?  JNZ HTB120 ;NO - LOOK TO NEXT BIT;**************************** ; BYTE EXHAUSTED * ; MOVE TO NEXT TABTBL ENTRY * ;**************************** HTB140 EQU $ MOV A,C ;GET COLUMN COUNT  SUI 8 ;DECREMENT JM CRLF ;DO CR,LF IF REACHED END MOV C,A INX H ;GET NEXT BYTE FROM TABLE  MOV A,M ORA A ;SET FLAGS JMP HTB100   ;****************** ; FORMAT MODE TAB * ;****************** HTB200 EQU $ CALL FLDSR ;SEARCH FOR NEXT FIELD RNZ ;RETURN IF FOUND JMP CURPH1 ;HOME TO FIRST UNPROT. FIELD ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; ICHON,ICHOFF - INSERT CHARACTER ON/OFF ; ICHON EQU $  MVI B,0 ;SET FOR NO BLINK ICH010 EQU $  MVI A,INSCHR ;TURN ON INSERT CHARACTER  JMP ZSTMD1 ;LED AND EXIT ; ICHOFF EQU $  MVI A,377Q-INSWRP  CALL CLCMFL ;CLEAR WRAP AROUND FLAG  MVI A,INSCHR ;TURN OFF INSERT CHARACTER JMP ZCLMD1 ;*************************************; IWRPON - INSERT WITH WRAPAROUND ON *;*************************************IWRPON EQU $  MVI A,INSWRP  CALL STCMFL ;SET WRAP AROUND FLAG  MVI B,377Q ;SET TO BLINK LED  JMP ICH010 ;SET INSERT CHARACTER LED ON ;******************************************** ; BCKSPC - BACKSPACE ONE CHARACTER POSITION * ;******************************************** BCKSPC EQU $  MVI L,CURCOL-BASE  DCR M ;DECREMENT CURRENT COLUMN  RP ;RETURN IF NOT AT COLUMN ZER INR M ;ELSE, RESTORE TO ZERO AND RET ;RETURN  ;************************** ; R O M B R E A K 4 * ;**************************  ORG ZBRK3+4000Q ZBRK4 EQU $  DB VERSN ;ROM PRESENT FLAGS DB ZBRK4/256  ;***********************************; CURADV - CURSOR ADVANCE ROUTINE *; ADVANCES CURSOR TO NEXT POSITION *; ON DISPLAY *;***********************************CURAD2 EQU $ ;ADVANCE CURSOR TWICE  CALL CURADV ;DO FIRST CURSOR ADVANCE; THEN FALL IN TO DO NEXT CURADV EQU $ CALL CRADV ;ADVANCE CURSOR  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RZ ;NO - RETURN;*****************************************; FORMAT MODE *; CHECK FOR ADVANCE INTO PROTECTED FIELD *;***************************************** LDA CURCOL ;GET NEW CURRENT COLUMN  ORA A ;DID CURSOR WRAP AROUND? JNZ CRA040 ;NO - CHECK FOR PROTECTED FL;********************************** ; CURSOR WRAPPED AROUND * ; SEE IF NEW LINE IS CONTINUATION * ; OF UNPROTECTED FIELD * ;**********************************  LHLD LSTLIN  XCHG ;GET CURRENT LINE ADDR IN D, LDA FMTCTL ;RESET "LSTFMT" TO LAST  STA LSTFMT ;FORMAT CONTROL IN LINE  CALL FLDSRB ;CONTINUATION FIELD? JNZ CRA060 ;NO - TAB TO NEXT FIELD  ;******************** ; RESET CURADV FLAG * ;******************** CRADV1 EQU $ XRA A  STA CRAFLG  RET ;*****************************; CURSOR DID NOT WRAP AROUND *; SEE IF CURSOR ENTERED *; PROTECTED FIELD *;*****************************CRA040 EQU $  LHLD CURADR ;GET THE CURRENT CHAR ADDR XCHG ;PUT IT INTO H,L DCX D ;SET POINTER TO NEXT CHAR  LHLD CHKRTN ;SAVE THE CURRENT CHECK  PUSH H ;ROUTINE ADDRESS CALL FNDCH0 ;NEXT CHARACTER PROTECTED? POP H ;(RESTORE CHECK ROUTINE  SHLD CHKRTN ;ROUTINE ADDRESS) RZ ;NO - RETURNCRA060 EQU $ CALL CRADV1 ;RESET CURADV FLAG CALL DCXB2D ;DATA COMM OR I/O BUFF CHAR? LXI H,ENDPR*256+XMONLY ;(SET DEFAULT) JNZ CRA070 ;YES - DON'T SOUND BELL  CALL ZBELL ;NO - SOUND BELL MOV L,H ;LOOK FOR "ENDPR" ONLYCRA070 EQU $  CALL FNDCH ;NEXT CHARACTER UNPROTECTED  CZ FLDSR ;OR ANOTHER FIELD EXIST? RNZ ;YES - RETURN  CALL DCXB2D ;DATA FROM DATA COMM OR CTU? RZ ;NO, FROM KEYBOARD - RETURN  JMP CURPH1 ;YES - HOME THE CURSOR  ;************************* ; CRADV - ADVANCE CURSOR * ;************************* CRADV EQU $ LDA RHTMGN ;GET RIGHT MARGIN SETTING  LXI H,CURCOL CRA010 EQU $  CMP M ;CURSOR AT RIGHT MARGIN? JZ CRA100 ;YES - CHECK FOR WRAP AROUND MVI A,MAXCOL ;(SET FOR LAST COL CHECK)  JM CRA010 ;AFTER MARGIN - CHECK EOL  INR M ;ADVANCE CURSOR  CMP M ;MOVED INTO RIGHT MARGIN OR  CNZ CKPROT ;INTO PROTECTED FIELD? RZ ;YES - DON'T SET CURADV FLAG LDA MDFLG1 ;GET TERMINAL MODE FLAGS ANI INSCHR ;IN CHARACTER INSERT MODE? RNZ ;YES - DON'T SET FLAG  MVI L,CRAFLG-BASE ;NO - SET CURADV FLAG MVI M,1 RET;***********************************; CURSOR IS IN LAST COLUMN OF LINE *;***********************************CRA100 EQU $  LDA LSTFMT ;SAVE LAST FORMAT CONTROL  STA FMTCTL ;IN CURRENT LINE CALL CHKFMS ;FORMAT/SOFT KEY DEFINE OR CZ CKDSPF ;DISPLAY FUNCTIONS ENABLED JNZ CRLF ;YES - DON'T CLEAR WRAP FLAG LDA KBJMPR ;NO - GET KEYBOARD JUMPERS 1 ANI LINWRP ;WRAP AROUND ENABLED?  RNZ ;NO - RETURN LDA DFLGS ;YES - GET DATA TRANSFER FLG ANI XBF2DS ;I/O BUFFER TO DISPLAY?  MVI A,377Q-WRPFLG ;(SET CLEAR MASK) CNZ CLRMF2 ;YES - CLEAR LINE WRAP FLAG ;****************************************** ; CURSOR SHOULD BE WRAPPED INTO NEXT LINE * ; GENERATE CR,LF * ;****************************************** CRLF EQU $ CALL CRRET ;CARRIAGE RETURN JMP LNFEED ;LINE FEED ;*******************************; CURPR - CURSOR POINTER RIGHT *;*******************************CURPR EQU $ MVI A,1 ;GET INCREMENT RIGHT JMP CURPL1 ;****************************** ; CURPL - CURSOR POINTER LEFT * ;****************************** CURPL EQU $ MVI A,-1 ;GET INCREMENT LEFT CURPL1 EQU $ MVI L,CURCOL ;GET CURSOR COLUMN ADD M ;ADD INCREMENT MOV M,A ;STORE NEW COLUMN ADDRESS  JM CURPL2 ;WRAPAROUND TO LEFT  SUI MAXCOL+1 ;WRAPAROUND TO RIGHT?  RNZ ;NO - RETURN MOV M,A ;YES - SET TO COLUMN ZERO ;****************************** ; CURPD - CURSOR POINTER DOWN * ;****************************** CURPD EQU $ MVI A,1 JMP CURPU1 ;********************************** ; CURSOR MOVED OFF LEFT OF SCREEN * ; WRAPAROUND TO RIGHT AND UP * ;********************************** CURPL2 EQU $ MVI M,MAXCOL ;PUT CURSOR AT LAST COLUMN;**************************** ; CURPU - CURSOR POINTER UP * ;**************************** CURPU EQU $ MVI A,MAXROW CURPU1 EQU $ MVI L,CURROW ;GET CURSOR ROW  ADD M ;ADD DISPLACEMENT  MOV M,A ;STORE NEW ROW ADDRESS SUI MAXROW+1 ;ROW LIMIT EXCEEDED? RM ;NO - RETURN MOV M,A ;YES - STORE ADJUSTED ROW  RET ;RETURN  ;**************************** ; DFSFKY - DEFINE SOFT KEYS * ;**************************** DFSFKY EQU $  MVI L,SCRNRW ;CLEAR SOFT KEY PARAMETERS MVI E,3 ;TO ZERO CALL CLRAL1  LXI H,DFSTAB ;SET RANGE TABLE FOR SOFT KE JMP ESCAPA ;DEFINITION ESCAPE SEQUENC; ; A - DEFINE ATTRIBUTE CODE; ; 0 = NORMAL  ; 1 = LOCAL ONLY ; 2 = TRANSMIT ONLY ; DFS100 EQU $  MVI C,2 ;SET MAXIMUM VALUE AND LXI D,PARM2 ;PARAMETER TO BE SET JMP DFS220 ;SET PARAMETER AND EXIT ; ; K - KEY NUMBER TO BE DEFINED ; DFS110 EQU $  MVI C,NMFCTK-1 ;SET MAXIMUM VALUE AND LXI D,PARM3 ;PARAMETER TO BE SET JMP DFS200 ;SET PARAMETER AND EXIT ;  ; L - SET LENGTH OF INPUT ; DFS120 EQU $  MVI C,MAXCOL ;SET MAXIMUM VALUE AND LXI D,PARM1 ; FALL INTO EVALUATION ROUTINE ; ; EVALUATE AND SET PARAMETER ; ; D = MAXIMUM ALLOWABLE VALUE; E = LSB OF PARAMETER TO BE SET (MSB = BASEH) ; DFS200 EQU $ ;ENTRY FOR MIN VALUE = 1 LHLD IODATA ;GET INPUT PARAMETER DCX H ;ADJUST PARAMETER TO ONE LES MOV A,H ;CHECK FOR ZERO PARAMETER  CMP L ;DOES MSB=LSB? JNZ DFS210 ;NO - STORE ADJUST VALUE INR A ;IS ADJUST VALUE -1  JZ DFS220 ;YES - DON'T STORE NEW VALUEDFS210 EQU $ ;NO - STORE ADJUSTED VALUE SHLD IODATA DFS220 EQU $  CALL CHKLI0 ;EVALUATE AND SET PARAMETERS LDA CHAR ;RECALL INPUT CHARACTER  ANI 40Q ;IS IT UPPER CASE? JNZ ESCAPB ;NO - CONTINUE ESCAPE SEQ ; YES - SET NEW DEFINITION ;*************************************************; UPPER CASE CHARACTER INPUT - EVALUATE SEQUENCE *;************************************************* CALL CHKSFK ;SOFT KEY DEFINE MODE? CZ SWAP ;NO - SET TO SOFT KEY DISPLA LDA PARM3 ;COMPUTE DESIRED KEY DATA RO ADD A  INR A ;= 2*(KEY NUMBER) + 1  STA CURROW  LXI H,SFTKYS ;LOCATE THE START OF THE CALL MLKSC1 ;DATA ROW  MVI A,MAXCOL+1  CALL FNDLS0 ;LOCATE THE END OF THE DATA  MVI A,MAXCOL+2 ;ROW + 1 SUB B  STA PARM3 ;SAVE END COLUMN NUMBER  LDA PARM1 ;TRY TO EXTEND LINE TO STA CURCOL ;END OF NEW DATA LINE  CALL DSPASC ;TRY TO ALLOCATE LINE NEEDED ORA A ;COLUMN POSITION ALLOCATED?  JZ DFS250 ;NO - DON'T SET NEW VALUE  LHLD CURADR ;YES - GET ADDRESS OF  CALL NXTCH0 ;END OF NEW DATA LINE  LDA CURCOL ;GET NUMBER OF DATA CHARS  CPI MAXCOL ;FULL LINE USED? CNZ CLERLA ;NO - CLEAR EXCESS CHARACTER CALL CURPRT ;SET CURRENT COLUMN TO ZERO  LXI H,CURROW ;SET FOR ATTRIBUTE ROW DCR M  LDA PARM2 ;GET ATTRIBUTE PARAMETER DCR A ;WHICH ATTRIBUTE TO SET? MVI A,N ;(N = NORMAL)  JM DFS230 ;0 - SET AS NORMAL KEY MVI A,L ;(L = LOCAL ONLY)  JZ DFS230 ;1 - SET FOR LOCAL ONLY  MVI A,T ;2 - SET FOR TRANSMIT ONLYDFS230 EQU $  CALL DSPTST ;STORE ATTRIBUTE LETTER  CALL SWAP0 ;RESTORE ACTIVE DISPLAY  LXI H,DFSTB2 ;SET RANGE TABLE FOR SOFT  JMP ESCAPA ;KEY DATA ACCUMULATION ;************************************************ ; NOT ENOUGH BLOCKS AVAILABLE FOR SOFT KEY DATA * ; RESTORE OLD STATE AND IGNORE DEFINITION * ;************************************************ DFS250 EQU $  LDA PARM3 ;RECALL END OF DATA LINE STA CURCOL  CALL CLEARL ;CLEAR ANY ADDED CHARACTERS ;********************************************** ; SWAP - SWAP DISPLAY PARAMETERS BETWEEN SOFT * ; KEY AND NORMAL DISPLAY * ;********************************************** ;  ; ENTRY: DON'T CARE ; ; EXIT : DISPLAY PARAMTERS EXCHANGED; ALL REGISTERS DESTROYED; SWAP0 EQU $  LDA CMFLGS ;GET COMMON FLAGS  ANI DEFSKY ;DEFINE SOFT KEY MODE? RNZ ;NO - DON'T DO SWAP ; SWAP EQU $  LXI H,DSPTYP ;SET DISPLAY TYPE FLAG MOV A,M ;TO VALUE FOR DISPLAY TO CMA ;MADE ACTIVE MOV M,A SWAP1 EQU $  MVI C,NUMSWP ;SET SWAP COUNT  LXI D,SWPSTR ;SET ADDRESS OF LOCATIONS  LXI H,RHTMGN ;TO BE EXCHANGED; ; EXCHANGE DISPLAY PARAMETERS; SWP010 EQU $  MOV B,M ;GET CURRENT SETTING LDAX D ;GET STORED SETTING  XCHG ;EXCHANGE ADDRESSES  MOV M,B ;STORE NEW SAVE VALUE  STAX D ;STORE NEW CURRENT VALUE XCHG ;RESTORE ADDRESSES INX D ;INCREMENT TO NEXT VALUE INX H  DCR C ;ALL VALUES EXCHANGED? JNZ SWP010 ;NO - MOVE NEXT VALUE  RET ;YES - RETURN   ;******************** ; SET SOFT KEY DATA * ;******************** DFS300 EQU $  CALL CHKSFK ;SOFT KEY ALREADY ENABLED? CZ SWAP ;NO - SET SOFT KEY DISPLAY O LXI H,MDFLG1 ;GET SOFT MODE FLAGS MOV A,M  PUSH PSW ;SAVE SOFT MODE FLAGS  MVI M,0 ;FORCE INSERT CHARACTER OFF  CALL FDESC1 ;ADD INPUT TO DEFINITION POP PSW ;RECALL SOFT MODE FLAGS  STA MDFLG1 ;RESTORE ORIGINAL VALUES CALL SWAP0 ;RESTORE ACTIVE DISPLAY  CALL GETDC1 ;SET DISPLAY CURSOR  LXI H,NEWCOL  DCR M ;ALL CHARACTERS DONE?  JP ESCAP1 ;NO - CONTINUE ESC SEQUENCE  LXI H,DFSTB3 ;YES - SET TO WAIT FOR ANY JMP ESCAPA ;CHAR EXCEPT CR, LF, OR DC;******************************************** ; WAIT FOR CHARACTER TO RESTORE NORMAL MODE * ;******************************************** DFS350 EQU $ ;LINE FEED CODE  CALL DCXB2D ;DATA FROM KEYBOARD? JZ LNFEED ;YES - DO LINE FEED  RET ;NO - RETURN TO RE-ENABLE AL; CODES BY CALL TO "ESCEND" ; IN "CHINT" CLEAN-UP ; DFS360 EQU $ ;RETURN CODE CALL DC@@XB2D ;DATA FROM KEYBOARD  JNZ ESCAP1 ;NO - CONTINUE WAITING; YES - DO RETURN OPERATION ;************************************ ; CRRET - SET CURSOR TO LEFT MARGIN * ;************************************ ;  ; ENTRY: DON'T CARE ; ; EXIT : A,CURCOL = LEFT MARGIN SETTING ; IF SPOW NOT DISABLED, SPOW SET ; CRRET EQU $  LDA KBJMPR ;GET STRAP SETTINGS  ANI SPLDIS ;SPOW DISABLED?  JZ CURPRT ;YES - RETURN CURSOR ONLY  LXI H,SPOWL ;NO - SET SPOW LATCH MVI M,SPOWON CURPRT EQU $  LDA LFTMGN ;SET CURSOR TO LEFT MARGINCRRET1 EQU $  STA CURCOL ;UPDATE CURRENT COLUMN NUMBE STA IOCRCL ;AND SET DISPLAY CURSOR  RET ;RETURN   ;********************** ; DISPLAY ENHANCEMENT * ;********************** DISPEN EQU $  CALL CHKSFK ;DEFINE SOFT KEY MODE? RNZ ;YES - NO DISPLAY ENHANCEMEN LXI H,DENTAB ;SET FOR DISPLAY ENHANCEMENT JMP ESCAP0 ;****************************************** ; DISPLC - ENTER DISPLAY ENHANCEMENT CHAR * ;****************************************** DISPLC EQU $ LDA DCHAR ;GET DISPLAY CHARACTER ANI 17Q ;EXTRACT ENHANCEMENT BITS DISPC0 EQU $  MVI B,60Q ;SET MASK TO SAVE ALT CHAR;***********************************************; DISPC1 - ENTER ENHANCEMENT OR FLAG CHARACTER *;***********************************************; ; ENTRY: A = CHARACTER TO BE STORED ; B = MASK TO SAVE UNCHANGED PART (USED; ONLY FOR ENHANCEMENT CHARACTERS) ;  ; EXIT : SEE "DISPLA" ; DISPC1 EQU $  ORI 200Q ;ADD BIT FOR REFRESH LOGICDISPC2 EQU $  STA DCHAR ;STORE NEW ENHANCEMENT CODE  MOV A,B ;STORE MASK FOR ENHANCEMENT  STA CDSPEN ;BITS NOT TO BE ALTERED ; FALL INTO DISPLAY ROUTINE  ;************************************ ; DISPLA - ADD CHARACTER TO DISPLAY * ;************************************ ; ; ENTRY: CURCOL,CURROW = SCREEN POSITION WHERE; CHARACTER IS TO BE INSERTED; DCHAR = CHARACTER TO BE DISPLAYED; CDSPEN = MASK TO MASK OUT COMMON BITS; IF DCHAR IS A DISPLAY CONTROL BYTE ; ; EXIT : A = 0, NO PLACE FOR CHARACTER; A # 0, CHARACTER PROCESSED ; B = CHARACTER REPLACED IF ADDITION ; DONE BY INSERT ; D,E = ADDRESS OF CHAR IN DISPLAY ; DISPLA EQU $ LDA DCHAR ;GET CHAR TO BE STORED  ORA A ;IS THIS ASCII CHAR? JP DIS060 ;YES - CONTINUE ;************************************ ; CONTROL CODE TO BE ENTERED INTO * ; DATA STREAM - FIND CHAR PRECEDING * ; THIS COLUMN * ;************************************  LDA CURCOL ;GET CURRENT COLUMN NUMBER DCR A ;SET FOR PREVIOUS COLUMN CALL RCADR0 ;DOES LINE EXIST?  JM MLOCK1 ;NO - SOUND BELL AND EXIT ; WITH A-REGISTER = 0  JNZ DIS100 ;COL BEYOND EOL - EXTEND LIN ;************************ ; PREVIOUS COLUMN FOUND * ;************************  MOV C,A ;SAVE COLUMN IN C  INR C ;SET C TO NEXT COLUMN NUMBER CALL CKPROT ;PREVIOUS CHAR PROTECTED?  JNZ DIS030 ;NO - CONTINUEDIS020 EQU $  DCX D ;YES - SET PTR TO NEXT CHAR  LXI H,ENDPR*256+XMONLY CALL FNDCH ;IS NEXT CHARACTER PROTECTED JZ DIS092 ;YES - LOOK FOR NEXT FIELD LXI H,CURCOL ;YES - RECALL COLUMN VALUE MOV C,M  ;*********************************; SEARCH FOR PLACE FOR CHARACTER *;*********************************DIS030 EQU $ CALL NXTCHR ;GET NEXT CHAR MOV B,A ;SAVE EXISTING CHAR IN B-REG LXI H,DCHAR  CPI STPFLG ;NON-DISPLAYING TERMINATOR?  JZ DIS035 ;YES - DELETE IT CPI EOL ;EXISTING CHARACTER AN EOL?  MOV A,M ;(GET CHAR TO BE DISPLAYED JZ DIS050 ;YES - ADD CHARACTER TO LINE CPI STPFLG ;NON-DISPLAYING TERMINATOR?  JZ CRI104 ;YES - INSERT TERMINATOR MOV A,B ;NO - RECALL EXISTING CHAR ADD A ;EXISTING CHARACTER ASCII? MOV A,M ;(GET CHAR TO BE DISPLAYED JNC DIS050 ;YES - INSERT NEW CHARACTER  JM DIS040 ;FLAG CHAR - ADD FLAG TO DIS ADD A ;NEW CHAR DISPLAY CONTROL? JM DIS030 ;NO - GO TO NEXT CHARACTER;***********************************; MERGE NEW DISPLAY ENHANCEMENT *; WITH CODE ALREADY IN THIS COLUMN *;*********************************** LDA CDSPEN ;GET ENHANCEMENT MASK  ANA B ;EXTRACT BITS TO BE SAVED  ORA M ;COMBINE WITH NEW ENHANCEMEN JMP DIS044 ;STORE THE NEW DISPLAY CODE ;********************************************** ; NON-DISPLAYING TERMINATOR FOUND - DELETE IT * ;********************************************** DIS035 EQU $  CMP M ;IS NEW CHAR TERMINATOR ALSO RZ ;YES - RETURN  CALL CHRDL2 ;NO - DELETE THE CHARACTER JMP DIS030 ;CONTINUE SCAN  ;****************** ; FLAG CHAR FOUND * ;****************** DIS040 EQU $ CMP B ;IS THIS SAME FLAG CHAR? RZ ;YES - RETURN (A # 0)  ADD A ;NEW CHARACTER DISPLAY CNTL? RAR ;(RESTORE CHARACTER) JP DIS045 ;YES - CHECK PROTECTED FIELD CPI ALPHA ;IS NEW CHAR TYPE DEFINITION MOV A,B ;(RECALL OLD FLAG CHAR)  JM DIS042 ;NO - ADD FIELD DEFINITION CPI ALPHA ;IS OLD CHAR TYPE DEFINITION JP DIS043 ;YES - REPLACE THE CHARACTER JMP DIS030 ;NO - GO TO NEXT CHARACTER;***********************************************; FIELD DEFINITION CHARACTER TO BE ADDED - PUT *; AHEAD OF TYPE DEFINITION OR AFTER "STPR" *;***********************************************DIS042 EQU $  CPI ALPHA ;IS OLD CHAR TYPE DEFINITION JP CRI104 ;YES - INSERT FIELD DEF  MVI A,STPR ;NO - STORE NEW FIELD DEF  CMP B ;OLD CHAR = START PROTECT? JZ DIS030 ;YES - LOOK TO NEXT CHAR CMP M ;IS NEW CHAR A STPR? JZ CRI104 ;YES - INSERT BEFORE UNPROTC;*************************************; REPLACE EXISTING DISPLAY CHARACTER *;*************************************DIS043 EQU $  LDAX D ;PUT EXISTING CHARACTER INTO MOV B,A ;B-REG FOR SOFT KEY CHECK  LDA DCHAR ;GET CHAR TO BE DISPLAYED  LXI H,SPOWL ;CHECK AGAINST SPOW LATCH  CMP M ;INPUT = SPACE AND SPOW SET? RZ ;YES - RETURN (A # 0) DIS044 EQU $  STAX D ;STORE THE NEW CHARACTER INR A ;FORCE A # 0 RET ;RETURN  ;****************************** ; FLAG CHAR FOUND AND * ; DISPLAY CONTROL TO BE ADDED * ;****************************** DIS045 EQU $  MOV A,B ;RECALL EXISTING CHARACTER CPI STPR ;BEGINNING A PROTECTED FIELD JNZ DIS030 ;NO - MOVE TO NEXT CHAR  CALL CHKFMS ;FORMAT MODE?  JZ DIS030 ;NO - ADD CHAR TO DISPLAY  JMP DIS020 ;YES - LOOK FOR NEXT FIELD;*****************************************; ASCII OR EOL FOUND *; MERGE NEW DISPLAY CONTROL IF NECESSARY *;*****************************************DIS050 EQU $  ADD A ;NEW CHAR DISPLAY CONTROL? JM DIS054 ;NO - ADD CHAR TO DISPLAY  LDA CDSPEN ;YES - GET MASK  MVI L,LSTDCD-BASE ;GET LAST ENHANCEMENT ANA M ;EXTRACT BITS TO BE SAVED  MVI L,DCHAR-BASE  ORA M ;COMBINE WITH NEW ENHANCEMEN MOV M,A ;STORE DIS054 EQU $ MOV A,B ;WAS CHAR ASCII? ORA A JP CRI104 ;YES - DO INSERT MVI C,0 ;NO - ADD SINGLE CHAR  JMP DIS110  ;*****************************************; ENTER ASCII CHARACTER INTO DATA STREAM *;*****************************************DSPASC EQU $ DIS060 EQU $ CALL RCADDR ;GET MEMORY ADDRESS  JZ DIS080 ;CHAR FOUND BY RCADDR DISPL0 EQU $ JM DIS070 ;RETURN IF LINE NOT BUILT  DCR C JNZ DIS100 ;MORE THAN ONE CHAR NEEDED;******************************** ; SINGLE CHARACTER REQUIRED * ; CHECK FOR LAST COLUMN OF LINE * ;********************************  CPI MAXCOL ;COMPARE WITH MAX COLUMN JNZ DIS110 ;NOT MAXIMUM COLUMN  JMP DIS090 ;******************************** ; LINE NOT BUILT * ; PERFORM HOMEUP IF FORMAT MODE * ;******************************** DIS070 EQU $  CALL CHKFMS ;FORMAT MODE?  RZ ;NO - RETURN (A = 0) CALL ZBELL ;YES - SOUND BELL  JMP DIS093 ;HOME UP AND TRY AGAIN  ;************************ ; CHARACTER REPLACEMENT * ;************************ DIS080 EQU $ MOV C,A ;SAVE COLUMN IN C  LDA MDFLG1 ;GET TERMINAL MODE FLAGS ANI INSCHR ;IN CHARACTER INSERT MODE? JZ DIS090 ;NO - ADD CHARACTER TO DISPL LDA EOLMV ;YES - GET EOL SHIFTED FLAG  ORA A ;HAS LINE BEEN EXTENDED? JZ CRI100 ;NO - PERFORM INSERT CHAR DIS090 EQU $  CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JNZ DIS043 ;NO - STORE THE CHARACTER DIS092 EQU $  CALL DCXB2D ;DATA COMM OR I/O BUFF CHAR? CZ ZBELL ;NO - SOUND THE BELL LDA DCHAR ;GET CHAR TO BE DISPLAYED  ORA A ;IS IT A CONTROL CHARACTER?  RM ;YES - DON'T TAB (RETURN A#0 CALL FLDSR ;NO - TAB TO NEXT FIELD  JNZ DISPLA ;JUMP IF FIELD FOUNDDIS093 EQU $  CALL CURPH1 ;ANY FIELDS IN DISPLAY?  JNZ DISPLA ;YES - ADD CHARACTER TO FIEL RET ;NO - RETURN (A # 0) ;*************************************************; LINE MUST BE EXTENDED TO ACCOMODATE CHARACTER *; - EXTEND TO ONE COLUMN BEFORE DESIRED COLUMN *;*************************************************; ; ENTRY: C = NUMBER OF CHARACTERS REQUIRED; DIS100 EQU $  DCR C ;MORE THAN ONE CHAR TO ADD?  JNZ DIS110 ;NO - ADD MULTIPLE CHARACTER CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JZ DIS092 ;YES - TAB TO NEXT FIELD LXI H,NCHAR ;NO - SET "NCHAR" TO STORE MVI M,1 ;BLANK OVER EOL (I.E.,; MAKE DISPLAY ROUTINE; THINK MORE THAN ONE ; CHARACTER BEING ADDED) CALL DISPL2 ;EXTEND LINE BY ONE CHARACTE JMP DIS114 ;CHECK MEMORY LOCKED; DIS110 EQU $  CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JZ DIS092 ;YES - TAB TO NEXT FIELD CALL DISPL1 ;NO - EXTEND LINE DIS114 EQU $  ORA A ;MEMORY LOCKED?  RZ ;YES - RETURN FAIL (A = 0) LDA NCHAR ;GET # OF CHARACTERS ADDED DCR A ;SINGLE CHARACTER ADDED? JP DISPLA ;NO - TRY TO STORE AGAIN RET ;YES - STORE DONE BY DISPLAY; (A # 0)  ; ; * * * * * * * * * * * * * * * * * * * * * * * ; ; DSPTST - DISPLAY TEST PATTERN; ; ENTRY: A = CHARACTER TO BE DISPLAYED; ; EXIT : A,B,C,D,E,L DESTROYED; DSPTST EQU $ STA DCHAR ;PUT CHAR IN DISPLAY BUFFER CALL SETDF0 ;SET DATA COMM INPUT FLAG TO; INHIBIT BELL ON FIELD SKIP; ; DSPCHR - DISPLAY CHARACTER IN DCHAR; DSPCHR EQU $  LXI H,CURADV ;SET NORMAL EXIT ROUTINEDSPCH0 EQU $  PUSH H ;SAVE NORMAL EXIT ROUTINE  CALL DSPASC ;ADD ASCII CHAR TO DISPLAY ORA A ;CHARACTER DISPLAYED?  JZ DCH100 ;NO - DON'T MOVE CURSOR ; FALL INTO DISPLAY ROUTINE   CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE RZ ;NO - DO NORMAL EXIT CALL DCXB2D ;DATA COMM OR I/O BUFF CHAR? RNZ ;NO - DO NORMAL EXIT LDA DCHAR ;GET CHARACTER DISPLAYED LHLD CHKRTN ;NO - GET CHECK ROUTINE ADDR RST RSTJMP ;IS IT A VALID CHARACTER?  RZ ;YES - DO NORMAL EXIT  POP PSW ;NO - POP OFF NORMAL EXIT AD; ; FIELD CHECK ERROR - LOCK UP UNTIL BACKSPACE HIT;  XRA A ;CLEAR OUT INPUT CHARACTER STA CHARIN ;TO KILL FUNCTION KEYSDCH010 EQU $  CALL ZBELL ;SOUND BELL DCH020 EQU $  CALL IOCTMN ;MONITOR THE TAPE DRIVES CALL ZGETKY ;ANY KEY HIT?  JNZ DCH020 ;NO - CONTINUE WAITING CPI CR ;IS IT THE RETURN KEY? JNZ DCH010 ;NO - SOUND BELL, TRY AGAIN  MVI A,STPRPT ;YES - STOP RETURN KEY JMP ZKBCTL ;FROM REPEATING AND EXIT;****************************************** ; CHARACTER NOT DISPLAYED - SOUND BELL IF * ; CHARACTER FROM KEYBOARD * ;****************************************** DCH100 EQU $  POP H ;POP OFF NORMAL EXIT ROUTINEDSPCH1 EQU $  CALL DCXB2D ;INPUT FROM KEYBOARD JZ ZBELL ;YES - SOUND BELL AND EXIT RET ;NO - RETURN ONLY  ;******************************************** ; EXPAND - EXPAND DISPLAY CONTROL TO ESCAPE * ; SEQUENCE * ;******************************************** ; ; ENTRY: A,C = DISPLAY CONTROL BYTE ;  ; EXIT : H = BASEH ; A,B,L DESTROYED ; EXPAND EQU $  CALL INITD1 ;INITIALIZE CHAR BUFFER PTRS ADD A ;IS CHAR DISPLAY CONTROL?  RAR ;(RESTORE CHARACTER) JM EXP100 ;NO - EXPAND FORMAT CONTROL  LXI H,ENHOUT ;YES - COMPARE TO PREVIOUS XRA M ;ANY CHANGES?  RZ ;NO - RETURN IMMEDIATELY ANI 17Q ;CHANGE IN ENHANCEMENT?  JZ EXP010 ;NO - CHECK NEW CHARACTER SE MVI B,AMPSND ;YES - OUTPUT ENHANCEMENT  CALL ECOUTB ;ESCAPE SEQUENCE:  MVI A,SMALLD ;-<&>-  CALL A2OUTB  MOV A,C ;COMPUTE ENHANCEMENT ANI 17Q ;PARAMETER (@-O) ORI 100Q ;ADJUST TO ASCII LETTER  CALL A2OUTB ;PUT IT INTO OUTPUT BUFFER MVI L,ENHOUT-BASE ;CHECK CHARACTER SET  ; ; CHECK FOR CHARACTER SET CHANGE ; EXP010 EQU $ MOV A,C ;RECALL CURRENT SETTING  XRA M ;COMPARE TO PREVIOUS VALUE ANI 60Q ;ANY CHANGE IN CHAR SET? MOV M,C ;(SAVE NEW SETTING)  RZ ;NO - RETURN MOV A,C ;YES - RECALL NEW SETTING  ANI 60Q ;RETURN TO BASE SET? JZ EXP030 ;YES - SEND SHIFT IN (SI)  MVI L,CALTST-BASE ;IS IT THE SAME CMP M ;ALTERNATE CHAR SET?  JZ EXP020 ;YES - SEND SHIFT OUT ONLY MOV M,A ;NO - SAVE NEW ALTERNATE; ; GENERATE ESCAPE SEQUENCE FOR ALTE@@RNATE ; CHARACTER SET SPECIFIER;  MVI B,ARPARN ;OUTPUT  CALL ECOUTB ; MOV A,C  ANI 60Q ;COMPUTE ALTERNATE CHARACTER RRC ;SET PARAMETER RRC RRC RRC ADI 100Q  CALL A2OUTB ;SEND IT; EXP020 EQU $ MVI A,SO ;SEND SHIFT OUT (SO) JMP A2OUTB ;AND RETURN ; EXP030 EQU $ MVI A,SI ;SEND SHIFT IN JMP A2OUTB ;AND RETURN  ; ; EXPAND ON FORMAT CONTROL ; EXP100 EQU $  CPI XMONLY ;TRANSMIT ONLY CONTROL?  MVI B,LFTBRC ;(SET FOR LEFT BRACE)  JZ ECOUTB ;YES - OUTPUT AND EXIT JP EXP110 ;TYPE DEF - OUTPUT NUMBER  CPI ENDPR ;END PROTECT?  MVI B,LFTBKT ;(SET FOR LEFT BRACKET - [ JZ ECOUTB ;YES - OUTPUT AND EXIT INR B ;NO - ALTER CHAR TO RIGHT INR B ;BRACKET AND OUTPUT IT JMP ECOUTB ; ; TYPE DEFINITION - OUTPUT NUMERIC TERMINATOR; EXP110 EQU $  CPI SFKYAT ;IS CODE VALID?  MVI B,ADEL ;(SET DEL CHAR FOR INVALID JP B2OUTB ;NO - RETURN DEL CHARACTER CPI FILL ;FILL CODE?  JZ B2OUTB ;YES - RETURN DEL CHARACTER  SUI ALPHA-6-ZERO ;COMPUTE ASCII DIGIT MOV B,A ;PUT CHARACTER INTO B-REG  JMP ECOUTB ;OUTPUT THE ESCAPE SEQUENCE  ;  ; GET DISPLAY DATA ; GDS010 EQU $  CALL CHKSFK ;SOFT KEY MODE?  JZ GDS050 ;NO - DO NORMAL PROCEDURE  LDA CURROW ;YES - GET CURSOR ROW  CPI SFTEND ;BEYOND SOFT KEY DATA? JP GDS160 ;YES - RETURN END OF DISPLAY RRC ;IN ATTRIBUTE ROW? JC GDS030 ;NO - OUTPUT DISPLAY DATA  MVI B,AMPSND ;YES - START ESCAPE SEQUENCE CALL INITD1 ;INIT OUTPUT BUFFER POINTERS CALL ECOUTB ;SEND -<&>  MVI A,SMALLF ;  CALL A2OUTB LDA CURROW  RRC ;  INR A  ORI ZERO CALL A2OUTB  MVI A,SMALLK ;  CALL A2OUTB  LHLD LSTLIN ;GET ADDRESS OF CURRENT  MOV A,L ;LINE  SUI ATBLOC ;COMPUTE LOCATION OF MOV L,A ;ATTRIBUTE CODE  MOV A,M ;GET ATTRIBUTE CODE  MVI B,ZERO ;COMPUTE ATTRIBUTE CODE: CPI N  JZ GDS020 ;0 = NORMAL  INR B ;1 = LOCAL ONLY  CPI L ;2 = TRANSMIT ONLY JZ GDS020  INR B GDS020 EQU $  CALL B2OUTB ;OUTPUT ATTRIBUTE CODE MVI A,SMALLA  CALL A2OUTB ;OUTPUT  MVI A,FRSOUT ;SET FLAG TO INDICATE FIRST  CALL SETMF2 ;SOFT KEY DATA OUT CALL FLDSR ;LOCATE THE DATA FIELD XCHG  SHLD GETADR ;SAVE FIRST CHAR ADDRESS; RESTART "GETDSP" TO OUTPUT; FIRST SOFT KEY CHAR  ; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; GETDSP - GET A CHARACTER FROM DISPLAY; ; ENTRY: CURADR = ADDR OF DISPLAY BYTE; CURCOL = COLUMN OF NEXT BYTE ; ; EXIT : NC - CHARACTER FOUND ; A = CHARACTER; GETADR,CURCOL UPDATED; C - NO CHARACTER ; M - END OF DISPLAY ; Z - END OF FIELD ; P,NZ - END OF LINE ; B-L DESTROYED; GETDSP EQU $  LXI H,B2DPTR ;GET EXPANSION BUFFER  MOV A,M ;POINTER DCX H ;SET ADDRESS TO END POINTER  CMP M ;BUFFER EMPTY? JZ GDS010 ;YES - GET BYTE FROM DISPLAY INR L ;NO - INCREMENT POINTER AND  INR A ;STORE IT  MOV M,A  MOV L,A ;SET BUFFER ADDRESS  MOV A,M ;GET THE DATA BYTE ORA A ;SET C = FALSE RET ;RETURN CHARACTER FOUND  ;  ; GET SOFT KEY DATA ; GDS030 EQU $  LXI H,MFLGS2 ;GET MODE FLAGS  MOV A,M ;MASK OUT FIRST OUTPUT FLAG  ANI 377Q-FRSOUT  CMP M ;FIRST DATA? JZ GDS050 ;NO - GET NEXT DATA  MOV M,A ;YES - UPDATE FLAG CALL INITD1 ;INITIALIZE CHAR BUFFER PTRS LHLD GETADR ;LOCATE END OF LINE  XCHG ;PUT START ADDRESS IN D,E  MVI A,MAXCOL ;SEARCH TO END OF LINE CALL FNDLS0 ;ANY "EOL" IN DATA LINE? MVI A,MAXCOL+1 ;(SET FOR NO EOL LENGTH=80 JM GDS040 ;NO - OUTPUT VALUE MAXCOL+1  SUB B ;YES - COMPUTE EOL LOCATIONGDS040 EQU $  PUSH PSW ;SAVE DATA LENGTH  LXI H,A2OUTB ;SET OUTPUT ROUTINE ADDRESS  CALL BN2DE1 ;CONVERT AND STORE IN BUFFER MVI A,L ;OUTPUT UPPER CASE L CALL A2OUTB  POP PSW ;RECALL DATA LENGTH  DCR A ;DOES DATA EXIST?  MVI A,ABLNK ;(SET TO ADD BLANK)  CM A2OUTB ;NO - ADD A BLANK TO OUTPUT  JMP GETDSP ;OUTPUT LENGTH PARAMETER ; ; GET NEXT BYTE FROM DISPLAY ; GDS045 EQU $ ;ENTRY TO SKIP TERMINATOR  MOV M,A ;UPDATE "DFLGS" TO CLEAR; SKIP TERMINATOR FLAGGDS050 EQU $  LHLD GETADR ;GET CURRENT ADDRESS XRA A  ORA L ;END OF DISPLAY? JZ GDS150 ;YES - TERMINATEGDS060 EQU $  MOV A,M  DCX H ;DECREMENT TO NEXT BYTE  SHLD GETADR ;UPDATE "GETADR" ORA A ;IS BYTE ASCII?  JP GDS100 ;YES - RETURN CHARACTER  CPI LNKLIM ;IS IT A LINK? JC GDS200 ;NO - PROCESS DISPLAY CONTRO MOV L,M ;YES - SET NEW ADDRESS MOV H,A  MOV A,L ;PUT LSB INTO A-REGISTER CMA ANI BLKSM ;IS IT AN END OF LINE LINK?  JZ GDS060 ;NO - CONTINUE THRU CHAIN  JMP GDS320 ;YES - CHECK TERMINATON  ; ; ASCII BYTE FOUND - RETURN CHARACTER FOUND; GDS100 EQU $  MOV B,A ;SAVE THE CHARACTER  LXI D,CURCOL  LDAX D ;INCREMENT CURSOR COLUMN INR A ;POSITION  STAX D  STA IOCRCL ;UPDATE DISPLAY CURSOR LDA BLKTRM ;GET BLOCK TERMINATOR CHAR CMP B ;IS CHAR = BLOCK TERMINATOR? MVI A,377Q-SKPTRM ;(SET CLEAR FLAG) JZ GDS110 ;YES - RETURN TERMINATION  CALL CLRDFL ;NO - CLEAR SKIP FLAG  MOV A,B ;RECALL DISPLAY CHARACTER  RET ;RETURN (NC FROM "CLRDFL");******************************************** ; BLOCK TERMINATOR - CHECK FOR END OF LINE, * ; RETURN END OF DISPLAY * ;******************************************** GDS110 EQU $  LXI H,DFLGS ;CLEAR SKIP TERMINATOR FLAG  ANA M  CMP M ;WAS SKIP FLAG SET?  JNZ GDS045 ;YES - IGNORE TERMINATOR LDAX D ;NO - TERMINATE TRANSMISSION CPI MAXCOL+1 ;WAS RS IN LAST COLUMN?  CZ CRLF ;YES - DO CR,LF ;  ; RETURN END OF DISPLAY ; GDS150 EQU $  CALL FLDSRX ;SET "LSTCOL" TO MAXCOL+1 TO; FORCE LINE RE-SCANGDS160 EQU $  XRA A ;SET A TO -1 DCR A  STC ;SET C-FLAG TRUE RET ;RETURN  ; ; NON-ASCII BYTE PROCESSING; GDS200 EQU $  CPI EOP ;END OF DISPLAY? JZ GDS150 ;YES - RETURN END OF DISPLAY CPI STPFLG ;NON-DISPLAYING TERMINATOR?  JZ GDS230 ;YES - RETURN END OF DISPLAY CPI EOL ;END OF LINE?  JZ GDS300 ;YES - RETURN END OF LINE  CPI FILL ;FILL BYTE?  JZ GDS060 ;YES - GET NEXT BYTE MOV C,A ;NO - SAVE THE BYTE  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JNZ GDS210 ;YES - LOOK FOR START PROTEC LDA IOFLG2 ;NO - GET I/O FLAGS 2  ANI XDS2BF ;DISPLAY TO I/O BUFFER?  MOV A,C ;(RECALL DATA BYTE)  RNZ ;YES - RETURN UNEXPANDED BYT CALL EXPAND ;NO - EXPAND DISPLAY CONTROL JMP GETDSP ;RETURN 1ST EXPANDED CHAR ; ; FORMAT MODE - IGNORE ALL DISPLAY CONTROL EXCEPT ; FOR START PROTECT ; GDS210 EQU $  MOV A,C ;RECALL THE DATA BYTE  CPI STPR ;IS IT START PROTECT?  JNZ GDS060 ;NO - IGNORE THE BYTE  XCHG ;YES - PUT GETADR INTO D,E LHLD CURROW ;SAVE ENDING ROW AND LDA TLINO ;COLUMN+1 FOR FIELD  ADD L  MOV L,A ;SAVE ABSOLUTE ROW NUMBER  SHLD ENDROW GDS220 EQU $  CALL GTMOD1 ;PAGE MODE/DISPLAY -> BUFFER JZ GDS225 ;NO - RETURN END OF FIELD  CALL FLDSR1 ;ANY MORE FIELDS?  JZ GDS150 ;NO - EXIT END OF DISPLAY  XCHG ;YES - STORE NEW GETADR  SHLD GETADR GDS225 EQU $  XRA A ;RETURN END OF FIELD STC ;(C = TRUE, A = 0) RET ;********************************************** ; NON-DISPLAYING TERMINATOR FOUND - CHECK FOR * ; AUTO CLEAR OPTION * ;********************************************** GDS230 EQU $  LDA KBJMP2 ;GET JUMPERS SET 2 ANI CLRTRM ;CLEAR TERMINATOR? LDA CURCOL ;(SET CURRENT COLUMN)  MOV C,A  LHLD GETADR ;(SET LOCATION OF  INX H ;TERMINATOR)  XCHG ;(PUT ADDRESS INTO D,E)  CNZ CHRDL2 ;YES - CLEAR THE BYTE  XCHG  DCX H ;SET LAST CHARACTER ADDRESS  JMP GDS150 ;RETURN END OF DISPLAY ; ; END OF LINE - PAD OUT LINE IF FORMAT MODE; GDS300 EQU $  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JZ GDS310 ;NO - ADVANCE TO NEXT LINE JM GDS310 ;SOFT KEY - SKIP TO NEXT LIN LXI D,CURCOL ;FORMAT - BLANK FILL LDAX D ;GET CURRENT CURSOR COLUMN CPI MAXCOL+1 ;LINE COMPLETED? JZ GDS310 ;YES - ADVANCE TO NEXT LINE  INR A ;NO - INCREMENT COLUMN STAX D ;NUMBER  STA IOCRCL ;UPDATE DISPLAY CURSOR INX H ;RESTORE "GETADR" TO LOCATIO SHLD GETADR ;OF "EOL"  MVI A,ABLNK ;RETURN BLANK  ORA A ;CLEAR C-FLAG  RET ;RETURN ; GDS310 EQU $  CALL CHAIN1 ;GET ADDR OF NEXT LINE LINK  ; ; EOL LINK FOUND - DETERMINE TERMINATION TYPE; GDS320 EQU $  MOV A,M ;GET POINTER TO NEXT LINE  DCX H  MOV L,M  MOV H,A  SHLD GETADR ;PUT IT INTO "GETADR"  XRA A ;PUT CURSOR IN COLUMN ZERO STA ENHOUT ;CLEAR LAST ENHANCE OUT FLAG CALL CRRET1  CALL CHKFMS ;FORMAT/SOFT KEY DEFINE MODE JZ GDS360 ;NEITHER - SEND END OF LINE  JM GDS350 ;SOFT KEY - FIND NEXT FIELD  LHLD CURROW ;FORMAT - SAVE ENDING ROW AN LDA TLINO ;COLUMN+1 FOR FIELD  ADD L  MOV L,A ;SAVE ABSOLUTE ROW NUMBER  SHLD ENDROW  CALL LNFEED ;YES - DO LINE FEED  CALL DISLN1 ;SET DISPLAY CURSOR ROW  LHLD GETADR ;RECALL POINTER TO NEXT LINE MOV A,L ;GET LSB VALUE ORA A ;END OF DISPLAY (LSB = 0)? JZ GDS160 ;YES - RETURN END OF DISPLAY; ; FORMAT EOL - CHECK FOR CONTINUATION FIELD;  XCHG ;PUT CURRENT ADDR IN D,E CALL FLDSR2 ;NEXT LINE CONTINUES FIELD?  JNZ GDS220 ;NO - RETURN END OF FIELD  XCHG ;YES - CONTINUE PROCESSING LDA IOFLG2 ;GET I/O FLAGS 2 ANI XDS2BF ;DISPLAY TO I/O BUFFER?  JZ GDS060 ;YES - CONTINUE FIELD  SHLD GETADR ;NO - STORE NEW "GETADR" STC ;RETURN END OF LINE  RET ;RETURN NZ, C  ;***********************************************; END OF LINE FOR NON-FORMAT MODE - RETURN END *; OF LINE CODE (C, P, NZ) *;***********************************************GDS350 EQU $ ;SOFT KEY END OF LINE  CALL LNFEED ;LOCATE THE ATTRIBUTE OF THE CALL FLDSR ;NEXT DEFINITIONGDS360 EQU $ ;NON-FORMAT/SOFT KEY EOL XRA A ;SET NZ,P  INR A  STC ;SET C-TRUE  RET ;RETURN END OF LINE  ;************************************** ; INITDG - INITIALIZE FOR DISPLAY GET * ;************************************** ; ; EXIT : Z - CHARACTER FOUND; GETADR = ADDRESS OF FIRST CHARACTER; NZ - NO CHARACTER FOUND; GETADR UNCHANGED ; ALL REGISTERS DESTROYED; ; DISPLAY GET ROUTINE IS SET TO START; AT CURRENT CURSOR LOCATION ; INITD0 EQU $ ;ENTRY FOR DISPLAY TO I/O  CALL CHKFMT ;FORMAT MODE ENABLED?  JNZ INITDG ;YES - DON'T MOVE CURSOR STA CURCOL ;NO - BEGIN AT LINE START INITDG EQU $  CALL SETDF0 ;SET DATA COMM INPUT FLAG TO; ENABLE TRANSMIT ONLY DATA  ANI 377Q-NOSEND ;CLEAR NO DATA FLAG CMP M ;WAS IT SET BEFORE?  MOV M,A ;(SET NEW VALUE) RNZ ;YES - RETURN NO DATA  MVI L,IOFLG2-BASE ;CLEAR DISPLAY BOUNDARY MOV A,M ;FLAGS ANI 377Q-ENDDSP-DSPBTM MOV M,A  ;  ; LOCATE FIRST CHARACTER ;  CALL CHKSFK ;SOFT KEY MODE?  JZ IDG055 ;NO - LOCATE THE FIRST CHAR  LXI H,CURROW ;YES - CHECK CURSOR POSITION MVI A,SFTEND  CMP M ;CURSOR BELOW DATA AREA? RM ;YES - RETURN NO CHARACTER MVI A,376Q ;NO - SET CURSOR ROW TO  ANA M ;ATTRIBUTE ROW MOV M,A  XRA A ;SET CURSOR COLUMN TO  INX H ;BEGINNING OF ROW  MOV M,A ; LOCATE ATTRIBUTE; IDG055 EQU $  MVI A,IGNTRM ;SET TO IGNORE NON-DISPLAYIN STA TRMFCT ;TERMINATORS CALL RCADR4 ;DISPLAY PRESENT?  RM ;NO - RETURN NO CHARACTER  JZ IDG060 ;CHARACTER - CHECK PROTECTED CALL CHKFMT ;EOL - FORMAT MODE?  JZ IDG100 ;NO - EXIT WITH EOL  JMP IDG070 ;YES - CHECK PROTECTED; IDG060 EQU $  LXI H,PROFLD ;SET PROTECT STATUS  MOV M,B IDG070 EQU $  CALL CKPROT ;CURSOR IN PROTECTED FIELD?  JNZ IDG090 ;NO - RETURN CHARACTER FOUND MVI A,STPXFR ;SET TERMINATOR FUNCTION TO  STA TRMFCT ;TERMINATE TRANSFER  CALL FLDSR1 ;ANY MORE FIELDS?  JZ NZEXIT ;NO - RETURN NO CHARACTER IDG090 EQU $  LXI H,377Q ;INITIALIZE PREVIOUS FIELD'S SHLD ENDROW ;ROW AND COLUMN TO ZERO  ; ; CHARACTER FOUND - RETURN CHARACTER FOUND ; IDG100 EQU $  LDAX D ;GET FIRST CHARACTER CPI STPFLG ;NON-DISPLAYING TERMINATOR?  CZ NXTCHR ;YES - GET THE NEXT CHARACTE XCHG @@ ;SAVE ADDRESS OF BYTE  SHLD GETADR  LDA ALTOUT ;SET CURRENT ALTERNATE CHAR  STA CALTST ;SET TO DEFAULT VALUE  LDA LSTDCD ;SET LAST ENHANCEMENT OUT  STA ENHOUT ;WORD  CMP A ;SET Z-FLAG TRUEINITD1 EQU $ ;INITIALIZE CHARACTER BUFFER LXI H,(B2DBFL-1)*256+B2DBFL-1;POINTERS SHLD B2DEND  RET ;RETURN  ;*************************************************; STAT2 - SEND SECONDARY TERMINAL STATUS REQUEST *;*************************************************STAT2 EQU $  LXI B,SSTAT2 ;SET SECONDARY STATUS PENDIN JMP SBLXF0 ;FLAG ;********************************************** ; STA2GO - TRANSMIT SECONDARY TERMINAL STATUS * ;********************************************** STA2GO EQU $  LXI B,-1-SSTAT2  CALL CLBLXF ;CLEAR STATUS 2 PENDING FLAG MVI B,VRTBAR ;SEND - CALL ESCOUT  LXI H,XPUTDC ;SET OUTPUT ROUTINE ADDRESS  CALL STA2G1 ;OUTPUT SECONDARY STATUS BIT JMP SDTERM ;SEND TERMINATOR AND RETURN  ;**************************************** ; STA2G1 - OUTPUT SECONDARY STATUS BITS * ;**************************************** ; ; ENTRY: H,L = ADDRESS OF OUTPUT ROUTINE; ; EXIT : ALL REGISTER DESTROYED ; CNTFAD DESTROYED ; STA2G1 EQU $  SHLD CNTFAD ;SET OUTPUT ROUTINE ADDRESS STA2G2 EQU $ ; ; SEND NON-DISPLAY RAM SIZE (K);  MVI A,(BFSPCE+1)/256 LXI H,BUFBGN+1 ;COMPUTE NON-DISPLAY RAM SUB M ;SIZE  CALL PAROT2 ;SEND NON-DISPLAY RAM SIZE;  ; OUTPUT TERMINAL TYPE ;  LDA TRMTYP ;GET THE TERMINAL TYPE NUMBE CALL PAROUT ;SEND ONLY LOWER FOUR BITS; ; OUTPUT REMAINING KYBD INTFACE STRAPS ;  LHLD KBJMP3 ;GET JUMPERS J-Z MOV A,H ;SEND STRAPS J-K-L-M CALL PAROUT  MOV A,H ;SEND STRAPS N-P-Q-R CALL PAROT4  MOV A,L ;SEND STRAPS S-T-U-V CALL PAROUT  MOV A,L ;SEND STRAPS W-X-Y-Z CALL PAROT4 ; ; OUTPUT MEMORY LOCK STATUS;  LDA MLKFLG ;GET MEMORY LOCK FLAG  LXI H,MDFLG1 ;COMBINE WITH MODE FLAG  ANA M ;EXTRACT MEMORY LOCK STATE ANI MEMLOK  JMP PAROUT ;OUTPUT MEMORY LOCK STATE ; AND RETURN ;************************************************ ; SOFT KEY DATA DONE TABLE - IGNORE DC3,CR,& LF * ;************************************************ DFSTB3 EQU $-3  DB 12Q,12Q ;LINE FEED DW DFS350+B15 ;CHECK FOR IGNORE  DB 15Q,15Q ;RETURN  DW DFS360+B15 ;CHECK FOR IGNORE  DB 23Q,23Q ;DC3  DW ESCAP1+B15 ;IGNORE IT;************************************ ; SOFT KEY MODE ENABLED RANGE TABLE * ;************************************ DFSTB0 EQU $-3  DB 40Q,177Q ;DISPLAYABLE CHARACTER DW SFKYDS+B15 ;DISPLAY IN PROPER DISPLAY;********************************** ; NORMAL CHARACTER SET ATTRIBUTES * ;********************************** RTABLE EQU $-3  DB 40Q,177Q ;ALPHANUMERICS DW DSPCHR+B15 ;DISPLAYABLE CHARACTERS  DB 7Q,17Q ;BELL,BS,HT,LF,VT,FF,CR,SO,S DW RTB010 ;USE FUNCTION TABLE  DB 33Q,33Q ;ESCAPE  DW ESCAPE+B15 ;USE RANGE TABLE;  DB 0Q,177Q ;ALL OTHER CODES DW CHKCTL+B15 ;CHECK FOR BLOCK XFR CHARS; ; THROUGH ; RTB010 EQU $  DW ZBELL ;BELL - SOUND KEYBOARD BELL RTB020 EQU $ ; THROUGH  DW BCKSPC ;BS - BACKSPACE CURSOR DW HTAB ;HORIZONTAL TAB  DW LNFEED ;LINE FEED DW NOFNCT ;VT - NO FUNCTION  DW NOFNCT ;FF - NO FUNCTION  DW CRRET ;CARRIAGE RETURN DW SHFTOT ;SHIFT OUT DW SHFTIN ;SHIFT IN  ;******************************************** ; ESCAPE CHARACTER ATTRIBUTES FOR SOFT KEYS * ;******************************************** SESCTB EQU $-3  DB 51Q,76Q ;<)> TO (>) DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE DB 114Q,117Q ; TO  DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE DB 123Q,130Q ; TO  DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE; *** LOWER CASE CHARACTERS *** DB 154Q,155Q ; TO  DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE DB 171Q,173Q ; TO <[> DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE;*************************************; NORMAL ESCAPE CHARACTER ATTRIBUTES *;*************************************ESCTAB EQU $-3  DB 46Q,46Q ;<&> - AMPERSAND DW PRMSEQ+B15 ;PARAMETERIZED SEQUENCE ;  DB 51Q,51Q ;) - SPECIFY ALT CHAR SET DW SCHRST+B15  DB 61Q,65Q ;<1> TO <5>  DW EI1  DB 66Q,70Q ;<6> TO <8>  DW TYPSET+B15 ;DEFINE FIELD TYPE;  DB 74Q,76Q ;(<) TO (>)  DW EI1A ;USE INDEX TABLE;  DB 100Q,155Q ;<@> TO  DW EI2 ;USE INDEX TABLE; *** LOWER CASE RANGE *** DB 170Q,173Q ; TO  DW EI3 ;USE INDEX TABLE;  DB 176Q,176Q ;<^> (TILDE)  DW STAT2+B15 ;TERMINAL STATUS 2;  DB 0Q,177Q ;ALL OTHER CODES DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE ;************************************ ; INDEX TABLES FOR ESCAPE SEQUENCES * ;************************************ EI1 EQU $  DW HTBSET ;1 - HORIZONTAL TAB SET  DW HTBCLR ;2 - HORIZONTAL TAB CLEAR  DW CLRALL ;3 - CLEAR ALL TABS  DW SETLFT ;4 - SET LEFT MARGIN DW SETRHT ;5 - SET RIGHT MARGIN ; EI1A EQU $  DW FRNCT1 ;< - SET FOREIGN MODE 1  DW ESCEND ;= - INVALID, ABORT SEQUENCE DW FRNCT2 ;> - SET FOREIGN MODE 2 ; EI2 EQU $  DW DELAY0 ;@ - PAUSE FOR 1 SECOND  DW CURPU ;A - CURSOR POINTER UP DW CURPD ;CURSOR POINTER DOWN DW CURPR ;CURSOR POINTER RIGHT  DW CURPL ;D - CURSOR LEFT DW CLEAR ;E - FULL TERMINAL RESET DW CURPHD ;F - HOME DOWN DW CURPRT ;G - CURSOR RETURN DW XMOHME ;H - HOME TO TRANSMIT-ONLY DW HTAB ;CURSOR POINTER TAB  DW CLEARS ;CLEAR DISPLAY DW CLEARL ;CLEAR LINE  DW LININS ;LINE INSERT DW LINDEL ;M - LINE DELETE DW IWRPON ;N - INSERT W/WRAP AROUND ON DW DELWRP ;O - DELETE CHAR W/WRAPAROUN DW CHRDEL ;P - DELETE CHARACTER  DW ICHON ;Q - INSERT CHARACTER ON DW ICHOFF ;R - INSERT CHARACTER OFF  DW ROLLUP ;S - ROLL UP DW ROLLDN ;ROLL DOWN DW NEXTPG ;NEXT PAGE DW PREVPG ;PREVIOUS PAGE DW FORMON ;FORMAT MODE ON  DW FORMOF ;X - FORMAT MODE OFF DW FDISON ;Y - DISPLAY FUNCTIONS ON  DW ESCEND ;INVALID DW PREND ;END PROTECT DW ESCEND ;INVALID DW PRSTRT ;START PROTECT DW STATUS ;^ - SEND TERMINAL STATUS  DW SETTRM ;_ - STORE NON-DISPLAYING ; TERMINATOR CODE  ; ; LOWER CASE RANGE FOR 2 CHARACTER ESC SEQUENCES ;  DW RLCRSN ;@ - SCREEN RELATIVE SENSE DW CURSEN ;A - ABSOLUTE CURSOR SENSE DW KBEN1 ;B - ENABLE KEYBOARD DW KBLOK0 ;C - DISABLE (LOCK) KEYBOARD DW ENTREN ;D - SEND DISPLAY TO CPU DW IOBNGO ;E - FAST BINARY READ  DW DISMDM ;F - DISCONNECT MODEM  DW SFTRST ;G - SOFT RESET  DW CURPH ;H - HOME TO UNPROTECTED DW BKTAB ;I - BACK TAB  DW SFKYON ;J - TURN ON SOFT KEY MENU DW SFKYOF ;K - RESTORE NORMAL DISPLAY  DW MLKON ;L - MEMORY LOCK ON  DW MLKOFF ;M - MEMORY LOCK OFF; EI3 EQU $ ;LOWER CASE TO <[> DW DCTEST ;X - DATA COMM SELF-TEST DW MNMDON ;Y - MONITOR MODE ON DW TEST ;Z - SELF-TEST DW STRXMO ;[ - START TRANSMIT-ONLY ;***********************************************; PRMTAB - TABLE FOR SEQUENCES WITH PARAMETERS *;***********************************************PRMTAB EQU $-3  DB 141Q,147Q ;LOWER CASE TO  DW PRM010 ;USE INDEX TABLE;  DB 153Q,153Q ;LOWER CASE  DW ZSTLKY+B15 ;GO TO SET KEYS ROUTINE ;  DB 160Q,160Q ;LOWER CASE

 DW IOCTGO+B15 ;GO TO I/O CONTROL ROUTINE;  DB 163Q,163Q ;LOWER CASE  DW ZSTJPR+B15 ;GO TO SET JUMPERS ROUTINE DB 0Q,177Q ;ALL OTHER CODES DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE; PRM010 EQU $ ;LOWER CASE TO  DW CURPOS ;A - CURSOR POSITIONING  DW LOADR ;B - BINARY LOADER DW LOADR1 ;C - LOADER SANS MESSAGE DW DISPEN ;D - DISPLAY ENHANCEMENT DW ESCEND ;E - INVALID, ABORT SEQUENCE DW DFSFKY ;F - DEFINE FUNCTION KEYS  DW SNDCDE ;G - SEND ATTENTION/FUNCTION; CODE ;******************************************** ; DENTAB - DISPLAY ENHANCEMENT ESCAPE TABLE * ;******************************************** DENTAB EQU $-3  DB 100Q,117Q ;<@>-  DW DISPLC+B15 ;TURN ON ENHANCEMENT;*****************************************; CHRSTB - ALTERNATE CHARACTER SET TABLE *;*****************************************CHRSTB EQU $-3  DB 100Q,103Q ;<@> -  DW SCHST1+B15 ;SET ALTERNATE CHAR SET ;  DB 0Q,177Q ;ALL OTHER CODES DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE;*******************************************; CRPTAB - CURSOR POSITIONING ESCAPE TABLE *;*******************************************CRPTAB EQU $-3  DB 53Q,53Q ;<+> - PLUS SIGN DW DCPLUS+B15 ;SET SIGN FLAG TO +1  DB 55Q,55Q ;NEGATIVE REL. POSITIONING DW DCMNUS+B15 ;SET SIGN FLAG TO -1  DB 60Q,71Q ;VALID PARAMETER DIGITS  DW DCNUM+B15 ;ACCUMULATE NUMERICAL VALUE ;  DB 103Q,103Q ;  DW CURPO1+B15 ;SET COLUMN PARAMETER ;  DB 122Q,122Q ;  DW CURPO3+B15 ;SET ROW PARAMETER;  DB 131Q,131Q ;  DW CURPO2+B15 ;SET SCREEN ROW PARAMETER ;  DB 143Q,143Q ; DW CURPO1+B15 ;SET COLUMN PARAMETER ;  DB 162Q,162Q ; DW CURPO3+B15 ;SET ROW PARAMTER ;  DB 171Q,171Q ; DW CURPO2+B15 ;SET SCREEN ROW PARAMETER ;  DB 40Q,40Q ;SPACE - IGNORE  DW ESCAP1+B15  DB 0,177Q ;INVALID DW ESCEND+B15  ;****************************** ; FUNCTION DISABLE ATTRIBUTES * ;****************************** FDISTB EQU $-3  DB 15Q,15Q ;RETURN CODE DW CARRET+B15  DB 33Q,33Q ;ESCAPE  DW FDESC+B15 DB 132Q,132Q DW FDISOF+B15  DB 0,177Q ;ALL OTHER CODES DW SFKYDS+B15 ;ADD CHARACTER TO DISPLAY  ;*************************************; BINARY LOADER CHARACTER ATTRIBUTES *;*************************************LDRTAB EQU $-3  DB 101Q,106Q ; -  DW LI1 ;USE INDEX TABLE;  DB 141Q,144Q ;LOADER COMMAND DW LI1 ;USE INDEX TABLE;  DB 12Q,12Q ;LINE FEED DW ESCAP1+B15 DB 15Q,15Q ;CR DW ESCAP1+B15 DB 23Q,23Q ;DC3  DW ESCAP1+B15 ;IGNORE ;********************************************** ; SNDCTB - ACCUMULATE ATTENTION/FUNCTION CODE * ;********************************************** SNDCTB EQU $-3  DB 60Q,67Q ;OCTAL DIGITS  DW DCNUM+B15 ;ACCUMULATE VALUE;  DB 101Q,101Q ;  DW SNDCD1+B15 ;SEND ATTENTION CODE;  DB 106Q,106Q ;  DW SNDCD2+B15 ;SEND FUNCTION CODE ;  DB 40Q,40Q ;SPACE DW ESCAP1+B15  DB 0,177Q ;OTHER CHARACTERS  DW B15 ;TERMINATE AND RESET; LI1 EQU $  DW LDR3 ;A - ADDRESS DW LDR0 ;B - IGNORE  DW LDR10 ;CHECKSUM  DW LDR4 ;DATA  DW LDR060 ;E - EXECUTE LOADED CODE DW BEGIN ;F - TERMINATE AND RESET ;********************************** ; DFSTAB - DEFINE SOFT KEYS TABLE * ;********************************** DFSTAB EQU $-3  DB 40Q,40Q ;SPACE DW ESCAP1+B15 ;IGNORE  DB 60Q,71Q ;DIGITS <0>-<9>  DW DCNUM+B15 ;ACCUMULATE NUMERICAL VALUE DB 101Q,101Q ; - ATTRIBUTE PARAMETER  DW DFS100+B15 ;STORE DEFINED ATTRIBUTE DB 113Q,114Q ; -  DW DFT010 ;USE INDEX TABLE;  ; LOWER CASE RANGE ;  DB 141Q,141Q ; - ATTRIBUTE PARAMETER  DW DFS100+B15 ;STORE DEFINED ATTRIBUTE DB 153Q,154Q ; -  DW DFT010 ;USE INDEX TABLE DB 0Q,177Q ;ALL OTHER CODES DW ESCEND+B15 ;ABORT ESCAPE SEQUENCE; DFT010 EQU $  DW DFS110 ;DEFINE KEY NUMBER DW DFS120 ;DEFINE LENGTH OF INPUT DATA;*********************************; ACCUMULATE SOFT KEY DATA TABLE *;*********************************DFSTB2 EQU $-3  DB 0Q,177Q ;ALL CODES DW DFS300+B15 ;ADD TO DATA LINE   ENDTH OF INPUT DATA;*********************************; ACCUMULATE SOFT KEY DATA TABLE *;********* ITL80 c@ITL80 <<.FSB .MPY .DIV .DLD .DST ..MAP.DIO. .IIO. .DTA. .STOPFLOATEXEC CLRIOIAND RMPARMSIZEIVAINDCLVAOPRSY<YADREF`Lb,@m  f if o `A=677`j  2* ' + - A B Z 0 7 9 , / . C D E L H S P M BIN ; : $ Q ( ) (7 `E`Q <<`]y?Y C d%tdDD tdDDdD%tD>,Edt md%]DD T<::`^c\[,a,d%DD T[,k,zd%DD t odDD T[,z,:<<`^zdDD T[,,dDD t pdDD T[,,dDD T<::`^d[,,dDD t rdDD T[,,dDD T[,,:;;`^dt tdDD 0t dDD td Z ,d[DD t sd;;;`ZGԶt ndt d%DDtd dDDtd dDDtd dt  ;<<`a $d ttdDtdD  6tdD, dtd tmD<::`h@,,1d p   Q  ,1(" AVAILABLE MEMORY FROM ",@6," TO ",@6)d u t<:;;`gt _ f6, 4Q?d?D(,,d t _, dIDtdhD u<;;`\<,,d@t _d ut f, d T?,[,=d?Dt'dID'tAd(t$dIt%;<<`afd$Dt'lI%'6t&d$D[tBdIDBtClI%$[C&d%-DIt%<;;`^y3D,d$DIt$DA,dIt$lI$$?t&d$D+D&d$DIt$D;;;`c|Q,?lI$?t&d.&lI$?t&d(&j?d D tB,~d p ;;;`h t0~.,(" ENTER SYMBOL "3A2" WITH VALUE "I6) d)Md.D ct bd b D(,X,J\ cF T(,bY,kd ct',i cFD't bmd.t m@@!;<<`\" m,JdIt bd,ZD=,w,d t bd,D4,,dt bd bD ct cdItGd t$<;;`^d$D+DT {[,d$tGd$DIt$D#,dIDGC  D tGdID+DJ;;;`\gt&d=DG&dGD+DJt&lI d&dIDGD+DJt&d a&d DGD+DJ;;;`Yöt&d _&dDGD+DJt&d f&dDGD+DJt&d g&dDGD+DJt&d h&d9;;;`YܶDGD+DJt&d/&dHDGD+DJt&d b&d3DGD+DJt&d.&d=DGD+DJt&;;;`_Md,&d8T,,,dID+DJt&d+& 6,dID t,a,;`P>ì  943YP`Afi(`Bf*(`Af-`Bf3 `Hf7 `Af@ `CgD`BfH WRINT c@4WRINT ‘.ENTR.DIO..IIO..DTA.EXEC INCDA<<``no, m  f idDDtdDDtd,Q,dD t(,!,_<`I!dDtd p ;:`FQo,dDDt;l `B/*adt ((`X2dDtDQ,,,E(1X,"WRINT", I3,40A2)d p \[(`FQMdDDt;l `C5~JdDt <<`]oESdDtDQ,M,_(10I7)dD D,f,dtdD DDtdDD<<<`\IpdDt[D,hdD t dtd T ,,dD DDtd<''`U, qe 6dt dD,,fm' `GgIP `B``A` `A` PASS2 c@PASS2 <<;[.FSB .MPY .DIV .DLD ..MAP.DIO..IIO..DTA..GOTO EXEC CLRIOIAND ICOR DCLVARDINTCODE SENDB REG CALC <[BHEX ERRORLETTRNDECMITL80`JN,Tm  f i`Bp>& `BB&@D`AF2IG`A)O2IP<<`\9TW-t,d. T ,_,bd,t ,d0t/d2t1d.t3d5t4daD6DBt8d78<;;`_ pd$D6DBt8d98d+t:dat;d.tD& $t?daD?tTdTD6DFt8daD6DC8daDTD6DF;;;``,at8d$D6DC8d>Dat>D+,d:ZDU,u,d p {Cd p 2!;::`^2;d+t:daD;t;dHTF,,dEt c @[,,daD6DCt8d$:;;``ID6DCtSd c8Sd p daD6DCt86ڇ8d$D6DCt88d$D6DFmt8;`M:6ڇ8d+D6DFt88dCD6DFt88`FpaζdTD6Dt8;l8 `B$̷adatT 99`e\ԶdTDatTD vQ,,(1X,I5,3X,A2,A2,1X,3(2X,A2),3X,80A1),+d p c c9`FpdTD6DFt8;l8 `BQadatT `GtdTDatTDCE,`Fp dTD6Dt8;l8 `B`adatT <<`d[dTDatTD vQ, ,+(1X,I5,2X,O6,1X,3(1X,A2,A1),2X,80A1)daD:t:dAD v@,5<++`U4,jdaD vtVdVtWdWD6D T {,DC,cd p Z:!Y+`FpKd>D6Dt8;l8 `BIadVt> <<`_ Qd>Dat>D)Q,K,_(5 1X,80A1)daD:t:,jdWDatWD),:d.T _,q<;;`cp,vsdaD:t:dXTF,},d&t b d s &3d p Q3,(I;<<`dM6," ERRORS FOUND IN ASSEMBLY CODE ."), daD3t3d:DY,,,nd at `md b<;;``}tZd `D6Dt[[\d.T\,,d]t _d[t f, `.E _d.T _h;<<`\5׶,,d1t g,dDt _dEt f,ƶd$t bdaD6D t8E08d.DE,,d$<<<`b(;D6D t8dEB Pt??08,d$D6D t8dE Pt??608d$<;;`[(DZtZ d@[D$,,6daD@D6DOt8daD6D 8d$D@D6DOt8md$D6;;;`]S0D 8d$D@t@d `D6D T {,@,d `D6D T ,J,daD `t `;;;`_3M,d btZdat bd at `d `D6Dt[][0\a[^ d.T\tJ d.T^4J;<<`_F~l,n,vd T[,u,v,ʅ{ `E _d.T _,,dED/,,daD6mD <;;`]bt8E08daDZtZ 4Pd+D@,,daD@t@d@D6DOt8dE8d `D6;;;`^DT {,,d `D6DT ,,daD `Qt `d `D v,,Td_t _;;;`\'ƢdZt b,d x T[,Ѷ,dat _d[t f,daD `t `d ` D v,අ,d_t _;<<`_,d `D6Dt[d xT[,,d[ Pt`daD6D t8&`08dahDZ<<<`\7tZ d+ZD@, ,ֶdaD@t@d@D6DOt8daD6D 8,daD `t `, <`OB"C43P`Ago.`Ahp0`Ar2?`C5W HE`A9X `CgB `AgH`AgL`ChN0 `AgU7`BgX6`Ag]`Ag_ `Aga PAPER c@2PAPER '' $.FSB .MPY .DIV .DLD ..MAP.ENTR.DIO..IIO. .IAY. .DTA.EXEC IAND '`JN,m  f i`A66 `A:6`BE&`AtoI`B HBIN `As&`BHEX <<`ed 68t  8,,  ,,d r &ZdD m-td<<<`_ Dtdtd mtdDtdtl$tdl$tMd<<<`]"+dDtD,dtdtdDDtdDtdtItl<<<`aH$tddT,_ltdd 6tdDtmD<;;`e i,AdDtD,7d r }| K P,(O7,4(1X,10A1)/7X,4(1X,10A1)) dD;<<`[tdDtD,dD mt mdtdDDtddQDtD(,d<;;`ct[,(20("*")) dT [,,D  r4QdD2,, mtd m ;<<`^ ̆DtdtdtdDDT,dtd[DDDttd<;;`cQCQDtD,dT,,d r d D rDt  $  $  m;<<`^\ d 6t dtdtdDDtdDDt &  tdDDDt <;;``h+ DdDtdDtD ,dD t C$ ,dt Lg r;<<`` K0T[,U,F mtd mC DtTdtdDtdDtmdD<<<`_kDT,tdtd[DDDTtTTtTdQDtD,idT@<;;`[m,,dDDtddDDtd mdC t dDtdmtd;<<`]DDDtdDDt  0 tdDDDt &ڃ DdDtdD<;;`^ٳ¢tD ,d D rt dD t  &dD mt mdT,,dt,F;`Aʐm`Kk P `Ac<`AWB `AYF `Ac;`Ac=`AcI  `DP N `AdG`Ac @`AcR RDINT c@/RDINT  .ENTREXEC INCDA <<`a, m  f id_T,,AdTTX,,Ad_DXDYDt[dZm[<<<`[3",$,Ad_DXDYDt\d_t]d]DYDt[d]DXDYD[d]D_t]D\E,,<""`R;=d\DXtX%I_ q Tn KdZtX,$" `GfQP `B`Y`A`_ REG c@REG N.ENTR<<`a, m  f idyDzD T },d~QDzD T ,$<<<`]C#۬dsDzD T ,0dwDzD T [,<dxDz<::`^2@D T ,HdrDzD T [,Td{DzD T :((`R^,`d|QDzD T |,ld}t _(`Mg:rP SENDB c@#SENDB ڌ.ENTR.DIO..IIO..IAY..DTA.PAPER`K, m  f i6 `Be' <<`n`y <<<`n`9<<<`n`g<<<`na<<<`na1<$$`ZaK$;;`f  dD tB,d p 1 b i,,(" SEND BYTES ",I4,4X,4I4)dT n,3;<<`\-3d btdD b,;,edT b[,B,qdtd DD tdDD dD <;;`^aOQt d D ,W,][&  dt dQDtD,Dd btdD t d ;""`P$=mD ,qd tw  d Dt ,km"`Ii'P`Aa`Aa PASS3 c@PASS3 33.FSB .MPY .DIV .DLD ..MAP.DIO..IIO. .DTA.EXEC CLRIOIAND DCLVAMOD CODE BHEX ITL803`K,1m  f iv `BD & `Ae-6.`B IHEX <<`dj1d\t@dBtAd7d:,<t?<t@d:,<;;;`b8jtA>@Z=@tBl:P ,.? ڀA@DB< ,6;<@<hx,4; `F`= t<<t=<t>d:,<t?<t@d:,<;;;`b8jtA>&& DCLVA cVIRTUAL MEMORY DECLARATION ROUTINE 750306 &@DCLVA`M< ,L t`A`Q t?<t@d:,<;;;`b8jtA>$$ .VAADD  cRTE VIRTUAL DATA MEMORY SYSTEM 750305 $@݄VAADD VAINIbIVAINb*EXEC ;;`e/tZ`t[l\d |]hTZ,4 , t^dZ@;;;``w%ZtZD,dZZ |Ud^BdZB]]d |  %,>L[  ;<<`dbRE D|aD` Dt_|`Ya _`B bt <bt <;;``@i,t]cl ,@tZtttDt^dZ ^,ta;::`cJd tD^"Ѐ <a, |cЀtd",t d]  :<<`c,t_$_d, dtZtd_ZtdlZT, \ ,<<<`]6ϴP,|_ d" ,T, \,, L | _td td4ttd t<55`aCPdt DPD PdbT <b҂ 5 ,<<<`]6ϴP,|_ d" ,T, \,, L | _td td4ttd t<55`aCPdt DPD:PU,%TEMP :LG,20:OF,ITL80,8 :OF,PASS1,8 :OF,PASS2,8 :OF,PASS3,8 :MR,%ITL80:SA,LG,%TEMP :ST,%TEMP,%T1,BR,1,1 :ST,%TEMP,%T2,BR,2,40 :LG,30:MR,%T1 :MR,%..MAP:MR,%RTERD:MR,%DCLVA:MR,%VAADD :MR,%T2 :PU,%TEMP :PU,%T1 :PU,%T2  :RU,LOADR,99,6,0,15001 :PU,ITL80 :PU,PASS1I:PU,PASS2I:PU,PASS3I:SP,ITL80 :SP,PASS1I:SP,PASS2I:SP,PASS3I:LG :CN,6 :CN,6 :::MR,%DCLVA:MR,%VAADD :MR,%TFTN4,L PROGRAM GNCRC(3) WRITE(1, 90) C C GNCRC - VERSION 1.0 - JULY 19, 1977C C GNCRC GENERATES THE CRC AND CHECKSUM THAT IS C STORED AT THE END OF A 2K ROM BLOCK FOR 264X C ROMS. THE CHECKSUM IS USED BY THE TERMINAL C SELF-TEST TO VERIFY PROPER OPERATION OF THEC ROMS.C THE CRC-16 USES THE FOLLOWING POLYNOMIAL:C C  90 FORMAT(/"COMPUTE CHECKSUM FOR 264X ROMS"/)  10 WRITE(1, 100)  100 FORMAT(/"ENTER THE ROM BLOCK SIZE (K)") READ(1, *)N  IF(N .GT. 0 .AND. N .LE. 24) GO TO 30 20 WRITE(1, 110) ! 110 FORMAT(/"ILLEGAL VALUE- SPECIFY 1,2,4,6,8,10,12,14,16,",! 1 "18,20,22, OR 24")  GO TO 10  30 IF(N .EQ. 1) GO TO 40 IF(MOD(N, 2) .NE. 0) GO TO 20 40 N = N * 1024 WRITE(1, 120) 120 FORMAT(1X) CALL GTCRC(-(N-3))  ENDEND$:: "18,20,22, OR 24")  GO TO 10  30 IF(N ASMB,C,L GTCRC - GENERATE 264XX CRC - 7/19/77  HED CRC GENERATOR - PROGRAM INITIALIZATION*  NAM GTCRC,7 770926  SUP  ENT GTCRC  EXT EXEC*  * INITIALIZE VARIBLES * GTCRC EQU *  NOP  ISZ GTCRC FETCH THE BLOCK SIZE LDA GTCRC,I  LDA A,I  STA BLKSZ SET BLOCK SIZE PARAMETER LDA .OPBF INITIALIZE OUTPUT ROUTINE  CLE,ELA BUFFER POINTER AND BUFFER  STA PTBW1 COUNTER  LDA =D-256 STA OPCNT  CCA INITIALIZE INPUT BUFFER  STA INCTR AND CODE BLOCK COUNTERS  STA BLKCT TO MINUS ONE* * OPEN INPUT AND OUTPUT DEVICES* *  JSB EXEC PUNCH TAPE LEADER  DEF *+3  DEF CTLRC  DEF PNLDR * * PROCESS THE HEADER RECORD*  JSB EXEC INPUT THE HEADER FROM THE  DEF *+5 INPUT TAPE DEF INPRC  DEF RDRIN  DEF BFOUT  DEF BUFLN *  STB INLEN STORE THE INPUT LENGTH JSB EXEC DEF *+5  DEF OUTRC  DEF PNASC  DEF BFOUT  DEF INLEN  HED CRC GENERATOR - MAIN PROGRAMMAINI EQU *  LDA BLKSZ INITIALIZE BYTE COUNTER  STA NMBYT  CMA COMPLEMENT THE BLOCK SIZE  ADA =D3 SET BLOCK ADDRESS MASK STA BLKMS THIS ROUTINE IS GIVEN A "* PARAMETER THAT IS 3 LESS THAN "* THE ACTUAL BLOCK SIZE  CLA CLEAR THE CRC  STA CRC  STA BCKSM CLEAR THE CHECKSUM* MAINL JSB GTBYT GET THE NEXT INPUT BYTE  JSB EOJ END OF TAPE - CHECK FOR EOJ  JSB PTBYT PUT THE BYTE OUT JSB NXCRC COMBINE IT INTO THE CRC  ISZ NMBYT ALL BYTES DONE?  JMP MAINL NO - DO NEXT BYTE *  JSB REPRT YES - DISPLAY THE CRC  LDA CRC FETCH THE CRC  STA CRCHD ADD THE CRC TO THE CRC AND =B377  JSB PTBYT OUTPUT THE MSB OF THE CRC  JSB NXCRC  LDA CRCHD  ALF,ALF  AND =B377  JSB PTBYT OUTPUT THE LSB OF THE CRC  JSB NXCRC  JSB REPRT *  * OUTPUT THE CHECKSUM *  LDA BCKSM FETCH THE CHECKSUM ALF,ALF  ADA BCKSM ADD LSB TO MSB ALF,ALF SHIFT FOR COMBINED VALUE CMA COMPLEMENT TO GET INVERSE  AND =B377 MASK FOR LOW ORDER BYTE  JSB PTBYT OUTPUT THE CHECKSUM *  LDB REPD1 FETCH CONVERSION BUFFER ADDRESS  CCE SET TO FILL LOW ORDER BYTE JSB O2AS CONVERT TO ASCII LDA REPD2 TRANSFER ASCII VALUE TO MESSAGE  CLE,ELA  LDB .CKM1  CCE SET UPPER/LOWER BYTE FLAG  ELB IN DESTINATION POINTER JSB XFR  DEC -3*  JSB EXEC DISPLAY THE CHECKSUM DEF *+5  DEF OUTRC  DEF TTY  DEF CKMSG  DEF CKMLN  LDA EOTFL GET END OF TAPE FLAG SSA,RSS END OF TAPE REACHED? JMP EOTL1 YES - EXIT*  LDA =D-256 RESET BLOCK ADDRESS  STA ADDR COUNTER  JSB GTBYT BYPASS LAST THREE BYTES  JMP ERRX1 UNEXPECTED EOT - TERMINATE JSB GTBYT  JMP ERRX1 UNEXPECTED EOT - TERMINATE JSB GTBYT  JMP ERRX1 UNEXPECTED EOT - TERMINATE JMP MAINI DO THE NEXT BLOCK  SKP ERRX1 JSB EXEC UNEXPECTED EOT TERMINATION DEF *+5 DISPLAY ERROR MESSAGE  DEF OUTRC  DEF TTY  DEF ERRM1  DEF ERRL1  HED CRC GENERATOR - CLOSE PROGRAM EOJ EQU *  NOP  CLA CLEAR THE A-REGISTER STA EOTFL SET THE END OF TAPE FLAG LDB NMBYT GET REMAINING NUM BYTES IN BLOCK CPB BLKSZ IS IT A NEW BLOCK? RSS YES - END OF JOB JMP EOJ,I NO - PAD OUT LAST BLOCK * * END OF JOB - CLEAR PUNCH AND TERMINATE * EOTL1 EQU *  LDA PCHLU WAIT FOR PUNCH TO FINISH JSB WAIT THE LAST RECORD  JSB EXEC PUNCH THE TAPE TRAILER DEF *+3  DEF CTLRC  DEF PNTRL *  JSB EXEC DISPLAY THE END OF JOB DEF *+5 MESSAGE  DEF OUTRC  DEF TTY  DEF EOJMS  DEF EOJML * RETN JSB EXEC RETURN TO DOS  DEF *+2  DEF EOJRC  HED CRC GENERATOR - SUBROUTINES * * * * * * A2BUF - ADD CHAR IN A-REG TO A BUFFER *  * CALLING SEQUENCE: *  * LDA * JSB A2BUF * DEF * * A2BUF NOP  STA A2BCH SAVE THE CHARACTER LDB A2BUF,I FETCH THE BUFFER ADDRESS ISZ A2BUF,I INCREMENT THE BUFFER POINTER SLB,INB ADJUST ADDRESS TO FETCH THE  ADB =D-2 OPPOSITE CHARACTER STB A2BW1  CLE,ERB REMOVE UPPER LOWER FLAG  STB A2BPT SAVE THE ADDRESS JSB NXCHR FETCH THE OPPOSITE CHARACTERA2BW1 DEF *  ALF,ALF ROTATE IT UP IOR A2BCH MERGE IN THE INPUT CHARACTER SEZ NEW CHARACTER TO UPPER BYTE? ALF,ALF YES - ROTATE THE WORD  STA A2BPT,I RESTORE THE BUFFER WORD  ISZ A2BUF INCREMENT THE RETURN ADDRESS JMP A2BUF,I RETURN * A2BCH OCT 0 INPUT CHARACTER A2BPT DEF * POINTER TO CURRENT BUFFER WORD SKP * * * * * GTBYT - GET THE NEXT BYTE *  * CALLING SEQUENCE: * * JSB GTBYT  * * * * ON NORMAL RETURN, THE A-REGISTER CONTAINS THE NEXT * INPUT BYTE * GTBYT NOP  LDA EOTFL GET THE END OF TAPE FLAG SZA,RSS END OF TAPE ALREADY REACHED? JMP GTBYT,I YES - RETURN IMMEDIATELY JSB GTTAP GET THE NEXT INPUT BYTE  NOP IGNORE END OF TAPE ISZ BLKCT END OF BINARY BLOCK? JMP GTBX1 NO - NORMAL RETURN* GTBW1 JMP GTBL2 BYPASS CHECKSUM CHECK ON 1ST PASS  JSB GTTAP GET CHECKSUM BYTE  JMP ERRX1 UNEXPECTED EOT - TERMINATE XOR CHKSM MASK IN THE COMPUTED CHECKSUM  AND =B377 MASK OUT UPPER HALF WORD SZA,RSS MATCH?  JMP GTBL0 YES - GO FIND NEXT BLOCK*  JSB EXEC NO - REPORT ERROR  DEF *+5  DEF OUTRC  DEF TTY  DEF ERRMS  DEF ERRML  JSB EOJ TERMINATE THE PROGRAM  JMP RETN AND RETURN* GTBL0 EQU *  LDA =D256 UPDATE NEXT BLOCK ADDRESS  ADA ADDR STA ADDRGTBL1 EQU *  JSB GTTAP GET THE NEXT INPUT BYTE  JMP GTBYT,I END OF TAPE - RETURN IMMEDIATELYGTBL2 EQU *  CLB CLEAR SKIP FOR FIRST PASS  STB GTBW1  CPA =B377 BINARY RECORD HEAD?  RSS YES - START RECORD JMP GTBL1 NO - GET NEXT BYTE*  LDA =D-256 INITIALIZE BLOCK COUNTER STA BLKCT  ISZ NMBLK INCREMENT BLOCK COUNT  JSB GTTAP GET SECOND ALL ONES BYTE JMP ERRX1 UNEXPECTED EOT - TERMINATE JSB GTTAP BYPASS ADDRESS BYTES JMP ERRX1 UNEXPECTED EOT - TERMINATE STA CHKSM INITIALIZE CHECKSUM  STA PNADR PUT ADDRESS INTO PUNCH BUFFER  JSB GTTAP  JMP ERRX1 UNEXPECTED EOT - TERMINATE LDB PNADR COMBINE LSB AND MSB OF LOAD  BLF,BLF ADDRESS AND PUT INTO PUNCH IOR B BUFFER STA PNADR  ADA CHKSM ADD ADDRESS TO CHECKSUM  STA CHKSM  LDA PNADR RECALL BLOCK ADDRESS AND BLKMS GET LOW ORDER BITS FOR BLOCK CPA ADDR ADDRESS CHECK  JMP GTBX0 COMPARE OK*  JSB EXEC MISSING DATA BLOCK DEF *+5  DEF OUTRC  DEF TTY  DEF ERRMA  DEF ERMAL  JSB EOJ TERMINATE THE PROGRAM  JMP RETN AND RETURN* GTBX0 EQU *  JSB GTTAP GET THE FIRST BINARY BYTE  JMP ERRX1 UNEXPECTED EOT - TERMINATE* GTBX1 STA B ACCUMULATE CHECKSUM  ADB CHKSM  STB CHKSM  ISZ GTBYT INCREMENT RETURN ADDRESS JMP GTBYT,I RETURN * ERRML DEC 7 ERROR MESSAGE BUFFER LENGTH  ERRMS ASC 7,CHECKSUM ERROR ERMAL DEC 11ERRMA ASC 11,MISSING BLOCK ADDRESSCHKSM OCT 0 COMPUTED CHECKSUM  SKP * * * * * GTTAP - GET INPUT FROM THE TAPE READER*  * CALLING SEQUENCE: * * JSB GTTAP  * * * * RETURNS WITH THE NEXT INPUT BYTE IN THE A-REGISTER* GTTAP NOP  ISZ INCTR INPUT BUFFER EXHAUSTED?  JMP GTTL2 NO - FETCH NEXT BYTE IN BUFFER*  JSB EXEC GET ANOTHER BLOCK OF INPUT DEF *+5  DEF INPRC = 1 DEF INBIN GTTD1 DEF INBUF  DEF BUFLN *  LDA GTTD1 INITIALIZE BUFFER POINTERS STA PTR  CLE,ELA SHIFT IN UPPER/LOWER FLAG  STA GTTP1  LDB NMCHR INITIALIZE COUNTER STB INCTR  CLA CHECK FOR NULL INPUT BRS DIVIDE COUNT BY TWO * GTTL1 XOR PTR,I COMBINE ALL INPUT  ISZ PTR  INB,SZB DONE?  JMP GTTL1 NO - ADD IN NEXT WORD  SZA,RSS END OF TAPE? JMP GTTAP,I YES - RETURN IMMEDIATELY* GTTL2 JSB NXCHR GET THE NEXT INPUT BYTE GTTP1 DEF *  ISZ GTTAP INCREMENT THE RETURN ADDRESS JMP GTTAP,I RETURN  SKP * * * * * NXCHR - GET NEXT BYTE IN A STRING *  * CALLING SEQUENCE: * * JSB NXCHR * DEF * * * RETURNS WITH THE NEXT BYTE IN THE A-REGISTER* NXCHR NOP  LDB NXCHR,I FETCH POINTER @@# CLE,ERB SHIFT OUT THE UPPER LOWER FLAG LDA B,I FETCH THE WORD SEZ,RSS UPPER BYTE? (FLAG = 0) ALF,ALF YES - SHIFT UPPER BYTE DOWN  AND =B377 MASK OUT THE UPPER HALF WORD ISZ NXCHR,I INCREMENT THE POINTER  ISZ NXCHR INCREMENT THE RETURN JMP NXCHR,I RETURN  SKP * * * * * NXCRC - ADD ANOTHER BYTE TO THE CRC *  * CALLING SEQUENCE: * * LDA * JSB NXCRC * * * CRC IS STORE IN THE WORD "CRC"* NXCRC NOP  STA B SAVE THE DATA BYTE ADA BCKSM ACCUMULATE THE BLOCK STA BCKSM  ALF,ALF ADD IN CARRY IF ANY  ADA BCKSM  AND =B377 ACCUMULATE LOWER BYTE ONLY STA BCKSM *  * ACCUMULATE CRC *  LDA =D-8 SET LOOP COUNT FOR STA NXCCT EIGHT BITS PER BYTE NXCL1 ERB EXTRACT THE LOW ORDER BIT  CLA,SEZ SET LOW ORDER BIT OF INA THE A-REGISTER ACCORDINGLY XOR CRC COMBINE INTO THE CRC ERA  CLA,SEZ SET A-TO ZERO IF LSB IS ZERO LDA NXCK1 MERGE IN ONES OTHERWISE  XOR CRC  ERA SHIFT IN NEW CRC BITS  STA CRC SAVE THE NEW CRC*  ISZ NXCCT ALL BITS DONE? JMP NXCL1 NO - DO NEXT BIT JMP NXCRC,I YES - RETURN* BCKSM OCT 0 BLOCK CHECKSUM CRC OCT 0 CRC NXCK1 OCT 40002 SHIFT IN PATTERN FOR ONES NXCCT DEC 0 BIT COUNTER  SKP * * * * * O2AS - CONVERT OCTAL TO ASCII *  * CALLING SEQUENCE: * * LDA * LDB * JSB O2AS* * * CONVERTS TO SIX ASCII CHARACTERS* O2AS NOP  ELB SHIFT IN U/L FLAG  STB O2AW1 STORE BUFFER POINTER LDB =D-6 SET LOOP COUNTER STB O2ACT  RAL ROTATE FOR FIRST DIGIT STA O2ACH SAVE THE WORD  AND =B1 MASK FOR FIRST DIGITO2AL1 AND =B7 MASK FOR OCTAL DIGIT ADA =B60 CONVERT TO ASCII JSB A2BUF PUT THE CHARACTER INTO THEO2AW1 DEF * BUFFER LDA O2ACH FETCH THE WORD ALF,RAR ROTATE THE WORD  STA O2ACH SAVE IT  ISZ O2ACT ALL DIGITS DONE? JMP O2AL1 NO - DO NEXT DIGIT JMP O2AS,I YES - RETURN* O2ACT DEC -6 LOOP COUNTERO2ACH OCT 0 SAVE AREA  SKP * * * * * PTBYT - PUT BYTE INTO PUNCH BUFFER* * ENTRY: A = BYTE TO BE OUTPUT *  * EXIT : B DESTROYED * PTBYT EQU *  NOP  STA PTBCH SAVE THE BYTE  JSB A2BUF PUT IT INTO THE OUTPUTPTBW1 DEF * BUFFER*  LDA PCKSM ACCUMULATE PUNCH CHECKSUM  ADA PTBCH  STA PCKSM *  ISZ OPCNT BUFFER FULL? RSS NO - EXIT  JSB PTBR1 YES - PUNCH THE RECORD LDA PTBCH RECALL BYTE  JMP PTBYT,I RETURN *  * PUNCH THE RECORD * PTBR1 EQU *  NOP  LDA PNADR ADD LOAD ADDRESS TO CHECKSUM ALF,ALF  ADA PNADR COMBINE LSB AND MSB  ADA PCKSM ADD TO ACCUMULATE CHECKSUM AND =B377 RETAIN ONLY LSB OF CHECKSUM  STA PCKSM PUT INTO PUNCH BUFFER * * WAIT FOR PREVIOUS PUNCH TO COMPLETE, THEN TRANSFER * RECORD TO OUTPUT BUFFER*  LDA PCHLU WAIT FOR PUNCH LOGICAL UNIT  JSB WAIT TO COMPLETE I/O  LDA .PBUF FETCH SOURCE AND DESTINATION LDB .PBFO POINTERS JSB XFRWD TRANSFER DATA TO OUTPUT BUFFER ABS -PBFLN*  JSB EXEC PUNCH BINARY RECORD  DEF *+5 WITHOUT WAITING FOR  DEF OUTRC COMPLETION DEF PNBIN .PBFO DEF BFOUT  DEF PBLEN * * INITIALIZE OUTPUT ROUTINE AND RETURN *  LDA .OPBF RESET BUFFER POINTER AND CLE,ELA BUFFER COUNTER STA PTBW1  LDA =D-256 STA OPCNT  LDA PNADR INCREMENT MSB OF LOAD ADDRESS  ADA =D256 IN PUNCH BUFFER IN CASE  STA PNADR BLOCK IS BEING PADDED OUT  CLA CLEAR PUNCH CHECKSUM STA PCKSM  JMP PTBR1,I RETURN *  * DATA FOR PUNCH ROUTINE * PTBCH OCT 0 CHARACTER TO BE OUTPUTOPCNT DEC 0 OUTPUT BUFFER COUNT .PBUF DEF *+1 PNBUF EQU *  ASC 10,************************  OCT 6412 CR/LF  DEC -1 TWO ALL ONES BYTE PNADR DEF * LOAD ADDRESSOPBUF BSS 128 DATA AREA PCKSM DEF 0 PUNCH CHECKSUM* PBFLN EQU *-PNBUF PUNCH BUFFER LENGTH PBLEN DEF PBFLN .OPBF DEF OPBUF POINTER TO OUTPUT BUFFER* BFOUT EQU *  BSS PBFLN OUTPUT BUFFER  SKP * * * * * REPRT - DISPLAY THE VALUE OF THE CRC* REPRT NOP  LDB NMBUF INITIALIZE THE BUFFER POINTER  CLE SET FOR UPPER BYTE LDA CRC FETCH THE CRC  JSB O2AS CONVERT TO OCTAL-ASCII*  LDA CRC FETCH THE CRC  AND =B377 MASK OUT UPPER BYTE  LDB REPD2 FETCH BUFFER ADDRESS CLE SET U/L FLAG FOR UPPER BYTE  JSB O2AS CONVERT LSB TO ASCII*  LDA CRC FETCH THE CRC  ALF,ALF SHIFT UPPER BYTE DOWN  AND =B377 MASK OUT UPPER HALF WORD LDB REPD1 FETCH BUFFER ADDRESS CCE SET FOR LOWER BYTE JSB O2AS CONVERT MSB TO ASCII*  LDA REPD2 FETCH BUFFER ADDRESS CLE,ELA SET U/L FLAG FOR UPPER BYTE  LDB OUTA1 FETCH OUTPUT ADDRESS CLE,ELB SET U/L FLAG FOR UPPER BYTE  JSB XFR TRANSFER MSB TO OUTPUT  DEC -3 LDB OUTA2 FETCH OUTPUT ADDRESS CLE,ELB SET U/L FLAG FOR UPPER BYTE  JSB XFR TRANSFER LSB TO OUTPUT  DEC -3*  JSB EXEC YES - DISPLAY THE VALUE  DEF *+5  DEF OUTRC  DEF TTY  DEF OUTBF  DEF OUTBL  JMP REPRT,I RETURN * REPB1 BSS 2 CONVERSION BUFFER FOR MSB REPB2 BSS 3 CONVERSION BUFFER FOR LSB REPD1 DEF REPB1 REPD2 DEF REPB2 NMBUF DEF OUTNM NUMBER FIELD POINTEROUTBL DEC 11 OUTPUT BUFFER LENGTHCNTR DEC 0 DIGIT COUNTER OUTBF ASC 2,CRC=OUTNM BSS 3 CRC DISPLAY VALUE  ASC 1, ( OUTMS ASC 3, ) ( OUTLS ASC 2, )OUTA1 DEF OUTMS OUTA2 DEF OUTLS  SKP * * * * * WAIT - WAIT UNTIL LOGICAL UNIT BECOMES FREE *  * CALLING SEQUENCE: * * LDA * JSB WAIT*  DEF WAIT0  DEF WAIT4  DEF WAIT5  LDA WAIT5 GET STATUS SSA IS DEVICE FREE (>=0)?  JMP WAIT2 NO - CONTINUE WAITING  JMP WAIT,I YES - RETURN* WAIT0 OCT 0 CONTROL CODE FOR EXEC CALLWAIT4 OCT 0 STATUS BUFFER WAIT5 OCT 0 TRANSMISSION LOG SKP * * * * * XFR - TRANSFER BYTES*  * CALLING SEQUENCE: * * LDA * LDB * JSB XFR * DEC -* * * ON RETURN, A AND B CONTAIN UPDATED POINTERS * XFR NOP  STA XFRW1 STORE SORCE AND DESTINATION  STB XFRW2 POINTERS LDA XFR,I FETCH THE NUMBER OF BYTES  STA XFRCT TO BE TRANSFERRED  ISZ XFR INCREMENT THE RETURN ADDRESSXFRL1 JSB NXCHR FETCH THE SOURCE BYTE XFRW1 DEF *  JSB A2BUF PUT IT INTO THE DESTINATION XFRW2 DEF * STRING ISZ XFRCT ALL BYTES TRANSFERRED? JMP XFRL1 NO - TRANSFER NEXT BYTE  LDA XFRW1 YES - FETCH UPDATED  LDB XFRW2 POINTERS JMP XFR,I RETURN * XFRCT DEC 0 NUMBER OF BYTES TO TRANSFERRED SKP * * * * * XFRWD - TRANSFER WORDS*  * CALLING SEQUENCE: *  * LDA * LDB * JSB XFRWD * DEC -* * XFRWD NOP  STA XFRW1 SAVE THE SOURCE POINTER  LDA XFRWD,I FETCH THE WORD COUNT STA XFRCT SAVE IT  ISZ XFRWD INCREMENT THE RETURN ADDRESS* XFRLA EQU *  LDA XFRW1,I FETCH THE SOURCE WORD  STA B,I PUT IT INTO THE DESTINATION  ISZ XFRW1 INCREMENT SOURCE AND INB DESTINATION POINTERS ISZ XFRCT ALL WORDS DONE?  JMP XFRLA NO - DO NEXT WORD  JMP XFRWD,I YES - RETURN HED CRC GENERATOR - DATAA EQU 0 A-REGISTERB EQU 1 B-REGISTER* BINRY EQU 2100B BINARY I/O FLAGLEADR EQU 1000B STEND EQU 700B SET END OF TAPE * CTLRC DEC 3 CONTROL REQUEST CODEINPRC DEC 1 INPUT REQUEST CODEOUTRC DEC 2 OUTPUT REQUEST CODE EOJRC DEC 6 END OF JOB REQUEST CODE STARC DEC 13 STATUS REQUEST CODE * READR EQU 5 TAPE READER LOGICAL UNITPUNCH EQU 4 TAPE PUNCH LOGICAL UNIT CONSL EQU 1 CONSOLE LOGICAL UNIT* TTY DEF CONSL CONSOLE I/O CODERDRIN DEF READR ASCII INPUT CODEINBIN ABS READR+BINRY BINARY INPUT CODEPCHLU DEF PUNCH PUNCH CONTROL WORDPNASC ABS PUNCH ASCII OUT WITHOUT WAITPNBIN ABS PUNCH+BINRY BINARY OUT WO/WAITPNLDR ABS PUNCH+LEADR PUNCH TAPE LEADERPNTRL EQU PNLDR PUNCH TRAILER * PTR DEF * INPUT POINTER BLKSZ DEC 0 ROM BLOCK SIZENMBLK DEC 0 BLOCK COUNT BLKCT DEC 0 BINARY BLOCK COUNTERCRCHD OCT 0 CRC SAVE WORD INCTR DEC 0 INPUT COUNTER BUFLN DEC 30 BUFFER LENGTH NMCHR DEC -60 NUMBER OF INPUT CHARACTERSINBUF BSS 30 INPUT BUFFERNMBYT DEC 0 BYTE COUNTERINLEN DEC 0 ASCII INPUT LENGTHEOTFL DEC -1 END OF TAPE FLAGADDR DEC 0 EXPECTED BLOCK ADDRESSBLKMS OCT 3777 BLOCK ADDR MASK (SET FOR 2K)* ERRM1 ASC 13,**UNEXPECTED END OF TAPE** ERRL1 DEC 13 * EOJMS OCT 6412 END OF JOB MESSAGE - CR/LF ASC 7,**END OF JOB** EOJML DEC 7 * CKMSG EQU * CHECKSUM MESSAGE ASC 5,CHECKSUM = CKSM1 EQU * CHECKSUM VALUE ASC 2,*  CKMLN DEF *-CKMSG .CKM1 DEF CKSM1  END ::C 7,**END OF JOB** EOJML DEC 7 * CKMSG EQU * CHECKSUM MESSAGE ASC 5,CHECKSUM = CKSM1 EQU * FTN4,L PROGRAM AMROM(3) C C C AMROM - VERSION 1.0 - JULY 21,1977 C C AMROM HAS TWO MODES OF OPERATION:C 1) OUTPUTC 2) VERIFYC  C 1) OUTPUT MODE: C AMROM READS BINARY OBJECT CODE AS INPUT AND RE-FORMATSC IT TO HEX SO THAT ADVANCED MICRO DEVICES WILL ACCEPTC IT FOR THEIR ROM MASK PROCESS FOR THE AM9216. C THE OUTPUT IS NORMALLY WRITTEN ON CARDS SINCE THAT IS C THE ONLY MEDIA ADVANCED MICRO DEVICES WILL ACCEPT.C C THE BINARY OBJECT CODE MAY BE FROM PAPER TAPE OR FROM C CARTRIDGE TAPE THAT WAS PREVIOUSLY CREATED BY THE C 8080 CROSS-ASSEMBLER. AMROM EXPECTS TO READ 2K BYTES  C OF BINARY CODE TO BE RE-FORMATTED FOR EACH ROM PATTERN. C  C 2) VERIFY MODE: C AMROM READS THE CARD DECK RETURNED BY ADVANCED MICROC DEVICES AS A VERIFICATION STEP AND COMPARES IT AGAINSTC THE ORIGINAL BINARY OBJECT CODE. ANY DIFFERENCES AREC LISTED ON THE CURRENT LIST DEVICE.C C C GET PARAMETERS FROM :TR AND :RU COMMANDS C C :TR,AMHEX,BINARY INPUT,LIST,OUTPUT,CARD INPUTC  C WHERE AMHEX: C C :RU,AMROM,BIN INPUT,LIST,OUTPUT,CARD INP,GLOBAL VAR 0C C WHERE INPUT = LU WHERE BINARY RESIDES FOR READINGC (LOGINP) DURING OUTPUT PHASEC DEFAULT = 5C C LIST = LU WHERE ERROR MESSAGES WILL BEC (LOGLIS) PRINTED DURING VERIFYC DEFAULT = 6C C OUTPUT= LU WHERE HEX WILL BE WRITTEN DURINGC (LOGHEX) THE TRANSLATION FROM BINARY TO HEX C DEFAULT = 8C C CARD = LU WHERE HEX IS READ FROM DURING VERIFY C INPUT PHASE C (LOGCRD) DEFAULT = 7C C  INTEGER HEX(16),ZERO  DIMENSION IDBUF(140),IBYTE(256),ICARD(80) INTEGER PART(8) INTEGER IPAR(5) COMMON IERR,LOGLIS DATA IADDR/0/ DATA LINE/0/ DATA ICRDLU/9/ DATA LOGIN,LPR/1,6/  DATA INSAD,ITPR,LF,LOGOUT,MTAPE,ZERO/ 1 0,69,12B,1,8,1H0/  DATA HEX/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7, 1 1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF/ DATA ICARD/80*2H / DATA IPNC/4/  DATA LOGOPR,LOGINP,LOGHEX,LOGCRD/1,5,8,7/  CALL RMPAR(IPAR)  LOGLIS = 6C  IF (IPAR(1) .EQ. 99) GO TO 20  IF (IPAR(1) .LE. 1) GO TO 15 IF (IPAR(1) .NE. IPAR(5)) LOGINP=IPAR(1)C 15 CONTINUE IF (IPAR(2) .EQ. 99) GO TO 20  IF (IPAR(2) .GT. 0) LOGLIS=IPAR(2) IF (IPAR(3) .EQ. 99) GO TO 20  IF (IPAR(3) .GT. 0) LOGHEX=IPAR(3) IF (IPAR(4) .EQ. 99) GO TO 20  IF (IPAR(4) .GT. 0) LOGCRD=IPAR(4)C 20 CONTINUEC  C GET LU OF USER TERMINAL C DONE VIA GLOBAL VARIABLE 0 IN :RU COMMANDC  IF (IPAR(5) .GT. 0) LOGOPR=IPAR(5)C  ITPR=LOGINP+100B+2000BC C DETERMINE IF PAPER TAPE OR 2645 CTU'SC C LOGCTU=0 => PAPER TAPE INPUT C  LOGCTU=0 CALL EXEC(13,LOGINP,IEQT5,IEQT4) IF (IAND(IEQT5,37400B) .EQ. 2400B) LOGCTU=1 C 25 CONTINUEC C C  IERR = 0  WRITE (LOGOPR,30) 30 FORMAT(" VERIFY(V) OR OUTPUT TAPE(O)?") READ (LOGOPR,40) ITYPE 40 FORMAT(1A1)  GO TO 75  C DO FIRST/NEXT ROM 60 CONTINUE  WRITE (LOGOPR,70) 70 FORMAT(" END? YES(Y) OR NO(N)")  READ (LOGOPR,40) IEND  IF (IEND .EQ. 1HY) STOP75 CONTINUE  WRITE (LOGOPR,78) 78 FORMAT(" SKIP NEXT 2K ON INPUT TAPE? YES(Y) OR NO(N)") READ (LOGOPR,40) ISKIP IF (ISKIP.EQ.1HY) GO TO 95  IF (ITYPE.EQ.1HV) GO TO 95  WRITE (LOGOPR,80) "80 FORMAT(" PART #?"/" (TYPE 8 CHARACTERS, NO EMBEDDED SPACES)")" READ (LOGOPR,90) PART  90 FORMAT(8A1) C C MAIN LOOP. PROCESS 256 BYTRES OF C BINARY DATA 8 TIMES C 95 CONTINUE  DO 400 ILOOP = 1,8 C C SKIP OVER ANY LEADING INFOC ON TAPE TO ADDRESS AND DATA C C  IF (LOGCTU .EQ. 0) GO TO 199C C GET INPUT FROM CARTRIDGE TAPES C 100 CONTINUE CALL EXEC(1,ITPR,IDBUF,-134) IF (IDBUF(1) .NE. -1) GO TO 100  IF (ISKIP .EQ. 1HY) GO TO 167  IF (IAND(IDBUF(2),3777B) .EQ. IADDR) GO TO 160 WRITE(LOGOPR,159) IDBU@@$F(2),IADDR159 FORMAT(" *** ERROR *** MISSING BLOCK ADDRESS ",  1 O6," , ",O6)  STOPC 160 CONTINUE ISUM=IAND(IDBUF(2),377B)+(IDBUF(2)/256) C  DO 165 I=3,66  IBYTE(2*I-4)=IAND(IDBUF(I),377B) IF (IDBUF(I) .LT. 0) IBYTE(2*I-5)= 1 IAND(NOT(NOT(IDBUF(I))/256),377B)  IF (IDBUF(I) .GE. 0) IBYTE(2*I-5)=IDBUF(I)/256 ISUM = IAND(ISUM+IBYTE(2*I-5),377B)  ISUM = IAND(ISUM+IBYTE(2*I-4),377B) 165 CONTINUEC  IF (ISUM .EQ. IDBUF(67)) GO TO 167 WRITE(LOGOPR,180) IDBUF(2),IADDR STOPC 167 CONTINUEC  CALL EXEC(1,ITPR,IDBUF,-134) IF (ISKIP .EQ. 1HY) GO TO 400  IF (IAND(IDBUF(2),3777B) .EQ. IADDR+128) GO TO 170 WRITE(LOGOPR,159) IDBUF(2),IADDR STOPC 170 CONTINUE ISUM=IAND(IDBUF(2),377B)+(IDBUF(2)/256) C  DO 175 I=3,66  IBYTE(128+(2*I-4))=IAND(IDBUF(I),377B) IF (IDBUF(I) .LT. 0) IBYTE(128+(2*I-5)) =  1 IAND(NOT(NOT(IDBUF(I))/256),377B)  IF (IDBUF(I) .GE. 0) IBYTE(128+(2*I-5))=IDBUF(I)/256 ISUM = IAND(ISUM+IBYTE(128+(2*I-5)),377B)  ISUM = IAND(ISUM+IBYTE(128+(2*I-4)),377B) 175 CONTINUEC  INSAD=0  IF (ISUM .EQ. IDBUF(67)) GO TO 300 WRITE(LOGOPR,180) IDBUF(2),IADDR180 FORMAT(" CHECKSUM ERROR AT ",O6," ,",O6) STOP199 CONTINUEC  C PAPER TAPE INPUT C 1990 CONTINUE CALL EXEC(1,ITPR,IDBUF,-1) IF (IDBUF(1)/256 .NE. LF) GO TO 1990C 1992 CONTINUE CALL EXEC(1,ITPR,IDBUF,1)  IF (IDBUF(1) .NE. -1) GO TO 1992C READ ADDRESS, DATA, AND CHECKSUMC  CALL EXEC(1,ITPR,IDBUF,-260)  IF (ISKIP.EQ.1HY) GO TO 400C NEXT SEQUENTIAL STARTING ADDRESS? C IF NOT, DATA ALL ZEROES IF(IAND(IDBUF(1),3777B).EQ.IADDR) GO TO 200 WRITE (LOGOPR,159) IDBUF(1), IADDR STOPC CONVERT DATA TO ONE BYTE/WORD  C CHECK CHECKSUM 200 CONTINUE  INSAD=0 ISUM=IAND(IDBUF(1),377B)+(IDBUF(1)/256) DO 250 I=2,129  IBYTE(2*I-2)=IAND(IDBUF(I),377B)  IF(IDBUF(I).LT.0) IBYTE(2*I-3) =  1 IAND(NOT(NOT(IDBUF(I))/256),377B)  IF(IDBUF(I).GE.0)IBYTE(2*I-3)=IDBUF(I)/256  ISUM=IAND(ISUM+IBYTE(2*I-3),377B) ISUM=IAND(ISUM+IBYTE(2*I-2),377B)250 CONTINUE  IF(ISUM.EQ.IDBUF(130))GO TO 300 WRITE (LOGOPR,270) 270 FORMAT(" CHECKSUM ERROR") STOP C  C FROMAT DATA ON "CARDS" C 300 CONTINUE C C PROCESS 16 DATA BYTES - 16 TIMESC  IPTR = 1  DO 395 IDATA = 1,16 C  C DO ONE DATA CARD C  C ADDRESS FIRST C  IVAL=IADDR/16  IF (ITYPE.EQ.1HO) GO TO 320 READ (LOGCRD,360) ICARD  LINE = LINE+1 C CHECK ADDRESS  ICOL = 21 CALL BNHEX(ICARD(21),ICARD(22),IBIN) IF (IVAL.NE.IBIN) CALL DIFF(LINE,ICOL,  1 ICARD) IF(ICARD(23).NE.ZERO) 1 CALL DIFF(LINE,ICOL,ICARD) GO TO 330320 CONTINUE  IMSB=IVAL/16 ILSB=IAND(IVAL,17B) C  ICARD(21)= HEX(IMSB+1)  ICARD(22)= HEX(ILSB+1)  ICARD(23)= ZERO 330 CONTINUE C SET DATA  ICOL= 30  DO 350 I=1,16 IVAL = IBYTE(IPTR)  IF(INSAD.EQ.1) IVAL = 0 IF (ITYPE.EQ.1HO) GO TO 340 C CHECK CARD VALUE  CALL BNHEX(ICARD(ICOL),ICARD(ICOL+1),IBIN) IF (IVAL.NE.IBIN)  1 CALL DIFF(LINE,ICOL,ICARD) GO TO 345340 CONTINUE  IMSB = IVAL/16  ILSB = IAND(IVAL,17B) ICARD(ICOL)= HEX(IMSB+1)  ICARD(ICOL+1)= HEX(ILSB+1) C 345 CONTINUE  IPTR=IPTR+1 ICOL = ICOL+3 350 CONTINUE C  IF (ITYPE .EQ. 1HV) GO TO 390 C SET PART NO..  IDASH = 0 DO 355 L = 1,8  ICARD(L+IPNC+IDASH) = PART(L) IF (L .EQ. 4) IDASH = 1355 CONTINUE  WRITE (LOGHEX,360) ICARD 360 FORMAT(80A1) C BUMP TO NEXT ADDRESS 390 CONTINUE  IADDR=IADDR+16 395 CONTINUE 400 CONTINUE  IF (ISKIP .EQ. 1HY) GO TO 60  IF (ITYPE.EQ.1HO) GO TO 450 C LOG # OF ERRORS  WRITE (LOGOPR,420) IERR 420 FORMAT(5X,I4," ERRORS IN VERIFY")  IADDR = 0 IERR = 0  LINE = 0  GO TO 60 450 CONTINUE C C WRITE END OF FILE OR SKIP ITC  ENDFILE LOGHEX  IADDR = 0 GO TO 60  END SUBROUTINE BNHEX(HEX1,HEX2,IBIN)C HEX1 = HEX DIGIN, MSBC HEX2 = HEX DIGIT, LSBC IBIN = CONVERTED BINARY BYTE  INTEGER HEX(16),HEX1,HEX2 DATA HEX/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7, 1 1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF/ DO 100 I = 1,16  IF (HEX1.EQ.HEX(I)) GO TO 120100 CONTINUE  IBIN = -1 RETURN 120 CONTINUE  IBIN = 16*(I-1) DO 200 I = 1,16  IF (HEX2 .EQ. HEX(I)) GO TO 220200 CONTINUE  IBIN = -1 RETURN 220 CONTINUE  IBIN = IBIN + I - 1  RETURN  END SUBROUTINE DIFF(LINE,ICOL,ICARD)  C ERROR IN VERIFY C PRINT ERROR MESSAGE C LINE = LINE # OF ERROR C ICOL = COLUMN # C ICARD = WRONG CARD IMAGE DIMENSION ICARD(80) COMMON IERR,LOGLIS DATA LPR/6/ IERR = IERR+1  WRITE (LOGLIS,380) LINE,ICOL,ICARD380 FORMAT(" ERROR: CARD # ",I3,", COLUMN # ", 1 I3/1X,80A1/)  RETURN  END$ENDENSION ICARD(80) COMMON IERR,LOGLIS DATA LPR/6/ IERR = IERR+1  WRITE (LOGLIS,380) LINE,ICOL,ICARD380 FORMAT(" ERROR: CARD # ",I ASB,HEX ;IO260 - 6/28/76 - 0530 HOURVERSN 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 TRANSMINOTEST EQU 4Q ;INHIBIT TERMINAL SELF-TEST EDTWRP EQU 10Q ;INVERT SENSE OF EDIT WRAPPRNTAL EQU 20Q ;SEND ALL CODES TO PRINTERDCJMP0 EQU 200Q ;DATA COMM JUMPER ;*****************************************; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *;*****************************************DCJMP1 EQU 1Q ;DATA COMM JUMPERSDCJMP2 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 AROUNDFRCRST EQU 4Q ;FORCE FULL TERMINAL RESETDEFSKY EQU 10Q ;DEFINE SOFT KEY MODE ENABLEREMSET EQU 20Q ;REMOTE MODE ENABLEDRCVMDE 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 INTERRUPTDCIOFF EQU 20Q ;DISABLE DATA COMM INTERRUPTTMIOFF 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 ENABLEDINSCHR EQU 2Q ;INSERT CHARACTER ENABLED MEMLOK EQU 4Q ;MEMORY LOCK ENABLEDFORMAT EQU 10Q ;FORMAT MODE ENABLEDEDIT EQU 20Q ;EDIT MODE ENABLEDSELECT EQU 40Q ;SELECT MODE ENABLEDRECORD EQU 100Q ;RECORD MODE ENABLEDFORGN EQU 200Q ;FOREIGN MODE ENABLED ;*********************************; MDFLG2 - TERMINAL MODE FLAGS 2 *;*********************************CAPSLK EQU 1Q ;CAPS LOCK ENABLEDBLKMDE EQU 2Q ;BLOCK MODE ENABLED AUTOLF EQU 4Q ;AUTO LF ENABLEDREMOTE EQU 10Q ;REMOTE ENABLED WBSR EQU 40Q ;WRITE-BACKSPACE-READ MODE;********************************************** ; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * ;********************************************** DECRDX EQU 10 ;DECIMAL NUMBERSOCTRDX EQU 8 ;OCTAL NUMBERS  ;******************* ; COMMON VARIABLES * ;******************* INTVEC EQU FSTRAM+145Q ;CENTRAL INTERRUPT VECTORSCNVEC EQU INTVEC+3 ;FOREIGN TERMINAL DISPLY SCA; COMMON EQU 177777Q ;UPPER LIMIT OF COMMON AREA CMBASE EQU COMMON/256 ;MSB OF COMMON ADDRESSESCMSTOR EQU CMBASE*256 ;MSB ADJUSTMENT FACTOR; DISPST EQU COMMON-1 ;DISPLAY REFRESH START PTRTRMTYP EQU DISPST-1 ;TERMINAL TYPE NUMBER KBDCSW EQU TRMTYP-1 ;KEYBOARD DATACOM SWITCHESKBJMPR EQU KBDCSW-1 ;KEYBOARD STRAPSKBJMP2 EQU KBJMPR-1 ;SET 2KBJMP3 EQU KBJMP2-1 ;SET 3CMFLGS EQU KBJMP3-1 ;COMMON FLAGS ERRFLG EQU CMFLGS-1 ;ERROR FLAGSINTFLG EQU ERRFLG-1 ;INTERRUPT FLAG PRCCTL EQU INTFLG-1 ;PROCESSOR CONTROL FLAGSMDFLG1 EQU PRCCTL-1 ;TERMINAL MODE FLAGS 1MDFLG2 EQU MDFLG1-1 ;AND 2MSGPT1 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 PARAMETERSRNGTA EQU RADIX-2 ;CHAR FUNCTION TABLE ADDRESSESCFLG EQU RNGTA-1 ;ESCAPE SEQUENCE FLAG ; = 0, NOT IN ESCAPE SEQ; # 0, ESC SEQ IN PROGRESSRSTTMR 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 KEYBOARDZGETKY 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 LEDZSTJPR EQU ZCLXMT+3 ;SET JUMPERS ESC SEQ ROUTINEZSTLKY EQU ZSTJPR+3 ;SET LATCHING KEYS ROUTINEZALPCK EQU ZSTLKY+3 ;ALPHA KEY ENTRY CHECKZNUMCK 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 KEYBOARDUNLKKB EQU 2 ;UNLOCK KEYBOARDRPTKEY EQU 3 ;REPEAT LAST KEY HITSTBLMD EQU 4 ;SET PERMANENT BLOCK MODE STRTST EQU 5 ;START SELF-TESTENDTST EQU 6 ;END SELF-TESTRSETKB EQU 7 ;RESET KEYBOARD CKIOKY EQU 8 ;CHECK FOR I/O CONTROL KEYSTPRPT EQU 9 ;STOP KEY REPEATCKBRKY EQU 10 ;CHECK FOR BREAK KEY DOWN SWCHAR EQU 11 ;SWITCH CHARACTER SET SETFRN EQU 12 ;UPDATE FOREIGN MODESTCHST EQU 13 ;SET FOREIGN OUTPUT MODEFRNMD1 EQU 14 ;SET FOREIGN MODE 1 FRNMD2 EQU 15 ;SET FOREIGN MODE 2  ;*************************************************;  ; DATACOM CONSTANTS ; ;*************************************************ZDCBAS EQU 50000Q ;DATACOM START ADDRESSTRIGGR 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 MASKDCJMS2 EQU DCJMSK+1 ;DATA COMM JUMPER MASK #2 ;*************************************************; ; DATACOM ENTRY VECTOR POINTERS; ;*************************************************ZINIDC EQU ZDCBAS+10Q ;INITIALIZE DATACOMZIN2DC EQU ZINIDC+3 ;INITIALIZATION CONTINUATOR ZDCMON EQU ZIN2DC+3 ;MONITORING ROUTINE ZDCCTL EQU ZDCMON+3 ;MISC CONTROL FUNCTIONS ZDCTST EQU ZDCCTL+3 ;SELF-TESTZGETDC EQU ZDCTST+3 ;GET DC CHARACTER ZPUTDC EQU ZGETDC+3 ;PUT DC CHARACTER ZGTBIN EQU ZPUTDC+3 ;GET BINARY DC CHARACTERZSTBIN EQU ZGTBIN+3 ;START BINARY OUTPUTZNDBIN EQU ZSTBIN+3 ;END BINARY OUTPUTZDCINT EQU ZNDBIN+3 ;DATACOM INTERRUPTS ;*************************************************; ; DATACOM CONTROL CALL CODES ; ;*************@@%************************************CLRTRG EQU 0 ;CLEAR BLOCK TRANSFER TRIGGESETTRG EQU 1 ;SET BLOCK TRANSFER TRIGGER RSETDC EQU 2 ;RESET DATACOMSETREM EQU 3 ;SET REMOTE MODESETLCL EQU 4 ;SET LOCAL MODE PUTBRK EQU 5 ;OUTPUT BREAK SIGNALDISCNT EQU 6 ;MODEM DISCONNECT ENDBLK EQU 7 ;TERMINATE OUTPUT MESSAGE SETMON EQU 8 ;ENTER MONITOR MODE SETNRM EQU 9 ;ENTER NORMAL MODEFSTBIN EQU 10 ;ENTER FAST BINARY OUT MODE SNDATN EQU 11 ;SEND ATTENTION CODESNDFCT EQU 12 ;SEND FUNCTION DATA PROMPT EQU 13 ;SEND PROMPT CODE  ;****************************** ; ALTERNATE I/O ENTRY VECTORS * ;****************************** ALTORG EQU 60000Q ;ALTERNATE I/O START ADDRESSZINIAL EQU ALTORG+2 ;INITIALIZATION ROUTINE ZIN2AL EQU ZINIAL+3 ;INITIALIZATION CONTINUATOR ZINTAL EQU ZIN2AL+3 ;INTERRUPT PROCESSORZMONAL EQU ZINTAL+3 ;MONITORING ROUTINE ZGETAL EQU ZMONAL+3 ;INPUT ROUTINEZPUTAL EQU ZGETAL+3 ;OUTPUT ROUTINE ZCTLAL EQU ZPUTAL+3 ;CONTROL ROUTINEZSTAAL EQU ZCTLAL+3 ;STATUS ROUTINE ZMSGAL EQU ZSTAAL+3 ;ALTERNATE DEVICE NAME ;************************** ; ASCII CHARACTER EQUATES * ;************************** NULL EQU 0Q ;NULL LF EQU 12Q ;LINE FEEDFF EQU 14Q ;FORM FEEDCR 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 BLANKAMPSND EQU 46Q ;(&) - AMPERSANDQUOTE EQU 47Q ;(') - SINGLE QUOTE ARPARN EQU 51Q ;[)] - RIGHT PARENTHESISPLUS EQU 53Q ;PLUS SIGNCOMMA EQU 54Q ;COMMAMINUS EQU 55Q ;MINUS SIGN PERIOD EQU 56Q ;(.) - PERIOD SLANT EQU 57Q ;(/) - SLANTZERO EQU 60Q ;ASCII ZERO TWO EQU 62Q ;ASCII TWOTHREE EQU 63Q ;ASCII THREEFOUR EQU 64Q ;ASCII FOUR FIVE EQU 65Q ;ASCII FIVE SIX EQU 66Q ;ASCII SIXSEVEN 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 FIELDENDPR EQU 301Q ;END PROTECTED FIELDXMONLY EQU 302Q ;START TRANSMIT-ONLY FIELDFILL EQU 303Q ;EOL FILL CHARACTER STPFLG EQU 304Q ;NON-DISPLAYING TERMINATORALPHA EQU 305Q ;ALPHABETIC ONLYNUMBER EQU 306Q ;NUMERIC ONLY ALPHNM EQU 307Q ;ALPHANUMERIC FIELD SFKYAT EQU 310Q ;SOFT KEY ATTRIBUTE FIELD ; FLDSEP EQU 304Q ;FIELD SEPARATOR FOR I/O BUFEOL EQU 314Q EOP EQU 316Q LNKLIM EQU 320Q ;LOWEST VALUE FOR A LINKNUM2K EQU 4000Q ;NUMBER 2048 (2K) B15 EQU 100000Q ;BIT 15 JMP EQU 303Q ;JUMP INSTRUCTION CODERET EQU 311Q ;RETURN INSTRUCTION CODE ;************************ ; MISCELLANEOUS EQUATES * ;************************ MAXROW EQU 23 ;MAXIMUM ROW NUMBER MAXCOL EQU 79 ;MAXIMUM COLUMN NUMBERSFTEND EQU 16 ;LAST SOFT KEY DEFINITION ROBELLIM EQU 8 ;SPACE FROM RHTMGN FOR BELL BLKSM EQU 17Q ;BLOCK SIZE MASKBLKSZ 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 SECNOSIGN EQU 200Q ;NO SIGN FLAG FOR INPUT DATA  ;********************* ; I/O MODULE EQUATES * ;********************* RESET EQU 0Q ;RESET TERMINAL VECTORRSTJMP 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 ADDRESSIOKBCO EQU IOKB+200Q ;RESET KEY CONTROL RSTON EQU 2Q ;RESET ONRSTOFF EQU 4Q ;RESET OFF NMFCTK EQU 8 ;NUMBER OF FUNCTION KEYS;  ; CURSOR CONTROL ; IODISP EQU (7Q+IOBASE)*256;MODULE 13 BASE ADDRESSIOCRCL EQU IODISP+0 ;CURSOR COLUMN ADDRESSIOCRRW EQU IODISP+40Q ;CURSOR ROW ADDRESS MAYEOP EQU 40Q ;DMA ON, EOP IF DMA ROW = ROMAYEOL EQU 100Q ;DMA OFF, SKIP EOP IF ROWS =DMAOFF EQU 140Q ;DMA OFFCRTOFF EQU 200Q ;DISPLAY OFFINVRS EQU 202Q ;INVERSE VIDEO ON NORMAL EQU 200Q ;NORMAL VIDEO ON;  ; CARTRIDGE TAPE ; IOCTU EQU (13Q+IOBASE)*256;MODULE 15 BASE ADDRESIOCTCO EQU IOCTU+0Q ;COMMAND TO CTU IOCTSI EQU IOCTU+0Q ;STATUS FROM CTUIOCTDO EQU IOCTU+40Q ;DATA TO CTU IOCTDI EQU IOCTU+40Q ;DATA FROM CTU  ; ; 9866 PRINTER ; IOPTR1 EQU (15Q+IOBASE)*256;MODULE 16 BASE ADDRESPTROT1 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 ADDRESSPTROT2 EQU IOPTR2+100Q ;INTERFACE CONTROL OUT PTRST2 EQU IOPTR2+40Q ;PRINTER STATUS INPTRDA2 EQU IOPTR2+140Q ;PRINTER DATA OUTPTRCF2 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 READYPTRPO1 EQU 200Q ;PRINTER OUT OF PAPER  ;************************* ; RS-232 PRINTER EQUATES * ;************************* PTRDY2 EQU 2 ;PRINTER READY MASK PTRSB2 EQU 100Q ;RS-232 SB LINE STROBEPTROL2 EQU 40Q ;PRINTER READY MASK PTRHD2 EQU 340Q ;RS-232 HANDSHAKE PROTOCOLPTRBD2 EQU 37Q ;PARITY AND BAUD RATE MASK ;**************************** ; VARIABLE SPACE ALLOCATION * ;**************************** DSPLIM EQU 175777Q ;DISPLAY UPPER LIMITLWDSP 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 ADDRESSEBASE EQU BASEH*256 ;DATA PAGE BASE ADDRESSBASEH2 EQU BASEH-1 ;BASE VALUES FOR SECOND PAGEBASE2 EQU BASEH2*256 ;OF VARIABLES SPACE ;***************************; VARIABLE SUBROUTINE CALL *;***************************ECONTF EQU OPSTOR-3 ;JUMP SUBROUTINECNTFAD 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; LINELSTLIN 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 SETTINGRHTMGN 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 HEADDSPBGN EQU FRBLKS-2 ;LOW ADDRESS OF DISPLAY AREADSPEND EQU DSPBGN-2 ;HIGH ADDR OF DISPLAY AREASFTKYS EQU DSPEND-2 ;SOFT KEY DISPLAY START ADDRCURFKY EQU SFTKYS-2 ;CURRENT FUNCTION KEY CHARTLINO EQU CURFKY-1 ;TOP LINE ABSOLUTE ROW NUMBELLINE EQU TLINO-2 ;LAST DISPLAY LINE START ADDFLINE 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 STORAGECHARIN EQU TEMP-1 ;CHARACTER FROM KEYBOARDNCHAR EQU CHARIN-1 ;NUMBER OF CHARS TO BE ADDEDNROWS EQU NCHAR-1 ;NO. OF ROWS TO BE ADDEDNBLKS EQU NROWS-1 ;NO. OF BLOCKS TO BE ADDEDCHSAV EQU NBLKS-1 ;SAVE AREA FOR CHAR ; PRECEDING LINKLNKSAV EQU CHSAV-2 ;LINK SAVE AREA EOLADR EQU LNKSAV-2 ;ADDR OF LAST EOL FRSTBL EQU EOLADR-2 ;FIRST BLOCK IN DISPL1BLKFIL EQU FRSTBL-1 ;FILL FLAG FOR FNDCHR EOLMV EQU BLKFIL-1 ;FLAG FOR EOLMOVFILCHR EQU EOLMV-1 ;FILL CHAR SAVE FOR GTBLK BFSPCE EQU 147777Q ;UPPER LIMIT OF BUFFERLWBUF EQU 130000Q/256 ;LOWER LIMIT BUFBGN EQU FILCHR-2 ;LOW ADDR OF NON-DISPLY BUFFBUFEND EQU BUFBGN-2 ;HIGH ADDR FOR BUFFER ;**************************************** ; STORAGE FOR CHARACTERS TO BE STORED * ;**************************************** FMTCTL EQU BUFEND-1 ;FORMAT CONTROL TO BE ENTEREDCHAR EQU FMTCTL-1 ;NEXT CHAR TO BE DISPLAYEDCHAR EQU DCHAR-1 ;CURRENT CHAR BEING PROCESSECHKRTN 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 FILLNMROLL EQU COUNT-1 ;NUMBER OF LINES TO ROLLROLLCT EQU NMROLL-1 ;ROLL COUNTER ; NEWCOL EQU PARM1 ;NEW COLUMN NUMBERNEWROW EQU PARM2 ;NEW ABSOLUTE ROW NUMBERSCRNRW 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 OUTGETADR 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 PENDINGSSTAT EQU 2Q*256 ;TERMINAL STATUS PENDINGSSTAT2 EQU 4Q*256 ;TERMINAL STATUS 2 PENDINGSDVST EQU 10Q*256 ;DEVICE STATUS PENDINGSCRSEN 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 PENDINGSBINRY EQU 2Q ;BINARY RECORD PENDINGRELSNS EQU 4Q ;RELATIVE CURSOR SENSEESCINP EQU 10Q ;ESC RECEIVED IN BLOCK MODE FRSOUT EQU 20Q ;FIRST SOFT KEY DATA OUTWRPDEL EQU 40Q ;DELETE CHAR W/ WRAP AROUND WRPFLG EQU 100Q ;LINE WRAP AROUND OCCURREDNWRWST 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 COMNOSEND EQU 4Q ;NO DISPLAY DATA TO SENDFCTK2D EQU 20Q ;FUNCTION KEY TO DISPLAYKBDLOK EQU 100Q ;KB LOCKED BY ESCAPE SEQUENCXBF2DS EQU 200Q ;I/O BUFFER TO DISPLAY MODE  ;********************************************** TRMFCT EQU DFLGS-1 ;NON-DISPLAYING TERMINATOR;********************************************** STPXFR EQU -1 ;TERMINATE TRANSFER DELTRM EQU 0 ;DELETE TERMINATORIGNTRM EQU 1 ;IGNORE TERMINATOR;****************************************** SPOWL EQU TRMFCT-1 ;SPACE OVERWRITE LATCH;****************************************** SPOWON EQU 40Q ;SPOW LATCH ONSPOWOF EQU 377Q ;SPOW LATCH OFF ;*************************************************MLKROW EQU SPOWL-1 ;MEMORY LOCK ROWMLKFLG EQU MLKROW-1 ;MEMORY LOCK FLAG LCHAR EQU MLKFLG-1 ;LAST CHARACTER PROCESSED TCHAR EQU LCHAR-1 ;CURRENT TEST PATTERN CHARCRAFLG 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 EQ@@&UATES - 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 40QHOL EQU 20Q ;TAPE HOLETAK 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 READFILRED EQU 4Q ;FILE READRECRWD EQU 10Q ;RECORD DISPLAY AND REWIND; OLD OUTPUT CTU (LOGGING)RECINI EQU 20Q ;START "RECORD" MODERECPGE 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 COMXDS2BF EQU 40Q ;TRANSFER DISPLAY TO BUFFER DSPBTM EQU 100Q ;BOTTOM OF DISPLAY REACHEDENDDSP EQU 200Q ;END OF DISPLAY REACHED  ;******************************** UNIT0 EQU IOFLG2-1 ;UNIT STATUS;******************************** LPM EQU 1Q ;TAPE AT OR BEFORE LOAD POINLSTFWD EQU 2Q ;TAPE LAST MOVED FORWARDFPS EQU 4Q ;TAPE WRITE PROTECTED CMDEXC EQU 10Q ;SUCCESSFUL COMMAND EXECUTIODBLHOL EQU 20Q ;DOUBLE HOLE FOUNDBOT EQU 40Q ;TAPE PAST BOT HOLESLP EQU 100Q ;TAPE PAST LP HOLEEW EQU 200Q ;TAPE PAST EW HOLE;*******************************************CNTRL0 EQU UNIT0-1 ;DATA TRANSFER FLAGS: * ;*******************************************EOF EQU 1Q ;END OF FILEEVD EQU 2Q ;END OF VALID DATAHRDERR EQU 4Q ;HARD ERROR SFTERR EQU 10Q ;SOFT ERROR HRDER1 EQU 20Q ;INTERRUPT ERROR FLAG WRTERR EQU 40Q ;WRITE ERRORDATATR EQU 100Q ;DATA RECORDEDEOFINH EQU 200Q ;INHIBIT REPORTING EOF;***********************************************RELTAK EQU CNTRL0-1 ;GAP LENGTH COUNTER ABSTAK EQU RELTAK-2 ;ABSOLUTE TACH COUNTERSTRTAK EQU 40660Q ;STARTING VALUE FOR COUNTER FILNUM EQU ABSTAK-1 ;CURRENT FILE NUMBERSFTCNT 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 TAPEFWD 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 UNITDISPLY EQU 4Q ;DISPLAYPRINTR EQU 10Q ;PRINTERALTIO EQU 20Q ;ALTERNATE I/ODATCOM EQU 40Q ;DATA COMMPTTPOK EQU 100Q ;BUF AVAIL FOR PTTPLN ROUTINBUFBSY EQU 200Q ;BUF HELD BY UNSPECIFIED DEV SCNCNT EQU CMND-1 ;NUM. OF KBSCAN PER CTU SCANCTBLNK EQU SCNCNT-1 ;BLINK MASK FOR EJECT LIGHTSCTBLTM EQU CTBLNK-1 ;BLINK TIMERCTBDLY EQU 40Q ;BLINK DELAYHOLCNT 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 OCCURREDINPDEV EQU IOCERR-1 ;CURRENT INPUT DEVICE OUTDEV EQU INPDEV-1 ;CURRENT OUTPUT DEVICEIOCDPT EQU OUTDEV-1 ;DEVICE FLAG POINTERIOSTA3 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 LIMITB2DBUF 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 FLAGIOCOUT EQU PARM2 ;OUTPUT DEVICE ACCUMULATORIOCINP EQU PARM3 ;INPUT DEVICE ACCUMULATOR IOCTYP EQU PARM4 ;COMMAND MODIFIER FLAGIOCMND EQU PARM5 ;COMMAND TYPE FLAGIOCCNT 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=EVDB1LEN EQU B1TYPE-1 ;LENGTH OF RECORD B2STAT EQU B1LEN-1 ;STATUS OF SECOND BUFFERB2TYPE EQU B2STAT-1 ;TYPE (-1=NORM, 0=EOF, 1=EVDB2LEN 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 BUFFERCTICNT 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 REPEASWPCTU EQU LSTRED-1 ;SWAP CTU IN LOGGING MODE ; -1 = SWAP ENABLED ; 0 = DISABLED SAVINP EQU SWPCTU-1 ;"INPDEV" SAVE FOR LOCAL RCRSAVOUT EQU SAVINP-1 ;SAVE OUTDEV DURING LCL READ; ; DATA FOR FORMAT DISPLAY STORAGE; ENDCOL EQU SAVOUT-1 ;ENDING COLUMN AND ROW FORENDROW 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 BUFFERPTRSPT 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 OCCURREDPTRFLG 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 -> CTSTATCTI100 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 DATACTM020 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 CTLCTLOG910 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 LIGHTLITOFL 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 VECTOROUTCM1 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 RESULOCM005 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 OFFOCM030 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 RETURNRSC005 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 INTERRUPRSC020 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 WAITINGRLP100 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 INTERRUPTSSTP100 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 COMMANDSTP200 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 RNZGPT010 EQU $ ;ADJUST FILE NUMBER  MVI L,FILNUM  CALL CHKFWD ;GOING FORWARD?  JZ GPT020  INR M ;YES - INCREMENT FILE COUNT  RETGPT020 EQU $  DCR M ;NO - DECREMENT FILE COUNT RETGPT030 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 ERRORFSP020 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 ROUTINEBAKSPW 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 NUMBERRSP040 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 COUNTEVDWAT EQU $ ;ENTRY TO WRITE EVD AND WAIT CALL EVDC ;START RECORDING EVD RC ;RETURN ON ERRORREV010 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 FILFCP100 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 - RETURNBSY010 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  RETC2B020 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 EXITRDI020 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 MARKGCT030 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 - RDRTRYGCT035 EQU $  LXI H,GETLSB ;GET LSB NEXT  JMP GC@@*T100 ;YES - SET STATUS = GET LSGETLSB 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 - RETRYGETDAT EQU $  LHLD CTIBPT ;GET BUFFER POINTER  JZ GCT070 ;READ OR VERIFY MODE?  CMP M ;VERIFY - SAME AS BYTE IN  JNZ RDRTRY ;BUFFER? NO => ERRORGCT070 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 NEXTGCT100 EQU $ ;UPDATE STATUS FOR NEXT  SHLD CTIADR ;SAVE ADDRESS OF NEXT SUBROU RETGETCSM 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-READGCT420 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  RETB2C015 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 COUNTERB2C030 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 COMPLETIONB2C150 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" GAPWRNORM 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 EWWRS020 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  RETWRS030 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 LENGTHWRS040 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 ERRORWRS050 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 =>-EOFPCT030 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 NEXTPCT100 EQU $ ;UPDATE POINTER TO SERVICE R SHLD CTIADR PCT200 EQU $ ;OUTPUT BYTE STA IOCTDO  RETPUTCSM 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 = -1USRCMF 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 GREATERCPB010 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  RETCPB100 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 RETCPB350 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  RETCPB370 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 STCTSTRCT 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 RETSTC020 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 BITSTC030 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 OFFSTC040 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 MESSAGESPC010 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 ERRORSPCEND 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 SEARCHSRC070 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 COMMANDSRC110 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  RETTCT005 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 - QUITTCT050 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 INTE@@-RPRETATION ***************************;***********************************************; ; * * * * * * * * * * * * * * * * * * * * * * * * ; ; 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 MESSAGEUTX100 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  RETCLWBSR 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 & RECTT100 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 FLAGSLK050 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 INSLK410 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 - RETURNRED120 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 MESSAGEUSS010 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 MESSAGEUSS030 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 KEYIOSCTL 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 (LOGGINGUTE070 EQU $  STA SWPCTU ;MARK SWPCTU ACCORDINGLYUTE100 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 BUFPTP020 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 QUITPTP040 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 AGAINPTP220 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 OEDA520 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 OTHEREDA580 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',0LLPMSG 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',EOPPREMSG EQU $ DB INVRS,'PRINT FAIL',EOP RTRYMS EQU $  DB 202Q,'RETRY' EOPMSG EQU $ DB EOPNLTPMS:DB 200QOLTPMS EQU $ DB ' ON LEFT DRIVE',0NRTPMS:DB 200QORTPMS EQU $ DB ' ON RIGHT DRIVE',0 TMFMSG EQU $  DB INVRS,'TOO MANY "FROM" DEVICES',EOP BSYMSG EQU $  DB INVRS,'BUSY - WAITING',0WRFMSG EQU $  DB INVRS,'WRITE FAIL',0NULMSG 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 ',0RECMSG EQU $  DB ', RECORD ',0 FILMSG EQU $  DB ', FILE' BLKMSG EQU $  DB ' ',0 STALMS EQU $  DB 203Q,'STALL',0 FMSMSG EQU $  DB INVRS,'FILE MISSING',0CONMSG 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 => INITIALIZECTD050 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 TO  DW IOCT20  DB 142Q,146Q ;LOWER CASE CHAR RANGE  DW IOCT20 ;  DB 115Q,127Q ;RANGE FROM TO  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 ; ; <&> . . . ; IOCNTL EQU $ LXI H,IOCTAB ;SET ESCAPE SEQUENCE SHLD RNGTA ;RANGE TABLE POINTERIOCCLR 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 BYTEIOC010 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 RECORDIOFNUM EQU 2 ;TRANSFER/COMPARE A FILEIOMNUM EQU 3 ;TRANSFER/COMPARE MEDIUMIOCNUM EQU 4 ;EXECUTE I/O CONTROLIOWNUM EQU 5 ;STORE RECORD FROM DATA COMMIORNUM EQU 6 ;READ RECORD TO DATA COMM IOSNUM EQU 7 ;GET I/O STATUS  ; ; - TRANSFER TO END OF DATA; IOC070 EQU $  INR B ;COMMAND CODE = 3 ; ; - SINGLE FILE TRANSFER ; IOC050 EQU $  INR B ;COMMAND CODE = 2 ; ; - 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 ; ; - READ A RECORD TO THE DATACOM ; IOC100 EQU $  INR B ;COMMAND CODE = 6  INR B ;  ; - 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; ; - 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  ;  ;

- 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; ; - 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; ; - DEFINE DESTINATION DEVICE; IOC080 EQU $ INR B ;INDEX TO IOCOUT; ; - 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 VALUEDFNDV0 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 @@0MSB 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 OUTXFR220 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  RETXFR500 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 DEVICESCTR010 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 DEVICECTR040 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/INCHTPS160 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 READIRD010 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 BYTEIOW023 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 ERRORIOW025 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 "CH@@1AR"? 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 IDCB010 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 INTRUPDCB020 EQU $  CALL ZGETDC ;CHECK DATACOM FOR CHAR  JC DCERR ;PROCESS DATACOM ERRORS  JNZ DCB010 ;WAIT - MON CTU & KYBD, RETRDCB030 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/256IOR025 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 BYTEIOR030 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/256IOR110 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 OUTPUTTINGIOR285 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 TERMINATORIOR380 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 ONLIOR500 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 XP@@2UTDC) ; ; 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 OUTPURDA005 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 COUNTRDA010 EQU $  LDA B2STAT ;IS IOBUF2 FULL? ANA C  JZ RDA020 ;NO -  INR B ;YES - INCREMENT COUNTRDA020 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 ERRORB2D005 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 FIELDB2D020 EQU $  JC B2D030 ;RETURN ON ERROR JZ B2D005 ;HANDLE ANY MORE FIELD SEP; ; DECIDE WHETHER TO DO CR LF ;  CALL B2D200 ;DISPLAY CR LFB2D030 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 CHAREXB020 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 - RETURNINTDSP 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 ; @@3 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 PD2B010 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 DATD2B280 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 LFD2B420 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 PRINTB2P030 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 ERRORB2P070 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 COUNTERPTR110 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 COUNTERPTR630 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  RETPTR640 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-REGPTRC60 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 NULLPTRC70 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 COUNTERPTRC80 EQU $  MVI B,0 ;SETUP NULL CHARACTER PTRC85 EQU $  CALL PRCHR2 ;OUTPUT THE CHARACTER  RC @@4 ;ERROR EXIT  DCR E ;IS THIS THE LAST NULL?  JNZ PTRC85 ;NO - GO DO IT AGAIN MVI B,LF ;RESTORE B TO A LFPTRC90 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 CODEFNCLIM EQU 240Q ;FUNCTION CODE UPPER LIMITTESTKY 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 100QDSPMSG EQU MANORG ;DISPLAY A MESSAGERSTDSP 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 DECIMALBN2DE0 EQU BN2DEC+3 ;CONVERT 1 BYTE BINARY TO DERCADRA EQU BN2DE0+3 ;LOCATE CURRENT CURSOR POSGTMODE EQU RCADRA+3 ;CHECK FOR PAGE MODE  ENDSG ASB,HEX ;MPTS2 11/10/76 1200 HRS MP; ; ; ; ; 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 TRANSMINOTEST EQU 4Q ;INHIBIT TERMINAL SELF-TEST EDTWRP EQU 10Q ;INVERT SENSE OF EDIT WRAPPRNTAL EQU 20Q ;SEND ALL CODES TO PRINTERDCJMP0 EQU 200Q ;DATA COMM JUMPER ;*****************************************; KBJMP3 - THIRD SET OF KEYBOARD JUMPERS *;*****************************************DCJMP1 EQU 1Q ;DATA COMM JUMPERSDCJMP2 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 AROUNDFRCRST EQU 4Q ;FORCE FULL TERMINAL RESETDEFSKY EQU 10Q ;DEFINE SOFT KEY MODE ENABLEREMSET EQU 20Q ;REMOTE MODE ENABLEDRCVMDE 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 INTERRUPTDCIOFF EQU 20Q ;DISABLE DATA COMM INTERRUPTTMIOFF 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 ENABLEDINSCHR EQU 2Q ;INSERT CHARACTER ENABLED MEMLOK EQU 4Q ;MEMORY LOCK ENABLEDFORMAT EQU 10Q ;FORMAT MODE ENABLEDEDIT EQU 20Q ;EDIT MODE ENABLEDSELECT EQU 40Q ;SELECT MODE ENABLEDRECORD EQU 100Q ;RECORD MODE ENABLEDFORGN EQU 200Q ;FOREIGN MODE ENABLED ;*********************************; MDFLG2 - TERMINAL MODE FLAGS 2 *;*********************************CAPSLK EQU 1Q ;CAPS LOCK ENABLEDBLKMDE EQU 2Q ;BLOCK MODE ENABLED AUTOLF EQU 4Q ;AUTO LF ENABLEDREMOTE EQU 10Q ;REMOTE ENABLED WBSR EQU 40Q ;WRITE-BACKSPACE-READ MODE;********************************************** ; RADIX - BASE OF INPUT PARAMETER FOR ESC SEQ * ;********************************************** DECRDX EQU 10 ;DECIMAL NUMBERSOCTRDX EQU 8 ;OCTAL NUMBERS  ;******************* ; COMMON VARIABLES * ;******************* INTVEC EQU FSTRAM+145Q ;CENTRAL INTERRUPT VECTORSCNVEC EQU INTVEC+3 ;FOREIGN TERMINAL DISPLY SCA; COMMON EQU 177777Q ;UPPER LIMIT OF COMMON AREA CMBASE EQU COMMON/256 ;MSB OF COMMON ADDRESSESCMSTOR EQU CMBASE*256 ;MSB ADJUSTMENT FACTOR; DISPST EQU COMMON-1 ;DISPLAY REFRESH START PTRTRMTYP EQU DISPST-1 ;TERMINAL TYPE NUMBER KBDCSW EQU TRMTYP-1 ;KEYBOARD DATACOM SWITCHESKBJMPR EQU KBDCSW-1 ;KEYBOARD STRAPSKBJMP2 EQU KBJMPR-1 ;SET 2KBJMP3 EQU KBJMP2-1 ;SET 3CMFLGS EQU KBJMP3-1 ;COMMON FLAGS ERRFLG EQU CMFLGS-1 ;ERROR FLAGSINTFLG EQU ERRFLG-1 ;INTERRUPT FLAG PRCCTL EQU INTFLG-1 ;PROCESSOR CONTROL FLAGSMDFLG1 EQU PRCCTL-1 ;TERMINAL MODE FLAGS 1MDFLG2 EQU MDFLG1-1 ;AND 2MSGPT1 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 PARAMETERSRNGTA EQU RADIX-2 ;CHAR FUNCTION TABLE ADDRESSESCFLG EQU RNGTA-1 ;ESCAPE SEQUENCE FLAG ; = 0, NOT IN ESCAPE SEQ; # 0, ESC SEQ IN PROGRESSRSTTMR EQU ESCFLG-1 ;SOFT RESET TIMER ; * * * * * * * * * * * * * * * * * * * * * * * * ; END OF COMMON EQUATES * ;^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*  ;*********************************; KEYBOARD ENTRY VECTOR POINTERS *;*********************************ZKBBAS EQU 44000Q ;KEYBOARD START ADDRESS ZINIKB EQU ZKBBAS+2 ;INIT KB VECTORS TO ROM +2 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 LEDZSTJPR EQU ZCLXMT+3 ;SET JUMPERS ESC SEQ ROUTINEZSTLKY EQU ZSTJPR+3 ;SET LATCHING KEYS ROUTINE;  ; KEYBOARD CONSTANTS ;  ZKBCON EQU ZKBBAS+50Q FRSALT EQU ZKBCON ;INITIAL ALTERNATE CHAR SET ALTOUT EQU FRSALT+1 ;INITIAL ALTERNATE CHAR OUT ;  ; KEYBOARD CONTROL CALLS ; LOCKKB EQU 1 ;LOCK KEYBOARDUNLKKB EQU 2 ;UNLOCK KEYBOARDRPTKEY EQU 3 ;REPEAT LAST KEY HITSTBLMD EQU 4 ;SET PERMANENT BLOCK MODE STRTST EQU 5 ;START SELF-TESTENDTST EQU 6 ;END SELF-TESTRSETKB EQU 7 ;RESET KEYBOARD CKIOKY EQU 8 ;CHECK FOR I/O CONTROL KEY ;*************************************************;  ; DATACOM CONSTANTS ; ;*************************************************ZDCBAS EQU 50000Q ;DATACOM START ADDRESSTRIGGR 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 J@@5UMPER MASKDCJMS2 EQU DCJMSK+1 ;DATA COMM JUMPER MASK #2 ;*************************************************; ; DATACOM ENTRY VECTOR POINTERS; ;*************************************************ZINIDC EQU ZDCBAS+10Q ;INITIALIZE DATACOMZIN2DC EQU ZINIDC+3 ;INITIALIZATION CONTINUATOR ZDCMON EQU ZIN2DC+3 ;MONITORING ROUTINE ZDCCTL EQU ZDCMON+3 ;MISC CONTROL FUNCTIONS ZDCTST EQU ZDCCTL+3 ;SELF-TESTZGETDC EQU ZDCTST+3 ;GET DC CHARACTER ZPUTDC EQU ZGETDC+3 ;PUT DC CHARACTER ZGTBIN EQU ZPUTDC+3 ;GET BINARY DC CHARACTERZSTBIN EQU ZGTBIN+3 ;START BINARY OUTPUTZNDBIN EQU ZSTBIN+3 ;END BINARY OUTPUTZDCINT EQU ZNDBIN+3 ;DATACOM INTERRUPTS ;*************************************************; ; DATACOM CONTROL CALL CODES ; ;*************************************************CLRTRG EQU 0 ;CLEAR BLOCK TRANSFER TRIGGESETTRG EQU 1 ;SET BLOCK TRANSFER TRIGGER RSETDC EQU 2 ;RESET DATACOMSETREM EQU 3 ;SET REMOTE MODESETLCL EQU 4 ;SET LOCAL MODE PUTBRK EQU 5 ;OUTPUT BREAK SIGNALDISCNT EQU 6 ;MODEM DISCONNECT ENDBLK EQU 7 ;TERMINATE OUTPUT MESSAGE SETMON EQU 8 ;ENTER MONITOR MODE SETNRM EQU 9 ;ENTER NORMAL MODEFSTBIN EQU 10 ;ENTER FAST BINARY OUT MODE SNDATN EQU 11 ;SEND ATTENTION CODESNDFCT EQU 12 ;SEND FUNCTION DATA PROMPT EQU 13 ;SEND PROMPT CODE  ;*************************************************; ; SYMBOL DEFINITION CONVENTIONS; ; THE PURPOSE IS TO KEEP RAM BYTE SYMBOL; DEFINITIONS RELATIVE TO DCCOMA OR SLWRAM; AND ALSO DISTINGUISH THOSE SYMBOLS THAT ARE ; ASSUMED TO BE CONTIGUOUS IN RAM (BY DATACOM ; CODE) ; ; A) SYMBOLS DEFINED IN TERMS OF OTHER SYMBOLS; HAVE CONTINUITY REQUIREMENTS, BECAUSE THE; DATACOM CODE ASSUMES THE SPECIFIED ORDER ; (EG, "SYM1 EQU SYM2+1") ; NOTE THAT BECAUSE OF THE ORDERING, ONE ; MAY NOT FIND ALL REFERENCES IN THE ; CROSS-REFERENCE LISTING. ; B) SYMBOLS WHOSE COMMENTS BEGIN WITH "!"; REQUIRE CONTINUITY BECAUSE THE BYTES ARE ; INITIALIZED (BY INI2DC) VIA A TABLE COPY ; (EG, "SYM1 EQU DCCOMA+1 !COMMENT").; C) SYMBOLS DEFINED ONLY IN TERMS OF "DCCOMA"; OR "SLWRAM" AND WITHOUT "!" HAVE NO; CONTINUITY REQUIREMENTS. ; D) SOME FLAGS ARE ASSUMED TO BE IN PARTIC-; ULAR BIT POSITIONS. REFERENCES TO SUCH; FLAGS MAY NOT BE FOUND IN THE CROSS- ; REFERENCE LISTING (EG, TO TEST BIT 6 ; ONE MAY "ADD A" AND "JM" OR "JP", RATHER ; THAN "ANI FLAG"). SUCH FLAGS ARE; COMMENTED BY A STATEMENT SUCH AS:; "ASSUMED = 100B" (SEE CRC16 FOR EXAMPLE) ;************************************************  ;*************************************************; ; KBDCSW - KEYBOARD DATACOM SWITCHES ; ;*************************************************KBDPAR EQU FRCPTY/4 ;PARITY, 0=ENABLE 1=DISABLE KBDODD EQU 020Q ;PARITY, 0=ODD 1=EVEN KBDBAU EQU 216Q ;BAUD RATE, D7=HI/LOW SWITCH; (D7=0 MEANS HI);************************************************ ; ; KBJMP2 - KEYBOARD JUMPER #2; ;************************************************ KB2SMN EQU 200Q ;1 = SIEMEN'S PROTOCOL; TPAD COMPATIBILITY; (WHEN 8-BIT MODE, TPAD=377) ; ASSUMED = 200B;*************************************************; ; KBJMP3 - KEYBOARD JUMPER #3; ;*************************************************KB3PMS EQU FRCPTY ;1=FORCE PARITY ; ASSUMED = 200BKB3CCL EQU 100Q ;1=MONITOR CC TO OPERATE LED; 0=OPERATE LED WHEN TERM ; COMMUNICATING WITH CPUKB3CH EQU 040Q ;1=TURN ON CH; 0=TURN OFF CHKB3STM EQU 020Q ;1=SELF-TEST INHIBITEDKB3CC EQU 010Q ;1=CONTINUOUS CARRIER MODEM ; 0=NON-CONTINUOUS CARRIERKB3BSZ EQU 006Q ;MAX # BUFFERS PER XMIT BLOC; 00 = 1/2 # BUFFERS ; ALLOCATED ; 01 = 2 BUFFS/BLOCK ; 10 = 4 BUFFS/BLOCK ; 11 = 8 BUFFS/BLOCK ; IF KB3BSZ > JC1BSZ THEN ; DEFAULTS TO 00  ;*************************************************; ; DATACOM FAST-RAM AREAS ; ;*************************************************DCCOMA EQU FSTRAM+200Q ;DATACOM FAST-RAM ARE;*************************************************; ; ASFLAG - INTERRUPT PROCESSOR FLAGS ; ;*************************************************ASFLAG EQU DCCOMA+0Q ;FLAGS FOR ASYNC CODE;  ; ASFLGS BIT DEFINITIONS ; HDRSW EQU 004Q ;1=PUT HEADER ON NEXT; TEXT BLK TRANSMITTED ; ASSUMED = 004B LBCAST EQU HDRSW*2 ;1=LINE BROADCASTGBCAST EQU LBCAST*2 ;1=GROUP BROADCAST BCAST EQU LBCAST+GBCAST ;NZ=LINE/GRP BROADCASSELEC EQU GBCAST*2 ;1=DEVICE SELECT POL EQU SELEC*2 ;1=DEVICE POLL ; ASSUMED=100B BY CTLINGPOLL EQU POL*2 ;1=GROUP POLL; ASSUMED=200B BY CTLINWRU EQU HDRSW/4 ;1=WHO-ARE-YOU ; ASSUMED=001B BY CTLIN; RCVN EQU SELEC+BCAST ;CONTROL SEQUENCE FLG; FOR WHICH DATACOM IS ; IN RECEIVE MODE ;*************************************************; ; CONFIG - CONFIGURATION FLAGS ; ;*************************************************CONFIG EQU ASFLAG+1 ;DATACOM CONFIGURATIO;  ; CONFIG BIT DEFINITIONS ; ; WARNING: HCODE,CRC16,M3270 ASSUMED TO BE; THE HIGH ORDER 3 BITSHCODE EQU FRCPTY ;1=EBCDIC, 0=ASCII ; ASSUMED=200B CRC16 EQU 100Q ;1=CRC16 BCC,0=LRC BC; ASSUMED=100B M3270 EQU 040Q ;0=NO SYNC FILL; 1=SYNC FILLPMASK EQU 020Q ;1=PARITY TO BE CALC-; ULATED BY SOFTWARE TPAR EQU 010Q ;1=TRANSPARENT MODE; ASSUMED = 010B DLC EQU 004Q ;1=HAVE SEEN DLEVRC2 EQU 002QVRC1 EQU 001QVRC EQU VRC2+VRC1 ;PARITY MASK ASSUMED=; WARNING: CODE ASSUMES THESE MASK DEFS VRCFC0 EQU 0Q ;FORCE 0 PARITYVRCODD EQU VRC1 ;ODD PARITYVRCEVN EQU VRC2 ;EVEN PARITY VRCFC1 EQU VRC2+VRC1 ;FORCE 1 PARITY ;*************************************************; ; CONFG2 - CONFIGURATION FLAGS, SET #2 ; ;*************************************************CONFG2 EQU CONFIG+1Q ;!DATACOM CONFIG ;  ; CONFG2 BIT DEFINITIONS ; DVRON EQU 200Q ;1=DRIVER MODE ; ASSUMED=200B MONTR EQU 100Q ;1=MONITOR MODE; ASSUMED=200B ; (DVRON & MONTR CANNOT; BE ON SIMULTANEOUSLY)NAKERR EQU 002Q ;1=ABORT WITH NAK; ASSUMED = 002B EOTO EQU 001Q ;1=ABORT WITH EOT; OR, 1=COMPUTER SENT; TERM AN ETX BLK ; OR, 1=TERM SENT COMP-; UTER AN ETX BLK ; ASSUMED = 001B ;*************************************************; ; ASACNT - ABORT TIMER COUNT ; ;*************************************************ASACNT EQU DCCOMA+3Q ;!ABORT TIMER COUNTABORTT EQU 113Q ;=3 SEC IF CONTINUOUS; CARRIER, ELSE 40MS;*************************************************; ; ASJMP1 -> ASVCT2 INTERRUPT VECTORS ; ;*************************************************ASJMP1 EQU DCCOMA+4Q ;!DISPATCH VECTOR #1 JMPOP EQU 303Q ;"JUMP" OPCODE  ASVCT1 EQU ASJMP1+1 ASJMP2 EQU DCCOMA+7Q ;!DISPATCH VECTOR #2  ASVCT2 EQU ASJMP2+1  ;*************************************************;  ; ASACK - "ACK" FLAG ; ;*************************************************ASACK EQU DCCOMA+12Q ;"ACK" TO SEND/RECEIV; = LAST ACK SENT OR ; NEXT ACK EXPECTED;  ; ASACK FLAG DEFINITIONS ; WARNING: CODE ASSUMES THE FOLLOWING DEFS; ACK0F EQU 000Q ;SEND/RECEIVE "ACK-0"ACK1F EQU 001Q ;SEND/RECEIVE "ACK-1"ACKDC EQU 200Q ;ACK DON'T CARE;*************************************************;  ; ASTCNT - TIMER COUNT ; ;*************************************************ASTCNT EQU DCCOMA+13Q ;TIMER COUNT ;  ; TIMER VALUES ; ; 1 = 40 MSEC TIMERONESEC EQU 031Q ;1 SEC TIMER TRISEC EQU 113Q ;3 SEC TIMER ;*************************************************; ; CTL1 & CTL2 ; ;*************************************************CTL1 EQU DCCOMA+14Q ;COPY OF IODC+OCTL1CTL2 EQU DCCOMA+15Q ;COPY OF IODC+OCTL2 ;*************************************************; ; HEXIN, HEXOUT - TRANSLATE TABLE ADDR'S; ;*************************************************HEXIN EQU DCCOMA+17Q ;HI-ORDER ADDR OF; EBCDIC->ASCII TABLE; (ALWAYS 256-ALIGNED) HEXOUT EQU DCCOMA+20Q ;2-BYTE ADDR OF; ASCII->EBCDIC TABLE; (ALWAYS 128-ALIGNED) ;*************************************************;  ; ASWK1 -> ASWK3 ; ;*************************************************ASWK1 EQU DCCOMA+22Q ;INTERRUPT PROCESSOR'ASWK2 EQU DCCOMA+24Q ;WORK AREAS ASWK3 EQU DCCOMA+26Q  ;*************************************************; ; DIAGNOSTIC WORK AREAS ; ;*************************************************DCFLGS EQU DCCOMA+30Q ;DIAGNOSTIC FLAGS; COPY OF IODC0+IODCST ; NZ=STANDARD DATACOM; CARD PRESENT ; DCSPTR = BUFEND-1 2-BYTE ADDR OF WHERE ; TO "PUT" NEXT CHAR ; IN BUFFERDCBPTR EQU ASWK2 ;2-BYTE ADDR OF WHERE; TO "GET" NEXT CHAR ; FROM BUFFER;*************************************************; ; STANDARD DATACOM CARD DEFINITIONS; ;*************************************************IODC0 EQU 100400Q ;BASE ADDR FOR MOD. 1IODCST EQU 040Q ;INPUT STATUS BYTE ; ; INPUT STATUS BYTE BIT DEFINITIONS ; DCTBE EQU 002Q ;TRANSMIT BUFFER EMPT; IODCDI EQU 000Q ;DATACOM DATA IN IODCCT EQU 100Q ;DATACOM CONTROL OUT IODCDO EQU 140Q ;DATACOM DATA OUT;*************************************************;  ; CHARACTER DEFINITIONS ; ;*************************************************ACK EQU 006Q ;DATACOM ACKNOWLEDGE ADEL EQU 177Q ;DELETE CHARACTER ;*************************************************; ; QMANGR - QUEUE MANAGEMENT WORK AREA; ;*************************************************QMANGR EQU DCCOMA+40Q ;BEGINNING OF Q-AREA ; LENGTH = 16B BYTES ;*************************************************; ; FLAG - BUFFER MANAGEMENT FLAGS ; ;*************************************************FLAG EQU QMANGR+0Q ;PUTDC/GETDC FLAGS ;  ; FLAG BIT DEFINITIONS ; BUFF1 EQU 200Q ;START NEW BLOCK ; ASSUMED = 200B ; (USED IN XMIT ONLY)NEWBUF EQU 100Q ;START NEW BUFFER; ASSUMED = 100B ; (USED IN XMIT ONLY)BLKIN EQU 040Q ;1=BLOCK INPUT MODE; (USED IN RECEIVE)BINARY EQU 001Q ;1=BIN BLK IN PROGRES; ASSUMED=001B ; (USED IN XMIT ONLY);*************************************************;  ; FQ - FREE QUEUE ; ;*************************************************FQ EQU QMANGR+1Q ;QUEUE OF FREE BUFFERFQT EQU FQ+0 ;TAIL (ADDR OF LAST; BUFFER IN QUEUE) FQH EQU FQ+1 ;HEAD (ADDR OF FIRST)FQI EQU FQT FQO EQU FQH ;*************************************************;  ; DQ - DATA QUEUE ; ;*************************************************DQ EQU FQ+2 ;QUEUE OF FILLED BUFFBUFPCO EQU DQ+0 ;PRODUCER COUNT OFFSE; (=APCNT OR PCNT) ; "LHLD BUFPCO" GETS ; THE ADDR OF CURRENT; PRODUCER COUNT DQT EQU DQ+1 ;TAIL (ADDR OF LAST) DQH EQU DQ+2 ;HEAD (ADDR OF FIRST)DQI EQU DQT DQO EQU DQH ;*************************************************; ; TQ - TEMPORARY QUEUE ; ;*************************************************TQ EQU DQ+3 ;QUEUE OF FILLED BUFF; WAITING FOR TRANSMIT ; ACKNOWLEDGE FROM CPU TQT EQU TQ+0 ;TAIL (ADDR OF LAST) TQH EQU TQ+1 ;HEAD (ADDR OF FIRST)TQI EQU TQT TQO EQU TQH ;*************************************************; ; BUFBP - BUFFER BOUNDARY POINTER ; ;*************************************************BUFBP EQU TQ+2 ;BLOCK INPUT MODE ONL; =ADDR OF BUFFER CON- ; TAINING 1ST CHAR OF; CURRENT BLOCK BEING; RECEIVED FROM CPU;*************************************************; ; ASBCNT - QUEUE CONTROL BUFFER COUNT; ;*************************************************ASBCNT EQU BUFBP+1 ;# OF COMPLETED BLOCK; IN DATA QUEUE; COUNT ; POSITIVE = # BLKS RDY; TO XMIT: CNT NEGATIVE; = # BLKS RCVD;*************************************************; ; BUFEND, BUFBEG BOUNDARIES OF RAM-AREA; ALLOCATED FOR DC BUFFERS; ;*************************************************; MAINCODE ALLOCATES A CONTIGUOUS RAM-AREA; FOR DC BUFFERS, THE TOP (HIGHEST ADDR) IS ; 256-ALIGNED; GIVEN THAT A=2-BYTE ADDR OF THE; 1ST BYTE (BYTE WITH SMALLEST ADDR), AND ; B=2-BYTE ADDR OF LAST BYTE, THEN; BUFBEG = B/256 (HI-BYTE OF B) ; BUFEND = A/256 (HI-BYTE OF A) ; BUFLOC EQU QMANGR+12Q ;BUFFER BOUNDARIES BUFEND EQU BUFLOC ;LAST 256-BYTE BUFFDCSPTR EQU @@6BUFEND-1 ;DIAGNOSTIC BUFF PTR BUFBEG EQU BUFEND+1Q ;FIRST 256-BYTE BUFF ;*************************************************; ; BUFMAX, BUFCNT BUFFERS PER BLOCK COUNT ; ;*************************************************BUFMAX EQU QMANGR+14Q ;MAXIMUM SIZE OF XMIT; BLOCKS; = # OF BUFFS ; TO FILL (LESS 1) ; BEFORE TERMINATING ; BLOCK WITH ETB BUFCNT EQU BUFMAX+1 ;COUNTDOWN FROM BUFMA ;*************************************************; ; INDIVIDUAL BUFFER FORMAT; ;*************************************************; ; APCNT - AUXILIARY PRODUCER COUNT; ;*************************************************APCNT EQU 000Q ;IN USE ONLY WHEN; BUFBC=1 AND BUFPCO=1 ; USED FOR MARKING BLK ; BOUNDARIES & RECEIVE ; ERRORS (ALLOWS PROD- ; UCER TO CONT PUTTING ; CHARS IN BUFF WHILE; CONSUMER STOPPED AT; PCNT);*************************************************; ; PCNT - PRODUCER COUNT; ;*************************************************PCNT EQU APCNT+1 ;ALWAYS = LOW-ORDER; ADDR OF LAST CHAR IN ; BUFFER, PLUS 1 ; (=0 WHEN BUFFER FULL); ; NOTE THAT BUFPCO DETERMINES WHICH COUNT TO USE; (IT CONTAINS 0 OR 1); BUFPCO AND DQT TOGETHER ; GIVE THE 2-BYTE ADDRESS OF THE CURRENT; PRODUCER COUNT (APCNT OR PCNT); BUFIP EQU 005+1Q ;INITIAL VALUE OF BOTH; PRODUCER COUNTS WHEN ; RETRIEVED FROM FQ; NOTE THAT BUFIP SHOULD=5 BUT SET TO 6 SO THAT ; MAX NO OF CHARS IN OUTPUT BLOCK CAN BE = 256; 256 = STX + GID + DID + AID + CCA + CCA; + 249 DATA CHARACTERS;*************************************************; ; CCNT - CONSUMER COUNT; ;*************************************************CCNT EQU PCNT+1 ;ALWAYS = LOW-ORDER; ADDR OF LAST CHAR; CONSUMED FROM BUFFER ; (=PCNT-1 WHEN THE; CONSUMER HAS CAUGHT; UP WITH PRODUCER); BUFIC EQU BUFIP-1 ;INITIAL VALUE OF; CONSUMER COUNT WHEN; RETRIEVED FROM FQ; ;*************************************************;  ; BFLG - BUFFER FLAGS ; ;************************************************* BFLG EQU CCNT+1 ;  ; BFLG BIT DEFINITIONS ; BUFBC EQU 004Q ;=1 SIGNALS BLOCK; BOUNDARY (WHEN CCNT= ; PCNT-1)BUFRER EQU 002Q ;=1 SIGNAL RECEIVE ; ERROR (WHEN CCNT=; PCNT-1)BUFBCT EQU EOTO ;VALID ONLY WHEN ; BUFBC=1; ; 0=ETB BLOCK BOUNDARY ; 1=ETX BLOCK BOUNDARY ; BUFIF EQU 000Q ;INITIAL BUFFER FLAGS; WHEN BUFFER RETRIEVED; FROM FQ;*************************************************; ; CHN - BUFFER CHAIN POINTER; ;*************************************************CHN EQU BFLG+1 ;HI-ORDER ADDR OF NEX; BUFFER IN THE CHAIN; (IE, NEXT IN QUEUE); 0 TERMINATES CHAIN ; (IF 0, BUFF = TAIL); BUFICH EQU 000Q ;INITIAL CHAIN POINTE; WHEN BUFFER RETRIEVED; FROM FQ ;*************************************************; ; DATACOM SLOW-RAM AREAS ; ;*************************************************SLWRAM EQU 177200Q ;DATACOM SLOW-RAM ARE;*************************************************; ; BCSTOP - POINTER TO END OF BCC XMIT STRING ; ;*************************************************BCSTOP EQU SLWRAM+0Q ;!LO-ORDER ADR OF LAS; BYTE IN BCC STRING ; IF LRC, PTS TO ASBCC ; IF CRC PTS TO ASBCC+1;*************************************************; ; XEND - BEGINNING OF TRANSPARENT BCC STRING ; ;*************************************************XEND EQU SLWRAM+1Q ;! = TRANSLATED DLE; ! XEND+1 = BEG OF; NON-TPAR BCC STRING; (= TRANSLATED ETB/ETX; DEPENDING ON BLOCK); ; WARNING: USAGE OF XEND REQUIRES THAT BCC; TRANSMIT STRING HAVE AN ADDRESS LESS THAN ; THAT OF ANY OTHER TRANSMIT STRING ;*************************************************; ; ASBCC - BCC ACCUMULATION AREA ; ;*************************************************ASBCC EQU XEND+2Q ;!BEG OF 3-BYTE STRIN; CRC: 2-BYTE BCC+TPAD ; LRC: BCC+TPAD+STOPER ASBHI EQU (ASBCC+1)/256*256;ASBLOW = LO-ORDER ADASBLOW EQU ASBCC+1-ASBHI ;OF LAST CHAR IN CRC1; BCC XMIT STRING;*************************************************; ; ASBCC0 - INITIAL VALUE OF BCC WORK AREA; ;*************************************************ASBCC0 EQU ASBCC+3Q ;!BEG OF 2-BYTE STRIN; CRC: STOPER+STOPER ; LRC: STOPER+TPAD  ;*************************************************; ; DLESTX - BLOCK HEADER WITHOUT ID'S ; ;*************************************************DLESTX EQU SLWRAM+10Q ;!BEG OF TPAR HDR; (= TRANSLATED DLE) STX EQU DLESTX+1Q ;!BEG OF NON-TPAR HDR; (= TRANSLATED STX) ; !DLESTX+2 = STOPER ;*************************************************; ; EOT ; ;*************************************************EOT EQU SLWRAM+13Q ;!TRANSLATED EOT ;*************************************************; ; THDR - BLOCK HEADER WITH ID'S; ;*************************************************THDR EQU DLESTX+HDRSW ;!BEG OF TPAR HDR; (= TRANSLATED DLE) ; NOTE: "HDRSW" FLAG ; USED IN CALCULATING; ADDR OF CORRECT HDRHDR EQU THDR+1Q ;!BEG OF NON-TPAR HDR; (= TRANSLATE DLE)GID EQU THDR+2Q ;!TRANSLATED GROUP IDID1 EQU GID POLRAT EQU GID ;TIMER FOR DRIVER POLL RATE ; USE ESC-&-B TO MODIFY DID EQU THDR+3Q ;!TRANSLATED DEVICE IID2 EQU DID ;*************************************************; ; IBM 3270 MODE HEADER EXTENSION; ;*************************************************; !THDR+4 & THDR+5:; NON-3270-MODE =; STOPER+STOPER ; 3270-MODE =; XLATED ENTER+SPACE; !THDR+6 = XLATED SPAC; !THDR+7 = STOPER  ;*************************************************; ; TLR - TERMINAL RESPONSE STRING; ;*************************************************TLR EQU SLWRAM+24Q ;! = TRANSLATED DLE; !TLR+1 = RESPONSE CHATPADIO EQU TLR+2Q ;! = TRANSLATED TPAD ; !TLR+3 = STOPER;*************************************************; ; LDR - SYNCRONOUS TRANSMISSION LEADER; AND SYNC-FILL; ;*************************************************LDR EQU SLWRAM+30Q ;! IF SYNC-CARD (OR; 3270-BIT ASYNC) = SYN; ELSE = STOPER; !LDR+1 & LDR+2 = SYN'SYNC EQU LDR+3Q ;! = TRANSLATED SYNC ; !SYNC+1 = STOPER ;*************************************************; ; ENTAID - COPY OF ENTER-AID IN HEADER ; ;*************************************************ENTAID EQU SLWRAM+35Q ;!SAME AS 1ST 2 BYTES; OF 3270 HDR EXTENSION;*************************************************; ; DLE - TRANSPARENT-SYNCRONOUS SYNC-FILL; ;*************************************************DLE EQU LDR+TPAR-1 ;!BEG OF TPAR-SYN FIL; TO USE IF 1SEC TIMER ; WENT OFF AND DLC ON; (= TRANSLATED DLE) DLESYN EQU LDR+TPAR ;!BEG OF NORMAL; TPAR-SYNC FILL ; (= TRANSLATED DLE) ; !DLESYN+1 =XLATED SYN; !DLESYN+2 =XLATED DLE; !DLESYN+3 =XLATED SYN; !DLESYN+4 =STOPER ;*************************************************; ; NAK -> WACK RESPONSE CONTROL CHARACTERS; ;*************************************************NAK EQU SLWRAM+45Q ;! = TRANSLATED NAKRVI EQU NAK+1Q ;! = TRANSLATED RVIACK0 EQU RVI+1Q ;! = TRANSLATED ACK-0ACK1 EQU ACK0+1Q ;! = TRANSLATED ACK-1WACK EQU ACK1+1Q ;! = TRANSLATED WACK ;*************************************************; ; CTLTBL - TABLE OF CONTROL SEQUENCE CHARACTERS; ;*************************************************CTLTBL EQU SLWRAM+52Q ;!1ST 3 CHARS ARE THE; ONLY LEGAL 1ST CHARS ; OF A CONTROL SEQUENCE; (= XLATED GROUP ID); !CTLTBL+1 = DEVICE ID; !CTLTBL+2 = TILDA; LAST 6 CHARS ARE THE ; ONLY LEGAL 3RD CHARS ; OF A CONTROL SEQUENCE; !CTLTBL+3 = TILDA; !CTLTBL+4 = DEVICE ID; !CTLTBL+5 = DEVICE ID; !CTLTBL+6 = QUOTE; !CTLTBL+7 = RT BRACE  ;*************************************************; ; PLIST - POLL LIST FOR DRIVER; ;*************************************************PLIST EQU SLWRAM+62Q ;! = XLATED GROUP ID ; ! PLIST+1 = GROUP ID ; ! PLIST+2 = DEVICE ID; ! PLIST+3 = DEVICE ID; ! PLIST+4 = ENQ; ! PLIST+5 = TPAD ; ! PLIST+6 = STOPER ;*************************************************; ; SLIST - SELECT LIST FOR DRIVER; ;*************************************************SLIST EQU SLWRAM+71Q ;! = SELECT GROUP ID ; ! SLIST+1 = SAME ; ! SLIST+2 = DEVICE ID; ! SLIST+3 = SAME ; ! SLIST+4 = ENQ; ! SLIST+5 = TPAD ; ! SLIST+6 = STOPER  ;*************************************************; ; ETB -> ENQ TERMINATOR CONTROL CHARACTERS; ;*************************************************ETB EQU SLWRAM+100Q ;! = XLATED ETBETX EQU ETB+BUFBCT ;! = XLATED ETXENQ EQU ETX+1 ;! = XLATED ENQ; ; ENQ+1 = HOLE FOR ; MATCH CHAR (TO ; TERMINATE SEARCH);*************************************************; ; SLFID, WRUSTS SELF-TEST MESSAGE; WHO-ARE-YOU STATUS STRING; ;*************************************************SLFID EQU SLWRAM+110Q ;BEG OF SELF-TEST MSG; (= NON-XLATED GRP ID); SLFID+1 = DEV ID WRUSTS EQU SLFID+2Q ;WRU STATUS BYTE #1; BIT#7=PARITY ; BIT#6=1 (ALWAYS) ; BIT#5-4=VRC TYPE ; BIT#3-0=BAUD RATE; (AS FROM KBDCSW); WRU STATUS BYTE #2 ; BIT#7=PARITY ; BIT#6=1 (ALWAYS) ; BIT#5=HCODE, #4=CRC16; BIT#3=M3270; BIT#2-1=BUFSIZ ; BIT#0=BLKIN; WRU STATUS BYTE #3 ; BIT#7=PARITY ; BIT#6=1 (ALWAYS) ; BIT#5=1 IF ASBCNT>0; BIT#4=REMSET ; BIT#3-0=TRMTYP ;*************************************************; ; DCMSG - DATACOM MESSAGE AREA; ;************************************************* DCMSG EQU SLWRAM+120Q  ;*************************************************; ; MULTIPOINT DATACOM CARD DEFINITIONS ; ;*************************************************IODC EQU 107000Q ;BASE ADDRESS FOR MODULE #7 ; ALL DC CARD ADDR'S ARE OF ; THE FORM IODC+OFFSET;*************************************************; ; ST1 - INPUT STATUS BYTE #1; ;*************************************************ST1 EQU 040Q ;INPUT STATUS BYTE #1 ; ; BIT DEFINITIONS FOR INPUT STATUS BYTE #1; ST1IBF EQU 200Q ;1 = INPUT BUFFER FULL; CLEARED BY INPUTTING CHAR ST1PER EQU 100Q ;1 = PARITY ERROR ; VALID ONLY IF ST1IBF=1ST1OER EQU 040Q ;1 = OVERRUN ERROR; VALID ONLY IF ST1IBF=1ST1NU EQU 030Q ;NOT USED ST1SYN EQU 004Q ;1 = AUTOMATIC SYNC FILL; CLEARED BY INPUTTING STATUS ST1TIM EQU 002Q ;1 = 40 MSEC TIMER TICKED OF; CLEARED BY RESETTING TIMERST1XMT EQU 001Q ;1 = TRANSMIT BUFFER EMPTY; CLEARED BY OUTPUTTING CHAR; CLEARED BY LOWERING CA; (NOTE THAT AFTER RAISING CA ; ST1XMT COMES UP WHEN CB=1);*************************************************; ; ST2 - INPUT STATUS BYTE #2; ;*************************************************ST2 EQU 050Q ;INPUT STATUS BYTE #2 ; ; BIT DEFINITIONS FOR INPUT STATUS BYTE #2; ST2MPT EQU 200Q ;1 = MULTIPOINT DATACOM CARDST2SYC EQU M3270*2 ;1 = SYNCHRONOUS CARD ST2CAZ EQU 040Q ;0 = DOWNLINE CA ON ST2CEZ EQU 020Q ;0 = CE ON (DATA SET RINGING; (1=LOOP-BACK SELF-TEST HOOD)ST2SBZ EQU 010Q ;0 = SB ON (SECONDARY CHANNLST2CCZ E@@7QU 004Q ;0 = CC ON (DATA SET READY) ST2CFZ EQU 002Q ;0 = CF ON (CARRIER)ST2CBZ EQU 001Q ;0 = CB ON (CLEAR TO SEND); ST2Z EQU ST2CEZ+ST2SBZ+ST2CCZ+ST2CFZ+ST2CBZ;*************************************************; ; CHARIN - RECEIVED CHARACTER; ;*************************************************CHARIN EQU 000Q ;INPUT CHARACTER ;*************************************************; ; OCTL1 - OUTPUT CONTROL BYTE #1; ;*************************************************OCTL1 EQU 040Q ;OUTPUT DATACOM COMMANDS;  ; OCTL1 BIT DEFINITIONS ; CT1ND2 EQU 200Q ;# OF DATA BITS CT1ND1 EQU 100Q ;# OF DATA BITS CT1D7 EQU CT1ND2 ;7 DATA BITS CT1D8 EQU CT1ND1+CT1ND2 ;8 DATA BITS CT1PAR EQU KBDPAR ;0 = ENABLE PARITY; MUST BE IN SAME POSITION AND; HAVE SAME SENSE AS KBDPAR CT1ODD EQU KBDODD ;0 = ODD PARITY, 1 = EVEN ; (USED ONLY WHEN CT1PAR = 0) ; MUST BE IN SAME POSITION AND; HAVE SAME SENSE AS KBDODD CT1BAU EQU 017Q ;BAUD RATE, ASSUMED = 017B; 00 = 19.2K BAUD; 01 = 50 BAUD; 02 = 75 BAUD; 03 = 110 BAUD; 04 = 134.5 BAUD; 05 = 150 BAUD; 06 = 300 BAUD; 07 = 600 BAUD; 10 = 200 BAUD; 11 = 1200 BAUD; 12 = 1800 BAUD; 13 = 2400 BAUD; 14 = 3600 BAUD; 15 = 4800 BAUD; 16 = 7200 BAUD; 17 = 9600 BAUD;*************************************************; ; OCTL2 - OUTPUT CONTROL BYTE #2; ;*************************************************OCTL2 EQU 100Q ;OUTPUT DATACOM COMMANDS;  ; OCTL2 BIT DEFINITIONS ; CT2CBD EQU 200Q ;1 = INHIBIT DOWNLINE CA & CCT2NU EQU 140Q ;NOT USED CT2CMM EQU 020Q ;1 = CHANNEL MONITOR MODE CT2CHZ EQU KB3CH/4 ;0 = CH ON (EUROPEAN SPEED) CT2CDZ EQU 004Q ;0 = CD ON (DATA TERM READY)CT2SAZ EQU 002Q ;0 = SA ON (SECONDARY RTS)CT2CAZ EQU 001Q ;0 = CA ON (REQUEST TO SEND); CT2Z EQU CT2CHZ+CT2CDZ+CT2SAZ+CT2CAZ ;*************************************************; ; TMIT - OUTPUT CHARACTER; ;*************************************************TMIT EQU 140Q ;OUTPUT DATA FOR TRANSMISSIOXCOMP EQU 010Q ;ENABLE TRANSMIT COMPLETE ; INTERRUPTSDISXMT EQU 200Q ;DISABLE TRANSMIT COMPLETE; INTERRUPTS ;*************************************************; ; MISCELLANEOUS IO COMMANDS ; ;*************************************************RTIME EQU 001Q ;RESET TIMER (TURN OFF) STIME EQU 002Q ;SET TIMER (TURN ON)RRECV EQU 004Q ;RESET SYNCRONOUS RECEIVER; (IGNORED BY ASYNC CARD) DCSYN EQU 150Q ;DEFINE SYNC CHARACTER; (IGNORED BY ASYNC CARD)  ;*************************************************; ; JC0 - DATACOM INPUT JUMPER #0 ; ;*************************************************JC0 EQU 100Q ;DATACOM OPTIONS; ; BIT DEFINITIONS FOR JC0 ; JC0EBC EQU HCODE ;1 = EBCDIC; 0 = ASCIIJC0CRC EQU CRC16 ;1 = CRC16 BCC; 0 = LRC BCC JC0IBM EQU M3270 ;IF SYNC CARD,; 1 = IBM 3270 DATACOM ; COMPATIBILITY OPTION ; IF ASYNC CARD,; 1 = PROVIDE SYNC FILLJC0ID EQU 037Q ;GROUP ID (0-32B; @-Z+SPACE) MASKID EQU JC0ID MAXID EQU 032Q ;MAXIMUM ID (OTHERS -> SPACE;*************************************************; ; JC1 - DATACOM INPUT JUMPER #1 ; ;*************************************************JC1 EQU 110Q ;DATACOM OPTIONS;  ; BIT DEFINITION FOR JC1 ; JC1BSZ EQU 300Q ;INPUT BUFFER SIZE; 00 = 512 BYTES ; 01 = 1024 BYTES; 10 = 2048 BYTES; 11 = 4096 BYTES BUFSIZ EQU JC1BSZ JC1BKI EQU BLKIN ;1 = BLOCK INPUT MODE JC1ID EQU MASKID ;DEVICE ID; SAME RULES AS ; GROUP ID  ;*************************************************; ; CHARACTER DEFINITIONS; ;*************************************************ACK0I EQU 060Q ;ASCII ACK0ACK0E EQU 160Q ;EBCDIC ACK0 ACK1I EQU 061Q ;ASCII ACK1ACK1E EQU 141Q ;EBCDIC ACK1 EOTI EQU 004Q ;ASCII EOT ETXI EQU 003Q ;ASCII ETX ETBI EQU 027Q ;ASCII ETB ENQI EQU 005Q ;ASCII ENQ DLEI EQU 020Q ;ASCII DLE WACKI EQU 073Q ;ASCII WACKWACKE EQU 153Q ;EBCDIC WACK RVII EQU 074Q ;ASCII RVI RVIE EQU 174Q ;EBCDIC RVIRVIACK EQU 70174Q ;ACK0E*256+RVIEACKWAC EQU 65541Q ;WACKE*256+ACK1E NAKI EQU 025Q ;ASCII NAK GCHARI EQU 042Q ;ASCII QUOTE ; GROUP POLL CHARACTER WCHARI EQU 175Q ;ASCII RIGHT BRACE ; WHO-ARE-YOU CHARACTERBCHARI EQU 176Q ;ASCII TILDA ; BROADCAST CHARACTERSTXI EQU 002Q ;ASCII STX ENTERI EQU 047Q ;ASCII ENTER KEY ; (3270 COMPATIBILITY) SPACEI EQU 040Q ;ASCII SPACE SYNCI EQU 026Q ;ASCII SYNCATSINI EQU 100Q ;ASCII @ DASHI EQU 055Q ;ASCII - LOWERI EQU 040Q ;BIT TO TURN ON FOR; UPPER-TO-LOWER ; CASE CONVERSIONTPADI EQU 177Q ;ASCII TRAILING PADTPADE EQU 377Q ;EBCDIC TRAILING PAD DC1 EQU 021Q ;BLOCK TRIGGER RS EQU 036Q ;RECORD SEPERATORGS EQU 035Q ;BLOCK TERMINATOR ;*************************************************; ; MISCELLANEOUS DEFINITIONS ; ;*************************************************STOPER EQU 000Q ;TERMINATES ALL TRANSMITION ; STRINGS (EXCEPT BCC); EOP EQU 316Q ;TERMINATES MAINCODE MSGS ; BLKMIN EQU 256-64 ;IF FQ EMPTY AND; PCNT > BLKMIN IN LAST BUFF; IN DQ, THEN SEND WACK ; CNT327 EQU 003Q ;# OF CHARS TO STRIP OFF; IN 3270 TEXT MODE ; AIDFLG EQU 200Q ;FLAGS SHORT ENTER-AID; ASSUMED = 200B ;*************************************************;  ; DATACOM CONSTANTS ; ;************************************************* ORG ZDCBAS ;  DB 'Q' ;ROM IDENTIFIER BYTE PAIR ; (DATACOM VERSION #2) DB ZDCBAS/256 ;  ORG TRIGGR ;  DB DC1 ;TRIGGR - BLOCK TRIGGER  DB RS ;RECSEP - RECORD SEPARATOR DB GS ;BLKTRM - BLOCK TERMINATOR DB 000Q ;DCJMSK - JUMPER MASK ; (ALL DC JUMPERS MODIFIABLE; BY ESCAPE SEQUENCES) DB 000Q ;DCJMS2 - JUMPER MASK #2;*************************************************; ; DATACOM ENTRY VECTORS; ;************************************************* ORG ZINIDC ;BEGINNING OF JUMP VECTORS;  JMP INITDC ;ZINIDC - INITIALIZE DATACOM JMP INI2DC ;ZIN2DC - CONTINUE INIT  JMP DCMON ;ZDCMON - MONITORING ROUTINE JMP DCCTL ;ZDCCTL - MISC CTL FUNCTIONS JMP DCTEST ;ZDCTST - SELF-TEST  JMP GETDC ;ZGETDC - CHARACTER INPUT  JMP PUTDC ;ZPUTDC - CHARACTER OUTPUT JMP GETBIN ;ZGTBIN - BINARY INPUT JMP STBIN ;ZSTBIN - START BINARY OUT JMP ENDBIN ;ZNDBIN - END BINARY OUTPUT  ;************************************************ ; ; STANDARD ENTRY POINT FOR ALL ; INTERRUPTS; SAVE STATUS AND; JUMP THROUGH VECTOR #1 ; ;************************************************ DCINTR EQU $ ;WARNING: MUST FOLLOW ENDBINENTRY: PUSH B ;WARNING: REGISTERS MUST BE  PUSH D ;PUSHED IN THIS ORDER  PUSH H ;REQUIRED BY DCCTL PUSH PSW ;  LDA IODC+ST1 ;DATACOM STATUS BYTE #1  MOV D,A ;  LXI H,IODC+CHARIN ;INPUT CHARACTER MOV B,M ;  LXI H,CONFIG ;CONFIGURATION BYTE  MOV C,M ;  JMP ASJMP1 ;DISPATCH INTERRUPT  ;  ; INITIAL RAM VALUES ; COPY1 EQU BCSTOP ;INIT BCSTOP -> ENQ XLAT1 EQU COPY1+1 ;TRANSLATE ALL BUT BCSTOP ;  ; BCC TRANSMIT STRING ; RAMTBL:DB ASBLOW ;LOW ORDER ADDR OF LAST ; BYTE IN TRANSMIT BCC;  DB DLEI ;START OF TRANSPARENT BCC  DB ETBI ;BEGINNING OF BCC TRAILER  DB 0,0 ;WORK AREA TO COMPUTE CRC  DB TPADI ;FOLLOW BCC BY PAD DB STOPER ;TRANSMIT TERMINATOR DB STOPER ;INITIAL RT BYTE OF BCC ; ; BLOCK HEADER WITH NO GROUP/DEVICE ID'S;  DB DLEI ;START OF TRANSPARENT HEADER DB STXI ;BEG OF NON-TRANSPARENT HDR  DB STOPER ;TRANSMIT TERMINATOR;  DB EOTI ;EOT ; ; BLOCK HEADER WITH GROUP/DEVICE ID'S ;  DB DLEI ;START OF TRANSPARENT HDR  DB STXI ;BEGINNING OF HEADER DB 0 ;HOLE FOR GROUP ID DB 0 ;HOLE FOR DEVICE ID  DB ENTERI ;FILL IN WITH STOPER; TO SET UP NON-3270 HDR DB SPACEI ;3270 MODE HEADER  DB SPACEI  DB STOPER ;TERMINATOR FOR 3270 HDR;  DB DLEI ;START OF TRAILER  DB 0 ;HOLE FOR RESPONSE DB TPADI ;RESPONSES FOLLOWED BY PAD DB STOPER ;TRAILER TERMINATOR ;  ; SYNCHRONOUS LEADER ; AND NON-TRANSPARENT SYNC FILL;  DB SYNCI,SYNCI,SYNCI,SYNCI  DB STOPER ;TRANSMIT TERMINATOR;  DB ENTERI,SPACEI ;COPY OF ENTER-SPACE ; FILL IN WITH STOPERS ; TO SET UP NON-3270 ;  ; TRANSPARENT SYNC FILL ;  DB DLEI,DLEI,SYNCI,DLEI,SYNCI DB STOPER ;TRANSMIT TERMINATOR;  DB NAKI ;NAK DB RVII ;RVI  DB ACK0I ;ACK0  DB ACK1I ;ACK1  DB WACKI ;WACK ;  ; CONTROL SEQUENCE TABLE ;  DB 0,0 ;HOLES FOR GROUP&SELECT IDS  DB BCHARI,BCHARI ;BROADCAST CHAR DB 0,0 ;2 HOLES FOR DEVICE ID DB GCHARI ;GENERAL POLL CHAR DB WCHARI ;WHO-ARE-YOU CHAR ;  ; POLL LIST FOR DRIVER ;  DB 101Q,101Q ;GROUP "A"  DB GCHARI,GCHARI ;GENERAL POLL DB ENQI,TPADI,STOPER ;  ; SELECT LIST FOR DRIVER ;  DB 141Q,141Q ;GROUP "A"  DB 101Q,101Q ;DEVICE "A" DB ENQI,TPADI,STOPER ; ; CONTROL CHARACTERS WHICH TERMINATE DATA BLKS;  DB ETBI,ETXI,ENQI ;  NCOPY1 EQU $-RAMTBL NXLAT1 EQU NCOPY1-1 ; COPY2 EQU CONFG2 ;INIT CONFG2 -> ASJMP2; RAMTB2:DB 0 ;INITIAL VALUE FOR CONFG2  DB 1 ;ABORT TIMER = 40MSEC  DB JMPOP ;ASJMP1  DW EOTIN ;1ST DATACOM INTERRUPT DB JMPOP ;ASJMP2 ;  NCOPY2 EQU $-RAMTB2  ;*************************************************; ; COMPRESSED TRANSLATE TABLES; ; THE TRANSLATE TABLES ARE COMPRESSED BY; REPLACING CERTAIN CHARACTER STRINGS ; BY SPECIAL COMPRESSION CODES; ; 1) OPCODE = SET-TO-SYNC  ; BIT 0 = 1 ; BITS 5-1 = # OF BYTES TO BE FILLED LESS 1; WITH SYNC CHARS  ; BITS 7-6 = 0 ; ; 2) OPCODE = SEQUENTIAL-STRING  ; BIT 0 = 0 ; BIT 1 = 1 ; BITS 6-2 = # OF BYTES TO BE FILLED LESS 1 ; BIT 7 = 0 ; ; NEXT BYTE IN XTABLE = 1ST BYTE IN STRING ; ; 3) OPCODE = EXCEPTION STRING ; BITS 1-0 =0 ; BIT 2 = 1 ; BITS 7-3 = # OF BYTES TO BE FILLED LESS 1; ; THE NEXT N BYTES (N = # IN BITS 7-3) ; CONTAIN THE EXCEPTION STRING ;  ; 4) TERMINATOR ; BITS 2-0 = 0 ; ; CPYSYN EQU 1Q ;OPCODE = SET-TO-SYNC MLTSYN EQU 2Q ;MULTIPLIER FOR COUNT ; CPYSEQ EQU 2Q ;OPCODE = SEQUENTIAL-STRING MLTSEQ EQU 4Q ;MULTIPLIER FOR COUNT ; CPYSTR EQU 4Q ;OPCODE = EXCEPTION-STRINGMLTSTR EQU 10Q ;MULTIPLIER FOR COUNT  ; ; COMPRESSED HEXOUT TABLE ; (ASCII TO EBCDIC TRANSLATE TABLE) ; ; TABLE IS 1-TO-1 WITH THE ; FOLLOWING EXCEPTIONS ; 1) LEFT-BRACKET CONVERTED TO LEFT-PAREN; 2) RGHT-BRACKET CONVERTED TO RGHT-PAREN; 3) CIRCUMFLEX CONVERTED TO SEMI-COLON; XTABLE:DB 3*MLTSEQ+CPYSEQ ;(ASCII 0-3) DB 0 ;NUL SOH STX ETX;  DB 6*MLTSTR+CPYSTR ;(ASCII 4-12)  DB 67Q,55Q,56Q,57Q ;EOT ENQ ACK BEL DB 26Q,5Q,45Q ;BS HT LF ;  DB 8*MLTSEQ+CPYSEQ ;(ASCII 13-23) DB 13Q ;VT FF CR SO SI DL; DC1 DC2 DC3 ;  DB 7*MLTSTR+CPYSTR ;(ASCII 24-33) DB 74Q,75Q,62Q,46Q ;DC4 NAK SYN ETB DB 30Q,31Q,77Q,47Q ;CAN EM SUB ESC ;  DB 3*MLTSEQ+CPYSEQ ;(ASCII 34-37) DB 34Q ;FS GS RS US;  DB 15*MLTSTR+CPYSTR ;(ASCII 40-57) DB 100Q,132Q,177Q ;SPACE ! " DB 173Q,133Q,154Q ;# $ % DB 120Q,175Q,115Q ;& ' ( DB 135Q,134Q,116Q ;) * + DB 153Q,140Q,113Q ;, - . DB 141Q ;/;  DB 9*MLTSEQ+CPYSEQ ;(ASCII 60-71) DB 360Q ;0 1 2 3 4 5; 6 7 8 9 ;  DB 6*MLTSTR+CPYSTR ;(ASCII 72-100)  DB 172Q,136Q,114Q ;: ; < DB 176Q,156Q,157Q ;= > ? DB 174Q ;@;  DB 8*MLTSEQ+CPYSEQ ;(ASCII 101-111) DB 301Q ;A B C D E F G H I;  DB 8*MLTSEQ+CPYSEQ ;(ASCII 112-122) DB 321Q ;J K L M N O P Q R;  DB 7*MLTSEQ+CPYSEQ ;(ASCII 123-132) DB 342Q ;S T U V W X Y Z;  DB 5*MLTSTR+CPYSTR ;(ASCII 133-140) DB 115Q ;LEFT-BRACKET  DB 340Q ;BACK-SLASH  DB 135Q ;RIGHT-BRACKET DB 136Q ;CIRCUMFLEX  DB 155Q ;UNDERSCORE  DB 171Q ;ACCENT ;  DB 8*MLTSEQ@@8+CPYSEQ ;(ASCII 141-151) DB 201Q ;A B C D E F G H I;  DB 8*MLTSEQ+CPYSEQ ;(ASCII 152-162) DB 221Q ;J K L M N O P Q R;  DB 7*MLTSEQ+CPYSEQ ;(ASCII 163-172) DB 242Q ;S T U V W X Y Z;  DB 4*MLTSTR+CPYSTR ;(ASCII 173-177) DB 300Q ;LEFT-BRACE  DB 152Q ;BROKN VERTICAL BA DB 320Q ;RIGHT-BRACE DB 241Q ;TILDA DB 007Q ;DELETE   ; COMPRESSED HEXIN TABLE ; (EBCDIC TO ASCII TRANSLATE TABLE; ; UNTRANSLATABLE AND UNDEFINED ; CHARACTERS CONVERTED TO SYNC'S ; DNT MEANS DOES NOT TRANSLATE ; ND MEANS NOT DEFINED ;  DB 3*MLTSEQ+CPYSEQ ;(EBCDIC 0-3)  DB 0 ;NUL SOH STX ETX;  DB 3*MLTSTR+CPYSTR ;(EBCDIC 4-7)  DB SYNCI,11Q ;DNT HT  DB SYNCI,177Q ;DNT DELETE ;  DB 2*MLTSYN+CPYSYN ;(EBCDIC 8-A) ; ND ND DNT ;  DB 8*MLTSEQ+CPYSEQ ;(EBCDIC B-13) DB 13Q ;VT FF CR SO SI ; DLE DC1 DC2 DC3 ;  DB 1*MLTSYN+CPYSYN ;(EBCDIC 14-15) ; DNT DNT ;  DB 3*MLTSTR+CPYSTR ;(EBCDIC 16-19)  DB 10Q,SYNCI ;BS DNT  DB 30Q,31Q ;CAN EM ;  DB 1*MLTSYN+CPYSYN ;(EBCDIC 1A-1B) ; DNT ND;  DB 3*MLTSEQ+CPYSEQ ;(EBCDIC 1C-1F)  DB 34Q ;IFS IGS IRS IUS;  DB 4*MLTSYN+CPYSYN ;(EBCDIC 20-24) ; DNT DNT DNT ND DNT;  DB 2*MLTSTR+CPYSTR ;(EBCDIC 25-27)  DB 12Q,27Q,33Q ;LF ETB ESC ;  DB 4*MLTSYN+CPYSYN ;(EBCDIC 28-2C) ; DNT DNT DNT ND DNT;  DB 2*MLTSEQ+CPYSEQ ;(EBCDIC 20-2F)  DB 5Q ;ENQ ACK BEL;  DB 6*MLTSYN+CPYSYN ;(EBCDIC 30-36) ; ND ND SYNC ND ; DNT DNT DNT ;  DB 0*MLTSTR+CPYSTR ;(EBCDIC 37) DB 4Q ;EOT;  DB 3*MLTSYN+CPYSYN ;(EBCDIC 38-38) ; ND ND ND ND ;  DB 4*MLTSTR+CPYSTR ;(EBCDIC 3C-40)  DB 24Q,25Q,SYNCI ;DC4 NAK ND  DB 32Q,40Q ;SUB SPACE;  DB 9*MLTSYN+CPYSYN ;(EBCDIC 41-4A) ; ND ND ND ND ND; ND ND ND ND DNT ;  DB 5*MLTSTR+CPYSTR ;(EBCDIC 4B-50)  DB 56Q,74Q,50Q ;. < ( DB 53Q,SYNCI,46Q ;+ DNT &;  DB 8*MLTSYN+CPYSYN ;(EBCDIC 51-59) ; ND ND ND ND ND; ND ND ND ND ;  DB 7*MLTSTR+CPYSTR ;(EBCDIC 5A-61)  DB 41Q,44Q,52Q,51Q ;! $ * ) DB 73Q,SYNCI,55Q ;; DNT - DB 57Q ;/;  DB 7*MLTSYN+CPYSYN ;(EBCDIC 62-69) ; ND ND ND ND ; ND ND ND ND ;  DB 5*MLTSTR+CPYSTR ;(EBCDIC 6A-6F)  DB 174Q ;BROKN VERTICAL BA DB 54Q,45Q,137Q ;, % - DB 76Q,77Q ;> ?;  DB 8*MLTSYN+CPYSYN ;(EBCDIC 70-78) ; ND ND ND ND ND; ND ND ND ND ;  DB 7*MLTSTR+CPYSTR ;(EBCDIC 79-80)  DB 140Q,72Q,43Q ;' : # DB 100Q,47Q,75Q ;@ ' = DB 42Q,SYNCI ;' ND ;  DB 8*MLTSEQ+CPYSEQ ;(EBCDIC 81-89)  DB 141Q ;A B C D E F G H I;  DB 6*MLTSYN+CPYSYN ;(EBCDIC 8A-90) ; ND ND ND ND ND; ND ND ;  DB 8*MLTSEQ+CPYSEQ ;(EBCDIC 91-99)  DB 152Q ;J K L M N O P Q R;  DB 6*MLTSYN+CPYSYN ;(EBCDIC 9A-A0) ; ND ND ND ND ND; ND ND ;  DB 0*MLTSTR+CPYSTR ;(EBCDIC A1) DB 176Q ;TILDA;  DB 7*MLTSEQ+CPYSEQ ;(EBCDIC A2-A9)  DB 163Q ;S T U V W X Y Z;  DB 21*MLTSYN+CPYSYN ;(EBCDIC AA-BF) ; ND ND .... ND ND;  DB 0*MLTSTR+CPYSTR ;(EBCDIC C0) DB 173Q ;LEFT-BRACE ;  DB 8*MLTSEQ+CPYSEQ ;(EBCDIC C1-C9)  DB 101Q ;A B C D E F G H I;  DB 5*MLTSYN+CPYSYN ;(EBCDIC CA-CF) ; ND ND ND ND ND ND ;  DB 0*MLTSTR+CPYSTR ;(EBCDIC D0) DB 175Q ;RIGHT-BRACE;  DB 8*MLTSEQ+CPYSEQ ;(EBCDIC D1-D9)  DB 112Q ;J K L M N O P Q R;  DB 5*MLTSYN+CPYSYN ;(EBCDIC DA-DF) ; ND ND ND ND ND ND ;  DB 1*MLTSTR+CPYSTR ;(EBCDIC E0-E1)  DB 134Q,SYNCI ;BACKSLASH ND ;  DB 7*MLTSEQ+CPYSEQ ;(EBCDIC E2-E9)  DB 123Q ;S T U V W X Y Z;  DB 5*MLTSYN+CPYSYN ;(EBCDIC EA-EF) ; ND ND ND ND ND;  DB 9*MLTSEQ+CPYSEQ ;(EBCDIC F0-F9)  DB 60Q ;0 1 2 3 4; 5 6 7 8 9 ;  DB 5*MLTSYN+CPYSYN ;(EBCDIC FA-FF) ; ND ND ND ND ND ND ;  DB STOPER ;TERMINATES TABLES ;*************************************************; ; INITDC; INITIALIZE DATA COMMUNICATIONS ; ; ENTRY DATACOM INTERRUPTS DISABLED ;  ; EXIT A DESTROYED ; ALWAYS RETURNS NC ; B,C = # CONTIGUOUS BYTES NEEDED FOR ; DATACOM BUFFERS (NOTE B,C ALSO ; SAVED IN BUFLOC) ; ;*************************************************; ; ENTRY POINT ; ; CALCULATE REQUIRED BUFFER SIZE; # BYTES = 512 * (2**N) + 256+128, WHERE ; N=JC1SIZ JUMPERS AND EXTRA 384 BYTES ; INCLUDED ONLY IF HCODE JUMPER SET; INITDC:LDA IODC+JC1 ;DATACOM JUMPER #1 RLC ;WANT BUFFER SIZE (BUFSIZ) RLC ;RIGHT JUSTIFIED CALL SHIFT ;CALCULATE 1*(2**A)  RLC ;RESULT IS # BUFFERS TO GET ; (00=2, 01=4, 10=8, 11=16) ; ; ADD IN TRANSLATION TABLE SIZE IF NECESSARY; INIS10:PUSH H ;H,L = # BYTES TO REQUEST  MOV H,A ;(NOTE H=# 256 BYTE BUFFERS  MVI L,0 ;L=0 FOR 256 ALIGNMENT)  LDA IODC+JC0 ;DATACOM JUMPER #0 ANI HCODE ;IF HCODE JUMPER SET MOV C,A ;THEN B,C = 384=128+256  RLC ;ELSE B,C = 0  MOV B,A  DAD B ;H,L = TOTAL # BYTES;  SHLD BUFLOC ;SAVE FOR INI2DC MOV B,H ;RET BUFFER REQUEST IN B,C MOV C,L  POP H  RET ;*************************************************; ; INI2DC; INITIALIZE DATA COMMUNICATIONS ; ; ENTRY DATACOM INTERRUPTS SHOULD BE; DISABLED UNTIL AFTER CALL TO INI2DC ; ; D,E = STARTING ADDRESS OF DATA COM; BUFFER SPACE ; BUFLOC = # OF BYTES REQUESTED BY ; INITDC ; NOTE THAT 256 ALIGNMENT IS REQUIRED ; AT THE TOP OF SPACE ALLOCATED; (IE, D,E + BUFEND MUST RESULT; IN A 0 LOW ORDER BYTE) ; ; EXIT A,D,E DESTROYED ; NC NO ERRORS DETECTED ; C ERROR = NO MULTIPOINT CARD ; H,L = ADDR OF ERROR MESSAGE; ;*************************************************; COMPUTE BUFFER AND TRANSLATE TABLE LOCATIONS; ENTRY D,E = STARTING ADDRESS ; BUFLOC = # BYTES REQUESTED ; EXIT HCODE JUMPER OFF ; BUFBEG = D ; BUFEND = (D + #BUFFS) - 1; ; HCODE JUMPER ON; HEXOUT = D,E ; HEXIN = D+1 ; BUFBEG = D+2 ; BUFEND = (D+2 + #BUFFS) - 1; IN EITHER CASE, BUFMAX=0,1,3, OR 7; AS GIVEN BY BLKSIZ  ; ; ENTRY POINT ; INI2DC:PUSH H ;SAVE CALLER'S REGS ;  LHLD BUFLOC ;D,E = # BYTES REQUESTED XCHG ;H,L = STARTING ADDR MOV A,E ;HCODE JUMPER ON ? ANA A ;(YES,#BYTES NOT 256 ALIGNED JZ INIZ10 ;NO, BRANCH ; ; HERE TO SET UP TRANSLATE TABLE ADDRESSES;  SHLD HEXOUT ;HEXOUT TABLE = 1ST 128 BYTE INR H ;(ASSUMES TOP OF TABLE ON  MOV A,H ;256 BOUNDARY) STA HEXIN ;HEXIN TABLE = NEXT 256 BYTE INR H ;NEXT 256 CHUNK = 1ST BUFFER DCR D ;ADJUST #256 CHUNKS REQUESTE; TO REFLECT ONLY # BUFFS ; ; HERE TO SET UP BUFFER BOUNDARIES; INIZ10:MOV A,H ;STARTING ADDRESS,LESS TABLE STA BUFBEG ;ADDR OF 1ST 256-BYTE BUFFER ADD D ;PLUS # BUFFERS REQUESTED  DCR A ;(ADJUST TO LOWER ADDR)  STA BUFEND ;ADDR OF LAST 256-BYTE BUFFE;  ; HERE TO SET UP BUFMAX ; (MAXIMUM # BUFFERS PER OUTPUT BLOCK);  LDA KBJMP3 ;KEYBOARD DATACOM JUMPERS  RRC ;WANT BLOCK SIZE (BLKSIZ) ; RIGHT JUSTIFIED  DCR A ;MAP 0->3, 1->0, 2->1, 3->2  CALL SHIFT ;CALCULATE 1*(2**A) ; RESULT: 1,2,4 OR 8 CMP D ;BLKSIZ SHOULD BE LESS THAN  JC INIZ20 ;THE # BUFFERS REQUESTED MOV A,D ;IF NOT, TAKE MAX ALLOWED  RAR ;2->1, 4->2, 8->4, 16->8INIZ20:DCR A ;(PUTDC WANTS TO DCR BUFCNT ; AND JUMP ON MINUS) STA BUFMAX ;MAX #BUFFERS IN; TRANSMISSION BLOCK;  POP H ;FALL INTO "SOFT RESET"  ;************************************************ ; ; INIRST; "SOFT RESET" - ALL DATACOM INIT; EXCEPT BUFFER ALLOCATION ; ; ENTRY MUST ENTER WITH INTERRUPTS DISABLED ;  ; EXIT A DESTROYED ; INTERRUPTS AS AT ENTRY; ;************************************************ INIRST:PUSH B ;SAVE CALLER'S REGS  PUSH D  PUSH H ;  ; INITIALIZE RAM AREAS ; SPECIFICALLY, COPY1 --> COPY1+NCOPY1-1; COPY2 --> COPY2+NCOPY2-1;  LXI H,RAMTBL ;SOURCE OF COPY = RAMTBL LXI D,COPY1 ;DESTINATION OF COPY MVI C,NCOPY1-1 ;# BYTES TO COPY, LESS 1 CALL CPYTBL ;COPY THE TABLE ; ; SOURCE OF COPY = RAMTB2  LXI D,COPY2 ;DESTINATION OF COPY MVI C,NCOPY2-1 ;# BYTES TO COPY, LESS 1 CALL CPYTBL ;COPY THE TABLE ;  LXI H,CMFLGS ;DATACOM IS NOW IN CONTROL MOV A,M ;MODE, SO MUST TURN ON ORI BLKTRG ;BLOCK-TRIGGER MODE FOR  MOV M,A ;MAINCODE ; ; CHECK FOR DIAGNOSTIC HOOKS;  LDA IODC0+IODCST ;DIAGNOSTIC HOOKS  STA DCFLGS ;SET DIAGNOSTIC FLAGS  ANA A ;DIAGNOSTIC DC BOARD ? JNZ DIAGDC ;YES, GO TO DIAGNOSTIC INIT ;  MVI A,STBLMD ;SET PERMANENT BLOCK MODE  CALL ZKBCTL ;KEYBOARD CONTROL ROUTINE ;  STA IODC+RTIME ;START DATACOM TIMER STA IODC+STIME ;  LDA IODC+JC0 ;DATACOM JUMPER #0 MOV B,A  ANA A ;EBCDIC TRANSMISSION ? JP INIT99 ;NO, SKIP TRANSLATE TBL INIT ; THIS SECTION EXPANDS CODE TRANSLATION TABLES; CONSULT DEFINITION OF XTABLE FOR DESCRIPTION; OF COMPRESSED TABLE FORMAT. ; ; ENTRY HEXOUT = ADDR OF 128-ALIGNED BLOCK; TO BE USED FOR ASCII TO EBCDIC ; TRANSLATE TABLE; HEXIN = ADDR OF 256-ALIGNED BLOCK ; TO BE USED FOR EBCDIC TO ASCII ; TRANSLATE TABLE; CAUTION: HEXIN MUST = HEXOUT+128; ;  LHLD HEXOUT ;D,E = ADDR OF 1ST BYTE IN XCHG ;ASCII TO EBCDIC TRANSLATE; TABLE (128 ALIGNED)  LXI H,XTABLE-1 ;H,L=ADDR OF 1ST BYTE IN; COMPRESSED TRANSLATE TABLE PUSH B ;SAVE DATACOM JUMPERS  ; ; LOOP TO EXPAND XTABLE ONE ; COMPRESSION CODE AT A TIME; INITRN:INX H ;PT TO NXT COMPRESSION CODE INIT10:CMP A ;SET CARRY TO 0  MOV A,M ;FETCH NEXT COMPRESSION CODE RAR ;OPCODE = SET-TO-SYNC ?  MOV C,A ;ASSUME YES, C=# OF SYNC BYT MVI A,SYNCI ;SET UP TO STORE (C) SYNC'S  MVI B,0 ;(DON'T INR THE CONSTANT)  JC INIT20 ;BRANCH WHEN SET-TO-SYNC COD; ; HERE WHEN OPCODE = SEQUENTIAL-STRING; OR = EXCEPTION-STRING ;  INX H ;IN EITHER CASE, WILL NEED; H,L POINTING TO NEXT BYTE  MOV A,C ;RESTORE COMPRESSION CODE  RAR ;OPCODE = SEQUENTIAL-STRING? JNC INIT30 ;NO  MOV C,A ;YES, C=# BYTES IN STRING  MOV A,M ;FIRST # IN THE STRING INR B ;SEQUENTIAL-STRING =; (A), (A)+1, (A)+2,... ; ; HERE WHEN OPCODE = SET-TO-SYNC; OR = SEQUENTIAL-STRING; INIT20:CALL CONSTI ;EXPAND THE STRING JMP INITRN ;CONTINUE WITH NEXT OPCODE; ; HERE WHEN OPCODE = EXCEPTION-STRING ; INIT30:RAR ;OPCODE = EXCEPTION-STRING?  JNC INIT40 ;NO THEN JUST SAW TERMINATOR MOV C,A ;YES, C=# BYTES IN STRING  CALL CPYTBL ;COPY STRING INTO TABLE  JMP INIT10 ;CONTINUE WITH NEXT OPCODE;  ; HERE WHEN DONE ; INIT40:POP B ;RESTORE DATACOM JUMPERSINIT99 EQU $  ; THIS SECTION COMPUTES THE BAUD RATE FROM THE; KEYBOARD DATACOM SWITCHES; OPERATES CH; ; 1) MAPS KBDBAU (BITS 7,3,2,1) OF KBDCSW ; (KEYBOARD DC SWITCHES) INTO CT1BAU ; (BITS 3,2,1,0) OF IODC+OCTL1 (DC BOARD); ACCORDING TO THE FOLLOWING MAPPING:; (0,1,2,...,7) --> (11,12,...,17,0); (10,11,...,14) --> (1,2,...,5) ; (15) --> (10); (16,17) --> (6,7) ;  ; ENTRY B = IODC+JC0 ; ; EXIT B = IODC+JC0 DATACOM JUMPER #0; C = IODC+JC1 DATACOM JUMPER #1; D = KBDCSW KEYBOARD DC SWITCHES; E = BAUD RATE, MAPPED, RT-JUSTIFIED ;  LDA IODC+JC1 ;DATACOM JUMPER #1 MOV C,A  LDA KBDCSW ;KEYBOARD DATACOM SWITCHES MOV D,A ; ; COLLECT BAUD BITS INTO LOWER HALF OF A;  ANI KBDBAU ;CLEAR ALL BUT BAUD (7321) XRI 200Q ;FLIP SENSE OF HI/LO SWITCH  JP @@9 INIBAU ;JUMP IF D7 IS OFF ORI 020Q ;IF D7 ON, TURN ON D4 INIBAU:RRC ;BITS COLLECTED, NOW RT-JUST ANI CT1BAU ;AND CLEAR LEFT HALF;  ; NOW DO THE MAPPING ;  CPI 10Q ;BRANCH TO INIB10 IF JP INIB10 ;(A) < 10B AND CPI 5 ;(A) > 4 JM INIB10 ; WHEN HERE MUST BE 5,6 OR 7 JNZ INIB20 ;NO CHANGE IF 6 OR 7 MVI A,10Q-1 ;5 MAPS TO 10 ; INIB10:INR A ;MAP (A) TO (A)+1  ANI CT1BAU ;MOD 20B; INIB20:MOV E,A ;MAPPING DONE  ; THIS SECTION SETS UP CONFIG, IODC+OCTL1,; CTL2, WRUSTS+0, WRUSTS+1 AND ASACNT; ; 0) TURN ON CH IF KB3CH=1; ENABLE DOWNLINE CB & CA; NO MONITOR MODE; CD ON; SA,CA OFF; ; 1) CONFIG FLAGS HCODE,CRC16,M3270 ARE COPIES; OF D7,D6,D5 OF DATACOM JUMPER #0 ; (NOTE THAT M3270 IS TURNED OFF BY; LDR-HDR ROUTINE IF RUNNING WITH; ASYNCRONOUS DATACOM CARD); ; 2) CONFIG FLAG PMASK: ; PMASK = (KBDPAR OR KB3PMS OR CRC16) ; AND (NOT HCODE); PMASK & HCODE MUST BE MUTUALLY EXCLUSIVE ; ; 3) CONFIG FLAGS VRC2,VRC1 ARE GIVEN BY; A) VRC=00 IF INPUT=1X0 (FORCE 0); B) VRC=01 IF INPUT=00X (ODD PARITY) ; C) VRC=10 IF INPUT=01X (EVEN PARITY); D) VRC=11 IF INPUT=1X1 (FORCE 1); WHERE "X" MEANS DON'T CARE AND "INPUT" ; REFERS TO THE 3 BITS KBDPAR,; KBDODD,KB3PMS, REPECTIVELY; ; 4) # OF DATA BITS (CT1ND2 & CT1ND1) ; # OF BITS = 8 WHEN ANY OF THE FOLLOWING; BITS ARE = 1: HCODE, CRC16, ; KB3PMS, KBDPAR; OTHERWISE # DATA BITS = 7; ; 5) CT1PAR=0 (ENABLE) IF #DATA BITS = 7; OTHERWISE CT1PAR=1 (DISABLE PARITY) ; CT1ODD=KBDODD (0=ODD); ; 6) WHO-ARE-YOU STATUS BYTE #1:; BITS 3-0 = BAUD RATE; BITS 5-4 = VRC2,VRC1 ; BIT 6 = 1 ; ; 7) WHO-ARE-YOU STATUS BYTE #2:; BIT 0 = BLKIN; BITS 2-1 = BUFSIZ ; BIT 3 = M3270; BIT 4 = CRC16; BIT 5 = HCODE ; BIT 6 = 1 ; ; 8) ASACNT = 1 IF KB3CC = 0; (NON-CONTINUOUS CARRIER); ASACNT=ABORTT IF KB3CC=1 ; (CONTINUOUS CARRIER); ; ENTRY B = IODC+JC0 DATACOM JUMPERS ; C = IODC+JC1 ; D = KBDCSW KEYBOARD DC SWITCHES ; E = BAUD RATE ; ; EXIT B,C UNMODIFIED; D,E,L DESTROYED ; H = CONFIG FLAGS ;  ; OPERATE CH (#0 ABOVE) ;  LDA KBJMP3 ;KEYBOARD DATACOM JUMPERS  MOV L,A  ANI KB3CH ;WANT JUST CH BIT  RRC ;MOVE TO CT2CHZ POSITION RRC XRI CT2CAZ+CT2SAZ+CT2CHZ; (TURN ON CH IF KB3CH=1)  STA CTL2; ; SET UP ASACNT (SEE #8 ABOVE);  MOV A,L ;KEYBOARD DATACOM SWITCHES ANI KB3CC ;CONTINUOUS CARRIER? JZ INICNT ;NO, TIMER ALREADY=40MSECS MVI A,ABORTT ;YES, SET ABORT TIMER=ABORTT STA ASACNT ;(ABORT TIMER COUNT)INICNT EQU $ ; ; SET UP CONFIG FLAGS (#1 ABOVE);  MOV A,B ;DATACOM JUMPER #0 ANI HCODE+CRC16+M3270  MOV H,A ;CONFIG FLAGS ; ; WHO-ARE-YOU STATUS BYTE #2 (#7 ABOVE);  MOV A,C ;DATACOM JUMPER #1 ANI BUFSIZ+BLKIN ;CLEAR OTHER JUNK RRC ;SHIFT RIGHT RRC ;TO MAKE ROOM FOR  RRC ;HCODE,CRC16,M3270 ORA H ;COLLECT JUMPERS 0 & 1 STC ;ALWAYS SET BIT #6 RAR ;RIGHT JUSTIFY THE STUFF RRC STA WRUSTS+1 ;COMPLETED WRU STATUS #2; ; SET UP VRC1 & VRC2 (#3 ABOVE) ;  MOV A,D ;KEYBOARD DATACOM SWITCHES ANI KBDPAR ;PARITY ODD OR EVEN? JZ INIP10 ;YES,BRANCH ; ; HERE IF PARITY DISABLED ;  MOV A,L ;KEYBOARD DATACOM JUMPERS  ANI KB3PMS ;CHECK FORCE PARITY SWITCH RLC ;KB3PMS=0, VRC2=0, VRC1=0  RAL ;KB3PMS=1, VRC2=1, VRC1=1  JMP INIP20 ;  ; HERE IF PARITY ENABLED ; INIP10:MOV A,D ;KEYBOARD DATACOM SWITCHES ANI KBDODD ;JUST ODD/EVEN BIT RLC RLC ;SHIFT KBDODD BIT INTO CARRY RLC RAL ;KBDODD=0, VRC2=0, VRC1=1  ACI VRCODD ;KBDODD=1, VRC2=1, VRC1=0 ; ; HERE WHEN HAVE VRC MASK SET UP; INIP20:ORA H ;COLLECT CONFIG FLAGS  MOV H,A ;DONE WITH CONFIG ; ; WHO-ARE-YOU STATUS BYTE #1 (#6 ABOVE);  ANI VRC2+VRC1 ;WANT JUST VRC2 & VRC1  RRC ;LEFT JUSTIFY  RRC STC ;ALWAYS SET BIT #6 RAR RRC ;NOW HAVE BIT#6 & VRC  ORA E ;COLLECT BIT#6, VRC & BAUD STA WRUSTS ;COMPLETE WRU STATUS #1 ; ; SET UP CONFIG FLAGS (SEE#2 ABOVE) ;  MOV A,D ;KEYBOARD DATACOM SWITCHES RLC ;MOVE KBDPAR TO SIGN BIT RLC ORA L ;KBDPAR OR KB3PMS  RRC ;MOVE TO CRC16 POSITION  ORA H ;KBDPAR OR KB3PMS OR CRC16 RLC ;MOVE BACK TO SIGN BIT MOV L,A ;L=KBDPAR OR KB3PMS OR CRC16 CMA ;IF HCODE = 1, THEN  ORA H ;MUST FORCE PMASK = 0  MOV A,H ;(FETCH CONFIG FLAGS)  JM INIPMS ;IF HCODE=0 AND KBDPAR=1 OR  ORI PMASK ;KB3PMS=1 OR CRC16=1 THEN  MOV H,A ;SET PMASK IN CONFIGINIPMS EQU $ ; ; SET UP # OF DATA BITS (#4 ABOVE); SET UP CT1PAR (#5 ABOVE);  ORA L ;KBDPAR OR KB3PMS OR CRC16; OR HCODE MVI A,CT1D7 ;IF ALL THOSE ARE 0, THEN  JP INIP30 ;#DATA BITS=7, ENABLE PARITY MVI A,CT1D8+CT1PAR ;IF ANY=1, THEN #DATA; BITS=8, NO PARITY; ; HERE WHEN HAVE #DATA & PARITY ; INIP30:ORA E ;COLLECT BAUD,#DATA,PARITY MOV E,A ; ; SET UP CT1ODD (SEE #5 ABOVE); INITIALIZE IODC+OCTL1 + CTL1;  MOV A,D ;KEYBOARD DATACOM SWITCHES ANI KBDODD ;GET ODD/EVEN BIT  ORA E ;COLLECT BAUD,#DATA,PARITY STA CTL1 STA IODC+OCTL1 ;DATACOM BOARD  ; 1) SET UP LDR & HDR AS FUNCTIONS OF ; SYNC/ASYNC AND IBM 3270 MODE:; A) SYNC & 3270 LDR, 3270 HDR ; B) SYNC LDR, SHORT HDR; C) ASYNC & 3270 LDR, SHORT HDR; D) ASYNC SHORT HDR ; ENTAID = COPY OF 1ST 2 BYTES OF 3270 ; MODE HEADER EXTENSION (IE, THE ; ENTER-SPACE COMBINATION) ; ; 2) TURN OFF M3270 CONFIG BIT IF ASYNC CARD; ; ENTRY B = IODC+JC0 DATACOM JUMPERS ; C = IODC+JC1 ; H = CONFIG FLAGS; ; EXIT B,C UNMODIFIED; D,E,H,L DESTROYED ; CONFIG STORED ;  LDA IODC+ST2 ;DATACOM STATUS  ANI ST2SYC ;1 = SYNCRONOUS CARD MOV L,A ;(SAVE SYNC/ASYNC BIT);  RRC ;MOVE TO M3270 POSITION  ORI 377Q-M3270 ;BITS TO LEAVE ON  ANA H ;M3270 BIT OFF IF ASYNC  STA CONFIG ;ALL DONE WITH CONFIG FLAGS ;  MOV A,B ;DATACOM JUMPER #0 ANI M3270 ;3270 MODE BIT ORA L ;COLLECT THE 2 BITS  JNZ INIHDR ; ; NO LEADER (OR SYNC FILL) IF ASYNC & NOT 3270;  LXI H,LDR ;ASSUME LDR ALREADY SET UP MVI M,STOPER ;PUT TERMINATOR IN 1ST BYTE ; INIHDR:CPI ST2SYC+M3270 ;BOTH SYNC & 3270?  JZ INIH99 ;YES, LEAVE 3270 HDR SET UP ; ; SHORT HEADER UNLESS BOTH SYNC & 3270 MODE ;  LXI H,STOPER ;H,L = STOPER'S  SHLD ID2+1 ;TERMINATE SHORT HEADER  SHLD ENTAID ;COPY OF ENTER-SPACE; INIH99 EQU $ ;DONE WITH HEADER JUNK ; THIS SECTION SETS UP DEVICE & GROUP IDS ; ; GID = GROUP ID + "@" (OR = SPACE; IF JUMPER ID > 32B) ; DID = DEVICE ID, AS ABOVE ; SID = GID, CONVERTED TO LOWER CASE; (OR = DASH IF GID = SPACE); GID ALSO COPIED INTO SLFID, CTLTBL; DID ALSO COPIED INTO SLFID+1,CTLTBL+4,  ; CTLTBL+5 ; ; ENTRY B = IODC+JC0 DATACOM JUMPERS  ; C = IODC+JC1 ; CONFIG SET UP ; ; EXIT B,C UNMODIFIED; D,E,H,L DESTROYED ;  MOV A,B ;DATACOM JUMPER #0 CALL INIDS ;COMPUTE GROUP ID  MOV L,A ;GROUP ID  CPI SPACEI ;CHECK FOR SPECIAL CASE  JNZ INII10 ;NOT SPACE SKIP SPECIAL CASE MVI A,DASHI ;IF GRP ID = SPACE, ; THEN SELECT ID = DASH ; WARNING: ASSUMES DASHI OR'D ; WITH LOWERI GIVES DASHI INII10:ORI LOWERI ;CONVERT @-Z TO LOWER CASE MOV D,A ;SELECT GROUP ID MOV A,C ;DATACOM JUMPER #1 CALL INIDS ;COMPUTE DEVICE ID MOV H,A ;DEVICE ID;  SHLD GID ;STORE DID AND GID SHLD SLFID ;STORE DID AND GID MOV E,L ;D=SELECT ID; E=GROUP ID MOV L,H ;H,L=DEVICE ID SHLD CTLTBL+4 ;STORE DID AND DID XCHG  SHLD CTLTBL ;STORE SID AND GID ; ; SET UP FLAG ; ; ENTER C = IODC+JC1 DATACOM JUMPER ;  MOV A,C ;DATACOM JUMPER #1 ANI BLKIN ;ALL OTHER FLAG BITS STA FLAG ;INIT'D BY THEIR USERS; ; SET UP BCC TRANSMISSION STRING;  ; ENTER B = IODC+JC0 ;  MOV A,B ;DATCOM JUMPER #0  ADD A ;IS BCC TO BE A CRC OR LRC ? JM INIBCC ;IF CRC16, ALREADY SET UP  LXI H,BCSTOP ;IF LRC, SHORTEN BCC STRING  DCR M ;(ADDR OF LAST BYTE IN BCC)  LHLD ASBCC+2 ;MOVE THE TPAD,0 LEFT  SHLD ASBCC+1 ;ONE BYTE  MOV A,L ;IF LRC, STA ASBCC0+1 ;INITIAL BCC = 0,TPAD INIBCC EQU $  ; ; TRANSLATE, OR COMPUTE PARITY, ; FOR CONTROL CHARACTERS IN RAM TABLES; MUST BE DONE AFTER GROUP/DEVICE ID & ; BCC STRING ARE SET UP ;  ; ENTER B = IODC+JC0 ;  PUSH B ;SAVE DATACOM JUMPERS  LXI H,XLAT1 ;BEG OF AREA TO TRANSLATE  MVI E,NXLAT1-1 ;# BYTES, LESS 1 CALL HEXPAR ;TRANSLATE OR DO PARITY  POP B ;RESTORE DATACOM JUMPERS;  MOV A,B ;DATCOM JUMPER #0  ANA A ;DID WE TRANSLATE THE TABLE? JP INIE99 ;NO, BRANCH ; ; SET UP ACK0E,ACK1E,WACKE,RVIE ;  LXI H,RVIACK ;FIX UP BAD TRANSLATION OF SHLD RVI ;ACK 0/1 WACK & RVI  LXI H,ACKWAC ;(THEY DON'T TRANSLATE SHLD ACK1 ;THROUGH TABLE CORRECTLY) ; INIE99 EQU $  ;  ; DEFINE SYNC CHARACTER ; MUST BE DONE AFTER CONTROL CHARACTER ; TABLES ARE TRANSLATED ;  LDA SYNC ;FETCH TRANLSATED SYNC CHAR  STA IODC+DCSYN ;TELL SYNC BOARD;  ; INITIALIZE BUFFERS ;  CALL BUFINI ; ; ; ; ; ENTRY POINT ; HERE TO RETURN WITH NC & Z CONDITION; (WITHOUT ENABLING INTERRUPTS) ; RTNCZ2:CMP A ;SET Z & NC CONDITION CODES  JMP RTHDB2 ;AND RETURN ; MUST NOT ENABLE INTERRUPTS; (SEE MAINCODE) ;*************************************************; ; DCMON ; OPERATE THE TRANSMIT LIGHT ;  ; ENTRY DON'T CARE ;  ; EXIT A DESTROYED ; ALWAYS RETURS WITH NC & Z ; 1) IF RUNNING WITH CC-LIGHT OPTION; TRANSMIT LIGHT TURNED ON IF CC ; IS ON, ELSE LIGHT OFF; 2) IF NOT RUNNING WITH CC-OPTION; LIGHT ON IF DATA COM ACTIVE. ; ELSE LIGHT OFF ; ;*************************************************; ; ENTRY POINT ; DCMON: LDA KBJMP3 ;KEYBOARD JUMPER 3 OPTIONS ANI KB3CCL ;WANT THE CC-LIGHT OPTION ?  JZ DCM020 ;NO ; ; HERE IF CC-LIGHT OPTION ;  LDA IODC+ST2 ;YES  CMA ;(ST2CCZ=1 IF CC ON) ANI ST2CCZ ;IS CC ON ?  JMP DCM030 ;NZ= CC ON; Z= CC OFF ; ; HERE IF NO CC-LIGHT OPTION ; DCM020:LDA ASFLAG ;ARE WE DOING ANYTHING ? ANA A ;Z= NO; NZ= YES ; ; HERE TO OPERATE THE LIGHT ; DCM030:JNZ ZSTXMT ;NZ = TURN ON THE LIGHT  JMP ZCLXMT ;Z = TURN OFF THE LIGHT  ;************************************************ ; ; DCCTL ; PROVIDE MISCELLANEOUS DATACOM CONTROLS ; ; ENTRY A = 0 CLEAR BLOCK TRANSFER; TRIGGER FLAG; 1 SET BLOCK TRANSFER; TRIGGER FLAG; 2 RESET DATACOM ; 3 NO-OP (SET REMOTE); 4 NO-OP (SET LOCAL) ; 5 BREAK-KEY FUNCTIONS ; 6 MODEM DISCONNECT; 7 TERMINATE MESSAGE ; 8 ENTER MONITOR MODE; 9 LEAVE MONITOR MODE; OR ENABLE KEYBOARD IN ; DRIVER MODE ; 10 FAST BINARY TAPE READ ; 11 ENTER SINGLE CHAR AID ; B = AID CHAR; 12 ENTER MULTI-CHAR AID; B = AID CHAR; 13 INVALID (SEND PROMPT) ;  ; EXIT A DESTROYED ; NC Z FUNCTION PERFORMED; NZ ILLEGAL CONTROL PARAMETER ; C Z CANNOT PERFORM FUNCTION ; ;************************************************ ; ; ENTRY POINT ; DCCTL: CPI DCMAX ;FUNCTION PARAMETER LEGAL ?  RNC ;NO, RETURN WITH NC & NZ;  PUSH B ;(SAVE SAME REGS AS INI2DC)  PUSH D  PUSH H  ; ; COMPUTE ADDRESS OF APPROPRIATE HANDLER;  LXI H,DCCTBL ;ADDR OF DISPATCH TABLE  ADD A ;MULTIPLY FUNCTION # BY 2  MOV E,A ;D,E = OFFSET INTO MVI D,0 ;DISPATCH TABLE  DAD D ;H,L = ADDR OF THE ADDR ; OF THE FUNCTION HANDLER  MOV E,M ;NOW FETCH HANDLER ADDR  INX H ;FROM TABLE INTO D,E MOV D,M ; ; DISPATCH TO HANDLING ROUTINE; ; EXIT D,E = ADDR OF CMFLGS; A = B (ENTRY PARAMETER)  ; B = 0 ; C = BUFBC+BUFBCT; NC CONDITION CODE SET ; INTERRUPTS DISABLED ; ; NOTE HANDLERS SHOULD NORMALLY EXIT ; WITH "RET" INSTR (TO RETURN THROUGH  ; RETNCZ) ;  LXI H,CMFLGS ;SOME HANDLERS NEED CMFLGS XCHG ;D,E=CMFLGS, H,L=HANDLER MOV A,B ;SOME HANDLERS NEED A=B  LXI B,RETNCZ ;PUT RETURN ADDR ON STACK  PUSH B ;F@@:OR EASIER RETURNS  LXI B,BUFBC+BUFBCT ;B=0 ; C=BUFBC+BUFBCT DI ;** DISABLE INTERRUPTS **  PCHL ;DISPATCH TO HANDLER ;  ; CLEAR BLOCK TRIGGER ; DCCTRG:LDAX D ;FETCH CMFLGS  ANI 377Q-BLKTRG ;TURN OFF BLOCK-TRIGGER JMP DCCBT ;1ST CHECK FOR MPT/DIAG MODE;  ; SET BLOCK-TRIGGER ; DCSTRG:LDAX D ;FETCH CMFLGS  ORI BLKTRG ;TURN ON BLOCK-TRIGGER; DCCBT: MOV B,A ;SAVE NEW CMFLGS LDA DCFLGS ;ONLY NEED TO OPERATE BLKTRG ANA A ;HERE FOR DIAGNOSTIC PROTOCO RZ ;IF MULTIPOINT, DO NOTHING MOV A,B ;IF DIAGNOSTIC MODE, STAX D ;STORE NEW BLOCK-TRIGGER RET ;AND GOTO RETNCZ;  ; RESET DATACOM ; DCCRST:CALL DCSTOP ;WAIT FOR CURRENT DATACOM ; OPERATION TO FINISH  CALL INIRST ;ALWAYS RE-INIT THE WORLD DCNOOP:RET ;JUMP TO RETNCZ ; AND ENABLE INTERRUPTS ;  ; BREAK-KEY FUNCTIONS ; DCCBRK:LDA ASFLAG ;BREAK-KEY NON-FUNCTIONAL IF ANA A ;DATACOM TRANSMITTING ; OR RECEIVING CZ BUFINI ;IF ALL QUIET, CLEAN QUEUES  RET ;AND GOTO RETNCZ;  ; MODEM DISCONNECT ; DCCMDC:LXI H,DISCON ;NXT INTERRUPT TO DISCONNECT JMP DCC100 ;GO SET VECTOR AND EXIT ; ; ENTER-AID 1 ; DCENT1:MVI B,AIDFLG ;SINGLE CHARACTER ENTER ; ; ENTER-AID N ; DCENTN:CPI TPADI ;IF CHAR >= 177B, ILLEGAL  JNC RETPCZ ;SO RETURN C & Z; (NOTE, RETPCZ POPS STACK)  CPI SPACEI ;IF CHAR < 40B, ILLEGAL  JC RETPCZ ;SO RETURN C & Z; (NOTE, RETPCZ POPS STACK) ;  ORA B ;CHAR OK, ADD ENTER 1/N FLAG MOV B,A ; ; LOOP TO PUT ENTER-AID CHAR IN BUFFER; DCENT: MOV A,B ;AID CHARACTER CALL PUTAID ;TRY TO PUT CHAR IN BUFFS  JNZ DCENT ;IF OUTPUT BUFS FULL (NC&NZ); SET UP CHAR & "LAST" FLAG ; AND TRY AGAIN  JC RETPCZ ;IF DC RECEIVING, RET C & Z ; (NOTE, RETPCZ POPS STACK)  MOV A,B ;IF CHAR ACCEPTED, THEN  RAL ;CHECK TO SEE IF "PA" OR "PF RNC ;IF "PF", MORE DATA TO FOLLO; (GOTO RETNCZ TO SET NC & Z)  JMP DCCETX ;IF CHAR ACCEPTED AND "PA"; MUST TERMINATE BLK WITH ETX ; ; HERE TO HANDLE FAST BINARY READ (ESC-E) ; WARNING: MAINCODE DOES NOT WAIT FOR ; BLKTRG=1 BEFORE STARTING THE BINARY ; TRANSFER. (FOR NORMAL DATA TRANSFERS,; MAINCODE WAITS FOR BLKTRG). THE "FSTBIN" ; ROUTINE SIMULATES THE NORMAL MAINCODE ; OPERATION BY CALLING GETDC (AND CHUCKING; INPUT CHARACTERS) UNTIL BLKTRG COMES ON.; NOTE THAT FSTBIN CALLED BEFORE PUTDC. ; ALSO NOTE THAT COULD GET CALL TO FSTBIN ; WHILE ALREADY IN TRANSMIT STATE.; DCCFST:CALL GETDC ;NEED TO PURGE BUFFERS LDA CMFLGS ;NEED TO WAIT FOR BLKTRG ANI BLKTRG ;(IE, WAIT FOR LINE TO JZ DCCFST ;TURN-AROUND) ; CONTINUE THIS LOOP TILL ; OK TO TRANSMIT; ; TERMINATE CURRENT OUTPUT BLOCK WITH AN ETB; AND TOGGLE SENSE OF "BINARY SWITCH" ; ("START-BIN" AND "END-BIN" COME IN PAIRS) ; DCCETB:LXI H,FLAG ;STBIN OR FSTBIN WANT TO MOV A,M ;TURN BINARY FLAG ON  XRI BINARY ;ENDBIN WANTS TO TURN  MOV M,A ;BINARY FLAG OFF ; WARNING: ASSUMES THAT ; STBIN (OR FSTBIN) WILL; ALWAYS BE FOLLOWED BY ; AN ENDBIN ;  MVI C,BUFBC ;SET BUFFER FLAGS FOR ; ETB BLOCK BOUNDARY; ; TERMINATE CURRENT OUTPUT BLOCK WITH ETB/ETX ; (C FLAGS BLOCK BOUNDARY TYPE) ; WARNING: DCCETX ASSUMES THAT ENDBLK CALL; WILL OCCUR AFTER ENDBIN DURING BINARY OUTPUT; DCCETX:DI ;DON'T ALLOW INTERRUPTS WHIL; TOUCHING THE QUEUES  LDA ASBCNT ;IF NOT IN TRANSMIT MODE,  ANA A ;THEN DON'T DO ANYTHING  CP PUTBLK ;(CALL MARKS LAST BUFFER IN ; THE DQ AS HAVING A BLOCK; BOUNDARY, AS GIVEN BY C) RET ;  ; DISPATCH TABLE ; DCCTBL:DW DCCTRG ;CLRTRG - CLEAR BLK TRIGGER  DW DCSTRG ;SETTRG - SET BLK TRIGGER  DW DCCRST ;RSETDC - "SOFT-RESET" DW DCNOOP ;SETREM - NO-OP  DW DCNOOP ;SETLCL - NO-OP  DW DCCBRK ;PUTBRK - BREAK-KEY FUNCTION DW DCCMDC ;DISCNT - MODEM DISCONNECT DW DCCETX ;ENDBLK - TERMINATE MESSAGE  DW DCICR ;SETMON - INVALID REQUEST  DW DCCNRM ;SETNRM - NORMAL MODE  DW DCCFST ;FSTBIN - START BINARY OUTPU DW DCENT1 ;SNDATN - ENTER AID-1  DW DCENTN ;SNDFCT - ENTER AID-N ; DFAD DCICR PROMPT - INVALID REQUEST; (DCMAX CMP CATCHES PROMPT); DCMAX EQU ($-DCCTBL)/2 ;# OF ENTRIES IN TABLE  ;************************************************ ; ; GETDC ; GET ONE DATACOM CHARACTER; (HI-ORDER BIT GUARANTEED = 0); ; GETBIN; GET ONE BINARY DATACOM CHARACTER ;  ; ENTRY DON'T CARE ; ; EXIT NC NO ERRORS DETECTED ; Z A = DATACOM CHARCTER; NZ A <> 0 WAIT ; (INPUT BUFFER EMPTY) ; A = 0 END-OF-INPUT ; (BUFFS NOW AVAIL ; FOR TRANSMISSION); C DATACOM ERROR DETECTED ; A DESTROYED; ALWAYS RETURNS Z (NO MESSAGE); DATACOM RECEIVE ERROR; (PROBABLY OVER-RUN OR PARITY); ;************************************************ ; ; ENTRY POINT ; GETBIN:MVI A,377Q ;8-BIT DATA CHARACTERS JMP GETDC5 ; ; ENTRY POINT ; GETDC: MVI A,177Q ;7-BIT DATA CHARACTERS; GETDC5:PUSH B ;SAVE REGISTERS  PUSH D  PUSH H  MOV B,A ;CHARACTER BIT MASK ;  LDA DCFLGS ;DIAGNOSTIC HOOKS  ORA A ;DIAGNOSTIC MODE ON ?  JNZ DIA500 ;YES, BRANCH TO DIAGNOSTIC ;  DI ;** DISABLE INTERRUPTS ** ;  LDA ASBCNT ;ARE WE IN RECEIVE MODE ; AND CAN WE CONSUME INR A ;(IE, IS THERE RECEIVED ; DATA IN THE DQ?; IN OTHER ; WORDS, IS ASBCNT < -1) JZ GETLST ;BRANCH IF WE JUST CAUGHT UP; IN BLKIN MODE (CATCH UP IN; NON-BLKIN MODE HANDLED; BY CNSUMR) JP WAIT ;IF ASBCNT >= 0, RETURN= WAI; (NO RECEIVE DATA IN QUEUE); ; HERE TO FETCH CHARACTER FROM BUFFER ; GETCHR:CALL CNSUMR ;LOOK FOR CHAR IN DQ JNZ CHROK ;GOT CHAR FROM BUFF = GOOD JC CHRBAD ;WHOOPS, RECEIVE ERROR; ; FALL THROUGH, DQ MUST BE; EMPTY OR REACHED BOUNDARY GETLST:LDA ASFLAG ;IF RCVN SET DOESN'T MATTER  ANI RCVN ;WHETHER DQ EMPTY OR JNZ RETHDB ;BOUNDARY SET,; WE SHOULD ALWAYS WAIT ; ; ; WHEN HERE, CONSUMER HAS CAUGHT UP WITH; THE PRODUCER; ITS THE TIME TO TURN OVER THE ; BUFFERS TO TRANSMITTER (ENABLE PUTDC) ; ;  LXI H,CMFLGS ;TELL MAINCODE THAT IT IS  MOV A,M ;NOW OK TO TRANSMIT  ANI 377Q-RCVMDE ;(TURN OFF RCVMDE)  ORI BLKTRG ;(TURN ON BLKTRG) MOV M,A ;(ENTER-KEY OK) ;  CALL BUFINI ;NORMALLY, DATA QUEUE WILL; BE EMPTY AT THIS POINT; BUT NEED; THIS TO CLEAN UP IN BLKIN MODE; (EG, ASYNC PROCESSOR DOES PUTE; ; OR DABORT ON FIRST BLOCK) ;  ORI 1 ;SET NZ,NC & A=0 MVI A,0 ;TO SIGNAL END-OF-INPUT  JMP RETHDB ;EI, POPS AND RET  ; ; ENTRY POINT ; HERE TO POP STACK AND RETURN NC & NZ; DCICR EQU $ ;DCCTL INVALID CTL REQUESTRPNCNZ:POP H ;POP STACK + SET NC & NZ; ; ENTRY POINT ; HERE TO RETURN WAIT CONDITION (NC+NZ)  ; (A DESTROYED) ; RTNCNZ EQU $ ;SET NC & NZWAIT: ORI 1 ;SET NZ & NC CONDITION CODES JMP RETHDB  ;************************************************ ; ; PUTDC ; OUTPUT CHARACTER TO DATACOM; ; PUTAID; PASS AID CHARACTER TO DATACOM; ; ENTRY A = CHARACTER TO OUTPUT ; NC NORMAL CHARACTER ; C TERMINATING CHARACTER;  ; EXIT A DESTROYED ; NC; Z CHARACTER ACCEPTED; NZ WAIT-1 CAN'T ACCEPT CHAR; BECAUSE OUTPUT BUFFS FULL ; C ; Z WAIT-2 CAN'T ACCEPT CHAR; BECAUSE DATACOM IS IN ; RECEIVE MODE; ;************************************************ ; ; ENTRY POINT ; PUTAID:PUSH B ;SAVE CALLER'S REGS  MVI B,PAPFKY  JMP PUTINI ;HAVE ENTER-AID FLAG SET; ; ENTRY POINT ; PUTDC: PUSH B ;SAVE CALLER'S REGS  MVI B,0 ;NO TRANSPARENT FLAG; ;  ; PUTDC FLAG DEFINITIONS ; PAPFKY EQU 200Q ;"PA" / "PF" KEY; ASSUMED = 001B PUTINI:PUSH D ;SAVE REST OF CALLER'S REGS  PUSH H  MOV D,A ;SAVE INPUT CHAR IN D ;  LDA DCFLGS ;DIAGNOSTIC HOOKS  ORA A ;DIAGNOSTIC MODE ON ?  JNZ DIA700 ;YES, BRANCH TO DIAGNOSTIC;  LXI H,FLAG ;TRANSMIT BUFFER FLAGS MOV C,M ;SAVE IN C; ; DONE WITH INITIALIZATION ; A,E = SCRATCH ; B = INPUT FLAGS (PAPFKY); C = FLAG BYTE (NEWBUF, BUFF1, BINARY) ; D = INPUT CHARACTER ; H,L = INTERFACE WITH PRDUCR ;  MOV A,C ;GET FLAG BYTE ADD A ;DO WE NEED A NEW BUFFER? ; (NEWBUF FLAG BIT)  JP PUTGO ;NO, BRANCH  ; ; HERE TO HANDLE BEGINNING OF BUFFER CONDITION; PUTQUE:DI ;MUST LOCK OUT INTERRUPT LDA ASBCNT ;PROCESSOR BEFORE TOUCHING ANA A ;THE QUEUES  JM WAIT2 ;BRANCH IF BUFFERS RECEIVING;  CALL FQHDQT ;NEW BUFFER FOR PRODUCER JZ WAIT ;WHOOPS, XMIT BUFFS FULL;  EI ;DONE WITH QUEUES FOR NOW  MOV A,C ;CLEAR THE BEGINNING ANI 377Q-BUFF1-NEWBUF  MOV M,A ;OF BUFFER CONDITION; ; HERE TO DETERMINE HOW TO FLAG THE NEW ; TRANSMIT BLOCK (USED BY INTERRUPT PROCESSOR); AS FOLLOWS: ; A) STX - NORMAL NON-BINARY BLOCK ; B) DLE - BINARY BLOCK; C) CHAR > 177B - ENTER-AID #1; D) CHAR < 200B - ENTER-AID #N;  RAR ;TRANSPARENT ENTRY; (IE, IS BINARY FLAG ON?) LXI H,DLESTX ;ADDR OF TRANSLATED DLE  JC PUTQ50 ;IF BINARY, FLAG CHAR = DLE  INX H ;IF NOT BINARY, FLAG = STXPUTQ50:MOV E,M ;E = STX OR DLE (TRANSLATED) ADD B ;ENTER-AID ENTRY? ; (IE, IS PAPFKY FLAG ON?) JP PUTQ75 ;NO, INITIAL CHAR ALL SET UP MOV E,D ;YES, FLAG CHAR = INPUT CHAR; ; HERE TO PUT BLOCK TYPE FLAG IN; FIRST BUFFER OF A TRANSMIT BLOCK; PUTQ75:MOV A,C ;BEGINNING OF BLK CONDITION? ANA A ;(BUFF1 BIT IN FLAG) CM PUTB1 ;YES, DO BEG OF BLK STUFF ;  MOV A,B ;IF ENTER-AID SPECIAL CASE ANA A ;SUPPRESS PUTTING INPUT ; CHAR IN THE BUFFER ; ; HERE TO PUT THE INPUT CHARACTER IN THE BUFFER ; AND CHECK FOR END-OF-BLOCK CONDITIONS ; ; ENTER P TO PUT INPUT CHAR IN BUFFER; M TO BYPASS PUTTING CHAR IN BUFF ; PUTGO: MOV E,D ;INPUT CHAR (TO PUT IN BUFF) CP PUTCHR ;DISABLE INTERRUPTS AND ; PUT THE CHAR IN BUFFER;  INR L ;IS THE BUFFER FULL NOW? CZ CHKETB ;IF YES, GO SEE IF TIME TO; TERMINATE BLOCK WITH AN ETB  JMP CHROK2 ;ALL DONE (SUCCESS) ; ; ; HERE TO PUT DLE/STX/AID AT BEG OF BLOCK ; PUTB1: LDA BUFMAX ;NEW BUFFER COUNT  STA BUFCNT ;SO WE KNOW WHEN TO PUT ETBS; ; HERE TO PUT A CHARACTER IN THE BUFFER ; PUTCHR:DI ;NO INTERRUPTS WHILE LDA ASBCNT ;MESSING WITH QUEUES ANA A  MOV A,E ;A = CHAR TO PUT IN BUFFER JP PRDUCR ;IF ASBCNT >= 0, OK TO PUT; ELSE, ABORT ; ; ENTRY POINT; HERE TO POP STACK AND RETURN Z & C ; RETPCZ:POP H ;POP RETURN OFF THE STACK ; ; ; ENTRY POINT ; HERE TO RETURN WITH Z & C ; WAIT2 EQU $ ;ABORT CAUSE NOW RECEIVINGCHRBAD EQU $ ;RECEIVE ERRORRETCZ EQU $  CMP A ;SET Z CONDITION CODE  STC ;SET C CONDITION CODE  JMP RETHDB ;EI, POPS & RET  ;************************************************ ; ; STBIN ; TERMINATE CURRENT OUTPUT BLOCK WITH ETB; TURN ON BINARY OUTPUT FLAG ; ; ENDBIN; TERMINATE CURRENT OUTPUT BLOCK WITH ETB; TURN OFF BINARY OUTPUT FLAG; WARNING: EVERY STBIN (OR FSTBIN) MUST; BE FOLLOWED BY AN ENDBIN, AND ENDBIN ; MUST PRECEDE ENDBLK;  ; ENTRY DON'T CARE ; ; EXIT A DESTROYED, ALWAYS NC & Z; CALL IGNORED IF DATACOM RECEIVING ; CALL IGNORED IF NO OUTPUT BLOCK ; ;************************************************ ; ; ENTRY POINT ; STBIN EQU $ ;SAME AS ENDBIN ENDBIN:PUSH B ;MUST SAVE SAME AS DCCTL PUSH D  PUSH H ;  CALL DCCETB ;TERMINATE OUTPUT BLOCK ; ; ENTRY POINT ; HERE TO RETURN SUCCESSFULLY ; CHROK: ANA B ;CLEAR ALL BUT CHAR BITS; ; ENTRY POINT ; RETNCZ EQU $ CHROK2:CMP A ;SET Z & NC CONDITION CODES ; ; ENTRY POINT ; WARNING: RETHDB MUST = RETNCZ+1 ; RETHDB:EI ;*** ENABLE INTERRUPTS ***; ; ENTRY POINT ; RTHDB2:POP H  POP D  POP B  RET ;*************************************************; ; CHKETB; CALL WHEN CURRENT OUTPUT BUFFER FULL ; CHECKS TO SEE IF SHOULD TERMINATE BLOCK ; WITH AN ETB ;  ; ENTRY DON'T CARE ;  ; EXIT AS BELOW ; ;************************************************ ; ; PUTBLK; TERMINATE CURRENT OUTPUT BUFFER WITH ; AN ETB OR ETX BLOCK BOUNDARY ; ; ENTRY C = BUFFER FLAGS (ETB/ETX); ; EXIT A,B,C,H,L DESTROYED ; WARNING: CALLER MUST HAVE INTERRUPTS DISABLED; @@;AND MUST CHECK ASBCNT TO ENSURE ; TRANSMIT MODE ; ;*************************************************; ; ENTRY POINT ; CHKETB:LXI H,BUFCNT ;TERMINATE OUTPUT BLOCK WITH DCR M ;AN ETB ONLY WHEN THE BUFFER; COUNT IS DEPLEATED LXI B,NEWBUF*256+BUFBC ;ASSUME NO ETB JP PUTFLG ;IF DON'T NEED ETB, SIMPLY; SET UP TO GET NEW BUFFER; ; ENTRY POINT ; PUTBLK:MVI B,NEWBUF+BUFF1 ;FLAG STARTING NEW ; OUTPUT BLOCK AT NEXT CALL ; TO PUTDC;  LDA DQT ;CHECK DATA QUEUE (TAIL) ANA A ;IF QUEUE EMPTY, ASSUME ; NO OUTPUT BLK TO TERMINATE RZ ;(BLOCK COULD BE IN TQ, ; TERMINATED BY AN ETB) ; ; ALWAYS TERMINATE THE CURRENT OUTPUT BLOCK ; AS REQUESTED (IE, WITH ETB/ETX), BUT ONLY ; INCREMENT THE OUTPUT BLOCK COUNT (ASBCNT) ; IF THE BLOCK WAS NOT ALREADY TERMINATED ; (THIS QUALIFICATION ALLOWS SPURIOUS CALLS  ; WITHOUT ILL EFFECT). ;  MOV H,A ;ADDR OF PRODUCER'S BUFFER MVI L,BFLG ;POINTER TO ITS FLAGS  MOV A,M ;GET CURRENT BUFFER FLAGS  MOV M,C ;TERMINATE BLK WITH ETB/ETX  ANI BUFBC ;IS BLK ALREADY TERMINATED?  JNZ PUTFLG ;YES, DON'T BUMP BLK-CNT; (NOTE THAT SHOULD UPDATE; BUFFER FLAGS EVEN IF BLOCK; ALREADY TERMINATED SO THAT; ENDBLK CAN CHANGE ETB ; TO AN ETX TERMINATOR)  LXI H,ASBCNT ;INFORM CONSUMER OF NEW BLK  INR M ;BY BUMPING TRANSMIT BLK CNT; PUTFLG:LXI H,FLAG ;START NEW BUFFER; IF BLOCK  MOV A,B ;TERMINATED, START NEW BLOCK ORA M  MOV M,A  RET ;*************************************************; ; CONST ; SET RAM TO A CONSTANT;  ; ENTRY A=CONSTANT ; C=# BYTES TO SET TO CONSTANT, LESS 1; D,E POINT TO 1ST BYTE TO SET;  ; EXIT A UNMODIFIED ; B = 0 ; C DESTROYED ; D,E = ADDR+1 OF LAST BYTE SET ; ;*************************************************; ; CONSTI ; SET RAM AREA TO ; A, A+B, A+2*B, A+3*B,...  ; ..., A+C*B ; ; ENTRY A=INITIAL VALUE  ; B=INCREMENT ; C = # BYTES TO SET, LESS 1; D,E POINT TO 1ST BYTE TO SET; ; EXIT A,C DESTROYED, B UNMODIFIED ; D,E = ADDR+1 OF LAST BYTE TO SET; ;*************************************************; ; ENTRY POINT ; CONST: MVI B,0 ;SET RAM TO CONSTANT; ; ENTRY POINT ; CONSTI:STAX D ;STORE NEXT CONSTANT INX D ;POINT TO WHERE TO PUT NEXT  ADD B ;+ INC, IF NECESSARY DCR C ;CONTINUE TIL CNT DEPLEATED  JP CONSTI  RET ; ; CPYTBL; COPY ROM TABLE TO RAM AREA ; ; ENTRY C=# BYTES TO COPY, LESS 1 ; D,E POINT TO FIRST RAM BYTE ; (DESTINATION) ; H,L POINT TO FIRST TABLE ENTRY ; (SOURCE) ; ; EXIT A,C DESTROYED ; D,E = ADDR+1 OF LAST BYTE SET ; H,L = ADDR+1 OF LAST BYTE COPIED; ;*************************************************; ; ENTRY POINT ; CPYTBL:MOV A,M ;BYTE TO COPY (FROM SOURCE)  STAX D ;BYTE COPIED (TO DESTINATION INX D ;ADDR OF NEXT BYTE TO COPY INX H ;ADDR OF WHERE TO COPY IT  DCR C ;CONSULT BYTE COPY COUNT JP CPYTBL ;CONTINUE TIL CNT DEPLEATED  RET ;************************************************ ; ; HEXPAR; TRANSLATE OR COMPUTE PARITY; FOR ALL ENTRIES IN RAM TABLE ; ; ENTRY H,L POINT TO FIRST TABLE ENTRY; E=# BYTES TO COPY, LESS 1 ; ; EXIT ALL REGS DESTROYED; ;************************************************ ; ; ENTRY POINT ; HEXPAR:MOV B,M ;NEXT TABLE ENTRY  MOV A,B  ANA A ;DON'T MESS WITH STOPERS CNZ PAREBC ;COMPUTE PARITY OR XLATE MOV M,A ;TRANSLATED/PARITY'D CHAR  INX H ;PT TO NEXT ENTRY  DCR E ;# ITEMS LEFT  JP HEXPAR ;CONTINUE TIL CNT DEPLEATED  RET ;************************************************ ; ; INIDS ; COMPUTE GROUP/DEVICE ID FROM JUMPERS ;  ; ENTRY A = JUMPER ; ; EXIT A = GROUP/DEVICE ID  ; E DESTROYED ; ;************************************************ ; ; ENTRY POINT ; INIDS: ANI MASKID ;CLEAR ALL BUT ID BITS CPI MAXID+1 ;IS ID > Z ? MOV E,A  MVI A,SPACEI ;YES, CONVERT TO SPACE RP ;AND RETURN  MOV A,E ;NO,  ORI ATSINI ;CONVERT ID'S TO @-Z RET ;A = TRANSLATE ID  ;************************************************ ; ; SHIFT ; CALCULATE 1*(2**A) ; IE, SHIFT 1 LEFT (A) TIMES ; ; ENTRY A = # TIMES TO SHIFT (TAKEN MOD 4); ; EXIT A = RESULT (1,2,4,8); ;************************************************ ; ; ENTRY POINT ; SHIFT: ANI 3Q ;TAKE COUNT MODULO 4 PUSH B ;SAVE SOME WORKING REG'S MOV B,A ;B=# TIMES TO SHIFT  MVI A,200Q ;A = BIT TO SHIFT ; SHIFT5:RLC ;MULTIPLY A BY 2 DCR B ;DECREMENT SHIFT COUNT JP SHIFT5 ;CONT TILL CNT DEPLEATED;  POP B ;RESTORE REG'S RET ;************************************************ ;  ; PRDUCR (ALSO, PUTR) ; PUT CHARACTERS IN DATA QUEUE BUFFERS ; ; ENTRY A = CHARACTER ; NEVER CALL WITH DQ EMPTY; ; EXIT A,D,L,H AS SPECIFIED BELOW; NZ CHARACTER ACCEPTED; A = CHARACTER, D SAVED; H,L = ADDR OF WHERE CHAR WAS PUT; Z CHARACTER NOT ACCEPTED; (CURRENT BUFFER FULL, AND FQ EMPTY) ; A = CHARACTER, D = CHARACTER; H,L - DESTROYED ; ;************************************************ ; ; ENTRY POINT ; PUTR EQU $ ;ASYNC CODE USE PUTRPRDUCR:LHLD BUFPCO ;H=(DQT) L=(BUFPCO) ; WARNING: ASSUMES THAT THE ; DQ IS NOT EMPTY ;  INR M ;INCREMENT PRODUCER COUNT ; FOR NEXT CALL  MOV L,M ;ADDR OF WHERE TO PUT CHAR DCR L ;(NOTE THAT PRODUCER COUNT; = ADDR OF LAST CHAR + 1);  MOV M,A ;PRODUCE !!!;  RNZ ;RETURN (NZ) IF STILL ROOM; IN THE BUFFER  ; ; WHEN HERE PRODUCER COUNT HAS JUST FALLEN OFF; THE TOP OF THE BUFFER, IE WE JUST STUFFED THE ; CHARACTER IN BYTE 0 OF THE BUFFER (DESTROYING ; APCNT!) ;  MOV D,A ;SAVE THE CHARACTER  LHLD BUFPCO ;ADDR OF PRODUCER COUNT  SUB A  MOV M,A ;SET PRODUCER COUNT TO ZERO ; (NOTE THAT IF WE WERE ; USING PCNT, THEN IT IS OK ; FOR APCNT TO BE DESTROYED);  CALL FQHDQT ;APPEND A FREE BUFFER FROM; THE FQ TO TAIL OF DQ; AND INITIALIZE IT  MOV A,D ;RESTORE THE CHARACTER JNZ PRDUCR ;GOT NEW BUFF, SO PRODUCE  RET ;WHOOPS, FQ IS EMPTY ;************************************************ ; ; GETX; SAME AS CNSUMR ACCEPT THAT IT ASSUMES; THAT DQ IS NOT EMPTY ; ; CNSUMR; TAKE CHARACTERS FROM THE ; DATA QUEUE BUFFERS ;  ; ENTRY DON'T CARE ; ; EXIT D,E,L,H ALWAYS DESTROYED; NZ A = CHARACTER (EMPTY BUFFERS DEQ'D) ; Z NO CHARACTER IN BUFFER; C RECEIVE ERROR, A DESTROYED ; TRANSMIT BLOCK BOUNDARY: ; (A)=(XEND+1)= TRANSLATED; ETB/ETX; EOTO SET IF; ETX BLOCK BOUNDARY; NC THE QUEUE IS EMPTY OR; ASBCNT IS NOW = -1 ; ;************************************************ ; ; HERE TO STICK THE EMPTIED BUFFER ON THE FQ; CNS025:PUSH B ;DQHYQT DESTROYS ALL REGS  LXI B,FQT ;TAKE 1ST BUFF IN DQ AND CALL DQHYQT ;LINK TO END OF FQ POP B ; ; ; ENTRY POINT ; CNSUMR:LDA DQH ;A=ADDR OF 1ST BUFF IN DQ  ANA A ;IS THE DQ EMPTY?  RZ ;YES, RETURN Z + NC  ; ; ENTRY POINT ; GETX: LHLD DQH-1 ;H=ADDR OF 1ST BUFF IN DQ ; WARNING: ASSUMES THAT THE ; DQ IS NOT EMPTY  MVI L,CCNT ;(CCNT=ADDR OF LAST BYTE; THAT WAS CONSUMED) INR M ;CCNT FOR NEXT CONSUMPTION MOV A,M ;LO-ADDR OF CHAR TO FETCH ;  DCX H ;ADDR OF PCNT  CMP M ;HAS THE CONSUMER CAUGHT; UP WITH THE PRODUCER? ; - ASSUME NOT FOR NOW;  MOV L,A ;ADDR OF WHERE THE CHAR IS MOV A,M ;CONSUME IT !!! ;  RNZ ;RETURN (NZ) IF CONSUMER; HASN'T CAUGHT UP YET; (CCNT < PCNT)  ; ; WHEN HERE, THE CONSUMER HAS CAUGHT UP WITH; THE PRODUCER (IE, CCNT+1=PCNT). THE; CONSUMER COUNT IS ALWAYS BACKED UP. THERE ARE ; THE FOLLOWING 3 DISTINCT POSSIBILITIES: ; ; 1) THE BUFFER IS SIMPLY EMPTY ; A) TRANSMITTING - DEQUEUE IT ; B) RECEIVING - DEQUEUE UNLESS LAST IN; CHAIN AND SELEC ON, IN WHICH ; CASE RETURN Z & NC ; ; 2) THE BUFFER IS MARKED AS BEING A BLOCK; BOUNDARY; THERE ARE 2 SUBCASES:; A) TRANSMITTING (ASBCNT >= 0): ; CONSUMER BACKED UP TO BUFIC;; THE BUFFER IS DEQUEUED TO TQ; ; ASBCNT DECREMENTED; ; ETB/ETX (TRANSLATED) PUT IN ; BCC TRANSMIT STRING (XEND+1) ; EOTO FLAG SET IF TERMINATOR IS ETX; RETURNS Z & C WITH; A = TRANSLATED TERMINATOR; B) RECEIVING (ASBCNT < 0): ; PCNT=(APCNT); ; IF LAST BUFF IN CHN, BUFPCO=PCNT; ; TURN OFF BUFBC FLAG;; INCREMENT ASBCNT; ; IF ASBCNT IS NOW < -1, THEN BACK; TO CNSUMR; IF ASBCNT IS NOW = -1, THEN RETURN; WITH Z & NC; ; 3) THE BUFFER IS MARKED AS HAVING A ; RECEIVE ERROR; CAN ONLY HAPPEN WHEN; RECEIVING AND NOT IN BLKIN MODE.  ; PCNT=(APCNT) ; IF LAST BUFF IN CHN, BUFPCO=PCNT; ; TURN OFF BUFRER ; RETURN WITH Z & C WITH A = BUFRER FLAG ; ; NOTES:; A HAS CONTENTS OF APCNT; BUFFERS DEQUEUED TO FQ IF RECEIVING,  ; ELSE TO TQ ;   MVI L,CCNT ;BACKUP THE CONSUMER COUNT DCR M ;(MAY KEEP THIS BUFFER) ;  LDA ASBCNT ;LOOK AT ASBCNT TO SEE IF  ANA A ;TRANSMITTING OR RECEIVING JM CNS100 ;BRANCH IF RECEIVING;  ; HERE WHEN TRANSMITTING ;  MVI M,BUFIC ;BACK UP CONSUMER TO BEG OF ; BUFF; SO WHEN REQ TQ TO DQ; TO RETRANSMIT, WILL CONSUME ;  PUSH B ;DQHYQT DESTROYS ALL REGS  PUSH H  LXI B,TQT ;TAKE 1ST BUFF IN DQ AND CALL DQHYQT ;LINK TO END OF TQ POP H ;GET REGS BACK POP B ; (ALL TRANSMIT CASES DEQ);  INX H ;H,L POINT TO BUFFER FLAGS MOV A,M ;A = BUFFER FLAGS  ANI BUFBC+BUFBCT ;IF BUFFER MARKED WITH ; BOUNDARY CONDITION  JZ CNSUMR ;NO, CASE #1, BUFF EMPTY; ; HERE FOR CASE 2A (TRANSMIT BOUNDARY); ; (ALREADY DEQUEUED) LXI H,ASBCNT ;ASBCNT=ASBCNT-1 DCR M ;(JUST FINISHED CONSUMING ; TRANSMIT BLOCK)  ANI BUFBCT ;ETB/ETX BOUNDARY CONDITION  MOV E,A ;SAVE THE BIT ;  LXI H,CONFG2 ;TURN ON EOTO IF ORA M ;BLOCK TERMINATED BY ETX MOV M,A ;  LXI H,ETB ;ADDR OF TRANSLATED ETB  MVI D,0 ;D,E = 0/1 DAD D ;POINT TO ETX IF BUFBCT=1  MOV A,M ;A = TRANSLATED ETB/ETX  STA XEND+1 ;SET UP BCC TRANSMIT STRING ; ; HERE TO RETURN Z & C WITH FLAG IN A ; CNS050:MOV E,A ;SAVE FLAG SUB A ;SET Z & C CONDITION CODES STC MOV A,E ;RETURN FLAGS IN A RET;  ; HERE WHEN RECEIVING ; CNS100:INX H ;H,L POINT TO BUFFER FLAGS MOV A,M ;A = BUFFER FLAGS  ANI BUFBC+BUFRER ;BLK BOUNDARY OR; RECEIVE ERROR  JNZ CNS200 ;YES, CASE #2 OR #3 ; ; HERE FOR CASE 1B (RECEIVING & BUFF EMPTY) ;  MVI L,CHN ;ADDR OF CHN FOR THIS BUFF SUB A ;IS THIS BUFF LAST IN DQ ? CMP M  JNZ CNS025 ;NO, THEN DEQUEUE IT LDA ASFLAG ;THIS BUFF IS LAST ANI RCVN ;IS ASYNC STILL ACTIVE ? JZ CNS025 ;NO, THEN GO DEQUEUE SUB A ;YES, THEN WE HAVE CAUGHT ; UP IN NON-BLKIN MODE RET ;RETURN Z & NC; ;  ; HERE FOR CASE 2B OR 3 ; RECEIVE BOUNDARY OR RECEIVE ERROR ; ; H,L POINT TO BUFFER FLAGS CNS200:MOV E,M ;SAVE BUFF FLAGS FOR LATER XRA E ;TURN OFF BUFBC  MOV M,A ;AND/OR BUFRER;  INX H ;H,L POINT TO BUFFER CHAIN MOV A,M ;LAST BUFFER IN THE CHAIN? ANA A ;(USE CONDITION CODE LATER) ;  MVI L,APCNT ;SET PCNT=(APCNT)  MOV A,M ;A=AUXILIARY PRDUCR CNT  INX H ;POINT TO REGULAR PRDUCR CNT MOV M,A ;PCNT=(APCNT) ;  JNZ CNS300 ;IF LAST BUFF IN CHAIN MVI A,PCNT ;THEN SET PUFPCO=PCNT  STA BUFPCO ;HANDLES SMALL BLK CASE ; (WHEN CONSMR & PRDUCR IN; THE SAME BUFFER); CNS300:MOV A,E ;GET OLD BUFFER FLAGS  ANI BUFRER ;CASE 3 (RECEIVE ERROR) ?  JNZ CNS050 ;YES, RETURN Z & C WITH ; A = BUFRER; ; HERE FOR CASE 2B (RECEIVE BOUNDARY) ;  LXI H,ASBCNT ;H,L POINT TO ASBCNT; JUST CONSUMED A RECEIVE BLK  INR M ;SO, ASBCNT=ASBCNT+1 MOV A,M ;STILL BUFFS TO CONSUME? CPI -1 ;(IE, IS ASBCNT < -1)  RZ ;NO, RETURN Z & NC; (HAVE JUST CAUGHT UP IN ; BLKIN MODE)  JMP CNSUMR ;YES, GO CONSUME THEM  ;************************************************ ; ; TQDQ@@<; RETURNS IMMEDIATELY IF TQ IS EMPTY.; (IE, OK TO CALL AT INAPPROPRIATE TIMES); TAKE ENTIRE TQ (EVERYTHING BETWEEN ; TQH AND TQT) AND INSERT BEFORE BEGINNING  ; OF DQ (AT DQH) ; INCREMENT ASBCNT (NEW BLK IN DQ) ; ; PURPOSE - RETRANSMIT DATA AFTER NAK;  ; ENTRY DON'T CARE ; ; EXIT ALL REGS DESTROYED; ;************************************************ ; ; TQFQ; RETURNS IMMEDIATELY IF TQ IS EMPTY.; (IE, OK TO CALL AT INAPPROPRIATE TIMERS) ; TAKE ENTIRE TQ (IE EVERYTHING; BETWEEN TQH AND TQT) AND INSERT BEFORE ; BEGINNING OF FQ (AT FQT) ; ; PURPOSE - DISCARD BUFFERS AFTER ACK;  ; ENTRY DON'T CARE ; ; EXIT ALL REGS DESTROYED; ;************************************************ ; ; CHNXQ ; TAKE SPECIFIED SOURCE CHAIN OF BUFFERS ; AND INSERT BEFORE BEGINNING OF  ; DESTINATION QUEUE ; ; ENTRY MOV B,ADDR OF 1ST IN CHAIN ; MOV C,ADDR OF LAST IN CHAIN; LXI H,HEAD OF DEST QUEUE  ; CALL CHNXQ ; ; EXIT A,D,E,H,L DESTROYED ; B,C SAME AS AT ENTRY; ALWAYS RETURNS NZ CONDITIONS; ;************************************************  ; ; ENTRY POINT ; TQDQ: LXI D,DQH ;INSERT TQ AT BEG OF DQ  CALL TQF100  RZ ;CALL IS NO-OP IF TQ EMPTY LXI H,ASBCNT ;ELSE, INCREMENT ASBCNT  INR M ;(NEW BLK IN THE DQ; NOTE ; THAT THERE CAN NEVER BE ; MORE THAN 1 BLK IN TQ) RET; ; ; ENTRY POINT ; TQFQ: LXI D,FQH ;INSERT TQ AT BEG OF FQ  TQF100:LXI H,TQH ; ; GET HEAD AND TAIL POINTERS FOR TQ ; SET TQH AND TQT TO ZERO ; ; D,E POINT TO DESTINATION Q; H,L POINT TO TQ-HEAD MOV B,M ;B=HEAD PTR FOR TQ (1ST) SUB A ;A=0  CMP B ;IS TQ EMPTY?  RZ ;YES, THEN DONE  MOV M,A ;SET TQH TO 0 ;  DCX H ;POINT TO TQT  MOV C,M ;C=TAIL PTR TO TQ (LAST) MOV M,A ;SET TQT TO 0  XCHG ;H,L POINT TO DESTINATION Q  ; ; ENTRY POINT ; ; LINK HEAD OF DESTINATION QUEUE TO TAIL OF ; SOURCE CHAIN (IE, INSERT SOURCE CHAIN AT; BEGINNNING OF DESTINATION QUEUE); ; H,L POINT TO DEST Q-HEAD; B=SOURCE CHAIN HEAD ; C=SOURCE CHAIN TAIL CHNXQ: MOV D,C ;D,E POINT TO CHAIN OF LAST  MVI E,CHN ;BUFF IN SOURCE CHAIN  MOV A,M ;A = 1ST BUFF IN DEST Q  STAX D ;LAST BUFF IN SOURCE CHAIN; NOW POINTS TO 1ST BUFF; IN DESTINATION Q; ; SET HEAD OF DEST Q TO HEAD OF SOURCE CHAIN; ; H,L POINT TO HEAD POINTER ; OF DESTINATION QUEUE MOV M,B ;SET HEAD POINTER TO HEAD ; OF SOURCE CHAIN  ANA A ;WAS THE DEST Q EMPTY? RNZ ;NO, THEN DONE; ; SPECIAL CASE WHEN DESTINATION QUEUE WAS ; EMPTY; SET TAIL OF DESTINATION QUEUE TO  ; TAIL OF SOURCE CHAIN ;  DCX H ;H,L POINT TO TAIL POINTER; OF DESTINATION QUEUE MOV M,C ;SET TAIL PTR TO TAIL OF; SOURCE CHAIN ORA C ;(ALWAYS RETURN WITH NZ ; NEEDED BY TQDQ)  RET ;************************************************ ; ; PUTE; SET BLOCK BOUNDARY WHEN RECEIVING; ; ENTER NEVER CALL WITH DQ EMPTY; ; EXIT A,D,E,H,L DESTROYED ; RETURNS IMMEDIATELY IF NOT BLKIN; SETS BUFBC FLAG IN PRODUCER BUFFER; IF THERE WAS ALREADY A BLOCK; BOUNDARY IN THE BUFFER, THEN ; WE MERELY SET PCNT TO APCNT; IF THERE WAS NOT A BLOCK BOUNDARY,; THEN APCNT SET TO PCNT ; BUFPCO SET TO APCNT; AND ASBCNT DECREMENTED ; ;************************************************ ; ; SETBND; SET BLOCK BOUNDARY WHEN RECEIVING; OR SET RECEIVE ERROR ; ; ENTER TYPE #1 - RECEIVE BLK BOUNDARY; D = -1 (DECREMENT ASBCNT); E = BUFBC; TYPE #2 - RECEIVE ERROR ; D = 0 (DON'T TOUCH ASBCNT) ; E = BUFRER ; ; EXIT A,D,E,H,L DESTROYED  ; TYPE #1 - ; IF BLOCK BOUNDARY NOT ALREADY; SET, THEN SET APCNT=PCNT; AND SET BUFPCO=APCNT; AND INCREMENT ASBCNT; IF BLOCK BOUNDARY IS ALREADY ; SET, THEN SET PCNT=APCNT ; TYPE #2 - ; IF BUFRER ALREADY SET, RETURNS ; IMMEDIATELY ; OTHERWISE, SETS BUFRER ; APCNT = PCNT; BUFPCO = APCNT; ;************************************************  ; ; ENTRY POINT ; PUTE: LDA FLAG ;RETURN IMMEDIATELY IF NOT ANI BLKIN ;BLKIN MODE  RZ ;  LXI D,DCRBBC ;ANOTHER BLK RECEIVED,; ASBCNT-1, BLK BOUNDARY; (D=-1, E=BUFBC) ; ; ; ENTRY POINT ; ; ENTER WITH: ; D=DELTA ASBCNT; E=BUFFER FLAGS TO SET SETBND:LDA DQT ;H=ADDR OF PRODUCER'S BUFFER MOV H,A  STA BUFBP ;REMEMBER LAST BLK BOUNDARY ;  MVI L,BFLG ;POINT TO PRODUCER'S BUF FLG MOV A,M ;IF BUFRER ALREADY SET, THEN ANI BUFRER ;DONE SINCE WANT GETDC TO  RNZ ;RETURN EARLIEST ERROR;  MOV A,E ;A=NEW FLAGS TO SET  MOV E,M ;E=OLD BUFFER FLAGS  ORA E ;COMBINE THEM  MOV M,A ;AND STORE IN BUFFER;  MOV A,E ;IS THERE ALREADY A  ANI BUFBC ;BLOCK BOUNDARY SET?; ; IF YES (NZ), LET CONSUMER CATCH UP TO; NEW BOUNDARY BY MERGING NEW BLK WITH OLD ; (THEREFORE NO NEED TO INFORM CONSUMER; OF NEW BLK, IE NO CHANGE TO ASBCNT); ; IF NO (Z), MARK BOUNDARY AND INFORM; CONSUMER (BY DECREMENTING ASBCNT) ; ENTER NZ TO SET ; PCNT=(APCNT); ENTER Z TO SET; APCNT=(PCNT); BUFPCO=APCNT; AND UPDATE ASBCNT SETPC: MVI L,APCNT ;ASSUME TO SET MOV A,M ;PCNT=(APCNT), ETC INX H  JNZ SETPCO ;ASSUMPTION CORRECT, BRANCH ;  LDA ASBCNT ;DECREMENT FOR RECEIVE BLK ADD D ;NO CHANGE FOR RECEIVE ERROR STA ASBCNT ; ; ; ENTRY POINT ; SETPC2:MOV A,M ;AND SET APCNT = PCNT  DCX H ; SETPCO:MOV M,A ;SET APCNT TO PCNT; OR SET PCNT TO APCNT LXI H,BUFPCO ;ALWAYS SET BUFPCO=APCNT MVI M,APCNT ;(IF BUFFER MARKED WITH ; BLOCK BOUNDARY, PRODUCER; MUST ALWAYS USE APCNT) RET; DCRBBC EQU 377Q*256+BUFBC ;LEFT=-1, RIGHT=BUFBC ;************************************************ ;  ; DEQALL, DEQIT, DEQIT2 ; SET UP BUFFERS FOR RECEPTION ;  ; ENTRY DON'T CARE ; ; EXIT A,D,E,H,L DESTROYED; B,C SAVED ; RETURNS IMMEDIATELY IF DQ STILL ; HAS RECEIVED DATA (ASBCNT<-1); OTHERWISE SET ASBCNT=-1 (BLKIN) ; OR ASBCNT=-2 (NOT BLKIN) ; PUTS 1 EMPTY BUFFER IN DQ,; AND ALL OTHERS IN FQ  ; BUFPCO = 0 ; BUFF1 & NEWBUF FLAGS SET; ;************************************************ ; ; ENTRY POINT ; DEQALL:LDA ASBCNT ;RETURN IMMEDIATELY IF INR A ;ASBCNT < -1; (DQ STILL HAS RECEIVED DATA) RM ; ; ; ENTRY POINT ; (SAME AS DEQALL, BUT UNCONDITIONAL) ; DEQIT: LXI H,CMFLGS ;TELL MAINCODE THAT DATACOM  MOV A,M ;IS IN RECEIVE MODE  ORI RCVMDE ;(ENTER-KEY NOT OK)  ANI 377Q-BLKTRG ;(TURN OFF BLKTRG)  MOV M,A ; ; ENTRY POINT ; (SAME AS DEQIT, BUT DOESN'T TURN ON RCVMDE) ; DEQIT2:CALL BUFINI ;REFRESH BUFFERS (ALL TO FQ);  LXI H,ASBCNT ;H,L POINT TO ASBCNT DCR M ;ASBCNT=-1 IF BLKIN  LDA FLAG ANI BLKIN  JNZ FQHDQT ;PUT EMPTY BUFF IN DQ, RET DCR M ;ASBCNT=-2 IF NOT BLKIN  JMP FQHDQT ;PUT EMPTY BUFF IN DQ, RET ;************************************************ ; ; BUFINI; INITIALIZE BUFFERS, RECONSTRUCTS FQ FROM  ; BUFBEG AND BEFEND ;  ; ENTRY DON'T CARE ; ; EXIT A,D,E,H,L DESTROYED; B,C SAVED  ; BUFBP = 0 ; ASBCNT = 0 ; TQ, DQ EMPTY ; BUFF1 AND NEWBUF FLAGS SET; ;************************************************ ; ; ENTRY POINT ; BUFINI:PUSH B ;SAVE CALLER'S REGS  LHLD BUFEND ;H=ADDR OF 1ST BUFF ; L=ADDR OF LAST BUFF  SHLD FQT ;FQH=FIRST, FQT=LAST;  MOV A,L ;A=ADDR OF LAST BUFF MVI L,CHN ;H,L POINT TO CHN OF 1ST BUF MOV C,H ; ; LOOP TO LINK ALL THE BUFFS TOGETHER ; DEQA50:INR C ;C=ADDR OF NEXT BUFF MOV M,C ;LINK BUFF H TO BUFF H+1 MOV H,C ;NEXT BUFF TO PUT LINK IN  CMP H ;NOW ON LAST BUFF? JNZ DEQA50 ;NO, CONTINUE ;  SUB A ;YES, SET CHN OF LAST TO 0 MOV M,A ; ; SET DQT,DQH,TQT,TQH,BUFBP,ASBCNT TO ZERO; ; A = 0  LXI D,DQT ;D,E POINT TO THINGS TO 0  MVI C,ASBCNT-DQT ;# THINGS, LESS 1  CALL CONST ;DQT --> ASBCNT SET TO 0;  LXI H,FLAG ;INIT FLAG FOR PUTADC  MOV A,M ;TURN OFF BINARY FLAG  ANI 377Q-BINARY ;(IN CASE; SOMEONE GOT CONFUSED)  ORI BUFF1+NEWBUF ;NEW OUTPUT BLOCK MOV M,A ;AND NEW BUFFER;  POP B  RET ;************************************************ ; ; DABORT; USED BY PRODUCER TO ABORT BAD DATA WHEN ; RECEIVING ;  ; ENTRY DON'T CARE ; ; EXIT ALL REGS DESTROYED; NON-BLKIN MODE: ; RETURNS IMMEDIATELY IF BUFRER; ALREADY SET, OTHERWISE; SET BUFRER ; APCNT = PCNT ; BUFPCO = APCNT  ; BLKIN MODE: ; DEQUEUES ANY BUFFERS ; CHAINED FROM LAST BUFFER; WITH BLOCK BOUNDARY ; STARTS PRODUCER AT POINT ; WHERE BOUNDARY WAS, IE, ; APCNT = PCNT; BUFPCO = APCNT; ;************************************************ ; ; ENTRY POINT ; DABORT:LDA FLAG ;BLKIN MODE? ANI BLKIN  LXI D,BUFRER ;(ASSUME NOT, D=0 E=BUFRER)  JZ SETBND ;NO, MARK CURRENT PRODUCER; POSITION AS HAVING RECEIVE; ERROR AND RETURN ; ; HERE TO ABORT IN BLKIN MODE ;  LDA BUFBP ;H=ADDR OF LAST BUFF WITH  MOV H,A ;BLOCK BOUNDARY  ANA A ;IF STILL ON FIRST MSG BLK JZ DEQALL ;THEN START FROM SCRATCH MVI L,PCNT ;SET APCNT=PCNT  CALL SETPC2 ;AND BUFPCO=APCNT ;  MVI L,CHN ;GET CHAIN PTR OF THE  MOV B,M ;BUFF THAT HAD THE BARRIER;  SUB A ;IF THERE AREN'T ANY BUFFS CMP B ;PAST THE BLK BOUNDARY RZ ;THEN ALL DONE; ; HERE TO DEQUEUE BUFFERS LINKED TO ; THE BUFFER THAT HAS THE BLOCK BOUNDARY;  MOV A,H ;SAVE ADDR OF BUFF LXI H,DQT ;H,L POINT TO DQ-TAIL  MOV C,M ;B=1ST BUFF IN CHAIN TO DEQ ; C=LAST BUFF IN CHAIN TO DEQ  MOV M,A ;DQ-TAIL MUST NOW BE THE; BUFFER WITH BLK BOUNDARY DCX H ;H,L POINT TO FQH  DCX H  JMP CHNXQ ;INSERT CHAIN AT BEG OF FQ; AND RETURN ;************************************************ ; ; FQHDQT; TAKE A FREE BUFFER FROM FQH AND APPEND ; TO END OF DQ (IE, AT DQT); ; INITIALIZES THE NEW BUFFER, AND CAUSES ; PRODUCER TO USE PCNT ;  ; ENTRY DON'T CARE ;  ; EXIT A DESTROYED ; Z FQ IS EMPTY; NZ APCNT = BUFIP (5); PCNT = BUFIP (5) ; CCNT = BUFIC (4) ; BFLG = BUFIF (0) ; CHN = BUFICH (0) ; ; BUFPCO = PCNT; ;************************************************ ; ; ENTRY POINT ; FQHDQT:PUSH B  PUSH D  PUSH H ;  LXI B,DQT ;DESTINATION = DQ-TAIL LXI H,FQH ;SOURCE = FQ-HEAD  CALL XQHYQT ;APPEND BUFF FROM FQ TO DQ JZ RTHDB2 ;WHOOPS, FQ EMPTY  ; ; INITIALIZE BUFFER HEADER OF NEW BUFFER;  MOV H,A ;H = ADDR OF NEW BUFFER  MVI L,APCNT ;H,L PT TO APCNT OF NEW BUFF;  MVI M,BUFIP ;APCNT = BUFIP INX H  MVI M,BUFIP ;PCNT = BUFIP  INX H  MVI M,BUFIC ;CCNT = BUFIC  INX H  SUB A  MOV M,A ;BFLG = 0  INX H  MOV M,A ;CHN = 0;  INR A ;PRODUCER USES PCNT  STA BUFPCO ;(IE, BUFPCO=1) ;  ANA A ;SET NZ CONDITION CODE POP H ;AND RETURN  POP D  POP B  RET ;************************************************ ; ; XQHYQT; GENERALIZED ROUTINE TO DEQUEUE A BUFFER; FROM HEAD OF SPECIFIED SOURCE QUEUE TO ; TAIL OF SPECIFIED DESTINATION QUEUE; ; ENTRY LXI B,YQT YQT=TAIL OF DEST Q ; LXI H,XQH XQH=HEAD OF SOURCE Q  ; CALL XQHYQT ; ; DQHYQT; DEQUEUE BUFFER FROM HEAD OF DATA QUEUE ; (SOURCE) TO TAIL OF SPECIFIED ; DESTINATION QUEUE ; ; ENTRY LXI B,YQT YQT=TAIL OF DEST Q  ; CALL DQHYQT ; ; EXIT ALL REGISTERS DESTROYED ; Z SOURCE QUEUE IS EMPTY; NZ BUFFER MOVED SUCCESSFULLY; A = ADDR OF BUFFER THAT WAS; MOVED (BUFF DEQUEUED FROM ; SOURCE AND ENQUEUED TO; DESTINATION); ;************************************************ ; ; ENTRY POINT ;  DQHYQT:LXI H,DQH  ; ; ENTRY POINT ; ; B,C PO@@=INT TO TAIL OF DEST Q ; H,L POINT TO SOURCE Q HEADXQHYQT:MOV D,M ;ADDR OF 1ST BUFF IN SOURCE  SUB A ;IS SOURCE Q EMPTY?  CMP D  RZ ;YES, THEN NOTHING TO DO MVI E,CHN ;D,E POINT TO CHN OF 1ST BUF XCHG ;  MOV A,M ;ADDR OF 2ND BUFF IN SOURCE  STAX D ;SOURCE HEAD = ADDR OF ANA A ;2ND BUFF IN ITS CHAIN JNZ XQH200 ;BRANCH IF THERE IS 2ND BUFF; ; SPECIAL CASE WHEN SOURCE Q HAS ONLY 1 BUFF;  DCX D ;D,E POINT TO TAIL POINTER STAX D ;TAIL=0 (HEAD ALREADY=0); ; SET CHAIN POINTER OF 1ST BUFF TO 0; XQH200:MVI M,0 ;TERMINATE THE CHAIN; ; ENQUEUE 1ST BUFF IN SOURCE Q TO TAIL ; OF DESTINATION Q ;  LDAX B ;ADDR OF LAST BUFF IN DEST Q ANA A ;(IS DEST Q EMPTY?)  MOV D,A ;SAVE ADDR OF LAST IN D  MOV A,H ;ADDR OF 1ST BUFF IN SOURCE  STAX B ;TAIL=ADDR OF 1ST SOURCE BUF;  MOV H,D ;H,L POINT TO CHN OF LAST ; BUFF IN DESTINATION Q  JNZ XQH300 ;BRANCH IF DEST Q NOT EMPTY ; ; SPECIAL CASE WHEN DESTINATION QUEUE EMPTY ;  INX B ;SET DEST Q HEAD TO 1ST BUFF MOV H,B ;H,L POINT TO DEST Q HEAD  MOV L,C ;A=ADDR OF 1ST SOURCE Q BUFF ANA A ;SET NZ CODE FOR RET; ; HERE TO LINK 1ST BUFF IN SOURCE QUEUE TO; LAST BUFF IN DESTINATION QUEUE OR SET HEAD OF ; DESTINATION QUEUE TO 1ST BUFF OF SOURCE QUEUE ; XQH300:MOV M,A  RET ;(CAUTION: MUST RETURN NZ) ;************************************************ ; ; DCSTOP; WAITS FOR CURRENT DATACOM OPERATIONS  ; TO FINISH ;  ; ENTRY DON'T CARE ;  ; EXIT A DESTROYED ; INTERRUPTS DISABLED, DATACOM CEASED ; ;************************************************ ; ; ENTRY POINT ; DCSTOP:DI ;INTERRUPTS OFF WHILE CHECK  LDA ASFLAG ;AND CHECK TO SEE IF ANA A ;DATACOM TRANSMITTING OR; RECEIVING  RZ ;CAUGHT HIM! RETURN WITH DI  EI ;LET INTERUPTS HAPPEN HERE JMP DCSTOP ;STILL BUSY, KEEP TRYING ;************************************************ ; ; PAREBC; TRANSLATE ASCII TO EBCDIC ; OR ADD PARITY ; ; ENTRY B = CHARACTER TO TRANSLATE; ; EXIT IF HCODE=0 AND PMASK=0 THEN A=B ; ELSE IF B=177 & HCODE=1 THEN A=377; ELSE IF B=177 & PMASK=1 & KB2SMN=1; THEN A=377 ; ELSE IF HCODE=1, A=TRANSLATED B ; ELSE IF PMASK=1, A=PARITY'D B ; B NEVER MODIFIED; C,D DESTROYED ; ;************************************************ ; ; ENTRY POINT ; PAREBC:LDA CONFIG ;IF NEITHER EBCDIC NOR 8-BIT ANI HCODE+PMASK ;MODE, THEN DO NOTHIN MOV C,A ;SAVE CONFIG BITS  MOV A,B ;CHARACTER TO XLATE OR PARIT RZ ;RET IF HCODE=0 & PMASK=0 ;  CPI TPADI ;CHECK FOR ASCII TPAD  JNZ PARCHK ;BRANCH IF NOT TPAD ;  LDA KBJMP2 ;IF KB2SMN=1 (AND PMASK=1); THEN WANT TPADIO=377; REGARDLESS OF PARITY ORA C ;ALSO WANT TPADIO=377  ORI TPADI ;IN EBCDIC MODE  RM ;RET IF FORCED TPADIO=377 ; PARCHK:MOV A,C ;HCODE & PMASK BITS  ANA A ;(KNOW ONE OF THEM IS ON)  JP PARITY ;IF PMASK, GO ADD PARITY; ; HERE TO TRANSLATE FROM ASCII TO EBCDIC ; (EXCEPT FOR TPAD'S) ;  PUSH H ;(SAVE FOR CALLER) LHLD HEXOUT ;ADDR OF TRANSLATE TABLE MOV A,B ;CHARACTER TO TRANSLATE  ANI 177Q ;LOW ORDER 7 BITS ONLY ADD L ;COMPUTE LOW-ORDER ADDR  MOV L,A ;(ASSUMES 128 ALIGNMENT) MOV A,M ;TRANSLATED CHARACTER ;  POP H  RET ;************************************************ ; ; CTL2ON ENTER WITH A = BITS TO TURN ON; (IN IODC+OCTL2) ; ; CTL2OF ENTER WITH A = BITS TO TURN OFF ;  ; CAON TURN ON "CA" ; ; CAOND1 TURN ON "CA" ONLY IF DEV1 IS NOT ON ; ; CAOFF TURN OFF "CA" ; ; ALL EXITS ; A = RESULT OUTPUT TO BOARD; H,L DESTROYED ; ;************************************************ ; ENTRY POINT ; CAOND1:LDA IODC+ST2 ;TURN ON "CA"  ANI ST2CCZ ;ONLY IF NOT DEV1  RZ ; ; ENTRY POINT ; CAON: MVI A,CT2CAZ ;TURN ON "CA" ; ; ENTRY POINT ; CTL2OF:LXI H,CTL2 ;CTL2 ALWAYS = IODC+OCTL2  CMA ;MASK OF BITS TO LEAVE ON  ANA M ;TURN OFF SPECIFIED BITS JMP CTL2ST ;AND UPDATE OCTL2 ; ; ENTRY POINT ; CAOFF: MVI A,CT2CAZ ;TURN OFF "CA"; ; ENTRY POINT ; CTL2ON:LXI H,CTL2 ;CTL2 ALWAYS = IODC+OCTL2  ORA M ;TURN ON SPECIFIED BITS CTL2ST:MOV M,A ;UPDATE CTL2 STA IODC+OCTL2 ;AND THE DC BOARD  RET ;************************************************ ; ; STRBCC; COMPUTE BCC FOR CHARACTER STRING ; TERMINATED BY A STOPER ; ; ENTRY H,L POINT TO STRING ; ASCRC,ASLRC INITIALIZED ; TO THE APPROPRIATE VALUE ; ; HDRBCC; COMPUTE BCC FOR HEADER ;  ; ENTRY ASBCC = 0 ; ; EXIT ALL REGS DESTROYED; BCC IN ASCRC,ASLRC; ;************************************************ ; ; ENTRY POINT ; HDRBCC:LXI H,ID1 ;COMPUTE BCC FOR HEADER ; ; ENTRY POINT ; STRBCC:MOV B,M ;1ST CHAR IN STRING ; STRB10:PUSH H ;(BCC DESTROYS H,L)  CALL BCC ;ACCUMULATE NXT CHAR IN BCC  POP H  INX H ;POINT TO NXT CHAR MOV B,M ;NEXT CHAR IN STRING MOV A,B  ANA A ;IS IT A STOPER? JNZ STRB10 ;NO, CONTINUE  RET ;YES, DONE ;************************************************ ; ; WRUS3P; SET UP WRU STATUS BYTE #3; AND ADD PARITY TO TRANSMIT STRING; AND ADD STOPER TO TRANSMIT STRING; ; WRUST3; AS ABOVE, EXCEPT FORCE 0 PARITY;  ; ENTRY DON'T CARE ; ; EXIT A,B,C,D,E DESTROYED ; H,L POINT TO BEGINNING OF WRUSTS; ;************************************************ ; ; WHO-ARE-YOU STATUS BYTE #3:  ; BITS 3-0 = TRMTYP ; BIT 4 = REMSET ; BIT 5 = 1 ONLY IF ASBCNT > 0 ; BIT 6 = 1 ; ; ENTRY POINT ; WRUST3:MVI C,PMASK+VRCFC0 ;CLEAR PARITY BITS  JMP WRUS25 ; ; ENTRY POINT ; WRUS3P:LDA CONFIG ;ADD CORRECT PARITY  MOV C,A ; WRUS25:LDA TRMTYP ;LOW ORDER 4 BITS=TERM TYPE  ANI 17Q ;CLEAR OTHER JUNK  MOV B,A ;SAVE FOR LATER  LDA CMFLGS ;WANT LOCAL/REMOTE BIT ANI REMSET ;CLEAR OTHER JUNK  ORA B ;COLLECT STATUS BITS MOV B,A ;SAVE FOR LATER  LDA ASBCNT ;WANT BIT TO SAY THAT TERM; WANTS TO TRANSMIT  DCR A ;IF ASBCNT > 0, THEN TERM  MOV A,B ;WANTS TO TRANSMIT JM WRUS50 ;BRANCH IF NOTHING TO SEND ORI 40Q ;BIT TO SAY WANT TO SENDWRUS50:ORI ATSINI ;MAKE BYTE BE ALPHA ;  MOV B,A ;SET UP FOR LOOP LXI H,WRUSTS+3 ;ADDR OF XMIT STOPER MVI M,0 ;APPEND STOPER TO STRING DCX H ;ADDR OF 3RD STATUS BYTE MVI E,2 ;# OF STATUS BYTES, LESS 1; ; LOOP TO ADD PARITY TO WRU STATUS BYTES; WRUS75:MOV A,C ;C DETERMINES PARITY TO ADD  CALL PARITC ;(0 OR CORRECT)  MOV M,A ;STORE IN STATUS STRING  DCR E ;COUNT OF # OF BYTES RM ;RETURN IF CNT DEPLEATED DCX H ;PT TO NEXT STATUS BYTE  MOV B,M ;FETCH NEXT BYTE JMP WRUS75 ;CONTINUE  DIAGDC EQU $  LDA DCSPTR  STA DCBPTR ;SET GET BUFFER ADDR LDA KBDCSW ;READ KB DC SWITCHES STA IODC0+IODCCT ;SET DC CONTROLS BAUD RA LXI H,DIA900 ;SET DIAGNOSTIC DC INTERRUPT SHLD ASVCT1 ;SET VCT1  JMP RTNCZ2 ;RETURN WITH NC & Z FLAGS ; AND DON'T ENABLE INTERRUPTS DIA500 EQU $  LHLD DCSPTR ;GET BUFFER ADDR LDA DCBPTR ;GET STORE BUFFER ADDR CMP L ;ARE THEY THE SAME?  JZ WAIT DIA507 EQU $  MOV L,A ;BUMP GET BUFFER ADDR  INR A ;INTO A STA DCBPTR ;AND STORE INTO DCBPTR MOV A,M ;GET CHAR FROM BUFFER  CPI ENQI ;IS CHAR ENQ?  JNZ RETNCZ DIA600 EQU $  LXI H,WAIT ;LOAD WAIT RETURN ADDR MVI D,ACK ;SET FOR ACK RESPONSE  JMP DIA800 ;GO TO OUTPUT ACK DIA700 EQU $  LXI H,RETNCZ ;LOAD RETURN ADDR DIA800 EQU $  LDA IODC0+IODCST ;READ DC STATUS ANI DCTBE ;IS XMIT BUFFER EMPTY  JZ DIA800 ;NO LOOP TILL YES  MOV A,D ;RESTORE CHAR  STA IODC0+IODCDO ;OUTPUT CHAR  PCHL DIA900 EQU $  LXI H,EXIT ;LOAD EXIT ADDR  PUSH H ;SET RETURN  LDA IODC0+IODCST ;READ STATUS DC  LDA IODC0+IODCDI ;GET THE CHAR  ANI 177Q ;REMOVE PARITY BIT RZ ;RETURN IF NULL  CPI ADEL ;CHECK FOR RUBOUT  RZ ;RETURN IF RUBOUT DIA910:LHLD DCSPTR ;GET STORE BUFFER PTR  MOV M,A ;STORE THE CHAR  INR L ;BUMP THE PTR  SHLD DCSPTR ;STORE THE NEW PTR RET ;*************************************************; ; BCC - BLOCK CHECK CHARACTER ; ENTRY: B=CHAR TO BE BLOCK CHECKED; EXIT: B+C=ORIGINAL CHARACTERS ; D,E,H,L ARE DISTROYED ; ; THIS ROUTINE DOES A LRC OR CRC16; DEPENDING ON WHETHER THE XMIT CODE; IS EBCDIC OR THE BCC IS A CRC16 OR; THE TERM IS IN TRANPARENCY MODE ; ;*************************************************BCC EQU $ ;ENTRY B = CHAR ASBCC =BCX LHLD ASBCC ;GET BCC LDA CONFIG ;GET CONFIGURATION BYTE  ANI CRC16 ;CRC16 CK REQUIRED?? JNZ CRCOUT ;GO DO CRC16 MOV A,B ;A=CHAR  XRA L ;BUMP LRC  STA ASBCC ;SAVE LRC  RET ;RETURN TO CALLER CRCOUT EQU $  MOV A,B ;RESTORE A; ; NXCRC ADD BYTE TO CRC16 ; ; ENTRY: A = BYTE TO BE ADDED; ; EXIT: D,E DISTROYED ; H,L = CRC (LSB,MSB)NXCRC: XRA L ;COMPUTE R(I,H) + M(I) MVI E,0 ;SET C-REG FOR EVEN PARITY JPE NXCL1 ;SET PARITY TRRM INR E ;SET E TO 1 FOR ODD PARITYNXCL1: RAR ;COMPUTE (R+7) * X JC NXCL3 ;SET CARRY BYTE  MVI L,0 ;NO CARRY SET TO ZERO  JMP NXCL4 NXCL3: MVI L,200Q ;SET CARRY TO X**9 ANA A ;CLEAR THE CARRY FLAG NXCL4: MOV D,A ;SAVE INTERMEDIATE RESULT  RAR ;COMPUTE (R+M) * X**2  JNC NXCL5 ;SKIP IF NO CARRY  INR L ;SET CARRY TO X**8NXCL5: XRA D ;COMBINE PARITY TERM WITH LS MOV D,A ;OF NEWCRC AND SAVE IT MOV A,E ;FETCH PARITY FLAG RRC ;SET UP PARITY ADJUSTMENT  RAR ;WORD = (1+X) * PARITY XRA D ;COMBINE WITH (M+R)*(X+X**2) MOV D,A ;SAVE RESULTS  MOV A,L ;FETCH CARRY BYTE  RRC ;ROTATE BITS TO PROPER PLACE XRA L ;COMBINE M(0) AND M(1) ANI 300Q ;CONSIDER UPPER 2 BITS ONL XRA H ;ADD TO LSB OF PREVIOUS CRC  XRA E ;ADD IN PARITY TERM  MOV L,A ;SET NEW CRC BYTES MOV H,D  SHLD ASBCC ;RESTORE BCC RET ;RETURN TO SENDER ;************************************************ ; ; PARITY IF FORCED PARITY IS ON; THIS ROUTINE ADDS PARITY TO THE ; CHARACTER ; ; ENTRY: B=CHARACTER TO CALC ; PARITY AGAINST; ; EXIT: A=CHARACTER + PARITY; B=ORIGINAL CHAR ; C=CONFIG; D=DISTROYED ; PARITY EQU $  LDA CONFIG ;GET CONFIG BYTE MOV C,A ;C=CONFIG PARITC EQU $  ANI TPAR ;XPARENT?? MOV A,B ;A = CHAR  RNZ ;YES SKIP PARITYPARITP EQU $  MOV A,C ;A = CONFIG  ANI PMASK ;PARITY MASK?? MOV A,B ;A = CHAR  RZ ;NO RETURN TO CALLERPARIT EQU $  MOV A,B ;A=CHAR  ANI 177Q ;USE ONLY 7 LOWER BITS MOV D,A ;SAVE 7 LO BITS  ANA A ;SET PARITY CONDITION CODE MOV A,C ;GET CONFIG  RRC ;PUT VRC1 IN HI ORDER BIT  JPE PAR010 ;JUMP IF PARITY IS EVEN  RRC ;PUT VRC2 IN HI ORDER BIT PAR010 EQU $  ANI 200Q ;MASK ALL BUT PARITY BIT ORA D ;OR IN 7ORIG BITS  RET ;RETURN TO CALLER ;  ; CHECK TIME ROUTINE ; ENTRY: ASTCNT CONTAINS TIMER CNT; EXIT: ASTCNT CONTAINS ADJUSTED TCNT ; CC = Z IF TCNT = O; CC = NOT Z IF TCNT = NOT ZERO ; ; THIS ROUTINE DECREMENTS THE TIMER; CNT AND RESETS THE TIMER IF THE; CNT IS NOT ZERO. ; CKTIME EQU $  STA IODC+RTIME ;RESET TIME  LDA ASTCNT ;GET TIMER COUNT DCR A ;TCNT=TCNT-1 RZ ;RETURN IF ZERO  STA ASTCNT ;RESTORE TCNT  STA IODC+STIME ;GO SET TIMER  RET ;RETURN   ORG ZDCBAS+4000Q ;BEG OF NEXT ROM ; REV1A: DB 'S' ;ROM IDENTIFIER BYTE PAIR ; (DATACOM VERSION #3) DB (ZDCBAS+4000Q)/256; ; TABLE OF CONTROL SEQUENCE FLAGS FOR; "SHORT POLL/SELECT" (WHEN 1ST 2 CHARS; MATCH GID AND 3RD CHAR IS "ENQ", THEN; CTLIN USES THIS TABLE TO DETERMINE ; WHETHER CTL SEQ IS A POL OR SELEC; ; WARNING: TABLE MUST BEGIN ON 256+2 BOUNDARY ; MATABL EQU $ MATBLH EQU MATABL/256 ;HI ORDER ADDR ; OF CTL SEQ TBL ;  DB 0 ;1ST CHAR="OTHERS", NO MATCH DB POL ;1ST CHAR=GROUP ID DB SELEC ;1ST CHAR=SELECT ID  DB 0 ;1ST CHAR=TILDA, NO MATCH  ;*************************************************; ; EOTIN - PUTS TERMINAL IN CONTROL MODE; WAITING FOR CONTROL SEQUENCE ; ;************************************************ RPADIN:CALL ETV1P ;WAIT FOR TPAD & RESETEOTIN EQU $ ;CLR@@> DATA COMM CARD FOR EOT  MVI A,CT2CBD+CT2CMM+CT2CDZ CALL CTL2OF ;GO SET CTL2 BIT OFFEOTIN1 EQU $  CALL RESEXT ;GO RESET + SET EXIT JMP EXIT ;GO WAIT FOR INTERRUPTEOTSRH EQU $ ;SEARCH FOR EOT CHAR CPI ST1IBF ;INPUT BUFF FULL ONLY?? REV1B: JNZ EOTIN1 ;NO, GO RESET THE RECEIVER; (DON'T DROP CB INHIBIT) EOT010 EQU $  LDA TPADIO ;CHECK TO SEE IF CHAR=TPAD CMP B  JZ RTIMER ;CHAR=TPAD, GO IGNORE ITEOT012 EQU $  LDA SYNC ;A=SYNC ?? CMP B  JZ RTIMER ;YES IGNORE CALL CKDLE ;GO CK FOR DLE?? JZ RTIMER ;DLE IN GO WAITEOT015 EQU $  LDA EOT ;GET EOT CHAR CMP B ;CHAR = EOT??? JNZ ASJMP2 ;NO EXIT THRU VECTOR 2  MOV A,C ;A=CONFIG  PUSH PSW ;SAVE PSW  CALL TQDQ ;GO DEQ BUFFERS  POP PSW ;RESTORE PSW ANI DLC ;DLE IN ?? JZ EOT020 ;NO GO TO CTLIN DISCON EQU $  MVI A,CT2CAZ+CT2CBD+CT2CDZ ;ZERO CA AND C CALL RESCT2 ;RESET DC + SET CTL2 MVI A,300Q ;SET TIMER TO 10 SECS  CALL ETV1P ;SET VECTOR1 + TIMERDIS010 EQU $  CALL CKTIME ;GO CK TIMER JZ EOTIN ;TIME UP GO TO CTL MODE  JMP EXIT ;TIME NOT UP GO WAIT;************************************************ ; ; EOTSRH - TERMINAL IS WAITING FOR EOT CHAR; AT BEGINNING OF CONTROL SEQUENCE; ;************************************************ EOT020 EQU $  CALL RESET  LXI H,CTLIN ;SET VECTOR 2 TO CTLIN JMP ETV2 ;GO SET TIMER + VECTOR2 ;*************************************************ETV1P: POP H ;NEXT INTERRUPT HANDLER ETV1 EQU $ ;EXIT-SET TIMER,ASVCT1 SHLD ASVCT1 ;PUT H&L IN VECTOR 1 JMP RTIME1 ;GO SET TIMEETV1V2 EQU $ ;EXIT-SET TIMER,ASVCT1,ASVCT; ASVCT1=H&L ASVCT2=D&E  SHLD ASVCT1 ;PUT H&L IN VECTOR 1ETV2X EQU $  XCHG ;H+L=D&EETV2 EQU $ ;HXIT SET TIMER,ASVCT2 SHLD ASVCT2 ;PUT H&L IN VECTOR 2RTIME1 EQU $ ;SET TIMER CNT TO 1  STA ASTCNT ;STORE TIMER CNTRTIMER EQU $ ;RESET & SET TIMER STA IODC+RTIME ;RESET TIMER STA IODC+STIME ;SET TIMER;************************************************ ; ; STANDARD EXIT ROUTINE RESTORES ALL STATUS  ; ENABLE INTERRUPTS ; ;************************************************ EXIT EQU $ ;EXIT ROUTINE  POP PSW ;* POP H ;*  POP D ;* RESTORE ALL STATUS  POP B ;*  EI ;ENABLE INTERRUPTS RET ;EXIT INTERRUPT PROCESSOR ; CKSTX EQU $  CALL CKTDLC ;TPAR OR DLC ON ??REV1C: JZ EOTIN1 ;NO, GO RESET THE RECEIVER; (CHAR INPUT IS INVALID; IN CONTROL MODE) LDA STX  CMP B ;CHAR = STX?? REV1D: JNZ EOTIN1 ;NO, GO RESET THE RECEIVER; (CHAR INPUT IS INVALID; IN CONTROL MODE)REV1E: JMP ABORT1 ;YES, WAIT FOR END OF BLK ; (DON'T CALL DABORT)  ;*************************************************; ; CTLIN ; PARSES CONTROL SEQUENCE; ; ENTRY B=INPUT CHARACTER ; INPUT STATUS OK ; PADS & SYNCS ALREADY CHECKED FOR; ; EXIT ASFLAG = CONTROL SEQUENCE FLAG; DISPATCHED TO APPROPRIATE HANDLER ; ;*************************************************;  ; HANDLING ROUTINES: ; CKDATA DEVICE OR GROUP POLL ; SELIN DEVICE SELECT; BCSTIN GROUP OR LINE BROADCAST; WRU000 WHO-ARE-YOU; ; CONTROL PASSES TO CKDATA, SELIN OR WRU000; AFTER THE "ENQ" INTERRUPT; THE ROUTINES; ARE EXPECTED TO WAIT FOR THE "TPAD". ; CONTROL PASSES TO BCSTIN AFTER THE 1ST ; DATA CHARACTER INTERUPT. ; ; OPERATION OF MODEM SIGNALS: ; DOWNLINE CB INHIBITED AFTER RECEIVING THE; 2ND CHARACTER OF THE CONTROL SEQUENCE, ; BUT ONLY IF IT MATCHES THE 1ST CHARACTER ; OF THE SEQUENCE (EG AFTER THE 2ND GROUP; ID CHARACTER OF A GENERAL POLL); NOTE; THAT INHIBIT REQUIRED AFTER 2ND CHAR ; MATCH BECAUSE OF SELF-TEST; ALSO NOTE; THAT REQUIRED TO BE AT LEAST 1 CHAR; TIME BEFORE RAISING CA TO ENSURE ; THAT CA DOESN'T GET TO MODEM TOO ; EARLY (IE, BEFORE TPAD COMES IN); NOTE ; THAT CB IS INHIBITED FOR ALL CONTROL  ; SEQUENCES. ; ; IF THE CONTROL SEQUENCE IS A GPOLL OR; WRU, THEN CA IS RAISED AFTER THE 3RD CHAR; OF THE CONTROL SEQUENCE, REGARDLESS OF ; WHETHER OR NOT THERE IS DATA (EG AFTER ; FIRST QUOTE OF GENERAL POLL). NOTE THAT ; IN THE SPECIAL CASE WHEN THE TERMINAL IS ; 1ST IN THE CHAIN, RAISING CA IS DELAYED; UNTIL AFTER THE TPAD IS INPUT. ; ; IF THE CONTROL SEQUENCE IS NOT FOR THE ; PARTICULAR TERMINAL, DOWNLINE CB INHIBIT ; IS DROPPED AFTER THE TPAD IS INPUT.; NOTE THAT MULTIPLE GROUPS/DROP ARE ; ALLOWED BECAUSE 1ST TERM IN CHAIN WAITS; TILL AFTER TPAD BEFORE DROPPING DOWN- ; LINE CB INHIBIT. ;  ; PARSING ALGORITHM: ; 1ST CHAR: ; THE INPUT CHARACTER IS COMPARED ; AGAINST THE 1ST 3 ENTRIES IN CTLTBL;; A MATCH # IS RECORDED IN ASWK2 AS ; GIVEN BY THE FOLLOWING TABLE; ; INPUT RESULTING ; CHAR MATCH # ; ------------------------------------; TILDA 3; SELECT ID 2; GROUP ID 1; "OTHERS" 0;  ; 2ND CHAR: ; INPUT CHAR COMPARED AGAINST IDIN; (WHERE 1ST CHAR RECORDED); IF THEY; ARE NOT IDENTICAL, THE MATCH # IN ; ASWK2 IS FORCED TO 0. ;  ; 3RD CHAR: ; THE CONTROL SEQUENCE FLAG STORED IN ; ASWK2 IS A FUNCTION OF THE INPUT; CHAR, THE ENTRIES IN CTLTBL, AND THE; MATCH # RECORDED IN ASWK2, AS GIVEN ; BY THE FOLLOWING TABLE; ; INPUT MATCH # RESULTING; CHAR IN ASWK2 CTL SEQ FLG ; ------------------------------------; TILDA 3 LBCAST =010; TILDA 2 GBCAST =020; DEV ID 2 SELEC =040; DEV ID 1 POL =100; QUOTE 1 GPOLL =200; BRACE 1 WRU =001;  ; 4TH CHAR: ; MUST MATCH 3RD, ANALAGOUS TO 2ND;  ; 5TH CHAR: ; MUST BE ENQ IF SELEC, POL, GPOLL; OR WHO-ARE-YOU CTLIN: MVI E,3 ;# OF LEGAL 1ST CHARS  LXI H,CTLTBL+2 ;ADDR OF LAST CHAR IN TBL  MOV A,B ;INPUT CHAR (1ST IN SEQ); ; LOOP TO FIND 1ST CTL CHAR IN TABLE; CTL100:CMP M ;INPUT MATCH ENTRY IN TBL? JZ CTL120 ;YES, BRANCH DCX H ;POINT TO NEXT TBL ENTRY DCR E ;COUNT & CHAR-MATCH-#  JNZ CTL100 ;CONTINUE TIL CNT DEPLEATED ; ; WHEN HERE, C HAS MATCH # (0 = NO MATCH) ; CTL120:MOV D,B ;SAVE 1ST CHAR (CMP TO 2ND)  XCHG ;SAVE CHAR-MATCH-# SHLD ASWK2 ;ASWK2=MATCH#, ASWK2+1=CHAR ;  LXI H,CTL300 ;WHERE TO GO AFTER 2ND CHAR ; CTL130:LXI D,CTL200 ;CTL200 HANDLES NXT CHARCTL140:SHLD ASWK3 ;WHERE TO GO AFTER THAT CHAR JMP ETV2X ;SET VCT2=D,E & EXIT; ; HERE TO ENSURE 2ND CHAR MATCHES 1ST  ; AND 4TH MATCHES 3RD ; CTL200:LDA ASWK2+1 ;LAST CHAR (1ST OR 3RD)  CMP B ;DOES 2ND=1ST OR 4TH=3RD ? MVI A,CT2CBD  JZ CTL250 ;YES, INHIBIT DOWNLINE CB ;  SUB A ;NO, THEN ILLEGAL SEQUENCE STA ASWK2 ;SO SET MATCH # TO 0; AND DON'T CTL250:CALL CTL2ON ;INHIBIT CB  LHLD ASWK3 ;GET RETURN ADDR JMP ETV2 ;SET VCT2 & EXIT ANYWAY ; ; HERE TO HANDLE 3RD CHAR OF SEQUENCE ; CTL300:LXI H,CTLTBL+2 ;TBL OF POSSIBLE 3RD CHARS LXI D,3*256+LBCAST ;D=3 (LARGEST MATCH #; E=LBCAST (1ST FLAG) LDA ASWK2 ;C=MATCH # OF 1ST CHAR MOV C,A ; ; LOOP TO FIND A MATCH BETWEEN THE 3RD CHAR ; AND AN ENTRY IN CTLTBL AND A MATCH WITH THE ; MATCH# FOUND FOR 1ST CHAR OF CONTROL SEQUENCE ; CTL320:MOV A,B ;INPUT CHAR (3RD IN SEQ) CMP M ;DOES IT MATCH TBL ENTRY?  JNZ CTL330 ;NO MATCH, GO TO NXT ENTRY; ; HERE WHEN 3RD CHAR MATCHES ENTRY IN TBL ;  MOV A,C ;DOES 1ST CHAR MATCH # FIT?  CMP D ;D HOLDS APPROPRIATE MATCH # JZ CTL340 ;HEY, IT MATCHES! ; CTL330:INX H ;ADDR OF NEXT ENTRY IN TBL MOV A,E ;COMPUTE NEXT FLAG BIT RLC ;(AS-FLAGS MUST BE IN ORDER) MOV E,A ;(FLAG OF 0 MEANS NO MATCH)  ANI (LBCAST+SELEC+WRU)*2 ;IF WERE AT ; ONE OF THESE FLAGS, TIME TO ; UPDATE CORRECT MATCH # JZ CTL320 ;MATCH# OK, CNT SEARCH DCR D ;UPDATE MATCH #  JNZ CTL320 ;CONTINUE TIL TBL DEPLEATED  MOV E,D ;HERE, SEQUENCE IS ILLEGAL; SO SET FLAGS TO 0 ; ; HERE WHEN HAVE RESOLVED WHAT THE CONTROL; SEQUENCE IS; E HAS FLAG FOR CTL SEQ ; (OR 0 IF ILLEGAL) ; CTL340:MOV D,B ;3RD CHAR OF SEQUENCE  XCHG ;ASWK2=CTL SEQ FLAGS SHLD ASWK2 ;ASWK2+1=3RD CHAR OF SEQ;  MOV A,L ;CTL SEQ FLAGS ANA A ;0=INVALID SEQ JZ CTL360 ;IF INVALID, GO CHECK ENQ ;  ANI GPOLL+WRU ;CONDITIONS UNDER WHICH CNZ CAOND1 ;WE SHOULD TURN ON "CA" ; CTL350:LXI H,CTL500 ;WHERE TO GO FOR 5TH CHAR  JMP CTL130 ;SET UP TO CHECK 4TH CHAR ; ; HERE WHEN 3RD CHAR OF SEQUENCE DOESN'T MATCH ; CHECK FOR ENQ ; (WILL ACCEPT GID-GID AS VALID POLL SEQ; OR SID-SID AS VALID SELECT SEQ) ; CTL360:LDA ENQ ;CHECK 3RD CHAR FOR ENQ  CMP B ;IF NOT AN ENQ, THENREV1F: JNZ REV1O ;MUST BE LONG CTL SEQ ; (ADD CODE TO LOWER; INHIBIT IF NOT 1ST) ; IF IT IS ENQ, THEN; ASSUME SHORT SEQ;  MVI B,MATBLH ;B,C=ADDR OF CTL SEQ FLGS  INX B ;(TBL BEGINS ON 256 BOUNDARY INX B ;PLUS OFFSET OF 2) LDAX B ;A=SELEC IF 1ST CHAR = SID; A=POL IF 1ST CHAR = GID  STA ASFLAG ;SET CONTROL SEQUENCE FLAG JMP CTL520 ;GO DISPATCH TO HANDLER ; ; WHEN HERE, HAVE 1ST FOUR CHARS OF CTL SEQ ; CTL500:LDA ASWK2 ;CTL SEQUENCE FLAGS  CPI POL ;IF GPOLL OR POL AND 4-CHAR  JC CTL510 ;CTL SEQ, THEN WANT TO ORI HDRSW ;TURN ON THE HDR SWITCH CTL510:MOV C,A ;CTL SEQUENCE FLAGS  STA ASFLAG ;SET CONTROL SEQUENCE FLAG;  ANI BCAST ;IF BROADCAST SEQ, INPUT DAT JNZ BCSTIN ;(NO ENQ FOR BROADCAST) ; (NOTE THAT LIGHT WILL NOT ; FLASH WHEN GET BROADCAST) ;  LDA ENQ ;ENQ (XLATED & PARITY'D) CMP B ;IS THE INPUT AN ENQ?  JNZ RPADIN ;NO, GO BAIL OUT, ILLEGAL ;  MOV A,C ;CTL SEQUENCE FLAGS ; CTL520:LXI H,ASACK ;MUST INITIALIZE ACK FLAG  MVI M,ACKDC ;GPOLL & WRU USE ACKDC;  CPI POL ;CTL SEQ = GPOLL OR POL ?  JC CTL530 ;JMP IF NOT A GPOLL OR POL ANA A ;TEST FOR GPOLL BIT ; (WARNING: HDRSW MAY BE ON) JM CKDATA ;BRANCH IF GPOLL CTL SEQ MVI M,ACK1F ;IF POL, NEED ACK FLAG = 1 JMP CKDATA ;GPOLL&POL GO TO CKDATA ; CTL530:RRC ;WRU CTL SEQ?  JC WRU000 ;YES ;  MVI M,ACK0F ;SELEC NEEDS ACK FLAG = 0  ANI SELEC/2 ;SELECT CTL SEQ? JNZ SELIN ;YES  JMP RPADIN ;FLAG BYTE = 0; GO BAIL OUT  ;************************************************ ; ; WRU000; ROUTINE TO TRANSMIT WHO-ARE-YOU STATUS ; SEQUENCE CONSISTS OF OPTIONAL LDR, HDR ; FOLLOWED BY 3 STATUS BYTES,  ; ETX AND BCC ; ;************************************************ WRUNAK EQU $ ;HERE TO RETRANSMIT STATUSWRU000:LXI H,WRU200 ;WHERE TO COME BACK TO JMP PADIN ;AFTER WAITING FOR TPAD ; ; HERE WHEN WANT TO TRANSMIT WRUSTS ; WRU200:LXI H,HDR ;ALWAYS TACK ON HEADER LXI D,WRU300 ;WHERE TO COME BACK TO AFTER JMP SDDXMT ;TRANSMITTING THE HEADER; ; HERE TO TRANSMIT THE WRU STATUS STRING; AND SET UP TO FOLLOW IT WITH BCC STRING ; WRU300:LHLD ASBCC0 ;INITIALIZE BCC TO ZERO  SHLD ASBCC  CALL HDRBCC ;CALCULATE BCC FOR HEADER  CALL WRUS3P ;SET UP WRU STATUS STRING  CALL STRBCC ;ADD IN BCC FOR STATUS STRIN LXI H,WRUSTS ;TRANSMIT WRU STATUS STRING  LXI D,WRUBCC ;RETURN TO XMIT BCC STRING JMP SDDXMT ;SET VECTORS & EXIT  ;************************************************ ; ; CKDATA - CHECK TRANSMIT QUE FOR OUTPUT DATA; IF NO DATA PREPARE TO SEND EOT; ;************************************************ CKEOTO EQU $  LDA CONFG2  ANI EOTO ;SEND EOT FLAG ON??  JNZ WRUACK ;DONE SENDING DATA; GO SEE IF WE SHOULD SEND EOT STC ;SET CARRY FLAG = NO EOTO CKDATA EQU $  LDA ASBCNT ;GET OUTPUT BLOCK COUNT  DCR A ;ANY BLKS TO XMIT ?  JP PADATA ;YES GO SET RETURN & WAIT  JC SDEOT ;NO DATA+NO EOTO GO SEND EOTWRUACK EQU $  LDA IODC+ST2 ;GET STATUS 2  ANI ST2CAZ ;CA=ZERO DOWNLINE??  JNZ SDEOT ;YES GO SEND EOT JMP RPADIN ;WAIT FOR PAD THEN GO TO CTL ;************************************************ ; ; SDDATA - SEND DATA PREPARE DATA BLOCK FOR; XMISSION AND SENT 1ST CHAR (STX); ;************************************************ SDDATA EQU $  LHLD ASBCC0  SHLD ASBCC ;CVLEAR ASBCC  CALL GETX ;GEYT CHAR MOV B,A ;B=CHAR  CALL CKDLE ;DLE CHAR??  LHLD ENTAID ;GET ENTER AID JZ SDD010 ;YES  INX D ;D+E = STX LDAX D  CMP B ;CHAR = STX??  JNZ SDD084 ;NO MUST BE AID SDD010 EQU $  LDA ASFLAG ;GET ASFLAG  ANI HDRSW ;HDR SW ON ??  JZ SDD080 ;NO GO SET NO HDR SDD020 EQU $  SHLD HDR+3 ;PUT AID IN HDR  CALL HDRBCC ;GO DO HDR BCC LXI D,HDR ;D+E=(HDR-STRING) SD@@?D040 EQU $  CALL CKTDLC ;TPAR OR DLC ON ?? JZ SDD050 ;NO  DCX D ;PUSH HDR BACK TO DLE SDD050 EQU $  XCHG ;H+L=STRING ADDR LXI D,STSYNC ;D+E=RETURN SDDXMT:SHLD ASWK1 ;ADDR OF TRANSMIT STRING XCHG SDD070:SHLD ASVCT2 ;SET VECTOR2 TO SEND BUFF  LXI H,XIT030  SHLD ASVCT1 ;SET VECTOR 1 TO XMIT  JMP XIT035 ;GO XMIT STRING SDD080 EQU $  LXI D,DLESTX+1 ;D+E=HDR ADDR  JMP SDD040 ;GO CK DLCSDD084 EQU $  CALL PAREBC ;GO ADD PARITY + XLATE MOV L,A ;L=CHAR  MOV A,B ;GET ORIG CHAR ANA A ;SHORT AID ??  JP SDD020 ;NO GO SET HDR SUB A  MOV H,A ;SET H TO ZERO JMP SDD020 ;GO SET HDR  ;************************************************ ; ; SDBUFF - SEND BUFFER XMIT ALL CHARS IN BUFFER ; XLATE CHAR AND COMPUTE BCC; ;************************************************ SDBUFF EQU $  ANI ST1XMT ;XMIT INTERRUPT ?? JZ XERROR ;NO GO CK STATUS SDB002 EQU $  CALL CKTDLC ;TPAR OR DLC ON ?? LDA DLE ;A = DLE CHAR  JNZ SDB055 ;GO SEND DLE IF TPAR+DLCSDB010 EQU $  CALL GETX ;GET CHAR FROM BUFFER  MOV B,A ;B=CHAR  JZ SDBCC ;BUFFER MT GO SEND BCC MOV A,C ;A=CONFIG SDB020 EQU $  ANI HCODE+TPAR+PMASK ;EBCDIC/TPAR/PARITY  JNZ SDB060 ;NOT VANILA ASCII GO PROCESSSDB040 EQU $ ;DO BCC  CALL BCC SDB050 EQU $  MOV A,B ;A=CHAR SDB055 EQU $  STA IODC+TMIT ;OUTPUT CHAR  JMP EXIT ;GO EXITSDB060 EQU $  ANI TPAR ;XPARENT ??  JZ SDB066 ;NO GO CK HEX  CALL CKDLE ;CHAR = DLE ?? JMP SDB040 ;GO DO BCCSDB066 EQU $ ;CK EBCDIC MOV A,C ;A=CONFIG  ANI HCODE ;EBCDIC CODE ? JZ SDB070 ;NO MUST BE FORCED PARITY LHLD HEXOUT ;YES, H,L = ADDR OF TABLE  MOV A,B ;A = CHAR TO TRANSLATE ADD L ;OFFSET INTO TABLE MOV L,A ;(ASSUME 128 ALIGNMENT)  MOV B,M ;B=XLATED CHAR JMP SDB040 ;GO BCC SDB070 EQU $ ;ADD PARITY TO OUTPUT CALL PARIT ;GO ADD PARITY MOV B,A ;B = CHAR + PARITY JMP SDB040 ;GO BCC WRUBCC:LDA ETX ;WRU ALWAYS USES ETX STA XEND+1 ;STUFF IT INTO BCC STRING  MOV B,A ;SET UP FOR CALL TO BCC SDBCC EQU $  CALL BCC ;DO BCC ON TERMINATOR  STA IODC+RTIME ;RESET TIMER LXI H,XEND+1 ;H+L= TERMINATOR STRING  MOV A,C ;A=CONFIG  ANI TPAR ;XPARENT ??  JZ SDBC10 ;NO  DCX H ;YES BUMP BACK TO DLESDBC10 EQU $  SHLD ASWK1 ;ASWK1 DATA STRING LXI H,STENQ ;SET RETURN TO SENT ENQ  MOV A,C ;A=CONFIG  ANI CRC16 ;CRC16?? JNZ SDD070 ;YES GO SEND STRING  LDA ASBCC ;A=LRC CHAR  MOV B,A ;B=LRC CHAR  CALL PARITP ;CK PMASK + ADD PARITY STA ASBCC ;ASBCC = LRC + PARITY  JMP SDD070 ;GO SEND STRING SDEOT EQU $  LXI D,EOTIN1 ;SET RETURN TO EOTIN1 SDE005 EQU $  LDA EOT ;GET EOT CHAR SDE010 EQU $  LXI H,TLR+1 ;H&L=A(OUTPUT STRING) SDE020 EQU $  MOV M,A ;PUT CHAR IN STRING SDE030:SHLD ASWK2 ;ASWK2 = A(OUTPUT STRING)  XCHG ;H&L=D&E SHLD ASWK3 ;ASWK3=RETURN REACK EQU $  LXI H,SDRESP  SHLD ASVCT2 ;VECTOR 2 = SEND RESPONSE  LDA ASFLAG ;GET FLAG  ANI BCAST ;BROADCAST ON ?? JNZ EOTIN ;YES GO BACK TO EOT SRH JMP TPADIN ;NO GO WAIT FOR TRAILING PASDENQ EQU $  LDA ENQ ;GET ENQ CHAR  LXI D,STENQ ;D&E=RETURN  JMP SDE010 ;GO BUILD TLR SDABRT EQU $ ;ABORT LAST BLOCK & SEND NAK CALL DABORT ;DELETE LAST RECEIVED BLOCK SDNAK EQU $  LDA NAK ;GET NAK CHAR  LXI D,STACK ;D&E=RETURN  JMP SDE010 ;GO BUILD TLR SELIN EQU $  CALL DEQALL ;GO SET UP TO RECVSDACK EQU $  LDA FQO ;GET FREE QUE OUT PTR  ANA A ;IS FREE-Q MT ?  JZ SDWACK ;GO SEND WACK SDA010 EQU $  LXI H,ACK0 ;H+L=A(ACK0) LDA ASACK ;GET ACK FLAG  ANA A ;SET CONDITION CODE  JZ SDA020  INX H ;BUMP POINTER TO ACK1 SDA020 EQU $  MOV A,M ;A=RESP CHAR LXI D,STACK ;D&E=RETURN ROUTINE  LXI H,TLR+1 ;H&L=A(TLR)  MOV M,A ;PUT CHAR IN TLR1  DCX H ;H&L=A(TLR)  JMP SDE030 ;GO BUILD TLR SDWACK EQU $  LXI H,CONFG2 ;GET CONFG2  MOV A,M ;A=CONFG2  ANI EOTO ;ETX IN ?? JZ SDW010 ;NO GO WACK  XRA M ;YES TURN OFF ETX IN MOV M,A ;RESTORE CONFG2  JMP SDA010 ;GO SEND ACKSDW010 EQU $  LXI H,WACK ;M=WACK  JMP SDA020 ;GO STORE IN TLRSDRESP EQU $  LHLD ASWK3 ;RETURN ADDR XCHG  LHLD ASWK2 ;ADDR OF STRING TO XMIT  JMP SDDXMT ;************************************************ ; ; XERROR - XMIT ERROR THIS ROUTINE HANDLES; INTERRUPTS THAT ARE NOT XMIT INTR'S; IF TIMER INTR TIME COUNTER IS CKED ; IF INPUT CHAR CK FOR EOT IF SO GO T  ; CTL MODE ; ;************************************************ XERROR EQU $  MOV A,D ;A=STATUS  ANI ST1TIM ;TIMER INTR  JZ EXIT ;NO GO EXIT  CALL CKTIME ;YES GO CK TIMER  JNZ EXIT ;TIME NOT UP GO EXITSDSYNC EQU $ ;TIME UP SEND SYNC'S LXI H,STSYNC  SHLD ASVCT2 ;ASVCT2= RETURN AFTER SYNCS  JMP XIT010 ;GO SEND SYNCS ;************************************************ ; ; TPADIN - WAIT HERE FOR TRAILING PAD CHARACTER; OR 1 TIMER UNIT (40MS) ; ;************************************************ NAKIN EQU $  LDA ASFLAG ;HERE WHEN RESPONSE = NAK  ANI WRU ;NAK TO WRU SEQUENCE?  JNZ WRUNAK ;YES, RETURN TO WRU CODE CALL TQDQ ;NO, PUT BLOCK BACK IN DQ ; AND FALL INTO PADATAPADATA EQU $  LXI H,SDDATA ;SET RETURN TO SDDATA PADIN EQU $  SHLD ASVCT2 ;ASVCT2=RETURNTPADIN EQU $ ;WAIT FOR TRAILING PAD THEN ; GO TRANSMIT DATA CALL ETV1P ;SET TIMER + VECTOR1=XMIT ;************************************************ ; ; XMIT - TRANSMIT ROUTINE THIS ROUTINE TURNS (C ; REQUEST TO SEND ON AND THEN WAITS ; FOR (CB) CLEAR TO SEND; ;************************************************ XMIT EQU $ ;INTERRUPT WAS CAUSE BY PAD ; CHAR OR TIMER  CALL RESDC ;GO RESET DC COMMANDS  CALL CAON ;GO TURN CA ON !XIT010 EQU $  LXI H,XIT020 ;SET RETURN TO XIT020  SHLD ASVCT1 ;SET VECTOR 1  JMP EXIT ;GO WAIT FOR CLEAR TO SENDXIT020 EQU $ ;CK FOR CLEAR TO SEND ANI ST1XMT ;XMIT BUFF MT??  JNZ XIT025 ;GO SET UP LDRXIT022 EQU $  LDA EOT  CMP B ;CHAR = EOT  JZ EOT020 ;GO SET CTL MODEREV1G: JMP REV1M ;ADD RESET RECEIVER CODEXIT025 EQU $  LXI H,XIT030  SHLD ASVCT1 ;SET VECTOR 1 TO XIT030 LXI H,LDR ;GET LEADER ADDR MOV A,M ;GET 1ST CHAR  CPI STOPER ;STOP CHAR JZ ASJMP2 ;YES GO THRU VECTOR 2  MOV A,C ;A=C/NFIG  ANI TPAR ;IF XPARENCY ADD TPAR  ADD L ;FLAG TO LDR ADDR  MOV L,A  MOV A,C ;A=CONFIG  ANI DLC ;DLC ON ?? JZ XIT028 ;NO  DCX H ;YES ADD DLE TO STRING  MOV A,C  ANI 377Q-DLC ;TURN OFF DLC  STA CONFIG ;SAVE CONFIGXIT028 EQU $  SHLD ASWK1 ;WK1=LDR ADDR  MVI A,ONESEC ;NO  STA ASTCNT ;SET TIMER CNT TO 1 SECOND STA IODC+STIME ;SET TIMER  MOV A,M ;PUT OUTPUT IN RA  JMP XIT040 XIT030 EQU $ ;CK FOR XMIT INTERRUPT ANI ST1XMT ;XMIT INTERRUPT ???  JZ XERROR ;NO GO CK ERROR XIT035 EQU $  LDA BCSTOP ;GET BCC STOP ADDR MOV B,A ;SAVE IN B LHLD ASWK1 ;H&L=OUTPUT CHAR ADDR  MOV A,M ;GET NEXT CHAR CPI STOPER ;LAST CHAR ? JNZ XIT040 ;NO GO XMIT  MOV A,B ;A=BCC STAP ADDR CMP L ;PAST BCC STRING JC ASJMP2 ;YES GO END STRING SUB A ;A=0 XIT040 EQU $ ;NO OUTPUT CHARACTER STA IODC+TMIT ;TRANSMIT CHARACTER INX H ;BUMP ADDR SHLD ASWK1 ;SAVE NEXT ADDR  MOV C,A ;C=XMIT CHAR LDA TPADIO ;GET TPAD  CMP C ;CHAR=TPAD?  JNZ EXIT ;NO GO EXIT  DCX H ;BUMP BACK TO TPAD ADDR  MOV A,B ;A=BCC END ADDR  CMP L ;PAST BCC STRING JNC EXIT ;NO GO EXIT  STA IODC+XCOMP ;SET XMIT CONPLETE JMP EXIT ;************************************************ ; ; STSYN - SENT SYNC CHARS RETURN FROM SENDING ; SYNC CHARS AND RESET TIMER TO ONE S ; ;************************************************ STSYNC EQU $  LXI H,SDBUFF  SHLD ASVCT1 ;SET VECTOR TO SEND BUFFER JMP SDB002 ;GO CONTINUE SENDING BUFFER ;************************************************ ; ; STACK - SENT ACK RETURN FROM SENDING ACK AN ; SET VECTORS TO RECEIVE DATA BLOCK ; ;************************************************ STACK EQU $ ;SENT ACKNOWLEDGEMENT  LXI D,HDRIN ;GO WAIT FOR RESPONSE  JMP RECVIN ;*************************************************; ; STENQ - SENT ENQ SET VECTORS TO RECEIVE A  ; RESPONSE MSG ; ;*************************************************STENQ EQU $ ;SENT ENQ WAIT FOR ACK LXI D,DLEIN ;*************************************************; ; RECVIN - RECEIVE INPUT THIS ROUTINE TERMINATE ; XMISSION AND PREPARES TERMINAL TO ; RECEIVE DATA OR A RESPONSE; ;*************************************************RECVIN EQU $ ;PREPARE TO RECEIVE CALL CAOFF ;GO TURN CA OFF !! CALL RESDC ;GO RESET DC COMMANDS  LXI H,RESPIN ;H+L=VECTOR 1  MVI A,TRISEC ;SET 3 SECOND CNT  JMP ETV1V2 ;GO EXIT SET TIMER,ASVCT1&2 ;*************************************************; ; RESP - RESPONSE WAIT HERE FOR RESPONSE INTR ; THEN GO TO HDRIN OR RESPIN; ;*************************************************RESPIN EQU $  ANI ST1IBF ;INPUT BUFF FULL?? JNZ EOT012 ;YES GO CK SYNC  CALL CKTIME ;NO GO CK TIMEREV1H: JNZ REV1N ;RESET RECV AND EXIT CALL TQDQ ;DEQ BUFFERS JMP EOTIN1 ;GO BACK TO CTL MODEDLEIN EQU $  LXI H,NAK ;GET NAK-RVI-ACK0-ACK1 STRG  MOV A,B ;A=CHAR  CMP M ;CHAR = NAK??  JZ NAKIN ;YES  INX H  CMP M ;CHAR = RVI ?? JZ RVIIN ;YES GO TO RVI INX H  CMP M ;CHAR = ACK0?? JZ ACKIN ;YES GO PROCESS  INX H  CMP M ;CHAR=ACK1 ??  JZ ACKIN ;YES GO CK ACK INX H  CMP M ;CHAR = WACKREV1I: JZ REV1K ;INPUT CHAR = WACK JMP EXIT ;GO IGNORE CHAR ACKIN EQU $  ANI 001Q ;TURN OFF HI BITS  MOV B,A ;SAVE  LXI H,ASACK ;GET ASACK MOV A,M  ANA A ;SET CC  MOV A,B ;A=ACK JM AKI010 ;ACK = DONT CARE GO FLIP  CMP M ;ACK CHAR=ACK FLAG?? JNZ SDENQ ;NO GO SEND ENQ AKI010 EQU $  XRI 001Q ;FLIP ACK FLAGP  MOV M,A ;SAVE IN ASACK LDA ASFLAG ;GET ASFLAG  ANI 377Q-HDRSW ;TURN OFF HDR SW STA ASFLAG ;SAVE FLAG ANI WRU ;WRU ??? JNZ WRUACK ;YES GO ACK  CALL TQFQ ;GO RELEASE BUFFERS  JMP CKEOTO ;GO CK DATA RVIIN EQU $  CALL TQFQ ;RELEASE BUFFERS JMP SDEOT ;GO SEND EOT BCSTIN EQU $ ;CLEAR BUFFERS FOR INPUT CALL DEQALL ;GO REFRESH BUFFERS ;*************************************************; ; HDRIN - HEADER IN CHECK FOR STX CHAR TO START  ; TEXT INPUT ; ;*************************************************HDRIN EQU $  CALL CKTDLC ;CK DLC FLAG + TURN OFF  LDA STX  CMP B ;CHAR =STX ??  JNZ HIN030 ;NO GO CK OTHER CTL CHARS LHLD ASBCC0 ;YES  SHLD ASBCC ;ZERO BCC  MOV A,C ;GET CONFIG  ANI M3270 ;3270 MODE JZ HIN020 ;NO GO EXIT  MVI A,CNT327 ;SET 3270 HDR CNT  LXI D,HIN020 ;SET RETURN  JMP ABT210 ;GO SET TO CHUCK CHARSHIN030 EQU $  LDA ENQ  CMP B ;CHAR=ENQ? JNZ EXIT ;NO IGNORE CHAR  LXI H,TLR+1 ;GET TLR SENT  LDA WACK CMP M ;CHAR = WACK ??  JZ SDACK ;YES GO CK BUFFER LEFT!!  JMP REACK ;YES RESEND LAST RESPONSE RERROR EQU $  MOV A,D ;A=STATUS  ANI ST1TIM ;TIMER ERROR JNZ ABORT ;YES  MOV A,D ;A=STATUS  ANI ST1PER ;PARITY ERROR  JNZ ABORTN ;YES ABORT&SEND NAK JMP ABORTE ;GO ABORT WITH EOTHIN020 EQU $  CALL ETV1P ;SET TIMER + VECTOR1=DATAIN DATAIN EQU $  CPI ST1IBF ;INPUT BUFFER FULL ONLY ?? JNZ RERROR ;NO GO TO RECV ERROR CALL PARITY ;GO CK FORCED PARITY CMP B ;A=B?? JNZ ABORTN ;NO MUST BE PARITY ERROR CALL CKTDLC ;TPAR OR DLC ON ?? PUSH PSW ;SAVE CONDITION CODES  JC DIN010 ;TPAR ON GO CK FOR DLE  LDA SYNC ;NO TPAR OR TPAR DLC CMP B ;CHAR = SYNC?? JNZ DIN015 ;NO GO BCCC DIN005 EQU $  POP PSW ;CLEAR STACK JMP RTIMER ;GO WAIT NXT CHAR DIN010 EQU $  CALL CKDLE ;DLE IN??  JZ DIN005 ;YES GO EXIT DIN015 EQU $  CALL BCC ;DO BCC  POP PSW ;RESTORE CONDITION CODE  JC DIN050 ;TPAR ON NO DLC GO PUT BUFF DIN040 EQU $  MOV A,B ;A=CHAR  CALL CKETB ;CK FOR TERMINATORS  JZ DIN046 ;NO GO PUT CHAR IN BUFF  RRC ;ROTATE  JNC ETXIN ;NO CARRY CHAR MUST BE ETX RRC ;ROTATE AGAIN  JNC ABORTN ;NO CARRY = ENQ  JMP BCCIN ;MUST BE ETB@@@DIN046 EQU $  MOV A,C ;A=CONFIG  ANI TPAR+HCODE ;TPAR OR EBCDIC ?? JZ DIN050 ;NO GO PUT IN BUFF  ANI TPAR ;TPAR ON?? JNZ DIN050 ;YES SKIP XLATEDIN048 EQU $  LXI H,HEXIN  MOV H,M  MOV L,B ;H+L=XLATE TABLE MOV B,M ;B = XLATED CHARDIN050 EQU $  MOV A,B ;GET CHARACTER CALL PUTR ;PUT CHAR IN BUFFER  JNZ RTIMER  JMP ABORTE ;GO ABORT WITH EOTETXIN EQU $  LDA CONFG2 ;GET CONFG2  ORI EOTO ;SET ETXIN FLAF  STA CONFG2 BCCIN EQU $  MOV A,C ;A=CONFIG  ANI CRC16+HCODE ;8 BIT BCC  JNZ BCI010 ;YES SKIP PARITY CK  LXI H,ASBCC ;H+L=(ASBCC) MOV B,M ;B=ASBCC LRC CALL PARITP ;CK PMASK + ADD PARITY MOV M,A ;PUT CHAR +PARITY IN ASBCCBCI010 EQU $  CALL ETV1P ;SET TIMER & VECTOR1=BCC1 ; BCC1 EQU $  LXI H,ASBCC ;LH+L=(ASBCC)  MOV A,C ;A=CONFIG  ANI CRC16 ;CRC16???  JZ BCC210 ;NO GO CK CHAR  MOV A,M ;YES  CMP B ;CHAR OK ??  JZ BCC150 ;YES, GO SET RETURN  INX H ;PT TO ASBCC+1 (2ND BCC CHAR INR M ;PERVERT 2NC CRC CHAR ; (SEND NAK AFTER BCC RECEIVEDBCC150 EQU $  CALL ETV1P ;SET TIMER & VECTOR1=BCC2 BCC2 EQU $  LXI H,ASBCC+1 ;H+L=(ASBCC+1)BCC210 EQU $  MOV A,M ;A=BCC CHAR  CMP B ;BCC OK??  JNZ SDABRT ;NO GO ABORT WITH NAK BCCOK EQU $  CALL PUTE ;END OF INPUT BLOCK ; (BLOCK-INPUT MODE ONLY)  LDA ASACK ;GET ACK FLAG  XRI 001Q ;FLIP ACK FLAG STA ASACK ;RESTORE ACK FLAG  JMP SDACK ;GO SEND ACK ABORTE EQU $ ;ABORT WITH EOT  MVI A,EOTO ;SET EOTO FLAG JMP ABORIT ABORTN EQU $ ;ABORT WITH NAK  MVI A,NAKERR ;SET NAK FLAG ABORIT EQU $  LXI H,CONFG2 ;GET CONFG2 FLAGS  ORA M ;TURN ON ERROR FLAG  MOV M,A ;SET CONFG2 ABORT EQU $  CALL DABORT ;GO DEQUE BUFFERS ABORT1 EQU $  LDA ASACNT ;GET ABORT TIMER CNT CALL ETV1P ;SET TIMER & VECTOR1=ABORTI ;*************************************************; ; ABORTI - ABORT INPUT IGNORE CHARACTERS UNTIL; TIMER GOES OFF WITHOUT CHAR THEN ; SEND NAK OR EOT ; ;*************************************************ABORTI EQU $  ANI ST1IBF ;INPUT BUFF FULL?? JNZ ABI020 ;YES ABI005 EQU $  CALL CKTIME ;GO CK TIMER JNZ EXIT ;TIME NOT UP GO WAIT LDA ASACNT ;GET ABORT TIMER DCR A ;CONTINUOUS CARRIER  JNZ EOTIN1 ;YES GO BACK TO CTL MODEABI010 EQU $  LDA CONFG2 ;GET CONFG2  RAR RAR ;ROTATR TO NAKERR  JC SDNAK ;IF NA NAKERR SEND NAK RAL ;ROTATTE BACK TO EOTO FLAG JC SDEOT ;SEND EOT IF ERROR JMP EOTIN1 ;GO TO CTL MODE ABI020 EQU $  CALL CKTDLC ;TPAR OR DLC ON ?? JNC ABI030 ;CK END NO TPAR OR DLC ON CALL CKDLE ;DLE IN?? SET FLAGS JMP ABI035 ;GO CK OVERFLOW ABI030 EQU $  MOV A,B ;A=CHAR  CALL CKETB ;GO CK FOR TERMINATORS JNZ ABORT2 ;FOUND TERM WAIT FOR BCCABI035 EQU $  LDA ASACNT ;GET ABORT TIMER CNT MOV B,A ;B=CNT DCR B ;CNT=1 JZ RTIME1 ;YES NOT CONT CARRIER  JMP EXIT ;CONT CARRIER GO EXIT ABORT2 EQU $  MVI A,002Q ;SET COUNT = 2 LXI D,ABI010 ;SET RETURN AFTER COUNT = 0 ABT210 EQU $  LXI H,ABORTC ;SET VECTOR 1 = ABORTC JMP ETV1V2 ;SET VECTOR 1 & 2 ABORTC EQU $  ANI ST1IBF ;INPUT BUFFER FULL ??  JZ ASJMP2 ;NO RETURN TO CALLER CALL BCC ;GO DO BCC LXI H,ASTCNT ;GET CHAR COUNT  DCR M ;DECR CNT  JZ ASJMP2 ;COUNT = ZERO RETURN TO CALL JMP RTIMER ;GO RESET TIMER  ;*************************************************; ; RESET - RESET ALL DATA COMM FLAG AND PUT TERM; IN CONTROL MODE ; ;*************************************************RESEXT EQU $  LXI H,CKSTX ;RETURN = CK RESTX SHLD ASVCT2 ;SET VECTOR 2 TO EXIT RESET EQU $ ;RESET DATA COMM CARD  CALL RESDC ;RESET DC COMMANDS MVI A,CT2CAZ+CT2SAZ  CALL CTL2ON ;SET ZERO FLAGS  SUB A  STA ASFLAG ;CLEAR ASFLAG  LXI H,EOTSRH ;SET VECTOR 1 TO EOT SEARCH  SHLD ASVCT1 LDA CONFG2  ANI DVRON ;CLEAR XCEPT DVR STA CONFG2  RZ ;NO RETURN POP H ;YES POP STACK JMP DVRCK ;GO CHECK DRIVER; RESCT2 EQU $  STA IODC+OCTL2 ;OUTPUT CTL2RESDC EQU $ ;RESET ALL DATA COMMANDSREV1J: LDA IODC+CHARIN ;CLEAR INPUT BUFFER STA IODC+RRECV+DISXMT+RTIME ; RESET RECEIVER ; DISABLE XMIT COMPLETE; TURN OFF TIMER ;  LXI H,CONFIG ;ADDR OF DLC + TPAR FLAGS  MVI A,377Q-DLC-TPAR ;TURNING LINE AROUND  ANA M ;CAN'T BE TRANSPARENT MOV M,A  RET; REV1K: CALL TQFQ ;WACK=POS ACKNOWLEDGEMENT  JMP SDENQ CKETB EQU $  LXI H,ETB ;PT TO ETB MVI D,004Q ;SET CNTCKE010 EQU $  STA ENQ+1 ;SAVE ORIG CHAR CKE020 EQU $  DCR D ;DECR CNT  CMP M ;A=M  INX H ;BUMP TABLE POINTER  JNZ CKE020 ;NO CK AGAIN MOV B,A ;PUT CHAR IN B MOV A,D ;A=CNT ANA A ;SET CC ON CNT RET ;RETURN TO CALLER  ;************************************************ ; ; CBDON INHIBIT DOWNLINE CB ; ; CBDOFF DROP CB INHIBIT ; ;************************************************ ; ENTRY POINT ; CBDON EQU $  MVI A,CT2CBD ;SET CB INHIBIT  JMP CTL2ON ;GO TURN ON ; ; ENTRY POINT ; CBDOFF EQU $  MVI A,CT2CBD ;SET CB INHIBIT  JMP CTL2OF ;GO TURN OFFCKTDLC EQU $ ;CK TPAR AND DLC C=CONFIG; EXIT: Z+NVC=NO TPAR Z+C=TPAR+NO PREV DLE ; NZ+NC=TPAR+PREV DLE IN MOV A,C ;A=CONFIG  ANI TPAR+DLC ;TPAR AND DLC ON?? RZ ;NO GO RETURN  ANI DLC ;DLC ON??  STC ;SET CARRY FLAG  RZ ;NO CC=Z+C TPAR ON DLC OFF  CMA ;FLIP BITS ANA C ;TURN OFF DLC CKT010 EQU $  LXI H,CONFIG ;H+L=CONFIG  MOV M,A ;RESTORE CONFIG  MOV C,A ;C=CONFIG  RET ;RETURN TO CALLER CKDLE EQU $ ;CK FOR DLE C=CONFIG; EXIT: NZ=NO DLE Z=DLE +DLC+TPAR SET ON  LXI D,DLESTX ;D+E=A(DLESTX) LDAX D  CMP B ;CHAR =DLE?? RNZ ;NO RETURN TO CALLER CC=NZ MVI A,DLC+TPAR  ORA C ;TURN ON TPAR+DLC  CMP A ;SET CC TO ZERO  JMP CKT010 ;GO RETURN ; DCTEST - DATA COMM SELF-TEST ; THIS ROUTINE TRANSMITS BIT PATTERNS ; FROM 000B TO 177B AND EXPECTS TO; RECEIVE THESE PATTERNS AS INPUT ; WITHIN 800MS OF EACH XMISSION; ;*************************************************DCTEST EQU $  DI ;DISABLE INTERRUPTS REV1L: CALL WRUST3 ;SET UP STATUS BYTES LXI H,CTL2  MOV C,M ;C=CONFIG  LXI D,E0EOP ;SET ERR FLG TO ZERO + EOP LDA KBJMP3 ;SELF-TEST MASK SET? ANI KB3STM ;SELFTEST MASK SET?? JNZ SLFERR ;YES GO POST ERRORSLFTST EQU $  CALL RESDC ;RESET DC COMMANDSREV1P: DB 0,0,0 ;DON'T INHIBIT CB & CA*  CALL CAON ;GO PUT CA ON  CALL SLFXMT ;GO WAIT FOR CB  MVI E,062Q ;E=ACSII 2LOOPIT EQU $  LHLD SYNC ;H+L= 0 + SYNC CHAR  MOV A,L ;A=SYNC  STA IODC+TMIT ;GO XMIT SYNC CALL SLFBUF ;GO WAIT FOR INPUT BUFF FULL MOV A,H ;A=STARTING CHARLOP010 EQU $  STA IODC+TMIT ;OUTPUT CHAR LOP012 EQU $  CALL SLFBUF ;GO WAIT FOR INPUT CHAR  LDA IODC+CHARIN ;INPUT CHAR CMP H ;INPUT CHAR = OUTPUT CHAR??  JNZ LOP016 ;NO GO CK SYNC INR H ;YES BUMP H  JM CKCE ;END OF LOP GO CK CE CALL SLFXMT ;GO WAIT FOR OUTPUT BUFF EMP MOV A,H ;A=CHAR  JMP LOP010 ;GO XMIT CHAR LOP016 EQU $  CMP L ;CHAR = SYNC ??  JZ LOP012 ;YES GO WAIT FOR NXT CHAR  JMP SLFERR ;SET ERROR MSGCKCE EQU $ ;CE=RS232 HOOD ON  LDA IODC+ST2 ;GET STATUS 2  ANI ST2CEZ ;CEZERO ON?? JNZ SLFTOK ;YES LOOP HOOD NOT ON!! MVI E,E4 ;SET ERROR CODE TO 4 MVI B,ST2Z ;B=STATUS 2 ZERO FLAGS MVI A,CT2Z ;CA, SA, CD, CH NOT ZERO  CALL CTL2OF  LDA IODC+ST2 ;GET STATUS 2  ANA B ;CK  JNZ SLFERR ;IF ANY ON MUST BE ERROR MVI A,CT2Z ;CA, SA, CD, CH ZERO CALL CTL2ON  LDA IODC+ST2 ;GET STATUS 2  ANA B ;MASK ALL BUT Z FLAGS  CMP B ;ALL ZERO FLAGS ON JNZ SLB030 ;NO GO SET ERRORSLFTOK EQU $ ;SELF TEST OK  SUB A ;CC = ZERO + NC  LXI H,OKMSG ;GET OKK MSG JMP SLFMSG ;GO GET REST OF MSG ;******* ; ERROR FLAGS ; 0 = SELFTEST INHIBITED ; 1 = NO CB ; 2 = CHAR RECV NOT = CHAR SENT ; 3 = CHARACTER DID NOTY LOOP BACK; 4 = CE-CF-CB-CC-SB- DID NOT COME ON; 5 = CE-CF-CB-CC-SB- DID NOT TURN OFF ;**** SLFXMT EQU $ ;CK STATUS FOR XMIT MT?? MVI B,ST1XMT+ST1TIM  JMP SLB010 ;GO WAIT FOR SWTATUSSLFBUF EQU $ ;CHECK STATUS FOR BUFFER FUL MVI B,ST1IBF+ST1TIM+ST1PER ;SET MASK SLB010 EQU $ ;RETURN: CC=Z STATUS FAILE MVI A,TRISEC ;SET TIMER TO 3 SECONDS  STA ASTCNT  STA IODC+RTIME ;RESET TIMER  STA IODC+STIME ;SET TIMERSLB020 EQU $  LDA IODC+ST1 ;GET STATUS  ANA B ;PUT MASK AGAINST STATUS JZ SLB020 ;NO STATUS CK AGAIN  CPI ST1TIM ;ANY STAT BESIDES TIMER  RNZ ;YES RETURN MUST BE STATUS CALL CKTIME ;NO GO CK TIMER  JNZ SLB020 ;TIMER NOT UP GO CK STATUS POP H ;POP RETURN POINTER SLB030 EQU $  INR E ;BUMP ERROR BY 1SLFERR EQU $ ;SELFTEST ERROR  STC ;CC=CARRY  XCHG ;H+L=D+E GET ERROR MSG  SHLD DCMSG ;PUT IN DCMSG AREA LXI H,DCMSG ;H+L=DCMSXG  SHLD MSGPT4 ;PUT IN POINTER  LXI H,FMSG ;H+L= FAIL MSFSLFMSG EQU $  PUSH PSW ;SAVE CC SHLD MSGPT3 ;PUT MSG IN MSG PTR 3  LXI H,STMSG ;GET SELF TEST VERBIAGE  SHLD MSGPT2 ;STORE PTR MOV A,C ;A=CTL2  CALL RESCT2 ;RESET CTL2 + DC COMMANDS  LXI H,SLFID ;H&L=SLFID POP PSW ;RESTORE PSW EI ;ENABLE INTERRUPTS RET ;RETURN TO CALLER STMSG: DB ' DATA COMM SELF TEST '  DB 000Q ;CONTINUATOROKMSG: DB 'OK' DB EOP ;SET END FMSG: DB 'ERROR '  DB 000Q ;CONTINUATORE0EOP EQU 316Q*256+060Q ;EOP+E0 E4 EQU 064Q ;ASCII 4 DCCMNT EQU $ ;MONITOR MODE  CALL DCSTOP ;GO WAIT FOR DC TO STOP  LXI H,DVR000 ;SET VECTOR TO DVR/MONITOR; DCC100:POP D ;DELETE ADDR OF RETNCZ CMP A ;SET NC & Z CONDITION CODES  PUSH PSW  JMP ETV1 ;SET ASVCT1 & TIMER, EXIT ; ; LEAVE MONITOR/DRIVER MODE ; (WARNING: THIS CODE MAY BE CALLED BY; MAINCODE EVEN THOUGH NEVER IN MONITOR ; OR DRIVER!) ; DCCNRM:LDA CONFG2 ;ARE WE IN DRIVER MODE?  ADD A ;YES, DON'T DO ANYTHING  RC ;(JUST WANT TO USE KEYBOARD) CM INIRST ;IF MONITOR MODE, RE-INIT  RET ;GOTO RETNCZ; DVR000 EQU $  CALL CNSUMR ;GO GET DATA JZ MONITR ;BUFFS EMPTY = MONITOR MODE DVR010 EQU $  LXI H,DVRMSG ;H+L ADDR%SS OF DVR PASSWORDDVR012 EQU $  PUSH H ;SAVE H+L  CALL CNSUMR ;GO GET DATA POP H ;RESTORE H JZ MONITR ;NO DATA GO TO MONITOR MODE  ANI 337Q ;MAKE UPPER CASE CMP M ;CHAR = PASSWORD JNZ DVR014 ;NO CK END OF PASSWORD INX H ;YES BUMP PTR  JMP DVR012 ;GO CK NEXT CHARDVR014 EQU $  MOV B,A ;SAVE CHARACTER  MOV A,M ;A= MATCH CHAR ANA A ;END OF LIST JNZ MONITR ;WRONG STRING IN BUFFER ; SO DEFAULT TO MONITOR MODEDVR020 EQU $  MVI A,XCHARU ;GET UPPER CASE X CHARACTER  CMP B ;CHAR=X??  JZ DVR024 ;YES GO DEFAULT TO LIST LXI H,PLIST ;H+L=POLL LIST CALL PUTLST ;PUT CHAR IN LIST  LXI H,SLIST ;H+L=SELECT LIST CALL PUTLST ;GO PUT CHAR IN LISTDVR024 EQU $  CALL BUFINI ;GO RESET BUFFERS  LXI H,CONFG2  MVI M,DVRON ;SET DVR FLAG IN CONFG2 DVRCK EQU $  CALL RESDC ;RESET DATA COMM COMMANDS  LDA POLRAT ;GET DRIVER POLL RATE TIMER ; NORMALLY = 20*40 MSEC ; MODIFY 177216 TO 1-377; TO RESET POLL RATE (*40MSEC) CALL ETV1P ;SET TIMER & VECTOR1=DVC010 DVC010 EQU $  ANI ST1TIM ;TIMER INTR??  JZ EOTIN ;NO GO RESET  CALL CKTIME ;YES GO CK TIMER JNZ RTIMER ;WAIT FOR NEXT TIMERDVC020 EQU $  LXI D,CKLST ;D+E=RETURN  JMP SDE005 ;GO SEND EOTCKLST EQU $  STA IODC+DISXMT ;TURN OFF XMIT COMP FLAG  LXI H,ASACK  MVI M,ACK0F ;SET ACK0 FLAG LDA ASBCNT ;GET BUFFER CNT  DCR A ;ANY DATA ?  JM POLIT ;NO GO POLL  LXI H,SLIST ;H+L=DATA  LXI D,SLEND ;D+E=RETURN ADDRESS CKL010 EQU $  SHLD ASWK2 ;ASWK2=DATA  XCHG ;GET D+E SHLD ASWK3 ;ASWK3=RETURN ADDR LXI H,SDRESP ;SET INTERMEDIATE RETURN SHLD ASVCT2  JMP XIT025 ;GO SEND LIST SLEND EQU $ ;SEND LIST COMPLETE  LXI H,ASFLAG  MVI M,POL+HDRSW ;SET FLAGS  JMP STENQ ;GO TO SENT ENQ POLIT EQU $  LXI H,ASFLAG  MVI M,SELEC ;SET SELEC ON  CALL DEQALL ;GO SET BUFFERS TO RECV  LXI H,PLIST ;H+L=DATA  LXI D,STACK ;D+E=RETURN @@A JMP CKL010 ;***************; SO DEFAULT TO MONITOR MODEPLT010 EQU $  MOV B,A ;B=CHAR  CALL PAREBC ;GO SET PARITY+XLATE POP H ;RESTORE H MOV M,A ;PUT CHAR IN LIST  INX H ;BUMP LIST PTR MOV M,A ;PUT CHAR IN LIST  INX H ;BUMP LIST PTR LDA ENQ ;GET ENQ CMP M ;END OF LIST JNZ PUTLST ;NO GET NEXT CHAR  RET DVRMSG:DB 'DVR'  DB 0Q ;STOPER XCHARU EQU 130Q ;UPPER CASE X CHARACTER ; ; PUTLST PUT CHARS FROM BUFFERS INTO ; LISTS H+L=LIST ADDR; PUTLST EQU $  PUSH H ;SAVE H+6  CALL CNSUMR ;GO GET DATA JNZ PLT010 ;GO PROCESS CHARACTER  POP H ;RESTORE H POP H ;POP STACK FOR RETURN  ;*************************************************; ; SCANIT - SCAN ALL DATA BEING SENT OR RECEIVED; BY COMMUNICATION LINE AND DISPLAY I  ; ON CRT ; CONTROL-DISPLAY-FUNCTION KEYS SET THIS ; MODE ; ;*************************************************;  ; ENTER MONITOR MODE ; MONITR EQU $ ;SET UP FOR MONITOR MODE SUB A ;TURN OFF BLKIN MODE STA FLAG ;(NO BLK END IN MONITOR) LXI H,ASFLAG ;TURN ON RCVN (MONITOR MVI M,RCVN ;ALWAYS IN RECEIVE STATE)  INX H ;H,L POINT TO CONFG2 INX H  MVI M,MONTR ;TURN ON MONITOR MODE FLAG;  CALL DEQIT2 ;REFRESH BUFFERS (ALL TO FQ); (DON'T TURN ON RCVMDE;; BECAUSE KEYBOARD WILL BE; LOCKED AND WE WON'T BE ABLE ; TO GET OUT OF MONITOR MODE) ; (PUTDC NOW UNSUCCESSFUL);  MVI A,CT2CMM ;TURN ON MONITOR MODE BIT  CALL CTL2ON ;(TERMINAL SEES DATA FROM ; BOTH DIRECTIONS ON CHANNEL) ; SCN002 EQU $  LXI D,SCANIT ;D+E=VECTOR 2  LXI H,SCANIN ;H+L=VECTOR 1  JMP ETV1V2 ;GO SET TIMER + VECTOR 1+2SCANIN EQU $  ANI ST1IBF ;INPUT BUFFER FULL JNZ ASJMP2 ;YES GO THRU VECTOR 2  CALL CBDOFF ;SET CB DOWNLINE INHIBIT OFF CALL RESDC ;RESET DC COMMANDS JMP EXIT ;GO EXIT + WAIT SCANIT EQU $  LXI H,ASBCC ;GET CAZ FLAG  MOV E,M ;E=CAZ FLAG  LDA IODC+ST2 ;GET STATUS 2  ANI ST2CAZ ;GET CAZ FLAG  CMP E ;CAZ FLAG = PREV CAZ FLAG  JZ SCN020 ;YES NO CHG IN DIRECTION MOV E,A ;YES E=NEW CAZ FLAG ANA A ;CAZ ON ?? MVI A,LTCHAR ;SET LT CHAR JZ SCN010 ;NO CA IS ON DOWNLINE !!  MVI A,GTCHAR ;YES MUST BE UPSTREAM DATA SCN010 EQU $  CALL PUTR ;PUT CHAR IN BUFFER  STA IODC+RRECV ;RESET RECEIVER  MOV A,E ;A = CAZ FLAG SCN020 EQU $  ANA A ;CAZ ON ???  JZ SCN030 ;NO MUST BE DOWN STREAM !! LDA EOT  CMP B ;CHAR = EOT??  JNZ SCN030 ;NO GO PUT CHAR IN BUFF  LDA IODC+ST2 ;GET STATUS 2  ANI ST2CCZ ;FIRST DEVICE IN LINE ?? CZ CBDON ;IF YES PUT CB INHIBIT ON  STA IODC+RRECV ;RESET RECEIVER SCN030 EQU $  LXI H,ASBCC  MOV M,E ;SAVE CAZ FLAG MOV A,C ;A=CONFIG  ANI HCODE ;EBCDIC ?? JZ SCN040 ;NO GO PUT BUFFER  LXI H,HEXIN  MOV H,M  MOV L,B ;H+L=XLATE TABLE MOV B,M ;B=XLATED CHARSCN040 EQU $  MOV A,B ;A = CHAR  CALL PUTR ;GO PUT CHAR IN BUFFER JNZ RTIMER ;GO WAIT FOR NXT CHAR  LXI H,SCNFUL  JMP ETV2 ;SET VECTOR 2 = SCNFULSCNFUL EQU $  MVI A,FCHAR ;GET FULL CHAR CALL PUTR ;PUT CHAR IN BUFFER  JZ RTIMER ;CHAR NOT ACCEPTED GO WAIT JMP SCN002 ;GO RESET SCANGTCHAR EQU 076Q ;GREATER THAN CHARLTCHAR EQU 074Q ;LESS THAN CHARACTERFCHAR EQU 030Q ;CANCEL CHAR REV1M: LDA SYNC ;INPUT CHAR = SYNC?  CMP B ;(MUST IGNORE SYNC INPUT JZ EXIT ;FOR VALID RESET RECEIVER)REV1N: STA IODC+RRECV ;NOT EOT NOR SYNC JMP EXIT ;SO RESET RECEIVER REV1O: LDA IODC+ST2 ;IF FIRST IN CHAIN,  ANI ST2CCZ ;THEN KEEP INHIBIT UP  JZ CTL350 ;UNTILL TPAD GOES BY JMP RPADIN ;ELSE, DROP INHIBIT ; (KNOW SEQUENCE NOT FOR; US AND NOT 1ST)  END CHAIN,  ANI ST2CCZ ;THEN KEEP INHIBIT UP  JZ cF[V2ITL80*|:<c ppA-|LOADR F.< <DFFpFsFyFFF 2* ' + - A B Z 0 7 9 , / . C D E L H S P M BIN ; : $ Q ( ) (Y wFFFFF.vwF//WF/ /Fvy F//W F/%/4 Fvz F/4/W F/>/M Fv| F/M/W F/W/Wv~ FPIII F /t Fv}vxvF F FgGvGIFfNGI  I / f~//fz mGGrIrIs/(" AVAILABLE MEMORY FROM ",@6," TO ",@6)fIQGIIIII//f} mGGrIs/("VIRTUAL MEMORY ERROR ",I2)gHOHImKFIIIueeumKFIIIueeEu,eH(IF|IIvIIU,2eeEuH?t'?@',d(PP),5< <DFFpFsdP*B)tQ)CQ,D+dR*++PPS,_< <DFFpFsdzTBSt{SD{,nUd|TUUPP},< <DFFpFsPPee:eueEDu2eEuE,}ueEDu2Uu3U5,-*Uu/U5,-0Uu1U5,-.U,-4U,-eEue:::E,,e:ueEEDF-,e:ueEEDG-,eeEEDF-$-eEEDG-0-eueEEDuAQ=QQeU-D-Iee >.j PAUSE VV׮STOP VV PNAME PAUSE 1234$ # Ҁ#N~ # Ҁ#N~v>ֳV>>VVVVՀVV00>>خV4Ucn%.VVƋVVW>v>~> @V?_g-w+0B`//"w,g*W+W.|H1wL?11wH?1g1/:wI?11wJ?1HW/MWKW/LmhL1 J @wmI?I?/d?/Zo/h?/jJgLm/dl?l?m?/woXN /?WWWWW/?oO_ /w(w/nwgmgwlgwWWWWWWWgJoLH@H (w/_ӯH/hTgH /c7w XwJL4/ s /oogww2wwgW//XS4TXeDgԀ DhԀXXX\,}u Diu&u'difku"6j&lm 6iuKn< .65JuKeJ;uJe .?.G??   u .Lm$ff YLmLfg eeu!utuuZc @q.nwqZwZ.t.Zn~n~n~hӄ.Z҉Zw>w.Fn~n~n~ZZZZcZZˮw ZvN`N~ȋf>. / *RUNTIME ERROR* @  0EOF vV..feU.fY#f^^^^^.f#IO1207060402?[ w w gfgcoH Q/VOc Q/Vc/3Od4kWhOe Q/VgGjwUwa[HUo /? @ObxGiQ/VUS[ U[H[ [U[\[ [f[?![a {[mpwpmwmnwncooH Q/O Q/c/O4WO Q/goGww[۱op / @OxGQ/۱[m۱[[mq[[[m[no[p?q!q[ {[cG4 ^/ g??7ȯoȀA[ga Y=tT,|྘\'dd5\-Ŭ,l15d5苋T ,>hDʬ= L|ZtYdYŸA/%>/1/1ffV//>f/Kfv ⰻA VN/NN // /fF f fN fn @FŸ/H g/fHȏfV/Nf宽  /vv^ ~/ @v/f/f/f /f nfu?u@eE,uE,c=E, ,$=E,c$,EBuB ,1,3r $ MB $mC @,WH H,W,Z,LA:A:@=@=?c}?c`m  r}>u=e=EBuB=>,xruAuFuGu?u@uBuC,=B,mF,,,,,,,-,mF =F,,mF=C,=F  H, ,,uA-6 ,eG=G-6,uF, @ -6ECuC, -6, ,-4mF ,,mF -4mA mF ECE?m?H =?m? m?@=@5F5G,5-8-4-"-2To-4u=- -6Y/CM=Y/-e:e;e<n*MoH-Wwenmm-YmlwgEpP-cwem-ZEs-jErHb.bRav2Pd} N azn$f%C -w-o^,-gGo Gw?-eqm.o? G!-H--ewwog M-gF)?gUŭEr-?-eq .?ewgEw d aw?>)f$f* @V,--F)v)f,  V*-g . f*V, .f+ !E DV*..~$^-. ~$F)v)b$b'b)wwN)~)o!.L.Gg6 Ǚ Oo_.M.>w@wN)~)gwwGw.l?OPOSw?癁c57?.cRbwv%v&v'v(|Wwf{n*c|G.$Fv).Uw.F*hw'=6v)n$yw.f)bwf$bONMw`Hf$n) @FQ.evmw.Gwf)Ff*wEwwfwxFwFwFw>w?.g.fw>w?.gz}0Mibf*wwewv)wwv$v%v&v'v(/,wwF>?/f$/,gGHf)v(9c4b$c5g7n*asf(v)86Wwn$ Us/EF*w65/rf&6'wf)F/n$ /if&6'7/i>%/i 6/pf%/~$/of)w{hf$/f*o5c9fv$v%v&v'6O 68/ / /O?/?? Kbbb\fffP.nF^.lV.(6X,2A2,3X,O3,I6) (%6fbbf`fff`fffIIIIɣIIIIIIIIIIIIIIIIIFDFFFzFFFF}F|FFF~< FxI<FFL FFFFFFFFFFFmLLL FoFFpPFFP+FFFPFFPUQRRSgSpSSST"TTTTTTTTSSSSSSSSSSSSSSSSSTUUUUUV VVVVVWW1XTXXXiXjXsVjXXXXXYY&Y'Y%Y Y#YYYYXXY.XXYHY(XYY#&YY!Y YY Y"Y YYYYYYYYYZqZZw[[[l[q[\YYYY[Y[[[ٕ[[[X[YXX[Y[[Y[[[[YYY[[[X^^aB`lY*Y4Y,aC[ `:`raEaDa?`ma@[Y+^^^^^^^^^^^^^^^^^^^^޽^Y/Y0^cb}c9cZ[fFnfDb]fFnf// F^/Fp`b]fFnf//5,f.fF2,  fV,,SF3,$,)f 9d.Fj`cPASS1cj S |c < <DFFpFsccccRLC RRC RAL RAR HLT vRET RC RNC RZ RNZ RP RM RPE RPO XCHGXTHLSPHLPCHLCMA /STC 7CMC ?DAA 'EI DI NOP ADD ADC SUB SBB ANA XRA ORA CMP INR DCR MOV @RST STAXLDAX PUSHPOP DAD DCX INX  IN OUT ADI ACI SUI SBI ANI XRI ORI CPI MVI  CALL CC CNC CZ CNZ CP CM CPE CPO JMP JC JNC JZ JNZ JP JM JPE JPO STA 2 LDA : SHLD" LHLD* LXI  ORG EQU DEF DFADASB END UNL LIS SKP DB DW ddY$- meeKegiiir-yEi-ws-(6X,2A2,3X,O3,I6) (%6eeOeiKcjjiKcjjiD2-(( :!2!2"!2#2#2$2$2"$26%&fFycFii'..4 mf$f#s.1(1X,"SOURCE INPUT ERROR") (.$.C mfDfCqFPs.P(" NEXT STATEMENT:"80A1))*1*.\+4*.c+,*.j.2*.q.=fuii-.|..*?/;272//@Fpcɩ/IgciA///%%%//B.-3-C.&&=2&&>-61-J-R8-Q?@8-YieYesjesezezeeff?ftftffggCggjilgggqgtgwg'//de~Fkj1-@0=2--2:-*jA'A//B1@deFkj1-@0=3--0;dejk1-ɩ@20=2--'C/;Aj;/DeFkjFi1-@7393E9E-/'*j//ff"F0=F..A.!0=G../[gyGrGsG!wvgywwgwGsGwugwGrGsG!ugwGywwGv/FgvGrwrkckyF{DknFFckegtwr/>Pkz/< <DFFpFsg{zGGF/|g{zGGe/|g{zGGG/|g{zGGf/|g{zGGN/¯|g{zGGg/ί|g{zGGh/گ|g{zGG>/|g1||Pkj< <DFFpFsley$- mmmrFlqFss-%(" SEND BYTES ",I4,4X,4I4)e&-,k8ue8-4-^ex8-;-jeueEDueEDeEueE-P-VlmTlmeueEuE-=k8ueEueE-jkeulmplmeEu-dkPm.o< <DFFpFsBIN mHEX mmnfm plmFm./9Fm./9! mo3nsfmnopoqprnstrupvpKnpp}pswxypKnpsp}pswzyvpv{.|}r~~Ep}}vpppKnpppswy|у.pKnpppswy၀pp.~p~u.! moorpzqnPs/(O7,4(1X,10A1)/7X,4(1X,10A1)) {rrs{sq.fmnnpssEw|yspsFm/#|/8(20("*")) p/@/oFpF|pp|/L/9vFwpon prov|pssE|/gpsEFvvnpvspsFm/\|ш//! mo3os!oplpnnpoplpFwpfm plprpssFwrEvpproprEvpoyrrsps/pooplpmpx/|opF|ppvpp|//ΘvFwpon prou|psmosE|/psEvmpdzDtzDxdT,,[dDtdlDtndv pltdDtydtzdlDzDtdyDtvpprtdDyDtvpDdlDytydzDtzD,,d!tdpDtp[plpmpdvnndT,edtP B F P N @d SjjjjjjjjjjkjcjjjjjjjjjjccFjjcjjFnFkFijFqjFrjjFljjjccjiai_jkkJkkFkFFkkFki"h&k k ck ShcgLdFjdgFFkOk|FFFFkmmpvFwpxppwpypzp|p{p}pp~pptpppppplpppppppppmpppppmonnnmo!ocPASS3cf |c/< <DFFpFsDHEX ccc gcOce Kcffe Kcffe md d s,(1H1)  mdds,,(" SYMBOL VALUE REFERENCED ON"/1X,74("="))fueunKceeevfvfF eveV,K,vfufEvffvfFvf FvxdgfF)vfFdvfF{<ffFfFvxd~feFvfEunKcefefFvnKcffeveV,,;fFv fv f Eu2f Fv E,fv yd mddf Eurs,(I5,1X) f EufEfF EueEeF EueEfF v eV ,- eF EueF Ev v f FeF v f F- ,fE-- md es mdesfufU-$-ĈFc---nKceeeufEv eEveB  mewevfvnKcfeeurfFvE-IfEureEurfvfEurfFvE-hs-(1X,3A2,3X,2A2,2X,30A2) - meefvnKcfeeurfFvE-fvfEurfFvE-s-(1X,3A2,O7,2X,30A2) fEufueV --, meefvfEurfFvE-˘s-(16X,30A2)-fEue%-,.eefP,8feeeeeccccSF* TRACK MAP TABLE DEFINITION FILE*  * FOLLOWING FORMAT..... * * PARAMETER 1. ENTRY NUMBER * 2. # TRACKS * 3. 1ST CYLLINDER * 4. STARTING HEAD * 5. # SURFACES * 6. UNIT # * 7. # SPARES * 8. # SECTORS/TRACK (96/128) * *ENT# TKS CYL HD SUR UN SP S/T  1 , 401 , 0 , 0 , 2 , 0 , 11 , 96  2 , 401 , 206 , 0 , 2 , 0 , 9 , 96  3 , 401 , 0 , 2 , 2 , 0 , 11 , 96  4 , 401 , 206 , 2 , 2 , 0 , 9 , 96  5 , 171 , 0 , 0 , 9 , 1 , 9 , 128  6 , 171 , 20 , 0 , 9 , 1 , 9 , 128  7 , 171 , 40 , 0 , 9 , 1 , 9 , 128  8 , 171 , 60 , 0 , 9 , 1 , 9 , 128  9 , 171 , 80 , 0 , 9 , 1 , 9 , 128  10 , 171 , 100 , 0 , 9 , 1 , 9 , 128  11 , 171 , 120 , 0 , 9 , 1 , 9 , 128  12 , 171 , 140 , 0 , 9 , 1 , 9 , 128  13 , 171 , 160 , 0 , 9 , 1 , 9 , 128  14 , 171 , 180 , 0 , 9 , 1 , 9 , 128  15 , 171 , 200 , 0 , 9 , 1 , 9 , 128  16 , 171 , 220 , 0 , 9 , 1 , 9 , 128  17 , 171 , 240 , 0 , 9 , 1 , 9 , 128  18 , 171 , 260 , 0 , 9 , 1 , 9 , 128  19 , 171 , 280 , 0 , 9 , 1 , 9 , 128  20 , 171 , 300 , 0 , 9 , 1 , 9 , 128  21 , 171 , 320 , 0 , 9 , 1 , 9 , 128  22 , 171 , 340 , 0 , 9 , 1 , 9 , 128  23 , 171 , 360 , 0 , 9 , 1 , 9 , 128  24 , 171 , 380 , 0 , 9 , 1 , 9 , 128  25 , 171 , 400 , 0 , 9 , 1 , 9 , 128  26 , 171 , 420 , 0 , 9 , 1 , 9 , 128  27 , 171 , 440 , 0 , 9 , 1 , 9 , 128  28 , 171 , 460 , 0 , 9 , 1 , 9 , 128  29 , 171 , 480 , 0 , 9 , 1 , 9 , 128  30 , 171 , 500 , 0 , 9 , 1 , 9 , 128  31 , 171 , 520 , 0 , 9 , 1 , 9 , 128  32 , 171 , 540 , 0 , 9 , 1 , 9 , 128  33 , 171 , 560 , 0 , 9 , 1 , 9 , 128  34 , 171 , 580 , 0 , 9 , 1 , 9 , 128  35 , 256 , 600 , 0 , 9 , 1 , 5 , 128  36 , 256 , 629 , 0 , 9 , 1 , 5 , 128  37 , 256 , 658 , 0 , 9 , 1 , 5 , 128  38 , 256 , 687 , 0 , 9 , 1 , 5 , 128  39 , 936 , 716 , 0 , 9 , 1 , 27 , 128  40 , 2420 , 0 , 0 , 9 , 2 , 46 , 128  41 , 2420 , 274 , 0 , 9 , 2 , 46 , 128  42 , 2430 , 548 , 0 , 9 , 2 , 45 , 128  , 9 , 1 , 5 , 128  39 , 936 , REQUEST CODEOUTRC DEC 2 OUTPUT REQUEST CODE EOJRC DEC 6 END OF JOB REQUEST CODE STARC DEC 13 STATUS REQUEST CODE * READR EQU 5 TAPE READER LOGICAL UNITPUNCH EQU 4 TAPE PUNCH LOGICAL UNIT CONSL EQU 1 CONSOLE LOGICAL UNIT* TTY DEF CONSL CONSOLE I/O CODERDRIN DEF READR ASCII INPUT CODEINBIN ABS READR+BINRY BINARY INPUT CODEPCHLU DEF PUNCH PUNCH CONTROL WORDPNASC ABS PUNCH ASCII OUT WITHOUT WAITPNBIN ABS PUNCH+BINRY BINARY OUT WO/WAITPNLDR ABS PUNCH+LEADR PUNCH TAPE LEADERPNTRL EQU PNLDR PUNCH TRAILER * PTR DEF * INPUT POINTER BLKSZ DEC 0 ROM BLOCK SIZENMBLK DEC 0 BLOCK COUNT BLKCT DEC 0 BINARY BLOCK COUNTERCRCHD OCT 0 CRC SAVE WORD INCTR DEC 0 INPUT COUNTER BUFLN DEC 30 BUFFER LENGTH NMCHR DEC -60 NUMBER OF INPUT CHARACTERSINBUF BSS 30 INPUT BUFFERNMBYT DEC 0 BYTE COUNTERINLEN DEC 0 ASCII INPUT LENGTHEOTFL DEC -1 END OF TAPE FLAGADDR DEC 0 EXPECTED BLOCK ADDRESSBLKMS OCT 3777 BLOCK ADDR MASK (SET FOR 2K)* ERRM1 ASC 13,**UNEXPECTED END OF TAPE** ERRL1 DEC 13 * EOJMS OCT 6412 END OF JOB MESSAGE - CR/LF ASC 7,**END OF JOB** EOJML DEC 7 * CKMSG EQU * CHECKSUM MESSAGE ASC 5,CHECKSUM = CKSM1 EQU * CHECKSUM VALUE ASC 2,*  CKMLN DEF *-CKMSG .CKM1 DEF CKSM1  END ::C 7,**END OF JOB** EOJML DEC 7 * CKMSG EQU * CHECKSUM MESSAGE ASC 5,CHECKSUM = CKSM1 EQU * FTN4,L PROGRAM AMROM(3) C C C AMROM - VERSION 1.0 - JULY 21,1977 C C AMROM HAS TWO MODES OF OPERATION:C 1) OUTPUTC 2) VERIFYC  C 1) OUTPUT MODE: C AMROM READS BINARY OBJECT CODE AS INPUT AND RE-FORMATSC IT TO HEX SO THAT ADVANCED MICRO DEVICES WILL ACCEPTC IT FOR THEIR ROM MASK PROCESS FOR THE AM9216. C THE OUTPUT IS NORMALLY WRITTEN ON CARDS SINCE THAT IS C THE ONLY MEDIA ADVANCED MICRO DEVICES WILL ACCEPT.C C THE BINARY OBJECT CODE MAY BE FROM PAPER TAPE OR FROM C CARTRIDGE TAPE THAT WAS PREVIOUSLY CREATED BY THE C 8080 CROSS-ASSEMBLER. AMROM EXPECTS TO READ 2K BYTES  C OF BINARY CODE TO BE RE-FORMATTED FOR EACH ROM PATTERN. C  C 2) VERIFY MODE: C AMROM READS THE CARD DECK RETURNED BY ADVANCED MICROC DEVICES AS A VERIFICATION STEP AND COMPARES IT AGAINSTC THE ORIGINAL BINARY OBJECT CODE. ANY DIFFERENCES AREC LISTED ON THE CURRENT LIST DEVICE.C C C GET PARAMETERS FROM :TR AND :RU COMMANDS C C :TR,AMHEX,BINARY INPUT,LIST,OUTPUT,CARD INPUTC  C WHERE AMHEX: C C :RU,AMROM,BIN INPUT,LIST,OUTPUT,CARD INP,GLOBAL VAR 0C C WHERE INPUT = LU WHERE BINARY RESIDES FOR READINGC (LOGINP) DURING OUTPUT PHASEC DEFAULT = 5C C LIST = LU WHERE ERROR MESSAGES WILL BEC (LOGLIS) PRINTED DURING VERIFYC DEFAULT = 6C C OUTPUT= LU WHERE HEX WILL BE WRITTEN DURINGC (LOGHEX) THE TRANSLATION FROM BINARY TO HEX C DEFAULT = 8C C CARD = LU WHERE HEX IS READ FROM DURING VERIFY C INPUT PHASE C (LOGCRD) DEFAULT = 7C C  INTEGER HEX(16),ZERO  DIMENSION IDBUF(140),IBYTE(256),ICARD(80) INTEGER PART(8) INTEGER IPAR(5) COMMON IERR,LOGLIS DATA IADDR/0/ DATA LINE/0/ DATA ICRDLU/9/ DATA LOGIN,LPR/1,6/  DATA INSAD,ITPR,LF,LOGOUT,MTAPE,ZERO/ 1 0,69,12B,1,8,1H0/  DATA HEX/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7, 1 1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF/ DATA ICARD/80*2H / DATA IPNC/4/  DATA LOGOPR,LOGINP,LOGHEX,LOGCRD/1,5,8,7/  CALL RMPAR(IPAR)  LOGLIS = 6C  IF (IPAR(1) .EQ. 99) GO TO 20  IF (IPAR(1) .LE. 1) GO TO 15 IF (IPAR(1) .NE. IPAR(5)) LOGINP=IPAR(1)C 15 CONTINUE IF (IPAR(2) .EQ. 99) GO TO 20  IF (IPAR(2) .GT. 0) LOGLIS=IPAR(2) IF (IPAR(3) .EQ. 99) GO TO 20  IF (IPAR(3) .GT. 0) LOGHEX=IPAR(3) IF (IPAR(4) .EQ. 99) GO TO 20  IF (IPAR(4) .GT. 0) LOGCRD=IPAR(4)C 20 CONTINUEC  C GET LU OF USER TERMINAL C DONE VIA GLOBAL VARIABLE 0 IN :RU COMMANDC  IF (IPAR(5) .GT. 0) LOGOPR=IPAR(5)C  ITPR=LOGINP+100B+2000BC C DETERMINE IF PAPER TAPE OR 2645 CTU'SC C LOGCTU=0 => PAPER TAPE INPUT C  LOGCTU=0 CALL EXEC(13,LOGINP,IEQT5,IEQT4) IF (IAND(IEQT5,37400B) .EQ. 2400B) LOGCTU=1 C 25 CONTINUEC C C  IERR = 0  WRITE (LOGOPR,30) 30 FORMAT(" VERIFY(V) OR OUTPUT TAPE(O)?") READ (LOGOPR,40) ITYPE 40 FORMAT(1A1)  GO TO 75  C DO FIRST/NEXT ROM 60 CONTINUE  WRITE (LOGOPR,70) 70 FORMAT(" END? YES(Y) OR NO(N)")  READ (LOGOPR,40) IEND  IF (IEND .EQ. 1HY) STOP75 CONTINUE  WRITE (LOGOPR,78) 78 FORMAT(" SKIP NEXT 2K ON INPUT TAPE? YES(Y) OR NO(N)") READ (LOGOPR,40) ISKIP IF (ISKIP.EQ.1HY) GO TO 95  IF (ITYPE.EQ.1HV) GO TO 95  WRITE (LOGOPR,80) "80 FORMAT(" PART #?"/" (TYPE 8 CHARACTERS, NO EMBEDDED SPACES)")" READ (LOGOPR,90) PART  90 FORMAT(8A1) C C MAIN LOOP. PROCESS 256 BYTRES OF C BINARY DATA 8 TIMES C 95 CONTINUE  DO 400 ILOOP = 1,8 C C SKIP OVER ANY LEADING INFOC ON TAPE TO ADDRESS AND DATA C C  IF (LOGCTU .EQ. 0) GO TO 199C C GET INPUT FROM CARTRIDGE TAPES C 100 CONTINUE CALL EXEC(1,ITPR,IDBUF,-134) IF (IDBUF(1) .NE. -1) GO TO 100  IF (ISKIP .EQ. 1HY) GO TO 167  IF (IAND(IDBUF(2),3777B) .EQ. IADDR) GO TO 160 WRITE(LOGOPR,159) IDBU@