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 FOR 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) = SQR(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               JSR     FSUB            ;CHECK CARRY TO SEE IF THERE IS AN ERROR 
A30A                CRYCHK 
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) 
001D                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 
008E                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                OPSLEN  =       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 (ALL OF ABOVE) 
009F                T1      *=*+1           ;TEMP VAR USED IN SCLINT&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) 

                    ;                               FP TO ASCII CONVERSION VARS 

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 NUMBER 
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 OP 
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          ;SAVE "." 
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                           ;DISPLAY NUMBER ON SCREEN ONLY, IN COL A 
9D7B 85 55                  STA     COLCRS 
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, 5X10^-((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 BUFFER 
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? 
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           ;JMP 
9ECE                RF148 
9ECE 98                     TYA 
9ECF 18                     CLC                     ;COMPUTE WHERE END OF NUMBER SHOULD BE 
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 0'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          ;LOAD AND STORE JSR ADDRESS 
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     DHO10 
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                DHO10 
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. SPECIAL 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 FOR 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(SQRT(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 OR 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            ;X<0: TAKE ABSOLUTE VALUE AND SHIFT IN OPPOSITE DIRECTION 
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                SSTO10 
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     SSTO10 
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+I) 
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/OUTPUT 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     SSTO10          ;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     SSTO10 
AE6F A9 64                  LDA     #100 
AE71 20 84 A8               JSR     INTMUL 
AE74 A9 04                  LDA     #4              ;FIX 4 FOR I IN PERCENT (DISPLAY) 
AE76 4C 6B A5               JMP     SFIX2           ;AND RETURN 
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 PMT 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*(I+1)+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+I) 
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     SSTO10          ;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                     NO ERROR CLEAR 
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->FSCR1 
B1EE 20 B6 DD               JSR     FMOVE           ;Y->FR1 
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 
                            .PAGE 
                    HYPSUB                          ;FR0 <- EXPE(X), FR1 <- EXPE(-X) 
                    ;                                       FOR COSH, SINH 
                            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 
                    SDCDEG                          ;DECIMAL DEG -> DMS 
                            LDA     #ZDCDEG 
                            LDX     #60 
                            LDY     #100 
                    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          ;Y%X = (X*Y)/100        (ORDERING IS UNIMPORTANT) 
                            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 + I) 
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,$73 ;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) <- SQRT(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