* BCD PACKAGE WITH FORM OF N * 10^+-16384, WHERE N IS 20 DIGIT DECIMAL FRACTION * BASED ON METHODS DESCRIBED IN BYTE MAGAZINE APRIL 1989 * THESE ROUTINES CONTAIN THE BASIC FOUR OPERATIONS (+,-,*,/), NORMALIZATION, * CONVERSIONS TO & FROM INTEGER, AND CONVERSIONS TO & FROM INTERNAL & EXTERNAL * FORMS * ADD2, SUB2, CMPW2 are macros for adding, subtracting and comparing 2 byte * integers values -- KAO 1996 * I hereby release this code into the public domain. KEEP BCD.OBJ MCOPY BCD.MACS JUMPTABLE START JMP FADD ADDITION JMP FSUB SUBTRACTION JMP NORM_FAC1 NORMALIZATION JMP FMUL MULTIPLICATION JMP FDIV DIVISION JMP ITOF INTEGER TO BCD JMP FTOI BCD TO INTEGER JMP PACK INTERNAL TO EXTERNAL FORM CONVERSION JMP UNPACK EXTERNAL TO INTERNAL FORM CONVERSION JMP OUTPUT PRINT BCD NUMBER AT X,Y END COMMON DATA FAC1_SIGN DC I1'0' SIGN FOR FLOATING POINT ACC1 FAC1_EXP DC I2'16384' EXPONENT FOR ACC1 BIAS 16384 FAC1_MAN DC 6I2'0' 6 WORD (12 BYTE) 22 DIGIT MANTISSA FAC2_SIGN DC I1'0' SIGN FOR ACC2 FAC2_EXP DC I2'16384' EXPONENT FOR ACC2 FAC2_MAN DC 6I2'0' 6 WORD (12 BYTE) 22 DIGIT MANTISSA FAC3_SIGN DC I1'0' SIGN FOR ACC3 FAC3_EXP DC I2'16384' EXPONENT FOR ACC3 FAC3_MAN DC 6I2'0' 6 WORD (12 BYTE) 22 DIGIT MANTISSA BIAS EQU $4000 BIAS FOR EXPONENTS FAC2OFF EQU FAC2_MAN-FAC1_MAN OFFSET CONSTANTS TO DIFFERENT ACCS FAC3OFF EQU FAC3_MAN-FAC1_MAN INT DC I2'0' INTEGER VARIABLE FOR CONVERSION ERROR DC I1'0' ERROR LOCATION END SUBROUTINES START COMMONLY USED SUBROUTINES SWAP ENTRY EXCHANGE FACS 1 & 2 USING COMMON LDX #FAC2_SIGN-FAC1_SIGN SWAP1 LDA FAC1_SIGN,X PHA LDA FAC2_SIGN,X STA FAC1_SIGN,X PLA STA FAC2_SIGN,X DEX BPL SWAP1 RTS SHIFTR ENTRY SHIFT MANTISSAS RIGHT ONE NIBBLE * (CODED LONG FOR SPEED) LDY #3 SHIFTR1 LSR FAC1_MAN,X ROR FAC1_MAN+1,X ROR FAC1_MAN+2,X ROR FAC1_MAN+3,X ROR FAC1_MAN+4,X ROR FAC1_MAN+5,X ROR FAC1_MAN+6,X ROR FAC1_MAN+7,X ROR FAC1_MAN+8,X ROR FAC1_MAN+9,X ROR FAC1_MAN+10,X ROR FAC1_MAN+11,X DEY BPL SHIFTR1 RTS SHIFTL ENTRY SHIFT MANTISSAS LEFT ON NIBBLE * (CODED LONG FOR SPEED) LDY #3 SHIFTL1 ASL FAC1_MAN+11,X ROL FAC1_MAN+10,X ROL FAC1_MAN+9,X ROL FAC1_MAN+8,X ROL FAC1_MAN+7,X ROL FAC1_MAN+6,X ROL FAC1_MAN+5,X ROL FAC1_MAN+4,X ROL FAC1_MAN+3,X ROL FAC1_MAN+2,X ROL FAC1_MAN+1,X ROL FAC1_MAN,X DEY BPL SHIFTL1 RTS INC3 ENTRY ADD ONE TO MAN3 (FOR DIVISION) SED CLC LDA #1 ADC FAC3_MAN+11 STA FAC3_MAN+11 BCC DONE LDX #10 INC31 LDA #0 ADC FAC3_MAN,X STA FAC3_MAN,X BCC DONE EXIT EARLY IF NO CARRY DEX BPL INC31 DONE CLD RTS NEGATE1 ENTRY NEGATE MAN1 FOR NEGATIVE NUMBERS SED SEC LDX #11 NEGATE11 LDA #0 SBC FAC1_MAN,X STA FAC1_MAN,X DEX BPL NEGATE11 CLD RTS ZERO1 ENTRY PLACE ZEROS IN FAC1 MANTISSA LDA #0 LDX #11 ZERO11 STA FAC1_MAN,X DEX BPL ZERO11 RTS SUBMAN12 ENTRY SUBTRACT MAN2 FROM MAN1 (MAN1-MAN2) SED SEC LDX #11 SUBMAN121 LDA FAC1_MAN,X SBC FAC2_MAN,X STA FAC1_MAN,X DEX BPL SUBMAN121 CLD RTS ADDMAN12 ENTRY ADD MAN2 TO MAN1 (MAN1+MAN2) SED CLC LDX #11 ADDMAN121 LDA FAC1_MAN,X ADC FAC2_MAN,X STA FAC1_MAN,X DEX BPL ADDMAN121 CLD RTS END END OF SUBROUTINES FADD START ADD FAC1 AND FAC2, STORE RESULT IN FAC1 USING COMMON LDA #0 CLEAR ERROR CONDITION STA ERROR CMPW FAC2_EXP,FAC1_EXP PUT NUMBER WITH LARGEST EXPONENT IN FAC1 BLT NOSWAP BEQ FADD0 IF EXPONENTS ARE EQUAL THEN NO ADJUSTING JSR SWAP SWAP EXPONENTS NOSWAP SUB2 FAC1_EXP,FAC2_EXP,FAC3_EXP FIND OUT HOW FAR TO SHIFT FAC2 CMPW FAC3_EXP,#22 TO LINE UP DECIMAL PLACES BGE DONE DON'T SHIFT IF MORE THAN 22 PLACES SHIFT LDX #FAC2OFF SHIFT FAC2 RIGHT JSR SHIFTR DEC FAC3_EXP BNE SHIFT FADD0 LDA FAC1_SIGN IF SIGNS ARE DIFFERENT THEN SUBTRACT CMP FAC2_SIGN BNE SUB JSR ADDMAN12 ADD MANTISSAS DONE JMP NORM_FAC1 NORMALIZE FAC1 SUB JSR SUBMAN12 SUBTRACT MANTISSAS BCS SIGNOK IF NO BORROW THEN SIGN OK LDA FAC1_SIGN OTHERWISE ADJUST IT EOR #%10000000 STA FAC1_SIGN JSR NEGATE1 NEGATE FAC1 MANTISSA SIGNOK JMP NORM_FAC1 NORMALIZE IT END FSUB START SUBTRACT FAC2 FROM FAC1 (FAC1-FAC2) USING COMMON LDA FAC2_SIGN TO SUBTRACT CHANGE SIGN AND ADD EOR #%10000000 STA FAC2_SIGN JMP FADD END NORM_FAC1 START NORMALIZE FAC1 USING COMMON (0.DDDDDDDDDDDDDDDDDDDDDE+-EXP) LDX #11 CHECK TO SEE IF MANTISSA IS ZERO ZERO LDA FAC1_MAN,X BNE NOTZERO DEX BPL ZERO LDA #0 STA FAC1_SIGN IF IT IS THEN PLACE ZERO'S IN SIGN AND STA FAC1_EXP EXPONENTS FOR EASY CHECKING STA FAC1_EXP+1 RTS NOTZERO LDA FAC1_MAN IF HIGH NIBBLE ISN'T ZERO THEN AND #%11110000 SHIFT RIGHT BEQ NORIGHT LDX #0 JSR SHIFTR INC2 FAC1_EXP ADD ONE TO EXPONENT SO SHIFT DOESN'T LDA FAC1_EXP+1 CHANGE NUMBER AND CHECK FOR OVERFLOW IN BPL DONE EXPONENT LDA #1 EXPONENT OVERFLOW ERROR STA ERROR RTS NORIGHT LDA FAC1_MAN IF SECOND NIBBLE ISN'T ZERO AND #%00001111 BNE NORM2 THEN DONE, IF IT IS THEN SHIFT RIGHT LDX #0 JSR SHIFTL DEC2 FAC1_EXP DECREMENT EXPONENT SO SHIFT DOESN'T JMP NORIGHT CHANGE NUMBER AND THEN REPEAT NORM2 LDA FAC1_EXP+1 CHECK FOR EXPONENT UNDERFLOW BPL DONE LDA #2 SEND EXPONENT UNDERFLOW ERROR DC H'2C' DONE LDA #0 DON'T SEND AN ERROR STA ERROR RTS END FMUL START MULTIPLY FACS 1 & 2 USING COMMON *MAN1 IS MULTIPLICAND, M2 IS MULTIPLIER CMPW FAC1_EXP,#0 CHECK FOR ZERO IN EITHER FAC BNE FIRSTNOT ZERO JSR ZERO1 IF EITHER IS THEN ZERO MANTISSA JMP NORM_FAC1 AND NORMALIZE FIRSTNOT CMPW FAC2_EXP,#0 BEQ ZERO ADD2 FAC1_EXP,FAC2_EXP CALCULATE EXPONENT AND CHECK FOR SUB2 FAC1_EXP,#BIAS OVERFLOW BPL NOERROR LDA #1 IF SO THEN REPORT EXPONENT OVERFLOW STA ERROR ERROR RTS NOERROR LDA FAC1_SIGN CALCULATE SIGN BY EXCLUSIVE-ORING SIGNS EOR FAC2_SIGN OF FAC1 AND FAC2 STA FAC1_SIGN LDX #11 MOVE MAN1 TO MAN3 MOVELOOP LDA FAC1_MAN,X *MAN1 IS PRODUCT STA FAC3_MAN,X *MAN3 IS MULTIPLICAND DEX BPL MOVELOOP JSR ZERO1 ZERO MAN1 IN PREPARATION FOR MULTIPLYING LDY #23 PREPARE FOR 22 DIGITS IN MULTIPLICATION MUL0 LDA FAC3_MAN+11 GET LOWEST NIBBLE OF MAN3 AND #%00001111 BEQ DONTADD IF IT IS ZERO THEN DON'T ADD STA FAC3_EXP IF NOT THEN ADD MAN2 TO MAN1 N TIMES MUL1 JSR ADDMAN12 ADD MANTISSAS N TIMES DEC FAC3_EXP BNE MUL1 DONTADD CPY #0 IF LAST TIME THROUGH THEN DON'T SHIFT BEQ NOSHIFT STY FAC3_EXP SAVE Y UNTIL AFTER SHIFT LDX #0 SHIFT MAN1 (PRODUCT) JSR SHIFTR LDX #FAC3OFF SHIFT MAN3 (MULTIPLICAND) JSR SHIFTR LDY FAC3_EXP RESTORE Y NOSHIFT DEY DECREMENT Y (NUMBER OF DIGITS) BPL MUL0 AND LOOP AGAIN UNTIL DONE JMP NORM_FAC1 NORMALIZE RESULT END FDIV START USING COMMON CMPW FAC2_EXP,#0 BNE NOZERO LDA #3 DIVISION BY ZERO ERROR STA ERROR RTS NOZERO CMPW FAC1_EXP,#0 BNE NOZERO1 RTS NOZERO1 SUB2 FAC1_EXP,FAC2_EXP ADD2 FAC1_EXP,#BIAS+1 LDA FAC1_SIGN EOR FAC2_SIGN STA FAC1_SIGN LDA #0 LDX #11 LOOP STA FAC3_MAN,X DEX BPL LOOP LDY #22 LOOP1 JSR SUBMAN12 BCC EXITLOOP JSR INC3 JMP LOOP1 EXITLOOP JSR ADDMAN12 CPY #0 BEQ NOSHIFT LDX #0 STY FAC3_EXP JSR SHIFTL LDX #FAC3OFF JSR SHIFTL LDY FAC3_EXP NOSHIFT DEY BPL LOOP1 LDX #11 LOOPA LDA FAC3_MAN,X STA FAC1_MAN,X DEX BPL LOOPA JMP NORM_FAC1 END FTOI START USING COMMON LDA #0 STA INT STA INT+1 CMPW FAC1_EXP,#BIAS+1 BGE NOTSMALL RTS NOTSMALL CMPW FAC1_EXP,#BIAS+6 BLT NOTBIG OVERFLOW LDA #4 OVERFLOW IN INTEGER STA ERROR RTS NOTBIG SUB2 FAC1_EXP,#BIAS+1,FAC3_EXP LOOP JSR TIMES10 BCS OVERFLOW LDX #0 JSR SHIFTL LDA FAC1_MAN AND #%11110000 LSR A LSR A LSR A LSR A CLC ADC INT STA INT LDA #0 ADC INT+1 STA INT+1 BMI OVERFLOW DEC2 FAC3_EXP BPL LOOP LDA FAC1_SIGN BEQ DONE SEC LDA #0 SBC INT STA INT LDA #0 SBC INT+1 STA INT+1 DONE RTS TIMES10 ASL INT ROL INT+1 LDA INT STA FAC3_MAN LDA INT+1 STA FAC3_MAN+1 ASL INT ROL INT+1 ASL INT ROL INT+1 ADD2 INT,FAC3_MAN RTS END ITOF START ** NOT THE ROUTINE DESCRIBED IN BYTE ** USING COMMON CMPW INT,#$8000 CALCULATE SIGN BLT POSITIVE SUB2 #0,INT,INT LDA #$80 DC H'2C' POSITIVE LDA #0 STA FAC1_SIGN LDA #22 SET UP EXPONENT STA FAC1_EXP LDA #$40 STA FAC1_EXP+1 LDX #4 WORK WITH 5 DIGITS LOOP LDY #0 INTIALIZE COUNT LOOP1 LDA HTEN,X GET VALUE TO SUBTRACT STA FAC3_EXP+1 IF INTEGER IS SMALLER THEN LDA LTEN,X STA FAC3_EXP CMPW INT,FAC3_EXP BLT GOTDIGIT IT ALREADY HAS THAT DIGIT SUB2 INT,FAC3_EXP ELSE SUBTRACT INY ADD ONE TO DIGIT VALUE BNE LOOP1 AND CONTINUE GOTDIGIT TYA MOVE DIGIT INTO ACCUMULATOR ORA FAC1_MAN+11 SAVE IT IN LAST BYTE OF FAC1 STA FAC1_MAN+11 STX FAC3_MAN LDX #0 JSR SHIFTL SHIFT FAC1 LEFT LDX FAC3_MAN NEXTDIGIT DEX DECREMENT DIGIT COUNTER BPL LOOP GO BACK IF NOT DONE JMP NORM_FAC1 NORMALIZE RESULT HTEN DC I1'0,0,0,3,39' HIGH BYTE OF POWERS OF 10 LTEN DC I1'1,10,100,232,16' LOW BYTE " " " " END PACK START ** NOT DESCRIBED IN BYTE ** USING COMMON INDEX EQU $00 STX INDEX STY INDEX+1 JSR NORM_FAC1 NORMALIZE FAC1 AND THEN SHIFT IT SO CMPW FAC1_EXP,#0 THAT THE MOST SIGNIFICANT NIBBLE ISN'T BEQ MOVE ZERO DEC2 FAC1_EXP IF FAC1 EQUALS ZERO THEN DON'T SHIFT LDX #0 JSR SHIFTL MOVE LDY #0 LDA FAC1_EXP MOVE EXPONENT AND SIGN STA (INDEX),Y INY LDA FAC1_SIGN ORA FAC1_EXP+1 STA (INDEX),Y INY LDX #0 MOVE MANTISSA, NOTICE THAT THERE IS NO LOOP LDA FAC1_MAN,X ROUNDING ON LAST BYTE OF TRANSFERED STA (INDEX),Y MANTISSA INY INX CPX #10 BNE LOOP RTS END UNPACK START ** NOT DESCRIBED IN BYTE ** USING COMMON INDEX EQU $00 STX INDEX STY INDEX+1 LDY #0 GET EXPONENT AND SIGN LDA (INDEX),Y STA FAC1_EXP INY LDA (INDEX),Y PHA SAVE VALUE OF HIGH BYTE OF EXPONENT AND #$80 THEN EXTRACT SIGN STA FAC1_SIGN PLA RESTORE VALUE STA FAC1_EXP+1 LDX #0 MOVE TEN BYTE MANTISSA LOOP LDA (INDEX),Y STA FAC1_MAN,X INY INX CPX #10 BNE LOOP LDA #0 FIX LAST TWO BYTES STA FAC1_MAN+10 STA FAC1_MAN+11 JMP NORM_FAC1 NORMALIZE IT END APPEND BCD.IO