~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / sail / _s / express
1 ;
2 ; express.s
3 ;
4 ; Evaluation of BASIC expressions
5 ;
6 ; © 1995 Straylight
7 ;
8
9 ;----- Standard header ------------------------------------------------------
10
11 GET libs:header
12 GET libs:swis
13
14 GET libs:stream
15
16 ;----- External dependencies ------------------------------------------------
17
18 GET sh.anchor
19 GET sh.ctrl
20 GET sh.divide
21 GET sh.errNum
22 GET sh.error
23 GET sh.getToken
24 GET sh.stracc
25 GET sh.termite
26 GET sh.termScript
27 GET sh.tokenise
28 GET sh.tokens
29 GET sh.upcalls
30 GET sh.mem
31 GET sh.var
32
33 ;----- Macros ---------------------------------------------------------------
34
35 MACRO
36 $label GETOP $r,$prec,$branch,$cc
37 ALIGN
38 $label
39 MOV$cc $r,#($prec)<<24
40 ORR$cc $r,$r,#($branch-exp__bTable)>>2
41 MEND
42
43 ;----- Main code ------------------------------------------------------------
44
45 AREA |TermScript$$Code|,CODE,READONLY
46
47 ;----- Stack handling -------------------------------------------------------
48
49 ; --- exp__pushOp ---
50 ;
51 ; On entry: R0 == operator thing to push
52 ;
53 ; On exit: R0-R4 corrupted
54 ;
55 ; Use: Pushes an operator onto the stack.
56
57 exp__pushOp ROUT
58
59 STMFD R13!,{R14}
60 MOV R3,R0 ;Look after thing to push
61 ADR R1,tsc_opStack ;Point to some stack data
62 LDMIA R1,{R0-R2} ;Load it out
63
64 ADD R4,R1,#4 ;New used size
65 CMP R4,R2 ;Do we need more stack?
66 BGT %10exp__pushOp ;Yes -- jump ahead
67 00exp__pushOp STR R4,tsc_opStkPtr ;Store back new size
68 LDR R0,[R0] ;Point to the stack
69 ADD R0,R0,R4 ;Address to put next thing on
70 STR R3,[R0,#-4] ;Store the new operator
71 LDMFD R13!,{PC}^
72
73 10exp__pushOp ADD R1,R4,#255 ;Align to next size thing
74 BIC R1,R1,#255 ;Finish the align
75 BL mem_realloc ;Yes -- get more space then
76 STR R1,tsc_opStkSize ;Store new size maybe
77 B %00exp__pushOp ;Branch back agin
78
79 LTORG
80
81 ; --- exp__popOp ---
82 ;
83 ; On entry: --
84 ;
85 ; On exit: R0 == value popped off
86 ; R1-R4 corrupted
87 ;
88 ; Use: Pops an operator from the stack.
89
90 exp__popOp ROUT
91
92 STMFD R13!,{R14}
93 ADR R1,tsc_opStack ;Point to some stack data
94 LDMIA R1,{R0-R2} ;Load it out
95
96 SUB R4,R1,#4 ;The new size
97 ADD R1,R4,#255 ;Align up again
98 BIC R1,R1,#255 ;Aligned down
99 ADD R1,R1,#256 ;At least this much
100 CMP R1,R2 ;Has this size changed?
101 BLLT mem_realloc ;Yes -- reduce memory reqs.
102 STRLT R1,tsc_opStkSize ;Store new size maybe
103 STR R4,tsc_opStkPtr ;Store back new size
104 LDR R0,[R0] ;Point to the stack
105 LDR R0,[R0,R4] ;Load the value off the stack
106 LDMFD R13!,{PC}^ ;Return to caller
107
108 LTORG
109
110 ; --- exp__pushVal ---
111 ;
112 ; On entry: R0 == operator thing to push
113 ; R1 == type of thing to push
114 ;
115 ; On exit: R0-R5 corrupted
116 ;
117 ; Use: Pushes an value onto the stack.
118
119 exp__pushVal ROUT
120
121 STMFD R13!,{R5,R14}
122 MOV R3,R0 ;Look after thing to push
123 MOV R4,R1
124 ADR R1,tsc_calcStack ;Point to some stack data
125 LDMIA R1,{R0-R2} ;Load it out
126
127 ADD R5,R1,#8 ;New used size
128 CMP R5,R2
129 BGT %10exp__pushVal
130 00exp__pushVal STR R5,tsc_calcStkPtr ;Store back new size
131 LDR R0,[R0] ;Point to the stack
132 ADD R0,R0,R5 ;Address to put next thing on
133 STMDB R0,{R3,R4} ;Store the thing
134 LDMFD R13!,{R5,PC}^
135
136 10exp__pushVal ADD R1,R5,#255 ;Align to next size thing
137 BIC R1,R1,#255 ;Finish the align
138 BL mem_realloc ;Yes -- get more space then
139 STR R1,tsc_calcStkSize ;Store new size maybe
140 B %00exp__pushVal
141
142 LTORG
143
144 ; --- exp__popVal ---
145 ;
146 ; On entry: --
147 ;
148 ; On exit: R0,R1 == value popped off
149 ; R2-R4 corrupted
150 ;
151 ; Use: Pops a value from the stack.
152
153 exp__popVal ROUT
154
155 STMFD R13!,{R14}
156 ADR R1,tsc_calcStack ;Point to some stack data
157 LDMIA R1,{R0-R2} ;Load it out
158
159 SUB R4,R1,#8 ;The new size
160 ADD R1,R4,#255 ;Align up again
161 BIC R1,R1,#255 ;Aligned down
162 ADD R1,R1,#256 ;At least this much please
163 CMP R1,R2 ;Has this size changed?
164 BLLT mem_realloc ;Yes -- reduce memory reqs.
165 STRLT R1,tsc_calcStkSize ;Store new size maybe
166 STR R4,tsc_calcStkPtr ;Store back new size
167 LDR R0,[R0] ;Point to the stack
168 ADD R0,R0,R4 ;Point into the stack
169 LDMIA R0,{R0,R1} ;Load values from the stack
170 LDMFD R13!,{PC}^ ;Return to caller
171
172 LTORG
173
174 ; --- exp__popTwoVals ---
175 ;
176 ; On entry: --
177 ;
178 ; On exit: R0-R3 == values popped off
179 ; R4 corrupted
180 ;
181 ; Use: Pops two values from the stack.
182
183 exp__popTwoVals ROUT
184
185 STMFD R13!,{R14}
186 ADR R1,tsc_calcStack ;Point to some stack data
187 LDMIA R1,{R0-R2} ;Load it out
188
189 SUB R4,R1,#16 ;The new size
190 ADD R1,R4,#255 ;Align up again
191 BIC R1,R1,#255 ;Aligned down
192 ADD R1,R1,#256 ;At least his much
193 CMP R1,R2 ;Has this size changed?
194 BLLT mem_realloc ;Yes -- reduce memory reqs.
195 STRLT R1,tsc_calcStkSize ;Store new size maybe
196 STR R4,tsc_calcStkPtr ;Store back new size
197 LDR R0,[R0] ;Point to the stack
198 ADD R0,R0,R4 ;Point into the stack
199 LDMIA R0,{R0-R3} ;Load values from the stack
200 LDMFD R13!,{PC}^ ;Return to caller
201
202 LTORG
203
204 ; --- express_pop ---
205 ;
206 ; On entry: --
207 ;
208 ; On exit: R0,R1 == value popped off
209 ;
210 ; Use: Pops a value from the stack.
211
212 EXPORT express_pop
213 express_pop ROUT
214
215 STMFD R13!,{R2-R4,R14} ;Stack registers
216 BL exp__popVal ;Get the value
217 LDMFD R13!,{R2-R4,PC}^ ;Return to caller
218
219 LTORG
220
221 ; --- express_popTwo ---
222 ;
223 ; On entry: --
224 ;
225 ; On exit: R0-R3 == two values popped from the stack
226 ;
227 ; Use: Pops two values from the stack.
228
229 EXPORT express_popTwo
230 express_popTwo ROUT
231
232 STMFD R13!,{R4,R14} ;Stack registers
233 BL exp__popTwoVals ;Pop the values
234 LDMFD R13!,{R4,PC}^ ;And return to caller
235
236 LTORG
237
238 ; --- express_push ---
239 ;
240 ; On entry: R0,R1 == l/rvalue to push
241 ;
242 ; On exit: --
243 ;
244 ; Use: Pushes a value onto the expression stack.
245
246 EXPORT express_push
247 express_push ROUT
248
249 STMFD R13!,{R0-R4,R14} ;Save some registers
250 BL exp__pushVal ;Do the pushing
251 LDMFD R13!,{R0-R4,PC}^ ;And return to caller
252
253 LTORG
254
255 ;----- Space-saving type checking routines ----------------------------------
256
257 ; --- exp__chkTwoInts ---
258 ;
259 ; On entry: R1,R3 == types of variable
260 ;
261 ; On exit: --
262 ;
263 ; Use: Ensures that R1 and R3 are both of type integer, and
264 ; complains otherwise.
265
266 exp__chkTwoInts ROUT
267
268 CMP R3,#vType_integer ;Is second an integer?
269 MOVNE R1,R3 ;No -- fiddle the first then
270
271 ; Drop through here (yuk)
272
273 ; --- exp__chkInt ---
274 ;
275 ; On entry: R1 == type of a variable
276 ;
277 ; On exit: --
278 ;
279 ; Use: Ensures that R1 is of type integer, and complains otherwise.
280
281 exp__chkInt ROUT
282
283 CMP R1,#vType_integer ;Is it an integer
284 MOVEQS PC,R14 ;Yes -- all OK -- return
285 MOV R0,#err_numNeeded ;No -- get the error
286 B error_report ;And complain at the user
287
288 LTORG
289
290 ; --- exp__popInt ---
291 ;
292 ; On entry: --
293 ;
294 ; On exit: R0,R1 == value popped from the stack
295 ; R2-R4 corrupted
296 ;
297 ; Use: Pops a value from the stack and ensures that it is an
298 ; integer.
299
300 exp__popInt STMFD R13!,{R14} ;Save the link for a bit
301 BL exp__popVal ;Pop a value from stack
302 LDMFD R13!,{R14} ;Restore link register
303 B exp__chkInt ;And check the value
304
305 LTORG
306
307 ; --- exp__popTwoInts ---
308 ;
309 ; On entry: --
310 ;
311 ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack
312 ; R4 corrupted
313 ;
314 ; Use: Pops two values from the stack and ensures that they are
315 ; integers.
316
317 exp__popTwoInts ROUT
318
319 STMFD R13!,{R14} ;Save the link for a bit
320 BL exp__popTwoVals ;Pop two values from stack
321 LDMFD R13!,{R14} ;Restore link register
322 B exp__chkTwoInts ;And check the values
323
324 LTORG
325
326 ; --- exp__chkTwoStrs ---
327 ;
328 ; On entry: R1,R3 == types of variable
329 ;
330 ; On exit: --
331 ;
332 ; Use: Ensures that R1 and R3 are both of type string, and
333 ; complains otherwise.
334
335 exp__chkTwoStrs ROUT
336
337 CMP R3,#vType_string ;Is second an integer?
338 MOVNE R1,R3 ;No -- fiddle the first then
339
340 ; Drop through here (yuk)
341
342 ; --- exp__chkStr ---
343 ;
344 ; On entry: R1 == type of a variable
345 ;
346 ; On exit: --
347 ;
348 ; Use: Ensures that R1 is of type string, and complains otherwise.
349
350 exp__chkStr ROUT
351
352 CMP R1,#vType_string ;Is it an integer
353 MOVEQS PC,R14 ;Yes -- all OK -- return
354 MOV R0,#err_strNeeded ;No -- get the error
355 B error_report ;And complain at the user
356
357 LTORG
358
359 ; --- exp__popStr ---
360 ;
361 ; On entry: --
362 ;
363 ; On exit: R0,R1 == value popped from the stack
364 ; R2-R4 corrupted
365 ;
366 ; Use: Pops a value from the stack and ensures that it is an
367 ; integer.
368
369 exp__popStr STMFD R13!,{R14} ;Save the link for a bit
370 BL exp__popVal ;Pop a value from stack
371 LDMFD R13!,{R14} ;Restore link register
372 B exp__chkStr ;And check the value
373
374 LTORG
375
376 ; --- exp__popTwoStrs ---
377 ;
378 ; On entry: --
379 ;
380 ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack
381 ; R4 corrupted
382 ;
383 ; Use: Pops two values from the stack and ensures that they are
384 ; integers.
385
386 exp__popTwoStrs ROUT
387
388 STMFD R13!,{R14} ;Save the link for a bit
389 BL exp__popTwoVals ;Pop two values from stack
390 LDMFD R13!,{R14} ;Restore link register
391 B exp__chkTwoStrs ;And check the values
392
393 LTORG
394
395 ;----- Expression evaluation routines ---------------------------------------
396
397 ; --- express_fnCont ---
398 ;
399 ; On entry: Involved
400 ;
401 ; On exit: Similarly involved.
402 ;
403 ; Use: We continue here after executing a function.
404
405 EXPORT express_fnCont
406
407 ; --- express_read ---
408 ;
409 ; On entry: R0 == 1 to read an lvalue, 2 to read ident, 0 otherwise
410 ; R7, R8, R9 == lookahead token
411 ; R10 == pointer into tokenised buffer
412 ; R11 == evaluation stack pointer
413 ; R12 == anchor pointer
414 ;
415 ; On exit: R0,R1 == value of expression
416 ; R7, R8, R9 == lookahead token
417 ; R0, R1 == result of expression
418 ; R10 == moved on to first char after expression
419 ;
420 ; Use: Reads an expression for the current position in the
421 ; tokenised file.
422
423 EXPORT express_read
424 express_read ROUT
425
426 STMFD R13!,{R0-R6,R14} ;Stack registers
427 MOV R6,#0 ;Current flags word
428 CMP R0,#1 ;Reading an lvalue?
429 ORREQ R6,R6,#eFlag__lval ;Yes -- set the flag then
430 CMP R0,#2 ;Reading an ident?
431 ORREQ R6,R6,#eFlag__parseLval ;Yes -- parse as lval then
432
433 GETOP R0,255,exp__bExpEnd ;Push a sentinel operand
434 BL exp__pushOp ;To separate this expression
435
436 exp__mainLoop
437 express_fnCont
438 10express_read TST R6,#eFlag__done ;Have we finished this?
439 BNE %70express_read ;Yes -- jump ahead
440 TST R6,#eFlag__op ;Are we reading an op?
441 BNE %50express_read ;Yes -- jump ahead
442
443 ; --- Read an operand then ---
444
445 SUBS R4,R9,#'_' ;Is it an underscore?
446 SUBNE R4,R9,#'A' ;Or a capital letter?
447 CMP R4,#26
448 SUBCS R4,R9,#'a' ;Or a lowercase letter?
449 CMPCS R4,#26
450 BCC exp__readIdent ;Read an identifier
451
452 CMP R9,#'!' ;Is it an indirection op?
453 CMPNE R9,#'?'
454 CMPNE R9,#'$'
455 BEQ exp__indir ;Yes -- jump ahead
456
457 TST R6,#eFlag__lval ;Are we reading an lvalue?
458 MOVNE R0,#err_syntax ;Yes -- get the error number
459 BNE error_report ;...and report the error
460
461 CMP R9,#'"' ;Is it a quote?
462 BEQ exp__string ;Yes -- read string then
463
464 CMP R9,#'(' ;Is it a bracket?
465 BEQ exp__par ;Yes -- jump ahead
466
467 CMP R9,#tok_fn ;Is it a function call?
468 BEQ exp__userFn ;Yes -- handle that then
469
470 CMP R9,#tok_rnd ;Is this the RND fn?
471 BLEQ getToken ;Yes -- gobble that
472 BEQ exp__doRnd ;And deal with it then
473
474 CMP R9,#'+' ;Is it a unary '+'?
475 BLEQ getToken ;...get another token
476 BEQ %10express_read ;...keep going around again
477 CMP R9,#'-' ;Is it a unary '-'?
478 BEQ exp__uMinus ;Yes -- jump ahead then
479
480 CMP R7,#tClass_pseud ;Is this a pseudovariable?
481 BEQ exp__pseud ;Yes -- deal with it
482
483 CMP R7,#tClass_fn ;Is it a function then?
484 BEQ exp__fn ;Yes -- deal with that
485
486 CMP R7,#tClass_streamOp ;Also check for stream ops
487 BEQ exp__streamOp ;Just for luck
488
489 CMP R7,#tClass_multArg ;Multiple parameter thing?
490 BEQ exp__multArg ;Yes -- deal with it then
491
492 CMP R9,#'&' ;Start a hex number?
493 BEQ exp__readHex ;Yes -- jump ahead
494 CMP R9,#'%' ;Start of a binary number?
495 BEQ exp__readBin ;Yes -- jump ahead
496 SUB R14,R9,#'0' ;Set up for a range check
497 CMP R14,#10 ;Is it a number?
498 BCC exp__readDec ;Read a decimal number
499
500 MOV R0,#err_unknown ;Get all-encompassing error
501 B error_report ;And report the error
502
503 LTORG
504
505 ; --- Handle a string ---
506
507 exp__string BL stracc_ensure ;Ensure stracc is big enough
508 MOV R2,#0 ;The initial length
509 00 BL getToken ;Read the next token
510 CMP R9,#&0a ;Is this a line end?
511 CMPNE R9,#&ff ;Or an end of file?
512 MOVEQ R0,#err_expQuote ;Yes -- get error number
513 BEQ error_report ;And report it
514 CMP R9,#'"' ;Is it a quote?
515 BEQ %f05 ;Yes -- branch ahead
516 03 STRB R9,[R0],#1 ;No -- store the byte
517 ADDS R2,R2,#1<<24 ;...increment the length
518 BCC %b00 ;Keep looping for more
519 MOVCS R0,#err_strTooLong ;Get error message
520 BCS error_report ;and report it nicely
521
522 05 BL getToken ;Get another token
523 CMP R9,#'"' ;Is this a quote too?
524 BEQ %b03 ;Yes -- jump back upwards
525
526 ORR R0,R1,R2,LSR #24 ;Get the rvalue word
527 MOV R1,#vType_string ;This is a string
528 BL stracc_added ;Tell stracc about this
529 BL exp__pushVal ;Push the value
530 ORR R6,R6,#eFlag__op ;Read an operator now
531 B %10express_read ;And jump with glee
532
533 ; --- Handle a function call ---
534
535 exp__userFn ORR R6,R6,#eFlag__op ;Expect operand next
536 BL getToken ;Gobble the token
537 B ctrl_fn ;And handle it elsewhere
538
539 ; --- Handle an open bracket ---
540
541 exp__par GETOP R0,253,exp__bPar ;Do a bracket like thing
542 BL exp__pushOp ;Push that onto the stack
543 ADD R6,R6,#1<<8 ;Bump the paren count
544 BL getToken ;Get another token
545 B %10express_read ;And read the first operand
546
547 ; --- Handle a unary minus ---
548
549 exp__uMinus GETOP R0,1,exp__bUMinus ;Do a unary minus
550 BL exp__pushOp ;Push that onto the stack
551 BL getToken ;Get another token
552 B %10express_read ;And read the first operand
553
554 ; --- Handle a pseudovariable ---
555
556 exp__pseud MOV R0,R8 ;Look after token index
557 BL getToken ;Move on to next token
558 ORR R6,R6,#eFlag__op ;Now expecting an operator
559 MOV R14,PC ;Set up return address
560 ADD PC,PC,R0,LSL #2 ;Dispatch on token index
561 B %10express_read ;And return to the top
562
563 B exp__doFalse ;Return 0
564 B exp__doTime ;Get the current time
565 B exp__doTimeS ;Read time as a string (ouch)
566 B exp__doTrue ;Return -1
567
568 ; --- Handle unary functions ---
569
570 exp__fn MOV R0,#(exp__fns-exp__bTable)>>2
571 ADD R0,R0,R8 ;Add on the token index
572 ORR R0,R0,#1<<24 ;Use normal unary precedence
573 CMP R9,#tok_strS ;Is this STR$?
574 BLNE exp__pushOp ;Put that on the stack
575 BLNE getToken ;Get the next token
576 BNE %10express_read ;And go back up top
577
578 BL getToken ;Get another token
579 CMP R9,#'~' ;Hex conversion?
580 ORREQ R0,R0,#1<<16 ;Set a useful flag
581 BLEQ getToken ;And get another token
582 BL exp__pushOp ;Put that on the stack
583 B %10express_read ;And go back up top
584
585 ; --- Handle stream operations with irritating #s ---
586
587 exp__streamOp MOV R1,R8 ;Look after token index
588 BL getToken ;Get the next token
589 CMP R9,#'#' ;Is next char a hash?
590 MOVNE R0,#err_expHash ;No -- complain then
591 BNE error_report ;And report an error
592 BL getToken ;Get the next token
593 MOV R0,#(exp__streamOps-exp__bTable)>>2
594 ADD R0,R0,R1 ;Add on the token index
595 ORR R0,R0,#1<<24 ;Use normal unary precedence
596 BL exp__pushOp ;Put that on the stack
597 B %10express_read ;And go back up top
598
599 ; --- Deal with multiple parameter commands ---
600
601 exp__multArg MOV R0,#(exp__multArgs-exp__bTable)>>2
602 ADD R0,R0,R8 ;Add on the token index
603 ORR R0,R0,#1<<24 ;Use normal unary precedence
604 BL exp__pushOp ;Put that on the stack
605 BL getToken ;Get the next token
606
607 GETOP R0,254,exp__bMultArg ;Get the operator value
608 TST R6,#eFlag__commaOk ;Are we allowing commas?
609 ORRNE R0,R0,#1<<16 ;Yes -- set the flag then
610 BL exp__pushOp ;Put that on there
611 ORR R6,R6,#eFlag__commaOk ;Allow commas for a while
612 ADD R6,R6,#1<<8 ;Increment the paren count
613
614 B %10express_read ;And go back up top
615
616 ; --- Deal with an indirection operator ---
617
618 exp__indir MOV R0,#0 ;Prepare a zero base
619 TST R6,#eFlag__lval ;Are we reading an lvalue?
620 MOVEQ R1,#vType_integer ;No -- call it an integer
621 MOVNE R1,#vType_lvInt ;Yes -- call it an int lval
622 BICNE R6,R6,#eFlag__lval ;Clear lvalue flag too
623 ORRNE R6,R6,#eFlag__parseLval ;But carry on parsing one!
624 BL exp__pushVal ;Push that on the calc stack
625 CMP R9,#'$' ;Is this a dollar?
626 MOVLT R0,#(exp__bPling-exp__bTable)>>2
627 MOVEQ R0,#(exp__bDollar-exp__bTable)>>2
628 MOVGT R0,#(exp__bQuery-exp__bTable)>>2
629 ORR R0,R0,#1<<24 ;Make it precedence 1
630 BL exp__pushOp ;Stick that on the op stack
631 BL getToken ;Get another token
632 B %10express_read ;And read the operand
633
634 ; --- Read a hexadecimal number ---
635
636 exp__readHex MOV R0,#0 ;Initial value is zero
637 BL getToken ;Get a first token
638 SUB R14,R9,#'A' ;Is this a letter
639 CMP R14,#6 ;If so, make sure it's OK
640 ADDCC R14,R14,#10 ;And move on to 10-15
641 SUBCS R14,R9,#'0' ;Otherwise check for digit
642 CMPCS R14,#10 ;Make sure that's in range
643 MOVCS R0,#err_badHex ;If not, make an error
644 BCS error_report ;And stop doing this
645
646 00express_read ADD R0,R14,R0,LSL #4 ;Accumulate a result
647 BL getToken ;Get another token
648 SUB R14,R9,#'A' ;Is this a letter
649 CMP R14,#6 ;If so, make sure it's OK
650 ADDCC R14,R14,#10 ;And move on to 10-15
651 SUBCS R14,R9,#'0' ;Otherwise check for digit
652 CMPCS R14,#10 ;Make sure that's in range
653 BCC %b00express_read ;If it was OK, go round more
654
655 MOV R1,#vType_integer ;Call it an integer
656 BL exp__pushVal ;Stick that on the val stack
657 TST R6,#eFlag__parseLval ;Parsing an lvalue?
658 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
659 ORR R6,R6,#eFlag__op ;Now look for binary operator
660 B %10express_read ;And read the operator
661
662 ; --- Read a binary number ---
663
664 exp__readBin MOV R0,#0 ;Initial value is zero
665 BL getToken ;Get a first token
666 SUB R14,R9,#'0' ;Otherwise check for digit
667 CMP R14,#1 ;Make sure that's in range
668 MOVHI R0,#err_badHex ;If not, make an error
669 BHI error_report ;And stop doing this
670
671 00express_read ADC R0,R0,R0 ;Accumulate a result
672 BL getToken ;Get another token
673 SUB R14,R9,#'0' ;Otherwise check for digit
674 CMP R14,#1 ;Make sure that's in range
675 BLS %b00express_read ;If it was OK, go round more
676
677 MOV R1,#vType_integer ;Call it an integer
678 BL exp__pushVal ;Stick that on the val stack
679 TST R6,#eFlag__parseLval ;Parsing an lvalue?
680 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
681 ORR R6,R6,#eFlag__op ;Now look for binary operator
682 B %10express_read ;And read the operator
683
684 ; --- Read a decimal number ---
685
686 exp__readDec MOV R0,#0 ;Initial value is zero
687
688 00express_read ADD R0,R0,R0,LSL #2 ;Multiply accumulator by 5
689 ADD R0,R14,R0,LSL #1 ;Accumulate the result
690
691 BL getToken ;Get another token
692 SUB R14,R9,#'0' ;Otherwise check for digit
693 CMP R14,#10 ;Make sure that's in range
694 BCC %b00express_read ;If it was OK, go round more
695
696 MOV R1,#vType_integer ;Call it an integer
697 BL exp__pushVal ;Stick that on the val stack
698 TST R6,#eFlag__parseLval ;Parsing an lvalue?
699 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
700 ORR R6,R6,#eFlag__op ;Now look for binary operator
701 B %10express_read ;And read the operator
702
703 ; --- Read an identifier ---
704
705 exp__readIdent ADR R1,tsc_misc ;Point to a nice block
706 MOV R2,#vType_integer ;The current variable type
707
708 00express_read SUBS R4,R9,#'_' ;Is it an underscore?
709 SUBNE R4,R9,#'0' ;Or a number?
710 CMP R4,#10
711 SUBCS R4,R9,#'A' ;Or a capital letter?
712 CMPCS R4,#26
713 SUBCS R4,R9,#'a' ;Or a lowercase letter?
714 CMPCS R4,#26
715 STRCCB R9,[R1],#1 ;Yes -- store it away
716 BLCC getToken ;Read the next byte
717 MOVCS R0,#err_unknown ;Don't know this -- error!
718 BCS error_report ;So give a bogus error msg
719
720 CMP R9,#'$' ;Is it a dollar sign?
721 MOVEQ R2,#vType_string ;It's a string now
722 CMPNE R9,#'%' ;Or a percentage?
723 STREQB R9,[R1],#1 ;Yes -- store it then
724 CMPNE R9,#' ' ;Just check for a space
725
726 BNE %b00express_read ;Go round for more
727
728 MOV R14,#0 ;The terminator
729 STRB R14,[R1],#0 ;Store that in the var name
730 BL getToken ;Read the next token ready
731
732 ; --- Check for arrays ---
733
734 CMP R9,#'(' ;Is this an array?
735 BNE %f05 ;No -- skip on then
736 BL getToken ;Get another token
737 ADD R2,R2,#vType_dimInt-vType_integer
738 MOV R0,R2 ;Put that in R2
739 ADR R1,tsc_misc ;Point to variable name
740 BL var_find ;Find the variable
741 LDR R14,tsc_varTree ;Find var tree anchor
742 LDR R14,[R14,#0] ;Grrr...
743 SUB R3,R0,R14 ;Convert this to an offset
744 TST R6,#eFlag__lval ;Reading an lvalue?
745 ADDNE R2,R2,#vType_lvIntArr-vType_dimInt
746
747 CMP R9,#')' ;Is it a whole array?
748 BEQ %f00 ;Yes -- deal with that
749
750 ; --- Set up for subscripting the array ---
751
752 STMFD R13!,{R2} ;Save some registers
753 MOV R0,R3 ;Get the array's offset
754 BL exp__pushOp ;Stuff that on op stack (!)
755 LDMFD R13!,{R0} ;And get its type
756 BL exp__pushOp ;Stuff that on op stack too
757
758 GETOP R0,254,exp__bSubscript ;Get the operator value
759 TST R6,#eFlag__commaOk ;Are we allowing commas?
760 ORRNE R0,R0,#1<<16 ;Yes -- set the flag then
761 TST R6,#eFlag__lval ;Are we reading an value?
762 ORRNE R0,R0,#1<<17 ;Yes -- set that flag
763 BL exp__pushOp ;Put that on there
764 ORR R6,R6,#eFlag__commaOk ;Allow commas for a while
765 BIC R6,R6,#eFlag__lval ;Don't read as lvalues
766 ADD R6,R6,#1<<8 ;Increment the paren count
767 B %10express_read ;Now read the subscripts
768
769 ; --- Just store the array lvalue ---
770
771 00 BL getToken ;Skip over the bracket
772 MOV R1,R2 ;Get the type
773 MOV R0,R3 ;And the tree offset
774 BL exp__pushVal ;Stash it on the stack
775 ORR R6,R6,#eFlag__op ;Expect an operator
776 B %10express_read ;And go read that
777
778 ; --- Handle strings and things ---
779
780 05 TST R6,#eFlag__lval ;Are we reading an lvalue?
781 BNE %f20express_read ;Yes -- jump ahead
782
783 TST R6,#eFlag__parseLval ;Parsing an lvalue?
784 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
785
786 ADR R1,tsc_misc ;Point to variable name
787 MOV R0,R2 ;Get the variable type too
788 BL var_find ;Try to find the variable
789
790 ; --- Do wildly different things with strings ---
791
792 CMP R2,#vType_string ;Is this a string
793 BNE %f00 ;No -- jump ahead then
794 LDR R14,tsc_varTree ;Load base of variable tree
795 LDR R14,[R14]
796 SUB R0,R0,R14 ;Get the offset of node
797 ADD R0,R0,#4 ;Point to the actual word
798 MOV R1,#vType_lvString ;The variable type
799 BL ctrl_load ;Load the string into stracc
800 MOV R0,R2 ;Put rvalue into R0,R1
801 MOV R1,R3
802 BL exp__pushVal ;Stack that nicely
803 ORR R6,R6,#eFlag__op ;Expect an operator
804 B %10express_read ;And keep on looking
805
806 00express_read MOV R1,R2 ;Get the operand type
807 LDR R0,[R0,#4] ;Load the integer value
808 BL exp__pushVal ;Stack that nicely
809
810 ; --- Now try to cope with indirection ---
811
812 CMP R9,#'!' ;Is this an indirection op?
813 CMPNE R9,#'?' ;Or maybe a different one
814 ORRNE R6,R6,#eFlag__op ;No -- expect an operator
815 BNE %10express_read ;And go for that then
816
817 CMP R9,#'?' ;Is this a '?' ?
818 MOVEQ R0,#(exp__bQuery-exp__bTable)>>2
819 MOVNE R0,#(exp__bPling-exp__bTable)>>2
820 ORR R0,R0,#1<<24 ;Use unary op precedence
821 BL exp__pushOp ;Stick that on the stack
822 BL getToken ;Get another token
823 B %10express_read ;Return, still expecting val
824
825 ; --- We are reading an lvalue ---
826 ;
827 ; We only need to create the variable if there is not an
828 ; indirection operator following.
829
830 20express_read CMP R9,#'!' ;Is this an indirection op?
831 CMPNE R9,#'?' ;Or maybe a different one
832 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
833 BIC R6,R6,#eFlag__lval ;Clear lvalue flag too
834 ORR R6,R6,#eFlag__parseLval ;Parse an lvalue-ish now
835
836 ADR R1,tsc_misc ;Point to variable name
837 MOV R0,R2 ;Get the variable type too
838 BLNE var_create ;Create the variable maybe
839 BLEQ var_find ;Or maybe we just find it
840
841 ADR R14,exp__indirTran ;Point to the translation
842 LDRB R1,[R14,R2] ;Get the new type
843 LDRNE R14,tsc_varTree ;Get the tree address
844 LDRNE R14,[R14] ;Wimp_Extension is shitty
845 SUBNE R0,R0,R14 ;Find the offset
846 ADDNE R0,R0,#4 ;Point to the actual value
847 LDREQ R0,[R0,#4] ;If indirect op, load value
848 BL exp__pushVal ;Push on the new value
849
850 CMP R9,#'?' ;Is this a '?' ?
851 MOVEQ R0,#(exp__bQuery-exp__bTable)>>2
852 MOVNE R0,#(exp__bPling-exp__bTable)>>2
853 CMPNE R9,#'!' ;Or a '!' ?
854 ORREQ R0,R0,#1<<24 ;Use unary op precedence
855 BLEQ exp__pushOp ;Stick that on the stack
856 BLEQ getToken ;Get a token if we need to
857
858 B %10express_read ;Return, still expecting val
859
860 ; --- Try reading an operator ---
861
862 50express_read CMP R9,#')' ;Is this a close bracket?
863 BEQ exp__en ;Yes -- deal with that then
864
865 CMP R9,#',' ;Is it a comma?
866 BEQ exp__comma ;Yes -- deal with that
867
868 ADRL R5,exp__opTable ;Point to the op table
869 LDR R0,[R5,R7,LSL #3]! ;Load the precedence
870 CMP R0,#0 ;Is this reasonable?
871 ORREQ R6,R6,#eFlag__done ;No -- stop then
872 BEQ %10express_read ;Let things tidy up nicely
873
874 BL exp__eval ;Evaluate things on the stack
875 LDR R5,[R5,#4] ;Load the branch table offset
876 ORR R0,R5,R0,LSL #24 ;Build the op stack entry
877 ADD R0,R0,R8 ;Add on the op index
878 BL exp__pushOp ;Stick that on the stack
879 BL getToken ;Get another token
880 BIC R6,R6,#eFlag__op ;Expect another operand
881 B %10express_read ;And go round again
882
883 ; --- Handle a closing bracket ---
884
885 exp__en SUBS R6,R6,#1<<8 ;Decrement paren counter
886 ORRLT R6,R6,#eFlag__done ;If no parens, then stop
887 BLT %10express_read ;It was someone else's `)'
888 BL getToken ;Get another token
889 MOV R0,#252 ;Stop at the dummy `(' op
890 BL exp__eval ;Force evaluation of that lot
891 BL exp__popOp ;Pop the dummy operator
892
893 ; --- Check for comma-separated pseudo-ops ---
894
895 MOV R14,R0,LSR #24 ;Get the op precedence
896 CMP R14,#254 ;Is it a cs-pseudo-op?
897 BNE %10express_read ;No -- keep going then
898
899 ; --- Reset the flags from the operator ---
900
901 BIC R6,R6,#eFlag__lval+eFlag__commaOk
902 TST R0,#1<<16 ;Is the comma-ok flag set?
903 ORRNE R6,R6,#eFlag__commaOk ;Yes -- then set it in R6
904 TST R0,#1<<17 ;Is the lvalue flag set?
905 ORRNE R6,R6,#eFlag__done+eFlag__lval
906
907 ; --- Now do the required processing ---
908
909 MOV R5,R0,LSR #8 ;Get the number of arguments
910 ADD R5,R5,#1 ;One less comman than subs
911 AND R5,R5,#&FF ;Clear the other bits
912 AND R0,R0,#&FF ;Also find jump entry
913 ADRL R14,exp__bTable ;Find the op table
914 ADD PC,R14,R0,LSL #2 ;And dispatch
915
916 ; --- Handle a comma ---
917
918 exp__comma TST R6,#eFlag__commaOk ;Expecting a comma here?
919 ORREQ R6,R6,#eFlag__done ;No -- must be someone else's
920 BEQ %10express_read ;So let them handle it
921 BL getToken ;Gobble the comma char
922 MOV R0,#253 ;Evaluate up to pseudoop
923 BL exp__eval ;Do lots of evaluating
924 BL exp__popOp ;Pop the pseudoop
925 ADD R0,R0,#1<<8 ;Bump the argument count
926 BL exp__pushOp ;Put the pseudoop back again
927 BIC R6,R6,#eFlag__op ;Read another operand
928 B %10express_read ;Now continue doing things
929
930 ; --- We have finished reading the expression ---
931
932 70express_read MOV R0,#254 ;Choose a suitable prec.
933 BL exp__eval ;Do rest of evaluations
934 BL exp__popOp ;Pop of the expression
935
936 ; --- See if this was an evaluated string ---
937
938 AND R14,R0,#&FF ;Get the branch table offset
939 CMP R14,#(exp__bEvalOp-exp__bTable)>>2
940 BEQ exp__endEval ;Yes -- continue doing that
941
942 LDMFD R13!,{R0-R6,PC}^ ;Load some registers
943
944 exp__indirTran DCB vType_lvInt
945 DCB vType_lvString
946 DCB vType_lvIntArr
947 DCB vType_lvStrArr
948
949 LTORG
950
951 ; --- exp__eval ---
952 ;
953 ; On entry: R0 == precedence to look for
954 ; R7, R8, R9 == lookahead token
955 ; R10 == pointer into tokenised buffer
956 ; R11 == evaluation stack pointer
957 ; R12 == anchor pointer
958 ;
959 ; On exit: R1-R4 corrupted
960 ;
961 ; Use: Performs things
962
963 exp__eval ROUT
964
965 STMFD R13!,{R0,R14} ;Stack some registers
966 00exp__eval BL exp__popOp ;Pop an operator
967 LDR R1,[R13,#0] ;Load back thing
968 CMP R1,R0,LSR #24 ;Compare the prec things
969 BLT %10exp__eval ;It's GE so jump ahead
970 MOV R2,R0 ;Put op thing in R2
971 AND R0,R0,#&FF ;Get the branch offset
972 ADR R1,exp__bTable ;Point to the table
973 ADD PC,R1,R0,LSL #2 ;Branch to the do it routine
974 exp__evalRet BL exp__pushVal ;Push the returned value
975 B %00exp__eval ;And keep on going
976
977 10exp__eval BL exp__pushOp ;Push it back on again
978 LDMFD R13!,{R0,PC}^ ;Return to caller
979
980 LTORG
981
982 ; --- exp__doMultArg ---
983 ;
984 ; On entry: R5 == number of subscripts provided
985 ; R6 == flags
986 ; R7, R8, R9 == lookahead token
987 ; R10 == pointer into tokenised buffer
988 ; R11 == upcall block pointer
989 ; R12 == anchor pointer
990 ;
991 ; On exit: R0-R3 corrupted
992 ;
993 ; Use: Subscripts an array of things to find just one of them.
994
995 exp__doMultArg ROUT
996
997 BL exp__popOp ;Pop off the function
998 AND R0,R0,#&FF ;Get the branch offset
999 ADR R1,exp__bTable ;Point to the table
1000 MOV R14,PC ;Set up return address
1001 ADD PC,R1,R0,LSL #2 ;Branch to the do it routine
1002 BL exp__pushVal ;Push the returned value
1003 B exp__mainLoop ;Go back to main loop
1004
1005 LTORG
1006
1007 ; --- A nice precedance table ----
1008
1009 exp__opTable DCD 0,0
1010 DCD 25,(exp__andOps-exp__bTable)>>2
1011 DCD 0,0
1012 DCD 0,0
1013 DCD 0,0
1014 DCD 0,0
1015 DCD 0,0
1016 DCD 10,(exp__multOps-exp__bTable)>>2
1017 DCD 30,(exp__orOps-exp__bTable)>>2
1018 DCD 0,0
1019 DCD 0,0
1020 DCD 0,0
1021 DCD 20,(exp__relOps-exp__bTable)>>2
1022 DCD 15,(exp__addOps-exp__bTable)>>2
1023 DCD 0,0
1024 DCD 5,(exp__powOps-exp__bTable)>>2
1025
1026 ; --- The main dispatch table ---
1027
1028 exp__bTable
1029
1030 exp__andOps B exp__doAnd
1031
1032 exp__multOps B exp__doDiv
1033 B exp__doMod
1034 B exp__doDiv
1035 B exp__doMult
1036
1037 exp__orOps B exp__doXor
1038 B exp__doOr
1039
1040 exp__relOps B exp__doEqual
1041 B exp__doLess
1042 B exp__doLessEq
1043 B exp__doNotEq
1044 B exp__doMore
1045 B exp__doMoreEq
1046 B exp__doLSL
1047 B exp__doASR
1048 B exp__doLSR
1049
1050 exp__addOps B exp__doAdd
1051 B exp__doSub
1052
1053 exp__fns B exp__doAbs
1054 B exp__doAsc
1055 B exp__doChrS
1056 B exp__doEval
1057 B exp__doLen
1058 B exp__doNot
1059 B exp__doOpenin
1060 B exp__doOpenout
1061 B exp__doOpenup
1062 B exp__doSgn
1063 B exp__doStrS
1064 B exp__doVal
1065
1066 exp__streamOps B exp__doBget
1067 B exp__doEof
1068 B exp__doExt
1069 B exp__doGetS
1070 B exp__doPtr
1071
1072 exp__multArgs B exp__doInstr
1073 B exp__doLeftS
1074 B exp__doMidS
1075 B exp__doRightS
1076 B exp__doStringS
1077
1078 exp__powOps B exp__doPow
1079
1080 exp__bUMinus B exp__doUMinus
1081 exp__bPar B exp__doParen
1082 exp__bExpEnd B exp__doEndEval
1083 exp__bEvalOp B exp__doEndEval
1084 exp__bPling B exp__doPling
1085 exp__bQuery B exp__doQuery
1086 exp__bDollar B exp__doDollar
1087
1088 exp__bSubscript B exp__doSubscript
1089
1090 exp__bMultArg B exp__doMultArg
1091
1092 ; --- exp__doAdd ---
1093 ;
1094 ; On entry: R7, R8, R9 == lookahead token
1095 ; R10 == pointer into tokenised buffer
1096 ; R11 == evaluation stack pointer
1097 ; R12 == anchor pointer
1098 ;
1099 ; On exit: R0-R3 corrupted
1100 ;
1101 ; Use: Adds two things.
1102
1103 exp__doAdd ROUT
1104
1105 BL exp__popTwoVals ;Get two values
1106 CMP R1,#vType_integer ;Is this an integer?
1107 BNE %10exp__doAdd ;No -- onwards ho
1108
1109 CMP R3,#vType_integer ;Is this a integer too?
1110 MOVNE R0,#err_numNeeded ;No -- get error number
1111 BNE error_report ;...and report the error
1112 ADD R0,R0,R2 ;Add the numbers together
1113 B exp__evalRet ;Jump back into eval loop
1114
1115 ; --- Concatenate strings ---
1116
1117 10exp__doAdd CMP R1,#vType_string ;This is a string I hope
1118 MOVNE R0,#err_arrayBad ;Arrays are bad
1119 BNE error_report ;So says my mum
1120 CMP R3,#vType_string ;Is this a string too?
1121 MOVNE R0,#err_strNeeded ;No -- get error number
1122 BNE error_report ;...and report the error
1123
1124 MOV R14,R2,LSL #24 ;Get the second string len
1125 CMN R14,R0,LSL #24 ;Is the string short enough?
1126 ADDCC R0,R0,R14,LSR #24 ;Add on second length
1127 BCC exp__evalRet ;Finished -- return
1128
1129 MOV R0,#err_strTooLong ;String is too long
1130 B error_report
1131
1132 LTORG
1133
1134 ; --- exp__doSub ---
1135 ;
1136 ; On entry: R7, R8, R9 == lookahead token
1137 ; R10 == pointer into tokenised buffer
1138 ; R11 == evaluation stack pointer
1139 ; R12 == anchor pointer
1140 ;
1141 ; On exit: R0-R3 corrupted
1142 ;
1143 ; Use: Subtracts one thing from another thing.
1144
1145 exp__doSub ROUT
1146
1147 BL exp__popTwoInts ;Get two integers
1148 SUB R0,R0,R2 ;Subtract the things
1149 B exp__evalRet ;Jump back into eval loop
1150
1151 LTORG
1152
1153 ; --- exp__doMult ---
1154 ;
1155 ; On entry: R7, R8, R9 == lookahead token
1156 ; R10 == pointer into tokenised buffer
1157 ; R11 == evaluation stack pointer
1158 ; R12 == anchor pointer
1159 ;
1160 ; On exit: R0-R3 corrupted
1161 ;
1162 ; Use: Multiplies two things together.
1163
1164 exp__doMult ROUT
1165
1166 BL exp__popTwoInts ;Get two integers
1167 MUL R0,R2,R0 ;Multiply the things
1168 B exp__evalRet ;Jump back into eval loop
1169
1170 LTORG
1171
1172 ; --- exp__doDiv ---
1173 ;
1174 ; On entry: R7, R8, R9 == lookahead token
1175 ; R10 == pointer into tokenised buffer
1176 ; R11 == evaluation stack pointer
1177 ; R12 == anchor pointer
1178 ;
1179 ; On exit: R0-R3 corrupted
1180 ;
1181 ; Use: Divides one thing by another thing.
1182
1183 exp__doDiv ROUT
1184
1185 BL exp__popTwoInts ;Get two integers
1186 MOV R1,R2 ;Get the other thing to do
1187 BL divide ;Divide the things
1188 MOV R1,#vType_integer ;Set the return type
1189 B exp__evalRet ;Jump back into eval loop
1190
1191 LTORG
1192
1193 ; --- exp__doMod ---
1194 ;
1195 ; On entry: R7, R8, R9 == lookahead token
1196 ; R10 == pointer into tokenised buffer
1197 ; R11 == evaluation stack pointer
1198 ; R12 == anchor pointer
1199 ;
1200 ; On exit: R0-R3 corrupted
1201 ;
1202 ; Use: Gives the remainder when one thing is divided by another
1203 ; thing.
1204
1205 exp__doMod ROUT
1206
1207 BL exp__popTwoInts ;Get two integers
1208 MOV R1,R2 ;Get the dividend ready
1209 BL divide ;Divide the things
1210 MOV R0,R1 ;Get the remainder
1211 MOV R1,#vType_integer ;Get the type of the thing
1212 B exp__evalRet ;Jump back into eval loop
1213
1214 LTORG
1215
1216 ; --- exp__doPow ---
1217 ;
1218 ; On entry: R7, R8, R9 == lookahead token
1219 ; R10 == pointer into tokenised buffer
1220 ; R11 == evaluation stack pointer
1221 ; R12 == anchor pointer
1222 ;
1223 ; On exit: R0-R3 corrupted
1224 ;
1225 ; Use: Raises one thing to the power of another thing.
1226
1227 exp__doPow ROUT
1228
1229 BL exp__popTwoInts ;Get two integers
1230
1231 ; --- Check for some special cases ---
1232
1233 CMP R0,#1 ;Raising 1 ^ anything...
1234 CMPNE R2,#0 ;And raising anything ^ 0...
1235 MOVEQ R0,#1 ;Gives you 1
1236 BEQ exp__evalRet ;And return to eval loop
1237
1238 CMP R2,#0 ;Is the exponent negative?
1239 MOVLT R0,#0 ;Yes -- result is fractional
1240 BLT exp__evalRet ;And return to eval loop
1241
1242 ; --- Now we use a cunning loop to make this quick ---
1243 ;
1244 ; Basically, we note that x^2y == (x^2)^y
1245
1246 MOV R3,R0 ;Look after the x value
1247 MOV R0,#1 ;An initial multiplier
1248
1249 10exp__doPow MOVS R2,R2,LSR #1 ;Get bottom bit
1250 MULCS R0,R3,R0 ;If set, do multiply
1251 MUL R14,R3,R3 ;Square thing to raise
1252 MOV R3,R14 ;Can't do in one instr :-(
1253 BNE %10exp__doPow ;If not finished, continue
1254
1255 B exp__evalRet ;Go back to eval loop
1256
1257 LTORG
1258
1259 ; --- exp__doAnd ---
1260 ;
1261 ; On entry: R7, R8, R9 == lookahead token
1262 ; R10 == pointer into tokenised buffer
1263 ; R11 == evaluation stack pointer
1264 ; R12 == anchor pointer
1265 ;
1266 ; On exit: R0-R3 corrupted
1267 ;
1268 ; Use: ANDs two things.
1269
1270 exp__doAnd ROUT
1271
1272 BL exp__popTwoInts ;Get two integers
1273 AND R0,R0,R2 ;Do the AND op
1274 B exp__evalRet ;Jump back into eval loop
1275
1276 LTORG
1277
1278 ; --- exp__doOr ---
1279 ;
1280 ; On entry: R7, R8, R9 == lookahead token
1281 ; R10 == pointer into tokenised buffer
1282 ; R11 == evaluation stack pointer
1283 ; R12 == anchor pointer
1284 ;
1285 ; On exit: R0-R3 corrupted
1286 ;
1287 ; Use: ORs two things.
1288
1289 exp__doOr ROUT
1290
1291 BL exp__popTwoInts ;Get two integers
1292 ORR R0,R0,R2 ;Do the OR op
1293 B exp__evalRet ;Jump back into eval loop
1294
1295 LTORG
1296
1297 ; --- exp__doXor ---
1298 ;
1299 ; On entry: R7, R8, R9 == lookahead token
1300 ; R10 == pointer into tokenised buffer
1301 ; R11 == evaluation stack pointer
1302 ; R12 == anchor pointer
1303 ;
1304 ; On exit: R0-R3 corrupted
1305 ;
1306 ; Use: XORs two things.
1307
1308 exp__doXor ROUT
1309
1310 BL exp__popTwoInts ;Get two integers
1311 EOR R0,R0,R2 ;Do the XOR op
1312 B exp__evalRet ;Jump back into eval loop
1313
1314 LTORG
1315
1316 ; --- exp__doPling ---
1317 ;
1318 ; On entry: R7, R8, R9 == lookahead token
1319 ; R10 == pointer into tokenised buffer
1320 ; R11 == evaluation stack pointer
1321 ; R12 == anchor pointer
1322 ;
1323 ; On exit: R0-R3 corrupted
1324 ;
1325 ; Use: Reads a word from a memory address.
1326
1327 exp__doPling ROUT
1328
1329 BL exp__popTwoVals ;Get next two values
1330 CMP R1,#vType_lvInt ;We can cope with lvalues
1331 BEQ %50exp__doPling ;If this is the case, be odd
1332 BL exp__chkTwoInts ;Make sure we have integers
1333 LDR R0,[R0,R2] ;Load the word
1334 B exp__evalRet ;Jump back into eval loop
1335
1336 50exp__doPling CMP R3,#vType_integer ;Make sure other val is int
1337 MOVNE R0,#err_numNeeded ;If not, moan at the user
1338 BNE error_report ;That's that done then
1339 ADD R0,R0,R2 ;Calculate the address
1340 MOV R1,#vType_lvWord ;This is a word lvalue
1341 B exp__evalRet ;Jump back into eval loop
1342
1343 LTORG
1344
1345 ; --- exp__doQuery ---
1346 ;
1347 ; On entry: R7, R8, R9 == lookahead token
1348 ; R10 == pointer into tokenised buffer
1349 ; R11 == evaluation stack pointer
1350 ; R12 == anchor pointer
1351 ;
1352 ; On exit: R0-R3 corrupted
1353 ;
1354 ; Use: Reads a byte from a memory address.
1355
1356 exp__doQuery ROUT
1357
1358 BL exp__popTwoVals ;Get next two values
1359 CMP R1,#vType_lvInt ;We can cope with lvalues
1360 BEQ %50exp__doQuery ;If this is the case, be odd
1361 BL exp__chkTwoInts ;Make sure we have integers
1362 LDRB R0,[R0,R2] ;Load the byte
1363 B exp__evalRet ;Jump back into eval loop
1364
1365 50exp__doQuery CMP R3,#vType_integer ;Make sure other val is int
1366 MOVNE R0,#err_numNeeded ;If not, moan at the user
1367 BNE error_report ;That's that done then
1368 ADD R0,R0,R2 ;Calculate the address
1369 MOV R1,#vType_lvByte ;This is a byte lvalue
1370 B exp__evalRet ;Jump back into eval loop
1371
1372 LTORG
1373
1374 ; --- exp__doDollar ---
1375 ;
1376 ; On entry: R7, R8, R9 == lookahead token
1377 ; R10 == pointer into tokenised buffer
1378 ; R11 == evaluation stack pointer
1379 ; R12 == anchor pointer
1380 ;
1381 ; On exit: R0-R3 corrupted
1382 ;
1383 ; Use: Reads a word from a memory address.
1384
1385 exp__doDollar ROUT
1386
1387 BL exp__popTwoVals ;Get next two values
1388 CMP R1,#vType_lvInt ;We can cope with lvalues
1389 BEQ %50exp__doDollar ;If this is the case, be odd
1390 BL exp__chkTwoInts ;Make sure we have integers
1391
1392 ADD R2,R0,R2 ;Point to the string
1393 BL stracc_ensure ;Make sure there is room
1394 MOV R3,#0 ;Number so far
1395 00 LDRB R14,[R2],#1 ;Load a byte
1396 CMP R14,#13 ;Is this the terminator?
1397 BEQ %10exp__doDollar ;Yes -- jump ahead
1398 STRB R14,[R0],#1 ;No -- save it away
1399 ADD R3,R3,#1 ;Increment the length
1400 CMP R3,#255 ;Are we at the maximum?
1401 BLT %b00 ;No -- branch back then
1402
1403 10 ORR R0,R1,R3 ;Set up the lvalue
1404 MOV R1,#vType_string ;This is a string
1405 B exp__evalRet ;Jump back into eval loop
1406
1407 ; --- The lvalue form ---
1408
1409 50exp__doDollar CMP R3,#vType_integer ;Make sure other val is int
1410 MOVNE R0,#err_numNeeded ;If not, moan at the user
1411 BNE error_report ;That's that done then
1412 ADD R0,R0,R2 ;Calculate the address
1413 MOV R1,#vType_lvBytes ;This is a bytes lvalue
1414 B exp__evalRet ;Jump back into eval loop
1415
1416 LTORG
1417
1418 ; --- RND ---
1419
1420 exp__doRnd ROUT
1421
1422 CMP R9,#'(' ;Do we have a bracket here?
1423 MOVNE R0,#-1 ;No -- range here then
1424 BLNE exp__rng ;And generate random number
1425 ORRNE R6,R6,#eFlag__op ;Read operator next
1426 BNE exp__mainLoop ;And go back up top
1427 BL getToken ;Gobble the bracket
1428
1429 ; --- Start scanning for an RND multi-op ---
1430
1431 GETOP R0,1,exp__rndArg ;Get the operator value
1432 BL exp__pushOp ;Put that on the stack
1433
1434 GETOP R0,254,exp__bMultArg ;Get the operator value
1435 TST R6,#eFlag__commaOk ;Are we allowing commas?
1436 ORRNE R0,R0,#1<<16 ;Yes -- set the flag then
1437 BL exp__pushOp ;Put that on there
1438 BIC R6,R6,#eFlag__commaOk ;Disallow commas for a while
1439 ADD R6,R6,#1<<8 ;Increment the paren count
1440 B exp__mainLoop ;And go back up top
1441
1442 LTORG
1443
1444 ; --- RND(arg) ---
1445
1446 exp__rndArg ROUT
1447
1448 STMFD R13!,{R14} ;Save a register
1449 BL exp__popInt ;Pop off the argument
1450 CMP R0,#0 ;Is the value negative?
1451 BLT %50exp__rndArg ;Yes -- deal with that
1452 CMPNE R0,#1 ;Is it one then?
1453 BEQ %60exp__rndArg ;Yes -- be odd then
1454 BL exp__rng ;And generate random number
1455 BL exp__popVal ;Pop the value off
1456 LDMFD R13!,{PC}^ ;Return to caller
1457
1458 ; --- Store a seed ---
1459
1460 50exp__rndArg STR R0,tsc_rndSeed ;Store the new seed
1461 MOV R14,#0 ;Clear the top bit
1462 STR R14,tsc_rndSeed+4 ;Store that too
1463 LDMFD R13!,{PC}^ ;And return to caller
1464
1465 ; --- Request for FP random number ---
1466
1467 60exp__rndArg STMFD R13!,{R5} ;Save another register
1468 MOV R0,#0 ;Return zero here
1469 MOV R1,#vType_integer ;Say this is an integer
1470 LDMFD R13!,{R5,PC}^ ;And return
1471
1472 LTORG
1473
1474 ; --- exp__rng ---
1475 ;
1476 ; On entry: R0 == maximum value for random number
1477 ;
1478 ; On exit: --
1479 ;
1480 ; Use: Stacks a random number between 1 and R0.
1481
1482 exp__rng ROUT
1483
1484 STMFD R13!,{R0-R5,R14} ;Save lots of registers
1485 MOV R3,R0 ;Look after this
1486 ADR R14,tsc_rndSeed ;Find the random seed
1487 LDMIA R14,{R0,R1} ;Load that out
1488 TST R1,R1,LSR #1 ;Top bit into carry
1489 MOVS R2,R0,RRX ;33-bit rotate right
1490 ADC R1,R1,R1 ;Carry into LSB of Rb
1491 EOR R2,R2,R0,LSL #12 ;(Involved!)
1492 EOR R0,R2,R2,LSR #20 ;(Similarly involved!)
1493 STMIA R14,{R0,R1} ;Store new seed back
1494 MOV R1,R3 ;Get maximum value again
1495 BL div_unsigned ;Do the division we need
1496 ADD R0,R1,#1 ;Fit it into range
1497 MOV R1,#vType_integer ;This is an integer
1498 BL exp__pushVal ;Push it onto the stack
1499 LDMFD R13!,{R0-R5,PC}^ ;And return to caller
1500
1501 LTORG
1502
1503 ; --- Relational operators (and shifts) ---
1504 ;
1505 ; On entry: R7, R8, R9 == lookahead token
1506 ; R10 == pointer into tokenised buffer
1507 ; R11 == evaluation stack pointer
1508 ; R12 == anchor pointer
1509 ;
1510 ; On exit: R0-R3 corrupted
1511 ;
1512 ; Use: Does comparing. Or shifting. Depending.
1513
1514 exp__doLess ROUT
1515
1516 BL exp__popTwoVals ;Get two values
1517 BL ctrl_compare ;Compare them
1518 MOVLT R0,#-1 ;It's less -- that's true
1519 MOVGE R0,#0 ;It's more or equal, -- false
1520 MOV R1,#vType_integer ;We are returning an integer
1521 B exp__evalRet ;Jump back into eval loop
1522
1523 LTORG
1524
1525 exp__doMore ROUT
1526
1527 BL exp__popTwoVals ;Get two values
1528 BL ctrl_compare ;Compare them
1529 MOVGT R0,#-1 ;It's more -- that's true
1530 MOVLE R0,#0 ;It's less or equal, -- false
1531 MOV R1,#vType_integer ;We are returning an integer
1532 B exp__evalRet ;Jump back into eval loop
1533
1534 LTORG
1535
1536 exp__doLessEq ROUT
1537
1538 BL exp__popTwoVals ;Get two values
1539 BL ctrl_compare ;Compare them
1540 MOVLE R0,#-1 ;It's less or equal -- true
1541 MOVGT R0,#0 ;It's more -- that's false
1542 MOV R1,#vType_integer ;We are returning an integer
1543 B exp__evalRet ;Jump back into eval loop
1544
1545 LTORG
1546
1547 exp__doMoreEq ROUT
1548
1549 BL exp__popTwoVals ;Get two values
1550 BL ctrl_compare ;Compare them
1551 MOVGE R0,#-1 ;It's more or equal -- true
1552 MOVLT R0,#0 ;It's less -- that's false
1553 MOV R1,#vType_integer ;We are returning an integer
1554 B exp__evalRet ;Jump back into eval loop
1555
1556 LTORG
1557
1558 exp__doEqual ROUT
1559
1560 BL exp__popTwoVals ;Get two values
1561 BL ctrl_compare ;Compare them
1562 MOVEQ R0,#-1 ;If equal, return TRUE
1563 MOVNE R0,#0 ;Otherwise return FALSE
1564 MOV R1,#vType_integer ;We are returning an integer
1565 B exp__evalRet ;Jump back into eval loop
1566
1567 LTORG
1568
1569 exp__doNotEq ROUT
1570
1571 BL exp__popTwoVals ;Get two values
1572 BL ctrl_compare ;Compare them
1573 MOVNE R0,#-1 ;If nonzero, return TRUE
1574 MOVEQ R0,#0 ;Otherwise return FALSE
1575 MOV R1,#vType_integer ;We are returning an integer
1576 B exp__evalRet ;Jump back into eval loop
1577
1578 LTORG
1579
1580 exp__doLSL ROUT
1581
1582 BL exp__popTwoInts ;Get two integers
1583 MOV R0,R0,LSL R2 ;Do the shift
1584 B exp__evalRet ;Jump back into eval loop
1585
1586 LTORG
1587
1588 exp__doLSR ROUT
1589
1590 BL exp__popTwoInts ;Get two integers
1591 MOV R0,R0,LSR R2 ;Do the shift
1592 B exp__evalRet ;Jump back into eval loop
1593
1594 LTORG
1595
1596 exp__doASR ROUT
1597
1598 BL exp__popTwoInts ;Get two integers
1599 MOV R0,R0,ASR R2 ;Do the shift
1600 B exp__evalRet ;Jump back into eval loop
1601
1602 LTORG
1603
1604 ; --- exp__doUMinus ---
1605 ;
1606 ; On entry: R7, R8, R9 == lookahead token
1607 ; R10 == pointer into tokenised buffer
1608 ; R11 == evaluation stack pointer
1609 ; R12 == anchor pointer
1610 ;
1611 ; On exit: R0-R3 corrupted
1612 ;
1613 ; Use: Negates a thing.
1614
1615 exp__doUMinus ROUT
1616
1617 BL exp__popInt ;Pop a val
1618 RSB R0,R0,#0 ;Negate the thing
1619 B exp__evalRet ;Jump back into eval loop
1620
1621 LTORG
1622
1623 ; --- exp__doSubscript ---
1624 ;
1625 ; On entry: R5 == number of subscripts provided
1626 ; R6 == flags
1627 ; R7, R8, R9 == lookahead token
1628 ; R10 == pointer into tokenised buffer
1629 ; R11 == upcall block pointer
1630 ; R12 == anchor pointer
1631 ;
1632 ; On exit: R0-R3 corrupted
1633 ;
1634 ; Use: Subscripts an array of things to find just one of them.
1635
1636 exp__doSubscript ROUT
1637
1638 BL exp__popOp ;Read the array's type
1639 STMFD R13!,{R0} ;Save that away
1640 BL exp__popOp ;Now find the offset too
1641 LDMFD R13!,{R2} ;Restore the type word
1642 LDR R14,tsc_varTree ;Find the variable tree
1643 LDR R14,[R14,#0] ;Grrr...
1644 ADD R3,R0,R14 ;Find the actual array
1645
1646 ; --- Do some preliminary checking ---
1647
1648 LDR R14,[R3,#4] ;Find number of subscripts
1649 CMP R14,R5 ;Do they match up?
1650 MOVNE R0,#err_numSubs ;No -- get an error
1651 BNE error_report ;And report it
1652
1653 ; --- Now actually find the element ---
1654
1655 STMFD R13!,{R2,R7-R10} ;Save some more registers
1656 ADD R10,R3,#12 ;Point to subscripts
1657 ADD R10,R10,R5,LSL #2 ;Find topmost subscript
1658 MOV R9,R10 ;Do this again
1659 MOV R8,#0 ;Current element is 0
1660 MOV R7,R5 ;Get the number of subscripts
1661
1662 00 BL exp__popInt ;Read the next integer
1663 LDR R14,[R9,#-4]! ;And load subscript size
1664 CMP R0,R14 ;How does this compare?
1665 MOVCS R0,#err_subRange ;Out of range -- get error
1666 BCS error_report ;And report it
1667 MLA R8,R14,R8,R0 ;Accumulate subscript
1668 SUBS R7,R7,#1 ;Decrement my counter
1669 BGT %b00 ;If more to go, keep on
1670
1671 ; --- Finally get an rvalue or lvalue as required ---
1672
1673 ADD R0,R10,R8,LSL #2 ;Find the lvalue
1674 LDMFD R13!,{R1,R7-R10} ;Restore system registers
1675 LDR R14,tsc_varTree ;Find the variable tree
1676 LDR R14,[R14,#0] ;Grrr...
1677 SUB R0,R0,R14 ;Yes -- turn into offset
1678 TST R6,#eFlag__lval ;Reading an lvalue?
1679 SUBNE R1,R1,#vType_lvIntArr-vType_lvInt
1680 SUBEQ R1,R1,#vType_dimInt-vType_lvInt
1681 BLEQ ctrl_load ;No -- load rvalue then
1682 MOVEQ R0,R2 ;And shift results around
1683 MOVEQ R1,R3 ;Because of strangeness
1684 BL exp__pushVal ;Push the result
1685 B exp__mainLoop ;Go back to main loop
1686
1687 LTORG
1688
1689 ; --- exp__doParen ---
1690 ;
1691 ; On entry: R7, R8, R9 == lookahead token
1692 ; R10 == pointer into tokenised buffer
1693 ; R11 == evaluation stack pointer
1694 ; R12 == anchor pointer
1695 ;
1696 ; On exit: R0-R3 corrupted
1697 ;
1698 ; Use: Complains.
1699
1700 exp__doParen ROUT
1701
1702 MOV R0,#err_expBracket ;Get the error message
1703 B error_report ;And complain bitterly
1704
1705 LTORG
1706
1707 ; --- exp__doEndEval ---
1708 ;
1709 ; On entry: R7, R8, R9 == lookahead token
1710 ; R10 == pointer into tokenised buffer
1711 ; R11 == evaluation stack pointer
1712 ; R12 == anchor pointer
1713 ;
1714 ; On exit: R0-R3 corrupted
1715 ;
1716 ; Use: Complains.
1717
1718 exp__doEndEval ROUT
1719
1720 MOV R0,#err_erk ;Get the error message
1721 B error_report ;And complain bitterly
1722
1723 LTORG
1724
1725 ; --- exp__getString ---
1726 ;
1727 ; On entry: R0 == buffer for string
1728 ; R7, R8, R9 == lookahead token
1729 ; R10 == pointer into tokenised buffer
1730 ; R11 == evaluation stack pointer
1731 ; R12 == anchor pointer
1732 ;
1733 ; On exit: R0 == length of string
1734 ;
1735 ; Use: Reads a string argument, and copies it into tsc_misc.
1736
1737 exp__getString ROUT
1738
1739 STMFD R13!,{R1-R5,R14} ;Stack some register
1740 MOV R5,R0 ;Look after address
1741 BL exp__popStr ;Get a string
1742 LDR R1,tsc_stracc ;Get the stracc address
1743 LDR R1,[R1]
1744 ADD R1,R1,R0,LSR #8 ;Point to the string
1745 AND R2,R0,#&FF ;Get the length
1746 MOV R3,R0 ;Look after the rvalue
1747 MOV R0,R5 ;Point to a buffer
1748 BL termite_copyString ;Copy the string over
1749 MOV R0,R3 ;Put the rvalue back
1750 BL stracc_free ;Won't need it any more
1751 MOV R0,R2 ;Put the length in R0
1752 LDMFD R13!,{R1-R5,PC}^ ;Return to caller
1753
1754 LTORG
1755
1756 ;----- Pseudovariables ------------------------------------------------------
1757
1758 ; --- TIME ---
1759
1760 exp__doTime STMFD R13!,{R14}
1761 SWI OS_ReadMonotonicTime
1762 LDR R1,tsc_timeOff
1763 SUB R0,R0,R1
1764 MOV R1,#vType_integer
1765 BL exp__pushVal
1766 LDMFD R13!,{PC}^
1767
1768 ; --- TIME$ ---
1769
1770 exp__doTimeS STMFD R13!,{R14} ;Save some registers
1771
1772 ; --- First, read the system clock ---
1773
1774 SUB R13,R13,#8 ;Get a nice block
1775 MOV R0,#14 ;Read the system clock
1776 MOV R1,R13 ;Point to the block
1777 MOV R14,#3 ;Get the reason code
1778 STRB R14,[R1,#0] ;Store in block
1779 SWI OS_Word ;Read the time then
1780
1781 ; -- Now put it into stracc ---
1782
1783 BL stracc_ensure ;Make sure we have room
1784 MOV R4,R1 ;Remember the index
1785 MOV R1,R0 ;Put the address in R1
1786 MOV R0,R13 ;Point to time block
1787 MOV R2,#255 ;Size of the buffer
1788 ADR R3,exp__timeFormat ;Point to the format
1789 SWI OS_ConvertDateAndTime ;Convert the date and time
1790 ORR R0,R4,#24 ;Set up the rvalue
1791 MOV R1,#vType_string ;This is a string
1792 BL stracc_added ;Tell stracc about this
1793 ADD R13,R13,#8 ;Reclaim my stack
1794 BL exp__pushVal ;Push on my value
1795 LDMFD R13!,{PC}^ ;Return the caller
1796
1797 exp__timeFormat DCB "%W3,%DY %M3 %CE%YR.%24:%MI:%SE",0
1798
1799 ; --- FALSE ---
1800
1801 exp__doFalse MOV R0,#0
1802 MOV R1,#vType_integer
1803 B exp__pushVal
1804
1805 ; --- TRUE ---
1806
1807 exp__doTrue MOV R0,#-1
1808 MOV R1,#vType_integer
1809 B exp__pushVal
1810
1811 ;----- Functions ------------------------------------------------------------
1812
1813 ; --- EVAL ---
1814
1815 exp__doEval ROUT
1816
1817 ; --- Hack the stack ---
1818 ;
1819 ; We're called from exp__eval, which has stacked R0 and R14.
1820 ; We pop these off the stack, and stuff them onto the op
1821 ; stack instead. Yukmeister.
1822
1823 LDMFD R13!,{R0} ;Get R0 off the stack
1824 BL exp__pushOp ;Push that onto op stack
1825 LDMFD R13!,{R0} ;And R14 off too
1826 BL exp__pushOp ;Push that onto op stack
1827 MOV R0,R5 ;We need to corrupt R5
1828 BL exp__pushOp ;Push that onto op stack
1829
1830 ; --- Tokenise the string to evaluate ---
1831
1832 BL stracc_ensure ;Make space for tokenised
1833 STMFD R13!,{R0,R1} ;Save the address away
1834 BL exp__popStr ;Pop the string
1835 LDR R14,tsc_stracc ;Load stracc anchor address
1836 LDR R14,[R14,#0] ;Grrr....
1837 MOV R5,R0 ;Remember this for a while
1838 AND R1,R0,#&FF ;Get the string length
1839 ADD R0,R14,R0,LSR #8 ;Work out string address
1840 LDMFD R13!,{R2} ;Load the address out
1841 MOV R3,#0 ;Just tokenise the expression
1842 BL tokenise ;Go and do that then
1843 LDMFD R13!,{R0} ;Load the stracc rvalue
1844 ADD R0,R0,#&FF ;Say it's very long
1845 BL stracc_added ;And record that
1846
1847 ; --- Now save state on the op stack ---
1848
1849 STMFD R13!,{R2} ;Save the address again
1850 MOV R0,R5 ;Save the stracc offset
1851 BL exp__pushOp ;Stack that
1852 MOV R0,R6 ;Save the eval flags
1853 BL exp__pushOp ;Stack that
1854 LDR R0,tsc_oldAnchor ;Load the old anchor
1855 BL exp__pushOp ;Push that away too
1856 LDR R0,tsc_currAnchor ;Load current file anchor
1857 STR R0,tsc_oldAnchor ;This is now the old one
1858 LDR R0,[R0,#0] ;Load the actual pointer
1859 SUB R0,R10,R0 ;Find the file offset
1860 BL exp__pushOp ;Push that away too
1861 LDR R14,tsc_stracc ;Input is now in stracc
1862 STR R14,tsc_currAnchor ;This is the new anchor
1863 LDMFD R13!,{R10} ;Load the new address
1864 GETOP R0,255,exp__bEvalOp ;Create a pseudoop
1865 BL exp__pushOp ;Stuff that on the stack
1866 MOV R6,#0 ;Just read an expression
1867 MOV R9,#-1 ;Make getToken happy
1868 BL getToken ;Prime the first token
1869 B exp__mainLoop ;And resume the main loop
1870
1871 LTORG
1872
1873 ; --- exp__endEval ---
1874
1875 exp__endEval ROUT
1876
1877 BL exp__popOp ;Pop the file offset
1878 MOV R10,R0 ;Look after this
1879 LDR R14,tsc_oldAnchor ;Load the previous anchor
1880 STR R14,tsc_currAnchor ;This is now the current one
1881 LDR R14,[R14,#0] ;Bodge for wimpextension
1882 ADD R10,R14,R10 ;Relocate the output pointer
1883 BL exp__popOp ;And the anchor pointer
1884 STR R0,tsc_oldAnchor ;Remember this now
1885 SUB R10,R10,#1 ;Quick hack now
1886 MOV R9,#-1 ;Make getToken happy
1887 BL getToken ;Prime lookahead token
1888 BL exp__popOp ;Pop the express_read flags
1889 MOV R6,R0 ;Re-instate them
1890 BL exp__popOp ;Get the stracc offset
1891 BL stracc_free ;Free *both* the strings
1892 BL exp__popOp ;Get preserved R5 value
1893 MOV R5,R0 ;Put that back nicely
1894 BL exp__popOp ;Get stacked R14 value
1895 STMFD R13!,{R0} ;Push that back on the stack
1896 BL exp__popOp ;Get stacked R0 value
1897 STMFD R13!,{R0} ;Push that back on the stack
1898 BL exp__popVal ;Pop the result (odd)
1899 B exp__evalRet ;Now leap back into routine
1900
1901 LTORG
1902
1903 ; --- VAL ---
1904
1905 exp__doVal ROUT
1906
1907 ADR R0,tsc_misc ;Point to a buffer
1908 BL exp__getString ;Get a string
1909 ADR R1,tsc_misc ;Point to the string
1910
1911 ; --- Scan the string ---
1912 ;
1913 ; We skip spaces, and stop at the first non space.
1914 ; If that happens to be a minus sign, we remember that.
1915
1916 00 LDRB R14,[R1],#1 ;Read the character
1917 CMP R14,#0 ;Are we at the end?
1918 MOVEQ R0,#0 ;Yes -- get the rvalue
1919 BEQ %20exp__doVal ;And jump ahead a bit
1920 CMP R14,#32 ;Is this a space
1921 BEQ %b00 ;Yes -- go round for more
1922 CMP R14,#'-' ;Is it a minus sign?
1923 SUBNE R1,R1,#1 ;No -- backtrack then
1924 MOV R0,#10 ;Read as base 10 by default
1925 SWI XOS_ReadUnsigned ;Read the value
1926 RSBEQ R0,R2,#0 ;Negate if we should
1927 MOVNE R0,R2 ;Otherwise don't bother
1928 MOVVS R0,#0 ;Return 0 on an error
1929 20 MOV R1,#vType_integer ;This is an integer
1930 B exp__evalRet ;Return to eval loop
1931
1932 LTORG
1933
1934 ;----- Arithmetic routine ---------------------------------------------------
1935
1936 ; --- ABS ---
1937
1938 exp__doAbs ROUT
1939
1940 BL exp__popInt ;Get an integer
1941 CMP R0,#0 ;Is the argument <0?
1942 RSBLT R0,R0,#0 ;Yes -- negate it then
1943 B exp__evalRet ;Return to eval loop
1944
1945 LTORG
1946
1947 ; --- NOT ---
1948
1949 exp__doNot ROUT
1950
1951 BL exp__popInt ;Get an integer
1952 MVN R0,R0 ;Invert the operand
1953 B exp__evalRet ;Return to eval loop
1954
1955 LTORG
1956
1957 ; --- SGN ---
1958
1959 exp__doSgn ROUT
1960
1961 BL exp__popInt ;Get an integer
1962 CMP R0,#0 ;Compare argument with 0
1963 MOVGT R0,#1 ;If bigger return 1
1964 MOVLT R0,#-1 ;If smaller, return -1
1965 B exp__evalRet ;Return to eval loop
1966
1967 LTORG
1968
1969 ;----- String associated routines -------------------------------------------
1970
1971 ; --- ASC ---
1972
1973 exp__doAsc ROUT
1974
1975 BL exp__popStr ;Get a string
1976 BL stracc_free ;Won't need it any more
1977 MOV R1,#vType_integer ;We will return an int
1978 TST R0,#&FF ;Is this a NULL string?
1979 MOVEQ R0,#-1 ;Yes -- return -1 then
1980 BEQ exp__evalRet
1981
1982 LDR R14,tsc_stracc ;Loacte stracc
1983 LDR R14,[R14]
1984 ADD R14,R14,R0,LSR #8 ;Point to the string
1985 LDRB R0,[R14,#0] ;Load a byte
1986 B exp__evalRet ;Return this to caller
1987
1988 ; --- CHR$ ---
1989
1990 exp__doChrS ROUT
1991
1992 BL exp__popInt ;Pop an integer
1993 MOV R2,R0 ;Look after the value
1994 BL stracc_ensure ;Make sure there's space
1995 MOVS R14,R2,LSR #8 ;Check the value's OK
1996 STREQB R2,[R0,#0] ;If so, store it
1997 ORREQ R1,R1,#1 ;And set length one
1998 MOV R0,R1 ;Get the rvalue
1999 MOV R1,#vType_string ;Say it's a string
2000 BL stracc_added ;Say I've added it
2001 B exp__evalRet ;And return to eval loop
2002
2003
2004 ; --- LEN ---
2005
2006 exp__doLen ROUT
2007
2008 BL exp__popStr ;Get a string
2009 BL stracc_free ;Won't need it any more
2010 AND R0,R0,#&FF ;Get the length
2011 MOV R1,#vType_integer ;This is an integer
2012 B exp__evalRet ;Return to eval loop
2013
2014 ; --- STR$ ---
2015
2016 exp__doStrS ROUT
2017
2018 TST R2,#(1<<16) ;Is this a hex conversion?
2019 BL exp__popInt ;Pop an integer
2020 MOV R3,R0 ;Put it in R3
2021 BL stracc_ensure ;Make sure we have room
2022 MOV R4,R1 ;Look after the offset
2023 BNE %10exp__doStrS ;If hex -- jump ahead
2024
2025
2026 MOV R1,R0 ;Write result to here
2027 MOV R2,#255 ;Buffer is big
2028 MOVS R0,R3 ;Put the number in here
2029 RSBLT R0,R0,#0 ;If -ve, mak positive
2030 MOVLT R14,#'-' ;...get a minus ready
2031 STRLTB R14,[R1],#1 ;Store in the buffer
2032 SWI OS_ConvertInteger4 ;Convert to a string
2033 SUB R14,R1,R0 ;Get the string length
2034 ADDLT R14,R14,#1 ;There may be a minus
2035 ORR R0,R4,R14 ;Get the rvalue
2036 MOV R1,#vType_string ;This is a string
2037 BL stracc_added ;Tell stracc about it
2038 B exp__evalRet ;Return to eval loop
2039
2040 ; --- We need to output as hex ---
2041
2042 10exp__doStrS ADR R1,tsc_misc ;Point to a nice buffer
2043 00 AND R2,R3,#&F ;Get teh remainder
2044 MOV R3,R3,LSR #4 ;Divide number by 16
2045 ADD R14,R2,#'0' ;Turn into a digit
2046 CMP R14,#'9'+1 ;Is it too big for this?
2047 ADDCS R14,R14,#'A'-'9'-1 ;Yes -- turn into a letter
2048 STRB R14,[R1],#1 ;Save the next byte
2049 CMP R3,#0 ;Have we finished now?
2050 BNE %b00 ;Yes -- jump back then
2051
2052 ; --- Copy the digits over ---
2053 ;
2054 ; The characters are now in the buffer in reverse order
2055
2056 ADR R2,tsc_misc ;Point to the buffer
2057 SUBS R2,R1,R2 ;Get the number of chars
2058 ORR R4,R4,R2 ;Put that in the index
2059 00 LDRGTB R14,[R1,#-1]! ;Load out byte
2060 STRGTB R14,[R0],#1 ;Store that in the buffer
2061 SUBS R2,R2,#1 ;Reduce the number count
2062 BGT %b00 ;And keep on doing this
2063
2064 MOV R0,R4 ;Get the rvalue
2065 MOV R1,#vType_string ;This is a string
2066 BL stracc_added ;Tell stracc about it
2067 B exp__evalRet ;Return to eval loop
2068
2069 LTORG
2070
2071 ;----- File operations ------------------------------------------------------
2072
2073 ; --- OPENOUT ---
2074
2075 exp__doOpenout ADR R0,tsc_misc ;Point to a buffer
2076 BL exp__getString ;Get the string argument
2077
2078 MOV R0,#&81 ;The flags to open with
2079 ADR R1,tsc_misc ;Point to the name
2080 SWI XOS_Find ;Try to open the file
2081 BVS error_reportReal ;Return possible error
2082 BL exp__opened ;Remember we opened the file
2083
2084 MOV R1,#vType_integer ;We will return an int
2085 B exp__evalRet ;Return this to caller
2086
2087 LTORG
2088
2089 ; --- OPENUP ---
2090
2091 exp__doOpenup ADR R0,tsc_misc ;Point to a buffer
2092 BL exp__getString ;Get the string argument
2093
2094 MOV R0,#&C7 ;The flags to open with
2095 ADR R1,tsc_misc ;Point to the name
2096 SWI XOS_Find ;Try to open the file
2097 BVS error_reportReal ;Return possible error
2098 BL exp__opened ;Remember we opened the file
2099
2100 MOV R1,#vType_integer ;We will return an int
2101 B exp__evalRet ;Return this to caller
2102
2103 LTORG
2104
2105 ; --- OPENIN ---
2106
2107 exp__doOpenin ADR R0,tsc_misc ;Point to a buffer
2108 BL exp__getString ;Get the string argument
2109
2110 MOV R0,#&47 ;The flags to open with
2111 ADR R1,tsc_misc ;Point to the name
2112 SWI XOS_Find ;Try to open the file
2113 BVS error_reportReal ;Return possible error
2114 BL exp__opened ;Remember we opened the file
2115
2116 MOV R1,#vType_integer ;We will return an int
2117 B exp__evalRet ;Return this to caller
2118
2119 LTORG
2120
2121 ; --- exp__opened ---
2122 ;
2123 ; On entry: R0 == file handle
2124 ;
2125 ; On exit: --
2126 ;
2127 ; Use: Remembers that a file has been opened. (Bit bashing code
2128 ; courtesy of the RISC OS 3.5 Keyboard Drivers, duplicated
2129 ; without permission.)
2130
2131 exp__opened ROUT
2132
2133 STMFD R13!,{R0-R2,R14} ;Save some registers
2134 ADR R1,tsc_files ;Find file bit-array
2135 MOV R14,R0,LSR #5 ;Get word index
2136 LDR R14,[R1,R14,LSL #2]! ;Load the word I want
2137 MOV R2,#(1<<31) ;Set the top bit here
2138 ORR R14,R14,R2,ROR R0 ;Set the correct bit
2139 STR R14,[R1,#0] ;Save the word back again
2140 LDMFD R13!,{R0-R2,PC}^ ;And return to caller
2141
2142 LTORG
2143
2144 ;----- Stream operations ----------------------------------------------------
2145
2146 ; --- BGET ---
2147
2148 exp__doBget ROUT
2149
2150 BL exp__popInt ;Get an integer
2151 MOV R1,R0 ;Put it in R1
2152 SWI XOS_BGet ;Get a byte from the file
2153 BVS error_reportReal
2154 MOV R1,#vType_integer ;It's an integer Jim
2155 B exp__evalRet ;Return to eval loop
2156
2157 LTORG
2158
2159 ; --- EOF ---
2160
2161 exp__doEof ROUT
2162
2163 BL exp__popInt ;Get an integer
2164 MOV R1,R0 ;Put it in R1
2165 MOV R0,#5 ;Read EOF status
2166 SWI XOS_Args ;Read it then
2167 BVS error_reportReal
2168 MOVS R0,R2 ;Put result in R0
2169 MOVNE R0,#-1 ;Make it -1 if TRUE
2170 MOV R1,#vType_integer ;It's an integer Jim
2171 B exp__evalRet ;Return to eval loop
2172
2173 LTORG
2174
2175 ; --- EXT ---
2176
2177 exp__doExt ROUT
2178
2179 BL exp__popInt ;Get an integer
2180 MOV R1,R0 ;Put it in R1
2181 MOV R0,#2 ;Read EOF status
2182 SWI XOS_Args ;Read it then
2183 BVS error_reportReal
2184 MOV R0,R2 ;Put result in R0
2185 MOV R1,#vType_integer ;It's an integer Jim
2186 B exp__evalRet ;Return to eval loop
2187
2188 LTORG
2189
2190 ; --- GET$ ---
2191
2192 exp__doGetS ROUT
2193
2194 BL exp__popInt ;Get an integer
2195 MOV R4,R0 ;Put it in R4
2196 BL stracc_ensure ;Ensure there is enough space
2197 MOV R2,R0 ;Remember the address
2198 MOV R3,R1 ;And the offset
2199 MOV R1,R4 ;Put file handle in R1
2200 MOV R4,#0 ;The length so far
2201 00 SWI XOS_BGet ;Geta byte
2202 BVS error_reportReal ;Report possible error
2203 BCS %10exp__doGetS ;Undefined -- dropout
2204 CMP R0,#10 ;Have we reached the end?
2205 CMPNE R0,#13
2206 CMPNE R0,#0
2207 BEQ %10exp__doGetS ;Yes -- drop out
2208 STRB R0,[R2],#1 ;No -- store the byte
2209 ADD R4,R4,#1 ;And increment the count
2210 CMP R4,#255 ;Have we read the maximum?
2211 BLT %b00 ;No -- keep getting them
2212
2213 10exp__doGetS ORR R0,R3,R4 ;Get the rvalue
2214 MOV R1,#vType_string ;This is a string
2215 BL stracc_added ;Tell stracc about this
2216 B exp__evalRet ;Return to eval loop
2217
2218 ; --- PTR ---
2219
2220 exp__doPtr ROUT
2221
2222 BL exp__popInt ;Get an integer
2223 MOV R1,R0 ;Put it in R1
2224 MOV R0,#0 ;Read EOF status
2225 SWI XOS_Args ;Read it then
2226 BVS error_reportReal
2227 MOV R0,R2 ;Put result in R0
2228 MOV R1,#vType_integer ;It's an integer Jim
2229 B exp__evalRet ;Return to eval loop
2230
2231 LTORG
2232
2233 ;---- Multiple argument things ----------------------------------------------
2234
2235 ; --- exp__midString ---
2236 ;
2237 ; On entry: R1 == index into string
2238 ; R2 == number of chars needed
2239 ; String is in tsc_misc
2240 ;
2241 ; On exit: R0, R1 == value to push
2242 ;
2243 ; Use: Performs a string extraction on the string
2244
2245 exp__midString ROUT
2246
2247 STMFD R13!,{R14} ;Stack the link
2248 ADR R0,tsc_misc ;Point to the string
2249 ADD R3,R0,R1 ;Copy from here
2250 MOV R4,R2 ;Remember the length
2251 BL stracc_ensure ;Make sure we have room
2252 CMP R2,#0 ;Anything to copy?
2253 00 LDRGTB R14,[R3],#1 ;Load a byte
2254 STRGTB R14,[R0],#1 ;Store it
2255 SUBS R2,R2,#1 ;Decrement the count
2256 BGT %b00 ;Go round for more
2257 ORR R0,R1,R4 ;Get the rvalue
2258 MOV R1,#vType_string ;This is a string
2259 BL stracc_added ;Tell stracc about this
2260 LDMFD R13!,{PC}^ ;Return to caller
2261
2262 LTORG
2263
2264 ; --- LEFT$ ---
2265
2266 exp__doLeftS ROUT
2267
2268 STMFD R13!,{R2-R6,R14} ;Stack registers
2269 CMP R5,#2 ;Two of them?
2270 MOVNE R0,#err_leftSArgs ;No -- get the error number
2271 BNE error_report ;And report the error
2272
2273 BL exp__popInt ;Get the number of chars
2274 MOV R2,R0 ;Put that in R2
2275 MOV R1,#0 ;From the beginning
2276 ADR R0,tsc_misc ;Point to a buffer
2277 BL exp__getString ;Get then string
2278 CMP R2,R0 ;Are we getting too many?
2279 MOVCS R2,R0 ;Yes -- get this many
2280 BL exp__midString ;Do the mid$
2281 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2282
2283 LTORG
2284
2285 ; --- MID$ ---
2286
2287 exp__doMidS ROUT
2288
2289 STMFD R13!,{R2-R6,R14} ;Stack registers
2290 CMP R5,#2 ;Two of them?
2291 CMPNE R5,#3 ;Or maybe 3?
2292 MOVNE R0,#err_midSArgs ;No -- get the error number
2293 BNE error_report ;And report the error
2294
2295 CMP R5,#2 ;Just two args?
2296 BEQ %10exp__doMidS ;Yes -- jump ahead
2297
2298 BL exp__popTwoInts ;Get the number of chars
2299 SUBS R1,R0,#1 ;Put index in R1
2300 MOVLT R1,#0 ;Put it in range
2301 ADR R0,tsc_misc ;Point to a buffer
2302 BL exp__getString ;Get then string
2303 CMP R1,R0 ;Is the index in range?
2304 MOVGT R1,R0 ;No -- put it in range
2305 SUB R14,R0,R1 ;Get number of chars left
2306 CMP R2,R14 ;Are we getting too many?
2307 MOVCS R2,R14 ;Yes -- get this many
2308 BL exp__midString ;Do the mid$
2309 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2310
2311 ; --- Deal with 2 arg variation ---
2312
2313 10exp__doMidS BL exp__popInt ;Get the index
2314 SUB R1,R0,#1 ;Put it in R1
2315 ADR R0,tsc_misc ;Point to a buffer
2316 BL exp__getString ;Get the string
2317 CMP R1,R0 ;Are we in range?
2318 MOVCS R1,R0 ;No -- we are now
2319 SUB R2,R0,R1 ;Get the number to get
2320 BL exp__midString ;Do the mid$
2321 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2322
2323 LTORG
2324
2325 ; --- RIGHT$ ---
2326
2327 exp__doRightS ROUT
2328
2329 STMFD R13!,{R2-R6,R14} ;Stack registers
2330 CMP R5,#2 ;Two of them?
2331 MOVNE R0,#err_rightSArgs ;No -- get the error number
2332 BNE error_report ;And report the error
2333
2334 BL exp__popInt ;Get the number
2335 MOV R2,R0 ;Put it in R2
2336 ADR R0,tsc_misc ;Point to the buffer
2337 BL exp__getString ;Get the string
2338 SUBS R1,R0,R2 ;Work out the index
2339 MOVLT R1,#0 ;If getting too many, reduce
2340 MOVLT R2,R0
2341 BL exp__midString ;Do the mid$
2342 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2343
2344 LTORG
2345
2346 ; --- STRING$ ---
2347
2348 exp__doStringS ROUT
2349
2350 ; --- Make sure we have the right number of arguments ---
2351
2352 STMFD R13!,{R2-R6,R14} ;Stack registers
2353 CMP R5,#2 ;Two of them?
2354 MOVNE R0,#err_stringSArgs ;No -- get the error number
2355 BNE error_report ;And report the error
2356
2357 ADR R0,tsc_misc ;Point to a buffer
2358 BL exp__getString ;Copy the string into buffer
2359 MOV R5,R0 ;Put length in R2
2360 BL exp__popInt ;Pop an integer
2361 MOV R3,R0 ;Put number in R3
2362 MUL R6,R5,R0 ;Get the overall length
2363 CMP R6,#255 ;Is it too big?
2364 MOVGT R0,#err_strTooLong ;Yes -- get error number
2365 BGT error_report ;And report it happily
2366
2367 ; --- Now copy the string ---
2368
2369 CMP R5,#0 ;Is this a 0 length string?
2370 MOVEQ R0,#0 ;Yes -- get rvalue
2371 BEQ %10exp__doStringS ;And jump ahead
2372
2373 BL stracc_ensure ;Make sure we have room
2374 MOV R4,R1 ;Look after the offset
2375 MOV R2,R5 ;Keep copy of length
2376
2377 00 ADR R1,tsc_misc ;Point to the string
2378 05 LDRB R14,[R1],#1 ;Load a byte
2379 STRB R14,[R0],#1 ;Store it
2380 SUBS R2,R2,#1 ;Decrement the string length
2381 BGT %b05 ;And go round for more
2382 MOV R2,R5 ;Get the length back
2383 SUBS R3,R3,#1 ;Decrment other counter
2384 BGT %b00 ;And go round for more
2385
2386 ORR R0,R4,R6 ;Get the rvalue
2387 10 MOV R1,#vType_string ;This is a string
2388 BL stracc_added ;Tell stracc about it
2389 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2390
2391 LTORG
2392
2393 ; --- INSTR ---
2394
2395 exp__doInstr ROUT
2396
2397 STMFD R13!,{R5,R14} ;Stack registers
2398 CMP R5,#2 ;Two of them?
2399 CMPNE R5,#3 ;Or maybe 3?
2400 MOVNE R0,#err_instrSArgs ;No -- get the error number
2401 BNE error_report ;And report the error
2402
2403 CMP R5,#3 ;Are there 3 args?
2404 BLEQ exp__popInt ;Yes -- get it then
2405 SUBEQ R5,R0,#1 ;And reduce by 1
2406 MOVNE R5,#0 ;Otherwise use 0
2407
2408 BL exp__popTwoStrs ;Get two strings
2409 STMFD R13!,{R0,R6-R9} ;Stack nice stracc position
2410 LDR R14,tsc_stracc ;Get the stracc anchor
2411 LDR R14,[R14]
2412 AND R1,R0,#&FF ;Get a string length
2413 ADD R0,R14,R0,LSR #8 ;Point at the strings
2414 AND R3,R2,#&FF ;Do this for...
2415 ADD R2,R14,R2,LSR #8 ;...both of them
2416
2417 SUB R1,R1,R5 ;Get len of remaining string
2418 05 CMP R1,R3 ;Enough string for a match?
2419 BLT %90exp__doInstr ;No match -- jump onwards
2420 ADD R6,R0,R5 ;Look after values
2421 MOV R7,R2
2422 MOV R9,R3 ;Remember the length too
2423 00 SUBS R9,R9,#1 ;Reduce length count
2424 BLT %95exp__doInstr ;We have a match :-)
2425 LDRB R8,[R6],#1 ;Load a byte
2426 LDRB R14,[R7],#1 ;From both strings
2427 CMP R8,R14 ;Do the bytes match?
2428 BEQ %b00 ;Yes -- keep on comparing
2429 ADD R5,R5,#1 ;Increment the position
2430 SUB R1,R1,#1 ;Reduce length
2431 B %b05 ;And keep on going
2432
2433 ; --- We return failure ---
2434
2435 90 LDMFD R13!,{R0,R6-R9} ;Load back registers
2436 BL stracc_free ;Free my strings
2437 MOV R0,#0 ;No match
2438 MOV R1,#vType_integer ;Return a string please
2439 LDMFD R13!,{R5,PC}^ ;Return to caller
2440
2441 ; --- Return success then ---
2442
2443 95 LDMFD R13!,{R0,R6-R9} ;Load back registers
2444 BL stracc_free ;Free my strings
2445 ADD R0,R5,#1 ;No match
2446 MOV R1,#vType_integer ;Return a string please
2447 LDMFD R13!,{R5,PC}^ ;Return to caller
2448
2449 LTORG
2450
2451 ;----- Flags and things -----------------------------------------------------
2452
2453 eFlag__commaOk EQU (1<<0) ;We can cope with commas here
2454 eFlag__op EQU (1<<1) ;We are reading an operator
2455 eFlag__done EQU (1<<2) ;Finished reading expression
2456 eFlag__lval EQU (1<<3) ;Reading an lvalue
2457 eFlag__parseLval EQU (1<<4) ;We are parsing an lvalue
2458
2459 ;----- That's all, folks ----------------------------------------------------
2460
2461 END
The Straylight Source Distribution (obsolete software for RISC OS)