
 1000  *---------------------------------
 1010  *      TEST
 1020  *---------------------------------
 1030  TEST   LDY #10      LOOP 10 TIMES
 1040         JSR FP.LOAD  VAR1 = 1.0
 1050         .DA AS.ONE
 1060         JSR FP.STORE
 1070         .DA VAR1
 1080         JSR FP.LOAD  VAR2 = 10.0
 1090         .DA AS.TEN
 1100         JSR FP.STORE
 1110         .DA VAR2
 1120  .1     JSR FP.LOAD  VAR1=(VAR1+1)/VAR2
 1130         .DA VAR1
 1140         JSR FP.ADD
 1150         JSR AS.ONE
 1160         JSR FP.DIV
 1170         .DA VAR2
 1180         JSR FP.STORE
 1190         .DA VAR1
 1200         JSR FP.LOAD  VAR2=VAR2-1
 1210         .DA VAR2
 1220         JSR FP.SUB
 1230         .DA AS.ONE
 1240         JSR FP.STORE
 1250         .DA VAR2
 1260         JSR FP.PRINT.WD
 1270         .DA VAR1,#8,#3
 1280         JSR FP.PRINT.WD
 1290         .DA VAR1,#19,#4
 1300         JSR MON.BLANKS  3 SPACES
 1310         JSR FP.PRINT
 1320         .DA VAR1
 1330         JSR MON.CROUT  PRINT CARRIAGE RETURN
 1340         DEY          NEXT TRIP AROUND THE LOOP
 1350         BNE .1
 1360         RTS          FINISHED
 1370  VAR1   .BS 5        MY VARIABLES
 1380  VAR2   .BS 5
 1390  *---------------------------------
 1400  *      ARITHMETIC PACKAGE
 1410  *---------------------------------
 1420  AS.FOUT.E  .EQ $9A
 1430  AS.TEMP1   .EQ $93 THRU $97
 1440  AS.TXTPTR  .EQ $B8,B9
 1450  *---------------------------------
 1460  AS.CHRGET  .EQ $00B1
 1470  AS.COUT    .EQ $DB5C
 1480  AS.FSUB    .EQ $E7A7 FAC=ARG-FAC
 1490  AS.FADD    .EQ $E7BE
 1500  AS.ONE     .EQ $E913 CONSTANT 1.0
 1510  AS.FMUL    .EQ $E97F
 1520  AS.TEN     .EQ $EA50 CONSTANT 10.0
 1530  AS.FDIVT   .EQ $EA69 DIVIDE ARG BY FAC
 1540  AS.MOVFM   .EQ $EAF9
 1550  AS.MOV1F   .EQ $EB21
 1560  AS.MOVMF   .EQ $EB2B
 1570  AS.MOVAF   .EQ $EB63 MOVE FAC TO ARG
 1580  AS.FOUT    .EQ $ED34
 1590  AS.NEGOP   .EQ $EED0 FAC = -FAC
 1600  *---------------------------------
 1610  MON.BLANKS .EQ $F948 PRINT 3 BLANKS
 1620  MON.CROUT  .EQ $FD8E PRINT CRLF
 1630  *---------------------------------
 1640  *      JSR FP.LOAD      LOAD VALUE INTO FAC
 1650  *      .DA <ADDR OF VALUE>
 1660  *---------------------------------
 1670  FP.LOAD
 1680         JSR GET.ADDR IN Y,X AND Y,A
 1690         JSR AS.MOVFM
 1700         JMP FP.EXIT
 1710  *---------------------------------
 1720  *      JSR FP.STORE     STORE FAC
 1730  *      .DA <ADDR TO STORE IN>
 1740  *---------------------------------
 1750  FP.STORE
 1760         JSR GET.ADDR IN Y,X AND Y,A
 1770         JSR AS.MOVMF
 1780         JMP FP.EXIT
 1790  *---------------------------------
 1800  *      JSR FP.PRINT     PRINT VALUE IN FREE FORMAT
 1810  *      .DA <ADDR OF VALUE TO BE PRINTED>
 1820  *---------------------------------
 1830  FP.PRINT
 1840         JSR GET.ADDR
 1850         JSR AS.MOVFM
 1860         JSR AS.FOUT
 1870         LDY #0
 1880  .1     LDA $100,Y
 1890         BEQ .2
 1900         JSR AS.COUT
 1910         INY
 1920         BNE .1       ...ALWAYS
 1930  .2     JMP FP.EXIT
 1940  *---------------------------------
 1950  *      JSR FP.ADD   FAC = FAC + VALUE
 1960  *      .DA <ADDR OF VALUE>
 1970  *---------------------------------
 1980  FP.ADD JSR GET.ADDR IN Y,X AND Y,A
 1990         JSR AS.FADD  FAC=ARG+FAC
 2000         JMP FP.EXIT
 2010  *---------------------------------
 2020  *      JSR FP.SUB   FAC = FAC - VALUE
 2030  *      .DA <ADDR OF VALUE>
 2040  *---------------------------------
 2050  FP.SUB JSR GET.ADDR
 2060         JSR AS.FSUB   FAC=ARG-FAC
 2070         JSR AS.NEGOP  FAC=-FAC
 2080         JMP FP.EXIT
 2090  *---------------------------------
 2100  *      JSR FP.MUL   FAC = FAC + VALUE
 2110  *      .DA <ADDR OF VALUE>
 2120  *---------------------------------
 2130  FP.MUL JSR GET.ADDR IN Y,X AND Y,A
 2140         JSR AS.FMUL  FAC=ARG*FAC
 2150         JMP FP.EXIT
 2160  *---------------------------------
 2170  *      JSR FP.DIV   FAC = FAC / VALUE
 2180  *      .DA <ADDR OF VALUE>
 2190  *---------------------------------
 2200  FP.DIV JSR GET.ADDR
 2210         PHA
 2220         TYA
 2230         PHA
 2240         JSR AS.MOVAF  MOVE FAC TO ARG
 2250         PLA
 2260         TAY
 2270         PLA
 2280         JSR AS.MOVFM
 2290         JSR AS.FDIVT
 2300         JMP FP.EXIT
 2310  *---------------------------------
 2320  *      JSR FP.PRINT.WD   PRINT VALUE WITH W.D FORMAT
 2330  *      .DA <ADDR OF VALUE>,#<W>,#<D>
 2340  *          D = # OF DIGITS AFTER DECIMAL POINT
 2350  *          W = # OF CHARACTERS IN WHOLE FIELD
 2360  *---------------------------------
 2370  FP.PRINT.WD
 2380         JSR GET.ADDR ADDRESS OF VALUE
 2390         JSR AS.MOVFM VALUE INTO FAC
 2400         JSR AS.FOUT  CONVERT TO STRING AT $100
 2410         JSR GET.ADDR2  (X)=W, (Y)=D
 2420         CPX #41      LIMIT FIELD WIDTH TO 40 CHARS
 2430         BCC .14
 2440         LDX #40
 2450  .14    STX W        # CHARACTERS IN WHOLE FIELD
 2460         STX WD.GT
 2470         CPY W        FORCE D<W
 2480         BCC .13
 2490         LDY W
 2500         DEY
 2510  .13    STY D
 2520         DEX          COMPUTE W-D-1
 2530         TXA
 2540         SEC
 2550         SBC D
 2560         STA W
 2570         LDA AS.FOUT.E  SEE IF E-FORMAT
 2580         BEQ .12      NO
 2590         JMP E.FORMAT
 2600  .12    LDY #0
 2610  *---------------------------------
 2620  *      SCAN TO "." OR END, DECREMENTING W
 2630  *---------------------------------
 2640  .1     LDA $100,Y   SCAN TO END OR DECIMAL POINT
 2650         BEQ .2       FOUND END, NO DECIMAL POINT
 2660         CMP #'.
 2670         BEQ .3       FOUND DECIMAL POINT
 2680         INY          COUNT STRING LENGTH
 2690         DEC W
 2700         BPL .1       ...UNLESS TOO MANY DIGITS FOR FIELD
 2710         LDA #0
 2720         STA W        NEED NO LEADING BLANKS
 2730         DEC D        BACK UP D IF POSSIBLE
 2740         BPL .1       TRY AGAIN
 2750         JMP PRINT.GT OVERFLOW
 2760  *---------------------------------
 2770  *      APPEND DECIMAL POINT SINCE NONE PRESENT
 2780  *---------------------------------
 2790  .2     LDA #'.      PUT DECIMAL POINT BACK ON END
 2800         STA $100,Y
 2810         LDA #0       END OF STRING CHAR
 2820         STA $101,Y
 2830  *---------------------------------
 2840  *      SCAN TO END, DECREMENTING D
 2850  *      (PUT EOS AFTER D DIGITS)
 2860  *---------------------------------
 2870  .3     INY          NEXT CHAR
 2880         LDA D
 2890         BEQ .5       NO FRACTIONAL DIGITS
 2900  .4     LDA $100,Y   COUNT FRACTIONAL DIGITS TO END
 2910         BEQ .6       END OF STRING
 2920         INY
 2930         DEC D
 2940         BNE .4       STILL NEED MORE DIGITS
 2950  *---------------------------------
 2960  .5     LDA #0       MAKE EOS
 2970         STA $100,Y
 2980         STA D        NEED NO TRAILING ZEROES
 2990  *---------------------------------
 3000  *      PRINT LEADING BLANKS AS NEEDED
 3010  *---------------------------------
 3020  .6     JSR LEADING.BLANKS
 3030  *---------------------------------
 3040  *      PRINT CONVERTED STRING
 3050  *---------------------------------
 3060  *      COMES HERE WITH (Y)=0
 3070  .8     LDA $100,Y
 3080         BEQ .9
 3090         JSR AS.COUT
 3100         INY
 3110         BNE .8       ...ALWAYS
 3120  *---------------------------------
 3130  *      PRINT TRAILING ZEROES AS NEEDED
 3140  *---------------------------------
 3150  .9     JSR TRAILING.ZEROES
 3160         JMP FP.EXIT
 3170  *---------------------------------
 3180  *      HANDLE NUMBERS WHICH COME IN E-FORMAT
 3190  *---------------------------------
 3200  E.FORMAT
 3210         LDX #0
 3220         LDY #0
 3230  .1     LDA $100,Y   SCAN TO "E", CHANGE TO EOS
 3240         CMP #'E
 3250         BEQ .3
 3260         CMP #'.      SHUFFLE DIGITS AFTER "."
 3270         BEQ .2       LEFT ONE POSITION
 3280         STA $100,X
 3290         INX
 3300  .2     INY
 3310         BNE .1       ...ALWAYS
 3320  .3     LDA #0       EOS
 3330         STA $100,X
 3340  *---------------------------------
 3350         LDA AS.FOUT.E  EXP AGAIN
 3360         BPL .12      EXP>0
 3370         EOR #$FF     -(EXP+1) IS # ZEROES
 3380         CMP D        SEE IF MORE THAN WE NEED
 3390         BCC .4       NO
 3400         LDA D        YES, JUST USE D
 3410  .4     TAX
 3420  *---------------------------------
 3430         JSR LEADING.BLANKS
 3440  *---------------------------------
 3450         LDA #'.      DECIMAL POINT
 3460         JSR AS.COUT
 3470  *---------------------------------
 3480  .7     LDA #'0      ZEROES
 3490         JSR AS.COUT
 3500         DEC D        REDUCE DIGIT COUNT
 3510         DEX
 3520         BNE .7       MORE ZEROES
 3530  *---------------------------------
 3540         LDY #0
 3550         LDA D        HOW MANY DIGITS?
 3560         BEQ .9       NONE
 3570  .8     LDA $100,Y   GET A DIGIT
 3580         BEQ .10      OUT OF DIGITS
 3590         JSR AS.COUT
 3600         INY
 3610         DEC D
 3620         BNE .8       MORE
 3630  .9     JMP FP.EXIT
 3640  *---------------------------------
 3650  .10    JSR TRAILING.ZEROES
 3660         JMP FP.EXIT
 3670  *---------------------------------
 3680  *      E-FORMAT WITH EXP>0
 3690  *---------------------------------
 3700  .12    CMP W        SEE IF ENOUGH ROOM
 3710         BCS PRINT.GT FILL FIELD WITH ">"
 3720         TAX
 3730         INX          # DIGITS AND TRAILING ZEROES
 3740         EOR #$FF     -(EXP+1)
 3750         ADC W        COMPUT # LEADING BLANKS
 3760         STA W
 3770         JSR LEADING.BLANKS
 3780  .13    LDA $100,Y   PRINT SIGNIFICANT DIGITS
 3790         BEQ .14
 3800         JSR AS.COUT
 3810         DEX
 3820         INY
 3830         BNE .13      ...ALWAYS
 3840  .14    LDA D        SAVE TRAILING ZERO CNT
 3850         PHA
 3860         STX D        SET UP ZEROES BEFORE "."
 3870         JSR TRAILING.ZEROES
 3880         PLA          RESTORE REAL TRAILING ZERO CNT
 3890         STA D
 3900         LDA #'.      PRINT DECIMAL POINT
 3910         JSR AS.COUT
 3920         JSR TRAILING.ZEROES
 3930         JMP FP.EXIT
 3940  *---------------------------------
 3950  *      PRINT (WD.GT) GREATER THAN SIGNS (">")
 3960  *---------------------------------
 3970  PRINT.GT
 3980         LDA #'>      OVERFLOW
 3990         LDY WD.GT
 4000         JSR PRINT.ACHAR.YTIMES
 4010         JMP FP.EXIT
 4020  *---------------------------------
 4030  *      OUTPUT (W) LEADING BLANKS
 4040  *---------------------------------
 4050  LEADING.BLANKS
 4060         LDA #$20     BLANK
 4070         LDY W        # TO PRINT
 4080         JMP PRINT.ACHAR.YTIMES
 4090  *---------------------------------
 4100  *      OUTPUT (D) TRAILING ZEROES
 4110  *---------------------------------
 4120  TRAILING.ZEROES
 4130         LDA #'0
 4140         LDY D
 4150  * FALL INTO PRINT.ACHAR.YTIMES
 4160  *---------------------------------
 4170  *      PRINT (Y) REPETITIONS OF (A)
 4180  *---------------------------------
 4190  PRINT.ACHAR.YTIMES
 4200         BEQ .2       (Y) IS 0, DON'T PRINT ANY
 4210  .1     JSR AS.COUT
 4220         DEY
 4230         BNE .1
 4240  .2     RTS
 4250  *---------------------------------
 4260  GET.ADDR
 4270         STA SAVE.A   SAVE A,X,Y REGISTERS
 4280         STX SAVE.X
 4290         STY SAVE.Y
 4300         PLA          SAVE GET.ADDR RETURN ADDRESS
 4310         STA RETLO
 4320         PLA
 4330         STA RETHI
 4340         LDA AS.TXTPTR  SAVE APPLESOFT TEXT POINTER
 4350         STA SAVE.T
 4360         LDA AS.TXTPTR+1
 4370         STA SAVE.T+1
 4380         PLA          POINT AT BYTES AFTER JSR FP.<WHATEVER>
 4390         STA AS.TXTPTR
 4400         PLA
 4410         STA AS.TXTPTR+1
 4420         JSR GET.ADDR2  GET FIRST TWO BYTES AFTER
 4430         LDA RETHI    RETURN
 4440         PHA
 4450         LDA RETLO
 4460         PHA
 4470         TXA          ADDR ALSO IN Y,A
 4480         RTS
 4490  *---------------------------------
 4500  GET.ADDR2
 4510         JSR AS.CHRGET  GET NEXT BYTE IN CALLING SEQUENCE
 4520         TAX
 4530         JSR AS.CHRGET  GET NEXT BYTE IN CALLING SEQUENCE
 4540         TAY
 4550         RTS
 4560  *---------------------------------
 4570  W      .BS 1
 4580  D      .BS 1
 4590  RETHI  .BS 1
 4600  RETLO  .BS 1
 4610  SAVE.A .BS 1
 4620  SAVE.X .BS 1
 4630  SAVE.Y .BS 1
 4640  SAVE.T .BS 2        TXTPTR
 4650  WD.GT  .BS 1
 4660  *---------------------------------
 4670  FP.EXIT
 4680         LDA AS.TXTPTR+1  GET HIGH BYTE
 4690         PHA
 4700         LDA AS.TXTPTR    GET LOW BYTE
 4710         PHA
 4720         LDA SAVE.T
 4730         STA AS.TXTPTR
 4740         LDA SAVE.T+1
 4750         STA AS.TXTPTR+1
 4760         LDA SAVE.A
 4770         LDX SAVE.X
 4780         LDY SAVE.Y
 4790         RTS

