************************************************* * * * 8080A ARITHMETIC PACKAGE WITH DATE ROUTINES * * by Dennis E. Baker 1/8/82 Title: RUNPAC * * * ************************************************* LENGTH EQU 4 ;VARIABLE LENGTH CHBUFR EQU 0BA00H ;CHANNEL DATA BUFFERS START CHNFCB EQU 0B8C0H ;CHANNEL FILE CONTROL BLOCKS START CLOSFL EQU 16 ;CLOSE FILE CPMENT EQU 5 ;CP/M ENTRY POINT CONIN EQU 1 ;CONSOLE INPUT CONOUT EQU 2 ;CONSOLE OUTPUT LSTOUT EQU 5 ;LIST DEVICE OUT MKFILE EQU 22 ;MAKE FILE OPNFIL EQU 15 ;OPEN FILE RDRAND EQU 33 ;READ RANDOM RDSEQ EQU 20 ;READ SEQUENTIAL SETDMA EQU 26 ;SET DMA ADDRESS TPAREA EQU 100H ;START OF TRANSIENT PROGRAM AREA WTRAND EQU 34 ;WRITE RANDOM T EQU 255 ;TERMINATOR ORG 0B000H ; SIGNED MULTIPLICATION ROUTINES ; INTMPY: ACC=ACC*OPERAND MPYTEN: ACC=ACC*10 MPYTEN: CALL OPTEN ;SET OPR=10 THEN ACC=ACC*10 INTMPY: CALL SIGN ;COMPUTE SIGN OF PRODUCT CM NEGOPR ;NEGATE OPR IF IT IS NEGATIVE MVI D,8*LENGTH+1 ;NUMBER OF SHIFTS REQUIRED RSHIFT: ANA A ;CLEAR CARRY MVI E,2*LENGTH ;NUMBER OF BYTES TO SHIFT LXI H,HIACC+LENGTH-1 ;SET POINTER NXRSHF: MOV A,M ;GET BYTE RAR ;SHIFT RIGHT MOV M,A ;REPLACE DCX H ;BACKUP POINTER DCR E ;BYTE COUNT -1 JNZ NXRSHF ;LAST BYTE ? CC ADOPAC ;YES -ADD OPERAND IF CARRY DCR D ;SHIFT COUNT -1 JNZ RSHIFT ;LAST ITERATION ? MPEND: POP PSW ;YES -GET SIGN CM NEGACC ;IF MINUS -NEGATE ACC RET ; SIGNED DIVISION ROUTINES ; INTDIV: ACC=ACC/OPERAND DIVTEN: ACC=ACC/10 DIVTEN: CALL OPTEN ;SET OPR=10 CALL INTDIV ;ACC=ACC/10 LDA HIACC ;GET REMAINDER ADI 30H ;TO ASCII RET INTDIV: CALL SIGN ;COMPUTE SIGN OF QUOTIENT CP NEGOPR ;NEGATE OPR IF POSITIVE MVI D,8*LENGTH ;SET SHIFT COUNTER D DIVLOP: ANA A ;CLEAR CARRY MVI E,2*LENGTH ;SET BYTE COUNTER E LXI H,ACC ;AND POINT TO ACCUMULATOR DVLP: MOV A,M ;GET BYTE RAL ;SHIFT LEFT (CARRY IN RIGHT) MOV M,A ;REPLACE BYTE INX H ;ADVANCE POINTER DCR E ;BYTE COUNT -1 JNZ DVLP ;LAST BYTE ? CALL STADOP ;SETUP ADD -OPERAND TO HIACC DVLP1: LDAX B ;TRIAL SUBTRACT ADC M INX B INX H DCR E ;BYTE COUNT -1 JNZ DVLP1 ;LAST BYTE ? JNC NOSUB ;YES -SUBTRACT OK ? CALL ADOPAC ;YES -ADD NEGATED OPERAND TO HIACC INR M ;SET CURRENT QUOTIENT BIT NOSUB: DCR D ;SHIFT COUNT -1 JNZ DIVLOP ;LAST ITERATION ? JMP MPEND ;YES -DO SIGN ; COMPUTE SIGN OF PRODUCT/QUOTIENT SIGN: POP B ;UNSTACK RETURN ADDRESS LDA ACC-1 ;GET TOP BYTE OF OPR LXI H,HIACC-1 ;SET TO TOP OF ACC XRA M ;EX-OR SIGNS PUSH PSW ;STACK RESULT PUSH B ;RESTACK SUBROUTINE RETURN INX H ;PNT TO HIACC SUB A ;A=0 CALL SET1 ;CLEAR HIACC LDA HIACC-1 ;GET TOP ACC BYTE ORA A ;SET STATUS CM NEGACC ;NEGATE ACC IF NEGATIVE LDA ACC-1 ;SET TO TOP OPERAND BYTE ORA A ;SET STATUS RET ;RETURN WITH HIGH OPERAND BYTE ; SETUP ADD OPERAND TO HIGH ACCUMULATOR STADOP: MVI E,LENGTH ;SETUP OPERAND+HIACC LXI B,HIACC LXI H,OPERAND ANA A ;CLEAR CARRY RET ; ADD OPERAND TO HIACC ADOPAC: CALL STADOP ;SETUP JMP ADBAK ;DO ADD ; SET OPERAND, CLEAR ACCUMULATOR SETACC: LXI H,ACC ;ACCUM ADDR JMP SET1 OPTEN: MVI A,10 ;SET OPERAND=10 SETOP: LXI H,OPERAND ;SET OPERAND SET1: MVI E,LENGTH ;SET BYTE COUNTER JMP CLR1 CLRACC: LXI H,ACC ;SETUP CLR HI&LO ACC MVI E,2*LENGTH ;BYTE COUNT CLRBAK: SUB A ;A=0 CLR1: MOV M,A ;CLR A BYTE INX H ;ADV POINTER DCR E ;CNTR -1 JNZ CLRBAK ;LAST BYTE ? RET ;YES ; CHECK FOR ZERO ACC CHKZAC: MVI E,LENGTH ;SET CNTR CHK1: LXI H,HIACC-1 ;TOP ACC BYTE ADDR MOV D,M ;SAVE IN D REG SUB A ;A=0 ZLP: ORA M ;OR ALL BYTES TO A DCX H ;DECR POINTER DCR E ;CNTR -1 JNZ ZLP ;LAST BYTE ? ORA A ;YES -SET STATUS RZ ;ZERO ? INR E ;NO -E=1 MOV A,D ;RECALL HI BYTE ORA E ;MAKE NON-ZERO RET ;REG A NEG IF ACC NEG HIZCHK: MVI E,LENGTH-1 ;CHEK TOP 3 BYTES JMP CHK1 ; STORE ACC AT LOC IN HL REG INTSTR: LXI D,ACC ;SET ACC ADDR JMP INMOV1 ;DO TRANSFER ; HIACC TO ACC HILO: LXI H,HIACC ;SET HIACC POINTER ; LOAD ACC FROM LOC IN HL REG INTACL: LXI D,ACC ;SET ACC POINTER JMP INMOV ;GO TRANSFER ; LOAD OPERAND FROM LOC IN HL REG INTOPL: LXI D,OPERAND ;SET POINTER TO OPERAND INMOV: XCHG ;SWAP HL AND DE INMOV1: MVI B,LENGTH ;SET BYTE COUNTER ; MOVE BLOCK OF BYTES ; ENTER WITH: HL = DESTINATION START ; DE = SOURCE START ; B = NO. OF BYTES MOVE: LDAX D ;GET BYTE FROM DE LOC MOV M,A ;PUT TO HL LOC INX H ;INCR HL POINTER INX D ;AND DE POINTER DCR B ;DECR COUNTER JNZ MOVE ;LAST BYTE ? RET ;YES ; ACC=ACC+1 ADDONE: MVI A,1 ;A=1 CALL SETOP ;OPERAND = 1 JMP INTADD ;ADD 1 ; ACC=ACC-1 SUBONE: MVI A,1 ;A=1 CALL SETOP ;OPERAND = 1 ; SUBTRACT OPERAND FROM ACC INTSUB: CALL NEGOPR ;COMPLEMENT OPERAND ; ADD OPERAND TO ACC INTADD: CALL STADOP ;SETUP ADD ADDRESSES LXI B,ACC ;ACC ADDR TO BC REG ADBAK: LDAX B ;GET ACC BYTE ADC M ;+OPR BYTE +CARRY STAX B ;TO ACC BYTE INX H ;ADV POINTERS INX B DCR E ;COUNTER -1 JNZ ADBAK ;LAST BYTE ? RET ;YES ; NEGATE OPERAND NEGOPR: LXI B,OPERAND ;SET POINTER TO OPERAND JMP NEG1 ;GO NEGATE IT ; NEGATE ACCUMULATOR NEGACC: LXI B,ACC ;SET POINTER TO ACC NEG1: MVI E,LENGTH ;SET BYTE COUNT NEGATE: STC ;SET CARRY FOR COMP +1 NGOBAK: LDAX B ;GET BYTE CMA ;COMPLEMENT IT ACI 0 ;ADD IMM WITH CARRY STAX B ;REPLACE BYTE INX B ;ADV POINTER DCR E ;COUNTER -1 JNZ NGOBAK ;LAST BYTE ? 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 FORMAT: LDA HIACC-1 ;GET TOP ACC BYTE ORA A ;SET STATUS PUSH H ;SAVE WRITE END POINTER PUSH D ;SAVE MODE AND WIDTH PUSH PSW ;SAVE ACC SIGN CM NEGACC ;NEGATE IF MINUS CALL CLBUF1 ;CLEAR BUFFER LXI H,PBFEND-1 ;SET END POINTER PUSH H ;SAVE IT CONVLP: CALL DIVTEN ;ACC/10 CONV REMAINDER POP H ;GET POINTER MOV M,A ;PLACE DIGIT DCX H ;PNTR-1 PUSH H ;SAVE POINTER CALL CHKZAC ;CHECK FOR ZERO ACC JNZ CONVLP ;ZERO ? POP H ;YES -DISCARD POINTER POP PSW ;RECALL STATUS JP ECONV ;POSITIVE ? MVI A,2DH ;NO -GET MINUS SIGN MOV M,A ;PLACE IT ECONV: POP D ;RECALL DIRECTIONS MVI C,0 ;CHAR COUNT=0 LXI H,PBFEND-1 ;SET BUFF POINTER CHEKLP: MOV A,M ;GET CHARACTER INR C ;COUNT +1 DCX H ;PNTR-1 CPI 20H ;COMPARE SPACE JNZ CHEKLP ;SPACE ? MOV A,D ;YES -GET DIRECTIONS ORA A ;STATUS JNZ WCHK ;ANY DECIMAL PLACES ? DCR C ;NO -LESS ONE PLACE WCHK: POP H ;RECALL FIELD POINTER MOV A,E ;GET WIDTH OF FIELD SUB C ;-REQUIRED PLACES JP XFR ;OK TO TRANSFER ? MVI A,3FH ;NO -GET QUESTION MARK QLOOP: MOV M,A ;FILL FIELD DCX H ;PNTR-1 DCR E ;CNTR-1 JNZ QLOOP ;LAST ? RET ;YES XFR: PUSH B ;SAVE CHAR COUNT LXI B,PBFEND-1 ;SET BUFF POINTER TRLOP: DCR D ;DECIMAL CNTR-1 CZ DECIN ;PLACE DEC POINT IF ZERO LDAX B ;GET BUFF CHAR SUI 30H ;-ASCII ZERO JM NUMEND ;<0 SUI 10 ;-10 JP NUMEND ;>9 LDAX B ;GET CHAR MOV M,A ;TO DEST FIELD DCX B ;BUFF PNTR-1 DCX H ;DEST PNTR-1 DCR E ;CNTR-1 JNZ TRLOP ;LAST ? POP B ;YES -EXIT RET NUMEND: LDAX B ;GET BUFF CHAR POP B ;RECALL COUNT MOV B,A ;SAVE CHAR DECHK: MOV A,D ;GET DECIMAL PLACE CNTR ORA A ;STATUS JM SGNCHK ;PLACE MINUS IF REQ'D CZ DECIN ;PUT DECIMAL PNT IF ZERO LASTZ: DCR D ;DEC CNTR-1 MVI M,30H ;PLACE LEAD ZERO INR C ;WIDTH+1 DCX H ;PNTR-1 JMP DECHK ;CHEK FOR DECIMAL PNT SGNCHK: INR A ;INCR DEC CNTR JZ LASTZ ;PUT ZERO IF WAS -1 MOV A,B ;RECALL LAST CHAR CPI 2DH ;COMP MINUS SIGN RNZ ;RET IF NOT MOV M,A ;PLACE MINUS RET DECIN: MVI M,2EH ;PUT DEC PNT DCX H ;PNTRS-1 DCR D 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 EVALUE: PUSH H ;SAVE REGISTERS PUSH D CALL CLRACC ;CLEAR ACCUMULATOR STA SIGNF ;SIGN FLAG STA DECF ;AND DECIMAL PNT FLAG POP D ;RECALL REGS POP H CONLP: MOV A,M ;GET CHAR SUI 30H ;-ASCII ZERO STA NUM ;SAVE JM NONUM ;<0 ? SUI 10 ;NO -10 JP NONUM ;>9 ? PUSH D ;NO -SAVE REGS PUSH H CALL MPYTEN ;ACC*10 LDA NUM CALL SETOP ;OPERAND=NUM CALL INTADD ;ACC+NUM POP H ;RECALL POP D LDA DECF ;GET DECIMAL FLAG ORA A ;STATUS JZ NXTCHR ;FLAG ? DCR D ;YES CNTR-1 JZ CNVOUT ;OUT IF LAST DECIMAL PLACE NXTCHR: INX H ;PNTR+1 DCR E ;WIDTH-1 JNZ CONLP ;LOOP IF NOT LAST CHAR FIXD: MOV A,D ;GET DEC PLACE COUNTER ORA A ;STATUS JZ CNVOUT ;MORE PLACES ? LDA DECF ;YES -GET DECIMAL FLAG ORA A ;STATUS JNZ DCIN ;FLAG SET ? DCR D ;NO CNTR-1 JZ CNVOUT ;LAST PLACE ? CMA ;NO -SET AND STA DECF ;STORE DECIMAL FLAG DCIN: PUSH D ;SAVE PARAMS CALL MPYTEN ;ACC*10 POP D ;RECALL PARAMS DCR D ;DEC CNTR-1 JNZ FIXD ;GO RETEST IF>0 CNVOUT: LDA SIGNF ;GET SIGN FLAG ORA A ;STATUS CM NEGACC ;NEGATE IF MINUS RET NONUM: MOV A,M ;GET CHAR CPI 20H ;COMP SPACE JZ NXTCHR ;IF SPACE CPI 2DH ;COMP MINUS JZ MIN ;IF MINUS CPI 2EH ;COMP DECIMAL POINT JNZ FIXD ;IF IT IS LDA DECF ;GET DEC FLAG ORA A ;STATUS JNZ FIXD ;IF ON CMA ;SET IT STA DECF MOV A,D ;GET DEC CNTR RAR ;/2 ORA A ;STATUS JZ CNVOUT ;EXIT IF ZERO DCR D ;CNTR-1 JMP NXTCHR ;DO NEXT CHAR MIN: LDA SIGNF ;GET SIGN FLAG CMA STA SIGNF ;REVERSE 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 INDEX: LDAX B ;GET 1ST OBJECT CHAR CMP M ;COMPARE LINE CHAR JZ SAME ;IF EQUAL INDXBK: INX H ;ADV PNTR ANA A ;CARRY=0 DCR E ;LINE CNTR-1 JNZ INDEX ;LAST LINE CHAR ? RET ;YES SAME: PUSH B ;SAVE REGISTERS PUSH D PUSH H SMLP: INX B ;ADV PNTRS INX H STC ;SET CARRY DCR D ;OBJ CNTR-1 JZ INXOUT ;IF LAST OBJECT CHAR CMC ;COMPLEMENT CARRY DCR E ;LINE CNTR-1 JZ INXOUT ;IF LAST LINE CHAR LDAX B ;GET OBJ CHAR CMP M ;COMP LINE JZ SMLP ;IF STILL EQUAL INXOUT: POP H ;RECALL REGS POP D POP B JNZ INDXBK ;LOOP RET ; ERASE LINE & RESET CURSOR ERCUE: LXI H,1701H ;SET LINE 23 COL 1 MVI C,79 ;LINE LENGTH CURSET: PUSH H ;SAVE COORD PUSH B ;AND CNTR CALL CURSOR ;SET CURSOR POP B ;RECALL CNTR ERASE: MVI A,20H ;SPACE PUSH B ;SAVE COUNT CALL DEVOUT ;SPACE TO CONSOLE POP B ;RECALL CNTR DCR C ;CNTR-1 JNZ ERASE ;AGAIN POP H ;RECALL COORD ; ROUTINE TO POSITION CURSOR ON CONSOLE DEVICE ; ENTER WITH: H = LINE NUMBER ; L = COLUMN NUMBER CURSOR: LXI D,1F1FH ;CUR OFFSET=31&31 DAD D ;ADD TO ROW, COL MOV A,L ;SWAP H & L MOV L,H MOV H,A SHLD CURSEQ+2 ;PLACE IN CURSOR SEQ LXI H,CURSEQ ;GET SEQ LOC JMP OUTROW ;AND DO IT ; FIND STRING (SPACE DELIMITER) 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 FIND: MOV D,H ;SAVE HL REF MOV E,L MVI C,0 ;CHAR CNT=0 NXFNDL: INR C ;CNTR+1 CMP M ;TEST DELIM INX H ;ADV PNTR JNZ NXFNDL ;IF NOT DELIM DCR B ;STRING CNTR-1 JNZ FIND ;NEXT STRING RET ; CONVERT NUMBER IN ACC TO DATE (Example: JUNE 1, 1981) ; HL REG POINTS TO LEFT CHAR POS IN RESULT CDATE1: PUSH H ;SAVE POINTER CALL DODATE ;SPLIT INTO MO. DA. YR. CALL MONAME ;GET MONTH NAME MOV B,C ;SET COUNTER POP H ;RECALL POINTER CALL MOVE ;MOVE MONTH NAME LDA SIGNF ;GET DAY CPI 10 ;COMP 10 JM NSNG ;IF 1 DIGIT INX H ;SPACE FOR 2 DIG NSNG: PUSH H ;SAVE POINTER CALL SETACC ;ACC=DAY POP H ;RECALL POINTER PUSH H ;SAVE LXI D,2 ;WIDTH CALL FORMAT ;PLACE DAY LXI H,1900 ;CENTURY LDA DECF ;GET YEAR MOV E,A ;TO DE MVI D,0 DAD D ;1900+YR SHLD ACC ;TO ACC POP H ;RECALL POINTER INX H ;ADV MVI M,2CH ;COMMA LXI D,5 ;SPACE FOR YR DAD D ;MOD PNTR DCX D ;WIDTH=4 JMP FORMAT ;PLACE YEAR ; CONVERT NUMBER IN ACC TO DATE (Example: 01JUN81) ; HL REG POINTS TO RIGHT CHAR POS IN RESULT CDATE2: PUSH H ;SAVE POINTER CALL DODATE ;SPLIT INTO MO. DA. YR. CALL SETACC ;ACC=YR POP H ;RECALL POINTER CALL DOTWO ;PLACE 2 DIGITS PUSH H ;SAVE POINTER CALL MONAME ;GET MONTH NAME POP H ;RECALL POINTER DCX H! DCX H ;-2 PUSH H ;SAVE MVI B,3 ;CNTR CALL MOVE ;PLACE MONTH LDA SIGNF ;GET DAY CALL SETACC ;TO ACC POP H ;RECALL POINTER DCX H ;ADJUST JMP DOTWO ;PUT DAY & RETURN MONAME: LDA NUM ;GET MONTH NAME MOV B,A ;CNTR LXI H,MONTHS ;POINTER JMP FINDSP ;FIND IT ; ROUTINE TO SPLIT MO. DA. YR. DODATE: CALL CHKZAC ;CHECK FOR ZERO ACC JNZ DATIT ;NON-ZERO POP D ;UNSTACK & RETURN POP D RET DATIT: MVI A,16 ;OPERAND=10000 CALL SETOP MVI A,27H STA OPERAND+1 CALL INTDIV ;DATE/10000 MOV A,M STA NUM ;SAVE MONTH CALL HILO ;REMAIN TO ACC MVI A,100 CALL SETOP ;OPERAND=100 CALL INTDIV MOV A,M STA SIGNF ;SAVE DAY LDA HIACC ;GET REMAIN STA DECF ;PLACE YEAR RET ; CONVERT NUMBER IN ACC TO DATE (Example: 06-01-81) ; HL REG POINTS TO RIGHT CHAR POS IN RESULT CDATE3: CALL DOTWO ;PLACE XX CALL MINTWO ;PLACE -XX MINTWO: MVI M,2DH ;MINUS SIGN PNT1: DCX H ;PNTR-1 DOTWO: CALL DODIG ;PLACE DIGIT DODIG: PUSH H ;SAVE POINTER CALL DIVTEN ;ACC/10 GET REMAIN POP H ;RECALL POINTER MOV M,A ;PUT DIGIT DCX H ;PNTR-1 RET ; CONVERT DATE IN ACC TO NUMBER OF DAYS FROM JAN 1, 1901 TODAYS: CALL DATIT ;SPLIT INTO MO. DA. YR. DCR A ;YR-1 JM CLRACC ;NO DATE MOV E,A ;YR*365 MVI D,0 MOV L,E MOV H,D DAD H! DAD H! DAD D! DAD H! DAD D! DAD H DAD H! DAD D! DAD H! DAD D! DAD H! DAD H DAD D LDA DECF ;GET YR RAR! RAR ;/4 ANI 3FH ;MASK OFF UPPER 2 MOV E,A ;TO DE DAD D ;ADD DAY FOR EACH LEAP YEAR LDA SIGNF ;RECALL DAYS IN DATE MOV E,A ;TO E REG DAD D ;ADD TO HL LXI B,MDAYS ;SET DAYS POINTER LDA DECF ;GET YR ANI 3 ;MASK JNZ DYSLP ;LEAP YEAR ? LDA NUM ;YES -GET MONTH CPI 3 ;TEST JP DYSLP ;AFTER FEB ? DCX H ;NO -MINUS 1 DAY DYSLP: LDAX B ;GET DAYS IN MONTH MOV E,A ;TO DE REGS LDA NUM ;GET MONTH DCR A ;CNTR-1 SHLD ACC ;DAYS TO ACC RZ ;OUT IF LAST MONTH STA NUM ;REPLACE COUNTER DAD D ;ADD DAYS INX B ;ADV DAYS POINTER JMP DYSLP ;NEXT MONTH ; CONVERT DAYS IN ACC TO DATE TODATE: CALL SUBONE ;DAYS-1 CALL CHKZAC ;CHECK FOR ZERO JM CLRACC ;YES, IT WAS MVI A,109 ;SET OPERAND=365 CALL SETOP INR A STA OPERAND+1 CALL INTDIV ;DAYS/365 LDA ACC ;GET QUOT LXI B,DECF ;POINT TO YR STAX B ;SAVE IT LHLD HIACC ;GET REMAIN INX H ;+1 RAR ;YR/4 RAR ANI 3FH ;MASK OFF UPPER 2 CMA ;CMP INC TO DE MOV E,A MVI D,T INX D DAD D ;-YR/4 LDAX B INR A ;YR+1 STAX B ;BACK MOV A,H ;TEST ORA A JM OOPS ;DAYS<1 ? ORA L ;NO OR LOW JNZ DOMO ;IF NON-ZERO OOPS: LXI D,365 DAD D ;ADD 365 BACK LDAX B DCR A ;YR-1 STAX B ANI 3 ;MASK JNZ DOMO ;IF NOT LEAP YEAR INX H ;FOR LEAP DOMO: MVI A,2 ;SET FEBRUARY STA NUM LDAX B ;GET YEAR ANI 3 ;MASK JNZ NOLEAP ;NOT LEAP YEAR ORA H ;LEAP -GET HI JNZ GT60 ;OVER 60 DAYS ORA L ;LO BYTE JM GT60 ;>60 CPI 61 ;TEST JP GT60 ;OVER 60 INX H ;ADV SUI 31 ;-31 DAYS JM GT60 ;IF <31 DAYS JNZ DTCOMP ;IF FEBRUARY GT60: DCX H ;TAKE BACK NOLEAP: SUB A STA NUM ;RESET MONTH COUNTER LXI B,MDAYS-1 ;TO MDAYS TABLE MVI D,T ;D=FF MOLP: INX B ;ADV MONTH DAYS POINTER LDA NUM ;GET MONTH COUNT INR A STA NUM LDAX B ;GET DAYS IN MONTH CMA ;NEGATE INR A MOV E,A ;TO DE DAD D ;SUBTR MONTH'S DAYS MOV A,H ;TEST ORA A JM DCORR ;TOO MUCH ? ORA L ;NO -GET L JNZ MOLP ;AGAIN IF DAYS LEFT DCORR: LDAX B ;GET DAYS AGAIN ADD L ;RESTORE REMAIN DTCOMP: MOV B,A ;SAVE DAY MVI H,0 LDA NUM ;GET MONTH MOV L,A CALL MP100 ;X100 MOV E,B MVI D,0 DAD D ;ADD DAY CALL MP100 ;X100 LDA DECF ;GET YR MOV E,A MVI D,0 DAD D ;ADD IT SHLD ACC ;TO ACC RET MP100: MOV E,L ;HL*100 MOV D,H DAD H! DAD D! DAD H! DAD H DAD H! DAD D! DAD H MOV A,H ORA A JP NOCARY ;HI BYTE SET ? MVI A,1 ;YES STA ACC+2 NOCARY: DAD H RET ; TABLES MONTHS: DB 'JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY ' DB 'AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER ' DAYS: DB 'MON TUE WED THU FRI SAT SUN ' MDAYS: DB 31,28,31,30,31,30,31,31,30,31,30,31 ; BUFFERED INPUT ROUTINE INPUT: CALL OUTROW ;PROMPT MESSAGE TO CRT LXI H,PRMT ;START OF PROMPT MES CALL OUTROW ;OUTPUT IT LXI H,PBUFER ;SET POINTER SHLD IOADDR ;FOR INPUT SUB A ;ZERO STA IOCNTR ;COUNTER CALL CLR131 ;CLEAR BUFFER INLP: MVI C,CONIN ;CONSOLE IN CALL CPMENT ;CALL CPM MOV B,A ;SAVE INPUT CHAR CPI 8 ;CONTROL H JZ RUBOUT ;IF IT IS CPI 255 ;SAME JZ RUBOUT CPI 13 ;CR LDA IOCNTR ;GET CHAR CNT MOV E,A ;SAVE FOR EVALUE MVI D,0 ;NO DECIMAL PLACES LXI H,PBUFER ;BUFF ADDRESS FOR EVALUE RZ ;RET IF CR LAST CHAR CPI 80H ;128 CHAR MAX RZ ;IF MAX INR A ;ADV CNTR STA IOCNTR ;BACK LHLD IOADDR ;RECALL POINTER MOV M,B ;STORE CHAR IN BUFFER INX H ;ADV POINTER SHLD IOADDR ;SAVE JMP INLP ;NEXT CHAR RUBOUT: MVI E,20H ;SPACE MVI C,CONOUT ;SET CONSOLE LDA IOCNTR ;GET COUNTER ORA A ;STATUS JNZ RBCHR ;COLS LEFT ? CALL CPMENT ;NO -OUT OF SPACE JMP INLP ;NEXT CHAR RBCHR: DCR A ;CNTR-1 STA IOCNTR ;SAVE CALL CPMENT ;OUT SPACE MVI E,8 ;CNTRL H MVI C,CONOUT CALL CPMENT LHLD IOADDR ;GET ADDRESS DCX H ;PNTR-1 MVI M,20H ;BLANK TO BUFFER SHLD IOADDR ;REPLACE JMP INLP ;NEXT CLSCRN: LXI H,CLRSEQ ;CLEAR SCREEN ; OUTPUT CHAR STRING TO CRT OR PRINTER OUTROW: SHLD IOADDR ;SAVE ADDRESS OUT1: LHLD IOADDR ;RECALL ADDR MOV A,M ;GET CHAR INX H ;ADV POINTER SHLD IOADDR ;SAVE CPI T ;TERMINATE CHAR ?? RZ ;YES ORA A ;STATUS JM OUT2 ;SPACE COUNT ? CALL DEVOUT ;OUTPUT CHAR JMP OUT1 ;NEXT OUT2: ANI 7FH ;MASK OFF TOP BIT STA IOCNTR ;SET COUNT OUT3: MVI A,20H ;SPACE CALL DEVOUT ;OUTPUT IT LXI H,IOCNTR ;POINT TO CNTR DCR M ;CNTR-1 JZ OUT1 ;LAST SPACE JMP OUT3 ;NEXT PRMT: DB ': ? ',T ;PROMPT MESS ; MOVE AND PRINT MVPRNT: CALL MOVE ;MOVE BLOCK ; PRINT BUFFER CONTENTS PRNTBF: LXI H,PBUFER ;GET BUFF LOC CALL OUTROW ;OUTPUT LINE JMP CRLF ; CLEAR BUFFERS CLR131: MVI B,131 ;CLEAR LONG LINE JMP CLRBUF CLR79: MVI B,79 ;SHORT LINE CLRBUF: LXI H,PBUFER ;CLEAR OUTPUT BUFFER PFILR: MVI M,20H INX H DCR B JNZ PFILR MVI M,0FFH RET CLBUF1: LXI H,PBUFF CLB1: MVI B,16 JMP PFILR FFEED: LXI H,FFSEQ ;FORM FEED JMP OUTROW DBCRLF: CALL CRLF ;DOUBLE CARRIAGE RETURN CRLF: MVI A,13 ;CR CALL DEVOUT ;OUT MVI A,10 ;LF ; OUTPUT CHARACTER DEVOUT: MOV E,A ;CHAR TO E REG FOR CP/M MVI C,CONOUT ;FOR CONSOLE JMP CPMENT ;TO CP/M ENTRY ; PRINTER ON/OFF SETPRN: MVI A,LSTOUT ;PRINTER ON JMP SETDEV SETCON: MVI A,CONOUT ;PRINTER OFF SETDEV: STA DEVOUT+2 RET ; CHAIN PROGRAM INTO TRANSIENT AREA ; HL = LOC OF FCB 8 BYTE NAME CHAIN: LXI D,PBUFER ;LOC OF FCB FOR CHAIN MVI B,8 ;CNTR XCHG CALL MOVE ;TRANS NAME LXI D,COMCHR ;SET LOC OF ' COM' MVI B,4 CALL MOVE MVI E,28 ;SET COUNT CALL CLRBAK ;CLEAR REST OF BLOCK LXI D,PBUFER ;FCB LOC MVI C,OPNFIL ;CP/M OPEN COMM CALL CPMENT CPI T ;CHECK FOR ERROR JZ NOTFND ;ERROR LXI H,TPAREA ;START LOC SHLD ADRSET+1 LDA PBUFER+15 ;NO. OF SECTORS STA IOCNTR XCHG CHREAD: CALL ADRSET ;SET ADDRESS LXI D,PBUFER ;FCB LOC MVI C,RDSEQ ;READ SEQ COMM CALL CPMENT ;READ CALL ADVCHN ;ADVANCE & COUNT JNZ CHREAD ;IF NOT THRU POP H ;CLEAR STACK JMP TPAREA ;GO EXECUTE PROGRAM NOTFND: CALL DBCRLF ;SKIP 2 LINES LXI H,NOFILE ;OUTPUT 'NOT SUPPLIED' JMP INPUT ; OPEN FILE FOR READ/WRITE ; DE = LOC OF FILENAME ; HL = LOC OF CHANNEL FCB OPEN: SHLD IOADDR ;SAVE FCB LOC MVI B,12 ;COUNT CALL MOVE MVI E,28 ;SET CNTR CALL CLRBAK ;ZERO REST OF BLOCK MVI C,OPNFIL ;OPEN COMM LHLD IOADDR ;RECALL XCHG CALL CPMENT ;TRY OPEN CPI T RNZ ;IF SUCCESS LHLD IOADDR XCHG MVI C,MKFILE ;OPEN NEW FILE JMP CPMENT ; CLOSE FILE CLOSE: MVI C,CLOSFL ;DE = ADDR OF FCB JMP CPMENT ; GET 512 BYTE RECORD ; HL = RECORD NUMBER ; C = CHAN# 0-7 GETREC: CALL DSKSET ;SETUP GETLP: CALL ADRSET ;SET BUFF ADDR MVI C,RDRAND ;COMM CALL ADVADR ;GET 128 BYTE SECTOR JNZ GETLP ;LAST ? RET ;YES ; PUT 512 BYTE RECORD ; HL = RECORD NUMBER ; C = CHAN# 0-7 PUTREC: CALL DSKSET ;SETUP PUTLP: CALL ADRSET ;SET BUFF ADDR MVI C,WTRAND ;COMM CALL ADVADR ;PUT 128 BYTE SECTOR JNZ PUTLP ;LAST ? RET ;RET ; SET BUFF ADDRESS FOR TRANSFER ADRSET: LXI D,CHBUFR ;DE = BUFFER ADDRESS MVI C,SETDMA ;COMM CALL CPMENT ;SET IT GETFCB: LXI D,CHNFCB ;DE = FCB ADDR RET ; ADVANCE ADDR 128, REC 1 & CNTR-1 ADVADR: CALL CPMENT ;DO READ OR WRITE ADVREC: LHLD CHNFCB+33 ;LOC OF CURRENT REC INX H ;ADVANCE ADVPUT: SHLD CHNFCB+33 ;REPLACE ADVCHN: LHLD ADRSET+1 ;ADDR +128 LXI D,128 DAD D SHLD ADRSET+1 ;REPLACE LXI H,IOCNTR ;COUNTER LOC DCR M ;CNTR-1 RET ; SETUP DISK ACCESS PARAMETERS DSKSET: DCX H ;REC-1 DAD H! DAD H ;X4 PUSH H ;SAVE MOV A,C ;CHAN*40 ADD A MOV B,A ADD A! ADD C! ADD A! ADD A! ADD A! MOV E,A ;TO DE MVI D,0 LXI H,CHNFCB DAD D SHLD GETFCB+1 ;SAVE FCB LOC LXI D,33 ;OFFSET DAD D ;DE+HL TO HL SHLD ADVREC+1 ;SAVE SHLD ADVPUT+1 POP D ;RECALL REC# MOV M,E ;PUT IN FCB INX H MOV M,D MVI C,0 LXI H,CHBUFR ;START OF BUFFERS DAD B ;+CHAN*512 SHLD ADRSET+1 ;SAVE MVI A,4 STA IOCNTR ;SET COUNTER RET COMPON: LXI H,CMSEQ ;COMPRESSED PRINT JMP OUTROW COMPOF: LXI H,DCMSEQ ;COMP PRINT OFF JMP OUTROW CONBYT: DB 6 ;SYS CONTROL BYTE (6 AND 7 ALLOWED) SIGNF: DB 0 ;SIGN FLAG & DAY NUM: DB 0 ;TEMP DIGIT & MONTH DECF: DB 0 ;DECIMAL FLAG & YEAR OPERAND: DS LENGTH ACC: DS LENGTH HIACC: DS LENGTH PBUFF: DS 16 PBFEND: DB 255 IOADDR: DW 0 ;CURRENT LOC OF INPUT/OUTPUT CHAR IOCNTR: DB 0 ;CURRENT CNT OF INPUT/OUTPUT CHARS PBUFER: DS 132 ;PRINTER BUFFER & FCB FOR CHAIN COMCHR: DB ' COM' ;COM TYPE FOR CHAIN CURSEQ: DB 27,61,31,31,T ;CURSOR SEQUENCE CLRSEQ: DB 0,0,26,T ;SCREEN CLEAR SEQUENCE FFSEQ: DB 0,0,12,T ;FORM FEED SEQUENCE CMSEQ: DB 27,55,0,0,T ;COMPRESSED PRINT DCMSEQ: DB 27,54,0,0,T ;DECOMP PRINT BLNKON: DB 27,126,66,T ;BLINK ON SEQUENCE (INTERTEC DATA) BLNKOF: DB 27,126,98,T ;BLINK OFF SEQ NOFILE: DB 'NOT SUPPLIED IN THIS PACKAGE' RETMES: DB ' -PRESS RETURN TO CONTINUE',T END