S-C DocuMentor — Applesoft
SAVE S.E7A0
1010 *--------------------------------
1020 * ADD 0.5 TO FAC
1030 *--------------------------------
E7A0- A9 64 1040 FADDH LDA #CON.HALF FAC+1/2 -> FAC
E7A2- A0 EE 1050 LDY /CON.HALF
E7A4- 4C BE E7 1060 JMP FADD
1070 *--------------------------------
1080 * FAC = (Y,A) - FAC
1090 *--------------------------------
E7A7- 20 E3 E9 1100 FSUB JSR LOAD.ARG.FROM.YA
1110 *--------------------------------
1120 * FAC = ARG - FAC
1130 *--------------------------------
E7AA- A5 A2 1140 FSUBT LDA FAC.SIGN COMPLEMENT FAC AND ADD
E7AC- 49 FF 1150 EOR #$FF
E7AE- 85 A2 1160 STA FAC.SIGN
E7B0- 45 AA 1170 EOR ARG.SIGN FIX SGNCPR TOO
E7B2- 85 AB 1180 STA SGNCPR
E7B4- A5 9D 1190 LDA FAC MAKE STATUS SHOW FAC EXPONENT
E7B6- 4C C1 E7 1200 JMP FADDT JOIN FADD
1210 *--------------------------------
1220 * SHIFT SMALLER ARGUMENT MORE THAN 7 BITS
1230 *--------------------------------
E7B9- 20 F0 E8 1240 FADD.1 JSR SHIFT.RIGHT ALIGN RADIX BY SHIFTING
E7BC- 90 3C 1250 BCC FADD.3 ...ALWAYS
1260 *--------------------------------
1270 * FAC = (Y,A) + FAC
1280 *--------------------------------
E7BE- 20 E3 E9 1290 FADD JSR LOAD.ARG.FROM.YA
1300 *--------------------------------
1310 * FAC = ARG + FAC
1320 *--------------------------------
E7C1- D0 03 1330 FADDT BNE .1 FAC IS NON-ZERO
E7C3- 4C 53 EB 1340 JMP COPY.ARG.TO.FAC FAC = 0 + ARG
E7C6- A6 AC 1350 .1 LDX FAC.EXTENSION
E7C8- 86 92 1360 STX ARG.EXTENSION
E7CA- A2 A5 1370 LDX #ARG SET UP TO SHIFT ARG
E7CC- A5 A5 1380 LDA ARG EXPONENT
1390 *--------------------------------
E7CE- A8 1400 FADD.2 TAY
E7CF- F0 CE 1410 BEQ RTS.10 IF ARG=0, WE ARE FINISHED
E7D1- 38 1420 SEC
E7D2- E5 9D 1430 SBC FAC GET DIFFNCE OF EXP
E7D4- F0 24 1440 BEQ FADD.3 GO ADD IF SAME EXP
E7D6- 90 12 1450 BCC .1 ARG HAS SMALLER EXPONENT
E7D8- 84 9D 1460 STY FAC EXP HAS SMALLER EXPONENT
E7DA- A4 AA 1470 LDY ARG.SIGN
E7DC- 84 A2 1480 STY FAC.SIGN
E7DE- 49 FF 1490 EOR #$FF COMPLEMENT SHIFT COUNT
E7E0- 69 00 1500 ADC #0 CARRY WAS SET
E7E2- A0 00 1510 LDY #0
E7E4- 84 92 1520 STY ARG.EXTENSION
E7E6- A2 9D 1530 LDX #FAC SET UP TO SHIFT FAC
E7E8- D0 04 1540 BNE .2 ...ALWAYS
E7EA- A0 00 1550 .1 LDY #0
E7EC- 84 AC 1560 STY FAC.EXTENSION
E7EE- C9 F9 1570 .2 CMP #$F9 SHIFT MORE THAN 7 BITS?
E7F0- 30 C7 1580 BMI FADD.1 YES
E7F2- A8 1590 TAY INDEX TO # OF SHIFTS
E7F3- A5 AC 1600 LDA FAC.EXTENSION
E7F5- 56 01 1610 LSR 1,X START SHIFTING...
E7F7- 20 07 E9 1620 JSR SHIFT.RIGHT.4 ...COMPLETE SHIFTING
E7FA- 24 AB 1630 FADD.3 BIT SGNCPR DO FAC AND ARG HAVE SAME SIGNS?
E7FC- 10 57 1640 BPL FADD.4 YES, ADD THE MANTISSAS
E7FE- A0 9D 1650 LDY #FAC NO, SUBTRACT SMALLER FROM LARGER
E800- E0 A5 1660 CPX #ARG WHICH WAS ADJUSTED?
E802- F0 02 1670 BEQ .1 IF ARG, DO FAC-ARG
E804- A0 A5 1680 LDY #ARG IF FAC, DO ARG-FAC
E806- 38 1690 .1 SEC SUBTRACT SMALLER FROM LARGER (WE HOPE)
E807- 49 FF 1700 EOR #$FF (IF EXPONENTS WERE EQUAL, WE MIGHT BE
E809- 65 92 1710 ADC ARG.EXTENSION SUBTRACTING LARGER FROM SMALLER)
E80B- 85 AC 1720 STA FAC.EXTENSION
E80D- B9 04 00 1730 LDA 4,Y
E810- F5 04 1740 SBC 4,X
E812- 85 A1 1750 STA FAC+4
E814- B9 03 00 1760 LDA 3,Y
E817- F5 03 1770 SBC 3,X
E819- 85 A0 1780 STA FAC+3
E81B- B9 02 00 1790 LDA 2,Y
E81E- F5 02 1800 SBC 2,X
E820- 85 9F 1810 STA FAC+2
E822- B9 01 00 1820 LDA 1,Y
E825- F5 01 1830 SBC 1,X
E827- 85 9E 1840 STA FAC+1
1850 *--------------------------------
1860 * NORMALIZE VALUE IN FAC
1870 *--------------------------------
1880 NORMALIZE.FAC.1
E829- B0 03 1890 BCS NORMALIZE.FAC.2
E82B- 20 9E E8 1900 JSR COMPLEMENT.FAC
1910 *--------------------------------
1920 NORMALIZE.FAC.2
E82E- A0 00 1930 LDY #0 SHIFT UP SIGNIF DIGIT
E830- 98 1940 TYA START A=0, COUNT SHIFTS IN A-REG
E831- 18 1950 CLC
E832- A6 9E 1960 .1 LDX FAC+1 LOOK AT MOST SIGNIFICANT BYTE
E834- D0 4A 1970 BNE NORMALIZE.FAC.4 SOME 1-BITS HERE
E836- A6 9F 1980 LDX FAC+2 HI-BYTE OF MANTISSA STILL ZERO,
E838- 86 9E 1990 STX FAC+1 SO DO A FAST 8-BIT SHUFFLE
E83A- A6 A0 2000 LDX FAC+3
E83C- 86 9F 2010 STX FAC+2
E83E- A6 A1 2020 LDX FAC+4
E840- 86 A0 2030 STX FAC+3
E842- A6 AC 2040 LDX FAC.EXTENSION
E844- 86 A1 2050 STX FAC+4
E846- 84 AC 2060 STY FAC.EXTENSION ZERO EXTENSION BYTE
E848- 69 08 2070 ADC #8 BUMP SHIFT COUNT
E84A- C9 20 2080 CMP #32 DONE 4 TIMES YET?
E84C- D0 E4 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
E84E- A9 00 2160 LDA #0
2170 *--------------------------------
2180 STA.IN.FAC.SIGN.AND.EXP
E850- 85 9D 2190 STA FAC
2200 *--------------------------------
2210 STA.IN.FAC.SIGN
E852- 85 A2 2220 STA FAC.SIGN
E854- 60 2230 RTS
2240 *--------------------------------
2250 * ADD MANTISSAS OF FAC AND ARG INTO FAC
2260 *--------------------------------
E855- 65 92 2270 FADD.4 ADC ARG.EXTENSION
E857- 85 AC 2280 STA FAC.EXTENSION
E859- A5 A1 2290 LDA FAC+4
E85B- 65 A9 2300 ADC ARG+4
E85D- 85 A1 2310 STA FAC+4
E85F- A5 A0 2320 LDA FAC+3
E861- 65 A8 2330 ADC ARG+3
E863- 85 A0 2340 STA FAC+3
E865- A5 9F 2350 LDA FAC+2
E867- 65 A7 2360 ADC ARG+2
E869- 85 9F 2370 STA FAC+2
E86B- A5 9E 2380 LDA FAC+1
E86D- 65 A6 2390 ADC ARG+1
E86F- 85 9E 2400 STA FAC+1
E871- 4C 8D E8 2410 JMP NORMALIZE.FAC.5
2420 *--------------------------------
2430 * FINISH NORMALIZING FAC
2440 *--------------------------------
2450 NORMALIZE.FAC.3
E874- 69 01 2460 ADC #1 COUNT BITS SHIFTED
E876- 06 AC 2470 ASL FAC.EXTENSION
E878- 26 A1 2480 ROL FAC+4
E87A- 26 A0 2490 ROL FAC+3
E87C- 26 9F 2500 ROL FAC+2
E87E- 26 9E 2510 ROL FAC+1
2520 *--------------------------------
2530 NORMALIZE.FAC.4
E880- 10 F2 2540 BPL NORMALIZE.FAC.3 UNTIL TOP BIT = 1
E882- 38 2550 SEC
E883- E5 9D 2560 SBC FAC ADJUST EXPONENT BY BITS SHIFTED
E885- B0 C7 2570 BCS ZERO.FAC UNDERFLOW, RETURN ZERO
E887- 49 FF 2580 EOR #$FF
E889- 69 01 2590 ADC #1 2'S COMPLEMENT
E88B- 85 9D 2600 STA FAC CARRY=0 NOW
2610 *--------------------------------
2620 NORMALIZE.FAC.5
E88D- 90 0E 2630 BCC RTS.11 UNLESS MANTISSA CARRIED
2640 *--------------------------------
2650 NORMALIZE.FAC.6
E88F- E6 9D 2660 INC FAC MANTISSA CARRIED, SO SHIFT RIGHT
E891- F0 42 2670 BEQ OVERFLOW OVERFLOW IF EXPONENT TOO BIG
E893- 66 9E 2680 ROR FAC+1
E895- 66 9F 2690 ROR FAC+2
E897- 66 A0 2700 ROR FAC+3
E899- 66 A1 2710 ROR FAC+4
E89B- 66 AC 2720 ROR FAC.EXTENSION
E89D- 60 2730 RTS.11 RTS
2740 *--------------------------------
2750 * 2'S COMPLEMENT OF FAC
2760 *--------------------------------
2770 COMPLEMENT.FAC
E89E- A5 A2 2780 LDA FAC.SIGN
E8A0- 49 FF 2790 EOR #$FF
E8A2- 85 A2 2800 STA FAC.SIGN
2810 *--------------------------------
2820 * 2'S COMPLEMENT OF FAC MANTISSA ONLY
2830 *--------------------------------
2840 COMPLEMENT.FAC.MANTISSA
E8A4- A5 9E 2850 LDA FAC+1
E8A6- 49 FF 2860 EOR #$FF
E8A8- 85 9E 2870 STA FAC+1
E8AA- A5 9F 2880 LDA FAC+2
E8AC- 49 FF 2890 EOR #$FF
E8AE- 85 9F 2900 STA FAC+2
E8B0- A5 A0 2910 LDA FAC+3
E8B2- 49 FF 2920 EOR #$FF
E8B4- 85 A0 2930 STA FAC+3
E8B6- A5 A1 2940 LDA FAC+4
E8B8- 49 FF 2950 EOR #$FF
E8BA- 85 A1 2960 STA FAC+4
E8BC- A5 AC 2970 LDA FAC.EXTENSION
E8BE- 49 FF 2980 EOR #$FF
E8C0- 85 AC 2990 STA FAC.EXTENSION
E8C2- E6 AC 3000 INC FAC.EXTENSION START INCREMENTING MANTISSA
E8C4- D0 0E 3010 BNE RTS.12
3020 *--------------------------------
3030 * INCREMENT FAC MANTISSA
3040 *--------------------------------
3050 INCREMENT.FAC.MANTISSA
E8C6- E6 A1 3060 INC FAC+4 ADD CARRY FROM EXTRA
E8C8- D0 0A 3070 BNE RTS.12
E8CA- E6 A0 3080 INC FAC+3
E8CC- D0 06 3090 BNE RTS.12
E8CE- E6 9F 3100 INC FAC+2
E8D0- D0 02 3110 BNE RTS.12
E8D2- E6 9E 3120 INC FAC+1
E8D4- 60 3130 RTS.12 RTS
3140 *--------------------------------
3150 OVERFLOW
E8D5- A2 45 3160 LDX #ERR.OVERFLOW
E8D7- 4C 12 D4 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
E8DA- A2 61 3260 LDX #RESULT-1 SHIFT RESULT RIGHT
3270 SHIFT.RIGHT.2
E8DC- B4 04 3280 LDY 4,X SHIFT 8 BITS RIGHT
E8DE- 84 AC 3290 STY FAC.EXTENSION
E8E0- B4 03 3300 LDY 3,X
E8E2- 94 04 3310 STY 4,X
E8E4- B4 02 3320 LDY 2,X
E8E6- 94 03 3330 STY 3,X
E8E8- B4 01 3340 LDY 1,X
E8EA- 94 02 3350 STY 2,X
E8EC- A4 A4 3360 LDY SHIFT.SIGN.EXT $00 IF +, $FF IF -
E8EE- 94 01 3370 STY 1,X
3380 *--------------------------------
3390 * MAIN ENTRY TO RIGHT SHIFT SUBROUTINE
3400 *--------------------------------
3410 SHIFT.RIGHT
E8F0- 69 08 3420 ADC #8
E8F2- 30 E8 3430 BMI SHIFT.RIGHT.2 STILL MORE THAN 8 BITS TO GO
E8F4- F0 E6 3440 BEQ SHIFT.RIGHT.2 EXACTLY 8 MORE BITS TO GO
E8F6- E9 08 3450 SBC #8 UNDO ADC ABOVE
E8F8- A8 3460 TAY REMAINING SHIFT COUNT
E8F9- A5 AC 3470 LDA FAC.EXTENSION
E8FB- B0 14 3480 BCS SHIFT.RIGHT.5 FINISHED SHIFTING
3490 SHIFT.RIGHT.3
E8FD- 16 01 3500 L ASL 1,X SIGN -> CARRY (SIGN EXTENSION)
E8FF- 90 02 3510 BCC .1 SIGN +
E901- F6 01 3520 INC 1,X PUT SIGN IN LSB
E903- 76 01 3530 .1 ROR 1,X RESTORE VALUE, SIGN STILL IN CARRY
E905- 76 01 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
E907- 76 02 3590 ROR 2,X
E909- 76 03 3600 ROR 3,X
E90B- 76 04 3610 ROR 4,X
E90D- 6A 3620 ROR EXTENSION
E90E- C8 3630 INY COUNT THE SHIFT
E90F- D0 EC 3640 BNE SHIFT.RIGHT.3
3650 SHIFT.RIGHT.5
E911- 18 3660 CLC RETURN WITH CARRY CLEAR
E912- 60 3670 RTS
3680 *--------------------------------
S.E597