181 lines
7.4 KiB
Plaintext
181 lines
7.4 KiB
Plaintext
1010 *--------------------------------
|
|
1020 * ROUND FAC USING EXTENSION BYTE
|
|
1030 *--------------------------------
|
|
1040 ROUND.FAC
|
|
1050 LDA FAC
|
|
1060 BEQ RTS.14 FAC = 0, RETURN
|
|
1070 ASL FAC.EXTENSION IS FAC.EXTENSION >= 128?
|
|
1080 BCC RTS.14 NO, FINISHED
|
|
1090 *--------------------------------
|
|
1100 * INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
|
|
1110 *--------------------------------
|
|
1120 INCREMENT.MANTISSA
|
|
1130 JSR INCREMENT.FAC.MANTISSA YES, INCREMENT FAC
|
|
1140 BNE RTS.14 HIGH BYTE HAS BITS, FINISHED
|
|
1150 JMP NORMALIZE.FAC.6 HI-BYTE=0, SO SHIFT LEFT
|
|
1160 *--------------------------------
|
|
1170 * TEST FAC FOR ZERO AND SIGN
|
|
1180 *
|
|
1190 * FAC > 0, RETURN +1
|
|
1200 * FAC = 0, RETURN 0
|
|
1210 * FAC < 0, RETURN -1
|
|
1220 *--------------------------------
|
|
1230 SIGN LDA FAC CHECK SIGN OF FAC AND
|
|
1240 BEQ RTS.15 RETURN -1,0,1 IN A-REG
|
|
1250 *--------------------------------
|
|
1260 SIGN1 LDA FAC.SIGN
|
|
1270 *--------------------------------
|
|
1280 SIGN2 ROL MSBIT TO CARRY
|
|
1290 LDA #$FF -1
|
|
1300 BCS RTS.15 MSBIT = 1
|
|
1310 LDA #1 +1
|
|
1320 RTS.15 RTS
|
|
1330 *--------------------------------
|
|
1340 * "SGN" FUNCTION
|
|
1350 *--------------------------------
|
|
1360 SGN JSR SIGN CONVERT FAC TO -1,0,1
|
|
1370 *--------------------------------
|
|
1380 * CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
|
|
1390 *--------------------------------
|
|
1400 FLOAT STA FAC+1 PUT IN HIGH BYTE OF MANTISSA
|
|
1410 LDA #0 CLEAR 2ND BYTE OF MANTISSA
|
|
1420 STA FAC+2
|
|
1430 LDX #$88 USE EXPONENT 2^9
|
|
1440 *--------------------------------
|
|
1450 * FLOAT UNSIGNED VALUE IN FAC+1,2
|
|
1460 * (X) = EXPONENT
|
|
1470 *--------------------------------
|
|
1480 FLOAT.1
|
|
1490 LDA FAC+1 MSBIT=0, SET CARRY; =1, CLEAR CARRY
|
|
1500 EOR #$FF
|
|
1510 ROL
|
|
1520 *--------------------------------
|
|
1530 * FLOAT UNSIGNED VALUE IN FAC+1,2
|
|
1540 * (X) = EXPONENT
|
|
1550 * C=0 TO MAKE VALUE NEGATIVE
|
|
1560 * C=1 TO MAKE VALUE POSITIVE
|
|
1570 *--------------------------------
|
|
1580 FLOAT.2
|
|
1590 LDA #0 CLEAR LOWER 16-BITS OF MANTISSA
|
|
1600 STA FAC+4
|
|
1610 STA FAC+3
|
|
1620 STX FAC STORE EXPONENT
|
|
1630 STA FAC.EXTENSION CLEAR EXTENSION
|
|
1640 STA FAC.SIGN MAKE SIGN POSITIVE
|
|
1650 JMP NORMALIZE.FAC.1 IF C=0, WILL NEGATE FAC
|
|
1660 *--------------------------------
|
|
1670 * "ABS" FUNCTION
|
|
1680 *--------------------------------
|
|
1690 ABS LSR FAC.SIGN CHANGE SIGN TO +
|
|
1700 RTS
|
|
1710 *--------------------------------
|
|
1720 * COMPARE FAC WITH PACKED # AT (Y,A)
|
|
1730 * RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
|
|
1740 *--------------------------------
|
|
1750 FCOMP STA DEST USE DEST FOR PNTR
|
|
1760 *--------------------------------
|
|
1770 * SPECIAL ENTRY FROM "NEXT" PROCESSOR
|
|
1780 * "DEST" ALREADY SET UP
|
|
1790 *--------------------------------
|
|
1800 FCOMP2 STY DEST+1
|
|
1810 LDY #0 GET EXPONENT OF COMPARAND
|
|
1820 LDA (DEST),Y
|
|
1830 INY POINT AT NEXT BYTE
|
|
1840 TAX EXPONENT TO X-REG
|
|
1850 BEQ SIGN IF COMPARAND=0, "SIGN" COMPARES FAC
|
|
1860 LDA (DEST),Y GET HI-BYTE OF MANTISSA
|
|
1870 EOR FAC.SIGN COMPARE WITH FAC SIGN
|
|
1880 BMI SIGN1 DIFFERENT SIGNS, "SIGN" GIVES ANSWER
|
|
1890 CPX FAC SAME SIGN, SO COMPARE EXPONENTS
|
|
1900 BNE .1 DIFFERENT, SO SUFFICIENT TEST
|
|
1910 LDA (DEST),Y SAME EXPONENT, COMPARE MANTISSA
|
|
1920 ORA #$80 SET INVISIBLE NORMALIZED BIT
|
|
1930 CMP FAC+1
|
|
1940 BNE .1 NOT SAME, SO SUFFICIENT
|
|
1950 INY SAME, COMPARE MORE MANTISSA
|
|
1960 LDA (DEST),Y
|
|
1970 CMP FAC+2
|
|
1980 BNE .1 NOT SAME, SO SUFFICIENT
|
|
1990 INY SAME, COMPARE MORE MANTISSA
|
|
2000 LDA (DEST),Y
|
|
2010 CMP FAC+3
|
|
2020 BNE .1 NOT SAME, SO SUFFICIENT
|
|
2030 INY SAME, COMPARE REST OF MANTISSA
|
|
2040 LDA #$7F ARTIFICIAL EXTENSION BYTE FOR COMPARAND
|
|
2050 CMP FAC.EXTENSION
|
|
2060 LDA (DEST),Y
|
|
2070 SBC FAC+4
|
|
2080 BEQ RTS.16 NUMBERS ARE EQUAL, RETURN (A)=0
|
|
2090 .1 LDA FAC.SIGN NUMBERS ARE DIFFERENT
|
|
2100 BCC .2 FAC IS LARGER MAGNITUDE
|
|
2110 EOR #$FF FAC IS SMALLER MAGNITUDE
|
|
2120 * <<< NOTE THAT ABOVE THREE LINES CAN BE SHORTENED: >>>
|
|
2130 * <<< .1 ROR PUT CARRY INTO SIGN BIT >>>
|
|
2140 * <<< EOR FAC.SIGN TOGGLE WITH SIGN OF FAC >>>
|
|
2150 .2 JMP SIGN2 CONVERT +1 OR -1
|
|
2160 *--------------------------------
|
|
2170 * QUICK INTEGER FUNCTION
|
|
2180 *
|
|
2190 * CONVERTS FP VALUE IN FAC TO INTEGER VALUE
|
|
2200 * IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
|
|
2210 * EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
|
|
2220 *
|
|
2230 * THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
|
|
2240 *--------------------------------
|
|
2250 QINT LDA FAC LOOK AT FAC EXPONENT
|
|
2260 BEQ QINT.3 FAC=0, SO FINISHED
|
|
2270 SEC GET -(NUMBER OF FRACTIONAL BITS)
|
|
2280 SBC #$A0 IN A-REG FOR SHIFT COUNT
|
|
2290 BIT FAC.SIGN CHECK SIGN OF FAC
|
|
2300 BPL .1 POSITIVE, CONTINUE
|
|
2310 TAX NEGATIVE, SO COMPLEMENT MANTISSA
|
|
2320 LDA #$FF AND SET SIGN EXTENSION FOR SHIFT
|
|
2330 STA SHIFT.SIGN.EXT
|
|
2340 JSR COMPLEMENT.FAC.MANTISSA
|
|
2350 TXA RESTORE BIT COUNT TO A-REG
|
|
2360 .1 LDX #FAC POINT SHIFT SUBROUTINE AT FAC
|
|
2370 CMP #$F9 MORE THAN 7 BITS TO SHIFT?
|
|
2380 BPL QINT.2 NO, SHORT SHIFT
|
|
2390 JSR SHIFT.RIGHT YES, USE GENERAL ROUTINE
|
|
2400 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
|
|
2410 RTS.16 RTS
|
|
2420 *--------------------------------
|
|
2430 QINT.2 TAY SAVE SHIFT COUNT
|
|
2440 LDA FAC.SIGN GET SIGN BIT
|
|
2450 AND #$80
|
|
2460 LSR FAC+1 START RIGHT SHIFT
|
|
2470 ORA FAC+1 AND MERGE WITH SIGN
|
|
2480 STA FAC+1
|
|
2490 JSR SHIFT.RIGHT.4 JUMP INTO MIDDLE OF SHIFTER
|
|
2500 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
|
|
2510 RTS
|
|
2520 *--------------------------------
|
|
2530 * "INT" FUNCTION
|
|
2540 *
|
|
2550 * USES QINT TO CONVERT (FAC) TO INTEGER FORM,
|
|
2560 * AND THEN REFLOATS THE INTEGER.
|
|
2570 * <<< A FASTER APPROACH WOULD SIMPLY CLEAR >>>
|
|
2580 * <<< THE FRACTIONAL BITS BY ZEROING THEM >>>
|
|
2590 *--------------------------------
|
|
2600 INT LDA FAC CHECK IF EXPONENT < 32
|
|
2610 CMP #$A0 BECAUSE IF > 31 THERE IS NO FRACTION
|
|
2620 BCS RTS.17 NO FRACTION, WE ARE FINISHED
|
|
2630 JSR QINT USE GENERAL INTEGER CONVERSION
|
|
2640 STY FAC.EXTENSION Y=0, CLEAR EXTENSION
|
|
2650 LDA FAC.SIGN GET SIGN OF VALUE
|
|
2660 STY FAC.SIGN Y=0, CLEAR SIGN
|
|
2670 EOR #$80 TOGGLE ACTUAL SIGN
|
|
2680 ROL AND SAVE IN CARRY
|
|
2690 LDA #$A0 SET EXPONENT TO 32
|
|
2700 STA FAC BECAUSE 4-BYTE INTEGER NOW
|
|
2710 LDA FAC+4 SAVE LOW 8-BITS OF INTEGER FORM
|
|
2720 STA CHARAC FOR EXP AND POWER
|
|
2730 JMP NORMALIZE.FAC.1 NORMALIZE TO FINISH CONVERSION
|
|
2740 *--------------------------------
|
|
2750 QINT.3 STA FAC+1 FAC=0, SO CLEAR ALL 4 BYTES FOR
|
|
2760 STA FAC+2 INTEGER VERSION
|
|
2770 STA FAC+3
|
|
2780 STA FAC+4
|
|
2790 TAY Y=0 TOO
|
|
2800 RTS.17 RTS
|