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

269 lines
8.8 KiB
Plaintext

1010 *--------------------------------
1020 * ADD 0.5 TO FAC
1030 *--------------------------------
1040 FADDH LDA #CON.HALF FAC+1/2 -> FAC
1050 LDY /CON.HALF
1060 JMP FADD
1070 *--------------------------------
1080 * FAC = (Y,A) - FAC
1090 *--------------------------------
1100 FSUB JSR LOAD.ARG.FROM.YA
1110 *--------------------------------
1120 * FAC = ARG - FAC
1130 *--------------------------------
1140 FSUBT LDA FAC.SIGN COMPLEMENT FAC AND ADD
1150 EOR #$FF
1160 STA FAC.SIGN
1170 EOR ARG.SIGN FIX SGNCPR TOO
1180 STA SGNCPR
1190 LDA FAC MAKE STATUS SHOW FAC EXPONENT
1200 JMP FADDT JOIN FADD
1210 *--------------------------------
1220 * SHIFT SMALLER ARGUMENT MORE THAN 7 BITS
1230 *--------------------------------
1240 FADD.1 JSR SHIFT.RIGHT ALIGN RADIX BY SHIFTING
1250 BCC FADD.3 ...ALWAYS
1260 *--------------------------------
1270 * FAC = (Y,A) + FAC
1280 *--------------------------------
1290 FADD JSR LOAD.ARG.FROM.YA
1300 *--------------------------------
1310 * FAC = ARG + FAC
1320 *--------------------------------
1330 FADDT BNE .1 FAC IS NON-ZERO
1340 JMP COPY.ARG.TO.FAC FAC = 0 + ARG
1350 .1 LDX FAC.EXTENSION
1360 STX ARG.EXTENSION
1370 LDX #ARG SET UP TO SHIFT ARG
1380 LDA ARG EXPONENT
1390 *--------------------------------
1400 FADD.2 TAY
1410 BEQ RTS.10 IF ARG=0, WE ARE FINISHED
1420 SEC
1430 SBC FAC GET DIFFNCE OF EXP
1440 BEQ FADD.3 GO ADD IF SAME EXP
1450 BCC .1 ARG HAS SMALLER EXPONENT
1460 STY FAC EXP HAS SMALLER EXPONENT
1470 LDY ARG.SIGN
1480 STY FAC.SIGN
1490 EOR #$FF COMPLEMENT SHIFT COUNT
1500 ADC #0 CARRY WAS SET
1510 LDY #0
1520 STY ARG.EXTENSION
1530 LDX #FAC SET UP TO SHIFT FAC
1540 BNE .2 ...ALWAYS
1550 .1 LDY #0
1560 STY FAC.EXTENSION
1570 .2 CMP #$F9 SHIFT MORE THAN 7 BITS?
1580 BMI FADD.1 YES
1590 TAY INDEX TO # OF SHIFTS
1600 LDA FAC.EXTENSION
1610 LSR 1,X START SHIFTING...
1620 JSR SHIFT.RIGHT.4 ...COMPLETE SHIFTING
1630 FADD.3 BIT SGNCPR DO FAC AND ARG HAVE SAME SIGNS?
1640 BPL FADD.4 YES, ADD THE MANTISSAS
1650 LDY #FAC NO, SUBTRACT SMALLER FROM LARGER
1660 CPX #ARG WHICH WAS ADJUSTED?
1670 BEQ .1 IF ARG, DO FAC-ARG
1680 LDY #ARG IF FAC, DO ARG-FAC
1690 .1 SEC SUBTRACT SMALLER FROM LARGER (WE HOPE)
1700 EOR #$FF (IF EXPONENTS WERE EQUAL, WE MIGHT BE
1710 ADC ARG.EXTENSION SUBTRACTING LARGER FROM SMALLER)
1720 STA FAC.EXTENSION
1730 LDA 4,Y
1740 SBC 4,X
1750 STA FAC+4
1760 LDA 3,Y
1770 SBC 3,X
1780 STA FAC+3
1790 LDA 2,Y
1800 SBC 2,X
1810 STA FAC+2
1820 LDA 1,Y
1830 SBC 1,X
1840 STA FAC+1
1850 *--------------------------------
1860 * NORMALIZE VALUE IN FAC
1870 *--------------------------------
1880 NORMALIZE.FAC.1
1890 BCS NORMALIZE.FAC.2
1900 JSR COMPLEMENT.FAC
1910 *--------------------------------
1920 NORMALIZE.FAC.2
1930 LDY #0 SHIFT UP SIGNIF DIGIT
1940 TYA START A=0, COUNT SHIFTS IN A-REG
1950 CLC
1960 .1 LDX FAC+1 LOOK AT MOST SIGNIFICANT BYTE
1970 BNE NORMALIZE.FAC.4 SOME 1-BITS HERE
1980 LDX FAC+2 HI-BYTE OF MANTISSA STILL ZERO,
1990 STX FAC+1 SO DO A FAST 8-BIT SHUFFLE
2000 LDX FAC+3
2010 STX FAC+2
2020 LDX FAC+4
2030 STX FAC+3
2040 LDX FAC.EXTENSION
2050 STX FAC+4
2060 STY FAC.EXTENSION ZERO EXTENSION BYTE
2070 ADC #8 BUMP SHIFT COUNT
2080 CMP #32 DONE 4 TIMES YET?
2090 BNE .1 NO, STILL MIGHT BE SOME 1'S
2100 * YES, VALUE OF FAC IS ZERO
2110 *--------------------------------
2120 * SET FAC = 0
2130 * (ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS)
2140 *--------------------------------
2150 ZERO.FAC
2160 LDA #0
2170 *--------------------------------
2180 STA.IN.FAC.SIGN.AND.EXP
2190 STA FAC
2200 *--------------------------------
2210 STA.IN.FAC.SIGN
2220 STA FAC.SIGN
2230 RTS
2240 *--------------------------------
2250 * ADD MANTISSAS OF FAC AND ARG INTO FAC
2260 *--------------------------------
2270 FADD.4 ADC ARG.EXTENSION
2280 STA FAC.EXTENSION
2290 LDA FAC+4
2300 ADC ARG+4
2310 STA FAC+4
2320 LDA FAC+3
2330 ADC ARG+3
2340 STA FAC+3
2350 LDA FAC+2
2360 ADC ARG+2
2370 STA FAC+2
2380 LDA FAC+1
2390 ADC ARG+1
2400 STA FAC+1
2410 JMP NORMALIZE.FAC.5
2420 *--------------------------------
2430 * FINISH NORMALIZING FAC
2440 *--------------------------------
2450 NORMALIZE.FAC.3
2460 ADC #1 COUNT BITS SHIFTED
2470 ASL FAC.EXTENSION
2480 ROL FAC+4
2490 ROL FAC+3
2500 ROL FAC+2
2510 ROL FAC+1
2520 *--------------------------------
2530 NORMALIZE.FAC.4
2540 BPL NORMALIZE.FAC.3 UNTIL TOP BIT = 1
2550 SEC
2560 SBC FAC ADJUST EXPONENT BY BITS SHIFTED
2570 BCS ZERO.FAC UNDERFLOW, RETURN ZERO
2580 EOR #$FF
2590 ADC #1 2'S COMPLEMENT
2600 STA FAC CARRY=0 NOW
2610 *--------------------------------
2620 NORMALIZE.FAC.5
2630 BCC RTS.11 UNLESS MANTISSA CARRIED
2640 *--------------------------------
2650 NORMALIZE.FAC.6
2660 INC FAC MANTISSA CARRIED, SO SHIFT RIGHT
2670 BEQ OVERFLOW OVERFLOW IF EXPONENT TOO BIG
2680 ROR FAC+1
2690 ROR FAC+2
2700 ROR FAC+3
2710 ROR FAC+4
2720 ROR FAC.EXTENSION
2730 RTS.11 RTS
2740 *--------------------------------
2750 * 2'S COMPLEMENT OF FAC
2760 *--------------------------------
2770 COMPLEMENT.FAC
2780 LDA FAC.SIGN
2790 EOR #$FF
2800 STA FAC.SIGN
2810 *--------------------------------
2820 * 2'S COMPLEMENT OF FAC MANTISSA ONLY
2830 *--------------------------------
2840 COMPLEMENT.FAC.MANTISSA
2850 LDA FAC+1
2860 EOR #$FF
2870 STA FAC+1
2880 LDA FAC+2
2890 EOR #$FF
2900 STA FAC+2
2910 LDA FAC+3
2920 EOR #$FF
2930 STA FAC+3
2940 LDA FAC+4
2950 EOR #$FF
2960 STA FAC+4
2970 LDA FAC.EXTENSION
2980 EOR #$FF
2990 STA FAC.EXTENSION
3000 INC FAC.EXTENSION START INCREMENTING MANTISSA
3010 BNE RTS.12
3020 *--------------------------------
3030 * INCREMENT FAC MANTISSA
3040 *--------------------------------
3050 INCREMENT.FAC.MANTISSA
3060 INC FAC+4 ADD CARRY FROM EXTRA
3070 BNE RTS.12
3080 INC FAC+3
3090 BNE RTS.12
3100 INC FAC+2
3110 BNE RTS.12
3120 INC FAC+1
3130 RTS.12 RTS
3140 *--------------------------------
3150 OVERFLOW
3160 LDX #ERR.OVERFLOW
3170 JMP ERROR
3180 *--------------------------------
3190 * SHIFT 1,X THRU 5,X RIGHT
3200 * (A) = NEGATIVE OF SHIFT COUNT
3210 * (X) = POINTER TO BYTES TO BE SHIFTED
3220 *
3230 * RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG
3240 *--------------------------------
3250 SHIFT.RIGHT.1
3260 LDX #RESULT-1 SHIFT RESULT RIGHT
3270 SHIFT.RIGHT.2
3280 LDY 4,X SHIFT 8 BITS RIGHT
3290 STY FAC.EXTENSION
3300 LDY 3,X
3310 STY 4,X
3320 LDY 2,X
3330 STY 3,X
3340 LDY 1,X
3350 STY 2,X
3360 LDY SHIFT.SIGN.EXT $00 IF +, $FF IF -
3370 STY 1,X
3380 *--------------------------------
3390 * MAIN ENTRY TO RIGHT SHIFT SUBROUTINE
3400 *--------------------------------
3410 SHIFT.RIGHT
3420 ADC #8
3430 BMI SHIFT.RIGHT.2 STILL MORE THAN 8 BITS TO GO
3440 BEQ SHIFT.RIGHT.2 EXACTLY 8 MORE BITS TO GO
3450 SBC #8 UNDO ADC ABOVE
3460 TAY REMAINING SHIFT COUNT
3470 LDA FAC.EXTENSION
3480 BCS SHIFT.RIGHT.5 FINISHED SHIFTING
3490 SHIFT.RIGHT.3
3500 L ASL 1,X SIGN -> CARRY (SIGN EXTENSION)
3510 BCC .1 SIGN +
3520 INC 1,X PUT SIGN IN LSB
3530 .1 ROR 1,X RESTORE VALUE, SIGN STILL IN CARRY
3540 ROR 1,X START RIGHT SHIFT, INSERTING SIGN
3550 *--------------------------------
3560 * ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION
3570 *--------------------------------
3580 SHIFT.RIGHT.4
3590 ROR 2,X
3600 ROR 3,X
3610 ROR 4,X
3620 ROR EXTENSION
3630 INY COUNT THE SHIFT
3640 BNE SHIFT.RIGHT.3
3650 SHIFT.RIGHT.5
3660 CLC RETURN WITH CARRY CLEAR
3670 RTS
3680 *--------------------------------