goapple2/source/applesoft/S.EB72

1010 *--------------------------------
1020 *      ROUND FAC USING EXTENSION BYTE
1030 *--------------------------------
1040 ROUND.FAC
1050        LDA FAC
1060        BEQ RTS.14   FAC = 0, RETURN
1070        ASL FAC.EXTENSION  IS FAC.EXTENSION >= 128?
1080        BCC RTS.14         NO, FINISHED
1090 *--------------------------------
1100 *      INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
1110 *--------------------------------
1120 INCREMENT.MANTISSA
1130        JSR INCREMENT.FAC.MANTISSA  YES, INCREMENT FAC
1140        BNE RTS.14         HIGH BYTE HAS BITS, FINISHED
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 *--------------------------------
1230 SIGN   LDA FAC      CHECK SIGN OF FAC AND
1240        BEQ RTS.15   RETURN -1,0,1 IN A-REG
1250 *--------------------------------
1260 SIGN1  LDA FAC.SIGN
1270 *--------------------------------
1280 SIGN2  ROL          MSBIT TO CARRY
1290        LDA #$FF     -1
1300        BCS RTS.15   MSBIT = 1
1310        LDA #1       +1
1320 RTS.15 RTS
1330 *--------------------------------
1340 *      "SGN" FUNCTION
1350 *--------------------------------
1360 SGN    JSR SIGN        CONVERT FAC TO -1,0,1
1370 *--------------------------------
1380 *      CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
1390 *--------------------------------
1400 FLOAT  STA FAC+1    PUT IN HIGH BYTE OF MANTISSA
1410        LDA #0       CLEAR 2ND BYTE OF MANTISSA
1420        STA FAC+2
1430        LDX #$88     USE EXPONENT 2^9
1440 *--------------------------------
1450 *      FLOAT UNSIGNED VALUE IN FAC+1,2
1460 *      (X) = EXPONENT
1470 *--------------------------------
1480 FLOAT.1
1490        LDA FAC+1    MSBIT=0, SET CARRY; =1, CLEAR CARRY
1500        EOR #$FF
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
1590        LDA #0       CLEAR LOWER 16-BITS OF MANTISSA
1600        STA FAC+4
1610        STA FAC+3
1620        STX FAC      STORE EXPONENT
1630        STA FAC.EXTENSION CLEAR EXTENSION
1640        STA FAC.SIGN      MAKE SIGN POSITIVE
1650        JMP NORMALIZE.FAC.1   IF C=0, WILL NEGATE FAC
1660 *--------------------------------
1670 *      "ABS" FUNCTION
1680 *--------------------------------
1690 ABS    LSR FAC.SIGN      CHANGE SIGN TO +
1700        RTS
1710 *--------------------------------
1720 *      COMPARE FAC WITH PACKED # AT (Y,A)
1730 *      RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
1740 *--------------------------------
1750 FCOMP  STA DEST     USE DEST FOR PNTR
1760 *--------------------------------
1770 *      SPECIAL ENTRY FROM "NEXT" PROCESSOR
1780 *      "DEST" ALREADY SET UP
1790 *--------------------------------
1800 FCOMP2 STY DEST+1
1810        LDY #0       GET EXPONENT OF COMPARAND
1820        LDA (DEST),Y
1830        INY          POINT AT NEXT BYTE
1840        TAX          EXPONENT TO X-REG
1850        BEQ SIGN     IF COMPARAND=0, "SIGN" COMPARES FAC
1860        LDA (DEST),Y GET HI-BYTE OF MANTISSA
1870        EOR FAC.SIGN COMPARE WITH FAC SIGN
1880        BMI SIGN1    DIFFERENT SIGNS, "SIGN" GIVES ANSWER
1890        CPX FAC      SAME SIGN, SO COMPARE EXPONENTS
1900        BNE .1       DIFFERENT, SO SUFFICIENT TEST
1910        LDA (DEST),Y SAME EXPONENT, COMPARE MANTISSA
1920        ORA #$80     SET INVISIBLE NORMALIZED BIT
1930        CMP FAC+1
1940        BNE .1       NOT SAME, SO SUFFICIENT
1950        INY          SAME, COMPARE MORE MANTISSA
1960        LDA (DEST),Y
1970        CMP FAC+2
1980        BNE .1       NOT SAME, SO SUFFICIENT
1990        INY          SAME, COMPARE MORE MANTISSA
2000        LDA (DEST),Y
2010        CMP FAC+3
2020        BNE .1       NOT SAME, SO SUFFICIENT
2030        INY          SAME, COMPARE REST OF MANTISSA
2040        LDA #$7F    ARTIFICIAL EXTENSION BYTE FOR COMPARAND
2050        CMP FAC.EXTENSION
2060        LDA (DEST),Y
2070        SBC FAC+4
2080        BEQ RTS.16   NUMBERS ARE EQUAL, RETURN (A)=0
2090 .1     LDA FAC.SIGN NUMBERS ARE DIFFERENT
2100        BCC .2       FAC IS LARGER MAGNITUDE
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  >>>
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 *--------------------------------
2250 QINT   LDA FAC      LOOK AT FAC EXPONENT
2260        BEQ QINT.3   FAC=0, SO FINISHED
2270        SEC          GET -(NUMBER OF FRACTIONAL BITS)
2280        SBC #$A0          IN A-REG FOR SHIFT COUNT
2290        BIT FAC.SIGN CHECK SIGN OF FAC
2300        BPL .1       POSITIVE, CONTINUE
2310        TAX          NEGATIVE, SO COMPLEMENT MANTISSA
2320        LDA #$FF     AND SET SIGN EXTENSION FOR SHIFT
2330        STA SHIFT.SIGN.EXT
2340        JSR COMPLEMENT.FAC.MANTISSA
2350        TXA          RESTORE BIT COUNT TO A-REG
2360 .1     LDX #FAC     POINT SHIFT SUBROUTINE AT FAC
2370        CMP #$F9     MORE THAN 7 BITS TO SHIFT?
2380        BPL QINT.2   NO, SHORT SHIFT
2390        JSR SHIFT.RIGHT   YES, USE GENERAL ROUTINE
2400        STY SHIFT.SIGN.EXT    Y=0, CLEAR SIGN EXTENSION
2410 RTS.16 RTS
2420 *--------------------------------
2430 QINT.2 TAY          SAVE SHIFT COUNT
2440        LDA FAC.SIGN      GET SIGN BIT
2450        AND #$80
2460        LSR FAC+1         START RIGHT SHIFT
2470        ORA FAC+1         AND MERGE WITH SIGN
2480        STA FAC+1
2490        JSR SHIFT.RIGHT.4     JUMP INTO MIDDLE OF SHIFTER
2500        STY SHIFT.SIGN.EXT    Y=0, CLEAR SIGN EXTENSION
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 *--------------------------------
2600 INT    LDA FAC      CHECK IF EXPONENT < 32
2610        CMP #$A0     BECAUSE IF > 31 THERE IS NO FRACTION
2620        BCS RTS.17   NO FRACTION, WE ARE FINISHED
2630        JSR QINT     USE GENERAL INTEGER CONVERSION
2640        STY FAC.EXTENSION  Y=0, CLEAR EXTENSION
2650        LDA FAC.SIGN      GET SIGN OF VALUE
2660        STY FAC.SIGN      Y=0, CLEAR SIGN
2670        EOR #$80          TOGGLE ACTUAL SIGN
2680        ROL               AND SAVE IN CARRY
2690        LDA #$A0          SET EXPONENT TO 32
2700        STA FAC           BECAUSE 4-BYTE INTEGER NOW
2710        LDA FAC+4         SAVE LOW 8-BITS OF INTEGER FORM
2720        STA CHARAC        FOR EXP AND POWER
2730        JMP NORMALIZE.FAC.1  NORMALIZE TO FINISH CONVERSION
2740 *--------------------------------
2750 QINT.3 STA FAC+1    FAC=0, SO CLEAR ALL 4 BYTES FOR
2760        STA FAC+2    INTEGER VERSION
2770        STA FAC+3
2780        STA FAC+4
2790        TAY          Y=0 TOO
2800 RTS.17 RTS