topicchi/SyncHome
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
SyncHome/trunk/workspace/AVR-Computer/AVR65C02/SBC2OS/SBC25.LST
paolo.iocco f29dcc4188 daily_automated
2023-03-13 08:36:51 +00:00

11625 lines
782 KiB
Plaintext
Raw Permalink Blame History

6502/65C02 Turbo Assembler listing file of "sbc.asm"
done on Sat Jul 06 15:40:09 2013
>4002 ff .byte $ff
.9e00 a9 00 lda #$00 _CSTART LDA #$00 ; REVERSE TOGGLE
.9e02 85 b7 sta $b7 STA REV
.9e04 85 fd sta $fd sta hist
.9e06 d8 cld CHESS CLD ; INITIALIZE
.9e07 a2 ff ldx #$ff LDX #$FF ; TWO STACKS
.9e09 9a txs TXS
.9e0a a2 c8 ldx #$c8 LDX #$C8
.9e0c 86 b2 stx $b2 STX SP2
.9e0e 20 c1 a1 jsr $a1c1 _OUT JSR pout ; DISPLAY AND
.9e11 20 ad a2 jsr $a2ad JSR KIN ; GET _INPUT *** my routine waits for a keypress
.9e14 c9 43 cmp #$43 CMP #$43 ; [C]
.9e16 d0 12 bne $9e2a BNE NOSET ; SET UP
.9e18 a2 1f ldx #$1f LDX #$1F ; BOARD
.9e1a bd 26 a4 lda $a426,x WHSET LDA SETW,X ; FROM
.9e1d 95 50 sta $50,x STA BOARD,X ; SETW
.9e1f ca dex DEX
.9e20 10 f8 bpl $9e1a BPL WHSET
.9e22 a2 1b ldx #$1b LDX #$1B ; *ADDED
.9e24 86 dc stx $dc STX OMOVE ; INITS TO $FF
.9e26 a9 cc lda #$cc LDA #$CC ; Display CCC
.9e28 d0 19 bne $9e43 BNE CLDSP
.9e2a c9 45 cmp #$45 NOSET CMP #$45 ; [E]
.9e2c d0 0e bne $9e3c BNE NOREV ; REVERSE
.9e2e 20 cb 9f jsr $9fcb JSR REVERSE ; BOARD IS
.9e31 38 sec SEC
.9e32 a9 01 lda #$01 LDA #$01
.9e34 e5 b7 sbc $b7 SBC REV
.9e36 85 b7 sta $b7 STA REV ; TOGGLE REV FLAG
.9e38 a9 ee lda #$ee LDA #$EE ; IS
.9e3a d0 07 bne $9e43 BNE CLDSP
.9e3c c9 40 cmp #$40 NOREV CMP #$40 ; [P]
.9e3e d0 0b bne $9e4b BNE NOGO ; PLAY CHESS
.9e40 20 bf a0 jsr $a0bf JSR GO
.9e43 85 fb sta $fb CLDSP STA DIS1 ; DISPLAY
.9e45 85 fa sta $fa STA DIS2 ; ACROSS
.9e47 85 f9 sta $f9 STA DIS3 ; DISPLAY
.9e49 d0 bb bne $9e06 BNE CHESS
.9e4b c9 0d cmp #$0d NOGO CMP #$0D ; [Enter]
.9e4d d0 09 bne $9e58 BNE NOMV ; MOVE MAN
.9e4f 20 65 a0 jsr $a065 JSR MOVE ; AS ENTERED
.9e52 20 85 a1 jsr $a185 jsr addhist ; add move to history
.9e55 4c 07 9f jmp $9f07 JMP DISP
.9e58 c9 41 cmp #$41 NOMV CMP #$41 ; [Q] ***Added to allow game exit***
.9e5a f0 0e beq $9e6a BEQ _DONE ; quit the game, exit back to system.
.9e5c c9 42 cmp #$42 cmp #$42 ; [B] Undo move
.9e5e d0 07 bne $9e67 bne Noud ;
.9e60 20 a3 a1 jsr $a1a3 jsr Undo ; undo last move
.9e63 a9 bb lda #$bb LDA #$BB ; undo
.9e65 d0 dc bne $9e43 BNE CLDSP
.9e67 4c 00 9f jmp $9f00 Noud JMP _INPUT ; process move
.9e6a 6c f7 03 jmp ($03f7) _DONE JMP (RESvector) ; exit back to SBC's Monitor
.9e6d a6 b5 ldx $b5 JANUS LDX _STATE
.9e6f 30 59 bmi $9eca BMI NO_COUNT
.9e71 a5 b0 lda $b0 _COUNTS LDA PIECE
.9e73 f0 08 beq $9e7d BEQ _OVER ; IF _STATE=8
.9e75 e0 08 cpx #$08 CPX #$08 ; DO NOT _COUNT
.9e77 d0 04 bne $9e7d BNE _OVER ; BLK MAX CAP
.9e79 c5 e6 cmp $e6 CMP BMAXP ; MOVES FOR
.9e7b f0 2e beq $9eab BEQ XRT ; WHITE
.9e7d f6 e3 inc $e3,x _OVER INC MOB,X ; MOBILITY
.9e7f c9 01 cmp #$01 CMP #$01 ; + QUEEN
.9e81 d0 02 bne $9e85 BNE NOQ ; FOR TWO
.9e83 f6 e3 inc $e3,x INC MOB,X
.9e85 50 1e bvc $9ea5 NOQ BVC NOCAP
.9e87 a0 0f ldy #$0f LDY #$0F ; CALCULATE
.9e89 a5 b1 lda $b1 LDA SQUARE ; POINTS
.9e8b d9 60 00 cmp $0060,y ELOOP CMP BK,Y ; CAPTURED
.9e8e f0 03 beq $9e93 BEQ FOUN ; BY THIS
.9e90 88 dey DEY ; MOVE
.9e91 10 f8 bpl $9e8b BPL ELOOP
.9e93 b9 57 a4 lda $a457,y FOUN LDA POINTS,Y
.9e96 d5 e4 cmp $e4,x CMP MAXC,X
.9e98 90 04 bcc $9e9e BCC _LESS ; SAVE IF
.9e9a 94 e6 sty $e6,x STY PCAP,X ; BEST THIS
.9e9c 95 e4 sta $e4,x STA MAXC,X ; _STATE
.9e9e 18 clc _LESS CLC
.9e9f 08 php PHP ; ADD TO
.9ea0 75 e5 adc $e5,x ADC CC,X ; CAPTURE
.9ea2 95 e5 sta $e5,x STA CC,X ; _COUNTS
.9ea4 28 plp PLP
.9ea5 e0 04 cpx #$04 NOCAP CPX #$04
.9ea7 f0 03 beq $9eac BEQ ON4
.9ea9 30 2e bmi $9ed9 BMI TREE ;(=00 ONLY)
.9eab 60 rts XRT RTS
.9eac a5 e8 lda $e8 ON4 LDA XMAXC ; SAVE ACTUAL
.9eae 85 dd sta $dd STA WCAP0 ; CAPTURE
.9eb0 a9 00 lda #$00 LDA #$00 ; _STATE=0
.9eb2 85 b5 sta $b5 STA _STATE
.9eb4 20 65 a0 jsr $a065 JSR MOVE ; GENERATE
.9eb7 20 cb 9f jsr $9fcb JSR REVERSE ; IMMEDIATE
.9eba 20 19 9f jsr $9f19 JSR GNMZ ; REPLY MOVES
.9ebd 20 cb 9f jsr $9fcb JSR REVERSE
.9ec0 a9 08 lda #$08 LDA #$08 ; _STATE=8
.9ec2 85 b5 sta $b5 STA _STATE ; GENERATE
.9ec4 20 4b a0 jsr $a04b JSR UMOVE ; MOVES
.9ec7 4c 1f a1 jmp $a11f JMP STRATGY ; FINAL EVALUATION
.9eca e0 f9 cpx #$f9 NO_COUNT CPX #$F9
.9ecc d0 0b bne $9ed9 BNE TREE
.9ece a5 60 lda $60 LDA BK ; IS KING
.9ed0 c5 b1 cmp $b1 CMP SQUARE ; IN CHECK?
.9ed2 d0 04 bne $9ed8 BNE RETJ ; SET INCHEK=0
.9ed4 a9 00 lda #$00 LDA #$00 ; IF IT IS
.9ed6 85 b4 sta $b4 STA INCHEK
.9ed8 60 rts RETJ RTS
.9ed9 50 fd bvc $9ed8 TREE BVC RETJ ; NO CAP
.9edb a0 07 ldy #$07 LDY #$07 ; (PIECES)
.9edd a5 b1 lda $b1 LDA SQUARE
.9edf d9 60 00 cmp $0060,y LOOPX CMP BK,Y
.9ee2 f0 05 beq $9ee9 BEQ FOUNX
.9ee4 88 dey DEY
.9ee5 f0 f1 beq $9ed8 BEQ RETJ ; (KING)
.9ee7 10 f6 bpl $9edf BPL LOOPX ; SAVE
.9ee9 b9 57 a4 lda $a457,y FOUNX LDA POINTS,Y ; BEST CAP
.9eec d5 e2 cmp $e2,x CMP BCAP0,X ; AT THIS
.9eee 90 02 bcc $9ef2 BCC NOMAX ; LEVEL
.9ef0 95 e2 sta $e2,x STA BCAP0,X
.9ef2 c6 b5 dec $b5 NOMAX DEC _STATE
.9ef4 a9 fb lda #$fb LDA #$FB ; IF _STATE=FB
.9ef6 c5 b5 cmp $b5 CMP _STATE ; TIME TO TURN
.9ef8 f0 03 beq $9efd BEQ UPTREE ; AROUND
.9efa 20 3f a0 jsr $a03f JSR GENRM ; GENERATE FURTHER
.9efd e6 b5 inc $b5 UPTREE INC _STATE ; CAPTURES
.9eff 60 rts RTS
.9f00 c9 08 cmp #$08 _INPUT CMP #$08 ; NOT A LEGAL
.9f02 b0 12 bcs $9f16 BCS _ERROR ; SQUARE #
.9f04 20 0f a1 jsr $a10f JSR DISMV
.9f07 a2 1f ldx #$1f DISP LDX #$1F
.9f09 b5 50 lda $50,x SEARCH LDA BOARD,X
.9f0b c5 fa cmp $fa CMP DIS2
.9f0d f0 03 beq $9f12 BEQ _HERE ; DISPLAY
.9f0f ca dex DEX ; PIECE AT
.9f10 10 f7 bpl $9f09 BPL SEARCH ; FROM
.9f12 86 fb stx $fb _HERE STX DIS1 ; SQUARE
.9f14 86 b0 stx $b0 STX PIECE
.9f16 4c 06 9e jmp $9e06 _ERROR JMP CHESS
.9f19 a2 10 ldx #$10 GNMZ LDX #$10 ; CLEAR
.9f1b a9 00 lda #$00 GNMX LDA #$00 ; _COUNTERS
.9f1d 95 de sta $de,x CLEAR STA _COUNT,X
.9f1f ca dex DEX
.9f20 10 fb bpl $9f1d BPL CLEAR
.9f22 a9 10 lda #$10 GNM LDA #$10 ; SET UP
.9f24 85 b0 sta $b0 STA PIECE ; PIECE
.9f26 c6 b0 dec $b0 NEWP DEC PIECE ; NEW PIECE
.9f28 10 01 bpl $9f2b BPL NEX ; ALL _DONE?
.9f2a 60 rts RTS ; #NAME?
.9f2b 20 38 a0 jsr $a038 NEX JSR _RESET ; READY
.9f2e a4 b0 ldy $b0 LDY PIECE ; GET PIECE
.9f30 a2 08 ldx #$08 LDX #$08
.9f32 86 b6 stx $b6 STX MOVEN ; COMMON START
.9f34 c0 08 cpy #$08 CPY #$08 ; WHAT IS IT?
.9f36 10 41 bpl $9f79 BPL PAWN ; PAWN
.9f38 c0 06 cpy #$06 CPY #$06
.9f3a 10 2e bpl $9f6a BPL KNIGHT ; KNIGHT
.9f3c c0 04 cpy #$04 CPY #$04
.9f3e 10 1f bpl $9f5f BPL BISHOP ; BISHOP
.9f40 c0 01 cpy #$01 CPY #$01
.9f42 f0 09 beq $9f4d BEQ QUEEN ; QUEEN
.9f44 10 0e bpl $9f54 BPL ROOK ; ROOK
.9f46 20 a7 9f jsr $9fa7 KING JSR SNGMV ; MUST BE KING!
.9f49 d0 fb bne $9f46 BNE KING ; MOVES
.9f4b f0 d9 beq $9f26 BEQ NEWP ; 8 TO 1
.9f4d 20 b5 9f jsr $9fb5 QUEEN JSR LINE
.9f50 d0 fb bne $9f4d BNE QUEEN ; MOVES
.9f52 f0 d2 beq $9f26 BEQ NEWP ; 8 TO 1
.9f54 a2 04 ldx #$04 ROOK LDX #$04
.9f56 86 b6 stx $b6 STX MOVEN ; MOVES
.9f58 20 b5 9f jsr $9fb5 AGNR JSR LINE ; 4 TO 1
.9f5b d0 fb bne $9f58 BNE AGNR
.9f5d f0 c7 beq $9f26 BEQ NEWP
.9f5f 20 b5 9f jsr $9fb5 BISHOP JSR LINE
.9f62 a5 b6 lda $b6 LDA MOVEN ; MOVES
.9f64 c9 04 cmp #$04 CMP #$04 ; 8 TO 5
.9f66 d0 f7 bne $9f5f BNE BISHOP
.9f68 f0 bc beq $9f26 BEQ NEWP
.9f6a a2 10 ldx #$10 KNIGHT LDX #$10
.9f6c 86 b6 stx $b6 STX MOVEN ; MOVES
.9f6e 20 a7 9f jsr $9fa7 AGNN JSR SNGMV ; 16 TO 9
.9f71 a5 b6 lda $b6 LDA MOVEN
.9f73 c9 08 cmp #$08 CMP #$08
.9f75 d0 f7 bne $9f6e BNE AGNN
.9f77 f0 ad beq $9f26 BEQ NEWP
.9f79 a2 06 ldx #$06 PAWN LDX #$06
.9f7b 86 b6 stx $b6 STX MOVEN
.9f7d 20 e3 9f jsr $9fe3 P1 JSR _CMOVE ; RIGHT CAP?
.9f80 50 05 bvc $9f87 BVC P2
.9f82 30 03 bmi $9f87 BMI P2
.9f84 20 6d 9e jsr $9e6d JSR JANUS ; YES
.9f87 20 38 a0 jsr $a038 P2 JSR _RESET
.9f8a c6 b6 dec $b6 DEC MOVEN ; LEFT CAP?
.9f8c a5 b6 lda $b6 LDA MOVEN
.9f8e c9 05 cmp #$05 CMP #$05
.9f90 f0 eb beq $9f7d BEQ P1
.9f92 20 e3 9f jsr $9fe3 P3 JSR _CMOVE ; AHEAD
.9f95 70 8f bvs $9f26 BVS NEWP ; ILLEGAL
.9f97 30 8d bmi $9f26 BMI NEWP
.9f99 20 6d 9e jsr $9e6d JSR JANUS
.9f9c a5 b1 lda $b1 LDA SQUARE ; GETS TO
.9f9e 29 f0 and #$f0 AND #$F0 ; 3RD RANK?
.9fa0 c9 20 cmp #$20 CMP #$20
.9fa2 f0 ee beq $9f92 BEQ P3 ; DO DOUBLE
.9fa4 4c 26 9f jmp $9f26 JMP NEWP
.9fa7 20 e3 9f jsr $9fe3 SNGMV JSR _CMOVE ; CALC MOVE
.9faa 30 03 bmi $9faf BMI ILL1 ; -IF LEGAL
.9fac 20 6d 9e jsr $9e6d JSR JANUS ; -EVALUATE
.9faf 20 38 a0 jsr $a038 ILL1 JSR _RESET
.9fb2 c6 b6 dec $b6 DEC MOVEN
.9fb4 60 rts RTS
.9fb5 20 e3 9f jsr $9fe3 LINE JSR _CMOVE ; CALC MOVE
.9fb8 90 02 bcc $9fbc BCC OVL ; NO CHK
.9fba 50 f9 bvc $9fb5 BVC LINE ; NOCAP
.9fbc 30 07 bmi $9fc5 OVL BMI ILL ; RETURN
.9fbe 08 php PHP
.9fbf 20 6d 9e jsr $9e6d JSR JANUS ; EVALUATE POSN
.9fc2 28 plp PLP
.9fc3 50 f0 bvc $9fb5 BVC LINE ; NOT A CAP
.9fc5 20 38 a0 jsr $a038 ILL JSR _RESET ; LINE STOPPED
.9fc8 c6 b6 dec $b6 DEC MOVEN ; NEXT DIR
.9fca 60 rts RTS
.9fcb a2 0f ldx #$0f REVERSE LDX #$0F
.9fcd 38 sec ETC SEC
.9fce b4 60 ldy $60,x LDY BK,X ; SUBTRACT
.9fd0 a9 77 lda #$77 LDA #$77 ; POSITION
.9fd2 f5 50 sbc $50,x SBC BOARD,X ; FROM 77
.9fd4 95 60 sta $60,x STA BK,X
.9fd6 94 50 sty $50,x STY BOARD,X ; AND
.9fd8 38 sec SEC
.9fd9 a9 77 lda #$77 LDA #$77 ; EXCHANGE
.9fdb f5 50 sbc $50,x SBC BOARD,X ; PIECES
.9fdd 95 50 sta $50,x STA BOARD,X
.9fdf ca dex DEX
.9fe0 10 eb bpl $9fcd BPL ETC
.9fe2 60 rts RTS
.9fe3 a5 b1 lda $b1 _CMOVE LDA SQUARE ; GET SQUARE
.9fe5 a6 b6 ldx $b6 LDX MOVEN ; MOVE POINTER
.9fe7 18 clc CLC
.9fe8 7d 46 a4 adc $a446,x ADC MOVEX,X ; MOVE LIST
.9feb 85 b1 sta $b1 STA SQUARE ; NEW POS'N
.9fed 29 88 and #$88 AND #$88
.9fef d0 42 bne $a033 BNE ILLEGAL ; OFF BOARD
.9ff1 a5 b1 lda $b1 LDA SQUARE
.9ff3 a2 20 ldx #$20 LDX #$20
.9ff5 ca dex LOOP DEX ; IS TO
.9ff6 30 0e bmi $a006 BMI NO ; SQUARE
.9ff8 d5 50 cmp $50,x CMP BOARD,X ; OCCUPIED?
.9ffa d0 f9 bne $9ff5 BNE LOOP
.9ffc e0 10 cpx #$10 CPX #$10 ; BY SELF?
.9ffe 30 33 bmi $a033 BMI ILLEGAL
.a000 a9 7f lda #$7f LDA #$7F ; MUST BE CAP!
.a002 69 01 adc #$01 ADC #$01 ; SET V FLAG
.a004 70 01 bvs $a007 BVS SPX ; (JMP)
.a006 b8 clv NO CLV ; NO CAPTURE
.a007 a5 b5 lda $b5 SPX LDA _STATE ; SHOULD WE
.a009 30 24 bmi $a02f BMI RETL ; DO THE
.a00b c9 08 cmp #$08 CMP #$08 ; CHECK CHECK?
.a00d 10 20 bpl $a02f BPL RETL
.a00f 48 pha CHKCHK PHA ; _STATE #392
.a010 08 php PHP
.a011 a9 f9 lda #$f9 LDA #$F9
.a013 85 b5 sta $b5 STA _STATE ; GENERATE
.a015 85 b4 sta $b4 STA INCHEK ; ALL REPLY
.a017 20 65 a0 jsr $a065 JSR MOVE ; MOVES TO
.a01a 20 cb 9f jsr $9fcb JSR REVERSE ; SEE IF KING
.a01d 20 22 9f jsr $9f22 JSR GNM ; IS IN
.a020 20 48 a0 jsr $a048 JSR RUM ; CHECK
.a023 28 plp PLP
.a024 68 pla PLA
.a025 85 b5 sta $b5 STA _STATE
.a027 a5 b4 lda $b4 LDA INCHEK
.a029 30 04 bmi $a02f BMI RETL ; NO - SAFE
.a02b 38 sec SEC ; YES - IN CHK
.a02c a9 ff lda #$ff LDA #$FF
.a02e 60 rts RTS
.a02f 18 clc RETL CLC ; LEGAL
.a030 a9 00 lda #$00 LDA #$00 ; RETURN
.a032 60 rts RTS
.a033 a9 ff lda #$ff ILLEGAL LDA #$FF
.a035 18 clc CLC ; ILLEGAL
.a036 b8 clv CLV ; RETURN
.a037 60 rts RTS
.a038 a6 b0 ldx $b0 _RESET LDX PIECE ; GET LOGAT
.a03a b5 50 lda $50,x LDA BOARD,X ; FOR PIECE
.a03c 85 b1 sta $b1 STA SQUARE ; FROM BOARD
.a03e 60 rts RTS
.a03f 20 65 a0 jsr $a065 GENRM JSR MOVE ; MAKE MOVE
.a042 20 cb 9f jsr $9fcb GENR2 JSR REVERSE ; REVERSE BOARD
.a045 20 22 9f jsr $9f22 JSR GNM ; GENERATE MOVES
.a048 20 cb 9f jsr $9fcb RUM JSR REVERSE ; REVERSE BACK
.a04b ba tsx UMOVE TSX ; UNMAKE MOVE
.a04c 86 b3 stx $b3 STX SP1
.a04e a6 b2 ldx $b2 LDX SP2 ; EXCHANGE
.a050 9a txs TXS ; STACKS
.a051 68 pla PLA ; MOVEN
.a052 85 b6 sta $b6 STA MOVEN
.a054 68 pla PLA ; CAPTURED
.a055 85 b0 sta $b0 STA PIECE ; PIECE
.a057 aa tax TAX
.a058 68 pla PLA ; FROM SQUARE
.a059 95 50 sta $50,x STA BOARD,X
.a05b 68 pla PLA ; PIECE
.a05c aa tax TAX
.a05d 68 pla PLA ; TO SOUARE
.a05e 85 b1 sta $b1 STA SQUARE
.a060 95 50 sta $50,x STA BOARD,X
.a062 4c 8a a0 jmp $a08a JMP STRV
.a065 ba tsx MOVE TSX
.a066 86 b3 stx $b3 STX SP1 ; SWITCH
.a068 a6 b2 ldx $b2 LDX SP2 ; STACKS
.a06a 9a txs TXS
.a06b a5 b1 lda $b1 LDA SQUARE
.a06d 48 pha PHA ; TO SQUARE
.a06e a8 tay TAY
.a06f a2 1f ldx #$1f LDX #$1F
.a071 d5 50 cmp $50,x CHECK CMP BOARD,X ; CHECK FOR
.a073 f0 03 beq $a078 BEQ TAKE ; CAPTURE
.a075 ca dex DEX
.a076 10 f9 bpl $a071 BPL CHECK
.a078 a9 cc lda #$cc TAKE LDA #$CC
.a07a 95 50 sta $50,x STA BOARD,X
.a07c 8a txa TXA ; CAPTURED
.a07d 48 pha PHA ; PIECE
.a07e a6 b0 ldx $b0 LDX PIECE
.a080 b5 50 lda $50,x LDA BOARD,X
.a082 94 50 sty $50,x STY BOARD,X ; FROM
.a084 48 pha PHA ; SQUARE
.a085 8a txa TXA
.a086 48 pha PHA ; PIECE
.a087 a5 b6 lda $b6 LDA MOVEN
.a089 48 pha PHA ; MOVEN
.a08a ba tsx STRV TSX
.a08b 86 b2 stx $b2 STX SP2 ; SWITCH
.a08d a6 b3 ldx $b3 LDX SP1 ; STACKS
.a08f 9a txs TXS ; BACK
.a090 60 rts RTS
.a091 a4 e4 ldy $e4 CKMATE LDY BMAXC ; CAN BLK CAP
.a093 ec 57 a4 cpx $a457 CPX POINTS ; MY KING?
.a096 d0 04 bne $a09c BNE NOCHEK
.a098 a9 00 lda #$00 LDA #$00 ; GULP!
.a09a f0 0a beq $a0a6 BEQ RETV ; DUMB MOVE!
.a09c a6 e3 ldx $e3 NOCHEK LDX BMOB ; IS BLACK
.a09e d0 06 bne $a0a6 BNE RETV ; UNABLE TO
.a0a0 a6 ee ldx $ee LDX WMAXP ; MOVE AND
.a0a2 d0 02 bne $a0a6 BNE RETV ; KING IN CH?
.a0a4 a9 ff lda #$ff LDA #$FF ; YES! MATE
.a0a6 a2 04 ldx #$04 RETV LDX #$04 ; RESTORE
.a0a8 86 b5 stx $b5 STX _STATE ; _STATE=4
.a0aa c5 fa cmp $fa _PUSH CMP BESTV ; IS THIS BEST
.a0ac 90 0c bcc $a0ba BCC RETP ; MOVE SO FAR?
.a0ae f0 0a beq $a0ba BEQ RETP
.a0b0 85 fa sta $fa STA BESTV ; YES!
.a0b2 a5 b0 lda $b0 LDA PIECE ; SAVE IT
.a0b4 85 fb sta $fb STA BESTP
.a0b6 a5 b1 lda $b1 LDA SQUARE
.a0b8 85 f9 sta $f9 STA BESTM ; FLASH DISPLAY
.a0ba a9 2e lda #$2e RETP LDA #"." ; print ... instead of flashing disp
.a0bc 4c f4 a4 jmp $a4f4 Jmp cout ; print . and return
.a0bf a6 dc ldx $dc GO LDX OMOVE ; OPENING?
.a0c1 30 1c bmi $a0df BMI NOOPEN ; -NO *ADD CHANGE FROM BPL
.a0c3 a5 f9 lda $f9 LDA DIS3 ; -YES WAS
.a0c5 dd 67 a4 cmp $a467,x CMP OPNING,X ; OPPONENT'S
.a0c8 d0 11 bne $a0db BNE END ; MOVE OK?
.a0ca ca dex DEX
.a0cb bd 67 a4 lda $a467,x LDA OPNING,X ; GET NEXT
.a0ce 85 fb sta $fb STA DIS1 ; CANNED
.a0d0 ca dex DEX ; OPENING MOVE
.a0d1 bd 67 a4 lda $a467,x LDA OPNING,X
.a0d4 85 f9 sta $f9 STA DIS3 ; DISPLAY IT
.a0d6 ca dex DEX
.a0d7 86 dc stx $dc STX OMOVE ; MOVE IT
.a0d9 d0 1c bne $a0f7 BNE MV2 ; (JMP)
.a0db a9 ff lda #$ff END LDA #$FF ; *ADD - STOP CANNED MOVES
.a0dd 85 dc sta $dc STA OMOVE ; FLAG OPENING
.a0df a2 0c ldx #$0c NOOPEN LDX #$0C ; FINISHED
.a0e1 86 b5 stx $b5 STX _STATE ; _STATE=C
.a0e3 86 fa stx $fa STX BESTV ; CLEAR BESTV
.a0e5 a2 14 ldx #$14 LDX #$14 ; GENERATE P
.a0e7 20 1b 9f jsr $9f1b JSR GNMX ; MOVES
.a0ea a2 04 ldx #$04 LDX #$04 ; _STATE=4
.a0ec 86 b5 stx $b5 STX _STATE ; GENERATE AND
.a0ee 20 19 9f jsr $9f19 JSR GNMZ ; TEST AVAILABLE
.a0f1 a6 fa ldx $fa LDX BESTV ; GET BEST MOVE
.a0f3 e0 0f cpx #$0f CPX #$0F ; IF NONE
.a0f5 90 15 bcc $a10c BCC MATE ; OH OH!
.a0f7 a6 fb ldx $fb MV2 LDX BESTP ; MOVE
.a0f9 b5 50 lda $50,x LDA BOARD,X ; THE
.a0fb 85 fa sta $fa STA BESTV ; BEST
.a0fd 86 b0 stx $b0 STX PIECE ; MOVE
.a0ff a5 f9 lda $f9 LDA BESTM
.a101 85 b1 sta $b1 STA SQUARE ; AND DISPLAY
.a103 20 65 a0 jsr $a065 JSR MOVE ; IT
.a106 20 85 a1 jsr $a185 jsr addhist ; add move to history
.a109 4c 06 9e jmp $9e06 JMP CHESS
.a10c a9 ff lda #$ff MATE LDA #$FF ; RESIGN
.a10e 60 rts RTS ; OR STALEMATE
.a10f a2 04 ldx #$04 DISMV LDX #$04 ; ROTATE
.a111 06 f9 asl $f9 DROL ASL DIS3 ; KEY
.a113 26 fa rol $fa ROL DIS2 ; INTO
.a115 ca dex DEX ; DISPLAY
.a116 d0 f9 bne $a111 BNE DROL ;
.a118 05 f9 ora $f9 ORA DIS3
.a11a 85 f9 sta $f9 STA DIS3
.a11c 85 b1 sta $b1 STA SQUARE
.a11e 60 rts RTS
.a11f 18 clc STRATGY CLC
.a120 a9 80 lda #$80 LDA #$80
.a122 65 eb adc $eb ADC WMOB ; PARAMETERS
.a124 65 ec adc $ec ADC WMAXC ; WITH WHEIGHT
.a126 65 ed adc $ed ADC WCC ; OF O25
.a128 65 e1 adc $e1 ADC WCAP1
.a12a 65 df adc $df ADC WCAP2
.a12c 38 sec SEC
.a12d e5 f0 sbc $f0 SBC PMAXC
.a12f e5 f1 sbc $f1 SBC PCC
.a131 e5 e2 sbc $e2 SBC BCAP0
.a133 e5 e0 sbc $e0 SBC BCAP1
.a135 e5 de sbc $de SBC BCAP2
.a137 e5 ef sbc $ef SBC PMOB
.a139 e5 e3 sbc $e3 SBC BMOB
.a13b b0 02 bcs $a13f BCS POS ; UNDERFLOW
.a13d a9 00 lda #$00 LDA #$00 ; PREVENTION
.a13f 4a lsr POS LSR
.a140 18 clc CLC ; **************
.a141 69 40 adc #$40 ADC #$40
.a143 65 ec adc $ec ADC WMAXC ; PARAMETERS
.a145 65 ed adc $ed ADC WCC ; WITH WEIGHT
.a147 38 sec SEC ; OF 05
.a148 e5 e4 sbc $e4 SBC BMAXC
.a14a 4a lsr LSR ; **************
.a14b 18 clc CLC
.a14c 69 90 adc #$90 ADC #$90
.a14e 65 dd adc $dd ADC WCAP0 ; PARAMETERS
.a150 65 dd adc $dd ADC WCAP0 ; WITH WEIGHT
.a152 65 dd adc $dd ADC WCAP0 ; OF 10
.a154 65 dd adc $dd ADC WCAP0
.a156 65 e1 adc $e1 ADC WCAP1
.a158 38 sec SEC ; [UNDER OR _OVER-
.a159 e5 e4 sbc $e4 SBC BMAXC ; FLOW MAY OCCUR
.a15b e5 e4 sbc $e4 SBC BMAXC ; FROM THIS
.a15d e5 e5 sbc $e5 SBC BMCC ; SECTION]
.a15f e5 e5 sbc $e5 SBC BMCC
.a161 e5 e0 sbc $e0 SBC BCAP1
.a163 a6 b1 ldx $b1 LDX SQUARE ; ***************
.a165 e0 33 cpx #$33 CPX #$33
.a167 f0 16 beq $a17f BEQ POSN ; POSITION
.a169 e0 34 cpx #$34 CPX #$34 ; BONUS FOR
.a16b f0 12 beq $a17f BEQ POSN ; MOVE TO
.a16d e0 22 cpx #$22 CPX #$22 ; CENTRE
.a16f f0 0e beq $a17f BEQ POSN ; OR
.a171 e0 25 cpx #$25 CPX #$25 ; OUT OF
.a173 f0 0a beq $a17f BEQ POSN ; BACK RANK
.a175 a6 b0 ldx $b0 LDX PIECE
.a177 f0 09 beq $a182 BEQ NOPOSN
.a179 b4 50 ldy $50,x LDY BOARD,X
.a17b c0 10 cpy #$10 CPY #$10
.a17d 10 03 bpl $a182 BPL NOPOSN
.a17f 18 clc POSN CLC
.a180 69 02 adc #$02 ADC #$02
.a182 4c 91 a0 jmp $a091 NOPOSN JMP CKMATE ; CONTINUE
.a185 a6 fd ldx $fd ADDHIST LDX HIST
.a187 e8 inx INX
.a188 ad c8 01 lda $01c8 LDA $01C8
.a18b 9d 00 16 sta $1600,x STA HIST1,X
.a18e ad c7 01 lda $01c7 LDA $01C7
.a191 9d 00 17 sta $1700,x STA HIST2,X
.a194 ad c6 01 lda $01c6 LDA $01C6
.a197 9d 00 18 sta $1800,x STA HIST3,X
.a19a ad c5 01 lda $01c5 LDA $01C5
.a19d 9d 00 19 sta $1900,x STA HIST4,X
.a1a0 86 fd stx $fd STX HIST
.a1a2 60 rts RTS
.a1a3 a4 fd ldy $fd UNDO LDY HIST
.a1a5 f0 19 beq $a1c0 BEQ UNDO1
.a1a7 b9 00 19 lda $1900,y LDA $1900,Y
.a1aa 85 b0 sta $b0 STA PIECE ; PIECE
.a1ac aa tax TAX
.a1ad b9 00 18 lda $1800,y LDA $1800,Y
.a1b0 95 50 sta $50,x STA BOARD,X
.a1b2 b9 00 17 lda $1700,y LDA $1700,Y
.a1b5 aa tax TAX
.a1b6 b9 00 16 lda $1600,y LDA $1600,Y
.a1b9 85 b1 sta $b1 STA SQUARE
.a1bb 95 50 sta $50,x STA BOARD,X
.a1bd 88 dey DEY
.a1be 84 fd sty $fd STY HIST
.a1c0 60 rts UNDO1 RTS
.a1c1 a9 b8 lda #$b8 POUT lda #<menu0
.a1c3 85 00 sta $00 sta mnu
.a1c5 a9 a2 lda #$a2 lda #>menu0
.a1c7 85 01 sta $01 sta mnu+1
.a1c9 20 7b a2 jsr $a27b jsr pout9 ; print CRLF
.a1cc 20 9f a2 jsr $a29f jsr pout13 ; print copyright
.a1cf 20 86 a2 jsr $a286 JSR POUT10 ; print column labels
.a1d2 a0 00 ldy #$00 LDY #$00 ; init board location
.a1d4 20 3a a2 jsr $a23a JSR POUT5 ; print board horz edge
.a1d7 a9 7c lda #$7c POUT1 lDA #"|" ; print vert edge
.a1d9 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - SPACE
.a1dc a2 1f ldx #$1f LDX #$1F
.a1de 98 tya POUT2 TYA ; scan the pieces for a location match
.a1df d5 50 cmp $50,x CMP BOARD,X ; match found?
.a1e1 f0 40 beq $a223 BEQ POUT4 ; yes; print the piece's color and type
.a1e3 ca dex DEX ; no
.a1e4 10 f8 bpl $a1de BPL POUT2 ; if not the last piece, try again
.a1e6 98 tya tya ; empty square
.a1e7 29 01 and #$01 and #$01 ; odd or even column?
.a1e9 85 fc sta $fc sta temp ; save it
.a1eb 98 tya tya ; is the row odd or even
.a1ec 4a lsr lsr ; shift column right 4 spaces
.a1ed 4a lsr lsr ;
.a1ee 4a lsr lsr ;
.a1ef 4a lsr lsr ;
.a1f0 29 01 and #$01 and #$01 ; strip LSB
.a1f2 18 clc clc ;
.a1f3 65 fc adc $fc adc temp ; combine row & col to determine square color
.a1f5 29 01 and #$01 and #$01 ; is board square white or blk?
.a1f7 d0 03 bne $a1fc bne pout25 ; white, print space
.a1f9 a9 2a lda #$2a lda #"*" ; black, print *
>a1fb 2c .byte $2c ; used to skip _OVER LDA #$20
.a1fc a9 20 lda #$20 POUT25 LDA #$20 ; ASCII space
.a1fe 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - SPACE
.a201 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - SPACE
.a204 c8 iny POUT3 INY ;
.a205 98 tya TYA ; get row number
.a206 29 08 and #$08 AND #$08 ; have we completed the row?
.a208 f0 cd beq $a1d7 BEQ POUT1 ; no, do next column
.a20a a9 7c lda #$7c LDA #"|" ; yes, put the right edge on
.a20c 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - |
.a20f 20 98 a2 jsr $a298 jsr pout12 ; print row number
.a212 20 7b a2 jsr $a27b JSR POUT9 ; print CRLF
.a215 20 3a a2 jsr $a23a JSR POUT5 ; print bottom edge of board
.a218 18 clc CLC ;
.a219 98 tya TYA ;
.a21a 69 08 adc #$08 ADC #$08 ; point y to beginning of next row
.a21c a8 tay TAY ;
.a21d c0 80 cpy #$80 CPY #$80 ; was that the last row?
.a21f f0 3e beq $a25f BEQ POUT8 ; yes, print the LED values
.a221 d0 b4 bne $a1d7 BNE POUT1 ; no, do new row
.a223 a5 b7 lda $b7 POUT4 LDA REV ; print piece's color & type
.a225 f0 05 beq $a22c BEQ POUT41 ;
.a227 bd e5 a3 lda $a3e5,x LDA cpl+16,X ;
.a22a d0 03 bne $a22f BNE POUT42 ;
.a22c bd d5 a3 lda $a3d5,x POUT41 LDA cpl,x ;
.a22f 20 f4 a4 jsr $a4f4 POUT42 JSR cout ;
.a232 bd 05 a4 lda $a405,x lda cph,x ;
.a235 20 f4 a4 jsr $a4f4 jsr cout ;
.a238 d0 ca bne $a204 BNE POUT3 ; branch always
.a23a 8a txa POUT5 TXA ; print "-----...-----<crlf>"
.a23b 48 pha PHA
.a23c a2 19 ldx #$19 LDX #$19
.a23e a9 2d lda #$2d LDA #"-"
.a240 20 f4 a4 jsr $a4f4 POUT6 JSR cout ; PRINT ONE ASCII CHR - "-"
.a243 ca dex DEX
.a244 d0 fa bne $a240 BNE POUT6
.a246 68 pla PLA
.a247 aa tax TAX
.a248 a9 19 lda #$19 lda #25
.a24a 85 02 sta $02 sta mnu+2
.a24c b2 00 lda ($00) POUT7 lda (mnu)
.a24e e6 00 inc $00 inc mnu
.a250 d0 02 bne $a254 bne POUT77
.a252 e6 01 inc $01 inc mnu+1
.a254 20 f4 a4 jsr $a4f4 POUT77 jsr cout
.a257 c6 02 dec $02 dec mnu+2
.a259 d0 f1 bne $a24c bne POUT7
.a25b 20 7b a2 jsr $a27b JSR POUT9
.a25e 60 rts RTS
.a25f 20 86 a2 jsr $a286 POUT8 jsr pout10 ;
.a262 a5 fb lda $fb LDA $FB
.a264 20 60 e7 jsr $e760 JSR print1byte ; PRINT 1 BYTE AS 2 HEX CHRS
.a267 a9 20 lda #$20 LDA #$20
.a269 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - SPACE
.a26c a5 fa lda $fa LDA $FA
.a26e 20 60 e7 jsr $e760 JSR print1byte ; PRINT 1 BYTE AS 2 HEX CHRS
.a271 a9 20 lda #$20 LDA #$20
.a273 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - SPACE
.a276 a5 f9 lda $f9 LDA $F9
.a278 20 60 e7 jsr $e760 JSR print1byte ; PRINT 1 BYTE AS 2 HEX CHRS
.a27b a9 0d lda #$0d POUT9 LDA #$0D
.a27d 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - CR
.a280 a9 0a lda #$0a LDA #$0A
.a282 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - LF
.a285 60 rts RTS
.a286 a2 00 ldx #$00 pout10 ldx #$00 ; print the column labels
.a288 a9 20 lda #$20 POUT11 lda #$20 ; 00 01 02 03 ... 07 <CRLF>
.a28a 20 f4 a4 jsr $a4f4 jsr cout
.a28d 8a txa txa
.a28e 20 60 e7 jsr $e760 jsr print1byte
.a291 e8 inx INX
.a292 e0 08 cpx #$08 CPX #$08
.a294 d0 f2 bne $a288 BNE POUT11
.a296 f0 e3 beq $a27b BEQ POUT9
.a298 98 tya POUT12 TYA
.a299 29 70 and #$70 and #$70
.a29b 20 60 e7 jsr $e760 JSR print1byte
.a29e 60 rts rts
.a29f a2 00 ldx #$00 Pout13 ldx #$00 ; Print the copyright banner
.a2a1 bd 99 a3 lda $a399,x Pout14 lda banner,x
.a2a4 f0 06 beq $a2ac beq POUT15
.a2a6 20 f4 a4 jsr $a4f4 jsr cout
.a2a9 e8 inx inx
.a2aa d0 f5 bne $a2a1 bne POUT14
.a2ac 60 rts POUT15 rts
.a2ad a9 3f lda #$3f KIN LDA #"?"
.a2af 20 f4 a4 jsr $a4f4 JSR cout ; PRINT ONE ASCII CHR - ?
.a2b2 20 dc a4 jsr $a4dc JSR cin ; GET A KEYSTROKE FROM SYSTEM
.a2b5 29 4f and #$4f AND #$4F ; MASK 0-7, AND ALPHA'S
.a2b7 60 rts RTS
>a2b8 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 menu0 .byte " "
>a2d1 20 20 20 5b 45 6e 74 65 72 5d 20 2d 20 75 73 65 72 20 6d 6f 76 65 20 20 20 menu1 .byte " [Enter] - user move "
>a2ea 20 20 20 20 20 5b 42 5d 20 2d 20 55 6e 64 6f 20 6d 6f 76 65 20 20 20 20 20 menu2 .byte " [B] - Undo move "
>a303 20 20 20 20 20 5b 43 5d 20 2d 20 52 65 73 65 74 20 42 6f 61 72 64 20 20 20 menu3 .byte " [C] - Reset Board "
>a31c 20 20 20 20 20 5b 45 5d 20 2d 20 53 77 61 70 20 53 69 64 65 73 20 20 20 20 menu4 .byte " [E] - Swap Sides "
>a335 20 20 20 20 20 5b 50 5d 20 2d 20 43 6f 6d 70 75 74 65 72 20 6d 6f 76 65 20 menu5 .byte " [P] - Computer move "
>a34e 20 20 20 20 20 5b 51 5d 20 2d 20 71 75 69 74 65 20 67 61 6d 65 20 20 20 20 menu6 .byte " [Q] - quite game "
>a367 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 menu7 .byte " "
>a380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 menu8 .byte " "
>a399 4d 69 63 72 6f 43 68 65 73 73 20 28 63 29 20 31 39 39 36 2d 32 30 30 32 20 50 65 74 65 72 20 4a 65 6e 6e 69 6e 67 73 2c 20 70 65 74 65 72 6a 40 62 65 6e 6c 6f 2e 63 6f 6d banner .byte "MicroChess (c) 1996-2002 Peter Jennings, peterj@benlo.com"
>a3d2 0d 0a 00 .byte $0d, $0a, $00
>a3d5 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 cpl .byte "WWWWWWWWWWWWWWWWBBBBBBBBBBBBBBBBWWWWWWWWWWWWWWWW"
>a405 4b 51 43 43 42 42 52 52 50 50 50 50 50 50 50 50 4b 51 43 43 42 42 52 52 50 50 50 50 50 50 50 50 cph .byte "KQCCBBRRPPPPPPPPKQCCBBRRPPPPPPPP"
>a425 00 .byte $00
>a426 03 04 00 07 02 05 01 06 SETW .byte $03, $04, $00, $07, $02, $05, $01, $06
>a42e 10 17 11 16 12 15 14 13 .byte $10, $17, $11, $16, $12, $15, $14, $13
>a436 73 74 70 77 72 75 71 76 .byte $73, $74, $70, $77, $72, $75, $71, $76
>a43e 60 67 61 66 62 65 64 63 .byte $60, $67, $61, $66, $62, $65, $64, $63
>a446 00 f0 ff 01 10 11 0f ef f1 MOVEX .byte $00, $F0, $FF, $01, $10, $11, $0F, $EF, $F1
>a44f df e1 ee f2 12 0e 1f 21 .byte $DF, $E1, $EE, $F2, $12, $0E, $1F, $21
>a457 0b 0a 06 06 04 04 04 04 POINTS .byte $0B, $0A, $06, $06, $04, $04, $04, $04
>a45f 02 02 02 02 02 02 02 02 .byte $02, $02, $02, $02, $02, $02, $02, $02
>a467 99 25 0b 25 01 00 33 25 OPNING .byte $99, $25, $0B, $25, $01, $00, $33, $25
>a46f 07 36 34 0d 34 34 0e 52 .byte $07, $36, $34, $0D, $34, $34, $0E, $52
>a477 25 0d 45 35 04 55 22 06 .byte $25, $0D, $45, $35, $04, $55, $22, $06
>a47f 43 33 0f cc .byte $43, $33, $0F, $CC
.a483 _top
.a483 a2 dc ldx #$dc ACIA1_init LDX #<ACIA1_Input ; set up RAM vectors for
.a485 a9 a4 lda #$a4 LDA #>ACIA1_Input ; Input, Output, and Scan
.a487 a8 tay TAY ; Routines
.a488 49 a5 eor #$a5 EOR #$A5 ;
.a48a 8d ed 03 sta $03ed sta ChrInVect+2 ;
.a48d 8c ec 03 sty $03ec sty ChrInVect+1 ;
.a490 8e eb 03 stx $03eb stx ChrInVect ;
.a493 a2 e7 ldx #$e7 LDX #<ACIA1_Scan ;
.a495 a9 a4 lda #$a4 LDA #>ACIA1_Scan ;
.a497 a8 tay TAY ;
.a498 49 a5 eor #$a5 EOR #$A5 ;
.a49a 8d f0 03 sta $03f0 sta ScanInVect+2 ;
.a49d 8c ef 03 sty $03ef sty ScanInVect+1 ;
.a4a0 8e ee 03 stx $03ee stx ScanInVect ;
.a4a3 a2 f4 ldx #$f4 LDX #<ACIA1_Output ;
.a4a5 a9 a4 lda #$a4 LDA #>ACIA1_Output ;
.a4a7 a8 tay TAY ;
.a4a8 49 a5 eor #$a5 EOR #$A5 ;
.a4aa 8d f3 03 sta $03f3 sta ChrOutVect+2 ;
.a4ad 8c f2 03 sty $03f2 sty ChrOutVect+1 ;
.a4b0 8e f1 03 stx $03f1 stx ChrOutVect ;
.a4b3 a9 e7 lda #$e7 lda #<ACIA1_scan ; setup BASIC vectors
.a4b5 8d 05 04 sta $0405 sta VEC_IN
.a4b8 a9 a4 lda #$a4 lda #>ACIA1_scan ; BASIC's chr input
.a4ba 8d 06 04 sta $0406 sta VEC_IN+1
.a4bd a9 f4 lda #$f4 lda #<ACIA1_Output
.a4bf 8d 07 04 sta $0407 sta VEC_OUT
.a4c2 a9 a4 lda #$a4 lda #>ACIA1_Output ; BASIC's chr output
.a4c4 8d 08 04 sta $0408 sta VEC_OUT+1
.a4c7 a9 59 lda #$59 lda #<Psave
.a4c9 8d 0b 04 sta $040b sta VEC_SV
.a4cc a9 e6 lda #$e6 lda #>Psave ; SAVE cmd
.a4ce 8d 0c 04 sta $040c sta VEC_SV+1
.a4d1 a9 82 lda #$82 lda #<pload
.a4d3 8d 09 04 sta $0409 sta VEC_LD
.a4d6 a9 e6 lda #$e6 lda #>pload ; LOAD cmd
.a4d8 8d 0a 04 sta $040a sta VEC_LD+1
.a4db 60 rts rts ; done
.a4dc cin
.a4dc acia1_input
.a4dc ad c0 3f lda $3fc0 lda UCSR0A ; Serial port status
.a4df 29 80 and #$80 and #$80 ; RXC0 bit
.a4e1 f0 f9 beq $a4dc beq ACIA1_Input ; no char to get
.a4e3 ad c6 3f lda $3fc6 lda UDR0 ; get chr
.a4e6 60 rts RTS ;
.a4e7 cscan
.a4e7 18 clc ACIA1_Scan clc
.a4e8 ad c0 3f lda $3fc0 lda UCSR0A ; Serial port status
.a4eb 29 80 and #$80 and #$80 ; RXC0 bit
.a4ed f0 04 beq $a4f3 beq ACIA1_scan2
.a4ef ad c6 3f lda $3fc6 lda UDR0 ; get chr
.a4f2 38 sec sec
.a4f3 60 rts ACIA1_scan2 rts
.a4f4 cout
.a4f4 48 pha ACIA1_Output PHA ; save registers
.a4f5 ad c0 3f lda $3fc0 ACIA1_Out1 lda UCSR0A ; Serial port status
.a4f8 29 20 and #$20 and #$20 ; UDRE0 bit
.a4fa f0 f9 beq $a4f5 beq ACIA1_Out1 ; no
.a4fc 68 pla PLA ; get chr
.a4fd 8d c6 3f sta $3fc6 sta UDR0 ; put character to Port
.a500 60 rts RTS ; done
.a501 a9 0d lda #$0d CROUT lda #$0d
.a503 20 f4 a4 jsr $a4f4 jsr cout
.a506 a9 0a lda #$0a lda #$0a
.a508 80 ea bra $a4f4 bra cout
.a50a 20 e7 a4 jsr $a4e7 cbrk jsr cscan
.a50d 90 05 bcc $a514 bcc cbrk2
.a50f c9 03 cmp #$03 cmp #$03
.a511 f0 01 beq $a514 beq cbrk2
.a513 18 clc clc
.a514 60 rts cbrk2 rts
.a600 ea nop ENTER NOP ; Vector to COLD entry
.a601 4c ba 13 jmp $13ba JMP COLD+2 ;
.a604 ea nop REENTR NOP ; User Warm entry point
.a605 4c ca 13 jmp $13ca JMP WARM ; Vector to WARM entry
>a608 04 00 .WORD $0004 ; 6502 in radix-36
>a60a d2 5e .WORD $5ED2 ;
>a60c 5a 1b .WORD NTOP ; Name address of MON
>a60e 7f 00 .WORD $7F ; Backspace Character
>a610 80 3e .WORD UAREA ; Initial User Area
>a612 9f 00 .WORD TOS ; Initial Top of Stack
>a614 ff 01 .WORD $1FF ; Initial Top of Return Stack
>a616 00 01 .WORD TIBX ; Initial terminal input buffer
>a618 1f 00 .WORD 31 ; Initial name field width
>a61a 01 00 .WORD 1 ; 0=nod disk, 1=disk
>a61c 65 1b .WORD TOP ; Initial fence address
>a61e 65 1b .WORD TOP ; Initial top of dictionary
>a620 31 13 .WORD VL0 ; Initial Vocabulary link ptr.
.a622 ea nop nop
.a623 ea nop nop
>a624 83 4c 49 d4 L22 .BYTE $83,"LI",$D4 ; <--- name field
>a628 00 00 .WORD 00 ; last link marked by zero
>a62a 2c 04 LIT .WORD *+2 ; <----- code address field
.a62c b1 af lda ($af),y LDA (IP),Y ; <----- start of parameter field
.a62e 48 pha PHA
.a62f e6 af inc $af INC IP
.a631 d0 02 bne $a635 BNE L30
.a633 e6 b0 inc $b0 INC IP+1
.a635 b1 af lda ($af),y L30 LDA (IP),Y
.a637 e6 af inc $af L31 INC IP
.a639 d0 02 bne $a63d BNE PUSH
.a63b e6 b0 inc $b0 INC IP+1
.a63d ca dex PUSH DEX
.a63e ca dex DEX
.a63f 95 01 sta $01,x PUT STA 1,X
.a641 68 pla PLA
.a642 95 00 sta $00,x STA 0,X
.a644 a0 01 ldy #$01 NEXT LDY #1
.a646 b1 af lda ($af),y LDA (IP),Y ; Fetch code field address pointed
.a648 85 b3 sta $b3 STA W+1 ; to by IP.
.a64a 88 dey DEY
.a64b b1 af lda ($af),y LDA (IP),Y
.a64d 85 b2 sta $b2 STA W
.a64f 18 clc CLC ; Increment IP by two.
.a650 a5 af lda $af LDA IP
.a652 69 02 adc #$02 ADC #2
.a654 85 af sta $af STA IP
.a656 90 02 bcc $a65a BCC L54
.a658 e6 b0 inc $b0 INC IP+1
.a65a 4c b1 00 jmp $00b1 L54 JMP W-1 ; Jump to an indirect jump (W) which
>a65d 84 43 4c 49 d4 L35 .BYTE $84,"CLI",$D4
>a662 24 04 .WORD L22 ; Link to LIT
>a664 66 04 CLIT .WORD *+2
.a666 b1 af lda ($af),y LDA (IP),Y
.a668 48 pha PHA
.a669 98 tya TYA
.a66a f0 cb beq $a637 BEQ L31 ; a forced branch into LIT
.a66c 0a asl SETUP ASL
.a66d 85 a6 sta $a6 STA N-1
.a66f b5 00 lda $00,x L63 LDA 0,X
.a671 99 a7 00 sta $00a7,y STA N,Y
.a674 e8 inx INX
.a675 c8 iny INY
.a676 c4 a6 cpy $a6 CPY N-1
.a678 d0 f5 bne $a66f BNE L63
.a67a a0 00 ldy #$00 LDY #0
.a67c 60 rts RTS
>a67d 87 45 58 45 43 55 54 c5 L75 .BYTE $87,"EXECUT",$C5
>a685 5d 04 .WORD L35 ; link to CLIT
>a687 89 04 EXEC .WORD *+2
.a689 b5 00 lda $00,x LDA 0,X
.a68b 85 b2 sta $b2 STA W
.a68d b5 01 lda $01,x LDA 1,X
.a68f 85 b3 sta $b3 STA W+1
.a691 e8 inx INX
.a692 e8 inx INX
.a693 4c b1 00 jmp $00b1 JMP W-1 ; to JMP (W) in z-page
>a696 86 42 52 41 4e 43 c8 L89 .BYTE $86,"BRANC",$C8
>a69d 7d 04 .WORD L75 ; link to EXCECUTE
>a69f a1 04 BRAN .WORD *+2
.a6a1 18 clc CLC
.a6a2 b1 af lda ($af),y LDA (IP),Y
.a6a4 65 af adc $af ADC IP
.a6a6 48 pha PHA
.a6a7 c8 iny INY
.a6a8 b1 af lda ($af),y LDA (IP),Y
.a6aa 65 b0 adc $b0 ADC IP+1
.a6ac 85 b0 sta $b0 STA IP+1
.a6ae 68 pla PLA
.a6af 85 af sta $af STA IP
.a6b1 4c 46 04 jmp $0446 JMP NEXT +2
>a6b4 87 30 42 52 41 4e 43 c8 L107 .BYTE $87,"0BRANC",$C8
>a6bc 96 04 .WORD L89 ; link to BRANCH
>a6be c0 04 ZBRAN .WORD *+2
.a6c0 e8 inx INX
.a6c1 e8 inx INX
.a6c2 b5 fe lda $fe,x LDA $FE,X
.a6c4 15 ff ora $ff,x ORA $FF,X
.a6c6 f0 d9 beq $a6a1 BEQ BRAN+2
.a6c8 18 clc BUMP CLC
.a6c9 a5 af lda $af LDA IP
.a6cb 69 02 adc #$02 ADC #2
.a6cd 85 af sta $af STA IP
.a6cf 90 02 bcc $a6d3 BCC L122
.a6d1 e6 b0 inc $b0 INC IP+1
.a6d3 4c 44 04 jmp $0444 L122 JMP NEXT
>a6d6 86 28 4c 4f 4f 50 a9 L127 .BYTE $86,"(LOOP",$A9
>a6dd b4 04 .WORD L107 ; link to 0BRANCH
>a6df e1 04 PLOOP .WORD L130
.a6e1 86 b6 stx $b6 L130 STX XSAVE
.a6e3 ba tsx TSX
.a6e4 fe 01 01 inc $0101,x INC $101,X
.a6e7 d0 03 bne $a6ec BNE PL1
.a6e9 fe 02 01 inc $0102,x INC $102,X
.a6ec 18 clc PL1 CLC
.a6ed bd 03 01 lda $0103,x LDA $103,X
.a6f0 fd 01 01 sbc $0101,x SBC $101,X
.a6f3 bd 04 01 lda $0104,x LDA $104,X
.a6f6 fd 02 01 sbc $0102,x SBC $102,X
.a6f9 a6 b6 ldx $b6 PL2 LDX XSAVE
.a6fb 0a asl ASL
.a6fc 90 a3 bcc $a6a1 BCC BRAN+2
.a6fe 68 pla PLA
.a6ff 68 pla PLA
.a700 68 pla PLA
.a701 68 pla PLA
.a702 4c c8 04 jmp $04c8 JMP BUMP
>a705 87 28 2b 4c 4f 4f 50 a9 L154 .BYTE $87,"(+LOOP",$A9
>a70d d6 04 .WORD L127 ; link to (loop)
>a70f 11 05 PPLOO .WORD *+2
.a711 e8 inx INX
.a712 e8 inx INX
.a713 86 b6 stx $b6 STX XSAVE
.a715 b5 ff lda $ff,x LDA $FF,X
.a717 48 pha PHA
.a718 48 pha PHA
.a719 b5 fe lda $fe,x LDA $FE,X
.a71b ba tsx TSX
.a71c e8 inx INX
.a71d e8 inx INX
.a71e 18 clc CLC
.a71f 7d 01 01 adc $0101,x ADC $101,X
.a722 9d 01 01 sta $0101,x STA $101,X
.a725 68 pla PLA
.a726 7d 02 01 adc $0102,x ADC $102,X
.a729 9d 02 01 sta $0102,x STA $102,X
.a72c 68 pla PLA
.a72d 10 bd bpl $a6ec BPL PL1
.a72f 18 clc CLC
.a730 bd 01 01 lda $0101,x LDA $101,X
.a733 fd 03 01 sbc $0103,x SBC $103,X
.a736 bd 02 01 lda $0102,x LDA $102,X
.a739 fd 04 01 sbc $0104,x SBC $104,X
.a73c 4c f9 04 jmp $04f9 JMP PL2
>a73f 84 28 44 4f a9 L185 .BYTE $84,"(DO",$A9
>a744 05 05 .WORD L154 ; link to (+LOOP)
>a746 48 05 PDO .WORD *+2
.a748 b5 03 lda $03,x LDA 3,X
.a74a 48 pha PHA
.a74b b5 02 lda $02,x LDA 2,X
.a74d 48 pha PHA
.a74e b5 01 lda $01,x LDA 1,X
.a750 48 pha PHA
.a751 b5 00 lda $00,x LDA 0,X
.a753 48 pha PHA
.a754 e8 inx POPTWO INX
.a755 e8 inx INX
.a756 e8 inx POP INX
.a757 e8 inx INX
.a758 4c 44 04 jmp $0444 JMP NEXT
>a75b 81 c9 L207 .BYTE $81,$C9
>a75d 3f 05 .WORD L185 ; link to (DO)
>a75f d5 07 I .WORD R+2 ; share the code for R
>a761 85 44 49 47 49 d4 L214 .BYTE $85,"DIGI",$D4
>a767 5b 05 .WORD L207 ; link to I
>a769 6b 05 DIGIT .WORD *+2
.a76b 38 sec SEC
.a76c b5 02 lda $02,x LDA 2,X
.a76e e9 30 sbc #$30 SBC #$30
.a770 30 18 bmi $a78a BMI L234
.a772 c9 0a cmp #$0a CMP #$A
.a774 30 07 bmi $a77d BMI L227
.a776 38 sec SEC
.a777 e9 07 sbc #$07 SBC #7
.a779 c9 0a cmp #$0a CMP #$A
.a77b 30 0d bmi $a78a BMI L234
.a77d d5 00 cmp $00,x L227 CMP 0,X
.a77f 10 09 bpl $a78a BPL L234
.a781 95 02 sta $02,x STA 2,X
.a783 a9 01 lda #$01 LDA #1
.a785 48 pha PHA
.a786 98 tya TYA
.a787 4c 3f 04 jmp $043f JMP PUT ; exit true with converted value
.a78a 98 tya L234 TYA
.a78b 48 pha PHA
.a78c e8 inx INX
.a78d e8 inx INX
.a78e 4c 3f 04 jmp $043f JMP PUT ; exit false with bad conversion
>a791 86 28 46 49 4e 44 a9 L243 .BYTE $86,"(FIND",$A9
>a798 61 05 .WORD L214 ; Link to DIGIT
>a79a 9c 05 PFIND .WORD *+2
.a79c a9 02 lda #$02 LDA #2
.a79e 20 6c 04 jsr $046c JSR SETUP
.a7a1 86 b6 stx $b6 STX XSAVE
.a7a3 a0 00 ldy #$00 L249 LDY #0
.a7a5 b1 a7 lda ($a7),y LDA (N),Y
.a7a7 51 a9 eor ($a9),y EOR (N+2),Y
.a7a9 29 3f and #$3f AND #$3F
.a7ab d0 2d bne $a7da BNE L281
.a7ad c8 iny L254 INY
.a7ae b1 a7 lda ($a7),y LDA (N),Y
.a7b0 51 a9 eor ($a9),y EOR (N+2),Y
.a7b2 0a asl ASL
.a7b3 d0 23 bne $a7d8 BNE L280
.a7b5 90 f6 bcc $a7ad BCC L254
.a7b7 a6 b6 ldx $b6 LDX XSAVE
.a7b9 ca dex DEX
.a7ba ca dex DEX
.a7bb ca dex DEX
.a7bc ca dex DEX
.a7bd 18 clc CLC
.a7be 98 tya TYA
.a7bf 69 05 adc #$05 ADC #5
.a7c1 65 a7 adc $a7 ADC N
.a7c3 95 02 sta $02,x STA 2,X
.a7c5 a0 00 ldy #$00 LDY #0
.a7c7 98 tya TYA
.a7c8 65 a8 adc $a8 ADC N+1
.a7ca 95 03 sta $03,x STA 3,X
.a7cc 94 01 sty $01,x STY 1,X
.a7ce b1 a7 lda ($a7),y LDA (N),Y
.a7d0 95 00 sta $00,x STA 0,X
.a7d2 a9 01 lda #$01 LDA #1
.a7d4 48 pha PHA
.a7d5 4c 3d 04 jmp $043d JMP PUSH
.a7d8 b0 05 bcs $a7df L280 BCS L284
.a7da c8 iny L281 INY
.a7db b1 a7 lda ($a7),y LDA (N),Y
.a7dd 10 fb bpl $a7da BPL L281
.a7df c8 iny L284 INY
.a7e0 b1 a7 lda ($a7),y LDA (N),Y
.a7e2 aa tax TAX
.a7e3 c8 iny INY
.a7e4 b1 a7 lda ($a7),y LDA (N),Y
.a7e6 85 a8 sta $a8 STA N+1
.a7e8 86 a7 stx $a7 STX N
.a7ea 05 a7 ora $a7 ORA N
.a7ec d0 b5 bne $a7a3 BNE L249
.a7ee a6 b6 ldx $b6 LDX XSAVE
.a7f0 a9 00 lda #$00 LDA #0
.a7f2 48 pha PHA
.a7f3 4c 3d 04 jmp $043d JMP PUSH ; exit false upon reading null link
>a7f6 87 45 4e 43 4c 4f 53 c5 L301 .BYTE $87,"ENCLOS",$C5
>a7fe 91 05 .WORD L243 ; link to (FIND)
>a800 02 06 ENCL .WORD *+2
.a802 a9 02 lda #$02 LDA #2
.a804 20 6c 04 jsr $046c JSR SETUP
.a807 8a txa TXA
.a808 38 sec SEC
.a809 e9 08 sbc #$08 SBC #8
.a80b aa tax TAX
.a80c 94 03 sty $03,x STY 3,X
.a80e 94 01 sty $01,x STY 1,X
.a810 88 dey DEY
.a811 c8 iny L313 INY
.a812 b1 a9 lda ($a9),y LDA (N+2),Y
.a814 c5 a7 cmp $a7 CMP N
.a816 f0 f9 beq $a811 BEQ L313
.a818 94 04 sty $04,x STY 4,X
.a81a b1 a9 lda ($a9),y L318 LDA (N+2),Y
.a81c d0 0e bne $a82c BNE L327
.a81e 94 02 sty $02,x STY 2,X
.a820 94 00 sty $00,x STY 0,X
.a822 98 tya TYA
.a823 d5 04 cmp $04,x CMP 4,X
.a825 d0 02 bne $a829 BNE L326
.a827 f6 02 inc $02,x INC 2,X
.a829 4c 44 04 jmp $0444 L326 JMP NEXT
.a82c 94 02 sty $02,x L327 STY 2,X
.a82e c8 iny INY
.a82f c5 a7 cmp $a7 CMP N
.a831 d0 e7 bne $a81a BNE L318
.a833 94 00 sty $00,x STY 0,X
.a835 4c 44 04 jmp $0444 JMP NEXT
>a838 84 45 4d 49 d4 L337 .BYTE $84,"EMI",$D4
>a83d f6 05 .WORD L301 ; link to ENCLOSE
>a83f 64 17 EMIT .WORD XEMIT ; Vector to code for KEY
>a841 83 4b 45 d9 L344 .BYTE $83,"KE",$D9
>a845 38 06 .WORD L337 ; link to EMIT
>a847 6c 17 KEY .WORD XKEY ; Vector to code for KEY
>a849 89 3f 54 45 52 4d 49 4e 41 cc L351 .BYTE $89,"?TERMINA",$CC
>a853 41 06 .WORD L344 ; link to KEY
>a855 72 17 QTERM .WORD XQTER ; Vector to code for ?TERMINAL
>a857 82 43 d2 L358 .BYTE $82,"C",$D2
>a85a 49 06 .WORD L351 ; link to ?TERMINAL
>a85c 7b 17 CR .WORD XCR ; Vector to code for CR
>a85e 85 43 4d 4f 56 c5 L365 .BYTE $85,"CMOV",$C5
>a864 57 06 .WORD L358 ; link to CR
>a866 68 06 CMOVE .WORD *+2
.a868 a9 03 lda #$03 LDA #3
.a86a 20 6c 04 jsr $046c JSR SETUP
.a86d c4 a7 cpy $a7 L370 CPY N
.a86f d0 07 bne $a878 BNE L375
.a871 c6 a8 dec $a8 DEC N+1
.a873 10 03 bpl $a878 BPL L375
.a875 4c 44 04 jmp $0444 JMP NEXT
.a878 b1 ab lda ($ab),y L375 LDA (N+4),Y
.a87a 91 a9 sta ($a9),y STA (N+2),Y
.a87c c8 iny INY
.a87d d0 ee bne $a86d BNE L370
.a87f e6 ac inc $ac INC N+5
.a881 e6 aa inc $aa INC N+3
.a883 4c 6d 06 jmp $066d JMP L370
>a886 82 55 aa L386 .BYTE $82,"U",$AA
>a889 5e 06 .WORD L365 ; link to CMOVE
>a88b 8d 06 USTAR .WORD *+2
.a88d a9 00 lda #$00 LDA #0 ; in some implementations TYA can be used since NEXT leaves Y=$00
.a88f 85 a7 sta $a7 STA N
.a891 a0 10 ldy #$10 LDY #16
.a893 56 03 lsr $03,x LSR 3,X
.a895 76 02 ror $02,x ROR 2,X
.a897 90 0d bcc $a8a6 L1 BCC L2
.a899 18 clc CLC
.a89a 85 a8 sta $a8 sta N+1 ; PHA
.a89c a5 a7 lda $a7 LDA N
.a89e 75 00 adc $00,x ADC 0,X
.a8a0 85 a7 sta $a7 STA N
.a8a2 a5 a8 lda $a8 lda N+1 ; PLA
.a8a4 75 01 adc $01,x ADC 1,X
.a8a6 6a ror L2 ROR
.a8a7 66 a7 ror $a7 ROR N
.a8a9 76 03 ror $03,x ROR 3,X
.a8ab 76 02 ror $02,x ROR 2,X
.a8ad 88 dey DEY
.a8ae d0 e7 bne $a897 BNE L1
.a8b0 95 01 sta $01,x STA 1,X
.a8b2 a5 a7 lda $a7 LDA N
.a8b4 95 00 sta $00,x STA 0,X
.a8b6 4c 44 04 jmp $0444 JMP NEXT
>a8b9 82 55 af L418 .BYTE $82,"U",$AF
>a8bc 86 06 .WORD L386 ; link to U*
>a8be c0 06 USLAS .WORD *+2
.a8c0 38 sec SEC ; Modified code - dr
.a8c1 b5 02 lda $02,x LDA 2,X ; Subtract hi cell of dividend by
.a8c3 f5 00 sbc $00,x SBC 0,X ; divisor to see if there's an overflow condition.
.a8c5 b5 03 lda $03,x LDA 3,X
.a8c7 f5 01 sbc $01,x SBC 1,X
.a8c9 b0 2e bcs $a8f9 BCS oflow ; Branch if /0 or overflow.
.a8cb a9 11 lda #$11 LDA #$11 ; Loop 17x.
.a8cd 85 a7 sta $a7 STA N ; Use N for loop counter.
.a8cf 36 04 rol $04,x loopp ROL 4,X ; Rotate dividend lo cell left one bit.
.a8d1 36 05 rol $05,x ROL 5,X
.a8d3 c6 a7 dec $a7 DEC N ; Decrement loop counter.
.a8d5 f0 2c beq $a903 BEQ endd ; If we're done, then branch to end.
.a8d7 36 02 rol $02,x ROL 2,X ; Otherwise rotate dividend hi cell left one bit.
.a8d9 36 03 rol $03,x ROL 3,X
.a8db 64 a8 stz $a8 STZ N+1
.a8dd 26 a8 rol $a8 ROL N+1 ; Rotate the bit carried out of above into N+1.
.a8df 38 sec SEC
.a8e0 b5 02 lda $02,x LDA 2,X ; Subtract dividend hi cell minus divisor.
.a8e2 f5 00 sbc $00,x SBC 0,X
.a8e4 85 a9 sta $a9 STA N+2 ; Put result temporarily in N+2 (lo byte)
.a8e6 b5 03 lda $03,x LDA 3,X
.a8e8 f5 01 sbc $01,x SBC 1,X
.a8ea a8 tay TAY ; and Y (hi byte).
.a8eb a5 a8 lda $a8 LDA N+1 ; Remember now to bring in the bit carried out above.
.a8ed e9 00 sbc #$00 SBC #$00
.a8ef 90 de bcc $a8cf BCC loopp
.a8f1 a5 a9 lda $a9 LDA N+2 ; If that didn't cause a borrow,
.a8f3 95 02 sta $02,x STA 2,X ; make the result from above to
.a8f5 94 03 sty $03,x STY 3,X ; be the new dividend hi cell
.a8f7 80 d6 bra $a8cf BRA loopp ; and then brach up. (NMOS 6502 can use BCS here.)
.a8f9 a9 ff lda #$ff oflow LDA #$FF ; If overflow or /0 condition found,
.a8fb 95 02 sta $02,x STA 2,X ; just put FFFF in both the remainder
.a8fd 95 03 sta $03,x STA 3,X
.a8ff 95 04 sta $04,x STA 4,X ; and the quotient.
.a901 95 05 sta $05,x STA 5,X
.a903 e8 inx endd INX ; When you're done, show one less cell on data stack,
.a904 e8 inx INX ; (INX INX is exactly what the Forth word DROP does)
.a905 4c 9a 08 jmp $089a JMP SWAP+2 ; and swap the two top cells to put quotient on top.
>a908 83 41 4e c4 L453 .BYTE $83,"AN",$C4
>a90c b9 06 .WORD L418 ; link to U/
>a90e 10 07 ANDD .WORD *+2
.a910 b5 00 lda $00,x LDA 0,X
.a912 35 02 and $02,x AND 2,X
.a914 48 pha PHA
.a915 b5 01 lda $01,x LDA 1,X
.a917 35 03 and $03,x AND 3,X
.a919 e8 inx BINARY INX
.a91a e8 inx INX
.a91b 4c 3f 04 jmp $043f JMP PUT
>a91e 82 4f d2 L469 .BYTE $82,"O",$D2
>a921 08 07 .WORD L453 ; link to AND
>a923 25 07 OR .WORD *+2
.a925 b5 00 lda $00,x LDA 0,X
.a927 15 02 ora $02,x ORA 2,X
.a929 48 pha PHA
.a92a b5 01 lda $01,x LDA 1,X
.a92c 15 03 ora $03,x ORA 3,X
.a92e e8 inx INX
.a92f e8 inx INX
.a930 4c 3f 04 jmp $043f JMP PUT
>a933 83 58 4f d2 L484 .BYTE $83,"XO",$D2
>a937 1e 07 .WORD L469 ; link to OR
>a939 3b 07 XOR .WORD *+2
.a93b b5 00 lda $00,x LDA 0,X
.a93d 55 02 eor $02,x EOR 2,X
.a93f 48 pha PHA
.a940 b5 01 lda $01,x LDA 1,X
.a942 55 03 eor $03,x EOR 3,X
.a944 e8 inx INX
.a945 e8 inx INX
.a946 4c 3f 04 jmp $043f JMP PUT
>a949 83 53 50 c0 L499 .BYTE $83,"SP",$C0
>a94d 33 07 .WORD L484 ; link to XOR
>a94f 51 07 SPAT .WORD *+2
.a951 8a txa TXA
.a952 48 pha PUSHOA PHA
.a953 a9 00 lda #$00 LDA #0
.a955 4c 3d 04 jmp $043d JMP PUSH
>a958 83 53 50 a1 L511 .BYTE $83,"SP",$A1
>a95c 49 07 .WORD L499 ; link to SP@
>a95e 60 07 SPSTO .WORD *+2
.a960 a0 06 ldy #$06 LDY #6
.a962 b1 b4 lda ($b4),y LDA (UP),Y ; load data stack pointer (X reg) from
.a964 aa tax TAX ; silent user variable S0.
.a965 4c 44 04 jmp $0444 JMP NEXT
>a968 83 52 50 a1 L522 .BYTE $83,"RP",$A1
>a96c 58 07 .WORD L511 ; link to SP!
>a96e 70 07 RPSTO .WORD *+2
.a970 86 b6 stx $b6 STX XSAVE ; load return stack pointer (machine
.a972 a0 08 ldy #$08 LDY #8 ; stack pointer) from silent user
.a974 b1 b4 lda ($b4),y LDA (UP),Y ; VARIABLE R0
.a976 aa tax TAX
.a977 9a txs TXS
.a978 a6 b6 ldx $b6 LDX XSAVE
.a97a 4c 44 04 jmp $0444 JMP NEXT
>a97d 82 3b d3 L536 .BYTE $82,";",$D3
>a980 68 07 .WORD L522 ; link to RP!
>a982 84 07 SEMIS .WORD *+2
.a984 68 pla PLA
.a985 85 af sta $af STA IP
.a987 68 pla PLA
.a988 85 b0 sta $b0 STA IP+1
.a98a 4c 44 04 jmp $0444 JMP NEXT
>a98d 85 4c 45 41 56 c5 L548 .BYTE $85,"LEAV",$C5
>a993 7d 07 .WORD L536 ; link to ;S
>a995 97 07 LEAVE .WORD *+2
.a997 86 b6 stx $b6 STX XSAVE
.a999 ba tsx TSX
.a99a bd 01 01 lda $0101,x LDA $101,X
.a99d 9d 03 01 sta $0103,x STA $103,X
.a9a0 bd 02 01 lda $0102,x LDA $102,X
.a9a3 9d 04 01 sta $0104,x STA $104,X
.a9a6 a6 b6 ldx $b6 LDX XSAVE
.a9a8 4c 44 04 jmp $0444 JMP NEXT
>a9ab 82 3e d2 L563 .BYTE $82,">",$D2
>a9ae 8d 07 .WORD L548 ; link to LEAVE
>a9b0 b2 07 TOR .WORD *+2
.a9b2 b5 01 lda $01,x LDA 1,X ; move high byte
.a9b4 48 pha PHA
.a9b5 b5 00 lda $00,x LDA 0,X ; then low byte
.a9b7 48 pha PHA ; to return stack
.a9b8 e8 inx INX
.a9b9 e8 inx INX ; popping off data stack
.a9ba 4c 44 04 jmp $0444 JMP NEXT
>a9bd 82 52 be L577 .BYTE $82,"R",$BE
>a9c0 ab 07 .WORD L563 ; link to >R
>a9c2 c4 07 RFROM .WORD *+2
.a9c4 ca dex DEX ; make room on data stack
.a9c5 ca dex DEX
.a9c6 68 pla PLA ; high byte
.a9c7 95 00 sta $00,x STA 0,X
.a9c9 68 pla PLA ; then low byte
.a9ca 95 01 sta $01,x STA 1,X ; restored to data stack
.a9cc 4c 44 04 jmp $0444 JMP NEXT
>a9cf 81 d2 L591 .BYTE $81,$D2
>a9d1 bd 07 .WORD L577 ; link to R>
>a9d3 d5 07 R .WORD *+2
.a9d5 86 b6 stx $b6 STX XSAVE
.a9d7 ba tsx TSX ; address return stack
.a9d8 bd 01 01 lda $0101,x LDA $101,X ; copy bottom value
.a9db 48 pha PHA ; to data stack
.a9dc bd 02 01 lda $0102,x LDA $102,X
.a9df a6 b6 ldx $b6 LDX XSAVE
.a9e1 4c 3d 04 jmp $043d JMP PUSH
>a9e4 82 30 bd L605 .BYTE $82,"0",$BD
>a9e7 cf 07 .WORD L591 ; link to R
>a9e9 eb 07 ZEQU .WORD *+2
.a9eb b5 01 lda $01,x LDA 1,X ; Corrected from FD3/2 p69
.a9ed 94 01 sty $01,x STY 1,X
.a9ef 15 00 ora $00,x ORA 0,X
.a9f1 d0 01 bne $a9f4 BNE L613
.a9f3 c8 iny INY
.a9f4 94 00 sty $00,x L613 STY 0,X
.a9f6 4c 44 04 jmp $0444 JMP NEXT
>a9f9 82 30 bc L619 .BYTE $82,"0",$BC
>a9fc e4 07 .WORD L605 ; link to 0=
>a9fe 00 08 ZLESS .WORD *+2
.aa00 16 01 asl $01,x ASL 1,X
.aa02 98 tya TYA
.aa03 2a rol ROL
.aa04 94 01 sty $01,x STY 1,X
.aa06 95 00 sta $00,x STA 0,X
.aa08 4c 44 04 jmp $0444 JMP NEXT
>aa0b 81 ab L632 .BYTE $81,$AB
>aa0d f9 07 .WORD L619 ; link to V-ADJ
>aa0f 11 08 PLUS .WORD *+2
.aa11 18 clc CLC
.aa12 b5 00 lda $00,x LDA 0,X
.aa14 75 02 adc $02,x ADC 2,X
.aa16 95 02 sta $02,x STA 2,X
.aa18 b5 01 lda $01,x LDA 1,X
.aa1a 75 03 adc $03,x ADC 3,X
.aa1c 95 03 sta $03,x STA 3,X
.aa1e e8 inx INX
.aa1f e8 inx INX
.aa20 4c 44 04 jmp $0444 JMP NEXT
>aa23 82 44 ab L649 .BYTE $82,"D",$AB
>aa26 0b 08 .WORD L632 ; LINK TO +
>aa28 2a 08 DPLUS .WORD *+2
.aa2a 18 clc CLC
.aa2b b5 02 lda $02,x LDA 2,X
.aa2d 75 06 adc $06,x ADC 6,X
.aa2f 95 06 sta $06,x STA 6,X
.aa31 b5 03 lda $03,x LDA 3,X
.aa33 75 07 adc $07,x ADC 7,X
.aa35 95 07 sta $07,x STA 7,X
.aa37 b5 00 lda $00,x LDA 0,X
.aa39 75 04 adc $04,x ADC 4,X
.aa3b 95 04 sta $04,x STA 4,X
.aa3d b5 01 lda $01,x LDA 1,X
.aa3f 75 05 adc $05,x ADC 5,X
.aa41 95 05 sta $05,x STA 5,X
.aa43 4c 54 05 jmp $0554 JMP POPTWO
>aa46 85 4d 49 4e 55 d3 L670 .BYTE $85,"MINU",$D3
>aa4c 23 08 .WORD L649 ; link to D+
>aa4e 50 08 MINUS .WORD *+2
.aa50 38 sec SEC
.aa51 98 tya TYA
.aa52 f5 00 sbc $00,x SBC 0,X
.aa54 95 00 sta $00,x STA 0,X
.aa56 98 tya TYA
.aa57 f5 01 sbc $01,x SBC 1,X
.aa59 95 01 sta $01,x STA 1,X
.aa5b 4c 44 04 jmp $0444 JMP NEXT
>aa5e 86 44 4d 49 4e 55 d3 L685 .BYTE $86,"DMINU",$D3
>aa65 46 08 .WORD L670 ; link to MINUS
>aa67 69 08 DMINU .WORD *+2
.aa69 38 sec SEC
.aa6a 98 tya TYA
.aa6b f5 02 sbc $02,x SBC 2,X
.aa6d 95 02 sta $02,x STA 2,X
.aa6f 98 tya TYA
.aa70 f5 03 sbc $03,x SBC 3,X
.aa72 95 03 sta $03,x STA 3,X
.aa74 4c 51 08 jmp $0851 JMP MINUS+3
>aa77 84 4f 56 45 d2 L700 .BYTE $84,"OVE",$D2
>aa7c 5e 08 .WORD L685 ; link to DMINUS
>aa7e 80 08 OVER .WORD *+2
.aa80 b5 02 lda $02,x LDA 2,X
.aa82 48 pha PHA
.aa83 b5 03 lda $03,x LDA 3,X
.aa85 4c 3d 04 jmp $043d JMP PUSH
>aa88 84 44 52 4f d0 L711 .BYTE $84,"DRO",$D0
>aa8d 77 08 .WORD L700 ; link to OVER
>aa8f 56 05 DROP .WORD POP
>aa91 84 53 57 41 d0 L718 .BYTE $84,"SWA",$D0
>aa96 88 08 .WORD L711 ; link to DROP
>aa98 9a 08 SWAP .WORD *+2
.aa9a b5 02 lda $02,x LDA 2,X
.aa9c 48 pha PHA
.aa9d b5 00 lda $00,x LDA 0,X
.aa9f 95 02 sta $02,x STA 2,X
.aaa1 b5 03 lda $03,x LDA 3,X
.aaa3 b4 01 ldy $01,x LDY 1,X
.aaa5 94 03 sty $03,x STY 3,X
.aaa7 4c 3f 04 jmp $043f JMP PUT
>aaaa 83 44 55 d0 L733 .BYTE $83,"DU",$D0
>aaae 91 08 .WORD L718 ; link to SWAP
>aab0 b2 08 DUP .WORD *+2
.aab2 b5 00 lda $00,x LDA 0,X
.aab4 48 pha PHA
.aab5 b5 01 lda $01,x LDA 1,X
.aab7 4c 3d 04 jmp $043d JMP PUSH
>aaba 82 2b a1 L744 .BYTE $82,"+",$A1
>aabd aa 08 .WORD L733 ; link to DUP
>aabf c1 08 PSTOR .WORD *+2
.aac1 18 clc CLC
.aac2 a1 00 lda ($00,x) LDA (0,X) ; fetch 16 bit value addressed by
.aac4 75 02 adc $02,x ADC 2,X ; bottom of stack, adding to
.aac6 81 00 sta ($00,x) STA (0,X) ; second item on stack, and return
.aac8 f6 00 inc $00,x INC 0,X ; to memory
.aaca d0 02 bne $aace BNE L754
.aacc f6 01 inc $01,x INC 1,X
.aace a1 00 lda ($00,x) L754 LDA (0,X)
.aad0 75 03 adc $03,x ADC 3,X
.aad2 81 00 sta ($00,x) STA (0,X)
.aad4 4c 54 05 jmp $0554 JMP POPTWO
>aad7 81 54 4f 47 47 4c c5 L762 .BYTE $81,"TOGGL",$C5
>aade ba 08 .WORD L744 ; link to +!
>aae0 e2 08 TOGGL .WORD *+2
.aae2 a1 02 lda ($02,x) LDA (2,X) ; complement bits in memory address
.aae4 55 00 eor $00,x EOR 0,X ; second on stack, by pattern on
.aae6 81 02 sta ($02,x) STA (2,X) ; bottom of stack.
.aae8 4c 54 05 jmp $0554 JMP POPTWO
>aaeb 81 c0 L773 .BYTE $81,$C0
>aaed d7 08 .WORD L762 ; link to TOGGLE
>aaef f1 08 AT .WORD *+2
.aaf1 a1 00 lda ($00,x) LDA (0,X)
.aaf3 48 pha PHA
.aaf4 f6 00 inc $00,x INC 0,X
.aaf6 d0 02 bne $aafa BNE L781
.aaf8 f6 01 inc $01,x INC 1,X
.aafa a1 00 lda ($00,x) L781 LDA (0,X)
.aafc 4c 3f 04 jmp $043f JMP PUT
>aaff 82 43 c0 L787 .BYTE $82,"C",$C0
>ab02 eb 08 .WORD L773 ; link to @
>ab04 06 09 CAT .WORD *+2
.ab06 a1 00 lda ($00,x) LDA (0,X) ; fetch byte addressed by bottom of
.ab08 95 00 sta $00,x STA 0,X ; stack to stack, zeroing the high
.ab0a 94 01 sty $01,x STY 1,X ; byte
.ab0c 4c 44 04 jmp $0444 JMP NEXT
>ab0f 81 a1 L798 .BYTE $81,$A1
>ab11 ff 08 .WORD L787 ; link to C@
>ab13 15 09 STORE .WORD *+2
.ab15 b5 02 lda $02,x LDA 2,X
.ab17 81 00 sta ($00,x) STA (0,X) ; store second 16bit value on stack
.ab19 f6 00 inc $00,x INC 0,X ; to memory as addressed by bottom
.ab1b d0 02 bne $ab1f BNE L806 ; of stack.
.ab1d f6 01 inc $01,x INC 1,X
.ab1f b5 03 lda $03,x L806 LDA 3,X
.ab21 81 00 sta ($00,x) STA (0,X)
.ab23 4c 54 05 jmp $0554 JMP POPTWO
>ab26 82 43 a1 L813 .BYTE $82,"C",$A1
>ab29 0f 09 .WORD L798 ; link to !
>ab2b 2d 09 CSTOR .WORD *+2
.ab2d b5 02 lda $02,x LDA 2,X
.ab2f 81 00 sta ($00,x) STA (0,X)
.ab31 4c 54 05 jmp $0554 JMP POPTWO
>ab34 c1 ba L823 .BYTE $C1,$BA
>ab36 26 09 .WORD L813 ; link to C!
>ab38 4c 09 COLON .WORD DOCOL
>ab3a b5 0c .WORD QEXEC
>ab3c 71 0c .WORD SCSP
>ab3e cb 0a .WORD CURR
>ab40 ef 08 .WORD AT
>ab42 be 0a .WORD CON
>ab44 13 09 .WORD STORE
>ab46 a9 11 .WORD CREAT
>ab48 36 0d .WORD RBRAC
>ab4a 85 0d .WORD PSCOD
.ab4c a5 b0 lda $b0 DOCOL LDA IP+1
.ab4e 48 pha PHA
.ab4f a5 af lda $af LDA IP
.ab51 48 pha PHA
.ab52 18 clc CLC
.ab53 a5 b2 lda $b2 LDA W
.ab55 69 02 adc #$02 ADC #2
.ab57 85 af sta $af STA IP
.ab59 98 tya TYA
.ab5a 65 b3 adc $b3 ADC W+1
.ab5c 85 b0 sta $b0 STA IP+1
.ab5e 4c 44 04 jmp $0444 JMP NEXT
>ab61 c1 bb L853 .BYTE $C1,$BB
>ab63 34 09 .WORD L823 ; link to :
>ab65 4c 09 .WORD DOCOL
>ab67 dd 0c .WORD QCSP
>ab69 12 0d .WORD COMP
>ab6b 82 07 .WORD SEMIS
>ab6d 4a 0d .WORD SMUDG
>ab6f 28 0d .WORD LBRAC
>ab71 82 07 .WORD SEMIS
>ab73 88 43 4f 4e 53 54 41 4e d4 L867 .BYTE $88,"CONSTAN",$D4
>ab7c 61 09 .WORD L853 ; link to ;
>ab7e 4c 09 CONST .WORD DOCOL
>ab80 a9 11 .WORD CREAT
>ab82 4a 0d .WORD SMUDG
>ab84 4c 0b .WORD COMMA
>ab86 85 0d .WORD PSCOD
.ab88 a0 02 ldy #$02 DOCON LDY #2
.ab8a b1 b2 lda ($b2),y LDA (W),Y
.ab8c 48 pha PHA
.ab8d c8 iny INY
.ab8e b1 b2 lda ($b2),y LDA (W),Y
.ab90 4c 3d 04 jmp $043d JMP PUSH
>ab93 88 56 41 52 49 41 42 4c c5 L885 .BYTE $88,"VARIABL",$C5
>ab9c 73 09 .WORD L867 ; link to CONSTANT
>ab9e 4c 09 VAR .WORD DOCOL
>aba0 7e 09 .WORD CONST
>aba2 85 0d .WORD PSCOD
.aba4 18 clc DOVAR CLC
.aba5 a5 b2 lda $b2 LDA W
.aba7 69 02 adc #$02 ADC #2
.aba9 48 pha PHA
.abaa 98 tya TYA
.abab 65 b3 adc $b3 ADC W+1
.abad 4c 3d 04 jmp $043d JMP PUSH
>abb0 84 55 53 45 d2 L902 .BYTE $84,"USE",$D2
>abb5 93 09 .WORD L885 ; link to VARIABLE
>abb7 4c 09 USER .WORD DOCOL
>abb9 7e 09 .WORD CONST
>abbb 85 0d .WORD PSCOD
.abbd a0 02 ldy #$02 DOUSE LDY #2
.abbf 18 clc CLC
.abc0 b1 b2 lda ($b2),y LDA (W),Y
.abc2 65 b4 adc $b4 ADC UP
.abc4 48 pha PHA
.abc5 a9 00 lda #$00 LDA #0
.abc7 65 b5 adc $b5 ADC UP+1
.abc9 4c 3d 04 jmp $043d JMP PUSH
>abcc 81 b0 L920 .BYTE $81,$B0
>abce b0 09 .WORD L902 ; link to USER
>abd0 88 09 ZERO .WORD DOCON
>abd2 00 00 .WORD 0
>abd4 81 b1 L928 .BYTE $81,$B1
>abd6 cc 09 .WORD L920 ; link to 0
>abd8 88 09 ONE .WORD DOCON
>abda 01 00 .WORD 1
>abdc 81 b2 L936 .BYTE $81,$B2
>abde d4 09 .WORD L928 ; link to 1
>abe0 88 09 TWO .WORD DOCON
>abe2 02 00 .WORD 2
>abe4 81 b3 L944 .BYTE $81,$B3
>abe6 dc 09 .WORD L936 ; link to 2
>abe8 88 09 THREE .WORD DOCON
>abea 03 00 .WORD 3
>abec 82 42 cc L952 .BYTE $82,"B",$CC
>abef e4 09 .WORD L944 ; link to 3
>abf1 88 09 BL .WORD DOCON
>abf3 20 00 .WORD $20
>abf5 83 43 2f cc L960 .BYTE $83,"C/",$CC
>abf9 ec 09 .WORD L952 ; link to BL
>abfb 88 09 CSLL .WORD DOCON
>abfd 40 00 .WORD 64
>abff 85 46 49 52 53 d4 L968 .BYTE $85,"FIRS",$D4
>ac05 f5 09 .WORD L960 ; link to C/L
>ac07 88 09 FIRST .WORD DOCON
>ac09 60 3a .WORD DAREA ; bottom of disk buffer area
>ac0b 85 4c 49 4d 49 d4 L976 .BYTE $85,"LIMI",$D4
>ac11 ff 09 .WORD L968 ; link to FIRST
>ac13 88 09 LIMIT .WORD DOCON
>ac15 80 3e .WORD UAREA ; buffers end at user area
>ac17 85 42 2f 42 55 c6 L984 .BYTE $85,"B/BU",$C6
>ac1d 0b 0a .WORD L976 ; link to LIMIT
>ac1f 88 09 BBUF .WORD DOCON
>ac21 80 00 .WORD SSIZE ; sector size
>ac23 85 42 2f 53 43 d2 L992 .BYTE $85,"B/SC",$D2
>ac29 17 0a .WORD L984 ; link to B/BUF
>ac2b 88 09 BSCR .WORD DOCON
>ac2d 08 00 .WORD 8 ; blocks to make one screen
>ac2f 87 2b 4f 52 49 47 49 ce L1000 .BYTE $87,"+ORIGI",$CE
>ac37 23 0a .WORD L992 ; link to B/SCR
>ac39 4c 09 PORIG .WORD DOCOL
>ac3b 2a 04 00 04 .WORD LIT,ORIG
>ac3f 0f 08 .WORD PLUS
>ac41 82 07 .WORD SEMIS
>ac43 83 54 49 c2 L1010 .BYTE $83,"TI",$C2
>ac47 2f 0a .WORD L1000 ; link to +ORIGIN
>ac49 bd 09 TIB .WORD DOUSE
>ac4b 0a .BYTE $A
>ac4c 85 57 49 44 54 c8 L1018 .BYTE $85,"WIDT",$C8
>ac52 43 0a .WORD L1010 ; link to TIB
>ac54 bd 09 WIDTH .WORD DOUSE
>ac56 0c .BYTE $C
>ac57 87 57 41 52 4e 49 4e c7 L1026 .BYTE $87,"WARNIN",$C7
>ac5f 4c 0a .WORD L1018 ; link to WIDTH
>ac61 bd 09 WARN .WORD DOUSE
>ac63 0e .BYTE $E
>ac64 85 46 45 4e 43 c5 L1034 .BYTE $85,"FENC",$C5
>ac6a 57 0a .WORD L1026 ; link to WARNING
>ac6c bd 09 FENCE .WORD DOUSE
>ac6e 10 .BYTE $10
>ac6f 82 44 d0 L1042 .BYTE $82,"D",$D0
>ac72 64 0a .WORD L1034 ; link to FENCE
>ac74 bd 09 DP .WORD DOUSE
>ac76 12 .BYTE $12
>ac77 88 56 4f 43 2d 4c 49 4e cb L1050 .BYTE $88,"VOC-LIN",$CB
>ac80 6f 0a .WORD L1042 ; link to DP
>ac82 bd 09 VOCL .WORD DOUSE
>ac84 14 .BYTE $14
>ac85 83 42 4c cb L1058 .BYTE $83,"BL",$CB
>ac89 77 0a .WORD L1050 ; link to VOC-LINK
>ac8b bd 09 BLK .WORD DOUSE
>ac8d 16 .BYTE $16
>ac8e 82 49 ce L1066 .BYTE $82,"I",$CE
>ac91 85 0a .WORD L1058 ; link to BLK
>ac93 bd 09 IN .WORD DOUSE
>ac95 18 .BYTE $18
>ac96 83 4f 55 d4 L1074 .BYTE $83,"OU",$D4
>ac9a 8e 0a .WORD L1066 ; link to IN
>ac9c bd 09 OUT .WORD DOUSE
>ac9e 1a .BYTE $1A
>ac9f 83 53 43 d2 L1082 .BYTE $83,"SC",$D2
>aca3 96 0a .WORD L1074 ; link to OUT
>aca5 bd 09 SCR .WORD DOUSE
>aca7 1c .BYTE $1C
>aca8 86 4f 46 46 53 45 d4 L1090 .BYTE $86,"OFFSE",$D4
>acaf 9f 0a .WORD L1082 ; link to SCR
>acb1 bd 09 OFSET .WORD DOUSE
>acb3 1e .BYTE $1E
>acb4 87 43 4f 4e 54 45 58 d4 L1098 .BYTE $87,"CONTEX",$D4
>acbc a8 0a .WORD L1090 ; link to OFFSET
>acbe bd 09 CON .WORD DOUSE
>acc0 20 .BYTE $20
>acc1 87 43 55 52 52 45 4e d4 L1106 .BYTE $87,"CURREN",$D4
>acc9 b4 0a .WORD L1098 ; link to CONTEXT
>accb bd 09 CURR .WORD DOUSE
>accd 22 .BYTE $22
>acce 85 53 54 41 54 c5 L1114 .BYTE $85,"STAT",$C5
>acd4 c1 0a .WORD L1106 ; link to CURRENT
>acd6 bd 09 STATE .WORD DOUSE
>acd8 24 .BYTE $24
>acd9 84 42 41 53 c5 L1122 .BYTE $84,"BAS",$C5
>acde ce 0a .WORD L1114 ; link to STATE
>ace0 bd 09 BASE .WORD DOUSE
>ace2 26 .BYTE $26
>ace3 83 44 50 cc L1130 .BYTE $83,"DP",$CC
>ace7 d9 0a .WORD L1122 ; link to BASE
>ace9 bd 09 DPL .WORD DOUSE
>aceb 28 .BYTE $28
>acec 83 46 4c c4 L1138 .BYTE $83,"FL",$C4
>acf0 e3 0a .WORD L1130 ; link to DPL
>acf2 bd 09 FLD .WORD DOUSE
>acf4 2a .BYTE $2A
>acf5 83 43 53 d0 L1146 .BYTE $83,"CS",$D0
>acf9 ec 0a .WORD L1138 ; link to FLD
>acfb bd 09 CSP .WORD DOUSE
>acfd 2c .BYTE $2C
>acfe 82 52 a3 L1154 .BYTE $82,"R",$A3
>ad01 f5 0a .WORD L1146 ; link to CSP
>ad03 bd 09 RNUM .WORD DOUSE
>ad05 2e .BYTE $2E
>ad06 83 48 4c c4 L1162 .BYTE $83,"HL",$C4
>ad0a fe 0a .WORD L1154 ; link to R#
>ad0c bd 09 HLD .WORD DOUSE
>ad0e 30 .BYTE $30
>ad0f 82 31 ab L1170 .BYTE $82,"1",$AB
>ad12 06 0b .WORD L1162 ; link to HLD
>ad14 4c 09 ONEP .WORD DOCOL
>ad16 d8 09 .WORD ONE
>ad18 0f 08 .WORD PLUS
>ad1a 82 07 .WORD SEMIS
>ad1c 82 32 ab L1180 .BYTE $82,"2",$AB
>ad1f 0f 0b .WORD L1170 ; link to 1+
>ad21 4c 09 TWOP .WORD DOCOL
>ad23 e0 09 .WORD TWO
>ad25 0f 08 .WORD PLUS
>ad27 82 07 .WORD SEMIS
>ad29 84 48 45 52 c5 L1190 .BYTE $84,"HER",$C5
>ad2e 1c 0b .WORD L1180 ; link to 2+
>ad30 4c 09 HERE .WORD DOCOL
>ad32 74 0a .WORD DP
>ad34 ef 08 .WORD AT
>ad36 82 07 .WORD SEMIS
>ad38 85 41 4c 4c 4f d4 L1200 .BYTE $85,"ALLO",$D4
>ad3e 29 0b .WORD L1190 ; link to HERE
>ad40 4c 09 ALLOT .WORD DOCOL
>ad42 74 0a .WORD DP
>ad44 bf 08 .WORD PSTOR
>ad46 82 07 .WORD SEMIS
>ad48 81 ac L1210 .BYTE $81,$AC
>ad4a 38 0b .WORD L1200 ; link to ALLOT
>ad4c 4c 09 COMMA .WORD DOCOL
>ad4e 30 0b .WORD HERE
>ad50 13 09 .WORD STORE
>ad52 e0 09 .WORD TWO
>ad54 40 0b .WORD ALLOT
>ad56 82 07 .WORD SEMIS
>ad58 82 43 ac L1222 .BYTE $82,"C",$AC
>ad5b 48 0b .WORD L1210 ; link to ,
>ad5d 4c 09 CCOMM .WORD DOCOL
>ad5f 30 0b .WORD HERE
>ad61 2b 09 .WORD CSTOR
>ad63 d8 09 .WORD ONE
>ad65 40 0b .WORD ALLOT
>ad67 82 07 .WORD SEMIS
>ad69 81 ad L1234 .BYTE $81,$AD
>ad6b 58 0b .WORD L1222 ; link to C,
>ad6d 4c 09 SUB .WORD DOCOL
>ad6f 4e 08 .WORD MINUS
>ad71 0f 08 .WORD PLUS
>ad73 82 07 .WORD SEMIS
>ad75 81 bd L1244 .BYTE $81,$BD
>ad77 69 0b .WORD L1234 ; link to -
>ad79 4c 09 EQUAL .WORD DOCOL
>ad7b 6d 0b .WORD SUB
>ad7d e9 07 .WORD ZEQU
>ad7f 82 07 .WORD SEMIS
>ad81 82 55 bc L1246 .BYTE $82,"U",$BC
>ad84 75 0b .WORD L1244 ; link to =
>ad86 4c 09 ULESS .WORD DOCOL
>ad88 6d 0b .WORD SUB ; subtract two values
>ad8a fe 07 .WORD ZLESS ; test sign
>ad8c 82 07 .WORD SEMIS
>ad8e 81 bc L1254 .BYTE $81,$BC
>ad90 81 0b .WORD L1246 ; link to U<
>ad92 94 0b LESS .WORD *+2
.ad94 38 sec SEC
.ad95 b5 02 lda $02,x LDA 2,X
.ad97 f5 00 sbc $00,x SBC 0,X ; subtract
.ad99 b5 03 lda $03,x LDA 3,X
.ad9b f5 01 sbc $01,x SBC 1,X
.ad9d 94 03 sty $03,x STY 3,X ; zero high byte
.ad9f 50 02 bvc $ada3 BVC L1258
.ada1 49 80 eor #$80 EOR #$80 ; correct overflow
.ada3 10 01 bpl $ada6 L1258 BPL L1260
.ada5 c8 iny INY ; invert boolean
.ada6 94 02 sty $02,x L1260 STY 2,X ; leave boolean
.ada8 4c 56 05 jmp $0556 JMP POP
>adab 81 be L1264 .BYTE $81,$BE
>adad 8e 0b .WORD L1254 ; link to <
>adaf 4c 09 GREAT .WORD DOCOL
>adb1 98 08 .WORD SWAP
>adb3 92 0b .WORD LESS
>adb5 82 07 .WORD SEMIS
>adb7 83 52 4f d4 L1274 .BYTE $83,"RO",$D4
>adbb ab 0b .WORD L1264 ; link to >
>adbd 4c 09 ROT .WORD DOCOL
>adbf b0 07 .WORD TOR
>adc1 98 08 .WORD SWAP
>adc3 c2 07 .WORD RFROM
>adc5 98 08 .WORD SWAP
>adc7 82 07 .WORD SEMIS
>adc9 85 53 50 41 43 c5 L1286 .BYTE $85,"SPAC",$C5
>adcf b7 0b .WORD L1274 ; link to ROT
>add1 4c 09 SPACE .WORD DOCOL
>add3 f1 09 .WORD BL
>add5 3f 06 .WORD EMIT
>add7 82 07 .WORD SEMIS
>add9 84 2d 44 55 d0 L1296 .BYTE $84,"-DU",$D0
>adde c9 0b .WORD L1286 ; link to SPACE
>ade0 4c 09 DDUP .WORD DOCOL
>ade2 b0 08 .WORD DUP
>ade4 be 04 .WORD ZBRAN
>ade6 04 00 L1301 .WORD $4 ; L1303-L1301
>ade8 b0 08 .WORD DUP
>adea 82 07 L1303 .WORD SEMIS
>adec 88 54 52 41 56 45 52 53 c5 L1308 .BYTE $88,"TRAVERS",$C5
>adf5 d9 0b .WORD L1296 ; link to -DUP
>adf7 4c 09 TRAV .WORD DOCOL
>adf9 98 08 .WORD SWAP
>adfb 7e 08 L1312 .WORD OVER
>adfd 0f 08 .WORD PLUS
>adff 64 04 .WORD CLIT
>ae01 7f .BYTE $7F
>ae02 7e 08 .WORD OVER
>ae04 04 09 .WORD CAT
>ae06 92 0b .WORD LESS
>ae08 be 04 .WORD ZBRAN
>ae0a f1 ff L1320 .WORD $FFF1 ; L1312-L1320
>ae0c 98 08 .WORD SWAP
>ae0e 8f 08 .WORD DROP
>ae10 82 07 .WORD SEMIS
>ae12 86 4c 41 54 45 53 d4 L1328 .BYTE $86,"LATES",$D4
>ae19 ec 0b .WORD L1308 ; link to TRAVERSE
>ae1b 4c 09 LATES .WORD DOCOL
>ae1d cb 0a .WORD CURR
>ae1f ef 08 .WORD AT
>ae21 ef 08 .WORD AT
>ae23 82 07 .WORD SEMIS
>ae25 83 4c 46 c1 L1339 .BYTE $83,"LF",$C1
>ae29 12 0c .WORD L1328 ; link to LATEST
>ae2b 4c 09 LFA .WORD DOCOL
>ae2d 64 04 .WORD CLIT
>ae2f 04 .BYTE 4
>ae30 6d 0b .WORD SUB
>ae32 82 07 .WORD SEMIS
>ae34 83 43 46 c1 L1350 .BYTE $83,"CF",$C1
>ae38 25 0c .WORD L1339 ; link to LFA
>ae3a 4c 09 CFA .WORD DOCOL
>ae3c e0 09 .WORD TWO
>ae3e 6d 0b .WORD SUB
>ae40 82 07 .WORD SEMIS
>ae42 83 4e 46 c1 L1360 .BYTE $83,"NF",$C1
>ae46 34 0c .WORD L1350 ; link to CFA
>ae48 4c 09 NFA .WORD DOCOL
>ae4a 64 04 .WORD CLIT
>ae4c 05 .BYTE $5
>ae4d 6d 0b .WORD SUB
>ae4f 2a 04 ff ff .WORD LIT,$FFFF
>ae53 f7 0b .WORD TRAV
>ae55 82 07 .WORD SEMIS
>ae57 83 50 46 c1 L1373 .BYTE $83,"PF",$C1
>ae5b 42 0c .WORD L1360 ; link to NFA
>ae5d 4c 09 PFA .WORD DOCOL
>ae5f d8 09 .WORD ONE
>ae61 f7 0b .WORD TRAV
>ae63 64 04 .WORD CLIT
>ae65 05 .BYTE 5
>ae66 0f 08 .WORD PLUS
>ae68 82 07 .WORD SEMIS
>ae6a 84 21 43 53 d0 L1386 .BYTE $84,"!CS",$D0
>ae6f 57 0c .WORD L1373 ; link to PFA
>ae71 4c 09 SCSP .WORD DOCOL
>ae73 4f 07 .WORD SPAT
>ae75 fb 0a .WORD CSP
>ae77 13 09 .WORD STORE
>ae79 82 07 .WORD SEMIS
>ae7b 86 3f 45 52 52 4f d2 L1397 .BYTE $86,"?ERRO",$D2
>ae82 6a 0c .WORD L1386 ; link to !CSP
>ae84 4c 09 QERR .WORD DOCOL
>ae86 98 08 .WORD SWAP
>ae88 be 04 .WORD ZBRAN
>ae8a 08 00 L1402 .WORD 8 ; L1406-L1402
>ae8c 40 11 .WORD ERROR
>ae8e 9f 04 .WORD BRAN
>ae90 04 00 L1405 .WORD 4 ; L1407-L1405
>ae92 8f 08 L1406 .WORD DROP
>ae94 82 07 L1407 .WORD SEMIS
>ae96 85 3f 43 4f 4d d0 L1412 .BYTE $85,"?COM",$D0
>ae9c 7b 0c .WORD L1397 ; link to ?ERROR
>ae9e 4c 09 QCOMP .WORD DOCOL
>aea0 d6 0a .WORD STATE
>aea2 ef 08 .WORD AT
>aea4 e9 07 .WORD ZEQU
>aea6 64 04 .WORD CLIT
>aea8 11 .BYTE $11
>aea9 84 0c .WORD QERR
>aeab 82 07 .WORD SEMIS
>aead 85 3f 45 58 45 c3 L1426 .BYTE $85,"?EXE",$C3
>aeb3 96 0c .WORD L1412 ; link to ?COMP
>aeb5 4c 09 QEXEC .WORD DOCOL
>aeb7 d6 0a .WORD STATE
>aeb9 ef 08 .WORD AT
>aebb 64 04 .WORD CLIT
>aebd 12 .BYTE $12
>aebe 84 0c .WORD QERR
>aec0 82 07 .WORD SEMIS
>aec2 86 3f 50 41 49 52 d3 L1439 .BYTE $86,"?PAIR",$D3
>aec9 ad 0c .WORD L1426 ; link to ?EXEC
>aecb 4c 09 QPAIR .WORD DOCOL
>aecd 6d 0b .WORD SUB
>aecf 64 04 .WORD CLIT
>aed1 13 .BYTE $13
>aed2 84 0c .WORD QERR
>aed4 82 07 .WORD SEMIS
>aed6 84 3f 43 53 d0 L1451 .BYTE $84,"?CS",$D0
>aedb c2 0c .WORD L1439 ; link to ?PAIRS
>aedd 4c 09 QCSP .WORD DOCOL
>aedf 4f 07 .WORD SPAT
>aee1 fb 0a .WORD CSP
>aee3 ef 08 .WORD AT
>aee5 6d 0b .WORD SUB
>aee7 64 04 .WORD CLIT
>aee9 14 .BYTE $14
>aeea 84 0c .WORD QERR
>aeec 82 07 .WORD SEMIS
>aeee 88 3f 4c 4f 41 44 49 4e c7 L1466 .BYTE $88,"?LOADIN",$C7
>aef7 d6 0c .WORD L1451 ; link to ?CSP
>aef9 4c 09 QLOAD .WORD DOCOL
>aefb 8b 0a .WORD BLK
>aefd ef 08 .WORD AT
>aeff e9 07 .WORD ZEQU
>af01 64 04 .WORD CLIT
>af03 16 .BYTE $16
>af04 84 0c .WORD QERR
>af06 82 07 .WORD SEMIS
>af08 87 43 4f 4d 50 49 4c c5 L1480 .BYTE $87,"COMPIL",$C5
>af10 ee 0c .WORD L1466 ; link to ?LOADING
>af12 4c 09 COMP .WORD DOCOL
>af14 9e 0c .WORD QCOMP
>af16 c2 07 .WORD RFROM
>af18 b0 08 .WORD DUP
>af1a 21 0b .WORD TWOP
>af1c b0 07 .WORD TOR
>af1e ef 08 .WORD AT
>af20 4c 0b .WORD COMMA
>af22 82 07 .WORD SEMIS
>af24 c1 db L1495 .BYTE $C1,$DB
>af26 08 0d .WORD L1480 ; link to COMPILE
>af28 4c 09 LBRAC .WORD DOCOL
>af2a d0 09 .WORD ZERO
>af2c d6 0a .WORD STATE
>af2e 13 09 .WORD STORE
>af30 82 07 .WORD SEMIS
>af32 81 dd L1507 .BYTE $81,$DD
>af34 24 0d .WORD L1495 ; link to [
>af36 4c 09 RBRAC .WORD DOCOL
>af38 64 04 .WORD CLIT
>af3a c0 .BYTE $C0
>af3b d6 0a .WORD STATE
>af3d 13 09 .WORD STORE
>af3f 82 07 .WORD SEMIS
>af41 86 53 4d 55 44 47 c5 L1519 .BYTE $86,"SMUDG",$C5
>af48 32 0d .WORD L1507 ; link to ]
>af4a 4c 09 SMUDG .WORD DOCOL
>af4c 1b 0c .WORD LATES
>af4e 64 04 .WORD CLIT
>af50 20 .BYTE $20
>af51 e0 08 .WORD TOGGL
>af53 82 07 .WORD SEMIS
>af55 83 48 45 d8 L1531 .BYTE $83,"HE",$D8
>af59 41 0d .WORD L1519 ; link to SMUDGE
>af5b 4c 09 HEX .WORD DOCOL
>af5d 64 04 .WORD CLIT
>af5f 10 .BYTE 16
>af60 e0 0a .WORD BASE
>af62 13 09 .WORD STORE
>af64 82 07 .WORD SEMIS
>af66 87 44 45 43 49 4d 41 cc L1543 .BYTE $87,"DECIMA",$CC
>af6e 55 0d .WORD L1531 ; link to HEX
>af70 4c 09 DECIM .WORD DOCOL
>af72 64 04 .WORD CLIT
>af74 0a .BYTE 10
>af75 e0 0a .WORD BASE
>af77 13 09 .WORD STORE
>af79 82 07 .WORD SEMIS
>af7b 87 28 3b 43 4f 44 45 a9 L1555 .BYTE $87,"(;CODE",$A9
>af83 66 0d .WORD L1543 ; link to DECIMAL
>af85 4c 09 PSCOD .WORD DOCOL
>af87 c2 07 .WORD RFROM
>af89 1b 0c .WORD LATES
>af8b 5d 0c .WORD PFA
>af8d 3a 0c .WORD CFA
>af8f 13 09 .WORD STORE
>af91 82 07 .WORD SEMIS
>af93 c5 3b 43 4f 44 c5 L1568 .BYTE $C5,";COD",$C5
>af99 7b 0d .WORD L1555 ; link to (;CODE)
>af9b 4c 09 .WORD DOCOL
>af9d dd 0c .WORD QCSP
>af9f 12 0d .WORD COMP
>afa1 85 0d .WORD PSCOD
>afa3 28 0d .WORD LBRAC
>afa5 4a 0d .WORD SMUDG
>afa7 82 07 .WORD SEMIS
>afa9 87 3c 42 55 49 4c 44 d3 L1582 .BYTE $87,"<BUILD",$D3
>afb1 93 0d .WORD L1568 ; link to ;CODE
>afb3 4c 09 BUILD .WORD DOCOL
>afb5 d0 09 .WORD ZERO
>afb7 7e 09 .WORD CONST
>afb9 82 07 .WORD SEMIS
>afbb 85 44 4f 45 53 be L1592 .BYTE $85,"DOES",$BE
>afc1 a9 0d .WORD L1582 ; link to <BUILDS
>afc3 4c 09 DOES .WORD DOCOL
>afc5 c2 07 .WORD RFROM
>afc7 1b 0c .WORD LATES
>afc9 5d 0c .WORD PFA
>afcb 13 09 .WORD STORE
>afcd 85 0d .WORD PSCOD
.afcf a5 b0 lda $b0 DODOE LDA IP+1
.afd1 48 pha PHA
.afd2 a5 af lda $af LDA IP
.afd4 48 pha PHA
.afd5 a0 02 ldy #$02 LDY #2
.afd7 b1 b2 lda ($b2),y LDA (W),Y
.afd9 85 af sta $af STA IP
.afdb c8 iny INY
.afdc b1 b2 lda ($b2),y LDA (W),Y
.afde 85 b0 sta $b0 STA IP+1
.afe0 18 clc CLC
.afe1 a5 b2 lda $b2 LDA W
.afe3 69 04 adc #$04 ADC #4
.afe5 48 pha PHA
.afe6 a5 b3 lda $b3 LDA W+1
.afe8 69 00 adc #$00 ADC #0
.afea 4c 3d 04 jmp $043d JMP PUSH
>afed 85 43 4f 55 4e d4 L1622 .BYTE $85,"COUN",$D4
>aff3 bb 0d .WORD L1592 ; link to DOES>
>aff5 4c 09 COUNT .WORD DOCOL
>aff7 b0 08 .WORD DUP
>aff9 14 0b .WORD ONEP
>affb 98 08 .WORD SWAP
>affd 04 09 .WORD CAT
>afff 82 07 .WORD SEMIS
>b001 84 54 59 50 c5 L1634 .BYTE $84,"TYP",$C5
>b006 ed 0d .WORD L1622 ; link to COUNT
>b008 4c 09 TYPE .WORD DOCOL
>b00a e0 0b .WORD DDUP
>b00c be 04 .WORD ZBRAN
>b00e 18 00 L1639 .WORD $18 ; L1651-L1639
>b010 7e 08 .WORD OVER
>b012 0f 08 .WORD PLUS
>b014 98 08 .WORD SWAP
>b016 46 05 .WORD PDO
>b018 5f 05 L1644 .WORD I
>b01a 04 09 .WORD CAT
>b01c 3f 06 .WORD EMIT
>b01e df 04 .WORD PLOOP
>b020 f8 ff L1648 .WORD $FFF8 ; L1644-L1648
>b022 9f 04 .WORD BRAN
>b024 04 00 L1650 .WORD $4 ; L1652-L1650
>b026 8f 08 L1651 .WORD DROP
>b028 82 07 L1652 .WORD SEMIS
>b02a 89 2d 54 52 41 49 4c 49 4e c7 L1657 .BYTE $89,"-TRAILIN",$C7
>b034 01 0e .WORD L1634 ; link to TYPE
>b036 4c 09 DTRAI .WORD DOCOL
>b038 b0 08 .WORD DUP
>b03a d0 09 .WORD ZERO
>b03c 46 05 .WORD PDO
>b03e 7e 08 L1663 .WORD OVER
>b040 7e 08 .WORD OVER
>b042 0f 08 .WORD PLUS
>b044 d8 09 .WORD ONE
>b046 6d 0b .WORD SUB
>b048 04 09 .WORD CAT
>b04a f1 09 .WORD BL
>b04c 6d 0b .WORD SUB
>b04e be 04 .WORD ZBRAN
>b050 08 00 L1672 .WORD 8 ; L1676-L1672
>b052 95 07 .WORD LEAVE
>b054 9f 04 .WORD BRAN
>b056 06 00 L1675 .WORD 6 ; L1678-L1675
>b058 d8 09 L1676 .WORD ONE
>b05a 6d 0b .WORD SUB
>b05c df 04 L1678 .WORD PLOOP
>b05e e0 ff L1679 .WORD $FFE0 ; L1663-L1679
>b060 82 07 .WORD SEMIS
>b062 84 28 2e 22 a9 L1685 .BYTE $84,"(.",$22,$A9 ; $84 (." $A9
>b067 2a 0e .WORD L1657 ; link to -TRAILING
>b069 4c 09 PDOTQ .WORD DOCOL
>b06b d3 07 .WORD R
>b06d f5 0d .WORD COUNT
>b06f b0 08 .WORD DUP
>b071 14 0b .WORD ONEP
>b073 c2 07 .WORD RFROM
>b075 0f 08 .WORD PLUS
>b077 b0 07 .WORD TOR
>b079 08 0e .WORD TYPE
>b07b 82 07 .WORD SEMIS
>b07d c2 2e a2 L1701 .BYTE $C2,".",$A2
>b080 62 0e .WORD L1685 ; link to PDOTQ
>b082 4c 09 .WORD DOCOL
>b084 64 04 .WORD CLIT
>b086 22 .BYTE $22
>b087 d6 0a .WORD STATE
>b089 ef 08 .WORD AT
>b08b be 04 .WORD ZBRAN
>b08d 14 00 L1709 .WORD $14 ;L1719-L1709
>b08f 12 0d .WORD COMP
>b091 69 0e .WORD PDOTQ
>b093 e3 0f .WORD WORD
>b095 30 0b .WORD HERE
>b097 04 09 .WORD CAT
>b099 14 0b .WORD ONEP
>b09b 40 0b .WORD ALLOT
>b09d 9f 04 .WORD BRAN
>b09f 0a 00 L1718 .WORD $A ;L1723-L1718
>b0a1 e3 0f L1719 .WORD WORD
>b0a3 30 0b .WORD HERE
>b0a5 f5 0d .WORD COUNT
>b0a7 08 0e .WORD TYPE
>b0a9 82 07 L1723 .WORD SEMIS
>b0ab 86 45 58 50 45 43 d4 L1729 .BYTE $86,"EXPEC",$D4
>b0b2 7d 0e .WORD L1701 ; link to ."
>b0b4 4c 09 EXPEC .WORD DOCOL
>b0b6 7e 08 .WORD OVER
>b0b8 0f 08 .WORD PLUS
>b0ba 7e 08 .WORD OVER
>b0bc 46 05 .WORD PDO
>b0be 47 06 L1736 .WORD KEY
>b0c0 b0 08 .WORD DUP
>b0c2 64 04 .WORD CLIT
>b0c4 0e .BYTE $E
>b0c5 39 0a .WORD PORIG
>b0c7 ef 08 .WORD AT
>b0c9 79 0b .WORD EQUAL
>b0cb be 04 .WORD ZBRAN
>b0cd 1f 00 L1744 .WORD $1F ; L1760-L1744
>b0cf 8f 08 .WORD DROP
>b0d1 64 04 .WORD CLIT
>b0d3 08 .BYTE 08
>b0d4 7e 08 .WORD OVER
>b0d6 5f 05 .WORD I
>b0d8 79 0b .WORD EQUAL
>b0da b0 08 .WORD DUP
>b0dc c2 07 .WORD RFROM
>b0de e0 09 .WORD TWO
>b0e0 6d 0b .WORD SUB
>b0e2 0f 08 .WORD PLUS
>b0e4 b0 07 .WORD TOR
>b0e6 6d 0b .WORD SUB
>b0e8 9f 04 .WORD BRAN
>b0ea 27 00 L1759 .WORD $27 ; L1779-L1759
>b0ec b0 08 L1760 .WORD DUP
>b0ee 64 04 .WORD CLIT
>b0f0 0d .BYTE $0D
>b0f1 79 0b .WORD EQUAL
>b0f3 be 04 .WORD ZBRAN
>b0f5 0e 00 L1765 .WORD $0E ; L1772-L1765
>b0f7 95 07 .WORD LEAVE
>b0f9 8f 08 .WORD DROP
>b0fb f1 09 .WORD BL
>b0fd d0 09 .WORD ZERO
>b0ff 9f 04 .WORD BRAN
>b101 04 00 L1771 .WORD 04 ; L1773-L1771
>b103 b0 08 L1772 .WORD DUP
>b105 5f 05 L1773 .WORD I
>b107 2b 09 .WORD CSTOR
>b109 d0 09 .WORD ZERO
>b10b 5f 05 .WORD I
>b10d 14 0b .WORD ONEP
>b10f 13 09 .WORD STORE
>b111 3f 06 L1779 .WORD EMIT
>b113 df 04 .WORD PLOOP
>b115 a9 ff L1781 .WORD $FFA9
>b117 8f 08 .WORD DROP ; L1736-L1781
>b119 82 07 .WORD SEMIS
>b11b 85 51 55 45 52 d9 L1788 .BYTE $85,"QUER",$D9
>b121 ab 0e .WORD L1729 ; link to EXPECT
>b123 4c 09 QUERY .WORD DOCOL
>b125 49 0a .WORD TIB
>b127 ef 08 .WORD AT
>b129 64 04 .WORD CLIT
>b12b 50 .BYTE 80 ; 80 characters from terminal
>b12c b4 0e .WORD EXPEC
>b12e d0 09 .WORD ZERO
>b130 93 0a .WORD IN
>b132 13 09 .WORD STORE
>b134 82 07 .WORD SEMIS
>b136 c1 80 L1804 .BYTE $C1,$80
>b138 1b 0f .WORD L1788 ; link to QUERY
>b13a 4c 09 .WORD DOCOL
>b13c 8b 0a .WORD BLK
>b13e ef 08 .WORD AT
>b140 be 04 .WORD ZBRAN
>b142 2a 00 L1810 .WORD $2A ; L1830-l1810
>b144 d8 09 .WORD ONE
>b146 8b 0a .WORD BLK
>b148 bf 08 .WORD PSTOR
>b14a d0 09 .WORD ZERO
>b14c 93 0a .WORD IN
>b14e 13 09 .WORD STORE
>b150 8b 0a .WORD BLK
>b152 ef 08 .WORD AT
>b154 d0 09 2b 0a .WORD ZERO,BSCR
>b158 be 06 .WORD USLAS
>b15a 8f 08 .WORD DROP ; fixed from model
>b15c e9 07 .WORD ZEQU
>b15e be 04 .WORD ZBRAN
>b160 08 00 L1824 .WORD 8 ; L1828-L1824
>b162 b5 0c .WORD QEXEC
>b164 c2 07 .WORD RFROM
>b166 8f 08 .WORD DROP
>b168 9f 04 L1828 .WORD BRAN
>b16a 06 00 L1829 .WORD 6 ; L1832-L1829
>b16c c2 07 L1830 .WORD RFROM
>b16e 8f 08 .WORD DROP
>b170 82 07 L1832 .WORD SEMIS
>b172 84 46 49 4c cc L1838 .BYTE $84,"FIL",$CC
>b177 36 0f .WORD L1804 ; link to X
>b179 4c 09 FILL .WORD DOCOL
>b17b 98 08 .WORD SWAP
>b17d b0 07 .WORD TOR
>b17f 7e 08 .WORD OVER
>b181 2b 09 .WORD CSTOR
>b183 b0 08 .WORD DUP
>b185 14 0b .WORD ONEP
>b187 c2 07 .WORD RFROM
>b189 d8 09 .WORD ONE
>b18b 6d 0b .WORD SUB
>b18d 66 06 .WORD CMOVE
>b18f 82 07 .WORD SEMIS
>b191 85 45 52 41 53 c5 L1856 .BYTE $85,"ERAS",$C5
>b197 72 0f .WORD L1838 ; link to FILL
>b199 4c 09 ERASE .WORD DOCOL
>b19b d0 09 .WORD ZERO
>b19d 79 0f .WORD FILL
>b19f 82 07 .WORD SEMIS
>b1a1 86 42 4c 41 4e 4b d3 L1866 .BYTE $86,"BLANK",$D3
>b1a8 91 0f .WORD L1856 ; link to ERASE
>b1aa 4c 09 BLANK .WORD DOCOL
>b1ac f1 09 .WORD BL
>b1ae 79 0f .WORD FILL
>b1b0 82 07 .WORD SEMIS
>b1b2 84 48 4f 4c c4 L1876 .BYTE $84,"HOL",$C4
>b1b7 a1 0f .WORD L1866 ; link to BLANKS
>b1b9 4c 09 HOLD .WORD DOCOL
>b1bb 2a 04 ff ff .WORD LIT,$FFFF
>b1bf 0c 0b .WORD HLD
>b1c1 bf 08 .WORD PSTOR
>b1c3 0c 0b .WORD HLD
>b1c5 ef 08 .WORD AT
>b1c7 2b 09 .WORD CSTOR
>b1c9 82 07 .WORD SEMIS
>b1cb 83 50 41 c4 L1890 .BYTE $83,"PA",$C4
>b1cf b2 0f .WORD L1876 ; link to HOLD
>b1d1 4c 09 PAD .WORD DOCOL
>b1d3 30 0b .WORD HERE
>b1d5 64 04 .WORD CLIT
>b1d7 44 .BYTE 68 ; PAD is 68 bytes above here.
>b1d8 0f 08 .WORD PLUS
>b1da 82 07 .WORD SEMIS
>b1dc 84 57 4f 52 c4 L1902 .BYTE $84,"WOR",$C4
>b1e1 cb 0f .WORD L1890 ; link to PAD
>b1e3 4c 09 WORD .WORD DOCOL
>b1e5 8b 0a .WORD BLK
>b1e7 ef 08 .WORD AT
>b1e9 be 04 .WORD ZBRAN
>b1eb 0c 00 L1908 .WORD $C ; L1914-L1908
>b1ed 8b 0a .WORD BLK
>b1ef ef 08 .WORD AT
>b1f1 48 16 .WORD BLOCK
>b1f3 9f 04 .WORD BRAN
>b1f5 06 00 L1913 .WORD $6 ; L1916-L1913
>b1f7 49 0a L1914 .WORD TIB
>b1f9 ef 08 .WORD AT
>b1fb 93 0a L1916 .WORD IN
>b1fd ef 08 .WORD AT
>b1ff 0f 08 .WORD PLUS
>b201 98 08 .WORD SWAP
>b203 00 06 .WORD ENCL
>b205 30 0b .WORD HERE
>b207 64 04 .WORD CLIT
>b209 22 .BYTE $22
>b20a aa 0f .WORD BLANK
>b20c 93 0a .WORD IN
>b20e bf 08 .WORD PSTOR
>b210 7e 08 .WORD OVER
>b212 6d 0b .WORD SUB
>b214 b0 07 .WORD TOR
>b216 d3 07 .WORD R
>b218 30 0b .WORD HERE
>b21a 2b 09 .WORD CSTOR
>b21c 0f 08 .WORD PLUS
>b21e 30 0b .WORD HERE
>b220 14 0b .WORD ONEP
>b222 c2 07 .WORD RFROM
>b224 66 06 .WORD CMOVE
>b226 82 07 .WORD SEMIS
>b228 85 55 50 50 45 d2 L1943 .BYTE $85,"UPPE",$D2
>b22e dc 0f .WORD L1902 ; link to WORD
>b230 4c 09 UPPER .WORD DOCOL
>b232 7e 08 .WORD OVER ; This routine converts text to U case
>b234 0f 08 .WORD PLUS ; It allows interpretation from a term.
>b236 98 08 .WORD SWAP ; without a shift-lock.
>b238 46 05 .WORD PDO
>b23a 5f 05 L1950 .WORD I
>b23c 04 09 .WORD CAT
>b23e 64 04 .WORD CLIT
>b240 5f .BYTE $5F
>b241 af 0b .WORD GREAT
>b243 be 04 .WORD ZBRAN
>b245 09 00 L1956 .WORD 09 ; L1961-L1956
>b247 5f 05 .WORD I
>b249 64 04 .WORD CLIT
>b24b 20 .BYTE $20
>b24c e0 08 .WORD TOGGL
>b24e df 04 L1961 .WORD PLOOP
>b250 ea ff L1962 .WORD $FFEA ; L1950-L1962
>b252 82 07 .WORD SEMIS
>b254 88 28 4e 55 4d 42 45 52 a9 L1968 .BYTE $88,"(NUMBER",$A9
>b25d 28 10 .WORD L1943 ; link to UPPER
>b25f 4c 09 PNUMB .WORD DOCOL
>b261 14 0b L1971 .WORD ONEP
>b263 b0 08 .WORD DUP
>b265 b0 07 .WORD TOR
>b267 04 09 .WORD CAT
>b269 e0 0a .WORD BASE
>b26b ef 08 .WORD AT
>b26d 69 05 .WORD DIGIT
>b26f be 04 .WORD ZBRAN
>b271 2c 00 L1979 .WORD $2C ; L2001-L1979
>b273 98 08 .WORD SWAP
>b275 e0 0a .WORD BASE
>b277 ef 08 .WORD AT
>b279 8b 06 .WORD USTAR
>b27b 8f 08 .WORD DROP
>b27d bd 0b .WORD ROT
>b27f e0 0a .WORD BASE
>b281 ef 08 .WORD AT
>b283 8b 06 .WORD USTAR
>b285 28 08 .WORD DPLUS
>b287 e9 0a .WORD DPL
>b289 ef 08 .WORD AT
>b28b 14 0b .WORD ONEP
>b28d be 04 .WORD ZBRAN
>b28f 08 00 L1994 .WORD 8 ; L1998-L1994
>b291 d8 09 .WORD ONE
>b293 e9 0a .WORD DPL
>b295 bf 08 .WORD PSTOR
>b297 c2 07 L1998 .WORD RFROM
>b299 9f 04 .WORD BRAN
>b29b c6 ff L2000 .WORD $FFC6 ; L1971-L2000
>b29d c2 07 L2001 .WORD RFROM
>b29f 82 07 .WORD SEMIS
>b2a1 86 4e 55 4d 42 45 d2 L2007 .BYTE $86,"NUMBE",$D2
>b2a8 54 10 .WORD L1968 ; link to (NUMBER)
>b2aa 4c 09 NUMBER .WORD DOCOL
>b2ac d0 09 .WORD ZERO
>b2ae d0 09 .WORD ZERO
>b2b0 bd 0b .WORD ROT
>b2b2 b0 08 .WORD DUP
>b2b4 14 0b .WORD ONEP
>b2b6 04 09 .WORD CAT
>b2b8 64 04 .WORD CLIT
>b2ba 2d .BYTE $2D
>b2bb 79 0b .WORD EQUAL
>b2bd b0 08 .WORD DUP
>b2bf b0 07 .WORD TOR
>b2c1 0f 08 .WORD PLUS
>b2c3 2a 04 ff ff .WORD LIT,$FFFF
>b2c7 e9 0a L2023 .WORD DPL
>b2c9 13 09 .WORD STORE
>b2cb 5f 10 .WORD PNUMB
>b2cd b0 08 .WORD DUP
>b2cf 04 09 .WORD CAT
>b2d1 f1 09 .WORD BL
>b2d3 6d 0b .WORD SUB
>b2d5 be 04 .WORD ZBRAN
>b2d7 15 00 L2031 .WORD $15 ; L2042-L2031
>b2d9 b0 08 .WORD DUP
>b2db 04 09 .WORD CAT
>b2dd 64 04 .WORD CLIT
>b2df 2e .BYTE $2E
>b2e0 6d 0b .WORD SUB
>b2e2 d0 09 .WORD ZERO
>b2e4 84 0c .WORD QERR
>b2e6 d0 09 .WORD ZERO
>b2e8 9f 04 .WORD BRAN
>b2ea dd ff L2041 .WORD $FFDD ; L2023-L2041
>b2ec 8f 08 L2042 .WORD DROP
>b2ee c2 07 .WORD RFROM
>b2f0 be 04 .WORD ZBRAN
>b2f2 04 00 L2045 .WORD 4 ; L2047-L2045
>b2f4 67 08 .WORD DMINU
>b2f6 82 07 L2047 .WORD SEMIS
>b2f8 85 2d 46 49 4e c4 L2052 .BYTE $85,"-FIN",$C4
>b2fe a1 10 .WORD L2007 ; link to NUMBER
>b300 4c 09 DFIND .WORD DOCOL
>b302 f1 09 .WORD BL
>b304 e3 0f .WORD WORD
>b306 30 0b .WORD HERE ; )
>b308 f5 0d .WORD COUNT ; |- Optional allowing free use of low
>b30a 30 10 .WORD UPPER ; ) case from terminal
>b30c 30 0b .WORD HERE
>b30e be 0a .WORD CON
>b310 ef 08 .WORD AT
>b312 ef 08 .WORD AT
>b314 9a 05 .WORD PFIND
>b316 b0 08 .WORD DUP
>b318 e9 07 .WORD ZEQU
>b31a be 04 .WORD ZBRAN
>b31c 0a 00 L2068 .WORD $A ; L2073-L2068
>b31e 8f 08 .WORD DROP
>b320 30 0b .WORD HERE
>b322 1b 0c .WORD LATES
>b324 9a 05 .WORD PFIND
>b326 82 07 L2073 .WORD SEMIS
>b328 87 28 41 42 4f 52 54 a9 L2078 .BYTE $87,"(ABORT",$A9
>b330 f8 10 .WORD L2052 ; link to -FIND
>b332 4c 09 PABOR .WORD DOCOL
>b334 90 13 .WORD ABORT
>b336 82 07 .WORD SEMIS
>b338 85 45 52 52 4f d2 L2087 .BYTE $85,"ERRO",$D2
>b33e 28 11 .WORD L2078 ; link to (ABORT)
>b340 4c 09 ERROR .WORD DOCOL
>b342 61 0a .WORD WARN
>b344 ef 08 .WORD AT
>b346 fe 07 .WORD ZLESS
>b348 be 04 .WORD ZBRAN
>b34a 04 00 L2094 .WORD $4 ; L2096-L2094
>b34c 32 11 .WORD PABOR
>b34e 30 0b L2096 .WORD HERE
>b350 f5 0d .WORD COUNT
>b352 08 0e .WORD TYPE
>b354 69 0e .WORD PDOTQ
>b356 04 20 20 3f 20 .BYTE 4," ? "
>b35b df 16 .WORD MESS
>b35d 5e 07 .WORD SPSTO
>b35f 8f 08 8f 08 .WORD DROP,DROP; make room for 2 error values
>b363 93 0a .WORD IN
>b365 ef 08 .WORD AT
>b367 8b 0a .WORD BLK
>b369 ef 08 .WORD AT
>b36b 61 13 .WORD QUIT
>b36d 82 07 .WORD SEMIS
>b36f 83 49 44 ae L2113 .BYTE $83,"ID",$AE
>b373 38 11 .WORD L2087 ; link to ERROR
>b375 4c 09 IDDOT .WORD DOCOL
>b377 d1 0f .WORD PAD
>b379 64 04 .WORD CLIT
>b37b 20 .BYTE $20
>b37c 64 04 .WORD CLIT
>b37e 5f .BYTE $5F
>b37f 79 0f .WORD FILL
>b381 b0 08 .WORD DUP
>b383 5d 0c .WORD PFA
>b385 2b 0c .WORD LFA
>b387 7e 08 .WORD OVER
>b389 6d 0b .WORD SUB
>b38b d1 0f .WORD PAD
>b38d 98 08 .WORD SWAP
>b38f 66 06 .WORD CMOVE
>b391 d1 0f .WORD PAD
>b393 f5 0d .WORD COUNT
>b395 64 04 .WORD CLIT
>b397 1f .BYTE $1F
>b398 0e 07 .WORD ANDD
>b39a 08 0e .WORD TYPE
>b39c d1 0b .WORD SPACE
>b39e 82 07 .WORD SEMIS
>b3a0 86 43 52 45 41 54 c5 L2142 .BYTE $86,"CREAT",$C5
>b3a7 6f 11 .WORD L2113 ; link to ID
>b3a9 4c 09 CREAT .WORD DOCOL
>b3ab 49 0a .WORD TIB ;)
>b3ad 30 0b .WORD HERE ;|
>b3af 64 04 .WORD CLIT ;| 6502 only, assures
>b3b1 a0 .BYTE $A0 ;| room exists in dict.
>b3b2 0f 08 .WORD PLUS ;|
>b3b4 86 0b .WORD ULESS ;|
>b3b6 e0 09 .WORD TWO ;|
>b3b8 84 0c .WORD QERR ;)
>b3ba 00 11 .WORD DFIND
>b3bc be 04 .WORD ZBRAN
>b3be 0f 00 L2155 .WORD $0F
>b3c0 8f 08 .WORD DROP
>b3c2 48 0c .WORD NFA
>b3c4 75 11 .WORD IDDOT
>b3c6 64 04 .WORD CLIT
>b3c8 04 .BYTE 4
>b3c9 df 16 .WORD MESS
>b3cb d1 0b .WORD SPACE
>b3cd 30 0b L2163 .WORD HERE
>b3cf b0 08 .WORD DUP
>b3d1 04 09 .WORD CAT
>b3d3 54 0a .WORD WIDTH
>b3d5 ef 08 .WORD AT
>b3d7 45 14 .WORD MIN
>b3d9 14 0b .WORD ONEP
>b3db 40 0b .WORD ALLOT
>b3dd 74 0a .WORD DP ;)
>b3df 04 09 .WORD CAT ;| 6502 only. The code field
>b3e1 64 04 .WORD CLIT ;| must not straddle page
>b3e3 fd .BYTE $FD ;| boundaries
>b3e4 79 0b .WORD EQUAL ;|
>b3e6 40 0b .WORD ALLOT ;)
>b3e8 b0 08 .WORD DUP
>b3ea 64 04 .WORD CLIT
>b3ec a0 .BYTE $A0
>b3ed e0 08 .WORD TOGGL
>b3ef 30 0b .WORD HERE
>b3f1 d8 09 .WORD ONE
>b3f3 6d 0b .WORD SUB
>b3f5 64 04 .WORD CLIT
>b3f7 80 .BYTE $80
>b3f8 e0 08 .WORD TOGGL
>b3fa 1b 0c .WORD LATES
>b3fc 4c 0b .WORD COMMA
>b3fe cb 0a .WORD CURR
>b400 ef 08 .WORD AT
>b402 13 09 .WORD STORE
>b404 30 0b .WORD HERE
>b406 21 0b .WORD TWOP
>b408 4c 0b .WORD COMMA
>b40a 82 07 .WORD SEMIS
>b40c c9 5b 43 4f 4d 50 49 4c 45 dd L2200 .BYTE $C9,"[COMPILE",$DD
>b416 a0 11 .WORD L2142 ; link to CREATE
>b418 4c 09 .WORD DOCOL
>b41a 00 11 .WORD DFIND
>b41c e9 07 .WORD ZEQU
>b41e d0 09 .WORD ZERO
>b420 84 0c .WORD QERR
>b422 8f 08 .WORD DROP
>b424 3a 0c .WORD CFA
>b426 4c 0b .WORD COMMA
>b428 82 07 .WORD SEMIS
>b42a c7 4c 49 54 45 52 41 cc L2216 .BYTE $C7,"LITERA",$CC
>b432 0c 12 .WORD L2200 ; link to [COMPILE]
>b434 4c 09 LITER .WORD DOCOL
>b436 d6 0a .WORD STATE
>b438 ef 08 .WORD AT
>b43a be 04 .WORD ZBRAN
>b43c 08 00 L2222 .WORD 8 ; L2226-L2222
>b43e 12 0d .WORD COMP
>b440 2a 04 .WORD LIT
>b442 4c 0b .WORD COMMA
>b444 82 07 L2226 .WORD SEMIS
>b446 c8 44 4c 49 54 45 52 41 cc L2232 .BYTE $C8,"DLITERA",$CC
>b44f 2a 12 .WORD L2216 ; link to LITERAL
>b451 4c 09 DLIT .WORD DOCOL
>b453 d6 0a .WORD STATE
>b455 ef 08 .WORD AT
>b457 be 04 .WORD ZBRAN
>b459 08 00 L2238 .WORD 8 ; L2242-L2238
>b45b 98 08 .WORD SWAP
>b45d 34 12 .WORD LITER
>b45f 34 12 .WORD LITER
>b461 82 07 L2242 .WORD SEMIS
>b463 86 3f 53 54 41 43 cb L2248 .BYTE $86,"?STAC",$CB
>b46a 46 12 .WORD L2232 ; link to DLITERAL
>b46c 4c 09 QSTAC .WORD DOCOL
>b46e 64 04 .WORD CLIT
>b470 9f .BYTE TOS
>b471 4f 07 .WORD SPAT
>b473 86 0b .WORD ULESS
>b475 d8 09 .WORD ONE
>b477 84 0c .WORD QERR
>b479 4f 07 .WORD SPAT
>b47b 64 04 .WORD CLIT
>b47d 20 .BYTE BOS
>b47e 86 0b .WORD ULESS
>b480 64 04 .WORD CLIT
>b482 07 .BYTE 7
>b483 84 0c .WORD QERR
>b485 82 07 .WORD SEMIS
>b487 89 49 4e 54 45 52 50 52 45 d4 L2269 .BYTE $89,"INTERPRE",$D4
>b491 63 12 .WORD L2248 ; link to ?STACK
>b493 4c 09 INTER .WORD DOCOL
>b495 00 11 L2272 .WORD DFIND
>b497 be 04 .WORD ZBRAN
>b499 1e 00 L2274 .WORD $1E ; L2289-L2274
>b49b d6 0a .WORD STATE
>b49d ef 08 .WORD AT
>b49f 92 0b .WORD LESS
>b4a1 be 04 .WORD ZBRAN
>b4a3 0a 00 L2279 .WORD $A ; L2284-L2279
>b4a5 3a 0c .WORD CFA
>b4a7 4c 0b .WORD COMMA
>b4a9 9f 04 .WORD BRAN
>b4ab 06 00 L2283 .WORD $6 ; L2286-L2283
>b4ad 3a 0c L2284 .WORD CFA
>b4af 87 04 .WORD EXEC
>b4b1 6c 12 L2286 .WORD QSTAC
>b4b3 9f 04 .WORD BRAN
>b4b5 1c 00 L2288 .WORD $1C ; L2302-L2288
>b4b7 30 0b L2289 .WORD HERE
>b4b9 aa 10 .WORD NUMBER
>b4bb e9 0a .WORD DPL
>b4bd ef 08 .WORD AT
>b4bf 14 0b .WORD ONEP
>b4c1 be 04 .WORD ZBRAN
>b4c3 08 00 L2295 .WORD 8 ; L2299-L2295
>b4c5 51 12 .WORD DLIT
>b4c7 9f 04 .WORD BRAN
>b4c9 06 00 L2298 .WORD $6 ; L2301-L2298
>b4cb 8f 08 L2299 .WORD DROP
>b4cd 34 12 .WORD LITER
>b4cf 6c 12 L2301 .WORD QSTAC
>b4d1 9f 04 L2302 .WORD BRAN
>b4d3 c2 ff L2303 .WORD $FFC2 ; L2272-L2303
>b4d5 89 49 4d 4d 45 44 49 41 54 c5 L2309 .BYTE $89,"IMMEDIAT",$C5
>b4df 87 12 .WORD L2269; ; link to INTERPRET
>b4e1 4c 09 .WORD DOCOL
>b4e3 1b 0c .WORD LATES
>b4e5 64 04 .WORD CLIT
>b4e7 40 .BYTE $40
>b4e8 e0 08 .WORD TOGGL
>b4ea 82 07 .WORD SEMIS
>b4ec 8a 56 4f 43 41 42 55 4c 41 52 d9 L2321 .BYTE $8A,"VOCABULAR",$D9
>b4f7 d5 12 .WORD L2309 ; link to IMMEDIATE
>b4f9 4c 09 .WORD DOCOL
>b4fb b3 0d .WORD BUILD
>b4fd 2a 04 81 a0 .WORD LIT,$A081
>b501 4c 0b .WORD COMMA
>b503 cb 0a .WORD CURR
>b505 ef 08 .WORD AT
>b507 3a 0c .WORD CFA
>b509 4c 0b .WORD COMMA
>b50b 30 0b .WORD HERE
>b50d 82 0a .WORD VOCL
>b50f ef 08 .WORD AT
>b511 4c 0b .WORD COMMA
>b513 82 0a .WORD VOCL
>b515 13 09 .WORD STORE
>b517 c3 0d .WORD DOES
>b519 21 0b DOVOC .WORD TWOP
>b51b be 0a .WORD CON
>b51d 13 09 .WORD STORE
>b51f 82 07 .WORD SEMIS
>b521 c5 46 4f 52 54 c8 L2346 .BYTE $C5,"FORT",$C8
>b527 ec 12 .WORD L2321 ; link to VOCABULARY
>b529 cf 0d FORTH .WORD DODOE
>b52b 19 13 .WORD DOVOC
>b52d 81 a0 .WORD $A081
>b52f 5a 1b XFOR .WORD NTOP ; points to top name in FORTH
>b531 00 00 VL0 .WORD 0 ; last vocab link ends at zero
>b533 8b 44 45 46 49 4e 49 54 49 4f 4e d3 L2357 .BYTE $8B,"DEFINITION",$D3
>b53f 21 13 .WORD L2346 ; link to FORTH
>b541 4c 09 DEFIN .WORD DOCOL
>b543 be 0a .WORD CON
>b545 ef 08 .WORD AT
>b547 cb 0a .WORD CURR
>b549 13 09 .WORD STORE
>b54b 82 07 .WORD SEMIS
>b54d c1 a8 L2369 .BYTE $C1,$A8
>b54f 33 13 .WORD L2357 ; link to DEFINITIONS
>b551 4c 09 .WORD DOCOL
>b553 64 04 .WORD CLIT
>b555 29 .BYTE $29
>b556 e3 0f .WORD WORD
>b558 82 07 .WORD SEMIS
>b55a 84 51 55 49 d4 L2381 .BYTE $84,"QUI",$D4
>b55f 4d 13 .WORD L2369 ; link to (
>b561 4c 09 QUIT .WORD DOCOL
>b563 d0 09 .WORD ZERO
>b565 8b 0a .WORD BLK
>b567 13 09 .WORD STORE
>b569 28 0d .WORD LBRAC
>b56b 6e 07 L2388 .WORD RPSTO
>b56d 5c 06 .WORD CR
>b56f 23 0f .WORD QUERY
>b571 93 12 .WORD INTER
>b573 d6 0a .WORD STATE
>b575 ef 08 .WORD AT
>b577 e9 07 .WORD ZEQU
>b579 be 04 .WORD ZBRAN
>b57b 07 00 L2396 .WORD 7 ; L2399-L2396
>b57d 69 0e .WORD PDOTQ
>b57f 02 4f 4b .BYTE 2,"OK"
>b582 9f 04 L2399 .WORD BRAN
>b584 e7 ff L2400 .WORD $FFE7 ; L2388-L2400
>b586 82 07 .WORD SEMIS
>b588 85 41 42 4f 52 d4 L2406 .BYTE $85,"ABOR",$D4
>b58e 5a 13 .WORD L2381 ; link to QUIT
>b590 4c 09 ABORT .WORD DOCOL
>b592 5e 07 .WORD SPSTO
>b594 70 0d .WORD DECIM
>b596 db 15 .WORD DR0
>b598 5c 06 .WORD CR
>b59a 69 0e .WORD PDOTQ
>b59c 0e 66 69 67 2d 46 4f 52 54 48 20 20 31 2e 30 .BYTE 14,"fig-FORTH 1.0"
>b5ab 29 13 .WORD FORTH
>b5ad 41 13 .WORD DEFIN
>b5af 61 13 .WORD QUIT
>b5b1 84 43 4f 4c c4 L2423 .BYTE $84,"COL",$C4
>b5b6 88 13 .WORD L2406 ; link to ABORT
>b5b8 ba 13 COLD .WORD *+2
.b5ba ad 0c 04 lda $040c LDA ORIG+$0C ; from cold start area
.b5bd 8d 2f 13 sta $132f STA FORTH+6
.b5c0 ad 0d 04 lda $040d LDA ORIG+$0D
.b5c3 8d 30 13 sta $1330 STA FORTH+7
.b5c6 a0 15 ldy #$15 LDY #$15
.b5c8 d0 02 bne $b5cc BNE L2433
.b5ca a0 0f ldy #$0f WARM LDY #$0F
.b5cc ad 10 04 lda $0410 L2433 LDA ORIG+$10
.b5cf 85 b4 sta $b4 STA UP
.b5d1 ad 11 04 lda $0411 LDA ORIG+$11
.b5d4 85 b5 sta $b5 STA UP+1
.b5d6 b9 0c 04 lda $040c,y L2437 LDA ORIG+$0C,Y
.b5d9 91 b4 sta ($b4),y STA (UP),Y
.b5db 88 dey DEY
.b5dc 10 f8 bpl $b5d6 BPL L2437
.b5de a9 13 lda #$13 LDA #>ABORT ; actually #>(ABORT+2)
.b5e0 85 b0 sta $b0 STA IP+1
.b5e2 a9 92 lda #$92 LDA #<ABORT+2
.b5e4 85 af sta $af STA IP
.b5e6 d8 cld CLD
.b5e7 a9 6c lda #$6c LDA #$6C ; ind jump opcode
.b5e9 85 b1 sta $b1 STA W-1
.b5eb 4c 70 07 jmp $0770 JMP RPSTO+2 ; And off we go !
>b5ee 84 53 2d 3e c4 L2453 .BYTE $84,"S->",$C4
>b5f3 b1 13 .WORD L2423 ; link to COLD
>b5f5 4c 09 STOD .WORD DOCOL
>b5f7 b0 08 .WORD DUP
>b5f9 fe 07 .WORD ZLESS
>b5fb 4e 08 .WORD MINUS
>b5fd 82 07 .WORD SEMIS
>b5ff 82 2b ad L2464 .BYTE $82,"+",$AD
>b602 ee 13 .WORD L2453 ; link to S->D
>b604 4c 09 PM .WORD DOCOL
>b606 fe 07 .WORD ZLESS
>b608 be 04 .WORD ZBRAN
>b60a 04 00 L2469 .WORD 4
>b60c 4e 08 .WORD MINUS
>b60e 82 07 L2471 .WORD SEMIS
>b610 83 44 2b ad L2476 .BYTE $83,"D+",$AD
>b614 ff 13 .WORD L2464 ; link to +-
>b616 4c 09 DPM .WORD DOCOL
>b618 fe 07 .WORD ZLESS
>b61a be 04 .WORD ZBRAN
>b61c 04 00 L2481 .WORD 4 ; L2483-L2481
>b61e 67 08 .WORD DMINU
>b620 82 07 L2483 .WORD SEMIS
>b622 83 41 42 d3 L2488 .BYTE $83,"AB",$D3
>b626 10 14 .WORD L2476 ; link to D+-
>b628 4c 09 ABS .WORD DOCOL
>b62a b0 08 .WORD DUP
>b62c 04 14 .WORD PM
>b62e 82 07 .WORD SEMIS
>b630 84 44 41 42 d3 L2498 .BYTE $84,"DAB",$D3
>b635 22 14 .WORD L2488 ; link to ABS
>b637 4c 09 DABS .WORD DOCOL
>b639 b0 08 .WORD DUP
>b63b 16 14 .WORD DPM
>b63d 82 07 .WORD SEMIS
>b63f 83 4d 49 ce L2508 .BYTE $83,"MI",$CE
>b643 30 14 .WORD L2498 ; link to DABS
>b645 4c 09 MIN .WORD DOCOL
>b647 7e 08 .WORD OVER
>b649 7e 08 .WORD OVER
>b64b af 0b .WORD GREAT
>b64d be 04 .WORD ZBRAN
>b64f 04 00 L2515 .WORD 4 ; L2517-L2515
>b651 98 08 .WORD SWAP
>b653 8f 08 L2517 .WORD DROP
>b655 82 07 .WORD SEMIS
>b657 83 4d 41 d8 L2523 .BYTE $83,"MA",$D8
>b65b 3f 14 .WORD L2508 ; link to MIN
>b65d 4c 09 MAX .WORD DOCOL
>b65f 7e 08 .WORD OVER
>b661 7e 08 .WORD OVER
>b663 92 0b .WORD LESS
>b665 be 04 .WORD ZBRAN
>b667 04 00 L2530 .WORD 4 ; L2532-L2530
>b669 98 08 .WORD SWAP
>b66b 8f 08 L2532 .WORD DROP
>b66d 82 07 .WORD SEMIS
>b66f 82 4d aa L2538 .BYTE $82,"M",$AA
>b672 57 14 .WORD L2523 ; link to MAX
>b674 4c 09 MSTAR .WORD DOCOL
>b676 7e 08 .WORD OVER
>b678 7e 08 .WORD OVER
>b67a 39 07 .WORD XOR
>b67c b0 07 .WORD TOR
>b67e 28 14 .WORD ABS
>b680 98 08 .WORD SWAP
>b682 28 14 .WORD ABS
>b684 8b 06 .WORD USTAR
>b686 c2 07 .WORD RFROM
>b688 16 14 .WORD DPM
>b68a 82 07 .WORD SEMIS
>b68c 82 4d af L2556 .BYTE $82,"M",$AF
>b68f 6f 14 .WORD L2538 ; link to M*
>b691 4c 09 MSLAS .WORD DOCOL
>b693 7e 08 .WORD OVER
>b695 b0 07 .WORD TOR
>b697 b0 07 .WORD TOR
>b699 37 14 .WORD DABS
>b69b d3 07 .WORD R
>b69d 28 14 .WORD ABS
>b69f be 06 .WORD USLAS
>b6a1 c2 07 .WORD RFROM
>b6a3 d3 07 .WORD R
>b6a5 39 07 .WORD XOR
>b6a7 04 14 .WORD PM
>b6a9 98 08 .WORD SWAP
>b6ab c2 07 .WORD RFROM
>b6ad 04 14 .WORD PM
>b6af 98 08 .WORD SWAP
>b6b1 82 07 .WORD SEMIS
>b6b3 81 aa L2579 .BYTE $81,$AA
>b6b5 8c 14 .WORD L2556 ; link to M/
>b6b7 4c 09 STAR .WORD DOCOL
>b6b9 8b 06 .WORD USTAR
>b6bb 8f 08 .WORD DROP
>b6bd 82 07 .WORD SEMIS
>b6bf 84 2f 4d 4f c4 L2589 .BYTE $84,"/MO",$C4
>b6c4 b3 14 .WORD L2579 ; link to *
>b6c6 4c 09 SLMOD .WORD DOCOL
>b6c8 b0 07 .WORD TOR
>b6ca f5 13 .WORD STOD
>b6cc c2 07 .WORD RFROM
>b6ce 91 14 .WORD MSLAS
>b6d0 82 07 .WORD SEMIS
>b6d2 81 af L2601 .BYTE $81,$AF
>b6d4 bf 14 .WORD L2589 ; link to /MOD
>b6d6 4c 09 SLASH .WORD DOCOL
>b6d8 c6 14 .WORD SLMOD
>b6da 98 08 .WORD SWAP
>b6dc 8f 08 .WORD DROP
>b6de 82 07 .WORD SEMIS
>b6e0 83 4d 4f c4 L2612 .BYTE $83,"MO",$C4
>b6e4 d2 14 .WORD L2601 ; link to /
>b6e6 4c 09 MOD .WORD DOCOL
>b6e8 c6 14 .WORD SLMOD
>b6ea 8f 08 .WORD DROP
>b6ec 82 07 .WORD SEMIS
>b6ee 85 2a 2f 4d 4f c4 L2622 .BYTE $85,"*/MO",$C4
>b6f4 e0 14 .WORD L2612 ; link to MOD
>b6f6 4c 09 SSMOD .WORD DOCOL
>b6f8 b0 07 .WORD TOR
>b6fa 74 14 .WORD MSTAR
>b6fc c2 07 .WORD RFROM
>b6fe 91 14 .WORD MSLAS
>b700 82 07 .WORD SEMIS
>b702 82 2a af L2634 .BYTE $82,"*",$AF
>b705 ee 14 .WORD L2622 ; link to */MOD
>b707 4c 09 SSLAS .WORD DOCOL
>b709 f6 14 .WORD SSMOD
>b70b 98 08 .WORD SWAP
>b70d 8f 08 .WORD DROP
>b70f 82 07 .WORD SEMIS
>b711 85 4d 2f 4d 4f c4 L2645 .BYTE $85,"M/MO",$C4
>b717 02 15 .WORD L2634 ; link to */
>b719 4c 09 MSMOD .WORD DOCOL
>b71b b0 07 .WORD TOR
>b71d d0 09 .WORD ZERO
>b71f d3 07 .WORD R
>b721 be 06 .WORD USLAS
>b723 c2 07 .WORD RFROM
>b725 98 08 .WORD SWAP
>b727 b0 07 .WORD TOR
>b729 be 06 .WORD USLAS
>b72b c2 07 .WORD RFROM
>b72d 82 07 .WORD SEMIS
>b72f 83 55 53 c5 L2662 .BYTE $83,"US",$C5
>b733 11 15 .WORD L2645 ; link to M/MOD
>b735 a4 09 USE .WORD DOVAR
>b737 60 3a .WORD DAREA
>b739 84 50 52 45 d6 L2670 .BYTE $84,"PRE",$D6
>b73e 2f 15 .WORD L2662 ; link to USE
>b740 a4 09 PREV .WORD DOVAR
>b742 60 3a .WORD DAREA
>b744 84 2b 42 55 c6 L2678 .BYTE $84,"+BU",$C6
>b749 39 15 .WORD L2670 ; link to PREV
>b74b 4c 09 PBUF .WORD DOCOL
>b74d 2a 04 .WORD LIT
>b74f 84 00 .WORD SSIZE+4 ; hold block #, one sector two num
>b751 0f 08 .WORD PLUS
>b753 b0 08 .WORD DUP
>b755 13 0a .WORD LIMIT
>b757 79 0b .WORD EQUAL
>b759 be 04 .WORD ZBRAN
>b75b 06 00 L2688 .WORD 6 ; L2691-L2688
>b75d 8f 08 .WORD DROP
>b75f 07 0a .WORD FIRST
>b761 b0 08 L2691 .WORD DUP
>b763 40 15 .WORD PREV
>b765 ef 08 .WORD AT
>b767 6d 0b .WORD SUB
>b769 82 07 .WORD SEMIS
>b76b 86 55 50 44 41 54 c5 L2700 .BYTE $86,"UPDAT",$C5
>b772 44 15 .WORD L2678 ; link to +BUF
>b774 4c 09 UPDAT .WORD DOCOL
>b776 40 15 .WORD PREV
>b778 ef 08 .WORD AT
>b77a ef 08 .WORD AT
>b77c 2a 04 00 80 .WORD LIT,$8000
>b780 23 07 .WORD OR
>b782 40 15 .WORD PREV
>b784 ef 08 .WORD AT
>b786 13 09 .WORD STORE
>b788 82 07 .WORD SEMIS
>b78a 85 46 4c 55 53 c8 L2705 .BYTE $85,"FLUS",$C8
>b790 6b 15 .WORD L2700 ; link to UPDATE
>b792 4c 09 .WORD DOCOL
>b794 13 0a 07 0a 6d 0b .WORD LIMIT,FIRST,SUB
>b79a 1f 0a 64 04 .WORD BBUF,CLIT
>b79e 04 .BYTE 4
>b79f 0f 08 d6 14 14 0b .WORD PLUS,SLASH,ONEP
>b7a5 d0 09 46 05 .WORD ZERO,PDO
>b7a9 2a 04 ff 7f 00 16 L2835 .WORD LIT,$7FFF,BUFFR
>b7af 8f 08 df 04 .WORD DROP,PLOOP
>b7b3 f6 ff L2839 .WORD $FFF6 ; L2835-L2839
>b7b5 82 07 .WORD SEMIS
>b7b7 8d 45 4d 50 54 59 2d 42 55 46 46 45 52 d3 L2716 .BYTE $8D,"EMPTY-BUFFER",$D3
>b7c5 8a 15 .WORD L2705 ; link to FLUSH
>b7c7 4c 09 .WORD DOCOL
>b7c9 07 0a .WORD FIRST
>b7cb 13 0a .WORD LIMIT
>b7cd 7e 08 .WORD OVER
>b7cf 6d 0b .WORD SUB
>b7d1 99 0f .WORD ERASE
>b7d3 82 07 .WORD SEMIS
>b7d5 83 44 52 b0 L2729 .BYTE $83,"DR",$B0
>b7d9 b7 15 .WORD L2716 ; link to EMPTY-BUFFERS
>b7db 4c 09 DR0 .WORD DOCOL
>b7dd d0 09 .WORD ZERO
>b7df b1 0a .WORD OFSET
>b7e1 13 09 .WORD STORE
>b7e3 82 07 .WORD SEMIS
>b7e5 83 44 52 b1 L2740 .BYTE $83,"DR",$B1
>b7e9 d5 15 .WORD L2729 ; link to DR0
>b7eb 4c 09 .WORD DOCOL
>b7ed 2a 04 20 03 .WORD LIT,SECTR ; sectors per drive
>b7f1 b1 0a .WORD OFSET
>b7f3 13 09 .WORD STORE
>b7f5 82 07 .WORD SEMIS
>b7f7 86 42 55 46 46 45 d2 L2751 .BYTE $86,"BUFFE",$D2
>b7fe e5 15 .WORD L2740 ; link to DR1
>b800 4c 09 BUFFR .WORD DOCOL
>b802 35 15 .WORD USE
>b804 ef 08 .WORD AT
>b806 b0 08 .WORD DUP
>b808 b0 07 .WORD TOR
>b80a 4b 15 L2758 .WORD PBUF
>b80c be 04 .WORD ZBRAN
>b80e fc ff L2760 .WORD $FFFC ; L2758-L2760
>b810 35 15 .WORD USE
>b812 13 09 .WORD STORE
>b814 d3 07 .WORD R
>b816 ef 08 .WORD AT
>b818 fe 07 .WORD ZLESS
>b81a be 04 .WORD ZBRAN
>b81c 14 00 L2767 .WORD $14 ; L2776-L2767
>b81e d3 07 .WORD R
>b820 21 0b .WORD TWOP
>b822 d3 07 .WORD R
>b824 ef 08 .WORD AT
>b826 2a 04 ff 7f .WORD LIT,$7FFF
>b82a 0e 07 .WORD ANDD
>b82c d0 09 .WORD ZERO
>b82e a0 17 .WORD RSW
>b830 d3 07 L2776 .WORD R
>b832 13 09 .WORD STORE
>b834 d3 07 .WORD R
>b836 40 15 .WORD PREV
>b838 13 09 .WORD STORE
>b83a c2 07 .WORD RFROM
>b83c 21 0b .WORD TWOP
>b83e 82 07 .WORD SEMIS
>b840 85 42 4c 4f 43 cb L2788 .BYTE $85,"BLOC",$CB
>b846 f7 15 .WORD L2751 ; link to BUFFER
>b848 4c 09 BLOCK .WORD DOCOL
>b84a b1 0a .WORD OFSET
>b84c ef 08 .WORD AT
>b84e 0f 08 .WORD PLUS
>b850 b0 07 .WORD TOR
>b852 40 15 .WORD PREV
>b854 ef 08 .WORD AT
>b856 b0 08 .WORD DUP
>b858 ef 08 .WORD AT
>b85a d3 07 .WORD R
>b85c 6d 0b .WORD SUB
>b85e b0 08 .WORD DUP
>b860 0f 08 .WORD PLUS
>b862 be 04 .WORD ZBRAN
>b864 34 00 L2804 .WORD $34 ; L2830-L2804
>b866 4b 15 L2805 .WORD PBUF
>b868 e9 07 .WORD ZEQU
>b86a be 04 .WORD ZBRAN
>b86c 14 00 L2808 .WORD $14 ; L2818-L2808
>b86e 8f 08 .WORD DROP
>b870 d3 07 .WORD R
>b872 00 16 .WORD BUFFR
>b874 b0 08 .WORD DUP
>b876 d3 07 .WORD R
>b878 d8 09 .WORD ONE
>b87a a0 17 .WORD RSW
>b87c e0 09 .WORD TWO
>b87e 6d 0b .WORD SUB
>b880 b0 08 L2818 .WORD DUP
>b882 ef 08 .WORD AT
>b884 d3 07 .WORD R
>b886 6d 0b .WORD SUB
>b888 b0 08 .WORD DUP
>b88a 0f 08 .WORD PLUS
>b88c e9 07 .WORD ZEQU
>b88e be 04 .WORD ZBRAN
>b890 d6 ff L2826 .WORD $FFD6 ; L2805-L2826
>b892 b0 08 .WORD DUP
>b894 40 15 .WORD PREV
>b896 13 09 .WORD STORE
>b898 c2 07 L2830 .WORD RFROM
>b89a 8f 08 .WORD DROP
>b89c 21 0b .WORD TWOP
>b89e 82 07 .WORD SEMIS ; end of BLOCK
>b8a0 86 28 4c 49 4e 45 a9 L2838 .BYTE $86,"(LINE",$A9
>b8a7 40 16 .WORD L2788 ; link to BLOCK
>b8a9 4c 09 PLINE .WORD DOCOL
>b8ab b0 07 .WORD TOR
>b8ad fb 09 .WORD CSLL
>b8af 1f 0a .WORD BBUF
>b8b1 f6 14 .WORD SSMOD
>b8b3 c2 07 .WORD RFROM
>b8b5 2b 0a .WORD BSCR
>b8b7 b7 14 .WORD STAR
>b8b9 0f 08 .WORD PLUS
>b8bb 48 16 .WORD BLOCK
>b8bd 0f 08 .WORD PLUS
>b8bf fb 09 .WORD CSLL
>b8c1 82 07 .WORD SEMIS
>b8c3 85 2e 4c 49 4e c5 L2857 .BYTE $85,".LIN",$C5
>b8c9 a0 16 .WORD L2838 ; link to (LINE)
>b8cb 4c 09 DLINE .WORD DOCOL
>b8cd a9 16 .WORD PLINE
>b8cf 36 0e .WORD DTRAI
>b8d1 08 0e .WORD TYPE
>b8d3 82 07 .WORD SEMIS
>b8d5 87 4d 45 53 53 41 47 c5 L2868 .BYTE $87,"MESSAG",$C5
>b8dd c3 16 .WORD L2857 ; link to .LINE
>b8df 4c 09 MESS .WORD DOCOL
>b8e1 61 0a .WORD WARN
>b8e3 ef 08 .WORD AT
>b8e5 be 04 .WORD ZBRAN
>b8e7 1b 00 L2874 .WORD $1B ; L2888-L2874
>b8e9 e0 0b .WORD DDUP
>b8eb be 04 .WORD ZBRAN
>b8ed 11 00 L2877 .WORD $11 ; L2886-L2877
>b8ef 64 04 .WORD CLIT
>b8f1 04 .BYTE 4
>b8f2 b1 0a .WORD OFSET
>b8f4 ef 08 .WORD AT
>b8f6 2b 0a .WORD BSCR
>b8f8 d6 14 .WORD SLASH
>b8fa 6d 0b .WORD SUB
>b8fc cb 16 .WORD DLINE
>b8fe 9f 04 L2886 .WORD BRAN
>b900 0d 00 L2887 .WORD 13 ; L2891-L2887
>b902 69 0e L2888 .WORD PDOTQ
>b904 06 4d 53 47 20 23 20 .BYTE 6,"MSG # "
>b90b 53 1a .WORD DOT
>b90d 82 07 L2891 .WORD SEMIS
>b90f 84 4c 4f 41 c4 L2896 .BYTE $84,"LOA",$C4
>b914 d5 16 .WORD L2868 ; link to MESSAGE
>b916 4c 09 LOAD .WORD DOCOL
>b918 8b 0a .WORD BLK
>b91a ef 08 .WORD AT
>b91c b0 07 .WORD TOR
>b91e 93 0a .WORD IN
>b920 ef 08 .WORD AT
>b922 b0 07 .WORD TOR
>b924 d0 09 .WORD ZERO
>b926 93 0a .WORD IN
>b928 13 09 .WORD STORE
>b92a 2b 0a .WORD BSCR
>b92c b7 14 .WORD STAR
>b92e 8b 0a .WORD BLK
>b930 13 09 .WORD STORE
>b932 93 12 .WORD INTER
>b934 c2 07 .WORD RFROM
>b936 93 0a .WORD IN
>b938 13 09 .WORD STORE
>b93a c2 07 .WORD RFROM
>b93c 8b 0a .WORD BLK
>b93e 13 09 .WORD STORE
>b940 82 07 .WORD SEMIS
>b942 c3 2d 2d be L2924 .BYTE $C3,"--",$BE
>b946 0f 17 .WORD L2896 ; link to LOAD
>b948 4c 09 .WORD DOCOL
>b94a f9 0c .WORD QLOAD
>b94c d0 09 .WORD ZERO
>b94e 93 0a .WORD IN
>b950 13 09 .WORD STORE
>b952 2b 0a .WORD BSCR
>b954 8b 0a .WORD BLK
>b956 ef 08 .WORD AT
>b958 7e 08 .WORD OVER
>b95a e6 14 .WORD MOD
>b95c 6d 0b .WORD SUB
>b95e 8b 0a .WORD BLK
>b960 bf 08 .WORD PSTOR
>b962 82 07 .WORD SEMIS
.b964 xemit
.b964 b5 00 lda $00,x LDA 0,X ; fetch character to output
.b966 20 f4 a4 jsr $a4f4 JSR OUTCH ; and display it
.b969 4c 56 05 jmp $0556 JMP POP
.b96c xkey
.b96c 20 dc a4 jsr $a4dc JSR INCH ; might otherwise clobber it while
.b96f 4c 52 07 jmp $0752 JMP PUSHOA
.b972 20 0a a5 jsr $a50a XQTER jsr cbrk ; if Ctrl-c, set C else clear C
.b975 a9 00 lda #$00 lda #$00 ; 0
.b977 2a rol rol ; move carry to bit 0
.b978 4c 52 07 jmp $0752 JMP PUSHOA
.b97b xcr
.b97b 20 01 a5 jsr $a501 JSR TCR ; use monitor call
.b97e 4c 44 04 jmp $0444 JMP NEXT
>b981 84 2d 42 43 c4 L3050 .BYTE $84,"-BC",$C4
>b986 42 17 .WORD L2924 ; link to -DISC
>b988 4c 09 DBCD .WORD DOCOL
>b98a d0 09 64 04 .WORD ZERO,CLIT
>b98e 0a .BYTE 10
>b98f be 06 64 04 .WORD USLAS,CLIT
>b993 10 .BYTE 16
>b994 b7 14 23 07 82 07 .WORD STAR,OR,SEMIS
>b99a 83 52 53 d7 L3070 .BYTE $83,"RS",$D7
>b99e 81 17 .WORD L3050 ; link to R/W
>b9a0 4c 09 RSW .WORD DOCOL
>b9a2 b0 07 .WORD TOR
>b9a4 1f 0a b7 14 2a 04 00 40 0f 08 b0 08 .WORD BBUF, STAR, LIT, $4000, PLUS, DUP
>b9b0 2a 04 00 68 af 0b 2a 04 06 00 84 0c .WORD LIT, $6800, GREAT, LIT, $6, QERR
>b9bc c2 07 be 04 04 00 98 08 .WORD RFROM, ZBRAN, $4, SWAP
>b9c4 1f 0a 66 06 .WORD BBUF, CMOVE
>b9c8 82 07 .WORD SEMIS
>b9ca c1 a7 L3202 .BYTE $C1,$A7
>b9cc 9a 17 .WORD L3070 ; link to RSW
>b9ce 4c 09 TICK .WORD DOCOL
>b9d0 00 11 .WORD DFIND
>b9d2 e9 07 .WORD ZEQU
>b9d4 d0 09 .WORD ZERO
>b9d6 84 0c .WORD QERR
>b9d8 8f 08 .WORD DROP
>b9da 34 12 .WORD LITER
>b9dc 82 07 .WORD SEMIS
>b9de 86 46 4f 52 47 45 d4 L3217 .BYTE $86,"FORGE",$D4
>b9e5 ca 17 .WORD L3202 ; link to ' TICK
>b9e7 4c 09 FORG .WORD DOCOL
>b9e9 ce 17 48 0c b0 08 .WORD TICK,NFA,DUP
>b9ef 6c 0a ef 08 86 0b 64 04 .WORD FENCE,AT,ULESS,CLIT
>b9f7 15 .BYTE $15
>b9f8 84 0c b0 07 82 0a ef 08 .WORD QERR,TOR,VOCL,AT
>ba00 d3 07 7e 08 86 0b L3220 .WORD R,OVER,ULESS
>ba06 be 04 12 00 .WORD ZBRAN,L3225-*
>ba0a 29 13 41 13 ef 08 b0 08 .WORD FORTH,DEFIN,AT,DUP
>ba12 82 0a 13 09 .WORD VOCL,STORE
>ba16 9f 04 e8 ff .WORD BRAN,$FFFF-24+1 ; L3220-*
>ba1a b0 08 64 04 L3225 .WORD DUP,CLIT
>ba1e 04 .BYTE 4
>ba1f 6d 0b .WORD SUB
>ba21 5d 0c 2b 0c ef 08 L3228 .WORD PFA,LFA,AT
>ba27 b0 08 d3 07 86 0b .WORD DUP,R,ULESS
>ba2d be 04 f2 ff .WORD ZBRAN,$FFFF-14+1 ; L3228-*
>ba31 7e 08 e0 09 6d 0b 13 09 .WORD OVER,TWO,SUB,STORE
>ba39 ef 08 e0 0b e9 07 .WORD AT,DDUP,ZEQU
>ba3f be 04 d9 ff .WORD ZBRAN,$FFFF-39+1 ; L3225-*
>ba43 c2 07 74 0a 13 09 .WORD RFROM,DP,STORE
>ba49 82 07 .WORD SEMIS
>ba4b 84 42 41 43 cb L3250 .BYTE $84,"BAC",$CB
>ba50 de 17 .WORD L3217 ; link to FORGET
>ba52 4c 09 BACK .WORD DOCOL
>ba54 30 0b .WORD HERE
>ba56 6d 0b .WORD SUB
>ba58 4c 0b .WORD COMMA
>ba5a 82 07 .WORD SEMIS
>ba5c c5 42 45 47 49 ce L3261 .BYTE $C5,"BEGI",$CE
>ba62 4b 18 .WORD L3250 ; link to BACK
>ba64 4c 09 .WORD DOCOL
>ba66 9e 0c .WORD QCOMP
>ba68 30 0b .WORD HERE
>ba6a d8 09 .WORD ONE
>ba6c 82 07 .WORD SEMIS
>ba6e c5 45 4e 44 49 c6 L3273 .BYTE $C5,"ENDI",$C6
>ba74 5c 18 .WORD L3261 ; link to BEGIN
>ba76 4c 09 ENDIF .WORD DOCOL
>ba78 9e 0c .WORD QCOMP
>ba7a e0 09 .WORD TWO
>ba7c cb 0c .WORD QPAIR
>ba7e 30 0b .WORD HERE
>ba80 7e 08 .WORD OVER
>ba82 6d 0b .WORD SUB
>ba84 98 08 .WORD SWAP
>ba86 13 09 .WORD STORE
>ba88 82 07 .WORD SEMIS
>ba8a c4 54 48 45 ce L3290 .BYTE $C4,"THE",$CE
>ba8f 6e 18 .WORD L3273 ; link to ENDIF
>ba91 4c 09 .WORD DOCOL
>ba93 76 18 .WORD ENDIF
>ba95 82 07 .WORD SEMIS
>ba97 c2 44 cf L3300 .BYTE $C2,"D",$CF
>ba9a 8a 18 .WORD L3290 ; link to THEN
>ba9c 4c 09 .WORD DOCOL
>ba9e 12 0d .WORD COMP
>baa0 46 05 .WORD PDO
>baa2 30 0b .WORD HERE
>baa4 e8 09 .WORD THREE
>baa6 82 07 .WORD SEMIS
>baa8 c4 4c 4f 4f d0 L3313 .BYTE $C4,"LOO",$D0
>baad 97 18 .WORD L3300 ; link to DO
>baaf 4c 09 .WORD DOCOL
>bab1 e8 09 .WORD THREE
>bab3 cb 0c .WORD QPAIR
>bab5 12 0d .WORD COMP
>bab7 df 04 .WORD PLOOP
>bab9 52 18 .WORD BACK
>babb 82 07 .WORD SEMIS
>babd c5 2b 4c 4f 4f d0 L3327 .BYTE $C5,"+LOO",$D0
>bac3 a8 18 .WORD L3313 ; link to LOOP
>bac5 4c 09 .WORD DOCOL
>bac7 e8 09 .WORD THREE
>bac9 cb 0c .WORD QPAIR
>bacb 12 0d .WORD COMP
>bacd 0f 05 .WORD PPLOO
>bacf 52 18 .WORD BACK
>bad1 82 07 .WORD SEMIS
>bad3 c5 55 4e 54 49 cc L3341 .BYTE $C5,"UNTI",$CC
>bad9 bd 18 .WORD L3327 ; link to +LOOP
>badb 4c 09 UNTIL .WORD DOCOL
>badd d8 09 .WORD ONE
>badf cb 0c .WORD QPAIR
>bae1 12 0d .WORD COMP
>bae3 be 04 .WORD ZBRAN
>bae5 52 18 .WORD BACK
>bae7 82 07 .WORD SEMIS
>bae9 c3 45 4e c4 L3355 .BYTE $C3,"EN",$C4
>baed d3 18 .WORD L3341 ; link to UNTIL
>baef 4c 09 .WORD DOCOL
>baf1 db 18 .WORD UNTIL
>baf3 82 07 .WORD SEMIS
>baf5 c5 41 47 41 49 ce L3365 .BYTE $C5,"AGAI",$CE
>bafb e9 18 .WORD L3355 ; link to END
>bafd 4c 09 AGAIN .WORD DOCOL
>baff d8 09 .WORD ONE
>bb01 cb 0c .WORD QPAIR
>bb03 12 0d .WORD COMP
>bb05 9f 04 .WORD BRAN
>bb07 52 18 .WORD BACK
>bb09 82 07 .WORD SEMIS
>bb0b c6 52 45 50 45 41 d4 L3379 .BYTE $C6,"REPEA",$D4
>bb12 f5 18 .WORD L3365 ; link to AGAIN
>bb14 4c 09 .WORD DOCOL
>bb16 b0 07 .WORD TOR
>bb18 b0 07 .WORD TOR
>bb1a fd 18 .WORD AGAIN
>bb1c c2 07 .WORD RFROM
>bb1e c2 07 .WORD RFROM
>bb20 e0 09 .WORD TWO
>bb22 6d 0b .WORD SUB
>bb24 76 18 .WORD ENDIF
>bb26 82 07 .WORD SEMIS
>bb28 c2 49 c6 L3396 .BYTE $C2,"I",$C6
>bb2b 0b 19 .WORD L3379 ; link to REPEAT
>bb2d 4c 09 IF .WORD DOCOL
>bb2f 12 0d .WORD COMP
>bb31 be 04 .WORD ZBRAN
>bb33 30 0b .WORD HERE
>bb35 d0 09 .WORD ZERO
>bb37 4c 0b .WORD COMMA
>bb39 e0 09 .WORD TWO
>bb3b 82 07 .WORD SEMIS
>bb3d c4 45 4c 53 c5 L3411 .BYTE $C4,"ELS",$C5
>bb42 28 19 .WORD L3396 ; link to IF
>bb44 4c 09 .WORD DOCOL
>bb46 e0 09 .WORD TWO
>bb48 cb 0c .WORD QPAIR
>bb4a 12 0d .WORD COMP
>bb4c 9f 04 .WORD BRAN
>bb4e 30 0b .WORD HERE
>bb50 d0 09 .WORD ZERO
>bb52 4c 0b .WORD COMMA
>bb54 98 08 .WORD SWAP
>bb56 e0 09 .WORD TWO
>bb58 76 18 .WORD ENDIF
>bb5a e0 09 .WORD TWO
>bb5c 82 07 .WORD SEMIS
>bb5e c5 57 48 49 4c c5 L3431 .BYTE $C5,"WHIL",$C5
>bb64 3d 19 .WORD L3411 ; link to ELSE
>bb66 4c 09 .WORD DOCOL
>bb68 2d 19 .WORD IF
>bb6a 21 0b .WORD TWOP
>bb6c 82 07 .WORD SEMIS
>bb6e 86 53 50 41 43 45 d3 L3442 .BYTE $86,"SPACE",$D3
>bb75 5e 19 .WORD L3431 ; link to WHILE
>bb77 4c 09 SPACS .WORD DOCOL
>bb79 d0 09 .WORD ZERO
>bb7b 5d 14 .WORD MAX
>bb7d e0 0b .WORD DDUP
>bb7f be 04 .WORD ZBRAN
>bb81 0c 00 L3449 .WORD $0C ; L3455-L3449
>bb83 d0 09 .WORD ZERO
>bb85 46 05 .WORD PDO
>bb87 d1 0b L3452 .WORD SPACE
>bb89 df 04 .WORD PLOOP
>bb8b fc ff L3454 .WORD $FFFC ; L3452-L3454
>bb8d 82 07 L3455 .WORD SEMIS
>bb8f 82 3c a3 L3460 .BYTE $82,"<",$A3
>bb92 6e 19 .WORD L3442 ; link to SPACES
>bb94 4c 09 BDIGS .WORD DOCOL
>bb96 d1 0f .WORD PAD
>bb98 0c 0b .WORD HLD
>bb9a 13 09 .WORD STORE
>bb9c 82 07 .WORD SEMIS
>bb9e 82 23 be L3471 .BYTE $82,"#",$BE
>bba1 8f 19 .WORD L3460 ; link to <#
>bba3 4c 09 EDIGS .WORD DOCOL
>bba5 8f 08 .WORD DROP
>bba7 8f 08 .WORD DROP
>bba9 0c 0b .WORD HLD
>bbab ef 08 .WORD AT
>bbad d1 0f .WORD PAD
>bbaf 7e 08 .WORD OVER
>bbb1 6d 0b .WORD SUB
>bbb3 82 07 .WORD SEMIS
>bbb5 84 53 49 47 ce L3486 .BYTE $84,"SIG",$CE
>bbba 9e 19 .WORD L3471 ; link to #>
>bbbc 4c 09 SIGN .WORD DOCOL
>bbbe bd 0b .WORD ROT
>bbc0 fe 07 .WORD ZLESS
>bbc2 be 04 .WORD ZBRAN
>bbc4 07 00 L3492 .WORD $7 ; L3496-L3492
>bbc6 64 04 .WORD CLIT
>bbc8 2d .BYTE $2D
>bbc9 b9 0f .WORD HOLD
>bbcb 82 07 L3496 .WORD SEMIS
>bbcd 81 a3 L3501 .BYTE $81,$A3
>bbcf b5 19 .WORD L3486 ; link to SIGN
>bbd1 4c 09 DIG .WORD DOCOL
>bbd3 e0 0a .WORD BASE
>bbd5 ef 08 .WORD AT
>bbd7 19 15 .WORD MSMOD
>bbd9 bd 0b .WORD ROT
>bbdb 64 04 .WORD CLIT
>bbdd 09 .BYTE 9
>bbde 7e 08 .WORD OVER
>bbe0 92 0b .WORD LESS
>bbe2 be 04 .WORD ZBRAN
>bbe4 07 00 L3513 .WORD 7 ; L3517-L3513
>bbe6 64 04 .WORD CLIT
>bbe8 07 .BYTE 7
>bbe9 0f 08 .WORD PLUS
>bbeb 64 04 L3517 .WORD CLIT
>bbed 30 .BYTE $30
>bbee 0f 08 .WORD PLUS
>bbf0 b9 0f .WORD HOLD
>bbf2 82 07 .WORD SEMIS
>bbf4 82 23 d3 L3526 .BYTE $82,"#",$D3
>bbf7 cd 19 .WORD L3501 ; link to #
>bbf9 4c 09 DIGS .WORD DOCOL
>bbfb d1 19 L3529 .WORD DIG
>bbfd 7e 08 .WORD OVER
>bbff 7e 08 .WORD OVER
>bc01 23 07 .WORD OR
>bc03 e9 07 .WORD ZEQU
>bc05 be 04 .WORD ZBRAN
>bc07 f4 ff L3535 .WORD $FFF4 ; L3529-L3535
>bc09 82 07 .WORD SEMIS
>bc0b 83 44 2e d2 L3541 .BYTE $83,"D.",$D2
>bc0f f4 19 .WORD L3526 ; link to #S
>bc11 4c 09 DDOTR .WORD DOCOL
>bc13 b0 07 .WORD TOR
>bc15 98 08 .WORD SWAP
>bc17 7e 08 .WORD OVER
>bc19 37 14 .WORD DABS
>bc1b 94 19 .WORD BDIGS
>bc1d f9 19 .WORD DIGS
>bc1f bc 19 .WORD SIGN
>bc21 a3 19 .WORD EDIGS
>bc23 c2 07 .WORD RFROM
>bc25 7e 08 .WORD OVER
>bc27 6d 0b .WORD SUB
>bc29 77 19 .WORD SPACS
>bc2b 08 0e .WORD TYPE
>bc2d 82 07 .WORD SEMIS
>bc2f 82 44 ae L3562 .BYTE $82,"D",$AE
>bc32 0b 1a .WORD L3541 ; link to D.R
>bc34 4c 09 DDOT .WORD DOCOL
>bc36 d0 09 .WORD ZERO
>bc38 11 1a .WORD DDOTR
>bc3a d1 0b .WORD SPACE
>bc3c 82 07 .WORD SEMIS
>bc3e 82 2e d2 L3573 .BYTE $82,".",$D2
>bc41 2f 1a .WORD L3562 ; link to D.
>bc43 4c 09 DOTR .WORD DOCOL
>bc45 b0 07 .WORD TOR
>bc47 f5 13 .WORD STOD
>bc49 c2 07 .WORD RFROM
>bc4b 11 1a .WORD DDOTR
>bc4d 82 07 .WORD SEMIS
>bc4f 81 ae L3585 .BYTE $81,$AE
>bc51 3e 1a .WORD L3573 ; link to .R
>bc53 4c 09 DOT .WORD DOCOL
>bc55 f5 13 .WORD STOD
>bc57 34 1a .WORD DDOT
>bc59 82 07 .WORD SEMIS
>bc5b 81 bf L3595 .BYTE $81,$BF
>bc5d 4f 1a .WORD L3585 ; link to .
>bc5f 4c 09 QUES .WORD DOCOL
>bc61 ef 08 .WORD AT
>bc63 53 1a .WORD DOT
>bc65 82 07 .WORD SEMIS
>bc67 84 4c 49 53 d4 L3605 .BYTE $84,"LIS",$D4
>bc6c 5b 1a .WORD L3595 ; link to ?
>bc6e 4c 09 LIST .WORD DOCOL
>bc70 70 0d .WORD DECIM
>bc72 5c 06 .WORD CR
>bc74 b0 08 .WORD DUP
>bc76 a5 0a .WORD SCR
>bc78 13 09 .WORD STORE
>bc7a 69 0e .WORD PDOTQ
>bc7c 06 53 43 52 20 23 20 .BYTE 6,"SCR # "
>bc83 53 1a .WORD DOT
>bc85 64 04 .WORD CLIT
>bc87 10 .BYTE 16
>bc88 d0 09 .WORD ZERO
>bc8a 46 05 .WORD PDO
>bc8c 5c 06 L3620 .WORD CR
>bc8e 5f 05 .WORD I
>bc90 e8 09 .WORD THREE
>bc92 43 1a .WORD DOTR
>bc94 d1 0b .WORD SPACE
>bc96 5f 05 .WORD I
>bc98 a5 0a .WORD SCR
>bc9a ef 08 .WORD AT
>bc9c cb 16 .WORD DLINE
>bc9e df 04 .WORD PLOOP
>bca0 ec ff L3630 .WORD $FFEC
>bca2 5c 06 .WORD CR
>bca4 82 07 .WORD SEMIS
>bca6 85 49 4e 44 45 d8 L3637 .BYTE $85,"INDE",$D8
>bcac 67 1a .WORD L3605 ; link to LIST
>bcae 4c 09 .WORD DOCOL
>bcb0 5c 06 .WORD CR
>bcb2 14 0b .WORD ONEP
>bcb4 98 08 .WORD SWAP
>bcb6 46 05 .WORD PDO
>bcb8 5c 06 L3647 .WORD CR
>bcba 5f 05 .WORD I
>bcbc e8 09 .WORD THREE
>bcbe 43 1a .WORD DOTR
>bcc0 d1 0b .WORD SPACE
>bcc2 d0 09 .WORD ZERO
>bcc4 5f 05 .WORD I
>bcc6 cb 16 .WORD DLINE
>bcc8 55 06 .WORD QTERM
>bcca be 04 .WORD ZBRAN
>bccc 04 00 L3657 .WORD 4 ; L3659-L3657
>bcce 95 07 .WORD LEAVE
>bcd0 df 04 L3659 .WORD PLOOP
>bcd2 e6 ff L3660 .WORD $FFE6 ; L3647-L3660
>bcd4 64 04 .WORD CLIT
>bcd6 0c .BYTE $0C ; form feed for printer
>bcd7 3f 06 .WORD EMIT
>bcd9 82 07 .WORD SEMIS
>bcdb 85 54 52 49 41 c4 L3666 .BYTE $85,"TRIA",$C4
>bce1 a6 1a .WORD L3637 ; link to INDEX
>bce3 4c 09 .WORD DOCOL
>bce5 e8 09 .WORD THREE
>bce7 d6 14 .WORD SLASH
>bce9 e8 09 .WORD THREE
>bceb b7 14 .WORD STAR
>bced e8 09 .WORD THREE
>bcef 7e 08 .WORD OVER
>bcf1 0f 08 .WORD PLUS
>bcf3 98 08 .WORD SWAP
>bcf5 46 05 .WORD PDO
>bcf7 5c 06 L3681 .WORD CR
>bcf9 5f 05 .WORD I
>bcfb 6e 1a .WORD LIST
>bcfd df 04 .WORD PLOOP
>bcff f8 ff L3685 .WORD $FFF8 ; L3681-L3685
>bd01 5c 06 .WORD CR
>bd03 64 04 .WORD CLIT
>bd05 0f .BYTE $F
>bd06 df 16 .WORD MESS
>bd08 5c 06 .WORD CR
>bd0a 64 04 .WORD CLIT
>bd0c 0c .BYTE $0C ; form feed for printer
>bd0d 3f 06 .WORD EMIT
>bd0f 82 07 .WORD SEMIS
>bd11 85 56 4c 49 53 d4 L3696 .BYTE $85,"VLIS",$D4
>bd17 db 1a .WORD L3666 ; link to TRIAD
>bd19 4c 09 VLIST .WORD DOCOL
>bd1b 64 04 .WORD CLIT
>bd1d 80 .BYTE $80
>bd1e 9c 0a .WORD OUT
>bd20 13 09 .WORD STORE
>bd22 be 0a .WORD CON
>bd24 ef 08 .WORD AT
>bd26 ef 08 .WORD AT
>bd28 9c 0a L3706 .WORD OUT
>bd2a ef 08 .WORD AT
>bd2c fb 09 .WORD CSLL
>bd2e af 0b .WORD GREAT
>bd30 be 04 .WORD ZBRAN
>bd32 0a 00 L3711 .WORD $A ; L3716-L3711
>bd34 5c 06 .WORD CR
>bd36 d0 09 .WORD ZERO
>bd38 9c 0a .WORD OUT
>bd3a 13 09 .WORD STORE
>bd3c b0 08 L3716 .WORD DUP
>bd3e 75 11 .WORD IDDOT
>bd40 d1 0b .WORD SPACE
>bd42 d1 0b .WORD SPACE
>bd44 5d 0c .WORD PFA
>bd46 2b 0c .WORD LFA
>bd48 ef 08 .WORD AT
>bd4a b0 08 .WORD DUP
>bd4c e9 07 .WORD ZEQU
>bd4e 55 06 .WORD QTERM
>bd50 23 07 .WORD OR
>bd52 be 04 .WORD ZBRAN
>bd54 d4 ff L3728 .WORD $FFD4 ; L3706-L3728
>bd56 8f 08 .WORD DROP
>bd58 82 07 .WORD SEMIS
>bd5a 83 4d 4f ce NTOP .BYTE $83,"MO",$CE
>bd5e 11 1b .WORD L3696 ; link to VLIST
>bd60 62 1b MON .WORD *+2
.bd62 6c f7 03 jmp ($03f7) JMP (RESvector) ; back to SBC Monitor
.bd65 top
.bd65 toprom
.bd65 a9 00 lda #$00 lda #<ORIG ; $0400
.bd67 85 00 sta $00 sta $00
.bd69 a9 04 lda #$04 lda #>ORIG ; $0400
.bd6b 85 01 sta $01 sta $01
.bd6d a9 00 lda #$00 lda #$00 ; start of Forth in ROM
.bd6f 85 02 sta $02 sta $02
.bd71 a9 a6 lda #$a6 lda #$A6
.bd73 85 03 sta $03 sta $03
.bd75 b2 02 lda ($02) CopyROM lda ($02)
.bd77 92 00 sta ($00) sta ($00)
.bd79 e6 00 inc $00 inc $00
.bd7b d0 02 bne $bd7f bne CopyR1
.bd7d e6 01 inc $01 inc $01
.bd7f e6 02 inc $02 CopyR1 inc $02
.bd81 d0 02 bne $bd85 bne CopyR2
.bd83 e6 03 inc $03 inc $03
.bd85 38 sec CopyR2 sec
.bd86 a9 65 lda #$65 lda #<TOPROM
.bd88 a2 bd ldx #$bd ldx #>TOPROM
.bd8a e5 02 sbc $02 sbc $02
.bd8c 8a txa txa
.bd8d e5 03 sbc $03 sbc $03
.bd8f b0 e4 bcs $bd75 bcs CopyROM
.bd91 4c 00 04 jmp $0400 JMP Enter ; Forth Cold Start
.be00 lab_cold
.be00 a0 04 ldy #$04 LDY #PG2_TABE-PG2_TABS-1
.be02 lab_2d13
.be02 b9 f6 de lda $def6,y LDA PG2_TABS,Y ; get byte
.be05 99 00 04 sta $0400,y STA ccflag,Y ; store in page 2
.be08 88 dey DEY ; decrement count
.be09 10 f7 bpl $be02 BPL LAB_2D13 ; loop if not done
.be0b a2 ff ldx #$ff LDX #$FF ; set byte
.be0d 86 88 stx $88 STX Clineh ; set current line high byte (set immediate mode)
.be0f 9a txs TXS ; reset stack pointer
.be10 a9 4c lda #$4c LDA #$4C ; code for JMP
.be12 85 a1 sta $a1 STA Fnxjmp ; save for jump vector for functions
.be14 a2 1c ldx #$1c LDX #StrTab-LAB_2CEE ; set byte count
.be16 lab_2d4e
.be16 bd fa de lda $defa,x LDA LAB_2CEE-1,X ; get byte from table
.be19 95 bb sta $bb,x STA LAB_IGBY-1,X ; save byte in page zero
.be1b ca dex DEX ; decrement count
.be1c d0 f8 bne $be16 BNE LAB_2D4E ; loop if not all done
.be1e lab_gmem
.be1e a2 12 ldx #$12 LDX #EndTab-StrTab-1 ; set byte count-1
.be20 tabloop
.be20 bd 17 df lda $df17,x LDA StrTab,X ; get byte from table
.be23 95 00 sta $00,x STA PLUS_0,X ; save byte in page zero
.be25 ca dex DEX ; decrement count
.be26 10 f8 bpl $be20 BPL TabLoop ; loop if not all done
.be28 a9 00 lda #$00 LDA #$00 ; clear A
.be2a 85 dc sta $dc STA NmiBase ; clear NMI handler enabled flag
.be2c 85 df sta $df STA IrqBase ; clear IRQ handler enabled flag
.be2e 85 b2 sta $b2 STA FAC1_o ; clear FAC1 overflow byte
.be30 85 67 sta $67 STA last_sh ; clear descriptor stack top item pointer high byte
.be32 a9 0e lda #$0e LDA #$0E ; set default tab size
.be34 85 64 sta $64 STA TabSiz ; save it
.be36 a9 03 lda #$03 LDA #$03 ; set garbage collect step size for descriptor stack
.be38 85 a0 sta $a0 STA g_step ; save it
.be3a a2 68 ldx #$68 LDX #des_sk ; descriptor stack start
.be3c 86 65 stx $65 STX next_s ; set descriptor stack pointer
.be3e 20 92 c6 jsr $c692 JSR LAB_CRLF ; print CR/LF
.be41 a9 2a lda #$2a LDA #<LAB_MSZM ; point to memory size message (low addr)
.be43 a0 df ldy #$df LDY #>LAB_MSZM ; point to memory size message (high addr)
.be45 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.be48 20 40 c0 jsr $c040 JSR LAB_INLN ; print "? " and get BASIC input
.be4b 86 c3 stx $c3 STX Bpntrl ; set BASIC execute pointer low byte
.be4d 84 c4 sty $c4 STY Bpntrh ; set BASIC execute pointer high byte
.be4f 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get last byte back
.be52 d0 1f bne $be73 BNE LAB_2DAA ; branch if not null (user typed something)
.be54 a0 00 ldy #$00 LDY #$00 ; else clear Y
.be56 lab_2d93
.be56 e6 11 inc $11 INC Itempl ; increment temporary integer low byte
.be58 d0 08 bne $be62 BNE LAB_2D99 ; branch if no overflow
.be5a e6 12 inc $12 INC Itemph ; increment temporary integer high byte
.be5c a5 12 lda $12 LDA Itemph ; get high byte
.be5e c9 3f cmp #$3f CMP #>Ram_top ; compare with top of RAM+1
.be60 f0 1d beq $be7f BEQ LAB_2DB6 ; branch if match (end of user RAM)
.be62 lab_2d99
.be62 a9 55 lda #$55 LDA #$55 ; set test byte
.be64 91 11 sta ($11),y STA (Itempl),Y ; save via temporary integer
.be66 d1 11 cmp ($11),y CMP (Itempl),Y ; compare via temporary integer
.be68 d0 15 bne $be7f BNE LAB_2DB6 ; branch if fail
.be6a 0a asl ASL ; shift test byte left (now $AA)
.be6b 91 11 sta ($11),y STA (Itempl),Y ; save via temporary integer
.be6d d1 11 cmp ($11),y CMP (Itempl),Y ; compare via temporary integer
.be6f f0 e5 beq $be56 BEQ LAB_2D93 ; if ok go do next byte
.be71 d0 0c bne $be7f BNE LAB_2DB6 ; branch if fail
.be73 lab_2daa
.be73 20 a6 d7 jsr $d7a6 JSR LAB_2887 ; get FAC1 from string
.be76 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.be78 c9 98 cmp #$98 CMP #$98 ; compare with exponent = 2^24
.be7a b0 a2 bcs $be1e BCS LAB_GMEM ; if too large go try again
.be7c 20 f7 d2 jsr $d2f7 JSR LAB_F2FU ; save integer part of FAC1 in temporary integer
.be7f lab_2db6
.be7f a5 11 lda $11 LDA Itempl ; get temporary integer low byte
.be81 a4 12 ldy $12 LDY Itemph ; get temporary integer high byte
.be83 c0 01 cpy #$01 CPY #<Ram_base+1 ; compare with start of RAM+$100 high byte
.be85 90 97 bcc $be1e BCC LAB_GMEM ; if too small go try again
.be87 85 85 sta $85 STA Ememl ; set end of mem low byte
.be89 84 86 sty $86 STY Ememh ; set end of mem high byte
.be8b 85 81 sta $81 STA Sstorl ; set bottom of string space low byte
.be8d 84 82 sty $82 STY Sstorh ; set bottom of string space high byte
.be8f a0 00 ldy #$00 LDY #<Ram_base ; set start addr low byte
.be91 a2 05 ldx #$05 LDX #>Ram_base ; set start addr high byte
.be93 84 79 sty $79 STY Smeml ; save start of mem low byte
.be95 86 7a stx $7a STX Smemh ; save start of mem high byte
.be97 98 tya TYA ; clear A
.be98 91 79 sta ($79),y STA (Smeml),Y ; clear first byte
.be9a e6 79 inc $79 INC Smeml ; increment start of mem low byte
.be9c lab_2e05
.be9c 20 92 c6 jsr $c692 JSR LAB_CRLF ; print CR/LF
.be9f 20 50 c1 jsr $c150 JSR LAB_1463 ; do "NEW" and "CLEAR"
.bea2 a5 85 lda $85 LDA Ememl ; get end of mem low byte
.bea4 38 sec SEC ; set carry for subtract
.bea5 e5 79 sbc $79 SBC Smeml ; subtract start of mem low byte
.bea7 aa tax TAX ; copy to X
.bea8 a5 86 lda $86 LDA Ememh ; get end of mem high byte
.beaa e5 7a sbc $7a SBC Smemh ; subtract start of mem high byte
.beac 20 82 d8 jsr $d882 JSR LAB_295E ; print XA as unsigned integer (bytes free)
.beaf a9 39 lda #$39 LDA #<LAB_SMSG ; point to sign-on message (low addr)
.beb1 a0 df ldy #$df LDY #>LAB_SMSG ; point to sign-on message (high addr)
.beb3 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.beb6 a9 5a lda #$5a LDA #<LAB_1274 ; warm start vector low byte
.beb8 a0 bf ldy #$bf LDY #>LAB_1274 ; warm start vector high byte
.beba 85 01 sta $01 STA Wrmjpl ; save warm start vector low byte
.bebc 84 02 sty $02 STY Wrmjph ; save warm start vector high byte
.bebe 6c 01 00 jmp ($0001) JMP (Wrmjpl) ; go do warm start
.bec1 lab_11cf
.bec1 20 0b bf jsr $bf0b JSR LAB_121F ; check available memory, "Out of memory" error if no room
.bec4 85 7f sta $7f STA Earryl ; save new array mem end low byte
.bec6 84 80 sty $80 STY Earryh ; save new array mem end high byte
.bec8 lab_11d6
.bec8 38 sec SEC ; set carry for subtract
.bec9 a5 a6 lda $a6 LDA Obendl ; get block end low byte
.becb e5 aa sbc $aa SBC Ostrtl ; subtract block start low byte
.becd a8 tay TAY ; copy MOD(block length/$100) byte to Y
.bece a5 a7 lda $a7 LDA Obendh ; get block end high byte
.bed0 e5 ab sbc $ab SBC Ostrth ; subtract block start high byte
.bed2 aa tax TAX ; copy block length high byte to X
.bed3 e8 inx INX ; +1 to allow for count=0 exit
.bed4 98 tya TYA ; copy block length low byte to A
.bed5 f0 24 beq $befb BEQ LAB_120A ; branch if length low byte=0
.bed7 38 sec SEC ; set carry for add + 1, two's complement
.bed8 49 ff eor #$ff EOR #$FF ; invert low byte for subtract
.beda 65 a6 adc $a6 ADC Obendl ; add block end low byte
.bedc 85 a6 sta $a6 STA Obendl ; save corrected old block end low byte
.bede b0 03 bcs $bee3 BCS LAB_11F3 ; branch if no underflow
.bee0 c6 a7 dec $a7 DEC Obendh ; else decrement block end high byte
.bee2 38 sec SEC ; set carry for add + 1, two's complement
.bee3 lab_11f3
.bee3 98 tya TYA ; get MOD(block length/$100) byte
.bee4 49 ff eor #$ff EOR #$FF ; invert low byte for subtract
.bee6 65 a4 adc $a4 ADC Nbendl ; add destination end low byte
.bee8 85 a4 sta $a4 STA Nbendl ; save modified new block end low byte
.beea b0 08 bcs $bef4 BCS LAB_1203 ; branch if no underflow
.beec c6 a5 dec $a5 DEC Nbendh ; else decrement block end high byte
.beee 90 04 bcc $bef4 BCC LAB_1203 ; branch always
.bef0 lab_11ff
.bef0 b1 a6 lda ($a6),y LDA (Obendl),Y ; get byte from source
.bef2 91 a4 sta ($a4),y STA (Nbendl),Y ; copy byte to destination
.bef4 lab_1203
.bef4 88 dey DEY ; decrement index
.bef5 d0 f9 bne $bef0 BNE LAB_11FF ; loop until Y=0
.bef7 b1 a6 lda ($a6),y LDA (Obendl),Y ; get byte from source
.bef9 91 a4 sta ($a4),y STA (Nbendl),Y ; save byte to destination
.befb lab_120a
.befb c6 a7 dec $a7 DEC Obendh ; decrement source pointer high byte
.befd c6 a5 dec $a5 DEC Nbendh ; decrement destination pointer high byte
.beff ca dex DEX ; decrement block count
.bf00 d0 f2 bne $bef4 BNE LAB_1203 ; loop until count = $0
.bf02 60 rts RTS
.bf03 lab_1212
.bf03 85 78 sta $78 STA TempB ; save result in temp byte
.bf05 ba tsx TSX ; copy stack
.bf06 e4 78 cpx $78 CPX TempB ; compare new "limit" with stack
.bf08 90 30 bcc $bf3a BCC LAB_OMER ; if stack < limit do "Out of memory" error then warm start
.bf0a 60 rts RTS
.bf0b lab_121f
.bf0b c4 82 cpy $82 CPY Sstorh ; compare bottom of string mem high byte
.bf0d 90 2a bcc $bf39 BCC LAB_124B ; if less then exit (is ok)
.bf0f d0 04 bne $bf15 BNE LAB_1229 ; skip next test if greater (tested <)
.bf11 c5 81 cmp $81 CMP Sstorl ; compare with bottom of string mem low byte
.bf13 90 24 bcc $bf39 BCC LAB_124B ; if less then exit (is ok)
.bf15 lab_1229
.bf15 48 pha PHA ; push addr low byte
.bf16 a2 08 ldx #$08 LDX #$08 ; set index to save Adatal to expneg inclusive
.bf18 98 tya TYA ; copy addr high byte (to push on stack)
.bf19 lab_122d
.bf19 48 pha PHA ; push byte
.bf1a b5 a3 lda $a3,x LDA Adatal-1,X ; get byte from Adatal to expneg ( ,$00 not pushed)
.bf1c ca dex DEX ; decrement index
.bf1d 10 fa bpl $bf19 BPL LAB_122D ; loop until all done
.bf1f 20 df cf jsr $cfdf JSR LAB_GARB ; garbage collection routine
.bf22 a2 00 ldx #$00 LDX #$00 ; clear the index to restore bytes
.bf24 lab_1238
.bf24 68 pla PLA ; pop byte
.bf25 95 a4 sta $a4,x STA Adatal,X ; save byte to Adatal to expneg
.bf27 e8 inx INX ; increment index
.bf28 e0 08 cpx #$08 CPX #$08 ; compare with end + 1
.bf2a 30 f8 bmi $bf24 BMI LAB_1238 ; loop if more to do
.bf2c 68 pla PLA ; pop addr high byte
.bf2d a8 tay TAY ; copy back to Y
.bf2e 68 pla PLA ; pop addr low byte
.bf2f c4 82 cpy $82 CPY Sstorh ; compare bottom of string mem high byte
.bf31 90 06 bcc $bf39 BCC LAB_124B ; if less then exit (is ok)
.bf33 d0 05 bne $bf3a BNE LAB_OMER ; if greater do "Out of memory" error then warm start
.bf35 c5 81 cmp $81 CMP Sstorl ; compare with bottom of string mem low byte
.bf37 b0 01 bcs $bf3a BCS LAB_OMER ; if >= do "Out of memory" error then warm start
.bf39 lab_124b
.bf39 60 rts RTS
.bf3a lab_omer
.bf3a a2 0c ldx #$0c LDX #$0C ; error code $0C ("Out of memory" error)
.bf3c lab_xerr
.bf3c 20 92 c6 jsr $c692 JSR LAB_CRLF ; print CR/LF
.bf3f bd b2 e4 lda $e4b2,x LDA LAB_BAER,X ; get error message pointer low byte
.bf42 bc b3 e4 ldy $e4b3,x LDY LAB_BAER+1,X ; get error message pointer high byte
.bf45 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.bf48 20 89 c1 jsr $c189 JSR LAB_1491 ; flush stack and clear continue flag
.bf4b a9 ef lda #$ef LDA #<LAB_EMSG ; point to " Error" low addr
.bf4d a0 e5 ldy #$e5 LDY #>LAB_EMSG ; point to " Error" high addr
.bf4f lab_1269
.bf4f 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.bf52 a4 88 ldy $88 LDY Clineh ; get current line high byte
.bf54 c8 iny INY ; increment it
.bf55 f0 03 beq $bf5a BEQ LAB_1274 ; go do warm start (was immediate mode)
.bf57 20 77 d8 jsr $d877 JSR LAB_2953 ; print " in line [LINE #]"
.bf5a lab_1274
.bf5a a9 00 lda #$00 LDA #$00 ; clear A
.bf5c 85 df sta $df STA IrqBase ; clear enabled byte
.bf5e 85 dc sta $dc STA NmiBase ; clear enabled byte
.bf60 a9 00 lda #$00 LDA #<LAB_RMSG ; point to "Ready" message low byte
.bf62 a0 e6 ldy #$e6 LDY #>LAB_RMSG ; point to "Ready" message high byte
.bf64 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; go do print string
.bf67 lab_127d
.bf67 20 4d c0 jsr $c04d JSR LAB_1357 ; call for BASIC input
.bf6a lab_1280
.bf6a 86 c3 stx $c3 STX Bpntrl ; set BASIC execute pointer low byte
.bf6c 84 c4 sty $c4 STY Bpntrh ; set BASIC execute pointer high byte
.bf6e 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.bf71 f0 f4 beq $bf67 BEQ LAB_127D ; loop while null
.bf73 a2 ff ldx #$ff LDX #$FF ; current line to null value
.bf75 86 88 stx $88 STX Clineh ; set current line high byte
.bf77 90 06 bcc $bf7f BCC LAB_1295 ; branch if numeric character (handle new BASIC line)
.bf79 20 7e c0 jsr $c07e JSR LAB_13A6 ; crunch keywords into Basic tokens
.bf7c 4c f3 c2 jmp $c2f3 JMP LAB_15F6 ; go scan and interpret code
.bf7f lab_1295
.bf7f 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.bf82 20 7e c0 jsr $c07e JSR LAB_13A6 ; crunch keywords into Basic tokens
.bf85 84 5d sty $5d STY Ibptr ; save index pointer to end of crunched line
.bf87 20 24 c1 jsr $c124 JSR LAB_SSLN ; search BASIC for temp integer line number
.bf8a 90 44 bcc $bfd0 BCC LAB_12E6 ; branch if not found
.bf8c a0 01 ldy #$01 LDY #$01 ; set index to next line pointer high byte
.bf8e b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer high byte
.bf90 85 72 sta $72 STA ut1_ph ; save it
.bf92 a5 7b lda $7b LDA Svarl ; get start of vars low byte
.bf94 85 71 sta $71 STA ut1_pl ; save it
.bf96 a5 ab lda $ab LDA Baslnh ; get found line pointer high byte
.bf98 85 74 sta $74 STA ut2_ph ; save it
.bf9a a5 aa lda $aa LDA Baslnl ; get found line pointer low byte
.bf9c 88 dey DEY ; decrement index
.bf9d f1 aa sbc ($aa),y SBC (Baslnl),Y ; subtract next line pointer low byte
.bf9f 18 clc CLC ; clear carry for add
.bfa0 65 7b adc $7b ADC Svarl ; add start of vars low byte
.bfa2 85 7b sta $7b STA Svarl ; save new start of vars low byte
.bfa4 85 73 sta $73 STA ut2_pl ; save destination pointer low byte
.bfa6 a5 7c lda $7c LDA Svarh ; get start of vars high byte
.bfa8 69 ff adc #$ff ADC #$FF ; -1 + carry
.bfaa 85 7c sta $7c STA Svarh ; save start of vars high byte
.bfac e5 ab sbc $ab SBC Baslnh ; subtract found line pointer high byte
.bfae aa tax TAX ; copy to block count
.bfaf 38 sec SEC ; set carry for subtract
.bfb0 a5 aa lda $aa LDA Baslnl ; get found line pointer low byte
.bfb2 e5 7b sbc $7b SBC Svarl ; subtract start of vars low byte
.bfb4 a8 tay TAY ; copy to bytes in first block count
.bfb5 b0 03 bcs $bfba BCS LAB_12D0 ; branch if overflow
.bfb7 e8 inx INX ; increment block count (correct for =0 loop exit)
.bfb8 c6 74 dec $74 DEC ut2_ph ; decrement destination high byte
.bfba lab_12d0
.bfba 18 clc CLC ; clear carry for add
.bfbb 65 71 adc $71 ADC ut1_pl ; add source pointer low byte
.bfbd 90 03 bcc $bfc2 BCC LAB_12D8 ; branch if no overflow
.bfbf c6 72 dec $72 DEC ut1_ph ; else decrement source pointer high byte
.bfc1 18 clc CLC ; clear carry
.bfc2 lab_12d8
.bfc2 b1 71 lda ($71),y LDA (ut1_pl),Y ; get byte from source
.bfc4 91 73 sta ($73),y STA (ut2_pl),Y ; copy to destination
.bfc6 c8 iny INY ; increment index
.bfc7 d0 f9 bne $bfc2 BNE LAB_12D8 ; while <> 0 do this block
.bfc9 e6 72 inc $72 INC ut1_ph ; increment source pointer high byte
.bfcb e6 74 inc $74 INC ut2_ph ; increment destination pointer high byte
.bfcd ca dex DEX ; decrement block count
.bfce d0 f2 bne $bfc2 BNE LAB_12D8 ; loop until all done
.bfd0 lab_12e6
.bfd0 ad 0d 04 lda $040d LDA Ibuffs ; get byte from start of input buffer
.bfd3 f0 3f beq $c014 BEQ LAB_1319 ; if null line just go flush stack/vars and exit
.bfd5 a5 85 lda $85 LDA Ememl ; get end of mem low byte
.bfd7 a4 86 ldy $86 LDY Ememh ; get end of mem high byte
.bfd9 85 81 sta $81 STA Sstorl ; set bottom of string space low byte
.bfdb 84 82 sty $82 STY Sstorh ; set bottom of string space high byte
.bfdd a5 7b lda $7b LDA Svarl ; get start of vars low byte (end of BASIC)
.bfdf 85 a6 sta $a6 STA Obendl ; save old block end low byte
.bfe1 a4 7c ldy $7c LDY Svarh ; get start of vars high byte (end of BASIC)
.bfe3 84 a7 sty $a7 STY Obendh ; save old block end high byte
.bfe5 65 5d adc $5d ADC Ibptr ; add input buffer pointer (also buffer length)
.bfe7 90 01 bcc $bfea BCC LAB_1301 ; branch if no overflow from add
.bfe9 c8 iny INY ; else increment high byte
.bfea lab_1301
.bfea 85 a4 sta $a4 STA Nbendl ; save new block end low byte (move to, low byte)
.bfec 84 a5 sty $a5 STY Nbendh ; save new block end high byte
.bfee 20 c1 be jsr $bec1 JSR LAB_11CF ; open up space in memory
.bff1 a5 7f lda $7f LDA Earryl ; get array mem end low byte
.bff3 a4 80 ldy $80 LDY Earryh ; get array mem end high byte
.bff5 85 7b sta $7b STA Svarl ; save start of vars low byte
.bff7 84 7c sty $7c STY Svarh ; save start of vars high byte
.bff9 a4 5d ldy $5d LDY Ibptr ; get input buffer pointer (also buffer length)
.bffb 88 dey DEY ; adjust for loop type
.bffc lab_1311
.bffc b9 09 04 lda $0409,y LDA Ibuffs-4,Y ; get byte from crunched line
.bfff 91 aa sta ($aa),y STA (Baslnl),Y ; save it to program memory
.c001 88 dey DEY ; decrement count
.c002 c0 03 cpy #$03 CPY #$03 ; compare with first byte-1
.c004 d0 f6 bne $bffc BNE LAB_1311 ; continue while count <> 3
.c006 a5 12 lda $12 LDA Itemph ; get line # high byte
.c008 91 aa sta ($aa),y STA (Baslnl),Y ; save it to program memory
.c00a 88 dey DEY ; decrement count
.c00b a5 11 lda $11 LDA Itempl ; get line # low byte
.c00d 91 aa sta ($aa),y STA (Baslnl),Y ; save it to program memory
.c00f 88 dey DEY ; decrement count
.c010 a9 ff lda #$ff LDA #$FF ; set byte to allow chain rebuild. if you didn't set this
.c012 91 aa sta ($aa),y STA (Baslnl),Y ; save it to program memory
.c014 lab_1319
.c014 20 65 c1 jsr $c165 JSR LAB_1477 ; reset execution to start, clear vars and flush stack
.c017 a6 79 ldx $79 LDX Smeml ; get start of mem low byte
.c019 a5 7a lda $7a LDA Smemh ; get start of mem high byte
.c01b a0 01 ldy #$01 LDY #$01 ; index to high byte of next line pointer
.c01d lab_1325
.c01d 86 71 stx $71 STX ut1_pl ; set line start pointer low byte
.c01f 85 72 sta $72 STA ut1_ph ; set line start pointer high byte
.c021 b1 71 lda ($71),y LDA (ut1_pl),Y ; get it
.c023 f0 18 beq $c03d BEQ LAB_133E ; exit if end of program
.c025 a0 04 ldy #$04 LDY #$04 ; point to first code byte of line
.c027 lab_1330
.c027 c8 iny INY ; next code byte
.c028 b1 71 lda ($71),y LDA (ut1_pl),Y ; get byte
.c02a d0 fb bne $c027 BNE LAB_1330 ; loop if not [EOL]
.c02c 38 sec SEC ; set carry for add + 1
.c02d 98 tya TYA ; copy end index
.c02e 65 71 adc $71 ADC ut1_pl ; add to line start pointer low byte
.c030 aa tax TAX ; copy to X
.c031 a0 00 ldy #$00 LDY #$00 ; clear index, point to this line's next line pointer
.c033 91 71 sta ($71),y STA (ut1_pl),Y ; set next line pointer low byte
.c035 98 tya TYA ; clear A
.c036 65 72 adc $72 ADC ut1_ph ; add line start pointer high byte + carry
.c038 c8 iny INY ; increment index to high byte
.c039 91 71 sta ($71),y STA (ut1_pl),Y ; save next line pointer low byte
.c03b 90 e0 bcc $c01d BCC LAB_1325 ; go do next line, branch always, carry clear
.c03d lab_133e
.c03d 4c 67 bf jmp $bf67 JMP LAB_127D ; else we just wait for Basic command, no "Ready"
.c040 lab_inln
.c040 20 eb c6 jsr $c6eb JSR LAB_18E3 ; print "?" character
.c043 20 e8 c6 jsr $c6e8 JSR LAB_18E0 ; print " "
.c046 d0 05 bne $c04d BNE LAB_1357 ; call for BASIC input and return
.c048 lab_134b
.c048 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c04b ca dex DEX ; decrement the buffer counter (delete)
>c04c 2c .byte $2C ; make LDX into BIT abs
.c04d lab_1357
.c04d a2 00 ldx #$00 LDX #$00 ; clear BASIC line buffer pointer
.c04f lab_1359
.c04f 20 ea de jsr $deea JSR V_INPT ; call scan input device
.c052 90 fb bcc $c04f BCC LAB_1359 ; loop if no byte
.c054 f0 f9 beq $c04f BEQ LAB_1359 ; loop until valid input (ignore NULLs)
.c056 c9 07 cmp #$07 CMP #$07 ; compare with [BELL]
.c058 f0 10 beq $c06a BEQ LAB_1378 ; branch if [BELL]
.c05a c9 0d cmp #$0d CMP #$0D ; compare with [CR]
.c05c f0 19 beq $c077 BEQ LAB_1384 ; do CR/LF exit if [CR]
.c05e e0 00 cpx #$00 CPX #$00 ; compare pointer with $00
.c060 d0 04 bne $c066 BNE LAB_1374 ; branch if not empty
.c062 c9 21 cmp #$21 CMP #$21 ; compare with [SP]+1
.c064 90 e9 bcc $c04f BCC LAB_1359 ; if < ignore character
.c066 lab_1374
.c066 c9 08 cmp #$08 CMP #$08 ; compare with [BACKSPACE] (delete last character)
.c068 f0 de beq $c048 BEQ LAB_134B ; go delete last character
.c06a lab_1378
.c06a e0 47 cpx #$47 CPX #Ibuffe-Ibuffs ; compare character count with max
.c06c b0 0c bcs $c07a BCS LAB_138E ; skip store and do [BELL] if buffer full
.c06e 9d 0d 04 sta $040d,x STA Ibuffs,X ; else store in buffer
.c071 e8 inx INX ; increment pointer
.c072 lab_137f
.c072 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c075 d0 d8 bne $c04f BNE LAB_1359 ; always loop for next character
.c077 lab_1384
.c077 4c 89 c6 jmp $c689 JMP LAB_1866 ; do CR/LF exit to BASIC
.c07a lab_138e
.c07a a9 07 lda #$07 LDA #$07 ; [BELL] character into A
.c07c d0 f4 bne $c072 BNE LAB_137F ; go print the [BELL] but ignore input character
.c07e lab_13a6
.c07e a0 ff ldy #$ff LDY #$FF ; set save index (makes for easy math later)
.c080 38 sec SEC ; set carry for subtract
.c081 a5 c3 lda $c3 LDA Bpntrl ; get basic execute pointer low byte
.c083 e9 0d sbc #$0d SBC #<Ibuffs ; subtract input buffer start pointer
.c085 aa tax TAX ; copy result to X (index past line # if any)
.c086 86 60 stx $60 STX Oquote ; clear open quote/DATA flag
.c088 lab_13ac
.c088 bd 0d 04 lda $040d,x LDA Ibuffs,X ; get byte from input buffer
.c08b f0 51 beq $c0de BEQ LAB_13EC ; if null save byte then exit
.c08d c9 5f cmp #$5f CMP #"_" ; compare with "_"
.c08f b0 4d bcs $c0de BCS LAB_13EC ; if >= go save byte then continue crunching
.c091 c9 3c cmp #$3c CMP #"<" ; compare with "<"
.c093 b0 0e bcs $c0a3 BCS LAB_13CC ; if >= go crunch now
.c095 c9 30 cmp #$30 CMP #"0" ; compare with "0"
.c097 b0 45 bcs $c0de BCS LAB_13EC ; if >= go save byte then continue crunching
.c099 85 5c sta $5c STA Scnquo ; save buffer byte as search character
.c09b c9 22 cmp #$22 CMP #$22 ; is it quote character?
.c09d f0 61 beq $c100 BEQ LAB_1410 ; branch if so (copy quoted string)
.c09f c9 2a cmp #$2a CMP #"*" ; compare with "*"
.c0a1 90 3b bcc $c0de BCC LAB_13EC ; if < go save byte then continue crunching
.c0a3 lab_13cc
.c0a3 24 60 bit $60 BIT Oquote ; get open quote/DATA token flag
.c0a5 70 37 bvs $c0de BVS LAB_13EC ; branch if b6 of Oquote set (was DATA)
.c0a7 86 78 stx $78 STX TempB ; save buffer read index
.c0a9 84 ba sty $ba STY csidx ; copy buffer save index
.c0ab a0 12 ldy #$12 LDY #<TAB_1STC ; get keyword first character table low address
.c0ad 84 73 sty $73 STY ut2_pl ; save pointer low byte
.c0af a0 e1 ldy #$e1 LDY #>TAB_1STC ; get keyword first character table high address
.c0b1 84 74 sty $74 STY ut2_ph ; save pointer high byte
.c0b3 a0 00 ldy #$00 LDY #$00 ; clear table pointer
.c0b5 lab_13d0
.c0b5 d1 73 cmp ($73),y CMP (ut2_pl),Y ; compare with keyword first character table byte
.c0b7 f0 05 beq $c0be BEQ LAB_13D1 ; go do word_table_chr if match
.c0b9 90 21 bcc $c0dc BCC LAB_13EA ; if < keyword first character table byte go restore
.c0bb c8 iny INY ; else increment pointer
.c0bc d0 f7 bne $c0b5 BNE LAB_13D0 ; and loop (branch always)
.c0be lab_13d1
.c0be 98 tya TYA ; copy matching index
.c0bf 0a asl ASL ; *2 (bytes per pointer)
.c0c0 aa tax TAX ; copy to new index
.c0c1 bd 30 e1 lda $e130,x LDA TAB_CHRT,X ; get keyword table pointer low byte
.c0c4 85 73 sta $73 STA ut2_pl ; save pointer low byte
.c0c6 bd 31 e1 lda $e131,x LDA TAB_CHRT+1,X ; get keyword table pointer high byte
.c0c9 85 74 sta $74 STA ut2_ph ; save pointer high byte
.c0cb a0 ff ldy #$ff LDY #$FF ; clear table pointer (make -1 for start)
.c0cd a6 78 ldx $78 LDX TempB ; restore buffer read index
.c0cf lab_13d6
.c0cf c8 iny INY ; next table byte
.c0d0 b1 73 lda ($73),y LDA (ut2_pl),Y ; get byte from table
.c0d2 lab_13d8
.c0d2 30 08 bmi $c0dc BMI LAB_13EA ; all bytes matched so go save token
.c0d4 e8 inx INX ; next buffer byte
.c0d5 dd 0d 04 cmp $040d,x CMP Ibuffs,X ; compare with byte from input buffer
.c0d8 f0 f5 beq $c0cf BEQ LAB_13D6 ; go compare next if match
.c0da d0 2b bne $c107 BNE LAB_1417 ; branch if >< (not found keyword)
.c0dc lab_13ea
.c0dc a4 ba ldy $ba LDY csidx ; restore save index
.c0de lab_13ec
.c0de e8 inx INX ; increment buffer index (to next input byte)
.c0df c8 iny INY ; increment save index (to next output byte)
.c0e0 99 0d 04 sta $040d,y STA Ibuffs,Y ; save byte to output
.c0e3 c9 00 cmp #$00 CMP #$00 ; set the flags, set carry
.c0e5 f0 32 beq $c119 BEQ LAB_142A ; do exit if was null [EOL]
.c0e7 e9 3a sbc #$3a SBC #":" ; subtract ":" (carry set by CMP #00)
.c0e9 f0 04 beq $c0ef BEQ LAB_13FF ; branch if it was ":" (is now $00)
.c0eb c9 49 cmp #$49 CMP #TK_DATA-$3A ; compare with DATA token - $3A
.c0ed d0 02 bne $c0f1 BNE LAB_1401 ; branch if not DATA
.c0ef lab_13ff
.c0ef 85 60 sta $60 STA Oquote ; save token-$3A (clear for ":", TK_DATA-$3A for DATA)
.c0f1 lab_1401
.c0f1 49 57 eor #$57 EOR #TK_REM-$3A ; effectively subtract REM token offset
.c0f3 d0 93 bne $c088 BNE LAB_13AC ; If wasn't REM then go crunch rest of line
.c0f5 85 5c sta $5c STA Asrch ; else was REM so set search for [EOL]
.c0f7 lab_1408
.c0f7 bd 0d 04 lda $040d,x LDA Ibuffs,X ; get byte from input buffer
.c0fa f0 e2 beq $c0de BEQ LAB_13EC ; branch if null [EOL]
.c0fc c5 5c cmp $5c CMP Asrch ; compare with stored character
.c0fe f0 de beq $c0de BEQ LAB_13EC ; branch if match (end quote)
.c100 lab_1410
.c100 c8 iny INY ; increment buffer save index
.c101 99 0d 04 sta $040d,y STA Ibuffs,Y ; save byte to output
.c104 e8 inx INX ; increment buffer read index
.c105 d0 f0 bne $c0f7 BNE LAB_1408 ; loop while <> 0 (should never be 0!)
.c107 lab_1417
.c107 a6 78 ldx $78 LDX TempB ; compare has failed, restore buffer index (start byte!)
.c109 lab_141b
.c109 b1 73 lda ($73),y LDA (ut2_pl),Y ; get table byte
.c10b 08 php PHP ; save status
.c10c c8 iny INY ; increment table index
.c10d 28 plp PLP ; restore byte status
.c10e 10 f9 bpl $c109 BPL LAB_141B ; if not end of keyword go do next
.c110 b1 73 lda ($73),y LDA (ut2_pl),Y ; get byte from keyword table
.c112 d0 be bne $c0d2 BNE LAB_13D8 ; go test next word if not zero byte (end of table)
.c114 bd 0d 04 lda $040d,x LDA Ibuffs,X ; restore byte from input buffer
.c117 10 c3 bpl $c0dc BPL LAB_13EA ; branch always (all bytes in buffer are $00-$7F)
.c119 lab_142a
.c119 c8 iny INY ; increment pointer
.c11a c8 iny INY ; increment pointer (makes it next line pointer high byte)
.c11b 99 0d 04 sta $040d,y STA Ibuffs,Y ; save [EOL] (marks [EOT] in immediate mode)
.c11e c8 iny INY ; adjust for line copy
.c11f c8 iny INY ; adjust for line copy
.c120 c8 iny INY ; adjust for line copy
.c121 c6 c3 dec $c3 DEC Bpntrl ; allow for increment (change if buffer starts at $xxFF)
.c123 60 rts RTS
.c124 lab_ssln
.c124 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c126 a6 7a ldx $7a LDX Smemh ; get start of mem high byte
.c128 lab_shln
.c128 a0 01 ldy #$01 LDY #$01 ; set index
.c12a 85 aa sta $aa STA Baslnl ; save low byte as current
.c12c 86 ab stx $ab STX Baslnh ; save high byte as current
.c12e b1 aa lda ($aa),y LDA (Baslnl),Y ; get pointer high byte from addr
.c130 f0 1a beq $c14c BEQ LAB_145F ; pointer was zero so we"re done, do "not found" exit
.c132 a0 03 ldy #$03 LDY #$03 ; set index to line # high byte
.c134 b1 aa lda ($aa),y LDA (Baslnl),Y ; get line # high byte
.c136 88 dey DEY ; decrement index (point to low byte)
.c137 c5 12 cmp $12 CMP Itemph ; compare with temporary integer high byte
.c139 d0 04 bne $c13f BNE LAB_1455 ; if <> skip low byte check
.c13b b1 aa lda ($aa),y LDA (Baslnl),Y ; get line # low byte
.c13d c5 11 cmp $11 CMP Itempl ; compare with temporary integer low byte
.c13f lab_1455
.c13f b0 09 bcs $c14a BCS LAB_145E ; else if temp < this line, exit (passed line#)
.c141 lab_1456
.c141 88 dey DEY ; decrement index to next line ptr high byte
.c142 b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer high byte
.c144 aa tax TAX ; copy to X
.c145 88 dey DEY ; decrement index to next line ptr low byte
.c146 b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer low byte
.c148 90 de bcc $c128 BCC LAB_SHLN ; go search for line # in temp (Itempl/Itemph) from AX
.c14a lab_145e
.c14a f0 01 beq $c14d BEQ LAB_1460 ; exit if temp = found line #, carry is set
.c14c lab_145f
.c14c 18 clc CLC ; clear found flag
.c14d lab_1460
.c14d 60 rts RTS
.c14e lab_new
.c14e d0 fd bne $c14d BNE LAB_1460 ; exit if not end of statement (to do syntax error)
.c150 lab_1463
.c150 a9 00 lda #$00 LDA #$00 ; clear A
.c152 a8 tay TAY ; clear Y
.c153 91 79 sta ($79),y STA (Smeml),Y ; clear first line, next line pointer, low byte
.c155 c8 iny INY ; increment index
.c156 91 79 sta ($79),y STA (Smeml),Y ; clear first line, next line pointer, high byte
.c158 18 clc CLC ; clear carry
.c159 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c15b 69 02 adc #$02 ADC #$02 ; calculate end of BASIC low byte
.c15d 85 7b sta $7b STA Svarl ; save start of vars low byte
.c15f a5 7a lda $7a LDA Smemh ; get start of mem high byte
.c161 69 00 adc #$00 ADC #$00 ; add any carry
.c163 85 7c sta $7c STA Svarh ; save start of vars high byte
.c165 lab_1477
.c165 18 clc CLC ; clear carry
.c166 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c168 69 ff adc #$ff ADC #$FF ; -1
.c16a 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c16c a5 7a lda $7a LDA Smemh ; get start of mem high byte
.c16e 69 ff adc #$ff ADC #$FF ; -1+carry
.c170 85 c4 sta $c4 STA Bpntrh ; save BASIC execute pointer high byte
.c172 lab_147a
.c172 a5 85 lda $85 LDA Ememl ; get end of mem low byte
.c174 a4 86 ldy $86 LDY Ememh ; get end of mem high byte
.c176 85 81 sta $81 STA Sstorl ; set bottom of string space low byte
.c178 84 82 sty $82 STY Sstorh ; set bottom of string space high byte
.c17a a5 7b lda $7b LDA Svarl ; get start of vars low byte
.c17c a4 7c ldy $7c LDY Svarh ; get start of vars high byte
.c17e 85 7d sta $7d STA Sarryl ; save var mem end low byte
.c180 84 7e sty $7e STY Sarryh ; save var mem end high byte
.c182 85 7f sta $7f STA Earryl ; save array mem end low byte
.c184 84 80 sty $80 STY Earryh ; save array mem end high byte
.c186 20 44 c3 jsr $c344 JSR LAB_161A ; perform RESTORE command
.c189 lab_1491
.c189 a2 68 ldx #$68 LDX #des_sk ; set descriptor stack pointer
.c18b 86 65 stx $65 STX next_s ; save descriptor stack pointer
.c18d 68 pla PLA ; pull return address low byte
.c18e aa tax TAX ; copy return address low byte
.c18f 68 pla PLA ; pull return address high byte
.c190 8e fe 01 stx $01fe STX LAB_SKFE ; save to cleared stack
.c193 8d ff 01 sta $01ff STA LAB_SKFF ; save to cleared stack
.c196 a2 fd ldx #$fd LDX #$FD ; new stack pointer
.c198 9a txs TXS ; reset stack
.c199 a9 00 lda #$00 LDA #$00 ; clear byte
.c19b 85 8c sta $8c STA Cpntrh ; clear continue pointer high byte
.c19d 85 61 sta $61 STA Sufnxf ; clear subscript/FNX flag
.c19f lab_14a6
.c19f 60 rts RTS
.c1a0 lab_clear
.c1a0 f0 d0 beq $c172 BEQ LAB_147A ; if no following token go do "CLEAR"
.c1a2 60 rts RTS
.c1a3 lab_list
.c1a3 90 06 bcc $c1ab BCC LAB_14BD ; branch if next character numeric (LIST n..)
.c1a5 f0 04 beq $c1ab BEQ LAB_14BD ; branch if next character [NULL] (LIST)
.c1a7 c9 b8 cmp #$b8 CMP #TK_MINUS ; compare with token for -
.c1a9 d0 f4 bne $c19f BNE LAB_14A6 ; exit if not - (LIST -m)
.c1ab lab_14bd
.c1ab 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.c1ae 20 24 c1 jsr $c124 JSR LAB_SSLN ; search BASIC for temp integer line number
.c1b1 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c1b4 f0 0c beq $c1c2 BEQ LAB_14D4 ; branch if no more characters
.c1b6 c9 b8 cmp #$b8 CMP #TK_MINUS ; compare with token for -
.c1b8 d0 93 bne $c14d BNE LAB_1460 ; return if not "-" (will be Syntax error)
.c1ba 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c1bd 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.c1c0 d0 8b bne $c14d BNE LAB_1460 ; exit if not ok
.c1c2 lab_14d4
.c1c2 a5 11 lda $11 LDA Itempl ; get temporary integer low byte
.c1c4 05 12 ora $12 ORA Itemph ; OR temporary integer high byte
.c1c6 d0 06 bne $c1ce BNE LAB_14E2 ; branch if start set
.c1c8 a9 ff lda #$ff LDA #$FF ; set for -1
.c1ca 85 11 sta $11 STA Itempl ; set temporary integer low byte
.c1cc 85 12 sta $12 STA Itemph ; set temporary integer high byte
.c1ce lab_14e2
.c1ce a0 01 ldy #$01 LDY #$01 ; set index for line
.c1d0 84 60 sty $60 STY Oquote ; clear open quote flag
.c1d2 20 92 c6 jsr $c692 JSR LAB_CRLF ; print CR/LF
.c1d5 b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer high byte
.c1d7 f0 3e beq $c217 BEQ LAB_152B ; if null all done so exit
.c1d9 20 14 c3 jsr $c314 JSR LAB_1629 ; do CRTL-C check vector
.c1dc c8 iny INY ; increment index for line
.c1dd b1 aa lda ($aa),y LDA (Baslnl),Y ; get line # low byte
.c1df aa tax TAX ; copy to X
.c1e0 c8 iny INY ; increment index
.c1e1 b1 aa lda ($aa),y LDA (Baslnl),Y ; get line # high byte
.c1e3 c5 12 cmp $12 CMP Itemph ; compare with temporary integer high byte
.c1e5 d0 04 bne $c1eb BNE LAB_14FF ; branch if no high byte match
.c1e7 e4 11 cpx $11 CPX Itempl ; compare with temporary integer low byte
.c1e9 f0 02 beq $c1ed BEQ LAB_1501 ; branch if = last line to do (< will pass next branch)
.c1eb lab_14ff
.c1eb b0 2a bcs $c217 BCS LAB_152B ; if greater all done so exit
.c1ed lab_1501
.c1ed 84 97 sty $97 STY Tidx1 ; save index for line
.c1ef 20 82 d8 jsr $d882 JSR LAB_295E ; print XA as unsigned integer
.c1f2 a9 20 lda #$20 LDA #$20 ; space is the next character
.c1f4 lab_1508
.c1f4 a4 97 ldy $97 LDY Tidx1 ; get index for line
.c1f6 29 7f and #$7f AND #$7F ; mask top out bit of character
.c1f8 lab_150c
.c1f8 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c1fb c9 22 cmp #$22 CMP #$22 ; was it " character
.c1fd d0 06 bne $c205 BNE LAB_1519 ; branch if not
.c1ff a5 60 lda $60 LDA Oquote ; get open quote flag
.c201 49 ff eor #$ff EOR #$FF ; toggle it
.c203 85 60 sta $60 STA Oquote ; save it back
.c205 lab_1519
.c205 c8 iny INY ; increment index
.c206 b1 aa lda ($aa),y LDA (Baslnl),Y ; get next byte
.c208 d0 0e bne $c218 BNE LAB_152E ; branch if not [EOL] (go print character)
.c20a a8 tay TAY ; else clear index
.c20b b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer low byte
.c20d aa tax TAX ; copy to X
.c20e c8 iny INY ; increment index
.c20f b1 aa lda ($aa),y LDA (Baslnl),Y ; get next line pointer high byte
.c211 86 aa stx $aa STX Baslnl ; set pointer to line low byte
.c213 85 ab sta $ab STA Baslnh ; set pointer to line high byte
.c215 d0 b7 bne $c1ce BNE LAB_14E2 ; go do next line if not [EOT]
.c217 lab_152b
.c217 60 rts RTS
.c218 lab_152e
.c218 10 de bpl $c1f8 BPL LAB_150C ; just go print it if not token byte
.c21a 24 60 bit $60 BIT Oquote ; test the open quote flag
.c21c 30 da bmi $c1f8 BMI LAB_150C ; just go print character if open quote set
.c21e a2 e3 ldx #$e3 LDX #>LAB_KEYT ; get table address high byte
.c220 0a asl ASL ; *2
.c221 0a asl ASL ; *4
.c222 90 02 bcc $c226 BCC LAB_152F ; branch if no carry
.c224 e8 inx INX ; else increment high byte
.c225 18 clc CLC ; clear carry for add
.c226 lab_152f
.c226 69 16 adc #$16 ADC #<LAB_KEYT ; add low byte
.c228 90 01 bcc $c22b BCC LAB_1530 ; branch if no carry
.c22a e8 inx INX ; else increment high byte
.c22b lab_1530
.c22b 85 73 sta $73 STA ut2_pl ; save table pointer low byte
.c22d 86 74 stx $74 STX ut2_ph ; save table pointer high byte
.c22f 84 97 sty $97 STY Tidx1 ; save index for line
.c231 a0 00 ldy #$00 LDY #$00 ; clear index
.c233 b1 73 lda ($73),y LDA (ut2_pl),Y ; get length
.c235 aa tax TAX ; copy length
.c236 c8 iny INY ; increment index
.c237 b1 73 lda ($73),y LDA (ut2_pl),Y ; get 1st character
.c239 ca dex DEX ; decrement length
.c23a f0 b8 beq $c1f4 BEQ LAB_1508 ; if no more characters exit and print
.c23c 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c23f c8 iny INY ; increment index
.c240 b1 73 lda ($73),y LDA (ut2_pl),Y ; get keyword address low byte
.c242 48 pha PHA ; save it for now
.c243 c8 iny INY ; increment index
.c244 b1 73 lda ($73),y LDA (ut2_pl),Y ; get keyword address high byte
.c246 a0 00 ldy #$00 LDY #$00
.c248 85 74 sta $74 STA ut2_ph ; save keyword pointer high byte
.c24a 68 pla PLA ; pull low byte
.c24b 85 73 sta $73 STA ut2_pl ; save keyword pointer low byte
.c24d lab_1540
.c24d b1 73 lda ($73),y LDA (ut2_pl),Y ; get character
.c24f ca dex DEX ; decrement character count
.c250 f0 a2 beq $c1f4 BEQ LAB_1508 ; if last character exit and print
.c252 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c255 c8 iny INY ; increment index
.c256 d0 f5 bne $c24d BNE LAB_1540 ; loop for next character
.c258 lab_for
.c258 a9 80 lda #$80 LDA #$80 ; set FNX
.c25a 85 61 sta $61 STA Sufnxf ; set subscript/FNX flag
.c25c 20 b4 c5 jsr $c5b4 JSR LAB_LET ; go do LET
.c25f 68 pla PLA ; pull return address
.c260 68 pla PLA ; pull return address
.c261 a9 10 lda #$10 LDA #$10 ; we need 16d bytes !
.c263 20 03 bf jsr $bf03 JSR LAB_1212 ; check room on stack for A bytes
.c266 20 9d c4 jsr $c49d JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
.c269 18 clc CLC ; clear carry for add
.c26a 98 tya TYA ; copy index to A
.c26b 65 c3 adc $c3 ADC Bpntrl ; add BASIC execute pointer low byte
.c26d 48 pha PHA ; push onto stack
.c26e a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.c270 69 00 adc #$00 ADC #$00 ; add carry
.c272 48 pha PHA ; push onto stack
.c273 a5 88 lda $88 LDA Clineh ; get current line high byte
.c275 48 pha PHA ; push onto stack
.c276 a5 87 lda $87 LDA Clinel ; get current line low byte
.c278 48 pha PHA ; push onto stack
.c279 a9 ae lda #$ae LDA #TK_TO ; get "TO" token
.c27b 20 f1 c9 jsr $c9f1 JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start
.c27e 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.c281 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.c284 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.c286 09 7f ora #$7f ORA #$7F ; set all non sign bits
.c288 25 ad and $ad AND FAC1_1 ; and FAC1 mantissa1
.c28a 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.c28c a9 97 lda #$97 LDA #<LAB_159F ; set return address low byte
.c28e a0 c2 ldy #$c2 LDY #>LAB_159F ; set return address high byte
.c290 85 71 sta $71 STA ut1_pl ; save return address low byte
.c292 84 72 sty $72 STY ut1_ph ; save return address high byte
.c294 4c 84 c9 jmp $c984 JMP LAB_1B66 ; round FAC1 and put on stack (returns to next instruction)
.c297 lab_159f
.c297 a9 e0 lda #$e0 LDA #<LAB_259C ; set 1 pointer low addr (default step size)
.c299 a0 df ldy #$df LDY #>LAB_259C ; set 1 pointer high addr
.c29b 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (AY) into FAC1
.c29e 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c2a1 c9 b3 cmp #$b3 CMP #TK_STEP ; compare with STEP token
.c2a3 d0 06 bne $c2ab BNE LAB_15B3 ; jump if not "STEP"
.c2a5 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c2a8 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.c2ab lab_15b3
.c2ab 20 e9 d6 jsr $d6e9 JSR LAB_27CA ; return A=FF,C=1/-ve A=01,C=0/+ve
.c2ae 85 b0 sta $b0 STA FAC1_s ; set FAC1 sign (b7)
.c2b0 20 79 c9 jsr $c979 JSR LAB_1B5B ; push sign, round FAC1 and put on stack
.c2b3 a5 98 lda $98 LDA Frnxth ; get var pointer for FOR/NEXT high byte
.c2b5 48 pha PHA ; push on stack
.c2b6 a5 97 lda $97 LDA Frnxtl ; get var pointer for FOR/NEXT low byte
.c2b8 48 pha PHA ; push on stack
.c2b9 a9 81 lda #$81 LDA #TK_FOR ; get FOR token
.c2bb 48 pha PHA ; push on stack
.c2bc lab_15c2
.c2bc 20 14 c3 jsr $c314 JSR LAB_1629 ; do CRTL-C check vector
.c2bf a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c2c1 a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte
.c2c3 a6 88 ldx $88 LDX Clineh ; continue line is $FFxx for immediate mode
.c2c5 e8 inx INX ; increment it (now $00 if immediate mode)
.c2c6 f0 04 beq $c2cc BEQ LAB_15D1 ; branch if null (immediate mode)
.c2c8 85 8b sta $8b STA Cpntrl ; save continue pointer low byte
.c2ca 84 8c sty $8c STY Cpntrh ; save continue pointer high byte
.c2cc lab_15d1
.c2cc a0 00 ldy #$00 LDY #$00 ; clear index
.c2ce b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next byte
.c2d0 f0 07 beq $c2d9 BEQ LAB_15DC ; branch if null [EOL]
.c2d2 c9 3a cmp #$3a CMP #":" ; compare with ":"
.c2d4 f0 1d beq $c2f3 BEQ LAB_15F6 ; branch if = (statement separator)
.c2d6 lab_15d9
.c2d6 4c 02 ca jmp $ca02 JMP LAB_SNER ; else syntax error then warm start
.c2d9 lab_15dc
.c2d9 a0 02 ldy #$02 LDY #$02 ; set index
.c2db b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next line pointer high byte
.c2dd 18 clc CLC ; clear carry for no "BREAK" message
.c2de f0 56 beq $c336 BEQ LAB_1651 ; if null go to immediate mode (was immediate or [EOT]
.c2e0 c8 iny INY ; increment index
.c2e1 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get line # low byte
.c2e3 85 87 sta $87 STA Clinel ; save current line low byte
.c2e5 c8 iny INY ; increment index
.c2e6 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get line # high byte
.c2e8 85 88 sta $88 STA Clineh ; save current line high byte
.c2ea 98 tya TYA ; A now = 4
.c2eb 65 c3 adc $c3 ADC Bpntrl ; add BASIC execute pointer low byte
.c2ed 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c2ef 90 02 bcc $c2f3 BCC LAB_15F6 ; branch if no overflow
.c2f1 e6 c4 inc $c4 INC Bpntrh ; else increment BASIC execute pointer high byte
.c2f3 lab_15f6
.c2f3 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c2f6 lab_15f9
.c2f6 20 fc c2 jsr $c2fc JSR LAB_15FF ; go interpret BASIC code from (Bpntrl)
.c2f9 lab_15fc
.c2f9 4c bc c2 jmp $c2bc JMP LAB_15C2 ; loop
.c2fc lab_15ff
.c2fc f0 54 beq $c352 BEQ LAB_1628 ; exit if zero [EOL]
.c2fe lab_1602
.c2fe 0a asl ASL ; *2 bytes per vector and normalise token
.c2ff b0 03 bcs $c304 BCS LAB_1609 ; branch if was token
.c301 4c b4 c5 jmp $c5b4 JMP LAB_LET ; else go do implied LET
.c304 lab_1609
.c304 c9 58 cmp #$58 CMP #(TK_TAB-$80)*2 ; compare normalised token * 2 with TAB
.c306 b0 ce bcs $c2d6 BCS LAB_15D9 ; branch if A>=TAB (do syntax error then warm start)
.c308 a8 tay TAY ; copy to index
.c309 b9 08 e0 lda $e008,y LDA LAB_CTBL+1,Y ; get vector high byte
.c30c 48 pha PHA ; onto stack
.c30d b9 07 e0 lda $e007,y LDA LAB_CTBL,Y ; get vector low byte
.c310 48 pha PHA ; onto stack
.c311 4c bc 00 jmp $00bc JMP LAB_IGBY ; jump to increment and scan memory
.c314 lab_1629
.c314 6c 03 04 jmp ($0403) JMP (VEC_CC) ; ctrl c check vector
.c317 lab_1636
.c317 c9 03 cmp #$03 CMP #$03 ; compare with CTRL-C
.c319 lab_stop
.c319 b0 01 bcs $c31c BCS LAB_163B ; branch if token follows STOP
.c31b lab_end
.c31b 18 clc CLC ; clear the carry, indicate a normal program end
.c31c lab_163b
.c31c d0 67 bne $c385 BNE LAB_167A ; if wasn't CTRL-C or there is a following byte return
.c31e a5 c4 lda $c4 LDA Bpntrh ; get the BASIC execute pointer high byte
.c320 49 04 eor #$04 EOR #>Ibuffs ; compare with buffer address high byte (Cb unchanged)
.c322 f0 10 beq $c334 BEQ LAB_164F ; branch if the BASIC pointer is in the input buffer
.c324 49 04 eor #$04 EOR #>Ibuffs ; correct the bits
.c326 a4 c3 ldy $c3 LDY Bpntrl ; get BASIC execute pointer low byte
.c328 84 8b sty $8b STY Cpntrl ; save continue pointer low byte
.c32a 85 8c sta $8c STA Cpntrh ; save continue pointer high byte
.c32c lab_1647
.c32c a5 87 lda $87 LDA Clinel ; get current line low byte
.c32e a4 88 ldy $88 LDY Clineh ; get current line high byte
.c330 85 89 sta $89 STA Blinel ; save break line low byte
.c332 84 8a sty $8a STY Blineh ; save break line high byte
.c334 lab_164f
.c334 68 pla PLA ; pull return address low
.c335 68 pla PLA ; pull return address high
.c336 lab_1651
.c336 90 07 bcc $c33f BCC LAB_165E ; if was program end just do warm start
.c338 a9 e7 lda #$e7 LDA #<LAB_BMSG ; point to "Break" low byte
.c33a a0 e5 ldy #$e5 LDY #>LAB_BMSG ; point to "Break" high byte
.c33c 4c 4f bf jmp $bf4f JMP LAB_1269 ; print "Break" and do warm start
.c33f lab_165e
.c33f 4c 5a bf jmp $bf5a JMP LAB_1274 ; go do warm start
.c342 lab_restore
.c342 d0 0f bne $c353 BNE LAB_RESTOREn ; branch if next character not null (RESTORE n)
.c344 lab_161a
.c344 38 sec SEC ; set carry for subtract
.c345 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c347 e9 01 sbc #$01 SBC #$01 ; -1
.c349 a4 7a ldy $7a LDY Smemh ; get start of mem high byte
.c34b b0 01 bcs $c34e BCS LAB_1624 ; branch if no underflow
.c34d lab_uflow
.c34d 88 dey DEY ; else decrement high byte
.c34e lab_1624
.c34e 85 8f sta $8f STA Dptrl ; save DATA pointer low byte
.c350 84 90 sty $90 STY Dptrh ; save DATA pointer high byte
.c352 lab_1628
.c352 60 rts RTS
.c353 lab_restoren
.c353 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.c356 20 a0 c4 jsr $c4a0 JSR LAB_SNBL ; scan for next BASIC line
.c359 a5 88 lda $88 LDA Clineh ; get current line high byte
.c35b c5 12 cmp $12 CMP Itemph ; compare with temporary integer high byte
.c35d b0 0b bcs $c36a BCS LAB_reset_search ; branch if >= (start search from beginning)
.c35f 98 tya TYA ; else copy line index to A
.c360 38 sec SEC ; set carry (+1)
.c361 65 c3 adc $c3 ADC Bpntrl ; add BASIC execute pointer low byte
.c363 a6 c4 ldx $c4 LDX Bpntrh ; get BASIC execute pointer high byte
.c365 90 07 bcc $c36e BCC LAB_go_search ; branch if no overflow to high byte
.c367 e8 inx INX ; increment high byte
.c368 b0 04 bcs $c36e BCS LAB_go_search ; branch always (can never be carry clear)
.c36a lab_reset_search
.c36a a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c36c a6 7a ldx $7a LDX Smemh ; get start of mem high byte
.c36e lab_go_search
.c36e 20 28 c1 jsr $c128 JSR LAB_SHLN ; search Basic for temp integer line number from AX
.c371 b0 03 bcs $c376 BCS LAB_line_found ; if carry set go set pointer
.c373 4c 72 c4 jmp $c472 JMP LAB_16F7 ; else go do "Undefined statement" error
.c376 lab_line_found
.c376 a5 aa lda $aa LDA Baslnl ; get pointer low byte
.c378 e9 01 sbc #$01 SBC #$01 ; -1
.c37a a4 ab ldy $ab LDY Baslnh ; get pointer high byte
.c37c b0 d0 bcs $c34e BCS LAB_1624 ; branch if no underflow (save DATA pointer and return)
.c37e 90 cd bcc $c34d BCC LAB_uflow ; else decrement high byte then save DATA pointer and
.c380 lab_null
.c380 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter
.c383 86 0d stx $0d STX Nullct ; save new NULL count
.c385 lab_167a
.c385 60 rts RTS
.c386 lab_cont
.c386 d0 fd bne $c385 BNE LAB_167A ; if following byte exit to do syntax error
.c388 a4 8c ldy $8c LDY Cpntrh ; get continue pointer high byte
.c38a d0 05 bne $c391 BNE LAB_166C ; go do continue if we can
.c38c a2 1e ldx #$1e LDX #$1E ; error code $1E ("Can't continue" error)
.c38e 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.c391 lab_166c
.c391 a9 93 lda #$93 LDA #TK_ON ; set token for ON
.c393 20 14 dd jsr $dd14 JSR LAB_IRQ ; set IRQ flags
.c396 a9 93 lda #$93 LDA #TK_ON ; set token for ON
.c398 20 17 dd jsr $dd17 JSR LAB_NMI ; set NMI flags
.c39b 84 c4 sty $c4 STY Bpntrh ; save BASIC execute pointer high byte
.c39d a5 8b lda $8b LDA Cpntrl ; get continue pointer low byte
.c39f 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c3a1 a5 89 lda $89 LDA Blinel ; get break line low byte
.c3a3 a4 8a ldy $8a LDY Blineh ; get break line high byte
.c3a5 85 87 sta $87 STA Clinel ; set current line low byte
.c3a7 84 88 sty $88 STY Clineh ; set current line high byte
.c3a9 60 rts RTS
.c3aa lab_run
.c3aa d0 03 bne $c3af BNE LAB_1696 ; branch if RUN n
.c3ac 4c 65 c1 jmp $c165 JMP LAB_1477 ; reset execution to start, clear variables, flush stack and
.c3af lab_1696
.c3af 20 72 c1 jsr $c172 JSR LAB_147A ; go do "CLEAR"
.c3b2 f0 2e beq $c3e2 BEQ LAB_16B0 ; get n and do GOTO n (branch always as CLEAR sets Z=1)
.c3b4 lab_do
.c3b4 a9 05 lda #$05 LDA #$05 ; need 5 bytes for DO
.c3b6 20 03 bf jsr $bf03 JSR LAB_1212 ; check room on stack for A bytes
.c3b9 a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.c3bb 48 pha PHA ; push on stack
.c3bc a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c3be 48 pha PHA ; push on stack
.c3bf a5 88 lda $88 LDA Clineh ; get current line high byte
.c3c1 48 pha PHA ; push on stack
.c3c2 a5 87 lda $87 LDA Clinel ; get current line low byte
.c3c4 48 pha PHA ; push on stack
.c3c5 a9 9d lda #$9d LDA #TK_DO ; token for DO
.c3c7 48 pha PHA ; push on stack
.c3c8 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c3cb 4c bc c2 jmp $c2bc JMP LAB_15C2 ; go do interpreter inner loop
.c3ce lab_gosub
.c3ce a9 05 lda #$05 LDA #$05 ; need 5 bytes for GOSUB
.c3d0 20 03 bf jsr $bf03 JSR LAB_1212 ; check room on stack for A bytes
.c3d3 a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.c3d5 48 pha PHA ; push on stack
.c3d6 a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c3d8 48 pha PHA ; push on stack
.c3d9 a5 88 lda $88 LDA Clineh ; get current line high byte
.c3db 48 pha PHA ; push on stack
.c3dc a5 87 lda $87 LDA Clinel ; get current line low byte
.c3de 48 pha PHA ; push on stack
.c3df a9 8d lda #$8d LDA #TK_GOSUB ; token for GOSUB
.c3e1 48 pha PHA ; push on stack
.c3e2 lab_16b0
.c3e2 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c3e5 20 eb c3 jsr $c3eb JSR LAB_GOTO ; perform GOTO n
.c3e8 4c bc c2 jmp $c2bc JMP LAB_15C2 ; go do interpreter inner loop
.c3eb lab_goto
.c3eb 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.c3ee 20 a0 c4 jsr $c4a0 JSR LAB_SNBL ; scan for next BASIC line
.c3f1 a5 88 lda $88 LDA Clineh ; get current line high byte
.c3f3 c5 12 cmp $12 CMP Itemph ; compare with temporary integer high byte
.c3f5 b0 0b bcs $c402 BCS LAB_16D0 ; branch if >= (start search from beginning)
.c3f7 98 tya TYA ; else copy line index to A
.c3f8 38 sec SEC ; set carry (+1)
.c3f9 65 c3 adc $c3 ADC Bpntrl ; add BASIC execute pointer low byte
.c3fb a6 c4 ldx $c4 LDX Bpntrh ; get BASIC execute pointer high byte
.c3fd 90 07 bcc $c406 BCC LAB_16D4 ; branch if no overflow to high byte
.c3ff e8 inx INX ; increment high byte
.c400 b0 04 bcs $c406 BCS LAB_16D4 ; branch always (can never be carry)
.c402 lab_16d0
.c402 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.c404 a6 7a ldx $7a LDX Smemh ; get start of mem high byte
.c406 lab_16d4
.c406 20 28 c1 jsr $c128 JSR LAB_SHLN ; search Basic for temp integer line number from AX
.c409 90 67 bcc $c472 BCC LAB_16F7 ; if carry clear go do "Undefined statement" error
.c40b a5 aa lda $aa LDA Baslnl ; get pointer low byte
.c40d e9 01 sbc #$01 SBC #$01 ; -1
.c40f 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c411 a5 ab lda $ab LDA Baslnh ; get pointer high byte
.c413 e9 00 sbc #$00 SBC #$00 ; subtract carry
.c415 85 c4 sta $c4 STA Bpntrh ; save BASIC execute pointer high byte
.c417 lab_16e5
.c417 60 rts RTS
.c418 lab_donok
.c418 a2 22 ldx #$22 LDX #$22 ; error code $22 ("LOOP without DO" error)
.c41a 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.c41d lab_loop
.c41d a8 tay TAY ; save following token
.c41e ba tsx TSX ; copy stack pointer
.c41f bd 03 01 lda $0103,x LDA LAB_STAK+3,X ; get token byte from stack
.c422 c9 9d cmp #$9d CMP #TK_DO ; compare with DO token
.c424 d0 f2 bne $c418 BNE LAB_DONOK ; branch if no matching DO
.c426 e8 inx INX ; dump calling routine return address
.c427 e8 inx INX ; dump calling routine return address
.c428 9a txs TXS ; correct stack
.c429 98 tya TYA ; get saved following token back
.c42a f0 20 beq $c44c BEQ LoopAlways ; if no following token loop forever
.c42c c9 3a cmp #$3a CMP #":" ; could be ":"
.c42e f0 1c beq $c44c BEQ LoopAlways ; if :... loop forever
.c430 e9 b4 sbc #$b4 SBC #TK_UNTIL ; subtract token for UNTIL, we know carry is set here
.c432 aa tax TAX ; copy to X (if it was UNTIL then Y will be correct)
.c433 f0 04 beq $c439 BEQ DoRest ; branch if was UNTIL
.c435 ca dex DEX ; decrement result
.c436 d0 62 bne $c49a BNE LAB_16FC ; if not WHILE go do syntax error and warm start
.c438 ca dex DEX ; set invert result byte
.c439 dorest
.c439 86 98 stx $98 STX Frnxth ; save invert result byte
.c43b 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c43e 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate expression
.c441 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.c443 f0 02 beq $c447 BEQ DoCmp ; if =0 go do straight compare
.c445 a9 ff lda #$ff LDA #$FF ; else set all bits
.c447 docmp
.c447 ba tsx TSX ; copy stack pointer
.c448 45 98 eor $98 EOR Frnxth ; EOR with invert byte
.c44a d0 1a bne $c466 BNE LoopDone ; if <> 0 clear stack and back to interpreter loop
.c44c loopalways
.c44c bd 02 01 lda $0102,x LDA LAB_STAK+2,X ; get current line low byte
.c44f 85 87 sta $87 STA Clinel ; save current line low byte
.c451 bd 03 01 lda $0103,x LDA LAB_STAK+3,X ; get current line high byte
.c454 85 88 sta $88 STA Clineh ; save current line high byte
.c456 bd 04 01 lda $0104,x LDA LAB_STAK+4,X ; get BASIC execute pointer low byte
.c459 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c45b bd 05 01 lda $0105,x LDA LAB_STAK+5,X ; get BASIC execute pointer high byte
.c45e 85 c4 sta $c4 STA Bpntrh ; save BASIC execute pointer high byte
.c460 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c463 4c bc c2 jmp $c2bc JMP LAB_15C2 ; go do interpreter inner loop
.c466 loopdone
.c466 e8 inx INX ; dump DO token
.c467 e8 inx INX ; dump current line low byte
.c468 e8 inx INX ; dump current line high byte
.c469 e8 inx INX ; dump BASIC execute pointer low byte
.c46a e8 inx INX ; dump BASIC execute pointer high byte
.c46b 9a txs TXS ; correct stack
.c46c 4c 8c c4 jmp $c48c JMP LAB_DATA ; go perform DATA (find : or [EOL])
.c46f lab_16f4
.c46f a2 04 ldx #$04 LDX #$04 ; error code $04 ("RETURN without GOSUB" error)
>c471 2c .byte $2C ; makes next line BIT LAB_0EA2
.c472 lab_16f7
.c472 a2 0e ldx #$0e LDX #$0E ; error code $0E ("Undefined statement" error)
.c474 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.c477 lab_return
.c477 d0 9e bne $c417 BNE LAB_16E5 ; exit if following token (to allow syntax error)
.c479 lab_16e8
.c479 68 pla PLA ; dump calling routine return address
.c47a 68 pla PLA ; dump calling routine return address
.c47b 68 pla PLA ; pull token
.c47c c9 8d cmp #$8d CMP #TK_GOSUB ; compare with GOSUB token
.c47e d0 ef bne $c46f BNE LAB_16F4 ; branch if no matching GOSUB
.c480 lab_16ff
.c480 68 pla PLA ; pull current line low byte
.c481 85 87 sta $87 STA Clinel ; save current line low byte
.c483 68 pla PLA ; pull current line high byte
.c484 85 88 sta $88 STA Clineh ; save current line high byte
.c486 68 pla PLA ; pull BASIC execute pointer low byte
.c487 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c489 68 pla PLA ; pull BASIC execute pointer high byte
.c48a 85 c4 sta $c4 STA Bpntrh ; save BASIC execute pointer high byte
.c48c lab_data
.c48c 20 9d c4 jsr $c49d JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
.c48f lab_170f
.c48f 98 tya TYA ; copy index to A
.c490 18 clc CLC ; clear carry for add
.c491 65 c3 adc $c3 ADC Bpntrl ; add BASIC execute pointer low byte
.c493 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c495 90 02 bcc $c499 BCC LAB_1719 ; skip next if no carry
.c497 e6 c4 inc $c4 INC Bpntrh ; else increment BASIC execute pointer high byte
.c499 lab_1719
.c499 60 rts RTS
.c49a lab_16fc
.c49a 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.c49d lab_snbs
.c49d a2 3a ldx #$3a LDX #":" ; set look for character = ":"
>c49f 2c .byte $2C ; makes next line BIT $00A2
.c4a0 lab_snbl
.c4a0 a2 00 ldx #$00 LDX #$00 ; set alt search character = [EOL]
.c4a2 a0 00 ldy #$00 LDY #$00 ; set search character = [EOL]
.c4a4 84 5c sty $5c STY Asrch ; store search character
.c4a6 lab_1725
.c4a6 8a txa TXA ; get alt search character
.c4a7 45 5c eor $5c EOR Asrch ; toggle search character, effectively swap with $00
.c4a9 85 5c sta $5c STA Asrch ; save swapped search character
.c4ab lab_172d
.c4ab b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next byte
.c4ad f0 ea beq $c499 BEQ LAB_1719 ; exit if null [EOL]
.c4af c5 5c cmp $5c CMP Asrch ; compare with search character
.c4b1 f0 e6 beq $c499 BEQ LAB_1719 ; exit if found
.c4b3 c8 iny INY ; increment index
.c4b4 c9 22 cmp #$22 CMP #$22 ; compare current character with open quote
.c4b6 d0 f3 bne $c4ab BNE LAB_172D ; if not open quote go get next character
.c4b8 f0 ec beq $c4a6 BEQ LAB_1725 ; if found go swap search character for alt search character
.c4ba lab_if
.c4ba 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate the expression
.c4bd 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c4c0 c9 b1 cmp #$b1 CMP #TK_THEN ; compare with THEN token
.c4c2 f0 11 beq $c4d5 BEQ LAB_174B ; if it was THEN go do IF
.c4c4 c9 89 cmp #$89 CMP #TK_GOTO ; compare with GOTO token
.c4c6 d0 d2 bne $c49a BNE LAB_16FC ; if it wasn't GOTO go do syntax error
.c4c8 a6 c3 ldx $c3 LDX Bpntrl ; save the basic pointer low byte
.c4ca a4 c4 ldy $c4 LDY Bpntrh ; save the basic pointer high byte
.c4cc 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c4cf b0 c9 bcs $c49a BCS LAB_16FC ; if not numeric go do syntax error
.c4d1 86 c3 stx $c3 STX Bpntrl ; restore the basic pointer low byte
.c4d3 84 c4 sty $c4 STY Bpntrh ; restore the basic pointer high byte
.c4d5 lab_174b
.c4d5 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.c4d7 f0 1b beq $c4f4 BEQ LAB_174E ; if the result was zero go look for an ELSE
.c4d9 20 bc 00 jsr $00bc JSR LAB_IGBY ; else increment and scan memory
.c4dc b0 03 bcs $c4e1 BCS LAB_174D ; if not numeric go do var or keyword
.c4de lab_174c
.c4de 4c eb c3 jmp $c3eb JMP LAB_GOTO ; else was numeric so do GOTO n
.c4e1 lab_174d
.c4e1 c9 90 cmp #$90 CMP #TK_RETURN ; compare the byte with the token for RETURN
.c4e3 d0 03 bne $c4e8 BNE LAB_174G ; if it wasn't RETURN go interpret BASIC code from (Bpntrl)
.c4e5 4c fe c2 jmp $c2fe JMP LAB_1602 ; else it was RETURN so interpret BASIC code from (Bpntrl)
.c4e8 lab_174g
.c4e8 20 fc c2 jsr $c2fc JSR LAB_15FF ; interpret BASIC code from (Bpntrl)
.c4eb a0 00 ldy #$00 LDY #$00 ; clear the index
.c4ed b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get the next BASIC byte
.c4ef c9 ad cmp #$ad CMP #TK_ELSE ; compare it with the token for ELSE
.c4f1 f0 99 beq $c48c BEQ LAB_DATA ; if ELSE ignore the following statement
.c4f3 60 rts RTS ; else return to the interpreter inner loop
.c4f4 lab_174e
.c4f4 a0 00 ldy #$00 LDY #$00 ; clear the BASIC byte index
.c4f6 a2 01 ldx #$01 LDX #$01 ; clear the nesting depth
.c4f8 lab_1750
.c4f8 c8 iny INY ; increment the BASIC byte index
.c4f9 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get the next BASIC byte
.c4fb f0 0f beq $c50c BEQ LAB_1753 ; if EOL go add the pointer and return
.c4fd c9 8b cmp #$8b CMP #TK_IF ; compare the byte with the token for IF
.c4ff d0 03 bne $c504 BNE LAB_1752 ; if not IF token skip the depth increment
.c501 e8 inx INX ; else increment the nesting depth ..
.c502 d0 f4 bne $c4f8 BNE LAB_1750 ; .. and continue looking
.c504 lab_1752
.c504 c9 ad cmp #$ad CMP #TK_ELSE ; compare the byte with the token for ELSE
.c506 d0 f0 bne $c4f8 BNE LAB_1750 ; if not ELSE token continue looking
.c508 ca dex DEX ; was ELSE so decrement the nesting depth
.c509 d0 ed bne $c4f8 BNE LAB_1750 ; loop if still nested
.c50b c8 iny INY ; increment the BASIC byte index past the ELSE
.c50c lab_1753
.c50c 98 tya TYA ; else copy line index to A
.c50d 18 clc CLC ; clear carry for add
.c50e 65 c3 adc $c3 ADC Bpntrl ; add the BASIC execute pointer low byte
.c510 85 c3 sta $c3 STA Bpntrl ; save the BASIC execute pointer low byte
.c512 90 02 bcc $c516 BCC LAB_1754 ; branch if no overflow to high byte
.c514 e6 c4 inc $c4 INC Bpntrh ; else increment the BASIC execute pointer high byte
.c516 lab_1754
.c516 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c519 90 c3 bcc $c4de BCC LAB_174C ; if numeric do GOTO n
.c51b 4c fc c2 jmp $c2fc JMP LAB_15FF ; interpret BASIC code from (Bpntrl)
.c51e lab_rem
.c51e 20 a0 c4 jsr $c4a0 JSR LAB_SNBL ; scan for next BASIC line
.c521 4c 8f c4 jmp $c48f JMP LAB_170F ; go set BASIC execute pointer and return, branch always
.c524 lab_16fd
.c524 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.c527 lab_on
.c527 c9 a9 cmp #$a9 CMP #TK_IRQ ; was it IRQ token ?
.c529 d0 03 bne $c52e BNE LAB_NOIN ; if not go check NMI
.c52b 4c 38 dd jmp $dd38 JMP LAB_SIRQ ; else go set-up IRQ
.c52e lab_noin
.c52e c9 aa cmp #$aa CMP #TK_NMI ; was it NMI token ?
.c530 d0 03 bne $c535 BNE LAB_NONM ; if not go do normal ON command
.c532 4c 3c dd jmp $dd3c JMP LAB_SNMI ; else go set-up NMI
.c535 lab_nonm
.c535 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter
.c538 48 pha PHA ; push GOTO/GOSUB token
.c539 c9 8d cmp #$8d CMP #TK_GOSUB ; compare with GOSUB token
.c53b f0 04 beq $c541 BEQ LAB_176B ; branch if GOSUB
.c53d c9 89 cmp #$89 CMP #TK_GOTO ; compare with GOTO token
.c53f lab_1767
.c53f d0 e3 bne $c524 BNE LAB_16FD ; if not GOTO do syntax error then warm start
.c541 lab_176b
.c541 c6 af dec $af DEC FAC1_3 ; decrement index (byte value)
.c543 d0 04 bne $c549 BNE LAB_1773 ; branch if not zero
.c545 68 pla PLA ; pull GOTO/GOSUB token
.c546 4c fe c2 jmp $c2fe JMP LAB_1602 ; go execute it
.c549 lab_1773
.c549 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c54c 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer (skip this n)
.c54f c9 2c cmp #$2c CMP #$2C ; compare next character with ","
.c551 f0 ee beq $c541 BEQ LAB_176B ; loop if ","
.c553 lab_177e
.c553 68 pla PLA ; else pull keyword token (run out of options)
.c554 lab_177f
.c554 60 rts RTS
.c555 lab_gfpn
.c555 a2 00 ldx #$00 LDX #$00 ; clear reg
.c557 86 11 stx $11 STX Itempl ; clear temporary integer low byte
.c559 lab_1785
.c559 86 12 stx $12 STX Itemph ; save temporary integer high byte
.c55b b0 f7 bcs $c554 BCS LAB_177F ; return if carry set, end of scan, character was
.c55d e0 19 cpx #$19 CPX #$19 ; compare high byte with $19
.c55f a8 tay TAY ; ensure Zb = 0 if the branch is taken
.c560 b0 dd bcs $c53f BCS LAB_1767 ; branch if >=, makes max line # 63999 because next
.c562 e9 2f sbc #$2f SBC #"0"-1 ; subtract "0", $2F + carry, from byte
.c564 a8 tay TAY ; copy binary digit
.c565 a5 11 lda $11 LDA Itempl ; get temporary integer low byte
.c567 0a asl ASL ; *2 low byte
.c568 26 12 rol $12 ROL Itemph ; *2 high byte
.c56a 0a asl ASL ; *2 low byte
.c56b 26 12 rol $12 ROL Itemph ; *2 high byte, *4
.c56d 65 11 adc $11 ADC Itempl ; + low byte, *5
.c56f 85 11 sta $11 STA Itempl ; save it
.c571 8a txa TXA ; get high byte copy to A
.c572 65 12 adc $12 ADC Itemph ; + high byte, *5
.c574 06 11 asl $11 ASL Itempl ; *2 low byte, *10d
.c576 2a rol ROL ; *2 high byte, *10d
.c577 aa tax TAX ; copy high byte back to X
.c578 98 tya TYA ; get binary digit back
.c579 65 11 adc $11 ADC Itempl ; add number low byte
.c57b 85 11 sta $11 STA Itempl ; save number low byte
.c57d 90 01 bcc $c580 BCC LAB_17B3 ; if no overflow to high byte get next character
.c57f e8 inx INX ; else increment high byte
.c580 lab_17b3
.c580 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c583 4c 59 c5 jmp $c559 JMP LAB_1785 ; loop for next character
.c586 lab_dec
.c586 a9 e4 lda #$e4 LDA #<LAB_2AFD ; set -1 pointer low byte
>c588 2c .byte $2C ; BIT abs to skip the LDA below
.c589 lab_inc
.c589 a9 e0 lda #$e0 LDA #<LAB_259C ; set 1 pointer low byte
.c58b lab_17b5
.c58b 48 pha PHA ; save +/-1 pointer low byte
.c58c lab_17b7
.c58c 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var address
.c58f a6 5f ldx $5f LDX Dtypef ; get data type flag, $FF=string, $00=numeric
.c591 30 1e bmi $c5b1 BMI IncrErr ; exit if string
.c593 85 97 sta $97 STA Lvarpl ; save var address low byte
.c595 84 98 sty $98 STY Lvarph ; save var address high byte
.c597 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (AY) into FAC1
.c59a 68 pla PLA ; get +/-1 pointer low byte
.c59b 48 pha PHA ; save +/-1 pointer low byte
.c59c a0 df ldy #$df LDY #>LAB_259C ; set +/-1 pointer high byte (both the same)
.c59e 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1
.c5a1 20 a3 d6 jsr $d6a3 JSR LAB_PFAC ; pack FAC1 into variable (Lvarpl)
.c5a4 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c5a7 c9 2c cmp #$2c CMP #"," ; compare with ","
.c5a9 d0 a8 bne $c553 BNE LAB_177E ; exit if not "," (either end or error)
.c5ab 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c5ae 4c 8c c5 jmp $c58c JMP LAB_17B7 ; go do next var
.c5b1 increrr
.c5b1 4c dc c8 jmp $c8dc JMP LAB_1ABC ; do "Type mismatch" error then warm start
.c5b4 lab_let
.c5b4 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var address
.c5b7 85 97 sta $97 STA Lvarpl ; save var address low byte
.c5b9 84 98 sty $98 STY Lvarph ; save var address high byte
.c5bb a9 c2 lda #$c2 LDA #TK_EQUAL ; get = token
.c5bd 20 f1 c9 jsr $c9f1 JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
.c5c0 a5 5f lda $5f LDA Dtypef ; get data type flag, $FF=string, $00=numeric
.c5c2 48 pha PHA ; push data type flag
.c5c3 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate expression
.c5c6 68 pla PLA ; pop data type flag
.c5c7 2a rol ROL ; set carry if type = string
.c5c8 20 d3 c8 jsr $c8d3 JSR LAB_CKTM ; type match check, set C for string
.c5cb d0 03 bne $c5d0 BNE LAB_17D5 ; branch if string
.c5cd 4c a3 d6 jmp $d6a3 JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return
.c5d0 lab_17d5
.c5d0 a0 02 ldy #$02 LDY #$02 ; set index to pointer high byte
.c5d2 b1 ae lda ($ae),y LDA (des_pl),Y ; get string pointer high byte
.c5d4 c5 82 cmp $82 CMP Sstorh ; compare bottom of string space high byte
.c5d6 90 17 bcc $c5ef BCC LAB_17F4 ; if less assign value and exit (was in program memory)
.c5d8 d0 07 bne $c5e1 BNE LAB_17E6 ; branch if >
.c5da 88 dey DEY ; decrement index
.c5db b1 ae lda ($ae),y LDA (des_pl),Y ; get pointer low byte
.c5dd c5 81 cmp $81 CMP Sstorl ; compare bottom of string space low byte
.c5df 90 0e bcc $c5ef BCC LAB_17F4 ; if less assign value and exit (was in program memory)
.c5e1 lab_17e6
.c5e1 a4 af ldy $af LDY des_ph ; get descriptor pointer high byte
.c5e3 c4 7c cpy $7c CPY Svarh ; compare start of vars high byte
.c5e5 90 08 bcc $c5ef BCC LAB_17F4 ; branch if less (descriptor is on stack)
.c5e7 d0 0d bne $c5f6 BNE LAB_17FB ; branch if greater (descriptor is not on stack)
.c5e9 a5 ae lda $ae LDA des_pl ; get descriptor pointer low byte
.c5eb c5 7b cmp $7b CMP Svarl ; compare start of vars low byte
.c5ed b0 07 bcs $c5f6 BCS LAB_17FB ; branch if >= (descriptor is not on stack)
.c5ef lab_17f4
.c5ef a5 ae lda $ae LDA des_pl ; get descriptor pointer low byte
.c5f1 a4 af ldy $af LDY des_ph ; get descriptor pointer high byte
.c5f3 4c 0c c6 jmp $c60c JMP LAB_1811 ; clean stack, copy descriptor to variable and return
.c5f6 lab_17fb
.c5f6 a0 00 ldy #$00 LDY #$00 ; index to length
.c5f8 b1 ae lda ($ae),y LDA (des_pl),Y ; get string length
.c5fa 20 32 cf jsr $cf32 JSR LAB_209C ; copy string
.c5fd a5 9e lda $9e LDA des_2l ; get descriptor pointer low byte
.c5ff a4 9f ldy $9f LDY des_2h ; get descriptor pointer high byte
.c601 85 b8 sta $b8 STA ssptr_l ; save descriptor pointer low byte
.c603 84 b9 sty $b9 STY ssptr_h ; save descriptor pointer high byte
.c605 20 11 d1 jsr $d111 JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill)
.c608 a9 ac lda #$ac LDA #<FAC1_e ; set descriptor pointer low byte
.c60a a0 00 ldy #$00 LDY #>FAC1_e ; get descriptor pointer high byte
.c60c lab_1811
.c60c 85 9e sta $9e STA des_2l ; save descriptor_2 pointer low byte
.c60e 84 9f sty $9f STY des_2h ; save descriptor_2 pointer high byte
.c610 20 73 d1 jsr $d173 JSR LAB_22EB ; clean descriptor stack, YA = pointer
.c613 a0 00 ldy #$00 LDY #$00 ; index to length
.c615 b1 9e lda ($9e),y LDA (des_2l),Y ; get string length
.c617 91 97 sta ($97),y STA (Lvarpl),Y ; copy to let string variable
.c619 c8 iny INY ; index to string pointer low byte
.c61a b1 9e lda ($9e),y LDA (des_2l),Y ; get string pointer low byte
.c61c 91 97 sta ($97),y STA (Lvarpl),Y ; copy to let string variable
.c61e c8 iny INY ; index to string pointer high byte
.c61f b1 9e lda ($9e),y LDA (des_2l),Y ; get string pointer high byte
.c621 91 97 sta ($97),y STA (Lvarpl),Y ; copy to let string variable
.c623 60 rts RTS
.c624 lab_get
.c624 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var address
.c627 85 97 sta $97 STA Lvarpl ; save var address low byte
.c629 84 98 sty $98 STY Lvarph ; save var address high byte
.c62b 20 00 dd jsr $dd00 JSR INGET ; get input byte
.c62e a6 5f ldx $5f LDX Dtypef ; get data type flag, $FF=string, $00=numeric
.c630 30 07 bmi $c639 BMI LAB_GETS ; go get string character
.c632 a8 tay TAY ; copy character to Y
.c633 20 66 ce jsr $ce66 JSR LAB_1FD0 ; convert Y to byte in FAC1
.c636 4c a3 d6 jmp $d6a3 JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return
.c639 lab_gets
.c639 48 pha PHA ; save character
.c63a a9 01 lda #$01 LDA #$01 ; string is single byte
.c63c b0 01 bcs $c63f BCS LAB_IsByte ; branch if byte received
.c63e 68 pla PLA ; string is null
.c63f lab_isbyte
.c63f 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
.c642 f0 05 beq $c649 BEQ LAB_NoSt ; skip store if null string
.c644 68 pla PLA ; get character back
.c645 a0 00 ldy #$00 LDY #$00 ; clear index
.c647 91 ad sta ($ad),y STA (str_pl),Y ; save byte in string (byte IS string!)
.c649 lab_nost
.c649 20 85 cf jsr $cf85 JSR LAB_RTST ; check for space on descriptor stack then put address
.c64c 4c d0 c5 jmp $c5d0 JMP LAB_17D5 ; do string LET and return
.c64f lab_1829
.c64f 20 d6 c6 jsr $c6d6 JSR LAB_18C6 ; print string from Sutill/Sutilh
.c652 lab_182c
.c652 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c655 lab_print
.c655 f0 3b beq $c692 BEQ LAB_CRLF ; if nothing following just print CR/LF
.c657 lab_1831
.c657 c9 ac cmp #$ac CMP #TK_TAB ; compare with TAB( token
.c659 f0 56 beq $c6b1 BEQ LAB_18A2 ; go do TAB/SPC
.c65b c9 b0 cmp #$b0 CMP #TK_SPC ; compare with SPC( token
.c65d f0 52 beq $c6b1 BEQ LAB_18A2 ; go do TAB/SPC
.c65f c9 2c cmp #$2c CMP #"," ; compare with ","
.c661 f0 38 beq $c69b BEQ LAB_188B ; go do move to next TAB mark
.c663 c9 3b cmp #$3b CMP #";" ; compare with ";"
.c665 f0 66 beq $c6cd BEQ LAB_18BD ; if ";" continue with PRINT processing
.c667 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate expression
.c66a 24 5f bit $5f BIT Dtypef ; test data type flag, $FF=string, $00=numeric
.c66c 30 e1 bmi $c64f BMI LAB_1829 ; branch if string
.c66e 20 95 d8 jsr $d895 JSR LAB_296E ; convert FAC1 to string
.c671 20 44 cf jsr $cf44 JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
.c674 a0 00 ldy #$00 LDY #$00 ; clear index
.c676 a5 0f lda $0f LDA TWidth ; get terminal width byte
.c678 f0 0a beq $c684 BEQ LAB_185E ; skip check if zero
.c67a 38 sec SEC ; set carry for subtract
.c67b e5 0e sbc $0e SBC TPos ; subtract terminal position
.c67d f1 ae sbc ($ae),y SBC (des_pl),Y ; subtract string length
.c67f b0 03 bcs $c684 BCS LAB_185E ; branch if less than terminal width
.c681 20 92 c6 jsr $c692 JSR LAB_CRLF ; else print CR/LF
.c684 lab_185e
.c684 20 d6 c6 jsr $c6d6 JSR LAB_18C6 ; print string from Sutill/Sutilh
.c687 f0 c9 beq $c652 BEQ LAB_182C ; always go continue processing line
.c689 lab_1866
.c689 a9 00 lda #$00 LDA #$00 ; clear byte
.c68b 9d 0d 04 sta $040d,x STA Ibuffs,X ; null terminate input
.c68e a2 0d ldx #$0d LDX #<Ibuffs ; set X to buffer start-1 low byte
.c690 a0 04 ldy #$04 LDY #>Ibuffs ; set Y to buffer start-1 high byte
.c692 lab_crlf
.c692 a9 0d lda #$0d LDA #$0D ; load [CR]
.c694 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c697 a9 0a lda #$0a LDA #$0A ; load [LF]
.c699 d0 52 bne $c6ed BNE LAB_PRNA ; go print the character and return, branch always
.c69b lab_188b
.c69b a5 0e lda $0e LDA TPos ; get terminal position
.c69d c5 10 cmp $10 CMP Iclim ; compare with input column limit
.c69f 90 05 bcc $c6a6 BCC LAB_1897 ; branch if less
.c6a1 20 92 c6 jsr $c692 JSR LAB_CRLF ; else print CR/LF (next line)
.c6a4 d0 27 bne $c6cd BNE LAB_18BD ; continue with PRINT processing (branch always)
.c6a6 lab_1897
.c6a6 38 sec SEC ; set carry for subtract
.c6a7 lab_1898
.c6a7 e5 64 sbc $64 SBC TabSiz ; subtract TAB size
.c6a9 b0 fc bcs $c6a7 BCS LAB_1898 ; loop if result was +ve
.c6ab 49 ff eor #$ff EOR #$FF ; complement it
.c6ad 69 01 adc #$01 ADC #$01 ; +1 (twos complement)
.c6af d0 12 bne $c6c3 BNE LAB_18B6 ; always print A spaces (result is never $00)
.c6b1 lab_18a2
.c6b1 48 pha PHA ; save token
.c6b2 20 89 d2 jsr $d289 JSR LAB_SGBY ; scan and get byte parameter
.c6b5 c9 29 cmp #$29 CMP #$29 ; is next character )
.c6b7 d0 7b bne $c734 BNE LAB_1910 ; if not do syntax error then warm start
.c6b9 68 pla PLA ; get token back
.c6ba c9 ac cmp #$ac CMP #TK_TAB ; was it TAB ?
.c6bc d0 06 bne $c6c4 BNE LAB_18B7 ; if not go do SPC
.c6be 8a txa TXA ; copy integer value to A
.c6bf e5 0e sbc $0e SBC TPos ; subtract terminal position
.c6c1 90 0a bcc $c6cd BCC LAB_18BD ; branch if result was < 0 (can't TAB backwards)
.c6c3 lab_18b6
.c6c3 aa tax TAX ; copy result to X
.c6c4 lab_18b7
.c6c4 8a txa TXA ; set flags on size for SPC
.c6c5 f0 06 beq $c6cd BEQ LAB_18BD ; branch if result was = $0, already here
.c6c7 lab_18ba
.c6c7 20 e8 c6 jsr $c6e8 JSR LAB_18E0 ; print " "
.c6ca ca dex DEX ; decrement count
.c6cb d0 fa bne $c6c7 BNE LAB_18BA ; loop if not all done
.c6cd lab_18bd
.c6cd 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c6d0 d0 85 bne $c657 BNE LAB_1831 ; if more to print go do it
.c6d2 60 rts RTS
.c6d3 lab_18c3
.c6d3 20 44 cf jsr $cf44 JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
.c6d6 lab_18c6
.c6d6 20 3e d1 jsr $d13e JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
.c6d9 a0 00 ldy #$00 LDY #$00 ; reset index
.c6db aa tax TAX ; copy length to X
.c6dc f0 49 beq $c727 BEQ LAB_188C ; exit (RTS) if null string
.c6de lab_18cd
.c6de b1 71 lda ($71),y LDA (ut1_pl),Y ; get next byte
.c6e0 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c6e3 c8 iny INY ; increment index
.c6e4 ca dex DEX ; decrement count
.c6e5 d0 f7 bne $c6de BNE LAB_18CD ; loop if not done yet
.c6e7 60 rts RTS
.c6e8 lab_18e0
.c6e8 a9 20 lda #$20 LDA #$20 ; load " "
>c6ea 2c .byte $2C ; change next line to BIT LAB_3FA9
.c6eb lab_18e3
.c6eb a9 3f lda #$3f LDA #$3F ; load "?" character
.c6ed lab_prna
.c6ed c9 20 cmp #$20 CMP #" " ; compare with " "
.c6ef 90 19 bcc $c70a BCC LAB_18F9 ; branch if less (non printing)
.c6f1 48 pha PHA ; save the character
.c6f2 a5 0f lda $0f LDA TWidth ; get terminal width
.c6f4 d0 0a bne $c700 BNE LAB_18F0 ; branch if not zero (not infinite length)
.c6f6 a5 0e lda $0e LDA TPos ; get position
.c6f8 e5 64 sbc $64 SBC TabSiz ; subtract TAB size, carry set by CMP #$20 above
.c6fa d0 0b bne $c707 BNE LAB_18F7 ; skip reset if different
.c6fc 85 0e sta $0e STA TPos ; else reset position
.c6fe f0 07 beq $c707 BEQ LAB_18F7 ; go print character
.c700 lab_18f0
.c700 c5 0e cmp $0e CMP TPos ; compare with terminal character position
.c702 d0 03 bne $c707 BNE LAB_18F7 ; branch if not at end of line
.c704 20 92 c6 jsr $c692 JSR LAB_CRLF ; else print CR/LF
.c707 lab_18f7
.c707 e6 0e inc $0e INC TPos ; increment terminal position
.c709 68 pla PLA ; get character back
.c70a lab_18f9
.c70a 20 ed de jsr $deed JSR V_OUTP ; output byte via output vector
.c70d c9 0d cmp #$0d CMP #$0D ; compare with [CR]
.c70f d0 14 bne $c725 BNE LAB_188A ; branch if not [CR]
.c711 86 78 stx $78 STX TempB ; save buffer index
.c713 a6 0d ldx $0d LDX Nullct ; get null count
.c715 f0 0a beq $c721 BEQ LAB_1886 ; branch if no nulls
.c717 a9 00 lda #$00 LDA #$00 ; load [NULL]
.c719 lab_1880
.c719 20 ed c6 jsr $c6ed JSR LAB_PRNA ; go print the character
.c71c ca dex DEX ; decrement count
.c71d d0 fa bne $c719 BNE LAB_1880 ; loop if not all done
.c71f a9 0d lda #$0d LDA #$0D ; restore the character (and set the flags)
.c721 lab_1886
.c721 86 0e stx $0e STX TPos ; clear terminal position (X always = zero when we get here)
.c723 a6 78 ldx $78 LDX TempB ; restore buffer index
.c725 lab_188a
.c725 29 ff and #$ff AND #$FF ; set the flags
.c727 lab_188c
.c727 60 rts RTS
.c728 lab_1904
.c728 a5 62 lda $62 LDA Imode ; get input mode flag, $00=INPUT, $00=READ
.c72a 10 0b bpl $c737 BPL LAB_1913 ; branch if INPUT (go do redo)
.c72c a5 8d lda $8d LDA Dlinel ; get current DATA line low byte
.c72e a4 8e ldy $8e LDY Dlineh ; get current DATA line high byte
.c730 85 87 sta $87 STA Clinel ; save current line low byte
.c732 84 88 sty $88 STY Clineh ; save current line high byte
.c734 lab_1910
.c734 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.c737 lab_1913
.c737 a9 1b lda #$1b LDA #<LAB_REDO ; point to redo message (low addr)
.c739 a0 e6 ldy #$e6 LDY #>LAB_REDO ; point to redo message (high addr)
.c73b 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.c73e a5 8b lda $8b LDA Cpntrl ; get continue pointer low byte
.c740 a4 8c ldy $8c LDY Cpntrh ; get continue pointer high byte
.c742 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c744 84 c4 sty $c4 STY Bpntrh ; save BASIC execute pointer high byte
.c746 60 rts RTS
.c747 lab_input
.c747 c9 22 cmp #$22 CMP #$22 ; compare next byte with open quote
.c749 d0 0b bne $c756 BNE LAB_1934 ; branch if no prompt string
.c74b 20 be c9 jsr $c9be JSR LAB_1BC1 ; print "..." string
.c74e a9 3b lda #$3b LDA #$3B ; load A with ";"
.c750 20 f1 c9 jsr $c9f1 JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
.c753 20 d6 c6 jsr $c6d6 JSR LAB_18C6 ; print string from Sutill/Sutilh
.c756 lab_1934
.c756 20 6a ce jsr $ce6a JSR LAB_CKRN ; check not Direct, back here if ok
.c759 20 40 c0 jsr $c040 JSR LAB_INLN ; print "? " and get BASIC input
.c75c a9 00 lda #$00 LDA #$00 ; set mode = INPUT
.c75e cd 0d 04 cmp $040d CMP Ibuffs ; test first byte in buffer
.c761 d0 0a bne $c76d BNE LAB_1953 ; branch if not null input
.c763 18 clc CLC ; was null input so clear carry to exit program
.c764 4c 2c c3 jmp $c32c JMP LAB_1647 ; go do BREAK exit
.c767 lab_read
.c767 a6 8f ldx $8f LDX Dptrl ; get DATA pointer low byte
.c769 a4 90 ldy $90 LDY Dptrh ; get DATA pointer high byte
.c76b a9 80 lda #$80 LDA #$80 ; set mode = READ
.c76d lab_1953
.c76d 85 62 sta $62 STA Imode ; set input mode flag, $00=INPUT, $80=READ
.c76f 86 91 stx $91 STX Rdptrl ; save READ pointer low byte
.c771 84 92 sty $92 STY Rdptrh ; save READ pointer high byte
.c773 lab_195b
.c773 20 aa cb jsr $cbaa JSR LAB_GVAR ; get (var) address
.c776 85 97 sta $97 STA Lvarpl ; save address low byte
.c778 84 98 sty $98 STY Lvarph ; save address high byte
.c77a a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c77c a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte
.c77e 85 11 sta $11 STA Itempl ; save as temporary integer low byte
.c780 84 12 sty $12 STY Itemph ; save as temporary integer high byte
.c782 a6 91 ldx $91 LDX Rdptrl ; get READ pointer low byte
.c784 a4 92 ldy $92 LDY Rdptrh ; get READ pointer high byte
.c786 86 c3 stx $c3 STX Bpntrl ; set BASIC execute pointer low byte
.c788 84 c4 sty $c4 STY Bpntrh ; set BASIC execute pointer high byte
.c78a 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c78d d0 11 bne $c7a0 BNE LAB_1988 ; branch if not null
.c78f 24 62 bit $62 BIT Imode ; test input mode flag, $00=INPUT, $80=READ
.c791 30 65 bmi $c7f8 BMI LAB_19DD ; branch if READ
.c793 20 eb c6 jsr $c6eb JSR LAB_18E3 ; print "?" character (double ? for extended input)
.c796 20 40 c0 jsr $c040 JSR LAB_INLN ; print "? " and get BASIC input
.c799 86 c3 stx $c3 STX Bpntrl ; set BASIC execute pointer low byte
.c79b 84 c4 sty $c4 STY Bpntrh ; set BASIC execute pointer high byte
.c79d lab_1985
.c79d 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c7a0 lab_1988
.c7a0 24 5f bit $5f BIT Dtypef ; test data type flag, $FF=string, $00=numeric
.c7a2 10 24 bpl $c7c8 BPL LAB_19B0 ; branch if numeric
.c7a4 85 5b sta $5b STA Srchc ; save search character
.c7a6 c9 22 cmp #$22 CMP #$22 ; was it " ?
.c7a8 f0 07 beq $c7b1 BEQ LAB_1999 ; branch if so
.c7aa a9 3a lda #$3a LDA #":" ; else search character is ":"
.c7ac 85 5b sta $5b STA Srchc ; set new search character
.c7ae a9 2c lda #$2c LDA #"," ; other search character is ","
.c7b0 18 clc CLC ; clear carry for add
.c7b1 lab_1999
.c7b1 85 5c sta $5c STA Asrch ; set second search character
.c7b3 a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c7b5 a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte
.c7b7 69 00 adc #$00 ADC #$00 ; c is =1 if we came via the BEQ LAB_1999, else =0
.c7b9 90 01 bcc $c7bc BCC LAB_19A4 ; branch if no execute pointer low byte rollover
.c7bb c8 iny INY ; else increment high byte
.c7bc lab_19a4
.c7bc 20 4a cf jsr $cf4a JSR LAB_20B4 ; print Srchc or Asrch terminated string to Sutill/Sutilh
.c7bf 20 cf d2 jsr $d2cf JSR LAB_23F3 ; restore BASIC execute pointer from temp (Btmpl/Btmph)
.c7c2 20 d0 c5 jsr $c5d0 JSR LAB_17D5 ; go do string LET
.c7c5 4c ce c7 jmp $c7ce JMP LAB_19B6 ; go check string terminator
.c7c8 lab_19b0
.c7c8 20 a6 d7 jsr $d7a6 JSR LAB_2887 ; get FAC1 from string
.c7cb 20 a3 d6 jsr $d6a3 JSR LAB_PFAC ; pack FAC1 into (Lvarpl)
.c7ce lab_19b6
.c7ce 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c7d1 f0 0a beq $c7dd BEQ LAB_19C5 ; branch if null (last entry)
.c7d3 c9 2c cmp #$2c CMP #"," ; else compare with ","
.c7d5 f0 03 beq $c7da BEQ LAB_19C2 ; branch if ","
.c7d7 4c 28 c7 jmp $c728 JMP LAB_1904 ; else go handle bad input data
.c7da lab_19c2
.c7da 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c7dd lab_19c5
.c7dd a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte (temp READ/INPUT ptr)
.c7df a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte (temp READ/INPUT ptr)
.c7e1 85 91 sta $91 STA Rdptrl ; save for now
.c7e3 84 92 sty $92 STY Rdptrh ; save for now
.c7e5 a5 11 lda $11 LDA Itempl ; get temporary integer low byte (temp BASIC execute ptr)
.c7e7 a4 12 ldy $12 LDY Itemph ; get temporary integer high byte (temp BASIC execute ptr)
.c7e9 85 c3 sta $c3 STA Bpntrl ; set BASIC execute pointer low byte
.c7eb 84 c4 sty $c4 STY Bpntrh ; set BASIC execute pointer high byte
.c7ed 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c7f0 f0 2c beq $c81e BEQ LAB_1A03 ; if null go do extra ignored message
.c7f2 20 fe c9 jsr $c9fe JSR LAB_1C01 ; else scan for "," , else do syntax error then warm start
.c7f5 4c 73 c7 jmp $c773 JMP LAB_195B ; go INPUT next variable from list
.c7f8 lab_19dd
.c7f8 20 9d c4 jsr $c49d JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
.c7fb c8 iny INY ; increment index
.c7fc aa tax TAX ; copy character ([:] or [EOL])
.c7fd d0 12 bne $c811 BNE LAB_19F6 ; branch if [:]
.c7ff a2 06 ldx #$06 LDX #$06 ; set for "Out of DATA" error
.c801 c8 iny INY ; increment index, now points to next line pointer high byte
.c802 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next line pointer high byte
.c804 f0 73 beq $c879 BEQ LAB_1A54 ; branch if end (eventually does error X)
.c806 c8 iny INY ; increment index
.c807 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next line # low byte
.c809 85 8d sta $8d STA Dlinel ; save current DATA line low byte
.c80b c8 iny INY ; increment index
.c80c b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get next line # high byte
.c80e c8 iny INY ; increment index
.c80f 85 8e sta $8e STA Dlineh ; save current DATA line high byte
.c811 lab_19f6
.c811 b1 c3 lda ($c3),y LDA (Bpntrl),Y ; get byte
.c813 c8 iny INY ; increment index
.c814 aa tax TAX ; copy to X
.c815 20 8f c4 jsr $c48f JSR LAB_170F ; set BASIC execute pointer
.c818 e0 83 cpx #$83 CPX #TK_DATA ; compare with "DATA" token
.c81a f0 81 beq $c79d BEQ LAB_1985 ; was "DATA" so go do next READ
.c81c d0 da bne $c7f8 BNE LAB_19DD ; go find next statement if not "DATA"
.c81e lab_1a03
.c81e a5 91 lda $91 LDA Rdptrl ; get temp READ pointer low byte
.c820 a4 92 ldy $92 LDY Rdptrh ; get temp READ pointer high byte
.c822 a6 62 ldx $62 LDX Imode ; get input mode flag, $00=INPUT, $80=READ
.c824 10 03 bpl $c829 BPL LAB_1A0E ; branch if INPUT
.c826 4c 4e c3 jmp $c34e JMP LAB_1624 ; save AY as DATA pointer and return
.c829 lab_1a0e
.c829 a0 00 ldy #$00 LDY #$00 ; clear index
.c82b b1 91 lda ($91),y LDA (Rdptrl),Y ; get next byte
.c82d d0 01 bne $c830 BNE LAB_1A1B ; error if not end of INPUT
.c82f 60 rts RTS
.c830 lab_1a1b
.c830 a9 0a lda #$0a LDA #<LAB_IMSG ; point to extra ignored message (low addr)
.c832 a0 e6 ldy #$e6 LDY #>LAB_IMSG ; point to extra ignored message (high addr)
.c834 4c d3 c6 jmp $c6d3 JMP LAB_18C3 ; print null terminated string from memory and return
.c837 lab_11a1
.c837 ba tsx TSX ; copy stack pointer
.c838 e8 inx INX ; +1 pass return address
.c839 e8 inx INX ; +2 pass return address
.c83a e8 inx INX ; +3 pass calling routine return address
.c83b e8 inx INX ; +4 pass calling routine return address
.c83c lab_11a6
.c83c bd 01 01 lda $0101,x LDA LAB_STAK+1,X ; get token byte from stack
.c83f c9 81 cmp #$81 CMP #TK_FOR ; is it FOR token
.c841 d0 21 bne $c864 BNE LAB_11CE ; exit if not FOR token
.c843 a5 98 lda $98 LDA Frnxth ; get var pointer for FOR/NEXT high byte
.c845 d0 0a bne $c851 BNE LAB_11BB ; branch if not null
.c847 bd 02 01 lda $0102,x LDA LAB_STAK+2,X ; get FOR variable pointer low byte
.c84a 85 97 sta $97 STA Frnxtl ; save var pointer for FOR/NEXT low byte
.c84c bd 03 01 lda $0103,x LDA LAB_STAK+3,X ; get FOR variable pointer high byte
.c84f 85 98 sta $98 STA Frnxth ; save var pointer for FOR/NEXT high byte
.c851 lab_11bb
.c851 dd 03 01 cmp $0103,x CMP LAB_STAK+3,X ; compare var pointer with stacked var pointer (high byte)
.c854 d0 07 bne $c85d BNE LAB_11C7 ; branch if no match
.c856 a5 97 lda $97 LDA Frnxtl ; get var pointer for FOR/NEXT low byte
.c858 dd 02 01 cmp $0102,x CMP LAB_STAK+2,X ; compare var pointer with stacked var pointer (low byte)
.c85b f0 07 beq $c864 BEQ LAB_11CE ; exit if match found
.c85d lab_11c7
.c85d 8a txa TXA ; copy index
.c85e 18 clc CLC ; clear carry for add
.c85f 69 10 adc #$10 ADC #$10 ; add FOR stack use size
.c861 aa tax TAX ; copy back to index
.c862 d0 d8 bne $c83c BNE LAB_11A6 ; loop if not at start of stack
.c864 lab_11ce
.c864 60 rts RTS
.c865 lab_next
.c865 d0 04 bne $c86b BNE LAB_1A46 ; branch if NEXT var
.c867 a0 00 ldy #$00 LDY #$00 ; else clear Y
.c869 f0 03 beq $c86e BEQ LAB_1A49 ; branch always (no variable to search for)
.c86b lab_1a46
.c86b 20 aa cb jsr $cbaa JSR LAB_GVAR ; get variable address
.c86e lab_1a49
.c86e 85 97 sta $97 STA Frnxtl ; store variable pointer low byte
.c870 84 98 sty $98 STY Frnxth ; store variable pointer high byte
.c872 20 37 c8 jsr $c837 JSR LAB_11A1 ; search the stack for FOR activity
.c875 f0 04 beq $c87b BEQ LAB_1A56 ; branch if found
.c877 a2 00 ldx #$00 LDX #$00 ; else set error $00 ("NEXT without FOR" error)
.c879 lab_1a54
.c879 f0 63 beq $c8de BEQ LAB_1ABE ; do error #X, then warm start
.c87b lab_1a56
.c87b 9a txs TXS ; set stack pointer, X set by search, dumps return addresses
.c87c 8a txa TXA ; copy stack pointer
.c87d 38 sec SEC ; set carry for subtract
.c87e e9 f7 sbc #$f7 SBC #$F7 ; point to TO var
.c880 85 73 sta $73 STA ut2_pl ; save pointer to TO var for compare
.c882 69 fb adc #$fb ADC #$FB ; point to STEP var
.c884 a0 01 ldy #$01 LDY #>LAB_STAK ; point to stack page high byte
.c886 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (STEP value) into FAC1
.c889 ba tsx TSX ; get stack pointer back
.c88a bd 08 01 lda $0108,x LDA LAB_STAK+8,X ; get step sign
.c88d 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.c88f a5 97 lda $97 LDA Frnxtl ; get FOR variable pointer low byte
.c891 a4 98 ldy $98 LDY Frnxth ; get FOR variable pointer high byte
.c893 20 be d3 jsr $d3be JSR LAB_246C ; add (FOR variable) to FAC1
.c896 20 a3 d6 jsr $d6a3 JSR LAB_PFAC ; pack FAC1 into (FOR variable)
.c899 a0 01 ldy #$01 LDY #>LAB_STAK ; point to stack page high byte
.c89b 20 19 d7 jsr $d719 JSR LAB_27FA ; compare FAC1 with (Y,ut2_pl) (TO value)
.c89e ba tsx TSX ; get stack pointer back
.c89f dd 08 01 cmp $0108,x CMP LAB_STAK+8,X ; compare step sign
.c8a2 f0 17 beq $c8bb BEQ LAB_1A9B ; branch if = (loop complete)
.c8a4 bd 0d 01 lda $010d,x LDA LAB_STAK+$0D,X ; get FOR line low byte
.c8a7 85 87 sta $87 STA Clinel ; save current line low byte
.c8a9 bd 0e 01 lda $010e,x LDA LAB_STAK+$0E,X ; get FOR line high byte
.c8ac 85 88 sta $88 STA Clineh ; save current line high byte
.c8ae bd 10 01 lda $0110,x LDA LAB_STAK+$10,X ; get BASIC execute pointer low byte
.c8b1 85 c3 sta $c3 STA Bpntrl ; save BASIC execute pointer low byte
.c8b3 bd 0f 01 lda $010f,x LDA LAB_STAK+$0F,X ; get BASIC execute pointer high byte
.c8b6 85 c4 sta $c4 STA Bpntrh ; save BASIC execute pointer high byte
.c8b8 lab_1a98
.c8b8 4c bc c2 jmp $c2bc JMP LAB_15C2 ; go do interpreter inner loop
.c8bb lab_1a9b
.c8bb 8a txa TXA ; stack copy to A
.c8bc 69 0f adc #$0f ADC #$0F ; add $10 ($0F+carry) to dump FOR structure
.c8be aa tax TAX ; copy back to index
.c8bf 9a txs TXS ; copy to stack pointer
.c8c0 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c8c3 c9 2c cmp #$2c CMP #"," ; compare with ","
.c8c5 d0 f1 bne $c8b8 BNE LAB_1A98 ; branch if not "," (go do interpreter inner loop)
.c8c7 20 bc 00 jsr $00bc JSR LAB_IGBY ; else increment and scan memory
.c8ca 20 6b c8 jsr $c86b JSR LAB_1A46 ; do NEXT (var)
.c8cd lab_evnm
.c8cd 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate expression
.c8d0 lab_ctnm
.c8d0 18 clc CLC ; destination is numeric
>c8d1 24 .byte $24 ; makes next line BIT $38
.c8d2 lab_ctst
.c8d2 38 sec SEC ; required type is string
.c8d3 lab_cktm
.c8d3 24 5f bit $5f BIT Dtypef ; test data type flag, $FF=string, $00=numeric
.c8d5 30 03 bmi $c8da BMI LAB_1ABA ; branch if data type is string
.c8d7 b0 03 bcs $c8dc BCS LAB_1ABC ; if required type is string do type mismatch error
.c8d9 lab_1ab9
.c8d9 60 rts RTS
.c8da lab_1aba
.c8da b0 fd bcs $c8d9 BCS LAB_1AB9 ; exit if required type is string
.c8dc lab_1abc
.c8dc a2 18 ldx #$18 LDX #$18 ; error code $18 ("Type mismatch" error)
.c8de lab_1abe
.c8de 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.c8e1 lab_evex
.c8e1 a6 c3 ldx $c3 LDX Bpntrl ; get BASIC execute pointer low byte
.c8e3 d0 02 bne $c8e7 BNE LAB_1AC7 ; skip next if not zero
.c8e5 c6 c4 dec $c4 DEC Bpntrh ; else decrement BASIC execute pointer high byte
.c8e7 lab_1ac7
.c8e7 c6 c3 dec $c3 DEC Bpntrl ; decrement BASIC execute pointer low byte
.c8e9 lab_evez
.c8e9 a9 00 lda #$00 LDA #$00 ; set null precedence (flag done)
.c8eb lab_1acc
.c8eb 48 pha PHA ; push precedence byte
.c8ec a9 02 lda #$02 LDA #$02 ; 2 bytes
.c8ee 20 03 bf jsr $bf03 JSR LAB_1212 ; check room on stack for A bytes
.c8f1 20 cd c9 jsr $c9cd JSR LAB_GVAL ; get value from line
.c8f4 a9 00 lda #$00 LDA #$00 ; clear A
.c8f6 85 9b sta $9b STA comp_f ; clear compare function flag
.c8f8 lab_1adb
.c8f8 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.c8fb lab_1ade
.c8fb 38 sec SEC ; set carry for subtract
.c8fc e9 c1 sbc #$c1 SBC #TK_GT ; subtract token for > (lowest comparison function)
.c8fe 90 17 bcc $c917 BCC LAB_1AFA ; branch if < TK_GT
.c900 c9 03 cmp #$03 CMP #$03 ; compare with ">" to "<" tokens
.c902 b0 13 bcs $c917 BCS LAB_1AFA ; branch if >= TK_SGN (highest evaluation function +1)
.c904 c9 01 cmp #$01 CMP #$01 ; compare with token for =
.c906 2a rol ROL ; *2, b0 = carry (=1 if token was = or <)
.c907 49 01 eor #$01 EOR #$01 ; toggle b0
.c909 45 9b eor $9b EOR comp_f ; EOR with compare function flag bits
.c90b c5 9b cmp $9b CMP comp_f ; compare with compare function flag
.c90d 90 67 bcc $c976 BCC LAB_1B53 ; if <(comp_f) do syntax error then warm start
.c90f 85 9b sta $9b STA comp_f ; save new compare function flag
.c911 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c914 4c fb c8 jmp $c8fb JMP LAB_1ADE ; go do next character
.c917 lab_1afa
.c917 a6 9b ldx $9b LDX comp_f ; get compare function flag
.c919 d0 2c bne $c947 BNE LAB_1B2A ; branch if compare function
.c91b b0 79 bcs $c996 BCS LAB_1B78 ; go do functions
.c91d 69 0a adc #$0a ADC #TK_GT-TK_PLUS ; add # of operators (+, -, *, /, ^, AND, OR or EOR)
.c91f 90 75 bcc $c996 BCC LAB_1B78 ; branch if < + operator
.c921 d0 07 bne $c92a BNE LAB_1B0B ; branch if not + token
.c923 24 5f bit $5f BIT Dtypef ; test data type flag, $FF=string, $00=numeric
.c925 10 03 bpl $c92a BPL LAB_1B0B ; branch if not string
.c927 4c d4 d0 jmp $d0d4 JMP LAB_224D ; add strings, string 1 is in descriptor des_pl, string 2
.c92a lab_1b0b
.c92a 85 71 sta $71 STA ut1_pl ; save it
.c92c 0a asl ASL ; *2
.c92d 65 71 adc $71 ADC ut1_pl ; *3
.c92f a8 tay TAY ; copy to index
.c930 lab_1b13
.c930 68 pla PLA ; pull previous precedence
.c931 d9 eb e0 cmp $e0eb,y CMP LAB_OPPT,Y ; compare with precedence byte
.c934 b0 65 bcs $c99b BCS LAB_1B7D ; branch if A >=
.c936 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.c939 lab_1b1c
.c939 48 pha PHA ; save precedence
.c93a lab_1b1d
.c93a 20 62 c9 jsr $c962 JSR LAB_1B43 ; get vector, execute function then continue evaluation
.c93d 68 pla PLA ; restore precedence
.c93e a4 99 ldy $99 LDY prstk ; get precedence stacked flag
.c940 10 19 bpl $c95b BPL LAB_1B3C ; branch if stacked values
.c942 aa tax TAX ; copy precedence (set flags)
.c943 f0 76 beq $c9bb BEQ LAB_1B9D ; exit if done
.c945 d0 5d bne $c9a4 BNE LAB_1B86 ; else pop FAC2 and return, branch always
.c947 lab_1b2a
.c947 26 5f rol $5f ROL Dtypef ; shift data type flag into Cb
.c949 8a txa TXA ; copy compare function flag
.c94a 85 5f sta $5f STA Dtypef ; clear data type flag, X is 0xxx xxxx
.c94c 2a rol ROL ; shift data type into compare function byte b0
.c94d a6 c3 ldx $c3 LDX Bpntrl ; get BASIC execute pointer low byte
.c94f d0 02 bne $c953 BNE LAB_1B34 ; branch if no underflow
.c951 c6 c4 dec $c4 DEC Bpntrh ; else decrement BASIC execute pointer high byte
.c953 lab_1b34
.c953 c6 c3 dec $c3 DEC Bpntrl ; decrement BASIC execute pointer low byte
.c955 a0 24 ldy #$24 LDY #TK_LT_PLUS*3 ; set offset to last operator entry
.c957 85 9b sta $9b STA comp_f ; save new compare function flag
.c959 d0 d5 bne $c930 BNE LAB_1B13 ; branch always
.c95b lab_1b3c
.c95b d9 eb e0 cmp $e0eb,y CMP LAB_OPPT,Y ;.compare with stacked function precedence
.c95e b0 44 bcs $c9a4 BCS LAB_1B86 ; branch if A >=, pop FAC2 and return
.c960 90 d7 bcc $c939 BCC LAB_1B1C ; branch always
.c962 lab_1b43
.c962 b9 ed e0 lda $e0ed,y LDA LAB_OPPT+2,Y ; get function vector high byte
.c965 48 pha PHA ; onto stack
.c966 b9 ec e0 lda $e0ec,y LDA LAB_OPPT+1,Y ; get function vector low byte
.c969 48 pha PHA ; onto stack
.c96a 20 79 c9 jsr $c979 JSR LAB_1B5B ; function will return here, then the next RTS will call
.c96d a5 9b lda $9b LDA comp_f ; get compare function flag
.c96f 48 pha PHA ; push compare evaluation byte
.c970 b9 eb e0 lda $e0eb,y LDA LAB_OPPT,Y ; get precedence byte
.c973 4c eb c8 jmp $c8eb JMP LAB_1ACC ; continue evaluating expression
.c976 lab_1b53
.c976 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.c979 lab_1b5b
.c979 68 pla PLA ; get return addr low byte
.c97a 85 71 sta $71 STA ut1_pl ; save it
.c97c e6 71 inc $71 INC ut1_pl ; increment it (was ret-1 pushed? yes!)
.c97e 68 pla PLA ; get return addr high byte
.c97f 85 72 sta $72 STA ut1_ph ; save it
.c981 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.c983 48 pha PHA ; push sign
.c984 lab_1b66
.c984 20 d9 d6 jsr $d6d9 JSR LAB_27BA ; round FAC1
.c987 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.c989 48 pha PHA ; push on stack
.c98a a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.c98c 48 pha PHA ; push on stack
.c98d a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.c98f 48 pha PHA ; push on stack
.c990 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.c992 48 pha PHA ; push on stack
.c993 6c 71 00 jmp ($0071) JMP (ut1_pl) ; return, sort of
.c996 lab_1b78
.c996 a0 ff ldy #$ff LDY #$FF ; flag function
.c998 68 pla PLA ; pull precedence byte
.c999 lab_1b7b
.c999 f0 20 beq $c9bb BEQ LAB_1B9D ; exit if done
.c99b lab_1b7d
.c99b c9 64 cmp #$64 CMP #$64 ; compare previous precedence with $64
.c99d f0 03 beq $c9a2 BEQ LAB_1B84 ; branch if was $64 (< function)
.c99f 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.c9a2 lab_1b84
.c9a2 84 99 sty $99 STY prstk ; save precedence stacked flag
.c9a4 lab_1b86
.c9a4 68 pla PLA ; pop byte
.c9a5 4a lsr LSR ; shift out comparison evaluation lowest bit
.c9a6 85 63 sta $63 STA Cflag ; save comparison evaluation flag
.c9a8 68 pla PLA ; pop exponent
.c9a9 85 b3 sta $b3 STA FAC2_e ; save FAC2 exponent
.c9ab 68 pla PLA ; pop mantissa1
.c9ac 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.c9ae 68 pla PLA ; pop mantissa2
.c9af 85 b5 sta $b5 STA FAC2_2 ; save FAC2 mantissa2
.c9b1 68 pla PLA ; pop mantissa3
.c9b2 85 b6 sta $b6 STA FAC2_3 ; save FAC2 mantissa3
.c9b4 68 pla PLA ; pop sign
.c9b5 85 b7 sta $b7 STA FAC2_s ; save FAC2 sign (b7)
.c9b7 45 b0 eor $b0 EOR FAC1_s ; EOR FAC1 sign (b7)
.c9b9 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.c9bb lab_1b9d
.c9bb a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.c9bd 60 rts RTS
.c9be lab_1bc1
.c9be a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.c9c0 a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte
.c9c2 69 00 adc #$00 ADC #$00 ; add carry to low byte
.c9c4 90 01 bcc $c9c7 BCC LAB_1BCA ; branch if no overflow
.c9c6 c8 iny INY ; increment high byte
.c9c7 lab_1bca
.c9c7 20 44 cf jsr $cf44 JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
.c9ca 4c cf d2 jmp $d2cf JMP LAB_23F3 ; restore BASIC execute pointer from temp and return
.c9cd lab_gval
.c9cd 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.c9d0 b0 03 bcs $c9d5 BCS LAB_1BAC ; branch if not numeric character
.c9d2 lab_1ba9
.c9d2 4c a6 d7 jmp $d7a6 JMP LAB_2887 ; get FAC1 from string and return
.c9d5 lab_1bac
.c9d5 aa tax TAX ; set the flags
.c9d6 30 2f bmi $ca07 BMI LAB_1BD0 ; if -ve go test token values
.c9d8 c9 24 cmp #$24 CMP #"$" ; compare with "$"
.c9da f0 f6 beq $c9d2 BEQ LAB_1BA9 ; branch if "$", hex number
.c9dc c9 25 cmp #$25 CMP #"%" ; else compare with "%"
.c9de f0 f2 beq $c9d2 BEQ LAB_1BA9 ; branch if "%", binary number
.c9e0 c9 2e cmp #$2e CMP #"." ; compare with "."
.c9e2 f0 ee beq $c9d2 BEQ LAB_1BA9 ; if so get FAC1 from string and return (e.g. was .123)
.c9e4 c9 22 cmp #$22 CMP #$22 ; compare with "
.c9e6 f0 d6 beq $c9be BEQ LAB_1BC1 ; branch if open quote
.c9e8 c9 28 cmp #$28 CMP #"(" ; compare with "("
.c9ea d0 4f bne $ca3b BNE LAB_1C18 ; if not "(" get (var), return value in FAC1 and $ flag
.c9ec lab_1bf7
.c9ec 20 e9 c8 jsr $c8e9 JSR LAB_EVEZ ; evaluate expression, no decrement
.c9ef lab_1bfb
.c9ef a9 29 lda #$29 LDA #$29 ; load A with ")"
.c9f1 lab_scca
.c9f1 a0 00 ldy #$00 LDY #$00 ; clear index
.c9f3 d1 c3 cmp ($c3),y CMP (Bpntrl),Y ; check next byte is = A
.c9f5 d0 0b bne $ca02 BNE LAB_SNER ; if not do syntax error then warm start
.c9f7 4c bc 00 jmp $00bc JMP LAB_IGBY ; increment and scan memory then return
.c9fa lab_1bfe
.c9fa a9 28 lda #$28 LDA #$28 ; load A with "("
.c9fc d0 f3 bne $c9f1 BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
.c9fe lab_1c01
.c9fe a9 2c lda #$2c LDA #$2C ; load A with ","
.ca00 d0 ef bne $c9f1 BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
.ca02 lab_sner
.ca02 a2 02 ldx #$02 LDX #$02 ; error code $02 ("Syntax" error)
.ca04 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.ca07 lab_1bd0
.ca07 c9 b8 cmp #$b8 CMP #TK_MINUS ; compare with token for -
.ca09 f0 29 beq $ca34 BEQ LAB_1C11 ; branch if - token (do set-up for functions)
.ca0b c9 b7 cmp #$b7 CMP #TK_PLUS ; compare with token for +
.ca0d f0 be beq $c9cd BEQ LAB_GVAL ; branch if + token (+n = n so ignore leading +)
.ca0f c9 b2 cmp #$b2 CMP #TK_NOT ; compare with token for NOT
.ca11 d0 13 bne $ca26 BNE LAB_1BE7 ; branch if not token for NOT
.ca13 a0 21 ldy #$21 LDY #TK_EQUAL_PLUS*3 ; offset to NOT function
.ca15 d0 1f bne $ca36 BNE LAB_1C13 ; do set-up for function then execute (branch always)
.ca17 lab_equal
.ca17 20 a6 cc jsr $cca6 JSR LAB_EVIR ; evaluate integer expression (no sign check)
.ca1a a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.ca1c 49 ff eor #$ff EOR #$FF ; invert it
.ca1e a8 tay TAY ; copy it
.ca1f a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.ca21 49 ff eor #$ff EOR #$FF ; invert it
.ca23 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.ca26 lab_1be7
.ca26 c9 af cmp #$af CMP #TK_FN ; compare with token for FN
.ca28 d0 03 bne $ca2d BNE LAB_1BEE ; branch if not token for FN
.ca2a 4c b4 ce jmp $ceb4 JMP LAB_201E ; go evaluate FNx
.ca2d lab_1bee
.ca2d e9 c4 sbc #$c4 SBC #TK_SGN ; subtract with token for SGN
.ca2f b0 19 bcs $ca4a BCS LAB_1C27 ; if a function token go do it
.ca31 4c 02 ca jmp $ca02 JMP LAB_SNER ; else do syntax error
.ca34 lab_1c11
.ca34 a0 1e ldy #$1e LDY #TK_GT_PLUS*3 ; set offset from base to > operator
.ca36 lab_1c13
.ca36 68 pla PLA ; dump return address low byte
.ca37 68 pla PLA ; dump return address high byte
.ca38 4c 3a c9 jmp $c93a JMP LAB_1B1D ; execute function then continue evaluation
.ca3b lab_1c18
.ca3b 20 aa cb jsr $cbaa JSR LAB_GVAR ; get (var) address
.ca3e 85 ae sta $ae STA FAC1_2 ; save address low byte in FAC1 mantissa2
.ca40 84 af sty $af STY FAC1_3 ; save address high byte in FAC1 mantissa3
.ca42 a6 5f ldx $5f LDX Dtypef ; get data type flag, $FF=string, $00=numeric
.ca44 30 03 bmi $ca49 BMI LAB_1C25 ; if string then return (does RTS)
.ca46 lab_1c24
.ca46 4c 7d d6 jmp $d67d JMP LAB_UFAC ; unpack memory (AY) into FAC1
.ca49 lab_1c25
.ca49 60 rts RTS
.ca4a lab_1c27
.ca4a 0a asl ASL ; *2 (2 bytes per function address)
.ca4b a8 tay TAY ; copy to index
.ca4c b9 a6 e0 lda $e0a6,y LDA LAB_FTBM,Y ; get function jump vector high byte
.ca4f 48 pha PHA ; push functions jump vector high byte
.ca50 b9 a5 e0 lda $e0a5,y LDA LAB_FTBL,Y ; get function jump vector low byte
.ca53 48 pha PHA ; push functions jump vector low byte
.ca54 b9 60 e0 lda $e060,y LDA LAB_FTPM,Y ; get function pre process vector high byte
.ca57 f0 05 beq $ca5e BEQ LAB_1C56 ; skip pre process if null vector
.ca59 48 pha PHA ; push functions pre process vector high byte
.ca5a b9 5f e0 lda $e05f,y LDA LAB_FTPL,Y ; get function pre process vector low byte
.ca5d 48 pha PHA ; push functions pre process vector low byte
.ca5e lab_1c56
.ca5e 60 rts RTS ; do function, or pre process, call
.ca5f lab_ppfs
.ca5f 20 ec c9 jsr $c9ec JSR LAB_1BF7 ; process expression in parenthesis
.ca62 4c d2 c8 jmp $c8d2 JMP LAB_CTST ; check if source is string then do function,
.ca65 lab_ppfn
.ca65 20 ec c9 jsr $c9ec JSR LAB_1BF7 ; process expression in parenthesis
.ca68 4c d0 c8 jmp $c8d0 JMP LAB_CTNM ; check if source is numeric then do function,
.ca6b lab_ppbi
.ca6b 46 5f lsr $5f LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
.ca6d 4c bc 00 jmp $00bc JMP LAB_IGBY ; increment and scan memory then do function
.ca70 lab_lrms
.ca70 20 e9 c8 jsr $c8e9 JSR LAB_EVEZ ; evaluate (should be string) expression
.ca73 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for ",", else do syntax error then warm start
.ca76 20 d2 c8 jsr $c8d2 JSR LAB_CTST ; check if source is string, else do type mismatch
.ca79 68 pla PLA ; get function jump vector low byte
.ca7a aa tax TAX ; save functions jump vector low byte
.ca7b 68 pla PLA ; get function jump vector high byte
.ca7c a8 tay TAY ; save functions jump vector high byte
.ca7d a5 af lda $af LDA des_ph ; get descriptor pointer high byte
.ca7f 48 pha PHA ; push string pointer high byte
.ca80 a5 ae lda $ae LDA des_pl ; get descriptor pointer low byte
.ca82 48 pha PHA ; push string pointer low byte
.ca83 98 tya TYA ; get function jump vector high byte back
.ca84 48 pha PHA ; save functions jump vector high byte
.ca85 8a txa TXA ; get function jump vector low byte back
.ca86 48 pha PHA ; save functions jump vector low byte
.ca87 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter
.ca8a 8a txa TXA ; copy byte parameter to A
.ca8b 60 rts RTS ; go do function
.ca8c lab_bhss
.ca8c 20 e9 c8 jsr $c8e9 JSR LAB_EVEZ ; process expression
.ca8f 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.ca92 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.ca94 c9 98 cmp #$98 CMP #$98 ; compare with exponent = 2^24
.ca96 b0 20 bcs $cab8 BCS LAB_BHER ; branch if n>=2^24 (is too big)
.ca98 20 50 d7 jsr $d750 JSR LAB_2831 ; convert FAC1 floating-to-fixed
.ca9b a2 02 ldx #$02 LDX #$02 ; 3 bytes to do
.ca9d lab_cfac
.ca9d b5 ad lda $ad,x LDA FAC1_1,X ; get byte from FAC1
.ca9f 95 11 sta $11,x STA nums_1,X ; save byte to temp
.caa1 ca dex DEX ; decrement index
.caa2 10 f9 bpl $ca9d BPL LAB_CFAC ; copy FAC1 mantissa to temp
.caa4 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get next BASIC byte
.caa7 a2 00 ldx #$00 LDX #$00 ; set default to no leading "0"s
.caa9 c9 29 cmp #$29 CMP #")" ; compare with close bracket
.caab f0 0a beq $cab7 BEQ LAB_1C54 ; if ")" go do rest of function
.caad 20 de d2 jsr $d2de JSR LAB_SCGB ; scan for "," and get byte
.cab0 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get last byte back
.cab3 c9 29 cmp #$29 CMP #")" ; is next character )
.cab5 d0 01 bne $cab8 BNE LAB_BHER ; if not ")" go do error
.cab7 lab_1c54
.cab7 60 rts RTS ; else do function
.cab8 lab_bher
.cab8 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start
.cabb lab_eor
.cabb 20 e2 ca jsr $cae2 JSR GetFirst ; get first integer expression (no sign check)
.cabe 45 5b eor $5b EOR XOAw_l ; EOR with expression 1 low byte
.cac0 a8 tay TAY ; save in Y
.cac1 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.cac3 45 5c eor $5c EOR XOAw_h ; EOR with expression 1 high byte
.cac5 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cac8 lab_or
.cac8 20 e2 ca jsr $cae2 JSR GetFirst ; get first integer expression (no sign check)
.cacb 05 5b ora $5b ORA XOAw_l ; OR with expression 1 low byte
.cacd a8 tay TAY ; save in Y
.cace a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.cad0 05 5c ora $5c ORA XOAw_h ; OR with expression 1 high byte
.cad2 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cad5 lab_and
.cad5 20 e2 ca jsr $cae2 JSR GetFirst ; get first integer expression (no sign check)
.cad8 25 5b and $5b AND XOAw_l ; AND with expression 1 low byte
.cada a8 tay TAY ; save in Y
.cadb a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.cadd 25 5c and $5c AND XOAw_h ; AND with expression 1 high byte
.cadf 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cae2 getfirst
.cae2 20 a6 cc jsr $cca6 JSR LAB_EVIR ; evaluate integer expression (no sign check)
.cae5 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.cae7 85 5c sta $5c STA XOAw_h ; save it
.cae9 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.caeb 85 5b sta $5b STA XOAw_l ; save it
.caed 20 c3 d3 jsr $d3c3 JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression)
.caf0 20 a6 cc jsr $cca6 JSR LAB_EVIR ; evaluate integer expression (no sign check)
.caf3 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.caf5 lab_1c95
.caf5 60 rts RTS
.caf6 lab_lthan
.caf6 20 d3 c8 jsr $c8d3 JSR LAB_CKTM ; type match check, set C for string
.caf9 b0 13 bcs $cb0e BCS LAB_1CAE ; branch if string
.cafb a5 b7 lda $b7 LDA FAC2_s ; get FAC2 sign (b7)
.cafd 09 7f ora #$7f ORA #$7F ; set all non sign bits
.caff 25 b4 and $b4 AND FAC2_1 ; and FAC2 mantissa1 (AND in sign bit)
.cb01 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.cb03 a9 b3 lda #$b3 LDA #<FAC2_e ; set pointer low byte to FAC2
.cb05 a0 00 ldy #$00 LDY #>FAC2_e ; set pointer high byte to FAC2
.cb07 20 17 d7 jsr $d717 JSR LAB_27F8 ; compare FAC1 with FAC2 (AY)
.cb0a aa tax TAX ; copy result
.cb0b 4c 3f cb jmp $cb3f JMP LAB_1CE1 ; go evaluate result
.cb0e lab_1cae
.cb0e 46 5f lsr $5f LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
.cb10 c6 9b dec $9b DEC comp_f ; clear < bit in compare function flag
.cb12 20 3e d1 jsr $d13e JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
.cb15 85 ac sta $ac STA str_ln ; save length
.cb17 86 ad stx $ad STX str_pl ; save string pointer low byte
.cb19 84 ae sty $ae STY str_ph ; save string pointer high byte
.cb1b a5 b5 lda $b5 LDA FAC2_2 ; get descriptor pointer low byte
.cb1d a4 b6 ldy $b6 LDY FAC2_3 ; get descriptor pointer high byte
.cb1f 20 42 d1 jsr $d142 JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
.cb22 86 b5 stx $b5 STX FAC2_2 ; save string pointer low byte
.cb24 84 b6 sty $b6 STY FAC2_3 ; save string pointer high byte
.cb26 aa tax TAX ; copy length
.cb27 38 sec SEC ; set carry for subtract
.cb28 e5 ac sbc $ac SBC str_ln ; subtract string 1 length
.cb2a f0 08 beq $cb34 BEQ LAB_1CD6 ; branch if str 1 length = string 2 length
.cb2c a9 01 lda #$01 LDA #$01 ; set str 1 length > string 2 length
.cb2e 90 04 bcc $cb34 BCC LAB_1CD6 ; branch if so
.cb30 a6 ac ldx $ac LDX str_ln ; get string 1 length
.cb32 a9 ff lda #$ff LDA #$FF ; set str 1 length < string 2 length
.cb34 lab_1cd6
.cb34 85 b0 sta $b0 STA FAC1_s ; save length compare
.cb36 a0 ff ldy #$ff LDY #$FF ; set index
.cb38 e8 inx INX ; adjust for loop
.cb39 lab_1cdb
.cb39 c8 iny INY ; increment index
.cb3a ca dex DEX ; decrement count
.cb3b d0 07 bne $cb44 BNE LAB_1CE6 ; branch if still bytes to do
.cb3d a6 b0 ldx $b0 LDX FAC1_s ; get length compare back
.cb3f lab_1ce1
.cb3f 30 0f bmi $cb50 BMI LAB_1CF2 ; branch if str 1 < str 2
.cb41 18 clc CLC ; flag str 1 <= str 2
.cb42 90 0c bcc $cb50 BCC LAB_1CF2 ; go evaluate result
.cb44 lab_1ce6
.cb44 b1 b5 lda ($b5),y LDA (FAC2_2),Y ; get string 2 byte
.cb46 d1 ad cmp ($ad),y CMP (FAC1_1),Y ; compare with string 1 byte
.cb48 f0 ef beq $cb39 BEQ LAB_1CDB ; loop if bytes =
.cb4a a2 ff ldx #$ff LDX #$FF ; set str 1 < string 2
.cb4c b0 02 bcs $cb50 BCS LAB_1CF2 ; branch if so
.cb4e a2 01 ldx #$01 LDX #$01 ; set str 1 > string 2
.cb50 lab_1cf2
.cb50 e8 inx INX ; x = 0, 1 or 2
.cb51 8a txa TXA ; copy to A
.cb52 2a rol ROL ; *2 (1, 2 or 4)
.cb53 25 63 and $63 AND Cflag ; AND with comparison evaluation flag
.cb55 f0 02 beq $cb59 BEQ LAB_1CFB ; branch if 0 (compare is false)
.cb57 a9 ff lda #$ff LDA #$FF ; else set result true
.cb59 lab_1cfb
.cb59 4c fa d6 jmp $d6fa JMP LAB_27DB ; save A as integer byte and return
.cb5c lab_1cfe
.cb5c 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for ",", else do syntax error then warm start
.cb5f lab_dim
.cb5f aa tax TAX ; copy "DIM" flag to X
.cb60 20 af cb jsr $cbaf JSR LAB_1D10 ; search for variable
.cb63 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.cb66 d0 f4 bne $cb5c BNE LAB_1CFE ; scan for "," and loop if not null
.cb68 60 rts RTS
.cb69 lab_lshift
.cb69 20 9f cb jsr $cb9f JSR GetPair ; get integer expression and byte (no sign check)
.cb6c a5 ae lda $ae LDA FAC1_2 ; get expression high byte
.cb6e a6 78 ldx $78 LDX TempB ; get shift count
.cb70 f0 22 beq $cb94 BEQ NoShift ; branch if zero
.cb72 e0 10 cpx #$10 CPX #$10 ; compare bit count with 16d
.cb74 b0 23 bcs $cb99 BCS TooBig ; branch if >=
.cb76 ls_loop
.cb76 06 af asl $af ASL FAC1_3 ; shift low byte
.cb78 2a rol ROL ; shift high byte
.cb79 ca dex DEX ; decrement bit count
.cb7a d0 fa bne $cb76 BNE Ls_loop ; loop if shift not complete
.cb7c a4 af ldy $af LDY FAC1_3 ; get expression low byte
.cb7e 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cb81 lab_rshift
.cb81 20 9f cb jsr $cb9f JSR GetPair ; get integer expression and byte (no sign check)
.cb84 a5 ae lda $ae LDA FAC1_2 ; get expression high byte
.cb86 a6 78 ldx $78 LDX TempB ; get shift count
.cb88 f0 0a beq $cb94 BEQ NoShift ; branch if zero
.cb8a e0 10 cpx #$10 CPX #$10 ; compare bit count with 16d
.cb8c b0 0b bcs $cb99 BCS TooBig ; branch if >=
.cb8e rs_loop
.cb8e 4a lsr LSR ; shift high byte
.cb8f 66 af ror $af ROR FAC1_3 ; shift low byte
.cb91 ca dex DEX ; decrement bit count
.cb92 d0 fa bne $cb8e BNE Rs_loop ; loop if shift not complete
.cb94 noshift
.cb94 a4 af ldy $af LDY FAC1_3 ; get expression low byte
.cb96 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cb99 toobig
.cb99 a9 00 lda #$00 LDA #$00 ; clear high byte
.cb9b a8 tay TAY ; copy to low byte
.cb9c 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.cb9f getpair
.cb9f 20 8f d2 jsr $d28f JSR LAB_EVBY ; evaluate byte expression, result in X
.cba2 86 78 stx $78 STX TempB ; save it
.cba4 20 c3 d3 jsr $d3c3 JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression)
.cba7 4c a6 cc jmp $cca6 JMP LAB_EVIR ; evaluate integer expression (no sign check)
.cbaa lab_gvar
.cbaa a2 00 ldx #$00 LDX #$00 ; set DIM flag = $00
.cbac 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory (1st character)
.cbaf lab_1d10
.cbaf 86 5e stx $5e STX Defdim ; save DIM flag
.cbb1 lab_1d12
.cbb1 85 93 sta $93 STA Varnm1 ; save 1st character
.cbb3 29 7f and #$7f AND #$7F ; clear FN flag bit
.cbb5 20 1e cc jsr $cc1e JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
.cbb8 b0 03 bcs $cbbd BCS LAB_1D1F ; branch if ok
.cbba 4c 02 ca jmp $ca02 JMP LAB_SNER ; else syntax error then warm start
.cbbd lab_1d1f
.cbbd a2 00 ldx #$00 LDX #$00 ; clear 2nd character temp
.cbbf 86 5f stx $5f STX Dtypef ; clear data type flag, $FF=string, $00=numeric
.cbc1 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory (2nd character)
.cbc4 90 05 bcc $cbcb BCC LAB_1D2D ; branch if character = "0"-"9" (ok)
.cbc6 20 1e cc jsr $cc1e JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
.cbc9 90 0b bcc $cbd6 BCC LAB_1D38 ; branch if <"A" or >"Z" (go check if string)
.cbcb lab_1d2d
.cbcb aa tax TAX ; copy 2nd character
.cbcc lab_1d2e
.cbcc 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory (3rd character)
.cbcf 90 fb bcc $cbcc BCC LAB_1D2E ; loop if character = "0"-"9" (ignore)
.cbd1 20 1e cc jsr $cc1e JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
.cbd4 b0 f6 bcs $cbcc BCS LAB_1D2E ; loop if character = "A"-"Z" (ignore)
.cbd6 lab_1d38
.cbd6 c9 24 cmp #$24 CMP #"$" ; compare with "$"
.cbd8 d0 0b bne $cbe5 BNE LAB_1D47 ; branch if not string
.cbda a9 ff lda #$ff LDA #$FF ; set data type = string
.cbdc 85 5f sta $5f STA Dtypef ; set data type flag, $FF=string, $00=numeric
.cbde 8a txa TXA ; get 2nd character back
.cbdf 09 80 ora #$80 ORA #$80 ; set top bit (indicate string var)
.cbe1 aa tax TAX ; copy back to 2nd character temp
.cbe2 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.cbe5 lab_1d47
.cbe5 86 94 stx $94 STX Varnm2 ; save 2nd character
.cbe7 05 61 ora $61 ORA Sufnxf ; or with subscript/FNX flag (or FN name)
.cbe9 c9 28 cmp #$28 CMP #"(" ; compare with "("
.cbeb d0 03 bne $cbf0 BNE LAB_1D53 ; branch if not "("
.cbed 4c b8 cc jmp $ccb8 JMP LAB_1E17 ; go find, or make, array
.cbf0 lab_1d53
.cbf0 a9 00 lda #$00 LDA #$00 ; clear A
.cbf2 85 61 sta $61 STA Sufnxf ; clear subscript/FNX flag
.cbf4 a5 7b lda $7b LDA Svarl ; get start of vars low byte
.cbf6 a6 7c ldx $7c LDX Svarh ; get start of vars high byte
.cbf8 a0 00 ldy #$00 LDY #$00 ; clear index
.cbfa lab_1d5d
.cbfa 86 ab stx $ab STX Vrschh ; save search address high byte
.cbfc lab_1d5f
.cbfc 85 aa sta $aa STA Vrschl ; save search address low byte
.cbfe e4 7e cpx $7e CPX Sarryh ; compare high address with var space end
.cc00 d0 04 bne $cc06 BNE LAB_1D69 ; skip next compare if <>
.cc02 c5 7d cmp $7d CMP Sarryl ; compare low address with var space end
.cc04 f0 2c beq $cc32 BEQ LAB_1D8B ; if not found go make new var
.cc06 lab_1d69
.cc06 a5 93 lda $93 LDA Varnm1 ; get 1st character of var to find
.cc08 d1 aa cmp ($aa),y CMP (Vrschl),Y ; compare with variable name 1st character
.cc0a d0 08 bne $cc14 BNE LAB_1D77 ; branch if no match
.cc0c a5 94 lda $94 LDA Varnm2 ; get 2nd character of var to find
.cc0e c8 iny INY ; index to point to variable name 2nd character
.cc0f d1 aa cmp ($aa),y CMP (Vrschl),Y ; compare with variable name 2nd character
.cc11 f0 69 beq $cc7c BEQ LAB_1DD7 ; branch if match (found var)
.cc13 88 dey DEY ; else decrement index (now = $00)
.cc14 lab_1d77
.cc14 18 clc CLC ; clear carry for add
.cc15 a5 aa lda $aa LDA Vrschl ; get search address low byte
.cc17 69 06 adc #$06 ADC #$06 ; +6 (offset to next var name)
.cc19 90 e1 bcc $cbfc BCC LAB_1D5F ; loop if no overflow to high byte
.cc1b e8 inx INX ; else increment high byte
.cc1c d0 dc bne $cbfa BNE LAB_1D5D ; loop always (RAM doesn't extend to $FFFF !)
.cc1e lab_casc
.cc1e c9 61 cmp #$61 CMP #"a" ; compare with "a"
.cc20 b0 0a bcs $cc2c BCS LAB_1D83 ; go check <"z"+1
.cc22 lab_1d82
.cc22 c9 41 cmp #$41 CMP #"A" ; compare with "A"
.cc24 90 05 bcc $cc2b BCC LAB_1D8A ; exit if less
.cc26 e9 5b sbc #$5b SBC #$5B ; subtract "Z"+1
.cc28 38 sec SEC ; set carry
.cc29 e9 a5 sbc #$a5 SBC #$A5 ; subtract $A5 (restore byte)
.cc2b lab_1d8a
.cc2b 60 rts RTS
.cc2c lab_1d83
.cc2c e9 7b sbc #$7b SBC #$7B ; subtract "z"+1
.cc2e 38 sec SEC ; set carry
.cc2f e9 85 sbc #$85 SBC #$85 ; subtract $85 (restore byte)
.cc31 60 rts RTS
.cc32 lab_1d8b
.cc32 68 pla PLA ; pop return address low byte
.cc33 48 pha PHA ; push return address low byte
.cc34 c9 3d cmp #$3d CMP #<LAB_1C18p2 ; compare with expected calling routine return low byte
.cc36 d0 05 bne $cc3d BNE LAB_1D98 ; if not get (var) go create new var
.cc38 a9 e1 lda #$e1 LDA #<LAB_1D96 ; low byte point to $00,$00
.cc3a a0 df ldy #$df LDY #>LAB_1D96 ; high byte point to $00,$00
.cc3c 60 rts RTS
.cc3d lab_1d98
.cc3d a5 7d lda $7d LDA Sarryl ; get var mem end low byte
.cc3f a4 7e ldy $7e LDY Sarryh ; get var mem end high byte
.cc41 85 aa sta $aa STA Ostrtl ; save old block start low byte
.cc43 84 ab sty $ab STY Ostrth ; save old block start high byte
.cc45 a5 7f lda $7f LDA Earryl ; get array mem end low byte
.cc47 a4 80 ldy $80 LDY Earryh ; get array mem end high byte
.cc49 85 a6 sta $a6 STA Obendl ; save old block end low byte
.cc4b 84 a7 sty $a7 STY Obendh ; save old block end high byte
.cc4d 18 clc CLC ; clear carry for add
.cc4e 69 06 adc #$06 ADC #$06 ; +6 (space for one var)
.cc50 90 01 bcc $cc53 BCC LAB_1DAE ; branch if no overflow to high byte
.cc52 c8 iny INY ; else increment high byte
.cc53 lab_1dae
.cc53 85 a4 sta $a4 STA Nbendl ; set new block end low byte
.cc55 84 a5 sty $a5 STY Nbendh ; set new block end high byte
.cc57 20 c1 be jsr $bec1 JSR LAB_11CF ; open up space in memory
.cc5a a5 a4 lda $a4 LDA Nbendl ; get new start low byte
.cc5c a4 a5 ldy $a5 LDY Nbendh ; get new start high byte (-$100)
.cc5e c8 iny INY ; correct high byte
.cc5f 85 7d sta $7d STA Sarryl ; save new var mem end low byte
.cc61 84 7e sty $7e STY Sarryh ; save new var mem end high byte
.cc63 a0 00 ldy #$00 LDY #$00 ; clear index
.cc65 a5 93 lda $93 LDA Varnm1 ; get var name 1st character
.cc67 91 aa sta ($aa),y STA (Vrschl),Y ; save var name 1st character
.cc69 c8 iny INY ; increment index
.cc6a a5 94 lda $94 LDA Varnm2 ; get var name 2nd character
.cc6c 91 aa sta ($aa),y STA (Vrschl),Y ; save var name 2nd character
.cc6e a9 00 lda #$00 LDA #$00 ; clear A
.cc70 c8 iny INY ; increment index
.cc71 91 aa sta ($aa),y STA (Vrschl),Y ; initialise var byte
.cc73 c8 iny INY ; increment index
.cc74 91 aa sta ($aa),y STA (Vrschl),Y ; initialise var byte
.cc76 c8 iny INY ; increment index
.cc77 91 aa sta ($aa),y STA (Vrschl),Y ; initialise var byte
.cc79 c8 iny INY ; increment index
.cc7a 91 aa sta ($aa),y STA (Vrschl),Y ; initialise var byte
.cc7c lab_1dd7
.cc7c a5 aa lda $aa LDA Vrschl ; get var address low byte
.cc7e 18 clc CLC ; clear carry for add
.cc7f 69 02 adc #$02 ADC #$02 ; +2 (offset past var name bytes)
.cc81 a4 ab ldy $ab LDY Vrschh ; get var address high byte
.cc83 90 01 bcc $cc86 BCC LAB_1DE1 ; branch if no overflow from add
.cc85 c8 iny INY ; else increment high byte
.cc86 lab_1de1
.cc86 85 95 sta $95 STA Cvaral ; save current var address low byte
.cc88 84 96 sty $96 STY Cvarah ; save current var address high byte
.cc8a 60 rts RTS
.cc8b lab_1de6
.cc8b a5 5d lda $5d LDA Dimcnt ; get # of dimensions (1, 2 or 3)
.cc8d 0a asl ASL ; *2 (also clears the carry !)
.cc8e 69 05 adc #$05 ADC #$05 ; +5 (result is 7, 9 or 11 here)
.cc90 65 aa adc $aa ADC Astrtl ; add array start pointer low byte
.cc92 a4 ab ldy $ab LDY Astrth ; get array pointer high byte
.cc94 90 01 bcc $cc97 BCC LAB_1DF2 ; branch if no overflow
.cc96 c8 iny INY ; else increment high byte
.cc97 lab_1df2
.cc97 85 a4 sta $a4 STA Adatal ; save array data pointer low byte
.cc99 84 a5 sty $a5 STY Adatah ; save array data pointer high byte
.cc9b 60 rts RTS
.cc9c lab_evin
.cc9c 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.cc9f 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.cca2 lab_evpi
.cca2 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.cca4 30 0d bmi $ccb3 BMI LAB_1E12 ; do function call error if -ve
.cca6 lab_evir
.cca6 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.cca8 c9 90 cmp #$90 CMP #$90 ; compare with exponent = 2^16 (n>2^15)
.ccaa 90 09 bcc $ccb5 BCC LAB_1E14 ; branch if n<2^16 (is ok)
.ccac a9 e8 lda #$e8 LDA #<LAB_1DF7 ; set pointer low byte to -32768
.ccae a0 df ldy #$df LDY #>LAB_1DF7 ; set pointer high byte to -32768
.ccb0 20 17 d7 jsr $d717 JSR LAB_27F8 ; compare FAC1 with (AY)
.ccb3 lab_1e12
.ccb3 d0 74 bne $cd29 BNE LAB_FCER ; if <> do function call error then warm start
.ccb5 lab_1e14
.ccb5 4c 50 d7 jmp $d750 JMP LAB_2831 ; convert FAC1 floating-to-fixed and return
.ccb8 lab_1e17
.ccb8 a5 5e lda $5e LDA Defdim ; get DIM flag
.ccba 48 pha PHA ; push it
.ccbb a5 5f lda $5f LDA Dtypef ; get data type flag, $FF=string, $00=numeric
.ccbd 48 pha PHA ; push it
.ccbe a0 00 ldy #$00 LDY #$00 ; clear dimensions count
.ccc0 lab_1e1f
.ccc0 98 tya TYA ; copy dimensions count
.ccc1 48 pha PHA ; save it
.ccc2 a5 94 lda $94 LDA Varnm2 ; get array name 2nd byte
.ccc4 48 pha PHA ; save it
.ccc5 a5 93 lda $93 LDA Varnm1 ; get array name 1st byte
.ccc7 48 pha PHA ; save it
.ccc8 20 9c cc jsr $cc9c JSR LAB_EVIN ; evaluate integer expression
.cccb 68 pla PLA ; pull array name 1st byte
.cccc 85 93 sta $93 STA Varnm1 ; restore array name 1st byte
.ccce 68 pla PLA ; pull array name 2nd byte
.cccf 85 94 sta $94 STA Varnm2 ; restore array name 2nd byte
.ccd1 68 pla PLA ; pull dimensions count
.ccd2 a8 tay TAY ; restore it
.ccd3 ba tsx TSX ; copy stack pointer
.ccd4 bd 02 01 lda $0102,x LDA LAB_STAK+2,X ; get DIM flag
.ccd7 48 pha PHA ; push it
.ccd8 bd 01 01 lda $0101,x LDA LAB_STAK+1,X ; get data type flag
.ccdb 48 pha PHA ; push it
.ccdc a5 ae lda $ae LDA FAC1_2 ; get this dimension size high byte
.ccde 9d 02 01 sta $0102,x STA LAB_STAK+2,X ; stack before flag bytes
.cce1 a5 af lda $af LDA FAC1_3 ; get this dimension size low byte
.cce3 9d 01 01 sta $0101,x STA LAB_STAK+1,X ; stack before flag bytes
.cce6 c8 iny INY ; increment dimensions count
.cce7 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.ccea c9 2c cmp #$2c CMP #"," ; compare with ","
.ccec f0 d2 beq $ccc0 BEQ LAB_1E1F ; if found go do next dimension
.ccee 84 5d sty $5d STY Dimcnt ; store dimensions count
.ccf0 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
.ccf3 68 pla PLA ; pull data type flag
.ccf4 85 5f sta $5f STA Dtypef ; restore data type flag, $FF=string, $00=numeric
.ccf6 68 pla PLA ; pull DIM flag
.ccf7 85 5e sta $5e STA Defdim ; restore DIM flag
.ccf9 a6 7d ldx $7d LDX Sarryl ; get array mem start low byte
.ccfb a5 7e lda $7e LDA Sarryh ; get array mem start high byte
.ccfd lab_1e5c
.ccfd 86 aa stx $aa STX Astrtl ; save as array start pointer low byte
.ccff 85 ab sta $ab STA Astrth ; save as array start pointer high byte
.cd01 c5 80 cmp $80 CMP Earryh ; compare with array mem end high byte
.cd03 d0 04 bne $cd09 BNE LAB_1E68 ; branch if not reached array mem end
.cd05 e4 7f cpx $7f CPX Earryl ; else compare with array mem end low byte
.cd07 f0 39 beq $cd42 BEQ LAB_1EA1 ; go build array if not found
.cd09 lab_1e68
.cd09 a0 00 ldy #$00 LDY #$00 ; clear index
.cd0b b1 aa lda ($aa),y LDA (Astrtl),Y ; get array name first byte
.cd0d c8 iny INY ; increment index to second name byte
.cd0e c5 93 cmp $93 CMP Varnm1 ; compare with this array name first byte
.cd10 d0 06 bne $cd18 BNE LAB_1E77 ; branch if no match
.cd12 a5 94 lda $94 LDA Varnm2 ; else get this array name second byte
.cd14 d1 aa cmp ($aa),y CMP (Astrtl),Y ; compare with array name second byte
.cd16 f0 16 beq $cd2e BEQ LAB_1E8D ; array found so branch
.cd18 lab_1e77
.cd18 c8 iny INY ; increment index
.cd19 b1 aa lda ($aa),y LDA (Astrtl),Y ; get array size low byte
.cd1b 18 clc CLC ; clear carry for add
.cd1c 65 aa adc $aa ADC Astrtl ; add array start pointer low byte
.cd1e aa tax TAX ; copy low byte to X
.cd1f c8 iny INY ; increment index
.cd20 b1 aa lda ($aa),y LDA (Astrtl),Y ; get array size high byte
.cd22 65 ab adc $ab ADC Astrth ; add array mem pointer high byte
.cd24 90 d7 bcc $ccfd BCC LAB_1E5C ; if no overflow go check next array
.cd26 lab_1e85
.cd26 a2 10 ldx #$10 LDX #$10 ; error code $10 ("Array bounds" error)
>cd28 2c .byte $2C ; makes next bit BIT LAB_08A2
.cd29 lab_fcer
.cd29 a2 08 ldx #$08 LDX #$08 ; error code $08 ("Function call" error)
.cd2b lab_1e8a
.cd2b 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.cd2e lab_1e8d
.cd2e a2 12 ldx #$12 LDX #$12 ; set error $12 ("Double dimension" error)
.cd30 a5 5e lda $5e LDA Defdim ; get DIM flag
.cd32 d0 f7 bne $cd2b BNE LAB_1E8A ; if we are trying to dimension it do error #X, then warm
.cd34 20 8b cc jsr $cc8b JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array
.cd37 a5 5d lda $5d LDA Dimcnt ; get dimensions count
.cd39 a0 04 ldy #$04 LDY #$04 ; set index to array's # of dimensions
.cd3b d1 aa cmp ($aa),y CMP (Astrtl),Y ; compare with no of dimensions
.cd3d d0 e7 bne $cd26 BNE LAB_1E85 ; if wrong do array bounds error, could do "Wrong
.cd3f 4c c5 cd jmp $cdc5 JMP LAB_1F28 ; found array so go get element
.cd42 lab_1ea1
.cd42 20 8b cc jsr $cc8b JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array
.cd45 20 0b bf jsr $bf0b JSR LAB_121F ; check available memory, "Out of memory" error if no room
.cd48 a0 00 ldy #$00 LDY #$00 ; clear Y (don't need to clear A)
.cd4a 84 bb sty $bb STY Aspth ; clear array data size high byte
.cd4c a5 93 lda $93 LDA Varnm1 ; get variable name 1st byte
.cd4e 91 aa sta ($aa),y STA (Astrtl),Y ; save array name 1st byte
.cd50 c8 iny INY ; increment index
.cd51 a5 94 lda $94 LDA Varnm2 ; get variable name 2nd byte
.cd53 91 aa sta ($aa),y STA (Astrtl),Y ; save array name 2nd byte
.cd55 a5 5d lda $5d LDA Dimcnt ; get dimensions count
.cd57 a0 04 ldy #$04 LDY #$04 ; index to dimension count
.cd59 84 ba sty $ba STY Asptl ; set array data size low byte (four bytes per element)
.cd5b 91 aa sta ($aa),y STA (Astrtl),Y ; set array's dimensions count
.cd5d 18 clc CLC ; clear carry for add (clear on subsequent loops)
.cd5e lab_1ec0
.cd5e a2 0b ldx #$0b LDX #$0B ; set default dimension value low byte
.cd60 a9 00 lda #$00 LDA #$00 ; set default dimension value high byte
.cd62 24 5e bit $5e BIT Defdim ; test default DIM flag
.cd64 50 07 bvc $cd6d BVC LAB_1ED0 ; branch if b6 of Defdim is clear
.cd66 68 pla PLA ; else pull dimension value low byte
.cd67 69 01 adc #$01 ADC #$01 ; +1 (allow for zeroeth element)
.cd69 aa tax TAX ; copy low byte to X
.cd6a 68 pla PLA ; pull dimension value high byte
.cd6b 69 00 adc #$00 ADC #$00 ; add carry from low byte
.cd6d lab_1ed0
.cd6d c8 iny INY ; index to dimension value high byte
.cd6e 91 aa sta ($aa),y STA (Astrtl),Y ; save dimension value high byte
.cd70 c8 iny INY ; index to dimension value high byte
.cd71 8a txa TXA ; get dimension value low byte
.cd72 91 aa sta ($aa),y STA (Astrtl),Y ; save dimension value low byte
.cd74 20 14 ce jsr $ce14 JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl)
.cd77 86 ba stx $ba STX Asptl ; save array data size low byte
.cd79 85 bb sta $bb STA Aspth ; save array data size high byte
.cd7b a4 71 ldy $71 LDY ut1_pl ; restore index (saved by subroutine)
.cd7d c6 5d dec $5d DEC Dimcnt ; decrement dimensions count
.cd7f d0 dd bne $cd5e BNE LAB_1EC0 ; loop while not = 0
.cd81 65 a5 adc $a5 ADC Adatah ; add size high byte to first element high byte
.cd83 b0 5d bcs $cde2 BCS LAB_1F45 ; if overflow go do "Out of memory" error
.cd85 85 a5 sta $a5 STA Adatah ; save end of array high byte
.cd87 a8 tay TAY ; copy end high byte to Y
.cd88 8a txa TXA ; get array size low byte
.cd89 65 a4 adc $a4 ADC Adatal ; add array start low byte
.cd8b 90 03 bcc $cd90 BCC LAB_1EF3 ; branch if no carry
.cd8d c8 iny INY ; else increment end of array high byte
.cd8e f0 52 beq $cde2 BEQ LAB_1F45 ; if overflow go do "Out of memory" error
.cd90 lab_1ef3
.cd90 20 0b bf jsr $bf0b JSR LAB_121F ; check available memory, "Out of memory" error if no room
.cd93 85 7f sta $7f STA Earryl ; save array mem end low byte
.cd95 84 80 sty $80 STY Earryh ; save array mem end high byte
.cd97 a9 00 lda #$00 LDA #$00 ; clear byte for array clear
.cd99 e6 bb inc $bb INC Aspth ; increment array size high byte (now block count)
.cd9b a4 ba ldy $ba LDY Asptl ; get array size low byte (now index to block)
.cd9d f0 05 beq $cda4 BEQ LAB_1F07 ; branch if low byte = $00
.cd9f lab_1f02
.cd9f 88 dey DEY ; decrement index (do 0 to n-1)
.cda0 91 a4 sta ($a4),y STA (Adatal),Y ; zero byte
.cda2 d0 fb bne $cd9f BNE LAB_1F02 ; loop until this block done
.cda4 lab_1f07
.cda4 c6 a5 dec $a5 DEC Adatah ; decrement array pointer high byte
.cda6 c6 bb dec $bb DEC Aspth ; decrement block count high byte
.cda8 d0 f5 bne $cd9f BNE LAB_1F02 ; loop until all blocks done
.cdaa e6 a5 inc $a5 INC Adatah ; correct for last loop
.cdac 38 sec SEC ; set carry for subtract
.cdad a0 02 ldy #$02 LDY #$02 ; index to array size low byte
.cdaf a5 7f lda $7f LDA Earryl ; get array mem end low byte
.cdb1 e5 aa sbc $aa SBC Astrtl ; subtract array start low byte
.cdb3 91 aa sta ($aa),y STA (Astrtl),Y ; save array size low byte
.cdb5 c8 iny INY ; index to array size high byte
.cdb6 a5 80 lda $80 LDA Earryh ; get array mem end high byte
.cdb8 e5 ab sbc $ab SBC Astrth ; subtract array start high byte
.cdba 91 aa sta ($aa),y STA (Astrtl),Y ; save array size high byte
.cdbc a5 5e lda $5e LDA Defdim ; get default DIM flag
.cdbe d0 53 bne $ce13 BNE LAB_1F7B ; exit (RET) if this was a DIM command
.cdc0 c8 iny INY ; index to # of dimensions
.cdc1 lab_1f24
.cdc1 b1 aa lda ($aa),y LDA (Astrtl),Y ; get array's dimension count
.cdc3 85 5d sta $5d STA Dimcnt ; save it
.cdc5 lab_1f28
.cdc5 a9 00 lda #$00 LDA #$00 ; clear byte
.cdc7 85 ba sta $ba STA Asptl ; clear array data pointer low byte
.cdc9 lab_1f2c
.cdc9 85 bb sta $bb STA Aspth ; save array data pointer high byte
.cdcb c8 iny INY ; increment index (point to array bound high byte)
.cdcc 68 pla PLA ; pull array index low byte
.cdcd aa tax TAX ; copy to X
.cdce 85 ae sta $ae STA FAC1_2 ; save index low byte to FAC1 mantissa2
.cdd0 68 pla PLA ; pull array index high byte
.cdd1 85 af sta $af STA FAC1_3 ; save index high byte to FAC1 mantissa3
.cdd3 d1 aa cmp ($aa),y CMP (Astrtl),Y ; compare with array bound high byte
.cdd5 90 0e bcc $cde5 BCC LAB_1F48 ; branch if within bounds
.cdd7 d0 06 bne $cddf BNE LAB_1F42 ; if outside bounds do array bounds error
.cdd9 c8 iny INY ; index to array bound low byte
.cdda 8a txa TXA ; get array index low byte
.cddb d1 aa cmp ($aa),y CMP (Astrtl),Y ; compare with array bound low byte
.cddd 90 07 bcc $cde6 BCC LAB_1F49 ; branch if within bounds
.cddf lab_1f42
.cddf 4c 26 cd jmp $cd26 JMP LAB_1E85 ; else do array bounds error
.cde2 lab_1f45
.cde2 4c 3a bf jmp $bf3a JMP LAB_OMER ; do "Out of memory" error then warm start
.cde5 lab_1f48
.cde5 c8 iny INY ; index to array bound low byte
.cde6 lab_1f49
.cde6 a5 bb lda $bb LDA Aspth ; get array data pointer high byte
.cde8 05 ba ora $ba ORA Asptl ; OR with array data pointer low byte
.cdea f0 0a beq $cdf6 BEQ LAB_1F5A ; branch if array data pointer = null (skip multiply)
.cdec 20 14 ce jsr $ce14 JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl)
.cdef 8a txa TXA ; get result low byte
.cdf0 65 ae adc $ae ADC FAC1_2 ; add index low byte from FAC1 mantissa2
.cdf2 aa tax TAX ; save result low byte
.cdf3 98 tya TYA ; get result high byte
.cdf4 a4 71 ldy $71 LDY ut1_pl ; restore index
.cdf6 lab_1f5a
.cdf6 65 af adc $af ADC FAC1_3 ; add index high byte from FAC1 mantissa3
.cdf8 86 ba stx $ba STX Asptl ; save array data pointer low byte
.cdfa c6 5d dec $5d DEC Dimcnt ; decrement dimensions count
.cdfc d0 cb bne $cdc9 BNE LAB_1F2C ; loop if dimensions still to do
.cdfe 06 ba asl $ba ASL Asptl ; array data pointer low byte * 2
.ce00 2a rol ROL ; array data pointer high byte * 2
.ce01 06 ba asl $ba ASL Asptl ; array data pointer low byte * 4
.ce03 2a rol ROL ; array data pointer high byte * 4
.ce04 a8 tay TAY ; copy high byte
.ce05 a5 ba lda $ba LDA Asptl ; get low byte
.ce07 65 a4 adc $a4 ADC Adatal ; add array data start pointer low byte
.ce09 85 95 sta $95 STA Cvaral ; save as current var address low byte
.ce0b 98 tya TYA ; get high byte back
.ce0c 65 a5 adc $a5 ADC Adatah ; add array data start pointer high byte
.ce0e 85 96 sta $96 STA Cvarah ; save as current var address high byte
.ce10 a8 tay TAY ; copy high byte to Y
.ce11 a5 95 lda $95 LDA Cvaral ; get current var address low byte
.ce13 lab_1f7b
.ce13 60 rts RTS
.ce14 lab_1f7c
.ce14 84 71 sty $71 STY ut1_pl ; save index
.ce16 b1 aa lda ($aa),y LDA (Astrtl),Y ; get dimension size low byte
.ce18 85 76 sta $76 STA dims_l ; save dimension size low byte
.ce1a 88 dey DEY ; decrement index
.ce1b b1 aa lda ($aa),y LDA (Astrtl),Y ; get dimension size high byte
.ce1d 85 77 sta $77 STA dims_h ; save dimension size high byte
.ce1f a9 10 lda #$10 LDA #$10 ; count = $10 (16 bit multiply)
.ce21 85 a8 sta $a8 STA numbit ; save bit count
.ce23 a2 00 ldx #$00 LDX #$00 ; clear result low byte
.ce25 a0 00 ldy #$00 LDY #$00 ; clear result high byte
.ce27 lab_1f8f
.ce27 8a txa TXA ; get result low byte
.ce28 0a asl ASL ; *2
.ce29 aa tax TAX ; save result low byte
.ce2a 98 tya TYA ; get result high byte
.ce2b 2a rol ROL ; *2
.ce2c a8 tay TAY ; save result high byte
.ce2d b0 b3 bcs $cde2 BCS LAB_1F45 ; if overflow go do "Out of memory" error
.ce2f 06 ba asl $ba ASL Asptl ; shift multiplier low byte
.ce31 26 bb rol $bb ROL Aspth ; shift multiplier high byte
.ce33 90 0b bcc $ce40 BCC LAB_1FA8 ; skip add if no carry
.ce35 18 clc CLC ; else clear carry for add
.ce36 8a txa TXA ; get result low byte
.ce37 65 76 adc $76 ADC dims_l ; add dimension size low byte
.ce39 aa tax TAX ; save result low byte
.ce3a 98 tya TYA ; get result high byte
.ce3b 65 77 adc $77 ADC dims_h ; add dimension size high byte
.ce3d a8 tay TAY ; save result high byte
.ce3e b0 a2 bcs $cde2 BCS LAB_1F45 ; if overflow go do "Out of memory" error
.ce40 lab_1fa8
.ce40 c6 a8 dec $a8 DEC numbit ; decrement bit count
.ce42 d0 e3 bne $ce27 BNE LAB_1F8F ; loop until all done
.ce44 60 rts RTS
.ce45 lab_fre
.ce45 a5 5f lda $5f LDA Dtypef ; get data type flag, $FF=string, $00=numeric
.ce47 10 03 bpl $ce4c BPL LAB_1FB4 ; branch if numeric
.ce49 20 3e d1 jsr $d13e JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
.ce4c lab_1fb4
.ce4c 20 df cf jsr $cfdf JSR LAB_GARB ; go do garbage collection
.ce4f 38 sec SEC ; set carry for subtract
.ce50 a5 81 lda $81 LDA Sstorl ; get bottom of string space low byte
.ce52 e5 7f sbc $7f SBC Earryl ; subtract array mem end low byte
.ce54 a8 tay TAY ; copy result to Y
.ce55 a5 82 lda $82 LDA Sstorh ; get bottom of string space high byte
.ce57 e5 80 sbc $80 SBC Earryh ; subtract array mem end high byte
.ce59 lab_ayfc
.ce59 46 5f lsr $5f LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
.ce5b 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.ce5d 84 ae sty $ae STY FAC1_2 ; save FAC1 mantissa2
.ce5f a2 90 ldx #$90 LDX #$90 ; set exponent=2^16 (integer)
.ce61 4c 02 d7 jmp $d702 JMP LAB_27E3 ; set exp=X, clear FAC1_3, normalise and return
.ce64 lab_pos
.ce64 a4 0e ldy $0e LDY TPos ; get terminal position
.ce66 lab_1fd0
.ce66 a9 00 lda #$00 LDA #$00 ; clear high byte
.ce68 f0 ef beq $ce59 BEQ LAB_AYFC ; always save and convert integer AY to FAC1 and return
.ce6a lab_ckrn
.ce6a a6 88 ldx $88 LDX Clineh ; get current line high byte
.ce6c e8 inx INX ; increment it
.ce6d d0 a4 bne $ce13 BNE LAB_1F7B ; return if can continue not direct mode
.ce6f lab_1fd9
.ce6f a2 16 ldx #$16 LDX #$16 ; error code $16 ("Illegal direct" error)
.ce71 lab_1fdb
.ce71 4c 3c bf jmp $bf3c JMP LAB_XERR ; go do error #X, then warm start
.ce74 lab_def
.ce74 20 a5 ce jsr $cea5 JSR LAB_200B ; check FNx syntax
.ce77 85 9c sta $9c STA func_l ; save function pointer low byte
.ce79 84 9d sty $9d STY func_h ; save function pointer high byte
.ce7b 20 6a ce jsr $ce6a JSR LAB_CKRN ; check not Direct (back here if ok)
.ce7e 20 fa c9 jsr $c9fa JSR LAB_1BFE ; scan for "(" , else do syntax error then warm start
.ce81 a9 80 lda #$80 LDA #$80 ; set flag for FNx
.ce83 85 61 sta $61 STA Sufnxf ; save subscript/FNx flag
.ce85 20 aa cb jsr $cbaa JSR LAB_GVAR ; get (var) address
.ce88 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.ce8b 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
.ce8e a9 c2 lda #$c2 LDA #TK_EQUAL ; get = token
.ce90 20 f1 c9 jsr $c9f1 JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
.ce93 a5 96 lda $96 LDA Cvarah ; get current var address high byte
.ce95 48 pha PHA ; push it
.ce96 a5 95 lda $95 LDA Cvaral ; get current var address low byte
.ce98 48 pha PHA ; push it
.ce99 a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.ce9b 48 pha PHA ; push it
.ce9c a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.ce9e 48 pha PHA ; push it
.ce9f 20 8c c4 jsr $c48c JSR LAB_DATA ; go perform DATA
.cea2 4c 14 cf jmp $cf14 JMP LAB_207A ; put execute pointer and variable pointer into function
.cea5 lab_200b
.cea5 a9 af lda #$af LDA #TK_FN ; get FN" token
.cea7 20 f1 c9 jsr $c9f1 JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start
.ceaa 09 80 ora #$80 ORA #$80 ; set FN flag bit
.ceac 85 61 sta $61 STA Sufnxf ; save FN flag so array variable test fails
.ceae 20 b1 cb jsr $cbb1 JSR LAB_1D12 ; search for FN variable
.ceb1 4c d0 c8 jmp $c8d0 JMP LAB_CTNM ; check if source is numeric and return, else do type
.ceb4 lab_201e
.ceb4 20 a5 ce jsr $cea5 JSR LAB_200B ; check FNx syntax
.ceb7 48 pha PHA ; push function pointer low byte
.ceb8 98 tya TYA ; copy function pointer high byte
.ceb9 48 pha PHA ; push function pointer high byte
.ceba 20 fa c9 jsr $c9fa JSR LAB_1BFE ; scan for "(", else do syntax error then warm start
.cebd 20 e1 c8 jsr $c8e1 JSR LAB_EVEX ; evaluate expression
.cec0 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
.cec3 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.cec6 68 pla PLA ; pop function pointer high byte
.cec7 85 9d sta $9d STA func_h ; restore it
.cec9 68 pla PLA ; pop function pointer low byte
.ceca 85 9c sta $9c STA func_l ; restore it
.cecc a2 20 ldx #$20 LDX #$20 ; error code $20 ("Undefined function" error)
.cece a0 03 ldy #$03 LDY #$03 ; index to variable pointer high byte
.ced0 b1 9c lda ($9c),y LDA (func_l),Y ; get variable pointer high byte
.ced2 f0 9d beq $ce71 BEQ LAB_1FDB ; if zero go do undefined function error
.ced4 85 96 sta $96 STA Cvarah ; save variable address high byte
.ced6 88 dey DEY ; index to variable address low byte
.ced7 b1 9c lda ($9c),y LDA (func_l),Y ; get variable address low byte
.ced9 85 95 sta $95 STA Cvaral ; save variable address low byte
.cedb aa tax TAX ; copy address low byte
.cedc c8 iny INY ; index to mantissa_3
.cedd lab_2043
.cedd b1 95 lda ($95),y LDA (Cvaral),Y ; get byte from variable
.cedf 48 pha PHA ; stack it
.cee0 88 dey DEY ; decrement index
.cee1 10 fa bpl $cedd BPL LAB_2043 ; loop until variable stacked
.cee3 a4 96 ldy $96 LDY Cvarah ; get variable address high byte
.cee5 20 a7 d6 jsr $d6a7 JSR LAB_2778 ; pack FAC1 (function expression value) into (XY)
.cee8 a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.ceea 48 pha PHA ; push it
.ceeb a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.ceed 48 pha PHA ; push it
.ceee b1 9c lda ($9c),y LDA (func_l),Y ; get function execute pointer low byte
.cef0 85 c3 sta $c3 STA Bpntrl ; save as BASIC execute pointer low byte
.cef2 c8 iny INY ; index to high byte
.cef3 b1 9c lda ($9c),y LDA (func_l),Y ; get function execute pointer high byte
.cef5 85 c4 sta $c4 STA Bpntrh ; save as BASIC execute pointer high byte
.cef7 a5 96 lda $96 LDA Cvarah ; get variable address high byte
.cef9 48 pha PHA ; push it
.cefa a5 95 lda $95 LDA Cvaral ; get variable address low byte
.cefc 48 pha PHA ; push it
.cefd 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.cf00 68 pla PLA ; pull variable address low byte
.cf01 85 9c sta $9c STA func_l ; save variable address low byte
.cf03 68 pla PLA ; pull variable address high byte
.cf04 85 9d sta $9d STA func_h ; save variable address high byte
.cf06 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.cf09 f0 03 beq $cf0e BEQ LAB_2074 ; branch if null (should be [EOL] marker)
.cf0b 4c 02 ca jmp $ca02 JMP LAB_SNER ; else syntax error then warm start
.cf0e lab_2074
.cf0e 68 pla PLA ; pull BASIC execute pointer low byte
.cf0f 85 c3 sta $c3 STA Bpntrl ; restore BASIC execute pointer low byte
.cf11 68 pla PLA ; pull BASIC execute pointer high byte
.cf12 85 c4 sta $c4 STA Bpntrh ; restore BASIC execute pointer high byte
.cf14 lab_207a
.cf14 a0 00 ldy #$00 LDY #$00 ; clear index
.cf16 68 pla PLA ; pull BASIC execute pointer low byte
.cf17 91 9c sta ($9c),y STA (func_l),Y ; save to function
.cf19 c8 iny INY ; increment index
.cf1a 68 pla PLA ; pull BASIC execute pointer high byte
.cf1b 91 9c sta ($9c),y STA (func_l),Y ; save to function
.cf1d c8 iny INY ; increment index
.cf1e 68 pla PLA ; pull current var address low byte
.cf1f 91 9c sta ($9c),y STA (func_l),Y ; save to function
.cf21 c8 iny INY ; increment index
.cf22 68 pla PLA ; pull current var address high byte
.cf23 91 9c sta ($9c),y STA (func_l),Y ; save to function
.cf25 60 rts RTS
.cf26 lab_strs
.cf26 20 d0 c8 jsr $c8d0 JSR LAB_CTNM ; check if source is numeric, else do type mismatch
.cf29 20 95 d8 jsr $d895 JSR LAB_296E ; convert FAC1 to string
.cf2c a9 f0 lda #$f0 LDA #<Decssp1 ; set result string low pointer
.cf2e a0 00 ldy #$00 LDY #>Decssp1 ; set result string high pointer
.cf30 f0 12 beq $cf44 BEQ LAB_20AE ; print null terminated string to Sutill/Sutilh
.cf32 lab_209c
.cf32 a6 ae ldx $ae LDX des_pl ; get descriptor pointer low byte
.cf34 a4 af ldy $af LDY des_ph ; get descriptor pointer high byte
.cf36 86 9e stx $9e STX des_2l ; save descriptor pointer low byte
.cf38 84 9f sty $9f STY des_2h ; save descriptor pointer high byte
.cf3a lab_mssp
.cf3a 20 ad cf jsr $cfad JSR LAB_2115 ; make space in string memory for string A long
.cf3d 86 ad stx $ad STX str_pl ; save string pointer low byte
.cf3f 84 ae sty $ae STY str_ph ; save string pointer high byte
.cf41 85 ac sta $ac STA str_ln ; save length
.cf43 60 rts RTS
.cf44 lab_20ae
.cf44 a2 22 ldx #$22 LDX #$22 ; set terminator to "
.cf46 86 5b stx $5b STX Srchc ; set search character (terminator 1)
.cf48 86 5c stx $5c STX Asrch ; set terminator 2
.cf4a lab_20b4
.cf4a 85 b8 sta $b8 STA ssptr_l ; store string start low byte
.cf4c 84 b9 sty $b9 STY ssptr_h ; store string start high byte
.cf4e 85 ad sta $ad STA str_pl ; save string pointer low byte
.cf50 84 ae sty $ae STY str_ph ; save string pointer high byte
.cf52 a0 ff ldy #$ff LDY #$FF ; set length to -1
.cf54 lab_20be
.cf54 c8 iny INY ; increment length
.cf55 b1 b8 lda ($b8),y LDA (ssptr_l),Y ; get byte from string
.cf57 f0 0c beq $cf65 BEQ LAB_20CF ; exit loop if null byte [EOS]
.cf59 c5 5b cmp $5b CMP Srchc ; compare with search character (terminator 1)
.cf5b f0 04 beq $cf61 BEQ LAB_20CB ; branch if terminator
.cf5d c5 5c cmp $5c CMP Asrch ; compare with terminator 2
.cf5f d0 f3 bne $cf54 BNE LAB_20BE ; loop if not terminator 2
.cf61 lab_20cb
.cf61 c9 22 cmp #$22 CMP #$22 ; compare with "
.cf63 f0 01 beq $cf66 BEQ LAB_20D0 ; branch if " (carry set if = !)
.cf65 lab_20cf
.cf65 18 clc CLC ; clear carry for add (only if [EOL] terminated string)
.cf66 lab_20d0
.cf66 84 ac sty $ac STY str_ln ; save length in FAC1 exponent
.cf68 98 tya TYA ; copy length to A
.cf69 65 b8 adc $b8 ADC ssptr_l ; add string start low byte
.cf6b 85 ba sta $ba STA Sendl ; save string end low byte
.cf6d a6 b9 ldx $b9 LDX ssptr_h ; get string start high byte
.cf6f 90 01 bcc $cf72 BCC LAB_20DC ; branch if no low byte overflow
.cf71 e8 inx INX ; else increment high byte
.cf72 lab_20dc
.cf72 86 bb stx $bb STX Sendh ; save string end high byte
.cf74 a5 b9 lda $b9 LDA ssptr_h ; get string start high byte
.cf76 c9 05 cmp #$05 CMP #>Ram_base ; compare with start of program memory
.cf78 b0 0b bcs $cf85 BCS LAB_RTST ; branch if not in utility area
.cf7a 98 tya TYA ; copy length to A
.cf7b 20 32 cf jsr $cf32 JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes
.cf7e a6 b8 ldx $b8 LDX ssptr_l ; get string start low byte
.cf80 a4 b9 ldy $b9 LDY ssptr_h ; get string start high byte
.cf82 20 1f d1 jsr $d11f JSR LAB_2298 ; store string A bytes long from XY to (Sutill)
.cf85 lab_rtst
.cf85 a6 65 ldx $65 LDX next_s ; get string stack pointer
.cf87 e0 71 cpx #$71 CPX #des_sk+$09 ; compare with max+1
.cf89 d0 05 bne $cf90 BNE LAB_20F8 ; branch if space on string stack
.cf8b a2 1c ldx #$1c LDX #$1C ; error code $1C ("String too complex" error)
.cf8d lab_20f5
.cf8d 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.cf90 lab_20f8
.cf90 a5 ac lda $ac LDA str_ln ; get string length
.cf92 95 00 sta $00,x STA PLUS_0,X ; put on string stack
.cf94 a5 ad lda $ad LDA str_pl ; get string pointer low byte
.cf96 95 01 sta $01,x STA PLUS_1,X ; put on string stack
.cf98 a5 ae lda $ae LDA str_ph ; get string pointer high byte
.cf9a 95 02 sta $02,x STA PLUS_2,X ; put on string stack
.cf9c a0 00 ldy #$00 LDY #$00 ; clear Y
.cf9e 86 ae stx $ae STX des_pl ; save string descriptor pointer low byte
.cfa0 84 af sty $af STY des_ph ; save string descriptor pointer high byte (always $00)
.cfa2 88 dey DEY ; Y = $FF
.cfa3 84 5f sty $5f STY Dtypef ; save data type flag, $FF=string
.cfa5 86 66 stx $66 STX last_sl ; save old stack pointer (current top item)
.cfa7 e8 inx INX ; update stack pointer
.cfa8 e8 inx INX ; update stack pointer
.cfa9 e8 inx INX ; update stack pointer
.cfaa 86 65 stx $65 STX next_s ; save new top item value
.cfac 60 rts RTS
.cfad lab_2115
.cfad 46 60 lsr $60 LSR Gclctd ; clear garbage collected flag (b7)
.cfaf lab_2117
.cfaf 48 pha PHA ; save string length
.cfb0 49 ff eor #$ff EOR #$FF ; complement it
.cfb2 38 sec SEC ; set carry for subtract (twos comp add)
.cfb3 65 81 adc $81 ADC Sstorl ; add bottom of string space low byte (subtract length)
.cfb5 a4 82 ldy $82 LDY Sstorh ; get bottom of string space high byte
.cfb7 b0 01 bcs $cfba BCS LAB_2122 ; skip decrement if no underflow
.cfb9 88 dey DEY ; decrement bottom of string space high byte
.cfba lab_2122
.cfba c4 80 cpy $80 CPY Earryh ; compare with array mem end high byte
.cfbc 90 11 bcc $cfcf BCC LAB_2137 ; do out of memory error if less
.cfbe d0 04 bne $cfc4 BNE LAB_212C ; if not = skip next test
.cfc0 c5 7f cmp $7f CMP Earryl ; compare with array mem end low byte
.cfc2 90 0b bcc $cfcf BCC LAB_2137 ; do out of memory error if less
.cfc4 lab_212c
.cfc4 85 81 sta $81 STA Sstorl ; save bottom of string space low byte
.cfc6 84 82 sty $82 STY Sstorh ; save bottom of string space high byte
.cfc8 85 83 sta $83 STA Sutill ; save string utility ptr low byte
.cfca 84 84 sty $84 STY Sutilh ; save string utility ptr high byte
.cfcc aa tax TAX ; copy low byte to X
.cfcd 68 pla PLA ; get string length back
.cfce 60 rts RTS
.cfcf lab_2137
.cfcf a2 0c ldx #$0c LDX #$0C ; error code $0C ("Out of memory" error)
.cfd1 a5 60 lda $60 LDA Gclctd ; get garbage collected flag
.cfd3 30 b8 bmi $cf8d BMI LAB_20F5 ; if set then do error code X
.cfd5 20 df cf jsr $cfdf JSR LAB_GARB ; else go do garbage collection
.cfd8 a9 80 lda #$80 LDA #$80 ; flag for garbage collected
.cfda 85 60 sta $60 STA Gclctd ; set garbage collected flag
.cfdc 68 pla PLA ; pull length
.cfdd d0 d0 bne $cfaf BNE LAB_2117 ; go try again (loop always, length should never be = $00)
.cfdf lab_garb
.cfdf a6 85 ldx $85 LDX Ememl ; get end of mem low byte
.cfe1 a5 86 lda $86 LDA Ememh ; get end of mem high byte
.cfe3 lab_214b
.cfe3 86 81 stx $81 STX Sstorl ; set string storage low byte
.cfe5 85 82 sta $82 STA Sstorh ; set string storage high byte
.cfe7 a0 00 ldy #$00 LDY #$00 ; clear index
.cfe9 84 9d sty $9d STY garb_h ; clear working pointer high byte (flag no strings to move)
.cfeb a5 7f lda $7f LDA Earryl ; get array mem end low byte
.cfed a6 80 ldx $80 LDX Earryh ; get array mem end high byte
.cfef 85 aa sta $aa STA Histrl ; save as highest string low byte
.cff1 86 ab stx $ab STX Histrh ; save as highest string high byte
.cff3 a9 68 lda #$68 LDA #des_sk ; set descriptor stack pointer
.cff5 85 71 sta $71 STA ut1_pl ; save descriptor stack pointer low byte
.cff7 84 72 sty $72 STY ut1_ph ; save descriptor stack pointer high byte ($00)
.cff9 lab_2161
.cff9 c5 65 cmp $65 CMP next_s ; compare with descriptor stack pointer
.cffb f0 05 beq $d002 BEQ LAB_216A ; branch if =
.cffd 20 63 d0 jsr $d063 JSR LAB_21D7 ; go garbage collect descriptor stack
.d000 f0 f7 beq $cff9 BEQ LAB_2161 ; loop always
.d002 lab_216a
.d002 06 a0 asl $a0 ASL g_step ; set step size = $06
.d004 a5 7b lda $7b LDA Svarl ; get start of vars low byte
.d006 a6 7c ldx $7c LDX Svarh ; get start of vars high byte
.d008 85 71 sta $71 STA ut1_pl ; save as pointer low byte
.d00a 86 72 stx $72 STX ut1_ph ; save as pointer high byte
.d00c lab_2176
.d00c e4 7e cpx $7e CPX Sarryh ; compare start of arrays high byte
.d00e d0 04 bne $d014 BNE LAB_217E ; branch if no high byte match
.d010 c5 7d cmp $7d CMP Sarryl ; else compare start of arrays low byte
.d012 f0 05 beq $d019 BEQ LAB_2183 ; branch if = var mem end
.d014 lab_217e
.d014 20 5d d0 jsr $d05d JSR LAB_21D1 ; go garbage collect strings
.d017 f0 f3 beq $d00c BEQ LAB_2176 ; loop always
.d019 lab_2183
.d019 85 a4 sta $a4 STA Nbendl ; save start of arrays low byte as working pointer
.d01b 86 a5 stx $a5 STX Nbendh ; save start of arrays high byte as working pointer
.d01d a9 04 lda #$04 LDA #$04 ; set step size
.d01f 85 a0 sta $a0 STA g_step ; save step size
.d021 lab_218b
.d021 a5 a4 lda $a4 LDA Nbendl ; get pointer low byte
.d023 a6 a5 ldx $a5 LDX Nbendh ; get pointer high byte
.d025 lab_218f
.d025 e4 80 cpx $80 CPX Earryh ; compare with array mem end high byte
.d027 d0 04 bne $d02d BNE LAB_219A ; branch if not at end
.d029 c5 7f cmp $7f CMP Earryl ; else compare with array mem end low byte
.d02b f0 75 beq $d0a2 BEQ LAB_2216 ; tidy up and exit if at end
.d02d lab_219a
.d02d 85 71 sta $71 STA ut1_pl ; save pointer low byte
.d02f 86 72 stx $72 STX ut1_ph ; save pointer high byte
.d031 a0 02 ldy #$02 LDY #$02 ; set index
.d033 b1 71 lda ($71),y LDA (ut1_pl),Y ; get array size low byte
.d035 65 a4 adc $a4 ADC Nbendl ; add start of this array low byte
.d037 85 a4 sta $a4 STA Nbendl ; save start of next array low byte
.d039 c8 iny INY ; increment index
.d03a b1 71 lda ($71),y LDA (ut1_pl),Y ; get array size high byte
.d03c 65 a5 adc $a5 ADC Nbendh ; add start of this array high byte
.d03e 85 a5 sta $a5 STA Nbendh ; save start of next array high byte
.d040 a0 01 ldy #$01 LDY #$01 ; set index
.d042 b1 71 lda ($71),y LDA (ut1_pl),Y ; get name second byte
.d044 10 db bpl $d021 BPL LAB_218B ; skip if not string array
.d046 a0 04 ldy #$04 LDY #$04 ; set index
.d048 b1 71 lda ($71),y LDA (ut1_pl),Y ; get # of dimensions
.d04a 0a asl ASL ; *2
.d04b 69 05 adc #$05 ADC #$05 ; +5 (array header size)
.d04d 20 95 d0 jsr $d095 JSR LAB_2208 ; go set up for first element
.d050 lab_21c4
.d050 e4 a5 cpx $a5 CPX Nbendh ; compare with start of next array high byte
.d052 d0 04 bne $d058 BNE LAB_21CC ; branch if <> (go do this array)
.d054 c5 a4 cmp $a4 CMP Nbendl ; else compare element pointer low byte with next array
.d056 f0 cd beq $d025 BEQ LAB_218F ; if equal then go do next array
.d058 lab_21cc
.d058 20 63 d0 jsr $d063 JSR LAB_21D7 ; go defrag array strings
.d05b f0 f3 beq $d050 BEQ LAB_21C4 ; go do next array string (loop always)
.d05d lab_21d1
.d05d c8 iny INY ; increment index (Y was $00)
.d05e b1 71 lda ($71),y LDA (ut1_pl),Y ; get var name byte 2
.d060 10 30 bpl $d092 BPL LAB_2206 ; if not string, step pointer to next var and return
.d062 c8 iny INY ; else increment index
.d063 lab_21d7
.d063 b1 71 lda ($71),y LDA (ut1_pl),Y ; get string length
.d065 f0 2b beq $d092 BEQ LAB_2206 ; if null, step pointer to next string and return
.d067 c8 iny INY ; else increment index
.d068 b1 71 lda ($71),y LDA (ut1_pl),Y ; get string pointer low byte
.d06a aa tax TAX ; copy to X
.d06b c8 iny INY ; increment index
.d06c b1 71 lda ($71),y LDA (ut1_pl),Y ; get string pointer high byte
.d06e c5 82 cmp $82 CMP Sstorh ; compare bottom of string space high byte
.d070 90 06 bcc $d078 BCC LAB_21EC ; branch if less
.d072 d0 1e bne $d092 BNE LAB_2206 ; if greater, step pointer to next string and return
.d074 e4 81 cpx $81 CPX Sstorl ; compare bottom of string space low byte
.d076 b0 1a bcs $d092 BCS LAB_2206 ; if >=, step pointer to next string and return
.d078 lab_21ec
.d078 c5 ab cmp $ab CMP Histrh ; compare to highest string high byte
.d07a 90 17 bcc $d093 BCC LAB_2207 ; if <, step pointer to next string and return
.d07c d0 04 bne $d082 BNE LAB_21F6 ; if > update pointers, step to next and return
.d07e e4 aa cpx $aa CPX Histrl ; compare to highest string low byte
.d080 90 11 bcc $d093 BCC LAB_2207 ; if <, step pointer to next string and return
.d082 lab_21f6
.d082 86 aa stx $aa STX Histrl ; save as new highest string low byte
.d084 85 ab sta $ab STA Histrh ; save as new highest string high byte
.d086 a5 71 lda $71 LDA ut1_pl ; get start of vars(descriptors) low byte
.d088 a6 72 ldx $72 LDX ut1_ph ; get start of vars(descriptors) high byte
.d08a 85 9c sta $9c STA garb_l ; save as working pointer low byte
.d08c 86 9d stx $9d STX garb_h ; save as working pointer high byte
.d08e 88 dey DEY ; decrement index DIFFERS
.d08f 88 dey DEY ; decrement index (should point to descriptor start)
.d090 84 a2 sty $a2 STY g_indx ; save index pointer
.d092 lab_2206
.d092 18 clc CLC ; clear carry for add
.d093 lab_2207
.d093 a5 a0 lda $a0 LDA g_step ; get step size
.d095 lab_2208
.d095 65 71 adc $71 ADC ut1_pl ; add pointer low byte
.d097 85 71 sta $71 STA ut1_pl ; save pointer low byte
.d099 90 02 bcc $d09d BCC LAB_2211 ; branch if no overflow
.d09b e6 72 inc $72 INC ut1_ph ; else increment high byte
.d09d lab_2211
.d09d a6 72 ldx $72 LDX ut1_ph ; get pointer high byte
.d09f a0 00 ldy #$00 LDY #$00 ; clear Y
.d0a1 60 rts RTS
.d0a2 lab_2216
.d0a2 c6 a0 dec $a0 DEC g_step ; decrement step size (now $03 for descriptor stack)
.d0a4 a6 9d ldx $9d LDX garb_h ; get string to move high byte
.d0a6 f0 f5 beq $d09d BEQ LAB_2211 ; exit if nothing to move
.d0a8 a4 a2 ldy $a2 LDY g_indx ; get index byte back (points to descriptor)
.d0aa 18 clc CLC ; clear carry for add
.d0ab b1 9c lda ($9c),y LDA (garb_l),Y ; get string length
.d0ad 65 aa adc $aa ADC Histrl ; add highest string low byte
.d0af 85 a6 sta $a6 STA Obendl ; save old block end low pointer
.d0b1 a5 ab lda $ab LDA Histrh ; get highest string high byte
.d0b3 69 00 adc #$00 ADC #$00 ; add any carry
.d0b5 85 a7 sta $a7 STA Obendh ; save old block end high byte
.d0b7 a5 81 lda $81 LDA Sstorl ; get bottom of string space low byte
.d0b9 a6 82 ldx $82 LDX Sstorh ; get bottom of string space high byte
.d0bb 85 a4 sta $a4 STA Nbendl ; save new block end low byte
.d0bd 86 a5 stx $a5 STX Nbendh ; save new block end high byte
.d0bf 20 c8 be jsr $bec8 JSR LAB_11D6 ; open up space in memory, don't set array end
.d0c2 a4 a2 ldy $a2 LDY g_indx ; get index byte
.d0c4 c8 iny INY ; point to descriptor low byte
.d0c5 a5 a4 lda $a4 LDA Nbendl ; get string pointer low byte
.d0c7 91 9c sta ($9c),y STA (garb_l),Y ; save new string pointer low byte
.d0c9 aa tax TAX ; copy string pointer low byte
.d0ca e6 a5 inc $a5 INC Nbendh ; correct high byte (move sets high byte -1)
.d0cc a5 a5 lda $a5 LDA Nbendh ; get new string pointer high byte
.d0ce c8 iny INY ; point to descriptor high byte
.d0cf 91 9c sta ($9c),y STA (garb_l),Y ; save new string pointer high byte
.d0d1 4c e3 cf jmp $cfe3 JMP LAB_214B ; re-run routine from last ending
.d0d4 lab_224d
.d0d4 a5 af lda $af LDA des_ph ; get descriptor pointer high byte
.d0d6 48 pha PHA ; put on stack
.d0d7 a5 ae lda $ae LDA des_pl ; get descriptor pointer low byte
.d0d9 48 pha PHA ; put on stack
.d0da 20 cd c9 jsr $c9cd JSR LAB_GVAL ; get value from line
.d0dd 20 d2 c8 jsr $c8d2 JSR LAB_CTST ; check if source is string, else do type mismatch
.d0e0 68 pla PLA ; get descriptor pointer low byte back
.d0e1 85 b8 sta $b8 STA ssptr_l ; set pointer low byte
.d0e3 68 pla PLA ; get descriptor pointer high byte back
.d0e4 85 b9 sta $b9 STA ssptr_h ; set pointer high byte
.d0e6 a0 00 ldy #$00 LDY #$00 ; clear index
.d0e8 b1 b8 lda ($b8),y LDA (ssptr_l),Y ; get length_1 from descriptor
.d0ea 18 clc CLC ; clear carry for add
.d0eb 71 ae adc ($ae),y ADC (des_pl),Y ; add length_2
.d0ed 90 05 bcc $d0f4 BCC LAB_226D ; branch if no overflow
.d0ef a2 1a ldx #$1a LDX #$1A ; else set error code $1A ("String too long" error)
.d0f1 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.d0f4 lab_226d
.d0f4 20 32 cf jsr $cf32 JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes
.d0f7 20 11 d1 jsr $d111 JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill)
.d0fa a5 9e lda $9e LDA des_2l ; get descriptor pointer low byte
.d0fc a4 9f ldy $9f LDY des_2h ; get descriptor pointer high byte
.d0fe 20 42 d1 jsr $d142 JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
.d101 20 23 d1 jsr $d123 JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill)
.d104 a5 b8 lda $b8 LDA ssptr_l ;.set descriptor pointer low byte
.d106 a4 b9 ldy $b9 LDY ssptr_h ;.set descriptor pointer high byte
.d108 20 42 d1 jsr $d142 JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
.d10b 20 85 cf jsr $cf85 JSR LAB_RTST ; check for space on descriptor stack then put string
.d10e 4c f8 c8 jmp $c8f8 JMP LAB_1ADB ;.continue evaluation
.d111 lab_228a
.d111 a0 00 ldy #$00 LDY #$00 ; clear index
.d113 b1 b8 lda ($b8),y LDA (sdescr),Y ; get string length
.d115 48 pha PHA ; save on stack
.d116 c8 iny INY ; increment index
.d117 b1 b8 lda ($b8),y LDA (sdescr),Y ; get source string pointer low byte
.d119 aa tax TAX ; copy to X
.d11a c8 iny INY ; increment index
.d11b b1 b8 lda ($b8),y LDA (sdescr),Y ; get source string pointer high byte
.d11d a8 tay TAY ; copy to Y
.d11e 68 pla PLA ; get length back
.d11f lab_2298
.d11f 86 71 stx $71 STX ut1_pl ; save source string pointer low byte
.d121 84 72 sty $72 STY ut1_ph ; save source string pointer high byte
.d123 lab_229c
.d123 aa tax TAX ; copy length to index (don't count with Y)
.d124 f0 14 beq $d13a BEQ LAB_22B2 ; branch if = $0 (null string) no need to add zero length
.d126 a0 00 ldy #$00 LDY #$00 ; zero pointer (copy forward)
.d128 lab_22a0
.d128 b1 71 lda ($71),y LDA (ut1_pl),Y ; get source byte
.d12a 91 83 sta ($83),y STA (Sutill),Y ; save destination byte
.d12c c8 iny INY ; increment index
.d12d ca dex DEX ; decrement counter
.d12e d0 f8 bne $d128 BNE LAB_22A0 ; loop while <> 0
.d130 98 tya TYA ; restore length from Y
.d131 lab_22a9
.d131 18 clc CLC ; clear carry for add
.d132 65 83 adc $83 ADC Sutill ; add string utility ptr low byte
.d134 85 83 sta $83 STA Sutill ; save string utility ptr low byte
.d136 90 02 bcc $d13a BCC LAB_22B2 ; branch if no carry
.d138 e6 84 inc $84 INC Sutilh ; else increment string utility ptr high byte
.d13a lab_22b2
.d13a 60 rts RTS
.d13b lab_evst
.d13b 20 d2 c8 jsr $c8d2 JSR LAB_CTST ; check if source is string, else do type mismatch
.d13e lab_22b6
.d13e a5 ae lda $ae LDA des_pl ; get descriptor pointer low byte
.d140 a4 af ldy $af LDY des_ph ; get descriptor pointer high byte
.d142 lab_22ba
.d142 85 71 sta $71 STA ut1_pl ; save descriptor pointer low byte
.d144 84 72 sty $72 STY ut1_ph ; save descriptor pointer high byte
.d146 20 73 d1 jsr $d173 JSR LAB_22EB ; clean descriptor stack, YA = pointer
.d149 08 php PHP ; save status flags
.d14a a0 00 ldy #$00 LDY #$00 ; clear index
.d14c b1 71 lda ($71),y LDA (ut1_pl),Y ; get length from string descriptor
.d14e 48 pha PHA ; put on stack
.d14f c8 iny INY ; increment index
.d150 b1 71 lda ($71),y LDA (ut1_pl),Y ; get string pointer low byte from descriptor
.d152 aa tax TAX ; copy to X
.d153 c8 iny INY ; increment index
.d154 b1 71 lda ($71),y LDA (ut1_pl),Y ; get string pointer high byte from descriptor
.d156 a8 tay TAY ; copy to Y
.d157 68 pla PLA ; get string length back
.d158 28 plp PLP ; restore status
.d159 d0 13 bne $d16e BNE LAB_22E6 ; branch if pointer <> last_sl,last_sh
.d15b c4 82 cpy $82 CPY Sstorh ; compare bottom of string space high byte
.d15d d0 0f bne $d16e BNE LAB_22E6 ; branch if <>
.d15f e4 81 cpx $81 CPX Sstorl ; else compare bottom of string space low byte
.d161 d0 0b bne $d16e BNE LAB_22E6 ; branch if <>
.d163 48 pha PHA ; save string length
.d164 18 clc CLC ; clear carry for add
.d165 65 81 adc $81 ADC Sstorl ; add bottom of string space low byte
.d167 85 81 sta $81 STA Sstorl ; save bottom of string space low byte
.d169 90 02 bcc $d16d BCC LAB_22E5 ; skip increment if no overflow
.d16b e6 82 inc $82 INC Sstorh ; increment bottom of string space high byte
.d16d lab_22e5
.d16d 68 pla PLA ; restore string length
.d16e lab_22e6
.d16e 86 71 stx $71 STX ut1_pl ; save string pointer low byte
.d170 84 72 sty $72 STY ut1_ph ; save string pointer high byte
.d172 60 rts RTS
.d173 lab_22eb
.d173 c4 67 cpy $67 CPY last_sh ; compare pointer high byte
.d175 d0 0c bne $d183 BNE LAB_22FB ; exit if <>
.d177 c5 66 cmp $66 CMP last_sl ; compare pointer low byte
.d179 d0 08 bne $d183 BNE LAB_22FB ; exit if <>
.d17b 85 65 sta $65 STA next_s ; save descriptor stack pointer
.d17d e9 03 sbc #$03 SBC #$03 ; -3
.d17f 85 66 sta $66 STA last_sl ; save low byte -3
.d181 a0 00 ldy #$00 LDY #$00 ; clear high byte
.d183 lab_22fb
.d183 60 rts RTS
.d184 lab_chrs
.d184 20 8f d2 jsr $d28f JSR LAB_EVBY ; evaluate byte expression, result in X
.d187 8a txa TXA ; copy to A
.d188 48 pha PHA ; save character
.d189 a9 01 lda #$01 LDA #$01 ; string is single byte
.d18b 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
.d18e 68 pla PLA ; get character back
.d18f a0 00 ldy #$00 LDY #$00 ; clear index
.d191 91 ad sta ($ad),y STA (str_pl),Y ; save byte in string (byte IS string!)
.d193 4c 85 cf jmp $cf85 JMP LAB_RTST ; check for space on descriptor stack then put string
.d196 lab_left
.d196 48 pha PHA ; push byte parameter
.d197 20 f7 d1 jsr $d1f7 JSR LAB_236F ; pull string data and byte parameter from stack
.d19a d1 9e cmp ($9e),y CMP (des_2l),Y ; compare byte parameter with string length
.d19c 98 tya TYA ; clear A
.d19d f0 09 beq $d1a8 BEQ LAB_2316 ; go do string copy (branch always)
.d19f lab_right
.d19f 48 pha PHA ; push byte parameter
.d1a0 20 f7 d1 jsr $d1f7 JSR LAB_236F ; pull string data and byte parameter from stack
.d1a3 18 clc CLC ; clear carry for add-1
.d1a4 f1 9e sbc ($9e),y SBC (des_2l),Y ; subtract string length
.d1a6 49 ff eor #$ff EOR #$FF ; invert it (A=LEN(expression$)-l)
.d1a8 lab_2316
.d1a8 90 04 bcc $d1ae BCC LAB_231C ; branch if string length > byte parameter
.d1aa b1 9e lda ($9e),y LDA (des_2l),Y ; else make parameter = length
.d1ac aa tax TAX ; copy to byte parameter copy
.d1ad 98 tya TYA ; clear string start offset
.d1ae lab_231c
.d1ae 48 pha PHA ; save string start offset
.d1af lab_231d
.d1af 8a txa TXA ; copy byte parameter (or string length if <)
.d1b0 lab_231e
.d1b0 48 pha PHA ; save string length
.d1b1 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
.d1b4 a5 9e lda $9e LDA des_2l ; get descriptor pointer low byte
.d1b6 a4 9f ldy $9f LDY des_2h ; get descriptor pointer high byte
.d1b8 20 42 d1 jsr $d142 JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
.d1bb 68 pla PLA ; get string length back
.d1bc a8 tay TAY ; copy length to Y
.d1bd 68 pla PLA ; get string start offset back
.d1be 18 clc CLC ; clear carry for add
.d1bf 65 71 adc $71 ADC ut1_pl ; add start offset to string start pointer low byte
.d1c1 85 71 sta $71 STA ut1_pl ; save string start pointer low byte
.d1c3 90 02 bcc $d1c7 BCC LAB_2335 ; branch if no overflow
.d1c5 e6 72 inc $72 INC ut1_ph ; else increment string start pointer high byte
.d1c7 lab_2335
.d1c7 98 tya TYA ; copy length to A
.d1c8 20 23 d1 jsr $d123 JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill)
.d1cb 4c 85 cf jmp $cf85 JMP LAB_RTST ; check for space on descriptor stack then put string
.d1ce lab_mids
.d1ce 48 pha PHA ; push byte parameter
.d1cf a9 ff lda #$ff LDA #$FF ; set default length = 255
.d1d1 85 af sta $af STA mids_l ; save default length
.d1d3 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.d1d6 c9 29 cmp #$29 CMP #")" ; compare with ")"
.d1d8 f0 06 beq $d1e0 BEQ LAB_2358 ; branch if = ")" (skip second byte get)
.d1da 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
.d1dd 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter (use copy in mids_l)
.d1e0 lab_2358
.d1e0 20 f7 d1 jsr $d1f7 JSR LAB_236F ; pull string data and byte parameter from stack
.d1e3 ca dex DEX ; decrement start index
.d1e4 8a txa TXA ; copy to A
.d1e5 48 pha PHA ; save string start offset
.d1e6 18 clc CLC ; clear carry for sub-1
.d1e7 a2 00 ldx #$00 LDX #$00 ; clear output string length
.d1e9 f1 9e sbc ($9e),y SBC (des_2l),Y ; subtract string length
.d1eb b0 c2 bcs $d1af BCS LAB_231D ; if start>string length go do null string
.d1ed 49 ff eor #$ff EOR #$FF ; complement -length
.d1ef c5 af cmp $af CMP mids_l ; compare byte parameter
.d1f1 90 bd bcc $d1b0 BCC LAB_231E ; if length>remaining string go do RIGHT$
.d1f3 a5 af lda $af LDA mids_l ; get length byte
.d1f5 b0 b9 bcs $d1b0 BCS LAB_231E ; go do string copy (branch always)
.d1f7 lab_236f
.d1f7 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
.d1fa 68 pla PLA ; pull return address low byte (return address)
.d1fb 85 a2 sta $a2 STA Fnxjpl ; save functions jump vector low byte
.d1fd 68 pla PLA ; pull return address high byte (return address)
.d1fe 85 a3 sta $a3 STA Fnxjph ; save functions jump vector high byte
.d200 68 pla PLA ; pull byte parameter
.d201 aa tax TAX ; copy byte parameter to X
.d202 68 pla PLA ; pull string pointer low byte
.d203 85 9e sta $9e STA des_2l ; save it
.d205 68 pla PLA ; pull string pointer high byte
.d206 85 9f sta $9f STA des_2h ; save it
.d208 a0 00 ldy #$00 LDY #$00 ; clear index
.d20a 8a txa TXA ; copy byte parameter
.d20b f0 79 beq $d286 BEQ LAB_23A8 ; if null do function call error then warm start
.d20d e6 a2 inc $a2 INC Fnxjpl ; increment function jump vector low byte
.d20f 6c a2 00 jmp ($00a2) JMP (Fnxjpl) ; in effect, RTS
.d212 lab_lcase
.d212 20 3b d1 jsr $d13b JSR LAB_EVST ; evaluate string
.d215 85 ac sta $ac STA str_ln ; set string length
.d217 a8 tay TAY ; copy length to Y
.d218 f0 38 beq $d252 BEQ NoString ; branch if null string
.d21a 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long A=length,
.d21d 86 ad stx $ad STX str_pl ; save string pointer low byte
.d21f 84 ae sty $ae STY str_ph ; save string pointer high byte
.d221 a8 tay TAY ; get string length back
.d222 lc_loop
.d222 88 dey DEY ; decrement index
.d223 b1 71 lda ($71),y LDA (ut1_pl),Y ; get byte from string
.d225 20 22 cc jsr $cc22 JSR LAB_1D82 ; is character "A" to "Z"
.d228 90 02 bcc $d22c BCC NoUcase ; branch if not upper case alpha
.d22a 09 20 ora #$20 ORA #$20 ; convert upper to lower case
.d22c noucase
.d22c 91 83 sta ($83),y STA (Sutill),Y ; save byte back to string
.d22e 98 tya TYA ; test index
.d22f d0 f1 bne $d222 BNE LC_loop ; loop if not all done
.d231 f0 1f beq $d252 BEQ NoString ; tidy up and exit, branch always
.d233 lab_ucase
.d233 20 3b d1 jsr $d13b JSR LAB_EVST ; evaluate string
.d236 85 ac sta $ac STA str_ln ; set string length
.d238 a8 tay TAY ; copy length to Y
.d239 f0 17 beq $d252 BEQ NoString ; branch if null string
.d23b 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long A=length,
.d23e 86 ad stx $ad STX str_pl ; save string pointer low byte
.d240 84 ae sty $ae STY str_ph ; save string pointer high byte
.d242 a8 tay TAY ; get string length back
.d243 uc_loop
.d243 88 dey DEY ; decrement index
.d244 b1 71 lda ($71),y LDA (ut1_pl),Y ; get byte from string
.d246 20 1e cc jsr $cc1e JSR LAB_CASC ; is character "a" to "z" (or "A" to "Z")
.d249 90 02 bcc $d24d BCC NoLcase ; branch if not alpha
.d24b 29 df and #$df AND #$DF ; convert lower to upper case
.d24d nolcase
.d24d 91 83 sta ($83),y STA (Sutill),Y ; save byte back to string
.d24f 98 tya TYA ; test index
.d250 d0 f1 bne $d243 BNE UC_loop ; loop if not all done
.d252 nostring
.d252 4c 85 cf jmp $cf85 JMP LAB_RTST ; check for space on descriptor stack then put string
.d255 lab_sadd
.d255 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.d258 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var address
.d25b 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
.d25e 20 d2 c8 jsr $c8d2 JSR LAB_CTST ; check if source is string, else do type mismatch
.d261 a0 02 ldy #$02 LDY #$02 ; index to string pointer high byte
.d263 b1 95 lda ($95),y LDA (Cvaral),Y ; get string pointer high byte
.d265 aa tax TAX ; copy string pointer high byte to X
.d266 88 dey DEY ; index to string pointer low byte
.d267 b1 95 lda ($95),y LDA (Cvaral),Y ; get string pointer low byte
.d269 a8 tay TAY ; copy string pointer low byte to Y
.d26a 8a txa TXA ; copy string pointer high byte to A
.d26b 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.d26e lab_lens
.d26e 20 74 d2 jsr $d274 JSR LAB_ESGL ; evaluate string, get length in A (and Y)
.d271 4c 66 ce jmp $ce66 JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
.d274 lab_esgl
.d274 20 3b d1 jsr $d13b JSR LAB_EVST ; evaluate string
.d277 a8 tay TAY ; copy length to Y
.d278 60 rts RTS
.d279 lab_asc
.d279 20 74 d2 jsr $d274 JSR LAB_ESGL ; evaluate string, get length in A (and Y)
.d27c f0 08 beq $d286 BEQ LAB_23A8 ; if null do function call error then warm start
.d27e a0 00 ldy #$00 LDY #$00 ; set index to first character
.d280 b1 71 lda ($71),y LDA (ut1_pl),Y ; get byte
.d282 a8 tay TAY ; copy to Y
.d283 4c 66 ce jmp $ce66 JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
.d286 lab_23a8
.d286 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start
.d289 lab_sgby
.d289 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.d28c lab_gtby
.d28c 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.d28f lab_evby
.d28f 20 a2 cc jsr $cca2 JSR LAB_EVPI ; evaluate integer expression (no check)
.d292 a4 ae ldy $ae LDY FAC1_2 ; get FAC1 mantissa2
.d294 d0 f0 bne $d286 BNE LAB_23A8 ; if top byte <> 0 do function call error then warm start
.d296 a6 af ldx $af LDX FAC1_3 ; get FAC1 mantissa3
.d298 4c c2 00 jmp $00c2 JMP LAB_GBYT ; scan memory and return
.d29b lab_val
.d29b 20 74 d2 jsr $d274 JSR LAB_ESGL ; evaluate string, get length in A (and Y)
.d29e d0 03 bne $d2a3 BNE LAB_23C5 ; branch if not null string
.d2a0 4c 50 d4 jmp $d450 JMP LAB_24F1 ; clear FAC1 exponent and sign and return
.d2a3 lab_23c5
.d2a3 a6 c3 ldx $c3 LDX Bpntrl ; get BASIC execute pointer low byte
.d2a5 a4 c4 ldy $c4 LDY Bpntrh ; get BASIC execute pointer high byte
.d2a7 86 ba stx $ba STX Btmpl ; save BASIC execute pointer low byte
.d2a9 84 bb sty $bb STY Btmph ; save BASIC execute pointer high byte
.d2ab a6 71 ldx $71 LDX ut1_pl ; get string pointer low byte
.d2ad 86 c3 stx $c3 STX Bpntrl ; save as BASIC execute pointer low byte
.d2af 18 clc CLC ; clear carry
.d2b0 65 71 adc $71 ADC ut1_pl ; add string length
.d2b2 85 73 sta $73 STA ut2_pl ; save string end low byte
.d2b4 a5 72 lda $72 LDA ut1_ph ; get string pointer high byte
.d2b6 85 c4 sta $c4 STA Bpntrh ; save as BASIC execute pointer high byte
.d2b8 69 00 adc #$00 ADC #$00 ; add carry to high byte
.d2ba 85 74 sta $74 STA ut2_ph ; save string end high byte
.d2bc a0 00 ldy #$00 LDY #$00 ; set index to $00
.d2be b1 73 lda ($73),y LDA (ut2_pl),Y ; get string end +1 byte
.d2c0 48 pha PHA ; push it
.d2c1 98 tya TYA ; clear A
.d2c2 91 73 sta ($73),y STA (ut2_pl),Y ; terminate string with $00
.d2c4 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.d2c7 20 a6 d7 jsr $d7a6 JSR LAB_2887 ; get FAC1 from string
.d2ca 68 pla PLA ; restore string end +1 byte
.d2cb a0 00 ldy #$00 LDY #$00 ; set index to zero
.d2cd 91 73 sta ($73),y STA (ut2_pl),Y ; put string end byte back
.d2cf lab_23f3
.d2cf a6 ba ldx $ba LDX Btmpl ; get BASIC execute pointer low byte back
.d2d1 a4 bb ldy $bb LDY Btmph ; get BASIC execute pointer high byte back
.d2d3 86 c3 stx $c3 STX Bpntrl ; save BASIC execute pointer low byte
.d2d5 84 c4 sty $c4 STY Bpntrh ; save BASIC execute pointer high byte
.d2d7 60 rts RTS
.d2d8 lab_gadb
.d2d8 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.d2db 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
.d2de lab_scgb
.d2de 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
.d2e1 a5 12 lda $12 LDA Itemph ; save temporary integer high byte
.d2e3 48 pha PHA ; on stack
.d2e4 a5 11 lda $11 LDA Itempl ; save temporary integer low byte
.d2e6 48 pha PHA ; on stack
.d2e7 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter
.d2ea 68 pla PLA ; pull low byte
.d2eb 85 11 sta $11 STA Itempl ; restore temporary integer low byte
.d2ed 68 pla PLA ; pull high byte
.d2ee 85 12 sta $12 STA Itemph ; restore temporary integer high byte
.d2f0 60 rts RTS
.d2f1 lab_f2fx
.d2f1 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d2f3 c9 98 cmp #$98 CMP #$98 ; compare with exponent = 2^24
.d2f5 b0 8f bcs $d286 BCS LAB_23A8 ; if >= do function call error then warm start
.d2f7 lab_f2fu
.d2f7 20 50 d7 jsr $d750 JSR LAB_2831 ; convert FAC1 floating-to-fixed
.d2fa a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d2fc a4 af ldy $af LDY FAC1_3 ; get FAC1 mantissa3
.d2fe 84 11 sty $11 STY Itempl ; save temporary integer low byte
.d300 85 12 sta $12 STA Itemph ; save temporary integer high byte
.d302 60 rts RTS
.d303 lab_peek
.d303 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
.d306 a2 00 ldx #$00 LDX #$00 ; clear index
.d308 a1 11 lda ($11,x) LDA (Itempl,X) ; get byte via temporary integer (addr)
.d30a a8 tay TAY ; copy byte to Y
.d30b 4c 66 ce jmp $ce66 JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
.d30e lab_poke
.d30e 20 d8 d2 jsr $d2d8 JSR LAB_GADB ; get two parameters for POKE or WAIT
.d311 8a txa TXA ; copy byte argument to A
.d312 a2 00 ldx #$00 LDX #$00 ; clear index
.d314 81 11 sta ($11,x) STA (Itempl,X) ; save byte via temporary integer (addr)
.d316 60 rts RTS
.d317 lab_deek
.d317 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
.d31a a2 00 ldx #$00 LDX #$00 ; clear index
.d31c a1 11 lda ($11,x) LDA (Itempl,X) ; PEEK low byte
.d31e a8 tay TAY ; copy to Y
.d31f e6 11 inc $11 INC Itempl ; increment pointer low byte
.d321 d0 02 bne $d325 BNE Deekh ; skip high increment if no rollover
.d323 e6 12 inc $12 INC Itemph ; increment pointer high byte
.d325 deekh
.d325 a1 11 lda ($11,x) LDA (Itempl,X) ; PEEK high byte
.d327 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.d32a lab_doke
.d32a 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.d32d 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; convert floating-to-fixed
.d330 84 97 sty $97 STY Frnxtl ; save pointer low byte (float to fixed returns word in AY)
.d332 85 98 sta $98 STA Frnxth ; save pointer high byte
.d334 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
.d337 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.d33a 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; convert floating-to-fixed
.d33d 98 tya TYA ; copy value low byte (float to fixed returns word in AY)
.d33e a2 00 ldx #$00 LDX #$00 ; clear index
.d340 81 97 sta ($97,x) STA (Frnxtl,X) ; POKE low byte
.d342 e6 97 inc $97 INC Frnxtl ; increment pointer low byte
.d344 d0 02 bne $d348 BNE Dokeh ; skip high increment if no rollover
.d346 e6 98 inc $98 INC Frnxth ; increment pointer high byte
.d348 dokeh
.d348 a5 12 lda $12 LDA Itemph ; get value high byte
.d34a 81 97 sta ($97,x) STA (Frnxtl,X) ; POKE high byte
.d34c 4c c2 00 jmp $00c2 JMP LAB_GBYT ; scan memory and return
.d34f lab_swap
.d34f 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var1 address
.d352 85 97 sta $97 STA Lvarpl ; save var1 address low byte
.d354 84 98 sty $98 STY Lvarph ; save var1 address high byte
.d356 a5 5f lda $5f LDA Dtypef ; get data type flag, $FF=string, $00=numeric
.d358 48 pha PHA ; save data type flag
.d359 20 fe c9 jsr $c9fe JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
.d35c 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var2 address (pointer in Cvaral/h)
.d35f 68 pla PLA ; pull var1 data type flag
.d360 45 5f eor $5f EOR Dtypef ; compare with var2 data type
.d362 10 10 bpl $d374 BPL SwapErr ; exit if not both the same type
.d364 a0 03 ldy #$03 LDY #$03 ; four bytes to swap (either value or descriptor+1)
.d366 swaplp
.d366 b1 97 lda ($97),y LDA (Lvarpl),Y ; get byte from var1
.d368 aa tax TAX ; save var1 byte
.d369 b1 95 lda ($95),y LDA (Cvaral),Y ; get byte from var2
.d36b 91 97 sta ($97),y STA (Lvarpl),Y ; save byte to var1
.d36d 8a txa TXA ; restore var1 byte
.d36e 91 95 sta ($95),y STA (Cvaral),Y ; save byte to var2
.d370 88 dey DEY ; decrement index
.d371 10 f3 bpl $d366 BPL SwapLp ; loop until done
.d373 60 rts RTS
.d374 swaperr
.d374 4c dc c8 jmp $c8dc JMP LAB_1ABC ; do "Type mismatch" error then warm start
.d377 lab_call
.d377 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.d37a 20 f1 d2 jsr $d2f1 JSR LAB_F2FX ; convert floating-to-fixed
.d37d a9 d3 lda #$d3 LDA #>CallExit ; set return address high byte
.d37f 48 pha PHA ; put on stack
.d380 a9 85 lda #$85 LDA #<CallExit-1 ; set return address low byte
.d382 48 pha PHA ; put on stack
.d383 6c 11 00 jmp ($0011) JMP (Itempl) ; do indirect jump to user routine
.d386 callexit
.d386 4c c2 00 jmp $00c2 JMP LAB_GBYT ; scan memory and return
.d389 lab_wait
.d389 20 d8 d2 jsr $d2d8 JSR LAB_GADB ; get two parameters for POKE or WAIT
.d38c 86 97 stx $97 STX Frnxtl ; save byte
.d38e a2 00 ldx #$00 LDX #$00 ; clear mask
.d390 20 c2 00 jsr $00c2 JSR LAB_GBYT ; scan memory
.d393 f0 03 beq $d398 BEQ LAB_2441 ; skip if no third argument
.d395 20 de d2 jsr $d2de JSR LAB_SCGB ; scan for "," and get byte, else SN error then warm start
.d398 lab_2441
.d398 86 98 stx $98 STX Frnxth ; save EOR argument
.d39a lab_2445
.d39a b1 11 lda ($11),y LDA (Itempl),Y ; get byte via temporary integer (addr)
.d39c 45 98 eor $98 EOR Frnxth ; EOR with second argument (mask)
.d39e 25 97 and $97 AND Frnxtl ; AND with first argument (byte)
.d3a0 f0 f8 beq $d39a BEQ LAB_2445 ; loop if result is zero
.d3a2 lab_244d
.d3a2 60 rts RTS
.d3a3 lab_2455
.d3a3 20 8b d5 jsr $d58b JSR LAB_264D ; unpack memory (AY) into FAC2
.d3a6 lab_subtract
.d3a6 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d3a8 49 ff eor #$ff EOR #$FF ; complement it
.d3aa 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d3ac 45 b7 eor $b7 EOR FAC2_s ; EOR with FAC2 sign (b7)
.d3ae 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.d3b0 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d3b2 4c c1 d3 jmp $d3c1 JMP LAB_ADD ; go add FAC2 to FAC1
.d3b5 lab_2467
.d3b5 20 da d4 jsr $d4da JSR LAB_257B ; shift FACX A times right (>8 shifts)
.d3b8 90 4d bcc $d407 BCC LAB_24A8 ;.go subtract mantissas
.d3ba lab_244e
.d3ba a9 e9 lda #$e9 LDA #<LAB_2A96 ; set 0.5 pointer low byte
.d3bc a0 df ldy #$df LDY #>LAB_2A96 ; set 0.5 pointer high byte
.d3be lab_246c
.d3be 20 8b d5 jsr $d58b JSR LAB_264D ; unpack memory (AY) into FAC2
.d3c1 lab_add
.d3c1 d0 10 bne $d3d3 BNE LAB_2474 ; branch if FAC1 was not zero
.d3c3 lab_279b
.d3c3 a5 b7 lda $b7 LDA FAC2_s ; get FAC2 sign (b7)
.d3c5 lab_279d
.d3c5 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d3c7 a2 04 ldx #$04 LDX #$04 ; 4 bytes to copy
.d3c9 lab_27a1
.d3c9 b5 b2 lda $b2,x LDA FAC1_o,X ; get byte from FAC2,X
.d3cb 95 ab sta $ab,x STA FAC1_e-1,X ; save byte at FAC1,X
.d3cd ca dex DEX ; decrement count
.d3ce d0 f9 bne $d3c9 BNE LAB_27A1 ; loop if not all done
.d3d0 86 b9 stx $b9 STX FAC1_r ; clear FAC1 rounding byte
.d3d2 60 rts RTS
.d3d3 lab_2474
.d3d3 a6 b9 ldx $b9 LDX FAC1_r ; get FAC1 rounding byte
.d3d5 86 a3 stx $a3 STX FAC2_r ; save as FAC2 rounding byte
.d3d7 a2 b3 ldx #$b3 LDX #FAC2_e ; set index to FAC2 exponent addr
.d3d9 a5 b3 lda $b3 LDA FAC2_e ; get FAC2 exponent
.d3db lab_247c
.d3db a8 tay TAY ; copy exponent
.d3dc f0 c4 beq $d3a2 BEQ LAB_244D ; exit if zero
.d3de 38 sec SEC ; set carry for subtract
.d3df e5 ac sbc $ac SBC FAC1_e ; subtract FAC1 exponent
.d3e1 f0 24 beq $d407 BEQ LAB_24A8 ; branch if = (go add mantissa)
.d3e3 90 12 bcc $d3f7 BCC LAB_2498 ; branch if <
.d3e5 84 ac sty $ac STY FAC1_e ; save FAC1 exponent
.d3e7 a4 b7 ldy $b7 LDY FAC2_s ; get FAC2 sign (b7)
.d3e9 84 b0 sty $b0 STY FAC1_s ; save FAC1 sign (b7)
.d3eb 49 ff eor #$ff EOR #$FF ; complement A
.d3ed 69 00 adc #$00 ADC #$00 ; +1 (twos complement, carry is set)
.d3ef a0 00 ldy #$00 LDY #$00 ; clear Y
.d3f1 84 a3 sty $a3 STY FAC2_r ; clear FAC2 rounding byte
.d3f3 a2 ac ldx #$ac LDX #FAC1_e ; set index to FAC1 exponent addr
.d3f5 d0 04 bne $d3fb BNE LAB_249C ; branch always
.d3f7 lab_2498
.d3f7 a0 00 ldy #$00 LDY #$00 ; clear Y
.d3f9 84 b9 sty $b9 STY FAC1_r ; clear FAC1 rounding byte
.d3fb lab_249c
.d3fb c9 f9 cmp #$f9 CMP #$F9 ; compare exponent diff with $F9
.d3fd 30 b6 bmi $d3b5 BMI LAB_2467 ; branch if range $79-$F8
.d3ff a8 tay TAY ; copy exponent difference to Y
.d400 a5 b9 lda $b9 LDA FAC1_r ; get FAC1 rounding byte
.d402 56 01 lsr $01,x LSR PLUS_1,X ; shift FAC? mantissa1
.d404 20 f1 d4 jsr $d4f1 JSR LAB_2592 ; shift FACX Y times right
.d407 lab_24a8
.d407 24 b8 bit $b8 BIT FAC_sc ; test sign compare (FAC1 EOR FAC2)
.d409 10 4c bpl $d457 BPL LAB_24F8 ; if = add FAC2 mantissa to FAC1 mantissa and return
.d40b a0 ac ldy #$ac LDY #FAC1_e ; set index to FAC1 exponent addr
.d40d e0 b3 cpx #$b3 CPX #FAC2_e ; compare X to FAC2 exponent addr
.d40f f0 02 beq $d413 BEQ LAB_24B4 ; branch if =
.d411 a0 b3 ldy #$b3 LDY #FAC2_e ; else set index to FAC2 exponent addr
.d413 lab_24b4
.d413 38 sec SEC ; set carry for subtract
.d414 49 ff eor #$ff EOR #$FF ; ones complement A
.d416 65 a3 adc $a3 ADC FAC2_r ; add FAC2 rounding byte
.d418 85 b9 sta $b9 STA FAC1_r ; save FAC1 rounding byte
.d41a b9 03 00 lda $0003,y LDA PLUS_3,Y ; get FACY mantissa3
.d41d f5 03 sbc $03,x SBC PLUS_3,X ; subtract FACX mantissa3
.d41f 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d421 b9 02 00 lda $0002,y LDA PLUS_2,Y ; get FACY mantissa2
.d424 f5 02 sbc $02,x SBC PLUS_2,X ; subtract FACX mantissa2
.d426 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d428 b9 01 00 lda $0001,y LDA PLUS_1,Y ; get FACY mantissa1
.d42b f5 01 sbc $01,x SBC PLUS_1,X ; subtract FACX mantissa1
.d42d 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d42f lab_24d0
.d42f b0 03 bcs $d434 BCS LAB_24D5 ; branch if number is +ve
.d431 20 96 d4 jsr $d496 JSR LAB_2537 ; negate FAC1
.d434 lab_24d5
.d434 a0 00 ldy #$00 LDY #$00 ; clear Y
.d436 98 tya TYA ; clear A
.d437 18 clc CLC ; clear carry for add
.d438 lab_24d9
.d438 a6 ad ldx $ad LDX FAC1_1 ; get FAC1 mantissa1
.d43a d0 3e bne $d47a BNE LAB_251B ; if not zero normalise FAC1
.d43c a6 ae ldx $ae LDX FAC1_2 ; get FAC1 mantissa2
.d43e 86 ad stx $ad STX FAC1_1 ; save FAC1 mantissa1
.d440 a6 af ldx $af LDX FAC1_3 ; get FAC1 mantissa3
.d442 86 ae stx $ae STX FAC1_2 ; save FAC1 mantissa2
.d444 a6 b9 ldx $b9 LDX FAC1_r ; get FAC1 rounding byte
.d446 86 af stx $af STX FAC1_3 ; save FAC1 mantissa3
.d448 84 b9 sty $b9 STY FAC1_r ; clear FAC1 rounding byte
.d44a 69 08 adc #$08 ADC #$08 ; add x to exponent offset
.d44c c9 18 cmp #$18 CMP #$18 ; compare with $18 (max offset, all bits would be =0)
.d44e d0 e8 bne $d438 BNE LAB_24D9 ; loop if not max
.d450 lab_24f1
.d450 a9 00 lda #$00 LDA #$00 ; clear A
.d452 lab_24f3
.d452 85 ac sta $ac STA FAC1_e ; set FAC1 exponent
.d454 lab_24f5
.d454 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d456 60 rts RTS
.d457 lab_24f8
.d457 65 a3 adc $a3 ADC FAC2_r ; add FAC2 rounding byte
.d459 85 b9 sta $b9 STA FAC1_r ; save FAC1 rounding byte
.d45b a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d45d 65 b6 adc $b6 ADC FAC2_3 ; add FAC2 mantissa3
.d45f 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d461 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d463 65 b5 adc $b5 ADC FAC2_2 ; add FAC2 mantissa2
.d465 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d467 a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.d469 65 b4 adc $b4 ADC FAC2_1 ; add FAC2 mantissa1
.d46b 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d46d b0 1a bcs $d489 BCS LAB_252A ; if carry then normalise FAC1 for C=1
.d46f 60 rts RTS ; else just exit
.d470 lab_2511
.d470 69 01 adc #$01 ADC #$01 ; add 1 to exponent offset
.d472 06 b9 asl $b9 ASL FAC1_r ; shift FAC1 rounding byte
.d474 26 af rol $af ROL FAC1_3 ; shift FAC1 mantissa3
.d476 26 ae rol $ae ROL FAC1_2 ; shift FAC1 mantissa2
.d478 26 ad rol $ad ROL FAC1_1 ; shift FAC1 mantissa1
.d47a lab_251b
.d47a 10 f4 bpl $d470 BPL LAB_2511 ; loop if not normalised
.d47c 38 sec SEC ; set carry for subtract
.d47d e5 ac sbc $ac SBC FAC1_e ; subtract FAC1 exponent
.d47f b0 cf bcs $d450 BCS LAB_24F1 ; branch if underflow (set result = $0)
.d481 49 ff eor #$ff EOR #$FF ; complement exponent
.d483 69 01 adc #$01 ADC #$01 ; +1 (twos complement)
.d485 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d487 lab_2528
.d487 90 0c bcc $d495 BCC LAB_2536 ; exit if no overflow
.d489 lab_252a
.d489 e6 ac inc $ac INC FAC1_e ; increment FAC1 exponent
.d48b f0 36 beq $d4c3 BEQ LAB_2564 ; if zero do overflow error and warm start
.d48d 66 ad ror $ad ROR FAC1_1 ; shift FAC1 mantissa1
.d48f 66 ae ror $ae ROR FAC1_2 ; shift FAC1 mantissa2
.d491 66 af ror $af ROR FAC1_3 ; shift FAC1 mantissa3
.d493 66 b9 ror $b9 ROR FAC1_r ; shift FAC1 rounding byte
.d495 lab_2536
.d495 60 rts RTS
.d496 lab_2537
.d496 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d498 49 ff eor #$ff EOR #$FF ; complement it
.d49a 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d49c lab_253d
.d49c a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.d49e 49 ff eor #$ff EOR #$FF ; complement it
.d4a0 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d4a2 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d4a4 49 ff eor #$ff EOR #$FF ; complement it
.d4a6 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d4a8 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d4aa 49 ff eor #$ff EOR #$FF ; complement it
.d4ac 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d4ae a5 b9 lda $b9 LDA FAC1_r ; get FAC1 rounding byte
.d4b0 49 ff eor #$ff EOR #$FF ; complement it
.d4b2 85 b9 sta $b9 STA FAC1_r ; save FAC1 rounding byte
.d4b4 e6 b9 inc $b9 INC FAC1_r ; increment FAC1 rounding byte
.d4b6 d0 0a bne $d4c2 BNE LAB_2563 ; exit if no overflow
.d4b8 lab_2559
.d4b8 e6 af inc $af INC FAC1_3 ; increment FAC1 mantissa3
.d4ba d0 06 bne $d4c2 BNE LAB_2563 ; finished if no rollover
.d4bc e6 ae inc $ae INC FAC1_2 ; increment FAC1 mantissa2
.d4be d0 02 bne $d4c2 BNE LAB_2563 ; finished if no rollover
.d4c0 e6 ad inc $ad INC FAC1_1 ; increment FAC1 mantissa1
.d4c2 lab_2563
.d4c2 60 rts RTS
.d4c3 lab_2564
.d4c3 a2 0a ldx #$0a LDX #$0A ; error code $0A ("Overflow" error)
.d4c5 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.d4c8 lab_2569
.d4c8 a2 74 ldx #$74 LDX #FACt_1-1 ; set offset to FACtemp
.d4ca lab_256b
.d4ca b4 03 ldy $03,x LDY PLUS_3,X ; get FACX mantissa3
.d4cc 84 b9 sty $b9 STY FAC1_r ; save as FAC1 rounding byte
.d4ce b4 02 ldy $02,x LDY PLUS_2,X ; get FACX mantissa2
.d4d0 94 03 sty $03,x STY PLUS_3,X ; save FACX mantissa3
.d4d2 b4 01 ldy $01,x LDY PLUS_1,X ; get FACX mantissa1
.d4d4 94 02 sty $02,x STY PLUS_2,X ; save FACX mantissa2
.d4d6 a4 b2 ldy $b2 LDY FAC1_o ; get FAC1 overflow byte
.d4d8 94 01 sty $01,x STY PLUS_1,X ; save FACX mantissa1
.d4da lab_257b
.d4da 69 08 adc #$08 ADC #$08 ; add 8 to shift count
.d4dc 30 ec bmi $d4ca BMI LAB_256B ; go do 8 shift if still -ve
.d4de f0 ea beq $d4ca BEQ LAB_256B ; go do 8 shift if zero
.d4e0 e9 08 sbc #$08 SBC #$08 ; else subtract 8 again
.d4e2 a8 tay TAY ; save count to Y
.d4e3 a5 b9 lda $b9 LDA FAC1_r ; get FAC1 rounding byte
.d4e5 b0 12 bcs $d4f9 BCS LAB_259A ;.
.d4e7 lab_2588
.d4e7 16 01 asl $01,x ASL PLUS_1,X ; shift FACX mantissa1
.d4e9 90 02 bcc $d4ed BCC LAB_258E ; branch if +ve
.d4eb f6 01 inc $01,x INC PLUS_1,X ; this sets b7 eventually
.d4ed lab_258e
.d4ed 76 01 ror $01,x ROR PLUS_1,X ; shift FACX mantissa1 (correct for ASL)
.d4ef 76 01 ror $01,x ROR PLUS_1,X ; shift FACX mantissa1 (put carry in b7)
.d4f1 lab_2592
.d4f1 76 02 ror $02,x ROR PLUS_2,X ; shift FACX mantissa2
.d4f3 76 03 ror $03,x ROR PLUS_3,X ; shift FACX mantissa3
.d4f5 6a ror ROR ; shift FACX rounding byte
.d4f6 c8 iny INY ; increment exponent diff
.d4f7 d0 ee bne $d4e7 BNE LAB_2588 ; branch if range adjust not complete
.d4f9 lab_259a
.d4f9 18 clc CLC ; just clear it
.d4fa 60 rts RTS
.d4fb lab_log
.d4fb 20 e9 d6 jsr $d6e9 JSR LAB_27CA ; test sign and zero
.d4fe f0 02 beq $d502 BEQ LAB_25C4 ; if zero do function call error then warm start
.d500 10 03 bpl $d505 BPL LAB_25C7 ; skip error if +ve
.d502 lab_25c4
.d502 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start (-ve)
.d505 lab_25c7
.d505 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d507 e9 7f sbc #$7f SBC #$7F ; normalise it
.d509 48 pha PHA ; save it
.d50a a9 80 lda #$80 LDA #$80 ; set exponent to zero
.d50c 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d50e a9 69 lda #$69 LDA #<LAB_25AD ; set 1/root2 pointer low byte
.d510 a0 df ldy #$df LDY #>LAB_25AD ; set 1/root2 pointer high byte
.d512 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1 (1/root2)
.d515 a9 6d lda #$6d LDA #<LAB_25B1 ; set root2 pointer low byte
.d517 a0 df ldy #$df LDY #>LAB_25B1 ; set root2 pointer high byte
.d519 20 01 d6 jsr $d601 JSR LAB_26CA ; convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
.d51c a9 e0 lda #$e0 LDA #<LAB_259C ; set 1 pointer low byte
.d51e a0 df ldy #$df LDY #>LAB_259C ; set 1 pointer high byte
.d520 20 a3 d3 jsr $d3a3 JSR LAB_2455 ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1)
.d523 a9 5c lda #$5c LDA #<LAB_25A0 ; set pointer low byte to counter
.d525 a0 df ldy #$df LDY #>LAB_25A0 ; set pointer high byte to counter
.d527 20 51 da jsr $da51 JSR LAB_2B6E ; ^2 then series evaluation
.d52a a9 71 lda #$71 LDA #<LAB_25B5 ; set -0.5 pointer low byte
.d52c a0 df ldy #$df LDY #>LAB_25B5 ; set -0.5 pointer high byte
.d52e 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1
.d531 68 pla PLA ; restore FAC1 exponent
.d532 20 45 d8 jsr $d845 JSR LAB_2912 ; evaluate new ASCII digit
.d535 a9 75 lda #$75 LDA #<LAB_25B9 ; set LOG(2) pointer low byte
.d537 a0 df ldy #$df LDY #>LAB_25B9 ; set LOG(2) pointer high byte
.d539 lab_25fb
.d539 20 8b d5 jsr $d58b JSR LAB_264D ; unpack memory (AY) into FAC2
.d53c lab_multiply
.d53c f0 4c beq $d58a BEQ LAB_264C ; exit if zero
.d53e 20 b1 d5 jsr $d5b1 JSR LAB_2673 ; test and adjust accumulators
.d541 a9 00 lda #$00 LDA #$00 ; clear A
.d543 85 75 sta $75 STA FACt_1 ; clear temp mantissa1
.d545 85 76 sta $76 STA FACt_2 ; clear temp mantissa2
.d547 85 77 sta $77 STA FACt_3 ; clear temp mantissa3
.d549 a5 b9 lda $b9 LDA FAC1_r ; get FAC1 rounding byte
.d54b 20 60 d5 jsr $d560 JSR LAB_2622 ; go do shift/add FAC2
.d54e a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d550 20 60 d5 jsr $d560 JSR LAB_2622 ; go do shift/add FAC2
.d553 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d555 20 60 d5 jsr $d560 JSR LAB_2622 ; go do shift/add FAC2
.d558 a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.d55a 20 65 d5 jsr $d565 JSR LAB_2627 ; go do shift/add FAC2
.d55d 4c 6e d6 jmp $d66e JMP LAB_273C ; copy temp to FAC1, normalise and return
.d560 lab_2622
.d560 d0 03 bne $d565 BNE LAB_2627 ; branch if byte <> zero
.d562 4c c8 d4 jmp $d4c8 JMP LAB_2569 ; shift FCAtemp << A+8 times
.d565 lab_2627
.d565 4a lsr LSR ; shift byte
.d566 09 80 ora #$80 ORA #$80 ; set top bit (mark for 8 times)
.d568 lab_262a
.d568 a8 tay TAY ; copy result
.d569 90 13 bcc $d57e BCC LAB_2640 ; skip next if bit was zero
.d56b 18 clc CLC ; clear carry for add
.d56c a5 77 lda $77 LDA FACt_3 ; get temp mantissa3
.d56e 65 b6 adc $b6 ADC FAC2_3 ; add FAC2 mantissa3
.d570 85 77 sta $77 STA FACt_3 ; save temp mantissa3
.d572 a5 76 lda $76 LDA FACt_2 ; get temp mantissa2
.d574 65 b5 adc $b5 ADC FAC2_2 ; add FAC2 mantissa2
.d576 85 76 sta $76 STA FACt_2 ; save temp mantissa2
.d578 a5 75 lda $75 LDA FACt_1 ; get temp mantissa1
.d57a 65 b4 adc $b4 ADC FAC2_1 ; add FAC2 mantissa1
.d57c 85 75 sta $75 STA FACt_1 ; save temp mantissa1
.d57e lab_2640
.d57e 66 75 ror $75 ROR FACt_1 ; shift temp mantissa1
.d580 66 76 ror $76 ROR FACt_2 ; shift temp mantissa2
.d582 66 77 ror $77 ROR FACt_3 ; shift temp mantissa3
.d584 66 b9 ror $b9 ROR FAC1_r ; shift temp rounding byte
.d586 98 tya TYA ; get byte back
.d587 4a lsr LSR ; shift byte
.d588 d0 de bne $d568 BNE LAB_262A ; loop if all bits not done
.d58a lab_264c
.d58a 60 rts RTS
.d58b lab_264d
.d58b 85 71 sta $71 STA ut1_pl ; save pointer low byte
.d58d 84 72 sty $72 STY ut1_ph ; save pointer high byte
.d58f a0 03 ldy #$03 LDY #$03 ; 4 bytes to get (0-3)
.d591 b1 71 lda ($71),y LDA (ut1_pl),Y ; get mantissa3
.d593 85 b6 sta $b6 STA FAC2_3 ; save FAC2 mantissa3
.d595 88 dey DEY ; decrement index
.d596 b1 71 lda ($71),y LDA (ut1_pl),Y ; get mantissa2
.d598 85 b5 sta $b5 STA FAC2_2 ; save FAC2 mantissa2
.d59a 88 dey DEY ; decrement index
.d59b b1 71 lda ($71),y LDA (ut1_pl),Y ; get mantissa1+sign
.d59d 85 b7 sta $b7 STA FAC2_s ; save FAC2 sign (b7)
.d59f 45 b0 eor $b0 EOR FAC1_s ; EOR with FAC1 sign (b7)
.d5a1 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.d5a3 a5 b7 lda $b7 LDA FAC2_s ; recover FAC2 sign (b7)
.d5a5 09 80 ora #$80 ORA #$80 ; set 1xxx xxx (set normal bit)
.d5a7 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.d5a9 88 dey DEY ; decrement index
.d5aa b1 71 lda ($71),y LDA (ut1_pl),Y ; get exponent byte
.d5ac 85 b3 sta $b3 STA FAC2_e ; save FAC2 exponent
.d5ae a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d5b0 60 rts RTS
.d5b1 lab_2673
.d5b1 a5 b3 lda $b3 LDA FAC2_e ; get FAC2 exponent
.d5b3 lab_2675
.d5b3 f0 1d beq $d5d2 BEQ LAB_2696 ; branch if FAC2 = $00 (handle underflow)
.d5b5 18 clc CLC ; clear carry for add
.d5b6 65 ac adc $ac ADC FAC1_e ; add FAC1 exponent
.d5b8 90 04 bcc $d5be BCC LAB_2680 ; branch if sum of exponents <$0100
.d5ba 30 31 bmi $d5ed BMI LAB_269B ; do overflow error
.d5bc 18 clc CLC ; clear carry for the add
>d5bd 2c .byte $2C ; makes next line BIT $1410
.d5be lab_2680
.d5be 10 12 bpl $d5d2 BPL LAB_2696 ; if +ve go handle underflow
.d5c0 69 80 adc #$80 ADC #$80 ; adjust exponent
.d5c2 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d5c4 d0 03 bne $d5c9 BNE LAB_268B ; branch if not zero
.d5c6 4c 54 d4 jmp $d454 JMP LAB_24F5 ; save FAC1 sign and return
.d5c9 lab_268b
.d5c9 a5 b8 lda $b8 LDA FAC_sc ; get sign compare (FAC1 EOR FAC2)
.d5cb 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d5cd lab_268f
.d5cd 60 rts RTS
.d5ce lab_2690
.d5ce a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d5d0 10 1b bpl $d5ed BPL LAB_269B ; do overflow error
.d5d2 lab_2696
.d5d2 68 pla PLA ; pop return address low byte
.d5d3 68 pla PLA ; pop return address high byte
.d5d4 4c 50 d4 jmp $d450 JMP LAB_24F1 ; clear FAC1 exponent and sign and return
.d5d7 lab_269e
.d5d7 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.d5da aa tax TAX ; copy exponent (set the flags)
.d5db f0 f0 beq $d5cd BEQ LAB_268F ; exit if zero
.d5dd 18 clc CLC ; clear carry for add
.d5de 69 02 adc #$02 ADC #$02 ; add two to exponent (*4)
.d5e0 b0 0b bcs $d5ed BCS LAB_269B ; do overflow error if > $FF
.d5e2 a2 00 ldx #$00 LDX #$00 ; clear byte
.d5e4 86 b8 stx $b8 STX FAC_sc ; clear sign compare (FAC1 EOR FAC2)
.d5e6 20 db d3 jsr $d3db JSR LAB_247C ; add FAC2 to FAC1 (*5)
.d5e9 e6 ac inc $ac INC FAC1_e ; increment FAC1 exponent (*10)
.d5eb d0 e0 bne $d5cd BNE LAB_268F ; if non zero just do RTS
.d5ed lab_269b
.d5ed 4c c3 d4 jmp $d4c3 JMP LAB_2564 ; do overflow error and warm start
.d5f0 lab_26b9
.d5f0 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.d5f3 a9 f1 lda #$f1 LDA #<LAB_26B5 ; set pointer to 10d low addr
.d5f5 a0 df ldy #$df LDY #>LAB_26B5 ; set pointer to 10d high addr
.d5f7 a2 00 ldx #$00 LDX #$00 ; clear sign
.d5f9 lab_26c2
.d5f9 86 b8 stx $b8 STX FAC_sc ; save sign compare (FAC1 EOR FAC2)
.d5fb 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (AY) into FAC1
.d5fe 4c 04 d6 jmp $d604 JMP LAB_DIVIDE ; do FAC2/FAC1
.d601 lab_26ca
.d601 20 8b d5 jsr $d58b JSR LAB_264D ; unpack memory (AY) into FAC2
.d604 lab_divide
.d604 f0 63 beq $d669 BEQ LAB_2737 ; if zero go do /0 error
.d606 20 d9 d6 jsr $d6d9 JSR LAB_27BA ; round FAC1
.d609 a9 00 lda #$00 LDA #$00 ; clear A
.d60b 38 sec SEC ; set carry for subtract
.d60c e5 ac sbc $ac SBC FAC1_e ; subtract FAC1 exponent (2s complement)
.d60e 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d610 20 b1 d5 jsr $d5b1 JSR LAB_2673 ; test and adjust accumulators
.d613 e6 ac inc $ac INC FAC1_e ; increment FAC1 exponent
.d615 f0 d6 beq $d5ed BEQ LAB_269B ; if zero do overflow error
.d617 a2 ff ldx #$ff LDX #$FF ; set index for pre increment
.d619 a9 01 lda #$01 LDA #$01 ; set bit to flag byte save
.d61b lab_26e4
.d61b a4 b4 ldy $b4 LDY FAC2_1 ; get FAC2 mantissa1
.d61d c4 ad cpy $ad CPY FAC1_1 ; compare FAC1 mantissa1
.d61f d0 0a bne $d62b BNE LAB_26F4 ; branch if <>
.d621 a4 b5 ldy $b5 LDY FAC2_2 ; get FAC2 mantissa2
.d623 c4 ae cpy $ae CPY FAC1_2 ; compare FAC1 mantissa2
.d625 d0 04 bne $d62b BNE LAB_26F4 ; branch if <>
.d627 a4 b6 ldy $b6 LDY FAC2_3 ; get FAC2 mantissa3
.d629 c4 af cpy $af CPY FAC1_3 ; compare FAC1 mantissa3
.d62b lab_26f4
.d62b 08 php PHP ; save FAC2-FAC1 compare status
.d62c 2a rol ROL ; shift the result byte
.d62d 90 0e bcc $d63d BCC LAB_2702 ; if no carry skip the byte save
.d62f a0 01 ldy #$01 LDY #$01 ; set bit to flag byte save
.d631 e8 inx INX ; else increment the index to FACt
.d632 e0 02 cpx #$02 CPX #$02 ; compare with the index to FACt_3
.d634 30 04 bmi $d63a BMI LAB_2701 ; if not last byte just go save it
.d636 d0 28 bne $d660 BNE LAB_272B ; if all done go save FAC1 rounding byte, normalise and
.d638 a0 40 ldy #$40 LDY #$40 ; set bit to flag byte save for the rounding byte
.d63a lab_2701
.d63a 95 75 sta $75,x STA FACt_1,X ; write result byte to FACt_1 + index
.d63c 98 tya TYA ; copy the next save byte flag
.d63d lab_2702
.d63d 28 plp PLP ; restore FAC2-FAC1 compare status
.d63e 90 14 bcc $d654 BCC LAB_2704 ; if FAC2 < FAC1 then skip the subtract
.d640 a8 tay TAY ; save FAC2-FAC1 compare status
.d641 a5 b6 lda $b6 LDA FAC2_3 ; get FAC2 mantissa3
.d643 e5 af sbc $af SBC FAC1_3 ; subtract FAC1 mantissa3
.d645 85 b6 sta $b6 STA FAC2_3 ; save FAC2 mantissa3
.d647 a5 b5 lda $b5 LDA FAC2_2 ; get FAC2 mantissa2
.d649 e5 ae sbc $ae SBC FAC1_2 ; subtract FAC1 mantissa2
.d64b 85 b5 sta $b5 STA FAC2_2 ; save FAC2 mantissa2
.d64d a5 b4 lda $b4 LDA FAC2_1 ; get FAC2 mantissa1
.d64f e5 ad sbc $ad SBC FAC1_1 ; subtract FAC1 mantissa1
.d651 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.d653 98 tya TYA ; restore FAC2-FAC1 compare status
.d654 lab_2704
.d654 06 b6 asl $b6 ASL FAC2_3 ; shift FAC2 mantissa3
.d656 26 b5 rol $b5 ROL FAC2_2 ; shift FAC2 mantissa2
.d658 26 b4 rol $b4 ROL FAC2_1 ; shift FAC2 mantissa1
.d65a b0 cf bcs $d62b BCS LAB_26F4 ; loop with no compare
.d65c 30 bd bmi $d61b BMI LAB_26E4 ; loop with compare
.d65e 10 cb bpl $d62b BPL LAB_26F4 ; loop always with no compare
.d660 lab_272b
.d660 4a lsr LSR ; shift b1 - b0 ..
.d661 6a ror ROR ; ..
.d662 6a ror ROR ; .. to b7 - b6
.d663 85 b9 sta $b9 STA FAC1_r ; save FAC1 rounding byte
.d665 28 plp PLP ; dump FAC2-FAC1 compare status
.d666 4c 6e d6 jmp $d66e JMP LAB_273C ; copy temp to FAC1, normalise and return
.d669 lab_2737
.d669 a2 14 ldx #$14 LDX #$14 ; error code $14 ("Divide by zero" error)
.d66b 4c 3c bf jmp $bf3c JMP LAB_XERR ; do error #X, then warm start
.d66e lab_273c
.d66e a5 75 lda $75 LDA FACt_1 ; get temp mantissa1
.d670 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d672 a5 76 lda $76 LDA FACt_2 ; get temp mantissa2
.d674 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d676 a5 77 lda $77 LDA FACt_3 ; get temp mantissa3
.d678 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d67a 4c 34 d4 jmp $d434 JMP LAB_24D5 ; normalise FAC1 and return
.d67d lab_ufac
.d67d 85 71 sta $71 STA ut1_pl ; save pointer low byte
.d67f 84 72 sty $72 STY ut1_ph ; save pointer high byte
.d681 a0 03 ldy #$03 LDY #$03 ; 4 bytes to do
.d683 b1 71 lda ($71),y LDA (ut1_pl),Y ; get last byte
.d685 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d687 88 dey DEY ; decrement index
.d688 b1 71 lda ($71),y LDA (ut1_pl),Y ; get last-1 byte
.d68a 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d68c 88 dey DEY ; decrement index
.d68d b1 71 lda ($71),y LDA (ut1_pl),Y ; get second byte
.d68f 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d691 09 80 ora #$80 ORA #$80 ; set 1xxx xxxx (add normal bit)
.d693 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d695 88 dey DEY ; decrement index
.d696 b1 71 lda ($71),y LDA (ut1_pl),Y ; get first byte (exponent)
.d698 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d69a 84 b9 sty $b9 STY FAC1_r ; clear FAC1 rounding byte
.d69c 60 rts RTS
.d69d lab_276e
.d69d a2 a4 ldx #$a4 LDX #<Adatal ; set pointer low byte
.d69f lab_2770
.d69f a0 00 ldy #$00 LDY #>Adatal ; set pointer high byte
.d6a1 f0 04 beq $d6a7 BEQ LAB_2778 ; pack FAC1 into (XY) and return
.d6a3 lab_pfac
.d6a3 a6 97 ldx $97 LDX Lvarpl ; get destination pointer low byte
.d6a5 a4 98 ldy $98 LDY Lvarph ; get destination pointer high byte
.d6a7 lab_2778
.d6a7 20 d9 d6 jsr $d6d9 JSR LAB_27BA ; round FAC1
.d6aa 86 71 stx $71 STX ut1_pl ; save pointer low byte
.d6ac 84 72 sty $72 STY ut1_ph ; save pointer high byte
.d6ae a0 03 ldy #$03 LDY #$03 ; set index
.d6b0 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d6b2 91 71 sta ($71),y STA (ut1_pl),Y ; store in destination
.d6b4 88 dey DEY ; decrement index
.d6b5 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d6b7 91 71 sta ($71),y STA (ut1_pl),Y ; store in destination
.d6b9 88 dey DEY ; decrement index
.d6ba a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d6bc 09 7f ora #$7f ORA #$7F ; set bits x111 1111
.d6be 25 ad and $ad AND FAC1_1 ; AND in FAC1 mantissa1
.d6c0 91 71 sta ($71),y STA (ut1_pl),Y ; store in destination
.d6c2 88 dey DEY ; decrement index
.d6c3 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d6c5 91 71 sta ($71),y STA (ut1_pl),Y ; store in destination
.d6c7 84 b9 sty $b9 STY FAC1_r ; clear FAC1 rounding byte
.d6c9 60 rts RTS
.d6ca lab_27ab
.d6ca 20 d9 d6 jsr $d6d9 JSR LAB_27BA ; round FAC1
.d6cd lab_27ae
.d6cd a2 05 ldx #$05 LDX #$05 ; 5 bytes to copy
.d6cf lab_27b0
.d6cf b5 ab lda $ab,x LDA FAC1_e-1,X ; get byte from FAC1,X
.d6d1 95 b2 sta $b2,x STA FAC1_o,X ; save byte at FAC2,X
.d6d3 ca dex DEX ; decrement count
.d6d4 d0 f9 bne $d6cf BNE LAB_27B0 ; loop if not all done
.d6d6 86 b9 stx $b9 STX FAC1_r ; clear FAC1 rounding byte
.d6d8 lab_27b9
.d6d8 60 rts RTS
.d6d9 lab_27ba
.d6d9 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d6db f0 fb beq $d6d8 BEQ LAB_27B9 ; exit if zero
.d6dd 06 b9 asl $b9 ASL FAC1_r ; shift FAC1 rounding byte
.d6df 90 f7 bcc $d6d8 BCC LAB_27B9 ; exit if no overflow
.d6e1 lab_27c2
.d6e1 20 b8 d4 jsr $d4b8 JSR LAB_2559 ; increment FAC1 mantissa
.d6e4 d0 f2 bne $d6d8 BNE LAB_27B9 ; branch if no overflow
.d6e6 4c 89 d4 jmp $d489 JMP LAB_252A ; normalise FAC1 for C=1 and return
.d6e9 lab_27ca
.d6e9 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d6eb f0 09 beq $d6f6 BEQ LAB_27D7 ; exit if zero (already correct SGN(0)=0)
.d6ed lab_27ce
.d6ed a5 b0 lda $b0 LDA FAC1_s ; else get FAC1 sign (b7)
.d6ef lab_27d0
.d6ef 2a rol ROL ; move sign bit to carry
.d6f0 a9 ff lda #$ff LDA #$FF ; set byte for -ve result
.d6f2 b0 02 bcs $d6f6 BCS LAB_27D7 ; return if sign was set (-ve)
.d6f4 a9 01 lda #$01 LDA #$01 ; else set byte for +ve result
.d6f6 lab_27d7
.d6f6 60 rts RTS
.d6f7 lab_sgn
.d6f7 20 e9 d6 jsr $d6e9 JSR LAB_27CA ; get FAC1 sign
.d6fa lab_27db
.d6fa 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d6fc a9 00 lda #$00 LDA #$00 ; clear A
.d6fe 85 ae sta $ae STA FAC1_2 ; clear FAC1 mantissa2
.d700 a2 88 ldx #$88 LDX #$88 ; set exponent
.d702 lab_27e3
.d702 a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.d704 49 ff eor #$ff EOR #$FF ; complement it
.d706 2a rol ROL ; sign bit into carry
.d707 lab_stfa
.d707 a9 00 lda #$00 LDA #$00 ; clear A
.d709 85 af sta $af STA FAC1_3 ; clear FAC1 mantissa3
.d70b 86 ac stx $ac STX FAC1_e ; set FAC1 exponent
.d70d 85 b9 sta $b9 STA FAC1_r ; clear FAC1 rounding byte
.d70f 85 b0 sta $b0 STA FAC1_s ; clear FAC1 sign (b7)
.d711 4c 2f d4 jmp $d42f JMP LAB_24D0 ; do ABS and normalise FAC1
.d714 lab_abs
.d714 46 b0 lsr $b0 LSR FAC1_s ; clear FAC1 sign (put zero in b7)
.d716 60 rts RTS
.d717 lab_27f8
.d717 85 73 sta $73 STA ut2_pl ; save pointer low byte
.d719 lab_27fa
.d719 84 74 sty $74 STY ut2_ph ; save pointer high byte
.d71b a0 00 ldy #$00 LDY #$00 ; clear index
.d71d b1 73 lda ($73),y LDA (ut2_pl),Y ; get exponent
.d71f c8 iny INY ; increment index
.d720 aa tax TAX ; copy (AY) exponent to X
.d721 f0 c6 beq $d6e9 BEQ LAB_27CA ; branch if (AY) exponent=0 and get FAC1 sign
.d723 b1 73 lda ($73),y LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign)
.d725 45 b0 eor $b0 EOR FAC1_s ; EOR FAC1 sign (b7)
.d727 30 c4 bmi $d6ed BMI LAB_27CE ; if signs <> do return A=FF,C=1/-ve
.d729 e4 ac cpx $ac CPX FAC1_e ; compare (AY) exponent with FAC1 exponent
.d72b d0 1a bne $d747 BNE LAB_2828 ; branch if different
.d72d b1 73 lda ($73),y LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign)
.d72f 09 80 ora #$80 ORA #$80 ; normalise top bit
.d731 c5 ad cmp $ad CMP FAC1_1 ; compare with FAC1 mantissa1
.d733 d0 12 bne $d747 BNE LAB_2828 ; branch if different
.d735 c8 iny INY ; increment index
.d736 b1 73 lda ($73),y LDA (ut2_pl),Y ; get mantissa2
.d738 c5 ae cmp $ae CMP FAC1_2 ; compare with FAC1 mantissa2
.d73a d0 0b bne $d747 BNE LAB_2828 ; branch if different
.d73c c8 iny INY ; increment index
.d73d a9 7f lda #$7f LDA #$7F ; set for 1/2 value rounding byte
.d73f c5 b9 cmp $b9 CMP FAC1_r ; compare with FAC1 rounding byte (set carry)
.d741 b1 73 lda ($73),y LDA (ut2_pl),Y ; get mantissa3
.d743 e5 af sbc $af SBC FAC1_3 ; subtract FAC1 mantissa3
.d745 f0 28 beq $d76f BEQ LAB_2850 ; exit if mantissa3 equal
.d747 lab_2828
.d747 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d749 90 02 bcc $d74d BCC LAB_282E ; branch if FAC1 > (AY)
.d74b 49 ff eor #$ff EOR #$FF ; else toggle FAC1 sign
.d74d lab_282e
.d74d 4c ef d6 jmp $d6ef JMP LAB_27D0 ; return A=FF,C=1/-ve A=01,C=0/+ve
.d750 lab_2831
.d750 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d752 f0 4a beq $d79e BEQ LAB_287F ; if zero go clear FAC1 and return
.d754 38 sec SEC ; set carry for subtract
.d755 e9 98 sbc #$98 SBC #$98 ; subtract maximum integer range exponent
.d757 24 b0 bit $b0 BIT FAC1_s ; test FAC1 sign (b7)
.d759 10 09 bpl $d764 BPL LAB_2845 ; branch if FAC1 +ve
.d75b aa tax TAX ; copy subtracted exponent
.d75c a9 ff lda #$ff LDA #$FF ; overflow for -ve number
.d75e 85 b2 sta $b2 STA FAC1_o ; set FAC1 overflow byte
.d760 20 9c d4 jsr $d49c JSR LAB_253D ; twos complement FAC1 mantissa
.d763 8a txa TXA ; restore subtracted exponent
.d764 lab_2845
.d764 a2 ac ldx #$ac LDX #FAC1_e ; set index to FAC1
.d766 c9 f9 cmp #$f9 CMP #$F9 ; compare exponent result
.d768 10 06 bpl $d770 BPL LAB_2851 ; if < 8 shifts shift FAC1 A times right and return
.d76a 20 da d4 jsr $d4da JSR LAB_257B ; shift FAC1 A times right (> 8 shifts)
.d76d 84 b2 sty $b2 STY FAC1_o ; clear FAC1 overflow byte
.d76f lab_2850
.d76f 60 rts RTS
.d770 lab_2851
.d770 a8 tay TAY ; copy shift count
.d771 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d773 29 80 and #$80 AND #$80 ; mask sign bit only (x000 0000)
.d775 46 ad lsr $ad LSR FAC1_1 ; shift FAC1 mantissa1
.d777 05 ad ora $ad ORA FAC1_1 ; OR sign in b7 FAC1 mantissa1
.d779 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d77b 20 f1 d4 jsr $d4f1 JSR LAB_2592 ; shift FAC1 Y times right
.d77e 84 b2 sty $b2 STY FAC1_o ; clear FAC1 overflow byte
.d780 60 rts RTS
.d781 lab_int
.d781 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d783 c9 98 cmp #$98 CMP #$98 ; compare with max int
.d785 b0 1e bcs $d7a5 BCS LAB_2886 ; exit if >= (already int, too big for fractional part!)
.d787 20 50 d7 jsr $d750 JSR LAB_2831 ; convert FAC1 floating-to-fixed
.d78a 84 b9 sty $b9 STY FAC1_r ; save FAC1 rounding byte
.d78c a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d78e 84 b0 sty $b0 STY FAC1_s ; save FAC1 sign (b7)
.d790 49 80 eor #$80 EOR #$80 ; toggle FAC1 sign
.d792 2a rol ROL ; shift into carry
.d793 a9 98 lda #$98 LDA #$98 ; set new exponent
.d795 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.d797 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d799 85 5b sta $5b STA Temp3 ; save for EXP() function
.d79b 4c 2f d4 jmp $d42f JMP LAB_24D0 ; do ABS and normalise FAC1
.d79e lab_287f
.d79e 85 ad sta $ad STA FAC1_1 ; clear FAC1 mantissa1
.d7a0 85 ae sta $ae STA FAC1_2 ; clear FAC1 mantissa2
.d7a2 85 af sta $af STA FAC1_3 ; clear FAC1 mantissa3
.d7a4 a8 tay TAY ; clear Y
.d7a5 lab_2886
.d7a5 60 rts RTS
.d7a6 lab_2887
.d7a6 a0 00 ldy #$00 LDY #$00 ; clear Y
.d7a8 84 5f sty $5f STY Dtypef ; clear data type flag, $FF=string, $00=numeric
.d7aa a2 09 ldx #$09 LDX #$09 ; set index
.d7ac lab_288b
.d7ac 94 a8 sty $a8,x STY numexp,X ; clear byte
.d7ae ca dex DEX ; decrement index
.d7af 10 fb bpl $d7ac BPL LAB_288B ; loop until numexp to negnum (and FAC1) = $00
.d7b1 90 7f bcc $d832 BCC LAB_28FE ; branch if 1st character numeric
.d7b3 c9 2d cmp #$2d CMP #"-" ; else compare with "-"
.d7b5 d0 04 bne $d7bb BNE LAB_289A ; branch if not "-"
.d7b7 86 b1 stx $b1 STX negnum ; set flag for -ve number (X = $FF)
.d7b9 f0 04 beq $d7bf BEQ LAB_289C ; branch always (go scan and check for hex/bin)
.d7bb lab_289a
.d7bb c9 2b cmp #$2b CMP #"+" ; else compare with "+"
.d7bd d0 05 bne $d7c4 BNE LAB_289D ; branch if not "+" (go check for hex/bin)
.d7bf lab_289c
.d7bf 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.d7c2 90 6e bcc $d832 BCC LAB_28FE ; branch if numeric character
.d7c4 lab_289d
.d7c4 c9 24 cmp #$24 CMP #"$" ; else compare with "$"
.d7c6 d0 03 bne $d7cb BNE LAB_NHEX ; branch if not "$"
.d7c8 4c 6e dc jmp $dc6e JMP LAB_CHEX ; branch if "$"
.d7cb lab_nhex
.d7cb c9 25 cmp #$25 CMP #"%" ; else compare with "%"
.d7cd d0 08 bne $d7d7 BNE LAB_28A3 ; branch if not "%" (continue original code)
.d7cf 4c 9c dc jmp $dc9c JMP LAB_CBIN ; branch if "%"
.d7d2 lab_289e
.d7d2 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory (ignore + or get next number)
.d7d5 lab_28a1
.d7d5 90 5b bcc $d832 BCC LAB_28FE ; branch if numeric character
.d7d7 lab_28a3
.d7d7 c9 2e cmp #$2e CMP #"." ; else compare with "."
.d7d9 f0 2e beq $d809 BEQ LAB_28D5 ; branch if "."
.d7db c9 45 cmp #$45 CMP #"E" ; else compare with "E"
.d7dd d0 30 bne $d80f BNE LAB_28DB ; branch if not "E"
.d7df 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.d7e2 90 17 bcc $d7fb BCC LAB_28C7 ; branch if numeric character
.d7e4 c9 b8 cmp #$b8 CMP #TK_MINUS ; else compare with token for -
.d7e6 f0 0e beq $d7f6 BEQ LAB_28C2 ; branch if token for -
.d7e8 c9 2d cmp #$2d CMP #"-" ; else compare with "-"
.d7ea f0 0a beq $d7f6 BEQ LAB_28C2 ; branch if "-"
.d7ec c9 b7 cmp #$b7 CMP #TK_PLUS ; else compare with token for +
.d7ee f0 08 beq $d7f8 BEQ LAB_28C4 ; branch if token for +
.d7f0 c9 2b cmp #$2b CMP #"+" ; else compare with "+"
.d7f2 f0 04 beq $d7f8 BEQ LAB_28C4 ; branch if "+"
.d7f4 d0 07 bne $d7fd BNE LAB_28C9 ; branch always
.d7f6 lab_28c2
.d7f6 66 ab ror $ab ROR expneg ; set exponent -ve flag (C, which=1, into b7)
.d7f8 lab_28c4
.d7f8 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.d7fb lab_28c7
.d7fb 90 5b bcc $d858 BCC LAB_2925 ; branch if numeric character
.d7fd lab_28c9
.d7fd 24 ab bit $ab BIT expneg ; test exponent -ve flag
.d7ff 10 0e bpl $d80f BPL LAB_28DB ; if +ve go evaluate exponent
.d801 a9 00 lda #$00 LDA #$00 ; clear result
.d803 38 sec SEC ; set carry for subtract
.d804 e5 a9 sbc $a9 SBC expcnt ; subtract exponent byte
.d806 4c 11 d8 jmp $d811 JMP LAB_28DD ; go evaluate exponent
.d809 lab_28d5
.d809 66 aa ror $aa ROR numdpf ; set decimal point flag
.d80b 24 aa bit $aa BIT numdpf ; test decimal point flag
.d80d 50 c3 bvc $d7d2 BVC LAB_289E ; branch if only one decimal point so far
.d80f lab_28db
.d80f a5 a9 lda $a9 LDA expcnt ; get exponent count byte
.d811 lab_28dd
.d811 38 sec SEC ; set carry for subtract
.d812 e5 a8 sbc $a8 SBC numexp ; subtract numerator exponent
.d814 85 a9 sta $a9 STA expcnt ; save exponent count byte
.d816 f0 12 beq $d82a BEQ LAB_28F6 ; branch if no adjustment
.d818 10 09 bpl $d823 BPL LAB_28EF ; else if +ve go do FAC1*10^expcnt
.d81a lab_28e6
.d81a 20 f0 d5 jsr $d5f0 JSR LAB_26B9 ; divide by 10
.d81d e6 a9 inc $a9 INC expcnt ; increment exponent count byte
.d81f d0 f9 bne $d81a BNE LAB_28E6 ; loop until all done
.d821 f0 07 beq $d82a BEQ LAB_28F6 ; branch always
.d823 lab_28ef
.d823 20 d7 d5 jsr $d5d7 JSR LAB_269E ; multiply by 10
.d826 c6 a9 dec $a9 DEC expcnt ; decrement exponent count byte
.d828 d0 f9 bne $d823 BNE LAB_28EF ; loop until all done
.d82a lab_28f6
.d82a a5 b1 lda $b1 LDA negnum ; get -ve flag
.d82c 30 01 bmi $d82f BMI LAB_28FB ; if -ve do - FAC1 and return
.d82e 60 rts RTS
.d82f lab_28fb
.d82f 4c f4 d9 jmp $d9f4 JMP LAB_GTHAN ; do - FAC1 and return
.d832 lab_28fe
.d832 48 pha PHA ; save character
.d833 24 aa bit $aa BIT numdpf ; test decimal point flag
.d835 10 02 bpl $d839 BPL LAB_2905 ; skip exponent increment if not set
.d837 e6 a8 inc $a8 INC numexp ; else increment number exponent
.d839 lab_2905
.d839 20 d7 d5 jsr $d5d7 JSR LAB_269E ; multiply FAC1 by 10
.d83c 68 pla PLA ; restore character
.d83d 29 0f and #$0f AND #$0F ; convert to binary
.d83f 20 45 d8 jsr $d845 JSR LAB_2912 ; evaluate new ASCII digit
.d842 4c d2 d7 jmp $d7d2 JMP LAB_289E ; go do next character
.d845 lab_2912
.d845 48 pha PHA ; save digit
.d846 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.d849 68 pla PLA ; restore digit
.d84a 20 fa d6 jsr $d6fa JSR LAB_27DB ; save A as integer byte
.d84d a5 b7 lda $b7 LDA FAC2_s ; get FAC2 sign (b7)
.d84f 45 b0 eor $b0 EOR FAC1_s ; toggle with FAC1 sign (b7)
.d851 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.d853 a6 ac ldx $ac LDX FAC1_e ; get FAC1 exponent
.d855 4c c1 d3 jmp $d3c1 JMP LAB_ADD ; add FAC2 to FAC1 and return
.d858 lab_2925
.d858 a5 a9 lda $a9 LDA expcnt ; get exponent count byte
.d85a c9 0a cmp #$0a CMP #$0A ; compare with 10 decimal
.d85c 90 09 bcc $d867 BCC LAB_2934 ; branch if less
.d85e a9 64 lda #$64 LDA #$64 ; make all -ve exponents = -100 decimal (causes underflow)
.d860 24 ab bit $ab BIT expneg ; test exponent -ve flag
.d862 30 0e bmi $d872 BMI LAB_2942 ; branch if -ve
.d864 4c c3 d4 jmp $d4c3 JMP LAB_2564 ; else do overflow error
.d867 lab_2934
.d867 0a asl ASL ; * 2
.d868 0a asl ASL ; * 4
.d869 65 a9 adc $a9 ADC expcnt ; * 5
.d86b 0a asl ASL ; * 10
.d86c a0 00 ldy #$00 LDY #$00 ; set index
.d86e 71 c3 adc ($c3),y ADC (Bpntrl),Y ; add character (will be $30 too much!)
.d870 e9 2f sbc #$2f SBC #"0"-1 ; convert character to binary
.d872 lab_2942
.d872 85 a9 sta $a9 STA expcnt ; save exponent count byte
.d874 4c f8 d7 jmp $d7f8 JMP LAB_28C4 ; go get next character
.d877 lab_2953
.d877 a9 f6 lda #$f6 LDA #<LAB_LMSG ; point to " in line " message low byte
.d879 a0 e5 ldy #$e5 LDY #>LAB_LMSG ; point to " in line " message high byte
.d87b 20 d3 c6 jsr $c6d3 JSR LAB_18C3 ; print null terminated string from memory
.d87e a5 88 lda $88 LDA Clineh ; get current line high byte
.d880 a6 87 ldx $87 LDX Clinel ; get current line low byte
.d882 lab_295e
.d882 85 ad sta $ad STA FAC1_1 ; save low byte as FAC1 mantissa1
.d884 86 ae stx $ae STX FAC1_2 ; save high byte as FAC1 mantissa2
.d886 a2 90 ldx #$90 LDX #$90 ; set exponent to 16d bits
.d888 38 sec SEC ; set integer is +ve flag
.d889 20 07 d7 jsr $d707 JSR LAB_STFA ; set exp=X, clearFAC1 mantissa3 and normalise
.d88c a0 00 ldy #$00 LDY #$00 ; clear index
.d88e 98 tya TYA ; clear A
.d88f 20 a2 d8 jsr $d8a2 JSR LAB_297B ; convert FAC1 to string, skip sign character save
.d892 4c d3 c6 jmp $c6d3 JMP LAB_18C3 ; print null terminated string from memory and return
.d895 lab_296e
.d895 a0 01 ldy #$01 LDY #$01 ; set index = 1
.d897 a9 20 lda #$20 LDA #$20 ; character = " " (assume +ve)
.d899 24 b0 bit $b0 BIT FAC1_s ; test FAC1 sign (b7)
.d89b 10 02 bpl $d89f BPL LAB_2978 ; branch if +ve
.d89d a9 2d lda #$2d LDA #$2D ; else character = "-"
.d89f lab_2978
.d89f 99 ef 00 sta $00ef,y STA Decss,Y ; save leading character (" " or "-")
.d8a2 lab_297b
.d8a2 85 b0 sta $b0 STA FAC1_s ; clear FAC1 sign (b7)
.d8a4 84 ba sty $ba STY Sendl ; save index
.d8a6 c8 iny INY ; increment index
.d8a7 a6 ac ldx $ac LDX FAC1_e ; get FAC1 exponent
.d8a9 d0 05 bne $d8b0 BNE LAB_2989 ; branch if FAC1<>0
.d8ab a9 30 lda #$30 LDA #"0" ; set character = "0"
.d8ad 4c ae d9 jmp $d9ae JMP LAB_2A89 ; save last character, [EOT] and exit
.d8b0 lab_2989
.d8b0 a9 00 lda #$00 LDA #$00 ; clear (number exponent count)
.d8b2 e0 81 cpx #$81 CPX #$81 ; compare FAC1 exponent with $81 (>1.00000)
.d8b4 b0 09 bcs $d8bf BCS LAB_299A ; branch if FAC1=>1
.d8b6 a9 81 lda #$81 LDA #<LAB_294F ; set pointer low byte to 1,000,000
.d8b8 a0 df ldy #$df LDY #>LAB_294F ; set pointer high byte to 1,000,000
.d8ba 20 39 d5 jsr $d539 JSR LAB_25FB ; do convert AY, FCA1*(AY)
.d8bd a9 fa lda #$fa LDA #$FA ; set number exponent count (-6)
.d8bf lab_299a
.d8bf 85 a8 sta $a8 STA numexp ; save number exponent count
.d8c1 lab_299c
.d8c1 a9 7d lda #$7d LDA #<LAB_294B ; set pointer low byte to 999999.4375 (max before sci note)
.d8c3 a0 df ldy #$df LDY #>LAB_294B ; set pointer high byte to 999999.4375
.d8c5 20 17 d7 jsr $d717 JSR LAB_27F8 ; compare FAC1 with (AY)
.d8c8 f0 1e beq $d8e8 BEQ LAB_29C3 ; exit if FAC1 = (AY)
.d8ca 10 12 bpl $d8de BPL LAB_29B9 ; go do /10 if FAC1 > (AY)
.d8cc lab_29a7
.d8cc a9 79 lda #$79 LDA #<LAB_2947 ; set pointer low byte to 99999.9375
.d8ce a0 df ldy #$df LDY #>LAB_2947 ; set pointer high byte to 99999.9375
.d8d0 20 17 d7 jsr $d717 JSR LAB_27F8 ; compare FAC1 with (AY)
.d8d3 f0 02 beq $d8d7 BEQ LAB_29B2 ; branch if FAC1 = (AY) (allow decimal places)
.d8d5 10 0e bpl $d8e5 BPL LAB_29C0 ; branch if FAC1 > (AY) (no decimal places)
.d8d7 lab_29b2
.d8d7 20 d7 d5 jsr $d5d7 JSR LAB_269E ; multiply by 10
.d8da c6 a8 dec $a8 DEC numexp ; decrement number exponent count
.d8dc d0 ee bne $d8cc BNE LAB_29A7 ; go test again (branch always)
.d8de lab_29b9
.d8de 20 f0 d5 jsr $d5f0 JSR LAB_26B9 ; divide by 10
.d8e1 e6 a8 inc $a8 INC numexp ; increment number exponent count
.d8e3 d0 dc bne $d8c1 BNE LAB_299C ; go test again (branch always)
.d8e5 lab_29c0
.d8e5 20 ba d3 jsr $d3ba JSR LAB_244E ; add 0.5 to FAC1 (round FAC1)
.d8e8 lab_29c3
.d8e8 20 50 d7 jsr $d750 JSR LAB_2831 ; convert FAC1 floating-to-fixed
.d8eb a2 01 ldx #$01 LDX #$01 ; set default digits before dp = 1
.d8ed a5 a8 lda $a8 LDA numexp ; get number exponent count
.d8ef 18 clc CLC ; clear carry for add
.d8f0 69 07 adc #$07 ADC #$07 ; up to 6 digits before point
.d8f2 30 09 bmi $d8fd BMI LAB_29D8 ; if -ve then 1 digit before dp
.d8f4 c9 08 cmp #$08 CMP #$08 ; A>=8 if n>=1E6
.d8f6 b0 06 bcs $d8fe BCS LAB_29D9 ; branch if >= $08
.d8f8 69 ff adc #$ff ADC #$FF ; take 1 from digit count
.d8fa aa tax TAX ; copy to A
.d8fb a9 02 lda #$02 LDA #$02 ;.set exponent adjust
.d8fd lab_29d8
.d8fd 38 sec SEC ; set carry for subtract
.d8fe lab_29d9
.d8fe e9 02 sbc #$02 SBC #$02 ; -2
.d900 85 a9 sta $a9 STA expcnt ;.save exponent adjust
.d902 86 a8 stx $a8 STX numexp ; save digits before dp count
.d904 8a txa TXA ; copy to A
.d905 f0 02 beq $d909 BEQ LAB_29E4 ; branch if no digits before dp
.d907 10 13 bpl $d91c BPL LAB_29F7 ; branch if digits before dp
.d909 lab_29e4
.d909 a4 ba ldy $ba LDY Sendl ; get output string index
.d90b a9 2e lda #$2e LDA #$2E ; character "."
.d90d c8 iny INY ; increment index
.d90e 99 ef 00 sta $00ef,y STA Decss,Y ; save to output string
.d911 8a txa TXA ;.
.d912 f0 06 beq $d91a BEQ LAB_29F5 ;.
.d914 a9 30 lda #$30 LDA #"0" ; character "0"
.d916 c8 iny INY ; increment index
.d917 99 ef 00 sta $00ef,y STA Decss,Y ; save to output string
.d91a lab_29f5
.d91a 84 ba sty $ba STY Sendl ; save output string index
.d91c lab_29f7
.d91c a0 00 ldy #$00 LDY #$00 ; clear index (point to 100,000)
.d91e a2 80 ldx #$80 LDX #$80 ;
.d920 lab_29fb
.d920 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.d922 18 clc CLC ; clear carry for add
.d923 79 f7 df adc $dff7,y ADC LAB_2A9C,Y ; add -ve LSB
.d926 85 af sta $af STA FAC1_3 ; save FAC1 mantissa3
.d928 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.d92a 79 f6 df adc $dff6,y ADC LAB_2A9B,Y ; add -ve NMSB
.d92d 85 ae sta $ae STA FAC1_2 ; save FAC1 mantissa2
.d92f a5 ad lda $ad LDA FAC1_1 ; get FAC1 mantissa1
.d931 79 f5 df adc $dff5,y ADC LAB_2A9A,Y ; add -ve MSB
.d934 85 ad sta $ad STA FAC1_1 ; save FAC1 mantissa1
.d936 e8 inx INX ;
.d937 b0 04 bcs $d93d BCS LAB_2A18 ;
.d939 10 e5 bpl $d920 BPL LAB_29FB ; not -ve so try again
.d93b 30 02 bmi $d93f BMI LAB_2A1A ;
.d93d lab_2a18
.d93d 30 e1 bmi $d920 BMI LAB_29FB ;
.d93f lab_2a1a
.d93f 8a txa TXA ;
.d940 90 04 bcc $d946 BCC LAB_2A21 ;
.d942 49 ff eor #$ff EOR #$FF ;
.d944 69 0a adc #$0a ADC #$0A ;
.d946 lab_2a21
.d946 69 2f adc #$2f ADC #"0"-1 ; add "0"-1 to result
.d948 c8 iny INY ; increment index ..
.d949 c8 iny INY ; .. to next less ..
.d94a c8 iny INY ; .. power of ten
.d94b 84 95 sty $95 STY Cvaral ; save as current var address low byte
.d94d a4 ba ldy $ba LDY Sendl ; get output string index
.d94f c8 iny INY ; increment output string index
.d950 aa tax TAX ; copy character to X
.d951 29 7f and #$7f AND #$7F ; mask out top bit
.d953 99 ef 00 sta $00ef,y STA Decss,Y ; save to output string
.d956 c6 a8 dec $a8 DEC numexp ; decrement # of characters before the dp
.d958 d0 06 bne $d960 BNE LAB_2A3B ; branch if still characters to do
.d95a a9 2e lda #$2e LDA #$2E ; character "."
.d95c c8 iny INY ; increment output string index
.d95d 99 ef 00 sta $00ef,y STA Decss,Y ; save to output string
.d960 lab_2a3b
.d960 84 ba sty $ba STY Sendl ; save output string index
.d962 a4 95 ldy $95 LDY Cvaral ; get current var address low byte
.d964 8a txa TXA ; get character back
.d965 49 ff eor #$ff EOR #$FF ;
.d967 29 80 and #$80 AND #$80 ;
.d969 aa tax TAX ;
.d96a c0 12 cpy #$12 CPY #$12 ; compare index with max
.d96c d0 b2 bne $d920 BNE LAB_29FB ; loop if not max
.d96e a4 ba ldy $ba LDY Sendl ; get output string index
.d970 lab_2a4b
.d970 b9 ef 00 lda $00ef,y LDA Decss,Y ; get character from output string
.d973 88 dey DEY ; decrement output string index
.d974 c9 30 cmp #$30 CMP #"0" ; compare with "0"
.d976 f0 f8 beq $d970 BEQ LAB_2A4B ; loop until non "0" character found
.d978 c9 2e cmp #$2e CMP #"." ; compare with "."
.d97a f0 01 beq $d97d BEQ LAB_2A58 ; branch if was dp
.d97c c8 iny INY ; increment output string index
.d97d lab_2a58
.d97d a9 2b lda #$2b LDA #$2B ; character "+"
.d97f a6 a9 ldx $a9 LDX expcnt ; get exponent count
.d981 f0 2e beq $d9b1 BEQ LAB_2A8C ; if zero go set null terminator and exit
.d983 10 08 bpl $d98d BPL LAB_2A68 ; branch if exponent count +ve
.d985 a9 00 lda #$00 LDA #$00 ; clear A
.d987 38 sec SEC ; set carry for subtract
.d988 e5 a9 sbc $a9 SBC expcnt ; subtract exponent count adjust (convert -ve to +ve)
.d98a aa tax TAX ; copy exponent count to X
.d98b a9 2d lda #$2d LDA #"-" ; character "-"
.d98d lab_2a68
.d98d 99 f1 00 sta $00f1,y STA Decss+2,Y ; save to output string
.d990 a9 45 lda #$45 LDA #$45 ; character "E"
.d992 99 f0 00 sta $00f0,y STA Decss+1,Y ; save exponent sign to output string
.d995 8a txa TXA ; get exponent count back
.d996 a2 2f ldx #$2f LDX #"0"-1 ; one less than "0" character
.d998 38 sec SEC ; set carry for subtract
.d999 lab_2a74
.d999 e8 inx INX ; increment 10's character
.d99a e9 0a sbc #$0a SBC #$0A ;.subtract 10 from exponent count
.d99c b0 fb bcs $d999 BCS LAB_2A74 ; loop while still >= 0
.d99e 69 3a adc #$3a ADC #":" ; add character ":" ($30+$0A, result is 10 less that value)
.d9a0 99 f3 00 sta $00f3,y STA Decss+4,Y ; save to output string
.d9a3 8a txa TXA ; copy 10's character
.d9a4 99 f2 00 sta $00f2,y STA Decss+3,Y ; save to output string
.d9a7 a9 00 lda #$00 LDA #$00 ; set null terminator
.d9a9 99 f4 00 sta $00f4,y STA Decss+5,Y ; save to output string
.d9ac f0 08 beq $d9b6 BEQ LAB_2A91 ; go set string pointer (AY) and exit (branch always)
.d9ae lab_2a89
.d9ae 99 ef 00 sta $00ef,y STA Decss,Y ; save last character to output string
.d9b1 lab_2a8c
.d9b1 a9 00 lda #$00 LDA #$00 ; set null terminator
.d9b3 99 f0 00 sta $00f0,y STA Decss+1,Y ; save after last character
.d9b6 lab_2a91
.d9b6 a9 f0 lda #$f0 LDA #<Decssp1 ; set result string low pointer
.d9b8 a0 00 ldy #$00 LDY #>Decssp1 ; set result string high pointer
.d9ba 60 rts RTS
.d9bb lab_power
.d9bb f0 42 beq $d9ff BEQ LAB_EXP ; go do EXP()
.d9bd a5 b3 lda $b3 LDA FAC2_e ; get FAC2 exponent
.d9bf d0 03 bne $d9c4 BNE LAB_2ABF ; branch if FAC2<>0
.d9c1 4c 52 d4 jmp $d452 JMP LAB_24F3 ; clear FAC1 exponent and sign and return
.d9c4 lab_2abf
.d9c4 a2 9c ldx #$9c LDX #<func_l ; set destination pointer low byte
.d9c6 a0 00 ldy #$00 LDY #>func_l ; set destination pointer high byte
.d9c8 20 a7 d6 jsr $d6a7 JSR LAB_2778 ; pack FAC1 into (XY)
.d9cb a5 b7 lda $b7 LDA FAC2_s ; get FAC2 sign (b7)
.d9cd 10 0f bpl $d9de BPL LAB_2AD9 ; branch if FAC2>0
.d9cf 20 81 d7 jsr $d781 JSR LAB_INT ; perform INT
.d9d2 a9 9c lda #$9c LDA #<func_l ; set source pointer low byte
.d9d4 a0 00 ldy #$00 LDY #>func_l ; set source pointer high byte
.d9d6 20 17 d7 jsr $d717 JSR LAB_27F8 ; compare FAC1 with (AY)
.d9d9 d0 03 bne $d9de BNE LAB_2AD9 ; branch if FAC1 <> (AY) to allow Function Call error
.d9db 98 tya TYA ; clear sign b7
.d9dc a4 5b ldy $5b LDY Temp3 ; save mantissa 3 from INT() function as sign in Y
.d9de lab_2ad9
.d9de 20 c5 d3 jsr $d3c5 JSR LAB_279D ; save FAC1 sign and copy ABS(FAC2) to FAC1
.d9e1 98 tya TYA ; copy sign back ..
.d9e2 48 pha PHA ; .. and save it
.d9e3 20 fb d4 jsr $d4fb JSR LAB_LOG ; do LOG(n)
.d9e6 a9 9c lda #$9c LDA #<garb_l ; set pointer low byte
.d9e8 a0 00 ldy #$00 LDY #>garb_l ; set pointer high byte
.d9ea 20 39 d5 jsr $d539 JSR LAB_25FB ; do convert AY, FCA1*(AY) (square the value)
.d9ed 20 ff d9 jsr $d9ff JSR LAB_EXP ; go do EXP(n)
.d9f0 68 pla PLA ; pull sign from stack
.d9f1 4a lsr LSR ; b0 is to be tested, shift to Cb
.d9f2 90 0a bcc $d9fe BCC LAB_2AF9 ; if no bit then exit
.d9f4 lab_gthan
.d9f4 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.d9f6 f0 06 beq $d9fe BEQ LAB_2AF9 ; exit if FAC1_e = $00
.d9f8 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.d9fa 49 ff eor #$ff EOR #$FF ; complement it
.d9fc 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign (b7)
.d9fe lab_2af9
.d9fe 60 rts RTS
.d9ff lab_exp
.d9ff a9 85 lda #$85 LDA #<LAB_2AFA ; set 1.443 pointer low byte
.da01 a0 df ldy #$df LDY #>LAB_2AFA ; set 1.443 pointer high byte
.da03 20 39 d5 jsr $d539 JSR LAB_25FB ; do convert AY, FCA1*(AY)
.da06 a5 b9 lda $b9 LDA FAC1_r ; get FAC1 rounding byte
.da08 69 50 adc #$50 ADC #$50 ; +$50/$100
.da0a 90 03 bcc $da0f BCC LAB_2B2B ; skip rounding if no carry
.da0c 20 e1 d6 jsr $d6e1 JSR LAB_27C2 ; round FAC1 (no check)
.da0f lab_2b2b
.da0f 85 a3 sta $a3 STA FAC2_r ; save FAC2 rounding byte
.da11 20 cd d6 jsr $d6cd JSR LAB_27AE ; copy FAC1 to FAC2
.da14 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.da16 c9 88 cmp #$88 CMP #$88 ; compare with EXP limit (256d)
.da18 90 03 bcc $da1d BCC LAB_2B39 ; branch if less
.da1a lab_2b36
.da1a 20 ce d5 jsr $d5ce JSR LAB_2690 ; handle overflow and underflow
.da1d lab_2b39
.da1d 20 81 d7 jsr $d781 JSR LAB_INT ; perform INT
.da20 a5 5b lda $5b LDA Temp3 ; get mantissa 3 from INT() function
.da22 18 clc CLC ; clear carry for add
.da23 69 81 adc #$81 ADC #$81 ; normalise +1
.da25 f0 f3 beq $da1a BEQ LAB_2B36 ; if $00 go handle overflow
.da27 38 sec SEC ; set carry for subtract
.da28 e9 01 sbc #$01 SBC #$01 ; now correct for exponent
.da2a 48 pha PHA ; save FAC2 exponent
.da2b a2 04 ldx #$04 LDX #$04 ; 4 bytes to do
.da2d lab_2b49
.da2d b5 b3 lda $b3,x LDA FAC2_e,X ; get FAC2,X
.da2f b4 ac ldy $ac,x LDY FAC1_e,X ; get FAC1,X
.da31 95 ac sta $ac,x STA FAC1_e,X ; save FAC1,X
.da33 94 b3 sty $b3,x STY FAC2_e,X ; save FAC2,X
.da35 ca dex DEX ; decrement count/index
.da36 10 f5 bpl $da2d BPL LAB_2B49 ; loop if not all done
.da38 a5 a3 lda $a3 LDA FAC2_r ; get FAC2 rounding byte
.da3a 85 b9 sta $b9 STA FAC1_r ; save as FAC1 rounding byte
.da3c 20 a6 d3 jsr $d3a6 JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1
.da3f 20 f4 d9 jsr $d9f4 JSR LAB_GTHAN ; do - FAC1
.da42 a9 89 lda #$89 LDA #<LAB_2AFE ; set counter pointer low byte
.da44 a0 df ldy #$df LDY #>LAB_2AFE ; set counter pointer high byte
.da46 20 67 da jsr $da67 JSR LAB_2B84 ; go do series evaluation
.da49 a9 00 lda #$00 LDA #$00 ; clear A
.da4b 85 b8 sta $b8 STA FAC_sc ; clear sign compare (FAC1 EOR FAC2)
.da4d 68 pla PLA ;.get saved FAC2 exponent
.da4e 4c b3 d5 jmp $d5b3 JMP LAB_2675 ; test and adjust accumulators and return
.da51 lab_2b6e
.da51 85 ba sta $ba STA Cptrl ; save count pointer low byte
.da53 84 bb sty $bb STY Cptrh ; save count pointer high byte
.da55 20 9d d6 jsr $d69d JSR LAB_276E ; pack FAC1 into Adatal
.da58 a9 a4 lda #$a4 LDA #<Adatal ; set pointer low byte (Y already $00)
.da5a 20 39 d5 jsr $d539 JSR LAB_25FB ; do convert AY, FCA1*(AY)
.da5d 20 6b da jsr $da6b JSR LAB_2B88 ; go do series evaluation
.da60 a9 a4 lda #$a4 LDA #<Adatal ; pointer to original # low byte
.da62 a0 00 ldy #$00 LDY #>Adatal ; pointer to original # high byte
.da64 4c 39 d5 jmp $d539 JMP LAB_25FB ; do convert AY, FCA1*(AY) and return
.da67 lab_2b84
.da67 85 ba sta $ba STA Cptrl ; save count pointer low byte
.da69 84 bb sty $bb STY Cptrh ; save count pointer high byte
.da6b lab_2b88
.da6b a2 a8 ldx #$a8 LDX #<numexp ; set pointer low byte
.da6d 20 9f d6 jsr $d69f JSR LAB_2770 ; set pointer high byte and pack FAC1 into numexp
.da70 b1 ba lda ($ba),y LDA (Cptrl),Y ; get constants count
.da72 85 b1 sta $b1 STA numcon ; save constants count
.da74 a4 ba ldy $ba LDY Cptrl ; get count pointer low byte
.da76 c8 iny INY ; increment it (now constants pointer)
.da77 98 tya TYA ; copy it
.da78 d0 02 bne $da7c BNE LAB_2B97 ; skip next if no overflow
.da7a e6 bb inc $bb INC Cptrh ; else increment high byte
.da7c lab_2b97
.da7c 85 ba sta $ba STA Cptrl ; save low byte
.da7e a4 bb ldy $bb LDY Cptrh ; get high byte
.da80 lab_2b9b
.da80 20 39 d5 jsr $d539 JSR LAB_25FB ; do convert AY, FCA1*(AY)
.da83 a5 ba lda $ba LDA Cptrl ; get constants pointer low byte
.da85 a4 bb ldy $bb LDY Cptrh ; get constants pointer high byte
.da87 18 clc CLC ; clear carry for add
.da88 69 04 adc #$04 ADC #$04 ; +4 to low pointer (4 bytes per constant)
.da8a 90 01 bcc $da8d BCC LAB_2BA8 ; skip next if no overflow
.da8c c8 iny INY ; increment high byte
.da8d lab_2ba8
.da8d 85 ba sta $ba STA Cptrl ; save pointer low byte
.da8f 84 bb sty $bb STY Cptrh ; save pointer high byte
.da91 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1
.da94 a9 a8 lda #$a8 LDA #<numexp ; set pointer low byte to partial @ numexp
.da96 a0 00 ldy #$00 LDY #>numexp ; set pointer high byte to partial @ numexp
.da98 c6 b1 dec $b1 DEC numcon ; decrement constants count
.da9a d0 e4 bne $da80 BNE LAB_2B9B ; loop until all done
.da9c 60 rts RTS
.da9d lab_rnd
.da9d a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.da9f f0 07 beq $daa8 BEQ NextPRN ; do next random # if zero
.daa1 a2 d8 ldx #$d8 LDX #Rbyte4 ; set PRNG pointer low byte
.daa3 a0 00 ldy #$00 LDY #$00 ; set PRNG pointer high byte
.daa5 20 a7 d6 jsr $d6a7 JSR LAB_2778 ; pack FAC1 into (XY)
.daa8 nextprn
.daa8 a2 af ldx #$af LDX #$AF ; set EOR byte
.daaa a0 13 ldy #$13 LDY #$13 ; do this nineteen times
.daac loopprn
.daac 06 d9 asl $d9 ASL Rbyte1 ; shift PRNG most significant byte
.daae 26 da rol $da ROL Rbyte2 ; shift PRNG middle byte
.dab0 26 db rol $db ROL Rbyte3 ; shift PRNG least significant byte
.dab2 26 d8 rol $d8 ROL Rbyte4 ; shift PRNG extra byte
.dab4 90 05 bcc $dabb BCC Ninc1 ; branch if bit 32 clear
.dab6 8a txa TXA ; set EOR byte
.dab7 45 d9 eor $d9 EOR Rbyte1 ; EOR PRNG extra byte
.dab9 85 d9 sta $d9 STA Rbyte1 ; save new PRNG extra byte
.dabb ninc1
.dabb 88 dey DEY ; decrement loop count
.dabc d0 ee bne $daac BNE LoopPRN ; loop if not all done
.dabe a2 02 ldx #$02 LDX #$02 ; three bytes to copy
.dac0 copyprng
.dac0 b5 d9 lda $d9,x LDA Rbyte1,X ; get PRNG byte
.dac2 95 ad sta $ad,x STA FAC1_1,X ; save FAC1 byte
.dac4 ca dex DEX
.dac5 10 f9 bpl $dac0 BPL CopyPRNG ; loop if not complete
.dac7 a9 80 lda #$80 LDA #$80 ; set the exponent
.dac9 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.dacb 0a asl ASL ; clear A
.dacc 85 b0 sta $b0 STA FAC1_s ; save FAC1 sign
.dace 4c 34 d4 jmp $d434 JMP LAB_24D5 ; normalise FAC1 and return
.dad1 lab_cos
.dad1 a9 a6 lda #$a6 LDA #<LAB_2C78 ; set (pi/2) pointer low byte
.dad3 a0 df ldy #$df LDY #>LAB_2C78 ; set (pi/2) pointer high byte
.dad5 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1
.dad8 lab_sin
.dad8 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.dadb a9 bb lda #$bb LDA #<LAB_2C7C ; set (2*pi) pointer low byte
.dadd a0 df ldy #$df LDY #>LAB_2C7C ; set (2*pi) pointer high byte
.dadf a6 b7 ldx $b7 LDX FAC2_s ; get FAC2 sign (b7)
.dae1 20 f9 d5 jsr $d5f9 JSR LAB_26C2 ; divide by (AY) (X=sign)
.dae4 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.dae7 20 81 d7 jsr $d781 JSR LAB_INT ; perform INT
.daea a9 00 lda #$00 LDA #$00 ; clear byte
.daec 85 b8 sta $b8 STA FAC_sc ; clear sign compare (FAC1 EOR FAC2)
.daee 20 a6 d3 jsr $d3a6 JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1
.daf1 a9 ed lda #$ed LDA #<LAB_2C80 ; set 0.25 pointer low byte
.daf3 a0 df ldy #$df LDY #>LAB_2C80 ; set 0.25 pointer high byte
.daf5 20 a3 d3 jsr $d3a3 JSR LAB_2455 ; perform subtraction, (AY) from FAC1
.daf8 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.dafa 48 pha PHA ; save FAC1 sign
.dafb 10 0d bpl $db0a BPL LAB_2C35 ; branch if +ve
.dafd 20 ba d3 jsr $d3ba JSR LAB_244E ; add 0.5 to FAC1
.db00 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.db02 30 09 bmi $db0d BMI LAB_2C38 ; branch if -ve
.db04 a5 63 lda $63 LDA Cflag ; get comparison evaluation flag
.db06 49 ff eor #$ff EOR #$FF ; toggle flag
.db08 85 63 sta $63 STA Cflag ; save comparison evaluation flag
.db0a lab_2c35
.db0a 20 f4 d9 jsr $d9f4 JSR LAB_GTHAN ; do - FAC1
.db0d lab_2c38
.db0d a9 ed lda #$ed LDA #<LAB_2C80 ; set 0.25 pointer low byte
.db0f a0 df ldy #$df LDY #>LAB_2C80 ; set 0.25 pointer high byte
.db11 20 be d3 jsr $d3be JSR LAB_246C ; add (AY) to FAC1
.db14 68 pla PLA ; restore FAC1 sign
.db15 10 03 bpl $db1a BPL LAB_2C45 ; branch if was +ve
.db17 20 f4 d9 jsr $d9f4 JSR LAB_GTHAN ; do - FAC1
.db1a lab_2c45
.db1a a9 aa lda #$aa LDA #<LAB_2C84 ; set pointer low byte to counter
.db1c a0 df ldy #$df LDY #>LAB_2C84 ; set pointer high byte to counter
.db1e 4c 51 da jmp $da51 JMP LAB_2B6E ; ^2 then series evaluation and return
.db21 lab_tan
.db21 20 9d d6 jsr $d69d JSR LAB_276E ; pack FAC1 into Adatal
.db24 a9 00 lda #$00 LDA #$00 ; clear byte
.db26 85 63 sta $63 STA Cflag ; clear comparison evaluation flag
.db28 20 d8 da jsr $dad8 JSR LAB_SIN ; go do SIN(n)
.db2b a2 9c ldx #$9c LDX #<func_l ; set sin(n) pointer low byte
.db2d a0 00 ldy #$00 LDY #>func_l ; set sin(n) pointer high byte
.db2f 20 a7 d6 jsr $d6a7 JSR LAB_2778 ; pack FAC1 into (XY)
.db32 a9 a4 lda #$a4 LDA #<Adatal ; set n pointer low addr
.db34 a0 00 ldy #$00 LDY #>Adatal ; set n pointer high addr
.db36 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (AY) into FAC1
.db39 a9 00 lda #$00 LDA #$00 ; clear byte
.db3b 85 b0 sta $b0 STA FAC1_s ; clear FAC1 sign (b7)
.db3d a5 63 lda $63 LDA Cflag ; get comparison evaluation flag
.db3f 20 49 db jsr $db49 JSR LAB_2C74 ; save flag and go do series evaluation
.db42 a9 9c lda #$9c LDA #<func_l ; set sin(n) pointer low byte
.db44 a0 00 ldy #$00 LDY #>func_l ; set sin(n) pointer high byte
.db46 4c 01 d6 jmp $d601 JMP LAB_26CA ; convert AY and do (AY)/FAC1
.db49 lab_2c74
.db49 48 pha PHA ; save comparison evaluation flag
.db4a 4c 0a db jmp $db0a JMP LAB_2C35 ; go do series evaluation
.db4d lab_usr
.db4d 20 0a 00 jsr $000a JSR Usrjmp ; call user code
.db50 4c ef c9 jmp $c9ef JMP LAB_1BFB ; scan for ")", else do syntax error then warm start
.db53 lab_atn
.db53 a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign (b7)
.db55 48 pha PHA ; save sign
.db56 10 03 bpl $db5b BPL LAB_2CA1 ; branch if +ve
.db58 20 f4 d9 jsr $d9f4 JSR LAB_GTHAN ; else do - FAC1
.db5b lab_2ca1
.db5b a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.db5d 48 pha PHA ; push exponent
.db5e c9 81 cmp #$81 CMP #$81 ; compare with 1
.db60 90 07 bcc $db69 BCC LAB_2CAF ; branch if FAC1<1
.db62 a9 e0 lda #$e0 LDA #<LAB_259C ; set 1 pointer low byte
.db64 a0 df ldy #$df LDY #>LAB_259C ; set 1 pointer high byte
.db66 20 01 d6 jsr $d601 JSR LAB_26CA ; convert AY and do (AY)/FAC1
.db69 lab_2caf
.db69 a9 bf lda #$bf LDA #<LAB_2CC9 ; set pointer low byte to counter
.db6b a0 df ldy #$df LDY #>LAB_2CC9 ; set pointer high byte to counter
.db6d 20 51 da jsr $da51 JSR LAB_2B6E ; ^2 then series evaluation
.db70 68 pla PLA ; restore old FAC1 exponent
.db71 c9 81 cmp #$81 CMP #$81 ; compare with 1
.db73 90 07 bcc $db7c BCC LAB_2CC2 ; branch if FAC1<1
.db75 a9 a6 lda #$a6 LDA #<LAB_2C78 ; set (pi/2) pointer low byte
.db77 a0 df ldy #$df LDY #>LAB_2C78 ; set (pi/2) pointer high byte
.db79 20 a3 d3 jsr $d3a3 JSR LAB_2455 ; perform subtraction, (AY) from FAC1
.db7c lab_2cc2
.db7c 68 pla PLA ; restore FAC1 sign
.db7d 10 16 bpl $db95 BPL LAB_2D04 ; exit if was +ve
.db7f 4c f4 d9 jmp $d9f4 JMP LAB_GTHAN ; else do - FAC1 and return
.db82 lab_bitset
.db82 20 d8 d2 jsr $d2d8 JSR LAB_GADB ; get two parameters for POKE or WAIT
.db85 e0 08 cpx #$08 CPX #$08 ; only 0 to 7 are allowed
.db87 b0 20 bcs $dba9 BCS FCError ; branch if > 7
.db89 a9 00 lda #$00 LDA #$00 ; clear A
.db8b 38 sec SEC ; set the carry
.db8c s_bits
.db8c 2a rol ROL ; shift bit
.db8d ca dex DEX ; decrement bit number
.db8e 10 fc bpl $db8c BPL S_Bits ; loop if still +ve
.db90 e8 inx INX ; make X = $00
.db91 01 11 ora ($11,x) ORA (Itempl,X) ; or with byte via temporary integer (addr)
.db93 81 11 sta ($11,x) STA (Itempl,X) ; save byte via temporary integer (addr)
.db95 lab_2d04
.db95 60 rts RTS
.db96 lab_bitclr
.db96 20 d8 d2 jsr $d2d8 JSR LAB_GADB ; get two parameters for POKE or WAIT
.db99 e0 08 cpx #$08 CPX #$08 ; only 0 to 7 are allowed
.db9b b0 0c bcs $dba9 BCS FCError ; branch if > 7
.db9d a9 ff lda #$ff LDA #$FF ; set A
.db9f s_bitc
.db9f 2a rol ROL ; shift bit
.dba0 ca dex DEX ; decrement bit number
.dba1 10 fc bpl $db9f BPL S_Bitc ; loop if still +ve
.dba3 e8 inx INX ; make X = $00
.dba4 21 11 and ($11,x) AND (Itempl,X) ; and with byte via temporary integer (addr)
.dba6 81 11 sta ($11,x) STA (Itempl,X) ; save byte via temporary integer (addr)
.dba8 60 rts RTS
.dba9 fcerror
.dba9 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start
.dbac lab_btst
.dbac 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment BASIC pointer
.dbaf 20 d8 d2 jsr $d2d8 JSR LAB_GADB ; get two parameters for POKE or WAIT
.dbb2 e0 08 cpx #$08 CPX #$08 ; only 0 to 7 are allowed
.dbb4 b0 f3 bcs $dba9 BCS FCError ; branch if > 7
.dbb6 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get next BASIC byte
.dbb9 c9 29 cmp #$29 CMP #")" ; is next character ")"
.dbbb f0 03 beq $dbc0 BEQ TST_OK ; if ")" go do rest of function
.dbbd 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.dbc0 tst_ok
.dbc0 20 bc 00 jsr $00bc JSR LAB_IGBY ; update BASIC execute pointer (to character past ")")
.dbc3 a9 00 lda #$00 LDA #$00 ; clear A
.dbc5 38 sec SEC ; set the carry
.dbc6 t_bits
.dbc6 2a rol ROL ; shift bit
.dbc7 ca dex DEX ; decrement bit number
.dbc8 10 fc bpl $dbc6 BPL T_Bits ; loop if still +ve
.dbca e8 inx INX ; make X = $00
.dbcb 21 11 and ($11,x) AND (Itempl,X) ; AND with byte via temporary integer (addr)
.dbcd f0 02 beq $dbd1 BEQ LAB_NOTT ; branch if zero (already correct)
.dbcf a9 ff lda #$ff LDA #$FF ; set for -1 result
.dbd1 lab_nott
.dbd1 4c fa d6 jmp $d6fa JMP LAB_27DB ; go do SGN tail
.dbd4 lab_bins
.dbd4 e0 19 cpx #$19 CPX #$19 ; max + 1
.dbd6 b0 48 bcs $dc20 BCS BinFErr ; exit if too big ( > or = )
.dbd8 86 78 stx $78 STX TempB ; save # of characters ($00 = leading zero remove)
.dbda a9 18 lda #$18 LDA #$18 ; need A byte long space
.dbdc 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long
.dbdf a0 17 ldy #$17 LDY #$17 ; set index
.dbe1 a2 18 ldx #$18 LDX #$18 ; character count
.dbe3 nextb1
.dbe3 46 11 lsr $11 LSR nums_1 ; shift highest byte
.dbe5 66 12 ror $12 ROR nums_2 ; shift middle byte
.dbe7 66 13 ror $13 ROR nums_3 ; shift lowest byte bit 0 to carry
.dbe9 8a txa TXA ; load with "0"/2
.dbea 2a rol ROL ; shift in carry
.dbeb 91 ad sta ($ad),y STA (str_pl),Y ; save to temp string + index
.dbed 88 dey DEY ; decrement index
.dbee 10 f3 bpl $dbe3 BPL NextB1 ; loop if not done
.dbf0 a5 78 lda $78 LDA TempB ; get # of characters
.dbf2 f0 0a beq $dbfe BEQ EndBHS ; branch if truncate
.dbf4 aa tax TAX ; copy length to X
.dbf5 38 sec SEC ; set carry for add !
.dbf6 49 ff eor #$ff EOR #$FF ; 1's complement
.dbf8 69 18 adc #$18 ADC #$18 ; add 24d
.dbfa f0 1c beq $dc18 BEQ GoPr2 ; if zero print whole string
.dbfc d0 0f bne $dc0d BNE GoPr1 ; else go make output string
.dbfe endbhs
.dbfe a8 tay TAY ; clear index (A=0, X=length here)
.dbff nextb2
.dbff b1 ad lda ($ad),y LDA (str_pl),Y ; get character from string
.dc01 c9 30 cmp #$30 CMP #"0" ; compare with "0"
.dc03 d0 07 bne $dc0c BNE GoPr ; if not "0" then go print string from here
.dc05 ca dex DEX ; decrement character count
.dc06 f0 03 beq $dc0b BEQ GoPr3 ; if zero then end of string so go print it
.dc08 c8 iny INY ; else increment index
.dc09 10 f4 bpl $dbff BPL NextB2 ; loop always
.dc0b gopr3
.dc0b e8 inx INX ; need at least 1 character
.dc0c gopr
.dc0c 98 tya TYA ; copy result
.dc0d gopr1
.dc0d 18 clc CLC ; clear carry for add
.dc0e 65 ad adc $ad ADC str_pl ; add low address
.dc10 85 ad sta $ad STA str_pl ; save low address
.dc12 a9 00 lda #$00 LDA #$00 ; do high byte
.dc14 65 ae adc $ae ADC str_ph ; add high address
.dc16 85 ae sta $ae STA str_ph ; save high address
.dc18 gopr2
.dc18 86 ac stx $ac STX str_ln ; X holds string length
.dc1a 20 bc 00 jsr $00bc JSR LAB_IGBY ; update BASIC execute pointer (to character past ")")
.dc1d 4c 85 cf jmp $cf85 JMP LAB_RTST ; check for space on descriptor stack then put address
.dc20 binferr
.dc20 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start
.dc23 lab_hexs
.dc23 e0 07 cpx #$07 CPX #$07 ; max + 1
.dc25 b0 f9 bcs $dc20 BCS BinFErr ; exit if too big ( > or = )
.dc27 86 78 stx $78 STX TempB ; save # of characters
.dc29 a9 06 lda #$06 LDA #$06 ; need 6 bytes for string
.dc2b 20 3a cf jsr $cf3a JSR LAB_MSSP ; make string space A bytes long
.dc2e a0 05 ldy #$05 LDY #$05 ; set string index
.dc30 f8 sed SED ; need decimal mode for nibble convert
.dc31 a5 13 lda $13 LDA nums_3 ; get lowest byte
.dc33 20 51 dc jsr $dc51 JSR LAB_A2HX ; convert A to ASCII hex byte and output
.dc36 a5 12 lda $12 LDA nums_2 ; get middle byte
.dc38 20 51 dc jsr $dc51 JSR LAB_A2HX ; convert A to ASCII hex byte and output
.dc3b a5 11 lda $11 LDA nums_1 ; get highest byte
.dc3d 20 51 dc jsr $dc51 JSR LAB_A2HX ; convert A to ASCII hex byte and output
.dc40 d8 cld CLD ; back to binary
.dc41 a2 06 ldx #$06 LDX #$06 ; character count
.dc43 a5 78 lda $78 LDA TempB ; get # of characters
.dc45 f0 b7 beq $dbfe BEQ EndBHS ; branch if truncate
.dc47 aa tax TAX ; copy length to X
.dc48 38 sec SEC ; set carry for add !
.dc49 49 ff eor #$ff EOR #$FF ; 1's complement
.dc4b 69 06 adc #$06 ADC #$06 ; add 6d
.dc4d f0 c9 beq $dc18 BEQ GoPr2 ; if zero print whole string
.dc4f d0 bc bne $dc0d BNE GoPr1 ; else go make output string (branch always)
.dc51 lab_a2hx
.dc51 aa tax TAX ; save byte
.dc52 29 0f and #$0f AND #$0F ; mask off top bits
.dc54 20 5c dc jsr $dc5c JSR LAB_AL2X ; convert low nibble to ASCII and output
.dc57 8a txa TXA ; get byte back
.dc58 4a lsr LSR ; /2 shift high nibble to low nibble
.dc59 4a lsr LSR ; /4
.dc5a 4a lsr LSR ; /8
.dc5b 4a lsr LSR ; /16
.dc5c lab_al2x
.dc5c c9 0a cmp #$0a CMP #$0A ; set carry for +1 if >9
.dc5e 69 30 adc #$30 ADC #"0" ; add ASCII "0"
.dc60 91 ad sta ($ad),y STA (str_pl),Y ; save to temp string
.dc62 88 dey DEY ; decrement counter
.dc63 60 rts RTS
.dc64 lab_nlto
.dc64 85 ac sta $ac STA FAC1_e ; save FAC1 exponent
.dc66 a9 00 lda #$00 LDA #$00 ; clear sign compare
.dc68 lab_mlte
.dc68 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.dc6a 8a txa TXA ; restore character
.dc6b 20 45 d8 jsr $d845 JSR LAB_2912 ; evaluate new ASCII digit
.dc6e lab_chex
.dc6e 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.dc71 90 0a bcc $dc7d BCC LAB_ISHN ; branch if numeric character
.dc73 09 20 ora #$20 ORA #$20 ; case convert, allow "A" to "F" and "a" to "f"
.dc75 e9 61 sbc #$61 SBC #"a" ; subtract "a" (carry set here)
.dc77 c9 06 cmp #$06 CMP #$06 ; compare normalised with $06 (max+1)
.dc79 b0 2a bcs $dca5 BCS LAB_EXCH ; exit if >"f" or <"0"
.dc7b 69 0a adc #$0a ADC #$0A ; convert to nibble
.dc7d lab_ishn
.dc7d 29 0f and #$0f AND #$0F ; convert to binary
.dc7f aa tax TAX ; save nibble
.dc80 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.dc82 f0 e4 beq $dc68 BEQ LAB_MLTE ; skip multiply if zero
.dc84 69 04 adc #$04 ADC #$04 ; add four to exponent (*16 - carry clear here)
.dc86 90 dc bcc $dc64 BCC LAB_NLTO ; if no overflow do evaluate digit
.dc88 lab_mlto
.dc88 4c c3 d4 jmp $d4c3 JMP LAB_2564 ; do overflow error and warm start
.dc8b lab_nxch
.dc8b aa tax TAX ; save bit
.dc8c a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.dc8e f0 06 beq $dc96 BEQ LAB_MLBT ; skip multiply if zero
.dc90 e6 ac inc $ac INC FAC1_e ; increment FAC1 exponent (*2)
.dc92 f0 f4 beq $dc88 BEQ LAB_MLTO ; do overflow error if = $00
.dc94 a9 00 lda #$00 LDA #$00 ; clear sign compare
.dc96 lab_mlbt
.dc96 85 b8 sta $b8 STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
.dc98 8a txa TXA ; restore bit
.dc99 20 45 d8 jsr $d845 JSR LAB_2912 ; evaluate new ASCII digit
.dc9c lab_cbin
.dc9c 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.dc9f 49 30 eor #$30 EOR #"0" ; convert "0" to 0 etc.
.dca1 c9 02 cmp #$02 CMP #$02 ; compare with max+1
.dca3 90 e6 bcc $dc8b BCC LAB_NXCH ; branch exit if < 2
.dca5 lab_exch
.dca5 4c 2a d8 jmp $d82a JMP LAB_28F6 ; evaluate -ve flag and return
.dca8 ctrlc
.dca8 ad 00 04 lda $0400 LDA ccflag ; get [CTRL-C] check flag
.dcab d0 18 bne $dcc5 BNE LAB_FBA2 ; exit if inhibited
.dcad 20 ea de jsr $deea JSR V_INPT ; scan input device
.dcb0 90 0b bcc $dcbd BCC LAB_FBA0 ; exit if buffer empty
.dcb2 8d 01 04 sta $0401 STA ccbyte ; save received byte
.dcb5 a2 20 ldx #$20 LDX #$20 ; "life" timer for bytes
.dcb7 8e 02 04 stx $0402 STX ccnull ; set countdown
.dcba 4c 17 c3 jmp $c317 JMP LAB_1636 ; return to BASIC
.dcbd lab_fba0
.dcbd ae 02 04 ldx $0402 LDX ccnull ; get countdown byte
.dcc0 f0 03 beq $dcc5 BEQ LAB_FBA2 ; exit if finished
.dcc2 ce 02 04 dec $0402 DEC ccnull ; else decrement countdown
.dcc5 lab_fba2
.dcc5 a2 dc ldx #$dc LDX #NmiBase ; set pointer to NMI values
.dcc7 20 d0 dc jsr $dcd0 JSR LAB_CKIN ; go check interrupt
.dcca a2 df ldx #$df LDX #IrqBase ; set pointer to IRQ values
.dccc 20 d0 dc jsr $dcd0 JSR LAB_CKIN ; go check interrupt
.dccf lab_crts
.dccf 60 rts RTS
.dcd0 lab_ckin
.dcd0 b5 00 lda $00,x LDA PLUS_0,X ; get interrupt flag byte
.dcd2 10 fb bpl $dccf BPL LAB_CRTS ; branch if interrupt not enabled
.dcd4 0a asl ASL ; move happened bit to setup bit
.dcd5 29 40 and #$40 AND #$40 ; mask happened bits
.dcd7 f0 f6 beq $dccf BEQ LAB_CRTS ; if no interrupt then exit
.dcd9 95 00 sta $00,x STA PLUS_0,X ; save interrupt flag byte
.dcdb 8a txa TXA ; copy index ..
.dcdc a8 tay TAY ; .. to Y
.dcdd 68 pla PLA ; dump return address low byte, call from CTRL-C
.dcde 68 pla PLA ; dump return address high byte
.dcdf a9 05 lda #$05 LDA #$05 ; need 5 bytes for GOSUB
.dce1 20 03 bf jsr $bf03 JSR LAB_1212 ; check room on stack for A bytes
.dce4 a5 c4 lda $c4 LDA Bpntrh ; get BASIC execute pointer high byte
.dce6 48 pha PHA ; push on stack
.dce7 a5 c3 lda $c3 LDA Bpntrl ; get BASIC execute pointer low byte
.dce9 48 pha PHA ; push on stack
.dcea a5 88 lda $88 LDA Clineh ; get current line high byte
.dcec 48 pha PHA ; push on stack
.dced a5 87 lda $87 LDA Clinel ; get current line low byte
.dcef 48 pha PHA ; push on stack
.dcf0 a9 8d lda #$8d LDA #TK_GOSUB ; token for GOSUB
.dcf2 48 pha PHA ; push on stack
.dcf3 b9 01 00 lda $0001,y LDA PLUS_1,Y ; get interrupt code pointer low byte
.dcf6 85 c3 sta $c3 STA Bpntrl ; save as BASIC execute pointer low byte
.dcf8 b9 02 00 lda $0002,y LDA PLUS_2,Y ; get interrupt code pointer high byte
.dcfb 85 c4 sta $c4 STA Bpntrh ; save as BASIC execute pointer high byte
.dcfd 4c bc c2 jmp $c2bc JMP LAB_15C2 ; go do interpreter inner loop
.dd00 inget
.dd00 20 ea de jsr $deea JSR V_INPT ; call scan input device
.dd03 b0 09 bcs $dd0e BCS LAB_FB95 ; if byte go reset timer
.dd05 ad 02 04 lda $0402 LDA ccnull ; get countdown
.dd08 f0 09 beq $dd13 BEQ LAB_FB96 ; exit if empty
.dd0a ad 01 04 lda $0401 LDA ccbyte ; get last received byte
.dd0d 38 sec SEC ; flag we got a byte
.dd0e lab_fb95
.dd0e a2 00 ldx #$00 LDX #$00 ; clear X
.dd10 8e 02 04 stx $0402 STX ccnull ; clear timer because we got a byte
.dd13 lab_fb96
.dd13 60 rts RTS
.dd14 lab_irq
.dd14 a2 df ldx #$df LDX #IrqBase ; set pointer to IRQ values
>dd16 2c .byte $2C ; make next line BIT abs.
.dd17 lab_nmi
.dd17 a2 dc ldx #$dc LDX #NmiBase ; set pointer to NMI values
.dd19 c9 93 cmp #$93 CMP #TK_ON ; compare with token for ON
.dd1b f0 11 beq $dd2e BEQ LAB_INON ; go turn on interrupt
.dd1d c9 b6 cmp #$b6 CMP #TK_OFF ; compare with token for OFF
.dd1f f0 07 beq $dd28 BEQ LAB_IOFF ; go turn off interrupt
.dd21 49 a2 eor #$a2 EOR #TK_CLEAR ; compare with token for CLEAR, A = $00 if = TK_CLEAR
.dd23 f0 0e beq $dd33 BEQ LAB_INEX ; go clear interrupt flags and return
.dd25 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.dd28 lab_ioff
.dd28 a9 7f lda #$7f LDA #$7F ; clear A
.dd2a 35 00 and $00,x AND PLUS_0,X ; AND with interrupt setup flag
.dd2c 10 05 bpl $dd33 BPL LAB_INEX ; go clear interrupt enabled flag and return
.dd2e lab_inon
.dd2e b5 00 lda $00,x LDA PLUS_0,X ; get interrupt setup flag
.dd30 0a asl ASL ; Shift bit to enabled flag
.dd31 15 00 ora $00,x ORA PLUS_0,X ; OR with flag byte
.dd33 lab_inex
.dd33 95 00 sta $00,x STA PLUS_0,X ; save interrupt flag byte
.dd35 4c bc 00 jmp $00bc JMP LAB_IGBY ; update BASIC execute pointer and return
.dd38 lab_sirq
.dd38 58 cli CLI ; enable interrupts
.dd39 a2 df ldx #$df LDX #IrqBase ; set pointer to IRQ values
>dd3b 2c .byte $2C ; make next line BIT abs.
.dd3c lab_snmi
.dd3c a2 dc ldx #$dc LDX #NmiBase ; set pointer to NMI values
.dd3e 86 78 stx $78 STX TempB ; save interrupt pointer
.dd40 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory (past token)
.dd43 20 55 c5 jsr $c555 JSR LAB_GFPN ; get fixed-point number into temp integer
.dd46 a5 79 lda $79 LDA Smeml ; get start of mem low byte
.dd48 a6 7a ldx $7a LDX Smemh ; get start of mem high byte
.dd4a 20 28 c1 jsr $c128 JSR LAB_SHLN ; search Basic for temp integer line number from AX
.dd4d b0 03 bcs $dd52 BCS LAB_LFND ; if carry set go set-up interrupt
.dd4f 4c 72 c4 jmp $c472 JMP LAB_16F7 ; else go do "Undefined statement" error and warm start
.dd52 lab_lfnd
.dd52 a6 78 ldx $78 LDX TempB ; get interrupt pointer
.dd54 a5 aa lda $aa LDA Baslnl ; get pointer low byte
.dd56 e9 01 sbc #$01 SBC #$01 ; -1 (carry already set for subtract)
.dd58 95 01 sta $01,x STA PLUS_1,X ; save as interrupt pointer low byte
.dd5a a5 ab lda $ab LDA Baslnh ; get pointer high byte
.dd5c e9 00 sbc #$00 SBC #$00 ; subtract carry
.dd5e 95 02 sta $02,x STA PLUS_2,X ; save as interrupt pointer high byte
.dd60 a9 c0 lda #$c0 LDA #$C0 ; set interrupt enabled/setup bits
.dd62 95 00 sta $00,x STA PLUS_0,X ; set interrupt flags
.dd64 lab_irts
.dd64 60 rts RTS
.dd65 lab_retirq
.dd65 d0 fd bne $dd64 BNE LAB_IRTS ; exit if following token (to allow syntax error)
.dd67 a5 df lda $df LDA IrqBase ; get interrupt flags
.dd69 0a asl ASL ; copy setup to enabled (b7)
.dd6a 05 df ora $df ORA IrqBase ; OR in setup flag
.dd6c 85 df sta $df STA IrqBase ; save enabled flag
.dd6e 4c 79 c4 jmp $c479 JMP LAB_16E8 ; go do rest of RETURN
.dd71 lab_retnmi
.dd71 d0 f1 bne $dd64 BNE LAB_IRTS ; exit if following token (to allow syntax error)
.dd73 a5 dc lda $dc LDA NmiBase ; get set-up flag
.dd75 0a asl ASL ; copy setup to enabled (b7)
.dd76 05 dc ora $dc ORA NmiBase ; OR in setup flag
.dd78 85 dc sta $dc STA NmiBase ; save enabled flag
.dd7a 4c 79 c4 jmp $c479 JMP LAB_16E8 ; go do rest of RETURN
.dd7d lab_mmpp
.dd7d 20 e9 c8 jsr $c8e9 JSR LAB_EVEZ ; process expression
.dd80 4c d0 c8 jmp $c8d0 JMP LAB_CTNM ; check if source is numeric, else do type mismatch
.dd83 lab_max
.dd83 20 b1 dd jsr $ddb1 JSR LAB_PHFA ; push FAC1, evaluate expression,
.dd86 10 fb bpl $dd83 BPL LAB_MAX ; branch if no swap to do
.dd88 a5 b4 lda $b4 LDA FAC2_1 ; get FAC2 mantissa1
.dd8a 09 80 ora #$80 ORA #$80 ; set top bit (clear sign from compare)
.dd8c 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.dd8e 20 c3 d3 jsr $d3c3 JSR LAB_279B ; copy FAC2 to FAC1
.dd91 f0 f0 beq $dd83 BEQ LAB_MAX ; go do next (branch always)
.dd93 lab_min
.dd93 20 b1 dd jsr $ddb1 JSR LAB_PHFA ; push FAC1, evaluate expression,
.dd96 30 fb bmi $dd93 BMI LAB_MIN ; branch if no swap to do
.dd98 f0 f9 beq $dd93 BEQ LAB_MIN ; branch if no swap to do
.dd9a a5 b4 lda $b4 LDA FAC2_1 ; get FAC2 mantissa1
.dd9c 09 80 ora #$80 ORA #$80 ; set top bit (clear sign from compare)
.dd9e 85 b4 sta $b4 STA FAC2_1 ; save FAC2 mantissa1
.dda0 20 c3 d3 jsr $d3c3 JSR LAB_279B ; copy FAC2 to FAC1
.dda3 f0 ee beq $dd93 BEQ LAB_MIN ; go do next (branch always)
.dda5 lab_mmec
.dda5 c9 29 cmp #$29 CMP #")" ; is it end of function?
.dda7 d0 05 bne $ddae BNE LAB_MMSE ; if not do MAX MIN syntax error
.dda9 68 pla PLA ; dump return address low byte
.ddaa 68 pla PLA ; dump return address high byte
.ddab 4c bc 00 jmp $00bc JMP LAB_IGBY ; update BASIC execute pointer (to chr past ")")
.ddae lab_mmse
.ddae 4c 02 ca jmp $ca02 JMP LAB_SNER ; do syntax error then warm start
.ddb1 lab_phfa
.ddb1 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get next BASIC byte
.ddb4 c9 2c cmp #$2c CMP #"," ; is there more ?
.ddb6 d0 ed bne $dda5 BNE LAB_MMEC ; if not go do end check
.ddb8 20 d9 d6 jsr $d6d9 JSR LAB_27BA ; round FAC1
.ddbb a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign
.ddbd 09 7f ora #$7f ORA #$7F ; set all non sign bits
.ddbf 25 ad and $ad AND FAC1_1 ; AND FAC1 mantissa1 (AND in sign bit)
.ddc1 48 pha PHA ; push on stack
.ddc2 a5 ae lda $ae LDA FAC1_2 ; get FAC1 mantissa2
.ddc4 48 pha PHA ; push on stack
.ddc5 a5 af lda $af LDA FAC1_3 ; get FAC1 mantissa3
.ddc7 48 pha PHA ; push on stack
.ddc8 a5 ac lda $ac LDA FAC1_e ; get FAC1 exponent
.ddca 48 pha PHA ; push on stack
.ddcb 20 bc 00 jsr $00bc JSR LAB_IGBY ; scan and get next BASIC byte (after ",")
.ddce 20 cd c8 jsr $c8cd JSR LAB_EVNM ; evaluate expression and check is numeric,
.ddd1 68 pla PLA ; pop exponent
.ddd2 85 b3 sta $b3 STA FAC2_e ; save FAC2 exponent
.ddd4 68 pla PLA ; pop mantissa3
.ddd5 85 b6 sta $b6 STA FAC2_3 ; save FAC2 mantissa3
.ddd7 68 pla PLA ; pop mantissa1
.ddd8 85 b5 sta $b5 STA FAC2_2 ; save FAC2 mantissa2
.ddda 68 pla PLA ; pop sign/mantissa1
.dddb 85 b4 sta $b4 STA FAC2_1 ; save FAC2 sign/mantissa1
.dddd 85 b7 sta $b7 STA FAC2_s ; save FAC2 sign
.dddf a9 b3 lda #$b3 LDA #<FAC2_e ; set pointer low byte to FAC2
.dde1 a0 00 ldy #$00 LDY #>FAC2_e ; set pointer high byte to FAC2
.dde3 4c 17 d7 jmp $d717 JMP LAB_27F8 ; compare FAC1 with FAC2 (AY) and return
.dde6 lab_wdth
.dde6 c9 2c cmp #$2c CMP #"," ; is next byte ","
.dde8 f0 1b beq $de05 BEQ LAB_TBSZ ; if so do tab size
.ddea 20 8c d2 jsr $d28c JSR LAB_GTBY ; get byte parameter
.dded 8a txa TXA ; copy width to A
.ddee f0 0a beq $ddfa BEQ LAB_NSTT ; branch if set for infinite line
.ddf0 e0 10 cpx #$10 CPX #$10 ; else make min width = 16d
.ddf2 90 45 bcc $de39 BCC TabErr ; if less do function call error and exit
.ddf4 e4 64 cpx $64 CPX TabSiz ; compare with tab size
.ddf6 b0 02 bcs $ddfa BCS LAB_NSTT ; branch if >= tab size
.ddf8 86 64 stx $64 STX TabSiz ; else make tab size = terminal width
.ddfa lab_nstt
.ddfa 86 0f stx $0f STX TWidth ; set the terminal width
.ddfc 20 c2 00 jsr $00c2 JSR LAB_GBYT ; get BASIC byte back
.ddff f0 1a beq $de1b BEQ WExit ; exit if no following
.de01 c9 2c cmp #$2c CMP #"," ; else is it ","
.de03 d0 a9 bne $ddae BNE LAB_MMSE ; if not do syntax error
.de05 lab_tbsz
.de05 20 89 d2 jsr $d289 JSR LAB_SGBY ; scan and get byte parameter
.de08 8a txa TXA ; copy TAB size
.de09 30 2e bmi $de39 BMI TabErr ; if >127 do function call error and exit
.de0b e0 01 cpx #$01 CPX #$01 ; compare with min-1
.de0d 90 2a bcc $de39 BCC TabErr ; if <=1 do function call error and exit
.de0f a5 0f lda $0f LDA TWidth ; set flags for width
.de11 f0 06 beq $de19 BEQ LAB_SVTB ; skip check if infinite line
.de13 e4 0f cpx $0f CPX TWidth ; compare TAB with width
.de15 f0 02 beq $de19 BEQ LAB_SVTB ; ok if =
.de17 b0 20 bcs $de39 BCS TabErr ; branch if too big
.de19 lab_svtb
.de19 86 64 stx $64 STX TabSiz ; save TAB size
.de1b wexit
.de1b a5 0f lda $0f LDA TWidth ; get width
.de1d f0 06 beq $de25 BEQ LAB_SULP ; branch if infinite line
.de1f c5 64 cmp $64 CMP TabSiz ; compare with tab size
.de21 b0 03 bcs $de26 BCS LAB_WDLP ; branch if >= tab size
.de23 85 64 sta $64 STA TabSiz ; else make tab size = terminal width
.de25 lab_sulp
.de25 38 sec SEC ; set carry for subtract
.de26 lab_wdlp
.de26 e5 64 sbc $64 SBC TabSiz ; subtract tab size
.de28 b0 fc bcs $de26 BCS LAB_WDLP ; loop while no borrow
.de2a 65 64 adc $64 ADC TabSiz ; add tab size back
.de2c 18 clc CLC ; clear carry for add
.de2d 65 64 adc $64 ADC TabSiz ; add tab size back again
.de2f 85 10 sta $10 STA Iclim ; save for now
.de31 a5 0f lda $0f LDA TWidth ; get width back
.de33 38 sec SEC ; set carry for subtract
.de34 e5 10 sbc $10 SBC Iclim ; subtract remainder
.de36 85 10 sta $10 STA Iclim ; save tab column limit
.de38 lab_nosq
.de38 60 rts RTS
.de39 taberr
.de39 4c 29 cd jmp $cd29 JMP LAB_FCER ; do function call error then warm start
.de3c lab_sqr
.de3c a5 b0 lda $b0 LDA FAC1_s ; get FAC1 sign
.de3e 30 f9 bmi $de39 BMI TabErr ; if -ve do function call error
.de40 a5 ac lda $ac LDA FAC1_e ; get exponent
.de42 f0 f4 beq $de38 BEQ LAB_NOSQ ; if zero just return
.de44 20 ca d6 jsr $d6ca JSR LAB_27AB ; round and copy FAC1 to FAC2
.de47 a9 00 lda #$00 LDA #$00 ; clear A
.de49 85 77 sta $77 STA FACt_3 ; clear remainder
.de4b 85 76 sta $76 STA FACt_2 ; ..
.de4d 85 75 sta $75 STA FACt_1 ; ..
.de4f 85 78 sta $78 STA TempB ; ..
.de51 85 af sta $af STA FAC1_3 ; clear root
.de53 85 ae sta $ae STA FAC1_2 ; ..
.de55 85 ad sta $ad STA FAC1_1 ; ..
.de57 a2 18 ldx #$18 LDX #$18 ; 24 pairs of bits to do
.de59 a5 b3 lda $b3 LDA FAC2_e ; get exponent
.de5b 4a lsr LSR ; check odd/even
.de5c b0 0e bcs $de6c BCS LAB_SQE2 ; if odd only 1 shift first time
.de5e lab_sqe1
.de5e 06 b6 asl $b6 ASL FAC2_3 ; shift highest bit of number ..
.de60 26 b5 rol $b5 ROL FAC2_2 ; ..
.de62 26 b4 rol $b4 ROL FAC2_1 ; ..
.de64 26 77 rol $77 ROL FACt_3 ; .. into remainder
.de66 26 76 rol $76 ROL FACt_2 ; ..
.de68 26 75 rol $75 ROL FACt_1 ; ..
.de6a 26 78 rol $78 ROL TempB ; .. never overflows
.de6c lab_sqe2
.de6c 06 b6 asl $b6 ASL FAC2_3 ; shift highest bit of number ..
.de6e 26 b5 rol $b5 ROL FAC2_2 ; ..
.de70 26 b4 rol $b4 ROL FAC2_1 ; ..
.de72 26 77 rol $77 ROL FACt_3 ; .. into remainder
.de74 26 76 rol $76 ROL FACt_2 ; ..
.de76 26 75 rol $75 ROL FACt_1 ; ..
.de78 26 78 rol $78 ROL TempB ; .. never overflows
.de7a 06 af asl $af ASL FAC1_3 ; root = root * 2
.de7c 26 ae rol $ae ROL FAC1_2 ; ..
.de7e 26 ad rol $ad ROL FAC1_1 ; .. never overflows
.de80 a5 af lda $af LDA FAC1_3 ; get root low byte
.de82 2a rol ROL ; *2
.de83 85 5b sta $5b STA Temp3 ; save partial low byte
.de85 a5 ae lda $ae LDA FAC1_2 ; get root low mid byte
.de87 2a rol ROL ; *2
.de88 85 5c sta $5c STA Temp3+1 ; save partial low mid byte
.de8a a5 ad lda $ad LDA FAC1_1 ; get root high mid byte
.de8c 2a rol ROL ; *2
.de8d 85 5d sta $5d STA Temp3+2 ; save partial high mid byte
.de8f a9 00 lda #$00 LDA #$00 ; get root high byte (always $00)
.de91 2a rol ROL ; *2
.de92 85 5e sta $5e STA Temp3+3 ; save partial high byte
.de94 a5 77 lda $77 LDA FACt_3 ; get remainder low byte
.de96 e5 5b sbc $5b SBC Temp3 ; subtract partial low byte
.de98 85 5b sta $5b STA Temp3 ; save partial low byte
.de9a a5 76 lda $76 LDA FACt_2 ; get remainder low mid byte
.de9c e5 5c sbc $5c SBC Temp3+1 ; subtract partial low mid byte
.de9e 85 5c sta $5c STA Temp3+1 ; save partial low mid byte
.dea0 a5 75 lda $75 LDA FACt_1 ; get remainder high mid byte
.dea2 e5 5d sbc $5d SBC Temp3+2 ; subtract partial high mid byte
.dea4 a8 tay TAY ; copy partial high mid byte
.dea5 a5 78 lda $78 LDA TempB ; get remainder high byte
.dea7 e5 5e sbc $5e SBC Temp3+3 ; subtract partial high byte
.dea9 90 0e bcc $deb9 BCC LAB_SQNS ; skip sub if remainder smaller
.deab 85 78 sta $78 STA TempB ; save remainder high byte
.dead 84 75 sty $75 STY FACt_1 ; save remainder high mid byte
.deaf a5 5c lda $5c LDA Temp3+1 ; get remainder low mid byte
.deb1 85 76 sta $76 STA FACt_2 ; save remainder low mid byte
.deb3 a5 5b lda $5b LDA Temp3 ; get partial low byte
.deb5 85 77 sta $77 STA FACt_3 ; save remainder low byte
.deb7 e6 af inc $af INC FAC1_3 ; increment root low byte (never any rollover)
.deb9 lab_sqns
.deb9 ca dex DEX ; decrement bit pair count
.deba d0 a2 bne $de5e BNE LAB_SQE1 ; loop if not all done
.debc 38 sec SEC ; set carry for subtract
.debd a5 b3 lda $b3 LDA FAC2_e ; get exponent
.debf e9 80 sbc #$80 SBC #$80 ; normalise
.dec1 6a ror ROR ; /2 and re-bias to $80
.dec2 69 00 adc #$00 ADC #$00 ; add bit zero back in (allow for half shift)
.dec4 85 ac sta $ac STA FAC1_e ; save it
.dec6 4c 34 d4 jmp $d434 JMP LAB_24D5 ; normalise FAC1 and return
.dec9 lab_varptr
.dec9 20 bc 00 jsr $00bc JSR LAB_IGBY ; increment and scan memory
.decc 20 aa cb jsr $cbaa JSR LAB_GVAR ; get var address
.decf 20 ef c9 jsr $c9ef JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
.ded2 a4 95 ldy $95 LDY Cvaral ; get var address low byte
.ded4 a5 96 lda $96 LDA Cvarah ; get var address high byte
.ded6 4c 59 ce jmp $ce59 JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
.ded9 lab_pi
.ded9 a9 bb lda #$bb LDA #<LAB_2C7C ; set (2*pi) pointer low byte
.dedb a0 df ldy #$df LDY #>LAB_2C7C ; set (2*pi) pointer high byte
.dedd 20 7d d6 jsr $d67d JSR LAB_UFAC ; unpack memory (AY) into FAC1
.dee0 c6 ac dec $ac DEC FAC1_e ; make result = PI
.dee2 60 rts RTS
.dee3 lab_twopi
.dee3 a9 bb lda #$bb LDA #<LAB_2C7C ; set (2*pi) pointer low byte
.dee5 a0 df ldy #$df LDY #>LAB_2C7C ; set (2*pi) pointer high byte
.dee7 4c 7d d6 jmp $d67d JMP LAB_UFAC ; unpack memory (AY) into FAC1 and return
.deea v_inpt
.deea 6c 05 04 jmp ($0405) JMP (VEC_IN) ; non halting scan input device
.deed v_outp
.deed 6c 07 04 jmp ($0407) JMP (VEC_OUT) ; send byte to output device
.def0 v_load
.def0 6c 09 04 jmp ($0409) JMP (VEC_LD) ; load BASIC program
.def3 v_save
.def3 6c 0b 04 jmp ($040b) JMP (VEC_SV) ; save BASIC program
.def6 pg2_tabs
>def6 00 .byte $00 ; ctrl-c flag - $00 = enabled
>def7 00 .byte $00 ; ctrl-c byte - GET needs this
>def8 00 .byte $00 ; ctrl-c byte timeout - GET needs this
>def9 a8 dc .word CTRLC ; ctrl c check vector
.defb pg2_tabe
.defb lab_2cee
.defb e6 c3 inc $c3 INC Bpntrl ; increment BASIC execute pointer low byte
.defd d0 02 bne $df01 BNE LAB_2CF4 ; branch if no carry
.deff e6 c4 inc $c4 INC Bpntrh ; increment BASIC execute pointer high byte
.df01 lab_2cf4
.df01 ad ff ff lda $ffff LDA $FFFF ; get byte to scan (addr set by call routine)
.df04 c9 ad cmp #$ad CMP #TK_ELSE ; compare with the token for ELSE
.df06 f0 0e beq $df16 BEQ LAB_2D05 ; exit if ELSE, not numeric, carry set
.df08 c9 3a cmp #$3a CMP #":" ; compare with ":"
.df0a b0 0a bcs $df16 BCS LAB_2D05 ; exit if >= ":", not numeric, carry set
.df0c c9 20 cmp #$20 CMP #" " ; compare with " "
.df0e f0 eb beq $defb BEQ LAB_2CEE ; if " " go do next
.df10 38 sec SEC ; set carry for SBC
.df11 e9 30 sbc #$30 SBC #"0" ; subtract "0"
.df13 38 sec SEC ; set carry for SBC
.df14 e9 d0 sbc #$d0 SBC #$D0 ; subtract -"0"
.df16 lab_2d05
.df16 60 rts RTS
.df17 strtab
>df17 4c .byte $4C ; JMP opcode
>df18 00 be .word LAB_COLD ; initial warm start vector (cold start)
>df1a 00 .byte $00 ; these bytes are not used by BASIC
>df1b 00 00 .word $0000 ;
>df1d 00 00 .word $0000 ;
>df1f 00 00 .word $0000 ;
>df21 4c .byte $4C ; JMP opcode
>df22 29 cd .word LAB_FCER ; initial user function vector ("Function call" error)
>df24 00 .byte $00 ; default NULL count
>df25 00 .byte $00 ; clear terminal position
>df26 00 .byte $00 ; default terminal width byte
>df27 f2 .byte $F2 ; default limit for TAB = 14
>df28 00 05 .word Ram_base ; start of user RAM
.df2a endtab
.df2a lab_mszm
>df2a 0d 0a 4d 65 6d 6f 72 79 20 73 69 7a 65 20 00 .byte $0D,$0A,"Memory size ",$00
.df39 lab_smsg
>df39 20 42 79 74 65 73 20 66 72 65 65 0d 0a 0a .byte " Bytes free",$0D,$0A,$0A
>df47 45 6e 68 61 6e 63 65 64 20 42 41 53 49 43 20 32 2e 32 32 0a 00 .byte "Enhanced BASIC 2.22",$0A,$00
.df5c lab_25a0
>df5c 02 .byte $02 ; counter
>df5d 80 19 56 62 .byte $80,$19,$56,$62 ; 0.59898
>df61 80 76 22 f3 .byte $80,$76,$22,$F3 ; 0.96147
>df65 82 38 aa 40 .byte $82,$38,$AA,$40 ; 2.88539
.df69 lab_25ad
>df69 80 35 04 f3 .byte $80,$35,$04,$F3 ; 0.70711 1/root 2
.df6d lab_25b1
>df6d 81 35 04 f3 .byte $81,$35,$04,$F3 ; 1.41421 root 2
.df71 lab_25b5
>df71 80 80 00 00 .byte $80,$80,$00,$00 ; -0.5
.df75 lab_25b9
>df75 80 31 72 18 .byte $80,$31,$72,$18 ; 0.69315 LOG(2)
.df79 lab_2947
>df79 91 43 4f f8 .byte $91,$43,$4F,$F8 ; 99999.9375 (max value with at least one decimal)
.df7d lab_294b
>df7d 94 74 23 f7 .byte $94,$74,$23,$F7 ; 999999.4375 (max value before scientific notation)
.df81 lab_294f
>df81 94 74 24 00 .byte $94,$74,$24,$00 ; 1000000
.df85 lab_2afa
>df85 81 38 aa 3b .byte $81,$38,$AA,$3B ; 1.4427 (1/LOG base 2 e)
.df89 lab_2afe
>df89 06 .byte $06 ; counter
>df8a 74 63 90 8c .byte $74,$63,$90,$8C ; 2.17023e-4
>df8e 77 23 0c ab .byte $77,$23,$0C,$AB ; 0.00124
>df92 7a 1e 94 00 .byte $7A,$1E,$94,$00 ; 0.00968
>df96 7c 63 42 80 .byte $7C,$63,$42,$80 ; 0.05548
>df9a 7e 75 fe d0 .byte $7E,$75,$FE,$D0 ; 0.24023
>df9e 80 31 72 15 .byte $80,$31,$72,$15 ; 0.69315
>dfa2 81 00 00 00 .byte $81,$00,$00,$00 ; 1.00000
.dfa6 lab_2c78
>dfa6 81 49 0f db .byte $81,$49,$0F,$DB ; 1.570796371 (pi/2) as floating #
.dfaa lab_2c84
>dfaa 04 .byte $04 ; counter
>dfab 86 1e d7 fb .byte $86,$1E,$D7,$FB ; 39.7109
>dfaf 87 99 26 65 .byte $87,$99,$26,$65 ;-76.575
>dfb3 87 23 34 58 .byte $87,$23,$34,$58 ; 81.6022
>dfb7 86 a5 5d e1 .byte $86,$A5,$5D,$E1 ;-41.3417
.dfbb lab_2c7c
>dfbb 83 49 0f db .byte $83,$49,$0F,$DB ; 6.28319 (2*pi) as floating #
.dfbf lab_2cc9
>dfbf 08 .byte $08 ; counter
>dfc0 78 3a c5 37 .byte $78,$3A,$C5,$37 ; 0.00285
>dfc4 7b 83 a2 5c .byte $7B,$83,$A2,$5C ;-0.0160686
>dfc8 7c 2e dd 4d .byte $7C,$2E,$DD,$4D ; 0.0426915
>dfcc 7d 99 b0 1e .byte $7D,$99,$B0,$1E ;-0.0750429
>dfd0 7d 59 ed 24 .byte $7D,$59,$ED,$24 ; 0.106409
>dfd4 7e 91 72 00 .byte $7E,$91,$72,$00 ;-0.142036
>dfd8 7e 4c b9 73 .byte $7E,$4C,$B9,$73 ; 0.199926
>dfdc 7f aa aa 53 .byte $7F,$AA,$AA,$53 ;-0.333331
.dfe0 lab_259c
>dfe0 81 00 00 00 .byte $81,$00,$00,$00 ; 1.000000, used for INC
.dfe4 lab_2afd
>dfe4 81 80 00 00 .byte $81,$80,$00,$00 ; -1.00000, used for DEC. must be on the same page as +1.00
.dfe8 lab_1df7
>dfe8 90 .byte $90 ;-32768 (uses first three bytes from 0.5)
.dfe9 lab_2a96
>dfe9 80 00 00 00 .byte $80,$00,$00,$00 ; 0.5
.dfed lab_2c80
>dfed 7f 00 00 00 .byte $7F,$00,$00,$00 ; 0.25
.dff1 lab_26b5
>dff1 84 20 00 00 .byte $84,$20,$00,$00 ; 10.0000 divide by 10 constant
.dff5 lab_2a9a
>dff5 fe 79 60 .byte $FE,$79,$60 ; -100000
>dff8 00 27 10 .byte $00,$27,$10 ; 10000
>dffb ff fc 18 .byte $FF,$FC,$18 ; -1000
>dffe 00 00 64 .byte $00,$00,$64 ; 100
>e001 ff ff f6 .byte $FF,$FF,$F6 ; -10
>e004 00 00 01 .byte $00,$00,$01 ; 1
.e007 lab_ctbl
>e007 1a c3 .word LAB_END-1 ; END
>e009 57 c2 .word LAB_FOR-1 ; FOR
>e00b 64 c8 .word LAB_NEXT-1 ; NEXT
>e00d 8b c4 .word LAB_DATA-1 ; DATA
>e00f 46 c7 .word LAB_INPUT-1 ; INPUT
>e011 5e cb .word LAB_DIM-1 ; DIM
>e013 66 c7 .word LAB_READ-1 ; READ
>e015 b3 c5 .word LAB_LET-1 ; LET
>e017 85 c5 .word LAB_DEC-1 ; DEC new command
>e019 ea c3 .word LAB_GOTO-1 ; GOTO
>e01b a9 c3 .word LAB_RUN-1 ; RUN
>e01d b9 c4 .word LAB_IF-1 ; IF
>e01f 41 c3 .word LAB_RESTORE-1 ; RESTORE modified command
>e021 cd c3 .word LAB_GOSUB-1 ; GOSUB
>e023 64 dd .word LAB_RETIRQ-1 ; RETIRQ new command
>e025 70 dd .word LAB_RETNMI-1 ; RETNMI new command
>e027 76 c4 .word LAB_RETURN-1 ; RETURN
>e029 1d c5 .word LAB_REM-1 ; REM
>e02b 18 c3 .word LAB_STOP-1 ; STOP
>e02d 26 c5 .word LAB_ON-1 ; ON modified command
>e02f 7f c3 .word LAB_NULL-1 ; NULL modified command
>e031 88 c5 .word LAB_INC-1 ; INC new command
>e033 88 d3 .word LAB_WAIT-1 ; WAIT
>e035 ef de .word V_LOAD-1 ; LOAD
>e037 f2 de .word V_SAVE-1 ; SAVE
>e039 73 ce .word LAB_DEF-1 ; DEF
>e03b 0d d3 .word LAB_POKE-1 ; POKE
>e03d 29 d3 .word LAB_DOKE-1 ; DOKE new command
>e03f 76 d3 .word LAB_CALL-1 ; CALL new command
>e041 b3 c3 .word LAB_DO-1 ; DO new command
>e043 1c c4 .word LAB_LOOP-1 ; LOOP new command
>e045 54 c6 .word LAB_PRINT-1 ; PRINT
>e047 85 c3 .word LAB_CONT-1 ; CONT
>e049 a2 c1 .word LAB_LIST-1 ; LIST
>e04b 9f c1 .word LAB_CLEAR-1 ; CLEAR
>e04d 4d c1 .word LAB_NEW-1 ; NEW
>e04f e5 dd .word LAB_WDTH-1 ; WIDTH new command
>e051 23 c6 .word LAB_GET-1 ; GET new command
>e053 4e d3 .word LAB_SWAP-1 ; SWAP new command
>e055 81 db .word LAB_BITSET-1 ; BITSET new command
>e057 95 db .word LAB_BITCLR-1 ; BITCLR new command
>e059 13 dd .word LAB_IRQ-1 ; IRQ new command
>e05b 16 dd .word LAB_NMI-1 ; NMI new command
>e05d 3d e8 .word SYSjmp-1 ; SYS *** added for SBC-2
.e05f lab_ftpl
>e05f 64 ca .word LAB_PPFN-1 ; SGN(n) process numeric expression in ()
>e061 64 ca .word LAB_PPFN-1 ; INT(n) "
>e063 64 ca .word LAB_PPFN-1 ; ABS(n) "
>e065 e8 c8 .word LAB_EVEZ-1 ; USR(x) process any expression
>e067 eb c9 .word LAB_1BF7-1 ; FRE(x) "
>e069 eb c9 .word LAB_1BF7-1 ; POS(x) "
>e06b 64 ca .word LAB_PPFN-1 ; SQR(n) process numeric expression in ()
>e06d 64 ca .word LAB_PPFN-1 ; RND(n) "
>e06f 64 ca .word LAB_PPFN-1 ; LOG(n) "
>e071 64 ca .word LAB_PPFN-1 ; EXP(n) "
>e073 64 ca .word LAB_PPFN-1 ; COS(n) "
>e075 64 ca .word LAB_PPFN-1 ; SIN(n) "
>e077 64 ca .word LAB_PPFN-1 ; TAN(n) "
>e079 64 ca .word LAB_PPFN-1 ; ATN(n) "
>e07b 64 ca .word LAB_PPFN-1 ; PEEK(n) "
>e07d 64 ca .word LAB_PPFN-1 ; DEEK(n) "
>e07f 00 00 .word $0000 ; SADD() none
>e081 5e ca .word LAB_PPFS-1 ; LEN($) process string expression in ()
>e083 64 ca .word LAB_PPFN-1 ; STR$(n) process numeric expression in ()
>e085 5e ca .word LAB_PPFS-1 ; VAL($) process string expression in ()
>e087 5e ca .word LAB_PPFS-1 ; ASC($) "
>e089 5e ca .word LAB_PPFS-1 ; UCASE$($) "
>e08b 5e ca .word LAB_PPFS-1 ; LCASE$($) "
>e08d 64 ca .word LAB_PPFN-1 ; CHR$(n) process numeric expression in ()
>e08f 8b ca .word LAB_BHSS-1 ; HEX$(n) "
>e091 8b ca .word LAB_BHSS-1 ; BIN$(n) "
>e093 00 00 .word $0000 ; BITTST() none
>e095 7c dd .word LAB_MMPP-1 ; MAX() process numeric expression
>e097 7c dd .word LAB_MMPP-1 ; MIN() "
>e099 6a ca .word LAB_PPBI-1 ; PI advance pointer
>e09b 6a ca .word LAB_PPBI-1 ; TWOPI "
>e09d 00 00 .word $0000 ; VARPTR() none
>e09f 6f ca .word LAB_LRMS-1 ; LEFT$() process string expression
>e0a1 6f ca .word LAB_LRMS-1 ; RIGHT$() "
>e0a3 6f ca .word LAB_LRMS-1 ; MID$() "
.e0a5 lab_ftbl
>e0a5 f6 d6 .word LAB_SGN-1 ; SGN()
>e0a7 80 d7 .word LAB_INT-1 ; INT()
>e0a9 13 d7 .word LAB_ABS-1 ; ABS()
>e0ab 4c db .word LAB_USR-1 ; USR()
>e0ad 44 ce .word LAB_FRE-1 ; FRE()
>e0af 63 ce .word LAB_POS-1 ; POS()
>e0b1 3b de .word LAB_SQR-1 ; SQR()
>e0b3 9c da .word LAB_RND-1 ; RND() modified function
>e0b5 fa d4 .word LAB_LOG-1 ; LOG()
>e0b7 fe d9 .word LAB_EXP-1 ; EXP()
>e0b9 d0 da .word LAB_COS-1 ; COS()
>e0bb d7 da .word LAB_SIN-1 ; SIN()
>e0bd 20 db .word LAB_TAN-1 ; TAN()
>e0bf 52 db .word LAB_ATN-1 ; ATN()
>e0c1 02 d3 .word LAB_PEEK-1 ; PEEK()
>e0c3 16 d3 .word LAB_DEEK-1 ; DEEK() new function
>e0c5 54 d2 .word LAB_SADD-1 ; SADD() new function
>e0c7 6d d2 .word LAB_LENS-1 ; LEN()
>e0c9 25 cf .word LAB_STRS-1 ; STR$()
>e0cb 9a d2 .word LAB_VAL-1 ; VAL()
>e0cd 78 d2 .word LAB_ASC-1 ; ASC()
>e0cf 32 d2 .word LAB_UCASE-1 ; UCASE$() new function
>e0d1 11 d2 .word LAB_LCASE-1 ; LCASE$() new function
>e0d3 83 d1 .word LAB_CHRS-1 ; CHR$()
>e0d5 22 dc .word LAB_HEXS-1 ; HEX$() new function
>e0d7 d3 db .word LAB_BINS-1 ; BIN$() new function
>e0d9 ab db .word LAB_BTST-1 ; BITTST() new function
>e0db 82 dd .word LAB_MAX-1 ; MAX() new function
>e0dd 92 dd .word LAB_MIN-1 ; MIN() new function
>e0df d8 de .word LAB_PI-1 ; PI new function
>e0e1 e2 de .word LAB_TWOPI-1 ; TWOPI new function
>e0e3 c8 de .word LAB_VARPTR-1 ; VARPTR() new function
>e0e5 95 d1 .word LAB_LEFT-1 ; LEFT$()
>e0e7 9e d1 .word LAB_RIGHT-1 ; RIGHT$()
>e0e9 cd d1 .word LAB_MIDS-1 ; MID$()
.e0eb lab_oppt
>e0eb 79 .byte $79 ; +
>e0ec c0 d3 .word LAB_ADD-1
>e0ee 79 .byte $79 ; -
>e0ef a5 d3 .word LAB_SUBTRACT-1
>e0f1 7b .byte $7B ; *
>e0f2 3b d5 .word LAB_MULTIPLY-1
>e0f4 7b .byte $7B ; /
>e0f5 03 d6 .word LAB_DIVIDE-1
>e0f7 7f .byte $7F ; ^
>e0f8 ba d9 .word LAB_POWER-1
>e0fa 50 .byte $50 ; AND
>e0fb d4 ca .word LAB_AND-1
>e0fd 46 .byte $46 ; EOR new operator
>e0fe ba ca .word LAB_EOR-1
>e100 46 .byte $46 ; OR
>e101 c7 ca .word LAB_OR-1
>e103 56 .byte $56 ; >> new operator
>e104 80 cb .word LAB_RSHIFT-1
>e106 56 .byte $56 ; << new operator
>e107 68 cb .word LAB_LSHIFT-1
>e109 7d .byte $7D ; >
>e10a f3 d9 .word LAB_GTHAN-1
>e10c 5a .byte $5A ; =
>e10d 16 ca .word LAB_EQUAL-1
>e10f 64 .byte $64 ; <
>e110 f5 ca .word LAB_LTHAN-1
.e112 tab_1stc
>e112 2a .byte "*"
>e113 2b .byte "+"
>e114 2d .byte "-"
>e115 2f .byte "/"
>e116 3c .byte "<"
>e117 3d .byte "="
>e118 3e .byte ">"
>e119 3f .byte "?"
>e11a 41 .byte "A"
>e11b 42 .byte "B"
>e11c 43 .byte "C"
>e11d 44 .byte "D"
>e11e 45 .byte "E"
>e11f 46 .byte "F"
>e120 47 .byte "G"
>e121 48 .byte "H"
>e122 49 .byte "I"
>e123 4c .byte "L"
>e124 4d .byte "M"
>e125 4e .byte "N"
>e126 4f .byte "O"
>e127 50 .byte "P"
>e128 52 .byte "R"
>e129 53 .byte "S"
>e12a 54 .byte "T"
>e12b 55 .byte "U"
>e12c 56 .byte "V"
>e12d 57 .byte "W"
>e12e 5e .byte "^"
>e12f 00 .byte $00 ; table terminator
.e130 tab_chrt
>e130 6a e1 .word TAB_STAR ; table for "*"
>e132 6c e1 .word TAB_PLUS ; table for "+"
>e134 6e e1 .word TAB_MNUS ; table for "-"
>e136 70 e1 .word TAB_SLAS ; table for "/"
>e138 72 e1 .word TAB_LESS ; table for "<"
>e13a 76 e1 .word TAB_EQUL ; table for "="
>e13c 78 e1 .word TAB_MORE ; table for ">"
>e13e 7c e1 .word TAB_QEST ; table for "?"
>e140 7e e1 .word TAB_ASCA ; table for "A"
>e142 8e e1 .word TAB_ASCB ; table for "B"
>e144 a7 e1 .word TAB_ASCC ; table for "C"
>e146 be e1 .word TAB_ASCD ; table for "D"
>e148 d7 e1 .word TAB_ASCE ; table for "E"
>e14a e6 e1 .word TAB_ASCF ; table for "F"
>e14c f0 e1 .word TAB_ASCG ; table for "G"
>e14e fd e1 .word TAB_ASCH ; table for "H"
>e150 03 e2 .word TAB_ASCI ; table for "I"
>e152 15 e2 .word TAB_ASCL ; table for "L"
>e154 3a e2 .word TAB_ASCM ; table for "M"
>e156 48 e2 .word TAB_ASCN ; table for "N"
>e158 5a e2 .word TAB_ASCO ; table for "O"
>e15a 62 e2 .word TAB_ASCP ; table for "P"
>e15c 77 e2 .word TAB_ASCR ; table for "R"
>e15e a6 e2 .word TAB_ASCS ; table for "S"
>e160 d4 e2 .word TAB_ASCT ; table for "T"
>e162 e8 e2 .word TAB_ASCU ; table for "U"
>e164 f9 e2 .word TAB_ASCV ; table for "V"
>e166 05 e3 .word TAB_ASCW ; table for "W"
>e168 14 e3 .word TAB_POWR ; table for "^"
.e16a tab_star
>e16a b9 00 .byte TK_MUL,$00 ; *
.e16c tab_plus
>e16c b7 00 .byte TK_PLUS,$00 ; +
.e16e tab_mnus
>e16e b8 00 .byte TK_MINUS,$00 ; -
.e170 tab_slas
>e170 ba 00 .byte TK_DIV,$00 ; /
.e172 tab_less
.e172 lbb_lshift
>e172 3c c0 .byte "<",TK_LSHIFT ; << note - "<<" must come before "<"
>e174 c3 .byte TK_LT ; <
>e175 00 .byte $00
.e176 tab_equl
>e176 c2 00 .byte TK_EQUAL,$00 ; =
.e178 tab_more
.e178 lbb_rshift
>e178 3e bf .byte ">",TK_RSHIFT ; >> note - ">>" must come before ">"
>e17a c1 .byte TK_GT ; >
>e17b 00 .byte $00
.e17c tab_qest
>e17c 9f 00 .byte TK_PRINT,$00 ; ?
.e17e tab_asca
.e17e lbb_abs
>e17e 42 53 28 c6 .byte "BS(",TK_ABS ; ABS(
.e182 lbb_and
>e182 4e 44 bc .byte "ND",TK_AND ; AND
.e185 lbb_asc
>e185 53 43 28 d8 .byte "SC(",TK_ASC ; ASC(
.e189 lbb_atn
>e189 54 4e 28 d1 .byte "TN(",TK_ATN ; ATN(
>e18d 00 .byte $00
.e18e tab_ascb
.e18e lbb_bins
>e18e 49 4e 24 28 dd .byte "IN$(",TK_BINS ; BIN$(
.e193 lbb_bitclr
>e193 49 54 43 4c 52 a8 .byte "ITCLR",TK_BITCLR ; BITCLR
.e199 lbb_bitset
>e199 49 54 53 45 54 a7 .byte "ITSET",TK_BITSET ; BITSET
.e19f lbb_bittst
>e19f 49 54 54 53 54 28 de .byte "ITTST(",TK_BITTST
>e1a6 00 .byte $00
.e1a7 tab_ascc
.e1a7 lbb_call
>e1a7 41 4c 4c 9c .byte "ALL",TK_CALL ; CALL
.e1ab lbb_chrs
>e1ab 48 52 24 28 db .byte "HR$(",TK_CHRS ; CHR$(
.e1b0 lbb_clear
>e1b0 4c 45 41 52 a2 .byte "LEAR",TK_CLEAR ; CLEAR
.e1b5 lbb_cont
>e1b5 4f 4e 54 a0 .byte "ONT",TK_CONT ; CONT
.e1b9 lbb_cos
>e1b9 4f 53 28 ce .byte "OS(",TK_COS ; COS(
>e1bd 00 .byte $00
.e1be tab_ascd
.e1be lbb_data
>e1be 41 54 41 83 .byte "ATA",TK_DATA ; DATA
.e1c2 lbb_dec
>e1c2 45 43 88 .byte "EC",TK_DEC ; DEC
.e1c5 lbb_deek
>e1c5 45 45 4b 28 d3 .byte "EEK(",TK_DEEK ; DEEK(
.e1ca lbb_def
>e1ca 45 46 99 .byte "EF",TK_DEF ; DEF
.e1cd lbb_dim
>e1cd 49 4d 85 .byte "IM",TK_DIM ; DIM
.e1d0 lbb_doke
>e1d0 4f 4b 45 9b .byte "OKE",TK_DOKE ; DOKE note - "DOKE" must come before "DO"
.e1d4 lbb_do
>e1d4 4f 9d .byte "O",TK_DO ; DO
>e1d6 00 .byte $00
.e1d7 tab_asce
.e1d7 lbb_else
>e1d7 4c 53 45 ad .byte "LSE",TK_ELSE ; ELSE
.e1db lbb_end
>e1db 4e 44 80 .byte "ND",TK_END ; END
.e1de lbb_eor
>e1de 4f 52 bd .byte "OR",TK_EOR ; EOR
.e1e1 lbb_exp
>e1e1 58 50 28 cd .byte "XP(",TK_EXP ; EXP(
>e1e5 00 .byte $00
.e1e6 tab_ascf
.e1e6 lbb_fn
>e1e6 4e af .byte "N",TK_FN ; FN
.e1e8 lbb_for
>e1e8 4f 52 81 .byte "OR",TK_FOR ; FOR
.e1eb lbb_fre
>e1eb 52 45 28 c8 .byte "RE(",TK_FRE ; FRE(
>e1ef 00 .byte $00
.e1f0 tab_ascg
.e1f0 lbb_get
>e1f0 45 54 a5 .byte "ET",TK_GET ; GET
.e1f3 lbb_gosub
>e1f3 4f 53 55 42 8d .byte "OSUB",TK_GOSUB ; GOSUB
.e1f8 lbb_goto
>e1f8 4f 54 4f 89 .byte "OTO",TK_GOTO ; GOTO
>e1fc 00 .byte $00
.e1fd tab_asch
.e1fd lbb_hexs
>e1fd 45 58 24 28 dc .byte "EX$(",TK_HEXS ; HEX$(
>e202 00 .byte $00
.e203 tab_asci
.e203 lbb_if
>e203 46 8b .byte "F",TK_IF ; IF
.e205 lbb_inc
>e205 4e 43 95 .byte "NC",TK_INC ; INC
.e208 lbb_input
>e208 4e 50 55 54 84 .byte "NPUT",TK_INPUT ; INPUT
.e20d lbb_int
>e20d 4e 54 28 c5 .byte "NT(",TK_INT ; INT(
.e211 lbb_irq
>e211 52 51 a9 .byte "RQ",TK_IRQ ; IRQ
>e214 00 .byte $00
.e215 tab_ascl
.e215 lbb_lcases
>e215 43 41 53 45 24 28 da .byte "CASE$(",TK_LCASES
.e21c lbb_lefts
>e21c 45 46 54 24 28 e4 .byte "EFT$(",TK_LEFTS ; LEFT$(
.e222 lbb_len
>e222 45 4e 28 d5 .byte "EN(",TK_LEN ; LEN(
.e226 lbb_let
>e226 45 54 87 .byte "ET",TK_LET ; LET
.e229 lbb_list
>e229 49 53 54 a1 .byte "IST",TK_LIST ; LIST
.e22d lbb_load
>e22d 4f 41 44 97 .byte "OAD",TK_LOAD ; LOAD
.e231 lbb_log
>e231 4f 47 28 cc .byte "OG(",TK_LOG ; LOG(
.e235 lbb_loop
>e235 4f 4f 50 9e .byte "OOP",TK_LOOP ; LOOP
>e239 00 .byte $00
.e23a tab_ascm
.e23a lbb_max
>e23a 41 58 28 df .byte "AX(",TK_MAX ; MAX(
.e23e lbb_mids
>e23e 49 44 24 28 e6 .byte "ID$(",TK_MIDS ; MID$(
.e243 lbb_min
>e243 49 4e 28 e0 .byte "IN(",TK_MIN ; MIN(
>e247 00 .byte $00
.e248 tab_ascn
.e248 lbb_new
>e248 45 57 a3 .byte "EW",TK_NEW ; NEW
.e24b lbb_next
>e24b 45 58 54 82 .byte "EXT",TK_NEXT ; NEXT
.e24f lbb_nmi
>e24f 4d 49 aa .byte "MI",TK_NMI ; NMI
.e252 lbb_not
>e252 4f 54 b2 .byte "OT",TK_NOT ; NOT
.e255 lbb_null
>e255 55 4c 4c 94 .byte "ULL",TK_NULL ; NULL
>e259 00 .byte $00
.e25a tab_asco
.e25a lbb_off
>e25a 46 46 b6 .byte "FF",TK_OFF ; OFF
.e25d lbb_on
>e25d 4e 93 .byte "N",TK_ON ; ON
.e25f lbb_or
>e25f 52 be .byte "R",TK_OR ; OR
>e261 00 .byte $00
.e262 tab_ascp
.e262 lbb_peek
>e262 45 45 4b 28 d2 .byte "EEK(",TK_PEEK ; PEEK(
.e267 lbb_pi
>e267 49 e1 .byte "I",TK_PI ; PI
.e269 lbb_poke
>e269 4f 4b 45 9a .byte "OKE",TK_POKE ; POKE
.e26d lbb_pos
>e26d 4f 53 28 c9 .byte "OS(",TK_POS ; POS(
.e271 lbb_print
>e271 52 49 4e 54 9f .byte "RINT",TK_PRINT ; PRINT
>e276 00 .byte $00
.e277 tab_ascr
.e277 lbb_read
>e277 45 41 44 86 .byte "EAD",TK_READ ; READ
.e27b lbb_rem
>e27b 45 4d 91 .byte "EM",TK_REM ; REM
.e27e lbb_restore
>e27e 45 53 54 4f 52 45 8c .byte "ESTORE",TK_RESTORE
.e285 lbb_retirq
>e285 45 54 49 52 51 8e .byte "ETIRQ",TK_RETIRQ ; RETIRQ
.e28b lbb_retnmi
>e28b 45 54 4e 4d 49 8f .byte "ETNMI",TK_RETNMI ; RETNMI
.e291 lbb_return
>e291 45 54 55 52 4e 90 .byte "ETURN",TK_RETURN ; RETURN
.e297 lbb_rights
>e297 49 47 48 54 24 28 e5 .byte "IGHT$(",TK_RIGHTS
.e29e lbb_rnd
>e29e 4e 44 28 cb .byte "ND(",TK_RND ; RND(
.e2a2 lbb_run
>e2a2 55 4e 8a .byte "UN",TK_RUN ; RUN
>e2a5 00 .byte $00
.e2a6 tab_ascs
.e2a6 lbb_sadd
>e2a6 41 44 44 28 d4 .byte "ADD(",TK_SADD ; SADD(
.e2ab lbb_save
>e2ab 41 56 45 98 .byte "AVE",TK_SAVE ; SAVE
.e2af lbb_sgn
>e2af 47 4e 28 c4 .byte "GN(",TK_SGN ; SGN(
.e2b3 lbb_sin
>e2b3 49 4e 28 cf .byte "IN(",TK_SIN ; SIN(
.e2b7 lbb_spc
>e2b7 50 43 28 b0 .byte "PC(",TK_SPC ; SPC(
.e2bb lbb_sqr
>e2bb 51 52 28 ca .byte "QR(",TK_SQR ; SQR(
.e2bf lbb_step
>e2bf 54 45 50 b3 .byte "TEP",TK_STEP ; STEP
.e2c3 lbb_stop
>e2c3 54 4f 50 92 .byte "TOP",TK_STOP ; STOP
.e2c7 lbb_strs
>e2c7 54 52 24 28 d6 .byte "TR$(",TK_STRS ; STR$(
.e2cc lbb_swap
>e2cc 57 41 50 a6 .byte "WAP",TK_SWAP ; SWAP
.e2d0 lbb_sys
>e2d0 59 53 ab .byte "YS", TK_SYS ; SYS *** added for SBC-2
>e2d3 00 .byte $00
.e2d4 tab_asct
.e2d4 lbb_tab
>e2d4 41 42 28 ac .byte "AB(",TK_TAB ; TAB(
.e2d8 lbb_tan
>e2d8 41 4e 28 d0 .byte "AN(",TK_TAN ; TAN(
.e2dc lbb_then
>e2dc 48 45 4e b1 .byte "HEN",TK_THEN ; THEN
.e2e0 lbb_to
>e2e0 4f ae .byte "O",TK_TO ; TO
.e2e2 lbb_twopi
>e2e2 57 4f 50 49 e2 .byte "WOPI",TK_TWOPI ; TWOPI
>e2e7 00 .byte $00
.e2e8 tab_ascu
.e2e8 lbb_ucases
>e2e8 43 41 53 45 24 28 d9 .byte "CASE$(",TK_UCASES
.e2ef lbb_until
>e2ef 4e 54 49 4c b4 .byte "NTIL",TK_UNTIL ; UNTIL
.e2f4 lbb_usr
>e2f4 53 52 28 c7 .byte "SR(",TK_USR ; USR(
>e2f8 00 .byte $00
.e2f9 tab_ascv
.e2f9 lbb_val
>e2f9 41 4c 28 d7 .byte "AL(",TK_VAL ; VAL(
.e2fd lbb_vptr
>e2fd 41 52 50 54 52 28 e3 .byte "ARPTR(",TK_VPTR ; VARPTR(
>e304 00 .byte $00
.e305 tab_ascw
.e305 lbb_wait
>e305 41 49 54 96 .byte "AIT",TK_WAIT ; WAIT
.e309 lbb_while
>e309 48 49 4c 45 b5 .byte "HILE",TK_WHILE ; WHILE
.e30e lbb_width
>e30e 49 44 54 48 a4 .byte "IDTH",TK_WIDTH ; WIDTH
>e313 00 .byte $00
.e314 tab_powr
>e314 bb 00 .byte TK_POWER,$00 ; ^
.e316 lab_keyt
>e316 03 45 .byte 3,"E"
>e318 db e1 .word LBB_END ; END
>e31a 03 46 .byte 3,"F"
>e31c e8 e1 .word LBB_FOR ; FOR
>e31e 04 4e .byte 4,"N"
>e320 4b e2 .word LBB_NEXT ; NEXT
>e322 04 44 .byte 4,"D"
>e324 be e1 .word LBB_DATA ; DATA
>e326 05 49 .byte 5,"I"
>e328 08 e2 .word LBB_INPUT ; INPUT
>e32a 03 44 .byte 3,"D"
>e32c cd e1 .word LBB_DIM ; DIM
>e32e 04 52 .byte 4,"R"
>e330 77 e2 .word LBB_READ ; READ
>e332 03 4c .byte 3,"L"
>e334 26 e2 .word LBB_LET ; LET
>e336 03 44 .byte 3,"D"
>e338 c2 e1 .word LBB_DEC ; DEC
>e33a 04 47 .byte 4,"G"
>e33c f8 e1 .word LBB_GOTO ; GOTO
>e33e 03 52 .byte 3,"R"
>e340 a2 e2 .word LBB_RUN ; RUN
>e342 02 49 .byte 2,"I"
>e344 03 e2 .word LBB_IF ; IF
>e346 07 52 .byte 7,"R"
>e348 7e e2 .word LBB_RESTORE ; RESTORE
>e34a 05 47 .byte 5,"G"
>e34c f3 e1 .word LBB_GOSUB ; GOSUB
>e34e 06 52 .byte 6,"R"
>e350 85 e2 .word LBB_RETIRQ ; RETIRQ
>e352 06 52 .byte 6,"R"
>e354 8b e2 .word LBB_RETNMI ; RETNMI
>e356 06 52 .byte 6,"R"
>e358 91 e2 .word LBB_RETURN ; RETURN
>e35a 03 52 .byte 3,"R"
>e35c 7b e2 .word LBB_REM ; REM
>e35e 04 53 .byte 4,"S"
>e360 c3 e2 .word LBB_STOP ; STOP
>e362 02 4f .byte 2,"O"
>e364 5d e2 .word LBB_ON ; ON
>e366 04 4e .byte 4,"N"
>e368 55 e2 .word LBB_NULL ; NULL
>e36a 03 49 .byte 3,"I"
>e36c 05 e2 .word LBB_INC ; INC
>e36e 04 57 .byte 4,"W"
>e370 05 e3 .word LBB_WAIT ; WAIT
>e372 04 4c .byte 4,"L"
>e374 2d e2 .word LBB_LOAD ; LOAD
>e376 04 53 .byte 4,"S"
>e378 ab e2 .word LBB_SAVE ; SAVE
>e37a 03 44 .byte 3,"D"
>e37c ca e1 .word LBB_DEF ; DEF
>e37e 04 50 .byte 4,"P"
>e380 69 e2 .word LBB_POKE ; POKE
>e382 04 44 .byte 4,"D"
>e384 d0 e1 .word LBB_DOKE ; DOKE
>e386 04 43 .byte 4,"C"
>e388 a7 e1 .word LBB_CALL ; CALL
>e38a 02 44 .byte 2,"D"
>e38c d4 e1 .word LBB_DO ; DO
>e38e 04 4c .byte 4,"L"
>e390 35 e2 .word LBB_LOOP ; LOOP
>e392 05 50 .byte 5,"P"
>e394 71 e2 .word LBB_PRINT ; PRINT
>e396 04 43 .byte 4,"C"
>e398 b5 e1 .word LBB_CONT ; CONT
>e39a 04 4c .byte 4,"L"
>e39c 29 e2 .word LBB_LIST ; LIST
>e39e 05 43 .byte 5,"C"
>e3a0 b0 e1 .word LBB_CLEAR ; CLEAR
>e3a2 03 4e .byte 3,"N"
>e3a4 48 e2 .word LBB_NEW ; NEW
>e3a6 05 57 .byte 5,"W"
>e3a8 0e e3 .word LBB_WIDTH ; WIDTH
>e3aa 03 47 .byte 3,"G"
>e3ac f0 e1 .word LBB_GET ; GET
>e3ae 04 53 .byte 4,"S"
>e3b0 cc e2 .word LBB_SWAP ; SWAP
>e3b2 06 42 .byte 6,"B"
>e3b4 99 e1 .word LBB_BITSET ; BITSET
>e3b6 06 42 .byte 6,"B"
>e3b8 93 e1 .word LBB_BITCLR ; BITCLR
>e3ba 03 49 .byte 3,"I"
>e3bc 11 e2 .word LBB_IRQ ; IRQ
>e3be 03 4e .byte 3,"N"
>e3c0 4f e2 .word LBB_NMI ; NMI
>e3c2 03 53 .byte 3,"S" ;
>e3c4 d0 e2 .word LBB_SYS ; SYS *** Added for SBC-2
>e3c6 04 54 .byte 4,"T"
>e3c8 d4 e2 .word LBB_TAB ; TAB
>e3ca 04 45 .byte 4,"E"
>e3cc d7 e1 .word LBB_ELSE ; ELSE
>e3ce 02 54 .byte 2,"T"
>e3d0 e0 e2 .word LBB_TO ; TO
>e3d2 02 46 .byte 2,"F"
>e3d4 e6 e1 .word LBB_FN ; FN
>e3d6 04 53 .byte 4,"S"
>e3d8 b7 e2 .word LBB_SPC ; SPC
>e3da 04 54 .byte 4,"T"
>e3dc dc e2 .word LBB_THEN ; THEN
>e3de 03 4e .byte 3,"N"
>e3e0 52 e2 .word LBB_NOT ; NOT
>e3e2 04 53 .byte 4,"S"
>e3e4 bf e2 .word LBB_STEP ; STEP
>e3e6 05 55 .byte 5,"U"
>e3e8 ef e2 .word LBB_UNTIL ; UNTIL
>e3ea 05 57 .byte 5,"W"
>e3ec 09 e3 .word LBB_WHILE ; WHILE
>e3ee 03 4f .byte 3,"O"
>e3f0 5a e2 .word LBB_OFF ; OFF
>e3f2 01 2b .byte 1,"+"
>e3f4 00 00 .word $0000 ; +
>e3f6 01 2d .byte 1,"-"
>e3f8 00 00 .word $0000 ; -
>e3fa 01 2a .byte 1,"*"
>e3fc 00 00 .word $0000 ; *
>e3fe 01 2f .byte 1,"/"
>e400 00 00 .word $0000 ; /
>e402 01 5e .byte 1,"^"
>e404 00 00 .word $0000 ; ^
>e406 03 41 .byte 3,"A"
>e408 82 e1 .word LBB_AND ; AND
>e40a 03 45 .byte 3,"E"
>e40c de e1 .word LBB_EOR ; EOR
>e40e 02 4f .byte 2,"O"
>e410 5f e2 .word LBB_OR ; OR
>e412 02 3e .byte 2,">"
>e414 78 e1 .word LBB_RSHIFT ; >>
>e416 02 3c .byte 2,"<"
>e418 72 e1 .word LBB_LSHIFT ; <<
>e41a 01 3e .byte 1,">"
>e41c 00 00 .word $0000 ; >
>e41e 01 3d .byte 1,"="
>e420 00 00 .word $0000 ; =
>e422 01 3c .byte 1,"<"
>e424 00 00 .word $0000 ; <
>e426 04 53 .byte 4,"S" ;
>e428 af e2 .word LBB_SGN ; SGN
>e42a 04 49 .byte 4,"I" ;
>e42c 0d e2 .word LBB_INT ; INT
>e42e 04 41 .byte 4,"A" ;
>e430 7e e1 .word LBB_ABS ; ABS
>e432 04 55 .byte 4,"U" ;
>e434 f4 e2 .word LBB_USR ; USR
>e436 04 46 .byte 4,"F" ;
>e438 eb e1 .word LBB_FRE ; FRE
>e43a 04 50 .byte 4,"P" ;
>e43c 6d e2 .word LBB_POS ; POS
>e43e 04 53 .byte 4,"S" ;
>e440 bb e2 .word LBB_SQR ; SQR
>e442 04 52 .byte 4,"R" ;
>e444 9e e2 .word LBB_RND ; RND
>e446 04 4c .byte 4,"L" ;
>e448 31 e2 .word LBB_LOG ; LOG
>e44a 04 45 .byte 4,"E" ;
>e44c e1 e1 .word LBB_EXP ; EXP
>e44e 04 43 .byte 4,"C" ;
>e450 b9 e1 .word LBB_COS ; COS
>e452 04 53 .byte 4,"S" ;
>e454 b3 e2 .word LBB_SIN ; SIN
>e456 04 54 .byte 4,"T" ;
>e458 d8 e2 .word LBB_TAN ; TAN
>e45a 04 41 .byte 4,"A" ;
>e45c 89 e1 .word LBB_ATN ; ATN
>e45e 05 50 .byte 5,"P" ;
>e460 62 e2 .word LBB_PEEK ; PEEK
>e462 05 44 .byte 5,"D" ;
>e464 c5 e1 .word LBB_DEEK ; DEEK
>e466 05 53 .byte 5,"S" ;
>e468 a6 e2 .word LBB_SADD ; SADD
>e46a 04 4c .byte 4,"L" ;
>e46c 22 e2 .word LBB_LEN ; LEN
>e46e 05 53 .byte 5,"S" ;
>e470 c7 e2 .word LBB_STRS ; STR$
>e472 04 56 .byte 4,"V" ;
>e474 f9 e2 .word LBB_VAL ; VAL
>e476 04 41 .byte 4,"A" ;
>e478 85 e1 .word LBB_ASC ; ASC
>e47a 07 55 .byte 7,"U" ;
>e47c e8 e2 .word LBB_UCASES ; UCASE$
>e47e 07 4c .byte 7,"L" ;
>e480 15 e2 .word LBB_LCASES ; LCASE$
>e482 05 43 .byte 5,"C" ;
>e484 ab e1 .word LBB_CHRS ; CHR$
>e486 05 48 .byte 5,"H" ;
>e488 fd e1 .word LBB_HEXS ; HEX$
>e48a 05 42 .byte 5,"B" ;
>e48c 8e e1 .word LBB_BINS ; BIN$
>e48e 07 42 .byte 7,"B" ;
>e490 9f e1 .word LBB_BITTST ; BITTST
>e492 04 4d .byte 4,"M" ;
>e494 3a e2 .word LBB_MAX ; MAX
>e496 04 4d .byte 4,"M" ;
>e498 43 e2 .word LBB_MIN ; MIN
>e49a 02 50 .byte 2,"P" ;
>e49c 67 e2 .word LBB_PI ; PI
>e49e 05 54 .byte 5,"T" ;
>e4a0 e2 e2 .word LBB_TWOPI ; TWOPI
>e4a2 07 56 .byte 7,"V" ;
>e4a4 fd e2 .word LBB_VPTR ; VARPTR
>e4a6 06 4c .byte 6,"L" ;
>e4a8 1c e2 .word LBB_LEFTS ; LEFT$
>e4aa 07 52 .byte 7,"R" ;
>e4ac 97 e2 .word LBB_RIGHTS ; RIGHT$
>e4ae 05 4d .byte 5,"M" ;
>e4b0 3e e2 .word LBB_MIDS ; MID$
.e4b2 lab_baer
>e4b2 d6 e4 .word ERR_NF ;$00 NEXT without FOR
>e4b4 e7 e4 .word ERR_SN ;$02 syntax
>e4b6 ee e4 .word ERR_RG ;$04 RETURN without GOSUB
>e4b8 03 e5 .word ERR_OD ;$06 out of data
>e4ba 0f e5 .word ERR_FC ;$08 function call
>e4bc 1d e5 .word ERR_OV ;$0A overflow
>e4be 26 e5 .word ERR_OM ;$0C out of memory
>e4c0 34 e5 .word ERR_US ;$0E undefined statement
>e4c2 48 e5 .word ERR_BS ;$10 array bounds
>e4c4 55 e5 .word ERR_DD ;$12 double dimension array
>e4c6 66 e5 .word ERR_D0 ;$14 divide by 0
>e4c8 75 e5 .word ERR_ID ;$16 illegal direct
>e4ca 84 e5 .word ERR_TM ;$18 type mismatch
>e4cc 92 e5 .word ERR_LS ;$1A long string
>e4ce a2 e5 .word ERR_ST ;$1C string too complex
>e4d0 b5 e5 .word ERR_CN ;$1E continue error
>e4d2 c4 e5 .word ERR_UF ;$20 undefined function
>e4d4 d7 e5 .word ERR_LD ;$22 LOOP without DO
>e4d6 4e 45 58 54 20 77 69 74 68 6f 75 74 20 46 4f 52 00 ERR_NF .byte "NEXT without FOR",$00
>e4e7 53 79 6e 74 61 78 00 ERR_SN .byte "Syntax",$00
>e4ee 52 45 54 55 52 4e 20 77 69 74 68 6f 75 74 20 47 4f 53 55 42 00 ERR_RG .byte "RETURN without GOSUB",$00
>e503 4f 75 74 20 6f 66 20 44 41 54 41 00 ERR_OD .byte "Out of DATA",$00
>e50f 46 75 6e 63 74 69 6f 6e 20 63 61 6c 6c 00 ERR_FC .byte "Function call",$00
>e51d 4f 76 65 72 66 6c 6f 77 00 ERR_OV .byte "Overflow",$00
>e526 4f 75 74 20 6f 66 20 6d 65 6d 6f 72 79 00 ERR_OM .byte "Out of memory",$00
>e534 55 6e 64 65 66 69 6e 65 64 20 73 74 61 74 65 6d 65 6e 74 00 ERR_US .byte "Undefined statement",$00
>e548 41 72 72 61 79 20 62 6f 75 6e 64 73 00 ERR_BS .byte "Array bounds",$00
>e555 44 6f 75 62 6c 65 20 64 69 6d 65 6e 73 69 6f 6e 00 ERR_DD .byte "Double dimension",$00
>e566 44 69 76 69 64 65 20 62 79 20 7a 65 72 6f 00 ERR_D0 .byte "Divide by zero",$00
>e575 49 6c 6c 65 67 61 6c 20 64 69 72 65 63 74 00 ERR_ID .byte "Illegal direct",$00
>e584 54 79 70 65 20 6d 69 73 6d 61 74 63 68 00 ERR_TM .byte "Type mismatch",$00
>e592 53 74 72 69 6e 67 20 74 6f 6f 20 6c 6f 6e 67 00 ERR_LS .byte "String too long",$00
>e5a2 53 74 72 69 6e 67 20 74 6f 6f 20 63 6f 6d 70 6c 65 78 00 ERR_ST .byte "String too complex",$00
>e5b5 43 61 6e 27 74 20 63 6f 6e 74 69 6e 75 65 00 ERR_CN .byte "Can't continue",$00
>e5c4 55 6e 64 65 66 69 6e 65 64 20 66 75 6e 63 74 69 6f 6e 00 ERR_UF .byte "Undefined function",$00
>e5d7 4c 4f 4f 50 20 77 69 74 68 6f 75 74 20 44 4f 00 ERR_LD .byte "LOOP without DO",$00
>e5e7 0d 0a 42 72 65 61 6b 00 LAB_BMSG .byte $0D,$0A,"Break",$00
>e5ef 20 45 72 72 6f 72 00 LAB_EMSG .byte " Error",$00
>e5f6 20 69 6e 20 6c 69 6e 65 20 00 LAB_LMSG .byte " in line ",$00
>e600 0d 0a 52 65 61 64 79 0d 0a 00 LAB_RMSG .byte $0D,$0A,"Ready",$0D,$0A,$00
>e60a 20 45 78 74 72 61 20 69 67 6e 6f 72 65 64 0d 0a 00 LAB_IMSG .byte " Extra ignored",$0D,$0A,$00
>e61b 20 52 65 64 6f 20 66 72 6f 6d 20 73 74 61 72 74 0d 0a 00 LAB_REDO .byte " Redo from start",$0D,$0A,$00
.e62e aa_end_basic
.e62e bsetup
.e62e a9 e7 lda #$e7 lda #<ACIA1_Scan
.e630 8d 05 04 sta $0405 sta VEC_IN
.e633 a9 a4 lda #$a4 lda #>ACIA1_Scan
.e635 8d 06 04 sta $0406 sta VEC_IN+1
.e638 a9 f4 lda #$f4 lda #<ACIA1_Output
.e63a 8d 07 04 sta $0407 sta VEC_OUT
.e63d a9 a4 lda #$a4 lda #>ACIA1_OUTPUT
.e63f 8d 08 04 sta $0408 sta VEC_OUT+1
.e642 a9 59 lda #$59 lda #<Psave
.e644 8d 0b 04 sta $040b sta VEC_SV
.e647 a9 e6 lda #$e6 Lda #>Psave
.e649 8d 0c 04 sta $040c sta VEC_SV+1
.e64c a9 82 lda #$82 lda #<pload
.e64e 8d 09 04 sta $0409 sta VEC_LD
.e651 a9 e6 lda #$e6 lda #>pload
.e653 8d 0a 04 sta $040a sta VEC_LD+1
.e656 4c 00 be jmp $be00 jmp LAB_COLD
.e659 psave
.e659 20 98 e6 jsr $e698 jsr pscan
.e65c a0 00 ldy #$00 ldy #$00
.e65e a5 11 lda $11 lda itempl
.e660 91 11 sta ($11),y sta (itempl),y
.e662 c8 iny iny
.e663 a5 12 lda $12 lda itemph
.e665 91 11 sta ($11),y sta (itempl),y
.e667 a6 79 ldx $79 ldx smeml
.e669 a5 7a lda $7a lda smemh
.e66b 20 5c e7 jsr $e75c jsr print2byte
.e66e 20 4f e7 jsr $e74f jsr print_cr
.e671 38 sec sec
.e672 a5 11 lda $11 lda itempl
.e674 e5 79 sbc $79 sbc smeml
.e676 aa tax tax
.e677 a5 12 lda $12 lda itemph
.e679 e5 7a sbc $7a sbc smemh
.e67b 20 5c e7 jsr $e75c jsr print2byte
.e67e 20 4f e7 jsr $e74f jsr print_cr
.e681 60 rts rts
.e682 pload
.e682 20 98 e6 jsr $e698 jsr pscan
.e685 a5 11 lda $11 lda itempl
.e687 85 7b sta $7b sta svarl
.e689 85 7d sta $7d sta sarryl
.e68b 85 7f sta $7f sta earryl
.e68d a5 12 lda $12 lda itemph
.e68f 85 7c sta $7c sta svarh
.e691 85 7e sta $7e sta sarryh
.e693 85 80 sta $80 sta earryh
.e695 4c 14 c0 jmp $c014 JMP LAB_1319
.e698 pscan
.e698 a5 79 lda $79 lda smeml
.e69a 85 11 sta $11 sta itempl
.e69c a5 7a lda $7a lda smemh
.e69e 85 12 sta $12 sta itemph
.e6a0 a0 00 ldy #$00 pscan1 ldy #$00
.e6a2 b1 11 lda ($11),y lda (itempl),y
.e6a4 d0 13 bne $e6b9 bne pscan2
.e6a6 c8 iny iny
.e6a7 b1 11 lda ($11),y lda (itempl),y
.e6a9 d0 0e bne $e6b9 bne pscan2
.e6ab 18 clc clc
.e6ac a9 02 lda #$02 lda #$02
.e6ae 65 11 adc $11 adc itempl
.e6b0 85 11 sta $11 sta itempl
.e6b2 a9 00 lda #$00 lda #$00
.e6b4 65 12 adc $12 adc itemph
.e6b6 85 12 sta $12 sta itemph
.e6b8 60 rts rts
.e6b9 a0 00 ldy #$00 pscan2 ldy #$00
.e6bb b1 11 lda ($11),y lda (itempl),y
.e6bd aa tax tax
.e6be c8 iny iny
.e6bf b1 11 lda ($11),y lda (itempl),y
.e6c1 85 12 sta $12 sta itemph
.e6c3 86 11 stx $11 stx itempl
.e6c5 80 d9 bra $e6a0 bra pscan1
.e6c7 4c 38 e8 jmp $e838 Start_OS jmp MonitorBoot ; easy access to monitor program
.e6ca 4c 4f e7 jmp $e74f Jmp_CR jmp Print_CR
.e6cd 4c 80 e7 jmp $e780 Jmp_1sp jmp Print1SP ; jump table for usable monitor
.e6d0 4c 7d e7 jmp $e77d Jmp_2sp jmp Print2SP ; routines
.e6d3 4c 78 e7 jmp $e778 Jmp_xsp jmp PrintXSP ; This will not change in future
.e6d6 4c 69 e7 jmp $e769 Jmp_nib jmp PrintDig ; releases, only be added to
.e6d9 4c 60 e7 jmp $e760 Jmp_byte jmp Print1Byte
.e6dc 4c 5c e7 jmp $e75c jmp_wrd jmp Print2Byte
.e6df 4c fe e7 jmp $e7fe jmp_bell jmp Bell
.e6e2 4c 03 e8 jmp $e803 jmp_delay jmp Delay
.e6e5 4c f8 e7 jmp $e7f8 jmp_scan jmp Scan_input
.e6e8 4c f5 e7 jmp $e7f5 jmp_inp jmp Input_chr
.e6eb 4c fb e7 jmp $e7fb jmp_out jmp Output
.e6ee 4c 88 e7 jmp $e788 jmp_input jmp Input
.e6f1 4c 8c e7 jmp $e78c jmp_input1 jmp Input1
>e6f4 20 50 43 3d 20 20 41 3d 20 20 58 3d 20 20 59 3d 20 20 53 3d 20 20 50 3d 20 28 4e 56 52 42 44 49 5a 43 29 3d RegData .byte" PC= A= X= Y= S= P= (NVRBDIZC)="
.e718 20 4f e7 jsr $e74f PrintReg Jsr Print_CR ; Lead with a CR
.e71b a2 ff ldx #$ff ldx #$ff ;
.e71d a0 ff ldy #$ff ldy #$ff ;
.e71f c8 iny Printreg1 iny ;
.e720 b9 f4 e6 lda $e6f4,y lda Regdata,y ;
.e723 20 fb e7 jsr $e7fb jsr Output ;
.e726 c9 3d cmp #$3d cmp #$3D ; "="
.e728 d0 f5 bne $e71f bne Printreg1 ;
.e72a e8 inx Printreg2 inx ;
.e72b e0 07 cpx #$07 cpx #$07 ;
.e72d f0 0c beq $e73b beq Printreg3 ; done with first 6
.e72f bd e0 03 lda $03e0,x lda PCH,x ;
.e732 20 60 e7 jsr $e760 jsr Print1Byte ;
.e735 e0 00 cpx #$00 cpx #$00 ;
.e737 d0 e6 bne $e71f bne Printreg1 ;
.e739 80 ef bra $e72a bra Printreg2 ;
.e73b ca dex Printreg3 dex ;
.e73c bd e0 03 lda $03e0,x lda PCH,x ; get Preg
.e73f a2 08 ldx #$08 ldx #$08 ;
.e741 2a rol Printreg4 rol ;
.e742 a8 tay tay ;
.e743 a9 31 lda #$31 lda #$31 ;
.e745 b0 01 bcs $e748 bcs Printreg5 ;
.e747 3a dec dec ;
.e748 20 fb e7 jsr $e7fb Printreg5 jsr Output ;
.e74b 98 tya tya ;
.e74c ca dex dex ;
.e74d d0 f2 bne $e741 bne Printreg4 ;
.e74f 48 pha Print_CR PHA ; Save Acc
.e750 a9 0d lda #$0d LDA #$0D ; "cr"
.e752 20 fb e7 jsr $e7fb JSR OUTPUT ; send it
.e755 a9 0a lda #$0a LDA #$0A ; "lf"
.e757 20 fb e7 jsr $e7fb JSR OUTPUT ; send it
.e75a 68 pla PLA ; Restore Acc
.e75b 60 rts RTS ;
.e75c 20 60 e7 jsr $e760 Print2Byte JSR Print1Byte ; prints AAXX hex digits
.e75f 8a txa TXA ;
.e760 48 pha Print1Byte PHA ; prints AA hex digits
.e761 4a lsr LSR ; MOVE UPPER NIBBLE TO LOWER
.e762 4a lsr LSR ;
.e763 4a lsr LSR ;
.e764 4a lsr LSR ;
.e765 20 69 e7 jsr $e769 JSR PrintDig ;
.e768 68 pla PLA ;
.e769 5a phy PrintDig PHY ; prints A hex nibble (low 4 bits)
.e76a 29 0f and #$0f AND #$0F ;
.e76c a8 tay TAY ;
.e76d b9 f8 ee lda $eef8,y LDA Hexdigdata,Y ;
.e770 7a ply PLY ;
.e771 4c fb e7 jmp $e7fb jmp output ;
.e774 20 80 e7 jsr $e780 PrintXSP1 JSR Print1SP ;
.e777 ca dex dex ;
.e778 e0 00 cpx #$00 PrintXSP cpx #$00 ;
.e77a d0 f8 bne $e774 bne PrintXSP1 ;
.e77c 60 rts rts ;
.e77d 20 80 e7 jsr $e780 Print2SP jsr Print1SP ; print 2 SPACES
.e780 a9 20 lda #$20 Print1SP LDA #$20 ; print 1 SPACE
.e782 4c fb e7 jmp $e7fb JMP OUTPUT ;
.e785 a9 21 lda #$21 Input_Assem lda #$21 ; Assembler Prompt "!"
>e787 2c .byte $2c ; mask out next line to bypass
.e788 a9 3e lda #$3e Input lda #$3E ; Monitor Prompt ">"
.e78a 85 32 sta $32 sta Prompt ; save prompt chr
.e78c 20 4f e7 jsr $e74f Input1 jsr Print_CR ; New Line
.e78f a5 32 lda $32 lda Prompt ; get prompt
.e791 20 fb e7 jsr $e7fb jsr Output ; Print Prompt
.e794 a0 ff ldy #$ff ldy #$ff ; pointer
.e796 20 f5 e7 jsr $e7f5 InputWait jsr Input_Chr ; get a character
.e799 c9 20 cmp #$20 cmp #$20 ; is ctrl char?
.e79b b0 3d bcs $e7da BCS InputSave ; no, echo chr
.e79d c9 0d cmp #$0d cmp #$0d ; cr
.e79f f0 4a beq $e7eb Beq InputDone ; done
.e7a1 c9 1b cmp #$1b cmp #$1B ; esc
.e7a3 f0 e7 beq $e78c beq Input1 ; cancel and new line
.e7a5 c9 08 cmp #$08 cmp #$08 ; bs
.e7a7 f0 09 beq $e7b2 beq backspace ;
.e7a9 c9 09 cmp #$09 cmp #$09 ; TAB key
.e7ab f0 1b beq $e7c8 beq tabkey ;
.e7ad c9 02 cmp #$02 cmp #$02 ; Ctrl-B
.e7af d0 e5 bne $e796 bne InputWait ; Ignore other codes
.e7b1 00 brk brk ; Force a keyboard Break cmd
.e7b2 c0 ff cpy #$ff backspace cpy #$ff ;
.e7b4 f0 e0 beq $e796 beq InputWait ; nothing to do
.e7b6 88 dey dey ; remove last char
.e7b7 a9 08 lda #$08 Lda #$08 ; backup one space
.e7b9 20 fb e7 jsr $e7fb jsr Output ;
.e7bc a9 20 lda #$20 Lda #$20 ; Print space (destructive BS)
.e7be 20 fb e7 jsr $e7fb jsr Output ;
.e7c1 a9 08 lda #$08 Lda #$08 ; backup one space
.e7c3 20 fb e7 jsr $e7fb jsr Output ;
.e7c6 80 ce bra $e796 BRA InputWait ; ready for next key
.e7c8 a9 20 lda #$20 tabkey lda #$20 ; convert tab to space
.e7ca c8 iny iny ; move cursor
.e7cb 30 1f bmi $e7ec bmi InputTooLong ; line too long?
.e7cd 99 00 03 sta $0300,y sta Buffer,y ; no, save space in buffer
.e7d0 20 fb e7 jsr $e7fb jsr output ; print the space too
.e7d3 98 tya tya ; test to see if tab is on multiple of 8
.e7d4 29 07 and #$07 and #$07 ; mask remainder of cursor/8
.e7d6 d0 f0 bne $e7c8 bne tabkey ; not done, add another space
.e7d8 80 bc bra $e796 bra InputWait ; done.
.e7da c9 61 cmp #$61 InputSave CMP #$61 ; ucase
.e7dc 90 02 bcc $e7e0 BCC InputSave1 ;
.e7de e9 20 sbc #$20 SBC #$20 ;
.e7e0 c8 iny InputSave1 INY ;
.e7e1 30 09 bmi $e7ec BMI InputTooLong ; get next char (up to 127)
.e7e3 99 00 03 sta $0300,y STA Buffer,y ;
.e7e6 20 fb e7 jsr $e7fb JSR Output ; OutputCharacter
.e7e9 80 ab bra $e796 BRA InputWait ;
.e7eb c8 iny InputDone INY ;
.e7ec a9 0d lda #$0d InputTooLong LDA #$0d ; force CR at end of 128 characters
.e7ee 99 00 03 sta $0300,y sta Buffer,y ;
.e7f1 20 fb e7 jsr $e7fb JSR Output ;
.e7f4 60 rts RTS ;
.e7f5 6c eb 03 jmp ($03eb) Input_chr jmp (ChrInVect) ;
.e7f8 6c ee 03 jmp ($03ee) Scan_input jmp (ScanInVect) ;
.e7fb 6c f1 03 jmp ($03f1) Output jmp (ChrOutVect) ;
.e7fe a9 07 lda #$07 bell LDA #$07 ; Ctrl G Bell
.e800 4c fb e7 jmp $e7fb jmp Output ;
.e803 48 pha Delay PHA ; use A to execute a delay loop
.e804 3a dec delay1 DEC ;
.e805 d0 fd bne $e804 BNE delay1 ;
.e807 68 pla PLA ;
.e808 3a dec DEC ;
.e809 d0 f8 bne $e803 BNE Delay ;
.e80b 60 rts GRTS RTS ;
.e80c 8d e2 03 sta $03e2 BRKroutine sta ACC ; save A Monitor"s break handler
.e80f 8e e3 03 stx $03e3 stx Xreg ; save X
.e812 8c e4 03 sty $03e4 sty Yreg ; save Y
.e815 68 pla pla ;
.e816 8d e6 03 sta $03e6 sta Preg ; save P
.e819 68 pla pla ; PCL
.e81a fa plx plx ; PCH
.e81b 38 sec sec ;
.e81c e9 02 sbc #$02 sbc #$02 ;
.e81e 8d e1 03 sta $03e1 sta PCL ; backup to BRK cmd
.e821 b0 01 bcs $e824 bcs Brk2 ;
.e823 ca dex dex ;
.e824 8e e0 03 stx $03e0 Brk2 stx PCH ; save PC
.e827 ba tsx TSX ; get stack pointer
.e828 8e e5 03 stx $03e5 stx SPtr ; save stack pointer
.e82b 20 fe e7 jsr $e7fe jsr Bell ; Beep speaker
.e82e 20 18 e7 jsr $e718 jsr PrintReg ; dump register contents
.e831 a2 ff ldx #$ff ldx #$FF ;
.e833 9a txs txs ; clear stack
.e834 58 cli cli ; enable interrupts again
.e835 4c 3e e8 jmp $e83e jmp Monitor ; start the monitor
.e838 monitorboot
.e838 20 fe e7 jsr $e7fe jsr bell ; beep ready
.e83b 20 b3 e8 jsr $e8b3 JSR Version ;
.e83e sysjmp
.e83e a2 ff ldx #$ff Monitor LDX #$FF ;
.e840 9a txs TXS ; Init the stack
.e841 20 88 e7 jsr $e788 JSR input ; line input
.e844 a9 00 lda #$00 LDA #$00 ;
.e846 a8 tay TAY ; set to 1st character in line
.e847 85 33 sta $33 sta LineCnt ; normal list vs range list
.e849 85 37 sta $37 Mon01 STA Memchr ;
.e84b 64 3c stz $3c Mon02 STZ Hexdigits ; holds parsed hex
.e84d 64 3d stz $3d STZ Hexdigits+1 ;
.e84f 20 74 e8 jsr $e874 JSR ParseHexDig ; Get any Hex chars
.e852 a2 13 ldx #$13 LDX #CmdCount ; get # of cmds currently used
.e854 dd 08 ef cmp $ef08,x Mon08 CMP CmdAscii,X ; is non hex cmd chr?
.e857 f0 05 beq $e85e BEQ Mon09 ; yes x= cmd number
.e859 ca dex DEX ;
.e85a 10 f8 bpl $e854 BPL Mon08 ;
.e85c 80 e0 bra $e83e BRA Monitor ; no
.e85e da phx Mon09 PHX ; save command
.e85f 5a phy PHY ; Save input line pointer
.e860 8a txa TXA ;
.e861 0a asl ASL ; ptr * 2
.e862 aa tax TAX ;
.e863 20 71 e8 jsr $e871 JSR Mon10 ; Execute cmd
.e866 7a ply PLY ;
.e867 fa plx PLX ;
.e868 f0 d4 beq $e83e BEQ Monitor ; done
.e86a bd 44 ef lda $ef44,x LDA Cmdseccode,X ;
.e86d 30 dc bmi $e84b BMI Mon02 ;
.e86f 80 d8 bra $e849 BRA Mon01 ;
.e871 7c 1c ef jmp ($ef1c,x) Mon10 JMP (Cmdjmptbl,X) ;
.e874 64 35 stz $35 ParseHexDig STZ Hexdigcnt ; cntr
.e876 80 0e bra $e886 BRA ParseHex05 ;
.e878 8a txa ParseHex03 TXA ; parse hex dig
.e879 a2 04 ldx #$04 LDX #$04 ;
.e87b 06 3c asl $3c ParseHex04 ASL Hexdigits ;
.e87d 26 3d rol $3d ROL Hexdigits+1 ;
.e87f ca dex DEX ;
.e880 d0 f9 bne $e87b BNE ParseHex04 ;
.e882 04 3c tsb $3c TSB Hexdigits ;
.e884 c6 35 dec $35 DEC Hexdigcnt ;
.e886 b9 00 03 lda $0300,y ParseHex05 LDA buffer,Y ;
.e889 a2 0f ldx #$0f LDX #$0F ; is hex chr?
.e88b c8 iny INY ;
.e88c dd f8 ee cmp $eef8,x ParseHex07 CMP Hexdigdata,X ;
.e88f f0 e7 beq $e878 BEQ ParseHex03 ; yes
.e891 ca dex DEX ;
.e892 10 f8 bpl $e88c BPL ParseHex07 ;
.e894 60 rts RTS ; Stored in HexDigits if HexDigCnt <> 0
.e895 a9 76 lda #$76 Help_cmd lda #<Helptxt ; lower byte - Menu of Commands
.e897 85 3a sta $3a sta addrptr ;
.e899 a9 f2 lda #$f2 lda #>Helptxt ; upper byte
.e89b 85 3b sta $3b sta addrptr+1 ;
.e89d 80 0f bra $e8ae bra Help_cmd3 ;
.e89f c9 7e cmp #$7e Help_Cmd4 cmp #$7e ; "~"
.e8a1 f0 05 beq $e8a8 beq Help_Cmd1 ;
.e8a3 20 fb e7 jsr $e7fb jsr Output ;
.e8a6 80 03 bra $e8ab bra Help_cmd2 ;
.e8a8 20 4f e7 jsr $e74f Help_cmd1 jsr Print_CR ;
.e8ab 20 65 e9 jsr $e965 Help_cmd2 jsr Inc_addrptr ;
.e8ae b2 3a lda ($3a) Help_cmd3 lda (addrptr) ;
.e8b0 d0 ed bne $e89f bne Help_cmd4 ;
.e8b2 60 rts rts ;
.e8b3 20 4f e7 jsr $e74f Version jsr Print_CR ;
.e8b6 a2 ff ldx #$ff ldx #$FF ; set txt pointer
.e8b8 a9 0d lda #$0d lda #$0d ;
.e8ba e8 inx PortReadyMsg inx ;
.e8bb 20 fb e7 jsr $e7fb JSR Output ; put character to Port
.e8be bd 9c f8 lda $f89c,x lda porttxt,x ; get message text
.e8c1 d0 f7 bne $e8ba bne PortReadyMsg ;
.e8c3 60 rts rts ;
.e8c4 20 cd e8 jsr $e8cd Excute_cmd jsr exe1 ;
.e8c7 a2 ff ldx #$ff ldx #$FF ; reset stack
.e8c9 9a txs txs ;
.e8ca 4c 3e e8 jmp $e83e jmp Monitor ;
.e8cd 6c 3c 00 jmp ($003c) exe1 JMP (Hexdigits) ;
.e8d0 a6 3c ldx $3c DOT_cmd LDX Hexdigits ; move address to addrptr
.e8d2 a5 3d lda $3d LDA Hexdigits+1 ;
.e8d4 86 3a stx $3a STX Addrptr ;
.e8d6 85 3b sta $3b STA Addrptr+1 ;
.e8d8 e6 33 inc $33 inc LineCnt ; range list command
.e8da 60 rts RTS ;
.e8db c0 01 cpy #$01 CR_cmd CPY #$01 ;
.e8dd d0 0c bne $e8eb BNE SP_cmd ;
.e8df a5 3a lda $3a LDA Addrptr ; CR alone - move addrptr to hexdigits
.e8e1 09 0f ora #$0f ORA #$0F ; to simulate entering an address
.e8e3 85 3c sta $3c STA Hexdigits ; *** change 07 to 0f for 16 byte/line
.e8e5 a5 3b lda $3b LDA Addrptr+1 ;
.e8e7 85 3d sta $3d STA Hexdigits+1 ;
.e8e9 80 17 bra $e902 BRA SP_cmd2 ;
.e8eb a5 35 lda $35 SP_cmd LDA Hexdigcnt ; Space command entry
.e8ed f0 5a beq $e949 BEQ SP_cmd5 ; any digits to process? no - done
.e8ef a6 37 ldx $37 LDX Memchr ; yes - is sec cmd code 0 ? yes -
.e8f1 f0 0a beq $e8fd BEQ SP_cmd1 ; yes -
.e8f3 ca dex DEX ; Is sec cmd = 1?
.e8f4 f0 1c beq $e912 BEQ SP_cmd3 ; yes - is sec cmd code 1 ?
.e8f6 a5 3c lda $3c LDA Hexdigits ; no - ":" cmd processed
.e8f8 92 3a sta ($3a) STA (Addrptr) ;
.e8fa 4c 65 e9 jmp $e965 JMP Inc_addrptr ; set to next address and return
.e8fd 20 d0 e8 jsr $e8d0 SP_cmd1 JSR DOT_cmd ; sec dig = 0 move address to addrptr
.e900 80 10 bra $e912 BRA SP_cmd3 ;
.e902 a5 3a lda $3a SP_cmd2 LDA Addrptr ; CR cmd entry
.e904 89 0f bit #$0f BIT #$0F ; *** changed 07 to 0F for 16 bytes/line
.e906 f0 0a beq $e912 BEQ SP_cmd3 ; if 16, print new line
.e908 c0 00 cpy #$00 cpy #$00 ; if TXT cmd, don"t print the - or spaces between chrs
.e90a f0 46 beq $e952 beq TXT_cmd1 ;
.e90c 89 07 bit #$07 BIT #$07 ; if 8, print -
.e90e f0 11 beq $e921 BEQ SP_cmd33 ;
.e910 80 19 bra $e92b BRA SP_cmd4 ; else print next byte
.e912 20 4f e7 jsr $e74f SP_cmd3 JSR Print_CR ; "." cmd - display address and data
.e915 20 f8 e7 jsr $e7f8 jsr Scan_Input ; see if brk requested
.e918 b0 2d bcs $e947 bcs SP_brk ; if so, stop
.e91a a5 3b lda $3b LDA Addrptr+1 ; print address
.e91c a6 3a ldx $3a LDX Addrptr ;
.e91e 20 5c e7 jsr $e75c JSR Print2Byte ;
.e921 a9 20 lda #$20 SP_cmd33 LDA #$20 ; " " print 1 - 16 bytes of data
.e923 20 fb e7 jsr $e7fb JSR OUTPUT ;
.e926 a9 2d lda #$2d LDA #$2D ; "-"
.e928 20 fb e7 jsr $e7fb JSR OUTPUT ;
.e92b a9 20 lda #$20 SP_cmd4 LDA #$20 ; " "
.e92d 20 fb e7 jsr $e7fb JSR OUTPUT ;
.e930 c0 00 cpy #$00 cpy #$00 ;
.e932 f0 1e beq $e952 beq TXT_Cmd1 ;
.e934 b2 3a lda ($3a) LDA (Addrptr) ;
.e936 20 60 e7 jsr $e760 JSR Print1Byte ;
.e939 38 sec SP_cmd44 SEC ; checks if range done
.e93a a5 3a lda $3a LDA Addrptr ;
.e93c e5 3c sbc $3c SBC Hexdigits ;
.e93e a5 3b lda $3b LDA Addrptr+1 ;
.e940 e5 3d sbc $3d SBC Hexdigits+1 ;
.e942 20 65 e9 jsr $e965 jsr Inc_addrptr ;
.e945 90 bb bcc $e902 BCC SP_cmd2 ; loop until range done
.e947 64 37 stz $37 SP_brk STZ Memchr ; reset sec cmd code
.e949 60 rts SP_cmd5 RTS ; done or no digits to process
.e94a 5a phy TXT_Cmd PHY ;
.e94b a0 00 ldy #$00 ldy #$00 ;
.e94d 20 eb e8 jsr $e8eb jsr SP_cmd ;
.e950 7a ply PLY ;
.e951 60 rts RTS ;
.e952 b2 3a lda ($3a) TXT_cmd1 LDA (Addrptr) ;
.e954 29 7f and #$7f AND #$7F ;
.e956 c9 7f cmp #$7f CMP #$7F ;
.e958 f0 04 beq $e95e BEQ TXT_Cmd2 ;
.e95a c9 20 cmp #$20 CMP #$20 ; " "
.e95c b0 02 bcs $e960 BCS TXT_Cmd3 ;
.e95e a9 2e lda #$2e TXT_Cmd2 LDA #$2E ; "." use "." if not printable char
.e960 20 fb e7 jsr $e7fb TXT_Cmd3 JSR OUTPUT ;
.e963 80 d4 bra $e939 BRA SP_cmd44 ;
.e965 e6 3a inc $3a Inc_addrptr INC Addrptr ; increments addrptr
.e967 d0 02 bne $e96b BNE Inc_addr1 ;
.e969 e6 3b inc $3b INC Addrptr+1 ;
.e96b 60 rts Inc_addr1 RTS ;
.e96c a5 33 lda $33 Insert_cmd lda Linecnt ; "I" cmd code
.e96e f0 3e beq $e9ae beq Insert_3 ; abort if no . cmd entered
.e970 38 sec sec ;
.e971 a5 3c lda $3c lda Hexdigits ;
.e973 e5 3a sbc $3a sbc addrptr ;
.e975 aa tax tax ;
.e976 a5 3d lda $3d lda Hexdigits+1 ;
.e978 e5 3b sbc $3b sbc addrptr+1 ;
.e97a a8 tay tay ;
.e97b 90 31 bcc $e9ae bcc Insert_3 ;
.e97d 18 clc clc ;
.e97e 8a txa txa ;
.e97f 65 3e adc $3e adc memptr ;
.e981 85 3c sta $3c sta hexdigits ;
.e983 98 tya tya ;
.e984 65 3f adc $3f adc memptr+1 ;
.e986 85 3d sta $3d sta hexdigits+1 ;
.e988 b2 3e lda ($3e) Insert_0 LDA (memptr) ;
.e98a 92 3c sta ($3c) STA (Hexdigits) ;
.e98c a9 ff lda #$ff lda #$FF ;
.e98e c6 3c dec $3c DEC Hexdigits ;
.e990 c5 3c cmp $3c cmp Hexdigits ;
.e992 d0 02 bne $e996 BNE Insert_1 ;
.e994 c6 3d dec $3d DEC Hexdigits+1 ;
.e996 c6 3e dec $3e Insert_1 dec Memptr ;
.e998 c5 3e cmp $3e cmp Memptr ;
.e99a d0 02 bne $e99e bne Insert_2 ;
.e99c c6 3f dec $3f dec Memptr+1 ;
.e99e 38 sec Insert_2 SEC ;
.e99f a5 3e lda $3e LDA memptr ;
.e9a1 e5 3a sbc $3a SBC Addrptr ;
.e9a3 a5 3f lda $3f LDA memptr+1 ;
.e9a5 e5 3b sbc $3b SBC Addrptr+1 ;
.e9a7 90 05 bcc $e9ae bcc Insert_3 ;
.e9a9 20 f8 e7 jsr $e7f8 jsr Scan_Input ; see if brk requested
.e9ac 90 da bcc $e988 bcc Insert_0 ; if so, stop List
.e9ae 60 rts Insert_3 RTS ;
.e9af a5 33 lda $33 Move_cmd lda Linecnt ; *** any changes to this routine affect EEPROM_WR too!!!
.e9b1 d0 0d bne $e9c0 bne Move_cmd3 ; abort if no . cmd was used
.e9b3 60 rts Move_brk RTS ;
.e9b4 e6 3a inc $3a Move_cmd1 INC Addrptr ; increments addrptr
.e9b6 d0 02 bne $e9ba BNE Move_cmd2 ;
.e9b8 e6 3b inc $3b INC Addrptr+1 ;
.e9ba e6 3c inc $3c Move_cmd2 inc Hexdigits ; "M" cmd code
.e9bc d0 02 bne $e9c0 bne Move_cmd3 ;
.e9be e6 3d inc $3d inc Hexdigits+1 ;
.e9c0 38 sec Move_cmd3 SEC ; checks if range done
.e9c1 a5 3e lda $3e LDA Memptr ;
.e9c3 e5 3a sbc $3a SBC Addrptr ;
.e9c5 a5 3f lda $3f LDA Memptr+1 ;
.e9c7 e5 3b sbc $3b SBC Addrptr+1 ;
.e9c9 90 e8 bcc $e9b3 BCC Move_brk ; exit if range done
.e9cb 20 f8 e7 jsr $e7f8 jsr Scan_Input ; see if brk requested
.e9ce b0 e3 bcs $e9b3 bcs Move_brk ;
.e9d0 b2 3a lda ($3a) LDA (Addrptr) ; Moves one byte
.e9d2 92 3c sta ($3c) STA (Hexdigits) ;
.e9d4 80 de bra $e9b4 BRA Move_cmd1 ; (zapped after move from eeprom_wr)
.e9d6 b2 3a lda ($3a) EEPROM_TEST lda (Addrptr) ; moved along with Move_cmd for EEPROM_WR
.e9d8 52 3c eor ($3c) eor (Hexdigits) ; ""
.e9da 30 fa bmi $e9d6 bmi EEPROM_TEST ; ""
.e9dc 80 d6 bra $e9b4 bra Move_cmd1 ; ""
.e9de a5 3a lda $3a EEPROM_WR lda Addrptr ; move the Move_cmd sub to $0280 (kybrd buffer)
.e9e0 48 pha pha ; adding EEPROM test routine
.e9e1 a5 3b lda $3b lda Addrptr+1 ; then run the burn program from RAM
.e9e3 48 pha pha ;
.e9e4 a9 af lda #$af lda #<Move_cmd ;
.e9e6 85 3a sta $3a sta Addrptr ;
.e9e8 a9 e9 lda #$e9 lda #>Move_cmd ;
.e9ea 85 3b sta $3b sta Addrptr+1 ;
.e9ec a0 2e ldy #$2e ldy #$2E ; 47 instructions
.e9ee b1 3a lda ($3a),y EEPROM_WR1 lda (Addrptr),y ;
.e9f0 99 80 02 sta $0280,y sta $0280,y ;
.e9f3 88 dey dey ;
.e9f4 10 f8 bpl $e9ee bpl EEPROM_WR1 ;
.e9f6 a9 ea lda #$ea lda #$EA ; NOP instruction
.e9f8 8d a5 02 sta $02a5 sta $02A5 ; *
.e9fb 8d a6 02 sta $02a6 sta $02A6 ; * affected by changes to Move_cmd routine
.e9fe 8d 9c 02 sta $029c sta $029C ; * affected by changes to Move_cmd routine
.ea01 8d 9d 02 sta $029d sta $029D ; * affected by changes to Move_cmd routine
.ea04 8d 9e 02 sta $029e sta $029E ; * affected by changes to Move_cmd routine
.ea07 8d 9f 02 sta $029f sta $029F ; * affected by changes to Move_cmd routine
.ea0a 8d a0 02 sta $02a0 sta $02A0 ; * affected by changes to Move_cmd routine
.ea0d 68 pla pla ;
.ea0e 85 3b sta $3b sta Addrptr+1 ;
.ea10 68 pla pla ;
.ea11 85 3a sta $3a sta Addrptr ;
.ea13 4c 80 02 jmp $0280 jmp $0280 ;
.ea16 a6 3c ldx $3c Dest_cmd LDX Hexdigits ; ">" cmd code
.ea18 a5 3d lda $3d LDA Hexdigits+1 ;
.ea1a 86 3e stx $3e STX Memptr ; move address to memptr
.ea1c 85 3f sta $3f STA Memptr+1 ;
.ea1e 60 rts RTS ;
.ea1f a5 33 lda $33 LIST_cmd lda LineCnt ; Check for normal/range
.ea21 f0 29 beq $ea4c beq List_cmd_1 ; 0 = normal 1=range
.ea23 a5 3a lda $3a LDA Addrptr ; Dissassemble range of code
.ea25 a6 3b ldx $3b LDX Addrptr+1 ; move addrptr to startaddr
.ea27 85 38 sta $38 STA Startaddr ;
.ea29 86 39 stx $39 STX Startaddr+1 ;
.ea2b 38 sec List_range sec ;
.ea2c a5 38 lda $38 lda Startaddr ;
.ea2e e5 3a sbc $3a sbc Addrptr ;
.ea30 a5 39 lda $39 lda Startaddr+1 ;
.ea32 e5 3b sbc $3b sbc Addrptr+1 ;
.ea34 90 15 bcc $ea4b bcc List_done ;
.ea36 20 64 ea jsr $ea64 jsr List_Line ; list one line
.ea39 20 f8 e7 jsr $e7f8 jsr Scan_Input ; see if brk requested
.ea3c b0 0d bcs $ea4b bcs List_done ; if so, stop List
.ea3e 38 sec SEC ; checks if range done
.ea3f a5 3c lda $3c LDA Hexdigits ;
.ea41 e5 38 sbc $38 SBC Startaddr ;
.ea43 a5 3d lda $3d LDA Hexdigits+1 ;
.ea45 e5 39 sbc $39 SBC Startaddr+1 ;
.ea47 b0 e2 bcs $ea2b BCS List_range ; if not, loop until done
.ea49 64 33 stz $33 stz LineCnt ;
.ea4b 60 rts List_done RTS ;
.ea4c a5 35 lda $35 List_cmd_1 LDA Hexdigcnt ; Dissassemble one page of cmds
.ea4e f0 08 beq $ea58 BEQ List1 ; followed with more pages
.ea50 a6 3c ldx $3c LDX Hexdigits ;
.ea52 a5 3d lda $3d LDA Hexdigits+1 ;
.ea54 86 38 stx $38 STX Startaddr ;
.ea56 85 39 sta $39 STA Startaddr+1 ;
.ea58 a9 14 lda #$14 List1 LDA #$14 ; one page of dissassembly
.ea5a 85 33 sta $33 STA Linecnt ;
.ea5c 20 64 ea jsr $ea64 List2 JSR List_line ;
.ea5f c6 33 dec $33 DEC Linecnt ;
.ea61 d0 f9 bne $ea5c BNE List2 ;
.ea63 60 rts RTS ;
.ea64 20 4f e7 jsr $e74f List_line JSR Print_CR ;
.ea67 20 76 ea jsr $ea76 JSR List_one ; one line of dissassembly
.ea6a 18 clc CLC ;
.ea6b a5 38 lda $38 LDA Startaddr ; inc address pointer to next cmd
.ea6d 65 35 adc $35 ADC Hexdigcnt ;
.ea6f 85 38 sta $38 STA Startaddr ;
.ea71 90 02 bcc $ea75 BCC List3 ;
.ea73 e6 39 inc $39 INC Startaddr+1 ;
.ea75 60 rts List3 RTS ;
.ea76 b2 38 lda ($38) List_one LDA (Startaddr) ; Dissassemble one CMD from Startaddr
.ea78 aa tax TAX ; Initialize List Cmd pointers
.ea79 bd 58 ef lda $ef58,x LDA OPCtxtidx,X ;
.ea7c 85 36 sta $36 STA OPCtxtptr ;
.ea7e bd 58 f0 lda $f058,x LDA OPCaddmode,X ;
.ea81 29 0f and #$0f AND #$0F ; mask out psuedo-modes
.ea83 85 34 sta $34 STA Modejmp ;
.ea85 aa tax TAX ;
.ea86 bd 58 f1 lda $f158,x LDA ModeByteCnt,X ;
.ea89 85 35 sta $35 STA Hexdigcnt ;
.ea8b a5 39 lda $39 LDA Startaddr+1 ;
.ea8d a6 38 ldx $38 LDX Startaddr ;
.ea8f 20 5c e7 jsr $e75c JSR Print2Byte ; print address
.ea92 a9 2d lda #$2d LDA #$2D ; "-"
.ea94 20 fb e7 jsr $e7fb JSR OUTPUT ;
.ea97 20 7d e7 jsr $e77d JSR Print2SP ; print " "
.ea9a a2 01 ldx #$01 LDX #$01 ;---------
.ea9c a0 00 ldy #$00 List4 LDY #$00 ;print up to 3 ascii chars...
.ea9e c4 35 cpy $35 List5 CPY Hexdigcnt ; two spaces...
.eaa0 b0 0b bcs $eaad BCS List6 ; up to three hex chars...
.eaa2 b1 38 lda ($38),y LDA (Startaddr),Y ; two spaces
.eaa4 e0 00 cpx #$00 CPX #$00 ;
.eaa6 d0 0e bne $eab6 BNE List8 ;
.eaa8 20 60 e7 jsr $e760 JSR Print1Byte ;
.eaab 80 07 bra $eab4 BRA List7 ;
.eaad e0 00 cpx #$00 List6 CPX #$00 ;
.eaaf d0 03 bne $eab4 BNE List7 ;
.eab1 20 7d e7 jsr $e77d JSR Print2SP ;
.eab4 a9 20 lda #$20 List7 LDA #$20 ; " "
.eab6 29 7f and #$7f List8 AND #$7F ;
.eab8 c9 7f cmp #$7f CMP #$7F ;
.eaba f0 04 beq $eac0 BEQ List9 ;
.eabc c9 20 cmp #$20 CMP #$20 ; " "
.eabe b0 02 bcs $eac2 BCS List10 ;
.eac0 a9 2e lda #$2e List9 LDA #$2E ; "." use "." if not printable char
.eac2 20 fb e7 jsr $e7fb List10 JSR OUTPUT ;
.eac5 c8 iny INY ;
.eac6 c0 03 cpy #$03 CPY #$03 ;
.eac8 90 d4 bcc $ea9e BCC List5 ;
.eaca 20 7d e7 jsr $e77d JSR Print2SP ;
.eacd ca dex DEX ;
.eace f0 cc beq $ea9c BEQ List4 ;---------
.ead0 a5 36 lda $36 LDA OPCtxtptr ; get opcode text
.ead2 0a asl ASL ;
.ead3 65 36 adc $36 ADC OPCtxtptr ;
.ead5 aa tax TAX ;
.ead6 a0 fd ldy #$fd LDY #$FD ;
.ead8 bd 98 f1 lda $f198,x List11 LDA OPCtxtData,X ;
.eadb 20 fb e7 jsr $e7fb JSR OUTPUT ; print opcode text
.eade e8 inx INX ;
.eadf c8 iny INY ;
.eae0 d0 f6 bne $ead8 BNE List11 ;
.eae2 a5 36 lda $36 LDA OPCtxtptr ;
.eae4 c9 42 cmp #$42 CMP #$42 ; 4chr opcodes start
.eae6 30 19 bmi $eb01 BMI List12 ;
.eae8 c9 46 cmp #$46 CMP #$46 ; the .xx cmds
.eaea 10 15 bpl $eb01 BPL List12 ;
.eaec b2 38 lda ($38) lda (startaddr) ; get opcode of 4byte code
.eaee 4a lsr lsr
.eaef 4a lsr lsr
.eaf0 4a lsr lsr
.eaf1 4a lsr lsr
.eaf2 29 07 and #$07 AND #$07 ; strip last 3 bits
.eaf4 09 30 ora #$30 ora #$30 ; add CHR '0'
.eaf6 20 fb e7 jsr $e7fb jsr Output ; print it
.eaf9 a9 20 lda #$20 lda #$20 ; " "
.eafb 20 fb e7 jsr $e7fb jsr Output ;
.eafe 4c 04 eb jmp $eb04 jmp List13 ;
.eb01 20 7d e7 jsr $e77d List12 JSR Print2SP ;
.eb04 a5 34 lda $34 List13 LDA Modejmp ; setup to print operand
.eb06 0a asl ASL ;
.eb07 aa tax TAX ;
.eb08 7c 68 f1 jmp ($f168,x) JMP (ModeJmpTbl,X) ; goto operand printing command
.eb0b a9 23 lda #$23 IMM_mode LDA #$23 ; print #$HH
.eb0d 20 fb e7 jsr $e7fb JSR output ;
.eb10 a9 24 lda #$24 ZP_mode LDA #$24 ; print $HH
.eb12 20 fb e7 jsr $e7fb JSR output ;
.eb15 a0 01 ldy #$01 LDY #$01 ;
.eb17 b1 38 lda ($38),y Byte_mode LDA (Startaddr),Y ;
.eb19 4c 60 e7 jmp $e760 JMP Print1Byte ;
.eb1c 20 10 eb jsr $eb10 ZP_X_mode JSR ZP_mode ; print $HH,X
.eb1f a9 2c lda #$2c X_mode LDA #$2C ; print ,X
.eb21 20 fb e7 jsr $e7fb JSR output ;
.eb24 a9 58 lda #$58 LDA #$58 ;
.eb26 4c fb e7 jmp $e7fb JMP output ;
.eb29 20 10 eb jsr $eb10 ZP_Y_mode JSR ZP_mode ; print $HH,Y
.eb2c a9 2c lda #$2c Y_mode LDA #$2C ; Print ,Y
.eb2e 20 fb e7 jsr $e7fb JSR output ;
.eb31 a9 59 lda #$59 LDA #$59 ;
.eb33 4c fb e7 jmp $e7fb JMP output ;
.eb36 20 7c eb jsr $eb7c INDZP_mode JSR IND0_mode ; Print ($HH)
.eb39 20 10 eb jsr $eb10 JSR ZP_mode ;
.eb3c a9 29 lda #$29 IND1_mode LDA #$29 ; Print )
.eb3e 4c fb e7 jmp $e7fb JMP output ;
.eb41 20 7c eb jsr $eb7c INDZP_X_mode JSR IND0_mode ; Print ($HH,X)
.eb44 20 10 eb jsr $eb10 JSR ZP_mode ;
.eb47 20 1f eb jsr $eb1f JSR X_mode ;
.eb4a 80 f0 bra $eb3c BRA IND1_mode ;
.eb4c 20 36 eb jsr $eb36 INDZP_Y_mode JSR INDZP_mode ; Print ($HH),Y
.eb4f 80 db bra $eb2c BRA Y_mode ;
.eb51 a9 24 lda #$24 ABS_mode LDA #$24 ; Print $HHHH
.eb53 20 fb e7 jsr $e7fb JSR output ;
.eb56 a0 02 ldy #$02 LDY #$02 ;
.eb58 20 17 eb jsr $eb17 JSR Byte_mode ;
.eb5b 88 dey DEY ;
.eb5c 80 b9 bra $eb17 BRA Byte_mode ;
.eb5e 20 51 eb jsr $eb51 ABS_X_mode JSR ABS_mode ; Print $HHHH,X
.eb61 80 bc bra $eb1f BRA X_mode ;
.eb63 20 51 eb jsr $eb51 ABS_Y_mode JSR ABS_mode ; Print $HHHH,Y
.eb66 80 c4 bra $eb2c BRA Y_mode ;
.eb68 20 7c eb jsr $eb7c INDABS_mode JSR IND0_mode ; Print ($HHHH)
.eb6b 20 51 eb jsr $eb51 JSR ABS_mode ;
.eb6e 80 cc bra $eb3c BRA IND1_mode ;
.eb70 20 7c eb jsr $eb7c INDABSX_mode JSR IND0_mode ; Print ($HHHH,X)
.eb73 20 51 eb jsr $eb51 JSR ABS_mode ;
.eb76 20 1f eb jsr $eb1f JSR X_mode ;
.eb79 80 c1 bra $eb3c BRA IND1_mode ;
.eb7b 60 rts IMPLIED_mode RTS ; Implied/Accumulator mode
.eb7c a9 28 lda #$28 IND0_mode LDA #$28 ; Print (
.eb7e 4c fb e7 jmp $e7fb JMP output ;
.eb81 20 10 eb jsr $eb10 BBREL_mode JSR ZP_mode ;
.eb84 a9 2c lda #$2c LDA #$2C ; Print ,
.eb86 20 fb e7 jsr $e7fb JSR output ;
.eb89 a9 24 lda #$24 LDA #$24 ; Print $
.eb8b 20 fb e7 jsr $e7fb JSR output ;
.eb8e a0 02 ldy #$02 LDY #$02 ;
.eb90 b1 38 lda ($38),y LDA (Startaddr),Y ;
.eb92 85 37 sta $37 STA Memchr ;
.eb94 18 clc CLC ;
.eb95 a5 38 lda $38 LDA Startaddr ;
.eb97 69 03 adc #$03 ADC #$03 ;
.eb99 4c ac eb jmp $ebac JMP REL_mode0 ;
.eb9c a9 24 lda #$24 REL_mode LDA #$24 ; Print $HHHH as Relative Branch
.eb9e 20 fb e7 jsr $e7fb JSR output ;
.eba1 a0 01 ldy #$01 LDY #$01 ;
.eba3 b1 38 lda ($38),y LDA (Startaddr),Y ;
.eba5 85 37 sta $37 STA Memchr ;
.eba7 18 clc CLC ;
.eba8 a5 38 lda $38 LDA Startaddr ;
.ebaa 69 02 adc #$02 ADC #$02 ;
.ebac aa tax REL_mode0 TAX ;
.ebad a5 39 lda $39 LDA Startaddr+1 ;
.ebaf 69 00 adc #$00 ADC #$00 ;
.ebb1 a8 tay TAY ;
.ebb2 18 clc CLC ;
.ebb3 8a txa TXA ;
.ebb4 65 37 adc $37 ADC Memchr ;
.ebb6 aa tax TAX ;
.ebb7 98 tya TYA ;
.ebb8 a4 37 ldy $37 LDY Memchr ;
.ebba 10 01 bpl $ebbd BPL Rel_mode1 ;
.ebbc 3a dec DEC ;
.ebbd 69 00 adc #$00 Rel_mode1 ADC #$00 ;
.ebbf 4c 5c e7 jmp $e75c JMP Print2Byte ;
.ebc2 ba tsx Assem_Init tsx ;
.ebc3 e8 inx inx ;
.ebc4 e8 inx inx ;
.ebc5 e8 inx inx ;
.ebc6 e8 inx inx ;
.ebc7 9e 00 01 stz $0100,x stz $0100,x ;
.ebca 20 b3 e8 jsr $e8b3 jsr version ; show version and ? prompt
.ebcd 4c f0 eb jmp $ebf0 jmp Assembler ;
.ebd0 a9 de lda #$de Asm_Help lda #<AsmHelptxt ; lower byte - Menu of Commands
.ebd2 85 3a sta $3a sta addrptr ;
.ebd4 a9 f6 lda #$f6 lda #>AsmHelptxt ; upper byte
.ebd6 85 3b sta $3b sta addrptr+1 ;
.ebd8 80 0f bra $ebe9 bra AsmHelp3 ;
.ebda c9 7e cmp #$7e ASmHelp4 cmp #$7e ; "~"
.ebdc f0 05 beq $ebe3 beq AsmHelp1 ;
.ebde 20 fb e7 jsr $e7fb jsr Output ;
.ebe1 80 03 bra $ebe6 bra AsmHelp2 ;
.ebe3 20 4f e7 jsr $e74f AsmHelp1 jsr Print_CR ;
.ebe6 20 65 e9 jsr $e965 AsmHelp2 jsr Inc_addrptr ;
.ebe9 b2 3a lda ($3a) AsmHelp3 lda (addrptr) ;
.ebeb d0 ed bne $ebda bne AsmHelp4 ;
.ebed 20 be ee jsr $eebe jsr Opcode_List ;
.ebf0 a2 ff ldx #$ff Assembler LDX #$FF ;
.ebf2 9a txs TXS ; init stack
.ebf3 64 35 stz $35 stz HexDigCnt ;
.ebf5 20 85 e7 jsr $e785 jsr Input_assem ;
.ebf8 a0 00 ldy #$00 ldy #$00 ; beginning of input line
.ebfa ad 00 03 lda $0300 lda buffer ;
.ebfd c9 0d cmp #$0d cmp #$0d ; Enter = done
.ebff d0 03 bne $ec04 bne Asm01 ;
.ec01 4c 3e e8 jmp $e83e JMP Monitor ; exit assembler
.ec04 c9 3f cmp #$3f Asm01 cmp #$3f ; "?" Print Help
.ec06 f0 c8 beq $ebd0 beq Asm_Help ;
.ec08 c9 20 cmp #$20 cmp #$20 ; space
.ec0a f0 3b beq $ec47 beq Asm_opfetch ;
.ec0c c9 3b cmp #$3b cmp #$3b ; ";" ignore line
.ec0e f0 e0 beq $ebf0 beq Assembler ;
.ec10 c9 4c cmp #$4c cmp #$4C ; "L" list
.ec12 f0 2c beq $ec40 beq Asm_List ;
.ec14 c9 24 cmp #$24 cmp #$24 ; "$" ignore this
.ec16 d0 01 bne $ec19 bne Asm02 ;
.ec18 c8 iny iny ;
.ec19 64 3c stz $3c Asm02 STZ Hexdigits ; holds parsed hex
.ec1b 64 3d stz $3d STZ Hexdigits+1 ;
.ec1d 20 74 e8 jsr $e874 JSR ParseHexDig ; get Hex Chars
.ec20 a6 35 ldx $35 LDX Hexdigcnt ;
.ec22 f0 08 beq $ec2c Beq Asm_Err ;
.ec24 c9 4c cmp #$4c cmp #$4C ; "L" do list ???
.ec26 f0 1a beq $ec42 Beq Asm_List1 ;
.ec28 c9 20 cmp #$20 cmp #$20 ; Space
.ec2a f0 1b beq $ec47 Beq Asm_opfetch ;
.ec2c 98 tya Asm_Err tya ; get line pointer
.ec2d aa tax tax ;
.ec2e a9 0a lda #$0a lda #$0a ; LF move down one line
.ec30 20 fb e7 jsr $e7fb jsr output ;
.ec33 20 78 e7 jsr $e778 jsr PrintXSP ; move to where error occured
.ec36 a9 5e lda #$5e lda #$5E ; "^" ???
.ec38 20 fb e7 jsr $e7fb jsr Output ; mark it
.ec3b 20 fe e7 jsr $e7fe jsr bell ;
.ec3e 80 b0 bra $ebf0 bra Assembler ;
.ec40 64 35 stz $35 Asm_list stz HexDigcnt ;
.ec42 20 4c ea jsr $ea4c Asm_List1 jsr List_Cmd_1 ;
.ec45 80 a9 bra $ebf0 Asm_hop bra Assembler ;
.ec47 a5 35 lda $35 Asm_opfetch lda HexDigCnt ;
.ec49 f0 0a beq $ec55 beq Asm_op01 ; no address change
.ec4b a6 3c ldx $3c LDX Hexdigits ;
.ec4d a5 3d lda $3d LDA Hexdigits+1 ;
.ec4f 86 3a stx $3a STX AddrPtr ;
.ec51 85 3b sta $3b STA AddrPtr+1 ;
.ec53 88 dey dey ;
.ec54 c8 iny Asm_stripSP iny ;
.ec55 b9 00 03 lda $0300,y Asm_op01 lda buffer,y ;
.ec58 c9 20 cmp #$20 cmp #$20 ; strip spaces
.ec5a f0 f8 beq $ec54 beq Asm_stripSP ;
.ec5c c9 0d cmp #$0d cmp #$0d ; done
.ec5e f0 e5 beq $ec45 beq Asm_hop ;
.ec60 c9 3b cmp #$3b cmp #$3b ; ";" comment char done
.ec62 f0 e1 beq $ec45 beq Asm_hop ;
.ec64 a2 00 ldx #$00 ldx #$00 ;
.ec66 86 36 stx $36 stx OpcTxtPtr ;
.ec68 84 33 sty $33 sty LineCnt ;
.ec6a a4 33 ldy $33 Asm_opclp ldy LineCnt ;
.ec6c a5 36 lda $36 lda OpcTxtPtr ;
.ec6e 0a asl ASL ;
.ec6f 65 36 adc $36 adc OpcTxtPtr ;
.ec71 aa tax tax ;
.ec72 b9 00 03 lda $0300,y lda buffer,y ;
.ec75 c8 iny iny ;
.ec76 dd 98 f1 cmp $f198,x cmp OpcTxtData,x ;
.ec79 d0 14 bne $ec8f bne Asm_getnext ;
.ec7b b9 00 03 lda $0300,y lda buffer,y ;
.ec7e e8 inx inx ;
.ec7f c8 iny iny ;
.ec80 dd 98 f1 cmp $f198,x cmp OpcTxtData,x ;
.ec83 d0 0a bne $ec8f bne Asm_getnext ;
.ec85 b9 00 03 lda $0300,y lda buffer,y ;
.ec88 e8 inx inx ;
.ec89 c8 iny iny ;
.ec8a dd 98 f1 cmp $f198,x cmp OpcTxtData,x ;
.ec8d f0 0c beq $ec9b beq Asm_goodop ;
.ec8f a6 36 ldx $36 Asm_getnext ldx OpcTxtPtr ;
.ec91 e8 inx inx ;
.ec92 86 36 stx $36 stx OpcTxtPtr ;
.ec94 e0 4a cpx #$4a cpx #$4A ; last one? then err
.ec96 d0 d2 bne $ec6a bne Asm_opclp
.ec98 4c 2c ec jmp $ec2c Asm_err2 jmp Asm_err
.ec9b a9 00 lda #$00 Asm_goodop lda #$00
.ec9d 85 34 sta $34 sta ModeJmp ;
.ec9f c6 34 dec $34 dec ModeJmp ; init to FF for () check
.eca1 85 3c sta $3c sta HexDigits ; and Byte holder
.eca3 85 3d sta $3d sta HexDigits+1 ;
.eca5 85 35 sta $35 sta HexDigCnt ;
.eca7 a6 36 ldx $36 ldx OpcTxtPtr ;
.eca9 e0 42 cpx #$42 cpx #$42 ;
.ecab 30 18 bmi $ecc5 bmi Asm_goodSP ; not a 4 chr opcode
.ecad e0 46 cpx #$46 cpx #$46
.ecaf 10 14 bpl $ecc5 bpl Asm_goodSP ; not a 4 chr opcode
.ecb1 b9 00 03 lda $0300,y lda buffer,y ; get next chr
.ecb4 c8 iny iny ; advance pointer
.ecb5 c9 38 cmp #$38 cmp #$38 ;
.ecb7 10 df bpl $ec98 bpl Asm_err2 ; not chr "0"-"7"
.ecb9 c9 30 cmp #$30 cmp #$30
.ecbb 30 db bmi $ec98 bmi Asm_err2 ; not chr "0"-"7"
.ecbd 0a asl ASL
.ecbe 0a asl ASL
.ecbf 0a asl ASL
.ecc0 0a asl ASL
.ecc1 85 39 sta $39 sta startaddr_H ; temp holder for 4th chr opcode
.ecc3 a9 80 lda #$80 LDA #$80 ; flag for
.ecc5 be 00 03 ldx $0300,y Asm_goodSP ldx buffer,y ; get next operand char
.ecc8 c8 iny iny ; point to next operand chr
.ecc9 e0 20 cpx #$20 cpx #$20 ; sp
.eccb d0 24 bne $ecf1 bne Asm_GoodSP2
.eccd c9 80 cmp #$80 cmp #$80
.eccf 30 f4 bmi $ecc5 bmi Asm_goodSP
.ecd1 a6 36 ldx $36 Asm_goodSP1 ldx OpcTxtPtr ; check if its a BBRx or BBSx opcode
.ecd3 e0 44 cpx #$44 cpx #$44 ;
.ecd5 10 ee bpl $ecc5 bpl Asm_GoodSP ;
.ecd7 a6 35 ldx $35 ldx HexDigCnt ;
.ecd9 f0 ea beq $ecc5 beq Asm_goodSP ;
.ecdb c9 d0 cmp #$d0 cmp #$D0 ; already have zp & rel?
.ecdd 10 e6 bpl $ecc5 bpl Asm_GoodSP ; we don't care then
.ecdf c9 c0 cmp #$c0 cmp #$C0 ; already got a zp address?
.ece1 10 b5 bpl $ec98 bpl Asm_Err2 ; then error
.ece3 a6 3d ldx $3d ldx HexDigits+1
.ece5 d0 b1 bne $ec98 bne Asm_err2 ; not zero page
.ece7 a6 3c ldx $3c ldx HexDigits
.ece9 86 38 stx $38 stx startaddr ; temp zp value for BBRx & BBSx cmds
.eceb 09 40 ora #$40 ora #$40 ; mark zp address fetched
.eced 29 f7 and #$f7 and #$F7 ; mask out zp address found
.ecef 80 d4 bra $ecc5 bra Asm_goodSP ; get next chr
.ecf1 e0 0d cpx #$0d Asm_goodSp2 cpx #$0d ; CR
.ecf3 d0 03 bne $ecf8 bne Asm_eol
.ecf5 4c af ed jmp $edaf Asm_jmp1 jmp Asm_modeSrch
.ecf8 e0 3b cpx #$3b Asm_eol cpx #$3b ; ";"
.ecfa f0 f9 beq $ecf5 beq Asm_jmp1
.ecfc 48 pha pha
.ecfd a5 36 lda $36 lda OpcTxtPtr
.ecff c9 46 cmp #$46 cmp #$46 ; normal opcode if <=45h
.ed01 30 44 bmi $ed47 bmi Asm_opnd1
.ed03 d0 19 bne $ed1e bne Asm_xtra1
.ed05 e0 24 cpx #$24 cpx #$24 ; $ .db pseudo-opcode
.ed07 f0 01 beq $ed0a beq Asm_db1
.ed09 88 dey dey
.ed0a 20 74 e8 jsr $e874 Asm_db1 jsr ParseHexDig
.ed0d fa plx plx
.ed0e a6 35 ldx $35 ldx HexDigCnt
.ed10 f0 86 beq $ec98 beq Asm_err2 ; no digits retrieved
.ed12 a0 00 ldy #$00 ldy #$00
.ed14 a9 01 lda #$01 lda #$01
.ed16 48 pha PHA
.ed17 a5 3c lda $3c lda HexDigits
.ed19 91 3a sta ($3a),y sta (AddrPtr),y
.ed1b 4c 4a ee jmp $ee4a jmp Asm_save
.ed1e c9 47 cmp #$47 Asm_xtra1 cmp #$47 ; .dw pseudo-opcode
.ed20 d0 1e bne $ed40 bne Asm_xtra2
.ed22 e0 24 cpx #$24 cpx #$24 ; $
.ed24 f0 01 beq $ed27 beq Asm_dw1
.ed26 88 dey dey
.ed27 20 74 e8 jsr $e874 Asm_dw1 jsr ParseHexDig
.ed2a fa plx plx
.ed2b a6 35 ldx $35 ldx HexDigCnt
.ed2d f0 7d beq $edac beq Asm_err1 ; no digits retrieved
.ed2f a0 00 ldy #$00 ldy #$00
.ed31 a9 02 lda #$02 lda #$02
.ed33 48 pha PHA
.ed34 a5 3c lda $3c lda HexDigits
.ed36 91 3a sta ($3a),y sta (AddrPtr),y
.ed38 a5 3d lda $3d lda HexDigits+1
.ed3a c8 iny iny
.ed3b 91 3a sta ($3a),y sta (AddrPtr),y
.ed3d 4c 4a ee jmp $ee4a jmp Asm_save
.ed40 c9 48 cmp #$48 Asm_xtra2 cmp #$48 ; .ds pseudo-opcode
.ed42 d0 68 bne $edac bne Asm_err1
.ed44 4c 90 ee jmp $ee90 jmp Asm_txt
.ed47 68 pla Asm_opnd1 pla
.ed48 e0 23 cpx #$23 cpx #$23 ; # 20
.ed4a d0 05 bne $ed51 bne Asm_parse01
.ed4c 09 20 ora #$20 ora #$20
.ed4e 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.ed51 e0 28 cpx #$28 Asm_parse01 cpx #$28 ; ( 04
.ed53 d0 0b bne $ed60 bne Asm_parse02
.ed55 09 04 ora #$04 ora #$04
.ed57 a6 34 ldx $34 ldx modeJmp
.ed59 10 51 bpl $edac bpl Asm_err1 ; more than one (
.ed5b e6 34 inc $34 inc ModeJmp
.ed5d 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.ed60 e0 29 cpx #$29 Asm_parse02 cpx #$29 ; )
.ed62 d0 09 bne $ed6d bne Asm_parse03
.ed64 a6 34 ldx $34 ldx ModeJmp
.ed66 d0 44 bne $edac bne Asm_err1 ; ) without (
.ed68 e6 34 inc $34 inc ModeJmp
.ed6a 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.ed6d e0 2c cpx #$2c Asm_parse03 cpx #$2C ; ,
.ed6f d0 1e bne $ed8f bne Asm_parse04
.ed71 be 00 03 ldx $0300,y ldx buffer,y
.ed74 e0 58 cpx #$58 cpx #$58 ; X 02
.ed76 d0 06 bne $ed7e bne Asm_parse31
.ed78 09 02 ora #$02 ora #$02
.ed7a c8 iny iny
.ed7b 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.ed7e e0 59 cpx #$59 Asm_parse31 cpx #$59 ; Y 01
.ed80 f0 07 beq $ed89 beq Asm_parse32
.ed82 c9 80 cmp #$80 cmp #$80 ; is BBRx or BBSx cmd active?
.ed84 30 26 bmi $edac bmi Asm_err1 ; , without X or Y or 4byte opcode
.ed86 4c d1 ec jmp $ecd1 jmp Asm_goodSP1 ; save zp address
.ed89 09 01 ora #$01 Asm_parse32 ora #$01
.ed8b c8 iny iny
.ed8c 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.ed8f e0 24 cpx #$24 Asm_parse04 cpx #$24 ; $
.ed91 f0 01 beq $ed94 beq Asm_parse42 ;
.ed93 88 dey dey ; not #$(),X,Y so try Hexdig, if not err
.ed94 48 pha Asm_parse42 pha
.ed95 20 74 e8 jsr $e874 jsr ParseHexDig
.ed98 88 dey dey ; adjust input line pointer
.ed99 68 pla pla
.ed9a a6 35 ldx $35 ldx HexDigCnt
.ed9c f0 0e beq $edac beq Asm_err1 ; no digits retrieved
.ed9e a6 3d ldx $3d ldx HexDigits+1
.eda0 d0 05 bne $eda7 bne Asm_parse41
.eda2 09 08 ora #$08 ora #$08 ; <256 08
.eda4 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.eda7 09 10 ora #$10 Asm_parse41 ora #$10 ; 2 bytes 10
.eda9 4c c5 ec jmp $ecc5 jmp Asm_goodSP
.edac 4c 2c ec jmp $ec2c Asm_err1 jmp Asm_Err
.edaf a2 0f ldx #$0f Asm_ModeSrch ldx #$0F ; # of modes
.edb1 dd 88 f1 cmp $f188,x Asm_ModeS1 cmp Asm_ModeLst,x
.edb4 f0 05 beq $edbb beq Asm_ModeFnd
.edb6 ca dex dex
.edb7 10 f8 bpl $edb1 bpl Asm_ModeS1
.edb9 80 f1 bra $edac bra Asm_Err1 ; invalid Mode
.edbb 86 37 stx $37 Asm_ModeFnd stx Memchr ; save mode
.edbd c9 80 cmp #$80 cmp #$80 ; is it 4 chr opcode?
.edbf 30 05 bmi $edc6 bmi Asm_opcSrch ;no
.edc1 8a txa txa
.edc2 05 39 ora $39 ora startaddr_H ; adjust the psuedo mode
.edc4 85 37 sta $37 sta Memchr ; set proper mode
.edc6 a2 00 ldx #$00 Asm_opcSrch ldx #$00
.edc8 bd 58 ef lda $ef58,x Asm_opcSrch1 lda OpcTxtidx,x
.edcb c5 36 cmp $36 cmp OpcTxtPtr
.edcd d0 07 bne $edd6 bne Asm_srchNxt
.edcf bd 58 f0 lda $f058,x lda OPCaddmode,x
.edd2 c5 37 cmp $37 cmp Memchr
.edd4 f0 2d beq $ee03 beq Asm_OpcFnd
.edd6 e8 inx Asm_srchNxt inx
.edd7 d0 ef bne $edc8 bne Asm_opcSrch1
.edd9 a5 37 lda $37 lda Memchr ;
.eddb c9 02 cmp #$02 cmp #$02 ; ZP
.eddd d0 06 bne $ede5 bne Asm_srchAlt
.eddf a9 01 lda #$01 LDA #$01 ; ABS
.ede1 85 37 sta $37 sta Memchr
.ede3 80 e1 bra $edc6 bra Asm_opcSrch
.ede5 c9 01 cmp #$01 Asm_srchAlt cmp #$01 ; ABS
.ede7 d0 06 bne $edef bne Asm_srchA0
.ede9 a9 0a lda #$0a LDA #$0A ; REL
.edeb 85 37 sta $37 sta Memchr
.eded 80 d7 bra $edc6 bra Asm_opcSrch
.edef c9 0d cmp #$0d Asm_srchA0 cmp #$0d ; ind zp
.edf1 d0 06 bne $edf9 bne Asm_srchA1
.edf3 a9 0b lda #$0b LDA #$0b ; ind Abs
.edf5 85 37 sta $37 sta Memchr
.edf7 80 cd bra $edc6 bra Asm_opcSrch
.edf9 c9 07 cmp #$07 Asm_SrchA1 cmp #$07 ; zp,y
.edfb d0 af bne $edac bne Asm_Err1 ; no more modes to try, bad mode err
.edfd a9 09 lda #$09 LDA #$09 ; ABS,y
.edff 85 37 sta $37 sta Memchr
.ee01 80 c3 bra $edc6 bra Asm_opcSrch
.ee03 a5 37 lda $37 Asm_OpcFnd lda Memchr
.ee05 29 0f and #$0f and #$0F ; mask out psuedo modes
.ee07 85 37 sta $37 sta Memchr ;
.ee09 c9 0e cmp #$0e CMP #$0E ; BBR mode?
.ee0b d0 0b bne $ee18 bne Asm_opcFnd0 ;
.ee0d 20 57 ee jsr $ee57 jsr Asm_BRelCalc ;
.ee10 85 3d sta $3d sta HexDigits_H ;
.ee12 a5 38 lda $38 lda Startaddr ;
.ee14 85 3c sta $3c sta Hexdigits ;
.ee16 80 07 bra $ee1f bra Asm_OpcFnd1 ;
.ee18 c9 0a cmp #$0a Asm_OpcFnd0 cmp #$0A ; is Rel Mode?
.ee1a d0 03 bne $ee1f bne Asm_OpcFnd1
.ee1c 20 6f ee jsr $ee6f jsr Asm_RelCalc ; adjust rel address
.ee1f a0 00 ldy #$00 Asm_OpcFnd1 ldy #$00
.ee21 8a txa txa
.ee22 91 3a sta ($3a),y sta (AddrPtr),y
.ee24 c8 iny iny
.ee25 a6 37 ldx $37 ldx Memchr ;
.ee27 bd 58 f1 lda $f158,x lda ModeByteCnt,x
.ee2a 48 pha PHA ; Save # of bytes
.ee2b c9 01 cmp #$01 cmp #$01
.ee2d f0 10 beq $ee3f beq Asm_EchoL
.ee2f a5 3c lda $3c lda HexDigits
.ee31 91 3a sta ($3a),y sta (AddrPtr),y
.ee33 c8 iny iny
.ee34 bd 58 f1 lda $f158,x lda ModeByteCnt,x
.ee37 c9 02 cmp #$02 cmp #$02
.ee39 f0 04 beq $ee3f beq Asm_EchoL
.ee3b a5 3d lda $3d lda HexDigits+1
.ee3d 91 3a sta ($3a),y sta (AddrPtr),y
.ee3f a5 3a lda $3a Asm_EchoL lda AddrPtr
.ee41 85 38 sta $38 sta StartAddr
.ee43 a5 3b lda $3b lda AddrPtr+1
.ee45 85 39 sta $39 sta StartAddr+1
.ee47 20 76 ea jsr $ea76 jsr List_One
.ee4a 18 clc Asm_Save clc
.ee4b 68 pla PLA
.ee4c 65 3a adc $3a adc AddrPtr
.ee4e 85 3a sta $3a sta AddrPtr
.ee50 90 02 bcc $ee54 bcc Asm_done
.ee52 e6 3b inc $3b inc AddrPtr+1
.ee54 4c f0 eb jmp $ebf0 Asm_done jmp Assembler
.ee57 20 5e ee jsr $ee5e Asm_BRelCalc jsr Asm_relsub
.ee5a e9 03 sbc #$03 sbc #$03
.ee5c 80 16 bra $ee74 bra Asm_RelC1
.ee5e 38 sec Asm_RelSub sec
.ee5f a5 3c lda $3c lda Hexdigits
.ee61 e5 3a sbc $3a sbc AddrPtr
.ee63 85 3e sta $3e sta Memptr
.ee65 a5 3d lda $3d lda Hexdigits+1
.ee67 e5 3b sbc $3b sbc AddrPtr+1
.ee69 85 3f sta $3f sta Memptr+1
.ee6b 38 sec sec
.ee6c a5 3e lda $3e lda Memptr
.ee6e 60 rts rts
.ee6f 20 5e ee jsr $ee5e Asm_RelCalc jsr Asm_relsub
.ee72 e9 02 sbc #$02 sbc #$02
.ee74 85 3e sta $3e Asm_Relc1 sta Memptr
.ee76 b0 02 bcs $ee7a bcs Asm_relC2
.ee78 c6 3f dec $3f dec Memptr+1
.ee7a a5 3f lda $3f Asm_relC2 lda Memptr+1
.ee7c f0 0b beq $ee89 beq Asm_relC4 ; positive
.ee7e c9 ff cmp #$ff cmp #$FF ; negative
.ee80 d0 0b bne $ee8d bne Asm_txtErr
.ee82 a5 3e lda $3e lda Memptr
.ee84 10 07 bpl $ee8d bpl Asm_txtErr
.ee86 85 3c sta $3c Asm_relC3 sta HexDigits
.ee88 60 rts rts
.ee89 a5 3e lda $3e Asm_relC4 lda Memptr
.ee8b 10 f9 bpl $ee86 bpl Asm_relC3
.ee8d 4c 2c ec jmp $ec2c Asm_txtErr jmp Asm_Err
.ee90 fa plx Asm_txt plx ; process the .ds pseudo-opcode
.ee91 88 dey dey
.ee92 98 tya tya
.ee93 aa tax tax
.ee94 a0 fe ldy #$fe ldy #$fe
.ee96 c8 iny Asm_txt1 iny
.ee97 bd 00 03 lda $0300,x Asm_txt2 lda buffer,x ; get next operand char
.ee9a e8 inx inx ; point to next operand chr
.ee9b c9 0d cmp #$0d cmp #$0d ; CR
.ee9d f0 1a beq $eeb9 beq Asm_txt9
.ee9f c9 27 cmp #$27 cmp #$27 ; "
.eea1 d0 06 bne $eea9 bne Asm_txt3
.eea3 c0 ff cpy #$ff cpy #$ff ; opening " found?
.eea5 d0 12 bne $eeb9 bne Asm_txt9 ; no, closing, so done
.eea7 80 ed bra $ee96 bra Asm_txt1 ; yes, get first text chr
.eea9 c0 ff cpy #$ff Asm_txt3 cpy #$ff ; already found opening "?
.eeab f0 04 beq $eeb1 beq Asm_txt4 ;
.eead 91 3a sta ($3a),y sta (AddrPtr),y ; yes, save chr
.eeaf 80 e5 bra $ee96 bra Asm_txt1
.eeb1 c9 20 cmp #$20 Asm_txt4 cmp #$20 ; no, if not a space, then err
.eeb3 f0 e2 beq $ee97 beq Asm_txt2
.eeb5 8a txa txa
.eeb6 a8 tay tay
.eeb7 80 d4 bra $ee8d bra Asm_txtErr
.eeb9 98 tya Asm_txt9 tya
.eeba 48 pha pha
.eebb 4c 4a ee jmp $ee4a jmp Asm_save
.eebe a0 49 ldy #$49 Opcode_List ldy #$49 ; Number of Opcodes (64)
.eec0 a2 00 ldx #$00 ldx #$00 ; pointer to characters
.eec2 8a txa Opcode_List1 txa ;
.eec3 29 0f and #$0f and #$0F ; Print CR after each 16 opcodes
.eec5 d0 03 bne $eeca bne Opcode_List2 ; not divisible by 16
.eec7 20 4f e7 jsr $e74f jsr Print_CR ;
.eeca bd 98 f1 lda $f198,x Opcode_List2 lda OPCtxtData,x ; get opcode chr data
.eecd 20 fb e7 jsr $e7fb jsr Output ; print 1st char
.eed0 e8 inx inx ;
.eed1 bd 98 f1 lda $f198,x lda OPCtxtData,x ;
.eed4 20 fb e7 jsr $e7fb jsr Output ; print 2nd char
.eed7 e8 inx inx ;
.eed8 bd 98 f1 lda $f198,x lda OPCtxtData,x ;
.eedb 20 fb e7 jsr $e7fb jsr Output ; print 3rd char
.eede e8 inx inx ;
.eedf c0 08 cpy #$08 cpy #$08 ;
.eee1 10 09 bpl $eeec bpl Opcode_List3 ; not 4 byte code
.eee3 c0 04 cpy #$04 cpy #$04 ;
.eee5 30 05 bmi $eeec bmi Opcode_list3 ;
.eee7 a9 78 lda #$78 lda #$78 ; add 'x'
.eee9 20 fb e7 jsr $e7fb jsr output ; for RMBx, SMBx,BBRx, & BBSx
.eeec a9 20 lda #$20 Opcode_List3 lda #$20 ; print space
.eeee 20 fb e7 jsr $e7fb jsr Output ;
.eef1 88 dey dey ;
.eef2 d0 ce bne $eec2 bne Opcode_List1 ;
.eef4 20 4f e7 jsr $e74f jsr Print_CR ; one last CR-LF
.eef7 60 rts rts ;
>eef8 30 31 32 33 34 35 36 37 38 39 41 42 43 44 45 46 Hexdigdata .byte "0123456789ABCDEF";hex char table
>ef08 0d CmdAscii .byte $0D ; 0 enter cmd codes
>ef09 20 .byte $20 ; 1 SPACE
>ef0a 2e .byte $2E ; 2 .
>ef0b 3a .byte $3A ; 3 :
>ef0c 3e .byte $3E ; 4 >
>ef0d 3f .byte $3f ; 5 ? - Help
>ef0e 21 .byte $21 ; 6 ! - Assembler
>ef0f 47 .byte $47 ; 7 g - Go
>ef10 49 .byte $49 ; 8 i - Insert
>ef11 4c .byte $4C ; 9 l - List
>ef12 4d .byte $4D ; A m - Move
>ef13 51 .byte $51 ; B q - Query memory (text dump)
>ef14 52 .byte $52 ; C r - Registers
>ef15 40 .byte $40 ; D @ - Cold Start Basic
>ef16 23 .byte $23 ; E # - Warm Start Basic
>ef17 55 .byte $55 ; F U - Uploader
>ef18 56 .byte $56 ;10 v - Version
>ef19 57 .byte $57 ;11 w - "(W)rite" eeprom
>ef1a 24 .byte $24 ;12 $ - fig forth
>ef1b 25 .byte $25 ;13 % - uChess
>ef1c db e8 Cmdjmptbl .word CR_cmd ; 0 enter cmd jmp table
>ef1e eb e8 .word SP_cmd ; 1 space
>ef20 d0 e8 .word DOT_cmd ; 2 .
>ef22 d0 e8 .word DOT_cmd ; 3 :
>ef24 16 ea .word Dest_cmd ; 4 >
>ef26 95 e8 .word Help_Cmd ; 5 ?
>ef28 c2 eb .word Assem_init ; 6 !
>ef2a c4 e8 .word Excute_cmd ; 7 g
>ef2c 6c e9 .word Insert_Cmd ; 8 i
>ef2e 1f ea .word LIST_cmd ; 9 l
>ef30 af e9 .word Move_cmd ; A m
>ef32 4a e9 .word TXT_cmd ; B q
>ef34 18 e7 .word Printreg ; C r
>ef36 2e e6 .word bsetup ; D @
>ef38 00 00 .word $0000 ; E #
>ef3a 00 fc .word xmodem ; F u
>ef3c b3 e8 .word Version ;10 v
>ef3e de e9 .word EEPROM_WR ;11 w
>ef40 65 bd .word TOPROM ;12 $
>ef42 00 9e .word _CSTART ;13 % - uChess
>ef44 00 Cmdseccode .byte $00 ; 0 enter secondary command table
>ef45 ff .byte $FF ; 1 sp
>ef46 01 .byte $01 ; 2 .
>ef47 02 .byte $02 ; 3 :
>ef48 00 .byte $00 ; 4 >
>ef49 00 .byte $00 ; 5 ?
>ef4a 00 .byte $00 ; 6 !
>ef4b 00 .byte $00 ; 7 g
>ef4c 00 .byte $00 ; 8 i
>ef4d 00 .byte $00 ; 9 l
>ef4e 00 .byte $00 ; A m
>ef4f 00 .byte $00 ; B q
>ef50 00 .byte $00 ; C r
>ef51 00 .byte $00 ; D @
>ef52 00 .byte $00 ; E #
>ef53 00 .byte $00 ; F u
>ef54 00 .byte $00 ;10 v
>ef55 00 .byte $00 ;11 w
>ef56 00 .byte $00 ;12 $
>ef57 00 .byte $00 ;13 % - uChess
>ef58 0b OPCtxtidx .byte $0B ;0 operand text index
>ef59 23 .byte $23 ;1
>ef5a 49 .byte $49 ;2
>ef5b 49 .byte $49 ;3
>ef5c 3b .byte $3B ;4
>ef5d 23 .byte $23 ;5
>ef5e 02 .byte $02 ;6
>ef5f 44 .byte $44 ;7
>ef60 25 .byte $25 ;8
>ef61 23 .byte $23 ;9
>ef62 02 .byte $02 ;A
>ef63 49 .byte $49 ;B
>ef64 3b .byte $3B ;C
>ef65 23 .byte $23 ;D
>ef66 02 .byte $02 ;E
>ef67 42 .byte $42 ;F
>ef68 09 .byte $09 ;10
>ef69 23 .byte $23 ;11
>ef6a 23 .byte $23 ;12
>ef6b 49 .byte $49 ;13
>ef6c 3a .byte $3A ;14
>ef6d 23 .byte $23 ;15
>ef6e 02 .byte $02 ;16
>ef6f 44 .byte $44 ;17
>ef70 0e .byte $0E ;18
>ef71 23 .byte $23 ;19
>ef72 19 .byte $19 ;1A
>ef73 49 .byte $49 ;1B
>ef74 3a .byte $3A ;1C
>ef75 23 .byte $23 ;1D
>ef76 02 .byte $02 ;1E
>ef77 42 .byte $42 ;1F
>ef78 1d .byte $1D ;20
>ef79 01 .byte $01 ;21
>ef7a 49 .byte $49 ;22
>ef7b 49 .byte $49 ;23
>ef7c 06 .byte $06 ;24
>ef7d 01 .byte $01 ;25
>ef7e 2c .byte $2C ;26
>ef7f 44 .byte $44 ;27
>ef80 29 .byte $29 ;28
>ef81 01 .byte $01 ;29
>ef82 2c .byte $2C ;2A
>ef83 49 .byte $49 ;2B
>ef84 06 .byte $06 ;2C
>ef85 01 .byte $01 ;2D
>ef86 2c .byte $2C ;2E
>ef87 42 .byte $42 ;2F
>ef88 07 .byte $07 ;30
>ef89 01 .byte $01 ;31
>ef8a 01 .byte $01 ;32
>ef8b 49 .byte $49 ;33
>ef8c 06 .byte $06 ;34
>ef8d 01 .byte $01 ;35
>ef8e 2c .byte $2C ;36
>ef8f 44 .byte $44 ;37
>ef90 31 .byte $31 ;38
>ef91 01 .byte $01 ;39
>ef92 15 .byte $15 ;3A
>ef93 49 .byte $49 ;3B
>ef94 06 .byte $06 ;3C
>ef95 01 .byte $01 ;3D
>ef96 2c .byte $2C ;3E
>ef97 42 .byte $42 ;3F
>ef98 2e .byte $2E ;40
>ef99 18 .byte $18 ;41
>ef9a 49 .byte $49 ;42
>ef9b 49 .byte $49 ;43
>ef9c 49 .byte $49 ;44
>ef9d 18 .byte $18 ;45
>ef9e 21 .byte $21 ;46
>ef9f 44 .byte $44 ;47
>efa0 24 .byte $24 ;48
>efa1 18 .byte $18 ;49
>efa2 21 .byte $21 ;4A
>efa3 49 .byte $49 ;4B
>efa4 1c .byte $1C ;4C
>efa5 18 .byte $18 ;4D
>efa6 21 .byte $21 ;4E
>efa7 42 .byte $42 ;4F
>efa8 0c .byte $0C ;50
>efa9 18 .byte $18 ;51
>efaa 18 .byte $18 ;52
>efab 49 .byte $49 ;53
>efac 49 .byte $49 ;54
>efad 18 .byte $18 ;55
>efae 21 .byte $21 ;56
>efaf 44 .byte $44 ;57
>efb0 10 .byte $10 ;58
>efb1 18 .byte $18 ;59
>efb2 27 .byte $27 ;5A
>efb3 49 .byte $49 ;5B
>efb4 49 .byte $49 ;5C
>efb5 18 .byte $18 ;5D
>efb6 21 .byte $21 ;5E
>efb7 42 .byte $42 ;5F
>efb8 2f .byte $2F ;60
>efb9 00 .byte $00 ;61
>efba 49 .byte $49 ;62
>efbb 49 .byte $49 ;63
>efbc 37 .byte $37 ;64
>efbd 00 .byte $00 ;65
>efbe 2d .byte $2D ;66
>efbf 44 .byte $44 ;67
>efc0 28 .byte $28 ;68
>efc1 00 .byte $00 ;69
>efc2 2d .byte $2D ;6A
>efc3 49 .byte $49 ;6B
>efc4 1c .byte $1C ;6C
>efc5 00 .byte $00 ;6D
>efc6 2d .byte $2D ;6E
>efc7 42 .byte $42 ;6F
>efc8 0d .byte $0D ;70
>efc9 00 .byte $00 ;71
>efca 00 .byte $00 ;72
>efcb 49 .byte $49 ;73
>efcc 37 .byte $37 ;74
>efcd 00 .byte $00 ;75
>efce 2d .byte $2D ;76
>efcf 44 .byte $44 ;77
>efd0 33 .byte $33 ;78
>efd1 00 .byte $00 ;79
>efd2 2b .byte $2B ;7A
>efd3 49 .byte $49 ;7B
>efd4 1c .byte $1C ;7C
>efd5 00 .byte $00 ;7D
>efd6 2d .byte $2D ;7E
>efd7 42 .byte $42 ;7F
>efd8 0a .byte $0A ;80
>efd9 34 .byte $34 ;81
>efda 49 .byte $49 ;82
>efdb 49 .byte $49 ;83
>efdc 36 .byte $36 ;84
>efdd 34 .byte $34 ;85
>efde 35 .byte $35 ;86
>efdf 45 .byte $45 ;87
>efe0 17 .byte $17 ;88
>efe1 06 .byte $06 ;89
>efe2 3d .byte $3D ;8A
>efe3 49 .byte $49 ;8B
>efe4 36 .byte $36 ;8C
>efe5 34 .byte $34 ;8D
>efe6 35 .byte $35 ;8E
>efe7 43 .byte $43 ;8F
>efe8 03 .byte $03 ;90
>efe9 34 .byte $34 ;91
>efea 34 .byte $34 ;92
>efeb 49 .byte $49 ;93
>efec 36 .byte $36 ;94
>efed 34 .byte $34 ;95
>efee 35 .byte $35 ;96
>efef 45 .byte $45 ;97
>eff0 3f .byte $3F ;98
>eff1 34 .byte $34 ;99
>eff2 3e .byte $3E ;9A
>eff3 49 .byte $49 ;9B
>eff4 37 .byte $37 ;9C
>eff5 34 .byte $34 ;9D
>eff6 37 .byte $37 ;9E
>eff7 43 .byte $43 ;9F
>eff8 20 .byte $20 ;A0
>eff9 1e .byte $1E ;A1
>effa 1f .byte $1F ;A2
>effb 49 .byte $49 ;A3
>effc 20 .byte $20 ;A4
>effd 1e .byte $1E ;A5
>effe 1f .byte $1F ;A6
>efff 45 .byte $45 ;A7
>f000 39 .byte $39 ;A8
>f001 1e .byte $1E ;A9
>f002 38 .byte $38 ;AA
>f003 49 .byte $49 ;AB
>f004 20 .byte $20 ;AC
>f005 1e .byte $1E ;AD
>f006 1f .byte $1F ;AE
>f007 43 .byte $43 ;AF
>f008 04 .byte $04 ;B0
>f009 1e .byte $1E ;B1
>f00a 1e .byte $1E ;B2
>f00b 49 .byte $49 ;B3
>f00c 20 .byte $20 ;B4
>f00d 1e .byte $1E ;B5
>f00e 1f .byte $1F ;B6
>f00f 45 .byte $45 ;B7
>f010 11 .byte $11 ;B8
>f011 1e .byte $1E ;B9
>f012 3c .byte $3C ;BA
>f013 49 .byte $49 ;BB
>f014 20 .byte $20 ;BC
>f015 1e .byte $1E ;BD
>f016 1f .byte $1F ;BE
>f017 43 .byte $43 ;BF
>f018 14 .byte $14 ;C0
>f019 12 .byte $12 ;C1
>f01a 49 .byte $49 ;C2
>f01b 49 .byte $49 ;C3
>f01c 14 .byte $14 ;C4
>f01d 12 .byte $12 ;C5
>f01e 15 .byte $15 ;C6
>f01f 45 .byte $45 ;C7
>f020 1b .byte $1B ;C8
>f021 12 .byte $12 ;C9
>f022 16 .byte $16 ;CA
>f023 40 .byte $40 ;CB
>f024 14 .byte $14 ;CC
>f025 12 .byte $12 ;CD
>f026 15 .byte $15 ;CE
>f027 43 .byte $43 ;CF
>f028 08 .byte $08 ;D0
>f029 12 .byte $12 ;D1
>f02a 12 .byte $12 ;D2
>f02b 49 .byte $49 ;D3
>f02c 49 .byte $49 ;D4
>f02d 12 .byte $12 ;D5
>f02e 15 .byte $15 ;D6
>f02f 45 .byte $45 ;D7
>f030 0f .byte $0F ;D8
>f031 12 .byte $12 ;D9
>f032 26 .byte $26 ;DA
>f033 41 .byte $41 ;DB
>f034 49 .byte $49 ;DC
>f035 12 .byte $12 ;DD
>f036 15 .byte $15 ;DE
>f037 43 .byte $43 ;DF
>f038 13 .byte $13 ;E0
>f039 30 .byte $30 ;E1
>f03a 49 .byte $49 ;E2
>f03b 49 .byte $49 ;E3
>f03c 13 .byte $13 ;E4
>f03d 30 .byte $30 ;E5
>f03e 19 .byte $19 ;E6
>f03f 45 .byte $45 ;E7
>f040 1a .byte $1A ;E8
>f041 30 .byte $30 ;E9
>f042 22 .byte $22 ;EA
>f043 49 .byte $49 ;EB
>f044 13 .byte $13 ;EC
>f045 30 .byte $30 ;ED
>f046 19 .byte $19 ;EE
>f047 43 .byte $43 ;EF
>f048 05 .byte $05 ;F0
>f049 30 .byte $30 ;F1
>f04a 30 .byte $30 ;F2
>f04b 49 .byte $49 ;F3
>f04c 49 .byte $49 ;F4
>f04d 30 .byte $30 ;F5
>f04e 19 .byte $19 ;F6
>f04f 45 .byte $45 ;F7
>f050 32 .byte $32 ;F8
>f051 30 .byte $30 ;F9
>f052 2a .byte $2A ;FA
>f053 49 .byte $49 ;FB
>f054 49 .byte $49 ;FC
>f055 30 .byte $30 ;FD
>f056 19 .byte $19 ;FE
>f057 43 .byte $43 ;FF
>f058 03 OPCaddmode .byte $03 ;0 opcode address mode
>f059 04 .byte $04 ;1
>f05a 03 .byte $03 ;2
>f05b 03 .byte $03 ;3
>f05c 02 .byte $02 ;4
>f05d 02 .byte $02 ;5
>f05e 02 .byte $02 ;6
>f05f 0f .byte $0F ;7
>f060 03 .byte $03 ;8
>f061 00 .byte $00 ;9
>f062 03 .byte $03 ;A
>f063 03 .byte $03 ;B
>f064 01 .byte $01 ;C
>f065 01 .byte $01 ;D
>f066 01 .byte $01 ;E
>f067 0e .byte $0E ;F
>f068 0a .byte $0A ;10
>f069 05 .byte $05 ;11
>f06a 0d .byte $0D ;12
>f06b 03 .byte $03 ;13
>f06c 02 .byte $02 ;14
>f06d 06 .byte $06 ;15
>f06e 06 .byte $06 ;16
>f06f 1f .byte $1F ;17
>f070 03 .byte $03 ;18
>f071 09 .byte $09 ;19
>f072 03 .byte $03 ;1A
>f073 03 .byte $03 ;1B
>f074 01 .byte $01 ;1C
>f075 08 .byte $08 ;1D
>f076 08 .byte $08 ;1E
>f077 1e .byte $1E ;1F
>f078 01 .byte $01 ;20
>f079 04 .byte $04 ;21
>f07a 03 .byte $03 ;22
>f07b 03 .byte $03 ;23
>f07c 02 .byte $02 ;24
>f07d 02 .byte $02 ;25
>f07e 02 .byte $02 ;26
>f07f 2f .byte $2F ;27
>f080 03 .byte $03 ;28
>f081 00 .byte $00 ;29
>f082 03 .byte $03 ;2A
>f083 03 .byte $03 ;2B
>f084 01 .byte $01 ;2C
>f085 01 .byte $01 ;2D
>f086 01 .byte $01 ;2E
>f087 2e .byte $2E ;2F
>f088 0a .byte $0A ;30
>f089 05 .byte $05 ;31
>f08a 0d .byte $0D ;32
>f08b 03 .byte $03 ;33
>f08c 06 .byte $06 ;34
>f08d 06 .byte $06 ;35
>f08e 06 .byte $06 ;36
>f08f 3f .byte $3F ;37
>f090 03 .byte $03 ;38
>f091 09 .byte $09 ;39
>f092 03 .byte $03 ;3A
>f093 03 .byte $03 ;3B
>f094 08 .byte $08 ;3C
>f095 08 .byte $08 ;3D
>f096 08 .byte $08 ;3E
>f097 3e .byte $3E ;3F
>f098 03 .byte $03 ;40
>f099 04 .byte $04 ;41
>f09a 03 .byte $03 ;42
>f09b 03 .byte $03 ;43
>f09c 03 .byte $03 ;44
>f09d 02 .byte $02 ;45
>f09e 02 .byte $02 ;46
>f09f 4f .byte $4F ;47
>f0a0 03 .byte $03 ;48
>f0a1 00 .byte $00 ;49
>f0a2 03 .byte $03 ;4A
>f0a3 03 .byte $03 ;4B
>f0a4 01 .byte $01 ;4C
>f0a5 01 .byte $01 ;4D
>f0a6 01 .byte $01 ;4E
>f0a7 4e .byte $4E ;4F
>f0a8 0a .byte $0A ;50
>f0a9 05 .byte $05 ;51
>f0aa 0d .byte $0D ;52
>f0ab 03 .byte $03 ;53
>f0ac 03 .byte $03 ;54
>f0ad 06 .byte $06 ;55
>f0ae 06 .byte $06 ;56
>f0af 5f .byte $5F ;57
>f0b0 03 .byte $03 ;58
>f0b1 09 .byte $09 ;59
>f0b2 03 .byte $03 ;5A
>f0b3 03 .byte $03 ;5B
>f0b4 03 .byte $03 ;5C
>f0b5 08 .byte $08 ;5D
>f0b6 08 .byte $08 ;5E
>f0b7 5e .byte $5E ;5F
>f0b8 03 .byte $03 ;60
>f0b9 04 .byte $04 ;61
>f0ba 03 .byte $03 ;62
>f0bb 03 .byte $03 ;63
>f0bc 02 .byte $02 ;64
>f0bd 02 .byte $02 ;65
>f0be 02 .byte $02 ;66
>f0bf 6f .byte $6F ;67
>f0c0 03 .byte $03 ;68
>f0c1 00 .byte $00 ;69
>f0c2 03 .byte $03 ;6A
>f0c3 03 .byte $03 ;6B
>f0c4 0b .byte $0B ;6C
>f0c5 01 .byte $01 ;6D
>f0c6 01 .byte $01 ;6E
>f0c7 6e .byte $6E ;6F
>f0c8 0a .byte $0A ;70
>f0c9 05 .byte $05 ;71
>f0ca 0d .byte $0D ;72
>f0cb 03 .byte $03 ;73
>f0cc 06 .byte $06 ;74
>f0cd 06 .byte $06 ;75
>f0ce 06 .byte $06 ;76
>f0cf 7f .byte $7F ;77
>f0d0 03 .byte $03 ;78
>f0d1 09 .byte $09 ;79
>f0d2 03 .byte $03 ;7A
>f0d3 03 .byte $03 ;7B
>f0d4 0c .byte $0C ;7C
>f0d5 08 .byte $08 ;7D
>f0d6 08 .byte $08 ;7E
>f0d7 7e .byte $7E ;7F
>f0d8 0a .byte $0A ;80
>f0d9 04 .byte $04 ;81
>f0da 03 .byte $03 ;82
>f0db 03 .byte $03 ;83
>f0dc 02 .byte $02 ;84
>f0dd 02 .byte $02 ;85
>f0de 02 .byte $02 ;86
>f0df 0f .byte $0F ;87
>f0e0 03 .byte $03 ;88
>f0e1 00 .byte $00 ;89
>f0e2 03 .byte $03 ;8A
>f0e3 03 .byte $03 ;8B
>f0e4 01 .byte $01 ;8C
>f0e5 01 .byte $01 ;8D
>f0e6 01 .byte $01 ;8E
>f0e7 0e .byte $0E ;8F
>f0e8 0a .byte $0A ;90
>f0e9 05 .byte $05 ;91
>f0ea 0d .byte $0D ;92
>f0eb 03 .byte $03 ;93
>f0ec 06 .byte $06 ;94
>f0ed 06 .byte $06 ;95
>f0ee 07 .byte $07 ;96
>f0ef 1f .byte $1F ;97
>f0f0 03 .byte $03 ;98
>f0f1 09 .byte $09 ;99
>f0f2 03 .byte $03 ;9A
>f0f3 03 .byte $03 ;9B
>f0f4 01 .byte $01 ;9C
>f0f5 08 .byte $08 ;9D
>f0f6 08 .byte $08 ;9E
>f0f7 1e .byte $1E ;9F
>f0f8 00 .byte $00 ;A0
>f0f9 04 .byte $04 ;A1 changed from 0d to 04
>f0fa 00 .byte $00 ;A2
>f0fb 03 .byte $03 ;A3
>f0fc 02 .byte $02 ;A4
>f0fd 02 .byte $02 ;A5
>f0fe 02 .byte $02 ;A6
>f0ff 2f .byte $2F ;A7
>f100 03 .byte $03 ;A8
>f101 00 .byte $00 ;A9
>f102 03 .byte $03 ;AA
>f103 03 .byte $03 ;AB
>f104 01 .byte $01 ;AC
>f105 01 .byte $01 ;AD
>f106 01 .byte $01 ;AE
>f107 2e .byte $2E ;AF
>f108 0a .byte $0A ;B0
>f109 05 .byte $05 ;B1
>f10a 0d .byte $0D ;B2
>f10b 03 .byte $03 ;B3
>f10c 06 .byte $06 ;B4
>f10d 06 .byte $06 ;B5
>f10e 07 .byte $07 ;B6
>f10f 3f .byte $3F ;B7
>f110 03 .byte $03 ;B8
>f111 09 .byte $09 ;B9
>f112 03 .byte $03 ;BA
>f113 03 .byte $03 ;BB
>f114 08 .byte $08 ;BC
>f115 08 .byte $08 ;BD
>f116 09 .byte $09 ;BE
>f117 3e .byte $3E ;BF
>f118 00 .byte $00 ;C0
>f119 04 .byte $04 ;C1
>f11a 03 .byte $03 ;C2
>f11b 03 .byte $03 ;C3
>f11c 02 .byte $02 ;C4
>f11d 02 .byte $02 ;C5
>f11e 02 .byte $02 ;C6
>f11f 4f .byte $4F ;C7
>f120 03 .byte $03 ;C8
>f121 00 .byte $00 ;C9
>f122 03 .byte $03 ;CA
>f123 03 .byte $03 ;CB
>f124 01 .byte $01 ;CC
>f125 01 .byte $01 ;CD
>f126 01 .byte $01 ;CE
>f127 4e .byte $4E ;CF
>f128 0a .byte $0A ;D0
>f129 05 .byte $05 ;D1
>f12a 0d .byte $0D ;D2
>f12b 03 .byte $03 ;D3
>f12c 03 .byte $03 ;D4
>f12d 06 .byte $06 ;D5
>f12e 06 .byte $06 ;D6
>f12f 5f .byte $5F ;D7
>f130 03 .byte $03 ;D8
>f131 09 .byte $09 ;D9
>f132 03 .byte $03 ;DA
>f133 03 .byte $03 ;DB
>f134 03 .byte $03 ;DC
>f135 08 .byte $08 ;DD
>f136 08 .byte $08 ;DE
>f137 5e .byte $5E ;DF
>f138 00 .byte $00 ;E0
>f139 04 .byte $04 ;E1
>f13a 03 .byte $03 ;E2
>f13b 03 .byte $03 ;E3
>f13c 02 .byte $02 ;E4
>f13d 02 .byte $02 ;E5
>f13e 02 .byte $02 ;E6
>f13f 6f .byte $6F ;E7
>f140 03 .byte $03 ;E8
>f141 00 .byte $00 ;E9
>f142 03 .byte $03 ;EA
>f143 03 .byte $03 ;EB
>f144 01 .byte $01 ;EC
>f145 01 .byte $01 ;ED
>f146 01 .byte $01 ;EE
>f147 6e .byte $6E ;EF
>f148 0a .byte $0A ;F0
>f149 05 .byte $05 ;F1
>f14a 0d .byte $0D ;F2
>f14b 03 .byte $03 ;F3
>f14c 03 .byte $03 ;F4
>f14d 06 .byte $06 ;F5
>f14e 06 .byte $06 ;F6
>f14f 7f .byte $7F ;F7
>f150 03 .byte $03 ;F8
>f151 09 .byte $09 ;F9
>f152 03 .byte $03 ;FA
>f153 03 .byte $03 ;FB
>f154 03 .byte $03 ;FC
>f155 08 .byte $08 ;FD
>f156 08 .byte $08 ;FE
>f157 7e .byte $7E ;FF
>f158 02 ModeByteCnt .byte $02 ;0 opcode mode byte count
>f159 03 .byte $03 ;1
>f15a 02 .byte $02 ;2
>f15b 01 .byte $01 ;3
>f15c 02 .byte $02 ;4
>f15d 02 .byte $02 ;5
>f15e 02 .byte $02 ;6
>f15f 02 .byte $02 ;7
>f160 03 .byte $03 ;8
>f161 03 .byte $03 ;9
>f162 02 .byte $02 ;A
>f163 03 .byte $03 ;B
>f164 03 .byte $03 ;C
>f165 02 .byte $02 ;D
>f166 03 .byte $03 ;E
>f167 02 .byte $02 ;F
>f168 0b eb ModeJmpTbl .word IMM_mode ;0 Operand print table
>f16a 51 eb .word ABS_mode ;1
>f16c 10 eb .word ZP_mode ;2
>f16e 7b eb .word IMPLIED_mode ;3
>f170 41 eb .word INDZP_X_mode ;4
>f172 4c eb .word INDZP_Y_mode ;5
>f174 1c eb .word ZP_X_mode ;6
>f176 29 eb .word ZP_Y_mode ;7
>f178 5e eb .word ABS_X_mode ;8
>f17a 63 eb .word ABS_Y_mode ;9
>f17c 9c eb .word REL_mode ;a
>f17e 68 eb .word INDABS_mode ;b
>f180 70 eb .word INDABSX_mode ;c
>f182 36 eb .word INDZP_mode ;d
>f184 81 eb .word BBREL_mode ;e
>f186 10 eb .word ZP_mode ;f dup of ZP for RMB,SMB cmds
>f188 28 Asm_ModeLst .byte $28 ;0 IMM_mode
>f189 10 .byte $10 ;1 ABS_mode
>f18a 08 .byte $08 ;2 ZP_mode
>f18b 00 .byte $00 ;3 IMPLIED_mode
>f18c 0e .byte $0E ;4 INDZP_X_mode
>f18d 0d .byte $0D ;5 INDZP_Y_mode
>f18e 0a .byte $0A ;6 ZP_X_mode
>f18f 09 .byte $09 ;7 ZP_Y_mode
>f190 12 .byte $12 ;8 ABS_X_mode
>f191 11 .byte $11 ;9 ABS_Y_mode
>f192 40 .byte $40 ;A REL_mode Never set!!!
>f193 14 .byte $14 ;B INDABS_mode
>f194 16 .byte $16 ;C INDABSX_mode
>f195 0c .byte $0C ;D INDZP_mode
>f196 d0 .byte $D0 ;E BBREL_mode
>f197 88 .byte $88 ;F used for RMBx & SMBx
>f198 41 44 43 OPCtxtData .byte "ADC" ;0
>f19b 41 4e 44 .byte "AND" ;1
>f19e 41 53 4c .byte "ASL" ;2
>f1a1 42 43 43 .byte "BCC" ;3
>f1a4 42 43 53 .byte "BCS" ;4
>f1a7 42 45 51 .byte "BEQ" ;5
>f1aa 42 49 54 .byte "BIT" ;6
>f1ad 42 4d 49 .byte "BMI" ;7
>f1b0 42 4e 45 .byte "BNE" ;8
>f1b3 42 50 4c .byte "BPL" ;9
>f1b6 42 52 41 .byte "BRA" ;A
>f1b9 42 52 4b .byte "BRK" ;B
>f1bc 42 56 43 .byte "BVC" ;C
>f1bf 42 56 53 .byte "BVS" ;D
>f1c2 43 4c 43 .byte "CLC" ;E
>f1c5 43 4c 44 .byte "CLD" ;F
>f1c8 43 4c 49 .byte "CLI" ;10
>f1cb 43 4c 56 .byte "CLV" ;11
>f1ce 43 4d 50 .byte "CMP" ;12
>f1d1 43 50 58 .byte "CPX" ;13
>f1d4 43 50 59 .byte "CPY" ;14
>f1d7 44 45 43 .byte "DEC" ;15
>f1da 44 45 58 .byte "DEX" ;16
>f1dd 44 45 59 .byte "DEY" ;17
>f1e0 45 4f 52 .byte "EOR" ;18
>f1e3 49 4e 43 .byte "INC" ;19
>f1e6 49 4e 58 .byte "INX" ;1A
>f1e9 49 4e 59 .byte "INY" ;1B
>f1ec 4a 4d 50 .byte "JMP" ;1C
>f1ef 4a 53 52 .byte "JSR" ;1D
>f1f2 4c 44 41 .byte "LDA" ;1E
>f1f5 4c 44 58 .byte "LDX" ;1F
>f1f8 4c 44 59 .byte "LDY" ;20
>f1fb 4c 53 52 .byte "LSR" ;21
>f1fe 4e 4f 50 .byte "NOP" ;22
>f201 4f 52 41 .byte "ORA" ;23
>f204 50 48 41 .byte "PHA" ;24
>f207 50 48 50 .byte "PHP" ;25
>f20a 50 48 58 .byte "PHX" ;26
>f20d 50 48 59 .byte "PHY" ;27
>f210 50 4c 41 .byte "PLA" ;28
>f213 50 4c 50 .byte "PLP" ;29
>f216 50 4c 58 .byte "PLX" ;2A
>f219 50 4c 59 .byte "PLY" ;2B
>f21c 52 4f 4c .byte "ROL" ;2C
>f21f 52 4f 52 .byte "ROR" ;2D
>f222 52 54 49 .byte "RTI" ;2E
>f225 52 54 53 .byte "RTS" ;2F
>f228 53 42 43 .byte "SBC" ;30
>f22b 53 45 43 .byte "SEC" ;31
>f22e 53 45 44 .byte "SED" ;32
>f231 53 45 49 .byte "SEI" ;33
>f234 53 54 41 .byte "STA" ;34
>f237 53 54 58 .byte "STX" ;35
>f23a 53 54 59 .byte "STY" ;36
>f23d 53 54 5a .byte "STZ" ;37
>f240 54 41 58 .byte "TAX" ;38
>f243 54 41 59 .byte "TAY" ;39
>f246 54 52 42 .byte "TRB" ;3A
>f249 54 53 42 .byte "TSB" ;3B
>f24c 54 53 58 .byte "TSX" ;3C
>f24f 54 58 41 .byte "TXA" ;3D
>f252 54 58 53 .byte "TXS" ;3E
>f255 54 59 41 .byte "TYA" ;3F
>f258 57 41 49 .byte "WAI" ;40
>f25b 53 54 50 .byte "STP" ;41
>f25e 42 42 52 .byte "BBR" ;42 4Byte Opcodes
>f261 42 42 53 .byte "BBS" ;43
>f264 52 4d 42 .byte "RMB" ;44
>f267 53 4d 42 .byte "SMB" ;45
>f26a 2e 44 42 .byte ".DB" ;46 define 1 byte for assembler
>f26d 2e 44 57 .byte ".DW" ;47 define 1 word for assembler
>f270 2e 44 53 .byte ".DS" ;48 define a string block for assembler
>f273 3f 3f 3f .byte "???" ;49 for invalid opcode
>f276 7e 43 75 72 72 65 6e 74 20 63 6f 6d 6d 61 6e 64 73 20 61 72 65 20 3a 7e HelpTxt .byte "~Current commands are :~"
>f28e 53 79 6e 74 61 78 20 3d 20 7b 7d 20 72 65 71 75 69 72 65 64 2c 20 5b 5d 20 6f 70 74 69 6f 6e 61 6c 2c 20 48 48 48 48 20 68 65 78 20 61 64 64 72 65 73 73 2c 20 44 44 20 68 65 78 20 64 61 74 61 7e .byte "Syntax = {} required, [] optional, HHHH hex address, DD hex data~"
>f2cf 7e .byte "~"
>f2d0 5b 48 48 48 48 5d 5b 20 48 48 48 48 5d 7b 52 65 74 75 72 6e 7d 20 2d 20 48 65 78 20 64 75 6d 70 20 61 64 64 72 65 73 73 28 73 29 28 75 70 20 74 6f 20 31 36 20 69 66 20 6e 6f 20 61 64 64 72 65 73 73 20 65 6e 74 65 72 65 64 29 7e .byte "[HHHH][ HHHH]{Return} - Hex dump address(s)(up to 16 if no address entered)~"
>f31c 5b 48 48 48 48 5d 7b 2e 48 48 48 48 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 48 65 78 20 64 75 6d 70 20 72 61 6e 67 65 20 6f 66 20 61 64 64 72 65 73 73 65 73 20 28 31 36 20 70 65 72 20 6c 69 6e 65 29 7e .byte "[HHHH]{.HHHH}{Return} - Hex dump range of addresses (16 per line)~"
>f35e 5b 48 48 48 48 5d 7b 3a 44 44 7d 5b 20 44 44 5d 7b 52 65 74 75 72 6e 7d 20 2d 20 43 68 61 6e 67 65 20 64 61 74 61 20 62 79 74 65 73 7e .byte "[HHHH]{:DD}[ DD]{Return} - Change data bytes~"
>f38b 5b 48 48 48 48 5d 7b 47 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 45 78 65 63 75 74 65 20 61 20 70 72 6f 67 72 61 6d 20 28 75 73 65 20 52 54 53 20 74 6f 20 72 65 74 75 72 6e 20 74 6f 20 6d 6f 6e 69 74 6f 72 29 7e .byte "[HHHH]{G}{Return} - Execute a program (use RTS to return to monitor)~"
>f3d0 7b 48 48 48 48 2e 48 48 48 48 3e 48 48 48 48 7b 49 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 6d 6f 76 65 20 72 61 6e 67 65 20 61 74 20 32 6e 64 20 48 48 48 48 20 64 6f 77 6e 20 74 6f 20 31 73 74 20 74 6f 20 33 72 64 20 48 48 48 48 7e .byte "{HHHH.HHHH>HHHH{I}{Return} - move range at 2nd HHHH down to 1st to 3rd HHHH~"
>f41c 5b 48 48 48 48 5d 7b 4c 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 4c 69 73 74 20 28 64 69 73 61 73 73 65 6d 62 6c 65 29 20 32 30 20 6c 69 6e 65 73 20 6f 66 20 70 72 6f 67 72 61 6d 7e .byte "[HHHH]{L}{Return} - List (disassemble) 20 lines of program~"
>f457 5b 48 48 48 48 5d 7b 2e 48 48 48 48 7d 7b 4c 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 44 69 73 73 61 73 73 65 6d 62 6c 65 20 61 20 72 61 6e 67 65 7e .byte "[HHHH]{.HHHH}{L}{Return} - Dissassemble a range~"
>f487 7b 48 48 48 48 2e 48 48 48 48 3e 48 48 48 48 7b 4d 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 4d 6f 76 65 20 72 61 6e 67 65 20 61 74 20 31 73 74 20 48 48 48 48 20 74 68 72 75 20 32 6e 64 20 74 6f 20 33 72 64 20 48 48 48 48 7e .byte "{HHHH.HHHH>HHHH{M}{Return} - Move range at 1st HHHH thru 2nd to 3rd HHHH~"
>f4d0 5b 48 48 48 48 5d 5b 20 48 48 48 48 5d 7b 51 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 54 65 78 74 20 64 75 6d 70 20 61 64 64 72 65 73 73 28 73 29 7e .byte "[HHHH][ HHHH]{Q}{Return} - Text dump address(s)~"
>f500 5b 48 48 48 48 5d 7b 2e 48 48 48 48 7d 7b 51 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 54 65 78 74 20 64 75 6d 70 20 72 61 6e 67 65 20 6f 66 20 61 64 64 72 65 73 73 65 73 20 28 31 36 20 70 65 72 20 6c 69 6e 65 29 7e .byte "[HHHH]{.HHHH}{Q}{Return} - Text dump range of addresses (16 per line)~"
>f546 7b 52 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 50 72 69 6e 74 20 72 65 67 69 73 74 65 72 20 63 6f 6e 74 65 6e 74 73 20 66 72 6f 6d 20 6d 65 6d 6f 72 79 20 6c 6f 63 61 74 69 6f 6e 73 7e .byte "{R}{Return} - Print register contents from memory locations~"
>f582 7b 55 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 55 70 6c 6f 61 64 20 46 69 6c 65 20 28 58 6d 6f 64 65 6d 2f 43 52 43 20 6f 72 20 49 6e 74 65 6c 20 48 65 78 29 7e .byte "{U}{Return} - Upload File (Xmodem/CRC or Intel Hex)~"
>f5b6 7b 56 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 4d 6f 6e 69 74 6f 72 20 56 65 72 73 69 6f 6e 7e .byte "{V}{Return} - Monitor Version~"
>f5d4 7b 48 48 48 48 2e 48 48 48 48 3e 48 48 48 48 7b 57 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 57 72 69 74 65 20 64 61 74 61 20 69 6e 20 52 41 4d 20 74 6f 20 45 45 50 52 4f 4d 7e .byte "{HHHH.HHHH>HHHH{W}{Return} - Write data in RAM to EEPROM~"
>f60d 7b 21 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 45 6e 74 65 72 20 41 73 73 65 6d 62 6c 65 72 7e .byte "{!}{Return} - Enter Assembler~"
>f62b 7b 40 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 43 6f 6c 64 2d 53 74 61 72 74 20 45 6e 68 61 6e 63 65 64 20 42 61 73 69 63 7e .byte "{@}{Return} - Cold-Start Enhanced Basic~"
>f653 7b 23 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 57 61 72 6d 5f 53 74 61 72 74 20 45 6e 68 61 6e 63 65 64 20 42 61 73 69 63 7e .byte "{#}{Return} - Warm_Start Enhanced Basic~"
>f67b 7b 24 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 53 74 61 72 74 20 46 49 47 46 6f 72 74 68 7e .byte "{$}{Return} - Start FIGForth~"
>f698 7b 25 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 53 74 61 72 74 20 4d 69 63 72 6f 43 68 65 73 73 7e .byte "{%}{Return} - Start MicroChess~"
>f6b7 7b 3f 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 50 72 69 6e 74 20 6d 65 6e 75 20 6f 66 20 63 6f 6d 6d 61 6e 64 73 7e 7e .byte "{?}{Return} - Print menu of commands~~"
>f6dd 00 .byte $00
>f6de 7e 43 75 72 72 65 6e 74 20 63 6f 6d 6d 61 6e 64 73 20 61 72 65 20 3a 7e AsmHelpTxt .byte "~Current commands are :~"
>f6f6 53 79 6e 74 61 78 20 3d 20 7b 7d 20 72 65 71 75 69 72 65 64 2c 20 5b 5d 20 6f 70 74 69 6f 6e 61 6c 7e .byte "Syntax = {} required, [] optional~"
>f718 48 48 48 48 3d 68 65 78 20 61 64 64 72 65 73 73 2c 20 4f 50 43 3d 4f 70 63 6f 64 65 2c 20 44 44 3d 68 65 78 20 64 61 74 61 2c 20 27 5f 27 3d 53 70 61 63 65 20 42 61 72 20 6f 72 20 54 61 62 7e .byte "HHHH=hex address, OPC=Opcode, DD=hex data, '_'=Space Bar or Tab~"
>f758 27 24 27 20 53 79 6d 62 6f 6c 73 20 61 72 65 20 6f 70 74 69 6f 6e 61 6c 2c 20 61 6c 6c 20 76 61 6c 75 65 73 20 61 72 65 20 48 45 58 2e 7e .byte "'$' Symbols are optional, all values are HEX.~"
>f786 41 6e 79 20 69 6e 70 75 74 20 61 66 74 65 72 20 61 20 27 73 65 6d 69 2d 63 6f 6c 6f 6e 27 20 69 73 20 69 67 6e 6f 72 65 64 2e 7e .byte "Any input after a 'semi-colon' is ignored.~"
>f7b1 7e .byte "~"
>f7b2 7b 48 48 48 48 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 53 65 74 20 69 6e 70 75 74 20 61 64 64 72 65 73 73 7e .byte "{HHHH}{Return} - Set input address~"
>f7d5 5b 48 48 48 48 5d 5b 5f 5d 7b 4f 50 43 7d 5b 5f 5d 5b 23 28 24 44 44 5f 48 48 48 48 2c 58 29 2c 59 5d 7b 52 65 74 75 72 6e 7d 20 2d 20 41 73 73 65 6d 62 6c 65 20 6c 69 6e 65 7e .byte "[HHHH][_]{OPC}[_][#($DD_HHHH,X),Y]{Return} - Assemble line~"
>f810 5b 48 48 48 48 5d 7b 4c 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 4c 69 73 74 20 28 64 69 73 61 73 73 65 6d 62 6c 65 29 20 32 30 20 6c 69 6e 65 73 20 6f 66 20 70 72 6f 67 72 61 6d 7e .byte "[HHHH]{L}{Return} - List (disassemble) 20 lines of program~"
>f84b 7b 52 65 74 75 72 6e 7d 20 2d 20 45 78 69 74 20 41 73 73 65 6d 62 6c 65 72 20 62 61 63 6b 20 74 6f 20 4d 6f 6e 69 74 6f 72 7e .byte "{Return} - Exit Assembler back to Monitor~"
>f875 7b 3f 7d 7b 52 65 74 75 72 6e 7d 20 2d 20 50 72 69 6e 74 20 6d 65 6e 75 20 6f 66 20 63 6f 6d 6d 61 6e 64 73 7e 7e .byte "{?}{Return} - Print menu of commands~~"
>f89b 00 .byte $00
>f89c 36 35 43 30 32 20 4d 6f 6e 69 74 6f 72 20 76 35 2e 32 20 28 36 2d 32 38 2d 31 33 29 20 52 65 61 64 79 Porttxt .byte "65C02 Monitor v5.2 (6-28-13) Ready"
>f8be 0d 0a .byte $0d, $0a
>f8c0 77 69 74 68 20 45 6e 68 61 6e 63 65 64 20 42 61 73 69 63 20 49 6e 74 65 72 70 72 65 74 65 72 20 28 63 29 20 4c 65 65 20 44 61 76 69 73 6f 6e 2c .byte "with Enhanced Basic Interpreter (c) Lee Davison,"
>f8f0 0d 0a .byte $0d, $0a
>f8f2 46 49 47 46 6f 72 74 68 2c 20 61 6e 64 20 4d 69 63 72 6f 43 68 65 73 73 20 28 63 29 20 50 65 74 65 72 20 4a 65 6e 6e 69 6e 67 73 .byte "FIGForth, and MicroChess (c) Peter Jennings"
>f91d 0d 0a .byte $0d, $0a
>f91f 28 50 72 65 73 73 20 3f 20 66 6f 72 20 68 65 6c 70 29 .byte "(Press ? for help)"
>f931 00 .byte $00
.fa00 crclo
>fa00 00 21 42 63 84 a5 c6 e7 08 29 4a 6b 8c ad ce ef .byte $00,$21,$42,$63,$84,$A5,$C6,$E7,$08,$29,$4A,$6B,$8C,$AD,$CE,$EF
>fa10 31 10 73 52 b5 94 f7 d6 39 18 7b 5a bd 9c ff de .byte $31,$10,$73,$52,$B5,$94,$F7,$D6,$39,$18,$7B,$5A,$BD,$9C,$FF,$DE
>fa20 62 43 20 01 e6 c7 a4 85 6a 4b 28 09 ee cf ac 8d .byte $62,$43,$20,$01,$E6,$C7,$A4,$85,$6A,$4B,$28,$09,$EE,$CF,$AC,$8D
>fa30 53 72 11 30 d7 f6 95 b4 5b 7a 19 38 df fe 9d bc .byte $53,$72,$11,$30,$D7,$F6,$95,$B4,$5B,$7A,$19,$38,$DF,$FE,$9D,$BC
>fa40 c4 e5 86 a7 40 61 02 23 cc ed 8e af 48 69 0a 2b .byte $C4,$E5,$86,$A7,$40,$61,$02,$23,$CC,$ED,$8E,$AF,$48,$69,$0A,$2B
>fa50 f5 d4 b7 96 71 50 33 12 fd dc bf 9e 79 58 3b 1a .byte $F5,$D4,$B7,$96,$71,$50,$33,$12,$FD,$DC,$BF,$9E,$79,$58,$3B,$1A
>fa60 a6 87 e4 c5 22 03 60 41 ae 8f ec cd 2a 0b 68 49 .byte $A6,$87,$E4,$C5,$22,$03,$60,$41,$AE,$8F,$EC,$CD,$2A,$0B,$68,$49
>fa70 97 b6 d5 f4 13 32 51 70 9f be dd fc 1b 3a 59 78 .byte $97,$B6,$D5,$F4,$13,$32,$51,$70,$9F,$BE,$DD,$FC,$1B,$3A,$59,$78
>fa80 88 a9 ca eb 0c 2d 4e 6f 80 a1 c2 e3 04 25 46 67 .byte $88,$A9,$CA,$EB,$0C,$2D,$4E,$6F,$80,$A1,$C2,$E3,$04,$25,$46,$67
>fa90 b9 98 fb da 3d 1c 7f 5e b1 90 f3 d2 35 14 77 56 .byte $B9,$98,$FB,$DA,$3D,$1C,$7F,$5E,$B1,$90,$F3,$D2,$35,$14,$77,$56
>faa0 ea cb a8 89 6e 4f 2c 0d e2 c3 a0 81 66 47 24 05 .byte $EA,$CB,$A8,$89,$6E,$4F,$2C,$0D,$E2,$C3,$A0,$81,$66,$47,$24,$05
>fab0 db fa 99 b8 5f 7e 1d 3c d3 f2 91 b0 57 76 15 34 .byte $DB,$FA,$99,$B8,$5F,$7E,$1D,$3C,$D3,$F2,$91,$B0,$57,$76,$15,$34
>fac0 4c 6d 0e 2f c8 e9 8a ab 44 65 06 27 c0 e1 82 a3 .byte $4C,$6D,$0E,$2F,$C8,$E9,$8A,$AB,$44,$65,$06,$27,$C0,$E1,$82,$A3
>fad0 7d 5c 3f 1e f9 d8 bb 9a 75 54 37 16 f1 d0 b3 92 .byte $7D,$5C,$3F,$1E,$F9,$D8,$BB,$9A,$75,$54,$37,$16,$F1,$D0,$B3,$92
>fae0 2e 0f 6c 4d aa 8b e8 c9 26 07 64 45 a2 83 e0 c1 .byte $2E,$0F,$6C,$4D,$AA,$8B,$E8,$C9,$26,$07,$64,$45,$A2,$83,$E0,$C1
>faf0 1f 3e 5d 7c 9b ba d9 f8 17 36 55 74 93 b2 d1 f0 .byte $1F,$3E,$5D,$7C,$9B,$BA,$D9,$F8,$17,$36,$55,$74,$93,$B2,$D1,$F0
.fb00 crchi
>fb00 00 10 20 30 40 50 60 70 81 91 a1 b1 c1 d1 e1 f1 .byte $00,$10,$20,$30,$40,$50,$60,$70,$81,$91,$A1,$B1,$C1,$D1,$E1,$F1
>fb10 12 02 32 22 52 42 72 62 93 83 b3 a3 d3 c3 f3 e3 .byte $12,$02,$32,$22,$52,$42,$72,$62,$93,$83,$B3,$A3,$D3,$C3,$F3,$E3
>fb20 24 34 04 14 64 74 44 54 a5 b5 85 95 e5 f5 c5 d5 .byte $24,$34,$04,$14,$64,$74,$44,$54,$A5,$B5,$85,$95,$E5,$F5,$C5,$D5
>fb30 36 26 16 06 76 66 56 46 b7 a7 97 87 f7 e7 d7 c7 .byte $36,$26,$16,$06,$76,$66,$56,$46,$B7,$A7,$97,$87,$F7,$E7,$D7,$C7
>fb40 48 58 68 78 08 18 28 38 c9 d9 e9 f9 89 99 a9 b9 .byte $48,$58,$68,$78,$08,$18,$28,$38,$C9,$D9,$E9,$F9,$89,$99,$A9,$B9
>fb50 5a 4a 7a 6a 1a 0a 3a 2a db cb fb eb 9b 8b bb ab .byte $5A,$4A,$7A,$6A,$1A,$0A,$3A,$2A,$DB,$CB,$FB,$EB,$9B,$8B,$BB,$AB
>fb60 6c 7c 4c 5c 2c 3c 0c 1c ed fd cd dd ad bd 8d 9d .byte $6C,$7C,$4C,$5C,$2C,$3C,$0C,$1C,$ED,$FD,$CD,$DD,$AD,$BD,$8D,$9D
>fb70 7e 6e 5e 4e 3e 2e 1e 0e ff ef df cf bf af 9f 8f .byte $7E,$6E,$5E,$4E,$3E,$2E,$1E,$0E,$FF,$EF,$DF,$CF,$BF,$AF,$9F,$8F
>fb80 91 81 b1 a1 d1 c1 f1 e1 10 00 30 20 50 40 70 60 .byte $91,$81,$B1,$A1,$D1,$C1,$F1,$E1,$10,$00,$30,$20,$50,$40,$70,$60
>fb90 83 93 a3 b3 c3 d3 e3 f3 02 12 22 32 42 52 62 72 .byte $83,$93,$A3,$B3,$C3,$D3,$E3,$F3,$02,$12,$22,$32,$42,$52,$62,$72
>fba0 b5 a5 95 85 f5 e5 d5 c5 34 24 14 04 74 64 54 44 .byte $B5,$A5,$95,$85,$F5,$E5,$D5,$C5,$34,$24,$14,$04,$74,$64,$54,$44
>fbb0 a7 b7 87 97 e7 f7 c7 d7 26 36 06 16 66 76 46 56 .byte $A7,$B7,$87,$97,$E7,$F7,$C7,$D7,$26,$36,$06,$16,$66,$76,$46,$56
>fbc0 d9 c9 f9 e9 99 89 b9 a9 58 48 78 68 18 08 38 28 .byte $D9,$C9,$F9,$E9,$99,$89,$B9,$A9,$58,$48,$78,$68,$18,$08,$38,$28
>fbd0 cb db eb fb 8b 9b ab bb 4a 5a 6a 7a 0a 1a 2a 3a .byte $CB,$DB,$EB,$FB,$8B,$9B,$AB,$BB,$4A,$5A,$6A,$7A,$0A,$1A,$2A,$3A
>fbe0 fd ed dd cd bd ad 9d 8d 7c 6c 5c 4c 3c 2c 1c 0c .byte $FD,$ED,$DD,$CD,$BD,$AD,$9D,$8D,$7C,$6C,$5C,$4C,$3C,$2C,$1C,$0C
>fbf0 ef ff cf df af bf 8f 9f 6e 7e 4e 5e 2e 3e 0e 1e .byte $EF,$FF,$CF,$DF,$AF,$BF,$8F,$9F,$6E,$7E,$4E,$5E,$2E,$3E,$0E,$1E
.fc00 20 fc fc jsr $fcfc XModem jsr prtMsg ; send prompt and info
.fc03 a9 01 lda #$01 lda #$01
.fc05 85 3c sta $3c sta blkno ; set block # to 1
.fc07 85 3f sta $3f sta bflag ; set flag to get address from block 1
.fc09 a9 43 lda #$43 StartCrc lda #"C" ; "C" start with CRC mode
.fc0b 20 fb e7 jsr $e7fb jsr output ; send it
.fc0e a9 ff lda #$ff lda #$FF
.fc10 85 3e sta $3e sta retry2 ; set loop counter for ~3 sec delay
.fc12 a9 00 lda #$00 lda #$00
.fc14 85 38 sta $38 sta crc
.fc16 85 39 sta $39 sta crch ; init CRC value
.fc18 20 e9 fc jsr $fce9 jsr GetByte ; wait for input
.fc1b b0 11 bcs $fc2e bcs GotByte ; byte received, process it
.fc1d 90 ea bcc $fc09 bcc StartCrc ; resend "C"
.fc1f a9 ff lda #$ff StartBlk lda #$FF ;
.fc21 85 3e sta $3e sta retry2 ; set loop counter for ~3 sec delay
.fc23 a9 00 lda #$00 lda #$00 ;
.fc25 85 38 sta $38 sta crc ;
.fc27 85 39 sta $39 sta crch ; init CRC value
.fc29 20 e9 fc jsr $fce9 jsr GetByte ; get first byte of block
.fc2c 90 f1 bcc $fc1f bcc StartBlk ; timed out, keep waiting...
.fc2e c9 1b cmp #$1b GotByte cmp #ESC ; quitting?
.fc30 d0 01 bne $fc33 bne GotByte3
.fc32 00 brk brk
.fc33 c9 01 cmp #$01 GotByte3 cmp #SOH ; start of block?
.fc35 f0 0e beq $fc45 beq BegBlk ; yes
.fc37 c9 3a cmp #$3a cmp #":" ; Intel-Hex format - jump to its handler below
.fc39 d0 03 bne $fc3e bne GotByte1 ;
.fc3b 4c 5a fd jmp $fd5a jmp HexUpLd ;
.fc3e c9 04 cmp #$04 GotByte1 cmp #EOT ;
.fc40 d0 59 bne $fc9b bne BadCrc ; Not SOH, ":", EOT, so flush buffer & send NAK
.fc42 4c dc fc jmp $fcdc jmp Done ; EOT - all done!
.fc45 a2 00 ldx #$00 BegBlk ldx #$00
.fc47 a9 ff lda #$ff GetBlk lda #$ff ; 3 sec window to receive characters
.fc49 85 3e sta $3e sta retry2 ;
.fc4b 20 e9 fc jsr $fce9 GetBlk1 jsr GetByte ; get next character
.fc4e 90 4b bcc $fc9b bcc BadCrc ; chr rcv error, flush and send NAK
.fc50 9d 00 03 sta $0300,x GetBlk2 sta Rbuff,x ; good char, save it in the rcv buffer
.fc53 e8 inx inx ; inc buffer pointer
.fc54 e0 84 cpx #$84 cpx #$84 ; <01> <FE> <128 bytes> <CRCH> <CRCL>
.fc56 d0 ef bne $fc47 bne GetBlk ; get 132 characters
.fc58 a2 00 ldx #$00 ldx #$00 ;
.fc5a bd 00 03 lda $0300,x lda Rbuff,x ; get block # from buffer
.fc5d c5 3c cmp $3c cmp blkno ; compare to expected block #
.fc5f f0 0b beq $fc6c beq GoodBlk1 ; matched!
.fc61 a9 fe lda #$fe lda #>MsgCrcBadBlkno
.fc63 a2 45 ldx #$45 ldx #<MsgCrcBadBlkno
.fc65 20 30 fe jsr $fe30 jsr PrintStrAX ; Unexpected block number - abort
.fc68 20 40 fd jsr $fd40 jsr Flush ; mismatched - flush buffer and then do BRK
.fc6b 00 brk brk ; unexpected block # - fatal error
.fc6c 49 ff eor #$ff GoodBlk1 eor #$ff ; 1's comp of block #
.fc6e e8 inx inx ;
.fc6f dd 00 03 cmp $0300,x cmp Rbuff,x ; compare with expected 1's comp of block #
.fc72 f0 0b beq $fc7f beq GoodBlk2 ; matched!
.fc74 a9 fe lda #$fe lda #>MsgCrcBadBlkno
.fc76 a2 45 ldx #$45 ldx #<MsgCrcBadBlkno
.fc78 20 30 fe jsr $fe30 jsr PrintStrAX ; Unexpected block number - abort
.fc7b 20 40 fd jsr $fd40 jsr Flush ; mismatched - flush buffer and then do BRK
.fc7e 00 brk brk ; bad 1's comp of block#
.fc7f a0 02 ldy #$02 GoodBlk2 ldy #$02 ;
.fc81 b9 00 03 lda $0300,y CalcCrc lda Rbuff,y ; calculate the CRC for the 128 bytes of data
.fc84 20 4a fd jsr $fd4a jsr UpdCrc ; could inline sub here for speed
.fc87 c8 iny iny ;
.fc88 c0 82 cpy #$82 cpy #$82 ; 128 bytes
.fc8a d0 f5 bne $fc81 bne CalcCrc ;
.fc8c b9 00 03 lda $0300,y lda Rbuff,y ; get hi CRC from buffer
.fc8f c5 39 cmp $39 cmp crch ; compare to calculated hi CRC
.fc91 d0 08 bne $fc9b bne BadCrc ; bad crc, send NAK
.fc93 c8 iny iny ;
.fc94 b9 00 03 lda $0300,y lda Rbuff,y ; get lo CRC from buffer
.fc97 c5 38 cmp $38 cmp crc ; compare to calculated lo CRC
.fc99 f0 0b beq $fca6 beq GoodCrc ; good CRC
.fc9b 20 40 fd jsr $fd40 BadCrc jsr Flush ; flush the input port
.fc9e a9 15 lda #$15 lda #NAK ;
.fca0 20 fb e7 jsr $e7fb jsr output ; send NAK to resend block
.fca3 4c 1f fc jmp $fc1f jmp StartBlk ; start over, get the block again
.fca6 a2 02 ldx #$02 GoodCrc ldx #$02 ;
.fca8 a5 3c lda $3c lda blkno ; get the block number
.fcaa c9 01 cmp #$01 cmp #$01 ; 1st block?
.fcac d0 12 bne $fcc0 bne CopyBlk ; no, copy all 128 bytes
.fcae a5 3f lda $3f lda bflag ; is it really block 1, not block 257, 513 etc.
.fcb0 f0 0e beq $fcc0 beq CopyBlk ; no, copy all 128 bytes
.fcb2 bd 00 03 lda $0300,x lda Rbuff,x ; get target address from 1st 2 bytes of blk 1
.fcb5 85 3a sta $3a sta ptr ; save lo address
.fcb7 e8 inx inx ;
.fcb8 bd 00 03 lda $0300,x lda Rbuff,x ; get hi address
.fcbb 85 3b sta $3b sta ptr+1 ; save it
.fcbd e8 inx inx ; point to first byte of data
.fcbe c6 3f dec $3f dec bflag ; set the flag so we won't get another address
.fcc0 a0 00 ldy #$00 CopyBlk ldy #$00 ; set offset to zero
.fcc2 bd 00 03 lda $0300,x CopyBlk3 lda Rbuff,x ; get data byte from buffer
.fcc5 91 3a sta ($3a),y sta (ptr),y ; save to target
.fcc7 e6 3a inc $3a inc ptr ; point to next address
.fcc9 d0 02 bne $fccd bne CopyBlk4 ; did it step over page boundry?
.fccb e6 3b inc $3b inc ptr+1 ; adjust high address for page crossing
.fccd e8 inx CopyBlk4 inx ; point to next data byte
.fcce e0 82 cpx #$82 cpx #$82 ; is it the last byte
.fcd0 d0 f0 bne $fcc2 bne CopyBlk3 ; no, get the next one
.fcd2 e6 3c inc $3c IncBlk inc blkno ; done. Inc the block #
.fcd4 a9 06 lda #$06 lda #ACK ; send ACK
.fcd6 20 fb e7 jsr $e7fb jsr output
.fcd9 4c 1f fc jmp $fc1f jmp StartBlk ; get next block
.fcdc a9 06 lda #$06 Done lda #ACK ; last block, send ACK and exit.
.fcde 20 fb e7 jsr $e7fb jsr output
.fce1 a9 fe lda #$fe lda #>MsgCrcDone
.fce3 a2 75 ldx #$75 ldx #<MsgCrcDone
.fce5 20 30 fe jsr $fe30 jsr PrintStrAX ;
.fce8 60 rts rts ;
.fce9 a9 00 lda #$00 GetByte lda #$00 ; wait for chr input and cycle timing loop
.fceb 85 3d sta $3d sta retry ; set low value of timing loop
.fced 20 f8 e7 jsr $e7f8 StartCrcLp jsr Scan_Input ; get chr from serial port, don't wait
.fcf0 b0 09 bcs $fcfb bcs GetByte1 ; got one, so exit
.fcf2 c6 3d dec $3d dec retry ; no character received, so dec counter
.fcf4 d0 f7 bne $fced bne StartCrcLp ;
.fcf6 c6 3e dec $3e dec retry2 ; dec hi byte of counter
.fcf8 d0 f3 bne $fced bne StartCrcLp ; look for character again
.fcfa 18 clc clc ; if loop times out, CLC, else SEC and return
.fcfb 60 rts GetByte1 rts ; with character in "A"
.fcfc a2 00 ldx #$00 PrtMsg ldx #$00 ; PRINT starting message
.fcfe bd 0b fd lda $fd0b,x PrtMsg1 lda Msg,x
.fd01 f0 07 beq $fd0a beq PrtMsg2
.fd03 20 fb e7 jsr $e7fb jsr output
.fd06 e8 inx inx
.fd07 4c fe fc jmp $fcfe jmp PrtMsg1
.fd0a 60 rts PrtMsg2 rts
>fd0b 42 65 67 69 6e 20 58 4d 4f 44 45 4d 2f 43 52 43 20 74 72 61 6e 73 66 65 72 2e Msg .byte "Begin XMODEM/CRC transfer."
>fd25 0d 0a .byte CRN,LF
>fd27 50 72 65 73 73 20 3c 45 73 63 3e 20 74 6f 20 61 62 6f 72 74 2e 2e 2e 20 .byte "Press <Esc> to abort... "
>fd3f 00 .byte 0
.fd40 a9 70 lda #$70 Flush lda #$70 ; flush receive buffer
.fd42 85 3e sta $3e sta retry2 ; flush until empty for ~1 sec.
.fd44 20 e9 fc jsr $fce9 Flush1 jsr GetByte ; read the port
.fd47 b0 f7 bcs $fd40 bcs Flush
.fd49 60 rts rts
.fd4a 45 39 eor $39 UpdCrc eor crc+1 ; Quick CRC computation with lookup tables
.fd4c aa tax tax
.fd4d a5 38 lda $38 lda crc
.fd4f 5d 00 fb eor $fb00,x eor CRCHI,X
.fd52 85 39 sta $39 sta crc+1
.fd54 bd 00 fa lda $fa00,x lda CRCLO,X
.fd57 85 38 sta $38 sta crc
.fd59 60 rts rts
.fd5a a9 0d lda #$0d HexUpLd lda #CRN
.fd5c 20 fb e7 jsr $e7fb jsr output
.fd5f a9 0a lda #$0a lda #LF
.fd61 20 fb e7 jsr $e7fb jsr output
.fd64 a9 00 lda #$00 lda #0
.fd66 85 3e sta $3e sta dlfail ;Start by assuming no D/L failure
.fd68 f0 07 beq $fd71 beq IHex
.fd6a 20 0a fe jsr $fe0a HdwRecs jsr GetSer ; Wait for start of record mark ':'
.fd6d c9 3a cmp #$3a cmp #":"
.fd6f d0 f9 bne $fd6a bne HdwRecs ; not found yet
.fd71 20 13 fe jsr $fe13 IHex jsr GetHex ; Get the record length
.fd74 85 39 sta $39 sta reclen ; save it
.fd76 85 38 sta $38 sta chksum ; and save first byte of checksum
.fd78 20 13 fe jsr $fe13 jsr GetHex ; Get the high part of start address
.fd7b 85 3c sta $3c sta start_hi
.fd7d 18 clc clc
.fd7e 65 38 adc $38 adc chksum ; Add in the checksum
.fd80 85 38 sta $38 sta chksum ;
.fd82 20 13 fe jsr $fe13 jsr GetHex ; Get the low part of the start address
.fd85 85 3b sta $3b sta start_lo
.fd87 18 clc clc
.fd88 65 38 adc $38 adc chksum
.fd8a 85 38 sta $38 sta chksum
.fd8c 20 13 fe jsr $fe13 jsr GetHex ; Get the record type
.fd8f 85 3d sta $3d sta rectype ; & save it
.fd91 18 clc clc
.fd92 65 38 adc $38 adc chksum
.fd94 85 38 sta $38 sta chksum
.fd96 a5 3d lda $3d lda rectype
.fd98 d0 2c bne $fdc6 bne HdEr1 ; end-of-record
.fd9a a6 39 ldx $39 ldx reclen ; number of data bytes to write to memory
.fd9c a0 00 ldy #$00 ldy #0 ; start offset at 0
.fd9e 20 13 fe jsr $fe13 HdLp1 jsr GetHex ; Get the first/next/last data byte
.fda1 91 3b sta ($3b),y sta (start_lo),y ; Save it to RAM
.fda3 18 clc clc
.fda4 65 38 adc $38 adc chksum
.fda6 85 38 sta $38 sta chksum ;
.fda8 c8 iny iny ; update data pointer
.fda9 ca dex dex ; decrement count
.fdaa d0 f2 bne $fd9e bne HdLp1
.fdac 20 13 fe jsr $fe13 jsr GetHex ; get the checksum
.fdaf 18 clc clc
.fdb0 65 38 adc $38 adc chksum
.fdb2 d0 08 bne $fdbc bne HdDlF1 ; If failed, report it
.fdb4 a9 23 lda #$23 lda #"#" ; Character indicating record OK = '#'
.fdb6 8d c6 3f sta $3fc6 sta UDR0 ; write it out but don't wait for output
.fdb9 4c 6a fd jmp $fd6a jmp HdwRecs ; get next record
.fdbc a9 46 lda #$46 HdDlF1 lda #"F" ; Character indicating record failure = 'F'
.fdbe 85 3e sta $3e sta dlfail ; upload failed if non-zero
.fdc0 8d c6 3f sta $3fc6 sta UDR0 ; write it to transmit buffer register
.fdc3 4c 6a fd jmp $fd6a jmp HdwRecs ; wait for next record start
.fdc6 c9 01 cmp #$01 HdEr1 cmp #1 ; Check for end-of-record type
.fdc8 f0 1b beq $fde5 beq HdEr2
.fdca a9 fe lda #$fe lda #>MsgUnknownRecType
.fdcc a2 97 ldx #$97 ldx #<MsgUnknownRecType
.fdce 20 30 fe jsr $fe30 jsr PrintStrAX ; Warn user of unknown record type
.fdd1 a5 3d lda $3d lda rectype ; Get it
.fdd3 85 3e sta $3e sta dlfail ; non-zero --> upload has failed
.fdd5 20 60 e7 jsr $e760 jsr Print1Byte ; print it
.fdd8 a9 0d lda #$0d lda #CRN ; but we'll let it finish so as not to
.fdda 20 fb e7 jsr $e7fb jsr output ; falsely start a new d/l from existing
.fddd a9 0a lda #$0a lda #LF ; file that may still be coming in for
.fddf 20 fb e7 jsr $e7fb jsr output ; quite some time yet.
.fde2 4c 6a fd jmp $fd6a jmp HdwRecs
.fde5 20 13 fe jsr $fe13 HdEr2 jsr GetHex ; get the checksum
.fde8 18 clc clc
.fde9 65 38 adc $38 adc chksum ; Add previous checksum accumulator value
.fdeb f0 07 beq $fdf4 beq HdEr3 ; checksum = 0 means we're OK!
.fded a9 fe lda #$fe lda #>MsgBadRecChksum
.fdef a2 b1 ldx #$b1 ldx #<MsgBadRecChksum
.fdf1 4c 30 fe jmp $fe30 jmp PrintStrAX
.fdf4 a5 3e lda $3e HdEr3 lda dlfail
.fdf6 f0 07 beq $fdff beq HdErOK
.fdf8 a9 fe lda #$fe lda #>MsgUploadFail
.fdfa a2 ca ldx #$ca ldx #<MsgUploadFail
.fdfc 4c 30 fe jmp $fe30 jmp PrintStrAX
.fdff a9 fe lda #$fe HdErOK lda #>MsgUploadOK
.fe01 a2 e7 ldx #$e7 ldx #<MsgUploadOK
.fe03 20 30 fe jsr $fe30 jsr PrintStrAX
.fe06 20 40 fd jsr $fd40 jsr Flush ; flush the input buffer
.fe09 60 rts HdErNX rts
.fe0a 20 f8 e7 jsr $e7f8 GetSer jsr scan_input ; get input from Serial Port
.fe0d c9 1b cmp #$1b cmp #ESC ; check for abort
.fe0f d0 01 bne $fe12 bne GSerXit ; return character if not
.fe11 00 brk brk
.fe12 60 rts GSerXit rts
.fe13 a9 00 lda #$00 GetHex lda #$00
.fe15 85 3f sta $3f sta temp
.fe17 20 20 fe jsr $fe20 jsr GetNibl
.fe1a 0a asl asl a
.fe1b 0a asl asl a
.fe1c 0a asl asl a
.fe1d 0a asl asl a ; This is the upper nibble
.fe1e 85 3f sta $3f sta temp
.fe20 20 0a fe jsr $fe0a GetNibl jsr GetSer
.fe23 c9 3a cmp #$3a cmp #"9"+1 ; See if it's 0-9 or 'A'..'F' (no lowercase yet)
.fe25 90 02 bcc $fe29 bcc MkNnh ; If we borrowed, we lost the carry so 0..9
.fe27 e9 08 sbc #$08 sbc #7+1 ; Subtract off extra 7 (sbc subtracts off one less)
.fe29 e9 2f sbc #$2f MkNnh sbc #"0"-1 ; subtract off '0' (if carry clear coming in)
.fe2b 29 0f and #$0f and #$0F ; no upper nibble no matter what
.fe2d 05 3f ora $3f ora temp
.fe2f 60 rts rts ; return with the nibble received
.fe30 85 41 sta $41 PrintStrAX sta strptr+1
.fe32 86 40 stx $40 stx strptr
.fe34 98 tya tya
.fe35 48 pha pha
.fe36 a0 00 ldy #$00 ldy #0
.fe38 b1 40 lda ($40),y PrintStrAXL1 lda (strptr),y
.fe3a f0 06 beq $fe42 beq PrintStrAXX1 ; quit if NULL
.fe3c 20 fb e7 jsr $e7fb jsr output
.fe3f c8 iny iny
.fe40 d0 f6 bne $fe38 bne PrintStrAXL1 ; quit if > 255
.fe42 68 pla PrintStrAXX1 pla
.fe43 a8 tay tay
.fe44 60 rts rts
>fe45 0d 0a 0d 0a MsgCrcBadBlkno .byte CRN,LF,CRN,LF
>fe49 55 6e 65 78 70 65 63 74 65 64 20 62 6c 6f 63 6b 20 6e 75 6d 62 65 72 20 72 65 63 65 69 76 65 64 .byte "Unexpected block number received"
>fe69 20 41 62 6f 72 74 69 6e 67 .byte " Aborting"
>fe72 0d 0a .byte CRN,LF
>fe74 00 .byte 0
>fe75 0d 0a MsgCrcDone .byte CRN,LF
>fe77 58 4d 4f 44 45 4d 2d 43 52 43 20 64 6f 77 6e 6c 6f 61 64 20 69 73 20 63 6f 6d 70 6c 65 74 65 .byte "XMODEM-CRC download is complete"
>fe96 00 .byte 0
.fe97 msgunknownrectype
>fe97 0d 0a 0d 0a .byte CRN,LF,CRN,LF
>fe9b 55 6e 6b 6e 6f 77 6e 20 72 65 63 6f 72 64 20 74 79 70 65 20 24 .byte "Unknown record type $"
>feb0 00 .byte 0 ; null-terminate every string
>feb1 0d 0a 0d 0a MsgBadRecChksum .byte CRN,LF,CRN,LF
>feb5 42 61 64 20 72 65 63 6f 72 64 20 63 68 65 63 6b 73 75 6d 21 .byte "Bad record checksum!"
>fec9 00 .byte 0 ; Null-terminate
>feca 0d 0a 0d 0a MsgUploadFail .byte CRN,LF,CRN,LF
>fece 55 70 6c 6f 61 64 20 46 61 69 6c 65 64 0d 0a .byte "Upload Failed",CRN,LF
>fedd 41 62 6f 72 74 69 6e 67 21 .byte "Aborting!"
>fee6 00 .byte 0 ; null-terminate every string or crash'n'burn
>fee7 0d 0a 0d 0a MsgUploadOK .byte CRN,LF,CRN,LF
>feeb 55 70 6c 6f 61 64 20 53 75 63 63 65 73 73 66 75 6c 21 .byte "Upload Successful!"
>fefd 00 .byte 0
.ff00 78 sei Reset SEI ; diable interupts
.ff01 d8 cld CLD ; clear decimal mode
.ff02 a2 ff ldx #$ff LDX #$FF ;
.ff04 9a txs TXS ; init stack pointer
.ff05 a2 c7 ldx #$c7 Set_Vectors LDX #<Start_OS ; *** only outside reference in reset routine
.ff07 a9 e6 lda #$e6 LDA #>Start_OS ; *** points to Monitor Boot routine
.ff09 8d f8 03 sta $03f8 sta RESvector+1 ;
.ff0c 8e f7 03 stx $03f7 stx RESvector ;
.ff0f a2 65 ldx #$65 LDX #<INTret ; set up to point to RTI command
.ff11 a9 ff lda #$ff LDA #>INTret ; (no system NMI applications)
.ff13 8d fe 03 sta $03fe sta NMIvector+1 ;
.ff16 8e fd 03 stx $03fd stx NMIvector ;
.ff19 a2 65 ldx #$65 LDX #<INTret ; set up to point to RTI command
.ff1b a9 ff lda #$ff LDA #>INTret ; (no system INT applications)
.ff1d 8d fb 03 sta $03fb sta INTvector+1 ;
.ff20 8e fa 03 stx $03fa stx INTvector ;
.ff23 a2 0c ldx #$0c LDX #<BRKroutine ; set up to point to my BRK routine
.ff25 a9 e8 lda #$e8 LDA #>BRKroutine ;
.ff27 8d f5 03 sta $03f5 sta BRKvector+1 ;
.ff2a 8e f4 03 stx $03f4 stx BRKvector ;
.ff2d a9 e7 lda #$e7 lda #<ACIA1_Scan
.ff2f 8d 05 04 sta $0405 sta VEC_IN
.ff32 a9 a4 lda #$a4 lda #>ACIA1_Scan
.ff34 8d 06 04 sta $0406 sta VEC_IN+1
.ff37 a9 f4 lda #$f4 lda #<ACIA1_Output
.ff39 8d 07 04 sta $0407 sta VEC_OUT
.ff3c a9 a4 lda #$a4 lda #>ACIA1_OUTPUT
.ff3e 8d 08 04 sta $0408 sta VEC_OUT+1
.ff41 a9 59 lda #$59 lda #<Psave
.ff43 8d 0b 04 sta $040b sta VEC_SV
.ff46 a9 e6 lda #$e6 lda #>Psave
.ff48 8d 0c 04 sta $040c sta VEC_SV+1
.ff4b a9 82 lda #$82 lda #<pload
.ff4d 8d 09 04 sta $0409 sta VEC_LD
.ff50 a9 e6 lda #$e6 lda #>pload
.ff52 8d 0a 04 sta $040a sta VEC_LD+1
.ff55 20 83 a4 jsr $a483 jsr ACIA1_init ; init the I/O devices
.ff58 a9 00 lda #$00 Clr_regs lda #$00 ; Clear registers
.ff5a a8 tay TAY ;
.ff5b aa tax TAX ;
.ff5c 18 clc CLC ; clear flags
.ff5d d8 cld CLD ; clear decimal mode
.ff5e 58 cli CLI ; Enable interrupt system
.ff5f 6c f7 03 jmp ($03f7) JMP (RESvector) ; Monitor for cold reset
.ff62 6c fd 03 jmp ($03fd) NMIjump jmp (NMIvector) ;
.ff65 40 rti INTret RTI ; Null Interrupt return
.ff66 da phx Interrupt PHX ;
.ff67 48 pha PHA ;
.ff68 ba tsx TSX ; get stack pointer
.ff69 bd 03 01 lda $0103,x LDA $0103,X ; load INT-P Reg off stack
.ff6c 29 10 and #$10 AND #$10 ; mask BRK
.ff6e d0 05 bne $ff75 BNE BrkCmd ; BRK CMD
.ff70 68 pla PLA ;
.ff71 fa plx PLX ;
.ff72 6c fa 03 jmp ($03fa) jmp (INTvector) ; let user routine have it
.ff75 68 pla BrkCmd pla ;
.ff76 fa plx plx ;
.ff77 6c f4 03 jmp ($03f4) jmp (BRKvector) ; patch in user BRK routine
.ff7a 60 rts RRTS rts ; documented RTS instruction
>fffa 62 ff .word NMIjump
>fffc 00 ff .word Reset
>fffe 66 ff .word Interrupt
--- end of code ---
Reference in New Issue View Git Blame Copy Permalink