397 lines
13 KiB
Plaintext
397 lines
13 KiB
Plaintext
1010 *--------------------------------
|
|
1020 CON.ONE .HS 8100000000
|
|
1030 *--------------------------------
|
|
1040 POLY.LOG .DA #3 # OF COEFFICIENTS - 1
|
|
1050 .HS 7F5E56CB79 * X^7 +
|
|
1060 .HS 80139B0B64 * X^5 +
|
|
1070 .HS 8076389316 * X^3 +
|
|
1080 .HS 8238AA3B20 * X
|
|
1090 *--------------------------------
|
|
1100 CON.SQR.HALF .HS 803504F334
|
|
1110 CON.SQR.TWO .HS 813504F334
|
|
1120 CON.NEG.HALF .HS 8080000000
|
|
1130 CON.LOG.TWO .HS 80317217F8
|
|
1140 *--------------------------------
|
|
1150 * "LOG" FUNCTION
|
|
1160 *--------------------------------
|
|
1170 LOG JSR SIGN GET -1,0,+1 IN A-REG FOR FAC
|
|
1180 BEQ GIQ LOG (0) IS ILLEGAL
|
|
1190 BPL LOG.2 >0 IS OK
|
|
1200 GIQ JMP IQERR <= 0 IS NO GOOD
|
|
1210 LOG.2 LDA FAC FIRST GET LOG BASE 2
|
|
1220 SBC #$7F SAVE UNBIASED EXPONENT
|
|
1230 PHA
|
|
1240 LDA #$80 NORMALIZE BETWEEN .5 AND 1
|
|
1250 STA FAC
|
|
1260 LDA #CON.SQR.HALF
|
|
1270 LDY /CON.SQR.HALF
|
|
1280 JSR FADD COMPUTE VIA SERIES OF ODD
|
|
1290 LDA #CON.SQR.TWO POWERS OF
|
|
1300 LDY /CON.SQR.TWO (SQR(2)X-1)/(SQR(2)X+1)
|
|
1310 JSR FDIV
|
|
1320 LDA #CON.ONE
|
|
1330 LDY /CON.ONE
|
|
1340 JSR FSUB
|
|
1350 LDA #POLY.LOG
|
|
1360 LDY /POLY.LOG
|
|
1370 JSR POLYNOMIAL.ODD
|
|
1380 LDA #CON.NEG.HALF
|
|
1390 LDY /CON.NEG.HALF
|
|
1400 JSR FADD
|
|
1410 PLA
|
|
1420 JSR ADDACC ADD ORIGINAL EXPONENT
|
|
1430 LDA #CON.LOG.TWO MULTIPLY BY LOG(2) TO FORM
|
|
1440 LDY /CON.LOG.TWO NATURAL LOG OF X
|
|
1450 *--------------------------------
|
|
1460 * FAC = (Y,A) * FAC
|
|
1470 *--------------------------------
|
|
1480 FMULT JSR LOAD.ARG.FROM.YA
|
|
1490 *--------------------------------
|
|
1500 * FAC = ARG * FAC
|
|
1510 *--------------------------------
|
|
1520 FMULTT BNE .1 FAC .NE. ZERO
|
|
1530 JMP RTS.13 FAC = 0 * ARG = 0
|
|
1540 * <<< WHY IS LINE ABOVE JUST "RTS"? >>>
|
|
1550 *--------------------------------
|
|
1560 *
|
|
1570 *--------------------------------
|
|
1580 .1 JSR ADD.EXPONENTS
|
|
1590 LDA #0
|
|
1600 STA RESULT INIT PRODUCT = 0
|
|
1610 STA RESULT+1
|
|
1620 STA RESULT+2
|
|
1630 STA RESULT+3
|
|
1640 LDA FAC.EXTENSION
|
|
1650 JSR MULTIPLY.1
|
|
1660 LDA FAC+4
|
|
1670 JSR MULTIPLY.1
|
|
1680 LDA FAC+3
|
|
1690 JSR MULTIPLY.1
|
|
1700 LDA FAC+2
|
|
1710 JSR MULTIPLY.1
|
|
1720 LDA FAC+1
|
|
1730 JSR MULTIPLY.2
|
|
1740 JMP COPY.RESULT.INTO.FAC
|
|
1750 *--------------------------------
|
|
1760 * MULTIPLY ARG BY (A) INTO RESULT
|
|
1770 *--------------------------------
|
|
1780 MULTIPLY.1
|
|
1790 BNE MULTIPLY.2 THIS BYTE NON-ZERO
|
|
1800 JMP SHIFT.RIGHT.1 (A)=0, JUST SHIFT ARG RIGHT 8
|
|
1810 *--------------------------------
|
|
1820 MULTIPLY.2
|
|
1830 LSR SHIFT BIT INTO CARRY
|
|
1840 ORA #$80 SUPPLY SENTINEL BIT
|
|
1850 .1 TAY REMAINING MULTIPLIER TO Y
|
|
1860 BCC .2 THIS MULTIPLIER BIT = 0
|
|
1870 CLC = 1, SO ADD ARG TO RESULT
|
|
1880 LDA RESULT+3
|
|
1890 ADC ARG+4
|
|
1900 STA RESULT+3
|
|
1910 LDA RESULT+2
|
|
1920 ADC ARG+3
|
|
1930 STA RESULT+2
|
|
1940 LDA RESULT+1
|
|
1950 ADC ARG+2
|
|
1960 STA RESULT+1
|
|
1970 LDA RESULT
|
|
1980 ADC ARG+1
|
|
1990 STA RESULT
|
|
2000 .2 ROR RESULT SHIFT RESULT RIGHT 1
|
|
2010 ROR RESULT+1
|
|
2020 ROR RESULT+2
|
|
2030 ROR RESULT+3
|
|
2040 ROR FAC.EXTENSION
|
|
2050 TYA REMAINING MULTIPLIER
|
|
2060 LSR LSB INTO CARRY
|
|
2070 BNE .1 IF SENTINEL STILL HERE, MULTIPLY
|
|
2080 RTS.13 RTS 8 X 32 COMPLETED
|
|
2090 *--------------------------------
|
|
2100 * UNPACK NUMBER AT (Y,A) INTO ARG
|
|
2110 *--------------------------------
|
|
2120 LOAD.ARG.FROM.YA
|
|
2130 STA INDEX USE INDEX FOR PNTR
|
|
2140 STY INDEX+1
|
|
2150 LDY #4 FIVE BYTES TO MOVE
|
|
2160 LDA (INDEX),Y
|
|
2170 STA ARG+4
|
|
2180 DEY
|
|
2190 LDA (INDEX),Y
|
|
2200 STA ARG+3
|
|
2210 DEY
|
|
2220 LDA (INDEX),Y
|
|
2230 STA ARG+2
|
|
2240 DEY
|
|
2250 LDA (INDEX),Y
|
|
2260 STA ARG.SIGN
|
|
2270 EOR FAC.SIGN SET COMBINED SIGN FOR MULT/DIV
|
|
2280 STA SGNCPR
|
|
2290 LDA ARG.SIGN TURN ON NORMALIZED INVISIBLE BIT
|
|
2300 ORA #$80 TO COMPLETE MANTISSA
|
|
2310 STA ARG+1
|
|
2320 DEY
|
|
2330 LDA (INDEX),Y
|
|
2340 STA ARG EXPONENT
|
|
2350 LDA FAC SET STATUS BITS ON FAC EXPONENT
|
|
2360 RTS
|
|
2370 *--------------------------------
|
|
2380 * ADD EXPONENTS OF ARG AND FAC
|
|
2390 * (CALLED BY FMULT AND FDIV)
|
|
2400 *
|
|
2410 * ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
|
|
2420 *--------------------------------
|
|
2430 ADD.EXPONENTS
|
|
2440 LDA ARG
|
|
2450 *--------------------------------
|
|
2460 ADD.EXPONENTS.1
|
|
2470 BEQ ZERO IF ARG=0, RESULT IS ZERO
|
|
2480 CLC
|
|
2490 ADC FAC
|
|
2500 BCC .1 IN RANGE
|
|
2510 BMI JOV OVERFLOW
|
|
2520 CLC
|
|
2530 .HS 2C TRICK TO SKIP
|
|
2540 .1 BPL ZERO OVERFLOW
|
|
2550 ADC #$80 RE-BIAS
|
|
2560 STA FAC RESULT
|
|
2570 BNE .2
|
|
2580 JMP STA.IN.FAC.SIGN RESULT IS ZERO
|
|
2590 * <<< CRAZY TO JUMP WAY BACK THERE! >>>
|
|
2600 * <<< SAME IDENTICAL CODE IS BELOW! >>>
|
|
2610 * <<< INSTEAD OF BNE .2, JMP STA.IN.FAC.SIGN >>>
|
|
2620 * <<< ONLY NEEDED BEQ .3 >>>
|
|
2630 .2 LDA SGNCPR SET SIGN OF RESULT
|
|
2640 .3 STA FAC.SIGN
|
|
2650 RTS
|
|
2660 *--------------------------------
|
|
2670 * IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
|
|
2680 * IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
|
|
2690 * CALLED FROM "EXP" FUNCTION
|
|
2700 *--------------------------------
|
|
2710 OUTOFRNG
|
|
2720 LDA FAC.SIGN
|
|
2730 EOR #$FF
|
|
2740 BMI JOV ERROR IF POSITIVE #
|
|
2750 *--------------------------------
|
|
2760 * POP RETURN ADDRESS AND SET FAC=0
|
|
2770 *--------------------------------
|
|
2780 ZERO PLA
|
|
2790 PLA
|
|
2800 JMP ZERO.FAC
|
|
2810 *--------------------------------
|
|
2820 JOV JMP OVERFLOW
|
|
2830 *--------------------------------
|
|
2840 * MULTIPLY FAC BY 10
|
|
2850 *--------------------------------
|
|
2860 MUL10 JSR COPY.FAC.TO.ARG.ROUNDED
|
|
2870 TAX TEXT FAC EXPONENT
|
|
2880 BEQ .1 FINISHED IF FAC=0
|
|
2890 CLC
|
|
2900 ADC #2 ADD 2 TO EXPONENT GIVES (FAC)*4
|
|
2910 BCS JOV OVERFLOW
|
|
2920 LDX #0
|
|
2930 STX SGNCPR
|
|
2940 JSR FADD.2 MAKES (FAC)*5
|
|
2950 INC FAC *2, MAKES (FAC)*10
|
|
2960 BEQ JOV OVERFLOW
|
|
2970 .1 RTS
|
|
2980 *--------------------------------
|
|
2990 CON.TEN .HS 8420000000
|
|
3000 *--------------------------------
|
|
3010 * DIVIDE FAC BY 10
|
|
3020 *--------------------------------
|
|
3030 DIV10 JSR COPY.FAC.TO.ARG.ROUNDED
|
|
3040 LDA #CON.TEN SET UP TO PUT
|
|
3050 LDY /CON.TEN 10 IN FAC
|
|
3060 LDX #0
|
|
3070 *--------------------------------
|
|
3080 * FAC = ARG / (Y,A)
|
|
3090 *--------------------------------
|
|
3100 DIV STX SGNCPR
|
|
3110 JSR LOAD.FAC.FROM.YA
|
|
3120 JMP FDIVT DIVIDE ARG BY FAC
|
|
3130 *--------------------------------
|
|
3140 * FAC = (Y,A) / FAC
|
|
3150 *--------------------------------
|
|
3160 FDIV JSR LOAD.ARG.FROM.YA
|
|
3170 *--------------------------------
|
|
3180 * FAC = ARG / FAC
|
|
3190 *--------------------------------
|
|
3200 FDIVT BEQ .8 FAC = 0, DIVIDE BY ZERO ERROR
|
|
3210 JSR ROUND.FAC
|
|
3220 LDA #0 NEGATE FAC EXPONENT, SO
|
|
3230 SEC ADD.EXPONENTS FORMS DIFFERENCE
|
|
3240 SBC FAC
|
|
3250 STA FAC
|
|
3260 JSR ADD.EXPONENTS
|
|
3270 INC FAC
|
|
3280 BEQ JOV OVERFLOW
|
|
3290 LDX #-4 INDEX FOR RESULT
|
|
3300 LDA #1 SENTINEL
|
|
3310 .1 LDY ARG+1 SEE IF FAC CAN BE SUBTRACTED
|
|
3320 CPY FAC+1
|
|
3330 BNE .2
|
|
3340 LDY ARG+2
|
|
3350 CPY FAC+2
|
|
3360 BNE .2
|
|
3370 LDY ARG+3
|
|
3380 CPY FAC+3
|
|
3390 BNE .2
|
|
3400 LDY ARG+4
|
|
3410 CPY FAC+4
|
|
3420 .2 PHP SAVE THE ANSWER, AND ALSO ROLL THE
|
|
3430 ROL BIT INTO THE QUOTIENT, SENTINEL OUT
|
|
3440 BCC .3 NO SENTINEL, STILL NOT 8 TRIPS
|
|
3450 INX 8 TRIPS, STORE BYTE OF QUOTIENT
|
|
3460 STA RESULT+3,X
|
|
3470 BEQ .6 32-BITS COMPLETED
|
|
3480 BPL .7 FINAL EXIT WHEN X=1
|
|
3490 LDA #1 RE-START SENTINEL
|
|
3500 .3 PLP GET ANSWER, CAN FAC BE SUBTRACTED?
|
|
3510 BCS .5 YES, DO IT
|
|
3520 .4 ASL ARG+4 NO, SHIFT ARG LEFT
|
|
3530 ROL ARG+3
|
|
3540 ROL ARG+2
|
|
3550 ROL ARG+1
|
|
3560 BCS .2 ANOTHER TRIP
|
|
3570 BMI .1 HAVE TO COMPARE FIRST
|
|
3580 BPL .2 ...ALWAYS
|
|
3590 .5 TAY SAVE QUOTIENT/SENTINEL BYTE
|
|
3600 LDA ARG+4 SUBTRACT FAC FROM ARG ONCE
|
|
3610 SBC FAC+4
|
|
3620 STA ARG+4
|
|
3630 LDA ARG+3
|
|
3640 SBC FAC+3
|
|
3650 STA ARG+3
|
|
3660 LDA ARG+2
|
|
3670 SBC FAC+2
|
|
3680 STA ARG+2
|
|
3690 LDA ARG+1
|
|
3700 SBC FAC+1
|
|
3710 STA ARG+1
|
|
3720 TYA RESTORE QUOTIENT/SENTINEL BYTE
|
|
3730 JMP .4 GO TO SHIFT ARG AND CONTINUE
|
|
3740 *--------------------------------
|
|
3750 .6 LDA #$40 DO A FEW EXTENSION BITS
|
|
3760 BNE .3 ...ALWAYS
|
|
3770 *--------------------------------
|
|
3780 .7 ASL LEFT JUSTIFY THE EXTENSION BITS WE DID
|
|
3790 ASL
|
|
3800 ASL
|
|
3810 ASL
|
|
3820 ASL
|
|
3830 ASL
|
|
3840 STA FAC.EXTENSION
|
|
3850 PLP
|
|
3860 JMP COPY.RESULT.INTO.FAC
|
|
3870 *--------------------------------
|
|
3880 .8 LDX #ERR.ZERODIV
|
|
3890 JMP ERROR
|
|
3900 *--------------------------------
|
|
3910 * COPY RESULT INTO FAC MANTISSA, AND NORMALIZE
|
|
3920 *--------------------------------
|
|
3930 COPY.RESULT.INTO.FAC
|
|
3940 LDA RESULT
|
|
3950 STA FAC+1
|
|
3960 LDA RESULT+1
|
|
3970 STA FAC+2
|
|
3980 LDA RESULT+2
|
|
3990 STA FAC+3
|
|
4000 LDA RESULT+3
|
|
4010 STA FAC+4
|
|
4020 JMP NORMALIZE.FAC.2
|
|
4030 *--------------------------------
|
|
4040 * UNPACK (Y,A) INTO FAC
|
|
4050 *--------------------------------
|
|
4060 LOAD.FAC.FROM.YA
|
|
4070 STA INDEX USE INDEX FOR PNTR
|
|
4080 STY INDEX+1
|
|
4090 LDY #4 PICK UP 5 BYTES
|
|
4100 LDA (INDEX),Y
|
|
4110 STA FAC+4
|
|
4120 DEY
|
|
4130 LDA (INDEX),Y
|
|
4140 STA FAC+3
|
|
4150 DEY
|
|
4160 LDA (INDEX),Y
|
|
4170 STA FAC+2
|
|
4180 DEY
|
|
4190 LDA (INDEX),Y
|
|
4200 STA FAC.SIGN FIRST BIT IS SIGN
|
|
4210 ORA #$80 SET NORMALIZED INVISIBLE BIT
|
|
4220 STA FAC+1
|
|
4230 DEY
|
|
4240 LDA (INDEX),Y
|
|
4250 STA FAC EXPONENT
|
|
4260 STY FAC.EXTENSION Y=0
|
|
4270 RTS
|
|
4280 *--------------------------------
|
|
4290 * ROUND FAC, STORE IN TEMP2
|
|
4300 *--------------------------------
|
|
4310 STORE.FAC.IN.TEMP2.ROUNDED
|
|
4320 LDX #TEMP2 PACK FAC INTO TEMP2
|
|
4330 .HS 2C TRICK TO BRANCH
|
|
4340 *--------------------------------
|
|
4350 * ROUND FAC, STORE IN TEMP1
|
|
4360 *--------------------------------
|
|
4370 STORE.FAC.IN.TEMP1.ROUNDED
|
|
4380 LDX #TEMP1 PACK FAC INTO TEMP1
|
|
4390 LDY /TEMP1 HI-BYTE OF TEMP1 SAME AS TEMP2
|
|
4400 BEQ STORE.FAC.AT.YX.ROUNDED ...ALWAYS
|
|
4410 *--------------------------------
|
|
4420 * ROUND FAC, AND STORE WHERE FORPNT POINTS
|
|
4430 *--------------------------------
|
|
4440 SETFOR LDX FORPNT
|
|
4450 LDY FORPNT+1
|
|
4460 *--------------------------------
|
|
4470 * ROUND FAC, AND STORE AT (Y,X)
|
|
4480 *--------------------------------
|
|
4490 STORE.FAC.AT.YX.ROUNDED
|
|
4500 JSR ROUND.FAC ROUND VALUE IN FAC USING EXTENSION
|
|
4510 STX INDEX USE INDEX FOR PNTR
|
|
4520 STY INDEX+1
|
|
4530 LDY #4 STORING 5 PACKED BYTES
|
|
4540 LDA FAC+4
|
|
4550 STA (INDEX),Y
|
|
4560 DEY
|
|
4570 LDA FAC+3
|
|
4580 STA (INDEX),Y
|
|
4590 DEY
|
|
4600 LDA FAC+2
|
|
4610 STA (INDEX),Y
|
|
4620 DEY
|
|
4630 LDA FAC.SIGN PACK SIGN IN TOP BIT OF MANTISSA
|
|
4640 ORA #$7F
|
|
4650 AND FAC+1
|
|
4660 STA (INDEX),Y
|
|
4670 DEY
|
|
4680 LDA FAC EXPONENT
|
|
4690 STA (INDEX),Y
|
|
4700 STY FAC.EXTENSION ZERO THE EXTENSION
|
|
4710 RTS
|
|
4720 *--------------------------------
|
|
4730 * COPY ARG INTO FAC
|
|
4740 *--------------------------------
|
|
4750 COPY.ARG.TO.FAC
|
|
4760 LDA ARG.SIGN COPY SIGN
|
|
4770 MFA STA FAC.SIGN
|
|
4780 LDX #5 MOVE 5 BYTES
|
|
4790 .1 LDA ARG-1,X
|
|
4800 STA FAC-1,X
|
|
4810 DEX
|
|
4820 BNE .1
|
|
4830 STX FAC.EXTENSION ZERO EXTENSION
|
|
4840 RTS
|
|
4850 *--------------------------------
|
|
4860 * ROUND FAC AND COPY TO ARG
|
|
4870 *--------------------------------
|
|
4880 COPY.FAC.TO.ARG.ROUNDED
|
|
4890 JSR ROUND.FAC ROUND FAC USING EXTENSION
|
|
4900 MAF LDX #6 COPY 6 BYTES, INCLUDES SIGN
|
|
4910 .1 LDA FAC-1,X
|
|
4920 STA ARG-1,X
|
|
4930 DEX
|
|
4940 BNE .1
|
|
4950 STX FAC.EXTENSION ZERO FAC EXTENSION
|
|
4960 RTS.14 RTS
|