| 1 |
16 |
robfinch |
;****************************************************************;
|
| 2 |
|
|
; ;
|
| 3 |
|
|
; Tiny BASIC for the Raptor64 ;
|
| 4 |
|
|
; ;
|
| 5 |
|
|
; Derived from a 68000 derivative of Palo Alto Tiny BASIC as ;
|
| 6 |
|
|
; published in the May 1976 issue of Dr. Dobb's Journal. ;
|
| 7 |
|
|
; Adapted to the 68000 by: ;
|
| 8 |
|
|
; Gordon brndly ;
|
| 9 |
|
|
; 12147 - 51 Street ;
|
| 10 |
|
|
; Edmonton AB T5W 3G8 ;
|
| 11 |
|
|
; Canada ;
|
| 12 |
|
|
; (updated mailing address for 1996) ;
|
| 13 |
|
|
; ;
|
| 14 |
|
|
; Adapted to the RTF65002 by: ;
|
| 15 |
|
|
; Robert Finch ;
|
| 16 |
|
|
; Ontario, Canada ;
|
| 17 |
|
|
; robfinch@opencores.org ;
|
| 18 |
|
|
;****************************************************************;
|
| 19 |
|
|
; Copyright (C) 2012 by Robert Finch. This program may be ;
|
| 20 |
|
|
; freely distributed for personal use only. All commercial ;
|
| 21 |
|
|
; rights are reserved. ;
|
| 22 |
|
|
;****************************************************************;
|
| 23 |
|
|
;
|
| 24 |
|
|
; Register Usage
|
| 25 |
|
|
; r8 = text pointer (global usage)
|
| 26 |
|
|
; r3,r4 = inputs parameters to subroutines
|
| 27 |
|
|
; r2 = return value
|
| 28 |
|
|
;
|
| 29 |
|
|
;* Vers. 1.0 1984/7/17 - Original version by Gordon brndly
|
| 30 |
|
|
;* 1.1 1984/12/9 - Addition of '0x' print term by Marvin Lipford
|
| 31 |
|
|
;* 1.2 1985/4/9 - Bug fix in multiply routine by Rick Murray
|
| 32 |
|
|
|
| 33 |
|
|
;
|
| 34 |
|
|
; Standard jump table. You can change these addresses if you are
|
| 35 |
|
|
; customizing this interpreter for a different environment.
|
| 36 |
|
|
;
|
| 37 |
|
|
CR EQU 0x0D ;ASCII equates
|
| 38 |
|
|
LF EQU 0x0A
|
| 39 |
|
|
TAB EQU 0x09
|
| 40 |
|
|
CTRLC EQU 0x03
|
| 41 |
|
|
CTRLH EQU 0x08
|
| 42 |
|
|
CTRLI EQU 0x09
|
| 43 |
|
|
CTRLJ EQU 0x0A
|
| 44 |
|
|
CTRLK EQU 0x0B
|
| 45 |
|
|
CTRLM EQU 0x0D
|
| 46 |
|
|
CTRLS EQU 0x13
|
| 47 |
|
|
CTRLX EQU 0x18
|
| 48 |
|
|
XON EQU 0x11
|
| 49 |
|
|
XOFF EQU 0x13
|
| 50 |
|
|
|
| 51 |
18 |
robfinch |
CursorRow EQU 0x7C2
|
| 52 |
|
|
CursorCol EQU 0x7C3
|
| 53 |
|
|
CursorFlash EQU 0x7C4
|
| 54 |
|
|
IRQFlag EQU 0x7C6
|
| 55 |
16 |
robfinch |
|
| 56 |
18 |
robfinch |
OSSP EQU 0x700
|
| 57 |
|
|
TXTUNF EQU 0x701
|
| 58 |
|
|
VARBGN EQU 0x702
|
| 59 |
|
|
LOPVAR EQU 0x703
|
| 60 |
|
|
STKGOS EQU 0x704
|
| 61 |
|
|
CURRNT EQU 0x705
|
| 62 |
16 |
robfinch |
BUFFER EQU 0x406
|
| 63 |
|
|
BUFLEN EQU 84
|
| 64 |
18 |
robfinch |
LOPPT EQU 0x760
|
| 65 |
|
|
LOPLN EQU 0x761
|
| 66 |
|
|
LOPINC EQU 0x762
|
| 67 |
|
|
LOPLMT EQU 0x763
|
| 68 |
|
|
NUMWKA EQU 0x764
|
| 69 |
|
|
STKINP EQU 0x774
|
| 70 |
|
|
STKBOT EQU 0x775
|
| 71 |
|
|
usrJmp EQU 0x776
|
| 72 |
|
|
IRQROUT EQU 0x777
|
| 73 |
16 |
robfinch |
|
| 74 |
|
|
|
| 75 |
|
|
|
| 76 |
|
|
cpu rtf65002
|
| 77 |
|
|
code
|
| 78 |
|
|
org $FFFFE800
|
| 79 |
|
|
GOSTART:
|
| 80 |
|
|
jmp CSTART ; Cold Start entry point
|
| 81 |
|
|
GOWARM:
|
| 82 |
|
|
jmp WSTART ; Warm Start entry point
|
| 83 |
|
|
GOOUT:
|
| 84 |
|
|
jmp OUTC ; Jump to character-out routine
|
| 85 |
|
|
GOIN:
|
| 86 |
|
|
jmp INCH ;Jump to character-in routine
|
| 87 |
|
|
GOAUXO:
|
| 88 |
|
|
jmp AUXOUT ; Jump to auxiliary-out routine
|
| 89 |
|
|
GOAUXI:
|
| 90 |
|
|
jmp AUXIN ; Jump to auxiliary-in routine
|
| 91 |
|
|
GOBYE:
|
| 92 |
|
|
jmp BYEBYE ; Jump to monitor, DOS, etc.
|
| 93 |
|
|
;
|
| 94 |
|
|
; Modifiable system constants:
|
| 95 |
|
|
;
|
| 96 |
|
|
align 4
|
| 97 |
|
|
TXTBGN dw 0x04080000 ;TXT ;beginning of program memory
|
| 98 |
|
|
ENDMEM dw 0x05FFDFF8 ; end of available memory
|
| 99 |
|
|
STACKOFFS dw 0x05FFDFF8 ; stack offset - leave a little room for the BIOS
|
| 100 |
|
|
;
|
| 101 |
|
|
; The main interpreter starts here:
|
| 102 |
|
|
;
|
| 103 |
|
|
; Usage
|
| 104 |
|
|
; r1 = temp
|
| 105 |
|
|
; r8 = text buffer pointer
|
| 106 |
|
|
; r12 = end of text in text buffer
|
| 107 |
|
|
;
|
| 108 |
|
|
align 4
|
| 109 |
|
|
public CSTART:
|
| 110 |
|
|
; First save off the link register and OS sp value
|
| 111 |
|
|
tsx
|
| 112 |
|
|
stx OSSP
|
| 113 |
|
|
ldx STACKOFFS>>2 ; initialize stack pointer
|
| 114 |
|
|
txs
|
| 115 |
|
|
stz CursorRow ; set screen output
|
| 116 |
|
|
stz CursorCol
|
| 117 |
|
|
stz CursorFlash
|
| 118 |
|
|
stz pos
|
| 119 |
|
|
ldx #0x10000020 ; black chars, yellow background
|
| 120 |
|
|
; stx charToPrint
|
| 121 |
|
|
jsr ClearScreen
|
| 122 |
|
|
lda #msgInit ; tell who we are
|
| 123 |
|
|
jsr PRMESG
|
| 124 |
|
|
lda TXTBGN>>2 ; init. end-of-program pointer
|
| 125 |
|
|
sta TXTUNF
|
| 126 |
|
|
lda ENDMEM>>2 ; get address of end of memory
|
| 127 |
|
|
sub #4096 ; reserve 4K for the stack
|
| 128 |
|
|
sta STKBOT
|
| 129 |
|
|
sub #16384 ; 1000 vars
|
| 130 |
|
|
sta VARBGN
|
| 131 |
|
|
jsr clearVars ; clear the variable area
|
| 132 |
18 |
robfinch |
stz IRQROUT
|
| 133 |
16 |
robfinch |
lda VARBGN ; calculate number of bytes free
|
| 134 |
|
|
ldy TXTUNF
|
| 135 |
|
|
sub r1,r1,r3
|
| 136 |
|
|
ldx #12 ; max 12 digits
|
| 137 |
|
|
jsr PRTNUM
|
| 138 |
|
|
lda #msgBytesFree
|
| 139 |
|
|
jsr PRMESG
|
| 140 |
|
|
WSTART:
|
| 141 |
|
|
stz LOPVAR ; initialize internal variables
|
| 142 |
|
|
stz STKGOS
|
| 143 |
|
|
stz CURRNT ; current line number pointer = 0
|
| 144 |
|
|
ldx ENDMEM>>2 ; init S.P. again, just in case
|
| 145 |
|
|
txs
|
| 146 |
|
|
lda #msgReady ; display "Ready"
|
| 147 |
|
|
jsr PRMESG
|
| 148 |
|
|
ST3:
|
| 149 |
|
|
lda #'>' ; Prompt with a '>' and
|
| 150 |
|
|
jsr GETLN ; read a line.
|
| 151 |
|
|
jsr TOUPBUF ; convert to upper case
|
| 152 |
|
|
ld r12,r8 ; save pointer to end of line
|
| 153 |
|
|
ld r8,#BUFFER ; point to the beginning of line
|
| 154 |
|
|
jsr TSTNUM ; is there a number there?
|
| 155 |
|
|
jsr IGNBLK ; skip trailing blanks
|
| 156 |
|
|
; does line no. exist? (or nonzero?)
|
| 157 |
|
|
cpx #0
|
| 158 |
|
|
beq DIRECT ; if not, it's a direct statement
|
| 159 |
|
|
cmp #$FFFF ; see if line no. is <= 16 bits
|
| 160 |
|
|
bcc ST2
|
| 161 |
|
|
beq ST2
|
| 162 |
|
|
lda #msgLineRange ; if not, we've overflowed
|
| 163 |
|
|
jmp ERROR
|
| 164 |
|
|
ST2:
|
| 165 |
|
|
; ugliness - store a character at potentially an
|
| 166 |
|
|
; odd address (unaligned).
|
| 167 |
|
|
tax ; r2 = line number
|
| 168 |
|
|
dec r8
|
| 169 |
|
|
stx (r8) ;
|
| 170 |
|
|
jsr FNDLN ; find this line in save area
|
| 171 |
|
|
ld r13,r9 ; save possible line pointer
|
| 172 |
|
|
cmp #0
|
| 173 |
|
|
beq ST4 ; if not found, insert
|
| 174 |
|
|
; here we found the line, so we're replacing the line
|
| 175 |
|
|
; in the text area
|
| 176 |
|
|
; first step - delete the line
|
| 177 |
|
|
lda #0
|
| 178 |
|
|
jsr FNDNXT ; find the next line (into r9)
|
| 179 |
|
|
cmp #0
|
| 180 |
|
|
bne ST7
|
| 181 |
|
|
cmp r9,TXTUNF
|
| 182 |
|
|
beq ST6 ; no more lines
|
| 183 |
|
|
bcs ST6
|
| 184 |
|
|
cmp r9,r0
|
| 185 |
|
|
beq ST6
|
| 186 |
|
|
ST7:
|
| 187 |
|
|
ld r1,r9 ; r1 = pointer to next line
|
| 188 |
|
|
ld r2,r13 ; pointer to line to be deleted
|
| 189 |
|
|
ldy TXTUNF ; points to top of save area
|
| 190 |
|
|
jsr MVUP ; move up to delete
|
| 191 |
|
|
stx TXTUNF ; update the end pointer
|
| 192 |
|
|
; we moved the lines of text after the line being
|
| 193 |
|
|
; deleted down, so the pointer to the next line
|
| 194 |
|
|
; needs to be reset
|
| 195 |
|
|
ld r9,r13
|
| 196 |
|
|
bra ST4
|
| 197 |
|
|
; here there were no more lines, so just move the
|
| 198 |
|
|
; end of text pointer down
|
| 199 |
|
|
ST6:
|
| 200 |
|
|
st r13,TXTUNF
|
| 201 |
|
|
ld r9,r13
|
| 202 |
|
|
ST4:
|
| 203 |
|
|
; here we're inserting because the line wasn't found
|
| 204 |
|
|
; or it was deleted from the text area
|
| 205 |
18 |
robfinch |
sub r1,r12,r8 ; calculate the length of new line
|
| 206 |
16 |
robfinch |
cmp #2 ; is it just a line no. & CR? if so, it was just a delete
|
| 207 |
|
|
beq ST3
|
| 208 |
|
|
bcc ST3
|
| 209 |
|
|
|
| 210 |
18 |
robfinch |
; compute new end of text
|
| 211 |
|
|
ld r10,TXTUNF ; r10 = old TXTUNF
|
| 212 |
|
|
add r11,r10,r1 ; r11 = new top of TXTUNF (r1=line length)
|
| 213 |
16 |
robfinch |
|
| 214 |
|
|
cmp r11,VARBGN ; see if there's enough room
|
| 215 |
|
|
bcc ST5
|
| 216 |
|
|
lda #msgTooBig ; if not, say so
|
| 217 |
|
|
jmp ERROR
|
| 218 |
|
|
|
| 219 |
|
|
; open a space in the text area
|
| 220 |
|
|
ST5:
|
| 221 |
|
|
st r11,TXTUNF ; if so, store new end position
|
| 222 |
|
|
ld r1,r10 ; points to old end of text
|
| 223 |
|
|
ld r2,r11 ; points to new end of text
|
| 224 |
|
|
ld r3,r9 ; points to start of line after insert line
|
| 225 |
|
|
jsr MVDOWN ; move things out of the way
|
| 226 |
|
|
|
| 227 |
|
|
; copy line into text space
|
| 228 |
|
|
ld r1,r8 ; set up to do the insertion; move from buffer
|
| 229 |
|
|
ld r2,r13 ; to vacated space
|
| 230 |
|
|
ld r3,r12 ; until end of buffer
|
| 231 |
|
|
jsr MVUP ; do it
|
| 232 |
|
|
jmp ST3 ; go back and get another line
|
| 233 |
|
|
|
| 234 |
|
|
;******************************************************************
|
| 235 |
|
|
;
|
| 236 |
|
|
; *** Tables *** DIRECT *** EXEC ***
|
| 237 |
|
|
;
|
| 238 |
|
|
; This section of the code tests a string against a table. When
|
| 239 |
|
|
; a match is found, control is transferred to the section of
|
| 240 |
|
|
; code according to the table.
|
| 241 |
|
|
;
|
| 242 |
|
|
; At 'EXEC', r8 should point to the string, r9 should point to
|
| 243 |
|
|
; the character table, and r10 should point to the execution
|
| 244 |
|
|
; table. At 'DIRECT', r8 should point to the string, r9 and
|
| 245 |
|
|
; r10 will be set up to point to TAB1 and TAB1_1, which are
|
| 246 |
|
|
; the tables of all direct and statement commands.
|
| 247 |
|
|
;
|
| 248 |
|
|
; A '.' in the string will terminate the test and the partial
|
| 249 |
|
|
; match will be considered as a match, e.g. 'P.', 'PR.','PRI.',
|
| 250 |
|
|
; 'PRIN.', or 'PRINT' will all match 'PRINT'.
|
| 251 |
|
|
;
|
| 252 |
|
|
; There are two tables: the character table and the execution
|
| 253 |
|
|
; table. The character table consists of any number of text items.
|
| 254 |
|
|
; Each item is a string of characters with the last character's
|
| 255 |
|
|
; high bit set to one. The execution table holds a 32-bit
|
| 256 |
|
|
; execution addresses that correspond to each entry in the
|
| 257 |
|
|
; character table.
|
| 258 |
|
|
;
|
| 259 |
|
|
; The end of the character table is a 0 byte which corresponds
|
| 260 |
|
|
; to the default routine in the execution table, which is
|
| 261 |
|
|
; executed if none of the other table items are matched.
|
| 262 |
|
|
;
|
| 263 |
|
|
; Character-matching tables:
|
| 264 |
|
|
|
| 265 |
|
|
TAB1:
|
| 266 |
|
|
db "LIS",'T'+0x80 ; Direct commands
|
| 267 |
|
|
db "LOA",'D'+0x80
|
| 268 |
|
|
db "NE",'W'+0x80
|
| 269 |
|
|
db "RU",'N'+0x80
|
| 270 |
|
|
db "SAV",'E'+0x80
|
| 271 |
|
|
TAB2:
|
| 272 |
|
|
db "NEX",'T'+0x80 ; Direct / statement
|
| 273 |
|
|
db "LE",'T'+0x80
|
| 274 |
|
|
db "I",'F'+0x80
|
| 275 |
|
|
db "GOT",'O'+0x80
|
| 276 |
|
|
db "GOSU",'B'+0x80
|
| 277 |
|
|
db "RETUR",'N'+0x80
|
| 278 |
|
|
db "RE",'M'+0x80
|
| 279 |
|
|
db "FO",'R'+0x80
|
| 280 |
|
|
db "INPU",'T'+0x80
|
| 281 |
|
|
db "PRIN",'T'+0x80
|
| 282 |
|
|
db "POK",'E'+0x80
|
| 283 |
|
|
db "STO",'P'+0x80
|
| 284 |
|
|
db "BY",'E'+0x80
|
| 285 |
|
|
db "SY",'S'+0x80
|
| 286 |
|
|
db "CL",'S'+0x80
|
| 287 |
|
|
db "CL",'R'+0x80
|
| 288 |
|
|
db "RDC",'F'+0x80
|
| 289 |
18 |
robfinch |
db "ONIR",'Q'+0x80
|
| 290 |
|
|
db "WAI",'T'+0x80
|
| 291 |
16 |
robfinch |
db 0
|
| 292 |
|
|
TAB4:
|
| 293 |
|
|
db "PEE",'K'+0x80 ;Functions
|
| 294 |
|
|
db "RN",'D'+0x80
|
| 295 |
|
|
db "AB",'S'+0x80
|
| 296 |
18 |
robfinch |
db "SG",'N'+0x80
|
| 297 |
16 |
robfinch |
db "TIC",'K'+0x80
|
| 298 |
|
|
db "SIZ",'E'+0x80
|
| 299 |
|
|
db "US",'R'+0x80
|
| 300 |
|
|
db 0
|
| 301 |
|
|
TAB5:
|
| 302 |
|
|
db "T",'O'+0x80 ;"TO" in "FOR"
|
| 303 |
|
|
db 0
|
| 304 |
|
|
TAB6:
|
| 305 |
|
|
db "STE",'P'+0x80 ;"STEP" in "FOR"
|
| 306 |
|
|
db 0
|
| 307 |
|
|
TAB8:
|
| 308 |
|
|
db '>','='+0x80 ;Relational operators
|
| 309 |
|
|
db '<','>'+0x80
|
| 310 |
|
|
db '>'+0x80
|
| 311 |
|
|
db '='+0x80
|
| 312 |
|
|
db '<','='+0x80
|
| 313 |
|
|
db '<'+0x80
|
| 314 |
|
|
db 0
|
| 315 |
|
|
TAB9:
|
| 316 |
|
|
db "AN",'D'+0x80
|
| 317 |
|
|
db 0
|
| 318 |
|
|
TAB10:
|
| 319 |
|
|
db "O",'R'+0x80
|
| 320 |
|
|
db 0
|
| 321 |
|
|
|
| 322 |
|
|
;* Execution address tables:
|
| 323 |
|
|
; We save some bytes by specifiying only the low order 16 bits of the address
|
| 324 |
|
|
;
|
| 325 |
|
|
TAB1_1:
|
| 326 |
|
|
dh LISTX ;Direct commands
|
| 327 |
|
|
dh LOAD
|
| 328 |
|
|
dh NEW
|
| 329 |
|
|
dh RUN
|
| 330 |
|
|
dh SAVE
|
| 331 |
|
|
TAB2_1:
|
| 332 |
|
|
dh NEXT ; Direct / statement
|
| 333 |
|
|
dh LET
|
| 334 |
|
|
dh IF
|
| 335 |
|
|
dh GOTO
|
| 336 |
|
|
dh GOSUB
|
| 337 |
|
|
dh RETURN
|
| 338 |
|
|
dh IF2 ; REM
|
| 339 |
|
|
dh FOR
|
| 340 |
|
|
dh INPUT
|
| 341 |
|
|
dh PRINT
|
| 342 |
|
|
dh POKE
|
| 343 |
|
|
dh STOP
|
| 344 |
|
|
dh GOBYE
|
| 345 |
|
|
dh SYSX
|
| 346 |
|
|
dh _cls
|
| 347 |
|
|
dh _clr
|
| 348 |
|
|
dh _rdcf
|
| 349 |
18 |
robfinch |
dh ONIRQ
|
| 350 |
|
|
dh WAITIRQ
|
| 351 |
16 |
robfinch |
dh DEFLT
|
| 352 |
|
|
TAB4_1:
|
| 353 |
|
|
dh PEEK ;Functions
|
| 354 |
|
|
dh RND
|
| 355 |
|
|
dh ABS
|
| 356 |
18 |
robfinch |
dh SGN
|
| 357 |
16 |
robfinch |
dh TICKX
|
| 358 |
|
|
dh SIZEX
|
| 359 |
|
|
dh USRX
|
| 360 |
|
|
dh XP40
|
| 361 |
|
|
TAB5_1
|
| 362 |
|
|
dh FR1 ;"TO" in "FOR"
|
| 363 |
|
|
dh QWHAT
|
| 364 |
|
|
TAB6_1
|
| 365 |
|
|
dh FR2 ;"STEP" in "FOR"
|
| 366 |
|
|
dh FR3
|
| 367 |
|
|
TAB8_1
|
| 368 |
|
|
dh XP11 ;>= Relational operators
|
| 369 |
|
|
dh XP12 ;<>
|
| 370 |
|
|
dh XP13 ;>
|
| 371 |
|
|
dh XP15 ;=
|
| 372 |
|
|
dh XP14 ;<=
|
| 373 |
|
|
dh XP16 ;<
|
| 374 |
|
|
dh XP17
|
| 375 |
|
|
TAB9_1
|
| 376 |
|
|
dh XP_AND
|
| 377 |
|
|
dh XP_ANDX
|
| 378 |
|
|
TAB10_1
|
| 379 |
|
|
dh XP_OR
|
| 380 |
|
|
dh XP_ORX
|
| 381 |
|
|
|
| 382 |
|
|
;*
|
| 383 |
|
|
; r3 = match flag (trashed)
|
| 384 |
|
|
; r9 = text table
|
| 385 |
|
|
; r10 = exec table
|
| 386 |
|
|
; r11 = trashed
|
| 387 |
|
|
DIRECT:
|
| 388 |
|
|
ld r9,#TAB1
|
| 389 |
|
|
ld r10,#TAB1_1
|
| 390 |
|
|
EXEC:
|
| 391 |
|
|
jsr IGNBLK ; ignore leading blanks
|
| 392 |
18 |
robfinch |
ld r11,r8 ; save the pointer
|
| 393 |
16 |
robfinch |
eor r3,r3,r3 ; clear match flag
|
| 394 |
|
|
EXLP:
|
| 395 |
|
|
lda (r8) ; get the program character
|
| 396 |
|
|
inc r8
|
| 397 |
|
|
lb r2,$0,r9 ; get the table character
|
| 398 |
|
|
bne EXNGO ; If end of table,
|
| 399 |
18 |
robfinch |
ld r8,r11 ; restore the text pointer and...
|
| 400 |
16 |
robfinch |
bra EXGO ; execute the default.
|
| 401 |
|
|
EXNGO:
|
| 402 |
|
|
cmp r1,r3 ; Else check for period... if so, execute
|
| 403 |
|
|
beq EXGO
|
| 404 |
|
|
and r2,r2,#0x7f ; ignore the table's high bit
|
| 405 |
|
|
cmp r2,r1 ; is there a match?
|
| 406 |
|
|
beq EXMAT
|
| 407 |
|
|
inc r10 ;if not, try the next entry
|
| 408 |
|
|
inc r10
|
| 409 |
18 |
robfinch |
ld r8,r11 ; reset the program pointer
|
| 410 |
16 |
robfinch |
eor r3,r3,r3 ; sorry, no match
|
| 411 |
|
|
EX1:
|
| 412 |
|
|
lb r1,0,r9 ; get to the end of the entry
|
| 413 |
|
|
inc r9
|
| 414 |
|
|
bit #$80 ; test for bit 7 set
|
| 415 |
|
|
beq EX1
|
| 416 |
|
|
bra EXLP ; back for more matching
|
| 417 |
|
|
EXMAT:
|
| 418 |
|
|
ldy #'.' ; we've got a match so far
|
| 419 |
|
|
lb r1,0,r9 ; end of table entry?
|
| 420 |
|
|
inc r9
|
| 421 |
|
|
bit #$80 ; test for bit 7 set
|
| 422 |
|
|
beq EXLP ; if not, go back for more
|
| 423 |
|
|
EXGO:
|
| 424 |
|
|
; execute the appropriate routine
|
| 425 |
18 |
robfinch |
lb r1,1,r10 ; get the low mid order byte
|
| 426 |
|
|
asl
|
| 427 |
|
|
asl
|
| 428 |
|
|
asl
|
| 429 |
|
|
asl
|
| 430 |
|
|
asl
|
| 431 |
|
|
asl
|
| 432 |
|
|
asl
|
| 433 |
|
|
asl
|
| 434 |
|
|
orb r1,r1,0,r10 ; get the low order byte
|
| 435 |
|
|
or r1,r1,#$FFFF0000 ; add in ROM base
|
| 436 |
|
|
jmp (r1)
|
| 437 |
16 |
robfinch |
|
| 438 |
|
|
|
| 439 |
|
|
;******************************************************************
|
| 440 |
|
|
;
|
| 441 |
|
|
; What follows is the code to execute direct and statement
|
| 442 |
|
|
; commands. Control is transferred to these points via the command
|
| 443 |
|
|
; table lookup code of 'DIRECT' and 'EXEC' in the last section.
|
| 444 |
|
|
; After the command is executed, control is transferred to other
|
| 445 |
|
|
; sections as follows:
|
| 446 |
|
|
;
|
| 447 |
|
|
; For 'LISTX', 'NEW', and 'STOP': go back to the warm start point.
|
| 448 |
|
|
; For 'RUN': go execute the first stored line if any; else go
|
| 449 |
|
|
; back to the warm start point.
|
| 450 |
|
|
; For 'GOTO' and 'GOSUB': go execute the target line.
|
| 451 |
|
|
; For 'RETURN' and 'NEXT'; go back to saved return line.
|
| 452 |
|
|
; For all others: if 'CURRNT' is 0, go to warm start; else go
|
| 453 |
|
|
; execute next command. (This is done in 'FINISH'.)
|
| 454 |
|
|
;
|
| 455 |
|
|
;******************************************************************
|
| 456 |
|
|
;
|
| 457 |
|
|
; *** NEW *** STOP *** RUN (& friends) *** GOTO ***
|
| 458 |
|
|
;
|
| 459 |
|
|
; 'NEW' sets TXTUNF to point to TXTBGN
|
| 460 |
|
|
;
|
| 461 |
|
|
|
| 462 |
|
|
NEW:
|
| 463 |
|
|
jsr ENDCHK
|
| 464 |
|
|
lda TXTBGN>>2
|
| 465 |
|
|
sta TXTUNF ; set the end pointer
|
| 466 |
|
|
jsr clearVars
|
| 467 |
|
|
|
| 468 |
|
|
; 'STOP' goes back to WSTART
|
| 469 |
|
|
;
|
| 470 |
|
|
STOP:
|
| 471 |
|
|
jsr ENDCHK
|
| 472 |
|
|
jmp WSTART ; WSTART will reset the stack
|
| 473 |
|
|
|
| 474 |
|
|
; 'RUN' finds the first stored line, stores its address
|
| 475 |
|
|
; in CURRNT, and starts executing it. Note that only those
|
| 476 |
|
|
; commands in TAB2 are legal for a stored program.
|
| 477 |
|
|
;
|
| 478 |
|
|
; There are 3 more entries in 'RUN':
|
| 479 |
|
|
; 'RUNNXL' finds next line, stores it's address and executes it.
|
| 480 |
|
|
; 'RUNTSL' stores the address of this line and executes it.
|
| 481 |
|
|
; 'RUNSML' continues the execution on same line.
|
| 482 |
|
|
;
|
| 483 |
|
|
RUN:
|
| 484 |
|
|
jsr ENDCHK
|
| 485 |
|
|
ld r8,TXTBGN>>2 ; set pointer to beginning
|
| 486 |
|
|
st r8,CURRNT
|
| 487 |
|
|
jsr clearVars
|
| 488 |
|
|
|
| 489 |
|
|
RUNNXL ; RUN
|
| 490 |
|
|
lda CURRNT ; executing a program?
|
| 491 |
|
|
beq WSTART ; if not, we've finished a direct stat.
|
| 492 |
18 |
robfinch |
lda IRQROUT ; are we handling IRQ's ?
|
| 493 |
|
|
beq RUN1
|
| 494 |
|
|
ld r0,IRQFlag ; was there an IRQ ?
|
| 495 |
|
|
beq RUN1
|
| 496 |
|
|
stz IRQFlag
|
| 497 |
|
|
jsr PUSHA ; the same code as a GOSUB
|
| 498 |
|
|
push r8
|
| 499 |
|
|
lda CURRNT
|
| 500 |
|
|
pha ; found it, save old 'CURRNT'...
|
| 501 |
|
|
lda STKGOS
|
| 502 |
|
|
pha ; and 'STKGOS'
|
| 503 |
|
|
stz LOPVAR ; load new values
|
| 504 |
|
|
tsx
|
| 505 |
|
|
stx STKGOS
|
| 506 |
|
|
ld r9,IRQROUT
|
| 507 |
|
|
bra RUNTSL
|
| 508 |
|
|
RUN1
|
| 509 |
16 |
robfinch |
lda #0 ; else find the next line number
|
| 510 |
|
|
ld r9,r8
|
| 511 |
|
|
jsr FNDLNP ; search for the next line
|
| 512 |
18 |
robfinch |
; cmp #0
|
| 513 |
|
|
; bne RUNTSL
|
| 514 |
16 |
robfinch |
cmp r9,TXTUNF; if we've fallen off the end, stop
|
| 515 |
|
|
beq WSTART
|
| 516 |
|
|
bcs WSTART
|
| 517 |
|
|
|
| 518 |
|
|
RUNTSL ; RUN
|
| 519 |
|
|
st r9,CURRNT ; set CURRNT to point to the line no.
|
| 520 |
|
|
add r8,r9,#1 ; set the text pointer to
|
| 521 |
|
|
|
| 522 |
|
|
RUNSML ; RUN
|
| 523 |
|
|
jsr CHKIO ; see if a control-C was pressed
|
| 524 |
|
|
ld r9,#TAB2 ; find command in TAB2
|
| 525 |
|
|
ld r10,#TAB2_1
|
| 526 |
|
|
jmp EXEC ; and execute it
|
| 527 |
|
|
|
| 528 |
|
|
|
| 529 |
|
|
; 'GOTO expr' evaluates the expression, finds the target
|
| 530 |
|
|
; line, and jumps to 'RUNTSL' to do it.
|
| 531 |
|
|
;
|
| 532 |
|
|
GOTO
|
| 533 |
18 |
robfinch |
lda #'G'
|
| 534 |
|
|
jsr DisplayChar
|
| 535 |
16 |
robfinch |
jsr OREXPR ;evaluate the following expression
|
| 536 |
18 |
robfinch |
jsr DisplayWord
|
| 537 |
16 |
robfinch |
ld r5,r1
|
| 538 |
|
|
jsr ENDCHK ;must find end of line
|
| 539 |
|
|
ld r1,r5
|
| 540 |
|
|
jsr FNDLN ; find the target line
|
| 541 |
|
|
cmp #0
|
| 542 |
|
|
bne RUNTSL ; go do it
|
| 543 |
|
|
lda #msgBadGotoGosub
|
| 544 |
|
|
jmp ERROR ; no such line no.
|
| 545 |
|
|
|
| 546 |
|
|
_clr:
|
| 547 |
|
|
jsr clearVars
|
| 548 |
|
|
jmp FINISH
|
| 549 |
|
|
|
| 550 |
|
|
; Clear the variable area of memory
|
| 551 |
|
|
clearVars:
|
| 552 |
|
|
push r6
|
| 553 |
|
|
ld r6,#2048 ; number of words to clear
|
| 554 |
|
|
lda VARBGN
|
| 555 |
|
|
cv1:
|
| 556 |
|
|
stz (r1)
|
| 557 |
|
|
ina
|
| 558 |
|
|
dec r6
|
| 559 |
|
|
bne cv1
|
| 560 |
|
|
pop r6
|
| 561 |
|
|
rts
|
| 562 |
|
|
|
| 563 |
18 |
robfinch |
;******************************************************************
|
| 564 |
|
|
; ONIRQ
|
| 565 |
|
|
; ONIRQ sets up an interrupt handler which acts like a specialized
|
| 566 |
|
|
; subroutine call. ONIRQ is coded like a GOTO that never executes.
|
| 567 |
|
|
;******************************************************************
|
| 568 |
|
|
;
|
| 569 |
|
|
ONIRQ:
|
| 570 |
|
|
jsr OREXPR ;evaluate the following expression
|
| 571 |
|
|
ld r5,r1
|
| 572 |
|
|
jsr ENDCHK ;must find end of line
|
| 573 |
|
|
ld r1,r5
|
| 574 |
|
|
jsr FNDLN ; find the target line
|
| 575 |
|
|
cmp #0
|
| 576 |
|
|
bne ONIRQ1
|
| 577 |
|
|
stz IRQROUT
|
| 578 |
|
|
jmp FINISH
|
| 579 |
|
|
ONIRQ1:
|
| 580 |
|
|
st r9,IRQROUT
|
| 581 |
|
|
jmp FINISH
|
| 582 |
16 |
robfinch |
|
| 583 |
18 |
robfinch |
|
| 584 |
|
|
WAITIRQ:
|
| 585 |
|
|
jsr CHKIO ; see if a control-C was pressed
|
| 586 |
|
|
ld r0,IRQFlag
|
| 587 |
|
|
beq WAITIRQ
|
| 588 |
|
|
jmp FINISH
|
| 589 |
|
|
|
| 590 |
|
|
|
| 591 |
16 |
robfinch |
;******************************************************************
|
| 592 |
|
|
; LIST
|
| 593 |
|
|
;
|
| 594 |
|
|
; LISTX has two forms:
|
| 595 |
|
|
; 'LIST' lists all saved lines
|
| 596 |
|
|
; 'LIST #' starts listing at the line #
|
| 597 |
|
|
; Control-S pauses the listing, control-C stops it.
|
| 598 |
|
|
;******************************************************************
|
| 599 |
|
|
;
|
| 600 |
|
|
LISTX:
|
| 601 |
|
|
jsr TSTNUM ; see if there's a line no.
|
| 602 |
|
|
ld r5,r1
|
| 603 |
|
|
jsr ENDCHK ; if not, we get a zero
|
| 604 |
|
|
ld r1,r5
|
| 605 |
|
|
jsr FNDLN ; find this or next line
|
| 606 |
|
|
LS1:
|
| 607 |
|
|
cmp #0
|
| 608 |
|
|
bne LS4
|
| 609 |
|
|
cmp r9,TXTUNF
|
| 610 |
|
|
beq WSTART
|
| 611 |
|
|
bcs WSTART ; warm start if we passed the end
|
| 612 |
|
|
LS4:
|
| 613 |
|
|
ld r1,r9
|
| 614 |
|
|
jsr PRTLN ; print the line
|
| 615 |
|
|
ld r9,r1 ; set pointer for next
|
| 616 |
|
|
jsr CHKIO ; check for listing halt request
|
| 617 |
|
|
cmp #0
|
| 618 |
|
|
beq LS3
|
| 619 |
|
|
cmp #CTRLS ; pause the listing?
|
| 620 |
|
|
bne LS3
|
| 621 |
|
|
LS2:
|
| 622 |
|
|
jsr CHKIO ; if so, wait for another keypress
|
| 623 |
|
|
cmp #0
|
| 624 |
|
|
beq LS2
|
| 625 |
|
|
LS3:
|
| 626 |
|
|
lda #0
|
| 627 |
|
|
jsr FNDLNP ; find the next line
|
| 628 |
|
|
bra LS1
|
| 629 |
|
|
|
| 630 |
|
|
|
| 631 |
|
|
;******************************************************************
|
| 632 |
|
|
; PRINT command is 'PRINT ....:' or 'PRINT ....'
|
| 633 |
|
|
; where '....' is a list of expressions, formats, back-arrows,
|
| 634 |
|
|
; and strings. These items a separated by commas.
|
| 635 |
|
|
;
|
| 636 |
|
|
; A format is a pound sign followed by a number. It controls
|
| 637 |
|
|
; the number of spaces the value of an expression is going to
|
| 638 |
|
|
; be printed in. It stays effective for the rest of the print
|
| 639 |
|
|
; command unless changed by another format. If no format is
|
| 640 |
|
|
; specified, 11 positions will be used.
|
| 641 |
|
|
;
|
| 642 |
|
|
; A string is quoted in a pair of single- or double-quotes.
|
| 643 |
|
|
;
|
| 644 |
|
|
; An underline (back-arrow) means generate a without a
|
| 645 |
|
|
;
|
| 646 |
|
|
; A is generated after the entire list has been printed
|
| 647 |
|
|
; or if the list is empty. If the list ends with a semicolon,
|
| 648 |
|
|
; however, no is generated.
|
| 649 |
|
|
;******************************************************************
|
| 650 |
|
|
;
|
| 651 |
|
|
PRINT:
|
| 652 |
|
|
ld r5,#11 ; D4 = number of print spaces
|
| 653 |
|
|
ldy #':'
|
| 654 |
|
|
ld r4,#PR2
|
| 655 |
|
|
jsr TSTC ; if null list and ":"
|
| 656 |
|
|
jsr CRLF ; give CR-LF and continue
|
| 657 |
|
|
jmp RUNSML ; execution on the same line
|
| 658 |
|
|
PR2:
|
| 659 |
|
|
ldy #CR
|
| 660 |
|
|
ld r4,#PR0
|
| 661 |
|
|
jsr TSTC ;if null list and
|
| 662 |
|
|
jsr CRLF ;also give CR-LF and
|
| 663 |
|
|
jmp RUNNXL ;execute the next line
|
| 664 |
|
|
PR0:
|
| 665 |
|
|
ldy #'#'
|
| 666 |
|
|
ld r4,#PR1
|
| 667 |
|
|
jsr TSTC ;else is it a format?
|
| 668 |
|
|
jsr OREXPR ; yes, evaluate expression
|
| 669 |
18 |
robfinch |
ld r5,r1 ; and save it as print width
|
| 670 |
16 |
robfinch |
bra PR3 ; look for more to print
|
| 671 |
|
|
PR1:
|
| 672 |
|
|
ldy #'$'
|
| 673 |
|
|
ld r4,#PR4
|
| 674 |
|
|
jsr TSTC ; is character expression? (MRL)
|
| 675 |
|
|
jsr OREXPR ; yep. Evaluate expression (MRL)
|
| 676 |
|
|
jsr GOOUT ; print low byte (MRL)
|
| 677 |
|
|
bra PR3 ;look for more. (MRL)
|
| 678 |
|
|
PR4:
|
| 679 |
|
|
jsr QTSTG ; is it a string?
|
| 680 |
|
|
; the following branch must occupy only two bytes!
|
| 681 |
|
|
bra PR8 ; if not, must be an expression
|
| 682 |
|
|
PR3:
|
| 683 |
|
|
ldy #','
|
| 684 |
|
|
ld r4,#PR6
|
| 685 |
|
|
jsr TSTC ; if ",", go find next
|
| 686 |
|
|
jsr FIN ;in the list.
|
| 687 |
|
|
bra PR0
|
| 688 |
|
|
PR6:
|
| 689 |
|
|
jsr CRLF ;list ends here
|
| 690 |
|
|
jmp FINISH
|
| 691 |
|
|
PR8:
|
| 692 |
|
|
jsr OREXPR ; evaluate the expression
|
| 693 |
|
|
ld r2,r5 ; set the width
|
| 694 |
|
|
jsr PRTNUM ; print its value
|
| 695 |
|
|
bra PR3 ; more to print?
|
| 696 |
|
|
|
| 697 |
|
|
FINISH:
|
| 698 |
|
|
jsr FIN ; Check end of command
|
| 699 |
|
|
jmp QWHAT ; print "What?" if wrong
|
| 700 |
|
|
|
| 701 |
|
|
|
| 702 |
|
|
;*******************************************************************
|
| 703 |
|
|
;
|
| 704 |
|
|
; *** GOSUB *** & RETURN ***
|
| 705 |
|
|
;
|
| 706 |
|
|
; 'GOSUB expr:' or 'GOSUB expr' is like the 'GOTO' command,
|
| 707 |
|
|
; except that the current text pointer, stack pointer, etc. are
|
| 708 |
|
|
; saved so that execution can be continued after the subroutine
|
| 709 |
|
|
; 'RETURN's. In order that 'GOSUB' can be nested (and even
|
| 710 |
|
|
; recursive), the save area must be stacked. The stack pointer
|
| 711 |
|
|
; is saved in 'STKGOS'. The old 'STKGOS' is saved on the stack.
|
| 712 |
|
|
; If we are in the main routine, 'STKGOS' is zero (this was done
|
| 713 |
|
|
; in the initialization section of the interpreter), but we still
|
| 714 |
|
|
; save it as a flag for no further 'RETURN's.
|
| 715 |
|
|
;******************************************************************
|
| 716 |
|
|
;
|
| 717 |
|
|
GOSUB:
|
| 718 |
|
|
jsr PUSHA ; save the current 'FOR' parameters
|
| 719 |
|
|
jsr OREXPR ; get line number
|
| 720 |
|
|
jsr FNDLN ; find the target line
|
| 721 |
|
|
cmp #0
|
| 722 |
|
|
bne gosub1
|
| 723 |
|
|
lda #msgBadGotoGosub
|
| 724 |
|
|
jmp ERROR ; if not there, say "How?"
|
| 725 |
|
|
gosub1:
|
| 726 |
|
|
push r8
|
| 727 |
|
|
lda CURRNT
|
| 728 |
|
|
pha ; found it, save old 'CURRNT'...
|
| 729 |
|
|
lda STKGOS
|
| 730 |
|
|
pha ; and 'STKGOS'
|
| 731 |
|
|
stz LOPVAR ; load new values
|
| 732 |
|
|
tsx
|
| 733 |
|
|
stx STKGOS
|
| 734 |
|
|
jmp RUNTSL
|
| 735 |
|
|
|
| 736 |
|
|
|
| 737 |
|
|
;******************************************************************
|
| 738 |
|
|
; 'RETURN' undoes everything that 'GOSUB' did, and thus
|
| 739 |
|
|
; returns the execution to the command after the most recent
|
| 740 |
|
|
; 'GOSUB'. If 'STKGOS' is zero, it indicates that we never had
|
| 741 |
|
|
; a 'GOSUB' and is thus an error.
|
| 742 |
|
|
;******************************************************************
|
| 743 |
|
|
;
|
| 744 |
|
|
RETURN:
|
| 745 |
|
|
jsr ENDCHK ; there should be just a
|
| 746 |
|
|
ldx STKGOS ; get old stack pointer
|
| 747 |
|
|
bne return1
|
| 748 |
|
|
lda #msgRetWoGosub
|
| 749 |
|
|
jmp ERROR ; if zero, it doesn't exist
|
| 750 |
|
|
return1:
|
| 751 |
|
|
txs ; else restore it
|
| 752 |
|
|
pla
|
| 753 |
|
|
sta STKGOS ; and the old 'STKGOS'
|
| 754 |
|
|
pla
|
| 755 |
|
|
sta CURRNT ; and the old 'CURRNT'
|
| 756 |
|
|
pop r8 ; and the old text pointer
|
| 757 |
|
|
jsr POPA ;and the old 'FOR' parameters
|
| 758 |
|
|
jmp FINISH ;and we are back home
|
| 759 |
|
|
|
| 760 |
|
|
;******************************************************************
|
| 761 |
|
|
; *** FOR *** & NEXT ***
|
| 762 |
|
|
;
|
| 763 |
|
|
; 'FOR' has two forms:
|
| 764 |
|
|
; 'FOR var=exp1 TO exp2 STEP exp1' and 'FOR var=exp1 TO exp2'
|
| 765 |
|
|
; The second form means the same thing as the first form with a
|
| 766 |
|
|
; STEP of positive 1. The interpreter will find the variable 'var'
|
| 767 |
|
|
; and set its value to the current value of 'exp1'. It also
|
| 768 |
|
|
; evaluates 'exp2' and 'exp1' and saves all these together with
|
| 769 |
|
|
; the text pointer, etc. in the 'FOR' save area, which consists of
|
| 770 |
|
|
; 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', and 'LOPPT'. If there is
|
| 771 |
|
|
; already something in the save area (indicated by a non-zero
|
| 772 |
|
|
; 'LOPVAR'), then the old save area is saved on the stack before
|
| 773 |
|
|
; the new values are stored. The interpreter will then dig in the
|
| 774 |
|
|
; stack and find out if this same variable was used in another
|
| 775 |
|
|
; currently active 'FOR' loop. If that is the case, then the old
|
| 776 |
|
|
; 'FOR' loop is deactivated. (i.e. purged from the stack)
|
| 777 |
|
|
;******************************************************************
|
| 778 |
|
|
;
|
| 779 |
|
|
FOR:
|
| 780 |
|
|
jsr PUSHA ; save the old 'FOR' save area
|
| 781 |
|
|
jsr SETVAL ; set the control variable
|
| 782 |
|
|
sta LOPVAR ; save its address
|
| 783 |
|
|
ld r9,#TAB5
|
| 784 |
|
|
ld r10,#TAB5_1 ; use 'EXEC' to test for 'TO'
|
| 785 |
|
|
jmp EXEC
|
| 786 |
|
|
FR1:
|
| 787 |
|
|
jsr OREXPR ; evaluate the limit
|
| 788 |
|
|
sta LOPLMT ; save that
|
| 789 |
|
|
ld r9,#TAB6
|
| 790 |
|
|
ld r10,#TAB6_1 ; use 'EXEC' to test for the word 'STEP
|
| 791 |
|
|
jmp EXEC
|
| 792 |
|
|
FR2:
|
| 793 |
|
|
jsr OREXPR ; found it, get the step value
|
| 794 |
|
|
bra FR4
|
| 795 |
|
|
FR3:
|
| 796 |
|
|
lda #1 ; not found, step defaults to 1
|
| 797 |
|
|
FR4:
|
| 798 |
|
|
sta LOPINC ; save that too
|
| 799 |
|
|
FR5:
|
| 800 |
|
|
ldx CURRNT
|
| 801 |
|
|
stx LOPLN ; save address of current line number
|
| 802 |
|
|
st r8,LOPPT ; and text pointer
|
| 803 |
|
|
tsx
|
| 804 |
|
|
txy ; dig into the stack to find 'LOPVAR'
|
| 805 |
|
|
ld r6,LOPVAR
|
| 806 |
|
|
bra FR7
|
| 807 |
|
|
FR6:
|
| 808 |
|
|
add r3,r3,#5 ; look at next stack frame
|
| 809 |
|
|
FR7:
|
| 810 |
|
|
ldx (y) ; is it zero?
|
| 811 |
|
|
beq FR8 ; if so, we're done
|
| 812 |
|
|
cmp r2,r6
|
| 813 |
|
|
bne FR6 ; same as current LOPVAR? nope, look some more
|
| 814 |
|
|
|
| 815 |
|
|
tya ; Else remove 5 long words from...
|
| 816 |
|
|
add r2,r3,#5 ; inside the stack.
|
| 817 |
|
|
tsx
|
| 818 |
|
|
txy
|
| 819 |
|
|
jsr MVDOWN
|
| 820 |
|
|
pla ; set the SP 5 long words up
|
| 821 |
|
|
pla
|
| 822 |
|
|
pla
|
| 823 |
|
|
pla
|
| 824 |
|
|
pla
|
| 825 |
|
|
FR8:
|
| 826 |
|
|
jmp FINISH ; and continue execution
|
| 827 |
|
|
|
| 828 |
|
|
|
| 829 |
|
|
;******************************************************************
|
| 830 |
|
|
; 'NEXT var' serves as the logical (not necessarily physical) end
|
| 831 |
|
|
; of the 'FOR' loop. The control variable 'var' is checked with
|
| 832 |
|
|
; the 'LOPVAR'. If they are not the same, the interpreter digs in
|
| 833 |
|
|
; the stack to find the right one and purges all those that didn't
|
| 834 |
|
|
; match. Either way, it then adds the 'STEP' to that variable and
|
| 835 |
|
|
; checks the result with against the limit value. If it is within
|
| 836 |
|
|
; the limit, control loops back to the command following the
|
| 837 |
|
|
; 'FOR'. If it's outside the limit, the save area is purged and
|
| 838 |
|
|
; execution continues.
|
| 839 |
|
|
;******************************************************************
|
| 840 |
|
|
;
|
| 841 |
|
|
NEXT:
|
| 842 |
|
|
lda #0 ; don't allocate it
|
| 843 |
|
|
jsr TSTV ; get address of variable
|
| 844 |
|
|
cmp #0
|
| 845 |
|
|
bne NX4
|
| 846 |
|
|
lda #msgNextVar
|
| 847 |
|
|
bra ERROR ; if no variable, say "What?"
|
| 848 |
|
|
NX4:
|
| 849 |
|
|
ld r9,r1 ; save variable's address
|
| 850 |
|
|
NX0:
|
| 851 |
|
|
lda LOPVAR ; If 'LOPVAR' is zero, we never...
|
| 852 |
|
|
bne NX5 ; had a FOR loop
|
| 853 |
|
|
lda #msgNextFor
|
| 854 |
|
|
bra ERROR
|
| 855 |
|
|
NX5:
|
| 856 |
|
|
cmp r1,r9
|
| 857 |
|
|
beq NX2 ; else we check them OK, they agree
|
| 858 |
|
|
jsr POPA ; nope, let's see the next frame
|
| 859 |
|
|
bra NX0
|
| 860 |
|
|
NX2:
|
| 861 |
|
|
lda (r9) ; get control variable's value
|
| 862 |
|
|
ldx LOPINC
|
| 863 |
|
|
add r1,r1,r2 ; add in loop increment
|
| 864 |
|
|
; BVS.L QHOW say "How?" for 32-bit overflow
|
| 865 |
|
|
sta (r9) ; save control variable's new value
|
| 866 |
|
|
ldy LOPLMT ; get loop's limit value
|
| 867 |
|
|
cmp r2,#1
|
| 868 |
|
|
beq NX1
|
| 869 |
|
|
bpl NX1 ; check loop increment, branch if loop increment is positive
|
| 870 |
|
|
cmp r1,r3
|
| 871 |
|
|
beq NX3
|
| 872 |
|
|
bmi NXPurge ; test against limit
|
| 873 |
|
|
bra NX3
|
| 874 |
|
|
NX1:
|
| 875 |
|
|
cmp r1,r3
|
| 876 |
|
|
beq NX3
|
| 877 |
|
|
bpl NXPurge
|
| 878 |
|
|
NX3:
|
| 879 |
|
|
ld r8,LOPLN ; Within limit, go back to the...
|
| 880 |
|
|
st r8,CURRNT
|
| 881 |
|
|
ld r8,LOPPT ; saved 'CURRNT' and text pointer.
|
| 882 |
|
|
jmp FINISH
|
| 883 |
|
|
NXPurge:
|
| 884 |
|
|
jsr POPA ; purge this loop
|
| 885 |
|
|
jmp FINISH
|
| 886 |
|
|
|
| 887 |
|
|
|
| 888 |
|
|
;******************************************************************
|
| 889 |
|
|
; *** REM *** IF *** INPUT *** LET (& DEFLT) ***
|
| 890 |
|
|
;
|
| 891 |
|
|
; 'REM' can be followed by anything and is ignored by the
|
| 892 |
|
|
; interpreter.
|
| 893 |
|
|
;
|
| 894 |
|
|
;REM
|
| 895 |
|
|
; br IF2 ; skip the rest of the line
|
| 896 |
|
|
; 'IF' is followed by an expression, as a condition and one or
|
| 897 |
|
|
; more commands (including other 'IF's) separated by colons.
|
| 898 |
|
|
; Note that the word 'THEN' is not used. The interpreter evaluates
|
| 899 |
|
|
; the expression. If it is non-zero, execution continues. If it
|
| 900 |
|
|
; is zero, the commands that follow are ignored and execution
|
| 901 |
|
|
; continues on the next line.
|
| 902 |
|
|
;******************************************************************
|
| 903 |
|
|
;
|
| 904 |
|
|
IF:
|
| 905 |
|
|
jsr OREXPR ; evaluate the expression
|
| 906 |
|
|
IF1:
|
| 907 |
|
|
cmp #0
|
| 908 |
|
|
bne RUNSML ; is it zero? if not, continue
|
| 909 |
|
|
IF2:
|
| 910 |
18 |
robfinch |
ld r9,r8 ; set lookup pointer
|
| 911 |
16 |
robfinch |
lda #0 ; find line #0 (impossible)
|
| 912 |
|
|
jsr FNDSKP ; if so, skip the rest of the line
|
| 913 |
|
|
cmp #0
|
| 914 |
|
|
bcs WSTART ; if no next line, do a warm start
|
| 915 |
|
|
IF3:
|
| 916 |
|
|
jmp RUNTSL ; run the next line
|
| 917 |
|
|
|
| 918 |
|
|
|
| 919 |
|
|
;******************************************************************
|
| 920 |
|
|
; INPUT is called first and establishes a stack frame
|
| 921 |
|
|
INPERR:
|
| 922 |
|
|
ldx STKINP ; restore the old stack pointer
|
| 923 |
|
|
txs
|
| 924 |
|
|
pla
|
| 925 |
|
|
sta CURRNT ; and old 'CURRNT'
|
| 926 |
|
|
pop r8 ; and old text pointer
|
| 927 |
|
|
tsx
|
| 928 |
|
|
add r2,r2,#5 ; fall through will subtract 5
|
| 929 |
|
|
txs
|
| 930 |
|
|
|
| 931 |
|
|
; 'INPUT' is like the 'PRINT' command, and is followed by a list
|
| 932 |
|
|
; of items. If the item is a string in single or double quotes,
|
| 933 |
|
|
; or is an underline (back arrow), it has the same effect as in
|
| 934 |
|
|
; 'PRINT'. If an item is a variable, this variable name is
|
| 935 |
|
|
; printed out followed by a colon, then the interpreter waits for
|
| 936 |
|
|
; an expression to be typed in. The variable is then set to the
|
| 937 |
|
|
; value of this expression. If the variable is preceeded by a
|
| 938 |
|
|
; string (again in single or double quotes), the string will be
|
| 939 |
|
|
; displayed followed by a colon. The interpreter the waits for an
|
| 940 |
|
|
; expression to be entered and sets the variable equal to the
|
| 941 |
|
|
; expression's value. If the input expression is invalid, the
|
| 942 |
|
|
; interpreter will print "What?", "How?", or "Sorry" and reprint
|
| 943 |
|
|
; the prompt and redo the input. The execution will not terminate
|
| 944 |
|
|
; unless you press control-C. This is handled in 'INPERR'.
|
| 945 |
|
|
;
|
| 946 |
|
|
INPUT:
|
| 947 |
|
|
push r7
|
| 948 |
|
|
tsr sp,r7
|
| 949 |
|
|
sub r7,r7,#5 ; allocate five words on stack
|
| 950 |
|
|
trs r7,sp
|
| 951 |
|
|
st r5,4,r7 ; save off r5 into stack var
|
| 952 |
|
|
IP6:
|
| 953 |
|
|
st r8,(r7) ; save in case of error
|
| 954 |
|
|
jsr QTSTG ; is next item a string?
|
| 955 |
|
|
bra IP2 ; nope - this branch must take only two bytes
|
| 956 |
|
|
lda #1 ; allocate var
|
| 957 |
|
|
jsr TSTV ; yes, but is it followed by a variable?
|
| 958 |
|
|
cmp #0
|
| 959 |
|
|
beq IP4 ; if not, brnch
|
| 960 |
|
|
or r10,r1,r0 ; put away the variable's address
|
| 961 |
|
|
bra IP3 ; if so, input to variable
|
| 962 |
|
|
IP2:
|
| 963 |
|
|
st r8,1,r7 ; save off in stack var for 'PRTSTG'
|
| 964 |
|
|
lda #1
|
| 965 |
|
|
jsr TSTV ; must be a variable now
|
| 966 |
|
|
cmp #0
|
| 967 |
|
|
bne IP7
|
| 968 |
|
|
lda #msgInputVar
|
| 969 |
|
|
add r7,r7,#5 ; cleanup stack
|
| 970 |
|
|
trs r7,sp
|
| 971 |
|
|
pop r7 ; so we can get back r7
|
| 972 |
|
|
bra ERROR ; "What?" it isn't?
|
| 973 |
|
|
IP7:
|
| 974 |
|
|
or r10,r1,r0 ; put away the variable's address
|
| 975 |
|
|
ld r5,(r8) ; get ready for 'PRTSTG' by null terminating
|
| 976 |
|
|
stz (r8)
|
| 977 |
|
|
lda 1,r7 ; get back text pointer
|
| 978 |
|
|
jsr PRTSTG ; print string as prompt
|
| 979 |
|
|
st r5,(r8) ; un-null terminate
|
| 980 |
|
|
IP3
|
| 981 |
|
|
st r8,1,r7 ; save in case of error
|
| 982 |
|
|
lda CURRNT
|
| 983 |
|
|
sta 2,r7 ; also save 'CURRNT'
|
| 984 |
|
|
lda #-1
|
| 985 |
|
|
sta CURRNT ; flag that we are in INPUT
|
| 986 |
|
|
stx STKINP ; save the stack pointer too
|
| 987 |
|
|
st r10,3,r7 ; save the variable address
|
| 988 |
|
|
lda #':' ; print a colon first
|
| 989 |
|
|
jsr GETLN ; then get an input line
|
| 990 |
|
|
ld r8,#BUFFER ; point to the buffer
|
| 991 |
|
|
jsr OREXPR ; evaluate the input
|
| 992 |
|
|
ld r10,3,r7 ; restore the variable address
|
| 993 |
|
|
sta (r10) ; save value in variable
|
| 994 |
|
|
lda 2,r7 ; restore old 'CURRNT'
|
| 995 |
|
|
sta CURRNT
|
| 996 |
|
|
ld r8,1,r7 ; and the old text pointer
|
| 997 |
|
|
IP4:
|
| 998 |
|
|
ldy #','
|
| 999 |
|
|
ld r4,#IP5 ; is the next thing a comma?
|
| 1000 |
|
|
jsr TSTC
|
| 1001 |
|
|
bra IP6 ; yes, more items
|
| 1002 |
|
|
IP5:
|
| 1003 |
|
|
ld r5,4,r7
|
| 1004 |
|
|
add r7,r7,#5 ; cleanup stack
|
| 1005 |
|
|
trs r7,sp
|
| 1006 |
|
|
pop r7
|
| 1007 |
|
|
jmp FINISH
|
| 1008 |
|
|
|
| 1009 |
|
|
|
| 1010 |
|
|
DEFLT:
|
| 1011 |
|
|
lda (r8)
|
| 1012 |
|
|
cmp #CR
|
| 1013 |
|
|
beq FINISH ; empty line is OK else it is 'LET'
|
| 1014 |
|
|
|
| 1015 |
|
|
|
| 1016 |
|
|
;******************************************************************
|
| 1017 |
|
|
; 'LET' is followed by a list of items separated by commas.
|
| 1018 |
|
|
; Each item consists of a variable, an equals sign, and an
|
| 1019 |
|
|
; expression. The interpreter evaluates the expression and sets
|
| 1020 |
|
|
; the variable to that value. The interpreter will also handle
|
| 1021 |
|
|
; 'LET' commands without the word 'LET'. This is done by 'DEFLT'.
|
| 1022 |
|
|
;******************************************************************
|
| 1023 |
|
|
;
|
| 1024 |
|
|
LET:
|
| 1025 |
|
|
jsr SETVAL ; do the assignment
|
| 1026 |
|
|
ldy #','
|
| 1027 |
|
|
ld r4,#FINISH
|
| 1028 |
|
|
jsr TSTC ; check for more 'LET' items
|
| 1029 |
|
|
bra LET
|
| 1030 |
|
|
LT1:
|
| 1031 |
|
|
jmp FINISH ; until we are finished.
|
| 1032 |
|
|
|
| 1033 |
|
|
|
| 1034 |
|
|
;******************************************************************
|
| 1035 |
|
|
; *** LOAD *** & SAVE ***
|
| 1036 |
|
|
;
|
| 1037 |
|
|
; These two commands transfer a program to/from an auxiliary
|
| 1038 |
|
|
; device such as a cassette, another computer, etc. The program
|
| 1039 |
|
|
; is converted to an easily-stored format: each line starts with
|
| 1040 |
|
|
; a colon, the line no. as 4 hex digits, and the rest of the line.
|
| 1041 |
|
|
; At the end, a line starting with an '@' sign is sent. This
|
| 1042 |
|
|
; format can be read back with a minimum of processing time by
|
| 1043 |
|
|
; the RTF65002
|
| 1044 |
|
|
;******************************************************************
|
| 1045 |
|
|
;
|
| 1046 |
|
|
LOAD
|
| 1047 |
|
|
ld r8,TXTBGN>>2 ; set pointer to start of prog. area
|
| 1048 |
|
|
lda #CR ; For a CP/M host, tell it we're ready...
|
| 1049 |
|
|
jsr GOAUXO ; by sending a CR to finish PIP command.
|
| 1050 |
|
|
LOD1:
|
| 1051 |
|
|
jsr GOAUXI ; look for start of line
|
| 1052 |
|
|
cmp #0
|
| 1053 |
|
|
beq LOD1
|
| 1054 |
|
|
bcc LOD1
|
| 1055 |
|
|
cmp #'@' ; end of program?
|
| 1056 |
|
|
beq LODEND
|
| 1057 |
|
|
cmp #$1A
|
| 1058 |
|
|
beq LODEND ; or EOF marker
|
| 1059 |
|
|
cmp #':'
|
| 1060 |
|
|
bne LOD1 ; if not, is it start of line? if not, wait for it
|
| 1061 |
|
|
jsr GCHAR ; get line number
|
| 1062 |
|
|
sta (r8) ; store it
|
| 1063 |
18 |
robfinch |
inc r8
|
| 1064 |
16 |
robfinch |
LOD2:
|
| 1065 |
|
|
jsr GOAUXI ; get another text char.
|
| 1066 |
|
|
cmp #0
|
| 1067 |
|
|
beq LOD2
|
| 1068 |
|
|
bcc LOD2
|
| 1069 |
|
|
sta (r8)
|
| 1070 |
18 |
robfinch |
inc r8 ; store it
|
| 1071 |
16 |
robfinch |
cmp #CR
|
| 1072 |
|
|
bne LOD2 ; is it the end of the line? if not, go back for more
|
| 1073 |
|
|
bra LOD1 ; if so, start a new line
|
| 1074 |
|
|
LODEND:
|
| 1075 |
|
|
st r8,TXTUNF ; set end-of program pointer
|
| 1076 |
|
|
jmp WSTART ; back to direct mode
|
| 1077 |
|
|
|
| 1078 |
|
|
|
| 1079 |
|
|
; get character from input (16 bit value)
|
| 1080 |
|
|
GCHAR:
|
| 1081 |
|
|
push r5
|
| 1082 |
|
|
push r6
|
| 1083 |
|
|
ld r6,#3 ; repeat four times
|
| 1084 |
|
|
ld r5,#0
|
| 1085 |
|
|
GCHAR1:
|
| 1086 |
|
|
jsr GOAUXI ; get a char
|
| 1087 |
|
|
cmp #0
|
| 1088 |
|
|
beq GCHAR1
|
| 1089 |
|
|
bcc GCHAR1
|
| 1090 |
|
|
jsr asciiToHex
|
| 1091 |
|
|
asl r5,r5
|
| 1092 |
|
|
asl r5,r5
|
| 1093 |
|
|
asl r5,r5
|
| 1094 |
|
|
asl r5,r5
|
| 1095 |
|
|
or r5,r5,r1
|
| 1096 |
18 |
robfinch |
dec r6
|
| 1097 |
16 |
robfinch |
bne GCHAR1
|
| 1098 |
18 |
robfinch |
ld r1,r5
|
| 1099 |
16 |
robfinch |
pop r6
|
| 1100 |
|
|
pop r5
|
| 1101 |
|
|
rts
|
| 1102 |
|
|
|
| 1103 |
|
|
|
| 1104 |
|
|
; convert an ascii char to hex code
|
| 1105 |
|
|
; input
|
| 1106 |
|
|
; r1 = char to convert
|
| 1107 |
|
|
|
| 1108 |
|
|
asciiToHex:
|
| 1109 |
|
|
cmp #'9' ; less than '9'
|
| 1110 |
|
|
beq a2h1
|
| 1111 |
|
|
bcc a2h1
|
| 1112 |
|
|
sub #7 ; shift 'A' to '9'+1
|
| 1113 |
|
|
a2h1:
|
| 1114 |
|
|
sub #'0'
|
| 1115 |
|
|
and #15 ; make sure a nybble
|
| 1116 |
|
|
rts
|
| 1117 |
|
|
|
| 1118 |
|
|
|
| 1119 |
|
|
|
| 1120 |
|
|
SAVE:
|
| 1121 |
|
|
ld r8,TXTBGN>>2 ;set pointer to start of prog. area
|
| 1122 |
|
|
ld r9,TXTUNF ;set pointer to end of prog. area
|
| 1123 |
|
|
SAVE1:
|
| 1124 |
|
|
jsr AUXOCRLF ; send out a CR & LF (CP/M likes this)
|
| 1125 |
|
|
cmp r8,r9
|
| 1126 |
|
|
bcs SAVEND ; are we finished?
|
| 1127 |
|
|
lda #':' ; if not, start a line
|
| 1128 |
|
|
jsr GOAUXO
|
| 1129 |
|
|
lda (r8) ; get line number
|
| 1130 |
18 |
robfinch |
inc r8
|
| 1131 |
16 |
robfinch |
jsr PWORD ; output line number as 4-digit hex
|
| 1132 |
|
|
SAVE2:
|
| 1133 |
|
|
lda (r8) ; get a text char.
|
| 1134 |
18 |
robfinch |
inc r8
|
| 1135 |
16 |
robfinch |
cmp #CR
|
| 1136 |
|
|
beq SAVE1 ; is it the end of the line? if so, send CR & LF and start new line
|
| 1137 |
|
|
jsr GOAUXO ; send it out
|
| 1138 |
|
|
bra SAVE2 ; go back for more text
|
| 1139 |
|
|
SAVEND:
|
| 1140 |
|
|
lda #'@' ; send end-of-program indicator
|
| 1141 |
|
|
jsr GOAUXO
|
| 1142 |
|
|
jsr AUXOCRLF ; followed by a CR & LF
|
| 1143 |
|
|
lda #$1A ; and a control-Z to end the CP/M file
|
| 1144 |
|
|
jsr GOAUXO
|
| 1145 |
|
|
bra WSTART ; then go do a warm start
|
| 1146 |
|
|
|
| 1147 |
|
|
|
| 1148 |
|
|
; output a CR LF sequence to auxillary output
|
| 1149 |
|
|
; Registers Affected
|
| 1150 |
|
|
; r3 = LF
|
| 1151 |
|
|
AUXOCRLF:
|
| 1152 |
|
|
lda #CR
|
| 1153 |
|
|
jsr GOAUXO
|
| 1154 |
|
|
lda #LF
|
| 1155 |
|
|
jsr GOAUXO
|
| 1156 |
|
|
rts
|
| 1157 |
|
|
|
| 1158 |
|
|
|
| 1159 |
|
|
; output a word in hex format
|
| 1160 |
|
|
; tricky because of the need to reverse the order of the chars
|
| 1161 |
|
|
PWORD:
|
| 1162 |
|
|
push r5
|
| 1163 |
|
|
ld r5,#NUMWKA+15
|
| 1164 |
|
|
or r4,r1,r0 ; r4 = value
|
| 1165 |
|
|
pword1:
|
| 1166 |
|
|
or r1,r4,r0 ; r1 = value
|
| 1167 |
|
|
lsr r4,r4 ; shift over to next nybble
|
| 1168 |
|
|
lsr r4,r4
|
| 1169 |
|
|
lsr r4,r4
|
| 1170 |
|
|
lsr r4,r4
|
| 1171 |
|
|
jsr toAsciiHex ; convert LS nybble to ascii hex
|
| 1172 |
|
|
sta (r5) ; save in work area
|
| 1173 |
|
|
sub r5,r5,#1
|
| 1174 |
|
|
cmp r5,#NUMWKA
|
| 1175 |
|
|
beq pword1
|
| 1176 |
|
|
bcs pword1
|
| 1177 |
|
|
pword2:
|
| 1178 |
|
|
add r5,r5,#1
|
| 1179 |
|
|
lda (r5) ; get char to output
|
| 1180 |
|
|
jsr GOAUXO ; send it
|
| 1181 |
|
|
cmp r5,#NUMWKA+15
|
| 1182 |
|
|
bcc pword2
|
| 1183 |
|
|
pop r5
|
| 1184 |
|
|
rts
|
| 1185 |
|
|
|
| 1186 |
|
|
|
| 1187 |
|
|
; convert nybble in r2 to ascii hex char2
|
| 1188 |
|
|
; r2 = character to convert
|
| 1189 |
|
|
|
| 1190 |
|
|
toAsciiHex:
|
| 1191 |
|
|
and #15 ; make sure it's a nybble
|
| 1192 |
|
|
cmp #10 ; > 10 ?
|
| 1193 |
|
|
bcc tah1
|
| 1194 |
|
|
add #7 ; bump it up to the letter 'A'
|
| 1195 |
|
|
tah1:
|
| 1196 |
|
|
add #'0' ; bump up to ascii '0'
|
| 1197 |
|
|
rts
|
| 1198 |
|
|
|
| 1199 |
|
|
|
| 1200 |
|
|
|
| 1201 |
|
|
;******************************************************************
|
| 1202 |
18 |
robfinch |
; *** POKE ***
|
| 1203 |
16 |
robfinch |
;
|
| 1204 |
18 |
robfinch |
; 'POKE expr1,expr2' stores the word from 'expr2' into the memory
|
| 1205 |
16 |
robfinch |
; address specified by 'expr1'.
|
| 1206 |
|
|
;******************************************************************
|
| 1207 |
|
|
;
|
| 1208 |
|
|
POKE:
|
| 1209 |
|
|
jsr OREXPR ; get the memory address
|
| 1210 |
|
|
ldy #','
|
| 1211 |
|
|
ld r4,#PKER ; it must be followed by a comma
|
| 1212 |
|
|
jsr TSTC ; it must be followed by a comma
|
| 1213 |
|
|
pha ; save the address
|
| 1214 |
|
|
jsr OREXPR ; get the byte to be POKE'd
|
| 1215 |
|
|
plx ; get the address back
|
| 1216 |
|
|
sta (x) ; store the byte in memory
|
| 1217 |
|
|
jmp FINISH
|
| 1218 |
|
|
PKER:
|
| 1219 |
|
|
lda #msgComma
|
| 1220 |
|
|
jmp ERROR ; if no comma, say "What?"
|
| 1221 |
|
|
|
| 1222 |
|
|
|
| 1223 |
18 |
robfinch |
;******************************************************************
|
| 1224 |
|
|
; 'SYSX expr' jumps to the machine language subroutine whose
|
| 1225 |
|
|
; starting address is specified by 'expr'. The subroutine can use
|
| 1226 |
|
|
; all registers but must leave the stack the way it found it.
|
| 1227 |
|
|
; The subroutine returns to the interpreter by executing an RTS.
|
| 1228 |
|
|
;******************************************************************
|
| 1229 |
16 |
robfinch |
|
| 1230 |
|
|
SYSX:
|
| 1231 |
|
|
jsr OREXPR ; get the subroutine's address
|
| 1232 |
|
|
cmp #0
|
| 1233 |
|
|
bne sysx1 ; make sure we got a valid address
|
| 1234 |
|
|
lda #msgSYSBad
|
| 1235 |
|
|
jmp ERROR
|
| 1236 |
|
|
sysx1:
|
| 1237 |
|
|
push r8 ; save the text pointer
|
| 1238 |
|
|
jsr (r1) ; jump to the subroutine
|
| 1239 |
|
|
pop r8 ; restore the text pointer
|
| 1240 |
|
|
jmp FINISH
|
| 1241 |
|
|
|
| 1242 |
|
|
;******************************************************************
|
| 1243 |
|
|
; *** EXPR ***
|
| 1244 |
|
|
;
|
| 1245 |
|
|
; 'EXPR' evaluates arithmetical or logical expressions.
|
| 1246 |
|
|
; ::= OR ...
|
| 1247 |
|
|
; ::= AND ...
|
| 1248 |
|
|
; ::=
|
| 1249 |
|
|
;
|
| 1250 |
|
|
; where is one of the operators in TAB8 and the result
|
| 1251 |
|
|
; of these operations is 1 if true and 0 if false.
|
| 1252 |
|
|
; ::=(+ or -)(+ or -)(...
|
| 1253 |
|
|
; where () are optional and (... are optional repeats.
|
| 1254 |
|
|
; ::=( <* or /> )(...
|
| 1255 |
|
|
; ::=
|
| 1256 |
|
|
;
|
| 1257 |
|
|
; ()
|
| 1258 |
|
|
; is recursive so that the variable '@' can have an
|
| 1259 |
|
|
; as an index, functions can have an as arguments, and
|
| 1260 |
|
|
; can be an in parenthesis.
|
| 1261 |
|
|
;
|
| 1262 |
|
|
|
| 1263 |
|
|
; ::= OR ...
|
| 1264 |
|
|
;
|
| 1265 |
|
|
OREXPR:
|
| 1266 |
|
|
jsr ANDEXPR ; get first
|
| 1267 |
|
|
XP_OR1:
|
| 1268 |
|
|
pha ; save value
|
| 1269 |
|
|
ld r9,#TAB10 ; look up a logical operator
|
| 1270 |
|
|
ld r10,#TAB10_1
|
| 1271 |
|
|
jmp EXEC ; go do it
|
| 1272 |
|
|
XP_OR:
|
| 1273 |
|
|
jsr ANDEXPR
|
| 1274 |
|
|
plx
|
| 1275 |
|
|
or r1,r1,r2
|
| 1276 |
|
|
bra XP_OR1
|
| 1277 |
|
|
XP_ORX:
|
| 1278 |
|
|
pla
|
| 1279 |
|
|
rts
|
| 1280 |
|
|
|
| 1281 |
|
|
|
| 1282 |
|
|
; ::= AND ...
|
| 1283 |
|
|
;
|
| 1284 |
|
|
ANDEXPR:
|
| 1285 |
|
|
jsr EXPR ; get first
|
| 1286 |
|
|
XP_AND1:
|
| 1287 |
|
|
pha ; save value
|
| 1288 |
|
|
ld r9,#TAB9 ; look up a logical operator
|
| 1289 |
|
|
ld r10,#TAB9_1
|
| 1290 |
|
|
jmp EXEC ; go do it
|
| 1291 |
|
|
XP_AND:
|
| 1292 |
|
|
jsr EXPR
|
| 1293 |
|
|
plx
|
| 1294 |
|
|
and r1,r1,r2
|
| 1295 |
|
|
bra XP_AND1
|
| 1296 |
|
|
XP_ANDX:
|
| 1297 |
|
|
pla
|
| 1298 |
|
|
rts
|
| 1299 |
|
|
|
| 1300 |
|
|
|
| 1301 |
|
|
; Determine if the character is a digit
|
| 1302 |
|
|
; Parameters
|
| 1303 |
|
|
; r1 = char to test
|
| 1304 |
|
|
; Returns
|
| 1305 |
|
|
; r1 = 1 if digit, otherwise 0
|
| 1306 |
|
|
;
|
| 1307 |
|
|
isDigit:
|
| 1308 |
|
|
cmp #'0'
|
| 1309 |
|
|
bcc isDigitFalse
|
| 1310 |
|
|
cmp #'9'+1
|
| 1311 |
|
|
bcs isDigitFalse
|
| 1312 |
|
|
lda #1
|
| 1313 |
|
|
rts
|
| 1314 |
|
|
isDigitFalse:
|
| 1315 |
|
|
lda #0
|
| 1316 |
|
|
rts
|
| 1317 |
|
|
|
| 1318 |
|
|
|
| 1319 |
|
|
; Determine if the character is a alphabetic
|
| 1320 |
|
|
; Parameters
|
| 1321 |
|
|
; r1 = char to test
|
| 1322 |
|
|
; Returns
|
| 1323 |
|
|
; r1 = 1 if alpha, otherwise 0
|
| 1324 |
|
|
;
|
| 1325 |
|
|
isAlpha:
|
| 1326 |
|
|
cmp #'A'
|
| 1327 |
|
|
bcc isAlphaFalse
|
| 1328 |
|
|
cmp #'Z'
|
| 1329 |
|
|
beq isAlphaTrue
|
| 1330 |
|
|
bcc isAlphaTrue
|
| 1331 |
|
|
cmp #'a'
|
| 1332 |
|
|
bcc isAlphaFalse
|
| 1333 |
|
|
cmp #'z'+1
|
| 1334 |
|
|
bcs isAlphaFalse
|
| 1335 |
|
|
isAlphaTrue:
|
| 1336 |
|
|
lda #1
|
| 1337 |
|
|
rts
|
| 1338 |
|
|
isAlphaFalse:
|
| 1339 |
|
|
lda #0
|
| 1340 |
|
|
rts
|
| 1341 |
|
|
|
| 1342 |
|
|
|
| 1343 |
|
|
; Determine if the character is a alphanumeric
|
| 1344 |
|
|
; Parameters
|
| 1345 |
|
|
; r1 = char to test
|
| 1346 |
|
|
; Returns
|
| 1347 |
|
|
; r1 = 1 if alpha, otherwise 0
|
| 1348 |
|
|
;
|
| 1349 |
|
|
isAlnum:
|
| 1350 |
|
|
tax ; save test char
|
| 1351 |
|
|
jsr isDigit
|
| 1352 |
|
|
cmp #0
|
| 1353 |
|
|
bne isDigitx ; if it is a digit
|
| 1354 |
|
|
txa ; get back test char
|
| 1355 |
|
|
jsr isAlpha
|
| 1356 |
|
|
isDigitx:
|
| 1357 |
|
|
rts
|
| 1358 |
|
|
|
| 1359 |
|
|
|
| 1360 |
|
|
EXPR:
|
| 1361 |
|
|
jsr EXPR2
|
| 1362 |
|
|
pha ; save value
|
| 1363 |
|
|
ld r9,#TAB8 ; look up a relational operator
|
| 1364 |
|
|
ld r10,#TAB8_1
|
| 1365 |
|
|
jmp EXEC ; go do it
|
| 1366 |
|
|
XP11:
|
| 1367 |
|
|
pla
|
| 1368 |
|
|
jsr XP18 ; is it ">="?
|
| 1369 |
|
|
cmp r2,r1
|
| 1370 |
|
|
bpl XPRT1 ; no, return r2=1
|
| 1371 |
|
|
bra XPRT0 ; else return r2=0
|
| 1372 |
|
|
XP12:
|
| 1373 |
|
|
pla
|
| 1374 |
|
|
jsr XP18 ; is it "<>"?
|
| 1375 |
|
|
cmp r2,r1
|
| 1376 |
|
|
bne XPRT1 ; no, return r2=1
|
| 1377 |
|
|
bra XPRT0 ; else return r2=0
|
| 1378 |
|
|
XP13:
|
| 1379 |
|
|
pla
|
| 1380 |
|
|
jsr XP18 ; is it ">"?
|
| 1381 |
|
|
cmp r2,r1
|
| 1382 |
|
|
beq XPRT0
|
| 1383 |
|
|
bpl XPRT1 ; no, return r2=1
|
| 1384 |
|
|
bra XPRT0 ; else return r2=0
|
| 1385 |
|
|
XP14:
|
| 1386 |
|
|
pla
|
| 1387 |
|
|
jsr XP18 ; is it "<="?
|
| 1388 |
|
|
cmp r2,r1
|
| 1389 |
|
|
beq XPRT1 ; no, return r2=1
|
| 1390 |
|
|
bmi XPRT1
|
| 1391 |
|
|
bra XPRT0 ; else return r2=0
|
| 1392 |
|
|
XP15:
|
| 1393 |
|
|
pla
|
| 1394 |
|
|
jsr XP18 ; is it "="?
|
| 1395 |
|
|
cmp r2,r1
|
| 1396 |
|
|
beq XPRT1 ; if not, return r2=1
|
| 1397 |
|
|
bra XPRT0 ; else return r2=0
|
| 1398 |
|
|
XP16:
|
| 1399 |
|
|
pla
|
| 1400 |
|
|
jsr XP18 ; is it "<"?
|
| 1401 |
|
|
cmp r2,r1
|
| 1402 |
|
|
bmi XPRT1 ; if not, return r2=1
|
| 1403 |
|
|
bra XPRT0 ; else return r2=0
|
| 1404 |
|
|
XPRT0:
|
| 1405 |
|
|
lda #0 ; return r1=0 (false)
|
| 1406 |
|
|
rts
|
| 1407 |
|
|
XPRT1:
|
| 1408 |
|
|
lda #1 ; return r1=1 (true)
|
| 1409 |
|
|
rts
|
| 1410 |
|
|
|
| 1411 |
|
|
XP17: ; it's not a rel. operator
|
| 1412 |
|
|
pla ; return r2=
|
| 1413 |
|
|
rts
|
| 1414 |
|
|
|
| 1415 |
|
|
XP18:
|
| 1416 |
|
|
pha
|
| 1417 |
|
|
jsr EXPR2 ; do a second
|
| 1418 |
|
|
plx
|
| 1419 |
|
|
rts
|
| 1420 |
|
|
|
| 1421 |
|
|
; ::=(+ or -)(+ or -)(...
|
| 1422 |
|
|
|
| 1423 |
|
|
EXPR2:
|
| 1424 |
|
|
ldy #'-'
|
| 1425 |
|
|
ld r4,#XP21
|
| 1426 |
|
|
jsr TSTC ; negative sign?
|
| 1427 |
|
|
lda #0 ; yes, fake '0-'
|
| 1428 |
|
|
pha
|
| 1429 |
|
|
bra XP26
|
| 1430 |
|
|
XP21:
|
| 1431 |
|
|
ldy #'+'
|
| 1432 |
|
|
ld r4,#XP22
|
| 1433 |
|
|
jsr TSTC ; positive sign? ignore it
|
| 1434 |
|
|
XP22:
|
| 1435 |
|
|
jsr EXPR3 ; first
|
| 1436 |
|
|
XP23:
|
| 1437 |
|
|
pha ; yes, save the value
|
| 1438 |
|
|
ldy #'+'
|
| 1439 |
|
|
ld r4,#XP25
|
| 1440 |
|
|
jsr TSTC ; add?
|
| 1441 |
|
|
jsr EXPR3 ; get the second
|
| 1442 |
|
|
XP24:
|
| 1443 |
|
|
plx
|
| 1444 |
|
|
add r1,r1,r2 ; add it to the first
|
| 1445 |
|
|
; BVS.L QHOW brnch if there's an overflow
|
| 1446 |
|
|
bra XP23 ; else go back for more operations
|
| 1447 |
|
|
XP25:
|
| 1448 |
|
|
ldy #'-'
|
| 1449 |
|
|
ld r4,#XP45
|
| 1450 |
|
|
jsr TSTC ; subtract?
|
| 1451 |
|
|
XP26:
|
| 1452 |
|
|
jsr EXPR3 ; get second
|
| 1453 |
|
|
sub r1,r0,r1 ; change its sign
|
| 1454 |
|
|
bra XP24 ; and do an addition
|
| 1455 |
|
|
XP45:
|
| 1456 |
|
|
pla
|
| 1457 |
|
|
rts
|
| 1458 |
|
|
|
| 1459 |
|
|
|
| 1460 |
|
|
; ::=( <* or /> )(...
|
| 1461 |
|
|
|
| 1462 |
|
|
EXPR3:
|
| 1463 |
|
|
jsr EXPR4 ; get first
|
| 1464 |
|
|
XP31:
|
| 1465 |
|
|
pha ; yes, save that first result
|
| 1466 |
|
|
ldy #'*'
|
| 1467 |
|
|
ld r4,#XP34
|
| 1468 |
|
|
jsr TSTC ; multiply?
|
| 1469 |
|
|
jsr EXPR4 ; get second
|
| 1470 |
|
|
plx
|
| 1471 |
|
|
muls r1,r1,r2 ; multiply the two
|
| 1472 |
|
|
bra XP31 ; then look for more terms
|
| 1473 |
|
|
XP34:
|
| 1474 |
|
|
ldy #'/'
|
| 1475 |
|
|
ld r4,#XP47
|
| 1476 |
|
|
jsr TSTC ; divide?
|
| 1477 |
|
|
jsr EXPR4 ; get second
|
| 1478 |
|
|
tax
|
| 1479 |
|
|
pla
|
| 1480 |
|
|
divs r1,r1,r2 ; do the division
|
| 1481 |
|
|
bra XP31 ; go back for any more terms
|
| 1482 |
|
|
XP47:
|
| 1483 |
|
|
pla
|
| 1484 |
|
|
rts
|
| 1485 |
|
|
|
| 1486 |
|
|
|
| 1487 |
|
|
; Functions are jsred through EXPR4
|
| 1488 |
|
|
; ::=
|
| 1489 |
|
|
;
|
| 1490 |
|
|
; ()
|
| 1491 |
|
|
|
| 1492 |
|
|
EXPR4:
|
| 1493 |
|
|
ld r9,#TAB4 ; find possible function
|
| 1494 |
|
|
ld r10,#TAB4_1
|
| 1495 |
|
|
jmp EXEC ; branch to function which does subsequent rts for EXPR4
|
| 1496 |
|
|
XP40: ; we get here if it wasn't a function
|
| 1497 |
|
|
lda #0
|
| 1498 |
|
|
jsr TSTV
|
| 1499 |
|
|
cmp #0
|
| 1500 |
|
|
beq XP41 ; nor a variable
|
| 1501 |
|
|
lda (r1) ; if a variable, return its value in r1
|
| 1502 |
|
|
rts
|
| 1503 |
|
|
XP41:
|
| 1504 |
|
|
jsr TSTNUM ; or is it a number?
|
| 1505 |
|
|
cmp r2,#0
|
| 1506 |
|
|
bne XP46 ; (if not, # of digits will be zero) if so, return it in r1
|
| 1507 |
|
|
jsr PARN ; check for (EXPR)
|
| 1508 |
|
|
XP46:
|
| 1509 |
|
|
rts
|
| 1510 |
|
|
|
| 1511 |
|
|
|
| 1512 |
|
|
; Check for a parenthesized expression
|
| 1513 |
|
|
PARN:
|
| 1514 |
|
|
ldy #'('
|
| 1515 |
|
|
ld r4,#XP43
|
| 1516 |
|
|
jsr TSTC ; else look for ( OREXPR )
|
| 1517 |
|
|
jsr OREXPR
|
| 1518 |
|
|
ldy #')'
|
| 1519 |
|
|
ld r4,#XP43
|
| 1520 |
|
|
jsr TSTC
|
| 1521 |
|
|
XP42:
|
| 1522 |
|
|
rts
|
| 1523 |
|
|
XP43:
|
| 1524 |
|
|
pla ; get rid of return address
|
| 1525 |
|
|
lda #msgWhat
|
| 1526 |
|
|
jmp ERROR
|
| 1527 |
|
|
|
| 1528 |
|
|
|
| 1529 |
|
|
; ===== Test for a valid variable name. Returns Z=1 if not
|
| 1530 |
|
|
; found, else returns Z=0 and the address of the
|
| 1531 |
|
|
; variable in r1.
|
| 1532 |
|
|
; Parameters
|
| 1533 |
|
|
; r1 = 1 = allocate if not found
|
| 1534 |
|
|
; Returns
|
| 1535 |
|
|
; r1 = address of variable, zero if not found
|
| 1536 |
|
|
|
| 1537 |
|
|
TSTV:
|
| 1538 |
|
|
push r5
|
| 1539 |
|
|
ld r5,r1 ; r5=allocate flag
|
| 1540 |
|
|
jsr IGNBLK
|
| 1541 |
|
|
lda (r8) ; look at the program text
|
| 1542 |
|
|
cmp #'@'
|
| 1543 |
|
|
bcc tstv_notfound ; C=1: not a variable
|
| 1544 |
|
|
bne TV1 ; brnch if not "@" array
|
| 1545 |
|
|
inc r8 ; If it is, it should be
|
| 1546 |
|
|
jsr PARN ; followed by (EXPR) as its index.
|
| 1547 |
|
|
; BCS.L QHOW say "How?" if index is too big
|
| 1548 |
|
|
pha ; save the index
|
| 1549 |
|
|
jsr SIZEX ; get amount of free memory
|
| 1550 |
|
|
plx ; get back the index
|
| 1551 |
|
|
cmp r2,r1
|
| 1552 |
|
|
bcc TV2 ; see if there's enough memory
|
| 1553 |
|
|
jmp QSORRY ; if not, say "Sorry"
|
| 1554 |
|
|
TV2:
|
| 1555 |
|
|
lda VARBGN ; put address of array element...
|
| 1556 |
|
|
sub r1,r1,r2 ; into r1 (neg. offset is used)
|
| 1557 |
|
|
bra TSTVRT
|
| 1558 |
|
|
TV1:
|
| 1559 |
|
|
jsr getVarName ; get variable name
|
| 1560 |
|
|
cmp #0
|
| 1561 |
|
|
beq TSTVRT ; if not, return r1=0
|
| 1562 |
|
|
ld r2,r5
|
| 1563 |
|
|
jsr findVar ; find or allocate
|
| 1564 |
|
|
TSTVRT:
|
| 1565 |
|
|
pop r5
|
| 1566 |
|
|
rts ; r1<>0 (found)
|
| 1567 |
|
|
tstv_notfound:
|
| 1568 |
|
|
pop r5
|
| 1569 |
|
|
lda #0 ; r1=0 if not found
|
| 1570 |
|
|
rts
|
| 1571 |
|
|
|
| 1572 |
|
|
|
| 1573 |
|
|
; Returns
|
| 1574 |
|
|
; r1 = 2 character variable name + type
|
| 1575 |
|
|
;
|
| 1576 |
|
|
getVarName:
|
| 1577 |
|
|
push r5
|
| 1578 |
|
|
|
| 1579 |
|
|
lda (r8) ; get first character
|
| 1580 |
|
|
pha ; save off current name
|
| 1581 |
|
|
jsr isAlpha
|
| 1582 |
|
|
cmp #0
|
| 1583 |
|
|
beq gvn1
|
| 1584 |
|
|
ld r5,#2 ; loop two more times
|
| 1585 |
|
|
|
| 1586 |
|
|
; check for second/third character
|
| 1587 |
|
|
gvn4:
|
| 1588 |
|
|
inc r8
|
| 1589 |
|
|
lda (r8) ; do we have another char ?
|
| 1590 |
|
|
jsr isAlnum
|
| 1591 |
|
|
cmp #0
|
| 1592 |
|
|
beq gvn2 ; nope
|
| 1593 |
|
|
pla ; get varname
|
| 1594 |
|
|
asl
|
| 1595 |
|
|
asl
|
| 1596 |
|
|
asl
|
| 1597 |
|
|
asl
|
| 1598 |
|
|
asl
|
| 1599 |
|
|
asl
|
| 1600 |
|
|
asl
|
| 1601 |
|
|
asl
|
| 1602 |
|
|
ldx (r8)
|
| 1603 |
|
|
or r1,r1,r2 ; add in new char
|
| 1604 |
|
|
pha ; save off name again
|
| 1605 |
|
|
dec r5
|
| 1606 |
|
|
bne gvn4
|
| 1607 |
|
|
|
| 1608 |
|
|
; now ignore extra variable name characters
|
| 1609 |
|
|
gvn6:
|
| 1610 |
|
|
inc r8
|
| 1611 |
|
|
lda (r8)
|
| 1612 |
|
|
jsr isAlnum
|
| 1613 |
|
|
cmp #0
|
| 1614 |
|
|
bne gvn6 ; keep looping as long as we have identifier chars
|
| 1615 |
|
|
|
| 1616 |
|
|
; check for a variable type
|
| 1617 |
|
|
gvn2:
|
| 1618 |
|
|
lda (r8)
|
| 1619 |
|
|
cmp #'%'
|
| 1620 |
|
|
beq gvn3
|
| 1621 |
|
|
cmp #'$'
|
| 1622 |
|
|
beq gvn3
|
| 1623 |
|
|
lda #0
|
| 1624 |
|
|
dec r8
|
| 1625 |
|
|
|
| 1626 |
|
|
; insert variable type indicator and return
|
| 1627 |
|
|
gvn3:
|
| 1628 |
|
|
inc r8
|
| 1629 |
|
|
plx
|
| 1630 |
|
|
asl r2,r2
|
| 1631 |
|
|
asl r2,r2
|
| 1632 |
|
|
asl r2,r2
|
| 1633 |
|
|
asl r2,r2
|
| 1634 |
|
|
asl r2,r2
|
| 1635 |
|
|
asl r2,r2
|
| 1636 |
|
|
asl r2,r2
|
| 1637 |
|
|
asl r2,r2
|
| 1638 |
|
|
or r1,r1,r2 ; add in variable type
|
| 1639 |
|
|
pop r5
|
| 1640 |
|
|
rts ; return Z = 0, r1 = varname
|
| 1641 |
|
|
|
| 1642 |
|
|
; not a variable name
|
| 1643 |
|
|
gvn1:
|
| 1644 |
|
|
pla
|
| 1645 |
|
|
pop r5
|
| 1646 |
|
|
lda #0 ; return Z = 1 if not a varname
|
| 1647 |
|
|
rts
|
| 1648 |
|
|
|
| 1649 |
|
|
|
| 1650 |
|
|
; Find variable
|
| 1651 |
|
|
; r1 = varname
|
| 1652 |
|
|
; r2 = allocate flag
|
| 1653 |
|
|
; Returns
|
| 1654 |
|
|
; r1 = variable address, Z =0 if found / allocated, Z=1 if not found
|
| 1655 |
|
|
|
| 1656 |
|
|
findVar:
|
| 1657 |
|
|
push r7
|
| 1658 |
|
|
ldy VARBGN
|
| 1659 |
|
|
fv4:
|
| 1660 |
|
|
ld r7,(y) ; get varname / type
|
| 1661 |
|
|
beq fv3 ; no more vars ?
|
| 1662 |
|
|
cmp r1,r7
|
| 1663 |
|
|
beq fv1 ; match ?
|
| 1664 |
|
|
iny ; move to next var
|
| 1665 |
|
|
iny
|
| 1666 |
|
|
ld r7,STKBOT
|
| 1667 |
|
|
cmp r3,r7
|
| 1668 |
|
|
bcc fv4 ; loop back to look at next var
|
| 1669 |
|
|
|
| 1670 |
|
|
; variable not found
|
| 1671 |
|
|
; no more memory
|
| 1672 |
|
|
lda #msgVarSpace
|
| 1673 |
|
|
jmp ERROR
|
| 1674 |
|
|
; lw lr,[sp]
|
| 1675 |
|
|
; lw r7,4[sp]
|
| 1676 |
|
|
; add sp,sp,#8
|
| 1677 |
|
|
; lw r1,#0
|
| 1678 |
|
|
; rts
|
| 1679 |
|
|
|
| 1680 |
|
|
; variable not found
|
| 1681 |
|
|
; allocate new ?
|
| 1682 |
|
|
fv3:
|
| 1683 |
|
|
cpx #0
|
| 1684 |
|
|
beq fv2
|
| 1685 |
|
|
sta (r3) ; save varname / type
|
| 1686 |
|
|
; found variable
|
| 1687 |
|
|
; return address
|
| 1688 |
|
|
fv1:
|
| 1689 |
|
|
add r1,r3,#1
|
| 1690 |
|
|
pop r7
|
| 1691 |
|
|
rts ; Z = 0, r1 = address
|
| 1692 |
|
|
|
| 1693 |
|
|
; didn't find var and not allocating
|
| 1694 |
|
|
fv2:
|
| 1695 |
|
|
pop r7
|
| 1696 |
|
|
lda #0 ; Z = 1, r1 = 0
|
| 1697 |
|
|
rts
|
| 1698 |
|
|
|
| 1699 |
|
|
|
| 1700 |
|
|
; ===== The PEEK function returns the byte stored at the address
|
| 1701 |
|
|
; contained in the following expression.
|
| 1702 |
|
|
;
|
| 1703 |
|
|
PEEK:
|
| 1704 |
|
|
jsr PARN ; get the memory address
|
| 1705 |
|
|
lda (r1) ; get the addressed byte
|
| 1706 |
|
|
rts
|
| 1707 |
|
|
|
| 1708 |
|
|
|
| 1709 |
|
|
; user function jsr
|
| 1710 |
|
|
; call the user function with argument in r1
|
| 1711 |
|
|
USRX:
|
| 1712 |
|
|
jsr PARN ; get expression value
|
| 1713 |
|
|
push r8 ; save the text pointer
|
| 1714 |
18 |
robfinch |
ldx #0
|
| 1715 |
|
|
jsr (usrJmp,x) ; get usr vector, jump to the subroutine
|
| 1716 |
16 |
robfinch |
pop r8 ; restore the text pointer
|
| 1717 |
|
|
rts
|
| 1718 |
|
|
|
| 1719 |
|
|
|
| 1720 |
|
|
; ===== The RND function returns a random number from 1 to
|
| 1721 |
|
|
; the value of the following expression in D0.
|
| 1722 |
|
|
;
|
| 1723 |
|
|
RND:
|
| 1724 |
|
|
jsr PARN ; get the upper limit
|
| 1725 |
|
|
cmp #0
|
| 1726 |
|
|
beq rnd2 ; it must be positive and non-zero
|
| 1727 |
|
|
bcc rnd1
|
| 1728 |
|
|
tax
|
| 1729 |
|
|
;gran ; generate a random number
|
| 1730 |
|
|
;mfspr r1,rand ; get the number
|
| 1731 |
|
|
tsr LFSR,r1
|
| 1732 |
|
|
; jsr modu4 ; RND(n)=MOD(number,n)+1
|
| 1733 |
|
|
mod r1,r1,r2
|
| 1734 |
|
|
ina
|
| 1735 |
|
|
rts
|
| 1736 |
|
|
rnd1:
|
| 1737 |
|
|
lda #msgRNDBad
|
| 1738 |
|
|
jmp ERROR
|
| 1739 |
|
|
rnd2:
|
| 1740 |
|
|
tsr LFSR,r1
|
| 1741 |
|
|
; gran
|
| 1742 |
|
|
; mfspr r1,rand
|
| 1743 |
|
|
rts
|
| 1744 |
|
|
|
| 1745 |
|
|
|
| 1746 |
|
|
; r = a mod b
|
| 1747 |
|
|
; a = r1
|
| 1748 |
|
|
; b = r2
|
| 1749 |
|
|
; r = r6
|
| 1750 |
|
|
;modu4:
|
| 1751 |
|
|
; push r3
|
| 1752 |
|
|
; push r5
|
| 1753 |
|
|
; push r6
|
| 1754 |
|
|
; push r7
|
| 1755 |
|
|
; ld r7,#31 ; n = 32
|
| 1756 |
|
|
; eor r5,r5,r5 ; w = 0
|
| 1757 |
|
|
;; eor r6,r6,r6 ; r = 0
|
| 1758 |
|
|
;mod2:
|
| 1759 |
|
|
; rol ; a <<= 1
|
| 1760 |
|
|
; and r3,r1,#1
|
| 1761 |
|
|
; asl r6 ; r <<= 1
|
| 1762 |
|
|
; or r6,r6,r3
|
| 1763 |
|
|
; and #-2
|
| 1764 |
|
|
; cmp r2,r6
|
| 1765 |
|
|
; bmi mod1 ; b < r ?
|
| 1766 |
|
|
; sub r6,r6,r2 ; r -= b
|
| 1767 |
|
|
;mod1:
|
| 1768 |
|
|
; dec r7 ; n--
|
| 1769 |
|
|
; bne mod2
|
| 1770 |
|
|
; ld r1,r6
|
| 1771 |
|
|
; pop r7
|
| 1772 |
|
|
; pop r6
|
| 1773 |
|
|
; pop r5
|
| 1774 |
|
|
; pop r3
|
| 1775 |
|
|
; rts
|
| 1776 |
|
|
;
|
| 1777 |
|
|
|
| 1778 |
|
|
; ===== The ABS function returns an absolute value in r2.
|
| 1779 |
|
|
;
|
| 1780 |
|
|
ABS:
|
| 1781 |
|
|
jsr PARN ; get the following expr.'s value
|
| 1782 |
|
|
cmp #0
|
| 1783 |
|
|
bmi ABS1
|
| 1784 |
|
|
rts
|
| 1785 |
|
|
ABS1:
|
| 1786 |
|
|
sub r1,r0,r1
|
| 1787 |
|
|
rts
|
| 1788 |
|
|
|
| 1789 |
|
|
;==== The TICK function returns the cpu tick value in r1.
|
| 1790 |
|
|
;
|
| 1791 |
|
|
TICKX:
|
| 1792 |
|
|
tsr TICK,r1
|
| 1793 |
|
|
rts
|
| 1794 |
|
|
|
| 1795 |
|
|
; ===== The SGN function returns the sign in r1. +1,0, or -1
|
| 1796 |
|
|
;
|
| 1797 |
|
|
SGN:
|
| 1798 |
|
|
jsr PARN ; get the following expr.'s value
|
| 1799 |
|
|
cmp #0
|
| 1800 |
|
|
beq SGN1
|
| 1801 |
|
|
bmi SGN2
|
| 1802 |
|
|
lda #1
|
| 1803 |
|
|
rts
|
| 1804 |
|
|
SGN2:
|
| 1805 |
|
|
lda #-1
|
| 1806 |
|
|
rts
|
| 1807 |
|
|
SGN1:
|
| 1808 |
|
|
rts
|
| 1809 |
|
|
|
| 1810 |
|
|
; ===== The SIZE function returns the size of free memory in r1.
|
| 1811 |
|
|
;
|
| 1812 |
|
|
SIZEX:
|
| 1813 |
|
|
lda VARBGN ; get the number of free bytes...
|
| 1814 |
|
|
ldx TXTUNF ; between 'TXTUNF' and 'VARBGN'
|
| 1815 |
|
|
sub r1,r1,r2
|
| 1816 |
|
|
rts ; return the number in r1
|
| 1817 |
|
|
|
| 1818 |
|
|
|
| 1819 |
|
|
;******************************************************************
|
| 1820 |
|
|
;
|
| 1821 |
|
|
; *** SETVAL *** FIN *** ENDCHK *** ERROR (& friends) ***
|
| 1822 |
|
|
;
|
| 1823 |
|
|
; 'SETVAL' expects a variable, followed by an equal sign and then
|
| 1824 |
|
|
; an expression. It evaluates the expression and sets the variable
|
| 1825 |
|
|
; to that value.
|
| 1826 |
|
|
;
|
| 1827 |
|
|
; returns
|
| 1828 |
|
|
; r2 = variable's address
|
| 1829 |
|
|
;
|
| 1830 |
|
|
SETVAL:
|
| 1831 |
|
|
lda #1 ; allocate var
|
| 1832 |
|
|
jsr TSTV ; variable name?
|
| 1833 |
|
|
cmp #0
|
| 1834 |
|
|
bne sv2
|
| 1835 |
|
|
lda #msgVar
|
| 1836 |
|
|
jmp ERROR
|
| 1837 |
|
|
sv2:
|
| 1838 |
|
|
pha ; save the variable's address
|
| 1839 |
|
|
ldy #'='
|
| 1840 |
|
|
ld r4,#SV1
|
| 1841 |
|
|
jsr TSTC ; get past the "=" sign
|
| 1842 |
|
|
jsr OREXPR ; evaluate the expression
|
| 1843 |
|
|
plx ; get back the variable's address
|
| 1844 |
|
|
sta (x) ; and save value in the variable
|
| 1845 |
|
|
txa ; return r1 = variable address
|
| 1846 |
|
|
rts
|
| 1847 |
|
|
SV1:
|
| 1848 |
|
|
jmp QWHAT ; if no "=" sign
|
| 1849 |
|
|
|
| 1850 |
|
|
|
| 1851 |
18 |
robfinch |
; 'FIN' checks the end of a command. If it ended with ":",
|
| 1852 |
|
|
; execution continues. If it ended with a CR, it finds the
|
| 1853 |
|
|
; the next line and continues from there.
|
| 1854 |
|
|
;
|
| 1855 |
16 |
robfinch |
FIN:
|
| 1856 |
|
|
ldy #':'
|
| 1857 |
|
|
ld r4,#FI1
|
| 1858 |
|
|
jsr TSTC ; *** FIN ***
|
| 1859 |
|
|
pla ; if ":", discard return address
|
| 1860 |
|
|
jmp RUNSML ; continue on the same line
|
| 1861 |
|
|
FI1:
|
| 1862 |
|
|
ldy #CR
|
| 1863 |
|
|
ld r4,#FI2
|
| 1864 |
|
|
jsr TSTC ; not ":", is it a CR?
|
| 1865 |
|
|
; else return to the caller
|
| 1866 |
|
|
pla ; yes, purge return address
|
| 1867 |
|
|
jmp RUNNXL ; execute the next line
|
| 1868 |
|
|
FI2:
|
| 1869 |
|
|
rts ; else return to the caller
|
| 1870 |
|
|
|
| 1871 |
|
|
|
| 1872 |
18 |
robfinch |
; 'ENDCHK' checks if a command is ended with a CR. This is
|
| 1873 |
|
|
; required in certain commands, such as GOTO, RETURN, STOP, etc.
|
| 1874 |
|
|
;
|
| 1875 |
16 |
robfinch |
; Check that there is nothing else on the line
|
| 1876 |
|
|
; Registers Affected
|
| 1877 |
|
|
; r1
|
| 1878 |
|
|
;
|
| 1879 |
|
|
ENDCHK:
|
| 1880 |
18 |
robfinch |
lda #'E'
|
| 1881 |
|
|
jsr DisplayChar
|
| 1882 |
16 |
robfinch |
jsr IGNBLK
|
| 1883 |
|
|
lda (r8)
|
| 1884 |
|
|
cmp #CR
|
| 1885 |
|
|
beq ec1 ; does it end with a CR?
|
| 1886 |
|
|
lda #msgExtraChars
|
| 1887 |
|
|
jmp ERROR
|
| 1888 |
|
|
ec1:
|
| 1889 |
|
|
rts
|
| 1890 |
|
|
|
| 1891 |
18 |
robfinch |
; 'ERROR' prints the string pointed to by r1. It then prints the
|
| 1892 |
|
|
; line pointed to by CURRNT with a "?" inserted at where the
|
| 1893 |
|
|
; old text pointer (should be on top of the stack) points to.
|
| 1894 |
|
|
; Execution of Tiny BASIC is stopped and a warm start is done.
|
| 1895 |
|
|
; If CURRNT is zero (indicating a direct command), the direct
|
| 1896 |
|
|
; command is not printed. If CURRNT is -1 (indicating
|
| 1897 |
|
|
; 'INPUT' command in progress), the input line is not printed
|
| 1898 |
|
|
; and execution is not terminated but continues at 'INPERR'.
|
| 1899 |
|
|
;
|
| 1900 |
|
|
; Related to 'ERROR' are the following:
|
| 1901 |
|
|
; 'QWHAT' saves text pointer on stack and gets "What?" message.
|
| 1902 |
|
|
; 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
|
| 1903 |
|
|
; 'QSORRY' and 'ASORRY' do the same kind of thing.
|
| 1904 |
|
|
; 'QHOW' and 'AHOW' also do this for "How?".
|
| 1905 |
|
|
;
|
| 1906 |
16 |
robfinch |
TOOBIG:
|
| 1907 |
|
|
lda #msgTooBig
|
| 1908 |
|
|
bra ERROR
|
| 1909 |
|
|
QSORRY:
|
| 1910 |
|
|
lda #SRYMSG
|
| 1911 |
|
|
bra ERROR
|
| 1912 |
|
|
QWHAT:
|
| 1913 |
|
|
lda #msgWhat
|
| 1914 |
|
|
ERROR:
|
| 1915 |
|
|
jsr PRMESG ; display the error message
|
| 1916 |
18 |
robfinch |
lda CURRNT ; get the current line pointer
|
| 1917 |
16 |
robfinch |
beq ERROR1 ; if zero, do a warm start
|
| 1918 |
|
|
cmp #-1
|
| 1919 |
|
|
beq INPERR ; is the line no. pointer = -1? if so, redo input
|
| 1920 |
|
|
ld r5,(r8) ; save the char. pointed to
|
| 1921 |
|
|
stz (r8) ; put a zero where the error is
|
| 1922 |
|
|
lda CURRNT ; point to start of current line
|
| 1923 |
|
|
jsr PRTLN ; display the line in error up to the 0
|
| 1924 |
18 |
robfinch |
ld r6,r1 ; save off end pointer
|
| 1925 |
16 |
robfinch |
st r5,(r8) ; restore the character
|
| 1926 |
|
|
lda #'?' ; display a "?"
|
| 1927 |
|
|
jsr GOOUT
|
| 1928 |
|
|
ldx #0 ; stop char = 0
|
| 1929 |
|
|
sub r1,r6,#1 ; point back to the error char.
|
| 1930 |
|
|
jsr PRTSTG ; display the rest of the line
|
| 1931 |
|
|
ERROR1:
|
| 1932 |
|
|
jmp WSTART ; and do a warm start
|
| 1933 |
|
|
|
| 1934 |
|
|
;******************************************************************
|
| 1935 |
|
|
;
|
| 1936 |
|
|
; *** GETLN *** FNDLN (& friends) ***
|
| 1937 |
|
|
;
|
| 1938 |
|
|
; 'GETLN' reads in input line into 'BUFFER'. It first prompts with
|
| 1939 |
|
|
; the character in r3 (given by the caller), then it fills the
|
| 1940 |
|
|
; buffer and echos. It ignores LF's but still echos
|
| 1941 |
|
|
; them back. Control-H is used to delete the last character
|
| 1942 |
|
|
; entered (if there is one), and control-X is used to delete the
|
| 1943 |
|
|
; whole line and start over again. CR signals the end of a line,
|
| 1944 |
|
|
; and causes 'GETLN' to return.
|
| 1945 |
|
|
;
|
| 1946 |
|
|
;
|
| 1947 |
|
|
GETLN:
|
| 1948 |
|
|
push r5
|
| 1949 |
|
|
jsr GOOUT ; display the prompt
|
| 1950 |
|
|
lda #1
|
| 1951 |
|
|
sta CursorFlash ; turn on cursor flash
|
| 1952 |
|
|
lda #' ' ; and a space
|
| 1953 |
|
|
jsr GOOUT
|
| 1954 |
|
|
ld r8,#BUFFER ; r8 is the buffer pointer
|
| 1955 |
|
|
GL1:
|
| 1956 |
|
|
jsr CHKIO ; check keyboard
|
| 1957 |
|
|
cmp #0
|
| 1958 |
|
|
beq GL1 ; wait for a char. to come in
|
| 1959 |
|
|
cmp #CTRLH
|
| 1960 |
|
|
beq GL3 ; delete last character? if so
|
| 1961 |
|
|
cmp #CTRLX
|
| 1962 |
|
|
beq GL4 ; delete the whole line?
|
| 1963 |
|
|
cmp #CR
|
| 1964 |
|
|
beq GL2 ; accept a CR
|
| 1965 |
|
|
cmp #' '
|
| 1966 |
|
|
bcc GL1 ; if other control char., discard it
|
| 1967 |
|
|
GL2:
|
| 1968 |
|
|
sta (r8) ; save the char.
|
| 1969 |
|
|
inc r8
|
| 1970 |
|
|
pha
|
| 1971 |
|
|
jsr GOOUT ; echo the char back out
|
| 1972 |
|
|
pla ; get char back (GOOUT destroys r1)
|
| 1973 |
|
|
cmp #CR
|
| 1974 |
|
|
beq GL7 ; if it's a CR, end the line
|
| 1975 |
|
|
cmp r8,#BUFFER+BUFLEN-1 ; any more room?
|
| 1976 |
|
|
bcc GL1 ; yes: get some more, else delete last char.
|
| 1977 |
|
|
GL3:
|
| 1978 |
|
|
lda #CTRLH ; delete a char. if possible
|
| 1979 |
|
|
jsr GOOUT
|
| 1980 |
|
|
lda #' '
|
| 1981 |
|
|
jsr GOOUT
|
| 1982 |
|
|
cmp r8,#BUFFER ; any char.'s left?
|
| 1983 |
|
|
bcc GL1 ; if not
|
| 1984 |
|
|
beq GL1
|
| 1985 |
|
|
lda #CTRLH ; if so, finish the BS-space-BS sequence
|
| 1986 |
|
|
jsr GOOUT
|
| 1987 |
|
|
dec r8 ; decrement the text pointer
|
| 1988 |
|
|
bra GL1 ; back for more
|
| 1989 |
|
|
GL4:
|
| 1990 |
18 |
robfinch |
ld r1,r8 ; delete the whole line
|
| 1991 |
16 |
robfinch |
sub r5,r1,#BUFFER ; figure out how many backspaces we need
|
| 1992 |
|
|
beq GL6 ; if none needed, brnch
|
| 1993 |
|
|
dec r5 ; loop count is one less
|
| 1994 |
|
|
GL5:
|
| 1995 |
|
|
lda #CTRLH ; and display BS-space-BS sequences
|
| 1996 |
|
|
jsr GOOUT
|
| 1997 |
|
|
lda #' '
|
| 1998 |
|
|
jsr GOOUT
|
| 1999 |
|
|
lda #CTRLH
|
| 2000 |
|
|
jsr GOOUT
|
| 2001 |
|
|
dec r5
|
| 2002 |
|
|
bne GL5
|
| 2003 |
|
|
GL6:
|
| 2004 |
|
|
ld r8,#BUFFER ; reinitialize the text pointer
|
| 2005 |
|
|
bra GL1 ; and go back for more
|
| 2006 |
|
|
GL7:
|
| 2007 |
|
|
lda #0 ; turn off cursor flash
|
| 2008 |
|
|
stz (r8) ; null terminate line
|
| 2009 |
|
|
stz CursorFlash
|
| 2010 |
|
|
lda #LF ; echo a LF for the CR
|
| 2011 |
|
|
jsr GOOUT
|
| 2012 |
|
|
pop r5
|
| 2013 |
|
|
rts
|
| 2014 |
|
|
|
| 2015 |
|
|
|
| 2016 |
|
|
; 'FNDLN' finds a line with a given line no. (in r1) in the
|
| 2017 |
|
|
; text save area. r9 is used as the text pointer. If the line
|
| 2018 |
|
|
; is found, r9 will point to the beginning of that line
|
| 2019 |
|
|
; (i.e. the high byte of the line no.), and r1 = 1.
|
| 2020 |
|
|
; If that line is not there and a line with a higher line no.
|
| 2021 |
|
|
; is found, r9 points there and r1 = 0. If we reached
|
| 2022 |
|
|
; the end of the text save area and cannot find the line, flags
|
| 2023 |
|
|
; r9 = 0, r1 = 0.
|
| 2024 |
|
|
; r1=1 if line found
|
| 2025 |
|
|
; r0 = 1 <= line is found
|
| 2026 |
|
|
; r9 = pointer to line
|
| 2027 |
|
|
; r0 = 0 <= line is not found
|
| 2028 |
|
|
; r9 = zero, if end of text area
|
| 2029 |
|
|
; r9 = otherwise higher line number
|
| 2030 |
|
|
;
|
| 2031 |
|
|
; 'FNDLN' will initialize r9 to the beginning of the text save
|
| 2032 |
|
|
; area to start the search. Some other entries of this routine
|
| 2033 |
|
|
; will not initialize r9 and do the search.
|
| 2034 |
|
|
; 'FNDLNP' will start with r9 and search for the line no.
|
| 2035 |
|
|
; 'FNDNXT' will bump r9 by 2, find a CR and then start search.
|
| 2036 |
|
|
; 'FNDSKP' uses r9 to find a CR, and then starts the search.
|
| 2037 |
|
|
; return Z=1 if line is found, r9 = pointer to line
|
| 2038 |
|
|
;
|
| 2039 |
|
|
; Parameters
|
| 2040 |
|
|
; r1 = line number to find
|
| 2041 |
|
|
;
|
| 2042 |
|
|
FNDLN:
|
| 2043 |
|
|
cmp #$FFFF
|
| 2044 |
|
|
bcc fl1 ; line no. must be < 65535
|
| 2045 |
|
|
lda #msgLineRange
|
| 2046 |
|
|
jmp ERROR
|
| 2047 |
|
|
fl1:
|
| 2048 |
|
|
ld r9,TXTBGN>>2 ; init. the text save pointer
|
| 2049 |
|
|
|
| 2050 |
|
|
FNDLNP:
|
| 2051 |
|
|
cmp r9,TXTUNF ; check if we passed the end
|
| 2052 |
|
|
beq FNDRET1
|
| 2053 |
|
|
bcs FNDRET1 ; if so, return with r9=0,r1=0
|
| 2054 |
|
|
ldx (r9) ; get line number
|
| 2055 |
|
|
cmp r1,r2
|
| 2056 |
|
|
beq FNDRET2
|
| 2057 |
|
|
bcs FNDNXT ; is this the line we want? no, not there yet
|
| 2058 |
|
|
FNDRET:
|
| 2059 |
|
|
lda #0 ; line not found, but r9=next line pointer
|
| 2060 |
|
|
rts ; return the cond. codes
|
| 2061 |
|
|
FNDRET1:
|
| 2062 |
|
|
; eor r9,r9,r9 ; no higher line
|
| 2063 |
|
|
lda #0 ; line not found
|
| 2064 |
|
|
rts
|
| 2065 |
|
|
FNDRET2:
|
| 2066 |
|
|
lda #1 ; line found
|
| 2067 |
|
|
rts
|
| 2068 |
|
|
|
| 2069 |
|
|
FNDNXT:
|
| 2070 |
|
|
inc r9 ; find the next line
|
| 2071 |
|
|
|
| 2072 |
|
|
FNDSKP:
|
| 2073 |
|
|
ldx (r9)
|
| 2074 |
|
|
inc r9
|
| 2075 |
|
|
cpx #CR
|
| 2076 |
|
|
bne FNDSKP ; try to find a CR, keep looking
|
| 2077 |
|
|
bra FNDLNP ; check if end of text
|
| 2078 |
|
|
|
| 2079 |
|
|
|
| 2080 |
|
|
;******************************************************************
|
| 2081 |
|
|
; 'MVUP' moves a block up from where r1 points to where r2 points
|
| 2082 |
|
|
; until r1=r3
|
| 2083 |
|
|
;
|
| 2084 |
|
|
MVUP1:
|
| 2085 |
|
|
ld r4,(r1)
|
| 2086 |
|
|
st r4,(r2)
|
| 2087 |
|
|
ina
|
| 2088 |
|
|
inx
|
| 2089 |
|
|
MVUP:
|
| 2090 |
|
|
cmp r1,r3
|
| 2091 |
|
|
bne MVUP1
|
| 2092 |
|
|
MVRET:
|
| 2093 |
|
|
rts
|
| 2094 |
|
|
|
| 2095 |
|
|
|
| 2096 |
|
|
; 'MVDOWN' moves a block down from where r1 points to where r2
|
| 2097 |
|
|
; points until r1=r3
|
| 2098 |
|
|
;
|
| 2099 |
|
|
MVDOWN1:
|
| 2100 |
|
|
dea
|
| 2101 |
|
|
dex
|
| 2102 |
|
|
ld r4,(r1)
|
| 2103 |
|
|
st r4,(r2)
|
| 2104 |
|
|
MVDOWN:
|
| 2105 |
|
|
cmp r1,r3
|
| 2106 |
|
|
bne MVDOWN1
|
| 2107 |
|
|
rts
|
| 2108 |
|
|
|
| 2109 |
|
|
|
| 2110 |
|
|
; 'POPA' restores the 'FOR' loop variable save area from the stack
|
| 2111 |
|
|
;
|
| 2112 |
|
|
; 'PUSHA' stacks for 'FOR' loop variable save area onto the stack
|
| 2113 |
|
|
;
|
| 2114 |
|
|
; Note: a single zero word is stored on the stack in the
|
| 2115 |
|
|
; case that no FOR loops need to be saved. This needs to be
|
| 2116 |
|
|
; done because PUSHA / POPA is called all the time.
|
| 2117 |
|
|
|
| 2118 |
|
|
POPA:
|
| 2119 |
|
|
ply
|
| 2120 |
|
|
pla
|
| 2121 |
|
|
sta LOPVAR ; restore LOPVAR, but zero means no more
|
| 2122 |
|
|
beq PP1
|
| 2123 |
|
|
pla
|
| 2124 |
|
|
sta LOPINC
|
| 2125 |
|
|
pla
|
| 2126 |
|
|
sta LOPLMT
|
| 2127 |
|
|
pla
|
| 2128 |
|
|
sta LOPLN
|
| 2129 |
|
|
pla
|
| 2130 |
|
|
sta LOPPT
|
| 2131 |
|
|
PP1:
|
| 2132 |
|
|
jmp (y)
|
| 2133 |
|
|
|
| 2134 |
|
|
|
| 2135 |
|
|
PUSHA:
|
| 2136 |
|
|
ply
|
| 2137 |
|
|
lda STKBOT ; Are we running out of stack room?
|
| 2138 |
|
|
add r1,r1,#5 ; we might need this many words
|
| 2139 |
|
|
tsx
|
| 2140 |
|
|
cmp r2,r1
|
| 2141 |
|
|
bcc QSORRY ; out of stack space
|
| 2142 |
|
|
ldx LOPVAR ; save loop variables
|
| 2143 |
|
|
beq PU1 ; if LOPVAR is zero, that's all
|
| 2144 |
|
|
lda LOPPT
|
| 2145 |
|
|
pha
|
| 2146 |
|
|
lda LOPLN
|
| 2147 |
|
|
pha
|
| 2148 |
|
|
lda LOPLMT
|
| 2149 |
|
|
pha
|
| 2150 |
|
|
lda LOPINC
|
| 2151 |
|
|
pha
|
| 2152 |
|
|
PU1:
|
| 2153 |
|
|
phx
|
| 2154 |
|
|
jmp (y)
|
| 2155 |
|
|
|
| 2156 |
|
|
|
| 2157 |
|
|
|
| 2158 |
|
|
;******************************************************************
|
| 2159 |
|
|
;
|
| 2160 |
|
|
; 'PRTSTG' prints a string pointed to by r1. It stops printing
|
| 2161 |
|
|
; and returns to the caller when either a CR is printed or when
|
| 2162 |
|
|
; the next byte is the same as what was passed in r2 by the
|
| 2163 |
|
|
; caller.
|
| 2164 |
|
|
;
|
| 2165 |
|
|
; 'PRTLN' prints the saved text line pointed to by r3
|
| 2166 |
|
|
; with line no. and all.
|
| 2167 |
|
|
;
|
| 2168 |
|
|
|
| 2169 |
|
|
; r1 = pointer to string
|
| 2170 |
|
|
; r2 = stop character
|
| 2171 |
|
|
; return r1 = pointer to end of line + 1
|
| 2172 |
|
|
|
| 2173 |
|
|
PRTSTG:
|
| 2174 |
|
|
push r5
|
| 2175 |
|
|
push r6
|
| 2176 |
|
|
push r7
|
| 2177 |
|
|
ld r5,r1 ; r5 = pointer
|
| 2178 |
|
|
ld r6,r2 ; r6 = stop char
|
| 2179 |
|
|
PS1:
|
| 2180 |
|
|
ld r7,(r5) ; get a text character
|
| 2181 |
|
|
inc r5
|
| 2182 |
|
|
cmp r7,r6
|
| 2183 |
|
|
beq PRTRET ; same as stop character? if so, return
|
| 2184 |
|
|
ld r1,r7
|
| 2185 |
|
|
jsr GOOUT ; display the char.
|
| 2186 |
|
|
cmp r7,#CR
|
| 2187 |
|
|
bne PS1 ; is it a C.R.? no, go back for more
|
| 2188 |
|
|
lda #LF ; yes, add a L.F.
|
| 2189 |
|
|
jsr GOOUT
|
| 2190 |
|
|
PRTRET:
|
| 2191 |
|
|
ld r2,r7 ; return r2 = stop char
|
| 2192 |
|
|
ld r1,r5 ; return r1 = line pointer
|
| 2193 |
|
|
pop r7
|
| 2194 |
|
|
pop r6
|
| 2195 |
|
|
pop r5
|
| 2196 |
|
|
rts ; then return
|
| 2197 |
|
|
|
| 2198 |
|
|
|
| 2199 |
|
|
; 'QTSTG' looks for an underline (back-arrow on some systems),
|
| 2200 |
|
|
; single-quote, or double-quote. If none of these are found, returns
|
| 2201 |
|
|
; to the caller. If underline, outputs a CR without a LF. If single
|
| 2202 |
|
|
; or double quote, prints the quoted string and demands a matching
|
| 2203 |
|
|
; end quote. After the printing, the next i-word of the caller is
|
| 2204 |
|
|
; skipped over (usually a branch instruction).
|
| 2205 |
|
|
;
|
| 2206 |
|
|
QTSTG:
|
| 2207 |
|
|
ldy #'"'
|
| 2208 |
|
|
ld r4,#QT3
|
| 2209 |
|
|
jsr TSTC ; *** QTSTG ***
|
| 2210 |
|
|
ldx #'"' ; it is a "
|
| 2211 |
|
|
QT1:
|
| 2212 |
|
|
ld r1,r8
|
| 2213 |
|
|
jsr PRTSTG ; print until another
|
| 2214 |
|
|
ld r8,r1
|
| 2215 |
|
|
cpx #CR
|
| 2216 |
|
|
bne QT2 ; was last one a CR?
|
| 2217 |
|
|
jmp RUNNXL ; if so run next line
|
| 2218 |
|
|
QT3:
|
| 2219 |
|
|
ldy #''''
|
| 2220 |
|
|
ld r4,#QT4
|
| 2221 |
|
|
jsr TSTC ; is it a single quote?
|
| 2222 |
|
|
ldx #'''' ; if so, do same as above
|
| 2223 |
|
|
bra QT1
|
| 2224 |
|
|
QT4:
|
| 2225 |
|
|
ldy #'_'
|
| 2226 |
|
|
ld r4,#QT5
|
| 2227 |
|
|
jsr TSTC ; is it an underline?
|
| 2228 |
|
|
lda #CR ; if so, output a CR without LF
|
| 2229 |
|
|
jsr GOOUT
|
| 2230 |
|
|
QT2:
|
| 2231 |
|
|
pla ; get return address
|
| 2232 |
|
|
ina ; add 2 to it in order to skip following branch
|
| 2233 |
|
|
ina
|
| 2234 |
|
|
jmp (r1) ; skip over next i-word when returning
|
| 2235 |
|
|
QT5: ; not " ' or _
|
| 2236 |
|
|
rts
|
| 2237 |
|
|
|
| 2238 |
|
|
; Output a CR LF sequence
|
| 2239 |
|
|
;
|
| 2240 |
|
|
prCRLF:
|
| 2241 |
|
|
lda #CR
|
| 2242 |
|
|
jsr GOOUT
|
| 2243 |
|
|
lda #LF
|
| 2244 |
|
|
jsr GOOUT
|
| 2245 |
|
|
rts
|
| 2246 |
|
|
|
| 2247 |
|
|
; 'PRTNUM' prints the 32 bit number in r3, leading blanks are added if
|
| 2248 |
|
|
; needed to pad the number of spaces to the number in r4.
|
| 2249 |
|
|
; However, if the number of digits is larger than the no. in
|
| 2250 |
|
|
; r4, all digits are printed anyway. Negative sign is also
|
| 2251 |
|
|
; printed and counted in, positive sign is not.
|
| 2252 |
|
|
;
|
| 2253 |
|
|
; r1 = number to print
|
| 2254 |
|
|
; r2 = number of digits
|
| 2255 |
|
|
; Register Usage
|
| 2256 |
|
|
; r5 = number of padding spaces
|
| 2257 |
|
|
public PRTNUM:
|
| 2258 |
|
|
push r3
|
| 2259 |
|
|
push r5
|
| 2260 |
|
|
push r6
|
| 2261 |
|
|
push r7
|
| 2262 |
|
|
ld r7,#NUMWKA ; r7 = pointer to numeric work area
|
| 2263 |
|
|
ld r6,r1 ; save number for later
|
| 2264 |
|
|
ld r5,r2 ; r5 = min number of chars
|
| 2265 |
|
|
cmp #0
|
| 2266 |
|
|
bpl PN2 ; is it negative? if not
|
| 2267 |
|
|
sub r1,r0,r1 ; else make it positive
|
| 2268 |
|
|
dec r5 ; one less for width count
|
| 2269 |
|
|
PN2:
|
| 2270 |
|
|
ld r3,#10
|
| 2271 |
|
|
PN1:
|
| 2272 |
|
|
mod r2,r1,r3 ; r2 = r1 mod 10
|
| 2273 |
|
|
div r1,r1,r3 ; r1 /= 10 divide by 10
|
| 2274 |
|
|
add r2,r2,#'0' ; convert remainder to ascii
|
| 2275 |
|
|
stx (r7) ; and store in buffer
|
| 2276 |
|
|
inc r7
|
| 2277 |
|
|
dec r5 ; decrement width
|
| 2278 |
|
|
beq PN6 ; safty, prevents infinte loop on div fail
|
| 2279 |
|
|
cmp #0
|
| 2280 |
|
|
bne PN1
|
| 2281 |
|
|
PN6:
|
| 2282 |
|
|
cmp r5,r0
|
| 2283 |
|
|
bcc PN4 ; test pad count, skip padding if not needed
|
| 2284 |
|
|
beq PN4
|
| 2285 |
|
|
PN3:
|
| 2286 |
|
|
lda #' ' ; display the required leading spaces
|
| 2287 |
|
|
jsr GOOUT
|
| 2288 |
|
|
dec r5
|
| 2289 |
|
|
bne PN3
|
| 2290 |
|
|
PN4:
|
| 2291 |
|
|
cmp r6,r0
|
| 2292 |
|
|
bpl PN5 ; is number negative?
|
| 2293 |
|
|
lda #'-' ; if so, display the sign
|
| 2294 |
|
|
jsr GOOUT
|
| 2295 |
|
|
PN5:
|
| 2296 |
|
|
dec r7
|
| 2297 |
|
|
lda (r7) ; now unstack the digits and display
|
| 2298 |
|
|
jsr GOOUT
|
| 2299 |
|
|
cmp r7,#NUMWKA
|
| 2300 |
|
|
beq PNRET
|
| 2301 |
|
|
bcs PN5
|
| 2302 |
|
|
PNRET:
|
| 2303 |
|
|
pop r7
|
| 2304 |
|
|
pop r6
|
| 2305 |
|
|
pop r5
|
| 2306 |
|
|
pop r3
|
| 2307 |
|
|
rts
|
| 2308 |
|
|
|
| 2309 |
|
|
; r1 = number to print
|
| 2310 |
|
|
; r2 = number of digits
|
| 2311 |
|
|
public PRTHEXNUM:
|
| 2312 |
|
|
push r4
|
| 2313 |
|
|
push r5
|
| 2314 |
|
|
push r6
|
| 2315 |
|
|
push r7
|
| 2316 |
|
|
push r8
|
| 2317 |
|
|
ld r7,#NUMWKA ; r7 = pointer to numeric work area
|
| 2318 |
|
|
ld r6,r1 ; save number for later
|
| 2319 |
|
|
; setlo r5,#20 ; r5 = min number of chars
|
| 2320 |
|
|
ld r5,r2
|
| 2321 |
|
|
ld r4,r1
|
| 2322 |
|
|
cmp r4,r0
|
| 2323 |
|
|
bpl PHN2 ; is it negative? if not
|
| 2324 |
|
|
sub r4,r0,r4 ; else make it positive
|
| 2325 |
|
|
dec r5 ; one less for width count
|
| 2326 |
|
|
PHN2
|
| 2327 |
|
|
ld r8,#10 ; maximum of 10 digits
|
| 2328 |
|
|
PHN1:
|
| 2329 |
|
|
ld r1,r4
|
| 2330 |
|
|
and #15
|
| 2331 |
|
|
cmp #10
|
| 2332 |
|
|
bcc PHN7
|
| 2333 |
|
|
add #'A'-10
|
| 2334 |
|
|
bra PHN8
|
| 2335 |
|
|
PHN7:
|
| 2336 |
|
|
add #'0' ; convert remainder to ascii
|
| 2337 |
|
|
PHN8:
|
| 2338 |
|
|
sta (r7) ; and store in buffer
|
| 2339 |
|
|
inc r7
|
| 2340 |
|
|
dec r5 ; decrement width
|
| 2341 |
|
|
lsr r4,r4
|
| 2342 |
|
|
lsr r4,r4
|
| 2343 |
|
|
lsr r4,r4
|
| 2344 |
|
|
lsr r4,r4
|
| 2345 |
|
|
beq PHN6 ; is it zero yet ?
|
| 2346 |
|
|
dec r8
|
| 2347 |
|
|
bne PHN1
|
| 2348 |
|
|
PHN6: ; test pad count
|
| 2349 |
|
|
cmp r5,r0
|
| 2350 |
|
|
beq PHN4
|
| 2351 |
|
|
bcc PHN4 ; skip padding if not needed
|
| 2352 |
|
|
PHN3:
|
| 2353 |
|
|
lda #' ' ; display the required leading spaces
|
| 2354 |
|
|
jsr GOOUT
|
| 2355 |
|
|
dec r5
|
| 2356 |
|
|
bne PHN3
|
| 2357 |
|
|
PHN4:
|
| 2358 |
|
|
cmp r6,r0
|
| 2359 |
|
|
bcs PHN5 ; is number negative?
|
| 2360 |
|
|
lda #'-' ; if so, display the sign
|
| 2361 |
|
|
jsr GOOUT
|
| 2362 |
|
|
PHN5:
|
| 2363 |
|
|
dec r7
|
| 2364 |
|
|
lda (r7) ; now unstack the digits and display
|
| 2365 |
|
|
jsr GOOUT
|
| 2366 |
|
|
cmp r7,#NUMWKA
|
| 2367 |
|
|
beq PHNRET
|
| 2368 |
|
|
bcs PHN5
|
| 2369 |
|
|
PHNRET:
|
| 2370 |
|
|
pop r8
|
| 2371 |
|
|
pop r7
|
| 2372 |
|
|
pop r6
|
| 2373 |
|
|
pop r5
|
| 2374 |
|
|
pop r4
|
| 2375 |
|
|
rts
|
| 2376 |
|
|
|
| 2377 |
|
|
|
| 2378 |
|
|
; r1 = pointer to line
|
| 2379 |
|
|
; returns r1 = pointer to end of line + 1
|
| 2380 |
|
|
PRTLN:
|
| 2381 |
|
|
push r5
|
| 2382 |
|
|
ld r5,r1 ; r5 = pointer
|
| 2383 |
|
|
lda (r5) ; get the binary line number
|
| 2384 |
|
|
inc r5
|
| 2385 |
|
|
ldx #12 ; display a 0 or more digit line no.
|
| 2386 |
|
|
jsr PRTNUM
|
| 2387 |
|
|
lda #' ' ; followed by a blank
|
| 2388 |
|
|
jsr GOOUT
|
| 2389 |
|
|
ldx #0 ; stop char. is a zero
|
| 2390 |
|
|
ld r1,r5
|
| 2391 |
|
|
jsr PRTSTG ; display the rest of the line
|
| 2392 |
|
|
pop r5
|
| 2393 |
|
|
rts
|
| 2394 |
|
|
|
| 2395 |
|
|
|
| 2396 |
|
|
; ===== Test text byte following the call to this subroutine. If it
|
| 2397 |
|
|
; equals the byte pointed to by r8, return to the code following
|
| 2398 |
|
|
; the call. If they are not equal, brnch to the point
|
| 2399 |
|
|
; indicated in r4.
|
| 2400 |
|
|
;
|
| 2401 |
|
|
; Registers Affected
|
| 2402 |
|
|
; r3,r8
|
| 2403 |
|
|
; Returns
|
| 2404 |
|
|
; r8 = updated text pointer
|
| 2405 |
|
|
;
|
| 2406 |
|
|
TSTC
|
| 2407 |
|
|
pha
|
| 2408 |
|
|
jsr IGNBLK ; ignore leading blanks
|
| 2409 |
|
|
lda (r8)
|
| 2410 |
|
|
cmp r3,r1
|
| 2411 |
|
|
beq TC1 ; is it = to what r8 points to? if so
|
| 2412 |
|
|
pla
|
| 2413 |
|
|
ply ; increment stack pointer (get rid of return address)
|
| 2414 |
|
|
jmp (r4) ; jump to the routine
|
| 2415 |
|
|
TC1:
|
| 2416 |
|
|
inc r8 ; if equal, bump text pointer
|
| 2417 |
|
|
pla
|
| 2418 |
|
|
rts
|
| 2419 |
|
|
|
| 2420 |
|
|
; ===== See if the text pointed to by r8 is a number. If so,
|
| 2421 |
|
|
; return the number in r2 and the number of digits in r3,
|
| 2422 |
|
|
; else return zero in r2 and r3.
|
| 2423 |
|
|
; Registers Affected
|
| 2424 |
|
|
; r1,r2,r3,r4
|
| 2425 |
|
|
; Returns
|
| 2426 |
|
|
; r1 = number
|
| 2427 |
|
|
; r2 = number of digits in number
|
| 2428 |
|
|
; r8 = updated text pointer
|
| 2429 |
|
|
;
|
| 2430 |
|
|
TSTNUM:
|
| 2431 |
|
|
phy
|
| 2432 |
|
|
jsr IGNBLK ; skip over blanks
|
| 2433 |
|
|
lda #0 ; initialize return parameters
|
| 2434 |
|
|
ldx #0
|
| 2435 |
|
|
ld r15,#10
|
| 2436 |
|
|
TN1:
|
| 2437 |
|
|
ldy (r8)
|
| 2438 |
|
|
cpy #'0' ; is it less than zero?
|
| 2439 |
|
|
bcc TSNMRET
|
| 2440 |
|
|
cpy #'9'+1 ; is it greater than nine?
|
| 2441 |
|
|
bcs TSNMRET
|
| 2442 |
|
|
cmp r1,#$7FFFFFF ; see if there's room for new digit
|
| 2443 |
|
|
bcc TN2
|
| 2444 |
|
|
beq TN2
|
| 2445 |
|
|
lda #msgNumTooBig
|
| 2446 |
|
|
jmp ERROR ; if not, we've overflowd
|
| 2447 |
|
|
TN2:
|
| 2448 |
|
|
inc r8 ; adjust text pointer
|
| 2449 |
|
|
mul r1,r1,r15 ; quickly multiply result by 10
|
| 2450 |
|
|
and r3,r3,#$0F ; add in the new digit
|
| 2451 |
|
|
add r1,r1,r3
|
| 2452 |
|
|
inx ; increment the no. of digits
|
| 2453 |
|
|
bra TN1
|
| 2454 |
|
|
TSNMRET:
|
| 2455 |
|
|
ply
|
| 2456 |
|
|
rts
|
| 2457 |
|
|
|
| 2458 |
|
|
|
| 2459 |
|
|
;===== Skip over blanks in the text pointed to by r8.
|
| 2460 |
|
|
;
|
| 2461 |
|
|
; Registers Affected:
|
| 2462 |
|
|
; r8
|
| 2463 |
|
|
; Returns
|
| 2464 |
|
|
; r8 = pointer updateded past any spaces or tabs
|
| 2465 |
|
|
;
|
| 2466 |
|
|
IGNBLK:
|
| 2467 |
|
|
pha
|
| 2468 |
|
|
IGB2:
|
| 2469 |
|
|
lda (r8) ; get char
|
| 2470 |
|
|
cmp #' '
|
| 2471 |
|
|
beq IGB1 ; see if it's a space
|
| 2472 |
|
|
cmp #'\t'
|
| 2473 |
|
|
bne IGBRET ; or a tab
|
| 2474 |
|
|
IGB1:
|
| 2475 |
|
|
inc r8 ; increment the text pointer
|
| 2476 |
|
|
bra IGB2
|
| 2477 |
|
|
IGBRET:
|
| 2478 |
|
|
pla
|
| 2479 |
|
|
rts
|
| 2480 |
|
|
|
| 2481 |
|
|
; ===== Convert the line of text in the input buffer to upper
|
| 2482 |
|
|
; case (except for stuff between quotes).
|
| 2483 |
|
|
;
|
| 2484 |
|
|
; Registers Affected
|
| 2485 |
|
|
; r1,r3
|
| 2486 |
|
|
; Returns
|
| 2487 |
|
|
; r8 = pointing to end of text in buffer
|
| 2488 |
|
|
;
|
| 2489 |
|
|
TOUPBUF:
|
| 2490 |
|
|
ld r8,#BUFFER ; set up text pointer
|
| 2491 |
|
|
eor r3,r3,r3 ; clear quote flag
|
| 2492 |
|
|
TOUPB1:
|
| 2493 |
|
|
lda (r8) ; get the next text char.
|
| 2494 |
|
|
inc r8
|
| 2495 |
|
|
cmp #CR
|
| 2496 |
|
|
beq TOUPBRT ; is it end of line?
|
| 2497 |
|
|
cmp #'"'
|
| 2498 |
|
|
beq DOQUO ; a double quote?
|
| 2499 |
|
|
cmp #''''
|
| 2500 |
|
|
beq DOQUO ; or a single quote?
|
| 2501 |
|
|
cpy #0
|
| 2502 |
|
|
bne TOUPB1 ; inside quotes?
|
| 2503 |
|
|
jsr toUpper ; convert to upper case
|
| 2504 |
|
|
sta -1,r8 ; store it
|
| 2505 |
|
|
bra TOUPB1 ; and go back for more
|
| 2506 |
|
|
DOQUO:
|
| 2507 |
|
|
cpy #0
|
| 2508 |
|
|
bne DOQUO1; are we inside quotes?
|
| 2509 |
|
|
tay ; if not, toggle inside-quotes flag
|
| 2510 |
|
|
bra TOUPB1
|
| 2511 |
|
|
DOQUO1:
|
| 2512 |
|
|
cmp r3,r1
|
| 2513 |
|
|
bne TOUPB1 ; make sure we're ending proper quote
|
| 2514 |
|
|
eor r3,r3,r3 ; else clear quote flag
|
| 2515 |
|
|
bra TOUPB1
|
| 2516 |
|
|
TOUPBRT:
|
| 2517 |
|
|
rts
|
| 2518 |
|
|
|
| 2519 |
|
|
|
| 2520 |
|
|
; ===== Convert the character in r1 to upper case
|
| 2521 |
|
|
;
|
| 2522 |
|
|
toUpper
|
| 2523 |
|
|
cmp #'a' ; is it < 'a'?
|
| 2524 |
|
|
bcc TOUPRET
|
| 2525 |
|
|
cmp #'z'+1 ; or > 'z'?
|
| 2526 |
|
|
bcs TOUPRET
|
| 2527 |
|
|
sub #32 ; if not, make it upper case
|
| 2528 |
|
|
TOUPRET
|
| 2529 |
|
|
rts
|
| 2530 |
|
|
|
| 2531 |
|
|
|
| 2532 |
|
|
; 'CHKIO' checks the input. If there's no input, it will return
|
| 2533 |
|
|
; to the caller with the r1=0. If there is input, the input byte is in r1.
|
| 2534 |
|
|
; However, if a control-C is read, 'CHKIO' will warm-start BASIC and will
|
| 2535 |
|
|
; not return to the caller.
|
| 2536 |
|
|
;
|
| 2537 |
|
|
CHKIO:
|
| 2538 |
|
|
jsr GOIN ; get input if possible
|
| 2539 |
|
|
cmp #0
|
| 2540 |
|
|
beq CHKRET2 ; if Zero, no input
|
| 2541 |
|
|
cmp #CTRLC
|
| 2542 |
|
|
bne CHKRET ; is it control-C?
|
| 2543 |
|
|
pla ; dump return address
|
| 2544 |
|
|
jmp WSTART ; if so, do a warm start
|
| 2545 |
|
|
CHKRET2:
|
| 2546 |
|
|
lda #0
|
| 2547 |
|
|
CHKRET:
|
| 2548 |
|
|
rts
|
| 2549 |
|
|
|
| 2550 |
|
|
; ===== Display a CR-LF sequence
|
| 2551 |
|
|
;
|
| 2552 |
|
|
CRLF:
|
| 2553 |
|
|
lda #CLMSG
|
| 2554 |
|
|
|
| 2555 |
|
|
|
| 2556 |
|
|
; ===== Display a zero-ended string pointed to by register r1
|
| 2557 |
|
|
; Registers Affected
|
| 2558 |
|
|
; r1,r2,r4
|
| 2559 |
|
|
;
|
| 2560 |
|
|
PRMESG:
|
| 2561 |
|
|
push r5
|
| 2562 |
|
|
or r5,r1,r0 ; r5 = pointer to message
|
| 2563 |
|
|
PRMESG1:
|
| 2564 |
|
|
inc r5
|
| 2565 |
|
|
lb r1,-1,r5 ; get the char.
|
| 2566 |
|
|
beq PRMRET
|
| 2567 |
|
|
jsr GOOUT ;else display it trashes r4
|
| 2568 |
|
|
bra PRMESG1
|
| 2569 |
|
|
PRMRET:
|
| 2570 |
|
|
or r1,r5,r0
|
| 2571 |
|
|
pop r5
|
| 2572 |
|
|
rts
|
| 2573 |
|
|
|
| 2574 |
|
|
|
| 2575 |
|
|
; ===== Display a zero-ended string pointed to by register r1
|
| 2576 |
|
|
; Registers Affected
|
| 2577 |
|
|
; r1,r2,r3
|
| 2578 |
|
|
;
|
| 2579 |
|
|
PRMESGAUX:
|
| 2580 |
|
|
phy
|
| 2581 |
|
|
tay ; y = pointer
|
| 2582 |
|
|
PRMESGA1:
|
| 2583 |
|
|
iny
|
| 2584 |
|
|
lb r1,-1,y ; get the char.
|
| 2585 |
|
|
beq PRMRETA
|
| 2586 |
|
|
jsr GOAUXO ;else display it
|
| 2587 |
|
|
bra PRMESGA1
|
| 2588 |
|
|
PRMRETA:
|
| 2589 |
|
|
tya
|
| 2590 |
|
|
ply
|
| 2591 |
|
|
rts
|
| 2592 |
|
|
|
| 2593 |
|
|
;*****************************************************
|
| 2594 |
|
|
; The following routines are the only ones that need *
|
| 2595 |
|
|
; to be changed for a different I/O environment. *
|
| 2596 |
|
|
;*****************************************************
|
| 2597 |
|
|
|
| 2598 |
|
|
|
| 2599 |
|
|
; ===== Output character to the console (Port 1) from register r1
|
| 2600 |
|
|
; (Preserves all registers.)
|
| 2601 |
|
|
;
|
| 2602 |
|
|
OUTC:
|
| 2603 |
|
|
jmp DisplayChar
|
| 2604 |
|
|
|
| 2605 |
|
|
|
| 2606 |
|
|
; ===== Input a character from the console into register R1 (or
|
| 2607 |
|
|
; return Zero status if there's no character available).
|
| 2608 |
|
|
;
|
| 2609 |
|
|
INCH:
|
| 2610 |
|
|
jsr KeybdCheckForKeyDirect
|
| 2611 |
|
|
cmp #0
|
| 2612 |
|
|
beq INCH1
|
| 2613 |
|
|
jmp KeybdGetCharDirect
|
| 2614 |
|
|
INCH1:
|
| 2615 |
|
|
rts
|
| 2616 |
|
|
|
| 2617 |
|
|
;*
|
| 2618 |
|
|
;* ===== Input a character from the host into register r1 (or
|
| 2619 |
|
|
;* return Zero status if there's no character available).
|
| 2620 |
|
|
;*
|
| 2621 |
|
|
AUXIN:
|
| 2622 |
|
|
jsr SerialGetChar
|
| 2623 |
|
|
cmp #-1
|
| 2624 |
|
|
beq AXIRET_ZERO
|
| 2625 |
|
|
and #$7F ;zero out the high bit
|
| 2626 |
|
|
AXIRET:
|
| 2627 |
|
|
rts
|
| 2628 |
|
|
AXIRET_ZERO:
|
| 2629 |
|
|
lda #0
|
| 2630 |
|
|
rts
|
| 2631 |
|
|
|
| 2632 |
|
|
; ===== Output character to the host (Port 2) from register r1
|
| 2633 |
|
|
; (Preserves all registers.)
|
| 2634 |
|
|
;
|
| 2635 |
|
|
AUXOUT
|
| 2636 |
|
|
jmp SerialPutChar ; call boot rom routine
|
| 2637 |
|
|
|
| 2638 |
|
|
|
| 2639 |
|
|
_cls
|
| 2640 |
|
|
jsr ClearScreen
|
| 2641 |
|
|
stz CursorRow
|
| 2642 |
|
|
stz CursorCol
|
| 2643 |
|
|
jmp FINISH
|
| 2644 |
|
|
|
| 2645 |
|
|
_wait10
|
| 2646 |
|
|
rts
|
| 2647 |
|
|
_getATAStatus
|
| 2648 |
|
|
rts
|
| 2649 |
|
|
_waitCFNotBusy
|
| 2650 |
|
|
rts
|
| 2651 |
|
|
_rdcf
|
| 2652 |
|
|
jmp FINISH
|
| 2653 |
|
|
rdcf6
|
| 2654 |
|
|
bra ERROR
|
| 2655 |
|
|
|
| 2656 |
|
|
|
| 2657 |
|
|
; ===== Return to the resident monitor, operating system, etc.
|
| 2658 |
|
|
;
|
| 2659 |
|
|
BYEBYE:
|
| 2660 |
|
|
ldx OSSP
|
| 2661 |
|
|
txs
|
| 2662 |
|
|
rts
|
| 2663 |
|
|
|
| 2664 |
|
|
; MOVE.B #228,D7 return to Tutor
|
| 2665 |
|
|
; TRAP #14
|
| 2666 |
|
|
|
| 2667 |
|
|
msgInit db CR,LF,"RTF65002 Tiny BASIC v1.0",CR,LF,"(C) 2013 Robert Finch",CR,LF,LF,0
|
| 2668 |
|
|
OKMSG db CR,LF,"OK",CR,LF,0
|
| 2669 |
|
|
msgWhat db "What?",CR,LF,0
|
| 2670 |
|
|
SRYMSG db "Sorry."
|
| 2671 |
|
|
CLMSG db CR,LF,0
|
| 2672 |
|
|
msgReadError db "Compact FLASH read error",CR,LF,0
|
| 2673 |
|
|
msgNumTooBig db "Number is too big",CR,LF,0
|
| 2674 |
|
|
msgDivZero db "Division by zero",CR,LF,0
|
| 2675 |
|
|
msgVarSpace db "Out of variable space",CR,LF,0
|
| 2676 |
|
|
msgBytesFree db " words free",CR,LF,0
|
| 2677 |
|
|
msgReady db CR,LF,"Ready",CR,LF,0
|
| 2678 |
|
|
msgComma db "Expecting a comma",CR,LF,0
|
| 2679 |
|
|
msgLineRange db "Line number too big",CR,LF,0
|
| 2680 |
|
|
msgVar db "Expecting a variable",CR,LF,0
|
| 2681 |
|
|
msgRNDBad db "RND bad parameter",CR,LF,0
|
| 2682 |
|
|
msgSYSBad db "SYS bad address",CR,LF,0
|
| 2683 |
|
|
msgInputVar db "INPUT expecting a variable",CR,LF,0
|
| 2684 |
|
|
msgNextFor db "NEXT without FOR",CR,LF,0
|
| 2685 |
|
|
msgNextVar db "NEXT expecting a defined variable",CR,LF,0
|
| 2686 |
|
|
msgBadGotoGosub db "GOTO/GOSUB bad line number",CR,LF,0
|
| 2687 |
|
|
msgRetWoGosub db "RETURN without GOSUB",CR,LF,0
|
| 2688 |
|
|
msgTooBig db "Program is too big",CR,LF,0
|
| 2689 |
|
|
msgExtraChars db "Extra characters on line ignored",CR,LF,0
|
| 2690 |
|
|
|
| 2691 |
|
|
align 4
|
| 2692 |
|
|
LSTROM equ * ; end of possible ROM area
|
| 2693 |
|
|
; END
|
| 2694 |
|
|
|
| 2695 |
|
|
;*
|
| 2696 |
|
|
;* ===== Return to the resident monitor, operating system, etc.
|
| 2697 |
|
|
;*
|
| 2698 |
|
|
;BYEBYE:
|
| 2699 |
|
|
; jmp Monitor
|
| 2700 |
|
|
; MOVE.B #228,D7 ;return to Tutor
|
| 2701 |
|
|
; TRAP #14
|
| 2702 |
|
|
|
