goapple2/source/applesoft/S.ED0A

1010 *--------------------------------
1020 CON.99999999.9 .HS 9B3EBC1FFD  99,999,999.9
1030 CON.999999999  .HS 9E6E6B27FD  999,999,999
1040 CON.BILLION    .HS 9E6E6B2800  1,000,000,000
1050 *--------------------------------
1060 *      PRINT "IN <LINE #>"
1070 *--------------------------------
1080 INPRT  LDA #QT.IN    PRINT " IN "
1090        LDY /QT.IN
1100        JSR GO.STROUT
1110        LDA CURLIN+1
1120        LDX CURLIN
1130 *--------------------------------
1140 *      PRINT A,X AS DECIMAL INTEGER
1150 *--------------------------------
1160 LINPRT STA FAC+1    PRINT A,X IN DECIMAL
1170        STX FAC+2
1180        LDX #$90     EXPONENT = 2^16
1190        SEC          CONVERT UNSIGNED
1200        JSR FLOAT.2  CONVERT LINE # TO FP 
1210 *--------------------------------
1220 *      CONVERT (FAC) TO STRING, AND PRINT IT
1230 *--------------------------------
1240 PRINT.FAC
1250        JSR FOUT     CONVERT (FAC) TO STRING AT STACK
1260 *--------------------------------
1270 *      PRINT STRING STARTING AT Y,A
1280 *--------------------------------
1290 GO.STROUT
1300        JMP STROUT    PRINT STRING AT A,Y
1310 *--------------------------------
1320 *      CONVERT (FAC) TO STRING STARTING AT STACK
1330 *      RETURN WITH (Y,A) POINTING AT STRING
1340 *--------------------------------
1350 FOUT   LDY #1       NORMAL ENTRY PUTS STRING AT STACK...
1360 *--------------------------------
1370 *      "STR$" FUNCTION ENTERS HERE, WITH (Y)=0
1380 *      SO THAT RESULT STRING STARTS AT STACK-1
1390 *      (THIS IS USED AS A FLAG)
1400 *--------------------------------
1410 FOUT.1 LDA #'-'     IN CASE VALUE NEGATIVE
1420        DEY          BACK UP PNTR
1430        BIT FAC.SIGN
1440        BPL .1       VALUE IS +
1450        INY          VALUE IS -
1460        STA STACK-1,Y     EMIT "-"
1470 .1     STA FAC.SIGN MAKE FAC.SIGN POSITIVE ($2D)
1480        STY STRNG2   SAVE STRING PNTR
1490        INY
1500        LDA #'0'     IN CASE (FAC)=0
1510        LDX FAC      NUMBER=0?
1520        BNE .2       NO, (FAC) NOT ZERO
1530        JMP FOUT.4   YES, FINISHED
1540 *--------------------------------
1550 .2     LDA #0       STARTING VALUE FOR TMPEXP
1560        CPX #$80     ANY INTEGER PART?
1570        BEQ .3       NO, BTWN .5 AND .999999999
1580        BCS .4       YES
1590 *--------------------------------
1600 .3     LDA #CON.BILLION  MULTIPLY BY 1E9
1610        LDY /CON.BILLION  TO GIVE ADJUSTMENT A HEAD START
1620        JSR FMULT
1630        LDA #-9           EXPONENT ADJUSTMENT
1640 .4     STA TMPEXP        0 OR -9
1650 *--------------------------------
1660 *      ADJUST UNTIL 1E8 <= (FAC) <1E9
1670 *--------------------------------
1680 .5     LDA #CON.999999999
1690        LDY /CON.999999999
1700        JSR FCOMP    COMPARE TO 1E9-1
1710        BEQ .10      (FAC) = 1E9-1
1720        BPL .8       TOO LARGE, DIVIDE BY TEN
1730 .6     LDA #CON.99999999.9   COMPARE TO 1E8-.1
1740        LDY /CON.99999999.9
1750        JSR FCOMP    COMPARE TO 1E8-.1
1760        BEQ .7       (FAC) = 1E8-.1
1770        BPL .9       IN RANGE, ADJUSTMENT FINISHED
1780 .7     JSR MUL10    TOO SMALL, MULTIPLY BY TEN
1790        DEC TMPEXP   KEEP TRACK OF MULTIPLIES
1800        BNE .6       ...ALWAYS
1810 .8     JSR DIV10    TOO LARGE, DIVIDE BY TEN
1820        INC TMPEXP   KEEP TRACK OF DIVISIONS
1830        BNE .5       ...ALWAYS
1840 *--------------------------------
1850 .9     JSR FADDH    ROUND ADJUSTED RESULT
1860 .10    JSR QINT   CONVERT ADJUSTED VALUE TO 32-BIT INTEGER
1870 *--------------------------------
1880 *      FAC+1...FAC+4 IS NOW IN INTEGER FORM
1890 *      WITH POWER OF TEN ADJUSTMENT IN TMPEXP
1900 *
1910 *      IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM
1920 *      OTHERWISE, PRINT IN EXPONENTIAL FORM
1930 *--------------------------------
1940 FOUT.2 LDX #1       ASSUME 1 DIGIT BEFORE "."
1950        LDA TMPEXP   CHECK RANGE
1960        CLC
1970        ADC #10
1980        BMI .1       < .01, USE EXPONENTIAL FORM
1990        CMP #11
2000        BCS .2       >= 1E10, USE EXPONENTIAL FORM
2010        ADC #$FF     LESS 1 GIVES INDEX FOR "."
2020        TAX
2030        LDA #2       SET REMAINING EXPONENT = 0
2040 .1     SEC          COMPUTE REMAINING EXPONENT
2050 .2     SBC #2
2060        STA EXPON    VALUE FOR "E+XX" OR "E-XX"
2070        STX TMPEXP   INDEX FOR DECIMAL POINT
2080        TXA          SEE IF "." COMES FIRST
2090        BEQ .3       YES
2100        BPL .5       NO, LATER
2110 .3     LDY STRNG2   GET INDEX INTO STRING BEING BUILT
2120        LDA #'.'     STORE A DECIMAL POINT
2130        INY
2140        STA STACK-1,Y
2150        TXA          SEE IF NEED ".0"
2160        BEQ .4       NO
2170        LDA #'0'     YES, STORE "0"
2180        INY
2190        STA STACK-1,Y
2200 .4     STY STRNG2   SAVE OUTPUT INDEX AGAIN
2210 *--------------------------------
2220 *     NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS
2230 *--------------------------------
2240 .5     LDY #0       INDEX TO TABLE OF POWERS OF TEN
2250        LDX #$80    STARTING VALUE FOR DIGIT WITH DIRECTION
2260 .6     LDA FAC+4    START BY ADDING -100000000 UNTIL
2270        CLC          OVERSHOOT.  THEN ADD +10000000,
2280        ADC DECTBL+3,Y    THEN ADD -1000000, THEN ADD
2290        STA FAC+4         +100000, AND SO ON.
2300        LDA FAC+3    THE # OF TIMES EACH POWER IS ADDED
2310        ADC DECTBL+2,Y   IS 1 MORE THAN CORRESPONDING DIGIT
2320        STA FAC+3
2330        LDA FAC+2
2340        ADC DECTBL+1,Y
2350        STA FAC+2
2360        LDA FAC+1
2370        ADC DECTBL,Y
2380        STA FAC+1
2390        INX          COUNT THE ADD
2400        BCS .7       IF C=1 AND X NEGATIVE, KEEP ADDING
2410        BPL .6       IF C=0 AND X POSITIVE, KEEP ADDING
2420        BMI .8       IF C=0 AND X NEGATIVE, WE OVERSHOT
2430 .7     BMI .6       IF C=1 AND X POSITIVE, WE OVERSHOT
2440 .8     TXA          OVERSHOT, SO MAKE X INTO A DIGIT
2450        BCC .9       HOW DEPENDS ON DIRECTION WE WERE GOING
2460        EOR #$FF     DIGIT = 9-X
2470        ADC #10
2480 .9     ADC #'0'-1   MAKE DIGIT INTO ASCII
2490        INY          ADVANCE TO NEXT SMALLER POWER OF TEN
2500        INY
2510        INY
2520        INY
2530        STY VARPNT   SAVE PNTR TO POWERS
2540        LDY STRNG2   GET OUTPUT PNTR
2550        INY          STORE THE DIGIT
2560        TAX          SAVE DIGIT, HI-BIT IS DIRECTION
2570        AND #$7F     MAKE SURE $30...$39 FOR STRING
2580        STA STACK-1,Y
2590        DEC TMPEXP   COUNT THE DIGIT
2600        BNE .10      NOT TIME FOR "." YET
2610        LDA #'.'     TIME, SO STORE THE DECIMAL POINT
2620        INY
2630        STA STACK-1,Y
2640 .10    STY STRNG2   SAVE OUTPUT PNTR AGAIN
2650        LDY VARPNT   GET PNTR TO POWERS
2660        TXA          GET DIGIT WITH HI-BIT = DIRECTION
2670        EOR #$FF     CHANGE DIRECTION
2680        AND #$80     $00 IF ADDING, $80 IF SUBTRACTING
2690        TAX
2700        CPY #DECTBL.END-DECTBL
2710        BNE .6       NOT FINISHED YET
2720 *--------------------------------
2730 *      NINE DIGITS HAVE BEEN STORED IN STRING.  NOW LOOK
2740 *      BACK AND LOP OFF TRAILING ZEROES AND A TRAILING
2750 *      DECIMAL POINT.
2760 *--------------------------------
2770 FOUT.3 LDY STRNG2   POINTS AT LAST STORED CHAR
2780 .1     LDA STACK-1,Y     SEE IF LOPPABLE
2790        DEY
2800        CMP #'0'     SUPPRESS TRAILING ZEROES
2810        BEQ .1       YES, KEEP LOOPING
2820        CMP #'.'     SUPPRESS TRAILING DECIMAL POINT
2830        BEQ .2       ".", SO WRITE OVER IT
2840        INY          NOT ".", SO INCLUDE IN STRING AGAIN
2850 .2     LDA #'+'     PREPARE FOR POSITIVE EXPONENT "E+XX"
2860        LDX EXPON    SEE IF ANY E-VALUE
2870        BEQ FOUT.5   NO, JUST MARK END OF STRING
2880        BPL .3       YES, AND IT IS POSITIVE
2890        LDA #0       YES, AND IT IS NEGATIVE
2900        SEC          COMPLEMENT THE VALUE
2910        SBC EXPON
2920        TAX          GET MAGNITUDE IN X
2930        LDA #'-'     E SIGN
2940 .3     STA STACK+1,Y     STORE SIGN IN STRING
2950        LDA #'E'          STORE "E" IN STRING BEFORE SIGN
2960        STA STACK,Y
2970        TXA          EXPONENT MAGNITUDE IN A-REG
2980        LDX #'0'-1   SEED FOR EXPONENT DIGIT
2990        SEC          CONVERT TO DECIMAL
3000 .4     INX          COUNT THE SUBTRACTION
3010        SBC #10      TEN'S DIGIT
3020        BCS .4       MORE TENS TO SUBTRACT
3030        ADC #'0'+10  CONVERT REMAINDER TO ONE'S DIGIT
3040        STA STACK+3,Y     STORE ONE'S DIGIT
3050        TXA
3060        STA STACK+2,Y     STORE TEN'S DIGIT
3070        LDA #0       MARK END OF STRING WITH $00
3080        STA STACK+4,Y
3090        BEQ FOUT.6   ...ALWAYS
3100 FOUT.4 STA STACK-1,Y     STORE "0" IN ASCII
3110 FOUT.5 LDA #0       STORE $00 ON END OF STRING
3120        STA STACK,Y
3130 FOUT.6 LDA #STACK   POINT Y,A AT BEGINNING OF STRING
3140        LDY /STACK   (STR$ STARTED STRING AT STACK-1, BUT
3150        RTS          STR$ DOESN'T USE Y,A ANYWAY.)
3160 *--------------------------------
3170 CON.HALF   .HS 8000000000  FP CONSTANT 0.5
3180 *--------------------------------
3190 *      POWERS OF 10 FROM 1E8 DOWN TO 1,
3200 *      AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS
3210 *--------------------------------
3220 DECTBL .HS FA0A1F00  -100000000
3230        .HS 00989680  10000000
3240        .HS FFF0BDC0  -1000000
3250        .HS 000186A0  100000
3260        .HS FFFFD8F0  -10000
3270        .HS 000003E8  1000
3280        .HS FFFFFF9C  -100
3290        .HS 0000000A  10
3300        .HS FFFFFFFF  -1
3310 DECTBL.END
3320 *--------------------------------