************************************************* * * * 8080A ARITHMETIC PACKAGE WITH DATE ROUTINES * * by Dennis E. Baker 1/8/82 Title: RUNPAC * * * ************************************************* 0004 = LENGTH EQU 4 ;VARIABLE LENGTH BA00 = CHBUFR EQU 0BA00H ;CHANNEL DATA BUFFERS START B8C0 = CHNFCB EQU 0B8C0H ;CHANNEL FILE CONTROL BLOCKS START 0010 = CLOSFL EQU 16 ;CLOSE FILE 0005 = CPMENT EQU 5 ;CP/M ENTRY POINT 0001 = CONIN EQU 1 ;CONSOLE INPUT 0002 = CONOUT EQU 2 ;CONSOLE OUTPUT 0005 = LSTOUT EQU 5 ;LIST DEVICE OUT 0016 = MKFILE EQU 22 ;MAKE FILE 000F = OPNFIL EQU 15 ;OPEN FILE 0021 = RDRAND EQU 33 ;READ RANDOM 0014 = RDSEQ EQU 20 ;READ SEQUENTIAL 001A = SETDMA EQU 26 ;SET DMA ADDRESS 0100 = TPAREA EQU 100H ;START OF TRANSIENT PROGRAM AREA 0022 = WTRAND EQU 34 ;WRITE RANDOM 00FF = T EQU 255 ;TERMINATOR B000 ORG 0B000H ; SIGNED MULTIPLICATION ROUTINES ; INTMPY: ACC=ACC*OPERAND MPYTEN: ACC=ACC*10 B000 CD91B0 MPYTEN: CALL OPTEN ;SET OPR=10 THEN ACC=ACC*10 B003 CD60B0 INTMPY: CALL SIGN ;COMPUTE SIGN OF PRODUCT B006 FCFEB0 CM NEGOPR ;NEGATE OPR IF IT IS NEGATIVE B009 1621 MVI D,8*LENGTH+1 ;NUMBER OF SHIFTS REQUIRED B00B A7 RSHIFT: ANA A ;CLEAR CARRY B00C 1E08 MVI E,2*LENGTH ;NUMBER OF BYTES TO SHIFT B00E 21AAB6 LXI H,HIACC+LENGTH-1 ;SET POINTER B011 7E NXRSHF: MOV A,M ;GET BYTE B012 1F RAR ;SHIFT RIGHT B013 77 MOV M,A ;REPLACE B014 2B DCX H ;BACKUP POINTER B015 1D DCR E ;BYTE COUNT -1 B016 C211B0 JNZ NXRSHF ;LAST BYTE ? B019 DC85B0 CC ADOPAC ;YES -ADD OPERAND IF CARRY B01C 15 DCR D ;SHIFT COUNT -1 B01D C20BB0 JNZ RSHIFT ;LAST ITERATION ? B020 F1 MPEND: POP PSW ;YES -GET SIGN B021 FC04B1 CM NEGACC ;IF MINUS -NEGATE ACC B024 C9 RET ; SIGNED DIVISION ROUTINES ; INTDIV: ACC=ACC/OPERAND DIVTEN: ACC=ACC/10 B025 CD91B0 DIVTEN: CALL OPTEN ;SET OPR=10 B028 CD31B0 CALL INTDIV ;ACC=ACC/10 B02B 3AA7B6 LDA HIACC ;GET REMAINDER B02E C630 ADI 30H ;TO ASCII B030 C9 RET B031 CD60B0 INTDIV: CALL SIGN ;COMPUTE SIGN OF QUOTIENT B034 F4FEB0 CP NEGOPR ;NEGATE OPR IF POSITIVE B037 1620 MVI D,8*LENGTH ;SET SHIFT COUNTER D B039 A7 DIVLOP: ANA A ;CLEAR CARRY B03A 1E08 MVI E,2*LENGTH ;SET BYTE COUNTER E B03C 21A3B6 LXI H,ACC ;AND POINT TO ACCUMULATOR B03F 7E DVLP: MOV A,M ;GET BYTE B040 17 RAL ;SHIFT LEFT (CARRY IN RIGHT) B041 77 MOV M,A ;REPLACE BYTE B042 23 INX H ;ADVANCE POINTER B043 1D DCR E ;BYTE COUNT -1 B044 C23FB0 JNZ DVLP ;LAST BYTE ? B047 CD7BB0 CALL STADOP ;SETUP ADD -OPERAND TO HIACC B04A 0A DVLP1: LDAX B ;TRIAL SUBTRACT B04B 8E ADC M B04C 03 INX B B04D 23 INX H B04E 1D DCR E ;BYTE COUNT -1 B04F C24AB0 JNZ DVLP1 ;LAST BYTE ? B052 D259B0 JNC NOSUB ;YES -SUBTRACT OK ? B055 CD85B0 CALL ADOPAC ;YES -ADD NEGATED OPERAND TO HIACC B058 34 INR M ;SET CURRENT QUOTIENT BIT B059 15 NOSUB: DCR D ;SHIFT COUNT -1 B05A C239B0 JNZ DIVLOP ;LAST ITERATION ? B05D C320B0 JMP MPEND ;YES -DO SIGN ; COMPUTE SIGN OF PRODUCT/QUOTIENT B060 C1 SIGN: POP B ;UNSTACK RETURN ADDRESS B061 3AA2B6 LDA ACC-1 ;GET TOP BYTE OF OPR B064 21A6B6 LXI H,HIACC-1 ;SET TO TOP OF ACC B067 AE XRA M ;EX-OR SIGNS B068 F5 PUSH PSW ;STACK RESULT B069 C5 PUSH B ;RESTACK SUBROUTINE RETURN B06A 23 INX H ;PNT TO HIACC B06B 97 SUB A ;A=0 B06C CD96B0 CALL SET1 ;CLEAR HIACC B06F 3AA6B6 LDA HIACC-1 ;GET TOP ACC BYTE B072 B7 ORA A ;SET STATUS B073 FC04B1 CM NEGACC ;NEGATE ACC IF NEGATIVE B076 3AA2B6 LDA ACC-1 ;SET TO TOP OPERAND BYTE B079 B7 ORA A ;SET STATUS B07A C9 RET ;RETURN WITH HIGH OPERAND BYTE ; SETUP ADD OPERAND TO HIGH ACCUMULATOR B07B 1E04 STADOP: MVI E,LENGTH ;SETUP OPERAND+HIACC B07D 01A7B6 LXI B,HIACC B080 219FB6 LXI H,OPERAND B083 A7 ANA A ;CLEAR CARRY B084 C9 RET ; ADD OPERAND TO HIACC B085 CD7BB0 ADOPAC: CALL STADOP ;SETUP B088 C3F4B0 JMP ADBAK ;DO ADD ; SET OPERAND, CLEAR ACCUMULATOR B08B 21A3B6 SETACC: LXI H,ACC ;ACCUM ADDR B08E C396B0 JMP SET1 B091 3E0A OPTEN: MVI A,10 ;SET OPERAND=10 B093 219FB6 SETOP: LXI H,OPERAND ;SET OPERAND B096 1E04 SET1: MVI E,LENGTH ;SET BYTE COUNTER B098 C3A1B0 JMP CLR1 B09B 21A3B6 CLRACC: LXI H,ACC ;SETUP CLR HI&LO ACC B09E 1E08 MVI E,2*LENGTH ;BYTE COUNT B0A0 97 CLRBAK: SUB A ;A=0 B0A1 77 CLR1: MOV M,A ;CLR A BYTE B0A2 23 INX H ;ADV POINTER B0A3 1D DCR E ;CNTR -1 B0A4 C2A0B0 JNZ CLRBAK ;LAST BYTE ? B0A7 C9 RET ;YES ; CHECK FOR ZERO ACC B0A8 1E04 CHKZAC: MVI E,LENGTH ;SET CNTR B0AA 21A6B6 CHK1: LXI H,HIACC-1 ;TOP ACC BYTE ADDR B0AD 56 MOV D,M ;SAVE IN D REG B0AE 97 SUB A ;A=0 B0AF B6 ZLP: ORA M ;OR ALL BYTES TO A B0B0 2B DCX H ;DECR POINTER B0B1 1D DCR E ;CNTR -1 B0B2 C2AFB0 JNZ ZLP ;LAST BYTE ? B0B5 B7 ORA A ;YES -SET STATUS B0B6 C8 RZ ;ZERO ? B0B7 1C INR E ;NO -E=1 B0B8 7A MOV A,D ;RECALL HI BYTE B0B9 B3 ORA E ;MAKE NON-ZERO B0BA C9 RET ;REG A NEG IF ACC NEG B0BB 1E03 HIZCHK: MVI E,LENGTH-1 ;CHEK TOP 3 BYTES B0BD C3AAB0 JMP CHK1 ; STORE ACC AT LOC IN HL REG B0C0 11A3B6 INTSTR: LXI D,ACC ;SET ACC ADDR B0C3 C3D3B0 JMP INMOV1 ;DO TRANSFER ; HIACC TO ACC B0C6 21A7B6 HILO: LXI H,HIACC ;SET HIACC POINTER ; LOAD ACC FROM LOC IN HL REG B0C9 11A3B6 INTACL: LXI D,ACC ;SET ACC POINTER B0CC C3D2B0 JMP INMOV ;GO TRANSFER ; LOAD OPERAND FROM LOC IN HL REG B0CF 119FB6 INTOPL: LXI D,OPERAND ;SET POINTER TO OPERAND B0D2 EB INMOV: XCHG ;SWAP HL AND DE B0D3 0604 INMOV1: MVI B,LENGTH ;SET BYTE COUNTER ; MOVE BLOCK OF BYTES ; ENTER WITH: HL = DESTINATION START ; DE = SOURCE START ; B = NO. OF BYTES B0D5 1A MOVE: LDAX D ;GET BYTE FROM DE LOC B0D6 77 MOV M,A ;PUT TO HL LOC B0D7 23 INX H ;INCR HL POINTER B0D8 13 INX D ;AND DE POINTER B0D9 05 DCR B ;DECR COUNTER B0DA C2D5B0 JNZ MOVE ;LAST BYTE ? B0DD C9 RET ;YES ; ACC=ACC+1 B0DE 3E01 ADDONE: MVI A,1 ;A=1 B0E0 CD93B0 CALL SETOP ;OPERAND = 1 B0E3 C3EEB0 JMP INTADD ;ADD 1 ; ACC=ACC-1 B0E6 3E01 SUBONE: MVI A,1 ;A=1 B0E8 CD93B0 CALL SETOP ;OPERAND = 1 ; SUBTRACT OPERAND FROM ACC B0EB CDFEB0 INTSUB: CALL NEGOPR ;COMPLEMENT OPERAND ; ADD OPERAND TO ACC B0EE CD7BB0 INTADD: CALL STADOP ;SETUP ADD ADDRESSES B0F1 01A3B6 LXI B,ACC ;ACC ADDR TO BC REG B0F4 0A ADBAK: LDAX B ;GET ACC BYTE B0F5 8E ADC M ;+OPR BYTE +CARRY B0F6 02 STAX B ;TO ACC BYTE B0F7 23 INX H ;ADV POINTERS B0F8 03 INX B B0F9 1D DCR E ;COUNTER -1 B0FA C2F4B0 JNZ ADBAK ;LAST BYTE ? B0FD C9 RET ;YES ; NEGATE OPERAND B0FE 019FB6 NEGOPR: LXI B,OPERAND ;SET POINTER TO OPERAND B101 C307B1 JMP NEG1 ;GO NEGATE IT ; NEGATE ACCUMULATOR B104 01A3B6 NEGACC: LXI B,ACC ;SET POINTER TO ACC B107 1E04 NEG1: MVI E,LENGTH ;SET BYTE COUNT B109 37 NEGATE: STC ;SET CARRY FOR COMP +1 B10A 0A NGOBAK: LDAX B ;GET BYTE B10B 2F CMA ;COMPLEMENT IT B10C CE00 ACI 0 ;ADD IMM WITH CARRY B10E 02 STAX B ;REPLACE BYTE B10F 03 INX B ;ADV POINTER B110 1D DCR E ;COUNTER -1 B111 C20AB1 JNZ NGOBAK ;LAST BYTE ? B114 C9 RET ;YES ; ROUTINE TO CONVERT ACC TO CHAR STRING ; ENTER WITH: HL POINTING TO RIGHT CHAR LOC IN DEST ; E = FIELD WIDTH ; D = NO. OF DECIMAL PLACES+1 B115 3AA6B6 FORMAT: LDA HIACC-1 ;GET TOP ACC BYTE B118 B7 ORA A ;SET STATUS B119 E5 PUSH H ;SAVE WRITE END POINTER B11A D5 PUSH D ;SAVE MODE AND WIDTH B11B F5 PUSH PSW ;SAVE ACC SIGN B11C FC04B1 CM NEGACC ;NEGATE IF MINUS B11F CD7BB5 CALL CLBUF1 ;CLEAR BUFFER B122 21BAB6 LXI H,PBFEND-1 ;SET END POINTER B125 E5 PUSH H ;SAVE IT B126 CD25B0 CONVLP: CALL DIVTEN ;ACC/10 CONV REMAINDER B129 E1 POP H ;GET POINTER B12A 77 MOV M,A ;PLACE DIGIT B12B 2B DCX H ;PNTR-1 B12C E5 PUSH H ;SAVE POINTER B12D CDA8B0 CALL CHKZAC ;CHECK FOR ZERO ACC B130 C226B1 JNZ CONVLP ;ZERO ? B133 E1 POP H ;YES -DISCARD POINTER B134 F1 POP PSW ;RECALL STATUS B135 F23BB1 JP ECONV ;POSITIVE ? B138 3E2D MVI A,2DH ;NO -GET MINUS SIGN B13A 77 MOV M,A ;PLACE IT B13B D1 ECONV: POP D ;RECALL DIRECTIONS B13C 0E00 MVI C,0 ;CHAR COUNT=0 B13E 21BAB6 LXI H,PBFEND-1 ;SET BUFF POINTER B141 7E CHEKLP: MOV A,M ;GET CHARACTER B142 0C INR C ;COUNT +1 B143 2B DCX H ;PNTR-1 B144 FE20 CPI 20H ;COMPARE SPACE B146 C241B1 JNZ CHEKLP ;SPACE ? B149 7A MOV A,D ;YES -GET DIRECTIONS B14A B7 ORA A ;STATUS B14B C24FB1 JNZ WCHK ;ANY DECIMAL PLACES ? B14E 0D DCR C ;NO -LESS ONE PLACE B14F E1 WCHK: POP H ;RECALL FIELD POINTER B150 7B MOV A,E ;GET WIDTH OF FIELD B151 91 SUB C ;-REQUIRED PLACES B152 F25EB1 JP XFR ;OK TO TRANSFER ? B155 3E3F MVI A,3FH ;NO -GET QUESTION MARK B157 77 QLOOP: MOV M,A ;FILL FIELD B158 2B DCX H ;PNTR-1 B159 1D DCR E ;CNTR-1 B15A C257B1 JNZ QLOOP ;LAST ? B15D C9 RET ;YES B15E C5 XFR: PUSH B ;SAVE CHAR COUNT B15F 01BAB6 LXI B,PBFEND-1 ;SET BUFF POINTER B162 15 TRLOP: DCR D ;DECIMAL CNTR-1 B163 CC98B1 CZ DECIN ;PLACE DEC POINT IF ZERO B166 0A LDAX B ;GET BUFF CHAR B167 D630 SUI 30H ;-ASCII ZERO B169 FA7BB1 JM NUMEND ;<0 B16C D60A SUI 10 ;-10 B16E F27BB1 JP NUMEND ;>9 B171 0A LDAX B ;GET CHAR B172 77 MOV M,A ;TO DEST FIELD B173 0B DCX B ;BUFF PNTR-1 B174 2B DCX H ;DEST PNTR-1 B175 1D DCR E ;CNTR-1 B176 C262B1 JNZ TRLOP ;LAST ? B179 C1 POP B ;YES -EXIT B17A C9 RET B17B 0A NUMEND: LDAX B ;GET BUFF CHAR B17C C1 POP B ;RECALL COUNT B17D 47 MOV B,A ;SAVE CHAR B17E 7A DECHK: MOV A,D ;GET DECIMAL PLACE CNTR B17F B7 ORA A ;STATUS B180 FA8EB1 JM SGNCHK ;PLACE MINUS IF REQ'D B183 CC98B1 CZ DECIN ;PUT DECIMAL PNT IF ZERO B186 15 LASTZ: DCR D ;DEC CNTR-1 B187 3630 MVI M,30H ;PLACE LEAD ZERO B189 0C INR C ;WIDTH+1 B18A 2B DCX H ;PNTR-1 B18B C37EB1 JMP DECHK ;CHEK FOR DECIMAL PNT B18E 3C SGNCHK: INR A ;INCR DEC CNTR B18F CA86B1 JZ LASTZ ;PUT ZERO IF WAS -1 B192 78 MOV A,B ;RECALL LAST CHAR B193 FE2D CPI 2DH ;COMP MINUS SIGN B195 C0 RNZ ;RET IF NOT B196 77 MOV M,A ;PLACE MINUS B197 C9 RET B198 362E DECIN: MVI M,2EH ;PUT DEC PNT B19A 2B DCX H ;PNTRS-1 B19B 15 DCR D B19C C9 RET ; ROUTINE TO CONVERT STORED STRING TO NUMBER IN ACC ; ENTER WITH: HL POINTED TO LEFT CHAR POS ; D = NO. OF DECIMAL PLACES ; E = FIELD WIDTH IN MEMORY B19D E5 EVALUE: PUSH H ;SAVE REGISTERS B19E D5 PUSH D B19F CD9BB0 CALL CLRACC ;CLEAR ACCUMULATOR B1A2 329CB6 STA SIGNF ;SIGN FLAG B1A5 329EB6 STA DECF ;AND DECIMAL PNT FLAG B1A8 D1 POP D ;RECALL REGS B1A9 E1 POP H B1AA 7E CONLP: MOV A,M ;GET CHAR B1AB D630 SUI 30H ;-ASCII ZERO B1AD 329DB6 STA NUM ;SAVE B1B0 FAFDB1 JM NONUM ;<0 ? B1B3 D60A SUI 10 ;NO -10 B1B5 F2FDB1 JP NONUM ;>9 ? B1B8 D5 PUSH D ;NO -SAVE REGS B1B9 E5 PUSH H B1BA CD00B0 CALL MPYTEN ;ACC*10 B1BD 3A9DB6 LDA NUM B1C0 CD93B0 CALL SETOP ;OPERAND=NUM B1C3 CDEEB0 CALL INTADD ;ACC+NUM B1C6 E1 POP H ;RECALL B1C7 D1 POP D B1C8 3A9EB6 LDA DECF ;GET DECIMAL FLAG B1CB B7 ORA A ;STATUS B1CC CAD3B1 JZ NXTCHR ;FLAG ? B1CF 15 DCR D ;YES CNTR-1 B1D0 CAF5B1 JZ CNVOUT ;OUT IF LAST DECIMAL PLACE B1D3 23 NXTCHR: INX H ;PNTR+1 B1D4 1D DCR E ;WIDTH-1 B1D5 C2AAB1 JNZ CONLP ;LOOP IF NOT LAST CHAR B1D8 7A FIXD: MOV A,D ;GET DEC PLACE COUNTER B1D9 B7 ORA A ;STATUS B1DA CAF5B1 JZ CNVOUT ;MORE PLACES ? B1DD 3A9EB6 LDA DECF ;YES -GET DECIMAL FLAG B1E0 B7 ORA A ;STATUS B1E1 C2ECB1 JNZ DCIN ;FLAG SET ? B1E4 15 DCR D ;NO CNTR-1 B1E5 CAF5B1 JZ CNVOUT ;LAST PLACE ? B1E8 2F CMA ;NO -SET AND B1E9 329EB6 STA DECF ;STORE DECIMAL FLAG B1EC D5 DCIN: PUSH D ;SAVE PARAMS B1ED CD00B0 CALL MPYTEN ;ACC*10 B1F0 D1 POP D ;RECALL PARAMS B1F1 15 DCR D ;DEC CNTR-1 B1F2 C2D8B1 JNZ FIXD ;GO RETEST IF>0 B1F5 3A9CB6 CNVOUT: LDA SIGNF ;GET SIGN FLAG B1F8 B7 ORA A ;STATUS B1F9 FC04B1 CM NEGACC ;NEGATE IF MINUS B1FC C9 RET B1FD 7E NONUM: MOV A,M ;GET CHAR B1FE FE20 CPI 20H ;COMP SPACE B200 CAD3B1 JZ NXTCHR ;IF SPACE B203 FE2D CPI 2DH ;COMP MINUS B205 CA22B2 JZ MIN ;IF MINUS B208 FE2E CPI 2EH ;COMP DECIMAL POINT B20A C2D8B1 JNZ FIXD ;IF IT IS B20D 3A9EB6 LDA DECF ;GET DEC FLAG B210 B7 ORA A ;STATUS B211 C2D8B1 JNZ FIXD ;IF ON B214 2F CMA ;SET IT B215 329EB6 STA DECF B218 7A MOV A,D ;GET DEC CNTR B219 1F RAR ;/2 B21A B7 ORA A ;STATUS B21B CAF5B1 JZ CNVOUT ;EXIT IF ZERO B21E 15 DCR D ;CNTR-1 B21F C3D3B1 JMP NXTCHR ;DO NEXT CHAR B222 3A9CB6 MIN: LDA SIGNF ;GET SIGN FLAG B225 2F CMA B226 329CB6 STA SIGNF ;REVERSE B229 C3D3B1 JMP NXTCHR ;NEXT CHAR ; INDEX ROUTINE FOR HUNT FEATURES ; ENTER WITH: BC POINTED TO OBJECT ; D = OBJECT LENGTH ; E = LINE LENGTH ; HL POINTED TO LINE START ; EXIT WITH: CARRY ON IF OBJECT FOUND IN LINE B22C 0A INDEX: LDAX B ;GET 1ST OBJECT CHAR B22D BE CMP M ;COMPARE LINE CHAR B22E CA38B2 JZ SAME ;IF EQUAL B231 23 INDXBK: INX H ;ADV PNTR B232 A7 ANA A ;CARRY=0 B233 1D DCR E ;LINE CNTR-1 B234 C22CB2 JNZ INDEX ;LAST LINE CHAR ? B237 C9 RET ;YES B238 C5 SAME: PUSH B ;SAVE REGISTERS B239 D5 PUSH D B23A E5 PUSH H B23B 03 SMLP: INX B ;ADV PNTRS B23C 23 INX H B23D 37 STC ;SET CARRY B23E 15 DCR D ;OBJ CNTR-1 B23F CA4CB2 JZ INXOUT ;IF LAST OBJECT CHAR B242 3F CMC ;COMPLEMENT CARRY B243 1D DCR E ;LINE CNTR-1 B244 CA4CB2 JZ INXOUT ;IF LAST LINE CHAR B247 0A LDAX B ;GET OBJ CHAR B248 BE CMP M ;COMP LINE B249 CA3BB2 JZ SMLP ;IF STILL EQUAL B24C E1 INXOUT: POP H ;RECALL REGS B24D D1 POP D B24E C1 POP B B24F C231B2 JNZ INDXBK ;LOOP B252 C9 RET ; ERASE LINE & RESET CURSOR B253 210117 ERCUE: LXI H,1701H ;SET LINE 23 COL 1 B256 0E4F MVI C,79 ;LINE LENGTH B258 E5 CURSET: PUSH H ;SAVE COORD B259 C5 PUSH B ;AND CNTR B25A CD6AB2 CALL CURSOR ;SET CURSOR B25D C1 POP B ;RECALL CNTR B25E 3E20 ERASE: MVI A,20H ;SPACE B260 C5 PUSH B ;SAVE COUNT B261 CD93B5 CALL DEVOUT ;SPACE TO CONSOLE B264 C1 POP B ;RECALL CNTR B265 0D DCR C ;CNTR-1 B266 C25EB2 JNZ ERASE ;AGAIN B269 E1 POP H ;RECALL COORD ; ROUTINE TO POSITION CURSOR ON CONSOLE DEVICE ; ENTER WITH: H = LINE NUMBER ; L = COLUMN NUMBER B26A 111F1F CURSOR: LXI D,1F1FH ;CUR OFFSET=31&31 B26D 19 DAD D ;ADD TO ROW, COL B26E 7D MOV A,L ;SWAP H & L B26F 6C MOV L,H B270 67 MOV H,A B271 2249B7 SHLD CURSEQ+2 ;PLACE IN CURSOR SEQ B274 2147B7 LXI H,CURSEQ ;GET SEQ LOC B277 C32AB5 JMP OUTROW ;AND DO IT ; FIND STRING (SPACE DELIMITER) B27A 3E20 FINDSP: MVI A,20H ;DELIM=SPACE ; FIND NTH STRING IN GROUP ; ENTER WITH: HL = START OF FIRST STRING ; B = NUMBER OF STRING TO FIND ; A = DELIMITER CHAR B27C 54 FIND: MOV D,H ;SAVE HL REF B27D 5D MOV E,L B27E 0E00 MVI C,0 ;CHAR CNT=0 B280 0C NXFNDL: INR C ;CNTR+1 B281 BE CMP M ;TEST DELIM B282 23 INX H ;ADV PNTR B283 C280B2 JNZ NXFNDL ;IF NOT DELIM B286 05 DCR B ;STRING CNTR-1 B287 C27CB2 JNZ FIND ;NEXT STRING B28A C9 RET ; CONVERT NUMBER IN ACC TO DATE (Example: JUNE 1, 1981) ; HL REG POINTS TO LEFT CHAR POS IN RESULT B28B E5 CDATE1: PUSH H ;SAVE POINTER B28C CDF2B2 CALL DODATE ;SPLIT INTO MO. DA. YR. B28F CDE8B2 CALL MONAME ;GET MONTH NAME B292 41 MOV B,C ;SET COUNTER B293 E1 POP H ;RECALL POINTER B294 CDD5B0 CALL MOVE ;MOVE MONTH NAME B297 3A9CB6 LDA SIGNF ;GET DAY B29A FE0A CPI 10 ;COMP 10 B29C FAA0B2 JM NSNG ;IF 1 DIGIT B29F 23 INX H ;SPACE FOR 2 DIG B2A0 E5 NSNG: PUSH H ;SAVE POINTER B2A1 CD8BB0 CALL SETACC ;ACC=DAY B2A4 E1 POP H ;RECALL POINTER B2A5 E5 PUSH H ;SAVE B2A6 110200 LXI D,2 ;WIDTH B2A9 CD15B1 CALL FORMAT ;PLACE DAY B2AC 216C07 LXI H,1900 ;CENTURY B2AF 3A9EB6 LDA DECF ;GET YEAR B2B2 5F MOV E,A ;TO DE B2B3 1600 MVI D,0 B2B5 19 DAD D ;1900+YR B2B6 22A3B6 SHLD ACC ;TO ACC B2B9 E1 POP H ;RECALL POINTER B2BA 23 INX H ;ADV B2BB 362C MVI M,2CH ;COMMA B2BD 110500 LXI D,5 ;SPACE FOR YR B2C0 19 DAD D ;MOD PNTR B2C1 1B DCX D ;WIDTH=4 B2C2 C315B1 JMP FORMAT ;PLACE YEAR ; CONVERT NUMBER IN ACC TO DATE (Example: 01JUN81) ; HL REG POINTS TO RIGHT CHAR POS IN RESULT B2C5 E5 CDATE2: PUSH H ;SAVE POINTER B2C6 CDF2B2 CALL DODATE ;SPLIT INTO MO. DA. YR. B2C9 CD8BB0 CALL SETACC ;ACC=YR B2CC E1 POP H ;RECALL POINTER B2CD CD2BB3 CALL DOTWO ;PLACE 2 DIGITS B2D0 E5 PUSH H ;SAVE POINTER B2D1 CDE8B2 CALL MONAME ;GET MONTH NAME B2D4 E1 POP H ;RECALL POINTER B2D5 2B2B DCX H! DCX H ;-2 B2D7 E5 PUSH H ;SAVE B2D8 0603 MVI B,3 ;CNTR B2DA CDD5B0 CALL MOVE ;PLACE MONTH B2DD 3A9CB6 LDA SIGNF ;GET DAY B2E0 CD8BB0 CALL SETACC ;TO ACC B2E3 E1 POP H ;RECALL POINTER B2E4 2B DCX H ;ADJUST B2E5 C32BB3 JMP DOTWO ;PUT DAY & RETURN B2E8 3A9DB6 MONAME: LDA NUM ;GET MONTH NAME B2EB 47 MOV B,A ;CNTR B2EC 213AB4 LXI H,MONTHS ;POINTER B2EF C37AB2 JMP FINDSP ;FIND IT ; ROUTINE TO SPLIT MO. DA. YR. B2F2 CDA8B0 DODATE: CALL CHKZAC ;CHECK FOR ZERO ACC B2F5 C2FBB2 JNZ DATIT ;NON-ZERO B2F8 D1 POP D ;UNSTACK & RETURN B2F9 D1 POP D B2FA C9 RET B2FB 3E10 DATIT: MVI A,16 ;OPERAND=10000 B2FD CD93B0 CALL SETOP B300 3E27 MVI A,27H B302 32A0B6 STA OPERAND+1 B305 CD31B0 CALL INTDIV ;DATE/10000 B308 7E MOV A,M B309 329DB6 STA NUM ;SAVE MONTH B30C CDC6B0 CALL HILO ;REMAIN TO ACC B30F 3E64 MVI A,100 B311 CD93B0 CALL SETOP ;OPERAND=100 B314 CD31B0 CALL INTDIV B317 7E MOV A,M B318 329CB6 STA SIGNF ;SAVE DAY B31B 3AA7B6 LDA HIACC ;GET REMAIN B31E 329EB6 STA DECF ;PLACE YEAR B321 C9 RET ; CONVERT NUMBER IN ACC TO DATE (Example: 06-01-81) ; HL REG POINTS TO RIGHT CHAR POS IN RESULT B322 CD2BB3 CDATE3: CALL DOTWO ;PLACE XX B325 CD28B3 CALL MINTWO ;PLACE -XX B328 362D MINTWO: MVI M,2DH ;MINUS SIGN B32A 2B PNT1: DCX H ;PNTR-1 B32B CD2EB3 DOTWO: CALL DODIG ;PLACE DIGIT B32E E5 DODIG: PUSH H ;SAVE POINTER B32F CD25B0 CALL DIVTEN ;ACC/10 GET REMAIN B332 E1 POP H ;RECALL POINTER B333 77 MOV M,A ;PUT DIGIT B334 2B DCX H ;PNTR-1 B335 C9 RET ; CONVERT DATE IN ACC TO NUMBER OF DAYS FROM JAN 1, 1901 B336 CDFBB2 TODAYS: CALL DATIT ;SPLIT INTO MO. DA. YR. B339 3D DCR A ;YR-1 B33A FA9BB0 JM CLRACC ;NO DATE B33D 5F MOV E,A ;YR*365 B33E 1600 MVI D,0 B340 6B MOV L,E B341 62 MOV H,D B342 2929192919 DAD H! DAD H! DAD D! DAD H! DAD D! DAD H B348 2919291929 DAD H! DAD D! DAD H! DAD D! DAD H! DAD H B34E 19 DAD D B34F 3A9EB6 LDA DECF ;GET YR B352 1F1F RAR! RAR ;/4 B354 E63F ANI 3FH ;MASK OFF UPPER 2 B356 5F MOV E,A ;TO DE B357 19 DAD D ;ADD DAY FOR EACH LEAP YEAR B358 3A9CB6 LDA SIGNF ;RECALL DAYS IN DATE B35B 5F MOV E,A ;TO E REG B35C 19 DAD D ;ADD TO HL B35D 01ACB4 LXI B,MDAYS ;SET DAYS POINTER B360 3A9EB6 LDA DECF ;GET YR B363 E603 ANI 3 ;MASK B365 C271B3 JNZ DYSLP ;LEAP YEAR ? B368 3A9DB6 LDA NUM ;YES -GET MONTH B36B FE03 CPI 3 ;TEST B36D F271B3 JP DYSLP ;AFTER FEB ? B370 2B DCX H ;NO -MINUS 1 DAY B371 0A DYSLP: LDAX B ;GET DAYS IN MONTH B372 5F MOV E,A ;TO DE REGS B373 3A9DB6 LDA NUM ;GET MONTH B376 3D DCR A ;CNTR-1 B377 22A3B6 SHLD ACC ;DAYS TO ACC B37A C8 RZ ;OUT IF LAST MONTH B37B 329DB6 STA NUM ;REPLACE COUNTER B37E 19 DAD D ;ADD DAYS B37F 03 INX B ;ADV DAYS POINTER B380 C371B3 JMP DYSLP ;NEXT MONTH ; CONVERT DAYS IN ACC TO DATE B383 CDE6B0 TODATE: CALL SUBONE ;DAYS-1 B386 CDA8B0 CALL CHKZAC ;CHECK FOR ZERO B389 FA9BB0 JM CLRACC ;YES, IT WAS B38C 3E6D MVI A,109 ;SET OPERAND=365 B38E CD93B0 CALL SETOP B391 3C INR A B392 32A0B6 STA OPERAND+1 B395 CD31B0 CALL INTDIV ;DAYS/365 B398 3AA3B6 LDA ACC ;GET QUOT B39B 019EB6 LXI B,DECF ;POINT TO YR B39E 02 STAX B ;SAVE IT B39F 2AA7B6 LHLD HIACC ;GET REMAIN B3A2 23 INX H ;+1 B3A3 1F RAR ;YR/4 B3A4 1F RAR B3A5 E63F ANI 3FH ;MASK OFF UPPER 2 B3A7 2F CMA ;CMP INC TO DE B3A8 5F MOV E,A B3A9 16FF MVI D,T B3AB 13 INX D B3AC 19 DAD D ;-YR/4 B3AD 0A LDAX B B3AE 3C INR A ;YR+1 B3AF 02 STAX B ;BACK B3B0 7C MOV A,H ;TEST B3B1 B7 ORA A B3B2 FAB9B3 JM OOPS ;DAYS<1 ? B3B5 B5 ORA L ;NO OR LOW B3B6 C2C6B3 JNZ DOMO ;IF NON-ZERO B3B9 116D01 OOPS: LXI D,365 B3BC 19 DAD D ;ADD 365 BACK B3BD 0A LDAX B B3BE 3D DCR A ;YR-1 B3BF 02 STAX B B3C0 E603 ANI 3 ;MASK B3C2 C2C6B3 JNZ DOMO ;IF NOT LEAP YEAR B3C5 23 INX H ;FOR LEAP B3C6 3E02 DOMO: MVI A,2 ;SET FEBRUARY B3C8 329DB6 STA NUM B3CB 0A LDAX B ;GET YEAR B3CC E603 ANI 3 ;MASK B3CE C2E8B3 JNZ NOLEAP ;NOT LEAP YEAR B3D1 B4 ORA H ;LEAP -GET HI B3D2 C2E7B3 JNZ GT60 ;OVER 60 DAYS B3D5 B5 ORA L ;LO BYTE B3D6 FAE7B3 JM GT60 ;>60 B3D9 FE3D CPI 61 ;TEST B3DB F2E7B3 JP GT60 ;OVER 60 B3DE 23 INX H ;ADV B3DF D61F SUI 31 ;-31 DAYS B3E1 FAE7B3 JM GT60 ;IF <31 DAYS B3E4 C209B4 JNZ DTCOMP ;IF FEBRUARY B3E7 2B GT60: DCX H ;TAKE BACK B3E8 97 NOLEAP: SUB A B3E9 329DB6 STA NUM ;RESET MONTH COUNTER B3EC 01ABB4 LXI B,MDAYS-1 ;TO MDAYS TABLE B3EF 16FF MVI D,T ;D=FF B3F1 03 MOLP: INX B ;ADV MONTH DAYS POINTER B3F2 3A9DB6 LDA NUM ;GET MONTH COUNT B3F5 3C INR A B3F6 329DB6 STA NUM B3F9 0A LDAX B ;GET DAYS IN MONTH B3FA 2F CMA ;NEGATE B3FB 3C INR A B3FC 5F MOV E,A ;TO DE B3FD 19 DAD D ;SUBTR MONTH'S DAYS B3FE 7C MOV A,H ;TEST B3FF B7 ORA A B400 FA07B4 JM DCORR ;TOO MUCH ? B403 B5 ORA L ;NO -GET L B404 C2F1B3 JNZ MOLP ;AGAIN IF DAYS LEFT B407 0A DCORR: LDAX B ;GET DAYS AGAIN B408 85 ADD L ;RESTORE REMAIN B409 47 DTCOMP: MOV B,A ;SAVE DAY B40A 2600 MVI H,0 B40C 3A9DB6 LDA NUM ;GET MONTH B40F 6F MOV L,A B410 CD25B4 CALL MP100 ;X100 B413 58 MOV E,B B414 1600 MVI D,0 B416 19 DAD D ;ADD DAY B417 CD25B4 CALL MP100 ;X100 B41A 3A9EB6 LDA DECF ;GET YR B41D 5F MOV E,A B41E 1600 MVI D,0 B420 19 DAD D ;ADD IT B421 22A3B6 SHLD ACC ;TO ACC B424 C9 RET B425 5D MP100: MOV E,L ;HL*100 B426 54 MOV D,H B427 29192929 DAD H! DAD D! DAD H! DAD H B42B 291929 DAD H! DAD D! DAD H B42E 7C MOV A,H B42F B7 ORA A B430 F238B4 JP NOCARY ;HI BYTE SET ? B433 3E01 MVI A,1 ;YES B435 32A5B6 STA ACC+2 B438 29 NOCARY: DAD H B439 C9 RET ; TABLES B43A 4A414E5541MONTHS: DB 'JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY ' B465 4155475553 DB 'AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER ' B490 4D4F4E2054DAYS: DB 'MON TUE WED THU FRI SAT SUN ' B4AC 1F1C1F1E1FMDAYS: DB 31,28,31,30,31,30,31,31,30,31,30,31 ; BUFFERED INPUT ROUTINE B4B8 CD2AB5 INPUT: CALL OUTROW ;PROMPT MESSAGE TO CRT B4BB 2156B5 LXI H,PRMT ;START OF PROMPT MES B4BE CD2AB5 CALL OUTROW ;OUTPUT IT B4C1 21BFB6 LXI H,PBUFER ;SET POINTER B4C4 22BCB6 SHLD IOADDR ;FOR INPUT B4C7 97 SUB A ;ZERO B4C8 32BEB6 STA IOCNTR ;COUNTER B4CB CD67B5 CALL CLR131 ;CLEAR BUFFER B4CE 0E01 INLP: MVI C,CONIN ;CONSOLE IN B4D0 CD0500 CALL CPMENT ;CALL CPM B4D3 47 MOV B,A ;SAVE INPUT CHAR B4D4 FE08 CPI 8 ;CONTROL H B4D6 CAFCB4 JZ RUBOUT ;IF IT IS B4D9 FEFF CPI 255 ;SAME B4DB CAFCB4 JZ RUBOUT B4DE FE0D CPI 13 ;CR B4E0 3ABEB6 LDA IOCNTR ;GET CHAR CNT B4E3 5F MOV E,A ;SAVE FOR EVALUE B4E4 1600 MVI D,0 ;NO DECIMAL PLACES B4E6 21BFB6 LXI H,PBUFER ;BUFF ADDRESS FOR EVALUE B4E9 C8 RZ ;RET IF CR LAST CHAR B4EA FE80 CPI 80H ;128 CHAR MAX B4EC C8 RZ ;IF MAX B4ED 3C INR A ;ADV CNTR B4EE 32BEB6 STA IOCNTR ;BACK B4F1 2ABCB6 LHLD IOADDR ;RECALL POINTER B4F4 70 MOV M,B ;STORE CHAR IN BUFFER B4F5 23 INX H ;ADV POINTER B4F6 22BCB6 SHLD IOADDR ;SAVE B4F9 C3CEB4 JMP INLP ;NEXT CHAR B4FC 1E20 RUBOUT: MVI E,20H ;SPACE B4FE 0E02 MVI C,CONOUT ;SET CONSOLE B500 3ABEB6 LDA IOCNTR ;GET COUNTER B503 B7 ORA A ;STATUS B504 C20DB5 JNZ RBCHR ;COLS LEFT ? B507 CD0500 CALL CPMENT ;NO -OUT OF SPACE B50A C3CEB4 JMP INLP ;NEXT CHAR B50D 3D RBCHR: DCR A ;CNTR-1 B50E 32BEB6 STA IOCNTR ;SAVE B511 CD0500 CALL CPMENT ;OUT SPACE B514 1E08 MVI E,8 ;CNTRL H B516 0E02 MVI C,CONOUT B518 CD0500 CALL CPMENT B51B 2ABCB6 LHLD IOADDR ;GET ADDRESS B51E 2B DCX H ;PNTR-1 B51F 3620 MVI M,20H ;BLANK TO BUFFER B521 22BCB6 SHLD IOADDR ;REPLACE B524 C3CEB4 JMP INLP ;NEXT B527 214CB7 CLSCRN: LXI H,CLRSEQ ;CLEAR SCREEN ; OUTPUT CHAR STRING TO CRT OR PRINTER B52A 22BCB6 OUTROW: SHLD IOADDR ;SAVE ADDRESS B52D 2ABCB6 OUT1: LHLD IOADDR ;RECALL ADDR B530 7E MOV A,M ;GET CHAR B531 23 INX H ;ADV POINTER B532 22BCB6 SHLD IOADDR ;SAVE B535 FEFF CPI T ;TERMINATE CHAR ?? B537 C8 RZ ;YES B538 B7 ORA A ;STATUS B539 FA42B5 JM OUT2 ;SPACE COUNT ? B53C CD93B5 CALL DEVOUT ;OUTPUT CHAR B53F C32DB5 JMP OUT1 ;NEXT B542 E67F OUT2: ANI 7FH ;MASK OFF TOP BIT B544 32BEB6 STA IOCNTR ;SET COUNT B547 3E20 OUT3: MVI A,20H ;SPACE B549 CD93B5 CALL DEVOUT ;OUTPUT IT B54C 21BEB6 LXI H,IOCNTR ;POINT TO CNTR B54F 35 DCR M ;CNTR-1 B550 CA2DB5 JZ OUT1 ;LAST SPACE B553 C347B5 JMP OUT3 ;NEXT B556 3A203F20FFPRMT: DB ': ? ',T ;PROMPT MESS ; MOVE AND PRINT B55B CDD5B0 MVPRNT: CALL MOVE ;MOVE BLOCK ; PRINT BUFFER CONTENTS B55E 21BFB6 PRNTBF: LXI H,PBUFER ;GET BUFF LOC B561 CD2AB5 CALL OUTROW ;OUTPUT LINE B564 C38CB5 JMP CRLF ; CLEAR BUFFERS B567 0683 CLR131: MVI B,131 ;CLEAR LONG LINE B569 C36EB5 JMP CLRBUF B56C 064F CLR79: MVI B,79 ;SHORT LINE B56E 21BFB6 CLRBUF: LXI H,PBUFER ;CLEAR OUTPUT BUFFER B571 3620 PFILR: MVI M,20H B573 23 INX H B574 05 DCR B B575 C271B5 JNZ PFILR B578 36FF MVI M,0FFH B57A C9 RET B57B 21ABB6 CLBUF1: LXI H,PBUFF B57E 0610 CLB1: MVI B,16 B580 C371B5 JMP PFILR B583 2150B7 FFEED: LXI H,FFSEQ ;FORM FEED B586 C32AB5 JMP OUTROW B589 CD8CB5 DBCRLF: CALL CRLF ;DOUBLE CARRIAGE RETURN B58C 3E0D CRLF: MVI A,13 ;CR B58E CD93B5 CALL DEVOUT ;OUT B591 3E0A MVI A,10 ;LF ; OUTPUT CHARACTER B593 5F DEVOUT: MOV E,A ;CHAR TO E REG FOR CP/M B594 0E02 MVI C,CONOUT ;FOR CONSOLE B596 C30500 JMP CPMENT ;TO CP/M ENTRY ; PRINTER ON/OFF B599 3E05 SETPRN: MVI A,LSTOUT ;PRINTER ON B59B C3A0B5 JMP SETDEV B59E 3E02 SETCON: MVI A,CONOUT ;PRINTER OFF B5A0 3295B5 SETDEV: STA DEVOUT+2 B5A3 C9 RET ; CHAIN PROGRAM INTO TRANSIENT AREA ; HL = LOC OF FCB 8 BYTE NAME B5A4 11BFB6 CHAIN: LXI D,PBUFER ;LOC OF FCB FOR CHAIN B5A7 0608 MVI B,8 ;CNTR B5A9 EB XCHG B5AA CDD5B0 CALL MOVE ;TRANS NAME B5AD 1143B7 LXI D,COMCHR ;SET LOC OF ' COM' B5B0 0604 MVI B,4 B5B2 CDD5B0 CALL MOVE B5B5 1E1C MVI E,28 ;SET COUNT B5B7 CDA0B0 CALL CLRBAK ;CLEAR REST OF BLOCK B5BA 11BFB6 LXI D,PBUFER ;FCB LOC B5BD 0E0F MVI C,OPNFIL ;CP/M OPEN COMM B5BF CD0500 CALL CPMENT B5C2 FEFF CPI T ;CHECK FOR ERROR B5C4 CAE9B5 JZ NOTFND ;ERROR B5C7 210001 LXI H,TPAREA ;START LOC B5CA 2238B6 SHLD ADRSET+1 B5CD 3ACEB6 LDA PBUFER+15 ;NO. OF SECTORS B5D0 32BEB6 STA IOCNTR B5D3 EB XCHG B5D4 CD37B6 CHREAD: CALL ADRSET ;SET ADDRESS B5D7 11BFB6 LXI D,PBUFER ;FCB LOC B5DA 0E14 MVI C,RDSEQ ;READ SEQ COMM B5DC CD0500 CALL CPMENT ;READ B5DF CD4DB6 CALL ADVCHN ;ADVANCE & COUNT B5E2 C2D4B5 JNZ CHREAD ;IF NOT THRU B5E5 E1 POP H ;CLEAR STACK B5E6 C30001 JMP TPAREA ;GO EXECUTE PROGRAM B5E9 CD89B5 NOTFND: CALL DBCRLF ;SKIP 2 LINES B5EC 2166B7 LXI H,NOFILE ;OUTPUT 'NOT SUPPLIED' B5EF C3B8B4 JMP INPUT ; OPEN FILE FOR READ/WRITE ; DE = LOC OF FILENAME ; HL = LOC OF CHANNEL FCB B5F2 22BCB6 OPEN: SHLD IOADDR ;SAVE FCB LOC B5F5 060C MVI B,12 ;COUNT B5F7 CDD5B0 CALL MOVE B5FA 1E1C MVI E,28 ;SET CNTR B5FC CDA0B0 CALL CLRBAK ;ZERO REST OF BLOCK B5FF 0E0F MVI C,OPNFIL ;OPEN COMM B601 2ABCB6 LHLD IOADDR ;RECALL B604 EB XCHG B605 CD0500 CALL CPMENT ;TRY OPEN B608 FEFF CPI T B60A C0 RNZ ;IF SUCCESS B60B 2ABCB6 LHLD IOADDR B60E EB XCHG B60F 0E16 MVI C,MKFILE ;OPEN NEW FILE B611 C30500 JMP CPMENT ; CLOSE FILE B614 0E10 CLOSE: MVI C,CLOSFL ;DE = ADDR OF FCB B616 C30500 JMP CPMENT ; GET 512 BYTE RECORD ; HL = RECORD NUMBER ; C = CHAN# 0-7 B619 CD5CB6 GETREC: CALL DSKSET ;SETUP B61C CD37B6 GETLP: CALL ADRSET ;SET BUFF ADDR B61F 0E21 MVI C,RDRAND ;COMM B621 CD43B6 CALL ADVADR ;GET 128 BYTE SECTOR B624 C21CB6 JNZ GETLP ;LAST ? B627 C9 RET ;YES ; PUT 512 BYTE RECORD ; HL = RECORD NUMBER ; C = CHAN# 0-7 B628 CD5CB6 PUTREC: CALL DSKSET ;SETUP B62B CD37B6 PUTLP: CALL ADRSET ;SET BUFF ADDR B62E 0E22 MVI C,WTRAND ;COMM B630 CD43B6 CALL ADVADR ;PUT 128 BYTE SECTOR B633 C22BB6 JNZ PUTLP ;LAST ? B636 C9 RET ;RET ; SET BUFF ADDRESS FOR TRANSFER B637 1100BA ADRSET: LXI D,CHBUFR ;DE = BUFFER ADDRESS B63A 0E1A MVI C,SETDMA ;COMM B63C CD0500 CALL CPMENT ;SET IT B63F 11C0B8 GETFCB: LXI D,CHNFCB ;DE = FCB ADDR B642 C9 RET ; ADVANCE ADDR 128, REC 1 & CNTR-1 B643 CD0500 ADVADR: CALL CPMENT ;DO READ OR WRITE B646 2AE1B8 ADVREC: LHLD CHNFCB+33 ;LOC OF CURRENT REC B649 23 INX H ;ADVANCE B64A 22E1B8 ADVPUT: SHLD CHNFCB+33 ;REPLACE B64D 2A38B6 ADVCHN: LHLD ADRSET+1 ;ADDR +128 B650 118000 LXI D,128 B653 19 DAD D B654 2238B6 SHLD ADRSET+1 ;REPLACE B657 21BEB6 LXI H,IOCNTR ;COUNTER LOC B65A 35 DCR M ;CNTR-1 B65B C9 RET ; SETUP DISK ACCESS PARAMETERS B65C 2B DSKSET: DCX H ;REC-1 B65D 2929 DAD H! DAD H ;X4 B65F E5 PUSH H ;SAVE B660 79 MOV A,C ;CHAN*40 B661 87 ADD A B662 47 MOV B,A B663 8781878787 ADD A! ADD C! ADD A! ADD A! ADD A! B668 5F MOV E,A ;TO DE B669 1600 MVI D,0 B66B 21C0B8 LXI H,CHNFCB B66E 19 DAD D B66F 2240B6 SHLD GETFCB+1 ;SAVE FCB LOC B672 112100 LXI D,33 ;OFFSET B675 19 DAD D ;DE+HL TO HL B676 2247B6 SHLD ADVREC+1 ;SAVE B679 224BB6 SHLD ADVPUT+1 B67C D1 POP D ;RECALL REC# B67D 73 MOV M,E ;PUT IN FCB B67E 23 INX H B67F 72 MOV M,D B680 0E00 MVI C,0 B682 2100BA LXI H,CHBUFR ;START OF BUFFERS B685 09 DAD B ;+CHAN*512 B686 2238B6 SHLD ADRSET+1 ;SAVE B689 3E04 MVI A,4 B68B 32BEB6 STA IOCNTR ;SET COUNTER B68E C9 RET B68F 2154B7 COMPON: LXI H,CMSEQ ;COMPRESSED PRINT B692 C32AB5 JMP OUTROW B695 2159B7 COMPOF: LXI H,DCMSEQ ;COMP PRINT OFF B698 C32AB5 JMP OUTROW B69B 06 CONBYT: DB 6 ;SYS CONTROL BYTE (6 AND 7 ALLOWED) B69C 00 SIGNF: DB 0 ;SIGN FLAG & DAY B69D 00 NUM: DB 0 ;TEMP DIGIT & MONTH B69E 00 DECF: DB 0 ;DECIMAL FLAG & YEAR B69F OPERAND: DS LENGTH B6A3 ACC: DS LENGTH B6A7 HIACC: DS LENGTH B6AB PBUFF: DS 16 B6BB FF PBFEND: DB 255 B6BC 0000 IOADDR: DW 0 ;CURRENT LOC OF INPUT/OUTPUT CHAR B6BE 00 IOCNTR: DB 0 ;CURRENT CNT OF INPUT/OUTPUT CHARS B6BF PBUFER: DS 132 ;PRINTER BUFFER & FCB FOR CHAIN B743 20434F4D COMCHR: DB ' COM' ;COM TYPE FOR CHAIN B747 1B3D1F1FFFCURSEQ: DB 27,61,31,31,T ;CURSOR SEQUENCE B74C 00001AFF CLRSEQ: DB 0,0,26,T ;SCREEN CLEAR SEQUENCE B750 00000CFF FFSEQ: DB 0,0,12,T ;FORM FEED SEQUENCE B754 1B370000FFCMSEQ: DB 27,55,0,0,T ;COMPRESSED PRINT B759 1B360000FFDCMSEQ: DB 27,54,0,0,T ;DECOMP PRINT B75E 1B7E42FF BLNKON: DB 27,126,66,T ;BLINK ON SEQUENCE (INTERTEC DATA) B762 1B7E62FF BLNKOF: DB 27,126,98,T ;BLINK OFF SEQ B766 4E4F542053NOFILE: DB 'NOT SUPPLIED IN THIS PACKAGE' B782 2020202D50RETMES: DB ' -PRESS RETURN TO CONTINUE',T B79F END