Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug032.ark / TBASICA2.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 46.1 KB | 1,912 lines

* RTN. B.11 * FIXED POINT MULTIPLY * (HL) TIMES (DE), PRODUCT IN WORK1 FMUL PUSH D ;SAVE REGISTERS PUSH H XCHG LXI D,TEMP2 ;MOVE OPERANDS INTO TEMP1 AND TEMP2 LXI B,6 CALL MVDN POP H ;GET OTHER ADDRESS BACK PUSH H LXI D,TEMP1 CALL MVDN LXI H,WORK1+11 ; GET ADDRESS TO STORE PRODUCT LDA TEMP1+5 ;GET MULTIPLIERS MOV C,A LDA TEMP2+5 MOV B,A CALL MUL2 ;GET PARTIAL PRODUCT MOV M,C ;STORE IN WORK1 DCX H ;UPDATE MOV M,B ;STORE DCX H LDA TEMP1+4 ;GET MULTIPLIERS MOV C,A LDA TEMP2+4 MOV B,A CALL MUL2 ;GET PARTIAL PRODUCT MOV M,C ;STORE IN WORK1 DCX H MOV M,B DCX H LDA TEMP1+3 ;GET MULTIPLIERS MOV C,A LDA TEMP2+3 MOV B,A CALL MUL2 ;GET PARTIAL PRODUCT MOV M,C ;STORE IN WORK1 DCX H MOV M,B DCX H LDA TEMP1+2 ;GET MULTIPLIERS MOV C,A LDA TEMP2+2 MOV B,A CALL MUL2 ;GET PARTIAL PRODUCT MOV M,C ;STORE IN WORK1 DCX H MOV M,B INX H ;GET READY FOR ADDING INX H LDA TEMP1+3 ;GET MULTIPLIERS MOV C,A LDA TEMP2+2 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+2 ;GET MULTIPLIERS MOV C,A LDA TEMP2+3 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT INX H ;GET NEXT COLUMN LDA TEMP1+2 ;GET MULTIPLIERS MOV C,A LDA TEMP2+4 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+4 ;GET MULTIPLIERS MOV C,A LDA TEMP2+2 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT INX H ;GET NEXT COLUMN LDA TEMP1+2 ;GET MULTIPLIERS MOV C,A LDA TEMP2+5 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+3 ;GET MULTIPLIERS MOV C,A LDA TEMP2+4 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+4 ;GET MULTIPLIERS MOV C,A LDA TEMP2+3 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+5 ;GET MULTIPLIERS MOV C,A LDA TEMP2+2 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT INX H ;GET NEXT COLUMN LDA TEMP1+3 ;GET MULTIPLIERS MOV C,A LDA TEMP2+5 MOV B,A CALL FMUL1 ;ADD PARTIAL PRODUCT LDA TEMP1+5 ;GET MULTIPLIERS MOV C,A LDA TEMP2+3 MOV B,A CALL FMUL1 INX H ;GET LAST COLUMN LDA TEMP1+4 ;GET MULTIPLIERS MOV C,A LDA TEMP2+5 MOV B,A CALL FMUL1 LDA TEMP1+5 ;GET MULTIPLIERS MOV C,A LDA TEMP2+4 MOV B,A CALL FMUL1 POP H ;RESTORE REGISTERS POP D RET ;DONE!!! FMUL1 CALL MUL2 ;GET PRODUCT PUSH H ;SAVE INDEX MOV A,C ;ADD TO WORK1 ADD M DAA ;BCD ADJUST MOV M,A ;STUFF IT BACK FMUL3 DCX H ;GET NEXT BYTE ADDRESS MOV A,B ;ADD IT ADC M DAA ;BCD ADJUST MOV M,A ;STUFF IT BACK JNC FMUL2 ;DONE MVI B,0 ;CLEAR B JMP FMUL3 ;LOOP TO PROPAGATE CARRY FMUL2 POP H ;RESTORE INDEX RET ;GO BACK * RTN. B.12 * FLOATING POINT MULTIPLY * (HL) TIMES (DE) TO (BC) FLML PUSH B ;SAVE DESTINATION CALL FMUL ;MULTIPLY MANTISSA'S LDA WORK1+4 ;GET BYTE TO SEE WHERE TO ADD ROUNDING ANI 0F0H ;STRIP OFF UPPER DIGIT MVI A,50H ;GET ROUNDING NUMBER JNZ FLML1 ;OK, WE GOT THE RIGHT ONE MVI A,05H ;REPLACE WITH THE LOWER 5 FLML1 PUSH H ;SAVE REGISTER LXI H,WORK1+8 ;GET READY TO ADD ROUNDING FLML2 ADD M ;ADD A BYTE DAA ;BCD ADJUST MOV M,A ;PUT IT BACK DCX H ;SET UP FOR NEXT BYTE MVI A,1 ;SET UP FOR CARRY PROPAGATE JC FLML2 ;LOOP IF CARRY UP LXI H,WORK1 ;SET UP TO CLEAR TOP OF BUFFER MVI A,4 ;NUMBER OF BYTES CALL ZERO ;CLEAR IT POP H ;RESTORE REGISTER PUSH D ;SAVE LOCATION LXI D,WORK1 ;GET LOCATION OF WORK1 TO DE CALL NORM ;NORMALIZE WORK1 POP H ;GET LOCATION BACK PUSH D ;SAVE MANTISSA LOCATION MOV D,M ;GET SIGNS AND EXPONENTS TO DE INX H MOV E,M XRA A ;CLEAR A STA MERR ;CLEAR THE ERROR FLAG CALL EXAD ;ADD THE EXPONENTS LXI D,1 ;SET UP TO CORRECT NORMALIZATION CALL EXAD ;CORRECTION POP D ;GET BACK MANTISSA LOCATION LDA TEMP1 ;GET SIGNS BYTE LXI H,TEMP2 ;GET ADDRESS OF THE OTHER XRA M ;COMPUTE SIGN OF RESULT ANI 80H ;STRIP OFF ALL BUT SIGN BIT ORI 03H ;PUT IN ID BITS MOV H,A ;SAVE IT MOV A,B ;GET EXPONENT SIGN ANI 40H ;STRIP ALL BUT EXPONENT SIGN ORA H ;PUT IN OTHER BITS POP H ;GET DESTINATION MOV M,A ;STORE SIGNS BYTE INX H MOV M,C ;STORE EXPONENT BYTE INX H XCHG ;SWAP ADDRESSES FOR MOVE LXI B,4 ;NUMBER OF BYTES TO MOVE CALL MVDN ;MOVE THE MANTISSA IN XCHG ;SEE IF IT'S A FLOATING ZERO MOV A,M DCX H DCX H ANA A RNZ ;NOPE XCHG LXI H,ZERO0 CALL MOVE RET ;DONE * RTN. B.51 * SQUARE ROOT EXTRACTION * SQR(HL) TO (DE) SQUR PUSH D ;SAVE DESTINATION PUSH H ;SAVE N MOV A,M ANA A ;SEE IF THIS IS A MINUS NUMBER MVI B,39H ;JUST IN CASE JM ERROR ;CAN'T HAVE A SQUARE ROOT OF A MINUS NUMBER, ROCK! LXI D,TMP5 ;SET FIRST GUESS TO N LXI B,6 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN, BOYS LXI D,ZERO0 ;CHECK FOR INPUT=0 CALL CMPR JZ SQUR2 ;SURE IS SQUR1 LXI H,TMP5 ;TMP6=TMP5*TMP5 LXI B,TMP6 MOV E,L MOV D,H CALL MULER LXI B,TMP6 ;COMPUTE DELTA Y POP H ;GET N PUSH H ;SAVE IT AGAIN MOV E,C MOV D,B CALL SUBER LXI B,TMP6 ;COMPUTE DELTA X BY DELTA Y/SLOPE MOV L,C MOV H,B LXI D,TWO22 CALL DIVER LXI B,TMP6 MOV L,C MOV H,B LXI D,TMP5 CALL DIVER ;DIVIDE BY GUESS CALL TRMN1 ;CHECK FOR DONENESS JC SQUR2 ;AHHH, DONE TO A T LXI B,TMP5 LXI D,TMP6 ;ADD DELTA X FOR NEXT GUESS MOV L,C MOV H,B CALL ADDER JMP SQUR1 ;TRY AGAIN SQUR2 POP H ;CLEAN UP THE STACK POP D ;GET THE DESTINATION LXI H,TMP5 ;GET THE SOURCE LXI B,6 ;NUMBER OF BYTES MOV A,M ;CLEAR ANY MINUS SIGN ANI 7FH MOV M,A CALL MOVE ;MOVE IT IN RET ;ALL DONE! * RTN. B.13 * UNPACK PACKED BCD * HL = SOURCE ADDRESS * DE = DESTINATION ADDRESS * B = NUMBER OF SOURCE BYTES TO UNPACK UNPK MOV A,M ;GET A PACKED BYTE MOV C,A ;SAVE IT IN C RLC ;GET UPPER DIGIT TO BOTTOM RLC RLC RLC ANI 0FH ;STRIP OFF UPPER DIGIT STAX D ;STORE TO DESTINATION INX D ;UPDATE INDEX MOV A,C ;GET PACKED BYTE AGAIN ANI 0FH ;STRIP OFF UPPER DIGIT STAX D ;STORE TO DESTINATION INX D ;UPDATE INDEXES INX H DCR B ;CHECK BYTES COUNTER JNZ UNPK ;LOOP FOR MORE BYTES TO UNPACK RET ;ALL DONE * RTN. B.14 * POWERS OF TWO GENERATOR * ASSUMES NUMBER IN WORK 2+6 THROUGH WORK 2+11 * POWERS OF TWO TO WORK 1+0 THROUGH WORK 2+5 PWER MVI B,18 ;INITIALIZE BYTE COUNTER LXI H,WORK2+11 ;INITIALIZE SOURCE COUNTER LXI D,WORK2+5 ;INITIALIZE DESTINATION COUNTER XRA A ;CLEAR CARRY PWER1 MOV A,M ;GET A BYTE ADC A ;DOUBLE IT, WITH CARRY DAA ;BCD ADJUST STAX D ;STORE IT TO DESTINATION DCX H ;UPDATE INDEXES DCX D DCR B ;CHECK BYTES COUNTER JNZ PWER1 ;LOOP FOR MORE ADDING TO DO RET ;DONE * RTN. B.15 * DIVIDE TEST AND SUBTRACT * HL = FIRST DIGIT OF TEST NUMBER * DE = FIRST DIGIT OF DIVIDEND * C = DIGIT OF QUOTIENT SO FAR * QFLAG = NUMBER OF DIVISOR DIGITS + 1 * SIGN FLAG IS SET ON EXIT IF NO SUBTRACT WAS PERFORMED TSTR PUSH D ;SAVE DIVIDEND INDEX LDA QFLAG ;GET NUMBER OF BYTES TO TEST DCR A ;CORRECT FOR LAST ADDRESS OFFSET MOV B,A ;PUT IT IN B TSTR1 LDAX D ;GET A DIVIDEND BYTE SUB M ;COMPARE WITH DIVISOR POWER JM TSTR4 ;JUMP IF DIVIDEND SMALLER JNZ TSTR6 ;JUMP IF DIVIDEND LARGER INX D ;UPDATE INDEXES INX H DCR B ;TEST BYTES COUNTER JNZ TSTR1 ;LOOP FOR MORE TESTING TSTR7 LDA QFLAG ;OK, NUMBER FITS, SO SUBTRACT IT MOV B,A ;PUT NUMBER OF BYTES TO SUBTRACT IN B XRA A ;CLEAR CARRY FLAG TSTR2 DCX H ;UPDATE INDEXES DCX D LDAX D ;GET DIVIDEND BYTE SBB M ;SUBTRACT POWER OF DIVISOR JP TSTR3 ;JUMP IF NO BORROW ADI 10 ;CORRECT FOR DECIMAL TSTR3 STAX D ;STORE RESULT DCR B ;CHECK BYTES COUNTER JNZ TSTR2 ;LOOP FOR MORE BYTES TO SUBTRACT TSTR4 POP D ;RESTORE DIVIDEND INDEX RET ;DONE TSTR6 MOV A,L ;ADD OFFSET TO INDEXES ADD B MOV L,A ;PUT IT BACK JNC TSTR5 ;NO CARRY INR H ;PROPAGATE CARRY TSTR5 MOV A,E ;AND THE OTHER ONE ADD B MOV E,A JNC TSTR7 INR D JMP TSTR7 * RTN. B.16 * DIVIDE MANTISSAS FOR FLOATING POINT DIVIDE * ASSUMES: * WORK4 HAS POWERS OF TWO OF DIVISOR * WORK3 HAS UNPACKED DIVIDEND IN +1 THROUGH +8 * QUOTIENT WILL BE IN WORK5 ON EXIT, +0 WILL BE * NONZERO, QFLAG WILL BE ZERO IF FIRST DIGIT * OF QUOTIENT WAS ZERO DIV1A MVI A,0FFH ;SET A NONZERO STA ZFRST ;SET ZFRST NONZERO LXI D,WORK3 ;GET FIRST ADDRESS OF DIVIDEND XRA A ;CLEAR A AND SET ZERO FLAG LXI H,WORK5 ;GET ADDRESS OF FIRST QUOTIENT DIGIT DIV10 PUSH H ;SAVE REGISTERS PUSH PSW MVI C,0 ;SET QUOTIENT DIGIT TO 0 LXI H,WORK4+2 ;GET X8 ADDRESS CALL TSTR ;CHECK IT JM DIV11 ;JUMP IF IT DIDN'T FIT MVI A,8 ;MOVE BIT INTO C IF IT DID FIT ORA C MOV C,A DIV11 LXI H,WORK4+14 ;GET X4 ADDRESS CALL TSTR ;CHECK IT JM DIV12 ;JUMP IF IT DIDN'T FIT MVI A,4 ;MOVE BIT INTO C IF IT DID FIT ORA C MOV C,A DIV12 LXI H,WORK4+26 ;GET X2 ADDRESS CALL TSTR ;CHECK IT JM DIV13 ;JUMP IF IT DIDN'T FIT MVI A,2 ;MOVE BIT INTO C IF IT DID FIT ORA C MOV C,A DIV13 LXI H,WORK4+38 ;GET X1 ADDRESS CALL TSTR ;CHECK IT JM DIV14 ;JUMP IF IT DIDN'T FIT MVI A,1 ;MOVE BIT INTO C IF IT DID FIT ORA C MOV C,A DIV14 INX D ;UPDATE DIVIDEND INDEX POP PSW ;RESTORE REGISTER POP H JZ DIV15 ;JUMP IF NO SIGNIFICANT DIGITS YET DIV16 MOV M,C ;STORE QUOTIENT DIGIT INR A ;INCREMENT SIGNIFICANT DIGIT COUNTER INX H ;INCREMENT QUOTIENT INDEX CPI 9 ;CHECK TO SEE IF WE ARE DONE JNZ DIV10 ;NOPE, SO LOOP FOR MORE RET ;DONE DIV15 DCR C ;CHECK FOR C = 0 INR C ;RESTORE VALUE JNZ DIV16 ;NOPE, WASN'T 0, SO STORE IT STA ZFRST ;OOPS, GOT AN INSIGNIFICANT 0 JMP DIV10 ;LOOP FOR NEXT DIGIT * RTN. B.17 * FP DIVIDE * (HL)/(DE) TO (BC) DIV2A PUSH B ;SAVE PARAMETERS PUSH H PUSH D INX D ;CHECK FOR DIVIDE BY ZERO INX D LDAX D ;GET THE MSD OF MANTISSA ANA A ;SET FLAGS JZ DERR ;YUP, SURE WAS ZERO MVI A,10 ;SET UP NUMBER OF DIGITS FLAG STA QFLAG XRA A ;CLEAR SOME BYTES STA MERR ;CLEAR ERROR FLAG STA WORK2+6 STA WORK2+7 MVI A,18 ;ZERO OUT 18 BYTES PUSH H ;SAVE HL LXI H,WORK3 CALL ZERO POP H ;RESTORE HL LXI D,WORK3+1 ;GET ADDRESS FOR UNPACKED DIVIDEND MVI B,4 ;NUMBER OF BYTES INX H ;GET MANTISSA ADDRESS INX H MOV A,M ;GET THE MSD ANA A ;SET FLAGS JNZ DIV2G ;JUMP IF DIVIDEND IS NOT ZERO POP H ;CLEAN UP STACK POP H POP H ;GET DESTINATION ADDRESS MVI M,3 ;STORE FLOATING POINT BITS MVI A,5 ;NUMBER OF BYTES INX H ;GET EXPONENT LOCATION CALL ZERO ;ZERO IS STORED RET ;DONE.... DIV2G CALL UNPK ;UNPACK IT XRA A ;CLEAR OUT THE TRAILING BYTE STAX D POP H ;GET DIVISOR ADDRESS PUSH H ;SAVE IT AGAIN INX H ;GET MANTISSA ADDRESS INX H LXI D,WORK2+8 ;GET ADDRESS TO STORE IT LXI B,4 ;NUMBER OF BYTES TO MOVE CALL MVDN ;MOVE IT CALL PWER ;COMPUTE X2,X4,X8 LXI H,WORK1 ;SET UP TO UNPACK POWERS OF TWO OF DIVISOR LXI D,WORK4-1 MVI B,24 ;NUMBER OF BYTES TO UNPACK CALL UNPK ;UNPACK IT CALL DIV1A ;DIVIDE THE MANTISSAS POP H ;GET LOCATIONS AGAIN POP D PUSH D ;SAVE THEM PUSH H MOV B,M ;GET SIGNS AND EXPONENTS INX H MOV C,M XCHG MOV D,M INX H MOV E,M MVI A,40H ;CHANGE EXPONENT SIGN XRA B MOV B,A ;PUT IT BACK CALL EXAD ;ADD EXPONENTS LDA ZFRST ;CHECK TO SEE IF THERE WAS A 0 FIRST ANA A ;SET FLAGS JNZ DIV22 ;NOPE, SO SKIP THE EXPONENT OFFSET LXI D,4001H ;SET UP A -1 EXPONENT CALL EXAD ;ADD IN THE OFFSET DIV22 POP H ;GET LOCATIONS BACK POP D LDAX D ;GET MANTISSA SIGN XRA M ANI 80H ;STRIP OFF THE SIGN PUSH PSW MOV A,B ;GET COMPUTED SIGN ANI 7FH ;STRIP OFF ALL BUT SIGN ORI 3 ;SET IN FLOATING POINT BITS MOV B,A ;PUT IT BACK POP PSW ORA B ;PUT THE TWO TOGETHER POP H ;GET DESTINATION MOV M,A ;STORE SIGNS BYTE INX H ;UPDATE INDEX MOV M,C ;STORE EXPONENT INX H ;GET MANTISSA LOCATION XCHG ;SET UP FOR PACK XRA A ;SET UP FOR ROUNDING STA WORK5-1 ;CLEAR EXTRA DIGIT MVI A,5 ;ROUNDING CONSTANT LXI H,WORK5+8 ;GET ADDRESS OF LSD+1 ANA A ;CLEAR CARRY DIV2B ADC M ;ADD A BYTE CPI 10 ;CHECK FOR OVERFLOW JM DIV2C ;SKIP CORRECTION IF NO OVERFLOW SBI 10 ;OFFSET DIV2C CMC ;ADJUST CARRY MOV M,A ;STORE THE RESULT MVI A,0 ;CLEAR A DCX H ;UPDATE INDEX JC DIV2B ;LOOP FOR MORE CARRY PROPAGATE LXI H,WORK5-1 ;SET UP SOURCE ADDRESS MOV A,M ;GET THE BYTE ANA A ;CHECK FOR ZERO JNZ DIV2D ;YUP, IT'S ZERO, SO DON'T CORRECT INX H ;CORRECT FOR REAL FIRST DIGIT DIV2D MVI C,4 ;NUMBER OF BYTES TO PACK CALL PACK ;PACK THEM RET * RTN. B.18 * PACK BCD DIGITS * HL = SOURCE * DE = DESTINATION * C = NUMBER OF BYTES TO PACK PACK MOV A,M ;GET A BYTE RLC ;SHIFT INTO UPPER HALF RLC RLC RLC INX H ;UPDATE INDEX ORA M ;OR IN THE LOWER DIGIT STAX D ;STORE IT TO DESTINATION INX H ;UPDATE INDEXES INX D DCR C ;CHECK BYTES COUNTER JNZ PACK ;LOOP IF MORE TO DO RET ;DONE DERR MVI A,4 ;SET ERROR FLAG STA MERR POP D ;CLEAN UP STACK POP H POP B RET ;ERROR RETURN * RTN. B.19 * INTEGER ADD AND SUBTRACT * (HL)+-(DE)=(BC) ISUB PUSH B ;SUBTRACT ENTRANCE PUSH H ;SAVE REGISTERS XCHG ;SET UP TO MOVE SUBTRACTED VALUE LXI D,TEMP1 ;GET DESTINATION ADDRESS LXI B,6 ;NUMBER OF BYTES CALL MVDN ;MOVE IT MVI A,80H ;MASK MANTISSA SIGN BIT XCHG ;PUT THE ADDRESS IN HL XRA M ;CHANGE THE SIGN BIT MOV M,A ;PUT IT BACK POP D ;RESTORE REGISTERS POP B IADD XRA A ;CLEAR A STA ASFLG ;CLEAR FLAGS STA MERR PUSH B ;SAVE DESTINATION PUSH H ;SAVE ONE SOURCE LXI H,WORK1 ;SET UP TO CLEAR WORKING REGISTERS MVI A,24 ;NUMBER OF BYTES TO CLEAR CALL ZERO ;CLEAR THEM POP H ;RESTORE THE SOURCE LDAX D ;GET A SIGNS BYTE XRA M ;GET BITS DIFFERENT ANI 80H ;MASK OUT ALL BUT MANTISSA SIGN JZ IADD1+2 ;JUMP IF BOTH SIGNS ARE THE SAME MOV A,M ;GET SIGNS BYTE FROM (HL) ANI 80H ;STRIP OFF SIGN BIT JNZ IADD2 ;JUMP IF (HL) IS MINUS XCHG ;SWAP IADD2 PUSH D ;SAVE LOCATIONS PUSH H LXI D,WORK1 ;GET ADDRESS TO MOVE MINUS NUMBER TO LXI B,6 ;NUMBER OF BYTES CALL MVDN ;MOVE IT PUSH D ;SAVE ADDRESS XCHG ;ADDRESS TO HL INX H ;GET MANTISSA LOCATION MVI C,5 ;NUMBER OF BYTES TO COMPLEMENT CALL CMPL ;GET 10'S COMPLEMENT POP H ;GET BACK THE ADDRESS XTHL ;PUT CORRECT NUMBER ON THE STACK MVI A,0FFH ;SET ASFLAG TO INDICATE A SUBTRACT JC IADD1 ;DON'T INDICATE SUBTRACT IF 'TWAS A ZERO STA ASFLG IADD1 POP H ;GET LOCATIONS POP D PUSH D ;SAVE THEM AGAIN PUSH H INX H ;GET MANTISSA LOCATIONS INX D LXI B,WORK2+1 ;GET LOCATION TO STORE RESULT MVI A,5 ;NUMBER OF BYTES CALL FXAD ;ADD THE MANTISSAS POP H ;CLEAN UP STACK POP H ;GET REFERENCE SIGN XRA M ;CHANGE THE SIGN, IF NECCESARY POP H ;GET LOCATION FOR RESULT OF ADDITION MOV M,A ;STORE SIGNS BYTE INX H ;GET MANTISSA LOCATION XCHG ;SET UP FOR MOVE LXI H,WORK2+1 LXI B,5 ;NUMBER OF BYTES CALL MVDN ;MOVE IT LDA WORK2 ;GET ANY OVERFLOW ANA A ;SET FLAGS RZ ;NO OVERFLOW STA MERR ;SET OVERFLOW BIT RET ;DONE * RTN. B.20 * INTEGER MULTIPLY * (HL)*(DE)=(BC) IMUL LDAX D ;GET SIGNS BYTES XRA M ;GET DIFFERENT BITS ORI 2 ;SET ID BITS STAX B ;STORE TO RESULT LOCATION INX B ;GET MANTISSA STORE PUSH B ;SAVE DESTINATION INX D ;GET MANTISSA LOCATIONS INX H XRA A ;CLEAR A STA MERR ;CLEAR ERROR FLAG PUSH D ;SAVE MANTISSA LOCATIONS PUSH H DCX H ;GET ADDRESSES FOR FIRST MULTIPLY DCX D CALL FMUL ;MULTIPLY POP H ;GET MANTISSA LOCATIONS BACK POP D LDAX D ;CHECK FOR NONZERO BYTES IN UPPER ORA M JZ IMUL1 ;BOTH ZERO, SO NO MULTIPLY NEEDED XRA M ;SEE IF HL WAS THE NONZERO ONE JNZ IMUL2 ;JUMP IF HL WAS ZERO XCHG ;MAKE HL THE ZERO ONE IMUL2 MVI B,4 ;NUMBER OF BYTES TO CHECK IMUL4 MOV A,M ;GET A BYTE ANA A ;SET FLAGS JNZ IMUL3 ;JUMP IF GUARANTEED OVERFLOW INX H ;UPDATE INDEX DCR B ;CHECK BYTES COUNTER JNZ IMUL4 ;LOOP FOR MORE BYTES TO CHECK MOV B,M ;GET A BYTE TO MULTIPLY XCHG MOV C,M ;GET ANOTHER BYTE CALL MUL2 ;MULTIPLY THEM LXI H,WORK1+7 ;GET ADDRESS TO ADD TO MOV A,M ;GET A BYTE ADD C ;ADD DAA ;BCD ADJUST MOV M,A ;STICK IT BACK DCX H ;GET ADDRESS FOR NEXT BYTE MOV A,M ;GET IT ADC B ;ADD DAA ;BCD ADJUST MOV M,A ;STICK IT BACK DCX H ;CHECK BYTES FOR ALL ZEROS ORA M DCX H ORA M DCX H ORA M JZ IMUL1 ;JUMP IF ALL ZEROS (NO OVERFLOW) IMUL3 MVI A,1 ;SET THE OVERFLOW BIT STA MERR IMUL1 POP D ;GET DESTINATION ADDRESS LXI H,WORK1+7 ;GET SOURCE LXI B,5 ;NUMBER OF BYTES CALL MVDN ;MOVE IT MVI B,3 ;CHECK FOR OVERFLOW XRA A IMUL8 DCX H ;UPDATE INDEX ORA M ;SET BITS DCR B ;UPDATE COUNTER JNZ IMUL8 ;MORE BYTES TO CHECK ANA A ;CHECK FOR OVERFLOW RZ ;IT'S OK MVI A,1 ;STORE OVERFLOW INDICATION STA MERR RET ;DONE * RTN. B.21 * INTEGER DIVIDE * (HL)/(DE)=(BC) IDIV PUSH B ;SAVE REGISTERS PUSH D PUSH H LDAX D ;COMPUTE NEW SIGN BYTE XRA M ;GET DIFFERENT BITS ORI 2 ;SET ID BITS STAX B ;STORE TO RESULT LOCATION MVI A,11 ;SET UP QFLAG STA QFLAG MVI B,5 ;GET NUMBER OF MANTISSA BYTES XRA A ;CLEAR A XCHG ;ADDRESS TO HL IDIV1 INX H ;UPDATE INDEX ORA M ;SEE IT BYTE IS ZERO JNZ IDIV2 ;JUMP IF NOT ZERO DCR B ;CHECK BYTES COUNTER JNZ IDIV1 ;LOOP FOR MORE BYTES TO CHECK POP H ;CLEAN UP STACK POP H POP H MVI A,4 ;SET ERROR FLAG FOR DIVIDED BY ZERO STA MERR RET ;ERROR EXIT IDIV2 XRA A ;CLEAR A STA MERR ;CLEAR ERROR FLAG STA WORK2+6 ;CLEAR BYTES MVI A,18 ;CLEAR OUT QUOTIENT REGISTER LXI H,WORK3 CALL ZERO POP H ;GET DIVIDEND ADDRESS LXI D,WORK3+1 ;GET DESTINATION ADDRESS MVI B,5 ;NUMBER OF BYTES TO UNPACK INX H ;GET MANTISSA ADDRESS CALL UNPK ;UNPACK POP H ;GET DIVISOR ADDRESS INX H ;GET MANTISSA ADDRESS LXI D,WORK2+7 ;GET ADDRESS TO MOVE IT TO LXI B,5 ;NUMBER OF BYTES TO MOVE CALL MVDN ;MOVE IT IN CALL PWER ;GENERATE POWERS OF TWO OF DIVISOR LXI H,WORK1 ;SET UP TO UNPACK INTO WORK4 LXI D,WORK4 MVI B,24 CALL UNPK ;UNPACK IT LXI D,WORK4+38 ;SET UP LOOP TO FIND MAGNITUDE OF QUOTIENT LXI H,WORK5 ;QUOTIENT FIRST DIGIT MVI C,0 ;0 TO DIGIT COUNTER IDIV3 LDAX D ;GET A BYTE ANA A ;SET FLAGS JNZ IDIV4 ;AH, FOUND A SIGNIFICANT DIGIT AT LAST MVI M,0 ;STORE A ZERO IN QUOTIENT INX D ;UPDATE INDEXES INX H INR C JMP IDIV3 ;LOOP TO CHECK NEXT DIGIT IDIV4 PUSH H ;SAVE QUOTIENT INDEX MOV L,C ;SET UP TO MOVE POWERS BACK MVI H,0 PUSH B ;SAVE COUNT LXI D,WORK4 ;POWERS ADDRESS DAD D ;ADD TO GET OFFSET LXI B,50 ;NUMBER OF BYTES CALL MVDN ;MOVE BACK LXI H,WORK4+50 ;SET UP TO CLEAR BYTES MOVED UP POP B ;GET COUNT BACK MOV B,C ;SAVE IT IN B IDIV5 DCX H ;UPDATE INDEX DCR C ;CHECK BYTES COUNTER JM IDIV6 ;JUMP OUT OF LOOP WHEN DONE MVI M,0 ;CLEAR A BYTE JMP IDIV5 ;LOOP BACK IDIV6 POP H ;GET BACK QUOTIENT INDEX MOV A,B ;COMPUTE NEW QUOTIENT INDEX ADD B MOV E,A MVI D,0 CALL SUB16 MVI A,10 CALL ADHL LXI D,WORK3 ;GET DIVIDEND ADDRESS XRA A ;CLEAR A IDIV7 PUSH H ;SAVE REGISTERS FOR DIVIDE LOOP PUSH PSW MVI C,0 ;CLEAR QUOTIENT DIGIT LXI H,WORK4 ;GET X8 ADDRESS CALL TSTR ;SEE IF IT WILL FIT JM IDIV8 ;NOPE MOV A,C ;OR IN AN 8 ORI 8 MOV C,A IDIV8 LXI H,WORK4+12 ;GET X4 ADDRESS CALL TSTR ;SEE IF IT WILL FIT JM IDIV9 ;NOPE MOV A,C ;OR IN A 4 ORI 4 MOV C,A IDIV9 LXI H,WORK4+24 ;GET X2 ADDRESS CALL TSTR ;SEE IF IT WILL FIT JM IDIVA ;NOPE MOV A,C ;OR IN A 2 ORI 2 MOV C,A IDIVA LXI H,WORK4+36 ;GET X1 ADDRESS CALL TSTR ;SEE IF IT WILL FIT JM IDIVB ;NOPE MOV A,C ;OR IN A 1 ORI 1 MOV C,A IDIVB POP PSW ;RESTORE REGISTERS POP H MOV M,C ;STORE THE QUOTIENT DIGIT INX D ;UPDATE INDEXES INX H INR A ;UPDATE DIGIT COUNTER CPI 11 ;ARE WE DONE?? JNZ IDIV7 ;NO, SO LOOP FOR MORE DIGITS POP D ;GET DESTINATION INX D ;CORRECT FOR MANTISSA LOCATION LXI H,WORK5 ;GET SOURCE MVI C,5 ;NUMBER OF BYTES CALL PACK ;PACK THE RESULT RET ;DONE!! * MATH MODULE * RTN. B.22 * CONVERT INTEGER TO FLOATING POINT * (HL) TO (DE) INFL PUSH D ;SAVE LOCATIONS PUSH H LXI D,WORK1 ;GET ADDRESS TO UNPACK INTO MVI B,5 ;NUMBER OF BYTES TO UNPACK INX H ;GET THE MANTISSA LOCATION CALL UNPK ;UNPACK THE INTEGER MVI A,10 ;SET UP TO CLEAR SOME MEMORY XCHG ;GET ADDRESS TO HL CALL ZERO ;CLEAR 10 BYTES AFTER UNPACKED NUMBER LXI H,WORK1 ;GET ADDRESS OF FIRST UNPACKED DIGIT MVI B,9H ;A BCD 9 TO B INFL1 MOV A,M ;GET A BYTE ANA A ;SET FLAGS JNZ INFL2 ;AH, A SIGNIFICANT DIGIT!! MVI A,99H ;SUBTRACT 1 FROM B, IN BCD ADD B DAA ;BCD ADJUST MOV B,A ;STUFF IT BACK INX H ;UPDATE INDEX JC INFL1 ;LOOP IF B IS NOT 0 YET MVI B,0 ;SEND A REAL 0 TO B INFL2 POP D ;GET INTEGER LOCATION LDAX D ;GET SIGNS BYTE ORI 1 ;SET LSB FOR FLOATING POINT ID POP D ;GET RESULT DESTINATION STAX D ;STORE ID BYTE INX D ;GET LOCATION FOR EXPONENT MOV A,B ;EXPONENT TO B STAX D ;STORE IT INX D ;LOCATION FOR MANTISSA MVI C,4 ;NUMBER OF BYTES CALL PACK ;PACK IN THE MANTISSA RET ;DONE * RTN. B.23 * CONVERT FLOATING POINT TO INTEGER * (HL) TO (DE) FLIN PUSH D ;SAVE DESTINATION LXI D,TMP11 ;MOVE THE NUMBER DOWN LXI B,6 ;NUMBER OF BYTES CALL MOVE XCHG ;NEW SOURCE TO HL POP D ;GET DESTINATION BACK MOV A,M ;GET SIGNS BYTE ANI 0BEH ;CONVERT TO INTEGER FORMAT STAX D ;STORE IT MOV A,M ;GET SIGNS BYTE AGAIN ANI 40H ;STRIP OFF EXPONENT SIGN BIT JNZ FLIN1 ;JUMP IF IT IS INX H ;GET EXPONENT ADDRESS MOV A,M ;GET IT CPI 10H ;SEE IF IT'S GREATER THAN 9 BCD JNC FLIN2 ;YUP, SO OVERFLOW FLIN3 MOV B,A ;SAVE IT TO B MVI A,9 ;SET UP SUBTRACT PUSH D ;SAVE DESTINATION SUB B ;SUBTRACT FOR AMOUNT TO SHIFT PUSH PSW ;SAVE IT INX H ;GET MANTISSA LOCATION LXI D,WORK1+8 ;SET UP TO MOVE MANTISSA LXI B,4 ;NUMBER OF BYTES TO MOVE CALL MVDN ;MOVE IT XCHG ;GET ADDRESS TO HL POP PSW ;GET NUMBER OF PLACES TO SHIFT CALL SHFT ;SHIFT POP D ;GET DESTINATION BACK INX D ;GET MANTISSA LOCATION LXI B,5 ;NUMBER OF BYTES TO MOVE CALL MVDN ;MOVE THEM IN FLIN4 LDA TMP11 ;CHECK FOR NEGATIVE INPUT ANA A RP ;NOPE DCX D LXI H,ONEEE ;GET CONSTANT XCHG MOV C,L MOV B,H CALL SUBER ;SUBTRACT RET FLIN1 XCHG ;GET DESTINATION ADDRESS TO HL INX H ;GET MANTISSA LOCATION PUSH H ;SAVE MANTISSA DESTINATION MVI A,5 ;NUMBER OF BYTES CALL ZERO ;CLEAR THEM OUT POP D ;GET DESTINATION BACK JMP FLIN4 FLIN2 MVI A,1 ;SET OVERFLOW FLAG STA MERR RET ;DONE * RTN. B.24 * CONVERT BCD EXPONENT TO BINARY * TWO DIGIT BCD NUMBER IN "A" IS CONVERTED TO BINARY * IN "A". NO OTHER REGISTERS DISTURBED * METHOD CONTRIBUTED BY SAM SINGER BCDBN PUSH B ;SAVE BC MOV B,A ;SAVE THE DIGITS ANI 0F0H ;MASK OUT THE MSD RAR ;EQUIVALENT TO DIGIT * 8 MOV C,A ;SAVE IT RAR ;RIGHT SHIFT TO DIVIDE RAR ;BY 4 ADD C ;DIGIT*8+DIGIT*2=DIGIT*10 MOV C,A ;SAVE IT MOV A,B ;GET ORIGINAL DIGITS ANI 0FH ;MASK OUT THE LSB ADD C ;ADD MSB*10 POP B ;RESTORE BC RET ;DONE. * THANKS, SAM * RTN. B.25 * CONVERT NUMBER TO EQUIVALENT SIGN * (HL) TO (DE) * IF (HL)>0, (DE) WILL BE +1 * IF (HL)=0, (DE) WILL BE 0 * IF (HL)<0, (DE) WILL BE -1 SIGN MOV A,M ;GET THE ID BYTE PUSH D ;SAVE DESTINATION ADDRESS LXI D,TMP11 ;CONVERSION REGISTER ANI 0BEH ;STRIP OFF FLOATING POINT BITS STAX D ;STORE TO NEW LOCATION MVI B,4 ;SET UP BYTE COUNTER SIGN1 INX H ;UPDATE INDEXES INX D MOV A,M ;GET A BYTE ANA A ;SET FLAGS JNZ SIGN2 ;JUMP OUT OF LOOP IF NONZERO STAX D ;STORE A ZERO BYTE DCR B ;CHECK BYTE COUNTER JP SIGN1 ;LOOP IF NOT DONE YET JMP SIGN9 ;DONE IF 'TWAS ALL ZEROES SIGN2 DCR B ;SEE IF WE ARE ON THE LAST BYTE YET JM SIGN3 ;YUP, SO GO STORE A ONE XRA A ;CLEAR A STAX D ;STORE THE ZERO JMP SIGN1+1 ;LOOP FOR ANOTHER BYTE SIGN3 MVI A,1 ;SET UP FOR STORING LAST BYTE STAX D ;DO IT SIGN9 POP D ;MOVE NUMBER TO DESTINATION LXI H,TMP11 LXI B,6 CALL MOVE RET ;DONE. * RTN. B.26 * INTEGER FUNCTION * INT(HL) TO (DE) INTG MOV A,M ;CHECK TO SEE IF (HL) IS INTEGER ALREADY ANI 1 ;STRIP OFF THE INTEGER/FLOATING BIT JZ INTG1 ;LEAP IF (HL) IS ALREADY AN INTEGER CALL FLIN ;CONVERT TO INTEGER RET ;DONE INTG1 LXI B,6 ;NUMBER OF BYTES CALL MVDN ;MOVE THE INTEGER TO NEW LOCATION RET ;AH, FINI. * RTN. B.27 * ABSOLUTE VALUE FUNCTION * ABS(HL) TO (DE) ABSLT MOV A,M ;GET ID BYTE ANI 7FH ;STRIP OFF MANTISSA SIGN BIT STAX D ;STORE IT TO NEW LOCATION INX D ;GET MANTISSA LOCATIONS INX H LXI B,5 ;NUMBER OF BYTES CALL MVDN ;MOVE MANTISSA (AND) EXPONENT IN RET ;DONE. (WHY CAN'T THEY ALL BE THIS EASY??) * RTN. B.28 * CONVERT ASCII STRING AT (HL) TO NUMBER AT (DE) * CARRY SET ON EXIT IF ERROR OCCURED * ON EXIT HL IS ADDRESS OF NEXT STRING ELEMENT STNM MOV A,M ;CHECK IT OUT ANI 7FH CPI 2DH ;CHECK FOR MINUS SIGN JZ P1 ;YUP CPI '.' JZ P1 CPI 3AH STC RP CPI 30H RC P1 PUSH H ;SAVE LOCATIONS PUSH D MVI A,0FFH ;PRESET COUNTERS STA CNVR1 STA CNVR2 MVI A,11 ;NUMBER OF BYTES PUSH H ;SAVE AGAIN LXI H,WORK1 ;ADDRESS OF BUFFER CALL ZERO ;CLEAR IT POP H ;GET ADDRESS BACK STA CNVR3 ;CLEAR ZERO COUNTER LXI D,WORK1 ;GET BUFFER ADDRESS LXI B,02H ;PRESET DIGIT COUNTER AND SIGNS STNM5 MOV A,M ;GET AN ASCII BYTE ANI 7FH ;STRIP UPPER BIT CPI '-' ;SEE IF IT'S A MINUS SIGN JZ STNM1 ;SURE WAS CPI '.' ;SEE IF IT'S A PERIOD JZ STNM3 ;YUP CPI 'E' ;SEE IF IT'S AN E JZ STNMA ;LOOKS THAT WAY CPI '0' ;SEE IF IT'S MAYBE A DIGIT JM STNM4 ;'PEARS NOT TO BE CPI '9'+1 ;IS IT STILL A DIGIT? JP STNM4 ;NOPE SUI 30H ;STRIP ASCII OFFSET JNZ STNM6 ;GO STORE IT LDA WORK1 ;SEE IF WE ARE INTO INSIGNIFICANT ZEROES ANA A ;SET FLAGS MVI A,0 ;RESTORE THE ZERO JNZ STNM6 ;GO STORE IT LDA CNVR3 ;INCREMENT THE LEADING ZEROES COUNTER INR A STA CNVR3 STNM7 INX H ;GET THE NEXT ASCII CHARACTER JMP STNM5 ;LOOP TO PROCESS STNM6 STAX D ;STORE THE CHARACTER IN THE BUFFER INX D ;UPDATE INDEX INR B ;UPDATE DIGIT COUNTER JMP STNM7 ;GO GET NEXT CHARACTER STNM1 INR B ;CHECK FOR B=0 DCR B JNZ STNM4 ;NO,NO, CAN'T HAVE MINUS SIGNS IN THE MIDDLE * OF NUMBERS. MVI A,80H ;SET THE MINUS MANTISSA INDICATOR ORA C MOV C,A ;PUT IT BACK JMP STNM7 ;GO GET NEXT CHARACTER STNMA INX H ;GET CHARACTER FOLLOWING E MOV A,M ANI 7FH ;STRIP OFF UPPER BIT CPI '-' ;IS IT A MINUS SIGN?? JZ STNMB ;SURE IS SUI 20H ;IS IT A SPACE?? JNZ STNM9 ;NO, SO WE'VE GOT AN ERROR INR A ;ONE TO A STNMC ORA C ;SET THE EXPONENT SIGN INDICATOR MOV C,A ;PUT IT BACK CALL STNMN ;GET AND CHECK CHARACTER STA CNVR4 ;SAVE THE MSD CALL STNMN ;GET AND CHECK CHARACTER PUSH B ;SAVE TEMP MOV B,A ;SAVE LSD LDA CNVR4 ;GET THE MSD BACK RLC ;SHIFT IT INTO UPPER POSITION RLC RLC RLC ADD B ;PUT IN THE LOWER DIGIT POP B ;RESTORE CALL BCDBN ;CONVERT IT TO BINARY STA CNVR2 ;STORE IT INX H ;CORRECT HL TO SHOW END PROPERLY JMP STNM4 ;GO FORM NUMBER STNMB MVI A,41H ;SET NEGATIVE INDICATOR JMP STNMC ;GO PROCESS EXPONENT STNMN INX H ;UPDATE INDEX MOV A,M ;GET THE CHARACTER ANI 7FH ;STRIP UPPER BIT SUI 30H ;IS IT LESS THAN A NUMBER JM STNMO ;SURE WAS CPI 10 ;IS IT MORE THAN A DIGIT? JP STNMO ;YUP RET ;IT'S OK STNMO POP D ;CLEAN UP STACK STNM9 POP D ;RESTORE REGISTERS FOR ERROR EXIT POP H STC ;SET ERROR INDICATOR RET ;EXIT, STAGE AN ERROR STNM4 MOV A,B ;PUT DIGIT COUNT IN A CPI 11 ;IS B > 10? JM STNME ;NO MVI A,1 ;SET UP TO SET FLOATING FLAG ORA C MOV C,A ;PUT IT BACK STNME MOV A,C ;CHECK FLOATING BIT ANI 1 JZ STNMF ;LEAP IF THIS IS AN INTEGER LDA CNVR2 ;CHECK STATE OF EXPONENT FLAG CPI 0FFH ;HAS IT BEEN READ IN? JZ STNMG ;NOPE STNML LDA CNVR1 ;CHECK STATE OF DECIMAL POINT FLAG CPI 0FFH ;HAS IT BEEN READ IN? JZ STNMH ;NOPE STNMI MOV A,C ;CHECK SIGN OF EXPONENT ANI 40H JNZ STNMJ ;LEAP FOR ALTERNATE CONVERSION (NEGATIVE) LDA CNVR1 ;GET CNVR1 TO B MOV B,A LDA CNVR2 ;GET CNVR2 TO A ADD B ;COMPUTE CNVR2+CNVR1 DCR A DCR A JMP STNMK ;SKIP STNMJ LDA CNVR3 ;GET CNVR3 MOV B,A ;SAVE IT IN B LDA CNVR2 ;GET CNVR2 ADD B ;ADD MOV B,A ;SAVE IT IN B LDA CNVR1 ;GET CNVR1 CMA ;2'S COMPLEMENT INR A ADD B STNMK INR A ;CORRECTION CALL STNMP ;CONVERT TO BCD POP D ;GET BACK ADDRESS TO STORE TO INX D ;GET EXPONENT ADDRESS STAX D ;STORE EXPONENT DCX D ;GET SIGNS LOCATION MOV A,C ;GET ID BYTE TO A STAX D ;STORE IT INX D ;GET MANTISSA LOCATION INX D PUSH H ;SAVE INDEX LXI H,WORK1 ;GET LOCATION OF NUMBER MVI C,8 ;PRESET COUNTER STNMW MOV A,M ;GET A BYTE ANA A ;SET FLAGS JNZ STNMV ;OK, NOT ZERO INX H ;UPDATE INDEX DCR C ;UPDATE COUNTER JNZ STNMW ;CHECK ANOTHER BYTE DCX D ;GET EXPONENT LOCATION STAX D ;STORE A ZERO INX D ;GET MANTISSA LOCATION BAC STNMV LXI H,WORK1 ;SOURCE MVI C,4 ;NUMBER OF PACKED BYTES CALL PACK ;PACK IN THE MANTISSA POP H ;RESTORE INDEX POP D ;CLEAN UP STACK XRA A ;CLEAR CARRY RET ;FLOATING POINT EXIT STNMP PUSH D ;SAVE REGISTERS PUSH H MOV L,A ;PUT BINARY NUMBER IN HL MVI H,0 MVI E,10 ;SET UP TO DIVIDE BY 10 CALL DIV ;DO IT TO IT MOV A,L ;ROTATE MSD INTO UPPER POSITION RLC RLC RLC RLC ADD H ;ADD REMAINDER POP H ;RESTORE POP D RET ;GO BACK FROM WHENCEVER YOUSE CAME STNMG XRA A ;CLEAR CNVR2 STA CNVR2 JMP STNML ;CONTINUE PROCESSING STNMH MOV A,B ;SEND B TO CNVR1 STA CNVR1 JMP STNMI ;CONTINUE PROCESSING STNM3 LDA WORK1 ;SEE IF ANY SIGNIFICANT DIGITS YET ANA A ;SET FLAGS JNZ STNMM ;AH, THERE ARE SIGNIFICANT DIGITS STA CNVR3 ;NO, SO CLEAR THE LEADING ZEROES COUNTER MVI A,40H ;SET IN EXPONENT SIGN BIT ORA C MOV C,A STNMM MVI A,1 ;SET THE FLOATING POINT BIT ORA C MOV C,A ;PUT IT BACK MOV A,B ;SEND B TO CNVR1 STA CNVR1 JMP STNM7 ;JUMP BACK TO PROCESS NEXT CHARACTER STNMF POP D ;GET LOCATION MOV A,C ;STORE ID BYTE STAX D INX D PUSH H ;SAVE INDEXES PUSH D MVI A,10 ;C=10-B SUB B MOV C,A LXI H,WORK1+9 ;GET END OF NUMBER MOV A,L ;DE=HL-C SUB C MOV E,A MOV A,H SBI 0 MOV D,A STMNQ INR B ;CHECK FOR B=0 DCR B JZ STMNR ;GO TO STORE ZEROES LDAX D ;GET A BYTE MOV M,A ;STORE IT DCX D ;UPDATE INDEXES DCX H DCR B ;UPDATE COUNTER JMP STMNQ ;LOOP FOR MORE BYTES TO MOVE STMNR INR C ;CHECK FOR C=0 DCR C JZ STNMQ ;ALL DONE MVI M,0 ;STORE A 0 DCX H ;UPDATE INDEX DCR C ;UPDATE COUNTER JMP STMNR ;LOOP FOR MORE ZEROES STNMQ LXI H,WORK1 ;GET SOURCE MVI C,5 ;NUMBER OF PACKED BYTES POP D ;GET DESTINATION CALL PACK ;PACK IT IN, BOYS. POP H ;RESTORE INDEX POP D ;CLEAN UP STACK XRA A ;CLEAR CARRY RET ;INTEGER EXIT * RTN. B.29 * CONVERT NUMBER TO ASCII STRING * NUMBER AT (HL) CONVERTED TO STRING STARTING AT (DE) * ON EXIT, DE IS NEXT CHARACTER AFTER STRING NMST XRA A ;CLEAR A AND SOME FLAGS STA CNVR5 ;CLEAR FLOATING/INTEGER FLAG STA CNVR1 ;CLEAR LEADING ZEROES FLAG MOV B,M ;GET ID BYTE MOV A,B ;GET ID BYTE TO A ANI 80H ;SEE IF MANTISSA IS NEGATIVE JZ NMSTZ ;SKIP IF POSITIVE MVI A,'-' ;SET UP A MINUS STAX D ;STORE TO STRING LOCATION INX D ;GET NEXT LOCATION NMSTZ PUSH D ;SAVE IT MOV A,B ;GET ID BYTE AGAIN ANI 1 ;SEE IF THIS IS AN INTEGER JZ NMST1 ;SURE WAS!! INX H ;GET EXPONENT LOCATION INX H ;GET FIRST BYTE MOV A,M ;CHECK FOR FLOATING ZERO DCX H ;BACK TO EXPONENT ANA A JNZ NMS47 ;IT'S A ZERO! MVI M,0 ;MAKE IT RIGHT DCX H MVI M,2 JMP NMST1 ;PROCESS AS INTEGER NMS47 MOV A,M ;GET EXPONENT MOV C,A ;PUT IT IN C AND EXPONENT FLAG STA CNVR4 MOV A,B ;GET ID BYTE TO FLOATING/INTEGER FLAG STA CNVR5 MVI A,1 ;GET A ONE TO DECIMAL POINT FLAG STA CNVR3 LDA CNVRA ;GET MAX NORMAL DISPLAY FLAG CMP C ;CHECK THIS TURKEY NUMBER'S SIZE JC NMST2 ;OOPS, TOO BIG, SO EXPONENT DISPLAY XRA A ;CLEAR EXPONENT DISPLAY FLAG STA CNVR5 MOV A,B ;GET ID BYTE AGAIN ANI 40H ;CHECK SIGN OF EXPONENT JNZ NMST3 ;LEAP IF IT'S MINUS LDA CNVR4 ;GET EXPONENT CALL BCDBN ;CONVERT IT TO BINARY INR A ;ADD ONE STA CNVR3 ;SET DECIMAL POINT FLAG JMP NMST2 ;SKIP NMST1 INX H ;UPDATE INDEX MVI A,10 ;TEN TO DECIMAL POINT FLAG STA CNVR3 JMP NMST4 ;CONTINUE NMST3 XRA A ;CLEAR DECIMAL POINT FLAG STA CNVR3 LDA CNVR4 ;GET EXPONENT CALL BCDBN ;CONVERT THE THING TO BINARY DCR A ;SUBTRACT ONE STA CNVR1 ;SET THE LEADING ZEROES FLAG NMST2 INX H ;GET MANTISSA ADDRESS MVI A,8 ;SET NUMBER OF BYTES NMST4 STA CNVR6 ;SET NUMBER OF DIGITS FLAG RRC ;DIVIDE BY TWO ANI 0FH MOV B,A ;STICK IT IN B LXI D,WORK1 ;SET UP TO UNPACK CALL UNPK ;DO IT MVI C,10 ;SET UP TO TURN IT ALL INTO ASCII LXI H,WORK1 NMST5 MOV A,M ;GET A BYTE ORI 30H ;SET ASCII BITS MOV M,A ;PUT IT BACK INX H ;UPDATE INDEX DCR C ;CHECK NUMBER OF BYTES JNZ NMST5 ;LOOP TO CONVERT MORE BYTES LDA CNVR6 ;GET NUMBER OF DIGITS MOV C,A ;SEND THE MESS TO C LXI H,WORK1 ;GET BUFFER LOCATION CALL ADHL ;HL=HL+A DCX H NMST6 MOV A,M ;GET A BYTE CPI 30H ;SEE IF IT'S AN ASCII ZERO JNZ NMST7 ;NO, SIREE DCX H ;WELL THEN, CHECK SOME MORE DCR C ;IS WE DONE YET??? JNZ NMST6 ;NO? WELL, THEN GO AND CHECK ANOTHER ONE MVI C,09H NMST7 MOV A,C ;STORE C IN TRAILING ZEROES FLAG STA CNVR2 LXI H,WORK1 ;GET BUFFER START LXI B,0 ;CLEAR COUNTERS POP D ;RESTORE INDEX NMST8 LDA CNVR3 ;GET DECIMAL POINT FLAG CMP B ;=B? JNZ NMST9 ;NO, SO SKIP LDA CNVR6 ;CHECK FOR FLOATING POINT CPI 8 JZ NMS00 ;SURE WAS, SO DUMP A DECIMAL POINT LDA CNVR2 ;GET TRAILING ZEROES START CMP B ;ANYTHING LEFT TO PRINT? JZ NMSTA ;NOPE. NMS00 MVI A,'.' ;GET AN ASCII PERIOD STAX D ;STORE IT INX D ;UPDATE INDEX NMST9 LDA CNVR2 ;GET TRAILING ZEROES FLAG CMP B ;ANYTHING LEFT TO PRINT?? JZ NMSTA ;NOPE LDA CNVR1 ;GET LEADING ZEROES FLAG ANA A ;CHECK FOR A ZERO JZ NMSTB ;SKIP IF IT'S ZERO PUSH B ;SAVE COUNTERS MOV C,A ;NUMBER OF ZEROES TO C MVI A,30H ;ASCII ZERO TO A NMSTC STAX D ;STORE A ZERO INX D ;UPDATE INDEX DCR C ;CHECK BYTES COUNTER JNZ NMSTC ;LOOP FOR MORE ZEROES POP B ;RESTORE COUNTERS XRA A ;CLEAR LEADING ZEROES FLAG STA CNVR1 NMSTB MOV A,M ;GET ANOTHER BYTE CPI 30H ;IS IT A ZERO (ASCII)?? JNZ NMSTD ;NO, NOT THIS TIME INR C ;CHECK FOR C = 0 DCR C JZ NMSTE ;SURE IS NMSTD INR C ;SET SIGNIFICANT DIGIT FLAG STAX D ;STORE A DIGIT INX D ;UPDATE INDEXES NMSTE INX H INR B ;INCREMENT DIGIT COUNTER LDA CNVR6 ;GET NUMBER OF DIGITS CMP B ;HAVE WE DONE THAT MANY? JNZ NMST8 ;NO, SO LOOP FOR SOME MORE NMSTA LDA CNVR2 ;CHECK FOR MORE ZEROES TO SPIT OUT MOV B,A ;SAVE IN B LDA CNVR3 ;GET DECIMAL LOCATION SUB B ;SUBTRACT MOV B,A ;STICK IT IN B JZ NMSTU ;YUP JM NMSTU ;YUP NMSTX DCR B ;CHECK COUNT JM NMS57 ;CONTINUE MVI A,'0' ;STORE A ZERO STAX D INX D ;INCREMENT INDEX JMP NMSTX ;LOOP FOR MORE ZEROES NMSTU LDA CNVR5 ;CHECK FOR EXPONENT DISPLAY ANA A ;SET FLAGS RZ ;RETURN IF NO EXPONENT NECESARY ANI 40H ;CHECK FOR MINUS EXPONENT MVI A,'E' ;STORE AN E STAX D INX D ;UPDATE INDEX MVI A,20H ;GET A SPACE JZ NMSTF ;SKIP IF EXPONENT POSITIVE MVI A,'-' ;GET A MINUS SIGN NMSTF STAX D ;STORE THIS INX D ;INCREMENT INDEX LDA CNVR4 ;GET EXPONENT MOV B,A ;PUT IT IN B RRC ;SHIFT MSD INTO BOTTOM RRC RRC RRC ANI 0FH ;STRIP OFF UPPER ORI 30H ;SET ASCII OFFSET STAX D ;STORE IT INX D MOV A,B ;GET THE EXPONENT AGAIN ANI 0FH ;STRIP OFF UPPER ORI 30H ;SET ASCII OFFSET STAX D ;STORE IT INX D ;UPDATE INDEX RET ;AHHHHH, DONE. NMS57 LDA CNVR6 ;SEE IF THIS IS FLOATING CPI 8 JNZ NMSTU ;NOPE MVI A,'.' ;STUFF A PERIOD STAX D INX D ;UPDATE JMP NMSTU ;CONTINUE * MATH MODULE * RTN. B.37 * TERMINATOR FOR TRANSCENDENTAL FUNCTIONS * TRMN ENTRANCE CHANGES SIGNF AND CHECKS TMP6 * TRMN1 ENTRANCE JUST CHECKS TMP6 TRMN LDA SIGNF ;GET THE SIGN CHANGE FLAG MOV B,A ;STICK IT IN B LXI H,TMP6 ;GET ADDRESS OF TERM XRA M ;CHANGE THE SIGN BIT IF INDICATED MOV M,A ;STUFF IT BACK MOV A,B ;GET THE SIGN FLAG BACK XRI 80H ;CHANGE IT STA SIGNF ;STUFF IT BACK TOO TRMN1 LHLD TMP5 ;GET ID BYTE AND EXPONENT MOV C,H ;MOVE TO BC MOV B,L LHLD TMP6 ;GET ID BYTE AND EXPONENT MOV E,H ;MOVE TO DE MOV A,L ;CHANGE EXPONENT SIGN XRI 40H MOV D,A LDA TMP6+2 ;CHECK FOR TERM=0 ANA A ;SET FLAGS STC ;SET THE CARRY JUST IN CASE RZ CALL EXAD ;ADD THE EXPONENTS MOV A,B ;CHECK THE SIGN ANI 40H ;STRIP IT OFF RNZ ;RETURN WITHOUT CARRY IF WAS NEGATIVE MOV A,C ;GET THE EXPONENT SUI 8 ;SET CARRY TO WRONG STATE CMC ;SET IT RIGHT RET ;DONE.. * RTN. B.38 * COMPARE (HL) AND (DE) * ZERO SET IF (HL) EQUALS (DE) * CARRY SET IF (HL) < (DE) CMPR LXI B,TMP7 ;GET ADDRESS OF ANSWER HOME CALL SUBER ;SUBTRACT (HL)-(DE) LXI H,TMP7+1 ;GET ADDRESS OF EXPONENT/MSD'S MVI B,5 ;NUMBER OF BYTES TO CHECK CMPR2 MOV A,M ;GET A BYTE ANA A ;SET FLAGS JNZ CMPR1 ;AH,HA, IT'S NOT ZERO INX H ;UPDATE INDEX DCR B ;CHECK BYTE COUNTER JNZ CMPR2 ;NOT DONE, SO LOOP FOR MORE RET ;THIS EXIT IF NUMBER WAS ZERO CMPR1 LDA TMP7 ;CHECKING THE MANTISSA SIGN ANI 80H ;STRIP IT OFF ORI 1 ;SET A BIT SO'S WE DON'T GET A ZERO RLC ;SET THE CARRY FLAG IF 'TWAS NEGATIVE RET ;THIS EXIT IF NUMBER WAS NOT ZERO * CONSTANT 2PI TWOPI DB 3 ;ID BYTE DB 0 ;EXPONENT DB 62H ;MANTISSA DB 83H DB 18H DB 53H * RTN. B.39 * NORMALIZE ANGLE IN RADIANS * (HL) MODULO (2PI) TO TMP1 NRML PUSH H ;SAVE THE ANGLE ADDRESS LXI D,TWOPI ;SET UP FOR COMPARE WITH 2*PI CALL CMPR ;DO IT POP H ;RETRIEVE ADDRESS JC NRML1 ;AH, IT'S ALREADY LESS THAN 2*PI PUSH H ;SAVE THE ANGLE ADDRESS AGAIN LXI D,TWOPI ;SET UP FOR DIVIDE BY TWOPI LXI B,TMP1 ;DESTINATION ADDRESS CALL DIVER ;DIVIDE LXI H,TMP1 ;SET UP FOR INT(TMP1) MOV D,H MOV E,L CALL INTG ;INT(TMP1) TO TMP1 LXI H,TMP1 ;SET UP FOR TMP1*2*PI LXI D,TWOPI MOV B,H MOV C,L CALL MULER ;MULTIPLY POP H ;GET BACK THE ANGLE ADDRESS LXI D,TMP1 ;SET UP FOR ANGLE-(INT(ANGLE/2*PI)*2*PI) MOV B,D MOV C,E CALL SUBER ;SUBTRACT RET ;LARGE ANGLE EXIT NRML1 LXI B,TMP1 ;MOVE ANGLE INTO TMP1 AS FLOATING LXI D,ONE11 ;FLOATING POINT ONE JMP MULER ;MULTIPLY IT! * CONTSTANTS, ZERO AND ONE ONE11 DB 03H DB 00 ;EXPONENT DB 10H DB 00 DB 00 DB 00H ZERO0 DB 02 ;ID BYTE DB 00 ;EXPONENT DB 00 ;MANTISSA DB 00 DB 00 DB 00 * RTN. B.40 * COMPUTE FACTORIAL TERM * TMP2 = N * TMP3 = N! FCTRL LXI H,TMP2 ;SET UP TO ADD ONE TO TMP2 LXI D,ONE11 MOV B,H MOV C,L CALL ADDER ;ADD IT LXI H,TMP2 ;SET UP FOR (TMP2)*(TMP3) TO (TMP3) LXI D,TMP3 MOV B,D MOV C,E CALL MULER ;MULTIPLY IT RET ;DONE * RTN. B.41 * TRIG SERIES INITIALIZER TRIN XRA A ;GET A ZERO STA SIGNF ;CLEAR THE SIGN FLAG LXI B,6 ;NUMBER OF BYTES PUSH B ;SAVE IT LXI D,TMP5 ;CLEAR TMP5 LXI H,ZERO0 CALL MVDN POP B ;SET TMP3, TMP2, TO ONE PUSH B LXI H,ONE11 PUSH H LXI D,TMP2 CALL MVDN POP H POP B LXI D,TMP3 CALL MVDN LXI H,TMP1 ;TMP1 SQUARED TO TMP4 MOV D,H MOV E,L LXI B,TMP4 CALL MULER RET ;DONE.. * RTN. B.43 * SINE/COSINE SERIES EVALUATION * RESULT IS IN TMP6 SERS LXI H,TMP1 ;TMP6=TMP1/TMP3 LXI D,TMP3 LXI B,TMP6 CALL DIVER ;DIVIDE CALL TRMN ;CHECK TO SEE IF WE ARE DONE RC ;YUP, SO RETURN LXI H,TMP5 ;TMP5=TMP5+TMP6 LXI D,TMP6 MOV B,H MOV C,L CALL ADDER ;ADD IT CALL FCTRL ;COMPUTE TWO FACTORIAL TERMS CALL FCTRL LXI H,TMP1 ;TMP1=TMP1*TMP4 LXI D,TMP4 MOV B,H MOV C,L CALL MULER ;MULTIPLY IT JMP SERS ;LOOP AND TRY ANOTHER TERM * RTN. B.44 * SINE AND COSINE EVALUATION * SINE ENTRANCE PROVIDES SINE * COSN ENTRANCE PROVIDES COSINE * F(HL) TO (DE) SINE XRA A ;CLEAR TMP6 STA TMP6 ;THIS INDICATES SINE SICO PUSH D ;SAVE DESTINATION CALL NRML ;NORMALIZE ANGLE CALL TRIN ;INITIALIZE LDA TMP6 ;GET SINE/COSINE FLAG ANA A ;SET FLAGS JZ SICO1 ;SKIP IF SINE COMPUTATION LXI H,ONE11 ;THIS IS COSINE, SO 1 TO TMP1 LXI D,TMP1 LXI B,6 CALL MVDN LXI H,ZERO0 ;AND ZERO TO TMP2 LXI D,TMP2 LXI B,6 CALL MVDN SICO1 CALL SERS ;EVALUATE THE SERIES POP D ;RESTORE DESTINATION ADDRESS LXI H,TMP5 ;MOVE FROM TMP5 TO (DE) LXI B,6 CALL MVDN RET ;ALL DONE... COSN MVI A,1 ;SET TMP6 NONZERO STA TMP6 ;INDICATING THAT THIS IS A COSINE JMP SICO ;COMPUTE IT * RTN. B.45 * TANGENT * COMPUTED BY TAN(X)=SIN(X)/COS(X) TANG PUSH D ;SAVE DESTINATION PUSH H ;SAVE SOURCE LXI D,TMP8 ;TMP8=SIN(HL) CALL SINE POP H ;GET SOURCE AGAIN LXI D,TMP9 ;TMP9=COS(HL) CALL COSN LXI H,TMP8 ;(DE)=TMP8/TMP9 LXI D,TMP9 POP B ;GET DESTINATION BACK CALL DIVER ;DO IT TO IT RET ;FINI! * RTN. B.46 * ARCTANGENT * FOR (HL) > 1.3, USES MACLAURIN SERIES FOR ARCTAN * FOR (HL) < 1.3, USES MACLAURIN SERIES FOR ARCSIN, * AND THE IDENTITY, ARCTAN(X)=ARCSIN(X/SQU(X*X+1)) * THIS ENSURES CONVERGENCE WITHIN OUR LIFETIME ATAN PUSH D ;SAVE DESTINATION PUSH H ;SAVE SOURCE LXI D,TMP1 ;MOVE (HL) TO TMP1 LXI B,6 CALL MVDN ;MOVE IT MOV H,D ;COMPUTE TMP4=TMP1*TMP1 MOV L,E LXI B,TMP4 CALL MULER ;MULTIPLY LXI H,TMP4 ;COMPARE TMP4 AND 1.69 LXI D,CONS1 CALL CMPR ;COMPARE POP H ;RESTORE SOURCE ADDRESS JC ATAN2 ;TOO SMALL, SO USE ARCSIN SERIES LXI H,CONS2 ;MOVE PI/2 TO TMP5 LXI D,TMP5 LXI B,6 CALL MVDN LXI H,ONE11 ;MOVE ONE INTO TMP2 LXI D,TMP2 LXI B,6 CALL MVDN MVI A,80H ;SET SIGN CHANGE FLAG TO 80H STA SIGNF LDA TMP1 ;MAKE MANTISSA SIGN OF TMP5 SAME ANI 80H ;AS SIGN OF TMP1 MOV B,A ;SAVE SIGN OF TMP1 IN B LXI H,TMP5 ;ADDRESS OF ID BYTE MOV A,M ;GET IT ANI 7FH ;STRIP ALL BUT SIGN OF MANTISSA ORA B ;SET IN SIGN OF TMP1 MOV M,A ;STICK IT BACK LXI H,ONE11 ;TMP1=1/TMP1 PUSH H ;SAVE THIS ADDRESS LXI D,TMP1 MOV B,D MOV C,E CALL DIVER ;DIVIDE IT POP H ;GET ONE.. ADDRESS BACK LXI D,TMP4 ;TMP4=1/TMP4 MOV B,D MOV C,E CALL DIVER ;DIVIDE IT ATAN1 LXI H,TMP1 ;TMP6=TMP1/TMP2 LXI D,TMP2 LXI B,TMP6 CALL DIVER ;DIVIDE CALL TRMN ;CHECK FOR DONENESS JC ATAN3 ;OH, MY, ALL DONE LXI H,TMP2 ;TMP2=TMP2+2 MOV B,H MOV C,L LXI D,TWO22 CALL ADDER ;ADD LXI H,TMP1 ;TMP1=TMP1*TMP4 MOV B,H MOV C,L LXI D,TMP4 CALL MULER ;MULTIPLY LXI H,TMP5 ;TMP5=TMP5+TMP6 MOV B,H MOV C,L LXI D,TMP6 CALL ADDER ;ADD JMP ATAN1 ;LOOP FOR ANOTHER TERM TWO22 DB 03 ;CONSTANT OF 2 DB 00 ;EXPONENT DB 20H ;MANTISSA DB 00 DB 00 DB 00 CONS1 DB 03 ;CONSTANT, 1.69 DB 00 ;EXPONENT DB 16H ;MANTISSA DB 90H DB 00 DB 00 CONS2 DB 03 ;ID BYTE FOR PI/2 DB 00 ;EXPONENT DB 15H ;MANTISSA DB 70H DB 79H DB 63H ATAN2 PUSH H ;SAVE SOURCE ADDRESS LXI H,ONE11 ;TMP10=TMP4+1 LXI D,TMP4 LXI B,TMP10 CALL ADDER ;ADD LXI H,TMP10 ;TMP10=SQR(TMP10) MOV D,H MOV E,L CALL SQUR ;COMPUTE SQUARE ROOT POP H ;RESTORE SOURCE ADDRESS LXI D,TMP10 ;TMP1=(HL)/TMP10 LXI B,TMP1 CALL DIVER ;DIVIDE IT LXI H,TMP1 ;TMP4=TMP1*TMP1 MOV D,H MOV E,L LXI B,TMP4 CALL MULER ;MULTIPLY LXI H,ONE11 ;TMP3=1 LXI D,TMP3 LXI B,6 CALL MVDN LXI D,TMP9 ;TMP9=1 CALL MVDN LXI H,ZERO0 ;TMP5=0 LXI D,TMP5 CALL MVDN LXI D,TMP2 ;TMP2=0 CALL MVDN ATAN4 LXI H,TMP9 ;TMP7=TMP9*TMP1 LXI D,TMP1 LXI B,TMP7 CALL MULER ;MULTIPLY LXI H,ONE11 ;TMP8=TMP2+1 LXI D,TMP2 LXI B,TMP8 CALL ADDER ;ADD LXI H,TMP7 ;TMP7=TMP7/TMP8 LXI D,TMP8 MOV B,H MOV C,L CALL DIVER ;DIVIDE LXI H,TMP7 ;TMP6=TMP7/TMP3 LXI D,TMP3 LXI B,TMP6 CALL DIVER ;DIVIDE CALL TRMN1 ;CHECK FOR DONENESS JC ATAN3 ;OK, WE'RE DONE LXI H,TMP5 ;TMP5=TMP5+TMP6 LXI D,TMP6 MOV B,H MOV C,L CALL ADDER ;ADD LXI H,TMP2 ;TMP2=TMP2+1 LXI D,ONE11 MOV B,H MOV C,L CALL ADDER ;ADD LXI H,TMP9 ;TMP9=TMP9*TMP2 LXI D,TMP2 MOV B,H MOV C,L CALL MULER ;MULTIPLY CALL FCTRL ;COMPUTE ANOTHER FACTORIAL TERM LXI H,TMP1 ;TMP1=TMP1*TMP4 LXI D,TMP4 MOV B,H MOV C,L CALL MULER ;MULTIPLY JMP ATAN4 ;LOOP FOR ANOTHER TERM ATAN3 POP D ;GET DESTINATION ADDRESS LXI H,TMP5 ;MOVE TMP5 THERE LXI B,6 CALL MVDN RET ;DONE AT LAST!! * RTN. B.47 * CONVERT NUMBER TO TWO BYTE BINARY * (HL) TO HL BCDB LXI D,TMP9 ;CONVERT TO INTEGER IN TMP9 CALL INTG LXI H,TMP9 ;COMPARE WITH 32767 LXI D,C2767 CALL CMPR JNC BCDB2 ;JUMP IF NUMBER TOO LARGE TO CONVERT LXI H,0 ;CLEAR HL LXI B,TMP9+3 ;INITIALIZE FOR CONVERSION LOOP LDAX B ;GET A DIGIT MOV L,A ;TO L INX B ;GET NEXT DIGIT ADDRESS XRA A ;CLEAR FLAGS AND A BCDB1 PUSH PSW ;SAVE FLAGS PUSH B ;SAVE INDEX DAD H ;HL=HL*100 (BY TOM GALLANT) DAD H ;GENERATE HL*4 MOV D,H ;TO DE MOV E,L DAD H ;GENERATE HL*32 DAD H DAD H MOV B,H ;TO BC MOV C,L DAD H ;GENERATE HL*64 DAD D DAD B POP B ;RESTORE INDEX LDAX B ;GET NEXT DIGIT CALL BCDBN ;CONVERT TO BINARY MOV E,A ;TO DE MVI D,0 ;CLEAR D DAD D ;ADD TO PARTIAL SUM INX B ;UPDATE INDEX POP PSW ;GET FLAGS BACK CMC ;TEST LOOP COUNTER JC BCDB1 ;MORE TO GO! LDA TMP9 ;CHECK SIGN BIT ANA A ;SET FLAGS RP ;ALL'S OK XCHG LXI H,0 ;GET THE COMPLEMENT CALL SUB16 RET ;DONE% * RTN. B.48 * CONVERT BINARY TO NUMBER * HL TO (DE) BBCD MOV A,H ;CHECK FOR A NEGATIVE NUMBER ANI 80H ;SET FLAGS AND STRIP OTHER BITS MOV B,A ;SIGN BIT TO B FOR PATTERN JZ BBBCD ;POSITIVE NUMBER MOV A,H ;COMPLEMENT HL CMA MOV H,A MOV A,L CMA MOV L,A INX H ;CORRECT FOR 2'S COMPLEMENT BBBCD MVI A,2 ;SET ID BYTE ORA B ;SET IN THE SIGN BIT STAX D XCHG ;SET UP TO ZERO OUT NUMBER INX H ;GET NEXT BYTE MVI A,5 ;SET UP FOR 5 BYTES CALL ZERO ;ZERO OUT FIVE BYTES DCX H ;CORRECT THE INDEX MVI A,3 ;NUMBER OF EXECUTIONS FOR CONVERSION LOOP XCHG ;PUT BINARY BACK IN HL MOV B,D ;PUT DESTINATION IN BC MOV C,E BBCD1 PUSH PSW ;SAVE THE COUNT PUSH B ;SAVE INDEX LXI B,0 ;CLEAR COUNTER LXI D,100 ;SET SUBTRACTOR BBCDA CALL CMP16 ;CHECK FOR IT FITTING JC BBCDB ;NOPE CALL SUB16 ;YUP INX B ;UPDATE THE QUOTIENT JMP BBCDA BBCDB MOV A,L ;GET REMAINDER TO A MOV L,C ;MOVE QUOTIENT TO HL MOV H,B CALL STNMP POP B ;RESTORE INDEX STAX B ;STORE IT AWAY DCX B ;UPDATE INDEX POP PSW ;GET THE COUNT BACK TO A DCR A ;CHECK THE COUNT JNZ BBCD1 ;LOOP IF MORE TO DO RET ;DONE$$$$ BCDB2 MVI B,5 ;GET ERROR TYPE JMP ERROR ;ERROR ESCAPE * I/O MODULE * RTN. C.1 * FIND MODE ENTRY, GET CHANNEL ADDRESS AND TERMINAL * DELIMITERS * IN: A = MODE TO LOOK FOR * BC = CHANNEL NUMBER TO START LOOKING WITH * OUT: IF Z = 0 THEN NO FIND * IF Z = 1, THEN FIND AND; * HL = CHANNEL ADDRESS * DE = ADDRESS OF WIDTH/POSITION/RUBOUT CODE * BC = NEXT CHANNEL NUMBER MFND LXI H,MODES-1 ;COMPUTE STARTING ADDRESS DAD B MOV D,A ;MASK TO D MFND3 MOV A,C ;BC=11? CPI 11 JZ MFND1 ;YUP MOV A,M ;GET A BYTE ANA D ;CHECK AGAINST MASK JNZ MFND2 ;GOT ONE INX B ;SET UP FOR NEXT ONE INX H JMP MFND3 ;GO GET IT MFND2 MOV L,C ;HL=BC MOV H,B DAD H ;TIMES TWO PUSH H ;SAVE TIMES TWO LXI D,CHANL-2 ;GET BEGINNING OF CHANNEL TABLE - OFFSET DAD D ;COMPUTE ENTRY ADDRESS MOV E,M ;PUT THE ENTRY IN DE INX H ;NEXT ONE MOV D,M POP H ;GET BACK TIMES TWO DAD B ;MAKE IT TIMES THREE PUSH D ;SAVE CHANNEL ADDRESS LXI D,TRMNL-3 ;GET WIDTH/POSITION/RUBOUT START-OFFSET DAD D ;COMPUTE ENTRY ADDRESS POP D ;RESTORE CHANNEL ADDRESS XCHG ;SWAP INX B ;GET NEXT ITEM NUMBER XRA A ;SET THE ZERO FLAG RET ;DONE.. POP H ;CLEAN UP STACK RET ;LEAVE.. MFND1 ORI 100 ;RESTORE A ORI 1 ;CLEAR THE ZERO FLAG RET ;DONE...... * RTN. C.2 * CONTROL C SCANNER * CALLS THE KEYBOARD ROUTINE WITH ZERO SET FOR * A CHECK FOR CONTROL C PUSHED. * OUT: ZERO SET IF CONTROL C PUSHED CONT XRA A ;SET THE ZERO FLAG CONT1 PUSH PSW ;SAVE IT MVI A,1 ;GET MODE KEYBOARD PUSH B ;SAVE BC LXI B,1 ;START WITH CHANNEL ONE CALL MFND ;FIND THE KEYBOARD CHANNEL POP B ;RESTORE BC POP PSW ;GET THE FLAG BACK PCHL ;GO TO THE KEYBOARD ROUTINE LINK2 LINK A:TBASICA3