| Line 46... |
Line 46... |
CTRLS EQU 0x13
|
CTRLS EQU 0x13
|
CTRLX EQU 0x18
|
CTRLX EQU 0x18
|
XON EQU 0x11
|
XON EQU 0x11
|
XOFF EQU 0x13
|
XOFF EQU 0x13
|
|
|
CursorRow EQU 0x212
|
CursorRow EQU 0x7C2
|
CursorCol EQU 0x213
|
CursorCol EQU 0x7C3
|
CursorFlash EQU 0x214
|
CursorFlash EQU 0x7C4
|
|
IRQFlag EQU 0x7C6
|
OSSP EQU 0x400
|
|
TXTUNF EQU 0x401
|
OSSP EQU 0x700
|
VARBGN EQU 0x402
|
TXTUNF EQU 0x701
|
LOPVAR EQU 0x403
|
VARBGN EQU 0x702
|
STKGOS EQU 0x404
|
LOPVAR EQU 0x703
|
CURRNT EQU 0x405
|
STKGOS EQU 0x704
|
|
CURRNT EQU 0x705
|
BUFFER EQU 0x406
|
BUFFER EQU 0x406
|
BUFLEN EQU 84
|
BUFLEN EQU 84
|
LOPPT EQU 0x460
|
LOPPT EQU 0x760
|
LOPLN EQU 0x461
|
LOPLN EQU 0x761
|
LOPINC EQU 0x462
|
LOPINC EQU 0x762
|
LOPLMT EQU 0x463
|
LOPLMT EQU 0x763
|
NUMWKA EQU 0x464
|
NUMWKA EQU 0x764
|
STKINP EQU 0x474
|
STKINP EQU 0x774
|
STKBOT EQU 0x475
|
STKBOT EQU 0x775
|
usrJmp EQU 0x476
|
usrJmp EQU 0x776
|
|
IRQROUT EQU 0x777
|
|
|
|
|
|
|
cpu rtf65002
|
cpu rtf65002
|
code
|
code
|
| Line 125... |
Line 127... |
sub #4096 ; reserve 4K for the stack
|
sub #4096 ; reserve 4K for the stack
|
sta STKBOT
|
sta STKBOT
|
sub #16384 ; 1000 vars
|
sub #16384 ; 1000 vars
|
sta VARBGN
|
sta VARBGN
|
jsr clearVars ; clear the variable area
|
jsr clearVars ; clear the variable area
|
|
stz IRQROUT
|
lda VARBGN ; calculate number of bytes free
|
lda VARBGN ; calculate number of bytes free
|
ldy TXTUNF
|
ldy TXTUNF
|
sub r1,r1,r3
|
sub r1,r1,r3
|
ldx #12 ; max 12 digits
|
ldx #12 ; max 12 digits
|
jsr PRTNUM
|
jsr PRTNUM
|
| Line 197... |
Line 200... |
st r13,TXTUNF
|
st r13,TXTUNF
|
ld r9,r13
|
ld r9,r13
|
ST4:
|
ST4:
|
; here we're inserting because the line wasn't found
|
; here we're inserting because the line wasn't found
|
; or it was deleted from the text area
|
; or it was deleted from the text area
|
ld r1,r12 ; calculate the length of new line
|
sub r1,r12,r8 ; calculate the length of new line
|
sub r1,r1,r8
|
|
cmp #2 ; is it just a line no. & CR? if so, it was just a delete
|
cmp #2 ; is it just a line no. & CR? if so, it was just a delete
|
beq ST3
|
beq ST3
|
bcc ST3
|
bcc ST3
|
|
|
ld r11,TXTUNF ; compute new end of text
|
; compute new end of text
|
ld r10,r11 ; r10 = old TXTUNF
|
ld r10,TXTUNF ; r10 = old TXTUNF
|
add r11,r11,r1 ; r11 = new top of TXTUNF (r1=line length)
|
add r11,r10,r1 ; r11 = new top of TXTUNF (r1=line length)
|
|
|
cmp r11,VARBGN ; see if there's enough room
|
cmp r11,VARBGN ; see if there's enough room
|
bcc ST5
|
bcc ST5
|
lda #msgTooBig ; if not, say so
|
lda #msgTooBig ; if not, say so
|
jmp ERROR
|
jmp ERROR
|
| Line 282... |
Line 284... |
db "BY",'E'+0x80
|
db "BY",'E'+0x80
|
db "SY",'S'+0x80
|
db "SY",'S'+0x80
|
db "CL",'S'+0x80
|
db "CL",'S'+0x80
|
db "CL",'R'+0x80
|
db "CL",'R'+0x80
|
db "RDC",'F'+0x80
|
db "RDC",'F'+0x80
|
|
db "ONIR",'Q'+0x80
|
|
db "WAI",'T'+0x80
|
db 0
|
db 0
|
TAB4:
|
TAB4:
|
db "PEE",'K'+0x80 ;Functions
|
db "PEE",'K'+0x80 ;Functions
|
db "RN",'D'+0x80
|
db "RN",'D'+0x80
|
db "AB",'S'+0x80
|
db "AB",'S'+0x80
|
|
db "SG",'N'+0x80
|
db "TIC",'K'+0x80
|
db "TIC",'K'+0x80
|
db "SIZ",'E'+0x80
|
db "SIZ",'E'+0x80
|
db "US",'R'+0x80
|
db "US",'R'+0x80
|
db 0
|
db 0
|
TAB5:
|
TAB5:
|
| Line 339... |
Line 344... |
dh GOBYE
|
dh GOBYE
|
dh SYSX
|
dh SYSX
|
dh _cls
|
dh _cls
|
dh _clr
|
dh _clr
|
dh _rdcf
|
dh _rdcf
|
|
dh ONIRQ
|
|
dh WAITIRQ
|
dh DEFLT
|
dh DEFLT
|
TAB4_1:
|
TAB4_1:
|
dh PEEK ;Functions
|
dh PEEK ;Functions
|
dh RND
|
dh RND
|
dh ABS
|
dh ABS
|
|
dh SGN
|
dh TICKX
|
dh TICKX
|
dh SIZEX
|
dh SIZEX
|
dh USRX
|
dh USRX
|
dh XP40
|
dh XP40
|
TAB5_1
|
TAB5_1
|
| Line 379... |
Line 387... |
DIRECT:
|
DIRECT:
|
ld r9,#TAB1
|
ld r9,#TAB1
|
ld r10,#TAB1_1
|
ld r10,#TAB1_1
|
EXEC:
|
EXEC:
|
jsr IGNBLK ; ignore leading blanks
|
jsr IGNBLK ; ignore leading blanks
|
or r11,r8,r0 ; save the pointer
|
ld r11,r8 ; save the pointer
|
eor r3,r3,r3 ; clear match flag
|
eor r3,r3,r3 ; clear match flag
|
EXLP:
|
EXLP:
|
lda (r8) ; get the program character
|
lda (r8) ; get the program character
|
inc r8
|
inc r8
|
lb r2,$0,r9 ; get the table character
|
lb r2,$0,r9 ; get the table character
|
bne EXNGO ; If end of table,
|
bne EXNGO ; If end of table,
|
or r8,r11,r0 ; restore the text pointer and...
|
ld r8,r11 ; restore the text pointer and...
|
bra EXGO ; execute the default.
|
bra EXGO ; execute the default.
|
EXNGO:
|
EXNGO:
|
cmp r1,r3 ; Else check for period... if so, execute
|
cmp r1,r3 ; Else check for period... if so, execute
|
beq EXGO
|
beq EXGO
|
and r2,r2,#0x7f ; ignore the table's high bit
|
and r2,r2,#0x7f ; ignore the table's high bit
|
cmp r2,r1 ; is there a match?
|
cmp r2,r1 ; is there a match?
|
beq EXMAT
|
beq EXMAT
|
inc r10 ;if not, try the next entry
|
inc r10 ;if not, try the next entry
|
inc r10
|
inc r10
|
or r8,r11,r0 ; reset the program pointer
|
ld r8,r11 ; reset the program pointer
|
eor r3,r3,r3 ; sorry, no match
|
eor r3,r3,r3 ; sorry, no match
|
EX1:
|
EX1:
|
lb r1,0,r9 ; get to the end of the entry
|
lb r1,0,r9 ; get to the end of the entry
|
inc r9
|
inc r9
|
bit #$80 ; test for bit 7 set
|
bit #$80 ; test for bit 7 set
|
| Line 412... |
Line 420... |
inc r9
|
inc r9
|
bit #$80 ; test for bit 7 set
|
bit #$80 ; test for bit 7 set
|
beq EXLP ; if not, go back for more
|
beq EXLP ; if not, go back for more
|
EXGO:
|
EXGO:
|
; execute the appropriate routine
|
; execute the appropriate routine
|
lb r11,0,r10 ; get the low order byte
|
lb r1,1,r10 ; get the low mid order byte
|
inc r10
|
asl
|
lb r12,0,r10 ; get the low mid order byte
|
asl
|
asl r12
|
asl
|
asl r12
|
asl
|
asl r12
|
asl
|
asl r12
|
asl
|
asl r12
|
asl
|
asl r12
|
asl
|
asl r12
|
orb r1,r1,0,r10 ; get the low order byte
|
asl r12
|
or r1,r1,#$FFFF0000 ; add in ROM base
|
or r11,r11,r12
|
jmp (r1)
|
or r11,r11,#$FFFF0000 ; add in ROM base
|
|
jmp (r11)
|
|
|
|
; lb r1,[r8] ; get token from text space
|
|
; bpl
|
|
; and r1,#0x7f
|
|
; shl r1,#2 ; * 4 - word offset
|
|
; add r1,r1,#TAB1_1
|
|
; lw r1,[r1]
|
|
; jmp [r1]
|
|
|
|
|
|
;******************************************************************
|
;******************************************************************
|
;
|
;
|
; What follows is the code to execute direct and statement
|
; What follows is the code to execute direct and statement
|
| Line 489... |
Line 487... |
jsr clearVars
|
jsr clearVars
|
|
|
RUNNXL ; RUN
|
RUNNXL ; RUN
|
lda CURRNT ; executing a program?
|
lda CURRNT ; executing a program?
|
beq WSTART ; if not, we've finished a direct stat.
|
beq WSTART ; if not, we've finished a direct stat.
|
|
lda IRQROUT ; are we handling IRQ's ?
|
|
beq RUN1
|
|
ld r0,IRQFlag ; was there an IRQ ?
|
|
beq RUN1
|
|
stz IRQFlag
|
|
jsr PUSHA ; the same code as a GOSUB
|
|
push r8
|
|
lda CURRNT
|
|
pha ; found it, save old 'CURRNT'...
|
|
lda STKGOS
|
|
pha ; and 'STKGOS'
|
|
stz LOPVAR ; load new values
|
|
tsx
|
|
stx STKGOS
|
|
ld r9,IRQROUT
|
|
bra RUNTSL
|
|
RUN1
|
lda #0 ; else find the next line number
|
lda #0 ; else find the next line number
|
ld r9,r8
|
ld r9,r8
|
jsr FNDLNP ; search for the next line
|
jsr FNDLNP ; search for the next line
|
cmp #0
|
; cmp #0
|
bne RUNTSL
|
; bne RUNTSL
|
cmp r9,TXTUNF; if we've fallen off the end, stop
|
cmp r9,TXTUNF; if we've fallen off the end, stop
|
beq WSTART
|
beq WSTART
|
bcs WSTART
|
bcs WSTART
|
|
|
RUNTSL ; RUN
|
RUNTSL ; RUN
|
| Line 513... |
Line 528... |
|
|
; 'GOTO expr' evaluates the expression, finds the target
|
; 'GOTO expr' evaluates the expression, finds the target
|
; line, and jumps to 'RUNTSL' to do it.
|
; line, and jumps to 'RUNTSL' to do it.
|
;
|
;
|
GOTO
|
GOTO
|
|
lda #'G'
|
|
jsr DisplayChar
|
jsr OREXPR ;evaluate the following expression
|
jsr OREXPR ;evaluate the following expression
|
|
jsr DisplayWord
|
ld r5,r1
|
ld r5,r1
|
jsr ENDCHK ;must find end of line
|
jsr ENDCHK ;must find end of line
|
ld r1,r5
|
ld r1,r5
|
jsr FNDLN ; find the target line
|
jsr FNDLN ; find the target line
|
cmp #0
|
cmp #0
|
| Line 540... |
Line 558... |
dec r6
|
dec r6
|
bne cv1
|
bne cv1
|
pop r6
|
pop r6
|
rts
|
rts
|
|
|
|
;******************************************************************
|
|
; ONIRQ
|
|
; ONIRQ sets up an interrupt handler which acts like a specialized
|
|
; subroutine call. ONIRQ is coded like a GOTO that never executes.
|
|
;******************************************************************
|
|
;
|
|
ONIRQ:
|
|
jsr OREXPR ;evaluate the following expression
|
|
ld r5,r1
|
|
jsr ENDCHK ;must find end of line
|
|
ld r1,r5
|
|
jsr FNDLN ; find the target line
|
|
cmp #0
|
|
bne ONIRQ1
|
|
stz IRQROUT
|
|
jmp FINISH
|
|
ONIRQ1:
|
|
st r9,IRQROUT
|
|
jmp FINISH
|
|
|
|
|
|
WAITIRQ:
|
|
jsr CHKIO ; see if a control-C was pressed
|
|
ld r0,IRQFlag
|
|
beq WAITIRQ
|
|
jmp FINISH
|
|
|
|
|
;******************************************************************
|
;******************************************************************
|
; LIST
|
; LIST
|
;
|
;
|
; LISTX has two forms:
|
; LISTX has two forms:
|
| Line 619... |
Line 664... |
PR0:
|
PR0:
|
ldy #'#'
|
ldy #'#'
|
ld r4,#PR1
|
ld r4,#PR1
|
jsr TSTC ;else is it a format?
|
jsr TSTC ;else is it a format?
|
jsr OREXPR ; yes, evaluate expression
|
jsr OREXPR ; yes, evaluate expression
|
or r5,r1,r0 ; and save it as print width
|
ld r5,r1 ; and save it as print width
|
bra PR3 ; look for more to print
|
bra PR3 ; look for more to print
|
PR1:
|
PR1:
|
ldy #'$'
|
ldy #'$'
|
ld r4,#PR4
|
ld r4,#PR4
|
jsr TSTC ; is character expression? (MRL)
|
jsr TSTC ; is character expression? (MRL)
|
| Line 860... |
Line 905... |
jsr OREXPR ; evaluate the expression
|
jsr OREXPR ; evaluate the expression
|
IF1:
|
IF1:
|
cmp #0
|
cmp #0
|
bne RUNSML ; is it zero? if not, continue
|
bne RUNSML ; is it zero? if not, continue
|
IF2:
|
IF2:
|
or r9,r8,r0 ; set lookup pointer
|
ld r9,r8 ; set lookup pointer
|
lda #0 ; find line #0 (impossible)
|
lda #0 ; find line #0 (impossible)
|
jsr FNDSKP ; if so, skip the rest of the line
|
jsr FNDSKP ; if so, skip the rest of the line
|
cmp #0
|
cmp #0
|
bcs WSTART ; if no next line, do a warm start
|
bcs WSTART ; if no next line, do a warm start
|
IF3:
|
IF3:
|
| Line 1013... |
Line 1058... |
beq LODEND ; or EOF marker
|
beq LODEND ; or EOF marker
|
cmp #':'
|
cmp #':'
|
bne LOD1 ; if not, is it start of line? if not, wait for it
|
bne LOD1 ; if not, is it start of line? if not, wait for it
|
jsr GCHAR ; get line number
|
jsr GCHAR ; get line number
|
sta (r8) ; store it
|
sta (r8) ; store it
|
add r8,r8,#1
|
inc r8
|
LOD2:
|
LOD2:
|
jsr GOAUXI ; get another text char.
|
jsr GOAUXI ; get another text char.
|
cmp #0
|
cmp #0
|
beq LOD2
|
beq LOD2
|
bcc LOD2
|
bcc LOD2
|
sta (r8)
|
sta (r8)
|
add r8,r8,#1 ; store it
|
inc r8 ; store it
|
cmp #CR
|
cmp #CR
|
bne LOD2 ; is it the end of the line? if not, go back for more
|
bne LOD2 ; is it the end of the line? if not, go back for more
|
bra LOD1 ; if so, start a new line
|
bra LOD1 ; if so, start a new line
|
LODEND:
|
LODEND:
|
st r8,TXTUNF ; set end-of program pointer
|
st r8,TXTUNF ; set end-of program pointer
|
| Line 1046... |
Line 1091... |
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
asl r5,r5
|
or r5,r5,r1
|
or r5,r5,r1
|
sub r6,r6,#1
|
dec r6
|
bne GCHAR1
|
bne GCHAR1
|
or r1,r5,r0
|
ld r1,r5
|
pop r6
|
pop r6
|
pop r5
|
pop r5
|
rts
|
rts
|
|
|
|
|
| Line 1080... |
Line 1125... |
cmp r8,r9
|
cmp r8,r9
|
bcs SAVEND ; are we finished?
|
bcs SAVEND ; are we finished?
|
lda #':' ; if not, start a line
|
lda #':' ; if not, start a line
|
jsr GOAUXO
|
jsr GOAUXO
|
lda (r8) ; get line number
|
lda (r8) ; get line number
|
add r8,r8,#1
|
inc r8
|
jsr PWORD ; output line number as 4-digit hex
|
jsr PWORD ; output line number as 4-digit hex
|
SAVE2:
|
SAVE2:
|
lda (r8) ; get a text char.
|
lda (r8) ; get a text char.
|
add r8,r8,#1
|
inc r8
|
cmp #CR
|
cmp #CR
|
beq SAVE1 ; is it the end of the line? if so, send CR & LF and start new line
|
beq SAVE1 ; is it the end of the line? if so, send CR & LF and start new line
|
jsr GOAUXO ; send it out
|
jsr GOAUXO ; send it out
|
bra SAVE2 ; go back for more text
|
bra SAVE2 ; go back for more text
|
SAVEND:
|
SAVEND:
|
| Line 1152... |
Line 1197... |
rts
|
rts
|
|
|
|
|
|
|
;******************************************************************
|
;******************************************************************
|
; *** POKE *** & SYSX ***
|
; *** POKE ***
|
;
|
;
|
; 'POKE expr1,expr2' stores the byte from 'expr2' into the memory
|
; 'POKE expr1,expr2' stores the word from 'expr2' into the memory
|
; address specified by 'expr1'.
|
; address specified by 'expr1'.
|
;
|
|
; 'SYSX expr' jumps to the machine language subroutine whose
|
|
; starting address is specified by 'expr'. The subroutine can use
|
|
; all registers but must leave the stack the way it found it.
|
|
; The subroutine returns to the interpreter by executing an RET.
|
|
;******************************************************************
|
;******************************************************************
|
;
|
;
|
POKE:
|
POKE:
|
jsr OREXPR ; get the memory address
|
jsr OREXPR ; get the memory address
|
ldy #','
|
ldy #','
|
| Line 1177... |
Line 1217... |
jmp FINISH
|
jmp FINISH
|
PKER:
|
PKER:
|
lda #msgComma
|
lda #msgComma
|
jmp ERROR ; if no comma, say "What?"
|
jmp ERROR ; if no comma, say "What?"
|
|
|
POKEC:
|
|
jmp FINISH
|
|
|
|
POKEH:
|
|
jmp FINISH
|
|
|
|
POKEW:
|
;******************************************************************
|
jmp FINISH
|
; 'SYSX expr' jumps to the machine language subroutine whose
|
|
; starting address is specified by 'expr'. The subroutine can use
|
|
; all registers but must leave the stack the way it found it.
|
|
; The subroutine returns to the interpreter by executing an RTS.
|
|
;******************************************************************
|
|
|
SYSX:
|
SYSX:
|
jsr OREXPR ; get the subroutine's address
|
jsr OREXPR ; get the subroutine's address
|
cmp #0
|
cmp #0
|
bne sysx1 ; make sure we got a valid address
|
bne sysx1 ; make sure we got a valid address
|
| Line 1670... |
Line 1709... |
; user function jsr
|
; user function jsr
|
; call the user function with argument in r1
|
; call the user function with argument in r1
|
USRX:
|
USRX:
|
jsr PARN ; get expression value
|
jsr PARN ; get expression value
|
push r8 ; save the text pointer
|
push r8 ; save the text pointer
|
jsr (usrJmp) ; get usr vector, jump to the subroutine
|
ldx #0
|
|
jsr (usrJmp,x) ; get usr vector, jump to the subroutine
|
pop r8 ; restore the text pointer
|
pop r8 ; restore the text pointer
|
rts
|
rts
|
|
|
|
|
; ===== The RND function returns a random number from 1 to
|
; ===== The RND function returns a random number from 1 to
|
| Line 1782... |
Line 1822... |
;
|
;
|
; 'SETVAL' expects a variable, followed by an equal sign and then
|
; 'SETVAL' expects a variable, followed by an equal sign and then
|
; an expression. It evaluates the expression and sets the variable
|
; an expression. It evaluates the expression and sets the variable
|
; to that value.
|
; to that value.
|
;
|
;
|
; 'FIN' checks the end of a command. If it ended with ":",
|
|
; execution continues. If it ended with a CR, it finds the
|
|
; the next line and continues from there.
|
|
;
|
|
; 'ENDCHK' checks if a command is ended with a CR. This is
|
|
; required in certain commands, such as GOTO, RETURN, STOP, etc.
|
|
;
|
|
; 'ERROR' prints the string pointed to by r1. It then prints the
|
|
; line pointed to by CURRNT with a "?" inserted at where the
|
|
; old text pointer (should be on top of the stack) points to.
|
|
; Execution of Tiny BASIC is stopped and a warm start is done.
|
|
; If CURRNT is zero (indicating a direct command), the direct
|
|
; command is not printed. If CURRNT is -1 (indicating
|
|
; 'INPUT' command in progress), the input line is not printed
|
|
; and execution is not terminated but continues at 'INPERR'.
|
|
;
|
|
; Related to 'ERROR' are the following:
|
|
; 'QWHAT' saves text pointer on stack and gets "What?" message.
|
|
; 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
|
|
; 'QSORRY' and 'ASORRY' do the same kind of thing.
|
|
; 'QHOW' and 'AHOW' also do this for "How?".
|
|
;
|
|
|
|
; returns
|
; returns
|
; r2 = variable's address
|
; r2 = variable's address
|
;
|
;
|
SETVAL:
|
SETVAL:
|
lda #1 ; allocate var
|
lda #1 ; allocate var
|
| Line 1829... |
Line 1846... |
rts
|
rts
|
SV1:
|
SV1:
|
jmp QWHAT ; if no "=" sign
|
jmp QWHAT ; if no "=" sign
|
|
|
|
|
|
; 'FIN' checks the end of a command. If it ended with ":",
|
|
; execution continues. If it ended with a CR, it finds the
|
|
; the next line and continues from there.
|
|
;
|
FIN:
|
FIN:
|
ldy #':'
|
ldy #':'
|
ld r4,#FI1
|
ld r4,#FI1
|
jsr TSTC ; *** FIN ***
|
jsr TSTC ; *** FIN ***
|
pla ; if ":", discard return address
|
pla ; if ":", discard return address
|
| Line 1846... |
Line 1867... |
jmp RUNNXL ; execute the next line
|
jmp RUNNXL ; execute the next line
|
FI2:
|
FI2:
|
rts ; else return to the caller
|
rts ; else return to the caller
|
|
|
|
|
|
; 'ENDCHK' checks if a command is ended with a CR. This is
|
|
; required in certain commands, such as GOTO, RETURN, STOP, etc.
|
|
;
|
; Check that there is nothing else on the line
|
; Check that there is nothing else on the line
|
; Registers Affected
|
; Registers Affected
|
; r1
|
; r1
|
;
|
;
|
ENDCHK:
|
ENDCHK:
|
|
lda #'E'
|
|
jsr DisplayChar
|
jsr IGNBLK
|
jsr IGNBLK
|
lda (r8)
|
lda (r8)
|
cmp #CR
|
cmp #CR
|
beq ec1 ; does it end with a CR?
|
beq ec1 ; does it end with a CR?
|
lda #msgExtraChars
|
lda #msgExtraChars
|
jmp ERROR
|
jmp ERROR
|
ec1:
|
ec1:
|
rts
|
rts
|
|
|
|
; 'ERROR' prints the string pointed to by r1. It then prints the
|
|
; line pointed to by CURRNT with a "?" inserted at where the
|
|
; old text pointer (should be on top of the stack) points to.
|
|
; Execution of Tiny BASIC is stopped and a warm start is done.
|
|
; If CURRNT is zero (indicating a direct command), the direct
|
|
; command is not printed. If CURRNT is -1 (indicating
|
|
; 'INPUT' command in progress), the input line is not printed
|
|
; and execution is not terminated but continues at 'INPERR'.
|
|
;
|
|
; Related to 'ERROR' are the following:
|
|
; 'QWHAT' saves text pointer on stack and gets "What?" message.
|
|
; 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
|
|
; 'QSORRY' and 'ASORRY' do the same kind of thing.
|
|
; 'QHOW' and 'AHOW' also do this for "How?".
|
|
;
|
TOOBIG:
|
TOOBIG:
|
lda #msgTooBig
|
lda #msgTooBig
|
bra ERROR
|
bra ERROR
|
QSORRY:
|
QSORRY:
|
lda #SRYMSG
|
lda #SRYMSG
|
bra ERROR
|
bra ERROR
|
QWHAT:
|
QWHAT:
|
lda #msgWhat
|
lda #msgWhat
|
ERROR:
|
ERROR:
|
jsr PRMESG ; display the error message
|
jsr PRMESG ; display the error message
|
lda CURRNT ; get the current line number
|
lda CURRNT ; get the current line pointer
|
beq ERROR1 ; if zero, do a warm start
|
beq ERROR1 ; if zero, do a warm start
|
cmp #-1
|
cmp #-1
|
beq INPERR ; is the line no. pointer = -1? if so, redo input
|
beq INPERR ; is the line no. pointer = -1? if so, redo input
|
ld r5,(r8) ; save the char. pointed to
|
ld r5,(r8) ; save the char. pointed to
|
stz (r8) ; put a zero where the error is
|
stz (r8) ; put a zero where the error is
|
lda CURRNT ; point to start of current line
|
lda CURRNT ; point to start of current line
|
jsr PRTLN ; display the line in error up to the 0
|
jsr PRTLN ; display the line in error up to the 0
|
or r6,r1,r0 ; save off end pointer
|
ld r6,r1 ; save off end pointer
|
st r5,(r8) ; restore the character
|
st r5,(r8) ; restore the character
|
lda #'?' ; display a "?"
|
lda #'?' ; display a "?"
|
jsr GOOUT
|
jsr GOOUT
|
ldx #0 ; stop char = 0
|
ldx #0 ; stop char = 0
|
sub r1,r6,#1 ; point back to the error char.
|
sub r1,r6,#1 ; point back to the error char.
|
| Line 1944... |
Line 1985... |
lda #CTRLH ; if so, finish the BS-space-BS sequence
|
lda #CTRLH ; if so, finish the BS-space-BS sequence
|
jsr GOOUT
|
jsr GOOUT
|
dec r8 ; decrement the text pointer
|
dec r8 ; decrement the text pointer
|
bra GL1 ; back for more
|
bra GL1 ; back for more
|
GL4:
|
GL4:
|
or r1,r8,r0 ; delete the whole line
|
ld r1,r8 ; delete the whole line
|
sub r5,r1,#BUFFER ; figure out how many backspaces we need
|
sub r5,r1,#BUFFER ; figure out how many backspaces we need
|
beq GL6 ; if none needed, brnch
|
beq GL6 ; if none needed, brnch
|
dec r5 ; loop count is one less
|
dec r5 ; loop count is one less
|
GL5:
|
GL5:
|
lda #CTRLH ; and display BS-space-BS sequences
|
lda #CTRLH ; and display BS-space-BS sequences
|
