goapple2/source/applesoft/S.E913
2014-05-09 17:59:16 -07:00

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