ftp.barnyard.co.uk

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

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG032.ARK / TBASICA1.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 26KB | 1,025 lines

* TARBELL BASIC * COPYRIGHT (C) 1978 TARBELL ELECTRONICS YES EQU 0FFFFH NO EQU NOT YES CASSETTE EQU YES DISK EQU NO ORG 500H * DESIGNED BY TOM DILATUSH AND JIM BARNICK OF * REAL TIME MICROSYSTEMS, CHULA VISTA, CALIFORNIA * CODED BY TOM DILATUSH, WITH A LITTLE HELP * FROM TOM GALLANT, BOB BROWN, AND SAM SINGER * * COMMON MODULE * TESTED 17 NOVEMBER 1977 * OBJECT OCCUPIES 316 BYTES START JMP STARS DW CHANL ;POINTER TO CHANL DW TRMNL ;POINTER TO TRMNL DW SSSS ;POINTER TO SSSS DW CNVRA ;POINTER TO CNVRA DW FPRAA+6 ;POINTER TO USER ADDRESS DW MODES ;POINTER TO MODES TABLE. DW FSRC ;PTR TO FIRST SOURCE BYTE. DW ESRC ;PTR TO 1ST BYTE AFTER SOURCE. DW ERROR ;POINTER TO ERROR ROUTINE DW TSCN ;POINTS TO TOKEN JUST SCANNED DW NSCN ;POINTS TO TOKEN TO BE SCANNED NEXT DW CHCK ;POINTS TO CHECKSUM ROUTINE DW INFL ;INTEGER TO FLOATING, (HL) TO (DE) DW FLIN ;FLOATING TO INTEGER, (HL) TO (DE) DW STNM ;STRING AT (HL) TO NUMBER AT (DE) DW NMST ;NUMBER AT (HL) TO STRING AT (DE) DW CMPR ;ZERO AND CARRY SET AS FOR (HL)-(DE) DW SINE ;SINE(HL) TO (DE) DW SICO ;COSINE(HL) TO (DE) DW TANG ;TANGENT(HL) TO (DE) DW ATAN ;ARCTANGENT(HL) TO (DE) DW BCDB ;NUMBER AT (HL) TO BINARY IN HL DW BBCD ;BINARY NUMBER IN HL TO NUMBER AT (DE) DW ETOX ;E TO THE (HL) POWER TO (DE) DW LOGX ;LOG BASE E (HL) TO (DE) DW SQUR ;(HL) TO 1/2 TO (DE) DW PWRS ;(HL) TO THE (DE) POWER TO (BC) DW ADDER ;(HL)+(DE) TO (BC) DW SUBER ;(HL)-(DE) TO (BC) DW MULER ;(HL)*(DE) TO (BC) DW DIVER ;(HL)/(DE) TO (BC) STARS LXI SP,STACK+100 ;INITIALIZE THE STACK MVI A,0C9H STA IOST+2 CALL CHCK ;SET INTEGRITY FLAG STA CHECK LDA SRFLG ;CHECK FOR PREVIOUS INITIALIZATION ANA A JNZ INTR ;GOTO TO NORMAL INITIALIZATION XRA A ;INITIALIZE EDIT FLAGS STA MERR ;INITIALIZE THE MATH ERROR FLAG LXI H,0 SHLD DMPMM STA EDITM CALL INIO ;INITIALIZE THE I/O ROUTINES LHLD SMEN ;SEE IF A MONITOR NEEDS TO BE LOADED MOV A,H ORA L JZ S0000 ;NOPE LHLD SMST ;GET FIRST ADDRESS OF MONITOR S0001 PUSH H ;SAVE ADDRESS CALL CAIN ;GET A BYTE FROM CASSETTE POP H ;GET ADDRESS BACK MOV M,A ;STUFF IT IN XCHG ;TO DE LHLD SMEN ;CHECK FOR DONENESS CALL CMP16 XCHG JNZ S0001 ;NOPE, SO LOOP FOR ANOTHER BYTE S0000 LXI H,BEGIN ;DUMP THE GREETING CALL MSGER MVI A,0FFH ;SET SRFLG STA SRFLG JMP INTR ;CONTINUE WITH INITIALIZATION BEGIN DB 0DH,'TARBELL ' IF DISK DB 'DISK' ENDIF IF CASSETTE DB 'CASSETTE' ENDIF DB ' BASIC',0DH DB 'BY REAL TIME MICROSYSTEMS, CHULA VISTA, CA' DB 0DH DB 'FOR TARBELL ELECTRONICS, CARSON, CA',0DH DB 'RELEASE 5.2 AUGUST 16, 1978',8DH * NOTE: FIRST DIGIT OF RELEASE NUMBER IS RTM'S. * SECOND DIGIT IS TARBELL ELECTRONICS'. * NEW COMPANIES SHOULD ADD . AND NUMBER. * * RTN A.1 * 16 BIT SUBTRACT * HL=HL-DE SUB16 MOV A,L SUB E MOV L,A ;BACK TO WHENCE IT CAME MOV A,H ;SUBTRACT MSB'S SBB D ;WITH THE CARRY (BORROW) MOV H,A ;AND BACK CMC ;REVERSE THE CARRY FLAG RET ;ALL DONE * RTN A.2 * 16 BIT COMPARE * FLAGS ARE SET AS FOR HL-DE, WITHOUT AFFECTING * THE REGISTERS. A IS CHANGED. * ONLY CARRY AND ZERO ARE CORRECTLY SET CMP16 MOV A,H ;TEST MSB'S SUB D RNZ ;NOT THE SAME MOV A,L ;TEST LSB'S SUB E RET ;DONE. * RTN A.3 * 8 BY 8 MULTIPLY * DE=D*E, NO OTHER REGISTERS DISTURBED MULT PUSH H PUSH PSW ;SAVE REGISTERS MOV H,D ;SET UP MULTIPLIERS MVI L,0 ;CLEAR SOME MOV D,L DAD H ;SHIFT AND ADD (S/A) 1 JNC MULT2 ;NO ADD DAD D ;ADD MULT2 DAD H ;S/A 2 JNC MULT3 DAD D MULT3 DAD H ;S/A 3 JNC MULT4 DAD D MULT4 DAD H ;S/A 4 JNC MULT5 DAD D MULT5 DAD H ;S/A 5 JNC MULT6 DAD D MULT6 DAD H ;S/A 6 JNC MULT7 DAD D MULT7 DAD H ;S/A 7 JNC MULT8 DAD D MULT8 DAD H ;S/A 8 JNC MULT9 ;DONE DAD D MULT9 POP PSW ;RESTORE REGISTERS XCHG ;PRODUCT TO DE POP H RET ;DONE. * RTN. A.4 * FAST MULTIPLY BY 6 * HL=HL*6 * NO OTHER REGISTERS DISTURBED * CARRY SET IF OVERFLOW FSTML PUSH D ;SAVE DE DAD H ;MULTIPLY HL BY 2 MOV D,H ;SEND IT TO DE MOV E,L DAD H ;MULTIPLY HL BY 2 DAD D ;6X=4X+2X POP D ;RESTORE DE RET ;GO AWAY * RTN. A.5 * MOVE BLOCK DOWN * (HL) TO (DE), BC TIMES * NO REGISTERS DISTURBED MVDN PUSH PSW ;SAVE THE WORLD PUSH B PUSH D PUSH H MVDN1 MOV A,M ;GET DATA STAX D ;STORE IT IN NEW LOCATION INX H ;UPDATE INDEXES INX D DCX B ;UPDATE BYTE COUNTER MOV A,B ;BC = 0? ORA C JNZ MVDN1 ;JUMP IF MORE BYTES TO MOVE POP H ;RESTORE THE WORLD TO IT'S FORMER STATE POP D POP B POP PSW RET ;ALL DONE * RTN. A.6 * MOVE BLOCK UP * (HL) TO (DE), BC TIMES * NO REGISTERS DISTURBED MVUP PUSH PSW ;SAVE THE WORLD PUSH B PUSH D PUSH H DAD B ;CHANGE INDEXES TO LAST BYTE+1 XCHG ;GET DE TO HL DAD B ;CHANGE DE XCHG ;BACK TO NORMAL MVUP1 DCX H ;UPDATE INDEXES DCX D DCX B ;UPDATE THE CHARACTER COUNTER MOV A,M ;GET THE DATA STAX D ;STORE IT TO NEW LOCATION MOV A,B ;IS BC=0? ORA C JNZ MVUP1 ;MORE DATA TO MOVE POP H ;RESTORE THE WORLD POP D POP B POP PSW RET ;DONE * RTN. A.7 * MOVE DATA BLOCK * WILL MOVE OVERLAPPING BLOCKS UP OR DOWN WITHOUT * ERRORS * (HL) TO (DE), BC TIMES * NO REGISTERS ARE DISTURBED MOVE CALL CMP16 ;SEE WHETHER MOVING DATA UP OR DOWN CC MVUP ;CARRY SET SO WE'RE GOING UP CNC MVDN ;CARRY CLEAR SO WE'RE GOING DOWN RET ;DONE * RTN. A.8 * STRING COMPARE * FIRST BYTE OF TWO STRINGS MUST BE ADDRESSED * BY HL AND DE. * IF (HL)=(DE), THE ZERO FLAG IS SET * IF (DE)<(HL), THE CARRY FLAG IS SET * REGISTER A IS DISTURBED * LAST CHARACTER OF STRINGS MUST HAVE 2 TO THE 7 SET STRNG PUSH B ;SAVE THE WORLD PUSH D PUSH H MVI C,0 ;CLEAR END FLAG STRN1 MOV A,M ;GET A CHARACTER ANA A ;CHECK FOR LAST ONE JP STRN2 ;NOT THE LAST ONE INR C ;SET END FLAG ANI 7FH ;STRIP UPPER BIT STRN2 CALL STRN10 ;CONVERT TO UPPER CASE MOV B,A ;CHARACTER TO B LDAX D ;GET CHARACTER FROM OTHER STRING ANA A ;CHECK FOR LAST ONE JP STRN3 ;NOT THE LAST ONE INR C ;CHECK IF BOTH STRINGS END HERE DCR C JNZ STRN6 ;YES, BOTH END HERE DCR A ;CORRECT A IF ONLY ONE ENDING HERE STRN6 INR C ;SET END FLAG ANI 7FH ;STRIP UPPER BIT STRN3 CALL STRN10 SUB B ;COMPARE THE TWO CHARACTERS INX D ;UPDATE INDEXES INX H PUSH PSW ;SAVE COMPARE RESULT DCR C ;CHECK IF END OF STRING OCCURED INR C JNZ STRN4 ;END OCCURED, SO LEAVE POP PSW ;GET RESULT BACK JZ STRN1 ;TRY NEXT CHARACTER STRN5 POP H ;RESTORE THE WORLD POP D POP B RET ;PHEW, DONE! STRN4 DCR C ;CHECK TO SEE IF BOTH STRINGS ENDED HERE DCR C JZ STRN8 ;YUP, BOTH ENDED HERE POP PSW ;GET RESULT BACK DCR C ;CLEAR ZERO FLAG (DIFFERENT LENGTHS CAN'T * BE EQUAL PUSH PSW ;SAVE RESULT AGAIN STRN8 POP PSW ;RESTORE RESULT JMP STRN5 ;LEAVE STRN10 CPI 7BH ;CHECK FOR LOWER CASE RNC ;NOPE CPI 61H RC ANI 5FH RET * RTN. A.9 * STRING SEARCH * SEARCHES A TABLE STARTING AT (DE) OF BC ITEMS * FOR THE FIRST OCCURENCE OF A STRING (HL) * ON RETURN, IF ZERO SET, A FIND WAS MADE, AND * BC = ITEM NUMBER, DE = FIRST ADDRESS OF * MATCHING STRING * IF ZERO IS CLEARED, NO FIND WAS MADE, AND * BC = NEXT ITEM NUMBER, DE = NEXT ADDRESS * AFTER THE TABLE. STSRH PUSH B ;SAVE NUMBER OF ITEMS STSRC CALL STRNG ;COMPARE STRINGS JZ STSC1 ;AH, FOUND IT * ADVANCE TILL NEXT STRING STSC2 LDAX D ;GET A CHARACTER ANA A ;SET FLAGS INX D ;UPDATE COUNTER JP STSC2 ;NOT LAST CHARACTER YET DCX B ;UPDATE ITEM COUNTER MOV A,B ;LAST ITEM? ORA C DCR A ;MAKE ZERO FLAG CLEAR IF ZERO JM STSC1 ;YUP, SO NO FINDS JP STSRC ;LOOP FOR NEXT STRING STSC1 XTHL ;GET NUMBER OF ITEMS AND SAVE HL PUSH D ;SAVE DE MOV D,B ;BC TO DE MOV E,C PUSH PSW ;SAVE FLAGS CALL SUB16 ;COMPUTE ITEM NUMBER OF FIND POP PSW ;RESTORE FLAGS INX H ;CORRECT TO MAKE FIRST ITEM #1 POP D ;GET BACK DE XTHL ;GET BACK HL, SAVING COMPUTED ITEM NUMBER POP B ;GET BACK ITEM NUMBER RET ;ALL DONE. * RTN. A.10 * COUNT CHARACTERS IN STRING * CHARACTERS IN STRING (HL) TO DE * A,B,C,H,L NOT DISTURBED COUNT PUSH PSW ;SAVE REGISTERS PUSH H LXI D,0 ;CLEAR DE XRA A ;CLEAR FLAGS CNT1 INX D ;UPDATE COUNTER ORA M ;SET FLAGS INX H ;UPDATE INDEX JP CNT1 ;LOOP IF NOT END YET POP H ;RESTORE REGISTERS POP PSW RET ;FINI * RTN. A.11 * BINARY DIVIDE 16/8 TO 8 WITH REMAINDER, ROUNDED AND * UNROUNDED QUOTIENTS * L = HL/E, UNROUNDED, H=REMAINDER * DE = HL/E, ROUNDED * B,C NOT DISTURBED * CARRY CLEARED IF OVERFLOW DIV PUSH B ;SAVE REGISTERS MOV A,H ;CHECK FOR OVERFLOW SUB E JNC DIV6 ;OH,DEAR, OVERFLOW MVI B,0 ;INITIALIZE QUOTIENT REGISTER MVI C,8 ;INITIALIZE SHIFT COUNTER DIV3 DAD H ;SHIFT HL LEFT JC DIV1 ;JUMP IF A BIT FELL OFF MOV A,H ;TEST SUBTRACT SUB E ;WILL IT FIT? JC DIV2 ;NOPE, TOO SMALL DIV1 MOV A,H ;PERFORM SUBTRACTION FOR REAL SUB E MOV H,A ;STICK IT BACK STC ;SHIFT A 'ONE' INTO QUOTIENT DIV5 MOV A,B ;SET UP TO SHIFT CARRY INTO QUOTIENT RAL ;SHIFT MOV B,A ;STICK IT BACK DCR C ;UPDATE SHIFT COUNTER JNZ DIV3 ;LOOP IF MORE SHIFTS TO DO MOV A,E ;ROUND QUOTIENT MVI D,0 ;CLEAR D ANA A ;CLEAR CARRY RAR ;DIVIDE BY TWO MOV E,B ;UNROUNDED QUOTIENT TO E CMP H ;REMAINDER*2>=DIVISOR? JNC DIV4 ;NOPE INX D ;YES, SO INCREMENT DIV4 STC ;SET FLAG FOR NO OVERFLOW DIV6 MOV L,B ;SEND UNROUNDED QUOTIENT TO L POP B ;RESTORE REGISTERS RET ;GO AWAY DIV2 ANA A ;CLEAR CARRY TO SHIFT A 0 JMP DIV5 ;SHIFT IT IN * RTN. A.12 * 8 BIT SEARCH * SEARCHES FROM HL FOR BC BYTES, LOOKING FOR A * ZERO SET IF FIND * A,D,E NOT DISTURBED * BC = ITEM NUMBER * HL = ADDRESS OF FIND SRC8 PUSH B ;SAVE REGISTERS SRC82 CMP M ;COMPARE AGAINST MEMORY JZ STSC1 ;AH, HA, A FIND! INX H ;UPDATE INDEX DCX B ;UPDATE BYTE COUNTER INR B ;CHECK FOR BEING DONE DCR B JNZ SRC82 ;NOT DONE YET INR C ;CHECK AGAIN DCR C JNZ SRC82 ;NOT DONE YET INR C ;CLEAR THE ZERO FLAG FOR NO FIND JMP STSC1 ;OH WELL, YOU CAN'T WIN 'EM ALL! * RTN A.13 * 8 BIT ADD TO HL * HL=HL+A * ONLY HL DISTURBED ADHL PUSH PSW ;SAVE A ADD L ;ADD LSB MOV L,A ;STUFF IT BACK JNC ADHL1 ;NO CARRY, SO DON'T INCREMENT INR H ;CORRECT FOR CARRY FROM LSB ADHL1 POP PSW ;RESTORE A RET ;DONE * RTN. A.14 * 2 BYTE TABLE LOOK UP * BC = ITEM DE ON TABLE STARTING AT HL * A,D,E,H,L NOT DISTURBED TABLE PUSH PSW ;SAVE REGISTERS PUSH D XCHG ;SET UP FOR ADDRESS COMPUTATION DAD H ;MULTIPLY ITEM # BY TWO DAD D ;ADD IN BASE ADDRESS DCX H ;GET ADDRESS OF MSB MOV B,M ;STUFF IT INTO B DCX H ;GET ADDRESS OF LSB MOV C,M ;STUFF IT INTO C XCHG ;RESTORE HL POP D ;RESTORE OTHER REGISTERS POP PSW RET ;DONE * THIS ROUTINE CHECKS THE INTEGRITY OF BASIC BY COMPUTING * THE MODULO 256 SUM OF ALL INSTRUCTIONS CHCK LXI H,STMSG+8 ;LAST ADDRESS LXI D,START+3 ;FIRST ADDRESS PUSH D ;SAVE IT CALL SUB16 ;COMPUTE NUMBER OF BYTES XCHG ;TO DE POP H ;GET FIRST ADDRESS BACK XRA A ;CLEAR PARTIAL CHECKSUM CHCK1 ADD M ;ADD A BYTE DCX D ;CHECK FOR DONENESS INX H ;UPDATE INDEX MOV B,A ;SAVE PARTIAL CHECKSUM MOV A,D ;CHECK COUNT ORA E MOV A,B ;PARTIAL CHECKSUM BACK JNZ CHCK1 ;NOT DONE YET RET ;DONE * MATH MODULE * RTN. B.1 * TWO DIGIT BCD SUBTRACT * A,CARRY = B-C-CARRY * B,C,D,E,H,L UNDISTURBED SUB2 PUSH B ;SAVE REGISTERS MVI A,0 ;CLEAR A WITHOUT TOUCHING CARRY ADC C ;GET C+CARRY DAA ;BCD ADJUST CMA ;GET 1'S COMPLEMENT SUI 66H ;GET 9'S BCD COMPLEMENT STC ;GET READY TO CORRECT TO 10'S COMPLEMENT ADC B ;ADD B AND CORRECTION TO 10'S COMPLEMENT DAA ;BCD ADJUST POP B ;RESTORE REGISTERS CMC ;CORRECT CARRY RET ;FINI * RTN. B.2 * ZERO REGISTER * ZEROES A BYTES STARTING AT HL ZERO MVI M,0 ;STORE A ZERO INX H ;UPDATE INDEX DCR A ;UPDATE COUNTER JNZ ZERO ;LOOP FOR MORE BYTES RET ;DONE * RTN. B.3 * SHIFT LEFT ONE BCD DIGIT (PACKED) * HL = ADDRESS OF MSB SFTL PUSH PSW ;SAVE THE WORLD PUSH B PUSH D PUSH H DCX H ;SET UP FOR FIRST SHIFT MVI E,5 ;SET UP SHIFT COUNT SFTL1 MOV A,M ;GET A BYTE INX H ;GET THE NEXT BYTE TOO MOV D,M DCX H ;SET THE INDEX BACK MVI C,4 ;SET THE SHIFT COUNTER SFTL2 MOV B,A ;SHIFT LOOP, SAVE UPPER BYTE MOV A,D ;SHIFT D LEFT ONE INTO CARRY RAL MOV D,A MOV A,B ;GET UPPER BYTE BACK RAL ;SHIFT THAT CARRY BACK IN DCR C ;CHECK SHIFT COUNT JNZ SFTL2 ;LOOP FOR MORE SHIFTS MOV M,A ;STORE THE SHIFTED DIGIT PAIR DCR E ;CHECK BYTE COUNTER INX H ;UPDATE INDEX JNZ SFTL1 ;LOOP FOR MORE BYTES POP H ;PUT THE WORLD BACK, PLEASE. POP D POP B POP PSW DCX H ;CORRECT INDEX RET ;ALL DONE! * RTN. B.4 * SHIFT BUFFER DOWN * SHIFTS BY MOVING INDEX TO SAVE TIME * IN: A = PLACES TO SHIFT * HL = ADDRESS OF MSB * B = 00 OR 99 FOR POSITIVE OR NEGATIVE * OUT: HL = ADDRESS OF MSB SHFT RRC ;CHECK LSB FOR ODDNESS CC SHFT1 ;IF IT'S ODD, SHIFT LEFT ONE DIGIT ANI 7FH ;STRIP UPPER BIT OFF SHFT5 ANA A ;SET FLAGS RZ ;RETURN IF ALL DONE DCX H ;GO BACK ONE MOV M,B ;SET IN FILLER DCR A ;DECREMENT COUNTER JMP SHFT5 ;LOOP TO SEE IF DONE YET SHFT1 CALL SFTL ;SHIFT LEFT PUSH PSW ;SAVE A MOV A,B ;GET FILLER BYTE ANI 0F0H ;STRIP OFF UPPER DIGIT MOV C,A ;STICK IT IN C MOV A,M ;GET DIGIT FROM MEMORY ANI 0FH ;STRIP OFF LOWER DIGIT ORA C ;SET IN THE UPPER DIGIT MOV M,A ;STICK IT BACK TO MEMORY POP PSW ;RESTORE A RET ;DONE * RTN. B.5 * ADD EXPONENTS * B,D = SIGN BYTES, C,E = EXPONENTS * OUT: B,C = SIGN BYTE, EXPONENT RESULT * IF AN UNDER/OVERFLOW OCCURS, THE * MATH ERROR FLAG IS SET. * CARRY FLAG IS SET ON EXIT IF AN ERROR OCCURRED EXAD MOV A,B ;GET STATE OF BC XRA D ;GET A 0 IF SIGNS ARE THE SAME ANI 40H ;LOOK AT SIGN BIT ONLY JNZ EXAD1 ;JUMP IF DIFFERENT SIGNS MOV A,C ;ADD THE EXPONENTS ADD E DAA ;BCD ADJUST MOV C,A ;PUT ANSWER IN C RNC ;RETURN IF NO ERROR MOV A,B ;FIGURE OUT IF UNDER OR OVER FLOW RLC ;GET SIGN BIT TO LSB RLC ANI 1 ;CLEAR ALL OTHERS INR A ;SET UNDER/OVERFLOW BIT STA MERR ;STORE IT TO MATH ERROR FLAG STC ;SET ERROR FLAG RET ;DONE EXAD1 ANA B ;CHECK IF BC IS NEGATIVE JNZ EXAD3 ;YUP, SO SKIP THE SWAP PUSH B ;SWAP BC AND DE PUSH D POP B POP D EXAD3 PUSH B ;SAVE BC MOV B,E ;SET UP FOR SUBTRACT CALL SUB2 ;SUBTRACT IN BCD POP B ;GET BC BACK MVI B,0 ;SET SIGN POSITIVE MOV C,A ;SET ANSWER IN C RNC ;RETURN IF STILL POSITIVE AFTER SUBTRACT CMA ;GET 9'S COMPLEMENT SUI 66H ;GET 10'S COMPLEMENT ADI 1 ;CORRECT FOR 10'S COMPLEMENT DAA ;BCD ADJUST MOV C,A ;SET NEW ANSWER IN C MVI B,040H ;SET SIGN NEGATIVE RET ;ALL DONE * RTN. B.6 * NORMALIZE WORKING REGISTER * IN: HL = ADDRESS OF REFERENCE NUMBER * DE = ADDRESS OF WORKING REGISTER * OUT: HL = ADDRESS OF REFERENCE NUMBER * DE = ADDRESS OF MANTISSA, NORMALIZED * BC = NORMALIZED EXPONENT NORM MVI B,0 ;CLEAR 0'S COUNTER NORM1 LDAX D ;GET A BYTE ANI 0F0H ;LOOK AT UPPER BCD DIGIT JNZ NORM3 ;JUMP IF DIGIT IS NONZERO MOV A,B ;UPDATE 0'S COUNTER ADI 1 DAA ;BCD ADJUST MOV B,A ;PUT IT BACK LDAX D ;NOW LET'S TRY THE LOWER DIGIT ANI 0FH ;STRIP OFF LOWER BCD DIGIT JNZ NORM3 ;JUMP IF DIGIT IS NONZERO MOV A,B ;UPDATE 0'S COUNTER ADI 1 DAA ;BCD ADJUST MOV B,A ;STUFF IT BACK INX D ;GET NEXT BYTE ADDRESS MVI A,16H ;CHECK FOR A ZERO RESULT CMP B JNZ NORM1 ;LOOP TO CHECK SOME MORE DCX D ;LOOKS LIKE ALL ZEROES DCX D ;CORRECT THE INDEX DCX D ;TO GIVE A ZEROES MANTISSA DCX D LXI B,0 ;SET UP A ZERO EXPONENT RET NORM3 MVI A,1 ;SEE IF B IS ODD ANA B JZ NORM4 ;NOPE, SO DON'T SHIFT XCHG ;SWAP INX H ;CORRECT THE INDEX CALL SFTL ;SHIFT THE MANTISSA LEFT ONE XCHG ;PUT EVERYTHING BACK WHERE IT BELONGS NORM4 MOV C,B ;SET UP FOR OFFSET SUBTRACTION MVI B,40H ;SET SIGN BIT PUSH D ;SAVE DE LXI D,8 ;SET UP DE CALL EXAD ;PERFORM SUBTRACTION MOV D,M ;GET REFERENCE PARAMETERS INX H MOV E,M DCX H CALL EXAD ;COMPUTE NORMALIZED EXPONENT POP D ;RESTORE DE RET ;DONE * RTN. B.7 * FIXED POINT ADD * NUMBERS POINTED TO BY DE,HL ARE ADDED TO BC * THE NUMBER AT HL PROVIDES THE ROUNDING BYTE * A = NUMBER OF BYTES TO ADD * ON RETURN, A=40H IF A SIGN CHANGE HAS OCCURED FXAD PUSH B ;SAVE DESTINATION STA QFLAG ;SAVE FLOATING/FIXED INDICATION MOV C,A ;SAVE NUMBER OF BYTES MVI B,0 ;CLEAR B XTHL ;GET DESTINATION TO HL DAD B ;ADD OFFSET XTHL ;PUT IT BACK ON THE STACK DAD B ;ADD OFFSET XCHG ;GET DE TO HL DAD B ;ADD OFFSET PUSH B ;SAVE COUNT XCHG ;SWAP 'EM PUSH D ;SAVE ONE SOURCE LXI D,WORK2+8 ;GET DESTINATION LXI B,4 ;NUMBER OF BYTES CALL MVDN ;MOVE LESS SIGNIFICANT BITS IN POP D ;RESTORE POP B XCHG ;SWAP 'EM BACK XRA A ;CLEAR CARRY FXAD1 DCX D ;UPDATE INDEXES DCX H LDAX D ;GET A BYTE TO ADD ADC M ;ADD MEMORY AND THE CARRY DAA ;BCD ADJUST XTHL ;GET DESTINATION DCX H ;UPDATE INDEX MOV M,A ;STORE THE RESULT XTHL ;STUFF IT BACK ON THE STACK DCR C ;CHECK BYTES COUNTER JNZ FXAD1 ;LOOP FOR MORE BYTES TO ADD RAL ;GET CARRY TO A ANI 1 ;STRIP ALL BUT LOWER BIT POP H ;CLEAN UP STACK MOV C,A ;SAVE A TO C LDA QFLAG ;GET FLOATING/FIXED INDICATION CPI 4 ;CHECK FOR FLOATING JNZ FXAD3 ;SKIP ROUNDING IF FIXED PUSH H ;SAVE ADDRESS LXI H,WORK2 ;INITIALIZE FIRST DIGIT SEARCH MVI B,8D ;MAX BYTE COUNT FXAD4 MVI A,0F0H ;MASK UPPER DIGIT ANA M ;AND WITH MEMORY JNZ FXAD5 ;LEAP IF NONZERO MVI A,0FH ;MASK LOWER DIGIT ANA M ;AND WITH MEMORY JNZ FXAD6 ;LEAP IF NONZERO INX H ;UPDATE INDEX DCR B ;CHECK COUNTER JNZ FXAD4 ;LOOP FOR MORE CHECKING FXAD9 POP H ;RESTORE ADDRESS JMP FXAD3 ;NO ROUNDING IS REQUIRED FOR ZEROES!! FXAD5 MVI A,50H ;GET ROUNDING NUMBER FOR UPPER FIND JMP FXAD7 ;SKIP FXAD6 MVI A,5H ;GET ROUNDING NUMBER FOR LOWER FIND FXAD7 LXI D,8D ;GET OFFSET DAD D ;ADD TO FIND ADDRESS ADD M ;ADD THE ROUNDING NUMBER DAA ;BCD ADJUST FXAD8 JNC FXADA ;JUMP WHEN DONE DCX H ;UPDATE INDEX MOV A,M ;GET A BYTE ADI 1 ;INCREMENT DAA ;BCD ADJUST MOV M,A ;STORE IT BACK JC FXAD8+3 ;LOOP FOR MORE ADDS FXADA POP H ;GET ADDRESS BACK TO HL DCX H ;GET OVERFLOW ADDRESS MOV A,M ;GET IT TO A MVI M,0 ;CLEAR IT OUT INX H ;RESTORE ADDRESS ORA C ;SET IN OLD OVERFLOW MOV C,A ;BACK TO C FXAD3 LDA ASFLG ;GET ADD/SUBTRACT FLAG ANA A ;SET FLAGS JNZ FXAD2 ;JUMP IF SUBTRACT WAS JUST PERFORMED DCX H ;GET OVERFLOW ADDRESS MOV M,C ;STORE ANY OVERFLOW FOR ADD OPERATION XRA A ;CLEAR A FOR NO SIGN CHANGE RET ;DONE FXAD2 XRA A ;CLEAR A DCR C ;CHECK FOR OVERFLOW RZ ;OK, NORMAL FOR SUBTRACT MVI C,5 ;OH,OH, SIGN CHANGE, SO COMPLEMENT CALL CMPL ;GET 10'S COMPLEMENT MVI A,080H ;SET SIGN CHANGE FLAG RET ;DONE * RTN. B.8 * 10'S COMPLEMENT BUFFER BCD * COMPLEMENTS C BYTES STARTING AT HL CMPL PUSH B ;SAVE BYTES COUNTER FOR LATER CMPL1 MOV A,M ;GET A BYTE CMA ;GET 1'S COMPLEMENT SUI 66H ;GET 9'S COMPLEMENT MOV M,A ;STICK IT BACK INX H ;UPDATE INDEX DCR C ;CHECK BYTES COUNTER JNZ CMPL1 ;LOOP FOR MORE BYTES STC ;SET UP FOR 10'S COMPLEMENT POP B ;RESTORE BYTE COUNT CMPL2 DCX H ;UPDATE INDEX MOV A,M ;GET BYTE BACK ACI 0 ;ADD CARRY FOR 10'S COMPLEMENT DAA ;BCD ADJUST MOV M,A ;STICK IT BACK RNC ;RETURN IF NO CARRY PROPAGATE DCR C ;CHECK BYTES COUNTER JNZ CMPL2 ;LOOP FOR MORE BYTES RET ;DONE * RTN. B.9 * FLOATING POINT ADD AND SUBTRACT * ADD ENTERS AT FPADD * SUBTRACT ENTERS AT FPSUB * PERFORMS (HL)+-(DE), PUTS RESULT IN (BC) FPSUB PUSH B ;SAVE REGISTERS PUSH H XCHG ;GET 'FROM' TO HL INX H ;GET ADDRESS OF MSD INX H MOV A,M ;GET THE MSD BYTE DCX H ;RESTORE THE ADDRESS DCX H LXI D,TEMP1 ;GET ADDRESS OF TEMPORARY 1 LXI B,6 ;GET NUMBER OF BYTES CALL MVDN ;MOVE TO TEMPORARY ANA A ;SET FLAGS JZ FPSB1 ;SKIP SIGN CHANGE IF ZERO LDAX D ;GET SIGN BYTE XRI 80H ;CHANGE SIGN OF MANTISSA STAX D ;PUT IT BACK FPSB1 POP H ;RESTORE REGISTERS POP B FPADD XRA A ;CLEAR ADD/SUBTRACT FLAG STA ASFLG PUSH H ;SAVE HL LXI H,WORK1 ;CLEAR OUT WORKING REGISTERS 1 AND 2 MVI A,24 ;NUMBER OF BYTES CALL ZERO ;CLEAR THEM POP H ;RESTORE HL PUSH B ;SAVE DESTINATION LDAX D ;GET SIGNS BYTE XRA M ;GET BITS DIFFERENT THAN OTHER NUMBER ANI 80H ;GET MANTISSA SIGN BIT ALONE JZ FPAS1 ;JUMP IF SIGNS ARE THE SAME ANA M ;CHECK SIGN OF NUMBER AT HL JNZ FPAS2 ;HL NEGATIVE ALREADY, SO SKIP SWAP XCHG ;PUT NEGATIVE NUMBER IN HL FPAS2 PUSH D ;SAVE OTHER NUMBER LXI B,6 ;GET NUMBER OF BYTES LXI D,TEMP2 ;GET ADDRESS TO MOVE TO CALL MVDN ;MOVE IT PUSH D ;SAVE NUMBER LOCATION XCHG ;PUT DESTINATION IN HL INX H ;MOVE UP TO MANTISSA INX H MVI C,4 ;NUMBER OF BYTES CALL CMPL ;DO A 10'S COMPLEMENT POP H ;RESTORE LOCATION POP D ;RESTORE THE OTHER LOCATION MVI A,0FFH ;SET ADD/SUBTRACT FLAG STA ASFLG FPAS1 PUSH H ;SAVE LOCATIONS PUSH D MOV B,M ;GET EXPONENTS AND SIGNS INX H MOV C,M XCHG MOV D,M INX H MOV E,M PUSH B ;SAVE ORIGINAL EXPONENT MVI A,40H ;COMPLEMENT SIGN BIT OF ONE XRA B ;FOR SUBTRACT MOV B,A ;STICK THE COMPLEMENTED BIT BACK PUSH D ;SAVE ORIGINAL EXPONENT CALL EXAD ;COMPUTE DIFFERENCE IN EXPONENTS POP D ;RESTORE ORIGINAL EXPONENT MOV A,D ;SAVE ORIGINAL EXPONENT POP D ;GET THE OTHER ORIGINAL BACK MOV E,A ;TWO ORIGINALS IN D,E PUSH PSW ;SAVE ANY CARRY FLAG FOR LATER MOV A,E ;COMPUTE A'B'R'+AB'+ABR TO FIND LARGER ORA D CMA ANA B MOV H,A MOV A,B ANA E ANA D ORA H MOV H,A MOV A,D CMA ANA E ORA H ANI 40H ;SEPARATE SIGN BIT POP H ;GET LOCATIONS BACK POP D XTHL JNZ FPAS4 ;JUMP IF NO SWAP NECCESARY XCHG ;SWAP LOCATIONS TO GET LARGER TO HL FPAS4 POP PSW ;GET THE CARRY FLAG BACK JC FPAS7 ;JUMP IF NO NEED TO ADD MOV A,C ;GET EXPONENTS DIFFERENCE TO A CPI 9 ;SEE IF > 8 JP FPAS7 ;YES, SO NO ADD REQUIRED PUSH H ;SAVE LOCATION PUSH D ;SAVE LOCATION PUSH B ;SAVE THE DIFFERENCE XCHG ;SET UP TO MOVE MANTISSA LXI D,WORK1+4 ;GET WORKING REGISTER ADDRESS INX H ;GET MANTISSA ADDRESS INX H LXI B,4 ;GET NUMBER OF BYTES CALL MVDN ;MOVE IT IN POP B ;GET THE DIFFERENCE BACK XCHG ;GET MANTISSA LOCATION TO HL POP D ;GET THE NUMBER LOCATION LDAX D ;GET THE SIGNS BYTE ANI 80H ;CHECK SIGN JZ FPAS5 ;POSITIVE, SO LEAVE ZEROES LDA ASFLG ;CHECK FOR SUBTRACT OPERATION ANA A ;SET FLAGS JZ FPAS5 ;JUMP IF BOTH SIGNS THE SAME MVI A,99H ;GET A 99 FPAS5 MOV B,A ;STICK IT IN B MOV A,C ;GET NUMBER OF SHIFTS CALL SHFT ;SHIFT THE BUFFER XCHG ;PUT ADDRESS TO DE POP H ;GET THE LOCATION PUSH H ;SAVE IT AGAIN INX H ;GET MANTISSA LOCATION INX H LXI B,WORK2+4D ;GET RESULT ADDRESS MVI A,4 ;GET NUMBER OF BYTES XCHG ;GET REGISTERS IN THE RIGHT PLACE CALL FXAD ;ADD THE MANTISSAS POP H ;GET ADDRESS OF REFERENCE NUMBER PUSH H ;SAVE REFERENCE LOCATION PUSH PSW ;SAVE ANY SIGN CHANGE LDA TEMP2 ;CHANGE SIGN OF TEMP2 XRI 80H STA TEMP2 XRA A ;CLEAR ERROR FLAG STA MERR LXI D,WORK2 ;GET ADDRESS OF WORKING REGISTER CALL NORM ;NORMALIZE RESULT POP PSW ;GET ADDRESS FOR RESULT POP H ;GET ANY SIGN CHANGE XRA M ;CHANGE SIGN IF NEEDED POP H ;CLEAN UP THE STACK PUSH PSW ;SAVE SIGNS BYTE MOV A,B ;GET THE EXPONENT SIGN ANI 40H ;STRIP OFF THE SIGN BIT MOV B,A ;BACK TO B POP PSW ;GET SIGNS BYTE BACK ANI 0BFH ;CLEAR THE SIGN BIT ORA B ;SET THE REAL SIGN BIT IN MOV M,A ;STORE SIGNS BYTE INX H ;UPDATE INDEX MOV M,C ;STORE EXPONENT XCHG ;SWAP ADDRESSES FOR MANTISSA MOVE INX D ;GET RIGHT ADDRESS LXI B,4 ;NUMBER OF BYTES CALL MVDN ;MOVE IT RET FPAS6 MOV A,D ;GET SIGNS BYTE POP D ;GET LOCATIONS BACK POP H ANI 40H ;CHECK EXPONENT SIGN JNZ FPAS7 ;DE ALREADY LITTLE ONE XCHG ;MAKE DE THE LITTLE ONE FPAS7 POP D ;GET DESTINATION LXI B,6 ;GET NUMBER OF BYTES CALL MVDN ;MOVE IT RET MTBLE DB 0,1,2,3,4,5,6,7,8,9 DS 6 DB 0,2,4,6,8,10H,12H,14H,16H,18H DS 6 DB 0,3,6,9,12H,15H,18H,21H,24H,27H DS 6 DB 0,4,8,12H,16H,20H,24H,28H,32H,36H DS 6 DB 0,5,10H,15H,20H,25H,30H,35H,40H,45H DS 6 DB 0,6,12H,18H,24H,30H,36H,42H,48H,54H DS 6 DB 0,7,14H,21H,28H,35H,42H,49H,56H,63H DS 6 DB 0,8,16H,24H,32H,40H,48H,56H,64H,72H DS 6 DB 0,9,18H,27H,36H,45H,54H,63H,72H,81H * RTN. B.10 * MULTIPLY TWO BCD DIGITS BY TWO DIGITS, FOUR DIGIT * PRODUCT. B * C = BC MUL2 INR B ;CHECK FOR B = 0 DCR B JZ MUL20 ;YUP, SO CLEAR BC AND RETURN INR C ;CHECK FOR C = 0 DCR C JZ MUL20 ;YUP, SO CLEAR BC AND RETURN PUSH D ;SAVE DE,HL PUSH H LXI D,0 ;CLEAR PRODUCT REGISTERS MOV A,C ;GET A DIGIT ANI 0FH JZ MUL21 ;NO MULTIPLY NEEDED MOV L,A ;SAVE IT MOV A,B ;GET ANOTHER DIGIT ANI 0F0H JZ MUL21 ;NO MULTIPLY NEEDED ADD L ;GENERATE TABLE ADDRESS LXI H,MTBLE-10H ADD L JNC MUL25 INR H MUL25 MOV L,A MOV E,M ;GET PRODUCT TO E MUL21 MOV A,B ;GET A DIGIT ANI 0FH JZ MUL22 ;NO MULTIPLY NEEDED MOV L,A MOV A,C ;GET ANOTHER ONE ANI 0F0H JZ MUL22 ;NO MULTIPLY NEEDED ADD L ;GENERATE TABLE ADDRESS LXI H,MTBLE-10H ADD L JNC MUL28 INR H MUL28 MOV L,A MOV A,M ;GET PRODUCT TO A ADD E ;ADD TO PRODUCT REGISTER DAA ;BCD ADJUST MOV E,A ;STUFF IT IN JNC MUL22 ;NO CARRY PROPAGATE INR D ;CARRY MUL22 XCHG ;SET UP TO SHIFT PRODUCT REGISTER ONE DIGIT DAD H ;SHIFT LEFT FOUR PLACES DAD H DAD H DAD H XCHG ;PUT IT BACK MOV A,C ;GET A DIGIT ANI 0FH JZ MUL23 ;NO MULTIPLY NEEDED MOV L,A MOV A,B ;GET ANOTHER DIGIT ANI 0FH JZ MUL23 ;NO MULTIPLY NEEDED RLC ;SHIFT LEFT 4 RLC RLC RLC ADD L ;GENERATE TABLE ADDRESS LXI H,MTBLE-10H ADD L JNC MUL26 INR H MUL26 MOV L,A MOV A,M ;GET PARTIAL PRODUCT ADD E ;ADD IT TO PRODUCT REGISTER DAA MOV E,A ;PUT RESULT IN JNC MUL23 ;NO CARRY INR D ;PROPAGATE CARRY MUL23 MOV A,B ;GET A DIGIT ANI 0F0H JZ MUL24 ;NO MULTIPLY NEEDED MOV L,A ;SAVE IT MOV A,C ;GET ANOTHER DIGIT ANI 0F0H JZ MUL24 ;NO MULTIPLY NEEDED RLC!RLC!RLC!RLC ;LEFT SHIFT 4 ADD L ;GENERATE TABLE ADDRESS LXI H,MTBLE-10H ADD L JNC MUL27 INR H MUL27 MOV L,A XRA A ;CLEAR CARRY MOV A,D ;GET PRODUCT REGISTER DAA ;ADJUST FOR ANY PREVIOUS CARRYS ADD M ;ADD NEW PRODUCT DAA ;BCD ADJUST MOV D,A ;STUFF IT BACK MUL24 XRA A ;CLEAR CARRYS MOV A,D ;ADJUST D IN CASE OF PREVIOUS CARRYS DAA MOV B,A ;PUT IT IN B MOV C,E ;MOVE E TO C POP H ;RESTORE REGISTERS POP D RET ;DONE!!! MUL20 LXI B,0 ;CLEAR BC RET ;FAST EXIT LINK1 LINK A:TBASICA2