S-C DocuMentor — Applesoft
SAVE S.EB72
1010 *--------------------------------
1020 * ROUND FAC USING EXTENSION BYTE
1030 *--------------------------------
1040 ROUND.FAC
EB72- A5 9D 1050 LDA FAC
EB74- F0 FB 1060 BEQ RTS.14 FAC = 0, RETURN
EB76- 06 AC 1070 ASL FAC.EXTENSION IS FAC.EXTENSION >= 128?
EB78- 90 F7 1080 BCC RTS.14 NO, FINISHED
1090 *--------------------------------
1100 * INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
1110 *--------------------------------
1120 INCREMENT.MANTISSA
EB7A- 20 C6 E8 1130 JSR INCREMENT.FAC.MANTISSA YES, INCREMENT FAC
EB7D- D0 F2 1140 BNE RTS.14 HIGH BYTE HAS BITS, FINISHED
EB7F- 4C 8F E8 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 *--------------------------------
EB82- A5 9D 1230 SIGN LDA FAC CHECK SIGN OF FAC AND
EB84- F0 09 1240 BEQ RTS.15 RETURN -1,0,1 IN A-REG
1250 *--------------------------------
EB86- A5 A2 1260 SIGN1 LDA FAC.SIGN
1270 *--------------------------------
EB88- 2A 1280 SIGN2 ROL MSBIT TO CARRY
EB89- A9 FF 1290 LDA #$FF -1
EB8B- B0 02 1300 BCS RTS.15 MSBIT = 1
EB8D- A9 01 1310 LDA #1 +1
EB8F- 60 1320 RTS.15 RTS
1330 *--------------------------------
1340 * "SGN" FUNCTION
1350 *--------------------------------
EB90- 20 82 EB 1360 SGN JSR SIGN CONVERT FAC TO -1,0,1
1370 *--------------------------------
1380 * CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
1390 *--------------------------------
EB93- 85 9E 1400 FLOAT STA FAC+1 PUT IN HIGH BYTE OF MANTISSA
EB95- A9 00 1410 LDA #0 CLEAR 2ND BYTE OF MANTISSA
EB97- 85 9F 1420 STA FAC+2
EB99- A2 88 1430 LDX #$88 USE EXPONENT 2^9
1440 *--------------------------------
1450 * FLOAT UNSIGNED VALUE IN FAC+1,2
1460 * (X) = EXPONENT
1470 *--------------------------------
1480 FLOAT.1
EB9B- A5 9E 1490 LDA FAC+1 MSBIT=0, SET CARRY; =1, CLEAR CARRY
EB9D- 49 FF 1500 EOR #$FF
EB9F- 2A 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
EBA0- A9 00 1590 LDA #0 CLEAR LOWER 16-BITS OF MANTISSA
EBA2- 85 A1 1600 STA FAC+4
EBA4- 85 A0 1610 STA FAC+3
EBA6- 86 9D 1620 STX FAC STORE EXPONENT
EBA8- 85 AC 1630 STA FAC.EXTENSION CLEAR EXTENSION
EBAA- 85 A2 1640 STA FAC.SIGN MAKE SIGN POSITIVE
EBAC- 4C 29 E8 1650 JMP NORMALIZE.FAC.1 IF C=0, WILL NEGATE FAC
1660 *--------------------------------
1670 * "ABS" FUNCTION
1680 *--------------------------------
EBAF- 46 A2 1690 ABS LSR FAC.SIGN CHANGE SIGN TO +
EBB1- 60 1700 RTS
1710 *--------------------------------
1720 * COMPARE FAC WITH PACKED # AT (Y,A)
1730 * RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
1740 *--------------------------------
EBB2- 85 60 1750 FCOMP STA DEST USE DEST FOR PNTR
1760 *--------------------------------
1770 * SPECIAL ENTRY FROM "NEXT" PROCESSOR
1780 * "DEST" ALREADY SET UP
1790 *--------------------------------
EBB4- 84 61 1800 FCOMP2 STY DEST+1
EBB6- A0 00 1810 LDY #0 GET EXPONENT OF COMPARAND
EBB8- B1 60 1820 LDA (DEST),Y
EBBA- C8 1830 INY POINT AT NEXT BYTE
EBBB- AA 1840 TAX EXPONENT TO X-REG
EBBC- F0 C4 1850 BEQ SIGN IF COMPARAND=0, "SIGN" COMPARES FAC
EBBE- B1 60 1860 LDA (DEST),Y GET HI-BYTE OF MANTISSA
EBC0- 45 A2 1870 EOR FAC.SIGN COMPARE WITH FAC SIGN
EBC2- 30 C2 1880 BMI SIGN1 DIFFERENT SIGNS, "SIGN" GIVES ANSWER
EBC4- E4 9D 1890 CPX FAC SAME SIGN, SO COMPARE EXPONENTS
EBC6- D0 21 1900 BNE .1 DIFFERENT, SO SUFFICIENT TEST
EBC8- B1 60 1910 LDA (DEST),Y SAME EXPONENT, COMPARE MANTISSA
EBCA- 09 80 1920 ORA #$80 SET INVISIBLE NORMALIZED BIT
EBCC- C5 9E 1930 CMP FAC+1
EBCE- D0 19 1940 BNE .1 NOT SAME, SO SUFFICIENT
EBD0- C8 1950 INY SAME, COMPARE MORE MANTISSA
EBD1- B1 60 1960 LDA (DEST),Y
EBD3- C5 9F 1970 CMP FAC+2
EBD5- D0 12 1980 BNE .1 NOT SAME, SO SUFFICIENT
EBD7- C8 1990 INY SAME, COMPARE MORE MANTISSA
EBD8- B1 60 2000 LDA (DEST),Y
EBDA- C5 A0 2010 CMP FAC+3
EBDC- D0 0B 2020 BNE .1 NOT SAME, SO SUFFICIENT
EBDE- C8 2030 INY SAME, COMPARE REST OF MANTISSA
EBDF- A9 7F 2040 LDA #$7F ARTIFICIAL EXTENSION BYTE FOR COMPARAND
EBE1- C5 AC 2050 CMP FAC.EXTENSION
EBE3- B1 60 2060 LDA (DEST),Y
EBE5- E5 A1 2070 SBC FAC+4
EBE7- F0 28 2080 BEQ RTS.16 NUMBERS ARE EQUAL, RETURN (A)=0
EBE9- A5 A2 2090 .1 LDA FAC.SIGN NUMBERS ARE DIFFERENT
EBEB- 90 02 2100 BCC .2 FAC IS LARGER MAGNITUDE
EBED- 49 FF 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 >>>
EBEF- 4C 88 EB 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 *--------------------------------
EBF2- A5 9D 2250 QINT LDA FAC LOOK AT FAC EXPONENT
EBF4- F0 4A 2260 BEQ QINT.3 FAC=0, SO FINISHED
EBF6- 38 2270 SEC GET -(NUMBER OF FRACTIONAL BITS)
EBF7- E9 A0 2280 SBC #$A0 IN A-REG FOR SHIFT COUNT
EBF9- 24 A2 2290 BIT FAC.SIGN CHECK SIGN OF FAC
EBFB- 10 09 2300 BPL .1 POSITIVE, CONTINUE
EBFD- AA 2310 TAX NEGATIVE, SO COMPLEMENT MANTISSA
EBFE- A9 FF 2320 LDA #$FF AND SET SIGN EXTENSION FOR SHIFT
EC00- 85 A4 2330 STA SHIFT.SIGN.EXT
EC02- 20 A4 E8 2340 JSR COMPLEMENT.FAC.MANTISSA
EC05- 8A 2350 TXA RESTORE BIT COUNT TO A-REG
EC06- A2 9D 2360 .1 LDX #FAC POINT SHIFT SUBROUTINE AT FAC
EC08- C9 F9 2370 CMP #$F9 MORE THAN 7 BITS TO SHIFT?
EC0A- 10 06 2380 BPL QINT.2 NO, SHORT SHIFT
EC0C- 20 F0 E8 2390 JSR SHIFT.RIGHT YES, USE GENERAL ROUTINE
EC0F- 84 A4 2400 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
EC11- 60 2410 RTS.16 RTS
2420 *--------------------------------
EC12- A8 2430 QINT.2 TAY SAVE SHIFT COUNT
EC13- A5 A2 2440 LDA FAC.SIGN GET SIGN BIT
EC15- 29 80 2450 AND #$80
EC17- 46 9E 2460 LSR FAC+1 START RIGHT SHIFT
EC19- 05 9E 2470 ORA FAC+1 AND MERGE WITH SIGN
EC1B- 85 9E 2480 STA FAC+1
EC1D- 20 07 E9 2490 JSR SHIFT.RIGHT.4 JUMP INTO MIDDLE OF SHIFTER
EC20- 84 A4 2500 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
EC22- 60 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 *--------------------------------
EC23- A5 9D 2600 INT LDA FAC CHECK IF EXPONENT < 32
EC25- C9 A0 2610 CMP #$A0 BECAUSE IF > 31 THERE IS NO FRACTION
EC27- B0 20 2620 BCS RTS.17 NO FRACTION, WE ARE FINISHED
EC29- 20 F2 EB 2630 JSR QINT USE GENERAL INTEGER CONVERSION
EC2C- 84 AC 2640 STY FAC.EXTENSION Y=0, CLEAR EXTENSION
EC2E- A5 A2 2650 LDA FAC.SIGN GET SIGN OF VALUE
EC30- 84 A2 2660 STY FAC.SIGN Y=0, CLEAR SIGN
EC32- 49 80 2670 EOR #$80 TOGGLE ACTUAL SIGN
EC34- 2A 2680 ROL AND SAVE IN CARRY
EC35- A9 A0 2690 LDA #$A0 SET EXPONENT TO 32
EC37- 85 9D 2700 STA FAC BECAUSE 4-BYTE INTEGER NOW
EC39- A5 A1 2710 LDA FAC+4 SAVE LOW 8-BITS OF INTEGER FORM
EC3B- 85 0D 2720 STA CHARAC FOR EXP AND POWER
EC3D- 4C 29 E8 2730 JMP NORMALIZE.FAC.1 NORMALIZE TO FINISH CONVERSION
2740 *--------------------------------
EC40- 85 9E 2750 QINT.3 STA FAC+1 FAC=0, SO CLEAR ALL 4 BYTES FOR
EC42- 85 9F 2760 STA FAC+2 INTEGER VERSION
EC44- 85 A0 2770 STA FAC+3
EC46- 85 A1 2780 STA FAC+4
EC48- A8 2790 TAY Y=0 TOO
EC49- 60 2800 RTS.17 RTS
S.E913