| 1 |
7 |
robfinch |
;*****************************************************************
|
| 2 |
|
|
; *
|
| 3 |
|
|
; Tiny BASIC for the Motorola MC68000 *
|
| 4 |
|
|
; *
|
| 5 |
|
|
; Derived from Palo Alto Tiny BASIC as published in the May 1976 *
|
| 6 |
|
|
; issue of Dr. Dobb's Journal. Adapted to the 68000 by: *
|
| 7 |
|
|
; Gordon Brandly *
|
| 8 |
|
|
; 12147 - 51 Street *
|
| 9 |
|
|
; Edmonton AB T5W 3G8 *
|
| 10 |
|
|
; Canada *
|
| 11 |
|
|
; (updated mailing address for 1996) *
|
| 12 |
|
|
; *
|
| 13 |
|
|
; This version is for MEX68KECB Educational Computer Board I/O. *
|
| 14 |
|
|
; *
|
| 15 |
|
|
;*****************************************************************
|
| 16 |
|
|
; Copyright (C) 1984 by Gordon Brandly. This program may be *
|
| 17 |
|
|
; freely distributed for personal use only. All commercial *
|
| 18 |
|
|
; rights are reserved. *
|
| 19 |
|
|
;*****************************************************************
|
| 20 |
|
|
; *
|
| 21 |
|
|
; Some Modifications by: Robert Finch *
|
| 22 |
|
|
; This version running on a Diligent Nexys2 board XC3S1200e *
|
| 23 |
|
|
; Running TG68 for a processor *
|
| 24 |
|
|
; - two character variable names *
|
| 25 |
|
|
; - TICK variable *
|
| 26 |
|
|
; - *
|
| 27 |
|
|
; *
|
| 28 |
|
|
;*****************************************************************
|
| 29 |
|
|
; Vers. 1.0 1984/7/17 - Original version by Gordon Brandly
|
| 30 |
|
|
; 1.1 1984/12/9 - Addition of '$' print term by Marvin Lipford
|
| 31 |
|
|
; 1.2 1985/4/9 - Bug fix in multiply routine by Rick Murray
|
| 32 |
|
|
|
| 33 |
|
|
; OPT FRS,BRS forward ref.'s & branches default to short
|
| 34 |
|
|
RANDOM EQU 0xFFDC0C00 ; Hardware random# gen. address
|
| 35 |
|
|
GRAPHICS EQU 0xFFDAE000 ; graphics (line draw) acceelerator address
|
| 36 |
|
|
SPRCTRL EQU 0xFFDAD000 ; sprite controller address
|
| 37 |
|
|
|
| 38 |
|
|
BUFLEN EQU 80 ; length of keyboard input buffer
|
| 39 |
|
|
|
| 40 |
|
|
;*
|
| 41 |
|
|
;* Internal variables follow:
|
| 42 |
|
|
;*
|
| 43 |
|
|
BSS
|
| 44 |
|
|
ORG 0x600
|
| 45 |
|
|
RANPNT:
|
| 46 |
|
|
DC.L START ; random number pointer
|
| 47 |
|
|
CURRNT:
|
| 48 |
|
|
DC.L 1 ;Current line pointer
|
| 49 |
|
|
STKGOS:
|
| 50 |
|
|
DC.L 1 ;Saves stack pointer in 'GOSUB'
|
| 51 |
|
|
STKINP:
|
| 52 |
|
|
DC.L 1 ;Saves stack pointer during 'INPUT'
|
| 53 |
|
|
LOPVAR:
|
| 54 |
|
|
DC.L 1 ;'FOR' loop save area
|
| 55 |
|
|
LOPINC:
|
| 56 |
|
|
DC.L 1 ;increment
|
| 57 |
|
|
LOPLMT:
|
| 58 |
|
|
DC.L 1 ;limit
|
| 59 |
|
|
LOPLN:
|
| 60 |
|
|
DC.L 1 ;line number
|
| 61 |
|
|
LOPPT:
|
| 62 |
|
|
DC.L 1 ;text pointer
|
| 63 |
|
|
TXTUNF:
|
| 64 |
|
|
DC.L 1 ;points to unfilled text area
|
| 65 |
|
|
VARBGN:
|
| 66 |
|
|
DC.L 1 ;points to variable area
|
| 67 |
|
|
STKLMT:
|
| 68 |
|
|
DC.L 1 ;holds lower limit for stack growth
|
| 69 |
|
|
BUFFER:
|
| 70 |
|
|
FILL.B BUFLEN,0x00 ; Keyboard input buffer
|
| 71 |
|
|
|
| 72 |
|
|
TXT EQU $ ;Beginning of program area
|
| 73 |
|
|
|
| 74 |
|
|
CODE
|
| 75 |
|
|
even
|
| 76 |
|
|
ORG 0xFFFF2400
|
| 77 |
|
|
|
| 78 |
|
|
; Tell the outside world about these symbols
|
| 79 |
|
|
; only needed for the assembler, since this file is included from another file
|
| 80 |
|
|
public START
|
| 81 |
|
|
public ENDMEM
|
| 82 |
|
|
public PRTNUM
|
| 83 |
|
|
public AUXIN
|
| 84 |
|
|
|
| 85 |
|
|
;*
|
| 86 |
|
|
;* Standard jump table. You can change these addresses if you are
|
| 87 |
|
|
;* customizing this interpreter for a different environment.
|
| 88 |
|
|
;*
|
| 89 |
|
|
START:
|
| 90 |
|
|
BRA.L CSTART ;Cold Start entry point
|
| 91 |
|
|
GOWARM: BRA.L WSTART ;Warm Start entry point
|
| 92 |
|
|
GOOUT: BRA.L OUTC ;Jump to character-out routine
|
| 93 |
|
|
GOIN: BRA.L INC ;Jump to character-in routine
|
| 94 |
|
|
GOAUXO: BRA.L AUXOUT ;Jump to auxiliary-out routine
|
| 95 |
|
|
GOAUXI: BRA.L AUXIN ;Jump to auxiliary-in routine
|
| 96 |
|
|
GOBYE: BRA.L BYEBYE ;Jump to monitor, DOS, etc.
|
| 97 |
|
|
;*
|
| 98 |
|
|
;* Modifiable system constants:
|
| 99 |
|
|
;*
|
| 100 |
|
|
; Give Tiny Basic 3MB
|
| 101 |
|
|
TXTBGN DC.L 0xC00000 ;beginning of program memory
|
| 102 |
|
|
ENDMEM DC.L 0xF00000 ; end of available memory
|
| 103 |
|
|
;*
|
| 104 |
|
|
;* The main interpreter starts here:
|
| 105 |
|
|
;*
|
| 106 |
|
|
CSTART:
|
| 107 |
|
|
LEA START,A0
|
| 108 |
|
|
MOVE.L A0,RANPNT
|
| 109 |
|
|
MOVE.L ENDMEM,SP ;initialize stack pointer
|
| 110 |
|
|
LEA INITMSG,A6 ;tell who we are
|
| 111 |
|
|
BSR.L PRMESG
|
| 112 |
|
|
MOVE.L TXTBGN,TXTUNF ;init. end-of-program pointer
|
| 113 |
|
|
MOVE.L ENDMEM,D0 ;get address of end of memory
|
| 114 |
|
|
SUB.L #2048,D0 ;reserve 2K for the stack
|
| 115 |
|
|
MOVE.L D0,STKLMT
|
| 116 |
|
|
SUB.L #4104,D0 ;reserve variable area (27 long words)
|
| 117 |
|
|
MOVE.L D0,VARBGN
|
| 118 |
|
|
WSTART:
|
| 119 |
|
|
CLR.L D0 ;initialize internal variables
|
| 120 |
|
|
MOVE.L D0,LOPVAR
|
| 121 |
|
|
MOVE.L D0,STKGOS
|
| 122 |
|
|
MOVE.L D0,CURRNT ;current line number pointer = 0
|
| 123 |
|
|
MOVE.L ENDMEM,SP ;init S.P. again, just in case
|
| 124 |
|
|
LEA OKMSG,A6 ;display "OK"
|
| 125 |
|
|
BSR.L PRMESG
|
| 126 |
|
|
ST3:
|
| 127 |
|
|
MOVE.B #'>',D0 ; Monitor with a '>' and
|
| 128 |
|
|
BSR.L GETLN ; read a line.
|
| 129 |
|
|
BSR.L TOUPBUF ; convert to upper case
|
| 130 |
|
|
MOVE.L A0,A4 ; save pointer to end of line
|
| 131 |
|
|
LEA BUFFER,A0 ;point to the beginning of line
|
| 132 |
|
|
BSR.L TSTNUM ; is there a number there?
|
| 133 |
|
|
BSR.L IGNBLK ; skip trailing blanks
|
| 134 |
|
|
TST D1 ;does line no. exist? (or nonzero?)
|
| 135 |
|
|
BEQ.L DIRECT ; if not, it's a direct statement
|
| 136 |
|
|
CMP.L #0xFFFF,D1 ;see if line no. is <= 16 bits
|
| 137 |
|
|
BCC.L QHOW ;if not, we've overflowed
|
| 138 |
|
|
MOVE.B D1,-(A0) ;store the binary line no.
|
| 139 |
|
|
ROR #8,D1 ;(Kludge to store a word on a
|
| 140 |
|
|
MOVE.B D1,-(A0) ;possible byte boundary)
|
| 141 |
|
|
ROL #8,D1
|
| 142 |
|
|
BSR.L FNDLN ; find this line in save area
|
| 143 |
|
|
MOVE.L A1,A5 ; save possible line pointer
|
| 144 |
|
|
BNE ST4 ; if not found, insert
|
| 145 |
|
|
BSR.L FNDNXT ;find the next line (into A1)
|
| 146 |
|
|
MOVE.L A5,A2 ;pointer to line to be deleted
|
| 147 |
|
|
MOVE.L TXTUNF,A3 ;points to top of save area
|
| 148 |
|
|
BSR.L MVUP ;move up to delete
|
| 149 |
|
|
MOVE.L A2,TXTUNF ;update the end pointer
|
| 150 |
|
|
ST4:
|
| 151 |
|
|
MOVE.L A4,D0 ;calculate the length of new line
|
| 152 |
|
|
SUB.L A0,D0
|
| 153 |
|
|
CMP.L #3,D0 ;is it just a line no. & CR?
|
| 154 |
|
|
BEQ ST3 ;if so, it was just a delete
|
| 155 |
|
|
MOVE.L TXTUNF,A3 ;compute new end
|
| 156 |
|
|
MOVE.L A3,A6
|
| 157 |
|
|
ADD.L D0,A3
|
| 158 |
|
|
MOVE.L VARBGN,D0 ;see if there's enough room
|
| 159 |
|
|
CMP.L A3,D0
|
| 160 |
|
|
BLS.L QSORRY ;if not, say so
|
| 161 |
|
|
MOVE.L A3,TXTUNF ;if so, store new end position
|
| 162 |
|
|
MOVE.L A6,A1 ;points to old unfilled area
|
| 163 |
|
|
MOVE.L A5,A2 ;points to beginning of move area
|
| 164 |
|
|
BSR.L MVDOWN ;move things out of the way
|
| 165 |
|
|
MOVE.L A0,A1 ;set up to do the insertion
|
| 166 |
|
|
MOVE.L A5,A2
|
| 167 |
|
|
MOVE.L A4,A3
|
| 168 |
|
|
BSR.L MVUP ;do it
|
| 169 |
|
|
BRA ST3 ;go back and get another line
|
| 170 |
|
|
|
| 171 |
|
|
;*
|
| 172 |
|
|
;*******************************************************************
|
| 173 |
|
|
;*
|
| 174 |
|
|
;* *** Tables *** DIRECT *** EXEC ***
|
| 175 |
|
|
;*
|
| 176 |
|
|
;* This section of the code tests a string against a table. When
|
| 177 |
|
|
;* a match is found, control is transferred to the section of
|
| 178 |
|
|
;* code according to the table.
|
| 179 |
|
|
;*
|
| 180 |
|
|
;* At 'EXEC', A0 should point to the string, A1 should point to
|
| 181 |
|
|
;* the character table, and A2 should point to the execution
|
| 182 |
|
|
;* table. At 'DIRECT', A0 should point to the string, A1 and
|
| 183 |
|
|
;* A2 will be set up to point to TAB1 and TAB1.1, which are
|
| 184 |
|
|
;* the tables of all direct and statement commands.
|
| 185 |
|
|
;*
|
| 186 |
|
|
;* A '.' in the string will terminate the test and the partial
|
| 187 |
|
|
;* match will be considered as a match, e.g. 'P.', 'PR.','PRI.',
|
| 188 |
|
|
;* 'PRIN.', or 'PRINT' will all match 'PRINT'.
|
| 189 |
|
|
;*
|
| 190 |
|
|
;* There are two tables: the character table and the execution
|
| 191 |
|
|
;* table. The character table consists of any number of text items.
|
| 192 |
|
|
;* Each item is a string of characters with the last character's
|
| 193 |
|
|
;* high bit set to one. The execution table holds a 16-bit
|
| 194 |
|
|
;* execution addresses that correspond to each entry in the
|
| 195 |
|
|
;* character table.
|
| 196 |
|
|
;*
|
| 197 |
|
|
;* The end of the character table is a 0 byte which corresponds
|
| 198 |
|
|
;* to the default routine in the execution table, which is
|
| 199 |
|
|
;* executed if none of the other table items are matched.
|
| 200 |
|
|
;*
|
| 201 |
|
|
;* Character-matching tables:
|
| 202 |
|
|
TAB1:
|
| 203 |
|
|
DC.B 'LIS',('T'+0x80) ; Direct commands
|
| 204 |
|
|
DC.B 'LOA',('D'+0x80)
|
| 205 |
|
|
DC.B 'NE',('W'+0x80)
|
| 206 |
|
|
DC.B 'RU',('N'+0x80)
|
| 207 |
|
|
DC.B 'SAV',('E'+0x80)
|
| 208 |
|
|
DC.B 'CL',('S'+0x80)
|
| 209 |
|
|
TAB2:
|
| 210 |
|
|
DC.B 'NEX',('T'+0x80) ; Direct / statement
|
| 211 |
|
|
DC.B 'LE',('T'+0x80)
|
| 212 |
|
|
DC.B 'I',('F'+0x80)
|
| 213 |
|
|
DC.B 'GOT',('O'+0x80)
|
| 214 |
|
|
DC.B 'GOSU',('B'+0x80)
|
| 215 |
|
|
DC.B 'RETUR',('N'+0x80)
|
| 216 |
|
|
DC.B 'RE',('M'+0x80)
|
| 217 |
|
|
DC.B 'FO',('R'+0x80)
|
| 218 |
|
|
DC.B 'INPU',('T'+0x80)
|
| 219 |
|
|
DC.B 'PRIN',('T'+0x80)
|
| 220 |
|
|
DC.B 'POK',('E'+0x80)
|
| 221 |
|
|
DC.B 'STO',('P'+0x80)
|
| 222 |
|
|
DC.B 'BY',('E'+0x80)
|
| 223 |
|
|
DC.B 'CAL',('L'+0x80)
|
| 224 |
|
|
DC.B 'LIN',('E'+0x80)
|
| 225 |
|
|
DC.B 'POIN',('T'+0x80)
|
| 226 |
|
|
DC.B 'PENCOLO',('R'+0x80)
|
| 227 |
|
|
DC.B 'FILLCOLO',('R'+0x80)
|
| 228 |
|
|
DC.B 'SPRPO',('S'+0x80)
|
| 229 |
|
|
DC.B 0
|
| 230 |
|
|
TAB4:
|
| 231 |
|
|
DC.B 'PEE',('K'+0x80) ; Functions
|
| 232 |
|
|
DC.B 'RN',('D'+0x80)
|
| 233 |
|
|
DC.B 'AB',('S'+0x80)
|
| 234 |
|
|
DC.B 'SIZ',('E'+0x80)
|
| 235 |
|
|
DC.B 'TIC',('K'+0x80)
|
| 236 |
|
|
DC.B 'TEM',('P'+0x80)
|
| 237 |
|
|
DC.B 'SG',('N'+0x80)
|
| 238 |
|
|
DC.B 0
|
| 239 |
|
|
TAB5:
|
| 240 |
|
|
DC.B 'T',('O'+0x80) ; "TO" in "FOR"
|
| 241 |
|
|
DC.B 0
|
| 242 |
|
|
TAB6:
|
| 243 |
|
|
DC.B 'STE',('P'+0x80) ; "STEP" in "FOR"
|
| 244 |
|
|
DC.B 0
|
| 245 |
|
|
TAB8:
|
| 246 |
|
|
DC.B '>',('='+0x80) ; Relational operators
|
| 247 |
|
|
DC.B '<',('>'+0x80)
|
| 248 |
|
|
DC.B ('>'+0x80)
|
| 249 |
|
|
DC.B ('='+0x80)
|
| 250 |
|
|
DC.B '<',('='+0x80)
|
| 251 |
|
|
DC.B ('<'+0x80)
|
| 252 |
|
|
DC.B 0
|
| 253 |
|
|
; DC.B 0 ;<- for aligning on a word boundary
|
| 254 |
|
|
|
| 255 |
|
|
even
|
| 256 |
|
|
|
| 257 |
|
|
;* Execution address tables:
|
| 258 |
|
|
TAB1_1:
|
| 259 |
|
|
DC.W LIST_ ;Direct commands
|
| 260 |
|
|
DC.W LOAD
|
| 261 |
|
|
DC.W NEW
|
| 262 |
|
|
DC.W RUN
|
| 263 |
|
|
DC.W SAVE
|
| 264 |
|
|
DC.W CLS
|
| 265 |
|
|
TAB2_1:
|
| 266 |
|
|
DC.W NEXT ;Direct / statement
|
| 267 |
|
|
DC.W LET
|
| 268 |
|
|
DC.W IF
|
| 269 |
|
|
DC.W GOTO
|
| 270 |
|
|
DC.W GOSUB
|
| 271 |
|
|
DC.W RETURN
|
| 272 |
|
|
DC.W REM
|
| 273 |
|
|
DC.W FOR
|
| 274 |
|
|
DC.W INPUT
|
| 275 |
|
|
DC.W PRINT
|
| 276 |
|
|
DC.W POKE
|
| 277 |
|
|
DC.W STOP_
|
| 278 |
|
|
DC.W GOBYE
|
| 279 |
|
|
DC.W CALL
|
| 280 |
|
|
DC.W LINE
|
| 281 |
|
|
DC.W POINT
|
| 282 |
|
|
DC.W PENCOLOR
|
| 283 |
|
|
DC.W FILLCOLOR
|
| 284 |
|
|
DC.W SPRPOS
|
| 285 |
|
|
DC.W DEFLT
|
| 286 |
|
|
TAB4_1:
|
| 287 |
|
|
DC.W PEEK ;Functions
|
| 288 |
|
|
DC.W RND
|
| 289 |
|
|
DC.W ABS
|
| 290 |
|
|
DC.W SIZE_
|
| 291 |
|
|
DC.W TICK
|
| 292 |
|
|
DC.W TEMP
|
| 293 |
|
|
DC.W SGN
|
| 294 |
|
|
DC.W XP40
|
| 295 |
|
|
TAB5_1:
|
| 296 |
|
|
DC.W FR1 ; "TO" in "FOR"
|
| 297 |
|
|
DC.W QWHAT
|
| 298 |
|
|
TAB6_1:
|
| 299 |
|
|
DC.W FR2 ; "STEP" in "FOR"
|
| 300 |
|
|
DC.W FR3
|
| 301 |
|
|
TAB8_1:
|
| 302 |
|
|
DC.W XP11; >= Relational operators
|
| 303 |
|
|
DC.W XP12 ;<>
|
| 304 |
|
|
DC.W XP13 ;>
|
| 305 |
|
|
DC.W XP15 ;=
|
| 306 |
|
|
DC.W XP14 ;<=
|
| 307 |
|
|
DC.W XP16 ;<
|
| 308 |
|
|
DC.W XP17
|
| 309 |
|
|
;*
|
| 310 |
|
|
DIRECT:
|
| 311 |
|
|
LEA TAB1,A1
|
| 312 |
|
|
LEA TAB1_1,A2
|
| 313 |
|
|
EXEC:
|
| 314 |
|
|
BSR.L IGNBLK; ignore leading blanks
|
| 315 |
|
|
MOVE.L A0,A3 ;save the pointer
|
| 316 |
|
|
CLR.B D2 ;clear match flag
|
| 317 |
|
|
EXLP:
|
| 318 |
|
|
MOVE.B (A0)+,D0; get the program character
|
| 319 |
|
|
MOVE.B (A1),D1 ;get the table character
|
| 320 |
|
|
BNE EXNGO ;If end of table,
|
| 321 |
|
|
MOVE.L A3,A0 ;; restore the text pointer and...
|
| 322 |
|
|
BRA EXGO ;execute the default.
|
| 323 |
|
|
EXNGO:
|
| 324 |
|
|
MOVE.B D0,D3 ; Else check for period...
|
| 325 |
|
|
AND.B D2,D3 ;and a match.
|
| 326 |
|
|
CMP.B #'.',D3
|
| 327 |
|
|
BEQ EXGO ;if so, execute
|
| 328 |
|
|
AND.B #0x7F,D1 ; ignore the table's high bit
|
| 329 |
|
|
CMP.B D0,D1 ; is there a match?
|
| 330 |
|
|
BEQ EXMAT
|
| 331 |
|
|
ADDQ.L #2,A2 ; if not, try the next entry
|
| 332 |
|
|
MOVE.L A3,A0 ; reset the program pointer
|
| 333 |
|
|
CLR.B D2 ;sorry, no match
|
| 334 |
|
|
EX1:
|
| 335 |
|
|
TST.B (A1)+ ; get to the end of the entry
|
| 336 |
|
|
BPL EX1
|
| 337 |
|
|
BRA EXLP ;back for more matching
|
| 338 |
|
|
EXMAT:
|
| 339 |
|
|
MOVEQ #-1,D2; we've got a match so far
|
| 340 |
|
|
TST.B (A1)+ ; end of table entry?
|
| 341 |
|
|
BPL EXLP ;if not, go back for more
|
| 342 |
|
|
EXGO:
|
| 343 |
|
|
LEA 0xFFFF0000,A3 ; execute the appropriate routine
|
| 344 |
|
|
move.w (a2),a2
|
| 345 |
|
|
JMP (A3,A2.W)
|
| 346 |
|
|
|
| 347 |
|
|
CLS:
|
| 348 |
|
|
jsr ClearScreen
|
| 349 |
|
|
clr.w CursorRow
|
| 350 |
|
|
clr.w CursorCol
|
| 351 |
|
|
bra WSTART
|
| 352 |
|
|
;*
|
| 353 |
|
|
;*******************************************************************
|
| 354 |
|
|
;*
|
| 355 |
|
|
;* What follows is the code to execute direct and statement
|
| 356 |
|
|
;* commands. Control is transferred to these points via the command
|
| 357 |
|
|
;* table lookup code of 'DIRECT' and 'EXEC' in the last section.
|
| 358 |
|
|
;* After the command is executed, control is transferred to other
|
| 359 |
|
|
;* sections as follows:
|
| 360 |
|
|
;*
|
| 361 |
|
|
;* For 'LIST', 'NEW', and 'STOP': go back to the warm start point.
|
| 362 |
|
|
;* For 'RUN': go execute the first stored line if any; else go
|
| 363 |
|
|
;* back to the warm start point.
|
| 364 |
|
|
;* For 'GOTO' and 'GOSUB': go execute the target line.
|
| 365 |
|
|
;* For 'RETURN' and 'NEXT'; go back to saved return line.
|
| 366 |
|
|
;* For all others: if 'CURRNT' is 0, go to warm start; else go;
|
| 367 |
|
|
;* execute next command. (This is done in 'FINISH'.)
|
| 368 |
|
|
;*
|
| 369 |
|
|
;*******************************************************************
|
| 370 |
|
|
;*
|
| 371 |
|
|
;* *** NEW *** STOP *** RUN (& friends) *** GOTO ***
|
| 372 |
|
|
;*
|
| 373 |
|
|
;* 'NEW' sets TXTUNF to point to TXTBGN
|
| 374 |
|
|
;*
|
| 375 |
|
|
;* 'STOP' goes back to WSTART
|
| 376 |
|
|
;*
|
| 377 |
|
|
;* 'RUN' finds the first stored line, stores its address
|
| 378 |
|
|
;* in CURRNT, and starts executing it. Note that only those
|
| 379 |
|
|
;* commands in TAB2 are legal for a stored program.
|
| 380 |
|
|
;*
|
| 381 |
|
|
;* There are 3 more entries in 'RUN':
|
| 382 |
|
|
;* 'RUNNXL' finds next line, stores it's address and executes it.
|
| 383 |
|
|
;* 'RUNTSL' stores the address of this line and executes it.
|
| 384 |
|
|
;* 'RUNSML' continues the execution on same line.
|
| 385 |
|
|
;*
|
| 386 |
|
|
;* 'GOTO expr' evaluates the expression, finds the target
|
| 387 |
|
|
;* line, and jumps to 'RUNTSL' to do it.
|
| 388 |
|
|
;*
|
| 389 |
|
|
NEW:
|
| 390 |
|
|
BSR.L ENDCHK
|
| 391 |
|
|
MOVE.L TXTBGN,TXTUNF ;set the end pointer
|
| 392 |
|
|
|
| 393 |
|
|
STOP_:
|
| 394 |
|
|
BSR.L ENDCHK
|
| 395 |
|
|
BRA WSTART
|
| 396 |
|
|
|
| 397 |
|
|
RUN:
|
| 398 |
|
|
BSR.L ENDCHK
|
| 399 |
|
|
MOVE.L TXTBGN,A0 ;set pointer to beginning
|
| 400 |
|
|
MOVE.L A0,CURRNT
|
| 401 |
|
|
|
| 402 |
|
|
RUNNXL:
|
| 403 |
|
|
TST.L CURRNT ; executing a program?
|
| 404 |
|
|
BEQ.L WSTART ;if not, we've finished a direct stat.
|
| 405 |
|
|
CLR.L D1 ;else find the next line number
|
| 406 |
|
|
MOVE.L A0,A1
|
| 407 |
|
|
BSR.L FNDLNP
|
| 408 |
|
|
BCS WSTART ;if we've fallen off the end, stop
|
| 409 |
|
|
|
| 410 |
|
|
RUNTSL:
|
| 411 |
|
|
MOVE.L A1,CURRNT ;set CURRNT to point to the line no.
|
| 412 |
|
|
MOVE.L A1,A0 ;set the text pointer to
|
| 413 |
|
|
ADDQ.L #2,A0 ;the start of the line text
|
| 414 |
|
|
|
| 415 |
|
|
RUNSML:
|
| 416 |
|
|
BSR.L CHKIO ; see if a control-C was pressed
|
| 417 |
|
|
LEA TAB2,A1 ;find command in TAB2
|
| 418 |
|
|
LEA TAB2_1,A2
|
| 419 |
|
|
BRA EXEC ;and execute it
|
| 420 |
|
|
|
| 421 |
|
|
GOTO:
|
| 422 |
|
|
BSR.L EXPR ; evaluate the following expression
|
| 423 |
|
|
BSR.L ENDCHK ;must find end of line
|
| 424 |
|
|
MOVE.L D0,D1
|
| 425 |
|
|
BSR.L FNDLN ;find the target line
|
| 426 |
|
|
BNE.L QHOW ;no such line no.
|
| 427 |
|
|
BRA RUNTSL ;go do it
|
| 428 |
|
|
|
| 429 |
|
|
;*
|
| 430 |
|
|
;*******************************************************************
|
| 431 |
|
|
;*
|
| 432 |
|
|
;* *** LIST *** PRINT ***
|
| 433 |
|
|
;*
|
| 434 |
|
|
;* LIST has two forms:
|
| 435 |
|
|
;* 'LIST' lists all saved lines
|
| 436 |
|
|
;* 'LIST #' starts listing at the line #
|
| 437 |
|
|
;* Control-S pauses the listing, control-C stops it.
|
| 438 |
|
|
;*
|
| 439 |
|
|
;* PRINT command is 'PRINT ....:' or 'PRINT ....'
|
| 440 |
|
|
;* where '....' is a list of expressions, formats, back-arrows,
|
| 441 |
|
|
;* and strings. These items a separated by commas.
|
| 442 |
|
|
;*
|
| 443 |
|
|
;* A format is a pound sign followed by a number. It controls
|
| 444 |
|
|
;* the number of spaces the value of an expression is going to
|
| 445 |
|
|
;* be printed in. It stays effective for the rest of the print
|
| 446 |
|
|
;* command unless changed by another format. If no format is
|
| 447 |
|
|
;* specified, 11 positions will be used.
|
| 448 |
|
|
;*
|
| 449 |
|
|
;* A string is quoted in a pair of single- or double-quotes.
|
| 450 |
|
|
;*
|
| 451 |
|
|
;* An underline (back-arrow) means generate a without a
|
| 452 |
|
|
;*
|
| 453 |
|
|
;* A is generated after the entire list has been printed
|
| 454 |
|
|
;* or if the list is empty. If the list ends with a semicolon,
|
| 455 |
|
|
;* however, no is generated.
|
| 456 |
|
|
;*
|
| 457 |
|
|
|
| 458 |
|
|
LIST_:
|
| 459 |
|
|
BSR.L TSTNUM ; see if there's a line no.
|
| 460 |
|
|
BSR.L ENDCHK ;if not, we get a zero
|
| 461 |
|
|
BSR.L FNDLN ;find this or next line
|
| 462 |
|
|
LS1:
|
| 463 |
|
|
BCS WSTART ;warm start if we passed the end
|
| 464 |
|
|
BSR.L PRTLN ; print the line
|
| 465 |
|
|
BSR.L CHKIO ; check for listing halt request
|
| 466 |
|
|
BEQ LS3
|
| 467 |
|
|
CMP.B #CTRLS,D0 ;pause the listing?
|
| 468 |
|
|
BNE LS3
|
| 469 |
|
|
LS2:
|
| 470 |
|
|
BSR.L CHKIO ;if so, wait for another keypress
|
| 471 |
|
|
BEQ LS2
|
| 472 |
|
|
LS3:
|
| 473 |
|
|
BSR.L FNDLNP ;find the next line
|
| 474 |
|
|
BRA LS1
|
| 475 |
|
|
|
| 476 |
|
|
PRINT:
|
| 477 |
|
|
MOVE #11,D4 ; D4 = number of print spaces
|
| 478 |
|
|
BSR.L TSTC ;if null list and ":"
|
| 479 |
|
|
DC.B ':',PR2-$
|
| 480 |
|
|
BSR.L CRLF1 ;give CR-LF and continue
|
| 481 |
|
|
BRA RUNSML ;execution on the same line
|
| 482 |
|
|
PR2:
|
| 483 |
|
|
BSR.L TSTC ;if null list and
|
| 484 |
|
|
DC.B CR,PR0-$
|
| 485 |
|
|
BSR.L CRLF1 ;also give CR-LF and
|
| 486 |
|
|
BRA RUNNXL ;execute the next line
|
| 487 |
|
|
PR0:
|
| 488 |
|
|
BSR.L TSTC ;else is it a format?
|
| 489 |
|
|
DC.B '#',PR1-$
|
| 490 |
|
|
BSR.L EXPR ;yes, evaluate expression
|
| 491 |
|
|
MOVE D0,D4 ;and save it as print width
|
| 492 |
|
|
BRA PR3 ;look for more to print
|
| 493 |
|
|
PR1:
|
| 494 |
|
|
BSR.L TSTC ;is character expression? (MRL)
|
| 495 |
|
|
DC.B '$',PR4-$
|
| 496 |
|
|
BSR.L EXPR ;yep. Evaluate expression (MRL)
|
| 497 |
|
|
BSR GOOUT ;print low byte (MRL)
|
| 498 |
|
|
BRA PR3 ;look for more. (MRL)
|
| 499 |
|
|
PR4:
|
| 500 |
|
|
BSR.L QTSTG ; is it a string?
|
| 501 |
|
|
BRA.S PR8 ;if not, must be an expression
|
| 502 |
|
|
PR3:
|
| 503 |
|
|
BSR.L TSTC ; if ",", go find next
|
| 504 |
|
|
DC.B ',',PR6-$
|
| 505 |
|
|
BSR.L FIN ;in the list.
|
| 506 |
|
|
BRA PR0
|
| 507 |
|
|
PR6:
|
| 508 |
|
|
BSR.L CRLF1 ; list ends here
|
| 509 |
|
|
BRA FINISH
|
| 510 |
|
|
PR8:
|
| 511 |
|
|
MOVE D4,-(SP) ;save the width value
|
| 512 |
|
|
BSR.L EXPR ;evaluate the expression
|
| 513 |
|
|
MOVE (SP)+,D4 ;restore the width
|
| 514 |
|
|
MOVE.L D0,D1
|
| 515 |
|
|
BSR.L PRTNUM ;print its value
|
| 516 |
|
|
BRA PR3 ;more to print?
|
| 517 |
|
|
|
| 518 |
|
|
FINISH:
|
| 519 |
|
|
BSR.L FIN ; Check end of command
|
| 520 |
|
|
BRA.L QWHAT ; print "What?" if wrong
|
| 521 |
|
|
|
| 522 |
|
|
;*
|
| 523 |
|
|
;*******************************************************************
|
| 524 |
|
|
;*
|
| 525 |
|
|
;* *** GOSUB *** & RETURN ***
|
| 526 |
|
|
;*
|
| 527 |
|
|
;* 'GOSUB expr:' or 'GOSUB expr' is like the 'GOTO' command,
|
| 528 |
|
|
;* except that the current text pointer, stack pointer, etc. are
|
| 529 |
|
|
;* saved so that execution can be continued after the subroutine
|
| 530 |
|
|
;* 'RETURN's. In order that 'GOSUB' can be nested (and even
|
| 531 |
|
|
;* recursive), the save area must be stacked. The stack pointer
|
| 532 |
|
|
;* is saved in 'STKGOS'. The old 'STKGOS' is saved on the stack.
|
| 533 |
|
|
;* If we are in the main routine, 'STKGOS' is zero (this was done
|
| 534 |
|
|
;* in the initialization section of the interpreter), but we still
|
| 535 |
|
|
;* save it as a flag for no further 'RETURN's.
|
| 536 |
|
|
;*
|
| 537 |
|
|
;* 'RETURN' undoes everything that 'GOSUB' did, and thus
|
| 538 |
|
|
;* returns the execution to the command after the most recent
|
| 539 |
|
|
;* 'GOSUB'. If 'STKGOS' is zero, it indicates that we never had
|
| 540 |
|
|
;* a 'GOSUB' and is thus an error.
|
| 541 |
|
|
;*
|
| 542 |
|
|
GOSUB:
|
| 543 |
|
|
BSR.L PUSHA ; save the current 'FOR' parameters
|
| 544 |
|
|
BSR.L EXPR ;get line number
|
| 545 |
|
|
MOVE.L A0,-(SP) ;save text pointer
|
| 546 |
|
|
MOVE.L D0,D1
|
| 547 |
|
|
BSR.L FNDLN ;find the target line
|
| 548 |
|
|
BNE.L AHOW ;if not there, say "How?"
|
| 549 |
|
|
MOVE.L CURRNT,-(SP) ;found it, save old 'CURRNT'...
|
| 550 |
|
|
MOVE.L STKGOS,-(SP) ;and 'STKGOS'
|
| 551 |
|
|
CLR.L LOPVAR ;load new values
|
| 552 |
|
|
MOVE.L SP,STKGOS
|
| 553 |
|
|
BRA RUNTSL
|
| 554 |
|
|
|
| 555 |
|
|
RETURN:
|
| 556 |
|
|
BSR.L ENDCHK ; there should be just a
|
| 557 |
|
|
MOVE.L STKGOS,D1 ;get old stack pointer
|
| 558 |
|
|
BEQ.L QWHAT ;if zero, it doesn't exist
|
| 559 |
|
|
MOVE.L D1,SP ;else restore it
|
| 560 |
|
|
MOVE.L (SP)+,STKGOS ;and the old 'STKGOS'
|
| 561 |
|
|
MOVE.L (SP)+,CURRNT ;and the old 'CURRNT'
|
| 562 |
|
|
MOVE.L (SP)+,A0 ;and the old text pointer
|
| 563 |
|
|
BSR.L POPA ;and the old 'FOR' parameters
|
| 564 |
|
|
BRA FINISH ;and we are back home
|
| 565 |
|
|
|
| 566 |
|
|
;*
|
| 567 |
|
|
;*******************************************************************
|
| 568 |
|
|
;*
|
| 569 |
|
|
;* *** FOR *** & NEXT ***
|
| 570 |
|
|
;*
|
| 571 |
|
|
;* 'FOR' has two forms:
|
| 572 |
|
|
;* 'FOR var=exp1 TO exp2 STEP exp1' and 'FOR var=exp1 TO exp2'
|
| 573 |
|
|
;* The second form means the same thing as the first form with a
|
| 574 |
|
|
;* STEP of positive 1. The interpreter will find the variable 'var'
|
| 575 |
|
|
;* and set its value to the current value of 'exp1'. It also
|
| 576 |
|
|
;* evaluates 'exp2' and 'exp1' and saves all these together with
|
| 577 |
|
|
;* the text pointer, etc. in the 'FOR' save area, which consisits of
|
| 578 |
|
|
;* 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', and 'LOPPT'. If there is
|
| 579 |
|
|
;* already something in the save area (indicated by a non-zero
|
| 580 |
|
|
;* 'LOPVAR'), then the old save area is saved on the stack before
|
| 581 |
|
|
;* the new values are stored. The interpreter will then dig in the
|
| 582 |
|
|
;* stack and find out if this same variable was used in another
|
| 583 |
|
|
;* currently active 'FOR' loop. If that is the case, then the old
|
| 584 |
|
|
;* 'FOR' loop is deactivated. (i.e. purged from the stack)
|
| 585 |
|
|
;*
|
| 586 |
|
|
;* 'NEXT var' serves as the logical (not necessarily physical) end
|
| 587 |
|
|
;* of the 'FOR' loop. The control variable 'var' is checked with
|
| 588 |
|
|
;* the 'LOPVAR'. If they are not the same, the interpreter digs in
|
| 589 |
|
|
;* the stack to find the right one and purges all those that didn't
|
| 590 |
|
|
;* match. Either way, it then adds the 'STEP' to that variable and
|
| 591 |
|
|
;* checks the result with against the limit value. If it is within
|
| 592 |
|
|
;* the limit, control loops back to the command following the
|
| 593 |
|
|
;* 'FOR'. If it's outside the limit, the save area is purged and
|
| 594 |
|
|
;* execution continues.
|
| 595 |
|
|
;*
|
| 596 |
|
|
FOR:
|
| 597 |
|
|
BSR.L PUSHA ;save the old 'FOR' save area
|
| 598 |
|
|
BSR.L SETVAL ;set the control variable
|
| 599 |
|
|
MOVE.L A6,LOPVAR ;save its address
|
| 600 |
|
|
LEA TAB5,A1 ;use 'EXEC' to test for 'TO'
|
| 601 |
|
|
LEA TAB5_1,A2
|
| 602 |
|
|
BRA EXEC
|
| 603 |
|
|
FR1:
|
| 604 |
|
|
BSR.L EXPR ;evaluate the limit
|
| 605 |
|
|
MOVE.L D0,LOPLMT ;save that
|
| 606 |
|
|
LEA TAB6,A1 ;use 'EXEC' to look for the
|
| 607 |
|
|
LEA TAB6_1,A2 ;word 'STEP'
|
| 608 |
|
|
BRA EXEC
|
| 609 |
|
|
FR2:
|
| 610 |
|
|
BSR.L EXPR ; found it, get the step value
|
| 611 |
|
|
BRA FR4
|
| 612 |
|
|
FR3:
|
| 613 |
|
|
MOVEQ #1,D0 ; not found, step defaults to 1
|
| 614 |
|
|
FR4:
|
| 615 |
|
|
MOVE.L D0,LOPINC ;save that too
|
| 616 |
|
|
FR5:
|
| 617 |
|
|
MOVE.L CURRNT,LOPLN ;save address of current line number
|
| 618 |
|
|
MOVE.L A0,LOPPT ;and text pointer
|
| 619 |
|
|
MOVE.L SP,A6 ;dig into the stack to find 'LOPVAR'
|
| 620 |
|
|
BRA FR7
|
| 621 |
|
|
FR6:
|
| 622 |
|
|
ADD.L #20,A6 ;look at next stack frame
|
| 623 |
|
|
FR7:
|
| 624 |
|
|
MOVE.L (A6),D0 ;is it zero?
|
| 625 |
|
|
BEQ FR8 ;if so, we're done
|
| 626 |
|
|
CMP.L LOPVAR,D0 ;same as current LOPVAR?
|
| 627 |
|
|
BNE FR6 ;nope, look some more
|
| 628 |
|
|
MOVE.L SP,A2 ; Else remove 5 long words from...
|
| 629 |
|
|
MOVE.L A6,A1 ; inside the stack.
|
| 630 |
|
|
LEA 20,A3
|
| 631 |
|
|
ADD.L A1,A3
|
| 632 |
|
|
BSR.L MVDOWN
|
| 633 |
|
|
MOVE.L A3,SP ; set the SP 5 long words up
|
| 634 |
|
|
FR8:
|
| 635 |
|
|
BRA FINISH ;and continue execution
|
| 636 |
|
|
|
| 637 |
|
|
NEXT:
|
| 638 |
|
|
BSR.L TSTV; get address of variable
|
| 639 |
|
|
BCS.L QWHAT ; if no variable, say "What?"
|
| 640 |
|
|
MOVE.L D0,A1 ; save variable's address
|
| 641 |
|
|
NX0:
|
| 642 |
|
|
MOVE.L LOPVAR,D0; If 'LOPVAR' is zero, we never...
|
| 643 |
|
|
BEQ.L QWHAT ; had a FOR loop, so say "What?"
|
| 644 |
|
|
CMP.L D0,A1 ;; else we check them
|
| 645 |
|
|
BEQ NX3 ; OK, they agree
|
| 646 |
|
|
BSR.L POPA ; nope, let's see the next frame
|
| 647 |
|
|
BRA NX0
|
| 648 |
|
|
NX3:
|
| 649 |
|
|
MOVE.L (A1),D0 ; get control variable's value
|
| 650 |
|
|
ADD.L LOPINC,D0; add in loop increment
|
| 651 |
|
|
BVS.L QHOW ; say "How?" for 32-bit overflow
|
| 652 |
|
|
MOVE.L D0,(A1) ; save control variable's new value
|
| 653 |
|
|
MOVE.L LOPLMT,D1; get loop's limit value
|
| 654 |
|
|
TST.L LOPINC
|
| 655 |
|
|
BPL NX1 ; branch if loop increment is positive
|
| 656 |
|
|
EXG D0,D1
|
| 657 |
|
|
NX1:
|
| 658 |
|
|
CMP.L D0,D1; test against limit
|
| 659 |
|
|
BLT NX2; branch if outside limit
|
| 660 |
|
|
MOVE.L LOPLN,CURRNT ;Within limit, go back to the...
|
| 661 |
|
|
MOVE.L LOPPT,A0 ;saved 'CURRNT' and text pointer.
|
| 662 |
|
|
BRA FINISH
|
| 663 |
|
|
NX2:
|
| 664 |
|
|
BSR.L POPA ;purge this loop
|
| 665 |
|
|
BRA FINISH
|
| 666 |
|
|
|
| 667 |
|
|
;*
|
| 668 |
|
|
;*******************************************************************
|
| 669 |
|
|
;*
|
| 670 |
|
|
;* *** REM *** IF *** INPUT *** LET (& DEFLT) ***
|
| 671 |
|
|
;*
|
| 672 |
|
|
;* 'REM' can be followed by anything and is ignored by the
|
| 673 |
|
|
;* interpreter.
|
| 674 |
|
|
;*
|
| 675 |
|
|
;* 'IF' is followed by an expression, as a condition and one or
|
| 676 |
|
|
;* more commands (including other 'IF's) separated by colons.
|
| 677 |
|
|
;* Note that the word 'THEN' is not used. The interpreter evaluates
|
| 678 |
|
|
;* the expression. If it is non-zero, execution continues. If it
|
| 679 |
|
|
;* is zero, the commands that follow are ignored and execution
|
| 680 |
|
|
;* continues on the next line.
|
| 681 |
|
|
;*
|
| 682 |
|
|
;* 'INPUT' is like the 'PRINT' command, and is followed by a list
|
| 683 |
|
|
;* of items. If the item is a string in single or double quotes,
|
| 684 |
|
|
;* or is an underline (back arrow), it has the same effect as in
|
| 685 |
|
|
;* 'PRINT'. If an item is a variable, this variable name is
|
| 686 |
|
|
;* printed out followed by a colon, then the interpreter waits for
|
| 687 |
|
|
;* an expression to be typed in. The variable is then set to the
|
| 688 |
|
|
;* value of this expression. If the variable is preceeded by a
|
| 689 |
|
|
;* string (again in single or double quotes), the string will be
|
| 690 |
|
|
;* displayed followed by a colon. The interpreter the waits for an
|
| 691 |
|
|
;* expression to be entered and sets the variable equal to the
|
| 692 |
|
|
;* expression's value. If the input expression is invalid, the
|
| 693 |
|
|
;* interpreter will print "What?", "How?", or "Sorry" and reprint
|
| 694 |
|
|
;* the prompt and redo the input. The execution will not terminate
|
| 695 |
|
|
;* unless you press control-C. This is handled in 'INPERR'.
|
| 696 |
|
|
;*
|
| 697 |
|
|
;* 'LET' is followed by a list of items separated by commas.
|
| 698 |
|
|
;* Each item consists of a variable, an equals sign, and an
|
| 699 |
|
|
;* expression. The interpreter evaluates the expression and sets
|
| 700 |
|
|
;* the variable to that value. The interpreter will also handle
|
| 701 |
|
|
;* 'LET' commands without the word 'LET'. This is done by 'DEFLT'.
|
| 702 |
|
|
;*
|
| 703 |
|
|
REM:
|
| 704 |
|
|
BRA IF2 ;skip the rest of the line
|
| 705 |
|
|
|
| 706 |
|
|
IF:
|
| 707 |
|
|
BSR.L EXPR ; evaluate the expression
|
| 708 |
|
|
IF1:
|
| 709 |
|
|
TST.L D0 ;is it zero?
|
| 710 |
|
|
BNE RUNSML ;if not, continue
|
| 711 |
|
|
IF2:
|
| 712 |
|
|
MOVE.L A0,A1
|
| 713 |
|
|
CLR.L D1
|
| 714 |
|
|
BSR.L FNDSKP ; if so, skip the rest of the line
|
| 715 |
|
|
BCC RUNTSL ;and run the next line
|
| 716 |
|
|
BRA.L WSTART ; if no next line, do a warm start
|
| 717 |
|
|
|
| 718 |
|
|
INPERR:
|
| 719 |
|
|
MOVE.L STKINP,SP; restore the old stack pointer
|
| 720 |
|
|
MOVE.L (SP)+,CURRNT; and old 'CURRNT'
|
| 721 |
|
|
ADDQ.L #4,SP
|
| 722 |
|
|
MOVE.L (SP)+,A0 ;and old text pointer
|
| 723 |
|
|
|
| 724 |
|
|
INPUT:
|
| 725 |
|
|
MOVE.L A0,-(SP); save in case of error
|
| 726 |
|
|
BSR.L QTSTG ;is next item a string?
|
| 727 |
|
|
BRA.S IP2 ;nope
|
| 728 |
|
|
BSR.L TSTV ; yes, but is it followed by a variable?
|
| 729 |
|
|
BCS IP4 ;if not, branch
|
| 730 |
|
|
MOVE.L D0,A2 ; put away the variable's address
|
| 731 |
|
|
BRA IP3 ;if so, input to variable
|
| 732 |
|
|
IP2:
|
| 733 |
|
|
MOVE.L A0,-(SP); save for 'PRTSTG'
|
| 734 |
|
|
BSR.L TSTV ; must be a variable now
|
| 735 |
|
|
BCS.L QWHAT ; "What?" it isn't?
|
| 736 |
|
|
MOVE.L D0,A2 ; put away the variable's address
|
| 737 |
|
|
MOVE.B (A0),D2 ; get ready for 'PRTSTG'
|
| 738 |
|
|
CLR.B D0
|
| 739 |
|
|
MOVE.B D0,(A0)
|
| 740 |
|
|
MOVE.L (SP)+,A1
|
| 741 |
|
|
BSR.L PRTSTG ; print string as prompt
|
| 742 |
|
|
MOVE.B D2,(A0) ; restore text
|
| 743 |
|
|
IP3:
|
| 744 |
|
|
MOVE.L A0,-(SP); save in case of error
|
| 745 |
|
|
MOVE.L CURRNT,-(SP) ;also save 'CURRNT'
|
| 746 |
|
|
MOVE.L #-1,CURRNT ;flag that we are in INPUT
|
| 747 |
|
|
MOVE.L SP,STKINP ;save the stack pointer too
|
| 748 |
|
|
MOVE.L A2,-(SP) ;save the variable address
|
| 749 |
|
|
MOVE.B #':',D0 ; print a colon first
|
| 750 |
|
|
BSR.L GETLN ;then get an input line
|
| 751 |
|
|
LEA BUFFER,A0 ;point to the buffer
|
| 752 |
|
|
BSR.L EXPR ; evaluate the input
|
| 753 |
|
|
MOVE.L (SP)+,A2 ;restore the variable address
|
| 754 |
|
|
MOVE.L D0,(A2) ;save value in variable
|
| 755 |
|
|
MOVE.L (SP)+,CURRNT ;restore old 'CURRNT'
|
| 756 |
|
|
MOVE.L (SP)+,A0; and the old text pointer
|
| 757 |
|
|
IP4:
|
| 758 |
|
|
ADDQ.L #4,SP ; clean up the stack
|
| 759 |
|
|
BSR.L TSTC ; is the next thing a comma?
|
| 760 |
|
|
DC.B ',',IP5-$
|
| 761 |
|
|
BRA INPUT ; yes, more items
|
| 762 |
|
|
IP5:
|
| 763 |
|
|
BRA FINISH
|
| 764 |
|
|
|
| 765 |
|
|
DEFLT:
|
| 766 |
|
|
CMP.B #CR,(A0); empty line is OK
|
| 767 |
|
|
BEQ LT1 ;else it is 'LET'
|
| 768 |
|
|
|
| 769 |
|
|
LET:
|
| 770 |
|
|
BSR.L SETVAL ;do the assignment
|
| 771 |
|
|
BSR.L TSTC ;check for more 'LET' items
|
| 772 |
|
|
DC.B ',',LT1-$
|
| 773 |
|
|
BRA LET
|
| 774 |
|
|
LT1:
|
| 775 |
|
|
BRA FINISH ;until we are finished.
|
| 776 |
|
|
|
| 777 |
|
|
;*
|
| 778 |
|
|
;*******************************************************************
|
| 779 |
|
|
;*
|
| 780 |
|
|
;* *** LOAD *** & SAVE ***
|
| 781 |
|
|
;*
|
| 782 |
|
|
;* These two commands transfer a program to/from an auxiliary
|
| 783 |
|
|
;* device such as a cassette, another computer, etc. The program
|
| 784 |
|
|
;* is converted to an easily-stored format: each line starts with
|
| 785 |
|
|
;* a colon, the line no. as 4 hex digits, and the rest of the line.
|
| 786 |
|
|
;* At the end, a line starting with an '@' sign is sent. This
|
| 787 |
|
|
;* format can be read back with a minimum of processing time by
|
| 788 |
|
|
;* the 68000.
|
| 789 |
|
|
;*
|
| 790 |
|
|
LOAD:
|
| 791 |
|
|
MOVE.L TXTBGN,A0 ;set pointer to start of prog. area
|
| 792 |
|
|
MOVE.B #CR,D0 ;For a CP/M host, tell it we're ready...
|
| 793 |
|
|
BSR GOAUXO ;by sending a CR to finish PIP command.
|
| 794 |
|
|
LOD1:
|
| 795 |
|
|
BSR GOAUXI ; look for start of line
|
| 796 |
|
|
BEQ LOD1
|
| 797 |
|
|
CMP.B #'@',D0 ; end of program?
|
| 798 |
|
|
BEQ LODEND
|
| 799 |
|
|
CMP.B #':',D0 ; if not, is it start of line?
|
| 800 |
|
|
BNE LOD1 ;if not, wait for it
|
| 801 |
|
|
BSR GBYTE ;get first byte of line no.
|
| 802 |
|
|
MOVE.B D1,(A0)+ ;store it
|
| 803 |
|
|
BSR GBYTE ;get 2nd bye of line no.
|
| 804 |
|
|
MOVE.B D1,(A0)+ ; store that, too
|
| 805 |
|
|
LOD2:
|
| 806 |
|
|
BSR GOAUXI ; get another text char.
|
| 807 |
|
|
BEQ LOD2
|
| 808 |
|
|
MOVE.B D0,(A0)+ ;store it
|
| 809 |
|
|
CMP.B #CR,D0 ;is it the end of the line?
|
| 810 |
|
|
BNE LOD2 ;if not, go back for more
|
| 811 |
|
|
BRA LOD1 ;if so, start a new line
|
| 812 |
|
|
LODEND:
|
| 813 |
|
|
MOVE.L A0,TXTUNF ;set end-of program pointer
|
| 814 |
|
|
BRA WSTART ;back to direct mode
|
| 815 |
|
|
|
| 816 |
|
|
GBYTE:
|
| 817 |
|
|
MOVEQ #1,D2 ; get two hex characters from auxiliary
|
| 818 |
|
|
CLR D1 ;and store them as a byte in D1
|
| 819 |
|
|
GBYTE1:
|
| 820 |
|
|
BSR GOAUXI ; get a char.
|
| 821 |
|
|
BEQ GBYTE1
|
| 822 |
|
|
CMP.B #'A',D0
|
| 823 |
|
|
BCS GBYTE2
|
| 824 |
|
|
SUBQ.B #7,D0 ; if greater than 9, adjust
|
| 825 |
|
|
GBYTE2:
|
| 826 |
|
|
AND.B #0xF,D0 ;strip ASCII
|
| 827 |
|
|
LSL.B #4,D1 ;put nybble into the result
|
| 828 |
|
|
OR.B D0,D1
|
| 829 |
|
|
DBRA D2,GBYTE1 ;get another char.
|
| 830 |
|
|
RTS
|
| 831 |
|
|
|
| 832 |
|
|
SAVE:
|
| 833 |
|
|
MOVE.L TXTBGN,A0; set pointer to start of prog. area
|
| 834 |
|
|
MOVE.L TXTUNF,A1 ;set pointer to end of prog. area
|
| 835 |
|
|
SAVE1:
|
| 836 |
|
|
MOVE.B #CR,D0 ; send out a CR & LF (CP/M likes this)
|
| 837 |
|
|
BSR GOAUXO
|
| 838 |
|
|
MOVE.B #LF,D0
|
| 839 |
|
|
BSR GOAUXO
|
| 840 |
|
|
CMP.L A0,A1 ;are we finished?
|
| 841 |
|
|
BLS SAVEND
|
| 842 |
|
|
MOVE.B #':',D0 ; if not, start a line
|
| 843 |
|
|
BSR GOAUXO
|
| 844 |
|
|
MOVE.B (A0)+,D1 ;send first half of line no.
|
| 845 |
|
|
BSR PBYTE
|
| 846 |
|
|
MOVE.B (A0)+,D1 ;and send 2nd half
|
| 847 |
|
|
BSR PBYTE
|
| 848 |
|
|
SAVE2:
|
| 849 |
|
|
MOVE.B (A0)+,D0; get a text char.
|
| 850 |
|
|
CMP.B #CR,D0 ;is it the end of the line?
|
| 851 |
|
|
BEQ SAVE1 ;if so, send CR & LF and start new line
|
| 852 |
|
|
BSR GOAUXO ;send it out
|
| 853 |
|
|
BRA SAVE2 ;go back for more text
|
| 854 |
|
|
SAVEND:
|
| 855 |
|
|
MOVE.B #'@',D0 ; send end-of-program indicator
|
| 856 |
|
|
BSR GOAUXO
|
| 857 |
|
|
MOVE.B #CR,D0 ; followed by a CR & LF
|
| 858 |
|
|
BSR GOAUXO
|
| 859 |
|
|
MOVE.B #LF,D0
|
| 860 |
|
|
BSR GOAUXO
|
| 861 |
|
|
MOVE.B #0x1A,D0 ;and a control-Z to end the CP/M file
|
| 862 |
|
|
BSR GOAUXO
|
| 863 |
|
|
BRA WSTART ;then go do a warm start
|
| 864 |
|
|
|
| 865 |
|
|
PBYTE:
|
| 866 |
|
|
MOVEQ #1,D2 ; send two hex characters from D1's low byte
|
| 867 |
|
|
PBYTE1:
|
| 868 |
|
|
ROL.B #4,D1 ; get the next nybble
|
| 869 |
|
|
MOVE.B D1,D0
|
| 870 |
|
|
AND.B #0xF,D0 ; strip off garbage
|
| 871 |
|
|
ADD.B #'0',D0 ; make it into ASCII
|
| 872 |
|
|
CMP.B #'9',D0
|
| 873 |
|
|
BLS PBYTE2
|
| 874 |
|
|
ADDQ.B #7,D0 ;adjust if greater than 9
|
| 875 |
|
|
PBYTE2:
|
| 876 |
|
|
BSR GOAUXO ;send it out
|
| 877 |
|
|
DBRA D2,PBYTE1 ;then send the next nybble
|
| 878 |
|
|
RTS
|
| 879 |
|
|
|
| 880 |
|
|
;*
|
| 881 |
|
|
;*******************************************************************
|
| 882 |
|
|
;*
|
| 883 |
|
|
;* *** POKE *** & CALL ***
|
| 884 |
|
|
;*
|
| 885 |
|
|
;* 'POKE expr1,expr2' stores the byte from 'expr2' into the memory
|
| 886 |
|
|
;* address specified by 'expr1'.
|
| 887 |
|
|
;*
|
| 888 |
|
|
;* 'CALL expr' jumps to the machine language subroutine whose
|
| 889 |
|
|
;* starting address is specified by 'expr'. The subroutine can use
|
| 890 |
|
|
;* all registers but must leave the stack the way it found it.
|
| 891 |
|
|
;* The subroutine returns to the interpreter by executing an RTS.
|
| 892 |
|
|
;*
|
| 893 |
|
|
POKE:
|
| 894 |
|
|
BSR EXPR ;get the memory address
|
| 895 |
|
|
BSR.L TSTC ;it must be followed by a comma
|
| 896 |
|
|
DC.B ',',PKER-$
|
| 897 |
|
|
MOVE.L D0,-(SP) ;save the address
|
| 898 |
|
|
BSR EXPR ;get the byte to be POKE'd
|
| 899 |
|
|
MOVE.L (SP)+,A1 ;get the address back
|
| 900 |
|
|
MOVE.B D0,(A1) ;store the byte in memory
|
| 901 |
|
|
BRA FINISH
|
| 902 |
|
|
PKER:
|
| 903 |
|
|
BRA.L QWHAT ; if no comma, say "What?"
|
| 904 |
|
|
|
| 905 |
|
|
;*
|
| 906 |
|
|
;*******************************************************************
|
| 907 |
|
|
;* Graphics Commands added R. Finch
|
| 908 |
|
|
|
| 909 |
|
|
POINT:
|
| 910 |
|
|
BSR EXPR
|
| 911 |
|
|
BSR TSTC
|
| 912 |
|
|
DC.B ',',PKER-$
|
| 913 |
|
|
MOVE.L D0,-(SP)
|
| 914 |
|
|
BSR EXPR
|
| 915 |
|
|
MOVE.L (SP)+,D1
|
| 916 |
|
|
MOVE.L D0,D2
|
| 917 |
|
|
BSR DrawPixel
|
| 918 |
|
|
BRA FINISH
|
| 919 |
|
|
|
| 920 |
|
|
PENCOLOR:
|
| 921 |
|
|
BSR EXPR
|
| 922 |
|
|
MOVE.L d0,GRAPHICS
|
| 923 |
|
|
BRA FINISH
|
| 924 |
|
|
FILLCOLOR:
|
| 925 |
|
|
BSR EXPR
|
| 926 |
|
|
MOVE.L d0,GRAPHICS+4
|
| 927 |
|
|
BRA FINISH
|
| 928 |
|
|
|
| 929 |
|
|
SPRPOS:
|
| 930 |
|
|
BSR EXPR
|
| 931 |
|
|
BSR TSTC
|
| 932 |
|
|
DC.B ',',LINEERR1-$
|
| 933 |
|
|
MOVE.L D0,-(SP)
|
| 934 |
|
|
BSR EXPR
|
| 935 |
|
|
BSR TSTC
|
| 936 |
|
|
DC.B ',',LINEERR2-$
|
| 937 |
|
|
MOVE.L D0,-(SP)
|
| 938 |
|
|
BSR EXPR
|
| 939 |
|
|
MOVE.L D1,-(SP)
|
| 940 |
|
|
MOVE.L 8(SP),D1 ; D1 = sprite number
|
| 941 |
|
|
ANDI.L #7,D1
|
| 942 |
|
|
ASL.L #4,D1 ; D1 * 16
|
| 943 |
|
|
ADD.L #SPRCTRL,D1 ; D1 = register base
|
| 944 |
|
|
MOVE.L A1,-(SP) ; save off A1
|
| 945 |
|
|
MOVE.L D1,A1 ; A1 = register base
|
| 946 |
|
|
MOVE.W D0,2(A1) ; set Y position
|
| 947 |
|
|
MOVE.L 8(SP),D0
|
| 948 |
|
|
MOVE.W D0,0(A1) ; set X position
|
| 949 |
|
|
MOVE.L (SP)+,A1 ; get back A1
|
| 950 |
|
|
MOVE.L (SP)+,D1 ; get D1 back
|
| 951 |
|
|
ADD.L #8,SP ; pop stack
|
| 952 |
|
|
BRA FINISH
|
| 953 |
|
|
|
| 954 |
|
|
LINE:
|
| 955 |
|
|
BSR EXPR
|
| 956 |
|
|
BSR TSTC
|
| 957 |
|
|
DC.B ',',LINEERR1-$
|
| 958 |
|
|
MOVE.L D0,-(SP)
|
| 959 |
|
|
BSR EXPR
|
| 960 |
|
|
BSR TSTC
|
| 961 |
|
|
DC.B ',',LINEERR2-$
|
| 962 |
|
|
MOVE.L D0,-(SP)
|
| 963 |
|
|
BSR EXPR
|
| 964 |
|
|
BSR TSTC
|
| 965 |
|
|
DC.B ',',LINEERR3-$
|
| 966 |
|
|
MOVE.L D0,-(SP)
|
| 967 |
|
|
BSR EXPR
|
| 968 |
|
|
MOVE.W d0,GRAPHICS+14
|
| 969 |
|
|
MOVE.L (SP)+,d0
|
| 970 |
|
|
MOVE.W d0,GRAPHICS+12
|
| 971 |
|
|
MOVE.L (SP)+,d0
|
| 972 |
|
|
MOVE.W d0,GRAPHICS+10
|
| 973 |
|
|
MOVE.L (SP)+,d0
|
| 974 |
|
|
MOVE.W d0,GRAPHICS+8
|
| 975 |
|
|
MOVE.W #G_DRAWLINE,GRAPHICS+30
|
| 976 |
|
|
BRA FINISH
|
| 977 |
|
|
|
| 978 |
|
|
LINEERR1:
|
| 979 |
|
|
BRA.L QWHAT
|
| 980 |
|
|
LINEERR2:
|
| 981 |
|
|
ADDQ #4,SP
|
| 982 |
|
|
BRA.L QWHAT
|
| 983 |
|
|
LINEERR3:
|
| 984 |
|
|
ADD.L #8,SP
|
| 985 |
|
|
BRA.L QWHAT
|
| 986 |
|
|
|
| 987 |
|
|
;*
|
| 988 |
|
|
;*******************************************************************
|
| 989 |
|
|
;*
|
| 990 |
|
|
CALL:
|
| 991 |
|
|
BSR EXPR ;get the subroutine's address
|
| 992 |
|
|
TST.L D0 ;make sure we got a valid address
|
| 993 |
|
|
BEQ.L QHOW ; if not, say "How?"
|
| 994 |
|
|
MOVE.L A0,-(SP); save the text pointer
|
| 995 |
|
|
MOVE.L D0,A1
|
| 996 |
|
|
JSR (A1) ;jump to the subroutine
|
| 997 |
|
|
MOVE.L (SP)+,A0 ;restore the text pointer
|
| 998 |
|
|
BRA FINISH
|
| 999 |
|
|
;*
|
| 1000 |
|
|
;*******************************************************************
|
| 1001 |
|
|
;*
|
| 1002 |
|
|
;* *** EXPR ***
|
| 1003 |
|
|
;*
|
| 1004 |
|
|
;* 'EXPR' evaluates arithmetical or logical expressions.
|
| 1005 |
|
|
;* ::=
|
| 1006 |
|
|
;*
|
| 1007 |
|
|
;* where is one of the operators in TAB8 and the result
|
| 1008 |
|
|
;* of these operations is 1 if true and 0 if false.
|
| 1009 |
|
|
;* ::=(+,-,&,|)(+,-,&,|)(...
|
| 1010 |
|
|
;* where () are optional and (... are optional repeats.
|
| 1011 |
|
|
;* ::=( <* or /> )(...
|
| 1012 |
|
|
;* ::=
|
| 1013 |
|
|
;*
|
| 1014 |
|
|
;* ()
|
| 1015 |
|
|
;* is recursive so that the variable '@' can have an
|
| 1016 |
|
|
;* as an index, functions can have an as arguments, and
|
| 1017 |
|
|
;* can be an in parenthesis.
|
| 1018 |
|
|
;*
|
| 1019 |
|
|
EXPR:
|
| 1020 |
|
|
BSR EXPR2
|
| 1021 |
|
|
MOVE.L D0,-(SP); save value
|
| 1022 |
|
|
LEA TAB8,A1 ;look up a relational operator
|
| 1023 |
|
|
LEA TAB8_1,A2
|
| 1024 |
|
|
BRA EXEC ;go do it
|
| 1025 |
|
|
|
| 1026 |
|
|
XP11:
|
| 1027 |
|
|
BSR XP18 ; is it ">="?
|
| 1028 |
|
|
BLT XPRT0 ;no, return D0=0
|
| 1029 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1030 |
|
|
|
| 1031 |
|
|
XP12:
|
| 1032 |
|
|
BSR XP18 ; is it "<>"?
|
| 1033 |
|
|
BEQ XPRT0 ;no, return D0=0
|
| 1034 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1035 |
|
|
|
| 1036 |
|
|
XP13:
|
| 1037 |
|
|
BSR XP18 ; is it ">"?
|
| 1038 |
|
|
BLE XPRT0 ;no, return D0=0
|
| 1039 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1040 |
|
|
|
| 1041 |
|
|
XP14:
|
| 1042 |
|
|
BSR XP18 ; is it "<="?
|
| 1043 |
|
|
BGT XPRT0 ;no, return D0=0
|
| 1044 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1045 |
|
|
|
| 1046 |
|
|
XP15:
|
| 1047 |
|
|
BSR XP18 ; is it "="?
|
| 1048 |
|
|
BNE XPRT0 ;if not, return D0=0
|
| 1049 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1050 |
|
|
XP15RT:
|
| 1051 |
|
|
RTS
|
| 1052 |
|
|
|
| 1053 |
|
|
XP16:
|
| 1054 |
|
|
BSR XP18 ; is it "<"?
|
| 1055 |
|
|
BGE XPRT0 ;if not, return D0=0
|
| 1056 |
|
|
BRA XPRT1 ;else return D0=1
|
| 1057 |
|
|
XP16RT:
|
| 1058 |
|
|
RTS
|
| 1059 |
|
|
|
| 1060 |
|
|
XPRT0:
|
| 1061 |
|
|
CLR.L D0 ; return D0=0 (false)
|
| 1062 |
|
|
RTS
|
| 1063 |
|
|
|
| 1064 |
|
|
XPRT1:
|
| 1065 |
|
|
MOVEQ #1,D0; return D0=1 (true)
|
| 1066 |
|
|
RTS
|
| 1067 |
|
|
|
| 1068 |
|
|
XP17:
|
| 1069 |
|
|
MOVE.L (SP)+,D0 ;it's not a rel. operator
|
| 1070 |
|
|
RTS ;return D0=
|
| 1071 |
|
|
|
| 1072 |
|
|
XP18:
|
| 1073 |
|
|
MOVE.L (SP)+,D0 ;reverse the top two stack items
|
| 1074 |
|
|
MOVE.L (SP)+,D1
|
| 1075 |
|
|
MOVE.L D0,-(SP)
|
| 1076 |
|
|
MOVE.L D1,-(SP)
|
| 1077 |
|
|
BSR EXPR2 ;do second
|
| 1078 |
|
|
MOVE.L (SP)+,D1
|
| 1079 |
|
|
CMP.L D0,D1 ; compare with the first result
|
| 1080 |
|
|
RTS ;return the result
|
| 1081 |
|
|
|
| 1082 |
|
|
EXPR2:
|
| 1083 |
|
|
BSR.L TSTC ;negative sign?
|
| 1084 |
|
|
DC.B '-',XP20-$
|
| 1085 |
|
|
CLR.L D0 ; yes, fake '0-'
|
| 1086 |
|
|
BRA XP26
|
| 1087 |
|
|
XP20:
|
| 1088 |
|
|
BSR.L TSTC
|
| 1089 |
|
|
DC.B '!',XP21-$
|
| 1090 |
|
|
CLR.L D0
|
| 1091 |
|
|
MOVE.L D0,-(SP)
|
| 1092 |
|
|
BSR EXPR3
|
| 1093 |
|
|
NOT.L D0
|
| 1094 |
|
|
JMP XP24
|
| 1095 |
|
|
XP21:
|
| 1096 |
|
|
BSR.L TSTC ; positive sign? ignore it
|
| 1097 |
|
|
DC.B '+',XP22-$
|
| 1098 |
|
|
XP22:
|
| 1099 |
|
|
BSR EXPR3 ;first
|
| 1100 |
|
|
XP23:
|
| 1101 |
|
|
BSR.L TSTC ; add?
|
| 1102 |
|
|
DC.B '+',XP25-$
|
| 1103 |
|
|
MOVE.L D0,-(SP) ;yes, save the value
|
| 1104 |
|
|
BSR EXPR3 ;get the second
|
| 1105 |
|
|
XP24:
|
| 1106 |
|
|
MOVE.L (SP)+,D1
|
| 1107 |
|
|
ADD.L D1,D0 ; add it to the first
|
| 1108 |
|
|
BVS.L QHOW ; branch if there's an overflow
|
| 1109 |
|
|
BRA XP23 ; else go back for more operations
|
| 1110 |
|
|
XP25:
|
| 1111 |
|
|
BSR.L TSTC ;subtract?
|
| 1112 |
|
|
DC.B '-',XP27-$ ; was XP42-$
|
| 1113 |
|
|
XP26:
|
| 1114 |
|
|
MOVE.L D0,-(SP) ;yes, save the result of 1st
|
| 1115 |
|
|
BSR EXPR3 ;get second
|
| 1116 |
|
|
NEG.L D0 ;change its sign
|
| 1117 |
|
|
JMP XP24 ;and do an addition
|
| 1118 |
|
|
XP27:
|
| 1119 |
|
|
BSR.L TSTC
|
| 1120 |
|
|
DC.B '&',XP28-$
|
| 1121 |
|
|
MOVE.L D0,-(SP)
|
| 1122 |
|
|
BSR EXPR3
|
| 1123 |
|
|
MOVE.L (SP)+,D1
|
| 1124 |
|
|
AND.L D1,D0
|
| 1125 |
|
|
BRA XP23
|
| 1126 |
|
|
XP28:
|
| 1127 |
|
|
BSR.L TSTC
|
| 1128 |
|
|
DC.B '|',XP42-$
|
| 1129 |
|
|
MOVE.L D0,-(SP)
|
| 1130 |
|
|
BSR EXPR3
|
| 1131 |
|
|
MOVE.L (SP)+,D1
|
| 1132 |
|
|
OR.L D1,D0
|
| 1133 |
|
|
BRA XP23
|
| 1134 |
|
|
|
| 1135 |
|
|
EXPR3:
|
| 1136 |
|
|
BSR EXPR4 ;get first
|
| 1137 |
|
|
XP31:
|
| 1138 |
|
|
BSR.L TSTC ; multiply?
|
| 1139 |
|
|
DC.B '*',XP34-$
|
| 1140 |
|
|
MOVE.L D0,-(SP); yes, save that first result
|
| 1141 |
|
|
BSR EXPR4 ;get second
|
| 1142 |
|
|
MOVE.L (SP)+,D1
|
| 1143 |
|
|
BSR.L MULT32 ; multiply the two
|
| 1144 |
|
|
BRA XP31 ;then look for more terms
|
| 1145 |
|
|
XP34:
|
| 1146 |
|
|
BSR.L TSTC; divide?
|
| 1147 |
|
|
DC.B '/',XP42-$
|
| 1148 |
|
|
MOVE.L D0,-(SP); save result of 1st
|
| 1149 |
|
|
BSR EXPR4 ;get second
|
| 1150 |
|
|
MOVE.L (SP)+,D1
|
| 1151 |
|
|
EXG D0,D1
|
| 1152 |
|
|
BSR.L DIV32 ; do the division
|
| 1153 |
|
|
BRA XP31 ;go back for any more terms
|
| 1154 |
|
|
|
| 1155 |
|
|
EXPR4:
|
| 1156 |
|
|
LEA TAB4,A1 ; find possible function
|
| 1157 |
|
|
LEA TAB4_1,A2
|
| 1158 |
|
|
BRA EXEC
|
| 1159 |
|
|
XP40:
|
| 1160 |
|
|
BSR TSTV ; nope, not a function
|
| 1161 |
|
|
BCS XP41 ;nor a variable
|
| 1162 |
|
|
MOVE.L D0,A1
|
| 1163 |
|
|
CLR.L D0
|
| 1164 |
|
|
MOVE.L (A1),D0 ; if a variable, return its value in D0
|
| 1165 |
|
|
EXP4RT:
|
| 1166 |
|
|
RTS
|
| 1167 |
|
|
XP41:
|
| 1168 |
|
|
BSR.L TSTNUM ; or is it a number?
|
| 1169 |
|
|
MOVE.L D1,D0
|
| 1170 |
|
|
TST D2 ;(if not, # of digits will be zero)
|
| 1171 |
|
|
BNE EXP4RT ; if so, return it in D0
|
| 1172 |
|
|
PARN:
|
| 1173 |
|
|
BSR.L TSTC ; else look for ( EXPR )
|
| 1174 |
|
|
DC.B '(',XP43-$
|
| 1175 |
|
|
BSR EXPR
|
| 1176 |
|
|
BSR.L TSTC
|
| 1177 |
|
|
DC.B ')',XP43-$
|
| 1178 |
|
|
XP42:
|
| 1179 |
|
|
RTS
|
| 1180 |
|
|
XP43:
|
| 1181 |
|
|
BRA.L QWHAT ; else say "What?"
|
| 1182 |
|
|
|
| 1183 |
|
|
;*
|
| 1184 |
|
|
;* ===== Test for a valid variable name. Returns Carry=1 if not
|
| 1185 |
|
|
;* found, else returns Carry=0 and the address of the
|
| 1186 |
|
|
;* variable in D0.
|
| 1187 |
|
|
|
| 1188 |
|
|
TSTV:
|
| 1189 |
|
|
BSR.L IGNBLK
|
| 1190 |
|
|
CLR.L D0
|
| 1191 |
|
|
MOVE.B (A0),D0 ; look at the program text
|
| 1192 |
|
|
SUB.B #'@',D0
|
| 1193 |
|
|
BCS TSTVRT ; C=1: not a variable
|
| 1194 |
|
|
BNE TV1 ;branch if not "@" array
|
| 1195 |
|
|
ADDQ #1,A0 ; If it is, it should be
|
| 1196 |
|
|
BSR PARN ;followed by (EXPR) as its index.
|
| 1197 |
|
|
ADD.L D0,D0
|
| 1198 |
|
|
BCS.L QHOW ; say "How?" if index is too big
|
| 1199 |
|
|
ADD.L D0,D0
|
| 1200 |
|
|
BCS.L QHOW
|
| 1201 |
|
|
MOVE.L D0,-(SP) ;save the index
|
| 1202 |
|
|
BSR.L SIZE_ ;get amount of free memory
|
| 1203 |
|
|
MOVE.L (SP)+,D1 ;get back the index
|
| 1204 |
|
|
CMP.L D1,D0 ;see if there's enough memory
|
| 1205 |
|
|
BLS.L QSORRY ;if not, say "Sorry"
|
| 1206 |
|
|
MOVE.L VARBGN,D0 ;put address of array element...
|
| 1207 |
|
|
SUB.L D1,D0 ;into D0
|
| 1208 |
|
|
RTS
|
| 1209 |
|
|
TV1:
|
| 1210 |
|
|
CMP.B #27,D0 ;if not @, is it A through Z?
|
| 1211 |
|
|
EOR #1,CCR
|
| 1212 |
|
|
BCS TSTVRT ;if not, set Carry and return
|
| 1213 |
|
|
ADDQ #1,A0 ; else bump the text pointer
|
| 1214 |
|
|
;
|
| 1215 |
|
|
CLR.L D1
|
| 1216 |
|
|
MOVE.B (a0),D1
|
| 1217 |
|
|
BSR CVT26
|
| 1218 |
|
|
cmpi.b #0xff,d1
|
| 1219 |
|
|
beq tv2
|
| 1220 |
|
|
ADDQ #1,A0 ; bump text pointer
|
| 1221 |
|
|
asl.l #5,D1
|
| 1222 |
|
|
ADD.L D1,D0
|
| 1223 |
|
|
tv2:
|
| 1224 |
|
|
ADD D0,D0 ;compute the variable's address
|
| 1225 |
|
|
ADD D0,D0
|
| 1226 |
|
|
MOVE.L VARBGN,D1
|
| 1227 |
|
|
ADD D1,D0 ;and return it in D0 with Carry=0
|
| 1228 |
|
|
TSTVRT:
|
| 1229 |
|
|
RTS
|
| 1230 |
|
|
|
| 1231 |
|
|
CVT26:
|
| 1232 |
|
|
cmpi.b #'A',d1
|
| 1233 |
|
|
blo CVT26a
|
| 1234 |
|
|
cmpi.b #'Z',d1
|
| 1235 |
|
|
bhi CVT26a
|
| 1236 |
|
|
subi.b #'A',d1
|
| 1237 |
|
|
rts
|
| 1238 |
|
|
CVT26a:
|
| 1239 |
|
|
moveq #-1,d1
|
| 1240 |
|
|
rts
|
| 1241 |
|
|
;*
|
| 1242 |
|
|
;* ===== Multiplies the 32 bit values in D0 and D1, returning
|
| 1243 |
|
|
;* the 32 bit result in D0.
|
| 1244 |
|
|
;*
|
| 1245 |
|
|
MULT32:
|
| 1246 |
|
|
MOVE.L D1,D4
|
| 1247 |
|
|
EOR.L D0,D4 ; see if the signs are the same
|
| 1248 |
|
|
TST.L D0 ;take absolute value of D0
|
| 1249 |
|
|
BPL MLT1
|
| 1250 |
|
|
NEG.L D0
|
| 1251 |
|
|
MLT1:
|
| 1252 |
|
|
TST.L D1 ; take absolute value of D1
|
| 1253 |
|
|
BPL MLT2
|
| 1254 |
|
|
NEG.L D1
|
| 1255 |
|
|
MLT2:
|
| 1256 |
|
|
CMP.L #0xFFFF,D1 ;is second argument <= 16 bits?
|
| 1257 |
|
|
BLS MLT3 ; OK, let it through
|
| 1258 |
|
|
EXG D0,D1 ; else swap the two arguments
|
| 1259 |
|
|
CMP.L #0xFFFF,D1 ;and check 2nd argument again
|
| 1260 |
|
|
BHI.L QHOW ;one of them MUST be 16 bits
|
| 1261 |
|
|
MLT3:
|
| 1262 |
|
|
MOVE D0,D2 ; prepare for 32 bit X 16 bit multiply
|
| 1263 |
|
|
MULU D1,D2 ;multiply low word
|
| 1264 |
|
|
SWAP D0
|
| 1265 |
|
|
MULU D1,D0 ;multiply high word
|
| 1266 |
|
|
SWAP D0
|
| 1267 |
|
|
;*** Rick Murray's bug correction follows:
|
| 1268 |
|
|
TST D0 ;if lower word not 0, then overflow
|
| 1269 |
|
|
BNE.L QHOW ; if overflow, say "How?"
|
| 1270 |
|
|
ADD.L D2,D0 ; D0 now holds the product
|
| 1271 |
|
|
BMI.L QHOW ; if sign bit set, it's an overflow
|
| 1272 |
|
|
TST.L D4 ;were the signs the same?
|
| 1273 |
|
|
BPL MLTRET
|
| 1274 |
|
|
NEG.L D0 ;if not, make the result negative
|
| 1275 |
|
|
MLTRET:
|
| 1276 |
|
|
RTS
|
| 1277 |
|
|
|
| 1278 |
|
|
;*
|
| 1279 |
|
|
;* ===== Divide the 32 bit value in D0 by the 32 bit value in D1.
|
| 1280 |
|
|
;* Returns the 32 bit quotient in D0, remainder in D1.
|
| 1281 |
|
|
;*
|
| 1282 |
|
|
DIV32:
|
| 1283 |
|
|
TST.L D1 ;check for divide-by-zero
|
| 1284 |
|
|
BEQ.L QHOW ;if so, say "How?"
|
| 1285 |
|
|
MOVE.L D1,D2
|
| 1286 |
|
|
MOVE.L D1,D4
|
| 1287 |
|
|
EOR.L D0,D4 ;see if the signs are the same
|
| 1288 |
|
|
TST.L D0 ;take absolute value of D0
|
| 1289 |
|
|
BPL DIV1
|
| 1290 |
|
|
NEG.L D0
|
| 1291 |
|
|
DIV1:
|
| 1292 |
|
|
TST.L D1 ; take absolute value of D1
|
| 1293 |
|
|
BPL DIV2
|
| 1294 |
|
|
NEG.L D1
|
| 1295 |
|
|
DIV2:
|
| 1296 |
|
|
MOVEQ #31,D3 ; iteration count for 32 bits
|
| 1297 |
|
|
MOVE.L D0,D1
|
| 1298 |
|
|
CLR.L D0
|
| 1299 |
|
|
DIV3:
|
| 1300 |
|
|
ADD.L D1,D1 ; (This algorithm was translated from
|
| 1301 |
|
|
ADDX.L D0,D0 ;the divide routine in Ron Cain's
|
| 1302 |
|
|
BEQ DIV4 ;Small-C run time library.)
|
| 1303 |
|
|
CMP.L D2,D0
|
| 1304 |
|
|
BMI DIV4
|
| 1305 |
|
|
ADDQ.L #1,D1
|
| 1306 |
|
|
SUB.L D2,D0
|
| 1307 |
|
|
DIV4:
|
| 1308 |
|
|
DBRA D3,DIV3
|
| 1309 |
|
|
EXG D0,D1 ; put rem. & quot. in proper registers
|
| 1310 |
|
|
TST.L D4 ; were the signs the same?
|
| 1311 |
|
|
BPL DIVRT
|
| 1312 |
|
|
NEG.L D0 ; if not, results are negative
|
| 1313 |
|
|
NEG.L D1
|
| 1314 |
|
|
DIVRT:
|
| 1315 |
|
|
RTS
|
| 1316 |
|
|
|
| 1317 |
|
|
;*
|
| 1318 |
|
|
;* ===== The PEEK function returns the byte stored at the address
|
| 1319 |
|
|
;* contained in the following expression.
|
| 1320 |
|
|
;*
|
| 1321 |
|
|
PEEK:
|
| 1322 |
|
|
BSR PARN ; get the memory address
|
| 1323 |
|
|
MOVE.L D0,A1
|
| 1324 |
|
|
CLR.L D0 ;upper 3 bytes will be zero
|
| 1325 |
|
|
MOVE.B (A1),D0 ; get the addressed byte
|
| 1326 |
|
|
RTS ;and return it
|
| 1327 |
|
|
|
| 1328 |
|
|
;*
|
| 1329 |
|
|
;* ===== The RND function returns a random number from 1 to
|
| 1330 |
|
|
;* the value of the following expression in D0.
|
| 1331 |
|
|
;* Uses hardware rand# generator R. Finch
|
| 1332 |
|
|
RND:
|
| 1333 |
|
|
BSR PARN ; get the upper limit
|
| 1334 |
|
|
TST.L D0 ; it must be positive and non-zero
|
| 1335 |
|
|
BEQ.L QHOW
|
| 1336 |
|
|
BMI.L QHOW
|
| 1337 |
|
|
MOVE.L D0,D1
|
| 1338 |
|
|
MOVE.W RANDOM+2,D0
|
| 1339 |
|
|
SWAP D0
|
| 1340 |
|
|
MOVE.W RANDOM,D0
|
| 1341 |
|
|
BCLR #31,D0 ; make sure it's positive
|
| 1342 |
|
|
BSR DIV32 ;RND(n)=MOD(number,n)+1
|
| 1343 |
|
|
MOVE.L D1,D0 ; MOD is the remainder of the div.
|
| 1344 |
|
|
ADDQ.L #1,D0
|
| 1345 |
|
|
RTS
|
| 1346 |
|
|
|
| 1347 |
|
|
;*
|
| 1348 |
|
|
;* ===== The ABS function returns an absolute value in D0.
|
| 1349 |
|
|
;*
|
| 1350 |
|
|
ABS:
|
| 1351 |
|
|
BSR PARN ;get the following expr.'s value
|
| 1352 |
|
|
TST.L D0
|
| 1353 |
|
|
BPL ABSRT
|
| 1354 |
|
|
NEG.L D0 ;if negative, complement it
|
| 1355 |
|
|
BMI.L QHOW ; if still negative, it was too big
|
| 1356 |
|
|
ABSRT:
|
| 1357 |
|
|
RTS
|
| 1358 |
|
|
|
| 1359 |
|
|
;* RTF
|
| 1360 |
|
|
;* ===== The SGN function returns the sign value in D0.
|
| 1361 |
|
|
;*
|
| 1362 |
|
|
SGN:
|
| 1363 |
|
|
BSR PARN ;get the following expr.'s value
|
| 1364 |
|
|
TST.L D0
|
| 1365 |
|
|
BEQ SGNRT
|
| 1366 |
|
|
BMI SGNMI
|
| 1367 |
|
|
MOVEQ #1,d0
|
| 1368 |
|
|
SGNRT:
|
| 1369 |
|
|
RTS
|
| 1370 |
|
|
SGNMI:
|
| 1371 |
|
|
MOVEQ #-1,d0
|
| 1372 |
|
|
RTS
|
| 1373 |
|
|
|
| 1374 |
|
|
;*
|
| 1375 |
|
|
;* ===== The SIZE function returns the size of free memory in D0.
|
| 1376 |
|
|
;*
|
| 1377 |
|
|
SIZE_:
|
| 1378 |
|
|
MOVE.L VARBGN,D0 ;get the number of free bytes...
|
| 1379 |
|
|
SUB.L TXTUNF,D0 ;between 'TXTUNF' and 'VARBGN'
|
| 1380 |
|
|
RTS ;return the number in D0
|
| 1381 |
|
|
|
| 1382 |
|
|
;* RTF
|
| 1383 |
|
|
;* ===== return the millisecond time value
|
| 1384 |
|
|
;*
|
| 1385 |
|
|
TICK:
|
| 1386 |
|
|
move.l Milliseconds,d0
|
| 1387 |
|
|
rts
|
| 1388 |
|
|
|
| 1389 |
|
|
TEMP:
|
| 1390 |
|
|
bsr ReadTemp
|
| 1391 |
|
|
andi.l #0xffff,d0
|
| 1392 |
|
|
rts
|
| 1393 |
|
|
|
| 1394 |
|
|
;*
|
| 1395 |
|
|
;*******************************************************************
|
| 1396 |
|
|
;*
|
| 1397 |
|
|
;* *** SETVAL *** FIN *** ENDCHK *** ERROR (& friends) ***
|
| 1398 |
|
|
;*
|
| 1399 |
|
|
;* 'SETVAL' expects a variable, followed by an equal sign and then
|
| 1400 |
|
|
;* an expression. It evaluates the expression and sets the variable
|
| 1401 |
|
|
;* to that value.
|
| 1402 |
|
|
;*
|
| 1403 |
|
|
;* 'FIN' checks the end of a command. If it ended with ":",
|
| 1404 |
|
|
;* execution continues. If it ended with a CR, it finds the
|
| 1405 |
|
|
;* the next line and continues from there.
|
| 1406 |
|
|
;*
|
| 1407 |
|
|
;* 'ENDCHK' checks if a command is ended with a CR. This is
|
| 1408 |
|
|
;* required in certain commands, such as GOTO, RETURN, STOP, etc.
|
| 1409 |
|
|
;*
|
| 1410 |
|
|
;* 'ERROR' prints the string pointed to by A0. It then prints the
|
| 1411 |
|
|
;* line pointed to by CURRNT with a "?" inserted at where the
|
| 1412 |
|
|
;* old text pointer (should be on top of the stack) points to.
|
| 1413 |
|
|
;* Execution of Tiny BASIC is stopped and a warm start is done.
|
| 1414 |
|
|
;* If CURRNT is zero (indicating a direct command), the direct
|
| 1415 |
|
|
;* command is not printed. If CURRNT is -1 (indicating
|
| 1416 |
|
|
;* 'INPUT' command in progress), the input line is not printed
|
| 1417 |
|
|
;* and execution is not terminated but continues at 'INPERR'.
|
| 1418 |
|
|
;*
|
| 1419 |
|
|
;* Related to 'ERROR' are the following:
|
| 1420 |
|
|
;* 'QWHAT' saves text pointer on stack and gets "What?" message.
|
| 1421 |
|
|
;* 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
|
| 1422 |
|
|
;* 'QSORRY' and 'ASORRY' do the same kind of thing.
|
| 1423 |
|
|
;* 'QHOW' and 'AHOW' also do this for "How?".
|
| 1424 |
|
|
;*
|
| 1425 |
|
|
SETVAL:
|
| 1426 |
|
|
BSR TSTV ; variable name?
|
| 1427 |
|
|
BCS QWHAT ;if not, say "What?"
|
| 1428 |
|
|
MOVE.L D0,-(SP); save the variable's address
|
| 1429 |
|
|
BSR.L TSTC ; get past the "=" sign
|
| 1430 |
|
|
DC.B '=',SV1-$
|
| 1431 |
|
|
BSR EXPR ; evaluate the expression
|
| 1432 |
|
|
MOVE.L (SP)+,A6
|
| 1433 |
|
|
MOVE.L D0,(A6) ; and save its value in the variable
|
| 1434 |
|
|
RTS
|
| 1435 |
|
|
SV1:
|
| 1436 |
|
|
BRA QWHAT ; if no "=" sign
|
| 1437 |
|
|
|
| 1438 |
|
|
FIN:
|
| 1439 |
|
|
BSR.L TSTC ; *** FIN ***
|
| 1440 |
|
|
DC.B ':',FI1-$
|
| 1441 |
|
|
ADDQ.L #4,SP ; if ":", discard return address
|
| 1442 |
|
|
BRA RUNSML ; continue on the same line
|
| 1443 |
|
|
FI1:
|
| 1444 |
|
|
BSR.L TSTC ; not ":", is it a CR?
|
| 1445 |
|
|
DC.B CR,FI2-$
|
| 1446 |
|
|
ADDQ.L #4,SP ; yes, purge return address
|
| 1447 |
|
|
BRA RUNNXL ;execute the next line
|
| 1448 |
|
|
FI2:
|
| 1449 |
|
|
RTS ;else return to the caller
|
| 1450 |
|
|
|
| 1451 |
|
|
ENDCHK:
|
| 1452 |
|
|
BSR.L IGNBLK
|
| 1453 |
|
|
CMP.B #CR,(A0); does it end with a CR?
|
| 1454 |
|
|
BNE QWHAT ; if not, say "WHAT?"
|
| 1455 |
|
|
RTS
|
| 1456 |
|
|
|
| 1457 |
|
|
QWHAT:
|
| 1458 |
|
|
MOVE.L A0,-(SP)
|
| 1459 |
|
|
AWHAT:
|
| 1460 |
|
|
LEA WHTMSG,A6
|
| 1461 |
|
|
ERROR:
|
| 1462 |
|
|
BSR.L PRMESG ; display the error message
|
| 1463 |
|
|
MOVE.L (SP)+,A0 ;restore the text pointer
|
| 1464 |
|
|
MOVE.L CURRNT,D0 ;get the current line number
|
| 1465 |
|
|
BEQ WSTART ;if zero, do a warm start
|
| 1466 |
|
|
CMP.L #-1,D0 ;is the line no. pointer = -1?
|
| 1467 |
|
|
BEQ INPERR ;if so, redo input
|
| 1468 |
|
|
MOVE.B (A0),-(SP) ;save the char. pointed to
|
| 1469 |
|
|
CLR.B (A0) ;put a zero where the error is
|
| 1470 |
|
|
MOVE.L CURRNT,A1 ;point to start of current line
|
| 1471 |
|
|
BSR.L PRTLN ;display the line in error up to the 0
|
| 1472 |
|
|
MOVE.B (SP)+,(A0) ;restore the character
|
| 1473 |
|
|
MOVE.B #'?',D0 ; display a "?"
|
| 1474 |
|
|
BSR GOOUT
|
| 1475 |
|
|
CLR D0
|
| 1476 |
|
|
SUBQ.L #1,A1 ;point back to the error char.
|
| 1477 |
|
|
BSR.L PRTSTG ;display the rest of the line
|
| 1478 |
|
|
BRA WSTART ;and do a warm start
|
| 1479 |
|
|
QSORRY:
|
| 1480 |
|
|
MOVE.L A0,-(SP)
|
| 1481 |
|
|
ASORRY:
|
| 1482 |
|
|
LEA SRYMSG,A6
|
| 1483 |
|
|
BRA ERROR
|
| 1484 |
|
|
QHOW:
|
| 1485 |
|
|
MOVE.L A0,-(SP) ;Error: "How?"
|
| 1486 |
|
|
AHOW:
|
| 1487 |
|
|
LEA HOWMSG,A6
|
| 1488 |
|
|
BRA ERROR
|
| 1489 |
|
|
;*
|
| 1490 |
|
|
;*******************************************************************
|
| 1491 |
|
|
;*
|
| 1492 |
|
|
;* *** GETLN *** FNDLN (& friends) ***
|
| 1493 |
|
|
;*
|
| 1494 |
|
|
;* 'GETLN' reads in input line into 'BUFFER'. It first prompts with
|
| 1495 |
|
|
;* the character in D0 (given by the caller), then it fills the
|
| 1496 |
|
|
;* buffer and echos. It ignores LF's but still echos
|
| 1497 |
|
|
;* them back. Control-H is used to delete the last character
|
| 1498 |
|
|
;* entered (if there is one), and control-X is used to delete the
|
| 1499 |
|
|
;* whole line and start over again. CR signals the end of a line,
|
| 1500 |
|
|
;* and causes 'GETLN' to return.
|
| 1501 |
|
|
;*
|
| 1502 |
|
|
GETLN:
|
| 1503 |
|
|
BSR GOOUT ;display the prompt
|
| 1504 |
|
|
MOVE.B #' ',D0 ; and a space
|
| 1505 |
|
|
BSR GOOUT
|
| 1506 |
|
|
LEA BUFFER,A0; A0 is the buffer pointer
|
| 1507 |
|
|
GL1:
|
| 1508 |
|
|
BSR.L CHKIO; check keyboard
|
| 1509 |
|
|
BEQ GL1 ; wait for a char. to come in
|
| 1510 |
|
|
CMP.B #CTRLH,D0 ;delete last character?
|
| 1511 |
|
|
BEQ GL3 ; if so
|
| 1512 |
|
|
CMP.B #CTRLX,D0; delete the whole line?
|
| 1513 |
|
|
BEQ GL4 ; if so
|
| 1514 |
|
|
CMP.B #CR,D0 ; accept a CR
|
| 1515 |
|
|
BEQ GL2
|
| 1516 |
|
|
CMP.B #' ',D0 ; if other control char., discard it
|
| 1517 |
|
|
BCS GL1
|
| 1518 |
|
|
GL2:
|
| 1519 |
|
|
MOVE.B D0,(A0)+; save the char.
|
| 1520 |
|
|
BSR GOOUT ;echo the char back out
|
| 1521 |
|
|
CMP.B #CR,D0 ; if it's a CR, end the line
|
| 1522 |
|
|
BEQ GL7
|
| 1523 |
|
|
CMP.L #(BUFFER+BUFLEN-1),A0 ;any more room?
|
| 1524 |
|
|
BCS GL1 ; yes: get some more, else delete last char.
|
| 1525 |
|
|
GL3:
|
| 1526 |
|
|
MOVE.B #CTRLH,D0 ;delete a char. if possible
|
| 1527 |
|
|
BSR GOOUT
|
| 1528 |
|
|
MOVE.B #' ',D0
|
| 1529 |
|
|
BSR GOOUT
|
| 1530 |
|
|
CMP.L #BUFFER,A0 ;any char.'s left?
|
| 1531 |
|
|
BLS GL1 ;if not
|
| 1532 |
|
|
MOVE.B #CTRLH,D0; if so, finish the BS-space-BS sequence
|
| 1533 |
|
|
BSR GOOUT
|
| 1534 |
|
|
SUBQ.L #1,A0 ; decrement the text pointer
|
| 1535 |
|
|
BRA GL1 ;back for more
|
| 1536 |
|
|
GL4:
|
| 1537 |
|
|
MOVE.L A0,D1 ; delete the whole line
|
| 1538 |
|
|
SUB.L #BUFFER,D1; figure out how many backspaces we need
|
| 1539 |
|
|
BEQ GL6 ;if none needed, branch
|
| 1540 |
|
|
SUBQ #1,D1 ; adjust for DBRA
|
| 1541 |
|
|
GL5:
|
| 1542 |
|
|
MOVE.B #CTRLH,D0 ;and display BS-space-BS sequences
|
| 1543 |
|
|
BSR GOOUT
|
| 1544 |
|
|
MOVE.B #' ',D0
|
| 1545 |
|
|
BSR GOOUT
|
| 1546 |
|
|
MOVE.B #CTRLH,D0
|
| 1547 |
|
|
BSR GOOUT
|
| 1548 |
|
|
DBRA D1,GL5
|
| 1549 |
|
|
GL6:
|
| 1550 |
|
|
LEA BUFFER,A0 ;reinitialize the text pointer
|
| 1551 |
|
|
BRA GL1 ;and go back for more
|
| 1552 |
|
|
GL7:
|
| 1553 |
|
|
MOVE.B #LF,D0 ; echo a LF for the CR
|
| 1554 |
|
|
BSR GOOUT
|
| 1555 |
|
|
RTS
|
| 1556 |
|
|
|
| 1557 |
|
|
;*
|
| 1558 |
|
|
;*******************************************************************
|
| 1559 |
|
|
;*
|
| 1560 |
|
|
;* *** FNDLN (& friends) ***
|
| 1561 |
|
|
;*
|
| 1562 |
|
|
;* 'FNDLN' finds a line with a given line no. (in D1) in the
|
| 1563 |
|
|
;* text save area. A1 is used as the text pointer. If the line
|
| 1564 |
|
|
;* is found, A1 will point to the beginning of that line
|
| 1565 |
|
|
;* (i.e. the high byte of the line no.), and flags are NC & Z.
|
| 1566 |
|
|
;* If that line is not there and a line with a higher line no.
|
| 1567 |
|
|
;* is found, A1 points there and flags are NC & NZ. If we reached
|
| 1568 |
|
|
;* the end of the text save area and cannot find the line, flags
|
| 1569 |
|
|
;* are C & NZ.
|
| 1570 |
|
|
;* 'FNDLN' will initialize A1 to the beginning of the text save
|
| 1571 |
|
|
;* area to start the search. Some other entries of this routine
|
| 1572 |
|
|
;* will not initialize A1 and do the search.
|
| 1573 |
|
|
;* 'FNDLNP' will start with A1 and search for the line no.
|
| 1574 |
|
|
;* 'FNDNXT' will bump A1 by 2, find a CR and then start search.
|
| 1575 |
|
|
;* 'FNDSKP' uses A1 to find a CR, and then starts the search.
|
| 1576 |
|
|
;*
|
| 1577 |
|
|
FNDLN:
|
| 1578 |
|
|
CMP.L #0xFFFF,D1 ;line no. must be < 65535
|
| 1579 |
|
|
BCC QHOW
|
| 1580 |
|
|
MOVE.L TXTBGN,A1 ;init. the text save pointer
|
| 1581 |
|
|
|
| 1582 |
|
|
FNDLNP:
|
| 1583 |
|
|
MOVE.L TXTUNF,A2 ;check if we passed the end
|
| 1584 |
|
|
SUBQ.L #1,A2
|
| 1585 |
|
|
CMPA.L A1,A2
|
| 1586 |
|
|
BCS FNDRET ; if so, return with Z=0 & C=1
|
| 1587 |
|
|
MOVE.B (A1),D2 ;if not, get a line no.
|
| 1588 |
|
|
LSL.W #8,D2
|
| 1589 |
|
|
MOVE.B 1(A1),D2
|
| 1590 |
|
|
CMP.W D1,D2 ;is this the line we want?
|
| 1591 |
|
|
BCS FNDNXT ;no, not there yet
|
| 1592 |
|
|
FNDRET:
|
| 1593 |
|
|
RTS ;return the cond. codes
|
| 1594 |
|
|
|
| 1595 |
|
|
FNDNXT:
|
| 1596 |
|
|
ADDQ.L #2,A1; find the next line
|
| 1597 |
|
|
|
| 1598 |
|
|
FNDSKP:
|
| 1599 |
|
|
CMP.B #CR,(A1)+ ;try to find a CR
|
| 1600 |
|
|
BNE FNDSKP ;keep looking
|
| 1601 |
|
|
BRA FNDLNP ;check if end of text
|
| 1602 |
|
|
|
| 1603 |
|
|
;*
|
| 1604 |
|
|
;*******************************************************************
|
| 1605 |
|
|
;*
|
| 1606 |
|
|
;* *** MVUP *** MVDOWN *** POPA *** PUSHA ***
|
| 1607 |
|
|
;*
|
| 1608 |
|
|
;* 'MVUP' moves a block up from where A1 points to where A2 points
|
| 1609 |
|
|
;* until A1=A3
|
| 1610 |
|
|
;*
|
| 1611 |
|
|
;* 'MVDOWN' moves a block down from where A1 points to where A3
|
| 1612 |
|
|
;* points until A1=A2
|
| 1613 |
|
|
;*
|
| 1614 |
|
|
;* 'POPA' restores the 'FOR' loop variable save area from the stack
|
| 1615 |
|
|
;*
|
| 1616 |
|
|
;* 'PUSHA' stacks for 'FOR' loop variable save area onto the stack
|
| 1617 |
|
|
;*
|
| 1618 |
|
|
MVUP:
|
| 1619 |
|
|
CMP.L A1,A3 ; see the above description
|
| 1620 |
|
|
BEQ MVRET
|
| 1621 |
|
|
MOVE.B (A1)+,(A2)+
|
| 1622 |
|
|
BRA MVUP
|
| 1623 |
|
|
MVRET:
|
| 1624 |
|
|
RTS
|
| 1625 |
|
|
|
| 1626 |
|
|
MVDOWN:
|
| 1627 |
|
|
CMP.L A1,A2 ; see the above description
|
| 1628 |
|
|
BEQ MVRET
|
| 1629 |
|
|
MOVE.B -(A1),-(A3)
|
| 1630 |
|
|
BRA MVDOWN
|
| 1631 |
|
|
|
| 1632 |
|
|
POPA:
|
| 1633 |
|
|
MOVE.L (SP)+,A6 ;A6 = return address
|
| 1634 |
|
|
MOVE.L (SP)+,LOPVAR ;restore LOPVAR, but zero means no more
|
| 1635 |
|
|
BEQ PP1
|
| 1636 |
|
|
MOVE.L (SP)+,LOPINC ;if not zero, restore the rest
|
| 1637 |
|
|
MOVE.L (SP)+,LOPLMT
|
| 1638 |
|
|
MOVE.L (SP)+,LOPLN
|
| 1639 |
|
|
MOVE.L (SP)+,LOPPT
|
| 1640 |
|
|
PP1:
|
| 1641 |
|
|
JMP (A6) ; return
|
| 1642 |
|
|
|
| 1643 |
|
|
PUSHA:
|
| 1644 |
|
|
MOVE.L STKLMT,D1 ;Are we running out of stack room?
|
| 1645 |
|
|
SUB.L SP,D1
|
| 1646 |
|
|
BCC QSORRY ;if so, say we're sorry
|
| 1647 |
|
|
MOVE.L (SP)+,A6 ;else get the return address
|
| 1648 |
|
|
MOVE.L LOPVAR,D1 ;save loop variables
|
| 1649 |
|
|
BEQ PU1 ;if LOPVAR is zero, that's all
|
| 1650 |
|
|
MOVE.L LOPPT,-(SP) ;else save all the others
|
| 1651 |
|
|
MOVE.L LOPLN,-(SP)
|
| 1652 |
|
|
MOVE.L LOPLMT,-(SP)
|
| 1653 |
|
|
MOVE.L LOPINC,-(SP)
|
| 1654 |
|
|
PU1:
|
| 1655 |
|
|
MOVE.L D1,-(SP)
|
| 1656 |
|
|
JMP (A6) ;return
|
| 1657 |
|
|
|
| 1658 |
|
|
;*
|
| 1659 |
|
|
;*******************************************************************
|
| 1660 |
|
|
;*
|
| 1661 |
|
|
;* *** PRTSTG *** QTSTG *** PRTNUM *** PRTLN ***
|
| 1662 |
|
|
;*
|
| 1663 |
|
|
;* 'PRTSTG' prints a string pointed to by A1. It stops printing
|
| 1664 |
|
|
;* and returns to the caller when either a CR is printed or when
|
| 1665 |
|
|
;* the next byte is the same as what was passed in D0 by the
|
| 1666 |
|
|
;* caller.
|
| 1667 |
|
|
;*
|
| 1668 |
|
|
;* 'QTSTG' looks for an underline (back-arrow on some systems),
|
| 1669 |
|
|
;* single-quote, or double-quote. If none of these are found, returns
|
| 1670 |
|
|
;* to the caller. If underline, outputs a CR without a LF. If single
|
| 1671 |
|
|
;* or double quote, prints the quoted string and demands a matching
|
| 1672 |
|
|
;* end quote. After the printing, the next 2 bytes of the caller are
|
| 1673 |
|
|
;* skipped over (usually a short branch instruction).
|
| 1674 |
|
|
;*
|
| 1675 |
|
|
;* 'PRTNUM' prints the 32 bit number in D1, leading blanks are added if
|
| 1676 |
|
|
;* needed to pad the number of spaces to the number in D4.
|
| 1677 |
|
|
;* However, if the number of digits is larger than the no. in
|
| 1678 |
|
|
;* D4, all digits are printed anyway. Negative sign is also
|
| 1679 |
|
|
;* printed and counted in, positive sign is not.
|
| 1680 |
|
|
;*
|
| 1681 |
|
|
;* 'PRTLN' prints the saved text line pointed to by A1
|
| 1682 |
|
|
;* with line no. and all.
|
| 1683 |
|
|
;*
|
| 1684 |
|
|
PRTSTG:
|
| 1685 |
|
|
MOVE.B D0,D1 ; save the stop character
|
| 1686 |
|
|
PS1:
|
| 1687 |
|
|
MOVE.B (A1)+,D0 ;get a text character
|
| 1688 |
|
|
CMP.B D0,D1 ;same as stop character?
|
| 1689 |
|
|
BEQ PRTRET ;if so, return
|
| 1690 |
|
|
BSR GOOUT ;display the char.
|
| 1691 |
|
|
CMP.B #CR,D0 ;;is it a C.R.?
|
| 1692 |
|
|
BNE PS1 ;no, go back for more
|
| 1693 |
|
|
MOVE.B #LF,D0 ; yes, add a L.F.
|
| 1694 |
|
|
BSR GOOUT
|
| 1695 |
|
|
PRTRET:
|
| 1696 |
|
|
RTS ;then return
|
| 1697 |
|
|
|
| 1698 |
|
|
QTSTG:
|
| 1699 |
|
|
BSR.L TSTC; *** QTSTG ***
|
| 1700 |
|
|
DC.B '"',QT3-$
|
| 1701 |
|
|
MOVE.B #'"',D0 ; it is a "
|
| 1702 |
|
|
QT1:
|
| 1703 |
|
|
MOVE.L A0,A1
|
| 1704 |
|
|
BSR PRTSTG ;print until another
|
| 1705 |
|
|
MOVE.L A1,A0
|
| 1706 |
|
|
MOVE.L (SP)+,A1; pop return address
|
| 1707 |
|
|
CMP.B #LF,D0 ; was last one a CR?
|
| 1708 |
|
|
BEQ RUNNXL ;if so, run next line
|
| 1709 |
|
|
QT2:
|
| 1710 |
|
|
ADDQ.L #2,A1 ; skip 2 bytes on return
|
| 1711 |
|
|
JMP (A1) ;return
|
| 1712 |
|
|
QT3:
|
| 1713 |
|
|
BSR.L TSTC ; is it a single quote?
|
| 1714 |
|
|
DC.B '\'',QT4-$
|
| 1715 |
|
|
MOVE.B #'''',D0 ; if so, do same as above
|
| 1716 |
|
|
BRA QT1
|
| 1717 |
|
|
QT4:
|
| 1718 |
|
|
BSR.L TSTC ;is it an underline?
|
| 1719 |
|
|
DC.B '_',QT5-$
|
| 1720 |
|
|
MOVE.B #CR,D0 ;if so, output a CR without LF
|
| 1721 |
|
|
BSR.L GOOUT
|
| 1722 |
|
|
MOVE.L (SP)+,A1 ;pop return address
|
| 1723 |
|
|
BRA QT2
|
| 1724 |
|
|
QT5:
|
| 1725 |
|
|
RTS ;none of the above
|
| 1726 |
|
|
|
| 1727 |
|
|
PRTNUM:
|
| 1728 |
|
|
movem.l d0/d1/d4/a1/a5,-(a7)
|
| 1729 |
|
|
lea scratch1,a5
|
| 1730 |
|
|
move.l d1,d0
|
| 1731 |
|
|
jsr HEX2DEC
|
| 1732 |
|
|
lea scratch1,a5
|
| 1733 |
|
|
PN8:
|
| 1734 |
|
|
move.b (a5)+,d0
|
| 1735 |
|
|
beq PN7
|
| 1736 |
|
|
dbra d4,PN8
|
| 1737 |
|
|
PN7:
|
| 1738 |
|
|
tst.w d4
|
| 1739 |
|
|
bmi PN9
|
| 1740 |
|
|
MOVE.B #' ',D0 ; display the required leading spaces
|
| 1741 |
|
|
BSR GOOUT
|
| 1742 |
|
|
DBRA D4,PN7
|
| 1743 |
|
|
PN9:
|
| 1744 |
|
|
lea scratch1,a1
|
| 1745 |
|
|
jsr DisplayString
|
| 1746 |
|
|
movem.l (a7)+,d0/d1/d4/a1/a5
|
| 1747 |
|
|
rts
|
| 1748 |
|
|
|
| 1749 |
|
|
;PRTNUM
|
| 1750 |
|
|
; MOVE.L D1,D3 ; save the number for later
|
| 1751 |
|
|
; MOVE.L D4,-(SP) ;save the width value
|
| 1752 |
|
|
; MOVE.W #0xFFFF,-(SP) ;flag for end of digit string
|
| 1753 |
|
|
; TST.L D1 ;is it negative?
|
| 1754 |
|
|
; BPL PN1 ;if not
|
| 1755 |
|
|
; NEG.L D1 ; else make it positive
|
| 1756 |
|
|
; SUBQ #1,D4 ; one less for width count
|
| 1757 |
|
|
;PN1:
|
| 1758 |
|
|
; DIVU #10,D1 ; get the next digit
|
| 1759 |
|
|
; BVS PNOV ; overflow flag set?
|
| 1760 |
|
|
; MOVE.L D1,D0 ; if not, save remainder
|
| 1761 |
|
|
; AND.L #0xFFFF,D1 ;strip the remainder
|
| 1762 |
|
|
; BRA TOASCII ;skip the overflow stuff
|
| 1763 |
|
|
;PNOV:
|
| 1764 |
|
|
; MOVE D1,D0 ; prepare for long word division
|
| 1765 |
|
|
; CLR.W D1 ;zero out low word
|
| 1766 |
|
|
; SWAP D1 ;high word into low
|
| 1767 |
|
|
; DIVU #10,D1 ; divide high word
|
| 1768 |
|
|
; MOVE D1,D2 ; save quotient
|
| 1769 |
|
|
; MOVE D0,D1 ; low word into low
|
| 1770 |
|
|
; DIVU #10,D1 ; divide low word
|
| 1771 |
|
|
; MOVE.L D1,D0 ; D0 = remainder
|
| 1772 |
|
|
; SWAP D1 ; R/Q becomes Q/R
|
| 1773 |
|
|
; MOVE D2,D1 ; D1 is low/high
|
| 1774 |
|
|
; SWAP D1 ; D1 is finally high/low
|
| 1775 |
|
|
;TOASCII:
|
| 1776 |
|
|
; SWAP D0 ; get remainder
|
| 1777 |
|
|
; MOVE.W D0,-(SP); stack it as a digit
|
| 1778 |
|
|
; SWAP D0
|
| 1779 |
|
|
; SUBQ #1,D4 ; decrement width count
|
| 1780 |
|
|
; TST.L D1 ;if quotient is zero, we're done
|
| 1781 |
|
|
; BNE PN1
|
| 1782 |
|
|
; SUBQ #1,D4 ; adjust padding count for DBRA
|
| 1783 |
|
|
; BMI PN4 ;skip padding if not needed
|
| 1784 |
|
|
;PN3:
|
| 1785 |
|
|
; MOVE.B #' ',D0 ; display the required leading spaces
|
| 1786 |
|
|
; BSR GOOUT
|
| 1787 |
|
|
; DBRA D4,PN3
|
| 1788 |
|
|
;PN4:
|
| 1789 |
|
|
; TST.L D3 ;is number negative?
|
| 1790 |
|
|
; BPL PN5
|
| 1791 |
|
|
; MOVE.B #'-',D0 ; if so, display the sign
|
| 1792 |
|
|
; BSR GOOUT
|
| 1793 |
|
|
;PN5:
|
| 1794 |
|
|
; MOVE.W (SP)+,D0 ;now unstack the digits and display
|
| 1795 |
|
|
; BMI PNRET ;until the flag code is reached
|
| 1796 |
|
|
; ADD.B #'0',D0 ; make into ASCII
|
| 1797 |
|
|
; BSR GOOUT
|
| 1798 |
|
|
; BRA PN5
|
| 1799 |
|
|
;PNRET:
|
| 1800 |
|
|
; MOVE.L (SP)+,D4 ;restore width value
|
| 1801 |
|
|
; RTS
|
| 1802 |
|
|
|
| 1803 |
|
|
PRTLN:
|
| 1804 |
|
|
CLR.L D1
|
| 1805 |
|
|
MOVE.B (A1)+,D1 ;get the binary line number
|
| 1806 |
|
|
LSL #8,D1
|
| 1807 |
|
|
MOVE.B (A1)+,D1
|
| 1808 |
|
|
MOVEQ #5,D4 ;display a 5 digit line no.
|
| 1809 |
|
|
BSR PRTNUM
|
| 1810 |
|
|
MOVE.B #' ',D0 ; followed by a blank
|
| 1811 |
|
|
BSR GOOUT
|
| 1812 |
|
|
CLR D0 ;stop char. is a zero
|
| 1813 |
|
|
BRA PRTSTG ; display the rest of the line
|
| 1814 |
|
|
|
| 1815 |
|
|
;*
|
| 1816 |
|
|
;* ===== Test text byte following the call to this subroutine. If it
|
| 1817 |
|
|
;* equals the byte pointed to by A0, return to the code following
|
| 1818 |
|
|
;* the call. If they are not equal, branch to the point
|
| 1819 |
|
|
;* indicated by the offset byte following the text byte.
|
| 1820 |
|
|
;*
|
| 1821 |
|
|
TSTC:
|
| 1822 |
|
|
BSR IGNBLK ;ignore leading blanks
|
| 1823 |
|
|
MOVE.L (SP)+,A1 ;get the return address
|
| 1824 |
|
|
MOVE.B (A1)+,D1 ;get the byte to compare
|
| 1825 |
|
|
CMP.B (A0),D1 ;is it = to what A0 points to?
|
| 1826 |
|
|
BEQ TC1 ;if so
|
| 1827 |
|
|
CLR.L D1 ;If not, add the second
|
| 1828 |
|
|
MOVE.B (A1),D1 ; byte following the call to
|
| 1829 |
|
|
ADD.L D1,A1 ; the return address.
|
| 1830 |
|
|
JMP (A1) ;jump to the routine
|
| 1831 |
|
|
TC1:
|
| 1832 |
|
|
ADDQ.L #1,A0 ; if equal, bump text pointer
|
| 1833 |
|
|
ADDQ.L #1,A1 ; Skip the 2 bytes following
|
| 1834 |
|
|
JMP (A1) ;the call and continue.
|
| 1835 |
|
|
|
| 1836 |
|
|
;*
|
| 1837 |
|
|
;* ===== See if the text pointed to by A0 is a number. If so,
|
| 1838 |
|
|
;* return the number in D1 and the number of digits in D2,
|
| 1839 |
|
|
;* else return zero in D1 and D2.
|
| 1840 |
|
|
;*
|
| 1841 |
|
|
TSTNUM:
|
| 1842 |
|
|
CLR.L D1 ;initialize return parameters
|
| 1843 |
|
|
CLR D2
|
| 1844 |
|
|
BSR IGNBLK ;skip over blanks
|
| 1845 |
|
|
TN1:
|
| 1846 |
|
|
CMP.B #'0',(A0) ; is it less than zero?
|
| 1847 |
|
|
BCS TSNMRET ;if so, that's all
|
| 1848 |
|
|
CMP.B #'9',(A0) ; is it greater than nine?
|
| 1849 |
|
|
BHI TSNMRET ;if so, return
|
| 1850 |
|
|
CMP.L #214748364,D1 ;see if there's room for new digit
|
| 1851 |
|
|
BCC QHOW ;if not, we've overflowd
|
| 1852 |
|
|
MOVE.L D1,D0 ; quickly multiply result by 10
|
| 1853 |
|
|
ADD.L D1,D1
|
| 1854 |
|
|
ADD.L D1,D1
|
| 1855 |
|
|
ADD.L D0,D1
|
| 1856 |
|
|
ADD.L D1,D1
|
| 1857 |
|
|
MOVE.B (A0)+,D0 ;add in the new digit
|
| 1858 |
|
|
AND.L #0xF,D0
|
| 1859 |
|
|
ADD.L D0,D1
|
| 1860 |
|
|
ADDQ #1,D2 ;increment the no. of digits
|
| 1861 |
|
|
BRA TN1
|
| 1862 |
|
|
TSNMRET:
|
| 1863 |
|
|
RTS
|
| 1864 |
|
|
|
| 1865 |
|
|
;*
|
| 1866 |
|
|
;* ===== Skip over blanks in the text pointed to by A0.
|
| 1867 |
|
|
;*
|
| 1868 |
|
|
IGNBLK:
|
| 1869 |
|
|
CMP.B #' ',(A0) ; see if it's a space
|
| 1870 |
|
|
BNE IGBRET ;if so, swallow it
|
| 1871 |
|
|
IGB1:
|
| 1872 |
|
|
ADDQ.L #1,A0 ; increment the text pointer
|
| 1873 |
|
|
BRA IGNBLK
|
| 1874 |
|
|
IGBRET:
|
| 1875 |
|
|
RTS
|
| 1876 |
|
|
|
| 1877 |
|
|
;*
|
| 1878 |
|
|
;* ===== Convert the line of text in the input buffer to upper
|
| 1879 |
|
|
;* case (except for stuff between quotes).
|
| 1880 |
|
|
;*
|
| 1881 |
|
|
TOUPBUF:
|
| 1882 |
|
|
LEA BUFFER,A0 ;set up text pointer
|
| 1883 |
|
|
CLR.B D1 ;clear quote flag
|
| 1884 |
|
|
TOUPB1:
|
| 1885 |
|
|
MOVE.B (A0)+,D0 ;get the next text char.
|
| 1886 |
|
|
CMP.B #CR,D0 ;is it end of line?
|
| 1887 |
|
|
BEQ TOUPBRT ;if so, return
|
| 1888 |
|
|
CMP.B #'"',D0 ; a double quote?
|
| 1889 |
|
|
BEQ DOQUO
|
| 1890 |
|
|
CMP.B #'''',D0 ; or a single quote?
|
| 1891 |
|
|
BEQ DOQUO
|
| 1892 |
|
|
TST.B D1 ;inside quotes?
|
| 1893 |
|
|
BNE TOUPB1 ;if so, do the next one
|
| 1894 |
|
|
BSR TOUPPER ;convert to upper case
|
| 1895 |
|
|
MOVE.B D0,-(A0); store it
|
| 1896 |
|
|
ADDQ.L #1,A0
|
| 1897 |
|
|
BRA TOUPB1 ;and go back for more
|
| 1898 |
|
|
TOUPBRT:
|
| 1899 |
|
|
RTS
|
| 1900 |
|
|
|
| 1901 |
|
|
DOQUO:
|
| 1902 |
|
|
TST.B D1 ; are we inside quotes?
|
| 1903 |
|
|
BNE DOQUO1
|
| 1904 |
|
|
MOVE.B D0,D1 ; if not, toggle inside-quotes flag
|
| 1905 |
|
|
BRA TOUPB1
|
| 1906 |
|
|
DOQUO1:
|
| 1907 |
|
|
CMP.B D0,D1 ; make sure we're ending proper quote
|
| 1908 |
|
|
BNE TOUPB1 ;if not, ignore it
|
| 1909 |
|
|
CLR.B D1 ;else clear quote flag
|
| 1910 |
|
|
BRA TOUPB1
|
| 1911 |
|
|
|
| 1912 |
|
|
;*
|
| 1913 |
|
|
;* ===== Convert the character in D0 to upper case
|
| 1914 |
|
|
;*
|
| 1915 |
|
|
TOUPPER:
|
| 1916 |
|
|
CMP.B #'a',D0 ; is it < 'a'?
|
| 1917 |
|
|
BCS TOUPRET
|
| 1918 |
|
|
CMP.B #'z',D0 ; or > 'z'?
|
| 1919 |
|
|
BHI TOUPRET
|
| 1920 |
|
|
SUB.B #32,D0 ;if not, make it upper case
|
| 1921 |
|
|
TOUPRET:
|
| 1922 |
|
|
RTS
|
| 1923 |
|
|
|
| 1924 |
|
|
;*
|
| 1925 |
|
|
;* 'CHKIO' checks the input. If there's no input, it will return
|
| 1926 |
|
|
;* to the caller with the Z flag set. If there is input, the Z
|
| 1927 |
|
|
;* flag is cleared and the input byte is in D0. However, if a
|
| 1928 |
|
|
;* control-C is read, 'CHKIO' will warm-start BASIC and will not
|
| 1929 |
|
|
;* return to the caller.
|
| 1930 |
|
|
;*
|
| 1931 |
|
|
CHKIO:
|
| 1932 |
|
|
BSR.L GOIN ; get input if possible
|
| 1933 |
|
|
BEQ CHKRET ;if Zero, no input
|
| 1934 |
|
|
CMP.B #CTRLC,D0 ;is it control-C?
|
| 1935 |
|
|
BNE CHKRET ;if not
|
| 1936 |
|
|
BRA.L WSTART ;if so, do a warm start
|
| 1937 |
|
|
CHKRET:
|
| 1938 |
|
|
RTS
|
| 1939 |
|
|
|
| 1940 |
|
|
;*
|
| 1941 |
|
|
;* ===== Display a CR-LF sequence
|
| 1942 |
|
|
;*
|
| 1943 |
|
|
CRLF1:
|
| 1944 |
|
|
LEA CLMSG,A6
|
| 1945 |
|
|
|
| 1946 |
|
|
;*
|
| 1947 |
|
|
;* ===== Display a zero-ended string pointed to by register A6
|
| 1948 |
|
|
;*
|
| 1949 |
|
|
PRMESG:
|
| 1950 |
|
|
MOVE.B (A6)+,D0 ;get the char.
|
| 1951 |
|
|
BEQ PRMRET ;if it's zero, we're done
|
| 1952 |
|
|
BSR GOOUT ;else display it
|
| 1953 |
|
|
BRA PRMESG
|
| 1954 |
|
|
PRMRET:
|
| 1955 |
|
|
RTS
|
| 1956 |
|
|
|
| 1957 |
|
|
;******************************************************
|
| 1958 |
|
|
;* The following routines are the only ones that need *
|
| 1959 |
|
|
;* to be changed for a different I/O environment. *
|
| 1960 |
|
|
;******************************************************
|
| 1961 |
|
|
|
| 1962 |
|
|
;UART EQU 0xFFDC0A00
|
| 1963 |
|
|
;UART_LS EQU UART+1
|
| 1964 |
|
|
;UART_CTRL EQU UART+7
|
| 1965 |
|
|
;KEYBD EQU 0xFFDC0000
|
| 1966 |
|
|
|
| 1967 |
|
|
|
| 1968 |
|
|
;*
|
| 1969 |
|
|
;* ===== Output character to the console (Port 1) from register D0
|
| 1970 |
|
|
;* (Preserves all registers.)
|
| 1971 |
|
|
;*
|
| 1972 |
|
|
OUTC:
|
| 1973 |
|
|
MOVEM.L D0/D1,-(SP)
|
| 1974 |
|
|
MOVE.L D0,D1
|
| 1975 |
|
|
JSR DisplayChar
|
| 1976 |
|
|
MOVEM.L (SP)+,D0/D1
|
| 1977 |
|
|
RTS
|
| 1978 |
|
|
|
| 1979 |
|
|
;*
|
| 1980 |
|
|
;* ===== Input a character from the console into register D0 (or
|
| 1981 |
|
|
;* return Zero status if there's no character available).
|
| 1982 |
|
|
;*
|
| 1983 |
|
|
INC:
|
| 1984 |
|
|
MOVE.W KEYBD,D0 ;is character ready?
|
| 1985 |
|
|
BPL INCRET0 ;if not, return Zero status
|
| 1986 |
|
|
CLR.W KEYBD+2 ; clear keyboard strobe line
|
| 1987 |
|
|
AND.W #0xFF,D0 ;zero out the high bit
|
| 1988 |
|
|
RTS
|
| 1989 |
|
|
INCRET0
|
| 1990 |
|
|
MOVEQ #0,D0
|
| 1991 |
|
|
RTS
|
| 1992 |
|
|
|
| 1993 |
|
|
;*
|
| 1994 |
|
|
;* ===== Output character to the host (Port 2) from register D0
|
| 1995 |
|
|
;* (Preserves all registers.)
|
| 1996 |
|
|
;*
|
| 1997 |
|
|
AUXOUT:
|
| 1998 |
|
|
BTST #5,UART_LS ;is port ready for a character?
|
| 1999 |
|
|
BEQ AUXOUT ;if not, wait for it
|
| 2000 |
|
|
MOVE.B D0,UART ;out it goes.
|
| 2001 |
|
|
RTS
|
| 2002 |
|
|
|
| 2003 |
|
|
;*
|
| 2004 |
|
|
;* ===== Input a character from the host into register D0 (or
|
| 2005 |
|
|
;* return Zero status if there's no character available).
|
| 2006 |
|
|
;*
|
| 2007 |
|
|
AUXIN:
|
| 2008 |
|
|
BTST #0,UART_LS ;is character ready?
|
| 2009 |
|
|
BEQ AXIRET ;if not, return Zero status
|
| 2010 |
|
|
MOVE.B UART,D0 ;else get the character
|
| 2011 |
|
|
AND.B #0x7F,D0 ;zero out the high bit
|
| 2012 |
|
|
AXIRET:
|
| 2013 |
|
|
RTS
|
| 2014 |
|
|
|
| 2015 |
|
|
;*
|
| 2016 |
|
|
;* ===== Return to the resident monitor, operating system, etc.
|
| 2017 |
|
|
;*
|
| 2018 |
|
|
BYEBYE:
|
| 2019 |
|
|
JMP Monitor
|
| 2020 |
|
|
; MOVE.B #228,D7 ;return to Tutor
|
| 2021 |
|
|
; TRAP #14
|
| 2022 |
|
|
|
| 2023 |
|
|
INITMSG:
|
| 2024 |
|
|
DC.B CR,LF,'Gordo\'s MC68000 Tiny BASIC, v1.3',CR,LF,LF,0
|
| 2025 |
|
|
OKMSG:
|
| 2026 |
|
|
DC.B CR,LF,'OK',CR,LF,0
|
| 2027 |
|
|
HOWMSG:
|
| 2028 |
|
|
DC.B 'How?',CR,LF,0
|
| 2029 |
|
|
WHTMSG:
|
| 2030 |
|
|
DC.B 'What?',CR,LF,0
|
| 2031 |
|
|
SRYMSG:
|
| 2032 |
|
|
DC.B 'Sorry.'
|
| 2033 |
|
|
CLMSG:
|
| 2034 |
|
|
DC.B CR,LF,0
|
| 2035 |
|
|
; DC.B 0 ;<- for aligning on a word boundary
|
| 2036 |
|
|
even
|
| 2037 |
|
|
|
| 2038 |
|
|
LSTROM EQU $
|
| 2039 |
|
|
; end of possible ROM area
|
| 2040 |
|
|
|
