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