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