Carol Shaw’s
6502 Assembly Source Code

Carol Shaw

Carol Shaw worked at Atari while the Atari 400/800 computers were in development, leaving in 1980. A short Player/Missile demonstration program written by her, “Atari 800 Checkers Display,” was published in the Atari 400/800 Hardware manual released in 1982.

On August 31, 2016, Kevin Savetz uploaded the source code to Colleen Calculator, which eventually shipped as Atari Calculator, and Colleen Floating Point Routines, which he had obtained from Harry Stewart.

I’ve transcribed all three of these listings here.

0000        10           TITLE "ATARI 800 CHECKERS DISPLAY BY C. SHAW 3/31/80"
            20 ;
            30 ;COPYRIGHT ATARI 1980
            40 ;
            50 ;THIS IS AN EXAMPLE OF A DISPLAY LIST WHICH USES CHARACTER MAPPING TO
            60 ;PRODUCE THE CHECKERS AND THE TOP AND BOTTOM BORDERS OF THE BOARD.
            70 ;PLAYERS ARE USED FOR THE RED SQUARES. THIS GIVES 6 COLORS WITHOUT
            80 ;CHANGING THE COLOR REGISTERS.
            90 ;MISSILES ARE USED FOR THE LEFT AND RIGHT BORDERS.
            0100 ;THE PROGRAM STARTS AT THE LOCATION SPECIFIED BY PMB.
            0110 ;A FEW TRICKS ARE USED TO SAVE RAM, BUT FURTHER OPTIMIZATION IS POSSIBLE
            0120 ;THIS IS A RAM BASED PROGRAM WHICH RUNS WITH THE ASSEMBLER CARTRIDGE, NOT A
            0120 ;ROM CARTRIDGE.
            0140 ;
            0150 ;COLLEEN (ATARI 800) EQUATES
            0160 ;
D409        0170 CHBASE =    $D409
D400        0180 DMACTL =    $D400
022F        0190 SDMCTL =    $022F
D000        0200 HPOSP0 =    $D000
D008        0210 SIZEP0 =    $D008
02C0        0220 PCOLR0 =    $02C0
0230        0230 SDLSTL =    $0230
0231        0240 SDLSTH =    $0231
D01D        0250 GRACTL =    $D01D
D407        0260 PMBASE =    $D407
026F        0270 GPRIOR =    $026F
0200        0280 VDSLST =    $0200
D40E        0290 NMIEN  =    $D40E
            0300 ;
            0310 ;DISPLAY LIST EQUATES
            0320 ;
0080        0330 INT    =    $80   ;DISPLAY LIST INTERRUPT (BIT 7 OF NMI STATUS)
0041        0340 JMPWT  =    $41   ;JUMP AND WAIT UNTIL END OF NEXT VERTICAL BLANK (2 BYTES)
0040        0350 RELOAD =    $40   ;RELOAD MEM SCAN COUNTER (2 BYTES)
0020        0360 VSC    =    $20   ;VERTICAL SCROLL ENABLE
0010        0370 HSC    =    $10   ;HORIZONTAL SCROLL ENABLE
0001        0380 JUMP   =    1     ;JUMP INSTRUCTION (2 BYTES)
0000        0390 BLANK1 =    0     ;1 BLANK TV LINE
0010        0400 BLANK2 =    $10   ;2 BLANK LINES
0020        0410 BLANK3 =    $20   ;3
0030        0420 BLANK4 =    $30   ;4
0040        0430 BLANK5 =    $40   ;5
0050        0440 BLANK6 =    $50   ;6
0060        0450 BLANK7 =    $60   ;7
0070        0460 BLANK8 =    $70   ;8 BLANK TV LINES
0000        0470         PAGE
            0480 ;
0020        0490 INTOFF =    $20       ;USED TO GET INTERNAL CODE FOR UPPER CASE ALPHANUMERICS
            0500 ;
            0510 ;INTERNAL CHARACTER CODES
            0520 ;
0000        0530 SPI    =    ' -INTOFF
0021        0540 AI     =    'A-INTOFF
0023        0550 CI     =    'C-INTOFF
0024        0560 DI     =    'D-INTOFF
0025        0570 EI     =    'E-INTOFF
0027        0580 GI     =    'G-INTOFF
0028        0590 HI     =    'H-INTOFF
0029        0600 II     =    'I-INTOFF
002F        0610 OI     =    'O-INTOFF
0030        0620 PI     =    'P-INTOFF
0032        0630 RI     =    'R-INTOFF
0034        0640 TI     =    'T-INTOFF
0039        0650 YI     =    'Y-INTOFF
0011        0660 N1I    =    '1-INTOFF
0018        0670 N8I    =    '8-INTOFF
0019        0680 N9I    =    '9-INTOFF
0010        0690 N0I    =    '0-INTOFF
            0700 ;
            0710 ;CHECKERS EQUATES
            0720 ;
            0730 ;CODES FOR SPECIAL CHECKERS CHARACTER SET
            0740 ;
0000        0750 EMPTY  =    0      ;EMPTY SQUARE
0001        0760 CHECKER=    1      ;ORDINARY CHECKER
0002        0770 KING   =    2
0003        0780 CURS   =    3      ;CURSOR (X)
0004        0790 BORDER =    4      ;USED FOR TOP AND BOTTOM BORDERS OF BOARD
            0800 ;
0000        0810 CLP0   =    0      ;PLAYER 0 (HUMAN)
0080        0820 CLP1   =    $80        ;PLAYER 1 (COMPUTER)
00C0        0830 CLBOR  =    $C0        ;BORDER COLOR (USED TO SET UP 2 MSB'S OF CHAR)
5000        0840 PMB    =    $5000  ;PLAYER MISSILE BASE ADDRESS & PROGRAM LOCATION
0000        0850         PAGE
            0860 ;
            0870 ; RAM VARIABLES
            0880 ;
0000        0890        *=  PMB
5000        0900 BOARD  *=  *+32        ;CHECKER BOARD (ONLY 32 BLOCK SQUARES ARE USED)
5020        0910 T0     *=  *+1         ;TEMP FOR MOVING BOARD TO MEM MAP
            0920 ;
            0930 ;PLAYER AND MISSILE GRAPHICS.
            0940 ;PLAYERS ARE USED FOR SQUARES, MISSILES FOR LEFT AND RIGHT BORDERS.
            0950 ;
5021        0960        *=   PMB+$180
5180        0970 GRM03  *=   *+$80     ;MISSILE GRAPHICS
5200        0980 GRP0   *=   *+$80     ;PLAYER 0 GRAPHICS
5280        0990 GRP1   *=   *+$80     ;PLAYER 1
5300        1000 GRP2   *=   *+$80     ;       2
5380        1010 GRP3   *=   *+$80     ;       3
            1020 ;
5400        1030 TITL   *=   *+20      ;TOP LINE OF CHARS -- ATASCII MESSAGE
5414        1040 TOPBRD *=   *+16      ;TOP BORDER OF BOARD
5424        1050 BRDSP  *=   8*16+*    ;BOARD DISPLAY
54A4        1060 BOTBRD *=   *+16      ;BOTTOM BORDER
54B4        1070         PAGE
            1080 ;
            1090 ;GP -- SPECIAL CHECKERS CHARACTER SET (ONLY CODES 0-4 ARE USED).
            1100 ;
54B4        1110        *=   PMB+$600
            1120 GR
5600 00     1130        .BYTE 0,0,0,0,0,0,0,0 ; BLANK (0)
5601 00
5602 00
5603 00
5604 00
5605 00
5606 00
5607 00
5608 3C     1140        .BYTE $3C,$7E,$FF,$FF,$FF,$FF,$7E,$3C ;CHECKER (1)
5609 7E
560A FF
560B FF
560C FF
560D FF
560E 7E
560F 3C
5610 3C     1150        .BYTE $3C,$7E,$A5,$A5,$C3,$C3,$7E,$3C ;KING (2)
5611 7E
5612 A5
5613 A5
5614 C3
5615 C3
5616 7E
5617 3C
5618 C3     1160        .BYTE $C3,$66,$3C,$18,$18,$3C,$66,$C3 ;CURSOR (3)
5619 66
561A 3C
561B 18
561C 18
561D 3C
561E 66
561F C3
5620 00     1170        .BYTE 0,$FF,$FF,$FF,$FF,$FF,$FF,0 ;BORDER (4)
5621 FF
5622 FF
5623 FF
5624 FF
5625 FF
5626 FF
5627 00
5628        1180         PAGE
            1190 ;
            1200 ;
            1210 ;DISPLAY LIST
            1220 ;
            1230 DSP
5628 70     1240        .BYTE BLANK8 ;24 BLANK LINES
5629 70     1250        .BYTE BLANK8
562A 70     1260        .BYTE BLANK8
562B 46     1270        .BYTE RELOAD+6 ;LINES 0-7 MESSAGE LINE: 20 ACROSS X 5 COLOR X 1 LINE RESOLUTION CHARACTERS
562C 0054   1280        .WORD TITL
562E 80     1290        .BYTE INT+BLANK1 ;8. INTERRUPT TO CHANGE CHARACTER BASE ADDRESS AND CHANGE TO NARROW SCREEN.
562F 06     1300        .BYTE 6        ;9-16. TOP BORDER: 16 X 5 X 1 CHARS (LAST LINE IS TOP OF 1ST ROW OF SQUARES)
5630 10     1310        .BYTE BLANK2   ;17-18. TOP OF FIRST ROW OF SQUARES
            1320 ;                     CHECKERBOARD (8 LINES OF CHARS WITH SPACES INBETWEEN - 22 LINES/SQUARE)
5631 07     1330        .BYTE 7        ;19-34. 16X5X2 LINE RESOLUTION CHARS
5632 50     1340        .BYTE BLANK6   ;35-40. FIRST 3 LINES=BOTTOM OF PREVIOUS SQUARE.
5633 07     1350        .BYTE 7        ;41-56
5634 50     1360        .BYTE BLANK6   ;57-62. LAST 3 LINES=TOP OF NEXT SQUARE.
5635 07     1370        .BYTE 7        ;63-78
5636 50     1380        .BYTE BLANK6   ;79-84
5637 07     1390        .BYTE 7        ;85-100
5638 50     1400        .BYTE BLANK6   ;101-106
5639 07     1410        .BYTE 7        ;107-122
563A 50     1420        .BYTE BLANK6   ;123-128
563B 07     1430        .BYTE 7        ;129-144
563C 50     1440        .BYTE BLANK6   ;145-150
563D 07     1450        .BYTE 7        ;151-166
563E 50     1460        .BYTE BLANK6   ;167-172
563F 07     1470        .BYTE 7        ;173-188
            1480 ;                      NEXT THREE LINES ARE BOTTOM OF PREVIOUS SQUARE
5640 10     1490        .BYTE BLANK2   ;189-190. END OF NORMAL DISPLAY (SHOULD BE ON SCREEN ON ALL TV'S).
5641 06     1500        .BYTE 6        ;191-198. BOTTOM BORDER (MAY OVERSCAN, BUT NOT ESSENTIAL TO GAME PLAY)
5642 41     1510        .BYTE JMPWT    ;WAIT FOR NEXT VBLANK, THEN START OVER
5643 2856   1520        .WORD DSP
            1530 ;
            1540 ;
            1550 ;DSP -- DISPLAY LIST INTERRUPT HANDLER.
            1560 ;CHANGES CHARACTER BASE AND WIDTH OF DISPLAY FOR SPECIAL CHECKERS GRAPHICS
            1570 ;THE OS WILL CHANGE CHBASE BACK TO NORMAL DURING VERTICAL BLANK.
            1580 ;
            1590 NCHR
5645 48     1600        PHA
5646 A956   1610        LDA  #GR/256
5648 8D09D4 1620        STA  CHBASE
            1630 ;
            1640 ;INSTRUCTION FETCH DMA ENABLE, P/M 2 LINE RES, P/M DMA ENABLE, NARROW SCREEN (128 CLOCKS)
564B A92D   1650        LDA  #$2D
564D 8D00D4 1660        STA  DMACTL
5650 68     1670        PLA
5651 40     1680        RTI
5652        1690         PAGE
            1700 ;
            1710 ;INITIALIZATION CODE -- START EXECUTION HERE
            1720 ;
5652        1730        *=   PMB+$700
            1740 ;
            1750 ;INIT OS'S DMACTL VRRIRBLE
            1760 ;INSTRUCTION FETCH DMA ENABLE, P/M 2 LINE RES, P/M DMA ENABLE, STANDARD SCREEN (160 CLOCKS)
            1770 ;
5700 A92E   1780        LDA  #$2E
5702 8D2F02 1790        STA  SDMCTL
            1800 ;
            1810 ;CLEAR RAM
            1820 ;
5705 A900   1830        LDA  #0
5707 AA     1840        TAX
            1850 INITLP
5708 9D0050 1860        STA  PMB,X
570B 9D0051 1870        STA  PMB+$100,X
570E 9D0052 1880        STA  PMB+$200,X
5711 9D0053 1890        STA  PMB+$300,X
5714 9D0054 1900        STA  PMB+$400,X
5717 E8     1910        INX
5718 D0EE   1920        BNE  INITLP
            1930 ;
            1940 ;INITIALIZE MISSILE GRAPHICS FOR BORDERS
            1950 ;
571A A90E   1960        LDA  #$0E
571C A05E   1970        LDY  #$5E
571E 999451 1980 LQPZ   STA  GRM03+$14,Y
5721 88     1990        DEY
5722 D0FA   2000        BNE  LQPZ
            2010 ;
            2020 ;INITIALIZE TOP AND BOTTOM BORDERS.
            2030 ;
5724 A010   2040        LDY  #16
5726 A9C4   2050        LDA  #CLBOR+BORDER
5728 991354 2060 TBLP   STA  TOPBRD-1,Y
572B 99A354 2070        STA  BOTBRD-1,Y
572E 88     2080        DEY
572F D0F7   2090        BNE  TBLP ; CONTINUE UNTIL Y=0
            2100 ;
            2110 ;INITIALIZE PLAYER GRAPHICS FOR SQUARES (CHECKER BOARD) Y=0
            2120 ;
5731 A9F0   2130        LDA  #$F0
5733 A20A   2140 IN2    LDX  #10
5735 991852 2150 IN3    STA  GRP0+$18,Y
5738 999852 2160        STA  GRP1+$18,Y
573B 991853 2170        STA  GRP2+$18,Y
573E 999853 2180        STA  GRP3+$18,Y
            2190 ;
5741 48     2200        PHA
5742 A90A   2210        LDA  #$0A
5744 999851 2220        STA  GRM03+$18,Y ;REST OF MISSILE GRAPHICS
5747 68     2230        PLA
5748 C8     2240        INY
5749 CA     2250        DEX
574A 10E9   2260        BPL  IN3
574C 49FF   2270        EOR  #$FF      ;FILL IN OPPOSITE SQUARES
574E C058   2280        CPY  #88
5750 90E1   2290        BCC  IN2
5752 A008   2300        LDY  #8
            2310 ;
            2320 ; INITIALIZE PLAYER AND MISSILE POSITIONS AND COLORS
            2330 ;
5754 B9D857 2340 IN4    LDA  ITBL,Y
5757 9900D0 2350        STA  HPOSP0,Y
575A 8A     2360        TXA           ;$FF
575B 9908D0 2370        STA  SIZEP0,Y ;$03 INDICATES 4 TIMES NORMAL SIZE (REST IS DON'T CARE)
575E B9E057 2380        LDA  ITBL1,Y
5761 99C002 2390        STA  PCOLR0,Y
5764 88     2400        DEY
5765 10ED   2410        BPL  IN4
            2420 ;
            2430 ;OS, ANTIC, POKEY INITIALIZATION
            2440 ;
5767 A928   2450        LDA  #DSP&$FF  ; DISPLAY LIST START ADDRESS (LSB)
5769 8D3002 2460        STA  SDLSTL
576C A956   2470        LDA  #DSP/256  ; MSB OF ADDRESS
576E 8D3102 2480        STA  SDLSTH
5771 A903   2490        LDA  #3        ;ENABLE PLAYER/MISSILE DMA TO GRAPHICS REGS.
5773 8D1DD0 2500        STA  GRACTL
5776 A950   2510        LDA  #PMB/256  ;MSB OF ADDRESS OF PLAYER/MISSILE GRAPHICS
5778 8D07D4 2520        STA  PMBASE
577B A914   2530        LDA  #$14      ;5TH PLAYER ENABLE (USE PF3 FOR MISSILE COLOR), PF TAKES PRIO OVER PLAYERS
577D 8D6F02 2540        STA  GPRIOR    ;OS PRIORITY REG
5780 A945   2550        LDA  #NCHR&$FF ;DISPLAY LIST INTERRUPT VECTOR (LSB)
5782 8D0002 2560        STA  VDSLST
5785 A956   2570        LDA  #NCHR/256
5787 8D0102 2580        STA  VDSLST+1
578A 8E0ED4 2590        STX  NMIEN     ;X=$FF   $C0 ENABLES DISPLAY LIST & VBLANK INTERRUPTS.
            2600 ;
            2610 ;INITIALIZE BOARD DISPLAY
            2620 ;
578D A20B   2630        LDX  #11
            2640 BRDLP
578F A901   2650        LDA  #CHECKER+CLP0 ;HUMAN PIECES ON SQUARES 0-11
5791 9D0050 2660        STA  BOARD,X
5794 A981   2670        LDA  #CHECKER+CLP1 ;COMPUTER PIECES ON SQUARES 20-31
5796 9D1450 2680        STA  BOARD+20,X
5799 CA     2690        DEX
579A 10F3   2700        BPL  BRDLP
            2710 ;
            2720 ;MOVE COPYRIGHT MESSAGE TO MESSAGE DISPLAY LINE
            2730 ;
579C A213   2740        LDX  #19
579E BDE957 2750 IN6    LDA  COPY,X
57A1 9D0054 2760        STA  TITL,X
57A4 CA     2770        DEX
57A5 10F7   2780        BPL  IN6
            2790 ;
            2800 ;LOOP TO MOVE BOARD TO GRAPHICS AREA.
            2810 ;THE CHECKERS PROGRAM LOGIC COULD BE ADDED HERE OR A VBLANK INTERRUPT COULD BE USED.
            2820 ;
            2830 LOOP
57A7 20AD57 2840        JSR  UPCHR
57AA 4CA757 2850        JMP  LOOP
            2860 ;
            2870 ;
            2880 ;
            2890 ;
            2900 ;UPCHR -- SUBROUTINE TO MOVE 32 BYTES OF CHECKER BOARD TO DISPLAY RAM.
            2910 ;
            2920 UPCHR
57AD A21F   2930        LDX  #31       ;SQUARE 31 = UPPER LEFT
57AF A000   2940        LDY  #0
            2950 UPLP1
57B1 A903   2960        LDA  #4-1      ;4 SQUARES/LINE
57B3 8D2050 2970        STA  T0
            2980 UPLP2
57B6 BD0050 2990        LDA  BOARD,X
57B9 992654 3000        STA  BRDSP+2,Y ; FOR ROWS SHIFTED TO RIGHT
57BC BDFC4F 3010        LDA  BOARD-4,X
57BF 993454 3020        STA  BRDSP+$10,Y ; FOR ROWS SHIFTED TO LEFT
57C2 C8     3030        INY
57C3 C8     3040        INY
57C4 C8     3050        INY
57C5 C8     3060        INY
57C6 CA     3070        DEX
57C7 CE2050 3080        DEC  T0
57CA 10EA   3090        BPL  UPLP2
            3100 ;
57CC 98     3110        TYA
57CD 18     3120        CLC
57CE 6910   3130        ADC  #$10
57D0 A8     3140        TAY
57D1 8A     3150        TXA
57D2 E903   3160        SBC  #4-1      ;CARRY IS CLEAR (SUBTRACT 4)
57D4 AA     3170        TAX
57D5 B0DA   3180        BCS  UPLP1
57D7 60     3190        RTS
            3200 ;
            3210 ;
            3220 ;
            3230 ;
            3240 ;DATA
            3250 ;HORIZONTAL POSITION OF PLAYERS (SQUARES) AND MISSILES (SIDE BORDERS).
            3260 ;M0=RIGHT BORDER, M1=LEFT BORDER
            3270 ;M2 & M3 ARE PLACED WITH M1.
            3280 ;             P0, P1, P2, P3, M0, M1, M2, M2
            3290 ITBL
57D8 3C     3300        .BYTE $3C,$5C,$7C,$9C,$BC,$38,$38,$38
57D9 5C
57DA 7C
57DB 9C
57DC BC
57DD 38
57DE 38
57DF 38
            3310 ;
            3320 ;COLOR TABLE
            3330 ITBL1
57E0 34     3340        .BYTE $34,$34,$34,$34 ;4 PLAYERS (RED SQUARES)
57E1 34
57E2 34
57E3 34
57E4 36     3350        .BYTE $36      ;PF0 RED CHECKERS AND MESSAGES
57E5 88     3360        .BYTE $88      ;PF1 BLUE CHARACTERS
57E6 0E     3370        .BYTE $0E      ;PF2 WHITE CHECKERS AND MESSAGES
57E7 26     3380        .BYTE $26      ;PF3 YELLOW BORDER (CHARS & MISSILES)
57E8 00     3390        .BYTE 0        ;BK: BLACK BACKGROUND
            3400 ;
            3410 ;"COPYRIGHT ATARI 1980" MESSAGE
            3420 ;
0000        3430 OF     =    $00       ;FOR PF0 COLOR (RED)
0030        3440 OF2    =    $80       ;FOR PF2 COLOR (WHITE)
0040        3450 OF3    =    $40       ;FOR PF1 COLOR (BLUE)
            3460 TGTBL
57E9 00     3470 COPY   .BYTE SPI,CI+OF,OI+OF,PI+OF,YI+OF,RI+OF,II+OF,GI+OF,HI+OF,TI+OF
57EA 23
57EB 2F
57EC 30
57ED 39
57EE 32
57EF 29
57F0 27
57F1 28
57F2 34
57F3 A1     3480        .BYTE AI+OF2,TI+OF2,AI+OF2,RI+OF2,II+OF2,N1I+OF3,N9I+OF3,N8I+OF3,N0I+OF3
57F4 B4
57F5 A1
57F6 B2
57F7 A9
57F8 51
57F9 59
57FA 58
57FB 50
                            .TITLE 'COLEEN FLOATING POINT ROUTINES BY C SHAW'
                    ;
                    ;       MORE ACCURATE VERSION OF THE FOLLOWING SHEPARDSON ROUTINES
                    ;
                    ;       EXP, EXP10, LOG, LOG10, SIN, COS, ATAN, SQR AND POWER
                    ;
                    ;       THESE ROUTINES WERE TAKEN FROM THE CALCULATOR CARTRIDGE AND MODIFIED
                    ;       MANY OTHER MATH FUNCTIONS SUCH AS TAN, ARCSIN AND ARCCOS ARE ALSO
                    ;       INCLUDED IN THAT CARTRIDGE.
                    ;
009B                CR      =       $9B             ;ATASCII CARRIAGE RETURN
                    ;
0005                GETREC  =       5               ;GET RECORD
0009                PUTREC  =       9               ;PUT RECORD
0342                ICCOM   =       $342
0344                ICBAL   =       $344
0348                ICBLL   =       $348
E456                CIOV    =       $E456

                    ;                               FLOATING POINT SUBROUTINES
                    ;
0006                FPREC   =       6               ;FLOATING PT PRECISION (# OF BYTES)
                    ;                               IF CARRY USED THEN CARRY CLEAR => NO ERROR, CARRY SET => ERROR
D800                AFP     =       $D800           ;ASCII->FLOATING POINT (FP)
                    ;                               INBUFF+CIX -> FR0, CIX, CARRY
D8E6                FASC    =       $D8E6           ;FP -> ASCII      FR0-> LBUFF  (INBUFF)
D9AA                IFP     =       $D9AA           ;INTEGER -> FP
                    ;                               0-$FFFF (LSB,MSB) IN FR0,FR0+1->FR0
D9D2                FPI     =       $D9D2           ;FP -> INTEGER    FR0 -> FR0,FR0+1, CARRY
DA60                FSUB    =       $DA60           ;FR0 <- FR0 - FR1  ,CARRY
DA66                FADD    =       $DA66           ;FR0 <- FR0 + FR1  ,CARRY
DADB                FMUL    =       $DADB           ;FR0 <- FR0 * FR1  ,CARRY
DB28                FDIV    =       $DB28           ;FR0 <- FR0 / FR1  ,CARRY
DD89                FLD0R   =       $DD89           ;FLOATING LOAD REG0    FR0 <- (X,Y)
DD98                FLD1R   =       $DD98           ;    "     "   REG1    FR1 <- (X,Y)
DDA7                FST0R   =       $DDA7           ;FLOATING STORE REG0 (X,Y) <- FR0
DDB6                FMOVE   =       $DDB6           ;FR1 <- FR0
DD40                PLYEVL  =       $DD40           ;FR0 <- P(Z) = SUM(I=N TO 0) (A(I)*Z**I)     CARRY
                    ;                               INPUT: (X,Y) = A(N),A(N-1)...A(0)  -> PLYARG
                    ;                                      ACC   = # OF COEFFICIENTS = DEGREE+1
                    ;                                      FR0   = Z
DDC0                EXP     =       $DDC0           ;FR0 <- E**FR0 = EXP10(FR0 * LOG10(E))  CARRY
DDCC                EXP10   =       $DDCC           ;FR0 <- 10**FR0  CARRY
DECD                LOG     =       $DECD           ;FR0 <- LN(FR0) = LOG10(FR0)/LOG10(E)   CARRY
DED1                LOG10   =       $DED1           ;FR0 <- LOG10 (FR0)    CARRY

                    ;                               THE FOLLOWING ARE IN BASIC CARTRIDGE:
                    ;SIN    =       $BD81           ;FR0 <- SIN(FR0)  DEGFLG=0 =>RADS,  6=>DEG.   CARRY
                    ;COS    =       $BD73           ;FR0 <- COS(FR0)    CARRY
                    ;ATAN   =       $BE43           ;FR0 <- ATAN(FR0)   CARRY
                    ;SQR    =       $BEB1           ;FR0 <- SQUAREROOT(FR0)   CARRY


                    ;FLOATING POINT ROUTINES ZERO PAGE (NEEDED ONLY IF F.P. ROUTINES ARE CALLED)
                            *=$D4
00D4                FR0     *=*+FPREC       ;FP REG0
00DA                FRE     *=*+FPREC
00E0                FR1     *=*+FPREC       ;FP REG1
00E6                FR2     *=*+FPREC
00EC                FRX     *=*+1           ;FP SPARE
00ED                EEXP    *=*+1           ;VALUE OF E
00EE                NSIGN   *=*+1           ;SIGN OF #
00EF                ESIGN   *=*+1           ;SIGN OF EXPONENT
00F0                FCHRFLG *=*+1           ;1ST CHAR FLAG
00F1                DIGRT   *=*+1           ;# OF DIGITS RIGHT OF DECIMAL
00F2                CIX     *=*+1           ;CURRENT INPUT INDEX
00F3                INBUFF  *=*+2           ;POINTS TO USER'S LINE INPUT BUFFER
00F5                ZTEMP1  *=*+2
00F7                ZTEMP4  *=*+2
00F9                ZTEMP3  *=*+2
00FB                RADFLG  *=*+1           ;0=RADIANS, 6=DEGREES
00FC                FLPTR   *=*+2           ;POINTS TO USER'S FLOATING PT NUMBER
00FE                FPTR2   *=*+2

                    ;FLOATING PT ROUTINES' NON-ZERO PAGE RAM (NEEDED ONLY IF F.P. ROUTINES CALLED)
                            *=$57E
057E                LBPR1   *=*+1           ;LBUFF PREFIX 1
057F                LBPR2   *=*+1           ;LBUFF PREFIX 2
0580                LBUFF   *=*+128         ;LINE BUFFER
05E0                PLYARG  =       LBUFF+$60       ;POLYNOMIAL ARGUMENTS
05E6                FPSCR   =       PLYARG+FPREC
05EC                FPSCR1  =       FPSCR+FPREC
05E6                FSCR    =       FPSCR
05EC                FSCR1   =       FPSCR1



                    ;                               FP PACKAGE EQUATES FOR SIN, COS, ATAN, AND SQR ROUTINES ETC

000B                NATCF   =       $B              ;NUMBER OF ATAN COEFFICIENTS FOR POLYNOMIAL EVALUATION
0006                NSCF    =       6               ;NUMBER OF SIN COEFFICIENTS

D905                FASC2   =       $D905           ;AFTER FASC (FINISH FP TO ASCII CONVERSION)
D920                XEFORM  =       $D920           ;!EFORM   PROCESS E FORMAT    FOR FP -> ASCII CONVERSION
D928                XEFRM2  =       $D928           ;AFTER XEFORM (FINISH CONVERSION)
DA44                ZFR0    =       $DA44           ;FR0 <- 0
DA46                ZF1     =       $DA46           ;CLEAR 6 BYTES STARTING AT 0,X
DA51                INTLBF  =       $DA51           ;INIT LBUFF INTO INBUFF FOR FP -> ASCII CONVERSION
DC00                NORM    =       $DC00           ;NORMALIZE FLOATING POINT NUMBER - USED BY STRUNC ONLY
DC70                XCVFR0  =       $DC70           ;ICVFR0 FP TO 10 ASCII DIGITS IN LBUFF
DE03                EXP1    =       $DE03           ;MIDDLE OF EXP10 WHERE PLYEVL IS CALLED
DE12                EXP11   =       $DE12           ;AFTER PLYEVL IN EXP10
DE89                LOG10E  =       $DE89           ;LOGTEN (E) = .4342944819
DE95                XFORM   =       $DE95           ;FR0 <- (FR0-(X,Y)) / (FR0+(X,Y)) .
DF6C                FHALF   =       $DF6C           ;FLOATING POINT CONSTANT 5
DFAE                ATCOEF  =       $DFAE           ;ATAN COEFFICIENTS
DFEA                FP9S    =       $DFEA           ;FLOATING POINT CONSTANT .9999999999 (ALMOST 1)
DFF0                PIOV4   =       $DFF0           ;FLOATING POINT CONSTANT PI/4 = .7853981634

                    ;                               VARIABLES
                            *=$480
0480                QUADFLG *=*+1                   ;SIN QUADRANT FLAG
0481                INTFLG  *=*+1                   ;FLAG FOR POWER ROUTINE
0482                FTEMP   *=*+6                   ;TEMPORARY FLOATING POINT REGISTER POR POWER ROUTINE

                            *=$A000                 ;ARBITRARY STARTING POINT
                    ;
                    ;       TEST PROGRAM
                    ;
A000                START
A000 20 4C A0               JSR     GETNUM
A003 20 B6 DD               JSR     FMOVE
A006 20 4C A0               JSR     GETNUM          ;GET 2ND NUMBER FROM E -- OMIT IF ONLY ONE ARGUMENT

A009 20 CE A0               JSR     SPOWER          ;CHANGE TO GET DIFFERENT ROUTINES
A00C 90 0A                  BCC     NOERR
                    ;
                    ;       ERROR -- DISPLAY MESSAGE
                    ;
A00E A9 79                  LDA     #ERRMSG
A010 8D 44 03               STA     ICBAL
A013 A9 A0                  LDA     #ERRMSG/256
A015 4C 32 A0               JMP     CONTIN

A018                NOERR
A018 20 E6 D8               JSR     FASC            ;FLOATING POINT TO ASCII
                    ;
                    ;       FIND END OF STRING AND CHANGE NEGATIVE # TO POSITIVE AND ADD CARRIAGE RETURN
                    ;
A01B A0 FF                  LDY     #$FF
A01D                MLOOP
A01D C8                     INY
A01E B1 F3                  LDA     (INBUFF),Y
A020 10 FB                  BPL     MLOOP
A022 29 7F                  AND     #$7F
A024 91 F3                  STA     (INBUFF),Y
A026 C8                     INY
A027 A9 9B                  LDA     #CR
A029 91 F3                  STA     (INBUFF),Y
                    ;
                    ;       DISPLAY RESULT
                    ;
A02B A5 F3                  LDA     INBUFF
A02D 8D 44 03               STA     ICBAL
A030 A5 F4                  LDA     INBUFF+1
A032                CONTIN
A032 8D 45 03               STA     ICBAL+1
A035 A9 09                  LDA     #PUTREC
A037 8D 42 03               STA     ICCOM
A03A A9 28                  LDA     #40
A03C 8D 48 03               STA     ICBLL
A03F A9 00                  LDA     #0
A041 8D 49 03               STA     ICBLL+1
A044 A2 00                  LDX     #0
A046 20 56 E4               JSR     CIOV

A049 4C 00 A0               JMP     START               ;DO IT AGAIN
A04C                GETNUM                      ;GET ONE NUMBER FROM E (IOCB #0)
A04C A9 05                  LDA     #GETREC             ;GET RECORD (ENDS IN CR)
A04E 8D 42 03               STA     ICCOM
A051 A9 80                  LDA     #LBUFF
A053 8D 44 03               STA     ICBAL
A056 A9 05                  LDA     #LBUFF/256
A058 8D 45 03               STA     ICBAL+1
A05B A9 28                  LDA     #40
A05D 8D 48 03               STA     ICBLL
A060 A9 00                  LDA     #0
A062 8D 49 03               STA     ICBLL+1
A065 A2 00                  LDX     #0
A067 20 56 E4               JSR     CIOV
A06A A9 80                  LDA     #LBUFF
A06C 85 F3                  STA     INBUFF
A06E A9 05                  LDA     #LBUFF/256
A070 85 F4                  STA     INBUFF+1
A072 A9 00                  LDA     #0
A074 85 F2                  STA     CIX
A076 4C 00 D8               JMP     AFP                 ;CALL ASCII TO FLOATING POINT AND RETURN


A079 45 52 52       ERRMSG  .BYTE   "ERROR",CR                  ;INDICATES CARRY SET RETURN FROM FP ROUTINE
A07C 4F 52 9B

                    ;
                    ;       FR0 <- E^FR0
                    ;
                    ;       USES INTEGER FUNCTION LIKE BASIC'S INSTEAD OF JUST IFP, WHICH ROUNDS
                    ;       PROVIDES ACCURACY OF AT LEAST 7 DIGITS (EXCEPT POSSIBLY AT EXTREMA)
                    ;       INSTEAD OF 6.

A07F                SEXPE                           ;E^X (SEE SHEP ATARI BASIC $DDC0 EXP)
A07F A2 89                  LDX     #LOG10E         ;E^X = 10^(X*LOGTEN(E))
A081 A0 DE                  LDY     #LOG10E/256
A083 20 E8 A2               JSR     LD1MUL          ;FR0 <- FR0*LOG10E
                    ;
                    ;       FR0 <- 10^FR0 (SEE COMMENTS FOR SEXPE)
                    ;
                    ;       RETURNS EXACT POWER OF 10 FOR INTEGERS.
                    ;
A086                SEXPTE                          ;10^X (SEE SHEP ATARI BASIC $DDCC EXP10)
A086 A9 00                  LDA     #0              ;CLEAR TRANSFORM FLAG
A088 85 F1                  STA     DIGRT           ;XFMFLG
A08A A5 D4                  LDA     FR0
A08C 85 F0                  STA     FCHRFLG         ;SAME AS SGNFLG   REMEMBER ARG SIGN
A08E 20 D2 A2               JSR     SABSVA          ;TAKE ABSOLUTE VALUE, A<-FR0
A091 38                     SEC
A092 E9 40                  SBC     #$40
A094 30 27                  BMI     SEXP05          ;X<1 SO USE SERIES DIRECTLY (BUT CHECK FOR 0 FIRST)
A096 A2 E6                  LDX     #FPSCR
A098 A0 05                  LDY     #FPSCR/256
A09A 20 A7 DD               JSR     FST0R           ;SAVE IN SCRATCH REG
A09D 20 18 A3               JSR     SINTEG          ;GREATEST INTEGER <= X
A0A0 20 D2 D9               JSR     FPI             ;MAKE INTEGER
A0A3 B0 27                  BCS     SFERR3          ;RETURN IF ERROR
A0A5 A5 D5                  LDA     FR0+1           ;CHECK MSB
A0A7 D0 23                  BNE     SFERR3          ;SHOULDN'T HAVE ANY -- RETURN IF ERROR
A0A9 A5 D4                  LDA     FR0
A0AB 85 F1                  STA     DIGRT           ;XFMFLG         SAVE MULTIPLIER EXP
A0AD 20 AA D9               JSR     IFP             ;NOW TURN IT BACK TO FP
A0B0 20 B6 DD               JSR     FMOVE           ;FR1 <- FR0
A0B3 A2 E6                  LDX     #FPSCR          ;RELOAD FROM TEMP SCRATCH REG
A0B5 A0 05                  LDY     #FPSCR/256
A0B7 20 89 DD               JSR     FLD0R
A0BA 20 07 A3               JSR     SFSUB
A0BD                SEXP05
A0BD A5 D4                  LDA     FR0
A0BF D0 08                  BNE     SEXP10
A0C1 A9 01                  LDA     #1              ;10^0 = 1
A0C3 20 53 A3               JSR     PSET0
A0C6 4C 12 DE               JMP     EXP11           ;$DE12 DO 10^X, SKIPPING PLYEVL   LDA XFMFLG
A0C9                SEXP10
A0C9 4C 03 DE               JMP     EXP1            ;DO REST OF 10^X
A0CC                SFERR3
A0CC 38                     SEC
A0CD 60             INIT    RTS

                    ;       FR0 <- FR0 ^ FR1 = SEXPTE (FR1 * SLOGTE (FR0))
                    ;
                    ;       USES MORE ACCURATE SEXPTE INSTEAD OF EXP10
                    ;       RETURNS EXACT INTEGER IF BOTH FR0 AND FR1 ARE POSITIVE INTEGERS.
                    ;       RETURNS RECIPROCAL INTEGER IF BOTH ARE INTEGERS AND FR1 < 0
                    ;       RETURNS CARRY SETT IF FR0 < 0 OR (FR0 = 0 AND FR1 < 0) OR OVERFLOW
                    ;       0 ^ FR1 = 0 IF FR1 = 0
                    ;       0 ^ 0 = 1
                    ;
A0CE                SPOWER
A0CE A5 D4                  LDA     FR0             ;FR0 = 0?
A0D0 D0 0D                  BNE     SPOW20          ;NO
A0D2 A9 00                  LDA     #0              ;YES.
A0D4 A6 E0                  LDX     FR1
A0D6 30 78                  BMI     PERR2           ;FR1 < 0        0 ^ -X => ERROR
A0D8 D0 02                  BNE     SPOW10          ;FR1 > 0        0 ^ X = 0
A0DA A9 01                  LDA     #1              ;FR1 = 0        0 ^ 0 = 1
A0DC                SPOW10
A0DC 4C 53 A3               JMP     PSET0
A0DF                SPOW20
A0DF A5 E0                  LDA     FR1
A0E1 48                     PHA                     ;SAVE FR1'S SIGN
A0E2 29 7F                  AND     #$7F            ;TAKE ABSOLUTE VALUE OF FR1
A0E4 85 E0                  STA     FR1
A0E6 A2 82                  LDX     #FTEMP          ;SAVE FR1 IN FTEMP
A0E8 A0 04                  LDY     #FTEMP/256
A0EA 20 D9 A2               JSR     FST1R
A0ED 20 B6 DD               JSR     FMOVE
A0F0 A9 01                  LDA     #1
A0F2 8D 81 04               STA     INTFLG          ;ASSUME NOT BOTH INTEGERS
A0F5 20 31 A3               JSR     STRUNC          ;TRUNCATE FR0 -- RETURN A=0 AND EQ IF FR0 WAS ALREADY AN INTEGER
A0F8 D0 0F                  BNE     SPOW50          ;FR0 WAS NOT AN INTEGER
A0FA A2 82                  LDX     #FTEMP          ;LOAD SAVED VALUE INTO FR0
A0FC A0 04                  LDY     #FTEMP/256
A0FE 20 89 DD               JSR     FLD0R
A101 20 31 A3               JSR     STRUNC          ;TEST FOR INTEGER
A104 D0 03                  BNE     SPOW50          ;NOT INTEGER
A106 8D 81 04               STA     INTFLG          ;0 => BOTH INTEGER => RESULT SHOULD BE INTEGER
A109                SPOW50
A109 A2 E0                  LDX     #FR1
A10B A0 00                  LDY     #FR1/256        ;FR0 <- FR1 (MOVE ORIGINAL FR0 BACK)
A10D 20 89 DD               JSR     FLD0R
A110 20 58 A1               JSR     SLOGTE          ;LOG10(FR0)
A113 B0 3A                  BCS     PERROR          ;ERROR => POP FR1 SIGN AND RETURN
A115 A2 82                  LDX     #FTEMP          ;LOAD FR1 AGAIN
A117 A0 04                  LDY     #FTEMP/256
A119 20 98 DD               JSR     FLD1R
A11C 20 DB DA               JSR     FMUL            ;FR0 <- FR1 * LOG10(BASE)
A11F B0 2E                  BCS     PERROR          ;RETURN IF ERROR
A121 20 86 A0               JSR     SEXPTE          ;10 ^ FR0
A124 B0 29                  BCS     PERROR
A126 AD 81 04               LDA     INTFLG          ;SHOULD RESULT BE INTEGER?
A129 D0 15                  BNE     SPOW80          ;NO.
                                                    ;YES ROUND TO NEAREST INTEGER
A12B A2 6C                  LDX     #FHALF          ;FR1 <- 0.5
A12D A0 DF                  LDY     #FHALF/256
A12F 20 98 DD               JSR     FLD1R
A132 A5 D4                  LDA     FR0
A134 10 04                  BPL     SROU10


A136 A9 BF                  LDA     #$3F+$80        ;IF FR0 =0 THEN FR1 <- -0.5
A138 85 E0                  STA     FR1
A13A                SROU10
A13A 20 F7 A2               JSR     SFADD           ;FR0 <- FR0 + FR1 (2-LEVEL RETURN IF ERROR)
A13D 20 31 A3               JSR     STRUNC          ;TRUNCATE
A140                SPOW80
A140 18                     CLC                     ;INDICATE NO ERROR?
A141 68                     PLA                     ;RELOAD FR1'S ORIGINAL SIGN
A142 10 0D                  BPL     PRTN            ;DONE IF > 0
A144 20 B6 DD               JSR     FMOVE           ;IF < 0 THEN TAKE RECIPROCAL
A147 A9 01                  LDA     #1
A149 20 53 A3               JSR     PSET0           ;FR0 <- 1
A14C 4C 28 DB               JMP     FDIV
A14F                PERROR
A14F 68                     PLA                     ;DISCARD FR1'S SIGN
A150                PERR2
A150 38                     SEC                     ;INDICATE ERROR
A151                PRTN
A151 60                     RTS

                    ;
                    ;       FR0 <- NATURAL LOG (FR0)
                    ;
                    ;       RETURNS CARRY SET IF FR0<=0
                    ;       RETURNS EXACTLY 0 IF FR0 = 1
                    ;
A152                SLN
A152 20 5E A1               JSR     LOGCHK          ;CHECK FDR 0,1 (SPECIAL CASES)
A155 4C CD DE               JMP     LOG

                    ;
                    ;       FR0 <- COMMON LOG (FR0) (LOG BASE 10)
                    ;       SIMILAR TO SLN
                    ;
A158                SLOGTE
A158 20 5E A1               JSR     LOGCHK
A15B 4C D1 DE               JMP     LOG10
A15E                LOGCHK                          ;CHECK FOR 0,1
A15E 38                     SEC
A15F A5 D4                  LDA     FR0
A161 F0 13                  BEQ     PULRTN          ;LN(0),LOG(0) => ERROR
A163 30 11                  BMI     PULRTN          ;<0  => ERROR => 2-LEVEL RETURN
A165 A2 05                  LDX     #FPREC-1
A167                LOGCLP
A167 B5 D4                  LDA     FR0,X
A169 DD A9 A3               CMP     ONE,X
A16C D0 0A                  BNE     RTURN2          ;NOT 1 => OK
A16E CA                     DEX
A16F 10 F6                  BPL     LOGCLP
A171 68                     PLA                     ;SKIP LOGCHK RETURN
A172 68                     PLA
A173 4C 51 A3               JMP     PCLRO           ;LN(1)=LOGTEN(1)=0
A176                PULRTN
A176 68                     PLA
A177 68                     PLA
A178 60             RTURN2  RTS

                    ; BASIC SINE & COS ROUTINES
                    ;
                    ; TO FIX BUGS OF VERSION 5 9 OF SHEP BASIC
                    ;
                    ; BY DAVE & LARRY -- MODIFIED BY CAROL
                    ; 4-6-79
                    ;
                    ; MOD FUNCTION MAKES ROUTINES MORE ACCURATE FOR ANGLES > 360 DEGREES
                    ;
                    ;
                    ; COSINE ROUTINE -- ADD 90 OR PI/2 TO FR0 TO DO SIN

A179                SCOS
A179 20 6F A3               JSR     SINMOD          ;TAKE ANGLE MOD 2*PI, 360
A17C 20 A0 A3               JSR     PIOVL           ;SET UP X & Y REGS TO LOAD PI/2 OR 90
A17F 20 98 DD               JSR     FLD1R           PUT PI/2 OR 90 INTO FR1
A182 20 F7 A2               JSR     SFADD           FR0=FR0 + PI/2 (OR 90)
                    ;
                    ; SINE ROUTINE
                    ; COMPUTE QUADRANT, GET FRACTION AND DO POLYNOMIAL.
                    ; THEN ADJUST FOR QUADRANT
A185                SSIN
A185 20 6F A3               JSR     SINMOD          ;TAKE ANGLE MOD 2*PI, 360
                    ;
                    ; FR0=FR0/(PI/2) OR FR0=FR0/90
A188 20 A0 A3               JSR     PIOVL           ;LOAD X & Y REGS TO GET PI/2 OR 90
A18B 20 0F A3               JSR     LD1DIV          FR0=FR0/FR1
                    ;                               NOW HAVE 0-4 (NOT NECESSARILY INTEGER)
                    ; IF FR0 NOW FRACTION, IT IS QUADRANT 0
                    ; ELSE, GET INTEGER OF FR0 LSD
A18E A9 00                  LDA     #0
A190 8D 80 04               STA     QUADFLG         ASSUME QUADRANT 0
A193 A5 D4                  LDA     FR0             EXPONENT
A195 C9 40                  CMP     #$40            SUBTRACT 64 EXCESS
A197 90 19                  BCC     SINF3           GO IF QUADRANT 0

A199 A5 D5                  LDA     FR0+1           ;SHOULD BE 0. 1. 2. OR 3
A19B 8D 80 04               STA     QUADFLG         NOW HAVE QUADRANT (0,1,2, OR 3)

A19E 20 B6 DD               JSR     FMOVE           ;FR1 <- FR0
A1A1 20 31 A3               JSR     STRUNC          ;TRUNCATE FR0
A1A4 20 07 A3               JSR     SFSUB           ;FR0 <- TRUNC(FR0)-FR0
A1A7 20 28 A3               JSR     SCHGSG          ; CHANGE SIGN -- FRACTIONAL PART (FR0) = FR0 - TRUNC (FR0)
                    ;
                    ; IF ODD QUADRANT' SET FR0=1-FR0 (90 DEGREE INVERT)
A1AA 4E 80 04               LSR     QUADFLG         IS IT ODD QUADRANT?
A1AD 90 03                  BCC     SINF3           NO
A1AF 20 FD A2               JSR     ONESUB          ;FR0 <- 1-FR0
                    ;
                    ; SAVE ARG FOR LATER A1B2 SINF3
A1B2                SINF3
A1B2 A2 E6                  LDX     #FPSCR
A1B4 A0 05                  LDY     #FPSCR/256
A1B6 20 A7 DD               JSR     FST0R           ;FPSCR <- FR0
                    ;
                    ; NOW COMPUTE SINE
                    ; THIS CODE TAKEN FROM BASIC 5.9 LINES 6760-6770
A1B9 20 EE A2               JSR     SSQUAR          FR0=X**2
A1BC A9 06                  LDA     #NSCF
A1BE A2 AF                  LDX     #SCOEF
A1C0 A0 A3                  LDY     #SCOEF/256


A1C2 20 40 DD               JSR     PLYEVL          EVALUATE P(X**2)
A1C5 A2 E6                  LDX     #FPSCR
A1C7 A0 05                  LDY     #FPSCR/256
A1C9 20 E8 A2               JSR     LD1MUL          FR0=SIN(X)=X*P(X**2)
                    ;
                    ; IF LOWER QUADRANT (2 OR 3) THEN FR0=-(FR0)
A1CC 4E 80 04               LSR     QUADFLG         IS IT LOWER QUAD
A1CF 90 03                  BCC     SINF4           NO
A1D1 20 28 A3               JSR     SCHGSG          ;YES
                    ;
A1D4                SINF4
                    ;
                    ; IF ABS(FR0) >= 1 THEN SET TO 1
A1D4 A5 D4                  LDA     FR0
A1D6 29 7F                  AND     #$7F            WITHOUT SIGN BIT
A1D8 C9 40                  CMP     #$40            COMPARE $40
A1DA 90 07                  BCC     SINFIN
A1DC A9 00                  LDA     #0
A1DE 85 D8                  STA     FR0+4           ;PERFORM PSEUDO INT(FR0)  (CLEAR LAST 2 BYTES)
A1E0 85 D9                  STA     FR0+5
A1E2 18             SINFN2  CLC                     ;NO ERROR
A1E3 60             SINFIN  RTS

                    ;
                    ;       FR0 <- ARC TANGENT (FR0)
                    ;       FROM SHEPARDSON ATARI BASIC 5.9 4-5-79 (MODIFIED)
                    ;       SAME ACCURACY AS SHEP VERSION -- USES FEWER BYTES
                    ;
A1E4                SATAN
A1E4 A9 00                  LDA     #0
A1E6 85 F0                  STA     FCHRFLG         ;SIGN FLAG OFF
A1E8 85 F1                  STA     DIGRT           ;AND TRANSFORM FLAG
A1EA A5 D4                  LDA     FR0
A1EC AA                     TAX
A1ED 29 7F                  AND     #$7F
A1EF C9 40                  CMP     #$40            ;CHECK X VS 1.0 JSBHHI
A1F1 30 10                  BMI     ATAN1           ;X<1 - USE SERIES DIRECTLY
A1F3 85 D4                  STA     FR0             ;FORCE PLUS
A1F5 8A                     TXA                     ;OLD FR0 WITH SIGN
A1F6 29 80                  AND     #$80
A1F8 85 F0                  STA     FCHRFLG ;REMEMBER SIGN
A1FA E6 F1                  INC     DIGRT
A1FC A2 EA                  LDX     #FP9S
A1FE A0 DF                  LDY     #FP9S/$100
A200 20 95 DE               JSR     XFORM           ;CHANGE ARG TO (X-1)/(X+1)
A203                ATAN1
                    ;                               ARCTAN(X), -1<X<1 BY SERIES APPROX
A203 A2 E6                  LDX     #FPSCR          ;CAN'T USE FTEMP BECAUSE SATAN IS CALLED BY OTHER ROUTINES. WHICH USE IT
A205 A0 05                  LDY     #FPSCR/256
A207 20 A7 DD               JSR     FST0R
A20A 20 EE A2               JSR     SSQUAR          ; X*X -> FR0
A20D A9 0B                  LDA     #NATCF
A20F A2 AE                  LDX     #ATCOEF
A211 A0 DF                  LDY     #ATCOEF/256
A213 20 40 DD               JSR     PLYEVL          ;P(X*X)
A216 B0 26                  BCS     ATNOUT          ;ERROR
A218 A2 E6                  LDX     #FPSCR
A21A A0 05                  LDY     #FPSCR/256
A21C 20 E8 A2               JSR     LD1MUL          ;X*P(X*X)
A21F A5 F1                  LDA     DIGRT           ;WAS ARG XFORMED
A221 F0 10                  BEQ     ATAN2           ;NO.
A223 A2 F0                  LDX     #PIOV4          ;YES-ADD ARCTAN(1) = PI/4
A225 A0 DF                  LDY     #PIOV4/256
A227 20 98 DD               JSR     FLD1R
A22A 20 66 DA               JSR     FADD
A22D A5 F0                  LDA     FCHRFLG         ;GET ORG SIGN
A22F 05 D4                  ORA     FR0
A231 85 D4                  STA     FR0             ;ATAN(-X) = -ATAN (X)
A233                ATAN2
A233 A5 FB                  LDA     RADFLG          ; RAD OR DEG
A235 F0 07                  BEQ     ATNOUT          ; RAD - FINI
A237 A2 D9                  LDX     #PIOV18
A239 A0 A3                  LDY     #PIOV18/256
A23B 20 0F A3               JSR     LD1DIV          ; DIVIDE BY PI/180 TO CONVERT TO DEGREES
A23E                ATNOUT
A23E 60                     RTS
                    ;
                    ;       FR0 <- SQUARE ROOT (FR0)
                    ;
                    ;       FROM SHEPARDSON ATARI BASIC 5.9 4-5-79 (MODIFIED)
                    ;       SAME ACCURACY AS SHEP VERSION -- USES FEWER BYTES
                    ;
                    ;       USES NEWTON-RAPHSON ITERATION
                    ;       F(Y) = Y*Y - X
                    ;       FPRIME(Y) = 2*Y
                    ;       Y[I+1] = Y[I] - F(Y[I]) / FPRIME(Y[I]) = Y[I] + . 5*((X/Y[I])-Y[I])
                    ;
                    ;       ERROR EXIT
                    ;

A23F                SQRERR
A23F 38                     SEC
A240 60                     RTS
                    ;
                    ;       ENTRY POINT
                    ;
A241                SSQRT                           ;X<-SQRT(X)
A241 A2 E0                  LDX     #FR1
A243 20 46 DA               JSR     ZF1             ;FR1 <- ALL 0'S
A246 A2 00                  LDX     #0
A248 86 F1                  STX     DIGRT
A24A E8                     INX                     ;1
A24B 86 E1                  STX     FR1+1
A24D A5 D4                  LDA     FR0
A24F 30 EE                  BMI     SQRERR          ;ERROR IF <0
A251 C9 3F                  CMP     #$3F
A253 F0 09                  BEQ     FSQR            ;X IN RANGE OF APPROX - GO DO IT TO IT
A255 AA                     TAX
A256 E8                     INX
A257 86 E0                  STX     FR1             ;MANTISSSA = 1
A259 86 F1                  STX     DIGRT           ;NOT IN RANGE - TRANSFORM
A25B 20 28 DB               JSR     FDIV            ;X/100**N
A25E                FSQR                            ;SQR(X) 0.1<=X<1
A25E A9 06                  LDA     #6
A260 85 EF                  STA     ESIGN
A262 A2 E6                  LDX     #FSCR
A264 A0 05                  LDY     #FSCR/256
A266 20 A7 DD               JSR     FST0R           ;STASH X IN FSCR
A269 A9 02                  LDA     #2
A26B 20 FF A2               JSR     INTSUB          ;2-X
A26E A2 E6                  LDX     #FSCR
A270 A0 05                  LDY     #FSCR/256
A272 20 E8 A2               JSR     LD1MUL          ;X*(2-X) : 1ST APPROX
A275                SQRLP
A275 A2 EC                  LDX     #FSCR1
A277 A0 05                  LDY     #FSCR1/256
A279 20 A7 DD               JSR     FST0R           ;Y->FSCR1
A27C 20 B6 DD               JSR     FMOVE           ;Y->FR1
A27F A2 E6                  LDX     #FSCR
A281 A0 05                  LDY     #FSCR/256
A283 20 89 DD               JSR     FLD0R
A286 20 28 DB               JSR     FDIV            ;X/Y
A289 A2 EC                  LDX     #FSCR1
A28B A0 05                  LDY     #FSCR1/256
A28D 20 98 DD               JSR     FLD1R
A290 20 60 DA               JSR     FSUB            ; (X/Y)-Y
A293 A2 6C                  LDX     #FHALF

A295 A0 DF                  LDY     #FHALF/256
A297 20 E8 A2               JSR     LD1MUL          ;.5*((X/Y)-Y)-DELTAY
A29A A5 D4                  LDA     FR0             ;DELTA 0
A29C F0 0E                  BEQ     SQRDON
A29E A2 EC                  LDX     #FSCR1
A2A0 A0 05                  LDY     #FSCR1/256
A2A2 20 98 DD               JSR     FLD1R
A2A5 20 66 DA               JSR     FADD            ;Y=Y+DELTAY
A2A8 C6 EF                  DEC     ESIGN           ;COUNT & LOOP
A2AA 10 C9                  BPL     SQRLP
A2AC                SQRDON
A2AC A2 EC                  LDX     #FSCR1          ;DELTA = 0 - GET Y BACK
A2AE A0 05                  LDY     #FSCR1/256
A2B0 20 89 DD               JSR     FLD0R
                    ;                               WAS ARG TRANSFORMED?
A2B3 A2 E0                  LDX     #FR1
A2B5 20 46 DA               JSR     ZF1             ;FR1 <- ALL 0'S AGAIN ;NO FINI
A2B8 A5 F1                  LDA     DIGRT
A2BA F0 16                  BEQ     SABSVA
A2BC 38                     SEC
A2BD E9 40                  SBC     #$40
                                                    ;YES - TRANSFORM RESULT TO MATCH
A2BF 4A                     LSR     A               ; DIVIDE EXP BY 2
A2C0 08                     PHP                     ;SAVE CARRY (LSB OF DIGRT)
A2C1 18                     CLC
A2C2 69 40                  ADC     #$40
A2C4 85 E0                  STA     FR1
A2C6 A9 01                  LDA     #1              ;MANTISSA = 1
A2C8 28                     PLP                     ;RELOAD CARRY (LSBIT OF DIGRT)
A2C9 90 02                  BCC     SQR2            ;WAS EXP ODD OR EVEN
A2CB A9 10                  LDA     #$10            ;ODD - MANT = 10
A2CD                SQR2
A2CD 85 E1                  STA     FR1+1
A2CF 20 DB DA               JSR     FMUL            ;SQR(X) = SGR(X/100**N) * <10**N>
A2D2                SABSVA                          ;FR0 - ABSVAL(FR0) AC-FR0
A2D2 A5 D4                  LDA     FR0
A2D4 29 7F                  AND     #$7F
A2D6 85 D4                  STA     FR0
A2D8                SABRTN
A2D8 60                     RTS
                    ;
                    ;       THE FOLLOWING ROUTINES ARE CALLED BY THE PREVIOUS ROUTINES
                    ;       IN GENERAL. THEY DO A 2-LEVEL RETURN WITH CARRY SET IF AN
                    ;       ERROR OCCURS. THUS BYPASSING THE REMAINDER OF THE CALLING ROUTINE
                    ;
A2D9                FST1R                           ; LIKE FST0R EXCEPT USES FR1
A2D9 86 FC                  STX     FLPTR
A2DB 84 FD                  STY     FLPTR+1
A2DD A0 05                  LDY     #5
A2DF                FSLOP
A2DF B9 E0 00               LDA     FR1,Y
A2E2 91 FC                  STA     (FLPTR),Y
A2E4 88                     DEY
A2E5 10 F8                  BPL     FSLOP
A2E7 60                     RTS

A2E8                LD1MUL                          ; FR0 <- FR0 * DATA CONSTANT (ADDR IN X & Y)
A2E8 20 98 DD               JSR     FLD1R
A2EB 4C F1 A2               JMP     SFMUL

A2EE                SSQUAR
A2EE 20 B6 DD               JSR     FMOVE           ;FR0 <- FR0 * FR0

A2F1                SFMUL                           ;FR0 <- FR0 * FR1
A2F1 20 DB DA               JSR     FMUL
A2F4 B0 16                  BCS     CRYSND
A2F6 60                     RTS
A2F7                SFADD                           ;FR0 <- FR0 + FR1
A2F7 20 66 DA               JSR     FADD
A2FA B0 10                  BCS     CRYSND
A2FC 60                     RTS
A2FD A9 01          ONESUB  LDA     #1              ;FR0 <- 1-FR0

A2FF                INTSUB                          ;FR0 <- A - FR0
A2FF 48                     PHA
A300 20 B6 DD               JSR     FMOVE
A303 68                     PLA
A304 20 53 A3               JSR     PSET0           ;A MUST BE FROM 0-9 OR BCD
A307                SFSUB                           ;FR0 <- FR0 - FR1
A307 20 60 DA       CRYCHK  JSR     FSUB            ;CHECK CARRY TO SEE IF THERE IS AN ERROR
A30A 90 02                  BCC     RETURN          ;RETURN IF CARRY CLEAR
A30C                CRYSND
A30C 68                     PLA                     ;DO A 2-LEVEL RETURN IF ERROR
A30D 68                     PLA
A30E 60             RETURN  RTS

A30F                LD1DIV                          ;FR0 <- FR0 / (X,Y)
A30F 20 98 DD               JSR     FLD1R
A312                SFDIV                           ;FR0 <- FR0 / FR1
A312 20 28 DB               JSR     FDIV
A315 B0 F5                  BCS     CRYSND
A317 60                     RTS

A318                SINTEG                          ;FR0 <- INT(FR0)
A318 A5 D4                  LDA     FR0
A31A 48                     PHA
A31B 20 31 A3               JSR     STRUNC          ;FR0 <- TRUNC(FR0), RETURN EQ IF ALREADY INT
A31E F0 2F                  BEQ     INTRT3          ;INTEGER   POP AND RETURN
A320 68                     PLA                     ;RELOAD OLD FR0 WITH SIGN
A321 10 2D                  BPL     INTRT2          ;POSITIVE
                    ;                               WAS NEGATIVE NON-INTEGER
A323                SUBONE                          ;FR0 <- FR0-1
A323 A9 01                  LDA     #1
A325                SUBINT                          ;FR0 <- FR0 - A
A325 20 FF A2               JSR     INTSUB          ;FR0 <- A-FR0
A328                SCHGSG
A328 A5 D4                  LDA     FR0             ;FR0 <- -FR0 SET EG/NE
A32A F0 04                  BEQ     SCH10
A32C 49 80                  EOR     #$80
A32E 85 D4                  STA     FR0
A330                SCH10
A330 60                     RTS

                    ;                               GREATEST INT <= FR0
                    ;
                    ;               PART OF INT ROUTINE FROM SHEP ATARI BASIC B0D5-B0EE
                    ;               DOES NOT AFFECT FR1?
                    ;
A331                STRUNC                          ; TRUNCATE FR0
                    ;                               RETURN A=0 AND EQ IF FR0 WAS ALREADY AN INTEGER
A331 A5 D4                  LDA     FR0             ;GET EXPONENT
A333 29 7F                  AND     #$7F            ;AND OUT SIGN BIT
A335 38                     SEC
A336 E9 3F                  SBC     #$3F            ;GET LOCATION OF 1ST FRACTION BYTE
A338 10 02                  BPL     XINT1           ; IF >= 0 THEN BRANCH
A33A A9 00                  LDA     #0              ;ELSE SET =0
A33C                XINT1

A33C AA                     TAX                     ;PUT IN X AS INDEX INTO FROM
A33D A9 00                  LDA     #0              ;SET ACCUM TO ZERO FOR ORING
A33F A8                     TAY                     ;ZERO Y
A340                INT2
A340 E0 05                  CPX     #FPREC-1        ;IS D. P. LOC >= 5?
A342 B0 07                  BCS     INTRTN          ;IF YES, LOOP DONE
A344 15 D5                  ORA     FR0+1,X         ;OR IN THE BYTE OF MANTISSA
A346 94 D5                  STY     FR0+1,X         ;ZERO BYTE
A348 E8                     INX                     ;POINT TO NEXT BYTE
A349 D0 F5                  BNE     INT2            ;JMP
A34B                INTRTN
A34B 48                     PHA                     ;SAVE OR OF ALL FRACTIONAL BYTES
A34C 20 00 DC               JSR     NORM            ;NORMALIZE
A34F                INTRT3
A34F 68                     PLA                     ;RELOAD
A350 60             INTRT2  RTS
A351                PCLRO                           ;CLEAR FR0
                    ;                               RETURN WITH CARRY CLEAR (CC)
A351 A9 00                  LDA     #0
A353                PSET0                           ;SET FR0 TO INTEGER PASSED IN A (MUST BE BCD OR <10)
                    ;                               RETURN WITH CARRY CLEAR (CC)
A353 48                     PHA
A354 20 44 DA               JSR     ZFR0            ;FR0 <- 0
A357 68                     PLA
A358 F0 06                  BEQ     CLRTN           ;0 => ALL 0'S
A35A 85 D5                  STA     FR0+1
A35C A9 40                  LDA     #$40            ;SET EXPONENT
A35E 85 D4                  STA     FR0
A360                CLRTN
A360 18                     CLC
A361 60                     RTS


                    ;       SINE ROUTINES
                    ;
A362                SINLD
A362 A2 DF                  LDX     #PI2            ;LOAD 2*PI
A364 A0 A3                  LDY     #PI2/256
A366 A5 FB                  LDA     RADFLG
A368 F0 04                  BEQ     SNMOD3
A36A A2 E5                  LDX     #C360           ;DEGREES => LOAD 360
A36C A0 A3                  LDY     #C360/256
A36E                SNMOD3
A36E 60                     RTS

A36F                SINMOD                          ;FIND ANGLE MOD 2*PI OR 360 DEPENDING ON RADFLG
A36F A5 D4                  LDA     FR0
A371 29 7F                  AND     #$7F
A373 C9 45                  CMP     #$45
A375 B0 95                  BCS     CRYSND          ;OUT OF RANGE -- 2-LEVEL RETURN
A377 A2 E6                  LDX     #FPSCR          ;SAVE IN TEMP SCRATCH REG
A379 A0 05                  LDY     #FPSCR/256
A37B 20 A7 DD               JSR     FST0R
A37E 20 62 A3               JSR     SINLD           ;LOAD 2*PI OR 360
A381 20 98 DD               JSR     FLD1R
A384 20 12 A3               JSR     SFDIV           ;ANGLE/360
A387 20 18 A3               JSR     SINTEG          ;INT(ANGLE/360)
A38A 20 62 A3               JSR     SINLD           ;LOAD 2*PI OR 360
A38D 20 98 DD               JSR     FLD1R
A390 20 F1 A2               JSR     SFMUL           ;INT(ANGLE/360)*360
A393 20 B6 DD               JSR     FMOVE
A396 A2 E6                  LDX     #FPSCR          ;RELOAD ANGLE
A398 A0 05                  LDY     #FPSCR/256
A39A 20 89 DD               JSR     FLD0R
A39D 4C 07 A3               JMP     SFSUB           ; ANGLE - INT(ANGLE/360)*360

A3A0                PIOVL           ;LOAD X & Y REGS IN PREPARATION FOR LOADING REG 0 OR 1 WITH PI/2. 90 OR 100(IF GRAD)
A3A0 A9 CD                  LDA     #RADPI2
A3A2 18                     CLC
A3A3 65 FB                  ADC     RADFLG
A3A5 AA                     TAX
A3A6 A0 A3                  LDY     #RADPI2/256
A3A8 60                     RTS

                    ;                               DATA

A3A9 40 01 00       ONE     .BYTE   $40,$01,0,0,0,0       ;1
A3AC 00 00 00
A3AF                SCOEF
A3AF BD 03 55               .BYTE   $BD,$03,$55,$14,$99,$39 ;-.00000355149939
A3B2 14 99 39
A3B5 3E 01 60               .BYTE   $3E,$01,$60,$44,$27,$52 ;0.000160442752
A3B8 44 27 52
A3BB BE 46 81               .BYTE   $BE,$46,$81,$75,$43,$55 ;-.004681754355
A3BE 75 43 55
A3C1 3F 07 96               .BYTE   $3F,$07,$96,$92,$62,$39 ;0.0796926239
A3C4 92 62 39
A3C7 BF 64 59               .BYTE   $BF,$64,$59,$64,$08,$67 ;-.6459640867
A3CA 64 08 67
A3CD 40 01 57       RADPI2  .BYTE   $40,$01,$57,$07,$96,$32 ;PI/2 =  1.570796327  PART OF SCOEF
A3D0 07 96 32
A3D3 40 90 00               .BYTE   $40,$90,0,0,0,0         ;90 (DEGREES)
A3D6 00 00 00
A3D9 3F 01 74       PIOV18  .BYTE   $3F,$01,$74,$53,$29,$25 ;PI/180 = .0174532925 DEG->RAD
A3DC 53 29 25
A3DF 40 06 28       PI2     .BYTE   $40,$06,$28,$31,$85,$31 ;2*PI = 6.28318531
A3E2 31 85 31
A3E5 41 03 60       C360    .BYTE   $41,$03,$60,0,0,0       ;360
A3E8 00 00 00
                            *=$BFFA                 ;CARTRIDGE START INFO
BFFA 00 A0                  .WORD   START           ;COLD/WARM START ADDRESS
BFFC 00 04                  .BYTE   0,4             ;RUN CARTRIDGE
BFFE CD A0                  .WORD   INIT            ;POWER UP START VECTOR
                            .END
                            .TITLE  'COLLEEN CALCULATOR, BY C. SHAW'
0000                ASMBL   =       0               ;1=>ASSEMBLE THIS SECTION, 0=>THIS STUFF HAS BEEN REMOVED
                    ;
                    ;               ATARI CALCULATOR CARTRIDGE  COPYRIGHT 1979
                    ;               WORK STARTED 2/20/79
                    ;               PROGRAM STARTED 3/14/79
                    ;
                    ; OPERATING SYSTEM EQUATES
                    ;
E456                CIOV    =       $E456           CENTRAL INPUT OUTPUT ROUTINE
E45C                SETVBV  =       $E45C           ;SET SYSTEM TIMERS ROUTINE
                    ;
                    ; COMMAND CODES FOR IOCB
0003                OPEN    =       3               OPEN FOR INPUT/OUTPUT
0007                GETCHR  =       7               GET CHARACTER(S)
000B                PUTCHR  =       $B              ;PUT CHARACTER(S)
000C                CLOSE   =       $C              ;CLOSE DEVICE

0001                SUCCES  =       $01             SUCCESSFUL OPERATION
0003                EOF     =       $03             ;END OF FILE (NOT REALLY AN ERROR)
0010                IOCBSZ  =       16              ;NUMBER OF BYTES PER IOCB
                    ;
                            *=8
0008                WARMST  *=*+1           ;WARM START FLAG
0009                BOOT?   *=*+1           ;SUCCESSFUL BOOT FLAG
                            *=$11
0011                BRKKEY  *=*+1           ;BREAK KEY FLAG
                            *=$52
0052                LMARGN  *=*+1           ;LEFT MARGIN (0 MIN.)
0053                RMARGN  *=*+1           ;RIGHT MARGIN (39 MAX.)
0054                ROWCRS  *=*+1           CURSOR COUNTERS
0055                COLCRS  *=*+2
                    ;
                            *=$22A
022A                CDTMF3  *=*+1           ;COUNT DOWN TIMER 3 FLAG
                            *=$2F0
02F0                CRSINH  *=*+1           CURSOR INHIBIT (00 = CURSOR ON)
                    ;
                            *=$340

0340                IOCB    *=*             I/O CONTROL BLOCKS
0340                ICHID   *=*+1           HANDLER INDEX NUMBER (FF = IOCB FREE)
0341                ICDNO   *=*+1           DEVICE NUMBER (DRIVE NUMBER)
0342                ICCOM   *=*+1           COMMAND CODE
0343                ICSTA   *=*+1           STATUS OF LAST IOCB ACTION
0344                ICBAL   *=*+1           BUFFER ADDRESS LOW BYTE
0345                ICBAH   *=*+1
0346                ICPTL   *=*+1           PUT BYTE ROUTINE ADDRESS - 1
0347                ICPTH   *=*+1
0348                ICBLL   *=*+1           BUFFER LENGTH LOW BYTE
0349                ICBLH   *=*+1
034A                ICAX1   *=*+1           AUXILIARY INFORMATION FIRST BYTE
034B                ICAX2   *=*+1
034C                ICSPR   *=*+4           FOUR SPARE BYTES
                    ;
                    ;                               FLOATING POINT SUBROUTINES
                    ;
0006                FPREC   =       6               ;FLOATING PT PRECISION (# OF BYTES)
                    ;                               IF CARRY USED THEN CARRY CLEAR => NO ERROR, CARRY SET => ERROR
D800                AFP     =       $D800           ;ASCII->FLOATING POINT (FP)
                    ;                               INBUFF+CIX -> FR0, CIX, CARRY
D8E6                FASC    =       $D8E6           ;FP -> ASCII      FR0-> LBUFF  (INBUFF)
D9AA                IFP     =       $D9AA           ;INTEGER -> FP
                    ;                               0-$FFFF (LSB,MSB) IN FR0,FR0+1->FR0
D9D2                FPI     =       $D9D2           ;FP -> INTEGER    FR0 -> FR0,FR0+1, CARRY
DA60                FSUB    =       $DA60           ;FR0 <- FR0 - FR1  ,CARRY
DA66                FADD    =       $DA66           ;FR0 <- FR0 + FR1  ,CARRY
DADB                FMUL    =       $DADB           ;FR0 <- FR0 * FR1  ,CARRY
DB28                FDIV    =       $DB28           ;FR0 <- FR0 / FR1  ,CARRY
DD89                FLD0R   =       $DD89           ;FLOATING LOAD REG0    FR0 <- (X,Y)
DD8D                FLD0P   =       $DD8D           ;    "     "    "      FR0 <- (FLPTR)
DD98                FLD1R   =       $DD98           ;    "     "   REG1    FR1 <- (X,Y)
DD9C                FLD1P   =       $DD9C           ;    "     "    "      FR1 <- (FLPTR)
DDA7                FST0R   =       $DDA7           ;FLOATING STORE REG0 (X,Y) <- FR0
DDAB                FST0P   =       $DDAB           ;    "     "    "   (FLPTR)<- FR0
DDB6                FMOVE   =       $DDB6           ;FR1 <- FR0
DD40                PLYEVL  =       $DD40           ;FR0 <- P(Z) = SUM(I=N TO 0) (A(I)*Z**I)     CARRY
                    ;                               INPUT: (X,Y) = A(N),A(N-1)...A(0)  -> PLYARG
                    ;                                      ACC   = # OF COEFFICIENTS = DEGREE+1
                    ;                                      FR0   = Z
DDC0                EXP     =       $DDC0           ;FR0 <- E**FR0 = EXP10(FR0 * LOG10(E))  CARRY
DDCC                EXP10   =       $DDCC           ;FR0 <- 10**FR0  CARRY
DECD                LOG     =       $DECD           ;FR0 <- LN(FR0) = LOG10(FR0)/LOG10(E)   CARRY
DED1                LOG10   =       $DED1           ;FR0 <- LOG10 (FR0)    CARRY

                    ;                               THE FOLLOWING ARE IN BASIC CARTRIDGE:
                    ;SIN    =       $BD81           ;FR0 <- SIN(FR0)  DEGFLG=0 =>RADS,  6=>DEG.   CARRY
                    ;COS    =       $BD73           ;FR0 <- COS(FR0)    CARRY
                    ;ATAN   =       $BE43           ;FR0 <- ATAN(FR0)   CARRY
                    ;SQR    =       $BEB1           ;FR0 <- SQUAREROOT(FR0)   CARRY


                    ;FLOATING POINT ROUTINES ZERO PAGE (NEEDED ONLY IF F.P. ROUTINES ARE CALLED)
                            *=$D4
00D4                FR0     *=*+FPREC       ;FP REG0
00DA                FRE     *=*+FPREC
00E0                FR1     *=*+FPREC       ;FP REG1
00E6                FR2     *=*+FPREC
00EC                FRX     *=*+1           ;FP SPARE
00ED                EEXP    *=*+1           ;VALUE OF E
00EE                NSIGN   *=*+1           ;SIGN OF #
00EF                ESIGN   *=*+1           ;SIGN OF EXPONENT
00F0                FCHRFLG *=*+1           ;1ST CHAR FLAG
00F1                DIGRT   *=*+1           ;# OF DIGITS RIGHT OF DECIMAL
00F2                CIX     *=*+1           ;CURRENT INPUT INDEX
00F3                INBUFF  *=*+2           ;POINTS TO USER'S LINE INPUT BUFFER
00F5                ZTEMP1  *=*+2
00F7                ZTEMP4  *=*+2
00F9                ZTEMP3  *=*+2
00FB                RADFLG  *=*+1           ;0=RADIANS, 6=DEGREES
00FC                FLPTR   *=*+2           ;POINTS TO USER'S FLOATING PT NUMBER
00FE                FPTR2   *=*+2

                    ;FLOATING PT ROUTINES' NON-ZERO PAGE RAM (NEEDED ONLY IF F.P. ROUTINES CALLED)
                            *=$57E
057E                LBPR1   *=*+1           ;LBUFF PREFIX 1
057F                LBPR2   *=*+1           ;LBUFF PREFIX 2
0580                LBUFF   *=*+128         ;LINE BUFFER
05E0                PLYARG  =       LBUFF+$60       ;POLYNOMIAL ARGUMENTS
05E6                FPSCR   =       PLYARG+FPREC
05EC                FPSCR1  =       FPSCR+FPREC
05E6                FSCR    =       FPSCR
05EC                FSCR1   =       FPSCR1

                    ;                               COLLEEN REGISTER EQUATES
D200                AUDF1   =       $D200           ;SOUND REG 1 FREQUENCY
D201                AUDC1   =       AUDF1+1         ;SOUND REG 1 CONTROL
D20A                RANDOM  =       AUDF1+10        ;8 BIT RANDOM NUMBER

                    ;                           UNIVERSAL EQUATES
                    ;

                    ;                               CIO COMMANDS
0004                INPUT   =       4               ;AUX1 ON OPEN
0008                OUTPUT  =       8               ;AUX1 ON OPEN

                    ;                               SPECIAL CHARS IN ATARI EXTERNAL ASCII
001B                ESC     =       $1B             ;ESCAPE
001C                UPAROW  =       ESC+1           ;UP ARROW (CONTROL CHAR)
0010                DNAROW  =       ESC+2           ;DOWN
001E                LFAROW  =       ESC+3           ;LEFT
001F                RTAROW  =       ESC+4           ;RIGHT
007D                CLS     =       $7D             ;CLEAR SCREEN
007E                BACKSP  =       CLS+1           ;BACKSP
007F                TAB     =       CLS+2
009B                CR      =       $9B             ;CARRIAGE RETURN
009C                DELLIN  =       CR+1            ;DELETE LINE
009D                INSLIN  =       CR+2            ;INSERT LINE
009E                CLRTAB  =       CR+3            ;CLEAR TAB
009F                SETTAB  =       CR+4            ;SET TAB
00FE                DELCHR  =       $FE             ;DELETE CHAR
00FF                INSCHR  =       DELCHR+1        ;INSERT CHAR

                    ;                               FP PACKAGE EQUATES FOR SIN, COS, ATAN, AND SQR ROUTINES ETC

000B                NATCF   =       $B              ;NUMBER OF ATAN COEFFICIENTS FOR POLYNOMIAL EVALUATION
0006                NSCF    =       6               ;NUMBER OF SIN COEFFICIENTS

D920                XEFORM  =       $D920           ;!EFORM   PROCESS E FORMAT    FOR FP -> ASCII CONVERSION
DA51                INTLBF  =       $DA51           ;INIT LBUFF INTO INBUFF    FOR FP -> ASCII CONVERSION
DC00                NORM    =       $DC00           ;NORMALIZE FLOATING POINT NUMBER - USED BY STRUNC ONLY
DE03                EXP1    =       $DE03           ;MIDDLE OF EXP10 WHERE PLYEVL IS CALLED
DE12                EXP11   =       $DE12           ;AFTER PLYEVL IN EXP10
DE89                LOG10E  =       $DE89           ;LOGTEN (E) = .4342944819
DE95                XFORM   =       $DE95           ;FR0 <- (FR0-(X,Y)) / (FR0+(X,Y))
DF6C                FHALF   =       $DF6C           ;FLOATING POINT CONSTANT .5
DFAE                ATCOEF  =       $DFAE           ;ATAN COEFFICIENTS
DFEA                FP9S    =       $DFEA           ;FLOATING POINT CONSTANT .9999999999- (ALMOST 1)
DFF0                PIOV4   =       $DFF0           ;FLOATING POINT CONSTANT PI/4 = .7853981634

                    ;               CALCULATOR EQUATES

0001                LMARG   =       1               ;LMARGN VALUE
0026                RMARG   =       38
0026                LINLEN  =       38              ;LENGTH OF LINE ON SCREEN

0016                ROWCMD  =       22              ;ROWCRS FOR COMMANDS
0016                COLCMD  =       22              ;COLCRS FOR COMMANDS
0001                ROWSTT  =       1               ;ROW # FOR STATUS
0005                ROWREG  =       5               ;ROW FOR STACK, MEM REGS
0010                ROWSCR  =       16              ;TOP ROW FOR SCROLLING


0000                SIOCB   =       0*IOCBSZ        ;SCREEN IOCB #  (SET UP BY OS)
0010                KIOCB   =       1*IOCBSZ        ;KEYBOARD IOCB #
0020                PIOCB   =       2*IOCBSZ        ;PRINTER IOCB #
0030                TIOCB   =       3*IOCBSZ        ;TEMP IOCB # (USED FOR FILE I/O)

000D                TOKCLN  =       TOKEND-TOKCHR-1 ;LENGTH OF TOKCHR-1
0087                SLASH   =       STAR+1
0088                PLUS    =       STAR+2
0089                MINUS   =       STAR+3
008A                LPAR    =       STAR+4
008B                RPAR    =       STAR+5
008C                EQUAL   =       STAR+6
008D                LPAD    =       STAR+7
008F                NUMBER  =       STAR+8

000E                PSPEC   =       14              ;PRIORITY OF SPECIAL 0-VAR FNS (PRINT, ETC.)
000D                PHIGH   =       13              ;PRIORITY OF SINGLE VAR FNS.
000A                PSPEC2  =       10              ;SPECIAL 2-VAR FNS
0009                PPOWER  =       9               ;POWER, ROOT
0008                PTIMES  =       8               ;* /
0007                PPLUS   =       7               ;+ -
0006                PAND    =       6
0005                POR     =       5
0002                PLRPAR  =       2               ;( )
0001                PEQUAL  =       1               ;=
0000                PLPAD   =       0               ;BOTTOM OF STACK SYMBOL

000E                NUMLEN  =       14              ;LENGTH OF NUMBER IN ASCII FORMAT
002A                FPSLEN  =       42              ;LENGTH OF FPSTK IN FP NUMBERS
0100                PSLEN   =       256             ;LENGTH OF OPSTK IN OPERANDS
0064                MEMLEN  =       100                     ;LENGTH OF MEMORY AREA IN FP NUMBERS
0028                TOKLEN  =       LINLEN+2        ;LENGTH OF TOKBUF IN CHARS
0400                PRGLEN  =       1024            ;PROGRAM MEMORY LENGTH IN BYTES
000A                SPCLEN  =       SPCEND-SPCTBL-1 ;LENGTH OF SPCTBL - 1

                    ;GRADON =       12              ;DEGREE FLAG SETTING FOR GRAD

                    ;                               COLUMN NUMBERS FOR LINE 0 STATUS DISPLAY
0002                DALG    =       2
0007                DDEG    =       7
000B                DDEC    =       11
0013                DBITS   =       15+4
0019                DFIX    =       22+3
001B                DFVDUE  =       27
0021                DENTER  =       33

                    ;                                       RAM PAGE ZERO
                            *=$80
0080                ZROPG
0080                LFRT    *=*+1           ;1 -> LEFT NIBBLE. 0=> RIGHT NIBBLE (USED BY LDNIB)
0081                TOKCOD  *=*+1           ;TOKEN CODE
0082                TOKPTR  *=*+2           ;POINTER TO NEXT TOKBUF LOC.
0084                TOKTMP  *=*+2           ;LAST 0-2 CHARS READ AND SAVED
0086                TOKTIN  *=*+1           ;INDEX TO TOKTMP (0-2)
0087                DHOFLG  *=*+1           ;0=> DEC, 16=>HEX, 8=>OCT. 2=>BIN
0088                KEYCHR  *=*+1           ;CURRENT KEY CHAR (0-?)
0089                KEYLEN  *=*+1           ;LENGTH OF CURRENT KEY WORD
008A                KEYLN2  *=*+1           ;KEY LENGTH (MODIFIED BY LDCHR FOR 2 NIBBLE CHARS)
008B                LDNBSV  *=*+1           ;REG Y SAVED FOR LDNIB
008C                CLRPTR                  ;FOR RAM CLEAR
008C                PKPTR   *=*+2           ;POINTER TO PACKED CHAR STRING (USED BY LDNIB)
008E                KYLFRT  *=*+1           ;LFRT FOR BEGINNING OF WORD
008F                KEYCNT  *=*+1           ;KEY WORD NUMBER
0090                JMPTR1  *=*+2           ;INDEX FOR SUBROUTINE JUMP
0092                JMPTR2  *=*+2
0094                RPNALG  *=*+1           ;0=>RPN, 1=>ALG, 2=>ALGN
0001                ALGP    =       1       ;ALGEBRAIC, OPERATOR PRECEDENCE
0002                ALGNOP  =       2       ;ALGEBRAIC, SAME PRECEDENCE FOR 2 VAR OPERATORS
0095                PRNFLG  *=*+1           ;1=>PRINT
0096                OPFLG   *=*+1           ;1=>PREVIOUS TOKEN WAS AN OPERATOR
0097                NOPFLG  *=*+1           ;NEW OPFLG 1=> CURRENT TOKEN IS OPERATOR
0098                PREVOP  *=*+1           ;PREVIOUS OPERATOR TOKEN CODE
0099                PRVPRI  *=*+1           ;   "        "    PRIORITY (PRECEDENCE)
009A                CURPRI  *=*+1           ;CURRENT     "       "
009B                FPPTR   *=*+1           ;FPSTK POINTER (STARTS AT 0)
009C                OPPTR   *=*+1           ;OPSTK   "       "     "  "
009D                BITINT  *=*+1           ;1-32: NUMBER OF BITS IN OCTAL & HEX ARITHMETIC
                    ;DAYTMP                 ;TEMP VAR FOR DAYSUB
                    ;CHRIND                 ;INDEX INTO CHRTAB
                    ;COUNT                  ;TEMP COUNT VAR
                    ;LOP                    ;FOR SAND, SOR, SXOR  0=>AND, 1=>OR, 2=> XOR
                    ;SHFFLG                 ;FOR SRSHF, SLSHF 0=>LEFT. 1=>RIGHT
009E                T0      *=*+1           ;TEMP VAR CALL OF ABOVE
009F                T1      *=*+1           ;TEMP VAR USED IN SCL INT&SCLSTA
00A0                NEGFLG  *=*+1           ;PL=> POSITIVE, MI=>NEGATIVE NUMBER
00A1                INTFLG  *=*+1           ;0=>X & Y BOTH INTEGER IN ROOT. POWER
00A2                NUMFLG  *=*+1           ;1=> PREVIOUS THING DISPLAYED WAS A NUMBER
00A3                MEMNUM  *=*+1           ;MEMORY NUMBER

00A4                BITBIN  *=*+4           ;2^(BITINT-1)-1
00A8                BITBN2  *=*+4           ;(2^BITINT)-1
00AC                BINMIN  *=*+4           ;-(2^(BITINT-1))  MSB-LSB = COMP(BITBIN)
00B0                BINARY  *=*+4           ;FR0 IN BINARY FORMAT
00B4                BIN2    *=*+4           ;SECOND BINARY #

00B8                QUADFLG *=*+1           ;SIN QUADRANT FLAG

00B9                PC      *=*+2           ;PROGRAM COUNTER LSB. MSB (INIT TO PRGMEM)
0002                EXEC    =       2
0001                STOPRG  =       1
00BB                PROG    *=*+1           ;0=>IMMEDIATE MODE, 1=>STORING PROG, 2=> EXECUTING
00BC                TRACE   *=*+1           ;1 => TRACE ON (DISPLAY ALL PROGRAM EXECUTION)
00BD                DSPFLG  *=*+1           ;1=> DO NOT DISPLAY OR PRINT ANYTHING (PROGRAM EXECUTING)
00BE                SSTFLG  *=*+1           ;1=>DO SINGLE STEP (EXECUTE ONE INSTRUCTION)


00BF                SEFORM  *=*+1           ;1=>EFORM
00C0                FIXNUM  *=*+1           ;FIX 0-9
00C1                MANTLN  *=*+1           ;LENGTH OF MANTISSA
00C2                SSIGN   *=*+1           ;BIT 8 IS SIGN BIT
00C3                SMSD    *=*+1           ;SAVE MSD OF FR0  (FR0+1)
00C4                LDCSAV  *=*+1           ;SAVE PART CHAR FOR LDCHAR
00C5                DUEFLG  *=*+1           ;0 => ANNUITY DUE/FV, 1=>ORDINARY ANNUITY/FV
                    ;                        2 => ANNUITY DUE/PV, 3 => ORDINARY ANNUITY/PV
                    ;                       $80 => COMPOUND INTEREST, NOT ANNUITY
00C6                ENTFLG  *=*+1           ;0 => ENTER VALUE, 1 => FIND VALUE (FOR INTEREST EQNS.)
00C7                ERRFLG  *=*+1           ;1=>ALREADY HAVE DISPLAYED ERROR MSG, DON'T DO MORE
00C8                MEMFLG  *=*+1           ;0=>ADD (SIGMA PLUS), 1=>SUB (SIGMA MINUS)
00C9                CALPTR  *=*+1           ;POINTER TO CALSTK
00CA                CONFLG  *=*+1           ;CONVERSION MSG LSB   0=> NO CONVERSION
00CB                SCONFG  *=*+1           ;SAVED CONFLG FROM PREVIOUS LOOP

00CC                OPSADR  *=*+2           ;OPSTK ADR
00CE                MEMADR  *=*+2           ;MEMORY ADR = OPSADR+$100
00D0                PRGADR  *=*+2           ;PRGMEM ADR = MEMADR+$300
00D2                PC1MAX  *=*+1           ;MAX PC+1 VALUE = PRGADR/256 + 3
00D3                PC1MX1  *=*+1           ;PC1MAX+1

                            *=FR0           ;FLOATING POINT RAM

                            *=$480

0480                CALSTK  *=*+$80         ;SUBROUTINE CALL STACK  (128/2 = 64 CALLS DEEP)
0500                TOKBUF  *=*+TOKLEN      ;TOKEN STRING BUFFER
0528                BLKBUF  *=*+20          ;ALL BLANKS
053C                CTLRS   *=*+20          ;ALL CTRL R'S (HORIZ. LINES)
0550                MODFAC  *=*+FPREC       ;INT (Y/X) AFTER MOD
0556                FTEMP   *=*+FPREC       ;MY OWN TEMP F.P. REG
055C                FPX     *=*+FPREC       ;X REG SAVED DURING STORE PROGRAM MODE
0562                ASAVE   *=*+1           ;REG A SAVE LOC
0563                XSAVE   *=*+1
0564                YSAVE   *=*+1
0565                PRVSTK  *=*+1           ;FOR DSPSTK: PREVIOUS ROWCRS VALUE AT END OF STACK
0566                SSTOLD  *=*+1           ;SSTFLG FROM PREVIOUS LOOP
                            *=LBPR1         ;FLOATING POINT
                            *=$600
0600                FPSTK   *=FPSLEN*FPREC+*        ;FLOATING POINT NUMBER STACK
                    ;                       DISK USES $700-$2800?
                            .IF     ASMBL
                    ;                       THESE ADDRESSES START AT 700 IF NO DISK. 3000 IF DISK
                            *=$3000
                    OPSTK   *=*+OPSLEN
                            *=*-1/256+1*256
                    MEMORY  *=MEMLEN*FPREC+*
                            *=*-1/256+1*256
                    PRGMEM  *=*+PRGLEN      ;USER PROGRAM MEMORY
                            .ENDIF

                            *=$9800
9800                SEXPE                           ;E^X (SEE SHEP ATARI BASIC $DDC0 EXP)
9800 A2 89                  LDX     #LOG10E         ;E^X = 10^(X*LOGTEN(E))
9802 A0 DE                  LDY     #LOG10E/256
9804 20 C5 AD               JSR     LD1MUL          ;FR0 <- FR0*LOG10E

9807                SEXPTE                          ;10^X (SEE SHEP ATARI BASIC $DDCC EXP10)
9807 A9 00                  LDA     #0              ;CLEAR TRANSFORM FLAG
9809 85 F1                  STA     DIGRT           ;XFMFLG
980B A5 D4                  LDA     FR0
980D 85 F0                  STA     FCHRFLG         ;SAME AS SGNFLG   REMEMBER ARG SIGN
980F 29 7F                  AND     #$7F            ;& MAKE PLUS
9811 85 D4                  STA     FR0
9813 38                     SEC
9814 E9 40                  SBC     #$40
9816 30 1B                  BMI     SEXP05          ;X<1 SO USE SERIES DIRECTLY (BUT CHECK FOR 0 FIRST)
9818 C9 04                  CMP     #FPREC-2
981A 10 2B                  BPL     SFERR2          ;ARG TOO BIG
981C 20 BB 9F               JSR     FPUSH0          ;SAVE ARG ON CALCULATOR FP STACK
981F 20 83 A6               JSR     SINTEG          ;GREATEST INTEGER <= X
9822 20 D2 D9               JSR     FPI             ;MAKE INTEGER
9825 A5 D5                  LDA     FR0+1           ;CHECK MSB
9827 D0 1E                  BNE     SFERR2          ;SHOULDN'T HAVE ANY
9829 A5 D4                  LDA     FR0
982B 85 F1                  STA     DIGRT           ;XFMFLG SAVE MULTIPLIER EXP
982D 20 AA D9               JSR     IFP             ;NOW TURN IT BACK TO FP
9830 20 80 A9               JSR     SPSUB           ;USE CALC ROUTINE   ARG FROM STACK - INTEGER PART = FRACTION PART
9833                SEXP05
9833 A5 D4                  LDA     FR0
9835 D0 0B                  BNE     SEXP10
9837 A9 01                  LDA     #1              ;10^0 = 1
9839 20 B9 A1               JSR     PSET0
983C 20 12 DE               JSR     EXP11           ;$DE12  DO 10^X, SKIPPING PLYEVL   LDA XFMFLG . . .
983F B0 06                  BCS     SFERR2
9841                SEXPRT
9841 60                     RTS
9842                SEXP10
9842 20 03 DE               JSR     EXP1            ;DO REST OF 10^X
9845 90 FA                  BCC     SEXPRT          ;CC => OK => RETURN
9847                SFERR2
9847 4C 95 A3               JMP     BITERR          ;DISPLAY ERROR MESSAGE

                    ;       *=$A000
                    ;
                    ;          INITIALIZATION
                    ;
                    ;
                    ;                                   CARTRIDGE COLD/WARM START LOC
984A                START
984A A9 00                  LDA     #0
984C AA                     TAX                     ;CLEAR ZERO PAGE RAM ($80-$FF)
984D                INIT2
984D 95 80                  STA     ZROPG,X
984F E8                     INX
9850 10 FB                  BPL     INIT2


9852 A9 07                  LDA     #$07            ;SET UP INDIRECT POINTERS TO RAM
9854 A6 09                  LDX     BOOT?           ;SUCCESSFUL BOOT?
9856 F0 02                  BEQ     NOBOOT          ;NO.
9858 A9 30                  LDA     #$30            ;YES.  ALLOW ROOM FOR DOS IN RAM
985A                NOBOOT
985A 85 CD                  STA     OPSADR+1        ;OPSTK ADR MSB
985C 18                     CLC
985D 69 01                  ADC     #1
985F 85 CF                  STA     MEMADR+1        ;MEMORY ADR MSB
9861 69 03                  ADC     #3
9863 85 D1                  STA     PRGADR+1        ;PRGMEM ADR MSB
9865 69 03                  ADC     #3
9867 85 D2                  STA     PC1MAX          ;END OF PRGMEM ADR MSB
9869 69 01                  ADC     #1
986B 85 D3                  STA     PC1MX1          ;PC1MAX+1

986D A0 01                  LDY     #LMARG          ;1   SET UP MARGINS
986F 84 52                  STY     LMARGN
9871 8C F0 02               STY     CRSINH          ;<>0 => INHIBIT CURSOR
9874 84 94                  STY     RPNALG          ;DEFAULT IS ALGEBRAIC WITH OPERATOR PRECEDENCE  ALGP=1
9876 A9 26                  LDA     #RMARG
9878 85 53                  STA     RMARGN

                    ;                               OPEN KEYBOARD, (SCREEN OPENED BY OS)
987A A2 10                  LDX     #KIOCB
987C 88                     DEY                     ;0
987D 20 F6 AC               JSR     CIOINT
                    ;                               CHECK FOR ERROR????

9880 A9 08                  LDA     #8
9882 85 C0                  STA     FIXNUM          ;INIT TO FIX 8

9884 A9 8D                  LDA     #LPAD
9886 20 D7 A1               JSR     PUSHOP          ;INIT OPERATOR STACK WITH LPAD ON BOTTOM
9889 A9 05                  LDA     #TOKBUF/$100
988B 85 83                  STA     TOKPTR+1

988D A5 08                  LDA     WARMST
988F D0 06                  BNE     WARM            ;DON'T CLEAR MEMS IF WARM START
9891 20 03 AA               JSR     MEMCLR          ;CLEAR MEMORY REGISTERS
9894 20 F5 A9               JSR     SCLPRO          ;INITIALIZE PC TO START OF PRGMEM AND CLEAR PRGMEM TO ALL STP'S

9897                WARM
9897 A4 D1                  LDY     PRGADR+1        ;INIT PC IN ANY CASE
9899 84 BA                  STY     PC+1

989B A2 13                  LDX     #20-1           ;INIT BLKBUF & CTLRS
989D                INIT4
989D A9 20                  LDA     #'
989F 9D 28 05               STA     BLKBUF,X
98A2 A9 12                  LDA     #'R-64
98A4 9D 3C 05               STA     CTLRS,X
98A7 CA                     DEX
98A8 10 F3                  BPL     INIT4

98AA 84 94                  STY     RPNALG          ;DEFAULT IS ALGEBRAIC WITH OPERATOR PRECEDENCE  ALGP=1

                            ;                       INIT SCREEN DISPLAY
                            ;                       ;LINE 0-1    "ALG RAD . . .
98AC A9 B6                  LDA     #STATLN
98AE 20 04 9C               JSR     STMSG2
98B1 20 74 A2               JSR     PUTCHS
98B4 A9 D4                  LDA     #STLN2
98B6 20 04 9C               JSR     STMSG2
98B9 20 27 9C               JSR     INVID           ;CHANGE TOKBUF TO INVERSE VIDEO & RELOAD A, X, Y
98BC 20 74 A2               JSR     PUTCHS

98BF 20 A6 AA               JSR     DSPALL          ;STANDARD DISPLAY

98C2 A9 10                  LDA     #16
98C4 20 F4 A4               JSR     SBITS2


98C7                LOOP
98C7 AD F0 02               LDA     CRSINH          ;BREAK KEY HIT, CAUSING CURSOR TO BE TURNED ON?
98CA D0 06                  BNE     MAIN02          ;NO.
98CC EE F0 02               INC     CRSINH          ;INHIBIT CURSOR
98CF 20 93 AA               JSR     SEND            ;DISPLAY STACK, CHANGE PROG
98D2                MAIN02
98D2 A5 BB                  LDA     PROG
98D4 C9 01                  CMP     #STOPRG         ;STORE PROGRAM?
98D6 D0 65                  BNE     NOSTOR

                    ;                                               STORE PROGRAM MODE
98D8 20 5A 9C               JSR     DSPRG           ;DISPLAY OLD VALUE IN PROGRAM LOC



98DB 20 51 9A               JSR     LEX             ;GET NEXT TOKEN FROM PROGRAM MEM
98DE 20 27 A2               JSR     PUTDEL

98E1 A5 81                  LDA     TOKCOD          ;CHECK FOR SPECIAL COMMAND
98E3 A2 0A                  LDX     #SPCLEN
98E5                LOOP3
98E5 DD E4 BA               CMP     SPCTBL,X
98E8 D0 0F                  BNE     LOOP4

98EA A9 01                  LDA     #1              ;"NUMBER" => SPECIAL COMMAND FOUND
98EC 85 A2                  STA     NUMFLG          ;ALWAYS ON SEPARATE LINE.
98EE 20 31 99               JSR     DSPROG
98F1 A5 81                  LDA     TOKCOD
98F3 20 05 A0               JSR     SUBCAL          ;CALL SUBROUTINE
98F6 4C C7 98               JMP     LOOP            ;CONTINUE

98F9                LOOP4
98F9 CA                     DEX
98FA 10 E9                  BPL     LOOP3           ;TRY NEXT ONE

98FC C9 8E                  CMP     #NUMBER         ;NOT SPECIAL COMMAND => SAVE NUMBER?
98FE D0 24                  BNE     STPR40          ;NO.
9900 20 85 A1               JSR     PCNCHK          ;CHECK PC TO SEE IF ROOM FOR
9903 B0 C2                  BCS     LOOP            ;ERROR END OF MEM

9905 20 A7 DD               JSR     FST0R           ;STORE FR0 IN PRGMEM
9908 A0 07                  LDY     #FPREC+1
990A A9 8E                  LDA     #NUMBER
990C 91 B9                  STA     (PC),Y
990E A0 00                  LDY     #0
9910 91 B9                  STA     (PC),Y
9912 20 9D A1               JSR     PCADDN          ;MOVE PC PAST NUMBER
9915 A9 16                  LDA     #22
9917 85 54                  STA     ROWCRS
9919 85 55                  STA     COLCRS
991B 20 B8 9C               JSR     DG40            ;PTTXTP NUMBER
991E 20 9D A2               JSR     PUTCRP
9921 4C C7 98               JMP     LOOP

9924                STPR40
9924 A0 00                  LDY     #0
9926 91 B9                  STA     (PC),Y
9928 20 99 A1               JSR     PCINC

                    ;                               ;DISPLAY NEW TOKEN AFTER OLD
992B 20 31 99               JSR     DSPROG
992E                JMPLOP
992E 4C C7 98               JMP     LOOP

9931                DSPROG                          ;SET UP CURSOR AND DISPLAY COMMAND
9931 A9 16                  LDA     #22
9933 85 54                  STA     ROWCRS
9935 85 55                  STA     COLCRS
9937 20 C0 9C               JSR     PUTCMD
993A 4C 9D A2               JMP     PUTCRP

993D                NOSTOR                          ;NOT STORE PROGRAM MODE
993D 20 92 A7               JSR     DSPSTK          ;DISPLAY STACK

9940 20 BB 9F               JSR     FPUSH0          ;STORE OLD # IN CASE RPN
9943 20 51 9A               JSR     LEX
9946 90 06                  BCC     NOST10

9948 20 9D 9F               JSR     FPOP0           ;EXEC ERROR (OUT OF EXEC MODE) RELOAD X
994B 4C C7 98               JMP     LOOP
994E                NOST10


994E A5 CA                  LDA     CONFLG          ;SAVE CONVERSION FLAG
9950 85 CB                  STA     SCONFG

9952 A9 00                  LDA     #0
9954 85 97                  STA     NOPFLG
9956 A6 BE                  LDX     SSTFLG
9958 8E 66 05               STX     SSTOLD
995B 85 BE                  STA     SSTFLG
995D A5 81                  LDA     TOKCOD
995F C9 8E                  CMP     #NUMBER         ;NUMBER?
9961 D0 0A                  BNE     MAIN05          ;NO. SKIP

9963 A5 94                  LDA     RPNALG          ;RPN?
9965 F0 03                  BEQ     MAIN04          ;YES.
9967 20 86 9F               JSR     FPOP1           ;NO. DISCARD NUMBER PUSHED ON STACK

996A                MAIN04
996A 4C 21 9A               JMP     ENDWLP

996D                MAIN05                          ;NOT NUMBER.
996D 20 86 9F               JSR     FPOP1           ;DISCARD # STORED ON STACK IN CASE RPN

9970 A0 00                  LDY     #0
9972 84 A2                  STY     NUMFLG

9974 A5 81                  LDA     TOKCOD
9976 20 06 A1               JSR     GETPRI
9979 85 9A                  STA     CURPRI
997B C9 0D                  CMP     #PHIGH
997D 90 11                  BCC     MAIN40

997F A5 81                  LDA     TOKCOD          ;SPECIAL OR HIGH
9981 20 05 A0               JSR     SUBCAL          ;EXECUTE SUBROUTINE
9984 A5 9A                  LDA     CURPRI

9986 C9 0D                  CMP     #PHIGH
9988 D0 03                  BNE     MAIN35
998A 20 EE A1               JSR     FDSCOM          ;HIGH

998D                MAIN35
998D 4C 21 9A               JMP     ENDWLP

9990                MAIN40                          ;A=CURRENT PRIORITY
9990 A6 94                  LDX     RPNALG
9992 D0 15                  BNE     MAIN60
9994 C9 03                  CMP     #PLRPAR+1       ;RPN
9996 B0 06                  BCS     MAIN50
9998 20 B5 9B               JSR     KEYERR          ;( ) = NOT LEGAL IN RPN
999B 4C 25 9A               JMP     ENDLP3

999E                MAIN50
999E A5 81                  LDA     TOKCOD
99A0 20 05 A0               JSR     SUBCAL          ;EXECUTE SUBROUTINE
99A3 20 EE A1               JSR     FDSCOM
99A6 4C 25 9A               JMP     ENDLP3


99A9                MAIN60                          ;NOT RPN
                    ;                               CHECK FOR 2 OPS IN A ROW
99A9 A6 81                  LDX     TOKCOD
99AB E0 8A                  CPX     #LPAR           ;OP CAN BE FOLLOWED BY '('
99AD D0 08                  BNE     MAIN62          ;NOT '('

99AF 8A                     TXA                     ;IS '('
99B0 20 D7 A1               JSR     PUSHOP          ;PUSH '('
99B3 E6 97                  INC     NOPFLG          ;<-1 LPAR CAN'T BE FOLLOWED BY BINARY OP (EXCEPT LPAR)
99B5 10 6A                  BPL     ENDWLP          ;JMP
99B7                MAIN62

99B7 C9 03                  CMP     #PLRPAR+1
99B9 90 02                  BCC     MAIN65          ;')' AND '=' CAN BE FOLLOWED BY OP
99BB E6 97                  INC     NOPFLG          ;2-VAR OPERATOR
99BD                MAIN65
99BD A6 96                  LDX     OPFLG
99BF F0 0B                  BEQ     WLOOP
99C1 A9 42                  LDA     #TOPMSG         ;2 BINARY OPS IN A ROW IS ILLEGAL: IGNORE 1ST OP
99C3 20 B7 9B               JSR     ERRSUB
99C6 20 C4 A1               JSR     POPOP           ;DISCARD PREV CP
99C9 20 86 9F               JSR     FPOP1           ;DISCARD EXTRA #


99CC                WLOOP
99CC 20 C4 A1               JSR     POPOP

99CF 85 98                  STA     PREVOP
99D1 20 06 A1               JSR     GETPRI
99D4 85 99                  STA     PRVPRI
99D6 A5 81                  LDA     TOKCOD
99D8 C9 8B                  CMP     #RPAR
99DA D0 19                  BNE     WLP10
99DC A5 98                  LDA     PREVOP          ;TOKCOD = RPAR  ')'
99DE C9 8A                  CMP     #LPAR
99E0 F0 3F                  BEQ     ENDWLP          ;PREVOP = LPAR  '('    (NUMBER)  =>  IGNORE PARENS
99E2 C9 8D                  CMP     #LPAD
99E4 D0 06                  BNE     WLP05
99E6 20 D7 A1               JSR     PUSHOP          ;LPAD ')'  =>  PUSH LPAD BACK ON BOTTOM OF STACK
99E9 4C 21 9A               JMP     ENDWLP

99EC                WLP05
99EC 20 05 A0               JSR     SUBCAL          ;EXECUTE SUBROUTINE   OP ')'  => PERFORM OP & CONTINUE
99EF 20 EE A1               JSR     FDSCOM
99F2 4C CC 99               JMP     WLOOP

99F5                WLP10
99F5 C9 8C                  CMP     #EQUAL
99F7 D0 06                  BNE     WLP20
99F9 A5 98                  LDA     PREVOP
99FB C9 8A                  CMP     #LPAR
99FD F0 CD                  BEQ     WLOOP           ;'(', '='    =>   CONTINUE  (CLOSE ALL OPEN LPARS)
99FF                WLP20                           ;NOT (TOKCOD = EQUAL AND PREVOP = LPAR)
99FF A5 99                  LDA     PRVPRI
9A01 C5 9A                  CMP     CURPRI
9A03 90 0B                  BCC     WLP30
9A05 A5 98                  LDA     PREVOP          ;PRVPRI >=CURPRI
9A07 20 05 A0               JSR     SUBCAL          ;EXECUTE SUBROUTINE
9A0A 20 EE A1               JSR     FDSCOM
9A0D 4C CC 99               JMP     WLOOP

9A10                WLP30                           ;PRVPRI<CURPRI
9A10 A5 98                  LDA     PREVOP
9A12 20 D7 A1               JSR     PUSHOP
9A15 A5 81                  LDA     TOKCOD
9A17 C9 8C                  CMP     #EQUAL
9A19 F0 06                  BEQ     ENDWLP          ;LPAD '='  =>  DONE
9A1B 20 D7 A1               JSR     PUSHOP          ;NOT '='   => SAVE CURRENT OP & PUSH STACK
9A1E 20 BB 9F               JSR     FPUSH0

9A21                ENDWLP
9A21 A5 97                  LDA     NOPFLG
9A23 85 96                  STA     OPFLG
9A25                ENDLP3
9A25 AD 66 05               LDA     SSTOLD          ;SINGLE STEP?
9A28 F0 06                  BEQ     ENDLP4          ;NO.
9A2A A9 00                  LDA     #0              ;YES. GO BACK TO IMMEDIATE MODE
9A2C 85 BB                  STA     PROG
9A2E 85 BE                  STA     SSTFLG
9A30                ENDLP4
9A30 A5 CA                  LDA     CONFLG          ;IS CONFLG UNCHANGED?
9A32 38                     SEC
9A33 E5 CB                  SBC     SCONFG
9A35 D0 02                  BNE     ENDSKP2         ;CONFLG CHANGED => DO NOTHING
9A37 85 CA                  STA     CONFLG          ;CONFLG NOT CHANGED => CLEAR
9A39                ENDSKP2
9A39 4C C7 98               JMP     LOOP

                    ;                               END OF MAIN PROGRAM LOOP

                    ;                                               LEXICAL ANALYZER
                    ;
                    ;                       FETCH NEXT TOKEN FROM TERMINAL AND
                    ;                       SET UP TOKEN CODE IN TOKCOD, PUT STRING IN TOKBUF
                    ;
9A3C                LXINIT                          ;SUBROUTINE TO DISPLAY '>', SET UP CURSOR
9A3C A9 00                  LDA     #0

9A3E 85 82                  STA     TOKPTR
9A40 8D F0 02               STA     CRSINH          ;CURSOR ON
9A43 A9 02                  LDA     #LMARG+1
9A45 85 55                  STA     COLCRS
9A47 A9 17                  LDA     #23
9A49 85 54                  STA     ROWCRS          ;START AT BOTTOM OF SCREEN
9A4B A9 3E                  LDA     #'>
9A4D 20 31 A2               JSR     PTCHR           ;TEST CHAR

9A50                EXEC20
9A50 60                     RTS



9A51                LEX
9A51 A9 00                  LDA     #0              ;CLEAR FLAG => NO ERROR THIS TIME
9A53 85 C7                  STA     ERRFLG

9A55 A5 BB                  LDA     PROG
9A57 C9 02                  CMP     #EXEC           ;EXECUTING PROGRAM?
9A59 D0 1A                  BNE     NOEXEC          ;NO.
9A5B 20 27 A2               JSR     PUTDEL          ;CLEAR BOTTOM LINE - SET UP CURSOR FOR DISPLAY DISPLAY
9A5E 20 5A 9C               JSR     DSPRG           ;DISPLAY PROGRAM ADDR & CONTENTS IF TRACE
9A61 20 9D A2               JSR     PUTCRP          ;CR ON PRINTER ONLY
9A64 20 61 A1               JSR     NCHKLD          ;YES. LOAD TOKEN AND CHECK FOR NUMBER
9A67 B0 E7                  BCS     EXEC20          ;ERROR
9A69 D0 05                  BNE     EXEC10          ;NOT NUMBER
9A6B 20 9D A1               JSR     PCADDN          ;NUMBER        MOVE PC PAST #
9A6E 18                     CLC                     ;IF END OF PROG MEM EXECUTE INSTRUCTION BEFORE STOPPING
9A6F 60                     RTS
9A70                EXEC10
9A70 20 99 A1               JSR     PCINC           ;NOT NUMBER
9A73 18                     CLC                     ;CLEAR ANY ERROR
9A74 60                     RTS


9A75                NOEXEC
9A75 20 3C 9A               JSR     LXINIT          ;DISPLAY '>' ; INIT CURSOR
9A78 20 26 A0               JSR     GTCHR           ;A=NEXT CHAR
9A7B C9 20                  CMP     #'
9A7D F0 D2                  BEQ     LEX
9A7F C9 9C                  CMP     #DELLIN
9A81 F0 CE                  BEQ     LEX

                    ;
                    ;                               CHECK FOR SINGLE CHAR TOKENS
                    ;
9A83 A2 0D                  LDX     #TOKCLN
9A85                LXLP20
9A85 DD CC BA               CMP     TOKCHR,X
9A88 D0 08                  BNE     LEX30


9A8A BD DA BA               LDA     TOKTBL,X
9A8D 85 81                  STA     TOKCOD
9A8F 4C 85 9B               JMP     LXRTN2

9A92                LEX30
9A92 CA                     DEX
9A93 10 F0                  BPL     LXLP20

                    ;
                    ;                               CHECK FOR KEYWORD (ALPHA)
                    ;
9A95 C9 41                  CMP     #'A
9A97 90 4C                  BCC     LXNMCK
9A99 C9 5B                  CMP     #'Z+1
9A9B B0 48                  BCS     LXNMCK


9A9D 20 E2 A2               JSR     UNPINT
9AA0                KEYLP1
9AA0 20 F3 A2               JSR     UNPNUM

9AA3 F0 4F                  BEQ     LXERR2          ;END OF LIST IF 0 COUNT=>ERROR
9AA5                KEYLP2
9AA5 20 24 A1               JSR     LDCHR

9AA8 A6 88                  LDX     KEYCHR
9AAA DD 00 05               CMP     TOKBUF,X
9AAD 90 26                  BCC     KEY20           ;NO MATCH: HAVEN'T GONE FAR ENOUGH
9AAF D0 43                  BNE     LXERR2          ;NO MATCH: HAVE GONE TOO FAR - GIVE ERROR MSG
9AB1 E8                     INX
9AB2 86 88                  STX     KEYCHR

9AB4 E4 82                  CPX     TOKPTR
9AB6 90 ED                  BCC     KEYLP2
9AB8 F0 EB                  BEQ     KEYLP2

9ABA 84 8B                  STY     LDNBSV          ;NEED TO FETCH MORE CHARS FROM TERMINAL
9ABC E6 82                  INC     TOKPTR          ;SAVE PREVIOUS CHAR
9ABE 20 26 A0               JSR     GTCHR

9AC1 C9 9C                  CMP     #DELLIN
9AC3 F0 8C                  BEQ     LEX

9AC5 A4 8B                  LDY     LDNBSV
9AC7 C9 41                  CMP     #'A
9AC9 90 10                  BCC     ENDL15          ;END OF CHAR STRING (INCOMPLETE KEYWORD MATCH)
9ACB C9 5B                  CMP     #'Z+1
9ACD B0 0C                  BCS     ENDL15
9ACF A6 88                  LDX     KEYCHR
9AD1 E4 8A                  CPX     KEYLN2
9AD3 90 D0                  BCC     KEYLP2          ;NOT END OF WORD => CONTINUE

9AD5                KEY20
                                                    ;TRY NEXT WORD IN LIST
9AD5 20 FF A2               JSR     UNPNXT
9AD8 4C A0 9A               JMP     KEYLP1          ;CONTINUE

9ADB                ENDL15
9ADB A5 8F                  LDA     KEYCNT
9ADD 85 81                  STA     TOKCOD
9ADF 20 D7 A2               JSR     SAVCHR
9AE2 4C 7F 9B               JMP     LEXRTN

                    ;
                    ;                               CHECK FOR NUMBER
                    ;
9AE5                LXNMCK
9AE5 C9 2E                  CMP     #'.
9AE7 D0 0F                  BNE     LXNDOT

9AE9 A6 87                  LDX     DHOFLG          ;DEC?
9AEB D0 07                  BNE     LXERR2          ;NO. '.' NOT ALLOWED
9AED E6 82                  INC     TOKPTR          ;SAVE "."
9AEF 20 A5 A0               JSR     GETDHO          ;GET DEC, HEX OR OCT DIGIT (ACCORDING TO DHOFLG)
9AF2 90 1E                  BCC     LXHVDT

9AF4                LXERR2
9AF4 A9 4C                  LDA     #KEYMSG         ;'.' WITH NO DIGITS  "NOT VALID COMMAND"
9AF6 D0 74                  BNE     LEXERR          ;JMP

9AF8                LXNDOT
9AF8 20 B1 A0               JSR     DHOCHK
9AFB B0 F7                  BCS     LXERR2          ;NO MATCH AT ALL SO ILLEGAL CHAR

                    ;                               HAVE NUMBER
9AFD                LXLP40
9AFD A6 82                  LDX     TOKPTR
9AFF E0 0F                  CPX     #NUMLEN+1       ;LIMIT TO NUMLEN CHARS
9B01 B0 67                  BCS     LENERR
9B03 20 A5 A0               JSR     GETDHO
9B06 90 F5                  BCC     LXLP40          ;KEEP GETTING DIGITS

9B08 C9 2E                  CMP     #'.
9B0A D0 11                  BNE     LXND2
9B0C A6 87                  LDX     DHOFLG          ;DEC?
9B0E D0 E4                  BNE     LXERR2          ;NO. '.' NOT ALLOWED

9B10 E6 82                  INC     TOKPTR
9B12                LXHVDT
9B12 A6 82                  LDX     TOKPTR          ;CHECK FOR BUFFER OVERFLOW
9B14 E0 0F                  CPX     #NUMLEN+1       ;LIMIT TO NUMLEN CHARS
9B16 B0 52                  BCS     LENERR          ;TOO MANY DIGITS
9B18 20 A5 A0               JSR     GETDHO
9B1B 90 F5                  BCC     LXHVDT

9B1D                LXND2
9B1D A6 87                  LDX     DHOFLG
9B1F D0 24                  BNE     LXNUM           ;OCTAL OR HEX => NO EXP ALLOWED

9B21 C9 45                  CMP     #'E             ;DECIMAL CHECK FOR EXPONENT
9B23 D0 20                  BNE     LXNUM           ;NO E-> END OF NUMBER

9B25 E6 82                  INC     TOKPTR          ;SAVE E
9B27 20 A5 A0               JSR     GETDHO
9B2A 90 0F                  BCC     LXGT2           ;HAVE DIGIT

9B2C C9 2B                  CMP     #'+             ;NOT A DIGIT. '+' OR '-'?
9B2E F0 04                  BEQ     LX50
9B30 C9 2D                  CMP     #'-
9B32 D0 2F                  BNE     LX60            ;E IS NOT FOR EXPONENT=> DONE WITH NUMBER
9B34                LX50
9B34 E6 82                  INC     TOKPTR          ;E IS FOR EXPONENT    => SAVE '+' OR '-'
9B36 20 A5 A0               JSR     GETDHO
9B39 B0 B9                  BCS     LXERR2

9B3B                LXGT2
9B3B 20 A5 A0               JSR     GETDHO          ;GET 2ND DIGIT OF EXPONENT
9B3E B0 05                  BCS     LXNUM           ;NO 2ND DIGIT
9B40 20 A5 A0               JSR     GETDHO          ;HAVE 2ND DIGIT. IS THERE 3RD?
9B43 90 25                  BCC     LENERR          ;ERROR - EXPONENT TOO LARGE

9B45                LXNUM
9B45 20 D7 A2               JSR     SAVCHR          ;SAVE LAST CHAR FOR NEXT TOKEN
9B48                LXN2
9B48 A0 00                  LDY     #0
9B4A A9 9B                  LDA     #CR
9B4C 91 82                  STA     (TOKPTR),Y
9B4E 20 2B A4               JSR     SNUMB           ;ASCII -> FP

9B51 EE F0 02               INC     CRSINH          ;CURSOR OFF
9B54 A5 BB                  LDA     PROG
9B56 C9 01                  CMP     #STOPRG
9B58 F0 03                  BEQ     LXN3            ;STORE PROGRAM => NO DISPLAY
9B5A 20 57 9D               JSR     FDSP0           ;DISPLAY # OTHERWISE FOR ALL LEX CALLS
9B5D                LXN3

9B5D A9 8E                  LDA     #NUMBER
9B5F 85 81                  STA     TOKCOD
9B61 D0 4D                  BNE     LXRTN3          ;JMP

9B63                LX60
9B63 20 D7 A2               JSR     SAVCHR          ;SAVE E FOR NEXT TOKEN
9B66 C6 82                  DEC     TOKPTR
9B68 10 DB                  BPL     LXNUM           ;JMP

9B6A                LENERR
9B6A A9 9D                  LDA     #DIGMSG         ;TOO MANY DIGITS
9B6C                LEXERR
9B6C A0 01                  LDY     #1
9B6E 8C F0 02               STY     CRSINH          ;CURSOR OFF
9B71 48                     PHA
9B72 20 08 A2               JSR     PTCRPD
9B75 68                     PLA
9B76 20 B7 9B               JSR     ERRSUB
9B79 20 0B A2               JSR     PUTCR           ;EXTRA CR
9B7C 4C 51 9A               JMP     LEX             ;TRY AGAIN


9B7F                LEXRTN
9B7F A0 00                  LDY     #0
9B81 A9 9B                  LDA     #CR
9B83 91 82                  STA     (TOKPTR),Y
9B85                LXRTN2
9B85 EE F0 02               INC     CRSINH          ;CURSOR OFF

9B88 A5 BB                  LDA     PROG
9B8A C9 01                  CMP     #STOPRG
9B8C F0 22                  BEQ     LXRTN3          ;DON'T DISPLAY IF STORE PROGRAM MODE
9B8E A5 BD                  LDA     DSPFLG
9B90 D0 1E                  BNE     MAIN21          ;NO DISPLAY
9B92 20 47 A3               JSR     UNPKEY          ;UNPACK KEYWORD TOKNUM INTO TOKBUF
9B95 A6 A2                  LDX     NUMFLG
9B97 D0 04                  BNE     MAIN15
9B99 A9 13                  LDA     #19             ;# OF BLANKS NEEDED TO GET COMMAND IN PROPER COL ON PRINTER
9B9B D0 06                  BNE     MAIN20          ;JMP     PREVIOUS TOKEN WAS NOT A NUMBER
9B9D                MAIN15                          ;PREVIOUS TOKEN WAS A NUMBER
9B9D A9 16                  LDA     #ROWCMD
9B9F 85 54                  STA     ROWCRS
9BA1 A9 01                  LDA     #1
9BA3                MAIN20
9BA3 20 6F 9F               JSR     PUTBLK

9BA6 A9 16                  LDA     #COLCMD
9BA8 85 55                  STA     COLCRS
9BAA 20 20 9C               JSR     TOKINT          ;SET UP X-TOKPTR, A=TOKBUF, Y=TOKBUF/256
9BAD 20 05 A2               JSR     PTTXTP
9BB0                MAIN21

9BB0                LXRTN3
9BB0 20 27 A2               JSR     PUTDEL          ;DELETE BOTTOM LINE
9BB3 18                     CLC                     ;NO ERROR
9BB4                INIT                                    ;POWER UP INIT: JUST RETURN

9BB4 60                     RTS
                    ;                                       END OF LEX

9BB5                KEYERR
9BB5 A9 4C                  LDA     #KEYMSG
9BB7                ERRSUB
                    ;                               OUTPUT "ERROR - ":MESSAGE   A=LSB OF ADDRESS
                    ;                               RETURN CS => ERROR
9BB7 A6 C7                  LDX     ERRFLG
9BB9 D0 1A                  BNE     ERRRTN          ;RETURN IF ERROR ALREADY DISPLAYED
9BBB E6 C7                  INC     ERRFLG          ;<- 1 SET FLAG
9BBD AA                     TAX
9BBE A5 54                  LDA     ROWCRS
9BC0 48                     PHA                     ;SAVE OLD CURSOR LOC SO IT CAN BE RESTORED LATER
9BC1 A5 55                  LDA     COLCRS
9BC3 48                     PHA
9BC4 8A                     TXA
9BC5 48                     PHA

9BC6 20 D7 9B               JSR     ERRSB2
9BC9 68                     PLA
9BCA A0 BC                  LDY     #ERRTBL/256
9BCC 20 F2 9B               JSR     PTMSG2

9BCF 68                     PLA
9BD0 85 55                  STA     COLCRS
9BD2 68                     PLA
9BD3 85 54                  STA     ROWCRS
9BD5                ERRRTN
9BD5 38                     SEC
9BD6 60                     RTS

9BD7                ERRSB2
9BD7 A9 00                  LDA     #0
9BD9 85 BD                  STA     DSPFLG          ;TURN DISPLAY ON
9BDB A5 BB                  LDA     PROG
9BDD 29 01                  AND     #1
9BDF 85 BB                  STA     PROG            ;STOP EXECUTION, IF ANY

9BE1 A2 01                  LDX     #1
9BE3 8E F0 02               STX     CRSINH          ;CURSOR OFF
9BE6 A9 80                  LDA     #$80            ;OUTPUT ERROR SOUND
9BE8 20 3A 9C               JSR     SOUND

9BEB 20 97 A2               JSR     PTCRPN


                    ;                               PUT "ERROR
9BEE A9 B0                  LDA     #ERRMSG         ;DISPLAY PACKED MESSAGE "ERROR -"


9BF0                PUTMSG                          ;PUT MESSAGE ON BOTTOM LINE OF SCREEN & PRINTER
                    ;                               INPUT: A=MSG LSBYTE
9BF0 A0 BD                  LDY     #PROMSG/256     ;MSG MSB
9BF2                PTMSG2                          ;INPUT A=MSG LSB, Y=MSG MSB
9BF2 A6 BD                  LDX     DSPFLG
9BF4 D0 30                  BNE     SETRTN
9BF6 A2 02                  LDX     #2
9BF8 86 55                  STX     COLCRS
9BFA A2 17                  LDX     #23
9BFC 86 54                  STX     ROWCRS
9BFE 20 06 9C               JSR     SETMSG          ;SET UP MSG IN TOKBUF
9C01 4C 05 A2               JMP     PTTXTP          ;PUT TOKBUF ON SCREEN & PRINTER


9C04 A0 BD          STMSG2  LDY     #PROMSG/256     ;SET UP MSG IN TOKBUF:  A=MSG LSB, MSG MSB = PROMSG/256
9C06                SETMSG                          ;SET UP MESSAGE IN TOKBUF: A=MSG LSB, Y=MSG MSB
9C06 A6 BD                  LDX     DSPFLG
9C08 D0 1C                  BNE     SETRTN
9C0A A2 00                  LDX     #TOKBUF
9C0C 86 82                  STX     TOKPTR
9C0E 85 8C                  STA     PKPTR
9C10 84 8D                  STY     PKPTR+1
9C12 A0 00                  LDY     #0
9C14 84 80                  STY     LFRT
9C16 B1 8C                  LDA     (PKPTR),Y
9C18 85 8A                  STA     KEYLN2
9C1A 98                     TYA
9C1B 20 1F A3               JSR     UNPCK2
9C1E 85 82                  STA     TOKPTR
9C20                TOKINT
9C20 A6 82                  LDX     TOKPTR          ;SUBROUTINE TO LOAD A,X,Y FOR TOKBUF DISPLAY

9C22                TKINT2
9C22 A9 00                  LDA     #TOKBUF
9C24 A0 05                  LDY     #TOKBUF/256
9C26                SETRTN
9C26 60                     RTS

9C27 A6 82          INVID   LDX     TOKPTR          ;CHANGE TOKBUF TO INVERSE VIDEO (EXCEPT BLANKS) & LOAD A,X,Y FOR DISPLAY
9C29                CHSLP
9C29 BD 00 05               LDA     TOKBUF,X
9C2C C9 20                  CMP     #'
9C2E F0 05                  BEQ     INV10           ;IF BLANK THEN NO INVERSE VIDEO
9C30 09 80                  ORA     #$80            ;INVERSE VIDEO BIT
9C32 9D 00 05               STA     TOKBUF,X
9C35                INV10
9C35 CA                     DEX
9C36 10 F1                  BPL     CHSLP
9C38 30 E6                  BMI     TOKINT          ;JMP            LOAD A,X,Y

9C3A                SOUND                           ;MAKE SOUND AT FREQ A
9C3A 8D 00 D2               STA     AUDF1
9C3D A9 AF                  LDA     #$AF
9C3F 8D 01 D2               STA     AUDC1
9C42 A0 80                  LDY     #$80            ;DELAY
9C44 AA                     TAX
9C45                SNDLP1
9C45 CA                     DEX
9C46 D0 FD                  BNE     SNDLP1
9C48 88                     DEY
9C49 D0 FA                  BNE     SNDLP1
9C4B 8C 01 D2               STY     AUDC1
9C4E 60                     RTS                     ;TURN SOUND OFF

9C4F                CLNUM                           ;CLEAR TOKBUF SO NUMBER CAN BE LOADED
                    ;                               RETURN A='    X=$FF    Y UNCHANGED
9C4F A2 0D                  LDX     #NUMLEN-1
9C51 A9 20                  LDA     #'
9C53                CLNLP
9C53 9D 00 05               STA     TOKBUF,X
9C56 CA                     DEX
9C57 10 FA                  BPL     CLNLP
9C59 60                     RTS

9C5A                DSPRG                           ;DISPLAY PROGRAM ADDRESS, CURRENT TOKEN
                    ;                               RETURN CS=>ERROR    CC=>NO ERROR
9C5A A5 BA                  LDA     PC+1
9C5C C5 D3                  CMP     PC1MX1
9C5E 90 05                  BCC     DG10
9C60                EPERR
9C60 A9 B6                  LDA     #EPMSG          ;PAST END OF MEM
9C62 4C B7 9B               JMP     ERRSUB

9C65                DG10
9C65 A6 BD                  LDX     DSPFLG
9C67 D0 76                  BNE     DG80            ;NO DISPLAY IF EXEC & NOTRACE
9C69 20 BB 9F               JSR     FPUSH0          ;SAVE X
9C6C A5 BA                  LDA     PC+1            ;RELOAD PC MSB
9C6E 38                     SEC
9C6F E5 D1                  SBC     PRGADR+1        ;NORMALIZE TO 0 BASE INSTEAD OF PRGMEM
9C71 85 D5                  STA     FR0+1
9C73 A5 B9                  LDA     PC
9C75 85 D4                  STA     FR0
9C77 20 AA D9               JSR     IFP
9C7A 20 E6 D8               JSR     FASC            ;0 -> 1023 IN (INBUFF) IN ASCII
9C7D 20 9D 9F               JSR     FPOP0           ;RELOAD X

9C80 20 97 A2               JSR     PTCRPN          ;PUT CR ON PRINTER IF PREVIOUS WAS #, NUMFLG<-0

9C83 A0 FF                  LDY     #$FF            ;RIGHT JUSTIFY IN TOKBUF, PUT 0'S AT LEFT
9C85                DGLP1
9C85 C8                     INY                     ;FIND END OF BUFFER
9C86 B1 F3                  LDA     (INBUFF),Y
9C88 10 FB                  BPL     DGLP1
9C8A 29 7F                  AND     #$7F            ;MASK OFF END OF BUFFER INDICATOR
9C8C A2 03                  LDX     #3
9C8E D0 02                  BNE     DG20            ;JMP
9C90                DGLP2                           ;MOVE TO TOKBUF


9C90 B1 F3                  LDA     (INBUFF),Y
9C92                DG20
9C92 9D 00 05               STA     TOKBUF,X
9C95 CA                     DEX
9C96 88                     DEY
9C97 10 F7                  BPL     DGLP2
9C99 8A                     TXA
9C9A 30 08                  BMI     DG30
9C9C A9 30                  LDA     #'0             ;PAD WITH 0'S
9C9E                DGLP3
9C9E 9D 00 05               STA     TOKBUF,X
9CA1 CA                     DEX
9CA2 10 FA                  BPL     DGLP3
9CA4                DG30
9CA4 20 27 A2               JSR     PUTDEL
9CA7 E6 55                  INC     COLCRS          ;ONE SPACE AT BEGINNING OF LINE
9CA9 20 22 9C               JSR     TKINT2          ;A<-TOKBUF, Y<-TOKBUF/256
9CAC A2 04                  LDX     #4
9CAE 20 AB A2               JSR     PTCHSP
9CB1 20 61 A1               JSR     NCHKLD          ;LOAD TOKEN CODE FROM PRGMEM. CHECK FOR NUMBER

9CB4 B0 2B                  BCS     DGRTN           ;ERROR
9CB6 D0 06                  BNE     DG60            ;NOT NUMBER
9CB8                DG40
9CB8 20 86 9D               JSR     TOKNUM          ;FP NUMBER -> ASCII IN TOKBUF
9CBB 4C D4 9C               JMP     DG70

9CBE                DG60
9CBE 85 81                  STA     TOKCOD          ;NOT A #
9CC0                PUTCMD                          ;ENTRY POINT TO DISPLAY COMMAND
9CC0 20 47 A3               JSR     UNPKEY          ;UNPACK CHARS FOR TOKEN
9CC3 B0 1C                  BCS     DGRTN           ;ERROR
9CC5 A9 0E                  LDA     #NUMLEN
9CC7 38                     SEC
9CC8 E5 82                  SBC     TOKPTR          ;Y = LENGTH OF BUFFER
9CCA F0 08                  BEQ     DG70
9CCC AA                     TAX                     ;OUTPUT BLANKS
9CCD A9 28                  LDA     #BLKBUF
9CCF A0 05                  LDY     #BLKBUF/256
9CD1 20 AB A2               JSR     PTCHSP
9CD4                DG70
9CD4 E6 55                  INC     COLCRS          ;ONE COLUMN TO RIGHT
9CD6 20 20 9C               JSR     TOKINT          ;SET UP A=TOKBUF,X=TOKPTR,Y=TOKBUF/256
9CD9 20 AB A2               JSR     PTCHSP
9CDC 20 0B A2               JSR     PUTCR           ;CR ON SCREEN ONLY, NOT PRINTER
9CDF                DG80
9CDF 18                     CLC
9CE0 60                     RTS

9CE1                DGRTN
9CE1 20 0B A2               JSR     PUTCR           ;PUT EXTRA LINE AFTER ERROR MSG
9CE4 38                     SEC
9CE5 60                     RTS


9CE6                FPBIN                           ;CONVERT FR0 TO 32 BIT BINARY #
                    ;                               THEN COMPARE WITH BITBIN TO SEE IF IT IS IN THE
                    ;                               RANGE SPECIFIED BY BITINT.
9CE6 A5 D4                  LDA     FR0
9CE8 85 A0                  STA     NEGFLG
9CEA 10 04                  BPL     FP10
9CEC 29 7F                  AND     #$7F            ;TAKE ABSOLUTE VALUE
9CEE 85 D4                  STA     FR0
9CF0                FP10
9CF0 20 2E 9D               JSR     FPBNCK          ;CONVERT FP TO BINARY
9CF3 B0 61                  BCS     FP21            ;OVERFLOW
9CF5 A5 A0                  LDA     NEGFLG
9CF7 10 03                  BPL     FP20
9CF9 20 06 A4               JSR     S2CMP           ;NEG # - TAKE COMP, ADD 1
9CFC                FP20


9CFC                BINCHK                          ;CHECK TO SEE IF BINARY IS WITHIN RANGE
                    ;                               AS SPECIFIED BY CURRENT BITS.
                    ;                               CS => ERROR     CC => NO ERROR
9CFC A5 B0                  LDA     BINARY
9CFE 30 11                  BMI     BINC10
9D00 A2 00                  LDX     #0              ;POSITIVE
9D02                BINLP1
9D02 B5 B0                  LDA     BINARY,X
9D04 D5 A4                  CMP     BITBIN,X
9D06 F0 02                  BEQ     BINOK
9D08 B0 16                  BCS     BOERR           ;TOO LARGE
9D0A                BINOK
9D0A E8                     INX
9D0B E0 04                  CPX     #4
9D0D D0 F3                  BNE     BINLP1
9D0F 18                     CLC
9D10 60                     RTS                     ;OK
9D11                BINC10
9D11 A2 00                  LDX     #0
9D13                BINLP2
9D13 B5 B0                  LDA     BINARY,X
9D15 D5 AC                  CMP     BINMIN,X
9D17 90 07                  BCC     BOERR           ;TOO SMALL
9D19 E8                     INX
9D1A E0 04                  CPX     #4
9D1C D0 F5                  BNE     BINLP2
9D1E 18                     CLC
9D1F 60                     RTS                     ;OK
9D20                BOERR
9D20 A2 03                  LDX     #3              ;CLEAR BINARY BECAUSE OF ERROR
9D22 A9 00                  LDA     #0
9D24 95 B0          BINLP3  STA     BINARY,X
9D26 CA                     DEX
9D27 10 FB                  BPL     BINLP3
9D29 A9 5C                  LDA     #BOMSG          ;BINARY UNDERFLOW
9D2B 4C B7 9B               JMP     ERRSUB

9D2E                FPBNCK                          ;CONVERT POSITIVE FR0 TO 4 BYTE BINARY
                    ;                               CLEAR BINARY IF TOO LARGE AND SET CARRY

9D2E 20 BB 9F               JSR     FPUSH0          ;SAVE COPY OF # FOR MOD
9D31 A2 30                  LDX     #C65536
9D33 A0 BA                  LDY     #C65536/256
9D35 20 89 DD               JSR     FLD0R
9D38 20 E8 A6               JSR     SMOD            ;FR0 = X MOD 65536 (2 LOWER BYTES)
9D3B 20 D2 D9               JSR     FPI             ;MODFAC = INT(X/65536) (2 UPPER BYTES)
9D3E A5 D4                  LDA     FR0             ;LSB
9D40 85 B3                  STA     BINARY+3
9D42 A5 D5                  LDA     FR0+1
9D44 85 B2                  STA     BINARY+2
9D46 20 12 9F               JSR     FLD0M           ;LOAD MODFAC
9D49 20 D2 D9               JSR     FPI
9D4C B0 D2                  BCS     BOERR           ;ERROR: OVERFLOW
9D4E A5 D4                  LDA     FR0
9D50 85 B1                  STA     BINARY+1
9D52 A5 D5                  LDA     FR0+1           ;MSB
9D54 85 B0                  STA     BINARY+0
9D56 60             FP21    RTS

9D57                FDSP0
                    ;                               CONVERT FR0 TO ASCII AND DISPLAY
9D57 A5 BD                  LDA     DSPFLG
9D59 D0 1F                  BNE     DSPRTN          ;RETURN IF NO DISPLAY
9D5B 20 27 A2               JSR     PUTDEL          ;CLEAR BOTTOM LINE & SET UP CURSOR
9D5E 20 86 9D               JSR     TOKNUM          ;CONVERT FR0 TO ASCII IN TOKBUF
                    ;DAYDSP                         ;DISPLAY TOKBUF ON SCREEN AND PRINTER (IF ON)
9D61 20 97 A2               JSR     PTCRPN          ;PUT CR ON PRINTER IF PREVIOUS THING WAS NUMBER
9D64 A9 04                  LDA     #4              ;PUT 4 BLANKS ON PRINTER ONLY
9D66 20 6F 9F               JSR     PUTBLK
9D69 A9 07                  LDA     #7
9D6B 85 55                  STA     COLCRS
9D6D 20 20 9C               JSR     TOKINT          ;SET UP A=TOKBUF,X=TOKPTR,Y=TOKBUF/256
9D70 20 AB A2               JSR     PTCHSP
9D73 20 0B A2               JSR     PUTCR
9D76 A9 01                  LDA     #1
9D78 85 A2                  STA     NUMFLG
9D7A 60             DSPRTN  RTS


9D7B                FDSP1
9D7B 85 55                  STA     COLCRS          ;DISPLAY NUMBER ON SCREEN ONLY, IN COL A
9D7D 20 86 9D               JSR     TOKNUM
9D80                FDSP2                           ;DISPLAY TOKBUF # ON SCREEN WHEREVER CURSOR IS
9D80 20 20 9C               JSR     TOKINT          ;SET UP A=TOKBUF,X=TOKPTR,Y=TOKBUF/256
9D83 4C 74 A2               JMP     PUTCHS

9D86                TOKNUM                          ;CONVERT FR0 TO ASCII IN TOKBUF -> TOKBUF+NUMLEN-1 (RIGHT JUSTIFIED)
9D86 A5 BD                  LDA     DSPFLG
9D88 D0 F0                  BNE     DSPRTN          ;RETURN IF NO DISPLAY
9D8A 20 BB 9F               JSR     FPUSH0          ;SAVE FP #
9D8D A5 87                  LDA     DHOFLG
9D8F F0 49                  BEQ     FDS05

                    ;                                               NON-DECIMAL NUMBER
9D91 20 7D A6               JSR     STRUNC          ;TRUNCATE # FOR DISPLAY ONLY
9D94 20 E6 9C               JSR     FPBIN
9D97 90 0A                  BCC     TOKN10
                    ;                               ;OVERFLOW ERROR => DISPLAY MSG INSTEAD OF NUMBER
9D99 A9 5C                  LDA     #BOMSG          ;"HEX/OCT OVRFLW"
9D9B A0 BC                  LDY     #ERRTBL/256
9D9D 20 06 9C               JSR     SETMSG          ;TOKBUF = MESSAGE
9DA0 4C 0B 9F               JMP     FABCD
9DA3                TOKN10

9DA3 A2 03                  LDX     #3


                    ;                               LIMIT TO # OF BITS SET BY "BITS" COMMAND
9DA5                FDLP3
9DA5 B5 B0                  LDA     BINARY,X
9DA7 35 A8                  AND     BITBN2,X
9DA9 95 B0                  STA     BINARY,X
9DAB CA                     DEX
9DAC 10 F7                  BPL     FDLP3


9DAE A9 00                  LDA     #0
9DB0 20 27 A8               JSR     BINFP2          ;TREAT ALL AS POSITIVE

9DB3 20 4F 9C               JSR     CLNUM           ;CLEAR TOKBUF
9DB6 A9 0E                  LDA     #NUMLEN
9DB8 85 82                  STA     TOKPTR

9DBA                FDLP2
9DBA A5 87                  LDA     DHOFLG
9DBC 20 E0 A6               JSR     INTMOD          ;FR0 <- FR0 MOD DHOFLG
9DBF A5 D5                  LDA     FR0+1           ;0-> (DHOFLG-1) IN BCD
9DC1 18                     CLC
9DC2 69 30                  ADC     #'0             ;CONVERT TO ASCII
9DC4 C9 40                  CMP     #'0+$10         ;10 TO 15?
9DC6 90 02                  BCC     FDS1            ;NO.
9DC8 69 00                  ADC     #'A-'0-$10-1    ;YES. CONVERT TO ASCII A TO F
9DCA                FDS1
9DCA A0 00                  LDY     #0
9DCC C6 82                  DEC     TOKPTR
9DCE 91 82                  STA     (TOKPTR),Y

9DD0 20 12 9F               JSR     FLD0M           ;LOAD MODFAC=INT(FR0/DHOFLG)
9DD3 A5 D4                  LDA     FR0
9DD5 D0 E3                  BNE     FDLP2

9DD7 4C 0B 9F               JMP     FABCD

                    ;                               DECIMAL MODE  A = DHOFLG = 0
9DDA                FDS05
9DDA 85 BF                  STA     SEFORM          ;INIT TO 0 TO INDICATE NOT EFORM
9DDC 20 4F 9C               JSR     CLNUM           ;CLEAR TOKBUF  RETURN A='  X=$FF  Y UNCHANGED
                    ;                               ADD 5X10^K IN PREPARATION FOR ROUNDING
9DDF A2 50                  LDX     #$50
9DE1 A5 D5                  LDA     FR0+1
9DE3 85 C3                  STA     SMSD            ;SAVE MSD OF NUMBER
9DE5 A5 D4                  LDA     FR0
9DE7 85 C2                  STA     SSIGN           ;SAVE SIGN
9DE9 F0 6A                  BEQ     RF90            ;0 -> NOTHING FANCY NEEDED
9DEB 29 7F                  AND     #$7F            ;TAKE ABSVAL
9DED 85 D4                  STA     FR0
9DEF C9 3F                  CMP     #$3F            ;E FORM?
9DF1 90 14                  BCC     RF10            ;YES.
9DF3 C9 44                  CMP     #$44
9DF5 B0 10                  BCS     RF10            ;YES.
9DF7 A5 C0                  LDA     FIXNUM          ;NO.
9DF9 C9 08                  CMP     #8              ;FIX 8 (NOFIX)?
9DFB F0 12                  BEQ     RF20            ;YES.
9DFD 4A                     LSR     A               ;DIVIDE BY 2
9DFE 90 02                  BCC     RF70            ;ODD?
9E00 A2 05                  LDX     #$05            ;YES.
9E02                RF70
9E02 49 3F                  EOR     #$3F            ;TAKE COMPLEMENT, CHANGE TO EXCESS 40 NOTATION
9E04 4C 29 9E               JMP     RF80


9E07                RF10
9E07 E6 BF                  INC     SEFORM          ;YES. SET FLAG
9E09 A5 C0                  LDA     FIXNUM          ;FORM 5X10^-(FIXNUM+1)X10^K1
9E0B C9 08                  CMP     #7+1            ;WHERE K1=POWER OF 10 IN FR0.
9E0D 90 02                  BCC     RF30            ;MAX # OF DIGITS AFTER DP=7 IN E MODE
9E0F                RF20

9E0F A9 07                  LDA     #7
9E11                RF30
9E11 A4 D5                  LDY     FR0+1
9E13 C0 10                  CPY     #$10            ;IN RANGE 0-9?
9E15 90 04                  BCC     RF40            ;YES.
9E17 E9 01                  SBC     #1              ;NO. 10-99 => ODD POWER OF 10, 5X^10-((FIXNUM-1)+1)X10^(K1-1)
9E19 C9 FF                  CMP     #$FF            ;SET CARRY IF NEG. TO BE ROTATED INTO MSB

9E1B                RF40
9E1B 6A                     ROR     A               ;DIVIDE BY 2 TO GET POWER OF 100
9E1C 90 02                  BCC     RF50            ;ODD POWER OF 10?
9E1E A2 05                  LDX     #$05            ;YES. USE 5, NOT $50
9E20                RF50
9E20 49 FF                  EOR     #$FF            ;TAKE COMPLEMENT = -(A-1)
9E22 18                     CLC
9E23 65 D4                  ADC     FR0             ;COMBINE WITH EXPONENT
9E25 C9 10                  CMP     #$F+1           ;TOO SMALL?
9E27 90 3A                  BCC     RFERR           ;YES. ERROR
9E29                RF80
9E29 85 E0                  STA     FR1             ;EXPONENT
9E2B 86 E1                  STX     FR1+1           ;5 OR $50

9E2D A2 03                  LDX     #3
9E2F A9 00                  LDA     #0
9E31                RFLP1
9E31 85 E2                  STA     FR1+2           ;CLEAR REST OF FR1
9E33 CA                     DEX

9E34 10 FB                  BPL     RFLP1

9E36 20 66 DA               JSR     FADD            ;FINALLY CAN DO ADD
9E39 B0 28                  BCS     RFERR           ;ERROR - OVERFLOW

9E3B A5 BF                  LDA     SEFORM          ;EFORM?
9E3D D0 08                  BNE     RF85            ;YES.
9E3F A5 D4                  LDA     FR0             ;NO.
9E41 C9 44                  CMP     #$44            ;EXPONENT TOO LARGE?
9E43 90 10                  BCC     RF90            ;NO. OK
9E45 E6 BF                  INC     SEFORM          ;YES. EFORM AFTER ALL MUST HAVE BEEN APPROX 99999999.9 TO 100000000
9E47                RF85
9E47 20 51 DA               JSR     INTLBF          ;YES. MAKE INBUFF POINT TO LBUFF
9E4A A9 30                  LDA     #'0             ;STORE ASCII 0
9E4C 8D 75 05               STA     LBUFF-11
9E4F 20 20 D9               JSR     XEFORM          ;FP -> EFORM ASCII
9E52 4C 58 9E               JMP     RF100
9E55                RF90
9E55 20 E6 D8               JSR     FASC            ;FP -> ASCII (NOT EFORM WE HOPE)
9E58                RF100


                    ;                               FIND & SAVE E+/-NN
9E58 A0 FF                  LDY     #$FF
9E5A                RFLP2
9E5A C8                     INY
9E5B B1 F3                  LDA     (INBUFF),Y
9E5D 10 16                  BPL     RF110
9E5F A6 BF                  LDX     SEFORM          ;END OF DUFFER
9E61 F0 09                  BEQ     RF105
9E63                RFERR                           ;ERROR: SHOULD HAVE E
9E63 20 88 A9               JSR     CRYSND          ;"ARITHMETIC OVERFLOW" ERROR - CLEAR FR0
9E66 20 86 9F               JSR     FPOP1           ;POP OFF OLD X VALUE
9E69 4C 86 9D               JMP     TOKNUM          ;TRY DISPLAY AGAIN

9E6C                RF105
9E6C 29 7F                  AND     #$7F            ;CLEAR END OF BUFFER INDICATOR
9E6E 91 F3                  STA     (INBUFF),Y
9E70 84 C1                  STY     MANTLN          ;SAVE MANTISSA LENGTH
9E72 4C 91 9E               JMP     RF120

9E75                RF110
9E75 C9 45                  CMP     #'E             ;E FOUND?
9E77 D0 E1                  BNE     RFLP2           ;NO. CONTINUE

9E79 A6 BF                  LDX     SEFORM          ;YES. EFORM? JE
9E7B F0 E6                  BEQ     RFERR           ;NO. ERROR, SHOULD NOT HAVE E
9E7D 88                     DEY
9E7E 84 C1                  STY     MANTLN          ;SAVE MANTISSA LENGTH (ADDR OF LAST CHAR)
9E80 C8                     INY
9E81 A2 0A                  LDX     #NUMLEN-4       ;MOVE E TO TOKBUF
9E83 9D 00 05       RFLP3   STA     TOKBUF,X
9E86 E8                     INX
9E87 C8                     INY
9E88 B1 F3                  LDA     (INBUFF),Y
9E8A 10 F7                  BPL     RFLP3
9E8C 29 7F                  AND     #$7F
9E8E 9D 00 05               STA     TOKBUF,X
9E91                RF120
                    ;                               NOW FIND DECIMAL POINT

9E91 A0 FF                  LDY     #$FF

9E93                RFLP4
9E93 C8                     INY
9E94 C4 C1                  CPY     MANTLN
9E96 F0 0A                  BEQ     RF130
9E98 90 08                  BCC     RF130           ;NOT AT END YET
9E9A A9 2E                  LDA     #'.             ;ADD '.'
9E9C 91 F3                  STA     (INBUFF),Y
9E9E 84 C1                  STY     MANTLN
9EA0 D0 06                  BNE     RF140           ;JMP
9EA2                RF130
9EA2 B1 F3                  LDA     (INBUFF),Y
9EA4 C9 2E                  CMP     #'.
9EA6 D0 EB                  BNE     RFLP4
9EA8                RF140                           ;HAVE '.'
9EA8 A6 C0                  LDX     FIXNUM
9EAA E0 08                  CPX     #8
9EAC D0 20                  BNE     RF148           ;FIXED DEC

9EAE A4 C1                  LDY     MANTLN          ;NOT FIXED DEC
9EB0 C0 09                  CPY     #9
9EB2 90 3D                  BCC     RF170           ;<= 8 DIGITS IS OK
9EB4 A0 08                  LDY     #8
9EB6 A5 C2                  LDA     SSIGN           ;LOAD OLD FR0 VALUE
9EB8 29 7F                  AND     #$7F
9EBA C9 3F                  CMP     #$3F            ;NON EFORM FRACTION (E.G. 1. .01)?
9EBC D0 07                  BNE     RF142           ;NO.
9EBE                INY                             ;YES. ALLOW EXTRA DIGIT FOR LEADING '0'
9EBE A5 C3                  LDA     SMSD            ;LOAD OLD FR0+1
9EC0 C9 10                  CMP     #$10            ;1 OR 2 DIGITS?
9EC2 B0 01                  BCS     RF142           ;2
9EC4 C8                     INY                     ;1 => ALLOW EXTRA CHAR FOR 0 AFTER D. P.

9EC5                RF142
9EC5 B1 F3                  LDA     (INBUFF),Y
9EC7 C9 30                  CMP     #'0
9EC9 D0 26                  BNE     RF170
9ECB 88                     DEY
9ECC 10 F7                  BPL     RF142
9ECE                RF148
9ECE 98                     TYA
9ECF 18                     CLC
9ED0 65 C0                  ADC     FIXNUM
9ED2 C5 C1                  CMP     MANTLN
9ED4 B0 04                  BCS     RF150
9ED6 85 C1                  STA     MANTLN          ;MANTISSA TOO LONG => DISCARD DIGITS
9ED8 90 0F                  BCC     RF160           ;JMP
9EDA F0 0D          RF150   BEQ     RF160           ;JUST RIGHT
9EDC A4 C1                  LDY     MANTLN          ;MANTISSA TOO SHORT: PAD WITH O'S
9EDE 85 C1                  STA     MANTLN          ;NEW MANTISSA LENGTH
9EE0 A9 30                  LDA     #'0

9EE2                RFLP5
9EE2 C8                     INY
9EE3 91 F3                  STA     (INBUFF),Y
9EE5 C4 C1                  CPY     MANTLN          ;REACHED DESIRED LENGTH
9EE7 D0 F9                  BNE     RFLP5           ;NO. CONTINUE

                    ;                               LIMIT TO 8 DIGITS MAX + DP
9EE9                RF160
9EE9 A4 C1                  LDY     MANTLN
9EEB C0 09                  CPY     #9

9EED 90 02                  BCC     RF170           ;OK
9EEF A0 08                  LDY     #8
9EF1                RF170                           ;MOVE TO TOKBUF
9EF1 A2 0D                  LDX     #NUMLEN-1
9EF3 A5 BF                  LDA     SEFORM          ;E FORM?
9EF5 F0 02                  BEQ     FDLP4           ;NO.
9EF7 A2 09                  LDX     #NUMLEN-5       ;YES. ALLOW ROOM FOR EXPONENT


9EF9                FDLP4
9EF9 B1 F3                  LDA     (INBUFF),Y
9EFB 9D 00 05               STA     TOKBUF,X
9EFE CA                     DEX
9EFF 88                     DEY
9F00 10 F7                  BPL     FDLP4

                    ;                               CHECK SIGN
9F02 A5 C2                  LDA     SSIGN
9F04 10 05                  BPL     FABCD
9F06 A9 2D                  LDA     #'-             ;NEGATIVE => STORE '-'
9F08 9D 00 05               STA     TOKBUF,X
9F0B                FABCD
9F0B A9 0E                  LDA     #NUMLEN
9F0D 85 82                  STA     TOKPTR
9F0F 4C 9D 9F               JMP     FPOP0           ;POP ORIGINAL # OFF STACK


9F12                FLD0M                           ;FR0 <- MODFAC
9F12 A2 50                  LDX     #MODFAC
9F14 A0 05                  LDY     #MODFAC/256
9F16 D0 35                  BNE     CFLD02          ;JMP
9F18                FLD0S                           ;FR0 <- TOP OF STACK
9F18 20 A9 9F               JSR     FPOPLD          ;LOAD X&Y REGS WITH STACK POINTER
9F1B D0 30                  BNE     CFLD02          ;JMP

9F1D                SRECTA  ;->POLAR NEW X=R=SQRT(SQU(X)+SQU(Y)) NEW Y=THETA=ASIN(Y/R)
9F1D A9 61                  LDA     #ZRECT
9F1F 20 F0 9B               JSR     PUTMSG          ;DISPLAY "->POLAR"
9F22 20 5A A8               JSR     SSQUAR          ;X*X
9F25 20 55 9F               JSR     FST0T
9F28 20 18 9F               JSR     FLD0S
9F2B 20 5A A8               JSR     SSQUAR          ;Y*Y
9F2E 20 4F 9F               JSR     FLD1T
9F31 20 6A A9               JSR     SFADD
9F34 20 A7 B1               JSR     SSQRT           ;R = NEW X (TOS)
9F37 20 B6 DD               JSR     FMOVE
9F3A 20 55 9F               JSR     FST0T
9F3D 20 9D 9F               JSR     FPOP0           ;Y
9F40 20 3A A9               JSR     SFDIV           ;Y/R
9F43 20 05 B1               JSR     SASIN           ;THETA = NEW Y
9F46 20 BB 9F               JSR     FPUSH0



9F49                FLD0T                           ;FR0 <- FTEMP
9F49 A2 56                  LDX     #FTEMP
9F4B A0 05                  LDY     #FTEMP/256
9F4D                CFLD02
9F4D D0 51                  BNE     CFLD0R          ;JMP

9F4F                FLD1T                           ;FR1 <- FTEMP
9F4F A2 56                  LDX     #FTEMP
9F51 A0 05                  LDY     #FTEMP/256
9F53 D0 34                  BNE     CFLD1R          ;JMP

9F55                FST0T                           ;FTEMP <- FR0
9F55 A2 56                  LDX     #FTEMP
9F57 A0 05                  LDY     #FTEMP/256
9F59 4C A7 DD               JMP     FST0R

9F5C                FST1T                           ;FTEMP <- FR1
9F5C A2 56                  LDX     #FTEMP
9F5E A0 05                  LDY     #FTEMP/256
9F60                FST1R                           ;(X, Y) <- FR1
9F60 86 FC                  STX     FLPTR
9F62 84 FD                  STY     FLPTR+1
9F64 A0 05                  LDY     #5
9F66                FSLOP
9F66 B9 E0 00               LDA     FR1,Y
9F69 91 FC                  STA     (FLPTR),Y
9F6B 88                     DEY
9F6C 10 F8                  BPL     FSLOP
9F6E                PUTBRT
9F6E 60                     RTS

9F6F                PUTBLK
9F6F A6 95                  LDX     PRNFLG          ;PUT A BLANKS ON PRINTER ONLY
9F71 F0 FB                  BEQ     PUTBRT
9F73 A2 20                  LDX     #PIOCB
9F75 9D 48 03               STA     ICBLL,X
9F78 A9 28                  LDA     #BLKBUF
9F7A A0 05                  LDY     #BLKBUF/256
9F7C 4C 7C A2               JMP     PTCHS2


9F7F                SRCL
9F7F 20 D0 A3               JSR     MEMSUB          ;X <- MEM
9F82 A5 94                  LDA     RPNALG
9F84 F0 E8                  BEQ     PUTBRT
9F86                FPOP1
9F86 20 A3 9F               JSR     FPOP
9F89 4C 98 DD       CFLD1R  JMP     FLD1R           ;FR1 <- POP()

9F8C                ARCSUB                          ;FR1 <- SQRT(1-FR0*FR0) FOR ARCCOS, ARCSIN
9F8C 20 BB 9F               JSR     FPUSH0
9F8F 20 5A A8               JSR     SSQUAR
9F92 A9 01                  LDA     #1
9F94 20 75 A9               JSR     INTSUB
9F97 20 A7 B1               JSR     SSQRT
9F9A                FMVPOP
9F9A 20 B6 DD               JSR     FMOVE           ;DO FMOVE THEN FPOP0
9F9D                FPOP0
                    ;                               FR0 <- POP(FPSTK)
9F9D 20 A3 9F               JSR     FPOP
9FA0 4C 89 DD       CFLD0R  JMP     FLD0R
9FA3                FPOP

9FA3 20 A9 9F               JSR     FPOPLD          ;LOAD REGISTERS AND
9FA6 86 9B                  STX     FPPTR           ;MODIFY STACK POINTER.
9FA8 60                     RTS
9FA9                FPOPLD                          ;LOAD X & Y REGISTERS IN PREPARATION FOR POP(FPSTK)
9FA9 A5 9B                  LDA     FPPTR
9FAB 38                     SEC
9FAC E9 06                  SBC     #FPREC
9FAE B0 07                  BCS     FPOP10
9FB0 A9 68                  LDA     #NSEMSG
9FB2 20 B7 9B               JSR     ERRSUB          ;STACK UNDERFLOW
9FB5 A5 9B                  LDA     FPPTR
9FB7                FPOP10
9FB7 AA                     TAX
9FB8 A0 06                  LDY     #FPSTK/256
9FBA 60                     RTS


9FBB                FPUSH0                          ;PUSH FR0 ON FPSTK
9FBB 20 F3 9F               JSR     FPSHLD
9FBE 20 A7 DD               JSR     FST0R
9FC1                FPSH05
9FC1 A5 9B                  LDA     FPPTR
9FC3 18                     CLC
9FC4 69 06                  ADC     #FPREC
9FC6 85 9B                  STA     FPPTR
9FC8 60                     RTS

9FC9                ZVAR2                           ;COMPUTE SIGMA(SQU(A))-SQU(SIGMA(A))/N
9FC9 48                     PHA                     ;SAVE REG #
9FCA 20 B2 A3               JSR     MEMLD0          ;SIGMA
9FCD 20 5A A8               JSR     SSQUAR          ;SQU(SIGMA)

9FD0 A9 04                  LDA     #4              ;N
9FD2 20 B8 A3               JSR     MEMLD1
9FD5 20 EB 9F               JSR     FPUSH1          ;SAVE N FOR LATER
9FD8 20 3A A9               JSR     SFDIV
9FDB 20 B6 DD               JSR     FMOVE
9FDE 68                     PLA                     ;RELOAD REG #
9FDF 18                     CLC                     ;AND INCREMENT
9FE0 69 01                  ADC     #1              ;SIGMA(SQU)
9FE2 20 B2 A3               JSR     MEMLD0
9FE5 20 83 A9               JSR     SFSUB
9FE8                SXCHGY                          ;X<==>Y       FR0<==>TOS
9FE8 20 9A 9F               JSR     FMVPOP
9FEB                FPUSH1
9FEB 20 F3 9F               JSR     FPSHLD          ;PUSH FR1 ON FPSTK
9FEE 20 60 9F               JSR     FST1R
9FF1 30 CE                  BMI     FPSH05          ;JMP
9FF3                FPSHLD
9FF3 A6 9B                  LDX     FPPTR           ;LOAD REGISTERS & CHECK FOR OVERFLOW
9FF5 E0 FC                  CPX     #FPSLEN*FPREC
9FF7 90 09                  BCC     FPC10
9FF9 A9 74                  LDA     #NSFMSG
9FFB 20 B7 9B               JSR     ERRSUB          ;STACK OVERFLOW
9FFE A2 F6                  LDX     #FPSLEN-1*FPREC
A000 86 9B                  STX     FPPTR
A002                FPC10
A002 A0 06                  LDY     #FPSTK/256
A004 60                     RTS


A005                SUBCAL                          ;PERFORM OP A (ROUTINE CALLED WILL DO RTS)



A005 C9 8D                  CMP     #EQUAL+1
A007 90 03                  BCC     SBCL5
A009 4C B5 9B               JMP     KEYERR
A00C                SBCL5
A00C 0A                     ASL     A
A00D A8                     TAY
A00E A9 13                  LDA     #JMPTBL
A010 85 90                  STA     JMPTR1
A012 A9 BB                  LDA     #JMPTBL/256
A014 85 91                  STA     JMPTR1+1
A016 90 02                  BCC     MAIN10
A018 E6 91                  INC     JMPTR1+1        ;SECOND PAGE OF TABLE
A01A                MAIN10
A01A B1 90                  LDA     (JMPTR1),Y
A01C 85 92                  STA     JMPTR2
A01E C8                     INY
A01F B1 90                  LDA     (JMPTR1),Y
A021 85 93                  STA     JMPTR2+1
A023 6C 92 00               JMP     (JMPTR2)



A026                GTCHR
                    ;                               RETURN NEXT INPUT CHAR IN A REG
A026 A6 86                  LDX     TOKTIN
A028 F0 07                  BEQ     GETC05
A02A C6 86                  DEC     TOKTIN
A02C B5 83                  LDA     TOKTMP-1,X      ;USE CHARS FROM PREVIOUS CALL
A02E 4C 81 A0               JMP     GETC10          ;SAVE CHAR IN TOKBUF
A031                GETC05

A031 A2 10                  LDX     #KIOCB
A033 A9 07                  LDA     #GETCHR         ;GET FROM K:   (DATA RETURNED IN A, STATUS IN Y)
A035 9D 42 03               STA     ICCOM,X
A038 A5 82                  LDA     TOKPTR
A03A 9D 44 03               STA     ICBAL,X
A03D A5 83                  LDA     TOKPTR+1
A03F 9D 45 03               STA     ICBAH,X
A042 A9 01                  LDA     #1
A044 9D 48 03               STA     ICBLL,X
A047 A9 00                  LDA     #0
A049 9D 49 03               STA     ICBLH,X

A04C 20 56 E4               JSR     CIOV
A04F C0 01                  CPY     #SUCCES
A051 D0 36                  BNE     GETC12          ;BREAK => DELETE LINE
A053 C9 9B                  CMP     #$9B
A055 90 14                  BCC     GETC06          ;0-9A
A057 D0 04                  BNE     GNOCR
A059 A9 20                  LDA     #'              ;9B
A05B D0 3C                  BNE     GETC30          ;CR => CHANGE TO BLANK AND DON'T PRINT
A05D                GNOCR
A05D C9 FD                  CMP     #$FD            ;FD=BELL
A05F B0 2C                  BCS     GETC15          ;FD-FF
A061 C9 A0                  CMP     #$A0
A063 B0 06                  BCS     GETC06          ;A0-FD
A065 C9 9C                  CMP     #DELLIN         ;9C-9F
A067 F0 2B                  BEQ     GETC20          ;DON'T ESCAPE IF DELETE LINE (9C)
A069 D0 22                  BNE     GETC15          ;9D-9F
A06B                GETC06                          ;0-9A OR A0-FD
A06B 29 7F                  AND     #$7F            ;STRIP OFF INVERSE VIDEO, IF ANY
A06D F0 1E                  BEQ     GETC15          ;0
A06F C9 1B                  CMP     #$1B
A071 B0 04                  BCS     GETC07
A073 69 40                  ADC     #2*32           ;1-1A (CONVERT CTRL GRAPHICS TO UPPER CASE LETTER)
A075 D0 0A                  BNE     GETC10          ;JMP
A077                GETC07
A077 C9 61                  CMP     #'A+32          ;LOWER CASE ALPHA TO UPPER CASE
A079 90 06                  BCC     GETC10
A07B C9 7B                  CMP     #'Z+32+1
A07D B0 02                  BCS     GETC10
A07F E9 1F                  SBC     #32-1           ;CARRY SET

A081                GETC10
A081 C9 20                  CMP     #'
A083 F0 14                  BEQ     GETC30          ;DON'T PRINT SPACE
A085 C9 7E                  CMP     #BACKSP
A087 D0 04                  BNE     GETC15
A089                GETC12
A089 A9 9C                  LDA     #DELLIN
A08B D0 07                  BNE     GETC20          ;JMP    BACKSPACE IS EQUIV TO DELETE LINE
A08D                GETC15
A08D 48                     PHA
A08E A9 1B                  LDA     #ESC
A090 20 31 A2               JSR     PTCHR
A093 68                     PLA
A094                GETC20
A094 48                     PHA
A095 20 31 A2               JSR     PTCHR
A098 68                     PLA

A099                GETC30
A099 EA                     NOP                     ;TEMP SO NO CARTRIDGE B
A09A EA                     NOP
A09B EA                     NOP
A09C EA                     NOP
A09D EA                     NOP
A09E EA                     NOP
A09F EA                     NOP
A0A0 A0 00                  LDY     #0
A0A2 91 82                  STA     (TOKPTR),Y
A0A4 60                     RTS

A0A5                GETDHO
                    ;                               GET DEC, HEX, OR OCT DIGIT AND RETURN IN A,TOKBUF
                    ;                               RETURN CC=>NO ERROR, CS=> ERROR
A0A5 20 26 A0               JSR     GTCHR
A0A8 C9 9C                  CMP     #DELLIN
A0AA D0 05                  BNE     DHOCHK
A0AC 68                     PLA                     ;IF DELETE LINE THEN POP STACK (SKIP RETURN)
A0AD 68                     PLA
A0AE 4C 51 9A               JMP     LEX

A0B1                DHOCHK                          ;ENTRY POINT IF ALREADY HAVE CHAR
                    ;                               RETURN CC=>NO ERROR, CS=> ERROR
A0B1 C9 30                  CMP     #'0
A0B3 90 0A                  BCC     DHOERR          ;ERROR
A0B5 A6 87                  LDX     DHOFLG
A0B7 E0 08                  CPX     #8
A0B9 D0 06                  BNE     DH010
A0BB C9 38                  CMP     #'7+1           ;OCTAL
A0BD 90 12                  BCC     DHOOK           ;OK OCT 0-7
A0BF                DHOERR
A0BF 38                     SEC
A0C0 60                     RTS                     ;ERROR CARRY SET

A0C1                DH010
A0C1 C9 3A                  CMP     #'9+1
A0C3 90 0C                  BCC     DHOOK           ;OK DEC OR HEX 0-9
A0C5 E0 10                  CPX     #16
A0C7 D0 F6                  BNE     DHOERR          ;ERROR   DEC >9
A0C9 C9 41                  CMP     #'A
A0CB 90 F2                  BCC     DHOERR
A0CD C9 47                  CMP     #'F+1
A0CF B0 EE                  BCS     DHOERR
A0D1                DHOOK
A0D1 E6 82                  INC     TOKPTR          ;SAVE CHAR
A0D3 60                     RTS



A0D4                GETINT                          ;GET INTEGER FROM 0-255 FROM KEYBOARD

                    ;                               USEFUL FOR MEM REG #. FIX. BITS
                    ;                               RETURN CC=> OK. CS => NOT OK
A0D4 20 BB 9F               JSR     FPUSH0          ;SAVE FR0

A0D7 A5 87                  LDA     DHOFLG
A0D9 48                     PHA                     ;SAVE DHOFLG
A0DA A9 00                  LDA     #0              ;FORCE DECIMAL MODE
A0DC 85 87                  STA     DHOFLG
A0DE 20 51 9A               JSR     LEX
A0E1 A5 81                  LDA     TOKCOD
A0E3 C9 8E                  CMP     #NUMBER
A0E5 F0 08                  BEQ     GI05



A0E7 68                     PLA
A0E8 85 87                  STA     DHOFLG
A0EA 20 9D 9F               JSR     FPOP0           ;RELOAD FR0

A0ED 38                     SEC
A0EE 60                     RTS


A0EF                GI05
A0EF 68                     PLA
A0F0 85 87                  STA     DHOFLG          ;RESTORE


A0F2                GINT2                           ;ENTRY PT. IF ALREADY HAVE FR0 (MUST HAVE FR0 ON STACK)
A0F2 20 D2 D9               JSR     FPI
A0F5 B0 05                  BCS     GI20
A0F7 A5 D5                  LDA     FR0+1
A0F9 F0 01                  BEQ     GI20
A0FB 38                     SEC                     ;ERROR

A0FC                GI20
A0FC 08                     PHP
A0FD A5 D4                  LDA     FR0
A0FF 48                     PHA
A100 20 9D 9F               JSR     FPOP0           ;RELOAD FR0
A103 68                     PLA                     ;OLD FR0 = INTEGER 0-255
A104 28                     PLP                     ;CC OR CS
A105 60                     RTS

A106                GETPRI                          ;INPUT: A=TOKEN CODE.  OUTPUT: A=PRIORITY
A106 4A                     LSR     A
A107 AA                     TAX
A108 BD 64 BF               LDA     PRIOTB,X
A10B B0 04                  BCS     GPR10
A10D 4A                     LSR     A
A10E 4A                     LSR     A
A10F 4A                     LSR     A
A110 4A                     LSR     A
A111                GPR10
A111 29 0F                  AND     #$F
A113 A6 94                  LDX     RPNALG
A115 E0 02                  CPX     #ALGNOP
A117 D0 0A                  BNE     GPR20

A119 C9 0D                  CMP     #PHIGH
A11B B0 06                  BCS     GPR20
A11D C9 06                  CMP     #POR+1
A11F 90 02                  BCC     GPR20
A121 A9 05                  LDA     #POR
A123                GPR20
A123 60                     RTS

A124                LDCHR

                    ;                               RETURN A=PACKED CHAR
A124 20 4C A1               JSR     LDNIB
A127 D0 1E                  BNE     LDCH10
A129 20 4C A1               JSR     LDNIB
A12C C6 8A                  DEC     KEYLN2          ;1 EXTRA BYTE
A12E C9 0F                  CMP     #15             ;SPECIAL 4-NIBBLE CHAR?
A130 D0 13                  BNE     LDCH05          ;NO. 2 NIBBLE CHAR
A132 20 4C A1               JSR     LDNIB           ;YES. LOAD 2 NIBBLES OF ASCII
A135 0A                     ASL     A
A136 0A                     ASL     A
A137 0A                     ASL     A
A138 0A                     ASL     A
A139 85 C4                  STA     LDCSAV
A13B 20 4C A1               JSR     LDNIB
A13E 05 C4                  ORA     LDCSAV          ;COMBINE 2 NIBBLES
A140 C6 8A                  DEC     KEYLN2          ;2 MORE EXTRA BYTES
A142 C6 8A                  DEC     KEYLN2
A144 60                     RTS                     ;RETURN
A145                LDCH05
                    ;       CLC                     ;2 NIBBLE CHAR
A145 69 10                  ADC     #16
A147                LDCH10
A147 AA                     TAX
A148 BD 26 BC               LDA     TABLE-1,X
A14B 60                     RTS

A14C                LDNIB
                    ;                               LOAD PACKED NIBBLE FROM PKPTR+Y. LFRT
A14C A5 80                  LDA     LFRT
A14E 49 01                  EOR     #1
A150 85 80                  STA     LFRT
A152 F0 08                  BEQ     LDN20
A154 C8                     INY                     ;LEFT NIBBLE
A155 B1 8C                  LDA     (PKPTR),Y
A157 4A                     LSR     A
A158 4A                     LSR     A
A159 4A                     LSR     A
A15A 4A                     LSR     A
A15B 60                     RTS
A15C                LDN20
A15C B1 8C                  LDA     (PKPTR),Y       ;RIGHT NIBBLE
A15E 29 0F                  AND     #$F
A160 60                     RTS




A161                NCHKLD                                  ;IF TOKEN IS NUMBER THEN LOAD NUMBER INTO FR0 FROM PRGMEM
                    ;                               RETURN EQ => NUMBER. NE => NOT #, CS => ERROR

A161 A0 00                  LDY     #0
A163 B1 B9                  LDA     (PC),Y
A165 85 81                  STA     TOKCOD
A167 C9 8E                  CMP     #NUMBER
A169 D0 18                  BNE     NCK30
A16B A0 07                  LDY     #FPREC+1
A16D B1 B9                  LDA     (PC),Y
A16F C9 8E                  CMP     #NUMBER         ;NUMBER AT OTHER END?
A171 F0 03                  BEQ     NCK10           ;YES
A173 4C 7E A3               JMP     UKERR           ;CR ON DISPLAY & PRINTER, KEYERR
A176                NCK10
A176 20 55 9F               JSR     FST0T
A179 20 85 A1               JSR     PCNCHK          ;SEE IF ROOM LEFT IN PRGMEM FOR #
A17C B0 06                  BCS     NCK40
A17E 20 89 DD               JSR     FLD0R
A181 A9 00                  LDA     #0              ;EQ

A183                NCK30
A183 18                     CLC
A184                NCK40
A184 60                     RTS

A185                PCNCHK                          ;CHECK PC TO SEE IF ROOM IN PRGMEM FOR #
                    ;                                       RETURN CC => OK. CS=> NOT OK

A185 A6 B9                  LDX     PC
A187 A4 BA                  LDY     PC+1
A189 C4 D2                  CPY     PC1MAX
A18B 90 07                  BCC     PCN10
A18D E0 F9                  CPX     #-FPREC-1
A18F 90 03                  BCC     PCN10
A191                PCN05
A191 4C 60 9C               JMP     EPERR
A194                PCN10
A194 E8                     INX
A195 D0 01                  BNE     PCN20
A197 C8                     INY
A198                PCN20
A198 60                     RTS


A199                PCINC                           ;PC <- PC+1
A199 A9 01                  LDA     #1
A19B D0 02                  BNE     PCADD           ;JMP
A19D                PCADDN
A19D A9 08                  LDA     #FPREC+2        ;PC <- PC+FPREC+2
A19F                PCADD
A19F 18                     CLC
A1A0 65 B9                  ADC     PC
A1A2 90 09                  BCC     PCADD1
A1A4 A6 BA                  LDX     PC+1            ;INC MSB
A1A6 E8                     INX
A1A7 E4 D3                  CPX     PC1MX1          ;END OF MEM?
A1A9 B0 E6                  BCS     PCN05           ;YES. DON'T CHANGE PC
A1AB 86 BA                  STX     PC+1            ;NO. STORE NEW PC
A1AD                PCADD1
A1AD 85 B9                  STA     PC              ;STORE LSB
A1AF 60                     RTS                     ;RETURN CARRY CLEAR => NO ERROR

A1B0                PCLR0                           ;CLEAR FR0
                    ;                               RETURN WITH CARRY CLEAR (CC)
A1B0 A9 00                  LDA     #0
A1B2 F0 05                  BEQ     PSET0           ;JMP

A1B4                LDINT                           ;MOVE FR0 TO FR1. THEN SET FR0 TO A
                    ;                               RETURN WITH CARRY CLEAR (CC)
A1B4 48                     PHA
A1B5 20 B6 DD               JSR     FMOVE           ;FR1 <- FR0
A1B8 68                     PLA

A1B9                PSET0                           ;SET FR0 TO INTEGER PASSED IN A
                    ;                               RETURN WITH CARRY CLEAR (CC)
A1B9 85 D4                  STA     FR0
A1BB A9 00                  LDA     #0
A1BD 85 D5                  STA     FR0+1
A1BF 20 AA D9               JSR     IFP             ;INTEGER A TO FP A
A1C2 18                     CLC
A1C3 60                     RTS


A1C4                POPOP                           ;POP A OFF OPSTK

A1C4 A4 9C                  LDY     OPPTR
A1C6 D0 09                  BNE     POP10
A1C8 A9 7F                  LDA     #OSEMSG
A1CA 20 B7 9B               JSR     ERRSUB          ;STACK UNDERFLOW
A1CD A4 9C                  LDY     OPPTR
A1CF B0 03                  BCS     POP20           ;JMP
A1D1                POP10
A1D1 88                     DEY
A1D2 84 9C                  STY     OPPTR
A1D4                POP20
A1D4 B1 CC                  LDA     (OPSADR),Y
A1D6 60                     RTS

A1D7                PUSHOP                          ;PUSH A ON OPSTK

A1D7 A4 9C                  LDY     OPPTR
A1D9 91 CC                  STA     (OPSADR),Y
A1DB C8                     INY
A1DC D0 07                  BNE     PSH10
A1DE A9 88                  LDA     #OSFMSG
A1E0 20 B7 9B               JSR     ERRSUB          ;STACK OVERFLOW
A1E3 B0 02                  BCS     DSPRT2          ;JMP TO RTS
A1E5                PSH10
A1E5 84 9C                  STY     OPPTR
A1E7 60             DSPRT2  RTS

A1E8                DSOME                           ;SUBROUTINE TO DISPLAY STACK. MEM. & X
A1E8 20 92 A7               JSR     DSPSTK
A1EB 20 CC A5               JSR     DMEMAL
A1EE                FDSCOM
A1EE A5 BD                  LDA     DSPFLG
A1F0 D0 F5                  BNE     DSPRT2          ;RETURN IF NO DISPLAY
A1F2 20 57 9D               JSR     FDSP0           ;DISPLAY FR0 FOLLOWED BY "***"
                    ;DAYCOM                         ;ENTRY PT
A1F5 C6 A2                  DEC     NUMFLG          ;<- 0
A1F7 A9 15                  LDA     #COLCMD-1
A1F9 85 55                  STA     COLCRS
A1FB A9 16                  LDA     #ROWCMD
A1FD 85 54                  STA     ROWCRS
A1FF A2 04                  LDX     #4              ;# OF CHARS
A201 A9 F0                  LDA     #STARMS
A203 A0 BA                  LDY     #STARMS/256
A205                PTTXTP
A205 20 AB A2               JSR     PTCHSP
A208                PTCRPD
A208 20 9D A2               JSR     PUTCRP
A20B                PUTCR
A20B A9 9B                  LDA     #CR
A20D A6 54                  LDX     ROWCRS
A20F E0 17                  CPX     #23
A211 D0 1E                  BNE     PTCHR           ;IF NOT ON BOTTOM LINE THEN DO NORMAL CR
                    ;                               ;OTHERWISE. DO SCROLLING & RETURN TO BOTTOM LINE
A213 A9 10                  LDA     #ROWSCR
A215 A6 BB                  LDX     PROG
A217 E0 01                  CPX     #STOPRG
A219 D0 02                  BNE     PUTCR2
A21B A9 02                  LDA     #2              ;SCROLL 22 LINES IF STORE PROGRAM MODE
A21D                PUTCR2
A21D 85 54                  STA     ROWCRS
A21F 20 2B A2               JSR     PTDEL2
A222 A9 17                  LDA     #23
A224 85 54                  STA     ROWCRS
A226 60                     RTS



A227                PUTDEL                          ;DELETE BOTTOM LINE ON SCREEN
                    ;                               RETURN COLCRS = LMARG = 1

A227 A9 17                  LDA     #23
A229 85 54                  STA     ROWCRS
A22B                PTDEL2                          ;DELETE CURRENT LINE
A22B A9 01                  LDA     #LMARG
A22D 85 55                  STA     COLCRS
A22F A9 9C                  LDA     #DELLIN
A231                PTCHR
                    ;                               PUT ONE CHAR (IN A) ON SCREEN

A231 A2 00                  LDX     #SIOCB
A233                PTCHR2
A233 A8                     TAY
A234 A5 BD                  LDA     DSPFLG
A236 D0 4B                  BNE     PTABC
A238 A9 0B                  LDA     #PUTCHR
A23A 9D 42 03               STA     ICCOM,X
A23D A9 00                  LDA     #0
A23F 9D 48 03               STA     ICBLL,X
A242 9D 49 03               STA     ICBLH,X
A245 98                     TYA
A246 4C 56 E4               JMP     CIOV


A249                PTLIN1                          ;PUT UP ONE LINE OF SCREEN DISPLAY (FOR INIT)
A249 86 9E                  STX     T0
A24B BD F4 BA               LDA     CHRTAB,X
A24E 20 31 A2               JSR     PTCHR
A251 20 68 A2               JSR     CTLR16
A254 A6 9E                  LDX     T0
A256 BD F5 BA               LDA     CHRTAB+1,X
A259 20 31 A2               JSR     PTCHR
A25C A2 13                  LDX     #19
A25E 20 6A A2               JSR     CTLR
A261 A6 9E                  LDX     T0
A263 BD F6 BA               LDA     CHRTAB+2,X
A266 D0 C9                  BNE     PTCHR

A268                CTLR16                          ;PUT 16 CTRL R'S ON SCREEN (HORIZ. LINES)
A268 A2 10                  LDX     #16
A26A                CTLR                            ;PUT X CTRL R'S ON SCREEN
A26A A9 3C                  LDA     #CTLRS
A26C D0 04                  BNE     PUTCTL          ;JMP


A26E                BLNK15                          ;PUT 15 BLANKS ON SCREEN
A26E A2 0F                  LDX     #15
A270                BLNKS                           ;PUT X BLANKS ON SCREEN
A270 A9 28                  LDA     #BLKBUF
A272                PUTCTL
A272 A0 05                  LDY     #BLKBUF/256

A274                PUTCHS
                    ;                               A=ICBAL,  Y=ICBAH, X=# OF CHARS
A274 48                     PHA
A275 8A                     TXA
A276 A2 00                  LDX     #SIOCB
A278 9D 48 03               STA     ICBLL,X
A27B 68                     PLA
A27C                PTCHS2
A27C 9D 44 03               STA     ICBAL,X
A27F A5 BD                  LDA     DSPFLG
A281 F0 03                  BEQ     PTABD
A283 A0 01          PTABC   LDY     #SUCCES         ;DON'T PRINT => ALWAYS SUCCESSFUL
A285 60             RETN2   RTS
A286                PTABD
A286 98                     TYA
A287 9D 45 03               STA     ICBAH,X
A28A A9 00                  LDA     #0
A28C 9D 49 03               STA     ICBLH,X
A28F A9 0B                  LDA     #PUTCHR
A291 9D 42 03               STA     ICCOM,X

A294 4C 56 E4               JMP     CIOV

A297                PTCRPN                          ;IF PREVIOUS TOKEN WAS NUMBER THEN PUT CR ON PRINTER
A297 A5 A2                  LDA     NUMFLG
A299 F0 EA                  BEQ     RETN2
A29B C6 A2                  DEC     NUMFLG          ;<- 0

A29D                PUTCRP                          ;PUT CR ON PRINTER IF PRINTER IS ON

A29D A6 95                  LDX     PRNFLG
A29F F0 E4                  BEQ     RETN2
A2A1 A9 9B                  LDA     #CR
A2A3 A2 20                  LDX     #PIOCB
A2A5 20 33 A2               JSR     PTCHR2
A2A8 4C CC A2               JMP     PRNCHK          ;CHECK TO SEE IF PRINTER STILL THERE

A2AB                PTCHSP                          ;PUT CHARS ON SCREEN AND PRINTER (IF OPEN)
                    ;                               A=ICBAL, Y=ICBAH, X=# OF CHARS

A2AB 8D 62 05               STA     ASAVE
A2AE 8E 63 05               STX     XSAVE
A2B1 8C 64 05               STY     YSAVE
A2B4 20 74 A2               JSR     PUTCHS
A2B7 A6 95                  LDX     PRNFLG
A2B9 F0 CA                  BEQ     RETN2
A2BB A2 20                  LDX     #PIOCB
A2BD AD 63 05               LDA     XSAVE
A2C0 9D 48 03               STA     ICBLL,X
A2C3 AD 62 05               LDA     ASAVE
A2C6 AC 64 05               LDY     YSAVE
A2C9 20 7C A2               JSR     PTCHS2
A2CC                PRNCHK

A2CC C0 01                  CPY     #SUCCES         ;SUCCESSFUL PRINTING?
A2CE F0 B5                  BEQ     RETN2           ;YES.
A2D0 C0 80                  CPY     #$80            ;BREAK KEY ABORT?
A2D2 F0 B1                  BEQ     RETN2           ;YES. OK - WILL BE HANDLED LATER
A2D4 4C 44 A7               JMP     OFFERR          ;NO. CLOSE PRINTER &DISPLAY ERROR MSG

A2D7                SAVCHR                          ;MOVE CHAR FROM TOKBUF TO TOKTMP
A2D7 A0 00                  LDY     #0
A2D9 B1 82                  LDA     (TOKPTR),Y
A2DB A6 86                  LDX     TOKTIN
A2DD 95 84                  STA     TOKTMP,X
A2DF E6 86                  INC     TOKTIN
A2E1 60                     RTS


A2E2                UNPINT                          ;UNPACK KEYWORD - INITIALIZATION
A2E2 A9 0A                  LDA     #KEYWRD-1       ;GET REST OF WORD
A2E4 85 8C                  STA     PKPTR
A2E6 A9 BE                  LDA     #KEYWRD/256
A2E8 85 8D                  STA     PKPTR+1
A2EA A9 00                  LDA     #0
A2EC 85 80                  STA     LFRT
A2EE 85 8E                  STA     KYLFRT
A2F0 85 8F                  STA     KEYCNT
A2F2 60                     RTS

A2F3                UNPNUM                          ;UNPACK KEYWORD - MIDDLE OF LOOP - FETCH & STORE LENGTH
A2F3 A0 00                  LDY     #0              ;SET UP Y REG FOR LDNIB
A2F5 84 88                  STY     KEYCHR
A2F7 20 4C A1               JSR     LDNIB

A2FA 85 89                  STA     KEYLEN
A2FC 85 8A                  STA     KEYLN2
A2FE 60                     RTS

A2FF                UNPNXT                          ;UNPACK KEYWORD - GOTO NEXT WORD (END OF LOOP)
A2FF E6 8F                  INC     KEYCNT
A301 E6 89                  INC     KEYLEN
A303 A5 89                  LDA     KEYLEN
A305 4A                     LSR     A
A306 AA                     TAX
A307 A5 8E                  LDA     KYLFRT
A309 90 07                  BCC     KEY50
A30B 49 01                  EOR     #1
A30D F0 01                  BEQ     KEY40
A30F E8                     INX
A310                KEY40
A310 85 8E                  STA     KYLFRT
A312                KEY50
A312 85 80                  STA     LFRT
A314 8A                     TXA
A315 18                     CLC
A316 65 8C                  ADC     PKPTR
A318 90 02                  BCC     KEY60
A31A E6 8D                  INC     PKPTR+1
A31C                KEY60
A31C 85 8C                  STA     PKPTR
A31E 60                     RTS

A31F                UNPCK2
A31F 48                     PHA
A320 4C 2E A3               JMP     UNP10
A323                UNPACK
                    ;                               UNPACK WORD INTO TOKBUF,X FROM (PKPTR),LFRT
                    ;                               RETURNS LENGTH OF WORD IN Y

A323 86 82                  STX     TOKPTR
A325 A0 00                  LDY     #0
A327 98                     TYA
A328 48                     PHA
A329 20 4C A1               JSR     LDNIB
A32C 85 8A                  STA     KEYLN2
A32E                UNP10
A32E 20 24 A1               JSR     LDCHR
A331 84 8B                  STY     LDNBSV

A333 AA                     TAX
A334 68                     PLA
A335 A8                     TAY
A336 8A                     TXA
A337 91 82                  STA     (TOKPTR),Y
A339 C8                     INY
A33A 98                     TYA
A33B 48                     PHA
A33C A4 8B                  LDY     LDNBSV
A33E C6 8A                  DEC     KEYLN2
A340 D0 EC                  BNE     UNP10
A342 68                     PLA
A343 A8                     TAY
A344 85 82                  STA     TOKPTR          ;# OF CHARS
A346 60                     RTS

A347                UNPKEY                                  ;UNPACK KEYWORD GIVEN TOKEN CODE IN TOKCOD
                    ;                                               ;OUTPUT: CHARS IN TOKBUF, Y=TOKPTR, CS IF ERROR
A347 A5 81                  LDA     TOKCOD
A349 C9 86                  CMP     #STAR
A34B 90 0F                  BCC     UNKY10
A34D C9 8D                  CMP     #EQUAL+1                ;OUT OF RANGE?
A34F B0 2D                  BCS     UKERR           ;YES.
A351 AA                     TAX                     ;NO. RPFOTAI CHAR
A352 BD 46 BA               LDA     TOKCHR-STAR,X
A355 8D 00 05               STA     TOKBUF
A358 A0 01                  LDY     #1
A35A D0 0E                  BNE     UNKRTN          ;JMP
A35C                UNKY10
A35C 20 E2 A2               JSR     UNPINT          ;INITIALIZE
A35F                UNPLP
A35F A5 8F                  LDA     KEYCNT

A361 C5 81                  CMP     TOKCOD
A363 D0 0E                  BNE     UNKY20
A365 A2 00                  LDX     #TOKBUF
A367 20 23 A3               JSR     UNPACK
A36A                UNKRTN
A36A 84 82                  STY     TOKPTR
A36C A9 9B                  LDA     #CR
A36E 99 00 05               STA     TOKBUF,Y
A371 18                     CLC                     ;NO ERROR
A372 60                     RTS

A373                UNKY20                          ;CONTINUE WITH NEXT WORD
A373 20 F3 A2               JSR     UNPNUM
A376 F0 06                  BEQ     UKERR           ;END OF LIST => ERROR (SHOULDN'T HAPPEN)
A378 20 FF A2               JSR     UNPNXT
A37B 4C 5F A3               JMP     UNPLP
A37E                UKERR
A37E 20 08 A2               JSR     PTCRPD          ;PUT CR ON SCREEN AND PRINTER
A381 4C B5 9B               JMP     KEYERR

A384                GETMN                           ;FETCH & STORE MEMNUM
                    ;                               CARRY SET => ERROR, CLEAR => NO ERROR
A384 A9 2C                  LDA     #MEMMSG         ;DISPLAY "ENTER MEMORY REGISTER 0-99"
A386 20 F0 9B               JSR     PUTMSG
A389 20 D4 A0               JSR     GETINT
A38C D0 07                  BNE     BITERR          ;ERROR
A38E C9 64                  CMP     #MEMLEN
A390 B0 03                  BCS     BITERR          ;ERROR
A392 85 A3                  STA     MEMNUM          ;OK  0 -> MEMLEN-1
A394 60                     RTS
A395                BITERR
A395 A9 91                  LDA     #BITMSG
A397 4C B7 9B               JMP     ERRSUB          ;DISPLAY ERROR MESSAGE (WILL RETURN WITH CS => ERROR)

A39A A9 05          LDFV    LDA     #5              ;FR0<-FV
A39C D0 14                  BNE     MEMLD0
A39E A9 06          LDI     LDA     #6              ;FR0<-I
A3A0 D0 10                  BNE     MEMLD0
A3A2 20 4E A9       Z1ILDN  JSR     Z1PLI           ;CALL Z1PLI TO COMPUTE (1+T) AND LOAD N
A3A5 20 BB 9F               JSR     FPUSH0
A3A8 A9 07          LDN     LDA     #7              ;FR0<-N
A3AA D0 06                  BNE     MEMLD0
A3AC A9 08          LDPMT   LDA     #8              ;FR0<-PMT
A3AE D0 02                  BNE     MEMLD0
A3B0 A9 09          LDPV    LDA     #9              ;FR0<-PV


A3B2                MEMLD0                          ;FR0 <- MEM(A)
A3B2 20 BE A3               JSR     MEMLD2
A3B5 4C 89 DD               JMP     FLD0R
A3B8                MEMLD1                          ;FR1 <- MEM(A)
A3B8 20 BE A3               JSR     MEMLD2
A3BB 4C 98 DD               JMP     FLD1R
A3BE                MEMLD2
A3BE 85 A3                  STA     MEMNUM          ;SET UP X & Y REGS TO LOAD OR STORE MEM(A)
A3C0                MEMLDR                          ;SET UP X & Y REGS TO LOAD OR STORE MEM(MEMNUM)
A3C0 A4 CF                  LDY     MEMADR+1
A3C2 A5 A3                  LDA     MEMNUM          ;MEMNUM <- MEMNUM*6    (FPREC=6)
A3C4 0A                     ASL     A
A3C5 65 A3                  ADC     MEMNUM          ;(CARRY IS CLEAR)
A3C7 90 01                  BCC     MLD10
A3C9 C8                     INY
A3CA                MLD10
A3CA 0A                     ASL     A
A3CB 90 01                  BCC     MLD20
A3CD C8                     INY
A3CE                MLD20
A3CE AA                     TAX
A3CF 60                     RTS


A3D0                MEMSUB                          ;SET UP FDR DIV, PRD, SUB, SUM, XCHM, SRCL
                    ;                               CARRY SET => ERROR, CLEAR => NO ERROR
A3D0 20 84 A3               JSR     GETMN           ;GET MEMNUM
A3D3 90 03                  BCC     MS10
A3D5 68                     PLA                     ;ERROR => RETURN 2 LEVELS UP
A3D6 68                     PLA
A3D7 60                     RTS
A3D8                MS10


A3D8 20 BB 9F               JSR     FPUSH0          ;SAVE X ON STACK
A3DB 20 B6 DD               JSR     FMOVE           ;FR1 <- X
A3DE 20 C0 A3               JSR     MEMLDR          ;SET UP X & Y REGS
A3E1 20 89 DD               JSR     FLD0R           ;FR0 <- MEM(MEMNUM)
A3E4 18                     CLC                     ;INDICATE NO ERROR
A3E5 60                     RTS
A3E6                MEMMUL                          ;FR0 <- FR0*MEM(A)
A3E6 85 A3                  STA     MEMNUM
A3E8 20 C0 A3               JSR     MEMLDR
A3EB 20 98 DD               JSR     FLD1R
A3EE 4C 97 A8               JMP     SFMUL

A3F1                PIOVL                           ;LOAD X & Y REGS IN PREPARATION FOR LOADING REG 0 OR 1 WITH PI/2, 90 OR 100(IF GRAD)
A3F1 A9 24                  LDA     #RADPI2
A3F3 18                     CLC
A3F4 65 FB                  ADC     RADFLG
A3F6 AA                     TAX
A3F7 A0 BA                  LDY     #RADPI2/256
A3F9 60                     RTS

A3FA                SCMP2                           ;TAKE COMPLEMENT OF BINARY
A3FA A2 03                  LDX     #3
A3FC                SCLP2
A3FC B5 B0                  LDA     BINARY,X
A3FE 49 FF                  EOR     #$FF
A400 95 B0                  STA     BINARY,X
A402 CA                     DEX
A403 10 F7                  BPL     SCLP2
A405 60                     RTS

A406                S2CMP                           ;TAKE COMPLEMENT OF BINARY AND ADD 1
A406 20 FA A3               JSR     SCMP2
A409 E6 B3                  INC     BINARY+3
A40B D0 0A                  BNE     STCRTN
A40D E6 B2                  INC     BINARY+2
A40F D0 06                  BNE     STCRTN
A411 E6 B1                  INC     BINARY+1
A413 D0 02                  BNE     STCRTN
A415 E6 B0                  INC     BINARY+0
A417                STCRTN
A417 60                     RTS

A418                SLSHF2                          ;SHIFT BINARY LEFT A PLACES
                    ;                               RETURN WITH ORIGINAL PROCESSOR STATUS
A418 08                     PHP                     ;ROTATING IN CARRY
A419 AA                     TAX
A41A F0 0D                  BEQ     SRTN
A41C                SLS05
A41C 28                     PLP
A41D 08                     PHP
A41E 26 B3                  ROL     BINARY+3
A420 26 B2                  ROL     BINARY+2
A422 26 B1                  ROL     BINARY+1
A424 26 B0                  ROL     BINARY+0
A426 CA                     DEX
A427 D0 F3                  BNE     SLS05
A429                SRTN
A429 28                     PLP
A42A 60             SNUM50  RTS

A42B                SNUMB
                    ;                               NUMBER PROCESSING: CONVERT ASCII IN TOKBUF TO FP IN FR0
A42B A5 87                  LDA     DHOFLG
A42D F0 5E                  BEQ     SNUM40          ;DECIMAL

A42F A9 FF                  LDA     #-1
A431 85 82                  STA     TOKPTR
A433 20 B0 A1               JSR     PCLR0           ;HEX BINARY OR OCT => CONVERT TO F.P.
A436                SNUM20
A436 E6 82                  INC     TOKPTR

A438 A0 00                  LDY     #0
A43A B1 82                  LDA     (TOKPTR),Y
A43C C9 9B                  CMP     #CR
A43E D0 37                  BNE     SNUM25          ;CONTINUE

A440 20 BB 9F               JSR     FPUSH0          ;SAVE FP #
A443 20 2E 9D               JSR     FPBNCK          ;CONVERT FP TO BINARY (4 BYTES) & CHECK WHETHER IT'S WITHIN RANGE
A446 20 9D 9F               JSR     FPOP0           ;RESTORE FP #

                    ;               IS # > BITBIN (2^(BITINT-1)-1) AND <= BITBN2 (2^BITINT)-1?
                    ;                               IF SO, THEN NUMBER WAS MEANT AS NEGATIVE, E. G. $FFFF

A449 A2 00                  LDX     #0
A44B                BBLP1
A44B B5 B0                  LDA     BINARY,X
A44D D5 A4                  CMP     BITBIN,X
A44F 90 D9                  BCC     SNUM50          ;< BITBIN => RETURN
A451 D0 07                  BNE     BB10            ;> BITBIN => OK
A453 E8                     INX
A454 E0 04                  CPX     #4
A456 D0 F3                  BNE     BBLP1           ;CONTINUE
A458 F0 D0                  BEQ     SNUM50          ;= BITBIN => RETURN
A45A                BB10
A45A A2 00                  LDX     #0
A45C                BBLP2
A45C B5 B0                  LDA     BINARY,X
A45E D5 A8                  CMP     BITBN2,X
A460 90 07                  BCC     BB30            ;< BITBN2 => OK
A462 D0 C6                  BNE     SNUM50          ;> BITBN2 => RETURN
A464 E8                     INX
A465 E0 04                  CPX     #4
A467 D0 F3                  BNE     BBLP2
                    ;                               ;= BITBN2 => OK
A469                BB30
A469 A2 03                  LDX     #3              ;OK => INPUT WAS REALLY MEANT AS NEG. #
A46B                BBLP3
A46B B5 B0                  LDA     BINARY,X        ;OR WITH BINMIN= -(2^(BITNIT-1)) TO EXTEND SIGN BIT
A46D 15 AC                  ORA     BINMIN,X
A46F 95 B0                  STA     BINARY,X
A471 CA                     DEX
A472 10 F7                  BPL     BBLP3
                    ;                               A=MSB WHICH SHOULD BE NEG.
A474 4C 27 A8               JMP     BINFP2          ;CONVERT TO NEW FLOATING # (SHOULD BE NEG.) AND RETURN

A477                SNUM25
A477 48                     PHA
A478 A5 87                  LDA     DHOFLG
A47A 20 84 A8               JSR     INTMUL
A47D 68                     PLA
A47E 38                     SEC
A47F E9 30                  SBC     #'0             ;'0-'9 -> 0-9
A481 C9 11                  CMP     #'A-'0
A483 90 02                  BCC     SNUM30
A485 E9 07                  SBC     #'A-'0-10       ;A-F -> 10-15
A487                SNUM30
A487 20 53 A9               JSR     INTADD
A48A 4C 36 A4               JMP     SNUM20
A48D                SNUM40
A48D 20 22 9C               JSR     TKINT2          ;A <- #TOKBUF, Y <- #TOKBUF/256
A490 85 F3                  STA     INBUFF
A492 84 F4                  STY     INBUFF+1
A494 A9 00                  LDA     #0
A496 85 F2                  STA     CIX
A498 4C 00 D8               JMP     AFP

                    ;                       ROUTINES CORRESPONDING TO KEYWORDS

A49B                RETURN
A49B 60                     RTS
A49C                SACOS                           ;ARCCOS(FR0) = ARCTAN(SGRT(1-FR0*FR0)/FR0)
A49C A5 D4                  LDA     FR0
A49E D0 06                  BNE     SAC30
                    ;                               ARCCOS(0) = 90 DEG = PI/2 RAD. SPECIAL CASE BECAUSE TAN UNDEFINED
A4A0                SAC10
A4A0 20 F1 A3               JSR     PIOVL           ;LOAD X & Y REGS TO GET PI/2, 90 OR 100
A4A3 4C 89 DD               JMP     FLD0R

A4A6                SAC30
A4A6 48                     PHA
A4A7 20 8C 9F               JSR     ARCSUB          ;FR1 <- SQRT(1-FR0*FR0)
A4AA A5 E0                  LDA     FR1
A4AC D0 1D                  BNE     SAC34
A4AE 68                     PLA                     ;ABSVAL(FR0) = 1
A4AF 30 03                  BMI     S180PI
A4B1 4C B0 A1               JMP     PCLR0           ;FR0=+1 . ARCCOS(+1) = 0
A4B4                S180PI                          ;FR0 <- 180 OR 200 OR PI, DEPENDING ON RADFLG


A4B4 A6 FB                  LDX     RADFLG
A4B6 F0 0C                  BEQ     SPI10           ;FR0<-PI
A4B8 A9 B4                  LDA     #180            ;DEG => 180
                    ;       CPX     #GRADON
                    ;       BNE     SAC32
                    ;       LDA     #200            ;GRAD => 200
                    ;SAC32
A4BA 4C B9 A1               JMP     PSET0
A4BD                SPI                             ;X <- PI
A4BD A5 94                  LDA     RPNALG
A4BF D0 03                  BNE     SPI10
A4C1 20 BB 9F               JSR     FPUSH0          ;PUSH OLD X IF RPN
A4C4                SPI10
A4C4 A2 00                  LDX     #PICONST
A4C6 A0 BA                  LDY     #PICONST/256
A4C8 4C 89 DD               JMP     FLD0R

A4CB                SAC34
A4CB 20 3A A9               JSR     SFDIV
A4CE 20 24 A9               JSR     SRECIP
A4D1 20 1B B1               JSR     SATAN
A4D4 68                     PLA
A4D5 10 C4                  BPL     RETURN
A4D7 20 B6 DD               JSR     FMOVE           ;COS <0 => ADD 180 DEG OR 200 GRAD GR PI TO ARCCOS
A4DA 20 B4 A4               JSR     S180PI
A4DD 4C 6A A9               JMP     SFADD

A4E0                SBITS                           ;SET OCTAL, HEX WORD LENGTH TO 1-32 BITS
                    ;                               BINARY TO 1-16 BITS
A4E0 A9 20                  LDA     #BTSMSG         ;DISPLAY "ENTER 1-32"
A4E2 20 F0 9B               JSR     PUTMSG
A4E5 20 D4 A0               JSR     GETINT          ;GET INTEGER
A4E8 B0 07                  BCS     SBERR           ;NOT GOOD - ERROR ALREADY REPORTED
A4EA AA                     TAX
A4EB F0 04                  BEQ     SBERR           ;TOO SMALL
A4ED C9 21                  CMP     #32+1
A4EF 90 03                  BCC     SBITS2          ;TOO LARGE?
A4F1                SBERR
A4F1 4C 95 A3               JMP     BITERR
A4F4                SBITS2
A4F4 85 9D                  STA     BITINT

A4F6 AA                     TAX
A4F7 CA                     DEX
A4F8 8A                     TXA
A4F9 A2 00                  LDX     #0
A4FB 86 B3                  STX     BINARY+3
A4FD 86 B2                  STX     BINARY+2
A4FF 86 B1                  STX     BINARY+1
A501 86 B0                  STX     BINARY+0        ;SET BINARY TO 0
A503 38                     SEC
A504 20 18 A4               JSR     SLSHF2          ;SHIFT LEFT BITINT BITS WITH CARRY
A507 A2 03                  LDX     #3
A509                SBLP1
A509 B5 B0                  LDA     BINARY,X
A50B 95 A4                  STA     BITBIN,X
A50D CA                     DEX
A50E 10 F9                  BPL     SBLP1
A510 20 FA A3               JSR     SCMP2           ;TAKE COMP
A513 A2 03                  LDX     #3

A515                SBLP2
A515 B5 B0                  LDA     BINARY,X
A517 95 AC                  STA     BINMIN,X
A519 CA                     DEX
A51A 10 F9                  BPL     SBLP2

A51C 20 FA A3               JSR     SCMP2
A51F A9 01                  LDA     #1
A521 38                     SEC
A522 20 18 A4               JSR     SLSHF2          ;(2^BITINT )-1
A525 A2 03                  LDX     #3
A527                SBLP3
A527 B5 B0                  LDA     BINARY,X
A529 95 A8                  STA     BITBN2,X
A52B CA                     DEX
A52C 10 F9                  BPL     SBLP3

A52E A2 B0                  LDX     #'0+$80         ;CONVERT INT 0-99 TO CHAR 00-99 (INVERSE VIDEO)
A530 8E 00 05               STX     TOKBUF
A533 A5 9D                  LDA     BITINT
A535                DSTLP
A535 C9 0A                  CMP     #10
A537 90 07                  BCC     DST10
A539 E9 0A                  SBC     #10             ;(CARRY SET)
A53B EE 00 05               INC     TOKBUF
A53E D0 F5                  BNE     DSTLP           ;JMP
A540                DST10
A540 69 B0                  ADC     #'0+$80         ;(CARRY CLEAR) (INVERSE VIDEO)
A542 8D 01 05               STA     TOKBUF+1        ;LSDIGIT
A545 A2 02                  LDX     #2              ;2 CHARS
A547 A9 13                  LDA     #DBITS


A549                DSPST
A549 85 55                  STA     COLCRS
A54B                DSPST2
A54B A9 01                  LDA     #ROWSTT
A54D 85 54                  STA     ROWCRS
A54F 20 78 A5               JSR     DSPCLR          ;CLEAR DSPFLG Y<-0 A<-OLD DSPFLG
A552 48                     PHA                     ;& SAVE OLD DSPFLG => ALWAYS DISPLAY
A553 98                     TYA                     ;0 = LSB OF ADDR
A554 A0 05                  LDY     #TOKBUF/256
A556 20 74 A2               JSR     PUTCHS
A559                DSPLOD                          ;LOAD OLD DSPFLG RESTORE
A559 68                     PLA
A55A 85 BD                  STA     DSPFLG          ;RESTORE OLD DSPFLG
A55C 60                     RTS


A55D                SFIX
A55D A9 16                  LDA     #FIXMSG         ;DISPLAY "ENTER 0-8"
A55F 20 F0 9B               JSR     PUTMSG
A562 20 D4 A0               JSR     GETINT          ;GET NEXT TOKEN: WANT INTEGER 0-8
A565 B0 8A                  BCS     SBERR           ;ERROR
A567 C9 09                  CMP     #8+1
A569 B0 86                  BCS     SBERR           ;ERROR - TOO LARGE
A56B                SFIX2                           ;ENTRY PT IF A=VALID INTEGER
A56B 85 C0                  STA     FIXNUM
A56D 69 B0                  ADC     #'0+$80         ;-> ASCII (INVERSE VIDEO)
A56F 8D 00 05               STA     TOKBUF
A572 A9 19                  LDA     #DFIX           ;DISPLAY IN STATUS AREA OF SCREEN
A574 A2 01                  LDX     #1              ;# OF CHARS
A576 D0 D1                  BNE     DSPST           ;JMP TO DISPLAY STATUS

A578                DSPCLR                          ;CLEAR DSPFLG & LOAD OLD DSPFLG INTO A
                    ;                               A <- OLD DSPFLG   X UNCHANGED   Y <- 0
A578 A5 BD                  LDA     DSPFLG
A57A A0 00                  LDY     #0
A57C 84 BD                  STY     DSPFLG
A57E 60                     RTS

A57F                SCOMPL                          ;X <- COMPLEMENT(X) = -(X+1)
A57F 20 51 A9               JSR     ONEADD          ;X<-X+1

A582                SCHGSG
A582 A5 D4                  LDA     FR0             ;FR0<- -FR0
A584 F0 04                  BEQ     SCH10
A586 49 80                  EOR     #$80
A588 85 D4                  STA     FR0
A58A                SCH10
A58A 60                     RTS


A58B                SCLINI
A58B A2 21                  LDX     #ENTER          ;GOTO ENTER MODE AND CHANGE STATUS LINE
A58D 86 81                  STX     TOKCOD
A58F 20 0B AE               JSR     SENTER

A592 A9 9F                  LDA     #INTCHR-3       ;CLEAR MEM4-9 FOR INTEREST CALCS & DISPLAY TITLES
A594 A0 18                  LDY     #FPREC*4
A596 D0 04                  BNE     CLST10          ;JMP


A598                SCLSTA                          ;CLEAR MEM 3-9 FOR STATISTICS & DISPLAY TITLES
A598 A9 B4                  LDA     #STACHR-3
A59A A0 12                  LDY     #FPREC*3
A59C                CLST10
A59C 85 9F                  STA     T1
A59E A9 00                  LDA     #0              ;CLEAR MEM
A5A0                CLSLP1
A5A0 91 CE                  STA     (MEMADR),Y
A5A2 C8                     INY
A5A3 C0 3C                  CPY     #FPREC*10
A5A5 90 F9                  BCC     CLSLP1
A5A7 A9 08                  LDA     #ROWREG+3       ;START WITH MEM 3
A5A9 85 54                  STA     ROWCRS
A5AB A9 06                  LDA     #6
A5AD 85 9E                  STA     T0
A5AF                CLSTLP
A5AF A9 14                  LDA     #20             ;DISPLAY TITLES IN COL 20
A5B1 85 55                  STA     COLCRS
A5B3 A5 9F                  LDA     T1
A5B5 18                     CLC
A5B6 69 03                  ADC     #3
A5B8 85 9F                  STA     T1
A5BA A0 BA                  LDY     #INTCHR/256
A5BC A2 03                  LDX     #3
A5BE 20 74 A2               JSR     PUTCHS          ;DISPLAY CHARS ON SCREEN ONLY
A5C1 E6 54                  INC     ROWCRS          ;GOTO NEXT LINE ON SCREEN
A5C3 C6 9E                  DEC     T0
A5C5 10 E8                  BPL     CLSTLP          ;CONTINUE
A5C7 30 03                  BMI     DMEMAL          ; DONE.  JMP TO DISPLAY NEWLY ZEROED MEM


A5C9                SCLMEM                          ;CLEAR MEMORY
A5C9 20 03 AA               JSR     MEMCLR


A5CC                DMEMAL                          ;DISPLAY ALL OF MEM (0-9)
A5CC A5 BD                  LDA     DSPFLG
A5CE D0 BA                  BNE     SCH10           ;RETURN IF NO DISPLAY
A5D0 20 BB 9F               JSR     FPUSH0          ;SAVE X

A5D3 A9 00                  LDA     #0
A5D5 20 B2 A3       DMELP   JSR     MEMLD0          ;FR0<-MEM(MEMNUM)  (USING MEMNUM)
A5D8 20 86 9D               JSR     TOKNUM          ;TOKBUF<-ASCII(FR0)
A5DB 20 72 A8               JSR     DSPMEM          ;DISPLAY IN MEM AREA OF SCREEN
A5DE A6 A3                  LDX     MEMNUM
A5E0 E8                     INX
A5E1 8A                     TXA
A5E2 C9 0A                  CMP     #10
A5E4 90 EF                  BCC     DMELP           ;CONTINUE
A5E6 4C 9D 9F               JMP     FPOP0           ;DONE - RELOAD X

A1B0                SCLX    =       PCLR0

A5E9                SFACTO                          ;X! = X(X-1)(X-2)...
A5E9 20 BB 9F               JSR     FPUSH0          ;GINT2 WILL POP
A5EC 20 F2 A0               JSR     GINT2           ;A= INTEGER 0-255
A5EF B0 21                  BCS     SFERR           ;ERROR
A5F1 C9 45                  CMP     #69
A5F3 B0 1D                  BCS     SFERR           ;ERROR - TOO LARGE
A5F5 AA                     TAX
A5F6 D0 02                  BNE     SF10
A5F8 A9 01                  LDA     #1

A5FA                SF10
A5FA 48                     PHA
A5FB 20 B9 A1               JSR     PSET0           ;FACT <- N
A5FE                SFLP
A5FE 20 B6 DD               JSR     FMOVE
A601 68                     PLA
A602 C9 03                  CMP     #3
A604 90 0F                  BCC     SFDON

A606 E9 01                  SBC     #1              ;X <- X-1
A608 48                     PHA
A609 20 B9 A1               JSR     PSET0           ;INT -> FP
A60C 20 DB DA               JSR     FMUL            ;FACT <- FACT * X
A60F 90 ED                  BCC     SFLP
A611 68                     PLA                     ;CARRY SET => MULTIPLY ERROR (SHOULDN'T HAPPEN)
A612                SFERR
A612 4C 86 A9               JMP     CRYCHK          ;FR0 <- 0   "ARITHMETIC OVERFLOW"


A615                SFDON
A615                SPOW60
A615 60                     RTS

A616                SROOT
A616 20 24 A9               JSR     SRECIP          ;Y ROOT X = Y POWER 1/X

A619                SPOWER                          ;Y^X = EXP10(X* LOG10(Y))
A619 20 86 9F               JSR     FPOP1
A61C A5 E0                  LDA     FR1
A61E 30 06                  BMI     SPOW25          ;Y < 0 => ERROR  STOP
A620 D0 0A                  BNE     SPOW40
A622 A5 D4                  LDA     FR0             ;Y = 0
A624 10 03                  BPL     SPOW30
A626 4C 88 A9       SPOW25  JMP     CRYSND          ;X<0 => ERROR     CLEAR FR0
A629                SPOW30
A629 4C B0 A1               JMP     PCLR0
A62C                SPOW40
A62C 20 5C 9F               JSR     FST1T

A62F A5 D4                  LDA     FR0             ;SAVE SIGN OF X
A631 48                     PHA
A632 29 7F                  AND     #$7F
A634 85 D4                  STA     FR0             ;X <- |X|

A636 20 BB 9F               JSR     FPUSH0
A639 A9 01                  LDA     #1
A63B 85 A1                  STA     INTFLG
A63D 20 7A A9               JSR     SFRACT          ;TAKE FRACTIONAL PART   IF =0 THEN X IS AN INTEGER
A640 A5 D4                  LDA     FR0
A642 D0 0C                  BNE     SPOW50
A644 20 49 9F               JSR     FLD0T           ;X IS INTEGER
A647 20 7A A9               JSR     SFRACT          ;TAKE FRACTIONAL PART
A64A A5 D4                  LDA     FR0
A64C D0 02                  BNE     SPOW50
A64E C6 A1                  DEC     INTFLG          ;Y IS INTEGER
A650                SPOW50
A650 20 49 9F               JSR     FLD0T           ;Y
A653 20 BE A6               JSR     SLOGTE
A656 20 94 A8               JSR     SPMUL           ;X * LOGTEN(Y)
A659 20 07 98               JSR     SEXPTE
A65C A5 A1                  LDA     INTFLG          ;BOTH X & Y INTEGER?
A65E D0 17                  BNE     SPOW80          ;NO
A660                SROUND                  ;ROUND(X) = SIGN(X)*TRUNC(ABS(X)+.5)
A660 A2 6C                  LDX     #FHALF
A662 A0 DF                  LDY     #FHALF/256
A664 20 98 DD               JSR     FLD1R
A667 A5 D4                  LDA     FR0
A669 10 06                  BPL     SROU10
A66B 20 83 A9               JSR     SFSUB           ;NEG => SUBTRACT .5
A66E 4C 74 A6               JMP     SPOW70
A671                SROU10

A671 20 6A A9               JSR     SFADD
A674                SPOW70
A674 20 7D A6               JSR     STRUNC          ;TRUNCATE FR0
A677                SPOW80
A677 68                     PLA                     ;LOAD SIGN OF X
A678 10 9B                  BPL     SPOW60          ;POSITIVE => RETURN
A67A 4C 24 A9               JMP     SRECIP          ;NEGATIVE => 1/X


A67D                STRUNC
A67D 20 95 A6               JSR     XINT            ;PERFORM INT FUNCTION (ALMOST)
A680                XINT4
A680 4C 00 DC               JMP     NORM            ;NORMALIZE  (TRUNCATE)

A683                SINTEG                          ;FR0 <- INT(FR0)
A683 20 95 A6               JSR     XINT            ;INTEGER SUBROUTINE
A686 A6 D4                  LDX     FR0
A688 10 F6                  BPL     XINT4
A68A AA                     TAX
A68B F0 F3                  BEQ     XINT4


A68D                SUBONE                          ;FR0 <- FR0-1
A68D A9 01                  LDA     #1


A68F                SUBINT                          ;FR0 <- FR0 - A
A68F 20 75 A9               JSR     INTSUB
A692 4C 82 A5               JMP     SCHGSG


                    ;               INT ROUTINE FROM SHEP ATARI BASIC B0D5-B0EE
A695                XINT
A695 A5 D4                  LDA     FR0             ;GET EXPONENT
A697 29 7F                  AND     #$7F            ;AND OUT SIGN BIT
A699 38                     SEC
A69A E9 3F                  SBC     #$3F            ;GET LOCATION OF 1ST FRACTION BYTE
A69C 10 02                  BPL     XINT1           ;IF >= 0 THEN BRANCH
A69E A9 00                  LDA     #0              ;ELSE SET =0
A6A0                XINT1
A6A0 AA                     TAX                     ;PUT IN X AS INDEX INTO FROM
A6A1 A9 00                  LDA     #0              ;SET ACCUM TO ZERO FOR 0RING
A6A3 A8                     TAY                     ;ZERO Y
A6A4                INT2
A6A4 E0 05                  CPX     #FPREC-1        ;IS D. P. LOC >= 5?
A6A6 B0 07                  BCS     INTRTN          ;IF YES, LOOP DONE
A6A8 15 D5                  ORA     FR0+1,X         ;OR IN THE BYTE OF MANTISSA
A6AA 94 D5                  STY     FR0+1,X         ;ZERO BYTE
A6AC E8                     INX                     ;POINT TO NEXT BYTE
A6AD D0 F5                  BNE     INT2            ;JMP
A6AF                INTRTN
A6AF 60                     RTS


A6B0                ZLN1I                           ;LN(1+I)
A6B0 20 4E A9               JSR     Z1PLI


A6B3                SLN                             ;FR0 <- LN(FR0)
A6B3 20 C9 A6               JSR     LOGCHK          ;CHECK FOR 0,1 (SPECIAL CASES)
A6B6 B0 03                  BCS     GOCRY
A6B8 20 CD DE               JSR     LOG
A6BB                GOCRY
A6BB 4C 86 A9               JMP     CRYCHK


A6BE                SLOGTE                          ;FR0 <- LOG10(FR0)
A6BE 20 C9 A6               JSR     LOGCHK
A6C1 B0 F8                  BCS     GOCRY
A6C3 20 D1 DE               JSR     LOG10
A6C6 4C 86 A9               JMP     CRYCHK


A6C9                LOGCHK                          ;CHECK FOR 0,1
A6C9 38                     SEC
A6CA A5 D4                  LDA     FR0
A6CC F0 E1                  BEQ     INTRTN          ;LN(0),LOG(0) => ERROR
A6CE A2 05                  LDX     #FPREC-1
A6D0                LOGCLP
A6D0 B5 D4                  LDA     FR0,X
A6D2 DD 42 BA               CMP     ONE,X
A6D5 18                     CLC
A6D6 D0 D7                  BNE     INTRTN           ;NOT 1 => OK
A6D8 CA                     DEX
A6D9 10 F5                  BPL     LOGCLP
A6DB 68                     PLA                     ;SKIP LOGCHK RETURN
A6DC 68                     PLA
A6DD 4C B0 A1               JMP     PCLR0           ;LN(1)=LOGTEN(1)=0


A6E0                INTMOD                          ;FR0 <- FR0 MOD A  (ALSO MODFAC <- INT(Y/X))

A6E0 48                     PHA
A6E1 20 BB 9F               JSR     FPUSH0
A6E4 68                     PLA
A6E5 20 B9 A1               JSR     PSET0
A6E8                SMOD                            ;Y MOD X = Y - X*INT(Y/X)
A6E8 20 B6 DD               JSR     FMOVE
A6EB 20 18 9F               JSR     FLD0S
A6EE 20 EB 9F               JSR     FPUSH1
A6F1 20 3A A9               JSR     SFDIV           ;Y/X
A6F4 20 83 A6               JSR     SINTEG          ;INT(Y/X)
A6F7 A2 50                  LDX     #MODFAC
A6F9 A0 05                  LDY     #MODFAC/256
A6FB 20 A7 DD               JSR     FST0R           ;SAVE INT(Y/X) IN MODFAC
A6FE 20 94 A8               JSR     SPMUL           ;INT(Y/X)*X
A701 4C 80 A9               JMP     SPSUB           ;Y - INT(Y/X)*X


A704 A9 00          SDEC    LDA     #0              ;DECIMAL MODE
A706 F0 06                  BEQ     SOCT10          ;JMP
A708 A9 10          SHEX    LDA     #16             ;HEXADECIMAL (BASE 16)
A70A D0 02                  BNE     SOCT10          ;JMP
A70C                SOCT                            ;SET OCTAL MODE
A70C A9 08                  LDA     #8

A70E                SOCT10
A70E 85 87                  STA     DHOFLG
A710 A9 0B                  LDA     #DDEC
A712 20 5D A7               JSR     CHSTAT          ;CHANGE STATUS LINE ON SCREEN
A715 4C CC A5               JMP     DMEMAL          ;DISPLAY MEMORY IN NEW BASE


A718                SADV                            ;PUT CR ON PRINTER
A718 A6 95                  LDX     PRNFLG          ;PRINTER ON ALREADY?
A71A F0 0A                  BEQ     SADV20
                    ;                               OUTPUT CR & RETURN
A71C                SADV10
A71C 20 78 A5               JSR     DSPCLR          ;CLEAR DSPFLG
A71F 48                     PHA
A720 20 9D A2               JSR     PUTCRP
A723 4C 59 A5               JMP     DSPLOD          ;RESTORE DSPFLG
A726                SADV20
A726 20 37 A7               JSR     SON             ;NO. TURN ON
A729 B0 27                  BCS     POPRTN          ;ERROR -> RETURN
A72B 20 1C A7               JSR     SADV10          ;OUTPUT CR
A72E                SOFF                            ;CLOSE PRINTER
A72E A2 00                  LDX     #0
A730 86 95                  STX     PRNFLG          ;ALWAYS OFF
A732 A2 20                  LDX     #PIOCB
A734 4C F2 AC               JMP     XCLOSE          ;CLOSE X AND CALL CIO
A737                SON                             ;OPEN PRINTER FOR OUTPUT
A737 A6 95                  LDX     PRNFLG
A739 D0 16                  BNE     POPN20          ;ALREADY OPEN
A73B A2 20                  LDX     #PIOCB
A73D A0 04                  LDY     #4
A73F 20 F6 AC               JSR     CIOINT          ;SET UP IOCB AND CALL CIO & CHECK SUCCESS
A742 F0 09                  BEQ     POPN10          ;SUCCESSFUL
A744                OFFERR                          ;NOT SUCCESSFUL
A744 98                     TYA
A745 48                     PHA                     ;SAVE ERROR #
A746 20 2E A7               JSR     SOFF
A749 68                     PLA                     ;RELOAD ERROR #
A74A 4C AA AC               JMP     IOERR2          ;DISPLAY "ERROR - " I/O ERROR #
A74D                POPN10
A74D A2 01                  LDX     #1
A74F 86 95                  STX     PRNFLG
A751                POPN20
A751 18                     CLC                     ;NO ERROR
A752 60             POPRTN  RTS
9F9D                SPOP    =       FPOP0           ;POP # OFF STACK
9FBB                SPUSH   =       FPUSH0          ;PUSH # ON STACK
A753 A9 06          SDEG    LDA     #6
A755 D0 02                  BNE     SRAD10
A757                SRAD                            ;SET RAD MODE
A757 A9 00                  LDA     #0              ;RADON
A759                SRAD10
A759 85 FB                  STA     RADFLG
A75B A9 07                  LDA     #DDEG           ;CHANGE STATUS LINE ON SCREEN


A75D                CHSTAT                          ;CHANGE STATUS BY DISPLAYING KEYWORD AT A ON STATUS LINE
A75D 85 55                  STA     COLCRS
A75F 20 47 A3               JSR     UNPKEY
A762 20 27 9C               JSR     INVID           ;INVERSE VIDEO
A765 A6 82                  LDX     TOKPTR
A767 E0 05                  CPX     #5
A769 B0 06                  BCS     CHS30           ;IF >= 5 CHARS THEN NO BLANK
A76B A9 20                  LDA     #'              ;ADD ONE BLANK TO CLEAR LONGER WORDS
A76D 9D 00 05               STA     TOKBUF,X
A770 E8                     INX
A771                CHS30
A771 4C 4B A5               JMP     DSPST2          ;DISPLAY TOKBUF (X CHARS) ON ROWSTT LINE



A774                SCLR
A774 20 B0 A1               JSR     PCLR0           ;CLEAR X, STACK
A777 90 11                  BCC     SCLSTK          ;JMP
A779                SALG
A779 A9 01                  LDA     #ALGP
A77B D0 06                  BNE     SRPN10          ;JMP
A77D                SALGN
A77D A9 02                  LDA     #ALGNOP
A77F D0 02                  BNE     SRPN10          ;JMP
A781                SRPN
A781 A9 00                  LDA     #0              ;RPN
A783                SRPN10
A783 85 94                  STA     RPNALG
A785 A9 02                  LDA     #DALG           ;CHANGE STATUS LINE ON SCREEN
A787 20 5D A7               JSR     CHSTAT

A78A                SCLSTK
A78A A9 01                  LDA     #1              ;CLEAR STACKS (LPAD ONLY)
A78C 85 9C                  STA     OPPTR
A78E A9 00                  LDA     #0              ;X ONLY, NOTHING ON STACK
A790 85 9B                  STA     FPPTR
A792                DSPSTK
A792 A5 BD                  LDA     DSPFLG
A794 D0 BC                  BNE     POPRTN          ;DON'T DISPLAY - RETURN
A796 20 BB 9F               JSR     FPUSH0          ;DISPLAY STACK    SAVE X ON STACK
A799 A9 05                  LDA     #ROWREG
A79B 85 54                  STA     ROWCRS
A79D A5 9B                  LDA     FPPTR
A79F 38                     SEC
A7A0 E9 06                  SBC     #FPREC
A7A2                STKD10
A7A2 85 9E                  STA     T0
A7A4 AA                     TAX
A7A5 A0 06                  LDY     #FPSTK/256
A7A7 20 89 DD               JSR     FLD0R
A7AA A9 04                  LDA     #4              ;DISPLAY IN COLUMN 4
A7AC 20 7B 9D               JSR     FDSP1

A7AF E6 54                  INC     ROWCRS
A7B1 A5 54                  LDA     ROWCRS
A7B3 C9 0F                  CMP     #ROWSCR-1
A7B5 B0 1D                  BCS     STKD45          ;STACK AT LEAST 10 DEEP
A7B7 A5 9E                  LDA     T0
A7B9 38                     SEC
A7BA E9 06                  SBC     #FPREC
A7BC B0 E4                  BCS     STKD10          ;CONTINUE
A7BE A5 54                  LDA     ROWCRS
A7C0 48                     PHA
A7C1                STKD30
A7C1 A5 54                  LDA     ROWCRS          ;CLEAR ALL ROWS UP TO PREVIOUS STACK MAX
A7C3 CD 65 05               CMP     PRVSTK
A7C6 B0 0B                  BCS     STKD40
A7C8 A9 03                  LDA     #3
A7CA 85 55                  STA     COLCRS
A7CC 20 6E A2               JSR     BLNK15
A7CF E6 54                  INC     ROWCRS
A7D1 D0 EE                  BNE     STKD30          ;JMP
A7D3                STKD40
A7D3 68                     PLA
A7D4                STKD45
A7D4 8D 65 05               STA     PRVSTK
A7D7 4C 9D 9F               JMP     FPOP0


A7DA A9 00          SLSHF   LDA     #0              ;Y LSHF X
A7DC F0 02                  BEQ     SHFSUB          ;JMP
A7DE                SRSHF                           ;Y RSHF X
A7DE A9 01                  LDA     #1
A7E0                SHFSUB                          ;Y SHF X (RIGHT OR LEFT)
A7E0 85 9E                  STA     T0              ;1=>RIGHT. 0=> LEFT
A7E2 A5 D4                  LDA     FR0
A7E4 10 0A                  BPL     SHF05
A7E6 29 7F                  AND     #$7F
A7E8 85 D4                  STA     FR0
A7EA A5 9E                  LDA     T0
A7EC 49 01                  EOR     #1
A7EE 85 9E                  STA     T0
A7F0                SHF05
A7F0 20 D2 D9               JSR     FPI             ;FP -> INT
A7F3 08                     PHP
A7F4 20 9A 9F               JSR     FMVPOP          ;FR1 <- FR0 (X), POP Y
A7F7 28                     PLP                     ;RELOAD CARRY FROM FPI
A7F8 B0 0A                  BCS     SHF10           ;ERROR => RETURN 0 (VERY LARGE SHIFT)
A7FA A5 E1                  LDA     FR1+1
A7FC D0 06                  BNE     SHF10           ;SHIFT > 256 => RETURN 0 (LARGE SHIFT)
A7FE A5 E0                  LDA     FR1             ;LOAD LSB OF SHIFT
A800 C5 9D                  CMP     BITINT          ;SHIFT > MAX # OF BITS ALLOWED IN #?
A802 90 03                  BCC     SHF15           ;NO. CONTINUE
A804                SHF10
A804 4C B0 A1               JMP     PCLR0           ;YES. SAVE TIME BY NOT DOING SHIFT - CLEAR & RETURN
A807                SHF15
A807 48                     PHA                     ;SAVE
A808 20 E6 9C               JSR     FPBIN
A80B 68                     PLA
A80C AA                     TAX
A80D A4 9E                  LDY     T0
A80F D0 06                  BNE     SHF20           ;RIGHT
A811 18                     CLC                     ;LEFT
A812 20 18 A4               JSR     SLSHF2          ;SHIFT LEFT A BITS WITH CARRY: RETURN ORIGINAL PROCESSOR STATUS
A815 90 0B                  BCC     BINFP           ;JMP

A817                SHF20
A817 46 B0                  LSR     BINARY+0        ;RIGHT
A819 66 B1                  ROR     BINARY+1
A81B 66 B2                  ROR     BINARY+2
A81D 66 B3                  ROR     BINARY+3
A81F CA                     DEX
A820 D0 F5                  BNE     SHF20
A822                BINFP                           ;4 BYTE BINARY TO FP
A822 20 FC 9C               JSR     BINCHK          ;CHECK IF BINARY <= BITINT BITS. IF NOT THEN BINARY <- 0
A825 A5 B0                  LDA     BINARY
A827                BINFP2
A827 85 A0                  STA     NEGFLG
A829 10 03                  BPL     BIN10
A82B 20 06 A4               JSR     S2CMP           ;TAKE ABSOLUTE VALUE
A82E                BIN10
A82E A5 B0                  LDA     BINARY          ;65536*IFP(BINARY+1,BINARY)+IFP(BINARY+3,BINARY+2)
A830 85 D5                  STA     FR0+1
A832 A5 B1                  LDA     BINARY+1
A834 85 D4                  STA     FR0
A836 20 AA D9               JSR     IFP
A839 A2 30                  LDX     #C65536
A83B 20 C3 AD               JSR     LDY1ML          ;FR0 <- FR0*65536
A83E 20 BB 9F               JSR     FPUSH0
A841 A5 B2                  LDA     BINARY+2
A843 85 D5                  STA     FR0+1
A845 A5 B3                  LDA     BINARY+3
A847 85 D4                  STA     FR0
A849 20 AA D9               JSR     IFP
A84C 20 67 A9               JSR     SPADD
A84F A5 A0                  LDA     NEGFLG
A851 10 06                  BPL     BIN20
A853 A5 D4                  LDA     FR0             ;NEGATIVE #
A855 09 80                  ORA     #$80
A857 85 D4                  STA     FR0
A859                BIN20
A859                SHF30
A859 60                     RTS
A85A                SSQUAR
A85A 20 B6 DD               JSR     FMOVE           ;X SQUARED = X*X
A85D 4C 97 A8               JMP     SFMUL
A860                SSTO
A860 20 84 A3               JSR     GETMN           ;MEM <- X
A863 B0 F4                  BCS     SHF30           ;ERROR => RETURN
A865                SST010
A865 20 C0 A3               JSR     MEMLDR
A868 20 A7 DD               JSR     FST0R
A86B A5 BD                  LDA     DSPFLG          ;DISPLAY INHIBIT?
A86D D0 EA                  BNE     SHF30           ;YES.  NO DISPLAY AT ALL
A86F 20 EE A1               JSR     FDSCOM          ;YES. NO DISPLAY, JUST CONVERT FP TO ASCII
A872                DSPMEM
A872 A5 A3                  LDA     MEMNUM          ;DISPLAY MEMNUM ON SCREEN (ASCII ALREADY IN TOKBUF)
A874 20 9D A8               JSR     DSPM3
A877 B0 2D                  BCS     DM10            ;MEM >= 10 SO DON'T DISPLAY
A879 A5 BD                  LDA     DSPFLG
A87B D0 29                  BNE     DM10            ;RETURN IF NO DISPLAY
A87D A9 18                  LDA     #24             ;COLUMN # FOR MEM DISPLAY
A87F 85 55                  STA     COLCRS
A881 4C 80 9D               JMP     FDSP2           ;MEM < 10 SO DISPLAY

A884                INTMUL                          ;FR0 <- A*FR0
A884 20 B4 A1               JSR     LDINT           ;FR1 <- FR0, FR0<-A
A887 90 0E                  BCC     SFMUL           ;JMP
A889                ZMUL1I                          ;IF ANNUITY DUE THEN FR0<-FR0*(1+I)
A889 A5 C5                  LDA     DUEFLG

A88B 6A                     ROR     A
A88C B0 18                  BCS     ZMRTN
A88E 20 BB 9F               JSR     FPUSH0
A891 20 4E A9               JSR     Z1PLI
A894                SPMUL
A894 20 9A 9F               JSR     FMVPOP          ;FR1 <- FR0 ; POP Y OFF STACK INTO FR0
A897                SFMUL                           ;X <- Y*X   FR0 <- FR0 * FR1
A897 20 DB DA               JSR     FMUL
A89A 4C 86 A9               JMP     CRYCHK


A89D                DSPM3                           ;SET UP TO DISPLAY MEM REG A
A89D C9 0A                  CMP     #10
A89F B0 05                  BCS     DM10            ;ONLY DISPLAY 0-9
A8A1 18                     CLC                     ;ROW = MEMNUM+4
A8A2 69 05                  ADC     #ROWREG
A8A4 85 54                  STA     ROWCRS
A8A6                SXRTN
A8A6                ZMRTN
A8A6                DM10
A8A6 60                     RTS


A8A7                SSUM
A8A7 20 D0 A3               JSR     MEMSUB          ;MEM <- MEM+X
A8AA 20 6A A9               JSR     SFADD
A8AD 20 65 A8               JSR     SST010
A8B0 4C 9D 9F               JMP     FPOP0           ;RELOAD X VALUE
A8B3                SXCHM
A8B3 20 D0 A3               JSR     MEMSUB          ;X <==> MEM    (MEMSUB PUSHES FR0)
A8B6 20 C0 A3               JSR     MEMLDR          ;MEM <- X
A8B9 20 60 9F               JSR     FST1R
A8BC 20 E8 9F               JSR     SXCHGY          ;EXCHANGE NEW X FOR OLD ON STACK
A8BF 20 86 9D               JSR     TOKNUM
A8C2 20 72 A8               JSR     DSPMEM          ;DISPLAY IN MEM AREA IN DSPFLG CLEAR
A8C5 4C 9D 9F               JMP     FPOP0
A8C8                SAND                            ;X AND Y
A8C8 A9 00                  LDA     #0
A8CA F0 06                  BEQ     DOLOP           ;JMP
A8CC A9 01          SOR     LDA     #1              ;Y OR X
A8CE D0 02                  BNE     DOLOP           ;JMP
A8D0                SXOR                            ;X <- Y XOR X
A8D0 A9 02                  LDA     #2
A8D2                DOLOP                           ;X <- Y LOP X     0=>AND; 1=>OR, 2=>XOR
A8D2 85 9E                  STA     T0
A8D4 20 E6 9C               JSR     FPBIN
A8D7 A2 03                  LDX     #3
A8D9                LOPLP1
A8D9 B5 B0                  LDA     BINARY,X
A8DB 95 B4                  STA     BIN2,X
A8DD CA                     DEX
A8DE 10 F9                  BPL     LOPLP1
A8E0 20 9D 9F               JSR     FPOP0
A8E3 20 E6 9C               JSR     FPBIN
A8E6 A4 9E                  LDY     T0
A8E8 A2 03                  LDX     #3
A8EA                LOPLP2
A8EA B5 B0                  LDA     BINARY,X
A8EC C0 00                  CPY     #0
A8EE D0 05                  BNE     LOP10
A8F0 35 B4                  AND     BIN2,X
A8F2 4C 00 A9               JMP     LOP30
A8F5                LOP10
A8F5 C0 01                  CPY     #1
A8F7 D0 05                  BNE     LOP20
A8F9 15 B4                  ORA     BIN2,X
A8FB 4C 00 A9               JMP     LOP30
A8FE                LOP20
A8FE 55 B4                  EOR     BIN2,X
A900                LOP30
A900 95 B0                  STA     BINARY,X
A902 CA                     DEX
A903 10 E5                  BPL     LOPLP2
A905 4C 22 A8               JMP     BINFP
A908                SPRINT
                    ;                               PRINT X REG
A908 A5 95                  LDA     PRNFLG          ;PRINTER ON?
A90A D0 0B                  BNE     SXR10           ;YES.
A90C 20 37 A7               JSR     SON             ;NO. TURN ON
A90F B0 95                  BCS     SXRTN           ;ERROR
A911 20 17 A9               JSR     SXR10           ;DISPLAY & PRINT
A914 4C 2E A7               JMP     SOFF            ;TURN OFF & RETURN
A917                SXR10
                    ;                               DISPLAY & PRINT &RETURN
A917 20 78 A5               JSR     DSPCLR          ;CLEAR DSPFLG
A91A 48                     PHA                     ;AND SAVE OLD VALUE.
A91B 20 57 9D               JSR     FDSP0           ;PRINT NUMBER
A91E 4C 59 A5               JMP     DSPLOD          ;RESTORE DSPFLG


A921                Z1IMN                           ;(1+I)^-N = 1/((1+I)^N)
A921 20 DB AD               JSR     Z1IN
A924                SRECIP
A924 A9 01                  LDA     #1
A926 20 B4 A1               JSR     LDINT           ;COMPUTE A/FR0
A929 90 0F                  BCC     SFDIV           ;JMP

A92B                STAN                            ;TAN(X) = SIN(X)/COS(X)
A92B 20 BB 9F               JSR     FPUSH0
A92E 20 6A B0               JSR     SSIN
A931 20 E8 9F               JSR     SXCHGY
A934 20 76 B2               JSR     SCOS
A937                SPDIV
A937 20 9A 9F               JSR     FMVPOP
A93A                SFDIV                           ;X <- Y/X
A93A 20 28 DB               JSR     FDIV
A93D 4C 86 A9               JMP     CRYCHK
A940                SC
A940 A9 5A                  LDA     #CELMSG         ;DISPLAY "-> FAHRENHEIT"
A942 20 F0 9B               JSR     PUTMSG
A945 A2 3C                  LDX     #C1PT8          ;CELSIUS -> FAHRENHEIT F=(9/5)*C+32
A947 20 C3 AD               JSR     LDY1ML          ;FR0 <- FR0*1.8
A94A A9 20                  LDA     #32
A94C D0 05                  BNE     INTADD          ;JMP
A94E                Z1PLI                           ;COMPUTE (1+1)
A94E 20 9E A3               JSR     LDI
A951                ONEADD
A951 A9 01                  LDA     #1              ;FR0 <- FR0+1

A953                INTADD
A953 20 B4 A1               JSR     LDINT           ;COMPUTE A+FR0
A956 90 12                  BCC     SFADD           ;JMP


A958                SY                              ;Y <- M*X + B
A958 20 BB 9F               JSR     FPUSH0          ;SAVE X
A95B 20 3A B0               JSR     SSLOPE          ;M
A95E 20 94 A8               JSR     SPMUL
A961 20 BB 9F               JSR     FPUSH0
A964 20 1C B0               JSR     SYINTE          ;B = Y-INTERCEPT
A967                SPADD
A967 20 9A 9F               JSR     FMVPOP
A96A                SFADD                           ;X <- Y+X
A96A 20 66 DA               JSR     FADD
A96D 4C 86 A9               JMP     CRYCHK
A970                Z11IMN                          ;1-(1+I)^-N
A970 20 21 A9               JSR     Z1IMN
A973 A9 01          ONESUB  LDA     #1              ;FR0 <- 1-FR0
A975                INTSUB
A975 20 B4 A1               JSR     LDINT           ;COMPUTE A-FR0
A978 90 09                  BCC     SFSUB           ;JMP
A97A                SFRACT                          ;FR0 <- FRACTIONAL PART OF FR0
A97A 20 BB 9F               JSR     FPUSH0
A97D 20 7D A6               JSR     STRUNC          ;FR0-TRUNC(FR0)
A980                SPSUB
A980 20 9A 9F               JSR     FMVPOP
A983                SFSUB                           ;X <- Y-X
A983 20 60 DA               JSR     FSUB
A986                CRYCHK                          ;IF CARRY SET THEN "ARITHMETIC OVERFLOW" ERROR

A986 90 43                  BCC     SBST50          ;RETURN IF CARRY CLEAR
A988                CRYSND
A988 20 B0 A1               JSR     PCLR0           ;CLEAR X
A98B A9 A9                  LDA     #CRYMSG         ;CARRY SET => ERROR
A98D 4C B7 9B               JMP     ERRSUB

                    ;                                               SUBROUTINES FOR PROGRAMMABILITY

A990                SBSTEP                          ;BACK STEP    PC <- PC-1
A990 A5 B9                  LDA     PC
A992 38                     SEC
A993 E9 01                  SBC     #1
A995 B0 0C                  BCS     SBST10
A997 A6 BA                  LDX     PC+1
A999 CA                     DEX
A99A E4 D1                  CPX     PRGADR+1        ;AT BEGINNING OF PRGMEM?
A99C B0 03                  BCS     SBST05
A99E 4C 60 9C               JMP     EPERR           ;YES. END OF PROGRAM MEM ERROR MSG AND RETURN


A9A1                SBST05
A9A1 86 BA                  STX     PC+1
A9A3                SBST10
A9A3 85 B9                  STA     PC
A9A5 A0 00                  LDY     #0              ;CHECK FOR NUMBER
A9A7 B1 B9                  LDA     (PC),Y
A9A9 C9 8E                  CMP     #NUMBER
A9AB D0 1E                  BNE     SBST50          ;RETURN
A9AD A5 B9                  LDA     PC              ;NUMBER => SUBTRACT MORE
A9AF A6 BA                  LDX     PC+1
A9B1 38                     SEC
A9B2 E9 07                  SBC     #FPREC+1
A9B4 B0 05                  BCS     SBST30
A9B6 CA                     DEX
A9B7 E4 D1                  CPX     PRGADR+1        ;NOW AT BEGINNING OF PRGMEM?
A9B9 90 09                  BCC     NERR


A9BB                SBST30
A9BB 48                     PHA                     ;SAVE NEW PC
A9BC B1 B9                  LDA     (PC),Y          ;DOUBLE CHECK FOR # AT BEGINNING
A9BE A8                     TAY
A9BF 68                     PLA                     ;RESTORE NEW PC
A9C0 C0 8E                  CPY     #NUMBER
A9C2 F0 03                  BEQ     SBST40          ;OK
A9C4                NERR
A9C4 4C B5 9B               JMP     KEYERR
A9C7                SBST40
A9C7 86 BA                  STX     PC+1            ;SAVE NEW PC
A9C9 85 B9                  STA     PC
A9CB                SBST50
A9CB 60                     RTS


A9CC                SSSTEP                          ;SINGLE STEP: IF IN STORE PROG MODE, THEN INC PC
                    ;                                       ;IF IN IMMEDIATE MODE, EXECUTE 1 INSTRUCTION

A9CC A5 BB                  LDA     PROG
A9CE C9 01                  CMP     #STOPRG
A9D0 F0 07                  BEQ     SSTP10
A9D2 A9 02                  LDA     #EXEC           ;IMMEDIATE -> EXECUTE MODE
A9D4 85 BE                  STA     SSTFLG
A9D6 85 BB                  STA     PROG
A9D8 60                     RTS
A9D9                SSTP10
A9D9 A0 00                  LDY     #0              ;CHECK FOR NUMBER
A9DB B1 B9                  LDA     (PC),Y
A9DD C9 8E                  CMP     #NUMBER
A9DF D0 11                  BNE     SSTP20
A9E1 A0 07                  LDY     #FPREC+1
A9E3 B1 B9                  LDA     (PC),Y
A9E5 C9 8E                  CMP     #NUMBER


A9E7 F0 06                  BEQ     SSTP15
A9E9 20 99 A1               JSR     PCINC
A9EC 4C B5 9B               JMP     KEYERR
A9EF                SSTP15
A9EF 4C 9D A1               JMP     PCADDN
A9F2                SSTP20
A9F2 4C 99 A1               JMP     PCINC

A9F5                SCLPRO                          ;CLEAR PROGRAM MEMORY. PC <- PRGMEM
A9F5 A9 00                  LDA     #0
A9F7 85 B9                  STA     PC
A9F9 A9 6E                  LDA     #STP            ;OPCODE FOR STOP => INIT ALL TO STOP
A9FB A4 D1                  LDY     PRGADR+1
A9FD 84 BA                  STY     PC+1
A9FF A6 D3                  LDX     PC1MX1
AA01 D0 06                  BNE     RAMSET

AA03                MEMCLR                          ;CLEAR MEMORY REGISTERS
AA03 A4 CF                  LDY     MEMADR+1        ;START ADDR MSB
AA05 A6 D1                  LDX     PRGADR+1        ;END ADDR MSB
AA07                RAMCLR                          ;SET PAGES Y TO X-1 TO 0
AA07 A9 00                  LDA     #0
AA09 48             RAMSET  PHA                     ;SET PAGES Y TO X-1 TO A
AA0A 84 8D                  STY     CLRPTR+1
AA0C 86 9E                  STX     T0              ;MEM UPPER LIMIT
AA0E A9 00                  LDA     #0
AA10 85 8C                  STA     CLRPTR
AA12 A8                     TAY
AA13 68                     PLA
AA14                INIT3
AA14 91 8C                  STA     (CLRPTR),Y
AA16 C8                     INY
AA17 D0 FB                  BNE     INIT3
AA19 E6 8D                  INC     CLRPTR+1
AA1B A6 8D                  LDX     CLRPTR+1
AA1D E4 9E                  CPX     T0
AA1F D0 F3                  BNE     INIT3
AA21 60                     RTS                     ;RETURN A= MEM CONTENTS



AA22                SLIST                                   ;LIST PROGRAM STARTING WITH PC
AA22 20 BB 9F               JSR     FPUSH0          ;SAVE X
AA25                SLSTLP
AA25 20 5A 9C               JSR     DSPRG
AA28 B0 1E                  BCS     SLST10
AA2A 20 9D A2               JSR     PUTCRP
AA2D AD F0 02               LDA     CRSINH          ;CURSOR ON => BREAK HIT
AA30 F0 13                  BEQ     BRKLST          ;BREAK
AA32 A5 81                  LDA     TOKCOD          ;NO BREAK
AA34 C9 8E                  CMP     #NUMBER
AA36 D0 06                  BNE     SLST05
AA38 20 9D A1               JSR     PCADDN
AA3B 4C 41 AA               JMP     SLST07
AA3E                SLST05
AA3E 20 99 A1               JSR     PCINC
AA41                SLST07
AA41 90 E2                  BCC     SLSTLP          ;OK: CONTINUE
AA43 B0 03                  BCS     SLST10          ;END OF PROG MEM: STOP
AA45                BRKLST
AA45 EE F0 02               INC     CRSINH          ;TURN CURSOR OFF
AA48                SLST10
AA48 4C 9D 9F               JMP     FPOP0           ;RESTORE X



AA4B                SPAUSE
AA4B 20 78 A5               JSR     DSPCLR
AA4E 48                     PHA
AA4F 20 E8 A1               JSR     DSOME           ;DISPLAY REGS & STACK
                    ;                                       PAUSE FOR 30 FRAMES (1/2 SEC)
AA52 A2 00                  LDX     #0              ;MSB
AA54 A0 1E                  LDY     #30             ;LSB (IN FRAMES)
AA56 A9 03                  LDA     #3
AA58 8D 2A 02               STA     CDTMF3          ;SET FLAG TO NON-ZERO
AA5B 20 5C E4               JSR     SETVBV          ;SET TIMER
AA5E                SPAULP
AA5E AD 2A 02               LDA     CDTMF3          ;WAIT FOR ZERO (TIME UP)
AA61 D0 FB                  BNE     SPAULP
AA63 4C 59 A5               JMP     DSPLOD          ;RESTORE DSPFLG

AA66                SPROGR                          ;TO STORE PROGRAM MODE
AA66 A9 01                  LDA     #STOPRG
AA68 C5 BB                  CMP     PROG            ;ALREADY IN MODE?
AA6A F0 26                  BEQ     SNOP            ;YES. RETURN
AA6C 85 BB                  STA     PROG            ;NO.

AA6E A9 0A                  LDA     #10             ;CLEAR LINES
AA70 85 9E                  STA     T0
AA72 A9 01                  LDA     #LMARG
AA74 85 55                  STA     COLCRS
AA76 A9 02                  LDA     #2
AA78 85 54                  STA     ROWCRS
AA7A A9 9C          SPROLP  LDA     #DELLIN
AA7C 20 31 A2               JSR     PTCHR
AA7F C6 9E                  DEC     T0
AA81 10 F7                  BPL     SPROLP

AA83 A2 5C                  LDX     #FPX            ;SAVE X REG
AA85 A0 05                  LDY     #FPX/256
AA87 4C A7 DD               JMP     FST0R

AA8A                SRESET
AA8A A9 00                  LDA     #0              ;PC <- 0
AA8C 85 B9                  STA     PC
AA8E A6 D1                  LDX     PRGADR+1
AA90 86 BA                  STX     PC+1

AA92                SNOP
AA92 60                     RTS


AA93                SSTP                            ;STOP PROGRAM EXECUTION
AA93                SEND                            ;END OF PROGRAM (STOP PROGRAM EXECUTION)
AA93 A9 00                  LDA     #0
AA95 85 BD                  STA     DSPFLG          ;DISPLAY ON
AA97 A6 BB                  LDX     PROG
AA99 85 BB                  STA     PROG            ;BACK TO IMMEDIATE MODE
AA9B E0 01                  CPX     #STOPRG         ;LEAVING STORE PROGRAM MODE?
AA9D D0 5F                  BNE     DSCAL2          ;NO.
AA9F A2 5C                  LDX     #FPX            ;YES. RELOAD FR0 (X)
AAA1 A0 05                  LDY     #FPX/256
AAA3 20 89 DD               JSR     FLD0R
AAA6                DSPALL
AAA6 A2 02                  LDX     #2
AAA8 86 54                  STX     ROWCRS
AAAA CA                     DEX                     ;LMARG=1
AAAB 86 55                  STX     COLCRS
AAAD CA                     DEX                     ;0
AAAE 20 49 A2               JSR     PTLIN1          ;LINE 2

                    ;                               ;LINE 3   "| STACK |REG . . .
AAB1 A9 F1                  LDA     #STKLIN
AAB3 20 04 9C               JSR     STMSG2          ;SET UP MESSAGE IN TOKBUF
AAB6 20 74 A2               JSR     PUTCHS

AAB9 A2 03                  LDX     #3
AABB 20 49 A2               JSR     PTLIN1

AABE A2 00                  LDX     #0              ;LINES 5-14    "|X      |0      0|"
AAC0                PTLP
AAC0 86 9E                  STX     T0

AAC2 A9 7C                  LDA     #'|
AAC4 20 31 A2               JSR     PTCHR
AAC7 A6 9E                  LDX     T0
AAC9 BD FD BA               LDA     CHTAB2,X        ;X , Y, 2, 3, 4. . .
AACC 20 31 A2               JSR     PTCHR
AACF 20 6E A2               JSR     BLNK15
AAD2 A9 7C                  LDA     #'|
AAD4 20 31 A2               JSR     PTCHR
AAD7 A5 9E                  LDA     T0
AAD9 18                     CLC
AADA 69 30                  ADC     #'0
AADC 20 31 A2               JSR     PTCHR           ;'0 - '9
AADF A2 12                  LDX     #18
AAE1 20 70 A2               JSR     BLNKS
AAE4 A9 7C                  LDA     #'|
AAE6 20 31 A2               JSR     PTCHR
AAE9 A6 9E                  LDX     T0
AAEB E8                     INX
AAEC E0 0A                  CPX     #10
AAEE D0 D0                  BNE     PTLP

                    ;                               ;WIDEN MARGINS SO LOGICAL LINES COME OUT RIGHT
AAF0 E6 53                  INC     RMARGN
AAF2 A2 06                  LDX     #6              ;LINE 15
AAF4 20 49 A2               JSR     PTLIN1
AAF7 20 0B A2               JSR     PUTCR           ;CR TO INDICATE END OF LOGICAL LINE
AAFA C6 53                  DEC     RMARGN          ;MARGINS BACK TO NORMAL
AAFC D0 05                  BNE     DSCAL           ;JMP
AAFE                DSCAL2
AAFE A9 40                  LDA     #$40            ;???
AB00 20 3A 9C               JSR     SOUND           ;STOP PROGRAM SOUND
AB03                DSCAL
AB03 4C E8 A1               JMP     DSOME           ;DISPLAY STACK, MEM, & X

AB06                XLTSUB                          ;XLT R N => IF X < MEM(R) THEN GOTO N
                    ;                               SUBROUTINE FOR CONDITIONAL BRANCH INSTRUCTIONS
AB06 20 D0 A3               JSR     MEMSUB          ;WILL RETURN FROM XLTSUB IF ERROR. OTHERWISE
AB09 20 83 A9               JSR     SFSUB           ;FR0 <- MEM(R) - X
AB0C A5 D4                  LDA     FR0             ;LOAD & SAVE SIGN BYTE
AB0E 48                     PHA
AB0F 20 9D 9F               JSR     FPOP0           ;RELOAD X
AB12 68                     PLA
AB13 18                     CLC                     ;NO ERROR
AB14                XLTERR
AB14 60                     RTS
AB15                SXEQ                            ;IF X=MEM ( R ) THEN GOTO N
AB15 20 06 AB               JSR     XLTSUB
AB18 B0 FA                  BCS     XLTERR          ;ERROR
AB1A F0 24                  BEQ     MATCH
AB1C                NOMAT                           ;CONDITION NOT SATISFIED
AB1C 20 54 AB               JSR     SGO1            ;CALL LEX AND CHECK FOR # IN RANGE
AB1F B0 F3                  BCS     XLTERR          ;ERROR => RETURN
AB21 90 2C                  BCC     SGO2            ;NO ERROR => RESTORE X & DHOFLG & RETURN
AB23                SXGE                            ;IF X>= MEM(R) THEN GOTO N
AB23 20 06 AB               JSR     XLTSUB
AB26 B0 EC                  BCS     XLTERR
AB28 F0 16                  BEQ     MATCH
AB2A 30 14                  BMI     MATCH           ;MI => MEM(R) < X => X>MEM(R)
AB2C 10 EE                  BPL     NOMAT
AB2E                SXLT                            ;IF X<MEM(R) THEN GOTO N
AB2E 20 06 AB               JSR     XLTSUB
AB31 B0 E1                  BCS     XLTERR
AB33 F0 E7                  BEQ     NOMAT
AB35 10 09                  BPL     MATCH           ;PL => MEM(R)>=X => X<=MEM(R)
AB37 30 E3                  BMI     NOMAT
AB39                SXNE                            ;IF X<MEM(R) THEN GOTO N
AB39 20 06 AB               JSR     XLTSUB
AB3C B0 D6                  BCS     XLTERR
AB3E F0 DC                  BEQ     NOMAT
AB40                MATCH
AB40                SGOTO                           ;GOTO N = 0-1023 ( 000-3FF)
AB40 20 54 AB               JSR     SGO1            ;CALL LEX & CHECK FOR NUMBER IN RANGE
AB43 B0 CF                  BCS     XLTERR          ;ERROR => RETURN
AB45 A6 D4                  LDX     FR0
AB47 86 B9                  STX     PC
AB49 A5 D5                  LDA     FR0+1
AB4B 65 D1                  ADC     PRGADR+1
AB4D 85 BA                  STA     PC+1
AB4F                SGO2                            ;ENTRY POINT
AB4F 20 9D 9F               JSR     FPOP0           ;RELOAD X
AB52 18                     CLC                     ;NO ERROR
AB53 60                     RTS


AB54                SGO1
AB54 20 BB 9F               JSR     FPUSH0          ; SAVE X
AB57 A9 00                  LDA     #PROMSG         ;DISPLAY "ENTER PROGRAM MEM ADDRESS 0-1023"
AB59 20 F0 9B               JSR     PUTMSG
AB5C A5 87                  LDA     DHOFLG          ;ALWAYS DECIMAL
AB5E 48                     PHA
AB5F A9 00                  LDA     #0
AB61 85 87                  STA     DHOFLG
AB63 20 51 9A               JSR     LEX
AB66 A5 81                  LDA     TOKCOD
AB68 C9 8E                  CMP     #NUMBER
AB6A D0 0F                  BNE     SGOERR
AB6C 20 D2 D9               JSR     FPI
AB6F B0 0A                  BCS     SGOERR
AB71 A5 D5                  LDA     FR0+1
AB73 C9 04                  CMP     #4
AB75 B0 04                  BCS     SGOERR          ;TOO LARGE
AB77 68                     PLA
AB78 85 87                  STA     DHOFLG          ;RESTORE DHOFLG
AB7A 60                     RTS

AB7B                SGOERR
AB7B 68                     PLA
AB7C 85 87                  STA     DHOFLG
AB7E 20 9D 9F               JSR     FPOP0           ;RELOAD X
AB81 4C 95 A3               JMP     BITERR


                    ;                           SUBROUTINE CALL & RETURN
AB84 A2 00          SCLCAL  LDX     #0          ;CLEAR CALL STACK
AB86 F0 14                  BEQ     PSHC20      ;JMP
AB88 20 D6 AB       SPOPC   JSR     POPCAL      ;POP CALL STACK (TWO POPS)
AB8B 90 49                  BCC     POPCAL
AB8D 60                     RTS

AB8E                PSHCAL                      ;SAVE A ON CALSTK
AB8E 18                     CLC                 ;NO ERROR
AB8F A6 C9                  LDX     CALPTR
AB91 10 05                  BPL     PSHC10      ;0-$7F IS OK
AB93 A9 CA                  LDA     #CLFMSG     ;"CALL STACK FULL" ERROR
AB95 4C B7 9B       ERRCAL  JMP     ERRSUB
AB98                PSHC10
AB98 9D 80 04               STA     CALSTK,X
AB9B E8                     INX
AB9C                PSHC20
AB9C 86 C9                  STX     CALPTR
AB9E 60                     RTS

AB9F                SCALL                       ;CALL N (0-1023)
AB9F A6 BB                  LDX     PROG        ;IMMEDIATE MODE?
ABA1 D0 16                  BNE     SCAL10      ;NO.
ABA3 A5 BA                  LDA     PC+1        ;YES. PC TO BE RESTORED ON RETURN
ABA5 09 80                  ORA     #$80        ;SET MSB IT TO INDICATE RETURN TO IMMEDIATE MODE
ABA7 20 8E AB               JSR     PSHCAL
ABAA A5 B9                  LDA     PC
ABAC 20 8E AB               JSR     PSHCAL
ABAF B0 4C                  BCS     SRET20      ;STACK FULL ERROR
ABB1 20 40 AB               JSR     SGOTO       ;GOTO N
ABB4 B0 1D                  BCS     SCAL30      ;ERROR
ABB6 4C F0 BC               JMP     SCONTI      ;RUN SUBROUTINE (CONTINUE)
ABB9                SCAL10
ABB9 A5 B9                  LDA     PC
ABBB A6 BA                  LDX     PC+1        ;EXEC MODE
ABBD 18                     CLC                 ;SKIP PAST N
ABBE 69 08                  ADC     #FPREC+2    ;TO GET RETURN ADDRESS.
ABC0 90 01                  BCC     SCAL20
ABC2 E8                     INX
ABC3                SCAL20

ABC3 48                     PHA
ABC4 8A                     TXA
ABC5 20 8E AB               JSR     PSHCAL      ;PC+1

ABC8 68                     PLA
ABC9 20 8E AB               JSR     PSHCAL      ;PC
ABCC B0 2F                  BCS     SRET20      ;STACK FULL ERROR => DON'T GO
ABCE 20 40 AB               JSR     SGOTO
ABD1 90 2A                  BCC     SRET20
ABD3                SCAL30
ABD3 20 D6 AB               JSR     POPCAL      ;ERROR => THROW AWAY RETURN ADDR FROM STACK
                    ;                           CALL POPCAL A 2ND TIME


ABD6                POPCAL                      ;POP A OFF CALSTK
ABD6 18                     CLC                 ;NO ERROR
ABD7 A6 C9                  LDX     CALPTR
ABD9 D0 04                  BNE     POPC10
ABDB A9 C0                  LDA     #CLEMSG
ABDD D0 B6                  BNE     ERRCAL       ;JMP  "CALL STACK EMPTY" ERROR
ABDF                POPC10
ABDF CA                     DEX
ABE0 86 C9                  STX     CALPTR
ABE2 BD 80 04               LDA     CALSTK,X
ABE5 60                     RTS

ABE6                SRETUR                      ;RETURN => POP PC OFF STACK. GOTO PC
ABE6 20 D6 AB               JSR     POPCAL      ;PC
ABE9 B0 12                  BCS     SRET20      ;ERROR - STACK EMPTY
ABEB 85 B9                  STA     PC
ABED 20 D6 AB               JSR     POPCAL      ;PC+1
ABF0 B0 0B                  BCS     SRET20      ;STACK EMPTY => DON'T EXECUTE RETURN
ABF2 10 07                  BPL     SRET10
ABF4 29 7F                  AND     #$7F        ;PC+1 (MSB) <0 => RETURN TO IMMEDIATE MODE
ABF6 85 BA                  STA     PC+1
ABF8 4C 93 AA               JMP     SSTP
ABFB                SRET10
ABFB 85 BA                  STA     PC+1        ;PC+1 >0 => STAY IN EXEC MODE
ABFD                SRET20
ABFD 60                     RTS


                    ;                       INSERT & DELETE
ABFE                SDELET                          ; DELETE - FOR I=PC TO 1022+PRGMEM: MEM(I)<-MEM(I+1):NEXT I
                    ;                               MEM(1023+PRGMEM)<-STP
ABFE 20 61 A1               JSR     NCHKLD          ;NUMBER?
AC01 B0 0D                  BCS     SDEL2           ;NO. ERROR DELETE 1 BYTE
AC03 D0 0B                  BNE     SDEL2           ;NO. DELETE 1 BYTE
AC05 A9 06                  LDA     #FPREC          ;YES DELETE 8 BYTES FOR NUMBER
AC07 85 9E                  STA     T0
AC09                SDELP2
AC09 20 10 AC               JSR     SDEL2
AC0C C6 9E                  DEC     T0
AC0E 10 F9                  BPL     SDELP2          ;7 TIMES
                    ;                               8TH CALL

AC10                SDEL2                           ;DELETE 1 BYTE FROM PRGMEM
AC10 A5 B9                  LDA     PC
AC12 85 90                  STA     JMPTR1
AC14 A5 BA                  LDA     PC+1
AC16 85 91                  STA     JMPTR1+1
AC18 A0 01          SDELP1  LDY     #1
AC1A B1 90                  LDA     (JMPTR1),Y      ;MEM(I+1)
AC1C 88                     DEY
AC1D 91 90                  STA     (JMPTR1),Y      ;MEM(I)
AC1F E6 90                  INC     JMPTR1
AC21 D0 F5                  BNE     SDELP1          ;CONTINUE
AC23 E6 91                  INC     JMPTR1+1
AC25 A5 91                  LDA     JMPTR1+1
AC27 C5 D3                  CMP     PC1MX1          ;AT END OF MEM?
AC29 D0 ED                  BNE     SDELP1          ;NO. CONTINUE

AC2B A9 6E                  LDA     #STP            ;DONE STORE "STOP" AT END OF PRGMEM
                    ;                               JMPTR1 = 0
AC2D C6 91                  DEC     JMPTR1+1        ;PC1MAX
AC2F A0 FF                  LDY     #$FF
AC31 91 90                  STA     (JMPTR1),Y
AC33 60                     RTS


AC34                SINSER          ;INSERT - FOR I=1022+PRGMEM TO PC: MEM(I+1)<-MEM(I):NEXT I
                    ;               MEM(PC)<-STP
AC34 A9 FE                  LDA     #$FE            JMPTR1<-ADDR(END OF PRGMEM-1)
AC36 85 90                  STA     JMPTR1
AC38 A5 D2                  LDA     PC1MAX
AC3A 85 91                  STA     JMPTR1+1
AC3C                SINSLP
AC3C A0 00                  LDY     #0
AC3E B1 90                  LDA     (JMPTR1),Y      ;MEM(I)
AC40 C8                     INY
AC41 91 90                  STA     (JMPTR1),Y      ;MEM(I+1)
AC43 C6 90                  DEC     JMPTR1
AC45 A6 90                  LDX     JMPTR1
AC47 E0 FF                  CPX     #$FF
AC49 D0 02                  BNE     INS10
AC4B C6 91                  DEC     JMPTR1+1
AC4D                INS10
AC4D A4 91                  LDY     JMPTR1+1
AC4F C4 BA                  CPY     PC+1
AC51 90 06                  BCC     INS30           ;JMPTR1<PC  => STOP
AC53 D0 E7                  BNE     SINSLP          ;JMPTR1>PC  => CONTINUE
AC55 E4 B9                  CPX     PC              ;JMPTR1+1 = PC+1
AC57 B0 E3                  BCS     SINSLP          ;JMPTR1 >= PC  => CONTINUE
AC59                INS30
AC59 A0 00                  LDY     #0              ;DONE MEM(PC) <- STP
AC5B A9 6E                  LDA     #STP
AC5D 91 B9                  STA     (PC),Y
AC5F 60                     RTS

                    ;                       SAVE & LOAD
AC60 48             FOPEN   PHA                     ; OPEN FILE FOR INPUT/OUTPUT (ACCORDING TO A)
AC61 A9 3B                  LDA     #FSPMSG         ; "ENTER FILESPEC" MESSAGE
AC63 20 F0 9B               JSR     PUTMSG
AC66                FOPLP1
AC66 20 3C 9A               JSR     LXINIT          ;SET UP CURSOR, DISPLAY '>'
AC69 20 26 A0               JSR     GTCHR           ;REMOVE LEADING SEPARATORS
AC6C C9 20                  CMP     #'
AC6E F0 F6                  BEQ     FOPLP1
AC70 C9 9C                  CMP     #DELLIN         ;DELETE LINE?
AC72 F0 F2                  BEQ     FOPLP1          ;YES. START OVER
AC74                FOP20
AC74 E6 82                  INC     TOKPTR          ;SAVE CHAR
AC76 20 26 A0               JSR     GTCHR
AC79 C9 20                  CMP     #'
AC7B F0 10                  BEQ     FOP30           ;DONE
AC7D C9 9C                  CMP     #DELLIN
AC7F F0 E5                  BEQ     FOPLP1          ;TRY AGAIN
AC81 A6 82                  LDX     TOKPTR
AC83 E0 0E                  CPX     #NUMLEN
AC85 90 ED                  BCC     FOP20
AC87 68                     PLA                     ;POP INPUT/QUTPUT INDICATOR
AC88 A9 9D                  LDA     #DIGMSG         ;"TOO MANY CHARS" ERROR MESSAGE
AC8A 4C B7 9B               JMP     ERRSUB
AC8D                FOP30                           ;NOW HAVE FILESPEC STRING IN TOKBUF
AC8D EE F0 02               INC     CRSINH          ;CURSOR OFF (INHIBIT ON)
AC90 20 0B A2               JSR     PUTCR           ;PUT CR SO >FILESPEC WILL BE DISPLAYED
AC93 A9 9B                  LDA     #CR
AC95 A6 82                  LDX     TOKPTR
AC97 9D 00 05               STA     TOKBUF,X        ;PUT CR AT END OF STRING
AC9A A2 30                  LDX     #TIOCB          ;TEMPORARY IOCB #
AC9C 68                     PLA                     ;INPUT OR OUTPUT
AC9D 9D 4A 03               STA     ICAX1,X
ACA0 A0 08                  LDY     #8              ;OPEN
ACA2                CIOCAL
ACA2 20 FC AC               JSR     CIOIN2          ;SET UP IOCB X, CALL CIO, AND CHECK FOR SUCCESS
ACA5 D0 02                  BNE     IOERR           ;ERROR
ACA7 18                     CLC                     ;NO ERROR
ACA8 60                     RTS


ACA9                IOERR                           ;DISPLAY "ERROR - " <ERROR #>"
ACA9 98                     TYA                     ;Y=ERROR #
ACAA                IOERR2
ACAA 48                     PHA                     ;SAVE
ACAB 20 D7 9B               JSR     ERRSB2          ;DISPLAY "ERROR - ", DO OTHER STUFF
ACAE 20 BB 9F               JSR     FPUSH0          ;SAVE X
ACB1 68                     PLA                     ;CONVERT ERROR # TO FP TO ASCII (0-255)
ACB2 20 B9 A1               JSR     PSET0           ;FR0 <- FP (A)
ACB5 A5 87                  LDA     DHOFLG          ;SAVE DHOFLG AND SET TO DECIMAL
ACB7 48                     PHA
ACB8 A9 00                  LDA     #0
ACBA 85 87                  STA     DHOFLG
ACBC 20 57 9D               JSR     FDSP0           ;DISPLAY ERROR NUMBER (WILL BE DECIMAL IN CURRENT FIX)
ACBF 68                     PLA
ACC0 85 87                  STA     DHOFLG

ACC2 20 9D 9F               JSR     FPOP0           ;RELOAD X
ACC5 38                     SEC                     ;ERROR
ACC6 60                     RTS

ACC7                SLOAD                           ;LOAD PROGRAM MEM FROM SPECIFIED FILE
ACC7 A9 04                  LDA     #INPUT

ACC9 20 60 AC               JSR     FOPEN
ACCC B0 22                  BCS     FCLOSE          ;ERROR IF CRY SET
ACCE A9 07                  LDA     #GETCHR
ACD0 20 14 AD               JSR     SAVLOD          ;LOAD DATA
ACD3 D0 05                  BNE     SLD10           ;STATUS NOT SUCCES
ACD5 20 60 9C               JSR     EPERR           ;IN THIS CASE SUCCESS => ERROR BECAUSE FILE
                    ;                               IS TOO LONG. DISPLAY "END OF PROGRAM MEM"
ACD8 B0 16                  BCS     FCLOSE          ;JMP TO CLOSE FILE
ACDA                SLD10
ACDA C0 03                  CPY     #EOF            ;FILE JUST RIGHT IF END-OF-FILE
ACDC 4C EB AC               JMP     SSAV10


ACDF A9 08          SSAVE   LDA     #OUTPUT         ;SAVE PROGRAM MEM IN FILE
ACE1 20 60 AC               JSR     FOPEN
ACE4 B0 0A                  BCS     FCLOSE
ACE6 A9 0B                  LDA     #PUTCHR
ACE8 20 14 AD               JSR     SAVLOD          ;SAVE DATA
ACEB                SSAV10
ACEB F0 03                  BEQ     FCLOSE          ;NO ERROR
ACED 20 A9 AC               JSR     IOERR           ;DISPLAY ERROR AND CLOSE
ACF0                FCLOSE                          ;CLOSE TIOCB
ACF0 A2 30                  LDX     #TIOCB
ACF2                XCLOSE
ACF2 A0 0B                  LDY     #11             ;CLOSE
ACF4 D0 AC                  BNE     CIOCAL          ;JMP TO CIO CALL

ACF6                CIOINT                          ;SET UP IOCB, CALL CIO, & CHECK FOR SUCCESS
                    ;                               INPUT: X=IOCB OFFSET, Y=CIOTAB OFFSET
                    ;                               OUTPUT:EQ=>SUCCES, NE=>ERROR
ACF6 B9 0A BB               LDA     CIOTAB+3,Y
ACF9 9D 4A 03               STA     ICAX1,X
ACFC                CIOIN2
ACFC B9 09 BB               LDA     CIOTAB+2,Y
ACFF 9D 45 03               STA     ICBAH,X
AD02 B9 08 BB               LDA     CIOTAB+1,Y
AD05 9D 44 03               STA     ICBAL,X
AD08 B9 07 BB               LDA     CIOTAB+0,Y
AD0B 9D 42 03               STA     ICCOM,X
AD0E                CIOIN3
AD0E 20 56 E4               JSR     CIOV
AD11 C0 01                  CPY     #SUCCES
AD13 60                     RTS



AD14                SAVLOD                          ; SUBROUTINE TO LOAD OR SAVE DATA
AD14 A2 30                  LDX     #TIOCB
AD16 9D 42 03               STA     ICCOM,X
AD19 A5 D1                  LDA     PRGADR+1
AD1B 9D 45 03               STA     ICBAH,X
AD1E A9 00                  LDA     #PRGLEN         ;0
AD20 9D 48 03               STA     ICBLL,X
AD23 9D 44 03               STA     ICBAL,X         ;0
AD26 A9 04                  LDA     #PRGLEN/256
AD28 9D 49 03               STA     ICBLH,X
AD2B D0 E1                  BNE     CIOIN3          ;CALL CIO AND CHECK FOR ERROR   JMP

                    ;                   SUBROUTINES FOR CONVERSIONS
AD2D                SM
AD2D A2 42                  LDX     #0*FPREC+LENGTH ;LOAD LSB OF ADDR OF CONVERSION CONSTANT
AD2F D0 16                  BNE     LENG            ;JMP
AD31                SIN
AD31 A2 48                  LDX     #1*FPREC+LENGTH
AD33 D0 12                  BNE     LENG
AD35                SFT
AD35 A2 4E                  LDX     #2*FPREC+LENGTH
AD37 D0 0E                  BNE     LENG
AD39 A2 54          SYD     LDX     #3*FPREC+LENGTH
AD3B D0 0A                  BNE     LENG
AD3D A2 5A          SMI     LDX     #4*FPREC+LENGTH
AD3F D0 06                  BNE     LENG
AD41 A2 60          SCM     LDX     #5*FPREC+LENGTH
AD43 D0 02                  BNE     LENG
AD45 A2 66          SKM     LDX     #6*FPREC+LENGTH
                    ;       BNE    LENG
                    ;SNAUTI LDX     #7*FPREC+LENGTH
AD47                LENG
AD47 A9 A2                  LDA     #ZM             ;LSB OF MESSAGE ADDR
AD49 D0 2E                  BNE     CONVRT          ;JMP

AD4B                SKG
AD4B A2 42                  LDX     #LENGTH         ;CONSTANT 1 (NO CONVERSION)
AD4D D0 0A                  BNE     MAS             ;JMP
AD4F A2 6C          SOZ     LDX     #0*FPREC+MASS
AD51 D0 06                  BNE     MAS
AD53                SLB
AD53 A2 72                  LDX     #1*FPREC+MASS
AD55 D0 02                  BNE     MAS
AD57                SGM
AD57 A2 78                  LDX     #2*FPREC+MASS
AD59                MAS
AD59 A9 A5                  LDA     #ZKG
AD5B D0 1C                  BNE     CONVRT          ;JMP

AD5D A2 42          SFLOZ   LDX     #LENGTH
AD5F D0 16                  BNE     VOL
AD61 A2 7E          STSP    LDX     #0*FPREC+VOLUME
AD63 D0 12                  BNE     VOL
AD65 A2 84          STBSP   LDX     #1*FPREC+VOLUME
AD67 D0 0E                  BNE     VOL
AD69 A2 8A          SCUP    LDX     #2*FPREC+VOLUME
AD6B D0 0A                  BNE     VOL
AD6D A2 90          SQT     LDX     #3*FPREC+VOLUME
AD6F D0 06                  BNE     VOL
AD71 A2 96          SGAL    LDX     #4*FPREC+VOLUME
AD73 D0 02                  BNE     VOL
AD75 A2 9C          SL      LDX     #5*FPREC+VOLUME
AD77                VOL
AD77 A9 AA                  LDA     #ZFL
                            .IF     ASMBL
                            BNE     CONVRT          ;JMP
                    SCDEG   LDX     #LENGTH         ;1
                            BNE     CDGR            ;JMP
                    SCGRAD  LDX     #0*FPREC+DEGREE
                            BNE     CDGR
                    SCRAD   LDX     #1*FPREC+DEGREE
                    CDGR    LDA     #ZDEG           ;DEGREES MSG
                            .ENDIF
AD79                CONVRT                          ;CONVERT TO DIFFERENT UNITS
AD79 A4 CA                  LDY     CONFLG          ;FLAG SET?
AD7B D0 17                  BNE     CONV10          ;YES.

AD7D 85 CA                  STA     CONFLG          ;NO. SAVE MSG ADDR LSB & DO INTERMEDIATE CONVERSION
AD7F A0 BA                  LDY     #LENGTH/256     ;LOAD CONVERSION CONSTANT
AD81 20 98 DD               JSR     FLD1R
AD84 20 97 A8               JSR     SFMUL           ;AND MULTIPLY.
AD87 A5 CA                  LDA     CONFLG          ;DISPLAY NEW UNITS
AD89 20 F0 9B               JSR     PUTMSG
AD8C 20 EE A1               JSR     FDSCOM          ;DISPLAY NEW X
AD8F A9 44                  LDA     #CN2MSG         ;DISPLAY "ENTER NEW UNITS"
AD91 4C F0 9B               JMP     PUTMSG

AD94                CONV10                          ;CONVERT FROM INTERMEDIATE UNITS TO FINAL UNITS
AD94 C5 CA                  CMP     CONFLG          ;FLAGS MATCH?
AD96 D0 10                  BNE     CONERR          ;NO. ERROR - CAN 'T MIX TYPES
AD98 A0 BA                  LDY     #LENGTH/256     ;YES. LOAD CONVERSION CONSTANT
AD9A 20 98 DD               JSR     FLD1R
AD9D 20 3A A9               JSR     SFDIV           ;AND DIVIDE.
ADA0 20 EE A1               JSR     FDSCOM          ;DISPLAY NEW VALUE
ADA3 A9 4F                  LDA     #CN3MSG         ;DISPLAY "CONVERSION COMPLETE"
ADA5 4C F0 9B               JMP     PUTMSG
ADA8                CONERR
ADA8 A9 D4                  LDA     #UNIMSG
ADAA 4C B7 9B               JMP     ERRSUB          ;DISPLAY "UNIT MISMATCH" ERROR MESSAGE & RETURN

                            .IF     ASMBL

                    ;                               NEW VERSION
                    SM      LDA     #ZM             ;METERS->FT
                            JSR     PUTMSG
                            LDX     #CFT
                            BNE     LC1DIV          ;JMP
                    SFT     LDA     #ZFT            ;FT->METERS
                            JSR     PUTMSG
                            LDX     #CFT
                            BNE     LC1MUL          ;JMP
                    SLB     LDA     #ZLB            ;LB->KG
                            JSR     PUTMSG
                            LDX     #CLB
                            BNE     LC1MUL
                    SKG     LDA     #ZKG
                            JSR     PUTMSG          ;KG->LB
                            LDX     #CLB
                            BNE     LC1DIV
                    SGAL    LDA     #ZGAL           ;GAL->LITERS (L)
                            JSR     PUTMSG
                            LDX     #CL
                            BNE     LC1DIV
                    SL      LDA     #ZLIT           ;L->GAL
                            JSR     PUTMSG
                            LDX     #CL
                            BNE     LC1MUL
                            .ENDIF


ADAD A9 9D          SCRAD   LDA     #ZRAD           ;RAD->DEG
ADAF 20 F0 9B               JSR     PUTMSG
ADB2 A2 36                  LDX     #PIOV18         ;PI/180
ADB4 A0 BA          LDY1DV  LDY     #PICONST/256    ;FR0 <- FR0 / (X, Y=PICONST/256)
ADB6                LD1DIV
ADB6 20 98 DD               JSR     FLD1R
ADB9 4C 3A A9               JMP     SFDIV


ADBC A9 99          SCDEG   LDA     #ZDEG

ADBE 20 F0 9B               JSR     PUTMSG
ADC1 A2 36                  LDX     #PIOV18
ADC3 A0 BA          LDY1ML  LDY     #PICONST/256    ;FR0 <- FR0 * DATA CONSTANT (LSB OF ADDR IN X)
ADC5                LD1MUL                          ;FR0 <- FR0 * DATA CONSTANT (ADDR IN X & Y)
ADC5 20 98 DD               JSR     FLD1R
ADC8 4C 97 A8               JMP     SFMUL


                            .IF     ASMBL
                    SMI     LDA     #ZMI            ;MILES->KG
                            JSR     PUTMSG
                            LDX     #CMI
                    SKM
                            LDA     #ZKM            ;KM->MI
                            JSR     PUTMSG
                            LDX     #CMI
                            .ENDIF
ADCB                SF
ADCB A9 5E                  LDA     #FAHMSG         ;DISPLAY "->CELSIUS"
ADCD 20 F0 9B               JSR     PUTMSG
ADD0 A9 20                  LDA     #32
ADD2 20 8F A6               JSR     SUBINT          ;FR0 <- FR0-32
ADD5 A2 3C                  LDX     #C1PT8          ;FAHRENHEIT -> CELSIUS C=(5/9)*(F-32)
ADD7 A0 BA                  LDY     #C1PT8/256
ADD9 D0 DB                  BNE     LD1DIV          ;JMP

                    ;                           COMPOUND INTEREST SUBROUTINES
                    ;               SUBROUTINES TO COMPUTE PARTS OF COMPOUND INT. EQUATIONS
ADDB 20 A2 A3       Z1IN    JSR     Z1ILDN          ;COMPUTE (1+I)^N
ADDE 4C 19 A6               JMP     SPOWER
ADE1 20 DB AD       Z1INM1  JSR     Z1IN            ;((1+I)^N)-1
ADE4 4C 8D A6               JMP     SUBONE
ADE7 20 70 A9       Z11INI  JSR     Z11IMN          ;(1-(1+I)^N)/I
ADEA 20 BB 9F       DIVI    JSR     FPUSH0          ;FR0 <- FR0/I
ADED 20 9E A3               JSR     LDI
ADF0 4C 37 A9               JMP     SPDIV


ADF3 A9 80          SCMPND  LDA     #$80            ;COMPOUND INTEREST
ADF5 D0 06                  BNE     SORD10          ;JMP
ADF7 A9 00          SFVDUE  LDA     #0              ;ANNUITY DUE (PAY AT BEGINNING OF PERIOD)
ADF9 F0 02                  BEQ     SORD10          ;E.G. SAVINGS ACCT.)
ADFB A9 01          SFVORD  LDA     #1              ;ORDINARY ANNUITY (PAY AT END OF PERIOD)
ADFD 85 C5          SORD10  STA     DUEFLG          ;E.G. LOAN
ADFF A9 1B                  LDA     #DFVDUE         ;DISPLAY STATUS
AE01 D0 12                  BNE     SFND20          ;JMP TO CHSTAT

AE03 A9 02          SPVDUE  LDA     #2              ;ANNUITY DUE/PV
AE05 D0 F6                  BNE     SORD10
AE07 A9 03          SPVORD  LDA     #3              ;ORDINARY ANNUITY/PV
AE09 D0 F2                  BNE     SORD10

AE0B A9 00          SENTER  LDA     #0              ;ENTER VALUE
AE0D F0 02                  BEQ     SFND10
AE0F A9 01          SFIND   LDA     #1              ;FIND VALUE, GIVEN OTHER VARIABLES
AE11 85 C6          SFND10  STA     ENTFLG
AE13 A9 21                  LDA     #DENTER         ;DISPLAY STATUS
AE15                SFND20
AE15 4C 5D A7               JMP     CHSTAT


AE18                SBAL                            ;BAL = BALLOON PAYMENT
AE18 A5 C6                  LDA     ENTFLG
AE1A F0 2C                  BEQ     SBAL05
AE1C A5 C5                  LDA     DUEFLG
AE1E 10 03                  BPL     SBAL20
AE20                SBAL15
AE20 4C B5 9B               JMP     KEYERR
AE23                SBAL20
AE23 29 02                  AND     #2
AE25 F0 F9                  BEQ     SBAL15          ;NO BAL IF FV OR CMPNDINTRST
                    ;                               BAL = (PV - PMT*(1-(1+I)^-N)/I)/(1+I)^-N
                    ;               ANNUITY DUE:    BAL = (PV - PMT*(1+I)*(1-(1+I)^-N)/I)/(1+I)^-N





AE27 20 AC A3               JSR     LDPMT           ;FR0 <- PMT
AE2A 20 89 A8               JSR     ZMUL1I          ;IF ANNUITY DUE THEN FR0 <- FR0*(1+I)
AE2D 20 BB 9F               JSR     FPUSH0
AE30 20 E7 AD               JSR     Z11INI          ;(1-(1+I)^-N)/I
AE33 20 94 A8               JSR     SPMUL
AE36 20 B6 DD               JSR     FMOVE
AE39 20 B0 A3               JSR     LDPV            ;PV
AE3C 20 83 A9               JSR     SFSUB
AE3F 20 BB 9F               JSR     FPUSH0
AE42 20 21 A9               JSR     Z1IMN           ;81+I)^-N
AE45 20 37 A9               JSR     SPDIV
AE48                SBAL05                          ;ENTER VALUE
AE48 A9 04                  LDA     #4
AE4A                MEMSTO
AE4A 85 A3                  STA     MEMNUM
AE4C A9 02                  LDA     #2              ;FIX 2 (DISPLAYING DOLLAR VALUE)
AE4E 20 6B A5               JSR     SFIX2
AE51 4C 65 A8               JMP     SST010          ;STORE REG & DISPLAY


AE54                SI                              ;ENTERED I = INTEREST IN PERCENT
AE54 A5 C6                  LDA     ENTFLG
AE56 D0 21                  BNE     SI10
AE58 20 BB 9F               JSR     FPUSH0          ;CONVERT INTEREST IN PERCENT TO FRACTIONAL VALUE
AE5B A9 64                  LDA     #100            ;BY DIVIDING BY 100


AE5D 20 B9 A1               JSR     PSET0
AE60 20 37 A9               JSR     SPDIV
AE63 A9 08          SI05    LDA     #8              ;FIX 8 FOR I/100
AE65 20 6B A5               JSR     SFIX2
AE68 A9 06                  LDA     #6              ;I
AE6A 85 A3                  STA     MEMNUM
AE6C 20 65 A8               JSR     SST010
AE6F A9 64                  LDA     #100
AE71 20 84 A8               JSR     INTMUL
AE74 A9 04                  LDA     #4
AE76 4C 6B A5               JMP     SFIX2
AE79                SI10
AE79 A5 C5                  LDA     DUEFLG
AE7B 10 A3                  BPL     SBAL15
                    ;                               COMPOUND INTEREST I=((FV/PV)^(1/N)-1)*100
AE7D 20 B0 A3               JSR     LDPV
AE80 20 B6 DD               JSR     FMOVE
AE83 20 9A A3               JSR     LDFV
AE86 20 3A A9               JSR     SFDIV           ;FV/PV
AE89 20 BB 9F               JSR     FPUSH0
AE8C 20 A8 A3               JSR     LDN
AE8F 20 24 A9               JSR     SRECIP          ;1/N
AE92 20 19 A6               JSR     SPOWER
AE95 20 8D A6               JSR     SUBONE
AE98 4C 63 AE               JMP     SI05            ;STORE NEW I
                            .IF     ASMBL
                    SI20                            ;ANNUITY - USE NEWTON - RAPHSON ITERATION (SEE SSQRT)
                            CMP     #1
                            BEQ     SI30
                            JMP     KEYERR
                    SI30                            ;ORDINARY ANNUITY/FV
                    ;       F(I) = PMT*((1+I)^N-1)/I - FV = 0
                    ;       FPRIME(I) = (PMT*N*(1+I)^(N-1)-(F(I)+FV))/I
                    ;       DELTA I = F(I)/FPRIME(I)

                            LDA     #0              ;I = MEM(6) <- .01 = $3F,1,0,0,0,0
                            LDX     #3
                    SILP1
                            STA     6*FPREC+MEMORY+2,X
                            DEX
                            BPL     SILP1
                            LDA     #$3F
                            STA     6*FPREC+MEMORY
                            LDA     #1
                            STA     6*FPREC+MEMORY+1
                            STA     DMFLG           ;DON'T DISPLAY MEM DURING ITERATION (<-1)
                            LDA     #$FF            ;NUMBER OF ITERATIONS
                            STA     ITER
                    SILP
                            JSR     Z1IN1I          ;((1+I)^N-1)/I
                            LDA     #8              ;PMT
                            JSR     MEMMUL
                            JSR     FPUSH0          ;SAVE FOR SPSUB
                            JSR     FST0T           ;SAVE FOR F'(I)
                            JSR     LDFV
                            JSR     SPSUB
                            JSR     FPUSH0          ;SAVE F(I)
                            JSR     Z1IN1           ;(1+I)^(N-1)
                            LDA     #8              ;PMT
                            JSR     MEMMUL
                            LDA     #7              ;N
                            JSR     MEMMUL
                            JSR     FLD1T           ;RELOAD F(I)-PV
                            JSR     SFSUB
                            JSR     FPUSH0
                            JSR     LDI
                            JSR     SPDIV           ;F'(I)
                            JSR     SPDIV           ;F(I)/F'(I) = DELTA I
                            LDA     FR0             ;0?
                            BNE     SI35            ;NO. CONTINUE
                            JSR     LDI             ;YES. RELOAD I INTO X REG
                            JMP     SI40            ;DONE
                    SI35
                            JSR     FMOVE           ;NO. I<- I+DELTA I
                            JSR     LDI
                            JSR     SFSUB
                            DEC     ITER
                            BEQ     SI40            ;DONE
                            JSR     SI05            ;STORE NEW I
                            JMP     SILP            ;CONTINUE
                    SI40    DEC     DMFLG           ; <- 0   DONE => RETURN
                            JMP     SI05            ;STORE NEW I & DISPLAY
                            .ENDIF
AE9B                SN                              ;N = NUMBER OF PERIODS
AE9B A5 C6                  LDA     ENTFLG
AE9D F0 46                  BEQ     SN05
AE9F A5 C5                  LDA     DUEFLG
AEA1 10 1B                  BPL     SN20
AEA3 20 B0 A3               JSR     LDPV            ;COMPOUND INTEREST N = LN(FV/PV)/LN(1+I)
AEA6 20 B6 DD               JSR     FMOVE
AEA9 20 9A A3               JSR     LDFV
AEAC 20 3A A9               JSR     SFDIV           ;FV/PV
AEAF 20 B3 A6               JSR     SLN
AEB2 20 BB 9F               JSR     FPUSH0
AEB5 20 B0 A6               JSR     ZLN1I           ;LN(1+I)
AEB8 20 37 A9               JSR     SPDIV
AEBB 4C E5 AE               JMP     SN05            ;STORE NEW N
AEBE                SN20                            ;ANNUITY FV OR PV?
AEBE 29 02                  AND     #2
AEC0 D0 28                  BNE     SN50            ;1 => PV
                    ;                                0=> FV  N=LN(FV*I/PMT+1)/LN(1+I)
                    ;                               DUE      N=LN(FV*I/(PMT*(1+I))+1)/LN(1+I)

AEC2 20 9A A3               JSR     LDFV
AEC5 A9 06                  LDA     #6              ;I
AEC7 20 E6 A3               JSR     MEMMUL
AECA 20 BB 9F               JSR     FPUSH0

AECD 20 AC A3               JSR     LDPMT
AED0 20 89 A8               JSR     ZMUL1I          ;IF DUE THEN *(1+I)
AED3 20 37 A9               JSR     SPDIV
AED6 20 51 A9               JSR     ONEADD
AED9                SN30
AED9 20 B3 A6               JSR     SLN
AEDC 20 BB 9F               JSR     FPUSH0
AEDF 20 B0 A6               JSR     ZLN1I           ; LN(1+I)
AEE2 20 37 A9               JSR     SPDIV
AEE5 A9 07          SN05    LDA     #7
AEE7 4C 4A AE               JMP     MEMSTO          ;ENTER

AEEA                SN50
                    ;                               PV N = LN((PMT-I*BAL)/(PMT-I*PV))/LN(1+I)
                    ;                              DUE N = LN((PMT*(1+I)-I*BAL)/(PMT*(1+I)-I*PV))/LN(1+I)

AEEA 20 AC A3               JSR     LDPMT
AEED 20 89 A8               JSR     ZMUL1I          ;IF DUE THEN *(1+I)
AEF0 20 55 9F               JSR     FST0T
AEF3 20 BB 9F               JSR     FPUSH0

AEF6 20 9E A3               JSR     LDI
AEF9 20 B6 DD               JSR     FMOVE
AEFC A9 04                  LDA     #4              ;BAL
AEFE 20 E6 A3               JSR     MEMMUL
AF01 20 80 A9               JSR     SPSUB
AF04 20 BB 9F               JSR     FPUSH0
AF07 20 9E A3               JSR     LDI
AF0A A9 09                  LDA     #9              ;PV
AF0C 20 E6 A3               JSR     MEMMUL
AF0F 20 B6 DD               JSR     FMOVE
AF12 20 49 9F               JSR     FLD0T           ;RELOAD PUT OR PMT*(1+I)
AF15 20 83 A9               JSR     SFSUB
AF18 20 37 A9               JSR     SPDIV
AF1B 4C D9 AE               JMP     SN30


AF1E                SPMT                            ;PMT = PAYMENT
AF1E A5 C6                  LDA     ENTFLG
AF20 F0 3F                  BEQ     SPMT05
AF22 A5 C5                  LDA     DUEFLG
AF24 10 03                  BPL     SPMT20
AF26 4C 20 AE               JMP     SBAL15          ;NO PMT IF COMPOUNT INTEREST - NOT VALID COMMAND
AF29                SPMT20
AF29 29 02                  AND     #2
AF2B D0 17                  BNE     SPMT30
                    ;                               FV PMT = FV*I/((1+I)^N-1)
                    ;                              DUE PMT = FV*I/((1+I)^N-1)*(1+I)=ABOVE/(1+I)
AF2D 20 E1 AD               JSR     Z1INM1          ;(1+I)^N-1
AF30 20 89 A8               JSR     ZMUL1I          ;IF DUE THEN *(1+I)
AF33 20 B6 DD               JSR     FMOVE
AF36 20 9A A3               JSR     LDFV
AF39 20 3A A9               JSR     SFDIV
AF3C A9 06                  LDA     #6              ;I
AF3E 20 E6 A3               JSR     MEMMUL


AF41 4C 61 AF               JMP     SPMT05
AF44                SPMT30                  ;PV  PMT = (PV-BAL*(1+I)^-N)/((1-(1+I)^-N)/I)
                    ;                                DUE PMT = (PV-BAL*(1+I)^-N)/((1-(1+I)^-N)/I*(1+I))
AF44 20 21 A9               JSR     Z1IMN           ;(1+I)*-N
AF47 A9 04                  LDA     #4              ;BAL
AF49 20 E6 A3               JSR     MEMMUL
AF4C 20 B6 DD               JSR     FMOVE
AF4F 20 B0 A3               JSR     LDPV
AF52 20 83 A9               JSR     SFSUB
AF55 20 BB 9F               JSR     FPUSH0

AF58 20 E7 AD               JSR     Z11INI          ;((1-(1+I)^-N)/I)
AF5B 20 89 A8               JSR     ZMUL1I          ;IF DUE THEN *(1+I)
AF5E 20 37 A9               JSR     SPDIV
AF61 A9 08          SPMT05  LDA     #8
AF63 4C 4A AE               JMP     MEMSTO          ;ENTER


AF66                SPV                             ;PV = PRESENT VALUE
AF66 A5 C6                  LDA     ENTFLG
AF68 F0 28                  BEQ     SPV05
AF6A A5 C5                  LDA     DUEFLG
AF6C 10 0B                  BPL     SPV20
                    ;                               COMPOUND INTEREST PV = FV*(1+I)^-N
AF6E 20 21 A9               JSR     Z1IMN           ;(1+I)^-N
AF71 A9 05                  LDA     #5              ;FV
AF73 20 E6 A3               JSR     MEMMUL
AF76 4C 92 AF               JMP     SPV05           ;STORE NEW VALUE
AF79                SPV20                           ;PV = PMT * (1-(1+I)^-N)/I+BAL*(1+I)^-N
                    ;                               DUE = PMT * (1-(1+I)^-N)/I*(1+I)+BAL*(1+I)^-N
AF79 20 E7 AD               JSR     Z11INI          ;(1-(1+I)^-N)/I
AF7C A9 08                  LDA     #8              ;PMT
AF7E 20 E6 A3               JSR     MEMMUL
AF81 20 89 A8               JSR     ZMUL1I          ;IF DUE THEN *< 1+1 )
AF84 20 BB 9F               JSR     FPUSH0
AF87 20 21 A9               JSR     Z1IMN           ;(1+I)^-N
AF8A A9 04                  LDA     #4              ;BAL
AF8C 20 E6 A3               JSR     MEMMUL
AF8F 20 67 A9               JSR     SPADD
AF92 A9 09          SPV05   LDA     #9
AF94 4C 4A AE               JMP     MEMSTO          ;ENTER

                    ;                       STATISTICS ROUTINES
                    ;
                    ;
AF97                ZSIGMA                          ;MEM(A)<-MEM(A)+TOS     MEM(A+1)<-MEM(A+1)+SQU(TOS)
AF97 48                     PHA
AF98 20 18 9F               JSR     FLD0S           ;FR0<-TOP OF STACK(TOS)
AF9B 68                     PLA
AF9C 48                     PHA                     ;RESAVE MEM#
AF9D 20 AA AF               JSR     MEMADD
AFA0 20 18 9F               JSR     FLD0S
AFA3 20 5A A8               JSR     SSQUAR
AFA6 68                     PLA
AFA7 18                     CLC
AFA8 69 01                  ADC     #1
                    ;                       MEM(A)<-MEM(A)+/-FR0
AFAA                MEMADD
AFAA 20 B8 A3               JSR     MEMLD1
AFAD A5 C8                  LDA     MEMFLG          ;ADD?
AFAF D0 06                  BNE     MEMA10          ;NO
AFB1 20 6A A9               JSR     SFADD           ;YES
AFB4 4C BD AF               JMP     MEMA20
AFB7                MEMA10
AFB7 20 83 A9               JSR     SFSUB           ;SUBTRACT
AFBA 20 82 A5               JSR     SCHGSG          ;FR0-MEM(A) -> MEM(A)-FR0
AFBD                MEMA20
AFBD 20 C0 A3               JSR     MEMLDR
AFC0 20 A7 DD               JSR     FST0R           ;MEM(MEMNUM)<-FR0
AFC3 A5 BD                  LDA     DSPFLG
AFC5 D0 06                  BNE     MEMA30
AFC7 20 86 9D               JSR     TOKNUM          ;DISPLAY IN MEM AREA
AFCA 4C 72 A8               JMP     DSPMEM
AFCD                MEMA30
AFCD 60                     RTS


AFCE                MEMDIV                          ;FR0 <- MEM(A) / N
AFCE 20 B2 A3               JSR     MEMLD0          ;MEM(A) -> FR0
AFD1 A9 04                  LDA     #4              ;N->FR1
AFD3 20 B8 A3               JSR     MEMLD1
AFD6 4C 3A A9               JMP     SFDIV

AFD9 A9 05          SXMEAN  LDA     #5              ;MEAN(X) <- SIGMA(X)/N
AFDB D0 F1                  BNE     MEMDIV          ;JMP
AFDD A9 07          SYMEAN  LDA     #7              ;MEAN(Y) <- SIGMA(Y)/N
AFDF D0 ED                  BNE     MEMDIV          ;JMP
AFE1                SXVARI                          ;VARIANCE(X) <- (SIGMA(SQU(X))-SQU(SIGMA(X))/N)/(N+WEIGHT)
AFE1 A9 05                  LDA     #5              ;SIGMA X
AFE3 D0 02                  BNE     ZVAR            ;JMP
AFE5                SYVARI                          ;VAR(Y) <- (SIGMA(SQU(Y))-SQU(SIGMA(Y))/N)/(N+WEIGHT)
AFE5 A9 07                  LDA     #7              ;SIGMA Y
AFE7                ZVAR                            ;THIS PART IS COMMON TO BOTH SXVARI AND XYVARI
AFE7 20 C9 9F               JSR     ZVAR2           ;COMPUTE SIGMA(SQU())-SQU(SIGMA())/N
AFEA A9 03                  LDA     #3              ;WEIGHT
AFEC 20 B8 A3               JSR     MEMLD1
AFEF 20 6A A9               JSR     SFADD           ;N+WEIGHT (SHOULD BE 0 OR -1)
AFF2 4C 37 A9               JMP     SPDIV           ;NUMERATOR/(N+WEIGHT)

AFF5 20 EC BF       SCORRE  JSR     SXSTDD          ;CORRELATION = R = M * STDDEV(X)/STDDEV(Y)
AFF8 20 BB 9F               JSR     FPUSH0
AFFB 20 F2 BF               JSR     SYSTDD
AFFE 20 37 A9               JSR     SPDIV           ;STDDEV(X)/STDDEV(Y)
B001 20 BB 9F               JSR     FPUSH0
B004 20 3A B0               JSR     SSLOPE          ;M
B007 4C 94 A8               JMP     SPMUL

B00A                SX                              ;X <- (Y-B)/M     (Y ENTERED IN X REG)
B00A 20 BB 9F               JSR     FPUSH0          ;SAVE Y
B00D 20 1C B0               JSR     SYINTE          ;B
B010 20 80 A9               JSR     SPSUB           ;Y-B
B013 20 BB 9F               JSR     FPUSH0
B016 20 3A B0               JSR     SSLOPE          ;M
B019 4C 37 A9               JMP     SPDIV           ;(Y-B)/M

B01C                SYINTE                          ;Y-INTERCEPT = B = (SIGMA(Y)-M*SIGMA(X))/N
B01C 20 3A B0               JSR     SSLOPE          ;M
B01F A9 05                  LDA     #5              ;SIGMA X
B021 20 B8 A3               JSR     MEMLD1
B024 20 97 A8               JSR     SFMUL           ;M*SIGMA(X)
B027 20 B6 DD               JSR     FMOVE
B02A A9 07                  LDA     #7              ;SIGMA(Y)
B02C 20 B2 A3               JSR     MEMLD0
B02F 20 83 A9               JSR     SFSUB
B032 A9 04                  LDA     #4              ;N
B034 20 B8 A3               JSR     MEMLD1
B037 4C 3A A9               JMP     SFDIV


B03A                SSLOPE                          ;SLOPE = M = (SIGMA(X*Y)-SIGMA(X)*SIGMA(Y)/N)/(SIGMA(SQU(X))-SQU(SIGMA(X))/N
B03A A9 05                  LDA     #5              ;SIGMA(X)
B03C 20 C9 9F               JSR     ZVAR2           ;COMPUTE SIGMA(SQU(X))-SQU(SIGMA(X))/N, STORE ON STACK
B03F 20 B6 DD               JSR     FMOVE           ;N-> FR1  (PUT IN FR0 BY ZVAR2)
B042 A9 05                  LDA     #5              ;SIGMA (X)
B044 20 B2 A3               JSR     MEMLD0
B047 20 3A A9               JSR     SFDIV
B04A A9 07                  LDA     #7              ;SIGMA (Y)
B04C 20 B8 A3               JSR     MEMLD1
B04F 20 97 A8               JSR     SFMUL
B052 20 B6 DD               JSR     FMOVE
B055 A9 09                  LDA     #9              ;SIGMA(X*Y)
B057 20 B2 A3               JSR     MEMLD0
B05A 20 83 A9               JSR     SFSUB           ;NUMERATOR
B05D 20 86 9F               JSR     FPOP1           ;LOAD DENOMINATOR (FROM ZVAR2)
B060 4C 3A A9               JMP     SFDIV

B063                SNWEIG
B063 A9 03                  LDA     #3              ;WEIGHT FACTOR
B065 85 A3                  STA     MEMNUM
B067 4C 65 A8               JMP     SST010          ;MEM(3) <- X

                    ; BASIC SINE ROUTINE
                    ; TO FIX BUGS OF VERSION 5.9 OF SHEP BASIC
                    ;
                    ; BY DAVE & LARRY
                    ; 4-6-79
                    ;
                    ;
                    ;
                    ;
                    ; SINE ROUTINE
                    ; COMPUTE QUADRANT, GET FRACTION AND DO POLYNOMIAL,
                    ; THEN ADJUST FOR QUADRANT
B06A                SSIN
B06A 20 DB BF               JSR     SINMOD          ;TAKE ANGLE MOD 2*PI, 360 OR 400
B06D A5 D4          SSIN2   LDA     FR0             GET SIGN
B06F 29 80                  AND     #$80
B071 85 F0                  STA     FCHRFLG         AND SAVE
B073 A5 D4                  LDA     FR0
B075 29 7F                  AND     #$7F            FR0=ABS(FR0)
B077 85 D4                  STA     FR0
                    ;
                    ; FR0=FR0/(PI/2) OR FR0=FR0/90
B079 20 F1 A3               JSR     PIOVL           ;LOAD X & Y REGS TO GET PI/2 90 OR 100
B07C 20 B6 AD               JSR     LD1DIV          FR0=FR0/FR1
B07F 90 04                  BCC     NOSNER
B081 60                     RTS                     ;RETURN
B082                SINERR
B082 4C 88 A9               JMP     CRYSND          GO IF ERROR
B085                NOSNER
                    ;
                    ; IF FR0 NOW FRACTION, IT IS QUADRANT 0
                    ; ELSE, GET INTEGER OF FR0 LSD
B085 A9 00                  LDA     #0
B087 85 B8                  STA     QUADFLG         ASSUME QUADRANT 0
B089 38                     SEC
B08A A5 D4                  LDA     FR0             GET EXPONENT
B08C E9 40                  SBC     #$40            SUBTRACT 64 EXCESS
B08E 30 37                  BMI     SINF3           GO IF QUADRANT 0
B090 C9 04                  CMP     #FPREC-2        IS EXPONENT TOO BIG?
B092 B0 EE                  BCS     SINERR          YES
                    ;
                    ; ACC=INDEX TO LSD. GET 10*TEN'S DIGIT + ONE'S DIGIT
                    ; THEN AND WITH 3 TO GET QUADRANT
B094 AA                     TAX                     INDEX TO LSD IN FR0
B095 B5 D5                  LDA     FR0+1,X         GET LSD
B097 29 0F                  AND     #$F             GET ONE'S DIGIT
B099 85 F1                  STA     DIGRT           AND SAVE
B09B B5 D5                  LDA     FR0+1,X         GET LSD
B09D 29 F0                  AND     #$F0            GET TEN'S DIGIT
B09F 4A                     LSR     A               TIMES 8
B0A0 85 B8                  STA     QUADFLG         AND TEMP SAVE
B0A2 4A                     LSR     A
B0A3 4A                     LSR     A               TIMES 2
B0A4 18                     CLC
B0A5 65 B8                  ADC     QUADFLG         PLUS TIMES 8 GIVES TIMES 10
B0A7 65 F1                  ADC     DIGRT           PLUS ONE'S DIGIT GIVES INTEGER
B0A9 29 03                  AND     #3              MASK LOW BITS
B0AB 85 B8                  STA     QUADFLG         NOW HAVE QUADRANT (0,1,2, OR 3)
B0AD 86 F1                  STX     DIGRT           SAVE INDEX TO LSD



                    ; PUT FR0 IN FR1, AND CLEAR FRACTIONAL PART OF FR1
                    ; THEN GET FR0=FRACTIONAL PART OF FR0
B0AF 20 B6 DD               JSR     FMOVE           FR1=FR0
B0B2 A6 F1                  LDX     DIGRT           RESTORE INDEX
B0B4 A9 00                  LDA     #0
B0B6 95 E2          SINF1   STA     FR1+2,X         CLEAR FRACTIONAL PART
B0B8 E8                     INX                     FROM DIGRT+1 TO END
B0B9 E0 04                  CPX     #FPREC-2        DONE?
B0BB 90 F9                  BCC     SINF1           NO
B0BD 20 60 DA               JSR     FSUB            FR0=FR0-FR1 (FR0 WILL BE FRACTIONAL PART)
                    ;
                    ; IF ODD QUADRANT, SET FR0=1-FR0 (90 DEGREE INVERT)
B0C0 46 B8                  LSR     QUADFLG         IS IT ODD QUADRANT?
B0C2 90 03                  BCC     SINF3           NO
B0C4 20 73 A9               JSR     ONESUB          ;FR0 <- 1-FR0
                    ;
                    ; SAVE ARG FOR LATER
B0C7                SINF3
B0C7 A2 E6                  LDX     #FPSCR          ;CAN'T USE FTEMP BECAUSE SSIN IS CALLED BY SPOLAR
B0C9 A0 05                  LDY     #FPSCR/256
B0CB 20 A7 DD               JSR     FST0R           ; FPSCR <- FR0
                    ;
                    ; NOW COMPUTE SINE
                    ; THIS CODE TAKEN FROM BASIC 5.9 LINES 6760-6770
B0CE 20 5A A8               JSR     SSQUAR          FR0=X**2
B0D1 B0 31                  BCS     SINFIN          ;ERROR (ALREADY REPORTED)
B0D3 A9 06                  LDA     #NSCF
B0D5 A2 06                  LDX     #SCOEF
B0D7 A0 BA                  LDY     #SCOEF/256
B0D9 20 40 DD               JSR     PLYEVL          EVALUATE P(X**2)
B0DC A2 E6                  LDX     #FPSCR
B0DE A0 05                  LDY     #FPSCR/256
B0E0 20 C5 AD               JSR     LD1MUL          FR0=SIN(X)=X*P(X**2)
                    ;
                    ; IF LOWER QUADRANT (2 OR 3) THEN FR0=-(FR0)
B0E3 46 B8                  LSR     QUADFLG         IS IT LOWER QUAD?
B0E5 90 08                  BCC     SINF4           NO
B0E7 A5 D4                  LDA     FR0             IS FR0=0
B0E9 F0 0C                  BEQ     SINDON          YES
B0EB 49 80                  EOR     #$80            ELSE, FR0=-(FR0)
B0ED 85 D4                  STA     FR0

                    ; IF SIGN WAS NEGATIVE COMING IN TO ROUTINE, INVERT SIGN
                    ; GOING OUT
B0EF A5 D4          SINF4   LDA     FR0             ANSWER
B0F1 F0 04                  BEQ     SINDON          GO IF ZERO
B0F3 45 F0                  EOR     FCHRFLG         INVERT ORIGINAL SIGN
B0F5 85 D4                  STA     FR0             AND THIS IS END ANSWER
                    ;
                    ;
                    ; IF ABS(FR0) >= 1 THEN PERFORM PSEUDO INT(FR0)
B0F7 29 7F          SINDON  AND     #$7F            WITHOUT SIGN BIT
B0F9 C9 40                  CMP     #$40            COMPARE $40
B0FB 90 07                  BCC     SINFIN
B0FD 18                     CLC
B0FE A9 00                  LDA     #0              STORE 0 IN LOW BYTES OF FR0
B100 85 D8                  STA     FR0+4
B102 85 D9                  STA     FR0+5
B104 60             SINFIN  RTS

B105                SASIN                           ;ARCSIN(FR0) = ARCTAN(FR0/SQRT(FR0*FR0))
B105 20 8C 9F               JSR     ARCSUB          ;FR1 <- SQRT(1-FR0*FR0)
B108 A5 E0                  LDA     FR1
B10A D0 0C                  BNE     SAS10
B10C A5 D4                  LDA     FR0
B10E 08                     PHP
B10F 20 A0 A4               JSR     SAC10
B112 28                     PLP
B113 10 EF                  BPL     SINFIN
B115 4C 82 A5               JMP     SCHGSG
B118                SAS10
B118 20 3A A9               JSR     SFDIV
                    ;       JMP     SATAN
                    ;               FROM SHEPARDSON ATARI BASIC 5.9 4-5-79 (MODIFIED)
B11B                SATAN                                   ;ARCTAN(FR0)


B11B A9 00                  LDA     #0
B11D 85 F0                  STA     FCHRFLG         ;SIGN FLAG OFF
B11F 85 F1                  STA     DIGRT           ;AND TRANSFORM FLAG
B121 A5 D4                  LDA     FR0
B123 29 7F                  AND     #$7F
B125 C9 40                  CMP     #$40            ;CHECK X VS 1.0
B127 30 15                  BMI     ATAN1           ;X<1 - USE SERIES DIRECTLY
B129 A5 D4                  LDA     FR0             ;X>=1 - SAVE SIGN & TRANSFORM
B12B 29 80                  AND     #$80
B12D 85 F0                  STA     FCHRFLG         ;REMEMBER SIGN
B12F E6 F1                  INC     DIGRT
B131 A9 7F                  LDA     #$7F
B133 25 D4                  AND     FR0
B135 85 D4                  STA     FR0             ;FORCE PLUS
B137 A2 EA                  LDX     #FP9S
B139 A0 DF                  LDY     #FP9S/$100
B13B 20 95 DE               JSR     XFORM           ;CHANGE ARG TO (X-1)/(X+1)
B13E                ATAN1
                    ;                               ARCTAN(X), -1<X<1 BY SERIES APPROX
B13E A2 E6                  LDX     #FPSCR          ;CAN'T USE FTEMP BECAUSE SATAN IS CALLED BY OTHER ROUTINES WHICH USE IT
B140 A0 05                  LDY     #FPSCR/256
B142 20 A7 DD               JSR     FST0R           ;X->FTEMP (CALC, NOT SHEP REG)
B145 20 5A A8               JSR     SSQUAR          ;X*X -> FR0
B148 B0 BA                  BCS     SINFIN          ;OVERFLOW (ERROR ALREADY REPORTED)
B14A A9 0B                  LDA     #NATCF
B14C A2 AE                  LDX     #ATCOEF
B14E A0 DF                  LDY     #ATCOEF/256
B150 20 40 DD               JSR     PLYEVL          ;P(X*X)
B153 B0 26                  BCS     ATNOUT          ;ERROR
B155 A2 E6                  LDX     #FPSCR
B157 A0 05                  LDY     #FPSCR/256
B159 20 C5 AD               JSR     LD1MUL          ;X*P(X*X)
B15C B0 A6                  BCS     SINFIN          ;OVERFLOW (ERROR ALREADY REPORTED SO RETURN)
B15E A5 F1                  LDA     DIGRT           ;WAS ARG XFORMED
B160 F0 10                  BEQ     ATAN2           ;NO
B162 A2 F0                  LDX     #PIOV4          ;YES-ADD ARCTAN(1) = PI/4
B164 A0 DF                  LDY     #PIOV4/256
B166 20 98 DD               JSR     FLD1R
B169 20 66 DA               JSR     FADD
B16C A5 F0                  LDA     FCHRFLG         ;GET ORG SIGN
B16E 05 D4                  ORA     FR0
B170 85 D4                  STA     FR0             ;ATAN(-X) = -ATAN(X)
B172                ATAN2

B172 A5 FB                  LDA     RADFLG          ;RAD OR DEG
B174 F0 05                  BEQ     ATNOUT          ;RAD - FINI


                    ;       CLC
                    ;       ADC     #PIOV18-FPREC
                    ;       TAX                     ;DIVIDE BY PI/180 OR PI/200
B176 A2 36                  LDX     #PIOV18         ;ABOVE IS USED IF GRADS ALLOWED
B178 4C B4 AD               JMP     LDY1DV          ;FR0 <- FR0/(WHATEVER)
B17B                ATNOUT
B17B 4C 86 A9               JMP     CRYCHK


B17E                SPOLAR  ;->RECT Y=THETA X=R   NEW Y=R*SIN(THETA)  NEW X=SQRT(SQU(R)-SQU(Y))
B17E A9 7D                  LDA     #ZPOLAR
B180 20 F0 9B               JSR     PUTMSG          ;DISPLAY "->RECTANGULAR"
B183 20 55 9F               JSR     FST0T           ;SAVE X=R
B186 20 9D 9F               JSR     FPOP0           ;LOAD THETA=Y
B189 20 6A B0               JSR     SSIN            ;SIN(THETA)
B18C 20 4F 9F               JSR     FLD1T           ;RELOAD R
B18F 20 97 A8               JSR     SFMUL           ;Y = R*SIN(THETA)
B192 20 BB 9F               JSR     FPUSH0          ;SAVE NEW Y ON STACK
B195 20 5A A8               JSR     SSQUAR          Y*Y
B198 20 BB 9F               JSR     FPUSH0          ;SAVE Y*Y
B19B 20 49 9F               JSR     FLD0T           ;LOAD R
B19E 20 5A A8               JSR     SSQUAR          ;R*R
B1A1 20 86 9F               JSR     FPOP1           ;RELOAD Y*Y
B1A4 20 83 A9               JSR     SFSUB           ;R*R - Y*Y


                    ;               FROM SHEPARDSON ATARI BASIC 5.9 4-5-79 (MODIFIED)
                    ;               USES NEWTON-RAPHSON ITERATION
                    ;               F(Y) = Y*Y - X
                    ;               FPRIME(Y) = 2*Y
                    ;               Y[I+1] = Y[I] - F(Y[I]) / FPRIME(Y[I]) = Y[I] + .5*((X/Y[I])-Y[I])

B1A7                SSQRT                           ;X<-SQRT(X)


B1A7 A9 00                  LDA     #0
B1A9 85 F1                  STA     DIGRT
B1AB A5 D4                  LDA     FR0
B1AD 10 06                  BPL     SQR0
B1AF 20 95 A3               JSR     BITERR          ;<0 => ERROR
B1B2 20 49 B2               JSR     SABSVA          ;TAKE ABS VALUE AND DO SQUARE ROOT (ABSVAL LOADS FR0 INTO A)
B1B5                SQR0
B1B5 C9 3F                  CMP     #$3F
B1B7 F0 17                  BEQ     FSQR            ;X IN RANGE OF APPROX - GO DO IT TO IT
B1B9 18                     CLC
B1BA 69 01                  ADC     #1
B1BC 85 F1                  STA     DIGRT           ;NOT IN RANGE - TRANSFORM
B1BE 85 E0                  STA     FR1             ;MANTISSA = 1
B1C0 A9 01                  LDA     #1
B1C2 85 E1                  STA     FR1+1
B1C4 A2 03                  LDX     #FPREC-3                ;CHANGED 5/11/79 FROM FPREC-2
B1C6 A9 00                  LDA     #0
B1C8                SQR1
B1C8 95 E2                  STA     FR1+2,X
B1CA CA                     DEX
B1CB 10 FB                  BPL     SQR1
B1CD 20 28 DB               JSR     FDIV            ;X/100**N
B1D0                FSQR                            ;SQR(X) 0.1<=X<1
B1D0 A9 06                  LDA     #6
B1D2 85 EF                  STA     ESIGN
B1D4 A2 E6                  LDX     #FSCR
B1D6 A0 05                  LDY     #FSCR/256

B1D8 20 A7 DD               JSR     FST0R           ;STASH X IN FSCR
B1DB A9 02                  LDA     #2
B1DD 20 75 A9               JSR     INTSUB          ;2-X
B1E0 A2 E6                  LDX     #FSCR
B1E2 A0 05                  LDY     #FSCR/256
B1E4 20 C5 AD               JSR     LD1MUL          ;X*(2-X)   1ST APPROX
B1E7                SQRLP
B1E7 A2 EC                  LDX     #FSCR1          ;DON'T USE FTEMP BECAUSE SSQRT IS USED BY OTHER ROUTINES
B1E9 A0 05                  LDY     #FSCR1/256
B1EB 20 A7 DD               JSR     FST0R           ;Y->FSCR
B1EE 20 B6 DD               JSR     FMOVE           ;Y->FR
B1F1 A2 E6                  LDX     #FSCR
B1F3 A0 05                  LDY     #FSCR/256
B1F5 20 89 DD               JSR     FLD0R
B1F8 20 28 DB               JSR     FDIV            ;X/Y
B1FB A2 EC                  LDX     #FSCR1
B1FD A0 05                  LDY     #FSCR1/256
B1FF 20 98 DD               JSR     FLD1R
B202 20 60 DA               JSR     FSUB            ;(X/Y)-Y
B205 A2 6C                  LDX     #FHALF
B207 A0 DF                  LDY     #FHALF/256

B209 20 C5 AD               JSR     LD1MUL          ;.5*((X/Y)-Y)=DELTAY
B20C A5 D4                  LDA     FR0             ;DELTA 0
B20E F0 0E                  BEQ     SQRDON
B210 A2 EC                  LDX     #FSCR1
B212 A0 05                  LDY     #FSCR1/256
B214 20 98 DD               JSR     FLD1R
B217 20 66 DA               JSR     FADD            ;Y=Y+DELTA Y

B21A C6 EF                  DEC     ESIGN           ;COUNT & LOOP
B21C 10 C9                  BPL     SQRLP
B21E                SQRDON
B21E A2 EC                  LDX     #FSCR1          ;DELTA = 0 - GET Y BACK
B220 A0 05                  LDY     #FSCR1/256
B222 20 89 DD               JSR     FLD0R
                    ;                               WAS ARG TRANSFORMED?
B225 A5 F1                  LDA     DIGRT
B227 F0 20                  BEQ     SQROUT          ;NO FINI
B229 38                     SEC
B22A E9 40                  SBC     #$40
                    ;                               ;YES - TRANSFORM RESULT TO MATCH

B22C 4A                     LSR     A               ;DIVIDE EXP BY 2
B22D 18                     CLC
B22E 69 40                  ADC     #$40
B230 85 E0                  STA     FR1
B232 A5 F1                  LDA     DIGRT
B234 6A                     ROR     A
B235 A9 01                  LDA     #1              ;MANTISSA = 1
B237 90 02                  BCC     SQR2            ;WAS EXP ODD OR EVEN
B239 A9 10                  LDA     #$10            ;ODD - MANT = 10
B23B                SQR2
B23B 85 E1                  STA     FR1+1
B23D A2 03                  LDX     #FPREC-3        ;CHANGED 5/11/79 FROM FPREC-2
B23F A9 00                  LDA     #0
B241                SQR3
B241 95 E2                  STA     FR1+2,X         ;CLEAR REST OF MANTISSA
B243 CA                     DEX
B244 10 FB                  BPL     SQR3
B246 20 97 A8               JSR     SFMUL           ;SQR(X) = SQR(X/100**N) * (10**N)
B249                SQROUT
B249                SABSVA
B249 A5 D4                  LDA     FR0
B24B 29 7F                  AND     #$7F
B24D 85 D4                  STA     FR0
B24F 60                     RTS
                            .IF     ASMBL           ;THE FOLLOWING HAVE BEEN REMOVED:
                    ;                               INPUT: FR0 IN MMDD.YYYY FORMAT
                    ;                               Z = YYYY; IF (MM-1) <=1 THEN Z-Z-1;
                    ;                               OUTPUT;FR0 = FACTOR = 365*YYYY + DD + 31*(MM-1) - (DAYTRM,(MM-1))
                    ;                                                     +INT(Z/4) - INT(.75[INT(Z/100)+1])
                    DAYERR
                            LDA     #DAYMSG
                            JSR     ERRSUB
                            JSR     PCLR0           ;CLEAR X
                            SEC                     ;INDICATE ERROR
                            RTS

                    DAYSUB
                            LDA     FR0
                            BMI     DAYERR          ;MUST BE >0
                            JSR     FST0T
                            JSR     SINTEG
                    ;                               ;COMPUTE DD = X MOD 100
                            LDA     #100
                            JSR     INTMOD

                            LDA     MODFAC+1        ;CHECK MM AND DD
                            BEQ     DAYERR          ;MM = 0 => ERROR
                            CMP     #$13
                            BCS     DAYERR          ;MM > 12 => ERROR
                            SED                     ;MM <- MM-1 (0-$11)
                            SBC     #1-1
                            STA     MODFAC+1
                            CLD
                            CMP     #$10            ;DEC -> INTEGER
                            BCC     DAYS10
                            SBC     #6
                    DAYS10
                            TAX
                            LDA     FR0+1           ;DD = 0 => ERROR
                            BEQ     DAYERR
                            CMP     MAXDAY,X
                            BCS     DAYERR          ;DD TOO LARGE
                            LDA     DAYTRM,X
                            STA     DAYTMP          ;SAVE INT( 4MM+2.3)

                            JSR     FPUSH0          ;PUSH DD
                            JSR     FLD0T           ;YYYY <- FRACT(X) * 10000
                            JSR     SFRACT
                            LDX     #C10000
                            LDY     #C10000/256
                            JSR     FLD1R
                            JSR     SFMUL
                            JSR     SINTEG
                            LDA     FR0
                            CMP     #$41
                            BNE     DAYERR          ;MUST HAVE $41,YY,YY,0,0,0,0
                            LDA     FR0+1
                            CMP     #$16
                            BCC     DAYERR          ;YYYY MUST BE GE 1600
                            JSR     FST0T           ;FTEMP <- YYYY

                            LDX     #C365           ;365 * YYYY
                            LDY     #C365/256
                            JSR     FLD1R
                            JSR     SFMUL

                            JSR     FPOP1           ;DD
                            JSR     SFADD           ;365*YYYY + DD
                            LDX     #MODFAC
                            LDY     #MODFAC/256     ;LOAD MM-1
                            JSR     FLD1R
                            JSR     FPUSH0

                            LDA     #31
                            JSR     PSET0
                            JSR     SFMUL           ;31*(MM-1)
                            JSR     FPOP1
                            JSR     SFADD           ;365*YYYY + DD + 31*(MM-1)

                            LDA     MODFAC+1
                            CMP     #2              ;JAN OR FEB?
                            BCS     DAYS20          ;NO.
                            LDA     FTEMP+2         ;YES. YYYY <- YYYY-1

                            SED
                            SBC     #1-1            ;CARRY IS CLEAR
                            STA     FTEMP+2
                            BCS     DAYS15
                            LDA     FTEMP+1
                            SBC     #1-1
                            STA     FTEMP+1
                    DAYS15
                            CLD
                    DAYS20
                            JSR     FMOVE           ;ADD -(DAYTRM,(MM-1))
                            LDA     DAYTMP
                            JSR     PSET0
                            JSR     SCHGSG
                            JSR     SFADD

                            JSR     FPUSH0          ;ADD INT ( YYYY/4)
                            LDA     #4
                            JSR     PSET0
                            JSR     FMOVE
                            JSR     FLD0T
                            JSR     SFDIV
                            JSR     SINTEG
                            JSR     FPOP1
                            JSR     SFADD

                            JSR     FPUSH0          ;SUB INT(.75[INT[(YYYY/100)+1])
                            LDA     #100
                            JSR     PSET0
                            JSR     FMOVE
                            JSR     FLD0T           ;YYYY
                            JSR     SFDIV           ;YYYY/100
                            LDA     #1
                            JSR     INTADD          ;1+YYYY/100
                            JSR     SINTEG
                            LDX     #CPT75
                            LDY     #CPT75/256
                            JSR     FLD1R
                            JSR     SFMUL
                            JSR     SINTEG
                            JSR     FMOVE
                            JSR     FPOP0
                            JMP     SFSUB
                    HYPSUB                          ;FR0 <- EXPE(X), FR1 <- EXPE(-X)
                    ;                                       FOR COSH, SINH
                            .PAGE
                            JSR     FPUSH0
                            JSR     SCHGSG
                            JSR     SEXPE           ;EXPE(-X)
                            JSR     SXCHGY
                            JSR     SEXPE           ;EXPE(X)
                            JMP     FPOP1

                    SCOMBI                          ;Y COMBI X = C(N,R) = N!/(R!(N-R)!) = P(N,R)/R! = (Y PERMU X)/X!
                            JSR     FPUSH0
                            JSR     SFACTO
                            LDX     #FTEMP2
                            LDY     #FTEMP2/256
                            JSR     FST0R
                            JSR     FPOP0
                            JSR     SPERMU
                            LDX     #FTEMP2
                            LDY     #FTEMP2/256
                            JSR     FLD1R           ;RELOAD X
                            JSR     SFDIV
                            JMP     SROUND
                    SCOSH                           ;COSH(X) <- (EXPE(X)+EXPE(-X))/2
                            JSR     HYPSUB          ;FR0 <- EXPE(X), FR1 <- EXPE(-X)
                            JSR     SFADD           ;EXPE(X) + EXPE(-X)
                            JMP     DIVTWO          ;DIVIDE BY 2 AND RETURN
                    SDAY
                            JSR     DAYSUB          ;MMDD.YYYY -> FACTOR
                            BCS     SCH10           ;ERROR => RETURN IMMEDIATELY
                            JSR     CLNUM           ;CLEAR TOKBUF
                    ;                               ;FACTOR <- FACTOR MOD 7
                            LDA     #7
                            JSR     INTMOD
                            LDA     FR0+1           ;0-6
                            ASL     A
                            ADC     FR0+1           ;3*(FACTOR MOD 7)
                            TAX                     ;MOVE DAY OF WEEK CHARS TO END OF TOKBUF
                            LDY     #NUMLEN-3
                    SDAYLP
                            LDA     DAYTBL,X
                            STA     TOKBUF,Y
                            INX
                            INY
                            CPY     #NUMLEN
                            BNE     SDAYLP
                            JSR     DAYDSP          ;DISPLAY DAY OF WEEK IN NUMBER LOC
                            JMP     DAYCOM          ;DISPLAY "***"
                    SDBD                            ;DAYS BETWEEN DATES
                            JSR     DAYSUB          ;Y DBD X = DAYSUB(Y) - DAYSUB(X)
                            BCS     SFDON           ;ERROR => RETURN
                            JSR     SXCHGY
                            JSR     DAYSUB          ;DAYSUB Y
                            BCS     SFDON           ;ERROR => RETURN
                            JSR     FPOP1
                            JMP     SFSUB
                    SDIV
                            JSR     MEMSUB          ;MEM <- MEM/X
                            JSR     SFDIV
                            JMP     SSUM10
                    SDMS                            ;DMS -> DECIMAL DEGREES DD.MMSSSSS -> DD.DDDD
                            LDA     #ZDMS
                            LDX     #100            ;NUMERATOR/ MOD BASE
                            LDY     #60             ;DENOMINATOR
                            BNE     DEGSUB          ;JMP
                    DEGSUB
                            STX     XSAVE2
                            STY     YSAVE2
                            JSR     PUTMSG          ;DISPLAY MESSAGE -> DMS OR -> DECIMAL DEGREES
                    ;       INT(X) + (FRACT(X) MODFAC (1/XSAVE2))/YSAVE2 + (FRACT(X) MOD (1/XSAVE2))*XSAVE2^2/YSAVE2^2
                            JSR     FMOVE
                            JSR     SINTEG
                            JSR     FPUSH0          ;SAVE INT(X)
                            JSR     FMOVE2
                            JSR     SFRACT
                            JSR     FPUSH0          ;SAVE FRACT(X)
                            LDA     XSAVE2
                            JSR     PSET0           ;INT -> FP
                            JSR     SRECIP
                            JSR     SMOD            ;FRACT(X) MOD (1/XSAVE2)  ALSO SETS UP MODFAC
                            JSR     FPUSH0          ;SAVE MOD
                            LDA     XSAVE2
                            JSR     PSET0
                            JSR     SSQUAR
                            JSR     FPUSH0
                            LDA     YSAVE2
                            JSR     PSET0
                            JSR     SSQUAR
                            JSR     SPDIV           ;XSAVE2^2/YSAVE2^2
                            JSR     SPMUL           ;MULTIPLY BY MOD
                            JSR     SPADD           ;ADD INT(X)
                            JSR     FPUSH0          ;SAVE RESULT ON STACK
                            LDA     YSAVE2
                            JSR     PSET0
                            JSR     FMOVE
                            JSR     FLD0M           ;LOAD MODFAC
                            JSR     SFDIV           ;MODFAC/YSAVE2
                            JMP     SPADD           ;ADD TO PREVIOUS RESULT & RETURN
                    SASINH                          ;ARCSINH(X) = SIGN(X) * LN(ABSVAL(X)+SQRT(SQUARE(X)+1))

                            LDA     FR0
                            PHA                     ;SAVE SIGN
                            JSR     SABSVA          ;ABSVAL(X)
                            JSR     FPUSH0
                            JSR     SSQUAR          ;X*X
                            LDA     #1
                            JSR     INTADD          ;X*X+1
                            JSR     AHYPSB          ;LN(X+SQRT(X*X+1))
                            PLA
                            BPL     BIN100          ;RETURN
                            JMP     SCHGSG          ;IF SIGN IS NEGATIVE THEN ARCSINH(X) < 0
                    SATANH                          ;ARCTANH (X) = LN((1+X)/(1-X)))/2
                            JSR     FPUSH0
                            LDA     #1
                            JSR     INTSUB          ;1-X
                            JSR     SXCHGY
                            LDA     #1
                            JSR     INTADD          ;1+X
                            JSR     FPOP1
                            JSR     SFDIV           ;(1+X)/(1-X)
                            JSR     SLN             ;LN((1+X)/(1-X))
                    DIVTWO                          ;MULTIPLY BY 1/2 (DIVIDE BY 2)
                            LDX     #FHALF
                            LDY     #FHALF/256
                            JMP     LD1MUL          ;LOAD FR1 AND MULTIPLY
                    SBIN                            ;BASE 2 OR BINARY
                            LDA     #2
                            JSR     SOCT10          ;CHANGE DHOFLG. STATUS MESSAGE
                            LDA     BITINT
                            CMP     #17
                            BCC     BIN100
                            LDA     #BIMSG
                            JSR     ERRSUB          ;BINARY REQUIRES 16 BITS OR LESS
                            LDA     #'1
                            STA     TOKBUF+NUMLEN-2
                            LDA     #'6
                            STA     TOKBUF+NUMLEN-1
                            LDA     #16
                            JSR     SBITS2
                    BIN100
                            RTS
                    SACOSH                          ;ARCCOSH(X) = LN(X+SQRT(SQUARE(X)-1))
                            JSR     FPUSH0
                            JSR     SSQUAR          ;X*X
                            LDA     #1
                            JSR     INTSUB          ;1-X*X
                            JSR     SCHGSG          ;X*X-1
                    AHYPSB                          ;FR0 <- LN(TOS + SQRT(FR0))
                            JSR     SSQRT           ;SQRT(X*X-1)
                            JSR     FPOP1
                            JSR     SFADD           ;X+SQRT(X*X-1)
                            JMP     SLN             ;LN(X+SQRT(X*X-1)
                    SGRAD                           ;SET GRAD MODE
                            LDA     #GRADON
                            JMP     SRAD10
                    SPERCE
                            JSR     FMVPOP

                            JSR     SFMUL
                            LDA     FR0
                            BEQ     SPE10
                            DEC     FR0
                    SPE10
                            RTS
                    SPERMU
                            JSR     FMOVE           ;Y PERMU X = P(N,R) = N!/(N-R)! = Y!/(Y-X)!
                            JSR     FLD0S
                            JSR     SFSUB           ;Y-X
                            JSR     SFACTO          ;(Y-X)!
                            JSR     SXCHGY          ;LOAD Y
                            JSR     SFACTO          ;Y!
                            JSR     FPOP1           ;LOAD (Y-X)!
                            JSR     SFDIV
                            JMP     SROUND
                    SPRD
                            JSR     MEMSUB          ;MEM <- MEM*X
                            JSR     SFMUL
                            JMP     SSUM10
                    SRANDO                  ;X <- RANDOM NUMBER FROM 0 TO 65535
                            LDA     RPNALG
                            BNE     SRAN10
                            JSR     FPUSH0          ;IF RPN PUSH PREVIOUS # AS IN SPI
                    SRAN10
                            LDA     RANDOM
                            STA     FR0
                            LDA     #0
                            STA     FR0+1
                            JMP     IFP
                    SSINH                           ;SINH(X) <- (EXPE(X) - EXPE(-X)) / 2
                            JSR     HYPSUB          ;FR0 <- EXPE(X), FR1 <- EXPE(-X)
                            JSR     SFSUB           ;EXPE(X) - EXPE(-X)
                            JMP     DIVTWO          ;DIVIDE BY 2 AND RETURN
                    SSUB                            ;MEM <- MEM-X
                            JSR     MEMSUB
                            JSR     SFSUB
                            JMP     SSUM10

                    STANH                           ;TANH(X) <- SINH(X)/COSH(X)
                            JSR     FPUSH0
                            JSR     SSINH
                            JSR     SXCHGY
                            JSR     SCOSH
                            JMP     SPDIV
                            .ENDIF

B250                SFV                             ;FV = FUTURE VALUE
B250 A5 C6                  LDA     ENTFLG
B252 F0 1D                  BEQ     SFV05
B254 A5 C5                  LDA     DUEFLG
B256 10 0B                  BPL     SFV20           ;ANNUITY => SKIP
                    ;                               COMPOUND INTEREST FV=PV*(1+I)^N
B258 20 DB AD               JSR     Z1IN            ;(1+I)^N
B25B A9 09                  LDA     #9              ;PV
B25D 20 E6 A3               JSR     MEMMUL          ;FR0 <- FR0 * MEM(A)
B260 4C 71 B2               JMP     SFV05           ;STORE NEW FV
B263                SFV20                           ;ORDINARY ANNUITY FV=PMT*((1+I)^N-1)/I
                    ;                               ;ANNUITY DUE      FV=ABOVE * (1+I)
B263 20 E1 AD               JSR     Z1INM1              ;((1+I)^N-1)/I
B266 20 EA AD               JSR     DIVI
B269 A9 08                  LDA     #8              ;PMT
B26B 20 E6 A3               JSR     MEMMUL
B26E 20 89 A8               JSR     ZMUL1I          ;IF ANNUITY DUE THEN FR0 <- FR0 * (1 + 1)
B271 A9 05          SFV05   LDA     #5
B273 4C 4A AE               JMP     MEMSTO          ;ENTER


                    ; COSINE ROUTINE - ADD 90 OR PI/2 TO FR0 TO DO SIN


B276                SCOS
B276 20 DB BF               JSR     SINMOD          ;TAKE ANGLE MOD 2*PI, 360 OR 400
B279 20 F1 A3               JSR     PIOVL           ;SET UP X & Y REGS TO LOAD PI/2 90 OR 100
B27C 20 98 DD               JSR     FLD1R           PUT PI/2 OR 90 INTO FR1
B27F 20 6A A9               JSR     SFADD           FR0=FR0 + PI/2 (OR 90)
B282 4C 6D B0               JMP     SSIN2


                    ;                               DATA

                    ;               THE FOLLOWING TABLES MUST NOT CROSS PAGE BOUNDARIES

                            *=$BA00                 ;DATA MUST BE AT END OF MEM

BA00 40 03 14       PICONST .BYTE   $40,$03,$14,$15,$92,$65 ;PI = 3.14159265
BA03 15 92 65

BA06                SCOEF
BA06 BD 03 55               .BYTE   $BD,$03,$55,$14,$99,$39 ;-.00000355149939
BA09 14 99 39
BA0C 3E 01 60               .BYTE   $3E,$01,$60,$44,$27,$52 ;0.000160442752
BA0F 44 27 52
BA12 BE 46 81               .BYTE   $BE,$46,$81,$75,$43,$55 ;-.004681754355
BA15 75 43 55
BA18 3F 07 96               .BYTE   $3F,$07,$96,$92,$62,$39 ;0.0796926239
BA1B 92 62 39
BA1E BF 64 59               .BYTE   $BF,$64,$59,$64,$08,$67 ;-.6459640867
BA21 64 08 67
BA24 40 01 57       RADPI2  .BYTE   $40,$01,$57,$07,$96,$32 ;PI/2 =  1.570796327
BA27 07 96 32
BA2A 40 90 00               .BYTE   $40,$90,0,0,0,0         ;90 (DEGREES)
BA2D 00 00 00
                    ;       .BYTE   $41,$01,0,0,0,0         ;100 (GRADS)
BA30 42 06 55       C65536  .BYTE   $42,$06,$55,$36,0,0     ;65536 IN FP (USED IN BINFP)
BA33 36 00 00
BA36 3F 01 74       PIOV18  .BYTE   $3F,$01,$74,$53,$29,$25 ;PI/180 = .0174532925 DEG->RAD
BA39 53 29 25
                    ;       .BYTE   $3F,$01,$57,$07,$96,$33 ;PI/200 = .0157079633
BA3C 40 01 80       C1PT8   .BYTE   $40,$01,$80,0,0,0       ;1.8 (USED IN SCELSI)
BA3F 00 00 00
BA42                LENGTH
BA42 40 01 00       ONE     .BYTE   $40,$01,0,0,0,0         ;M -> M    = 1     EXACTLY
BA45 00 00 00
BA48 3F 02 54               .BYTE   $3F,$02,$54,0,0,0       ;INCHES->M = .0254 EXACTLY
BA4B 00 00 00
BA4E 3F 30 48               .BYTE   $3F,$30,$48,0,0,0       ;FEET        .3048   "
BA51 00 00 00
BA54 3F 91 44               .BYTE   $3F,$91,$44,0,0,0       ;YARDS       .9144   "
BA57 00 00 00
BA5A 41 16 09               .BYTE   $41,$16,$09,$34,$40,0   ;MILES   1609.344    "
BA5D 34 40 00
BA60 3F 01 00               .BYTE   $3F,$01,0,0,0,0         ;CM          .01     "
BA63 00 00 00
BA66 41 10 00               .BYTE   $41,$10,0,0,0,0         ;KM      1000        "
BA69 00 00 00
                    ;       .BYTE   $41,$18,$52,0,0,$04     ;NAUTMI  1852.000004 ????????

BA6C                MASS
BA6C 3F 02 83               .BYTE   $3F,$02,$83,$49,$52,$31 ;OZ->KG = .02834952313 (NOT EXACT)
BA6F 49 52 31
BA72 3F 45 35               .BYTE   $3F,$45,$35,$92,$37,0   ;LB       .45359237     ??
BA75 92 37 00
BA78 3E 10 00               .BYTE   $3E,$10,0,0,0,0         ;GM        .001      EXACTLY
BA7B 00 00 00

BA7E                VOLUME
BA7E 3F 16 66               .BYTE   $3F,$16,$66,$66,$66,$67 ;TSP->FLOZ = .1666666667
BA81 66 66 67
BA84 3F 50 00               .BYTE   $3F,$50,0,0,0,0         ;TBSP        .5     EXACTLY
BA87 00 00 00

BA8A 40 08 00               .BYTE   $40,8,0,0,0,0           ;CUPS       8          "
BA8D 00 00 00
BA90 40 32 00               .BYTE   $40,$32,0,0,0,0         ;QUARTS    32          "
BA93 00 00 00
BA96 41 01 28               .BYTE   $41,$01,$28,0,0,0       ;GAL      128          "
BA99 00 00 00
BA9C 40 33 81               .BYTE   $40,$33,$81,$40,$22,$66 ;LITERS    33.81402266 NOT EXACT?
BA9F 40 22 66

BAA2 20 20 20       INTCHR  .BYTE   "   BALFV ",'I+32,"  N  "       ;FIRST PART OF INTEREST DISPLAY
BAA5 42 41 4C
BAA8 46 56 20
BAAB 69 20 20
BAAE 4E 20 20
BAB1 50 4D 54       PBUFF   .BYTE   "PMTPV "        ;INTEREST DISPLAY (END OF INTCHR) AND "P" FOR PRINTER OPEN
BAB4 50 56 20
BAB7 4E 57 54       STACHR  .BYTE   "NWTN  X  X^2Y  Y^2X*Y"
BABA 4E 20 20
BABD 58 20 20
BAC0 58 5E 32
BAC3 59 20 20
BAC6 59 5E 32
BAC9 58 2A 59
                    ;
BACC 2A 2F 2B       TOKCHR  .BYTE   "*/+-()=^!%",UPAROW,DNAROW,LFAROW,RTAROW
BACF 2D 28 29
BAD2 3D 5E 21
BAD5 25 1C 1D
BAD8 1E 1F
BADA                TOKEND
                    ;                       TOKEN NUMBERS FOR TOKCHR COMMANDS
BADA 86 87 88       TOKTBL  .BYTE   STAR,SLASH,PLUS,MINUS,LPAR,RPAR,EQUAL,POWER,FACTOR,MOD
BADD 89 8A 8B
BAE0 8C 51 25
BAE3 41
                    ;               BSTEP,SSTEP,DELETE,INSERT ARE PART OF BOTH TOKTBL & SPCTBL
                    ;                       SPECIAL COMMANDS IN STORE PROGRAM MODE (EXECUTED IMMEDIATELY, NOT STORED)
BAE4 0A 6C 1F       SPCTBL  .BYTE   BSTEP,SSTEP,DELETE,INSERT,CLPROG,ZEND,PROGRAM,LIST,SAVE,LOAD,RST
BAE7 34 12 20
BAEA 53 3A 65
BAED 3C 63

BAEF                SPCEND
BAEF 4B             KBUFF   .BYTE   "K"             ;K FOR KEYBOARD OPEN
BAF0 20 2A 2A       STARMS  .BYTE   " ***"
BAF3 2A
                    ;GRAPHICS CHARS FOR SCREEN DISPLAY      -64 => CONTROL KEY HIT (USED IN PTLIN1)
BAF4 11 17 05       CHRTAB  .BYTE   'Q-64,'W-64,'E-64,'A-64,'S-64,'D-64,'Z-64,'X-64,'C-64
BAF7 01 13 04
BAFA 1A 18 03
BAFD 58 59 32       CHTAB2  .BYTE   "XY23456789"
BB00 33 34 35
BB03 36 37 38
BB06 39

                    ;                               COM,BAL,BAH,AX1 FOR IOCB
BB07 03 EF BA       CIOTAB  .BYTE   OPEN,KBUFF,KBUFF/256,INPUT      ;OPEN K: FOR INPUT
BB0A 04
BB0B 03 B1 BA               .BYTE   OPEN,PBUFF,PBUFF/256,OUTPUT     ;OPEN P: FOR OUTPUT
BB0E 08
BB0F 03 00 05               .BYTE   OPEN,TOKBUF,TOKBUF/256          ;OPEN TIOCB
BB12 0C                     .BYTE   CLOSE                           ;CLOSE (OTHER PARAMETERS DON'T MATTER)

                            .IF     ASMBL           ;DON'T ASSEMBLE
                    ;               MY EXPERIMENTAL SCOEF FOR SIN,COS   (9 TERMS INSTEAD OF 6)
                    ;EXPSC
                    ;       .BYTE   $3A,$06,$06,$69,$35,$74 ;6.066935731E-12
                    ;       .BYTE   $BB,$06,$68,$80,$35,$12 ;-6.688035123E-10 = -(PI/2)^15/15!
                    ;       .BYTE   $3C,$05,$69,$21,$72,$92 ;5.692172922E-08 = (PI/2)^13/13!
                    ;       .BYTE   $BD,$03,$59,$88,$43,$24 ;-.00000359884324 - (PI/2)^11/11!
                    ;       .BYTE   $3E,$01,$60,$44,$11,$85 ;0.000160441185
                    ;       .BYTE   $BE,$46,$81,$75,$41,$35 ;-.004681754155
                    ;       .BYTE   $3F,$07,$96,$92,$62,$62 ;0.0796926262
                    ;       .BYTE   $BF,$64,$59,$64,$09,$75 ;-.6459640975
                    ;       .BYTE   $40,$01,$57,$07,$96,$32 ;PI/2 = 1.570796327

                    ;C10000 .BYTE   $42,$01,0,0,0,0         ;10000 (USED IN DAY CALCULATIONS)
                    ;C365   .BYTE   $41,$03,$65,0,0,0       ;365
                    ;CPT75  .BYTE   $3F,$75,0,0,0,0         ;.75 = 3/4
                    DEGREE
                            .BYTE   $3F,$90,0,0,0,0         ;180/200 = .9 GRAD -> DEG
                            .BYTE   $40,$57,$29,$57,$79,$51 ;180/PI = 57.29577951 RAD -> DEG
                    CFT     .BYTE   $3F,$30,$48,0,0,0       ;FT->M        .3048   EXACTLY
                    CMI     .BYTE   $40,$01,$60,$93,$44,0   ;MI->KM  1.609344 EXACTLY
                    CLB     .BYTE   $3F,$45,$35,$92,$37,0   ;LB->KG       .45359237     ??
                    CL      .BYTE   $3F,$26,$41,$72,$05,$24 ;L->GAL  .2641720524
                    ONE     .BYTE   $40,$01,0,0,0,0         ;ONE

                    ;               MY EXPERIMENTAL P10COF FOR EXP FUNCTION
                    ;P10COF
                    ;       .BYTE   $3D,$09,$79,$28,$29,$75 ;.000009792829753 = (LN(10)/2)^9/9!
                    ;       .BYTE   $3D,$76,$55,$34,$94,$63 ;.00007655349463  = (LN(10)/2)^8/8!
                    ;       .BYTE   $3E,$05,$31,$94,$81,$65 ;.000531948165
                    ;       .BYTE   $3E,$32,$34,$31,$01,$36 ;.003234310136
                    ;       .BYTE   $3F,$01,$68,$55,$71,$65 ;.0168557165
                    ;       .BYTE   $3F,$07,$32,$03,$44,$68 ;.0732034468      = (LN(10)/2)^4/4!
                    ;       .BYTE   $3F,$25,$43,$34,$82,$44 ;.2543348244
                    ;       .BYTE   $3F,$66,$27,$37,$26,$38 ;.6627372638      = (LN(10)/2)^2/2!
                    ;       .BYTE   $40,$01,$15,$12,$92,$55 ;1.15129255       = LN(10)/2
                    ;       .BYTE   $3F,$99,$99,$99,$99,$99 ;.999999999         APPROX. 1
                    ;
                    ;               LENGTH OF EACH MONTH + 1 IN BCD
                    ;MAXDAY .BYTE   1+$31,$30,1+$31,1+$30,1+$31,1+$30,1+$31,1+$31,1+$30,1+$31,1+$30,1+$31
                    ;DAYTRM .BYTE   0,0,3,3,4,4,5,5,5,6,6,7 ;# OF DAYS LESS THAN 31/MONTH FOR EACH MONTH
                    ;DAYTBL .BYTE   "SATSUNMONTUEWEDTHUFRI"
                            .ENDIF
BB13                JMPTBL
BB13 49 B2 9C               .WORD   SABSVA,SACOS,SADV,SALG,SALGN,SAND,SASIN,SATAN,SBAL,SBITS
BB16 A4 18 A7
BB19 79 A7 7D
BB1C A7 C8 A8
BB1F 05 B1 1B
BB22 B1 18 AE
BB25 E0 A4
BB27 90 A9 40               .WORD   SBSTEP,SC,SCALL,SCDEG,SCHGSG,SCLCAL,SCLINI,SCLMEM,SCLPRO,SCLR,SCLSTAT,SCLX
BB2A A9 9F AB
BB2D BC AD 82
BB30 A5 84 AB
BB33 8B A5 C9
BB36 A5 F5 A9
BB39 74 A7 98
BB3C A5 B0 A1
BB3F 41 AD F3               .WORD   SCM,SCMPND,SCOMPL,SCONTI,SCOS,SCRAD,SCUP,SDEC,SDEG,SDELET
BB42 AD 7F A5
BB45 F0 BC 76
BB48 B2 AD AD
BB4B 69 AD 04
BB4E A7 53 A7
BB51 FE AB
BB53 93 AA 0B               .WORD   SEND,SENTER,SEXPE,SEXPTE,SF,SFACTO,SFIND,SFIX,SFLOZ,SFRACT,SFT
BB56 AE 00 98
BB59 07 98 CB
BB5C AD E9 A5
BB5F 0F AE 5D
BB62 A5 5D AD
BB65 7A A9 35
BB68 AD
BB69 50 B2 F7               .WORD   SFV,SFVDUE,SFVORD,SGAL,SGM,SGOTO,SHEX,SI,SIN,SINSER,SINTEG,SKG
BB6C AD FB AD
BB6F 71 AD 57
BB72 AD 40 AB
BB75 08 A7 54
BB78 AE 31 AD
BB7B 34 AC 83
BB7E A6 4B AD
BB81 45 AD 75               .WORD   SKM,SL,SLB,SLIST,SLN,SLOAD,SLOGTE,SLSHF,SM,SMI
BB84 AD 53 AD
BB87 22 AA B3
BB8A A6 C7 AC
BB8D BE A6 DA
BB90 A7 2D AD
BB93 3D AD
BB95 E8 A6 9B               .WORD   SMOD,SN,SNOP,SNOTRA,SNWEIG,SOCT,SOFF,SON,SOR,SOZ,SPAUSE
BB98 AE 92 AA
BB9B DC BC 63
BB9E B0 0C A7
BBA1 2E A7 37
BBA4 A7 CC A8
BBA7 4F AD 4B
BBAA AA
BBAB BD A4 1E               .WORD   SPI,SPMT,SPOLAR,SPOP,SPOPC,SPOWER,SPRINT,SPROGR,SPUSH,SPV
BBAE AF 7E B1
BBB1 9D 9F 88
BBB4 AB 19 A6
BBB7 08 A9 66
BBBA AA BB 9F
BBBD 66 AF
BBBF 03 AE 07               .WORD   SPVDUE,SPVORD,SQT,SCORRE,SRAD,SRCL,SRECIP,SRECTA,SRETUR,SROOT
BBC2 AE 6D AD
BBC5 F5 AF 57
BBC8 A7 7F 9F
BBCB 24 A9 1D
BBCE 9F E6 AB
BBD1 16 A6
BBD3 60 A6 81               .WORD   SROUND,SRPN,SRSHF,SRESET,SRUN,SSAVE,SSIN,SSLOPE,SSMINU,SSPLUS,SSQRT
BBD6 A7 DE A7
BBD9 8A AA ED
BBDC BC DF AC
BBDF 6A B0 3A
BBE2 B0 AB BF
BBE5 AF BF A7
BBE8 B1
BBE9 5A A8 CC               .WORD   SSQUAR,SSSTEP,SSTO,SSTP,SSUM,STAN,STBSP,STRACE,STRUNC,STSP,SX
BBEC A9 60 A8
BBEF 93 AA A7
BBF2 A8 2B A9
BBF5 65 AD E0
BBF8 BC 7D A6
BBFB 61 AD 0A
BBFE B0
BBFF E8 9F B3               .WORD   SXCHGY,SXCHM,SXEQ,SXGE,SXLT,SXMEAN,SXNE,SXOR,SXSTDD,SXVARI
BC02 A8 15 AB
BC05 23 AB 2E
BC08 AB D9 AF
BC0B 39 AB D0
BC0E A8 EC BF
BC11 E1 AF
BC13 58 A9 39               .WORD   SY,SYD,SYINTE,SYMEAN,SYSTDD,SYVARI
BC16 AD 1C B0
BC19 DD AF F2
BC1C BF E5 AF               .WORD   SPMUL,SPDIV,SPADD,SPSUB
BC1F 94 A8 37
BC22 A9 67 A9
BC25 80 A9
                    ;       OUTPUT FROM BASIC PROGRAM DK1:WORDSG.BAS
BC27 20 54 45       TABLE   .BYTE   " TEROANCSLPDIMUFGXYVHBKWQZJ"
BC2A 52 4F 41
BC2D 4E 43 53
BC30 4C 50 44
BC33 49 4D 55
BC36 46 47 58
BC39 59 56 48
BC3C 42 4B 57
BC3F 51 5A 4A
BC42                ERRTBL
                    ;               TWO OPS IN A ROW
BC42 12 20 85       TOPMSG  .BYTE    18,32,133,21,185,29,113,97,69,8
BC45 15 B9 1D
BC48 71 61 45
BC4B 08
                    ;               NOT VALID COMMAND OR NUMBER
BC4C 1D 75 21       KEYMSG  .BYTE    29,117,33,4,106,220,24,94,230,124,21,65,127,224,99,64
BC4F 04 6A DC
BC52 18 5E E6
BC55 7C 15 41
BC58 7F E0 63
BC5B 40
                    ;               HEX/OCT OVRFLW
BC5C 16 05 30       BOMSG   .BYTE    22,5,48,32,242,245,130,21,4,64,10,8
BC5F 20 F2 F5
BC62 82 15 04
BC65 40 0A 08
                    ;               NUMBER STACK EMPTY
BC68 15 7F E0       NSEMSG  .BYTE    21,127,224,99,65,146,104,7,19,235,32,48
BC6B 63 41 92
BC6E 68 07 13
BC71 EB 20 30
                    ;               NUMBER STACK FULL
BC74 14 7F E0       NSFMSG  .BYTE    20,127,224,99,65,146,104,7,16,15,170
BC77 63 41 92
BC7A 68 07 10
BC7D 0F AA
                    ;               OP STACK EMPTY BYTE
BC7F 10 5B 19       OSEMSG  .BYTE    16,91,25,38,128,113,62,178,3
BC82 26 80 71
BC85 3E B2 03
                    ;               OP STACK FULL
BC88 0F 5B 19       OSFMSG  .BYTE    15,91,25,38,128,113,0,250,160
BC8B 26 80 71
BC8E 00 FA A0
                    ;               NUMBER OUT OF RANGE
BC91 16 7F E0       BITMSG  .BYTE    22, 127,224,99,65,95,33,80,1,70,112,19
BC94 63 41 5F
BC97 21 50 01
BC9A 46 70 13
                    ;               TOO MANY CHARACTERS
BC9D 15 25 51       DIGMSG  .BYTE    21,37,81,230,112,49,128,86,70,130,52,144
BCA0 E6 70 31
BCA3 80 56 46
BCA6 82 34 90
                    ;               ARITHMETIC OVERFLOW
BCA9 17 64 D2       CRYMSG  .BYTE    23,100,210,5,227,45,129,80,67,64,10,80,128
BCAC 05 E3 2D
BCAF 81 50 43
BCB2 40 0A 50
BCB5 80
                    ;               END OF PROG MEM
BCB6 11 37 C1       EPMSG   .BYTE    17,55,193,80,1,180,80,17,227,224
BCB9 50 01 B4
BCBC 50 11 E3
BCBF E0
                    ;               CALL STACK EMPTY
BCC0 12 86 AA       CLEMSG  .BYTE    18,134,170,25,38,128,113,62,178,3
BCC3 19 26 80
BCC6 71 3E B2
BCC9 03

                    ;               CALL STACK FULL
BCCA 11 86 AA       CLFMSG  .BYTE    17,134,170,25,38,128,113,0,250,160
BCCD 19 26 80
BCD0 71 00 FA
BCD3 A0
                    ;               UNIT MISMATCH
BCD4 0E F7 D2       UNIMSG  .BYTE    14,247,210,30,217,230,40,5
BCD7 1E D9 E6
BCDA 28 05

BCDC                SNOTRACE                                ;TRACE OFF 20 LIMES
BCDC A9 00                  LDA     #0
BCDE F0 02                  BEQ     STR10
BCE0                STRACE                                  ;TRACE ON
BCE0 A9 01                  LDA     #1
BCE2                STR10
BCE2 85 BC                  STA     TRACE
BCE4 A6 BB                  LDX     PROG            ;PROGRAM IN EXECUTION?
BCE6 F0 04                  BEQ     STR20           ;NO.

BCE8                STR15
BCE8 49 01                  EOR     #$01            ;YES. TRACE DETERMINES DSPFLG
BCEA 85 BD                  STA     DSPFLG
BCEC                STR20
BCEC 60                     RTS
BCED 20 8A AA       SRUN    JSR     SRESET          ;GOTO 0 AND RUN
BCF0                SCONTI                          ;CONTINUE=> RUN STARTING AT CURRENT PC
BCF0 A2 02                  LDX     #EXEC
BCF2 86 BB                  STX     PROG
BCF4 A5 BC                  LDA     TRACE
BCF6 10 F0                  BPL     STR15           ;JMP IF NOTRACE THEN DSPFLGC<-1

                            *=*-1/256+1*256         ;GOTO NEXT PAGE BOUNDARY
                    ;               ENTER PROG ADDR 0-1023
BD00 29 37 23       PROMSG  .BYTE    41,55,35,65,180,80,17,108,196,16,243,0,242,208,243,16,243,0,243,32,243,48
BD03 41 B4 50
BD06 11 6C C4
BD09 10 F3 00
BD0C F2 D0 F3
BD0F 10 F3 00
BD12 F3 20 F3
BD15 30
                    ;               ENTER 0-8
BD16 12 37 23       FIXMSG  .BYTE    18,55,35,65,15,48,15,45,15,56
BD19 41 0F 30
BD1C 0F 2D 0F
BD1F 38
                    ;               ENTER 1-32
BD20 16 37 23       BTSMSG  .BYTE    22,55,35,65,15,49,15,45,15,51,15,50
BD23 41 0F 31
BD26 0F 2D 0F
BD29 33 0F 32
                    ;               ENTER REG 0-99
BD2C 1B 37 23       MEMMSG  .BYTE    27,55,35,65,67,1,16,243,0,242,208,243,144,243,144
BD2F 41 43 01
BD32 10 F3 00
BD35 F2 D0 F3
BD38 90 F3 90

                    ;               ENTER FILESPEC
BD3B 0F 37 23       FSPMSG  .BYTE    15,55,35,65,0,218,57,179,128
BD3E 41 00 DA
BD41 39 B3 80
                    ;               ENTER DESIRED UNITS
BD44 13 37 23       CN2MSG  .BYTE    19,55,35,65,195,157,67,193,247,210,144
BD47 41 C3 9D
BD4A 43 C1 F7
BD4D D2 90

                    ;               CONVERSION COMPLETE
BD4F 14 85 70       CN3MSG  .BYTE    20, 133,112,67,73,213,113,133,235,163,35
BD52 43 49 D5
BD55 71 85 EB
BD58 A3 23
                    ;               TO F
BD5A 05 25 10       CELMSG  .BYTE    5,37,16,0
BD5D 00
                    ;               TO
BD5E 04 25 18       FAHMSG  .BYTE    4,37,24
                    ;               TO POLAR  Y,X->Y=ANGLE,X=RADIUS
BD61 36 25 1B       ZRECT   .BYTE    54,37,27,90,100,17,3,15,44,2,15,45,15,62,3,15,61,103,1,163,15,44,2,15,61,70,205,249
BD64 5A 64 11
BD67 03 0F 2C
BD6A 02 0F 2D
BD6D 0F 3E 03
BD70 0F 3D 67
BD73 01 A3 0F
BD76 2C 02 0F
BD79 3D 46 CD
BD7C F9
                    ;               TO RECT Y=ANGLE, X=-RADIUS->Y, X
BD7D 35 25 14       ZPOLAR  .BYTE    53,37,20,56,33,16,48,243,214,112,26,48,242,192,32,243,212,108,223,144,242,208,243,224,48,242,192,32
BD80 38 21 10
BD83 30 F3 D6
BD86 70 1A 30
BD89 F2 C0 20
BD8C F3 D4 6C
BD8F DF 90 F2
BD92 D0 F3 E0
BD95 30 F2 C0
BD98 20

                    ;               TO RAD
BD99 06 25 14       ZDEG    .BYTE    6,37,20,108
BD9C 6C             ;               TO DEG

BD9D 07 25 1C       ZRAD    .BYTE    7,37,28,48,16
BDA0 30 10
                    ;               TO M
BDA2 04 25 1E       ZM      .BYTE    4,37,30
                    ;               TO KG
BDA5 07 25 10       ZKG     .BYTE    7,37,16,112,16
BDA8 70 10
                    ;               TO FL OZ
BDAA 0A 25 10       ZFL     .BYTE    10,37,16,10,21,10
BDAD 0A 15 0A
                    ;               ERROR -
BDB0 0A 34 45       ERRMSG  .BYTE    10,52,69,65,15,45
BDB3 41 0F 2D



                    ;               [    ATARI CALCULATOR COPYRIGHT 1979
BDB6 39 0F 7D       STATLN  .BYTE    57,15,125,17,17,98,100,209,134,168,250,98,84,24,91,3,77,1,5,33,15,49,15,57,15,55,15,57,17,16
BDB9 11 11 62
BDBC 64 D1 86
BDBF A8 FA 62
BDC2 54 18 5B
BDC5 03 4D 01
BDC8 05 21 0F
BDCB 31 0F 39
BDCE 0F 37 0F
BDD1 39 11 10
                    ;                ALG RAD DEC BITS16 FIX8 FVDUE ENTER]
BDD4 38 16 A0       STLN2   .BYTE    56,22,160,17,20,108,28,56,16,109,41,15,49,15,54,16,13,2,15,56,16,0,76,243,19,114,52,15,155
BDD7 11 14 6C
BDDA 1C 38 10
BDDD 6D 29 0F
BDE0 31 0F 36
BDE3 10 0D 02
BDE6 0F 38 10
BDE9 00 4C F3
BDEC 13 72 34
BDEF 0F 9B
                    ;               |      STACK     |    REGISTERS      |
BDF1 31 0F 7C       STKLIN  .BYTE    49,15,124,17,17,17,146,104,7,17,17,16,247,193,17,17,67,1,217,35,73,17,17,16,247,192
BDF4 11 11 11
BDF7 92 68 07
BDFA 11 11 10
BDFD F7 C1 11
BE00 11 43 01
BE03 D9 23 49
BE06 11 11 10
BE09 F7 C0
BE0B                KEYWRD

                    ;                                                       ABS         0
BE0B 46 06                  .BYTE        70,6
                    ;                                                       ACOS        1
BE0D 94 68 59               .BYTE        148,104,89
                    ;                                                       ADV         2
BE10 46 C0                  .BYTE        70,192
                    ;                                                       ALG         3
BE12 44 6A 01               .BYTE        68,106,1
                    ;                                                       ALGN        4
BE15 56 A0 17               .BYTE        86,160,23
                    ;                                                       AND         5
BE18 36 7C                  .BYTE        54,124
                    ;                                                       ASIN        6
BE1A 46 9D                  .BYTE        70,157
                    ;                                                       ATAN        7
BE1C 74 62 67               .BYTE        116,98,103
                    ;                                                       BAL         8
BE1F 40 66                  .BYTE        64,102
                    ;                                                       BITS        9
BE21 A5 06 D2               .BYTE        165,6,210
                    ;                                                       BST         10
BE24 94 06 92               .BYTE        148,6,146
                    ;                                                       C           11
BE27 18                     .BYTE        24
                    ;                                                       CALL        12
BE28 48 6A                  .BYTE        72,106
                    ;                                                       CDEG        13
BE2A A5 8C 30               .BYTE        165,140,48
                    ;                                                       CHGSGN      14

BE2D 19 80 50               .BYTE        25,128,80,25,1
BE30 19 01
                    ;                                                       CLCALL      15
BE32 76 8A 86               .BYTE        118,138,134,170
BE35 AA
                    ;                                                       CLINT       16
BE36 58 AD 72               .BYTE        88,173,114
                    ;                                                       CLMEM       17
BE39 58 AE 3E               .BYTE        88,174,62
                    ;                                                       CLPROG      18
BE3C 78 AB 45               .BYTE        120,171,69,1
BE3F 01
                    ;                                                       CLR         19
BE40 38 A4                  .BYTE        56,164
                    ;                                                       CLSTAT      20
BE42 68 A9 26               .BYTE        104,169,38
                    ;                                                       CLX         21
BE45 24 8A 02               .BYTE        36,138,2
                    ;                                                       CM          22
BE48 28                     .BYTE        40
                    ;                                                       CMPND       23
BE49 E5 8E B7               .BYTE        229,142,183
                    ;                                                       COMP        24
BE4C C4 85 EB               .BYTE        196,133,235
                    ;                                                       CONT        25
BE4F 48 57                  .BYTE        72,87
                    ;                                                       COS         26
BE51 23 85                  .BYTE        35,133
                    ;                                                       CRAD        27
BE53 94 84 6C               .BYTE        148,132,108
                    ;                                                       CUP         28
BE56 38 FB                  .BYTE        56,251
                    ;                                                       DEC         29
BE58 3C 38                  .BYTE        60,56
                    ;                                                       DEG         30
BE5A 4C 30                  .BYTE        76,48
                    ;                                                       DEL         31
BE5C 13 C3                  .BYTE        19,195
                    ;                                                       END         32
BE5E A3 37                  .BYTE        163,55
                    ;                                                       ENTER       33
BE60 C5 37 23               .BYTE        197,55,35
                    ;                                                       EXPE        34
BE63 45 30 2B               .BYTE        69,48,43
                    ;                                                       EXPTEN      35
BE66 37 30 2B               .BYTE        55,48,43,35
BE69 23
                    ;                                                       F           36
BE6A 72 00                  .BYTE        114,0
                    ;                                                       FACT        37
BE6C 50 06 82               .BYTE        80,6,130
                    ;                                                       FIND        38
BE6F 50 0D 7C               .BYTE        80,13,124
                    ;                                                       FIX         39
BE72 50 0D 02               .BYTE        80,13,2
                    ;                                                       FLOZ        40
BE75 60 0A 50               .BYTE        96,10,80
                    ;                                                       FRAC        41
BE78 A5 00 46               .BYTE        165,0,70
                    ;                                                       FT          42
BE7B 83 00                  .BYTE        131,0
                    ;                                                       FV          43
BE7D 24 00 04               .BYTE        36,0,4
                    ;                                                       FVDUE       44
BE80 70 00 4C               .BYTE        112,0,76,243
BE83 F3
                    ;                                                       FVORD       45
BE84 70 00 45               .BYTE        112,0,69,76
BE87 4C
                    ;                                                       GAL         46
BE88 40 16                  .BYTE        64,22
                    ;                                                       GM          47
BE8A A3 01                  .BYTE        163,1
                    ;                                                       GOTO        48
BE8C E5 01 52               .BYTE        229,1,82
                    ;                                                       HEX         49
BE8F 55 05 30               .BYTE        85,5,48
                    ;                                                       I           50
BE92 21                     .BYTE        33
                    ;                                                       IN          51
BE93 D2 D7                  .BYTE        210,215
                    ;                                                       INS         52
BE95 3D 79                  .BYTE        61,121
                    ;                                                       INT         53
BE97 3D 72                  .BYTE        61,114
                    ;                                                       KG          54
BE99 40 70                  .BYTE        64,112
                    ;                                                       KM          55
BE9B 13 07                  .BYTE        19,7
                    ;                                                       L           56
BE9D E1                     .BYTE        225
                    ;                                                       LB          57
BE9E A3 A0                  .BYTE        163,160
                    ;                                                       LIST        58
BEA0 64 AD 92               .BYTE        100,173,146
                    ;                                                       LN          59
BEA3 2A                     .BYTE        42
                    ;                                                       LOAD        60
BEA4 74 A5 6C               .BYTE        116,165,108
                    ;                                                       LOGTEN      61
BEA7 7A 50 12               .BYTE        122,80,18,55
BEAA 37
                    ;                                                       LSHF        62
BEAB 6A 90 50               .BYTE        106,144,80
                    ;                                                       M           63
BEAE 01                     .BYTE        1
                    ;                                                       MI          64
BEAF E2 ED                  .BYTE        226,237
                    ;                                                       MOD         65
BEB1 3E 5C                  .BYTE        62,92
                    ;                                                       N           66
BEB3 17                     .BYTE        23
                    ;                                                       NOP         67
BEB4 37 5B                  .BYTE        55,91
                    ;                                                       NOTRC       68
BEB6 57 52 48               .BYTE        87,82,72
                    ;                                                       NWT         69
BEB9 47 08                  .BYTE        71,8
                    ;                                                       OCT         70
BEBB 23 58                  .BYTE        35,88
                    ;                                                       OFF         71
BEBD 25 50 00               .BYTE        37,80,0
                    ;                                                       ON          72
BEC0 02 57                  .BYTE        2,87
                    ;                                                       OR          73
BEC2 25                     .BYTE        37
                    ;                                                       OZ          74
BEC3 43 50                  .BYTE        67,80
                    ;                                                       PAUSE       75
BEC5 A5 B6 F9               .BYTE        165,182,249
                    ;                                                       PI          76
BEC8 32 BD                  .BYTE        50,189
                    ;                                                       PMT         77
BECA 3B E2                  .BYTE        59,226
                    ;                                                       POLAR       78
BECC 5B 5A 64               .BYTE        91,90,100
                    ;                                                       POP         79
BECF 3B 5B                  .BYTE        59,91
                    ;                                                       POPC        80
BED1 4B 5B                  .BYTE        75,91
                    ;                                                       POWER       81
BED3 86 B5 08               .BYTE        134,181,8,52
BED6 34
                    ;                                                       PRINT       82
BED7 5B 4D 72               .BYTE        91,77,114
                    ;                                                       PROG        83
BEDA 5B 45 01               .BYTE        91,69,1
                    ;                                                       PUSH        84
BEDD 5B F9 05               .BYTE        91,249,5
                    ;                                                       PV          85
BEE0 3B 04                  .BYTE        59,4
                    ;                                                       PVDUE       86
BEE2 6B 04 CF               .BYTE        107,4,207
                    ;                                                       PVORD       87
BEE5 36 B0 45               .BYTE        54,176,69,76
BEE8 4C
                    ;                                                       QT          88
BEE9 30 92                  .BYTE        48,146
                    ;                                                       R           89
BEEB 14                     .BYTE        20
                    ;                                                       RAD         90
BEEC 34 6C                  .BYTE        52,108
                    ;                                                       RCL         91
BEEE 34 8A                  .BYTE        52,138
                    ;                                                       RECIP       92
BEF0 54 38 DB               .BYTE        84,56,219
                    ;                                                       RECT        93
BEF3 44 38                  .BYTE        68,56
                    ;                                                       RETURN      94
BEF5 26 43 2F               .BYTE        38,67,47,71
BEF8 47
                    ;                                                       ROOT        95
BEF9 44 55                  .BYTE        68,85
                    ;                                                       ROUND       96
BEFB 25 45 F7               .BYTE        37,69,247
                    ;                                                       RPN         97
BEFE C3 4B                  .BYTE        195,75
                    ;                                                       RSHF        98
BF00 76 49 05               .BYTE        118,73,5,0
BF03 00
                    ;                                                       RST         99
BF04 34 92                  .BYTE        52,146
                    ;                                                       RUN         100
BF06 34 F7                  .BYTE        52,247
                    ;                                                       SAVE        101
BF08 59 60 43               .BYTE        89,96,67
                    ;                                                       SIN         102
BF0B 39 D7                  .BYTE        57,215
                    ;                                                       SLOPE       103
BF0D 59 A5 B3               .BYTE        89,165,179
                    ;                                                       SMINUS      104
BF10 69 ED 7F               .BYTE        105,237,127
                    ;                                                       SPLUS       105
BF13 95 9B AF               .BYTE        149,155,175
                    ;                                                       SQRT        106
BF16 95 90 94               .BYTE        149,144,148
                    ;                                                       SQUARE      107
BF19 27 90 9F               .BYTE        39,144,159,100
BF1C 64
                    ;                                                       SST         108
BF1D 33 99                  .BYTE        51,153
                    ;                                                       STO         109
BF1F 23 92                  .BYTE        35,146
                    ;                                                       STP         110
BF21 53 92                  .BYTE        83,146
                    ;                                                       SUM         111
BF23 B3 9F                  .BYTE        179,159
                    ;                                                       TAN         112
BF25 E3 26                  .BYTE        227,38
                    ;                                                       TBSP        113
BF27 75 20 69               .BYTE        117,32,105
                    ;                                                       TRACE       114
BF2A B5 24 68               .BYTE        181,36,104
                    ;                                                       TRUNC       115
BF2D 35 24 F7               .BYTE        53,36,247
                    ;                                                       TSP         116
BF30 83 29                  .BYTE        131,41
                    ;                                                       X           117
BF32 B2 02                  .BYTE        178,2
                    ;                                                       XCHGY       118
BF34 90 28 05               .BYTE        144,40,5,1,3
BF37 01 03
                    ;                                                       XCHM        119
BF39 60 28 05               .BYTE        96,40,5
                    ;                                                       XEQ 120
BF3C E5 02 30               .BYTE        229,2,48
                    ;                                                       XGE 121
BF3F 95 02 01               .BYTE        149,2,1
                    ;                                                       XLT 122
BF42 34 02 A2               .BYTE        52,2,162
                    ;                                                       XMEAN 123
BF45 60 2E 36               .BYTE        96,46,54
                    ;                                                       XNE 124
BF48 74 02 73               .BYTE        116,2,115
                    ;                                                       XOR 125
BF4B 40 25                  .BYTE        64,37
                    ;                                                       XSD 126
BF4D 44 02 9C               .BYTE        68,2,156
                    ;                                                       XVAR 127
BF50 60 20 46               .BYTE        96,32,70
                    ;                                                       Y 128
BF53 42 03                  .BYTE        66,3
                    ;                                                       YD 129
BF55 30 3C                  .BYTE        48,60
                    ;                                                       YINT 130
BF57 50 3D 72               .BYTE        80,61,114
                    ;                                                       YMEAN 131
BF5A 60 3E 36               .BYTE        96,62,54
                    ;                                                       YSD 132
BF5D 74 03 9C               .BYTE        116,3,156
                    ;                                                       YVAR 133
BF60 60 30 46               .BYTE        96,48,70,64
BF63 40
0086                STAR    =       134
0051                POWER   =       81
0025                FACTOR  =       37
0041                MOD     =       65
000A                BSTEP   =       10
0012                CLPROG  =       18
0020                ZEND    =       32
0053                PROGRAM =       83
006C                SSTEP   =       108
006E                STP     =       110
0034                INSERT  =       52
001F                DELETE  =       31
003A                LIST    =       58
0065                SAVE    =       101
003C                LOAD    =       60
0021                ENTER   =       33
0063                RST     =       99

BF64                PRIOTB
                    ;                                                       ACOS          0
BF64 DD EE E6               .BYTE          221,238,230,221,237,237,237,222,238,237
BF67 DD ED ED
BF6A ED DE EE
BF6D ED
                    ;                                                       CLX           0
BF6E ED EE DE               .BYTE          237,238,222,221,237,238,238,221,221,237
BF71 DD ED EE
BF74 EE DD DD
BF77 ED
                    ;                                                       FRAC          0
BF78 ED EE EE               .BYTE          237,238,238,238,237,222,237,238,238,237
BF7B EE ED DE
BF7E ED EE EE
BF81 ED
                    ;                                                       LOGTEN        0
BF82 ED AE EA               .BYTE          237,174,234,238,238,222,229,238,222,221
BF85 EE EE DE
BF88 E5 EE DE
BF8B DD
                    ;                                                       POWER         0
BF8C E9 EE EE               .BYTE          233,238,238,238,237,237,221,233,222,174
BF8F EE ED ED
BF92 DD E9 DE
BF95 AE
                    ;                                                       SAVE          0
BF96 EE DD DD               .BYTE          238,221,221,221,238,237,222,237,237,221
BF99 DD EE ED
BF9C DE ED ED
BF9F DD
                    ;                                                       XGE           0
BFA0 DD DD D5               .BYTE          221,221,213,221,222,221,221,136,119,34,16
BFA3 DD DE DD
BFA6 DD 88 77
BFA9 22 10
BFAB                SSMINU                          ;SIGMA MINUS (DELETE PREVIOUS ENTRY)
BFAB A9 01                  LDA     #1
BFAD D0 02                  BNE     SIGSUB          ;JMP
BFAF                SSPLUS                          ;SIGMA PLUS: ADD NEW X,Y PAIR
BFAF A9 00                  LDA     #0
BFB1                SIGSUB                          ;THIS PART IS COMMON TO BOTH SSMINU AND SSPLUS
BFB1 85 C8                  STA     MEMFLG
BFB3 20 BB 9F               JSR     FPUSH0
BFB6 A9 01                  LDA     #1
BFB8 20 B9 A1               JSR     PSET0           ;N <- N+1
BFBB A9 04                  LDA     #4
BFBD 20 AA AF               JSR     MEMADD

BFC0 A9 05                  LDA     #5              ;SIGMA X
BFC2 20 97 AF               JSR     ZSIGMA          ;COMPUTE SIGMA X, SIGMA X SQUARED
BFC5 20 86 9F               JSR     FPOP1           ;LOAD X
BFC8 20 18 9F               JSR     FLD0S           ;LOAD Y (& LEAVE ON STACK)
BFCB 20 97 A8               JSR     SFMUL
BFCE A9 09                  LDA     #9              ;SIGMA (X*Y)

BFD0 20 AA AF               JSR     MEMADD
BFD3 A9 07                  LDA     #7              ;SIGMA Y
BFD5 20 97 AF               JSR     ZSIGMA          ;COMPUTE SIGMA Y, SIGMA Y SQUARED
BFD8 4C 9D 9F               JMP     FPOP0           ;Y -> X

BFDB                SINMOD                          ;FIND ANGLE MOD 2*PI, 360 OR 400
BFDB 20 BB 9F               JSR     FPUSH0          ;DEPENDING ON CURRENT MODE. SAVE FR0 ON STACK FOR MOD
BFDE 20 F1 A3               JSR     PIOVL           ;LOAD PI/2, 90, OR 100
BFE1 20 89 DD               JSR     FLD0R
BFE4 A9 04                  LDA     #4
BFE6 20 84 A8               JSR     INTMUL          ;MULTIPLY BY 4 (LOSE ACCURACY IN 10TH DIGIT OF 2*PI)
BFE9 4C E8 A6               JMP     SMOD            ;TAKE MOD AND RETURN
BFEC 20 E1 AF       SXSTDD  JSR     SXVARI          ;STANDARD DEVIATION (X) <- SQRT(VARIANCE(X))
BFEF 4C A7 B1               JMP     SSQRT
BFF2 20 E5 AF       SYSTDD  JSR     SYVARI          ;STDDEV(Y) <- SORT(VAR(Y))
BFF5 4C A7 B1               JMP     SSQRT

                     *=$A000+$2000-6                ;CARTRIDGE START INFO
BFFA 4A 98                  .WORD   START           ;COLD/WARM START ADDRESS
BFFC 00 05                  .BYTE   0,4+1           ;BOOT DISK &RUN CARTRIDGE
BFFE B4 9B                  .WORD   INIT            ;POWER UP START VECTOR
                            .END