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