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