4 ; Evaluation of BASIC expressions
9 ;----- Standard header ------------------------------------------------------
16 ;----- External dependencies ------------------------------------------------
33 ;----- Macros ---------------------------------------------------------------
36 $label GETOP $r,$prec,$branch,$cc
39 MOV$cc $r,#($prec)<<24
40 ORR$cc $r,$r,#($branch-exp__bTable)>>2
43 ;----- Main code ------------------------------------------------------------
45 AREA |TermScript$$Code|,CODE,READONLY
47 ;----- Stack handling -------------------------------------------------------
51 ; On entry: R0 == operator thing to push
53 ; On exit: R0-R4 corrupted
55 ; Use: Pushes an operator onto the stack.
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
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
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
85 ; On exit: R0 == value popped off
88 ; Use: Pops an operator from the stack.
93 ADR R1,tsc_opStack ;Point to some stack data
94 LDMIA R1,{R0-R2} ;Load it out
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
110 ; --- exp__pushVal ---
112 ; On entry: R0 == operator thing to push
113 ; R1 == type of thing to push
115 ; On exit: R0-R5 corrupted
117 ; Use: Pushes an value onto the stack.
122 MOV R3,R0 ;Look after thing to push
124 ADR R1,tsc_calcStack ;Point to some stack data
125 LDMIA R1,{R0-R2} ;Load it out
127 ADD R5,R1,#8 ;New used size
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
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
144 ; --- exp__popVal ---
148 ; On exit: R0,R1 == value popped off
151 ; Use: Pops a value from the stack.
156 ADR R1,tsc_calcStack ;Point to some stack data
157 LDMIA R1,{R0-R2} ;Load it out
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
174 ; --- exp__popTwoVals ---
178 ; On exit: R0-R3 == values popped off
181 ; Use: Pops two values from the stack.
186 ADR R1,tsc_calcStack ;Point to some stack data
187 LDMIA R1,{R0-R2} ;Load it out
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
204 ; --- express_pop ---
208 ; On exit: R0,R1 == value popped off
210 ; Use: Pops a value from the stack.
215 STMFD R13!,{R2-R4,R14} ;Stack registers
216 BL exp__popVal ;Get the value
217 LDMFD R13!,{R2-R4,PC}^ ;Return to caller
221 ; --- express_popTwo ---
225 ; On exit: R0-R3 == two values popped from the stack
227 ; Use: Pops two values from the stack.
229 EXPORT express_popTwo
232 STMFD R13!,{R4,R14} ;Stack registers
233 BL exp__popTwoVals ;Pop the values
234 LDMFD R13!,{R4,PC}^ ;And return to caller
238 ; --- express_push ---
240 ; On entry: R0,R1 == l/rvalue to push
244 ; Use: Pushes a value onto the expression stack.
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
255 ;----- Space-saving type checking routines ----------------------------------
257 ; --- exp__chkTwoInts ---
259 ; On entry: R1,R3 == types of variable
263 ; Use: Ensures that R1 and R3 are both of type integer, and
264 ; complains otherwise.
268 CMP R3,#vType_integer ;Is second an integer?
269 MOVNE R1,R3 ;No -- fiddle the first then
271 ; Drop through here (yuk)
273 ; --- exp__chkInt ---
275 ; On entry: R1 == type of a variable
279 ; Use: Ensures that R1 is of type integer, and complains otherwise.
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
290 ; --- exp__popInt ---
294 ; On exit: R0,R1 == value popped from the stack
297 ; Use: Pops a value from the stack and ensures that it is an
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
307 ; --- exp__popTwoInts ---
311 ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack
314 ; Use: Pops two values from the stack and ensures that they are
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
326 ; --- exp__chkTwoStrs ---
328 ; On entry: R1,R3 == types of variable
332 ; Use: Ensures that R1 and R3 are both of type string, and
333 ; complains otherwise.
337 CMP R3,#vType_string ;Is second an integer?
338 MOVNE R1,R3 ;No -- fiddle the first then
340 ; Drop through here (yuk)
342 ; --- exp__chkStr ---
344 ; On entry: R1 == type of a variable
348 ; Use: Ensures that R1 is of type string, and complains otherwise.
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
359 ; --- exp__popStr ---
363 ; On exit: R0,R1 == value popped from the stack
366 ; Use: Pops a value from the stack and ensures that it is an
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
376 ; --- exp__popTwoStrs ---
380 ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack
383 ; Use: Pops two values from the stack and ensures that they are
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
395 ;----- Expression evaluation routines ---------------------------------------
397 ; --- express_fnCont ---
401 ; On exit: Similarly involved.
403 ; Use: We continue here after executing a function.
405 EXPORT express_fnCont
407 ; --- express_read ---
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
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
420 ; Use: Reads an expression for the current position in the
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
433 GETOP R0,255,exp__bExpEnd ;Push a sentinel operand
434 BL exp__pushOp ;To separate this expression
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
443 ; --- Read an operand then ---
445 SUBS R4,R9,#'_' ;Is it an underscore?
446 SUBNE R4,R9,#'A' ;Or a capital letter?
448 SUBCS R4,R9,#'a' ;Or a lowercase letter?
450 BCC exp__readIdent ;Read an identifier
452 CMP R9,#'!' ;Is it an indirection op?
455 BEQ exp__indir ;Yes -- jump ahead
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
461 CMP R9,#'"' ;Is it a quote?
462 BEQ exp__string ;Yes -- read string then
464 CMP R9,#'(' ;Is it a bracket?
465 BEQ exp__par ;Yes -- jump ahead
467 CMP R9,#tok_fn ;Is it a function call?
468 BEQ exp__userFn ;Yes -- handle that then
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
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
480 CMP R7,#tClass_pseud ;Is this a pseudovariable?
481 BEQ exp__pseud ;Yes -- deal with it
483 CMP R7,#tClass_fn ;Is it a function then?
484 BEQ exp__fn ;Yes -- deal with that
486 CMP R7,#tClass_streamOp ;Also check for stream ops
487 BEQ exp__streamOp ;Just for luck
489 CMP R7,#tClass_multArg ;Multiple parameter thing?
490 BEQ exp__multArg ;Yes -- deal with it then
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
500 MOV R0,#err_unknown ;Get all-encompassing error
501 B error_report ;And report the error
505 ; --- Handle a string ---
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
522 05 BL getToken ;Get another token
523 CMP R9,#'"' ;Is this a quote too?
524 BEQ %b03 ;Yes -- jump back upwards
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
533 ; --- Handle a function call ---
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
539 ; --- Handle an open bracket ---
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
547 ; --- Handle a unary minus ---
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
554 ; --- Handle a pseudovariable ---
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
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
568 ; --- Handle unary functions ---
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
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
585 ; --- Handle stream operations with irritating #s ---
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
599 ; --- Deal with multiple parameter commands ---
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
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
614 B %10express_read ;And go back up top
616 ; --- Deal with an indirection operator ---
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
634 ; --- Read a hexadecimal number ---
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
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
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
662 ; --- Read a binary number ---
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
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
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
684 ; --- Read a decimal number ---
686 exp__readDec MOV R0,#0 ;Initial value is zero
688 00express_read ADD R0,R0,R0,LSL #2 ;Multiply accumulator by 5
689 ADD R0,R14,R0,LSL #1 ;Accumulate the result
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
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
703 ; --- Read an identifier ---
705 exp__readIdent ADR R1,tsc_misc ;Point to a nice block
706 MOV R2,#vType_integer ;The current variable type
708 00express_read SUBS R4,R9,#'_' ;Is it an underscore?
709 SUBNE R4,R9,#'0' ;Or a number?
711 SUBCS R4,R9,#'A' ;Or a capital letter?
713 SUBCS R4,R9,#'a' ;Or a lowercase letter?
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
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
726 BNE %b00express_read ;Go round for more
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
732 ; --- Check for arrays ---
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
747 CMP R9,#')' ;Is it a whole array?
748 BEQ %f00 ;Yes -- deal with that
750 ; --- Set up for subscripting the array ---
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
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
769 ; --- Just store the array lvalue ---
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
778 ; --- Handle strings and things ---
780 05 TST R6,#eFlag__lval ;Are we reading an lvalue?
781 BNE %f20express_read ;Yes -- jump ahead
783 TST R6,#eFlag__parseLval ;Parsing an lvalue?
784 ORRNE R6,R6,#eFlag__done ;Yes -- we're finished
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
790 ; --- Do wildly different things with strings ---
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
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
802 BL exp__pushVal ;Stack that nicely
803 ORR R6,R6,#eFlag__op ;Expect an operator
804 B %10express_read ;And keep on looking
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
810 ; --- Now try to cope with indirection ---
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
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
825 ; --- We are reading an lvalue ---
827 ; We only need to create the variable if there is not an
828 ; indirection operator following.
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
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
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
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
858 B %10express_read ;Return, still expecting val
860 ; --- Try reading an operator ---
862 50express_read CMP R9,#')' ;Is this a close bracket?
863 BEQ exp__en ;Yes -- deal with that then
865 CMP R9,#',' ;Is it a comma?
866 BEQ exp__comma ;Yes -- deal with that
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
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
883 ; --- Handle a closing bracket ---
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
893 ; --- Check for comma-separated pseudo-ops ---
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
899 ; --- Reset the flags from the operator ---
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
907 ; --- Now do the required processing ---
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
916 ; --- Handle a comma ---
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
930 ; --- We have finished reading the expression ---
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
936 ; --- See if this was an evaluated string ---
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
942 LDMFD R13!,{R0-R6,PC}^ ;Load some registers
944 exp__indirTran DCB vType_lvInt
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
959 ; On exit: R1-R4 corrupted
961 ; Use: Performs things
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
977 10exp__eval BL exp__pushOp ;Push it back on again
978 LDMFD R13!,{R0,PC}^ ;Return to caller
982 ; --- exp__doMultArg ---
984 ; On entry: R5 == number of subscripts provided
986 ; R7, R8, R9 == lookahead token
987 ; R10 == pointer into tokenised buffer
988 ; R11 == upcall block pointer
989 ; R12 == anchor pointer
991 ; On exit: R0-R3 corrupted
993 ; Use: Subscripts an array of things to find just one of them.
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
1007 ; --- A nice precedance table ----
1009 exp__opTable DCD 0,0
1010 DCD 25,(exp__andOps-exp__bTable)>>2
1016 DCD 10,(exp__multOps-exp__bTable)>>2
1017 DCD 30,(exp__orOps-exp__bTable)>>2
1021 DCD 20,(exp__relOps-exp__bTable)>>2
1022 DCD 15,(exp__addOps-exp__bTable)>>2
1024 DCD 5,(exp__powOps-exp__bTable)>>2
1026 ; --- The main dispatch table ---
1030 exp__andOps B exp__doAnd
1032 exp__multOps B exp__doDiv
1037 exp__orOps B exp__doXor
1040 exp__relOps B exp__doEqual
1050 exp__addOps B exp__doAdd
1053 exp__fns B exp__doAbs
1066 exp__streamOps B exp__doBget
1072 exp__multArgs B exp__doInstr
1078 exp__powOps B exp__doPow
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
1088 exp__bSubscript B exp__doSubscript
1090 exp__bMultArg B exp__doMultArg
1092 ; --- exp__doAdd ---
1094 ; On entry: R7, R8, R9 == lookahead token
1095 ; R10 == pointer into tokenised buffer
1096 ; R11 == evaluation stack pointer
1097 ; R12 == anchor pointer
1099 ; On exit: R0-R3 corrupted
1101 ; Use: Adds two things.
1105 BL exp__popTwoVals ;Get two values
1106 CMP R1,#vType_integer ;Is this an integer?
1107 BNE %10exp__doAdd ;No -- onwards ho
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
1115 ; --- Concatenate strings ---
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
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
1129 MOV R0,#err_strTooLong ;String is too long
1134 ; --- exp__doSub ---
1136 ; On entry: R7, R8, R9 == lookahead token
1137 ; R10 == pointer into tokenised buffer
1138 ; R11 == evaluation stack pointer
1139 ; R12 == anchor pointer
1141 ; On exit: R0-R3 corrupted
1143 ; Use: Subtracts one thing from another thing.
1147 BL exp__popTwoInts ;Get two integers
1148 SUB R0,R0,R2 ;Subtract the things
1149 B exp__evalRet ;Jump back into eval loop
1153 ; --- exp__doMult ---
1155 ; On entry: R7, R8, R9 == lookahead token
1156 ; R10 == pointer into tokenised buffer
1157 ; R11 == evaluation stack pointer
1158 ; R12 == anchor pointer
1160 ; On exit: R0-R3 corrupted
1162 ; Use: Multiplies two things together.
1166 BL exp__popTwoInts ;Get two integers
1167 MUL R0,R2,R0 ;Multiply the things
1168 B exp__evalRet ;Jump back into eval loop
1172 ; --- exp__doDiv ---
1174 ; On entry: R7, R8, R9 == lookahead token
1175 ; R10 == pointer into tokenised buffer
1176 ; R11 == evaluation stack pointer
1177 ; R12 == anchor pointer
1179 ; On exit: R0-R3 corrupted
1181 ; Use: Divides one thing by another thing.
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
1193 ; --- exp__doMod ---
1195 ; On entry: R7, R8, R9 == lookahead token
1196 ; R10 == pointer into tokenised buffer
1197 ; R11 == evaluation stack pointer
1198 ; R12 == anchor pointer
1200 ; On exit: R0-R3 corrupted
1202 ; Use: Gives the remainder when one thing is divided by another
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
1216 ; --- exp__doPow ---
1218 ; On entry: R7, R8, R9 == lookahead token
1219 ; R10 == pointer into tokenised buffer
1220 ; R11 == evaluation stack pointer
1221 ; R12 == anchor pointer
1223 ; On exit: R0-R3 corrupted
1225 ; Use: Raises one thing to the power of another thing.
1229 BL exp__popTwoInts ;Get two integers
1231 ; --- Check for some special cases ---
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
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
1242 ; --- Now we use a cunning loop to make this quick ---
1244 ; Basically, we note that x^2y == (x^2)^y
1246 MOV R3,R0 ;Look after the x value
1247 MOV R0,#1 ;An initial multiplier
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
1255 B exp__evalRet ;Go back to eval loop
1259 ; --- exp__doAnd ---
1261 ; On entry: R7, R8, R9 == lookahead token
1262 ; R10 == pointer into tokenised buffer
1263 ; R11 == evaluation stack pointer
1264 ; R12 == anchor pointer
1266 ; On exit: R0-R3 corrupted
1268 ; Use: ANDs two things.
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
1280 ; On entry: R7, R8, R9 == lookahead token
1281 ; R10 == pointer into tokenised buffer
1282 ; R11 == evaluation stack pointer
1283 ; R12 == anchor pointer
1285 ; On exit: R0-R3 corrupted
1287 ; Use: ORs two things.
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
1297 ; --- exp__doXor ---
1299 ; On entry: R7, R8, R9 == lookahead token
1300 ; R10 == pointer into tokenised buffer
1301 ; R11 == evaluation stack pointer
1302 ; R12 == anchor pointer
1304 ; On exit: R0-R3 corrupted
1306 ; Use: XORs two things.
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
1316 ; --- exp__doPling ---
1318 ; On entry: R7, R8, R9 == lookahead token
1319 ; R10 == pointer into tokenised buffer
1320 ; R11 == evaluation stack pointer
1321 ; R12 == anchor pointer
1323 ; On exit: R0-R3 corrupted
1325 ; Use: Reads a word from a memory address.
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
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
1345 ; --- exp__doQuery ---
1347 ; On entry: R7, R8, R9 == lookahead token
1348 ; R10 == pointer into tokenised buffer
1349 ; R11 == evaluation stack pointer
1350 ; R12 == anchor pointer
1352 ; On exit: R0-R3 corrupted
1354 ; Use: Reads a byte from a memory address.
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
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
1374 ; --- exp__doDollar ---
1376 ; On entry: R7, R8, R9 == lookahead token
1377 ; R10 == pointer into tokenised buffer
1378 ; R11 == evaluation stack pointer
1379 ; R12 == anchor pointer
1381 ; On exit: R0-R3 corrupted
1383 ; Use: Reads a word from a memory address.
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
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
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
1407 ; --- The lvalue form ---
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
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
1429 ; --- Start scanning for an RND multi-op ---
1431 GETOP R0,1,exp__rndArg ;Get the operator value
1432 BL exp__pushOp ;Put that on the stack
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
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
1458 ; --- Store a seed ---
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
1465 ; --- Request for FP random number ---
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
1476 ; On entry: R0 == maximum value for random number
1480 ; Use: Stacks a random number between 1 and R0.
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
1503 ; --- Relational operators (and shifts) ---
1505 ; On entry: R7, R8, R9 == lookahead token
1506 ; R10 == pointer into tokenised buffer
1507 ; R11 == evaluation stack pointer
1508 ; R12 == anchor pointer
1510 ; On exit: R0-R3 corrupted
1512 ; Use: Does comparing. Or shifting. Depending.
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
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
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
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
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
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
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
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
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
1604 ; --- exp__doUMinus ---
1606 ; On entry: R7, R8, R9 == lookahead token
1607 ; R10 == pointer into tokenised buffer
1608 ; R11 == evaluation stack pointer
1609 ; R12 == anchor pointer
1611 ; On exit: R0-R3 corrupted
1613 ; Use: Negates a thing.
1617 BL exp__popInt ;Pop a val
1618 RSB R0,R0,#0 ;Negate the thing
1619 B exp__evalRet ;Jump back into eval loop
1623 ; --- exp__doSubscript ---
1625 ; On entry: R5 == number of subscripts provided
1627 ; R7, R8, R9 == lookahead token
1628 ; R10 == pointer into tokenised buffer
1629 ; R11 == upcall block pointer
1630 ; R12 == anchor pointer
1632 ; On exit: R0-R3 corrupted
1634 ; Use: Subscripts an array of things to find just one of them.
1636 exp__doSubscript ROUT
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
1646 ; --- Do some preliminary checking ---
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
1653 ; --- Now actually find the element ---
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
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
1671 ; --- Finally get an rvalue or lvalue as required ---
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
1689 ; --- exp__doParen ---
1691 ; On entry: R7, R8, R9 == lookahead token
1692 ; R10 == pointer into tokenised buffer
1693 ; R11 == evaluation stack pointer
1694 ; R12 == anchor pointer
1696 ; On exit: R0-R3 corrupted
1702 MOV R0,#err_expBracket ;Get the error message
1703 B error_report ;And complain bitterly
1707 ; --- exp__doEndEval ---
1709 ; On entry: R7, R8, R9 == lookahead token
1710 ; R10 == pointer into tokenised buffer
1711 ; R11 == evaluation stack pointer
1712 ; R12 == anchor pointer
1714 ; On exit: R0-R3 corrupted
1720 MOV R0,#err_erk ;Get the error message
1721 B error_report ;And complain bitterly
1725 ; --- exp__getString ---
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
1733 ; On exit: R0 == length of string
1735 ; Use: Reads a string argument, and copies it into tsc_misc.
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
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
1756 ;----- Pseudovariables ------------------------------------------------------
1760 exp__doTime STMFD R13!,{R14}
1761 SWI OS_ReadMonotonicTime
1764 MOV R1,#vType_integer
1770 exp__doTimeS STMFD R13!,{R14} ;Save some registers
1772 ; --- First, read the system clock ---
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
1781 ; -- Now put it into stracc ---
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
1797 exp__timeFormat DCB "%W3,%DY %M3 %CE%YR.%24:%MI:%SE",0
1801 exp__doFalse MOV R0,#0
1802 MOV R1,#vType_integer
1807 exp__doTrue MOV R0,#-1
1808 MOV R1,#vType_integer
1811 ;----- Functions ------------------------------------------------------------
1817 ; --- Hack the stack ---
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.
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
1830 ; --- Tokenise the string to evaluate ---
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
1847 ; --- Now save state on the op stack ---
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
1873 ; --- exp__endEval ---
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
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
1911 ; --- Scan the string ---
1913 ; We skip spaces, and stop at the first non space.
1914 ; If that happens to be a minus sign, we remember that.
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
1934 ;----- Arithmetic routine ---------------------------------------------------
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
1951 BL exp__popInt ;Get an integer
1952 MVN R0,R0 ;Invert the operand
1953 B exp__evalRet ;Return to eval loop
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
1969 ;----- String associated routines -------------------------------------------
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
1982 LDR R14,tsc_stracc ;Loacte stracc
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
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
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
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
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
2040 ; --- We need to output as hex ---
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
2052 ; --- Copy the digits over ---
2054 ; The characters are now in the buffer in reverse order
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
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
2071 ;----- File operations ------------------------------------------------------
2075 exp__doOpenout ADR R0,tsc_misc ;Point to a buffer
2076 BL exp__getString ;Get the string argument
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
2084 MOV R1,#vType_integer ;We will return an int
2085 B exp__evalRet ;Return this to caller
2091 exp__doOpenup ADR R0,tsc_misc ;Point to a buffer
2092 BL exp__getString ;Get the string argument
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
2100 MOV R1,#vType_integer ;We will return an int
2101 B exp__evalRet ;Return this to caller
2107 exp__doOpenin ADR R0,tsc_misc ;Point to a buffer
2108 BL exp__getString ;Get the string argument
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
2116 MOV R1,#vType_integer ;We will return an int
2117 B exp__evalRet ;Return this to caller
2121 ; --- exp__opened ---
2123 ; On entry: R0 == file handle
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.)
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
2144 ;----- Stream operations ----------------------------------------------------
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
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
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
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?
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
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
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
2233 ;---- Multiple argument things ----------------------------------------------
2235 ; --- exp__midString ---
2237 ; On entry: R1 == index into string
2238 ; R2 == number of chars needed
2239 ; String is in tsc_misc
2241 ; On exit: R0, R1 == value to push
2243 ; Use: Performs a string extraction on the string
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
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
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
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
2295 CMP R5,#2 ;Just two args?
2296 BEQ %10exp__doMidS ;Yes -- jump ahead
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
2311 ; --- Deal with 2 arg variation ---
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
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
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
2341 BL exp__midString ;Do the mid$
2342 LDMFD R13!,{R2-R6,PC}^ ;Return to caller
2350 ; --- Make sure we have the right number of arguments ---
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
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
2367 ; --- Now copy the string ---
2369 CMP R5,#0 ;Is this a 0 length string?
2370 MOVEQ R0,#0 ;Yes -- get rvalue
2371 BEQ %10exp__doStringS ;And jump ahead
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
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
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
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
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
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
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
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
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
2433 ; --- We return failure ---
2435 90 LDMFD R13!,{R0,R6-R9} ;Load back registers
2436 BL stracc_free ;Free my strings
2438 MOV R1,#vType_integer ;Return a string please
2439 LDMFD R13!,{R5,PC}^ ;Return to caller
2441 ; --- Return success then ---
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
2451 ;----- Flags and things -----------------------------------------------------
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
2459 ;----- That's all, folks ----------------------------------------------------
~mdw / ssr / blob