4 ; Control flow handling
9 ;----- Standard header ------------------------------------------------------
16 ;----- External dependencies ------------------------------------------------
34 ;----- Main code ------------------------------------------------------------
36 AREA |TermScript$$Code|,CODE,READONLY
38 ;----- Execution stack handling ---------------------------------------------
40 ; --- ctrl__pushFrame ---
42 ; On entry: R0 == type of frame to create
44 ; On exit: R0 == address of frame data to fill in
46 ; Use: Creates a new frame of the given type on the execution stack.
50 STMFD R13!,{R1-R5,R14} ;Save some registers
51 MOV R3,R0 ;Look after thing to push
52 ADR R14,ctrl__frSize ;Point to frame size table
53 LDRB R4,[R14,R3] ;Load the frame size
54 ADR R1,sail_execStack ;Point to some stack data
55 LDMIA R1,{R0-R2} ;Load it out
57 ADD R5,R1,R4 ;New used size
58 ADD R1,R5,#255 ;Align to next size thing
59 BIC R1,R1,#255 ;Finish the align
60 CMP R1,R2 ;Has it got too big?
61 BLGT mem_realloc ;Yes -- get more space then
62 STRGT R1,sail_execStkSize ;Store new size maybe
63 STR R5,sail_execStkPtr ;Store back new size
64 LDR R0,[R0] ;Point to the stack
65 ADD R0,R0,R5 ;Address to put next thing on
66 STR R3,[R0,#-4] ;Store the new frame type
67 SUB R0,R0,R4 ;And return frame base addr
68 LDMFD R13!,{R1-R5,PC}^ ;And return to caller
72 ; --- ctrl__peekFrame ---
76 ; On exit: R0 == type of topmost frame
77 ; R1 == base address of frame
79 ; Use: Returns the type of the topmost frame, so a routine can
80 ; work out if it needs to be removed.
84 STMFD R13!,{R14} ;Save a register
85 ADR R0,sail_execStack ;Point to stack info block
86 LDMIA R0,{R0,R1} ;Load anchor addr and sp
87 LDR R0,[R0] ;WimpExt_Heap's oddness again
88 ADD R14,R0,R1 ;Find top of the stack
89 LDR R0,[R14,#-4] ;Load the frame type
90 ADR R1,ctrl__frSize ;Find the frame size table
91 LDRB R1,[R1,R0] ;Load the size of this entry
92 SUB R1,R14,R1 ;Find base of this frame
93 LDMFD R13!,{PC}^ ;And return to caller
97 ; --- ctrl__popFrame ---
101 ; On exit: R0 == frame type
102 ; R1 == base address of frame
104 ; Use: Pops the top stack frame off the execution stack. A pointer
105 ; to the frame's data is returned; this data is *still on
106 ; the stack*, so be careful about pushing more on.
110 STMFD R13!,{R2-R5,R14} ;Save some registers
111 ADR R1,sail_execStack ;Point to some stack data
112 LDMIA R1,{R0-R2} ;Load it out
113 LDR R14,[R0] ;Load the actual base address
114 ADD R14,R14,R1 ;Find the top of the stack
115 LDR R3,[R14,#-4] ;Load type of top frame
116 ADR R14,ctrl__frSize ;Point to frame size table
117 LDRB R5,[R14,R3] ;And get the frame size
119 SUB R4,R1,R5 ;The new size
120 ADD R1,R4,#255 ;Align up again
121 BIC R1,R1,#255 ;Aligned down
122 ADD R1,R1,#256 ;At more than we need
123 CMP R1,R2 ;Has this size changed?
124 BLLT mem_realloc ;Yes -- reduce memory reqs.
125 STRLT R1,sail_execStkSize ;Store new size maybe
126 STR R4,sail_execStkPtr ;Store back new size
127 LDR R0,[R0] ;Point to the stack
128 ADD R1,R0,R4 ;Find the frame base address
129 MOV R0,R3 ;And get the frame type
130 LDMFD R13!,{R2-R5,PC}^ ;And return to caller
134 ctrl__frSize DCB cFor__size+4
145 ;----- Command handlers -----------------------------------------------------
152 MOV R0,#1 ;Read an lvalue
153 BL express_read ;Leave that on the stack
154 CMP R9,#'=' ;Is this an assignment op?
155 BNE %10ctrl_let ;No -- maybe more complex
156 BL getToken ;Get another token
157 MOV R0,#0 ;Read a general expression
158 BL express_read ;Read that nicely
160 BL express_popTwo ;Pop two values off the stack
161 BL ctrl_store ;Stuff one into the other
162 B interp_next ;Move on to next instruction
164 ; --- Try other assignment ops then ---
166 10 CMP R7,#tClass_assign ;Is it an assign op?
167 MOVNE R0,#err_mistake ;No -- that's a mistake
168 BNE error_report ;So complain at someone
170 ; --- Read the rvalue ---
172 MOV R6,R8 ;Look after the index
173 BL getToken ;Get another token
174 BL express_pop ;Pop off the lvalue
175 BL ctrl_load ;Load it's value
176 STMFD R13!,{R0,R1} ;Look after the lvalue
177 MOV R0,#0 ;Read a general expression
178 BL express_read ;Read that nicely
179 BL express_pop ;Pop the rvalue
180 MOV R4,R0 ;Look after rvalue
182 LDMFD R13!,{R0,R1} ;Load the lvalue back
184 ADD PC,PC,R6,LSL #2 ;Jump to the right routine
192 ; --- The operations ---
196 20 CMP R3,#vType_string
198 CMP R3,#vType_integer
199 MOVNE R0,#err_arrayBad
201 CMP R5,#vType_integer
202 MOVNE R0,#err_numNeeded
208 25 CMP R5,#vType_string ;This is a string I hope
209 MOVNE R0,#err_strNeeded ;No -- get error number
210 BNE error_report ;...and report the error
212 MOV R14,R4,LSL #24 ;Get the second string len
213 CMN R14,R2,LSL #24 ;Is the string short enough?
214 ADDCC R2,R2,R14,LSR #24 ;Add on second length
218 MOV R0,#err_strTooLong ;String is too long
221 ; --- Subtraction ---
223 30 CMP R3,#vType_integer
224 CMPEQ R5,#vType_integer
225 MOVNE R0,#err_numNeeded
231 ; --- Multiplication ---
233 40 CMP R3,#vType_integer
234 CMPEQ R5,#vType_integer
235 MOVNE R0,#err_numNeeded
243 50 CMP R3,#vType_integer
244 CMPEQ R5,#vType_integer
245 MOVNE R0,#err_numNeeded
258 ; --- ctrl_timeEq ---
263 CMP R9,#'=' ;Next char must be `='
264 MOVNE R0,#err_expEq ;If it isn't, moan
266 BL getToken ;Skip past the equals sign
267 MOV R0,#0 ;Read the expression
269 BL express_pop ;Pop the result
270 CMP R1,#vType_integer ;It must be an integer
271 BNE ctrl__notAnInt ;So if it isn't, complain
272 MOV R1,R0 ;Look after this result
273 SWI OS_ReadMonotonicTime ;Find the current real time
274 SUB R0,R0,R1 ;Work out the correct offset
275 STR R0,sail_timeOff ;Store it away nicely
276 B interp_next ;And read another instruction
285 MOV R0,#1 ;Read an lvalue
286 BL express_read ;Leave that on the stack
287 CMP R9,#'=' ;We now need an equals
288 MOVNE R0,#err_eqInFor ;If we don't have it, moan
290 BL getToken ;Skip over the equals sign
291 MOV R0,#0 ;Read the base value
293 CMP R9,#tok_to ;Make sure we have a TO
294 MOVNE R0,#err_expTo ;If we don't have it, moan
296 BL getToken ;Skip over the TO token
297 MOV R0,#0 ;Read the end value
299 CMP R9,#tok_step ;Is there a STEP?
300 BLEQ getToken ;Yes -- get another token
301 MOVEQ R0,#0 ;...read another rvalue
303 BLEQ express_pop ;...and get this value
304 MOVNE R0,#1 ;Otherwise use sensible value
305 MOVNE R1,#vType_integer
307 ; --- Create the stack frame ---
309 STMFD R13!,{R0,R1} ;Save step again for a bit
310 MOV R0,#cFrame__for ;Create a FOR loop frame
311 BL ctrl__pushFrame ;Stick that on the stack
312 MOV R4,R0 ;Look after the frame pointer
313 LDMFD R13!,{R0,R1} ;Load the step value again
314 CMP R1,#vType_integer ;Check it's an integer
315 BNE ctrl__notAnInt ;If not, complain
316 STR R0,[R4,#cFor__step] ;Save the step away
318 BL express_pop ;Find the end marker
319 CMP R1,#vType_integer ;Check it's an integer
320 BNE ctrl__notAnInt ;If not, complain
321 STR R0,[R4,#cFor__end] ;Stuff that in the end pos
323 BL express_popTwo ;Get ctrl var and start pos
324 CMP R1,#vType_lvInt ;Ensure lvalue is integral
325 CMPNE R1,#vType_lvWord
326 CMPNE R1,#vType_lvByte
327 MOVNE R0,#err_badForVar ;If not, find suitable error
328 BNE error_report ;And tell the user
329 BL ctrl_store ;Initialise it nicely
330 ADD R14,R4,#cFor__lval ;Find the lvalue position
331 STMIA R14,{R0,R1} ;Save that away too
333 ADD R14,R4,#cFor__resume ;Point to resume buffer
334 LDR R1,sail_tokAnchor ;Find anchor of script buff
335 SUB R1,R10,R1 ;Work out current offset
336 LDR R0,sail_line ;Get the current line number
337 STMIA R14,{R0,R1} ;Save these in the frame
339 B interp_next ;Move on to next instruction
348 ; --- First check for identifier ---
350 ; If there is one, we need to search for a specific FOR
351 ; frame. Otherwise any old one will do.
353 SUBS R14,R9,#'_' ;Is this an identifier?
354 SUBNE R14,R9,#'A' ;No -- check for uppercase
356 SUBCS R14,R9,#'a' ;No -- check for lowercase
359 ; --- Read the lvalue given ---
361 MOVCC R0,#1 ;Read an lvalue
362 BLCC express_read ;And put it on the stack
363 BLCC express_pop ;Get it in registers
364 MOVCS R1,#-1 ;Otherwise get bogus value
365 MOV R2,R0 ;Look after the lvalue
366 MOV R3,R1 ;And the type
367 10 MOV R0,#cFrame__for ;Look for a FOR frame
368 BL ctrl__findFrame ;Try to find the frame
369 MOVCC R0,#err_noFor ;Complain if we hit routine
371 ADD R14,R1,#cFor__lval ;Find the lvalue
372 LDMIA R1,{R4,R5} ;Load them out nicely
373 CMP R2,R4 ;Now check for a match
374 CMPEQ R3,R5 ;Check the type too
375 CMPNE R3,#-1 ;Or maybe we don't care
376 BLNE ctrl__popFrame ;No match -- discard frame
377 BNE %10ctrl_next ;And loop back round
379 ; --- Now step the variable ---
381 MOV R6,R1 ;Look after frame base
382 MOV R0,R4 ;Get the original lvalue back
383 MOV R1,R5 ;And its type
384 BL ctrl_load ;Load the current value
385 LDR R4,[R6,#cFor__step] ;Load the step size
386 ADD R2,R2,R4 ;Bump the loop counter
387 BL ctrl_store ;Save the modified counter
388 LDR R14,[R6,#cFor__end] ;Find the end limit
389 CMP R4,#0 ;Are we going backwards?
390 SUBGT R14,R2,R14 ;Yes -- subtract this way
391 SUBLT R14,R14,R2 ;Otherwise the other way
392 CMP R14,#0 ;Now which way do we go?
393 BGT %50ctrl_next ;Finished the loop -- stop
395 ; --- Now resume from the FOR loop ---
397 ADD R14,R6,#cFor__resume ;Find the resume point
398 LDMIA R14,{R0,R1} ;Load the line and offset
399 STR R0,sail_line ;Save the line counter
400 LDR R14,sail_tokAnchor ;Find the anchor of the file
401 ADD R10,R14,R1 ;Get the new offset
402 SUB R10,R10,#1 ;Backtrack to read prev token
403 MOV R9,#0 ;Give bogus current token
404 BL getToken ;Read this token
405 B interp_next ;And continue merrily
407 ; --- Now see if there's more loops to close ---
409 50ctrl_next BL ctrl__popFrame ;Remove defunct FOR frame
410 CMP R9,#',' ;Do we have more loops?
411 BLEQ getToken ;Yes -- skip the comma
412 BEQ ctrl_next ;And close them too
414 B interp_next ;Finished this instruction
418 ; --- ctrl_repeat ---
423 MOV R0,#cFrame__repeat ;Create a REPEAT frame
424 BL ctrl__pushFrame ;Stick that on the stack
425 LDR R2,sail_tokAnchor ;Find anchor of script buff
426 SUB R2,R10,R2 ;Work out current offset
427 LDR R1,sail_line ;Get the current line number
428 STMIA R0,{R1,R2} ;Save these in the frame
429 B interp_exec ;Get the next instruction
438 MOV R0,#0 ;Read an rvalue
439 BL express_read ;Read an expression
440 BL express_pop ;Read it then
441 CMP R1,#vType_integer ;Is it an integer?
442 BNE ctrl__notAnInt ;No -- complain then
443 MOV R2,R0 ;Look after the result
445 ; --- Find the REPEAT frame ---
447 MOV R0,#cFrame__repeat ;Look for a REPEAT frame
448 BL ctrl__findFrame ;Try to find the frame
449 MOVCC R0,#err_noRepeat ;Complain if we hit routine
452 CMP R2,#0 ;Should we REPEAT?
453 BLNE ctrl__popFrame ;No -- pop the repeat frame
454 BNE interp_next ;No -- just continue then
456 ; --- Go back to the REPEAT ---
458 LDMIA R1,{R0,R1} ;Load the line and offset
459 STR R0,sail_line ;Save the line counter
460 LDR R14,sail_tokAnchor ;Find the anchor of the file
461 ADD R10,R14,R1 ;Get the new offset
462 SUB R10,R10,#1 ;Backtrack to read prev token
463 MOV R9,#-1 ;Give bogus current token
464 BL getToken ;Read this token
465 B interp_exec ;And continue merrily
474 ; --- Push a while frame on the stack ---
476 MOV R0,#cFrame__while ;Create a REPEAT frame
477 BL ctrl__pushFrame ;Stick that on the stack
478 LDR R2,sail_tokAnchor ;Find anchor of script buff
479 SUB R2,R10,R2 ;Work out current offset
480 LDR R1,sail_line ;Get the current line number
481 STMIA R0,{R1,R2} ;Save these in the frame
483 ; --- Read the expression ---
485 MOV R0,#0 ;Read an expression
486 BL express_read ;Read it ithen
487 BL express_pop ;Pop the resut
488 CMP R1,#vType_integer ;Is it an integer?
489 BNE ctrl__notAnInt ;No -- that's bad then
490 CMP R0,#0 ;Is is FALSE?
491 BNE interp_exec ;No -- continue then
493 ; --- Scan for the first ENDWHILE then ---
495 MOV R2,#0 ;Keep a nesting count
496 LDR R4,sail_line ;Get current line number
497 10ctrl_while BL getToken ;Get another token
498 CMP R9,#&FF ;Reached the end yet?
499 BEQ %90ctrl_while ;If so, moan about ENDWHILE
500 CMP R9,#tok_while ;Is it a WHILE token?
501 ADDEQ R2,R2,#1 ;Yes -- bump nesting count
503 CMP R9,#tok_endwhile ;Yes -- check for ENDWHILE
504 SUBEQ R2,R2,#1 ;Yes -- decrement nesting
505 CMP R2,#0 ;Have we dropped out?
506 BGE %10ctrl_while ;No -- loop
508 ; --- We found the ENDWHILE ---
510 BL getToken ;Get the next token
511 BL ctrl__popFrame ;Get rid of my WHILE frame
512 B interp_next ;And execute from here
514 ; --- We fell off the end -- oops ---
516 90ctrl_while STR R4,sail_line ;Save bogus line back
517 MOV R0,#err_expEndwhile ;Hmm... should have had an...
518 B error_report ;ENDWHILE somewhere
522 ; --- ctrl_endwhile ---
527 ; --- Find the ENDWHILE frame ---
529 MOV R0,#cFrame__while ;Look for a REPEAT frame
530 BL ctrl__findFrame ;Try to find the frame
531 MOVCC R0,#err_noWhile ;Complain if we hit routine
534 ; --- Remember where we are ---
536 LDR R2,sail_line ;Get the line number
537 MOV R3,R10 ;And our position
539 ; --- Go back to the WHILE ---
541 LDMIA R1,{R0,R1} ;Load the line and offset
542 STR R0,sail_line ;Save the line counter
543 LDR R14,sail_tokAnchor ;Find the anchor of the file
544 ADD R10,R14,R1 ;Get the new offset
545 SUB R10,R10,#1 ;Backtrack to read prev token
546 MOV R9,#-1 ;Give bogus current token
547 BL getToken ;Read this token
549 ; --- Now read the expression ---
551 MOV R0,#0 ;Read an rvalue
552 BL express_read ;Read it then
553 BL express_pop ;Get the value
554 CMP R0,#0 ;Should we go from here?
555 BNE interp_exec ;Yes -- execute then
557 ; --- Execute from the ENDWHILE ---
559 BL ctrl__popFrame ;Pop the WHILE frame
560 SUB R10,R3,#1 ;Set R10 up
561 STR R2,sail_line ;Store the line number
562 MOV R9,#-1 ;Make getToken happy
563 BL getToken ;Get a token then
564 B interp_next ;And execute happily
568 ; --- ctrl__readLabel ---
572 ; On exit: CS if there was a label and,
573 ; R0 == pointer to the label node
577 ; Use: Reads a label fromthe current position, and looks it
578 ; up inthe symbol table.
582 STMFD R13!,{R14} ;Stack the link
584 ADR R2,sail_misc ;Point to a nice buffer
585 SUBS R14,R9,#'_' ;Is it a valid characer?
592 BCS %90ctrl__readLabel ;No -- bark then
593 STRB R9,[R2],#1 ;And store in the buffer
595 10 BL getToken ;Get the next character
596 SUBS R14,R9,#'_' ;Is it a valid characer?
603 STRCCB R9,[R2],#1 ;Yes -- store in the buffer
604 BCC %10ctrl__readLabel ;...and keep on looping
609 ; --- Now find the node ---
611 MOV R0,#vType_label ;This is a label
612 ADR R1,sail_misc ;Point at the name
613 BL tree_find ;Try to find it
614 MOVCC R0,#err_noLabel ;Not there -- complain
617 LDMFD R13!,{R14} ;Load the link back
618 ORRS PC,R14,#C_flag ;Return 'label here'
620 ; --- The label was bad --
622 90 LDMFD R13!,{R14} ;Load the link back
623 BICS PC,R14,#C_flag ;Return 'no label'
632 ; --- Read the label ---
634 BL ctrl__readLabel ;Read a label
635 BCC %90ctrl_gosub ;No there -- barf
636 MOV R3,R0 ;Look after node address
638 ; --- Push a GOSUB frame ---
640 MOV R0,#cFrame__gosub ;Create a REPEAT frame
641 BL ctrl__pushFrame ;Stick that on the stack
642 LDR R2,sail_tokAnchor ;Find anchor of script buff
643 SUB R2,R10,R2 ;Work out current offset
644 LDR R1,sail_line ;Get the current line number
645 STMIA R0,{R1,R2} ;Save these in the frame
647 ; --- Branch off somewhere ---
649 LDMIB R3,{R0,R1} ;Load out address/line
650 STR R1,sail_line ;Store the line number
651 LDR R1,sail_tokAnchor ;Load anchor address
652 MOV R9,#-1 ;Don't confuse getToken
653 ADD R10,R0,R1 ;This is where we are
654 BL getToken ;Prime the lookahead token
655 LDR R14,sail_flags ;Load the flags word
656 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
657 STR R14,sail_flags ;Store the flasg back
658 B interp_exec ;Execute from here!
660 90ctrl_gosub MOV R0,#err_expLabel ;Get the error number
661 B error_report ;Report the error
665 ; --- ctrl_return ---
670 MOV R0,#cFrame__gosub ;Look for a GOSUB frame
671 BL ctrl__findFrame ;Try to find the frame
672 MOVCC R0,#err_notInSub ;Complain if not a GOSUB
674 BL ctrl__popFrame ;Pop off the frame
675 LDMIA R1,{R0,R1} ;Load the line and offset
676 STR R0,sail_line ;Save the line counter
677 LDR R14,sail_tokAnchor ;Find the anchor of the file
678 ADD R10,R14,R1 ;Get the new offset
679 SUB R10,R10,#1 ;Backtrac a little
680 MOV R9,#-1 ;Give bogus current token
681 BL getToken ;Read this token
682 B interp_next ;And continue merrily
689 LDR R14,sail_flags ;Load the flags word
690 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
691 STR R14,sail_flags ;Store the flasg back
693 MOV R0,#0 ;Read an rvalue
695 BL express_pop ;Get that value
696 CMP R1,#vType_integer ;It must be an integer
697 MOVNE R0,#err_numNeeded ;Isn't -- get error
698 BNE error_report ;And report the error
699 CMP R0,#0 ;Should we execute this?
700 BEQ %10ctrl_if ;No -- look for the else
702 CMP R9,#tok_then ;Is there a THEN here?
703 BLEQ getToken ;Yes -- skip over it then
704 B interp_exec ;And just execute from here
706 ; --- Look for an ELSE statement ---
708 10ctrl_if CMP R9,#tok_then ;Do we have a THEN then?
709 BNE %30ctrl_if ;No -- search line for else
711 BL getToken ;Get another token
712 CMP R9,#&0a ;Is this a return?
713 BNE %30ctrl_if ;No -- search line then
715 ; --- Now look for ELSE ... ENDIF structure ---
717 MOV R3,#0 ;My counter thing
718 LDR R4,sail_line ;Get the current line
720 20ctrl_if MOV R2,R9 ;Remmber the previous char
721 BL getToken ;Skip over the return
722 CMP R9,#&FF ;Is this the end of file?
723 BEQ %50ctrl_if ;Yes -- jump ahead
724 CMP R2,#&0a ;Was prev a newline?
725 CMPNE R9,#&0a ;Or even this one?
726 BNE %20ctrl_if ;Neither -- keep looping
728 CMP R2,#tok_then ;Did we just read a then
729 ADDEQ R3,R3,#1 ;Yes -- increment the count
730 BEQ %20ctrl_if ;And keep on looping
732 CMP R9,#tok_else ;Or an else?
733 CMPEQ R3,#0 ;Yes -- at bottom level?
734 CMPNE R9,#tok_endif ;Is this an endif?
735 SUBEQ R3,R3,#1 ;Yes -- decrement the count
736 CMP R3,#0 ;Are we ready to execute?
737 BGE %20ctrl_if ;No -- loop then
739 BL getToken ;Get the next token
740 B interp_next ;Execute from here!
742 ; --- Search on the same line ---
744 30ctrl_if MOV R0,R9 ;Look after this char
745 CMP R9,#&FF ;At end of file?
746 BLNE getToken ;No -- read next token
747 CMPNE R0,#tok_else ;Stop at ELSE tokens
748 CMPNE R0,#&0a ;And at line end
749 BNE %30ctrl_if ;If not, loop back again
750 B interp_exec ;And carry on going
752 ; -- Missing ENDIF ---
754 50ctrl_if STR R4,sail_line ;Store original line number
755 MOV R0,#err_expEndif ;Get the error number
756 B error_report ;And report the error
765 LDR R0,sail_flags ;Load the flags word
766 TST R0,#tscFlag_nl ;Have we just had a newline?
767 BNE %20ctrl_else ;Yes -- look for an ENDIF
769 ; --- Search for the line end ---
771 10ctrl_else MOV R0,R9 ;Look after old token
772 CMP R9,#&FF ;Is this the EOF
773 BLNE getToken ;No - get a token
774 CMP R0,#&0a ;Was it the line end?
775 BNE %10ctrl_else ;No -- keep on looking
776 B interp_next ;Execute from here
778 ; --- Look for an ENDIF ---
780 20ctrl_else MOV R3,#0 ;My counter thing
781 LDR R4,sail_line ;Get the current line
782 MOV R2,#0 ;Dummy previous char
785 40ctrl_else MOV R2,R9 ;Remember the previous token
786 BL getToken ;Get a new one
787 45ctrl_else CMP R9,#&FF ;Is this the end of file?
788 BEQ %50ctrl_else ;Yes -- jump ahead
789 CMP R2,#&0a ;Was prev a newline?
790 CMPNE R9,#&0a ;Or even this one?
791 BNE %40ctrl_else ;Neither -- keep looping
793 CMP R2,#tok_then ;Did we just read a then
794 ADDEQ R3,R3,#1 ;Yes -- increment the count
795 BEQ %40ctrl_else ;And keep on looping
797 CMP R9,#tok_endif ;Is this an endif?
798 SUBEQ R3,R3,#1 ;Yes -- decrement the count
799 CMP R3,#0 ;Are we ready to execute?
800 BGE %40ctrl_else ;No -- loop then
802 BL getToken ;Get the next token
803 B interp_next ;Execute from here!
805 ; -- Missing ENDIF ---
807 50ctrl_else STR R4,sail_line ;Store original line number
808 MOV R0,#err_expEndif ;Get the error number
809 B error_report ;And report the error
818 BL ctrl__readLabel ;Read the label
819 BCC %90ctrl_goto ;Not there -- barf
821 LDMIB R0,{R0,R1} ;Load out address/line
822 STR R1,sail_line ;Store the line number
823 LDR R1,sail_tokAnchor ;Load anchor address
824 MOV R9,#-1 ;Don't confuse getToken
825 ADD R10,R0,R1 ;This is where we are
826 BL getToken ;Prime the lookahead token
827 LDR R14,sail_flags ;Load the flags word
828 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
829 STR R14,sail_flags ;Store the flasg back
830 B interp_exec ;Execute from here!
832 90ctrl_goto MOV R0,#err_expLabel ;Get the error number
833 B error_report ;Report the error
842 MOV R0,#0 ;Read the comparand
844 BL express_pop ;Read the value of that
845 CMP R1,#vType_integer ;Is it an integer?
846 CMPNE R1,#vType_string ;Or a string?
847 MOVNE R0,#err_arrayBad ;No -- then point to error
848 BNE error_report ;And report the error
849 MOV R2,R0 ;Look after compare value
850 MOV R3,R1 ;And the type too, please
852 CMP R9,#tok_of ;We pointlessly expect `OF'
853 MOVNE R0,#err_expOf ;If not there, complain
855 BL getToken ;Get the next token
856 CMP R9,#&0A ;This must be the line end
857 MOVNE R0,#err_afterCase ;If not, complain annoyingly
860 ; --- Now keep an eye out for WHENs and OTHERWISEs ---
862 MOV R5,#0 ;Keep a nesting count
863 LDR R6,sail_line ;Get current line number
864 10ctrl_case MOV R4,R9 ;Look after previous char
865 BL getToken ;Get another token
866 CMP R9,#&FF ;Reached the end yet?
867 BEQ %90ctrl_case ;If so, moan about ENDCASE
868 CMP R9,#tok_case ;Is it a CASE token?
869 ADDEQ R5,R5,#1 ;Yes -- bump nesting count
870 CMP R4,#&0A ;Was previous newline?
871 BNE %10ctrl_case ;No -- nothing doing here
873 CMP R5,#0 ;At bottom nesting level?
874 CMPEQ R9,#tok_otherwise ;Yes -- check for OTHERWISE
875 CMPNE R9,#tok_endcase ;Or maybe an ENDCASE?
876 SUBEQ R5,R5,#1 ;Yes -- decrement nesting
877 CMP R5,#0 ;Have we dropped out?
878 BLLT getToken ;Yes -- get the next token
879 BLT %80ctrl_case ;Yes -- start executing
880 CMPEQ R9,#tok_when ;Now check for a W
881 BNE %10ctrl_case ;No -- loop
882 BL getToken ;Get another token
884 ; --- Found a WHEN -- check for a match ---
886 11ctrl_case MOV R0,#0 ;Read an rvalue
888 BL express_pop ;Get result from the stack
889 BL ctrl_compare ;Compare the values
890 BEQ %15ctrl_case ;Match -- skip other exprs
891 CMP R1,#vType_string ;Did we load a string?
892 BLEQ stracc_free ;Yes -- reomve the string
893 CMP R9,#',' ;Comma next?
894 BLEQ getToken ;Yes -- skip it
895 BEQ %11ctrl_case ;And try next expression
896 B %10ctrl_case ;Otherwise hope we get lucky
898 ; --- Skip other expressions ---
900 ; BASIC allows extreme bogosity here, and so shall we.
902 15ctrl_case CMP R1,#vType_string ;Did we load a string?
903 BLEQ stracc_free ;Yes -- reomve the string
904 00 CMP R5,#0 ;Are we quoted?
905 CMPEQ R9,#':' ;No -- check for colon
906 CMPNE R9,#&0A ;Newline?
907 BEQ %80ctrl_case ;Yes -- let it rip
908 CMP R9,#'""' ;Is this a quote?
909 EOREQ R5,R5,#1 ;Yes -- toggle quoted bit
910 BL getToken ;Get another token
911 B %b00 ;And keep going
913 ; --- Return to interp_next, removing str from stracc ---
915 80ctrl_case CMP R3,#vType_string ;Were we dealing with a str?
916 MOVEQ R0,R2 ;Yes -- put it in R0
917 BLEQ stracc_free ;...and remove it from stracc
918 B interp_next ;Keep on interpreting
920 ; --- We fell off the end -- oops ---
922 90ctrl_case STR R6,sail_line ;Save bogus line back
923 MOV R0,#err_expEndcase ;Hmm... should have had an...
924 B error_report ;ENDCASE somewhere
932 ; --- ctrl_otherwise ---
934 EXPORT ctrl_otherwise
939 MOV R3,#0 ;My counter thing
940 LDR R4,sail_line ;Get the current line
941 MOV R2,#0 ;Dummy previous char
944 40ctrl_when MOV R2,R9 ;Remember the previous token
945 BL getToken ;Get a new one
946 45ctrl_when CMP R9,#&FF ;Is this the end of file?
947 BEQ %50ctrl_when ;Yes -- jump ahead
948 CMP R9,#tok_case ;Did we just read a CASE
949 ADDEQ R3,R3,#1 ;Yes -- increment the count
950 BEQ %40ctrl_when ;And keep on looping
951 CMP R2,#&0a ;Was prev a newline?
952 CMPEQ R9,#tok_endcase ;Is this an endcase?
953 SUBEQ R3,R3,#1 ;Yes -- decrement the count
954 CMP R3,#0 ;Are we ready to execute?
955 BGE %40ctrl_when ;No -- loop then
957 BL getToken ;Get the next token
958 B interp_next ;Execute from here!
960 ; -- Missing ENDCASE ---
962 50ctrl_when STR R4,sail_line ;Store original line number
963 MOV R0,#err_expEndcase ;Get the error number
964 B error_report ;And report the error
983 MOV R0,#1 ;Read an lvalue
985 CMP R9,#',' ;Do we have a comma?
986 MOVNE R0,#err_expComma ;No -- get the error number
987 BNE error_report ;And report the error
988 BL getToken ;Skip over the comma
989 MOV R0,#1 ;Read another lvalue
991 BL express_popTwo ;Pop off the two lvalues
993 ; --- Swap the contents of the lvalues ---
995 10ctrl_swap MOV R4,R2 ;Look after parm 2
997 BL ctrl_load ;Load the parameter
998 STMFD R13!,{R2,R3} ;Store rvalue
999 STMFD R13!,{R0,R1} ;And lvalue
1000 MOV R0,R4 ;Get the second one
1002 BL ctrl_load ;Load it's value too
1003 LDMFD R13!,{R0,R1} ;Get back lvalue
1004 BL ctrl_store ;Store rvalue in lvalue
1005 MOV R0,R4 ;Get the second one
1007 LDMFD R13!,{R2,R3} ;Load rvalue
1008 BL ctrl_store ;Complete the swap
1009 B interp_next ;All over and happy
1018 MOV R0,#2 ;Read an rvalue ident
1019 BL express_read ;Read it then
1020 BL express_pop ;And get it off the stack
1021 CMP R1,#vType_integer ;Is this a string?
1022 BNE ctrl__notAnInt ;So if it isn't, complain
1023 MOV R3,R0 ;Remember file handle
1025 CMP R9,#'=' ;Next char must be `='
1026 MOVNE R0,#err_expEq ;If it isn't, moan
1028 BL getToken ;Skip past the equals sign
1029 MOV R0,#0 ;Read the expression
1031 BL express_pop ;Pop the result
1032 CMP R1,#vType_integer ;It must be an integer
1033 BNE ctrl__notAnInt ;So if it isn't, complain
1035 MOV R2,R0 ;Put pointer in R2
1036 MOV R1,R3 ;And handle in R1
1037 MOV R0,#1 ;Write pointer
1038 SWI XOS_Args ;Write the pointer
1039 BVS sail_error ;Report possible error
1041 B interp_next ;And read another instruction
1050 MOV R0,#2 ;Read an rvalue ident
1051 BL express_read ;Read it then
1052 BL express_pop ;And get it off the stack
1053 CMP R1,#vType_integer ;Is this a string?
1054 BNE ctrl__notAnInt ;So if it isn't, complain
1055 MOV R3,R0 ;Remember file handle
1057 CMP R9,#'=' ;Next char must be `='
1058 MOVNE R0,#err_expEq ;If it isn't, moan
1060 BL getToken ;Skip past the equals sign
1061 MOV R0,#0 ;Read the expression
1063 BL express_pop ;Pop the result
1064 CMP R1,#vType_integer ;It must be an integer
1065 BNE ctrl__notAnInt ;So if it isn't, complain
1067 MOV R2,R0 ;Put extent in R2
1068 MOV R1,R3 ;And handle in R1
1069 MOV R0,#3 ;Write pointer
1070 SWI XOS_Args ;Write the extent
1071 BVS sail_error ;Report possible error
1073 B interp_next ;And read another instruction
1077 ; --- ctrl_close ---
1082 MOV R0,#2 ;Read an rvalue ident
1083 BL express_read ;Read it then
1084 BL express_pop ;And get it off the stack
1085 CMP R1,#vType_integer ;Is this a string?
1086 BNE ctrl__notAnInt ;So if it isn't, complain
1087 MOV R1,R0 ;Remember file handle
1088 MOV R0,#0 ;Close file
1089 SWI XOS_Find ;Close it then
1090 BVS interp_next ;And read another instr
1092 AND R0,R0,#&FF ;Make sure this is a byte
1093 ADR R1,sail_files ;Find file bit-array
1094 MOV R14,R0,LSR #5 ;Get word index
1095 LDR R14,[R1,R14,LSL #2]! ;Load the word I want
1096 MOV R2,#(1<<31) ;Set the top bit here
1097 BIC R14,R14,R2,ROR R0 ;Clear the correct bit
1098 STR R14,[R1,#0] ;Save the word back again
1099 B interp_next ;And read another instr
1108 ; --- First, make sure we have a hash ---
1110 CMP R9,#'#' ;We must have a hash
1111 MOVNE R0,#err_expHash ;No -- complain then
1112 BNE error_report ;And report an error
1113 BL getToken ;Get the next token
1115 ; --- Now read the channel number ---
1117 MOV R0,#2 ;Read an rvalue ident
1118 BL express_read ;Read it then
1119 BL express_pop ;And get it off the stack
1120 CMP R1,#vType_integer ;Is this a string?
1121 BNE ctrl__notAnInt ;So if it isn't, complain
1122 MOV R3,R0 ;Remember file handle
1124 ; --- Skip over the comma ---
1126 CMP R9,#',' ;Next char must be `,'
1127 MOVNE R0,#err_expComma ;If it isn't, moan
1129 BL getToken ;Skip past the comma
1131 ; --- Now we read an expression ---
1133 MOV R0,#0 ;Read the expression
1135 BL express_pop ;Pop the result
1136 CMP R1,#vType_integer ;Is it an integer?
1137 BEQ %10ctrl_bput ;Yes -- jump ahead
1138 CMP R1,#vType_string ;Make sure it is a string
1139 MOVNE R0,#err_arrayBad ;Nope -- get error message
1140 BNE error_report ;So if it isn't, complain
1142 ; --- Write a string to the file ---
1144 MOV R5,R0 ;Look after the value
1145 LDR R1,sail_stracc ;Get the stracc address
1147 ADD R4,R1,R0,LSR #8 ;Point to the string
1148 AND R2,R0,#&FF ;Get the length
1150 MOV R1,R3 ;Get the file handle
1151 CMP R2,#0 ;Is this a short string?
1152 00 LDRGTB R0,[R4],#1 ;Load a character
1153 SWIGT XOS_BPut ;Put the byte
1154 BVS error_reportReal ;Report possible error
1155 SUBS R2,R2,#1 ;Reduce the count
1156 BGT %b00 ;And keep on goin'
1158 MOV R0,R5 ;Put the string in R0
1159 BL stracc_free ;Free it from stracc
1161 CMP R9,#';' ;Is there a semicolon now?
1162 BLEQ getToken ;Yes -- get a token
1163 MOVNE R0,#10 ;Get a terminator
1164 SWINE XOS_BPut ;Put the byte
1165 B interp_next ;And read another instruction
1167 ; --- Just write a character ---
1169 10 MOV R1,R3 ;Get the file handle
1170 SWI XOS_BPut ;Put the byte
1171 BVS error_reportReal ;Report possible error
1172 B interp_next ;And read another instruction
1176 ;----- Odds and sods --------------------------------------------------------
1178 ; --- ctrl_error ---
1183 ; --- Read a parameter ---
1185 MOV R0,#0 ;Read an rvalue
1186 BL express_read ;Read it then
1187 BL express_pop ;And get it off the stack
1188 CMP R1,#vType_string ;Is this a string?
1189 MOVNE R0,#err_strNeeded ;Nope -- get error number
1190 BNE error_report ;...and report the error
1192 LDR R1,sail_stracc ;Get the stracc address
1194 ADD R1,R1,R0,LSR #8 ;Point to the string
1195 AND R2,R0,#&FF ;Get the length
1197 MOV R5,R0 ;look after the rvalue
1198 ADR R0,sail_misc ;Point to the misc buffer
1199 MOV R14,#1 ;A sillu error number
1200 STR R14,[R0],#4 ;Store that
1201 BL ctrl_copyString ;Copy the string over
1202 ADR R0,sail_misc ;Point to the misc buffer
1203 B sail_error ;Return the error
1207 ; --- ctrl_oscli ---
1212 ; --- Read a parameter ---
1214 MOV R0,#0 ;Read an rvalue
1215 BL express_read ;Read it then
1216 BL express_pop ;And get it off the stack
1217 CMP R1,#vType_string ;Is this a string?
1218 MOVNE R0,#err_strNeeded ;Nope -- get error number
1219 BNE error_report ;...and report the error
1221 LDR R1,sail_stracc ;Get the stracc address
1223 ADD R1,R1,R0,LSR #8 ;Point to the string
1224 AND R2,R0,#&FF ;Get the length
1226 MOV R5,R0 ;look after the rvalue
1227 ADR R0,sail_misc ;Point to the misc buffer
1228 BL ctrl_copyString ;Copy the string over
1229 SWI OS_CLI ;Do the command
1230 MOV R0,R5 ;Get the rvalue back
1231 BL stracc_free ;Free the string from stracc
1232 B interp_next ;Continue happily
1238 ;----- DATA and the like ----------------------------------------------------
1240 ; --- ctrl__findDATA ---
1242 ; On entry: All the normal things
1244 ; On exit: R0 == *address* in file of next DATA
1246 ; Use: Sets the internal data pointer to the first DATA statement
1247 ; fromthe current position.
1249 EXPORT ctrl_findDATA
1252 STMFD R13!,{R1,R2,R14} ;Save some registers
1253 LDR R0,sail_dataPtr ;Load the current position
1254 LDR R1,sail_tokAnchor ;Load the anchor
1255 ADD R0,R1,R0 ;Point into the file
1256 LDR R2,sail_dataLine ;Line number of DATA
1258 ; --- Search the file for DATA, or EOF ---
1260 00 LDRB R14,[R0],#1 ;Load a byte
1261 CMP R14,#10 ;Are we at a return?
1262 ADDEQ R2,R2,#1 ;Yes -- inc line number
1263 CMP R14,#&FF ;Is this the EOF?
1264 SUBEQ R0,R0,#1 ;Yes -- point to it
1265 CMPNE R14,#tok_data ;Did we read a DATA?
1266 BNE %b00 ;No -- keep on looking
1268 90 SUB R1,R0,R1 ;Get it as an offset
1269 STR R1,sail_dataPtr ;Save this away then
1270 STR R2,sail_dataLine ;And the line number
1271 LDMFD R13!,{R1,R2,PC}^ ;Return to caller
1280 ; --- Point at the current position ---
1282 LDR R4,sail_dataPtr ;Load the current position
1283 LDR R5,sail_tokAnchor ;Load the anchor
1284 ADD R4,R5,R4 ;Point into the file
1286 00ctrl_read LDRB R14,[R4,#0] ;Load the byte there
1287 CMP R14,#&FF ;Is it the EOF?
1288 MOVEQ R0,#err_outOfDATA ;Yes -- get error num
1289 BEQ error_report ;And report the error
1290 CMP R14,#10 ;Are we at the line end?
1291 BLEQ ctrl_findDATA ;Yes -- find next data
1292 MOVEQ R4,R0 ;...put ptr in R0
1293 BEQ %00ctrl_read ;...and start again
1294 CMP R14,#',' ;Is it a comma?
1295 ADDEQ R4,R4,#1 ;Yes -- skip over it
1297 ; --- Read an rvalue from this position ---
1299 LDR R6,sail_line ;Load the line number
1300 STMFD R13!,{R6-R10} ;Stack position details
1301 MOV R10,R4 ;Point just before data
1302 LDR R14,sail_dataLine ;Get the line number
1303 STR R14,sail_line ;Store as actual line
1304 MOV R9,#-1 ;Make getToken happy
1305 BL getToken ;Get a token
1306 MOV R0,#0 ;Read an rvalue
1307 BL express_read ;Read it then
1308 BL express_pop ;Get it off the stack
1309 LDR R14,sail_line ;Get line number
1310 STR R14,sail_dataLine ;Store as DATA line number
1311 SUB R4,R10,#1 ;Restore data pointer
1312 LDMFD R13!,{R6-R10} ;Load back position
1313 STR R6,sail_line ;Restore line number
1314 MOV R2,R0 ;Put rvalue in R2,R3
1317 ; --- We are hopefully pointing at some data ---
1319 MOV R0,#1 ;Prepare to read an lvalue
1320 BL express_read ;Read one then
1321 BL express_pop ;Get it off the stack
1322 BL ctrl_store ;Store the rvalue
1324 SUB R14,R4,R5 ;Get data pointer as offset
1325 STR R14,sail_dataPtr ;Store this away
1326 CMP R9,#',' ;Should we read more?
1327 BLEQ getToken ;Yes -- skip over the comma
1328 BEQ %00ctrl_read ;..and loop back again
1330 B interp_next ;Do next instruction
1334 ; --- ctrl_restore ---
1339 BL ctrl__readLabel ;Read the label
1340 MOVCC R0,#0 ;Not there -- offset is 0
1341 MOVCC R1,#1 ;Line is 1
1342 LDMCSIB R0,{R0,R1} ;Load out address/line
1344 STR R0,sail_dataPtr ;Save the data pointer
1345 STR R1,sail_dataLine ;And the line number
1346 BL ctrl_findDATA ;Find the DATA
1347 B interp_next ;And do the next instruction
1351 ;----- SYS and friends ------------------------------------------------------
1358 BL ctrl_setUpRegs ;Set up the regs then
1360 CMP R10,#vType_integer ;Is this an integer?
1361 MOVNE R0,#err_numNeeded ;No -- get error number
1362 BNE error_report ;...and report the error
1364 MOV R14,PC ;Set up return address
1365 MOV PC,R9 ;Execute the code
1367 ADRL R9,ctrl__returned ;Point to some space
1368 STMIA R9!,{R0-R8} ;Store returned registers
1369 MOV R14,PC,LSR #28 ;Get the flags
1370 STMIA R9,{R14} ;Strore the flags too
1371 LDMFD R13!,{R7-R12} ;Load back position info
1372 LDMFD R13!,{R0} ;Load stracc offset
1373 BL stracc_free ;Free any strings I had
1375 ; --- We have now done the SWI instr ---
1377 ADRL R0,ctrl__returned ;Point to the returned regs
1378 BL ctrl_resolveRegs ;Do the other half now
1379 B interp_next ;If flags -- return
1388 BL ctrl_setUpRegs ;Set up the registers
1389 STMFD R13!,{R0-R8} ;Stack these registers
1391 CMP R10,#vType_integer ;Did user use an integer?
1392 MOVEQ R0,R9 ;Yes -- use that then
1393 BEQ %10ctrl_sys ;And jump ahead
1395 ; --- Convert the name to a number ---
1397 LDR R1,sail_stracc ;Load the stracc address
1399 ADD R1,R1,R9,LSR #8 ;Point to the name
1400 SWI XOS_SWINumberFromString ;Convert it then
1401 BVS error_reportReal ;Report possible error
1403 ; --- We have the SWI number in R0 ---
1405 ; We build the following instructions on the stack:
1410 10 ORR R9,R0,#&EF000000 ;Build the SWI instruction
1411 LDR R10,=&E1A0F00E ;Get the MOV instr too
1412 LDMFD R13!,{R0-R8} ;Load the registers
1413 SUB R13,R13,#8 ;Make some room
1414 STMIA R13,{R9,R10} ;Stack code
1415 MOV R14,PC ;Set up return address
1416 MOV PC,R13 ;Call my code
1418 ADD R13,R13,#8 ;Get rid of my code
1419 ADR R9,ctrl__returned ;Point to some space
1420 STMIA R9!,{R0-R8} ;Store returned registers
1421 MOV R14,PC,LSR #28 ;Get the flags
1422 STMIA R9,{R14} ;Strore the flags too
1423 LDMFD R13!,{R7-R12} ;Load back position info
1424 LDMFD R13!,{R0} ;Load stracc offset
1425 BL stracc_free ;Free any strings I had
1427 ; --- We have now done the SWI instr ---
1429 ADR R0,ctrl__returned ;Point to the returned regs
1430 BL ctrl_resolveRegs ;Do the other half now
1431 B interp_next ;Do the next instruction
1433 ctrl__returned DCD 0,0,0,0,0,0,0,0,0,0,0
1437 ; --- ctrl_setUpRegs ---
1439 ; On entry: R7-R10 == position info
1441 ; On exit: R0-R8 set up for sys call
1442 ; R9,R10 == rvalue of first parameter
1444 ; new position info, R7-R12
1445 ; place to stracc free
1447 ; Use: Sets up all the registers as required by a SYS or SYSCALL
1450 EXPORT ctrl_setUpRegs
1453 MOV R3,R14 ;Look after the link
1454 BL stracc_ensure ;Get current stracc offset
1455 STMFD R13!,{R1} ;Put it on the stack
1456 MOV R5,#0 ;Might be useful
1458 ; --- Read the complusory argument ---
1460 MOV R0,#0 ;It's an rvalue
1461 BL express_read ;Read the expression
1462 BL express_pop ;Pop it
1463 BL express_push ;Push it again
1465 CMP R1,#vType_integer ;Is it an integer?
1466 BEQ %f00 ;Yes -- go round again then
1467 CMP R1,#vType_string ;Was it a string?
1468 MOVNE R0,#err_arrayBad ;No -- get error number
1469 BNE error_report ;And report the error
1470 BL stracc_ensure ;If it was -- ensure room
1471 STRB R5,[R0,#0] ;...store a terminator
1472 AND R0,R0,#3 ;Get the alignment
1474 ORR R0,R1,R0 ;...set up the rvalue
1475 BL stracc_added ;Tell stracc about this
1477 ; --- Now read all other parameters ---
1479 00 MOV R2,#0 ;Mask of regs read
1480 MOV R4,#0 ;Number we have read
1481 00 CMP R9,#',' ;Do we have a comma?
1482 BNE %10ctrl_setUpRegs ;No -- we have finshed then
1483 05 ADD R4,R4,#1 ;Increment the counter
1484 CMP R4,#8 ;Have we read 8?
1485 MOVEQ R0,#err_sysTooManyI ;Yes -- get error number
1486 BEQ error_report ;And report the error
1487 BL getToken ;Skip over the comma
1488 CMP R9,#',' ;Another comma?
1489 MOVEQ R2,R2,LSL #1 ;Yes -- shift R2 along
1490 BEQ %b05 ;And go back for more
1491 MOV R0,#0 ;Read an rvalue
1492 BL express_read ;Read it then
1493 MOV R2,R2,LSL #1 ;Shift R2 along
1494 ORR R2,R2,#1 ;And set the bit
1495 BL express_pop ;Get it off the stack
1496 BL express_push ;Oh -- better not!
1497 CMP R1,#vType_integer ;Is it an integer?
1498 BEQ %b00 ;Yes -- go round again then
1499 CMP R1,#vType_string ;Was it a string?
1500 MOVNE R0,#err_arrayBad ;No -- get error number
1501 BNE error_report ;And report the error
1502 BL stracc_ensure ;If it was -- ensure room
1503 STRB R5,[R0] ;...store a terminator
1504 AND R0,R0,#3 ;Get the alignment
1506 ORR R0,R1,R0 ;...set up the rvalue
1507 BL stracc_added ;Tell stracc about this
1508 B %b00 ;And go round for more
1510 ; --- We have read the input parameters ---
1512 ; We must put the position infor on the stack before
1513 ; the link here, so that it remains on the stack at return
1516 10 STMFD R13!,{R7-R12} ;Stack position info
1517 STMFD R13!,{R3} ;And then stack the link!
1518 LDR R9,sail_stracc ;Load the stracc anchor
1519 LDR R9,[R9] ;Get it's address
1520 MOV R10,R2 ;Put the mask in R10
1522 ; --- Now transfer the info to R0-R8 ---
1524 ; Each routine is padded to eight bytes, for niceness (?)
1525 ; To start, we set everything to
1527 MOV R14,R4 ;Look after number of regs
1538 CMP R14,#0 ;Read no registers?
1539 BEQ %30ctrl_setUpRegs ;Indeed -- jump ahead then
1540 RSB R14,R14,#9 ;Make R4 right
1541 ADD R14,R14,R14,LSL #1 ;Multiply by 3
1542 ADDS PC,PC,R14,LSL #3 ;Jump to the routine (*24)
1543 DCB "TMA!" ;Pad pad pad pad...
1545 28 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1546 BCC %27ctrl_setUpRegs ;No go -- jump ahead then
1547 BL express_pop ;Get the rvalue
1548 CMP R1,#vType_string ;Was it a string?
1549 ADDEQ R8,R9,R0,LSR #8 ;Yes -- point to string
1550 MOVNE R8,R0 ;No -- it's an integer then
1552 27 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1553 BCC %26ctrl_setUpRegs ;No go -- jump ahead then
1554 BL express_pop ;Get the rvalue
1555 CMP R1,#vType_string ;Was it a string?
1556 ADDEQ R7,R9,R0,LSR #8 ;Yes -- point to string
1557 MOVNE R7,R0 ;No -- it's an integer then
1559 26 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1560 BCC %25ctrl_setUpRegs ;No go -- jump ahead then
1561 BL express_pop ;Get the rvalue
1562 CMP R1,#vType_string ;Was it a string?
1563 ADDEQ R6,R9,R0,LSR #8 ;Yes -- point to string
1564 MOVNE R6,R0 ;No -- it's an integer then
1566 25 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1567 BCC %24ctrl_setUpRegs ;No go -- jump ahead then
1568 BL express_pop ;Get the rvalue
1569 CMP R1,#vType_string ;Was it a string?
1570 ADDEQ R5,R9,R0,LSR #8 ;Yes -- point to string
1571 MOVNE R5,R0 ;No -- it's an integer then
1573 24 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1574 BCC %23ctrl_setUpRegs ;No go -- jump ahead then
1575 BL express_pop ;Get the rvalue
1576 CMP R1,#vType_string ;Was it a string?
1577 ADDEQ R4,R9,R0,LSR #8 ;Yes -- point to string
1578 MOVNE R4,R0 ;No -- it's an integer then
1580 23 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1581 BCC %22ctrl_setUpRegs ;No go -- jump ahead then
1582 BL express_pop ;Get the rvalue
1583 CMP R1,#vType_string ;Was it a string?
1584 ADDEQ R3,R9,R0,LSR #8 ;Yes -- point to string
1585 MOVNE R3,R0 ;No -- it's an integer then
1587 22 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1588 BCC %21ctrl_setUpRegs ;No go -- jump ahead then
1589 BL express_pop ;Get the rvalue
1590 CMP R1,#vType_string ;Was it a string?
1591 ADDEQ R2,R9,R0,LSR #8 ;Yes -- point to string
1592 MOVNE R2,R0 ;No -- it's an integer then
1594 21 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1595 BCC %20ctrl_setUpRegs ;No go -- jump ahead then
1596 BL express_pop ;Get the rvalue
1597 CMP R1,#vType_string ;Was it a string?
1598 ADDEQ R1,R9,R0,LSR #8 ;Yes -- point to string
1599 MOVNE R1,R0 ;No -- it's an integer then
1601 20 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1602 BCC %30ctrl_setUpRegs ;No go -- jump ahead then
1603 STMFD R13!,{R1} ;Stack R1
1604 BL express_pop ;Get the rvalue
1605 CMP R1,#vType_string ;Was it a string?
1606 ADDEQ R0,R9,R0,LSR #8 ;Yes -- point to string
1607 LDMFD R13!,{R1} ;Restore R1
1609 ; --- All the registers are now set up, phew! ---
1611 30 STMFD R13!,{R0,R1} ;Stack some registers
1612 BL express_pop ;Get off first arg!
1613 MOV R9,R0 ;Put rvalue in R9,R10
1615 LDMFD R13!,{R0,R1,PC}^ ;Return to caller
1619 ; --- ctrl_resolveRegs ---
1621 ; On entry: R0 == pointer to register block
1623 ; On exit: CS if flags were required, CC otherwise
1625 ; Use: Resolves the registers returned from a SYS or SYSCALL
1626 ; into the appropriate variables. The code assumes that
1627 ; we have possibly just read a TO command, and goes on
1630 EXPORT ctrl_resolveRegs
1631 ctrl_resolveRegs ROUT
1633 ; --- See if we require register return ---
1635 CMP R9,#tok_to ;Do we have a TO?
1636 MOVNES PC,R14 ;No -- return PDQ then
1638 STMFD R13!,{R0-R6,R14} ;Stack registers
1639 BL getToken ;Skip over the TO
1640 MOV R4,R0 ;Put the block in R4
1641 MOV R5,#0 ;Number read so far
1642 ADD R6,R4,#9*4 ;Point tothe flags
1644 00 CMP R9,#':' ;Is this the end?
1648 BEQ %90ctrl_resolveRegs ;Yes -- return then
1649 CMP R9,#',' ;Do we skip this one?
1650 ADDEQ R4,R4,#4 ;Yes -- go onto next reg
1651 ADDEQ R5,R5,#1 ;We have done this many
1652 CMP R5,#9 ;Is this reg 9?
1653 MOVEQ R0,#err_sysTooManyO ;Yes -- get error number
1654 BEQ error_report ;And report then error
1655 CMP R9,#',' ;Compare again with comma
1656 BLEQ getToken ;Yes -- skip the comma
1657 BEQ %b00 ;Keep on going
1659 ; --- We must read one then ---
1661 ; Actually, we may be reading the flags too.
1663 CMP R9,#';' ;Do we have a semicolon?
1664 BEQ %30ctrl_resolveRegs ;Yes -- deal with it then
1666 MOV R0,#1 ;We are reading an lvalue
1667 BL express_read ;Read it
1668 BL express_pop ;Pop it off the stack
1669 BL ctrl_load ;Load the value
1670 CMP R3,#vType_integer ;Is it an integer?
1671 BEQ %20ctrl_resolveRegs ;Yes -- jump ahead
1673 CMP R3,#vType_string ;Is it a string then?
1674 MOVNE R0,#err_arrayBad ;No -- get error number
1675 BNE error_report ;And report the error
1677 ; --- We have to return a string ---
1679 STMFD R13!,{R0,R1} ;Look after the lvalue
1680 MOV R0,R2 ;Put the rvalue in R0
1681 BL stracc_free ;Free the string from stracc
1683 LDR R2,[R4,#0] ;Load the string address
1684 BL stracc_ensure ;Make sure we have room
1685 MOV R3,#0 ;Length so far
1687 10 LDRB R14,[R2],#1 ;Load a byte
1688 CMP R14,#0 ;Is it 0?
1689 STRNEB R14,[R0],#1 ;No -- store it then
1690 ADDNE R3,R3,#1 ;...increment the length
1691 BNE %b10 ;And go round for more
1693 ORR R0,R1,R3 ;Create the rvalue
1694 BL stracc_added ;Tell stracc about this
1695 MOV R2,R0 ;Put rvalue in R2 too
1696 MOV R3,#vType_string ;This is a string
1697 LDMFD R13!,{R0,R1} ;Load the lvalue back
1698 BL ctrl_store ;Store the new value
1699 B %b00 ;Go round again
1701 ; --- It's just an integer then ---
1703 20 LDR R2,[R4,#0] ;Load the integer
1704 BL ctrl_store ;Store this result
1705 B %b00 ;Go round again
1707 ; --- We must read the flags ---
1709 30 BL getToken ;Skip over the ';'
1710 MOV R0,#1 ;Read an lvalue
1711 BL express_read ;Read it then
1712 BL express_pop ;Get it off the stack
1713 BL ctrl_load ;Load the current value
1714 CMP R3,#vType_integer ;Is it an integer?
1715 MOVNE R0,#err_numNeeded ;No -- get error number
1716 BNE error_report ;And report the error
1717 LDR R2,[R6,#0] ;Load the flags word
1718 BL ctrl_store ;Store the new value
1719 LDMFD R13!,{R0-R6,R14} ;Load back registers
1720 ORRS PC,R14,#C_flag ;Return with C set
1722 90 LDMFD R13!,{R0-R6,R14} ;Load back registers
1723 BICS PC,R14,#C_flag ;Return with C clear
1727 ;----- Function/Procedure call ----------------------------------------------
1731 ; OK, maybe it shouldn't be here. I don't really care.
1733 ; Hack warning: This is a hack. We unwind express_read's stack and stuff
1734 ; them away somewhere completely different.
1739 ; --- First we need to make a FN frame ---
1741 ; This involves taking a copy of express_read's stack and
1742 ; stuffing it into the frame so we can restore it afterwards.
1743 ; This basically means that we can recurse mightily without
1744 ; using any R13 stack space. Huzzah!
1746 MOV R0,#cFrame__fn ;Get the frame type
1747 BL ctrl__pushFrame ;Push the frame
1748 LDR R14,sail_oldAnchor ;Load the old anchor address
1749 STR R14,[R0,#cFn__anchor] ;Save it in the frame
1750 STR R6,[R0,#cFn__flags] ;Save express_read's flags
1751 STMFD R13!,{R0} ;Save some register
1752 BL stracc_ensure ;Get current strac position
1753 LDMFD R13!,{R0} ;Load registers back again
1754 STR R1,[R0,#cFn__stracc] ;Save this away
1755 ; Oh, bugger. This doesn't work.
1756 LDR R14,sail_currAnchor ;Load the current anchor
1757 STR R14,sail_oldAnchor ;Save this as the old one
1758 LDR R14,sail_tokAnchor ;Now we work from the file
1759 STR R14,sail_currAnchor ;So set this as current one
1761 ADD R14,R0,#cFn__stack+32 ;Find the stack copy bit
1762 LDMFD R13!,{R1-R4} ;Load some registers
1763 STMFD R14!,{R1-R4} ;Save them into the frame
1764 LDMFD R13!,{R1-R4} ;Load some registers again
1765 STMFD R14!,{R1-R4} ;Save them into the frame
1767 ; --- Now get on with the business of calling ---
1769 LDR R1,sail_execStack ;Load the stack anchor
1770 LDR R1,[R1,#0] ;Tycho bops WimpExtension
1771 SUB R6,R0,R1 ;Turn into an offset
1773 ; --- Substitute the arguments ---
1775 MOV R0,#vType_fn ;This is a FN
1776 BL ctrl__subArgs ;Substitute the args
1778 LDR R0,sail_execStack ;Load the stack anchor
1779 LDR R0,[R0,#0] ;Tycho bops WimpExtension
1780 ADD R0,R0,R6 ;Point to my frame
1781 STMIA R0,{R3,R4} ;Save the return point away
1783 B interp_exec ;Execute next instruction
1792 ; --- First, evaluate the argument ---
1794 MOV R0,#0 ;Get an rvalue for it
1795 BL express_read ;Read the expression
1796 CMP R9,#&0A ;Now at end of line?
1797 CMPNE R9,#':' ;Or end of statement (weird)
1798 CMPNE R9,#&FF ;Or end of file?
1799 CMPNE R9,#tok_else ;Or an ElSE?
1800 MOVNE R0,#err_syntax ;No -- that's a cock-up
1801 BNE error_report ;So be righteous about it
1803 ; --- If the result is a string, copy it ---
1805 BL express_pop ;Pop off the result
1806 MOV R4,R0 ;Put the rvalue in R4
1807 MOV R5,R1 ;And the type in R5
1808 CMP R5,#vType_string ;Is it a string?
1809 BNE %10ctrl_equals ;No -- jump ahead
1811 ; --- Copy the string elsewhere ---
1813 ; We do this since there may be local strings that are
1814 ; removed from stracc, underneath the result.
1816 LDR R1,sail_stracc ;Load stracc's anchor
1817 LDR R1,[R1] ;Load the address
1818 ADD R1,R1,R4,LSR #8 ;Point to the string
1820 ADR R0,sail_misc ;Point to a misc buffer
1821 ANDS R2,R4,#&FF ;Get the length
1822 BEQ %10ctrl_equals ;Nothin' doin', jump
1824 00 LDRB R14,[R1],#1 ;Load a byte
1825 STRB R14,[R0],#1 ;Store a byte
1826 SUBS R2,R2,#1 ;Reduce counter
1827 BNE %b00 ;Do this lots
1828 MOV R0,R4 ;Put the rvalue in R0
1829 BL stracc_free ;Free the string
1831 ; --- Find the frame thing ---
1833 10ctrl_equals MOV R0,#cFrame__fn ;Search for a FN frame
1834 BL ctrl__unwind ;Look for one of these then
1835 MOVCC R0,#err_notInFn ;Get possible error num
1836 BCC error_report ;And report the error
1837 MOV R6,R1 ;Look after frame address
1839 ; --- Put stracc in the right place ---
1841 LDR R0,[R6,#cFn__stracc] ;Load the offset
1842 BL stracc_free ;Okaydokey
1844 ; --- Reset other things ---
1846 LDMIA R1,{R0,R1} ;Load the line and offset
1847 STR R1,sail_line ;Save the line counter
1848 LDR R14,sail_oldAnchor ;Find the anchor of the file
1849 STR R14,sail_currAnchor ;This is the current one
1850 LDR R1,[R6,#cFn__anchor] ;Load the saved anchor
1851 STR R1,sail_oldAnchor ;This is the old one
1852 LDR R14,[R14] ;Pointless instruction
1853 ADD R10,R14,R0 ;Get the new offset
1854 SUB R10,R10,#1 ;Backtrack a little
1855 MOV R9,#-1 ;Give bogus current token
1856 BL getToken ;Read this token
1858 ; --- Put a string result back on stracc ---
1860 MOV R0,R4 ;Get the rvalue
1861 MOV R1,R5 ;And the type
1862 CMP R1,#vType_string ;Was it a string?
1863 BNE %20ctrl_equals ;No -- jump ahead
1865 ; --- Copy the result back into stracc ---
1867 BL stracc_ensure ;Make sure we have room
1868 ADR R2,sail_misc ;Point to our string
1869 ANDS R3,R4,#&FF ;Get the length
1870 BEQ %15ctrl_equals ;Very short -- jump
1871 00 LDRB R14,[R2],#1 ;Load a byte
1872 STRB R14,[R0],#1 ;Store a byte
1873 SUBS R3,R3,#1 ;Reduce a counter
1874 BNE %b00 ;Lots more please
1876 15 ANDS R3,R4,#&FF ;Get the length again
1877 ORR R0,R1,R3 ;Put the rvalue in R0
1878 MOV R1,#vType_string ;This is a string
1879 BL stracc_added ;Tell stracc about this
1880 20 BL express_push ;Push this result
1882 ; --- Now we need to return to express_read ---
1884 ; Hack warning: This is a hack.
1886 ADD R14,R6,#cFn__stack ;Find stack contents
1887 LDMFD R14!,{R0-R3} ;Load contents out
1888 STMFD R13!,{R0-R3} ;Stuff them back on the stack
1891 LDR R6,[R6,#cFn__flags] ;Restore express_read's flags
1892 B express_fnCont ;And resume horridly
1901 ; --- First, we push a PROC frame onto the stack ---
1903 MOV R0,#cFrame__proc ;Push on this type
1904 BL ctrl__pushFrame ;Push on the frame
1905 LDR R14,sail_oldAnchor ;Get the old anchor
1906 STR R14,[R0,#cProc__anchor] ;Save it in the frame
1907 LDR R14,sail_tokAnchor ;Args must be in the file
1908 STR R14,sail_oldAnchor ;So read them from there
1909 STMFD R13!,{R0} ;Save some register
1910 BL stracc_ensure ;Get current strac position
1911 LDMFD R13!,{R0} ;Load registers back again
1912 STR R1,[R0,#cProc__stracc] ;Save this away
1913 LDR R1,sail_execStack ;Load the stack anchor
1914 LDR R1,[R1,#0] ;Tycho bops WimpExtension
1915 SUB R6,R0,R1 ;Turn into an offset
1917 ; --- Substitute the arguments ---
1919 MOV R0,#vType_proc ;This is a PROC
1920 BL ctrl__subArgs ;Substitute the args
1922 LDR R0,sail_execStack ;Load the stack anchor
1923 LDR R0,[R0,#0] ;Tycho bops WimpExtension
1924 ADD R0,R0,R6 ;Point to my frame
1925 STMIA R0,{R3,R4} ;Save the return point away
1926 LDR R14,[R0,#cProc__anchor] ;Load anchor we saved above
1927 STR R14,sail_oldAnchor ;Re-instate this again
1929 B interp_exec ;Execute next instruction
1938 MOV R0,#cFrame__proc ;Search for a PROC frame
1939 BL ctrl__unwind ;Look for one of these then
1940 MOVCC R0,#err_notInProc ;Get possible error num
1941 BCC error_report ;And report the error
1943 LDR R0,[R1,#cProc__stracc] ;Load the offset
1944 BL stracc_free ;Okaydokey
1946 LDMIA R1,{R0,R1} ;Load the line and offset
1947 STR R1,sail_line ;Save the line counter
1948 LDR R14,sail_tokAnchor ;Find the anchor of the file
1949 LDR R14,[R14] ;Pointless instruction
1950 ADD R10,R14,R0 ;Get the new offset
1951 SUB R10,R10,#1 ;Backtrac a little
1952 MOV R9,#-1 ;Give bogus current token
1953 BL getToken ;Read this token
1954 B interp_next ;And continue merrily
1969 ; --- Simply search for a newline! ---
1971 00 CMP R9,#10 ;Is this a newline?
1972 CMPNE R9,#&FF ;Or the EOF?
1973 BNE getToken ;No -- get another token
1974 BNE %b00 ;...get another one then
1975 B interp_next ;And carry on as before
1984 ; --- We read lots of lvalues, and create local frames ---
1986 00 MOV R0,#cFrame__local ;We want a local frame
1987 BL ctrl__pushFrame ;Create the frame then
1988 MOV R5,R0 ;Look after the address
1989 MOV R0,#1 ;Read an lvalue
1990 BL express_read ;Go to it then
1991 BL express_pop ;Pop it off
1992 BL ctrl_load ;Load its value out
1993 STMIA R5,{R0-R3} ;Store this in the frame
1995 CMP R9,#',' ;Do we have a comma now?
1996 BLEQ getToken ;Yes -- gobble it up
1997 BEQ %b00 ;...and do another one
1999 B interp_next ;Do the next instruction
2003 ; --- ctrl__subArgs ---
2005 ; On entry: R0 == type of routine to find
2007 ; On exit: R3 == offset of return point
2008 ; R4 == line number of return point
2009 ; R0-R2, R5 corrupted
2011 ; Use: Performs argument substitution. The next token to read
2012 ; should be the name of the routine to execute. On exit,
2013 ; the interpreter will begin execution of the routine.
2017 ; --- A nasty macro ---
2019 ; Swap between the two states
2023 LDR R0,sail_oldAnchor
2028 LDR R0,sail_currAnchor
2040 LDR R0,sail_currAnchor
2045 LDR R0,sail_oldAnchor
2055 ; --- Now get on with it ---
2057 ; We're calling express_read during the first part of this,
2058 ; so we don't have the luxury of a stack...
2060 MOV R5,R14 ;Remember the return address
2062 ; --- First, get the PROC/FN name ---
2064 ADR R2,sail_misc ;Point to a nice buffer
2065 SUBS R14,R9,#'_' ;Is it a valid characer?
2072 MOVCS R0,#err_badCall ;No -- get error then
2073 BCS error_report ;And report it
2074 STRB R9,[R2],#1 ;And store in the buffer
2076 00 BL getToken ;Get the next character
2077 SUBS R14,R9,#'_' ;Is it a valid characer?
2084 STRCCB R9,[R2],#1 ;Yes -- store in the buffer
2085 BCC %b00 ;...and keep on looping
2090 ; --- Now find the PROC/FN ---
2092 ADR R1,sail_misc ;Point to the name
2093 BL tree_find ;Try to find the thing
2094 MOVCC R0,#err_noProc ;Not there -- complain
2096 LDMIB R0,{R3,R4} ;Load out address/line
2097 ADD R3,R3,#1 ;Skip past the proc
2099 ; --- First, see if we have an open banana ---
2101 SUBS R1,R9,#'(' ;Do we have actual arguments?
2102 BLEQ getToken ;Yes -- gobble the bracket
2103 MOVNE R1,#1 ;No -- remember this then
2104 READDEF ;Swap to the def
2105 SUBS R2,R9,#'(' ;Do we have formal args?
2106 BLEQ getToken ;Yes -- gobble the bracket
2107 MOVNE R2,#1 ;No -- remember this then
2108 CMP R1,R2 ;Are both the same?
2109 MOVNE R0,#err_badArgs ;No -- get an error
2110 BNE error_report ;So report it then
2111 CMP R1,#0 ;Any arguments?
2112 BNE %90ctrl__subArgs ;No -- just tidy up then
2114 MOV R2,#0 ;No arguments read yet
2116 ; --- Stage 1: Read actual and formal arguments ---
2118 ; Here we will build 3 records on the val stack for each
2121 ; If argument is RETURN, lvalue of actual arg, else 0
2122 ; rvalue of actual arg (read to avoid aliassing problems)
2123 ; lvalue of formal arg
2125 10ctrl__subArgs CMP R9,#tok_return ;Is this a RETURN token?
2126 BLEQ getToken ;If so, gobble it
2127 READARG ;Swap back to the call
2128 BNE %f00 ;No -- skip to read rvalue
2130 ; --- Read lvalue for actual arg ---
2132 MOV R0,#1 ;Read the lvalue here
2133 BL express_read ;Read that please
2134 STMFD R13!,{R2,R3} ;Save some registers
2135 BL express_pop ;Pop the lvalue
2136 BL ctrl_load ;Load the rvalue out
2137 BL express_push ;Push the lvalue back
2138 MOV R0,R2 ;Get the rvalue now
2139 MOV R1,R3 ;And its type, please
2140 BL express_push ;Push that too
2141 LDMFD R13!,{R2,R3} ;Restore my registers
2142 B %f01 ;Now skip to handling formal
2144 ; --- Read rvalue for actual arg ---
2146 00 MOV R1,#-1 ;Mark a strange lvalue type
2147 BL express_push ;Push that on
2148 MOV R0,#0 ;Read an rvalue
2149 BL express_read ;Do that then
2151 ; --- Now swap and read the formal argument ---
2153 01 ADD R2,R2,#1 ;Bump argument counter
2154 CMP R9,#')' ;Is this a close bracket?
2155 CMPNE R9,#',' ;Or maybe a comma?
2156 MOVNE R0,#err_badCall ;No -- that's an error
2157 BNE error_report ;So complain about it
2158 MOV R1,R9 ;Look after this token
2159 BL getToken ;Gobble the token
2161 READDEF ;Swap back to the DEF
2162 MOV R0,#1 ;Read an lvalue now
2163 BL express_read ;Read the expression
2165 CMP R9,#')' ;Is this a close bracket?
2166 CMPNE R9,#',' ;Or maybe a comma?
2167 MOVNE R0,#err_expBracket ;No -- error (odd BASIC one)
2168 BNE error_report ;So complain about it
2170 CMP R1,R9 ;Do these match?
2171 MOVNE R0,#err_badArgs ;No -- someone can't count
2172 BNE error_report ;So report that
2173 CMP R9,#',' ;Is there more to come?
2174 BL getToken ;Get the next token
2175 BEQ %10ctrl__subArgs ;Yes -- read the rest then
2177 ; --- Stage 2: Bind arguments, and queue value/returns ---
2179 ; Here, we build the LOCAL frames for the arguments, and
2180 ; store the actual arguments into the formal ones. We also
2181 ; remember which ones are value/return so we can sort them
2182 ; out later. Fortunately we've now done all the messing
2183 ; about with express_read that we need to, so we can stack
2184 ; registers and seriously get down to business...
2186 STMFD R13!,{R0-R10} ;Save loads of registers
2187 MOV R10,R2 ;Look after argument count
2188 MOV R9,#0 ;Counter of valret args
2190 ; --- First, build the LOCAL frame for formal arg ---
2192 00 MOV R0,#cFrame__local ;Create a local frame
2193 BL ctrl__pushFrame ;Push that on the stack
2194 MOV R4,R0 ;Look after the address
2195 BL express_pop ;Pop a formal arg lvalue
2196 BL ctrl_load ;Load the current value
2197 STMIA R4,{R0-R3} ;Save all that lot away
2199 ; --- Now read the rvalue and lvalue of actual arg ---
2201 MOV R4,R0 ;Look after this lvalue
2202 MOV R5,R1 ;Copy it away somewhere
2203 BL express_popTwo ;Pop the lvalue and rvalue
2204 CMP R1,#-1 ;Do we have an actual lvalue?
2205 STMNEFD R13!,{R0,R1,R4,R5} ;Yes -- stack that lot away
2206 ADDNE R9,R9,#1 ;And increment the counter
2207 MOV R0,R4 ;Put formal lvalue in R0,R1
2208 ORR R1,R5,#(1<<31) ;Don't remove strs from strc
2209 BL ctrl_store ;And bind the argument
2211 SUBS R10,R10,#1 ;Decrement arg counter
2212 BGT %b00 ;And loop till all done
2214 ; --- Stage 3: Finally deal with value/return args ---
2216 ; We have to create the value/return frames now. This is
2217 ; complicated by the need to prevent LOCAL from over-
2218 ; zealously restoring values. We transform any LOCAL frames
2219 ; which might do this into deadlocal ones, which won't.
2221 CMP R9,#0 ;Do I need to do any of this?
2222 BEQ %85ctrl__subArgs ;No -- go away then
2223 LDR R8,sail_execStkPtr ;Find ctrl stack pointer
2224 LDR R7,sail_execStack ;And find the anchor
2226 ; --- Check for matching LOCAL frame ---
2228 05 LDR R0,[R13,#0] ;Load the lvalue to match
2229 LDR R14,[R7,#0] ;Load the stack anchor
2230 ADD R14,R14,R8 ;And find the stack top
2231 00 LDR R1,[R14,#-4] ;Load the frame type
2232 CMP R1,#cFrame__local ;Is this a local frame?
2233 CMPNE R1,#cFrame__dead ;Or one we nobbled earlier?
2234 BNE %f00 ;No -- not there then
2236 LDR R1,[R14,#-20]! ;Load the lvalue from here
2237 CMP R1,R0 ;Do these match?
2238 BNE %b00 ;No -- keep looking then
2239 MOV R0,#cFrame__dead ;Nobble this frame
2240 STR R0,[R14,#16] ;Change the type to a dummy
2242 ; --- Now create a value/return frame ---
2244 00 MOV R0,#cFrame__return ;Get the frame type
2245 BL ctrl__pushFrame ;Push this frame
2246 LDMFD R13!,{R1-R4} ;Load the lvalues out
2247 STMIA R0,{R1-R4} ;Save that information away
2248 SUBS R9,R9,#1 ;One less of them to do
2249 BGT %b05 ;If any more to do, do them
2251 ; --- We're done here -- return to caller ---
2253 85 LDMFD R13!,{R0-R10} ;Restore registers
2254 90 MOVS PC,R5 ;And return (slurrrp)
2258 ; --- ctrl__unwind ---
2260 ; On entry: R0 == type of frame to find (PROC or FN)
2262 ; On exit: CS and R1 == address of frame found, else
2263 ; CC and R1 corrupted
2266 ; Use: Pops frames off the stack, until it finds a frame which
2267 ; matches the type specified. Looping constructs are ignored,
2268 ; and locals, deadlocals and return locals are all dealt with.
2269 ; It will stop at any other routine frame, and return CC.
2273 STMFD R13!,{R2-R6,R14} ;Stack registers
2274 MOV R4,R0 ;Look after the routine type
2275 MOV R5,#0 ;Number of return-frames now
2276 00 BL ctrl__popFrame ;Pop the frame off the stack
2277 CMP R0,#cFrame__routine ;Is it a routine frame?
2278 BLT %b00 ;Nope -- keep on looking then
2280 ; --- Now pop off routine frames ---
2282 CMP R0,R4 ;Have we found it?
2283 BEQ %90ctrl__unwind ;Yes -- return success
2285 CMP R0,#cFrame__local ;Is this a local frame?
2286 BNE %10ctrl__unwind ;No -- jump ahead
2288 ; --- Deal with local frames ---
2290 LDMIA R1,{R0-R3} ;Load lvalue/rvalue
2291 ORR R1,R1,#(1<<31) ;Don't remove strings
2292 BL ctrl_store ;Put it back to how it was
2293 B %b00 ;And go round for more
2295 ; --- Check for dead frame ---
2297 10 CMP R0,#cFrame__dead ;Is this frame dead?
2298 BEQ %b00 ;Yes -- ignore it then
2300 15 CMP R0,#cFrame__return ;A return frame?
2301 BNE %95ctrl__unwind ;Nope -- return CC then
2303 ; --- We have a return frame ---
2305 MOV R6,R1 ;Look after frame address
2306 ADD R1,R1,#8 ;Point to formal lvalue
2307 LDMIA R1,{R0,R1} ;Load that out
2308 BL ctrl_load ;Get its value
2309 LDMIA R6,{R0,R1} ;Load destination lvalue
2310 STMFD R13!,{R0-R3} ;Store on the R13 stack
2311 ADD R5,R5,#1 ;Increment number so far
2312 B %b00 ;Yes -- ignore it then
2314 ; --- We found what we were looking for ---
2316 ; Resolve all the value return types ---
2318 90 MOV R6,R1 ;Look after frame address
2319 CMP R5,#0 ;And value returns on stack?
2320 00 LDMNEFD R13!,{R0-R3} ;Load lvalue/rvalue
2321 BLNE ctrl_store ;Store the value away
2322 SUBNES R5,R5,#1 ;Decrement the counter
2323 BNE %b00 ;And do this for all
2325 MOV R1,R6 ;Put address in R1
2326 LDMFD R13!,{R2-R6,R14} ;Load registers
2327 ORRS PC,R14,#C_flag ;Return success then
2329 ; --- We didn't find it :-( ---
2331 95 LDMFD R13!,{R2-R6,R14} ;Load registers
2332 BICS PC,R14,#C_flag ;Return failure
2336 ;----- String manipulation --------------------------------------------------
2338 ; --- ctrl__alterStr ---
2340 ; On entry: R2 == rvalue of string to change
2341 ; R3 == index to copy into
2342 ; R4 == number of chars to copy
2343 ; R5 = rvalue of string to copy from
2349 STMFD R13!,{R0-R5,R14} ;Save some registers
2350 MOV R0,R5 ;Remeber rvalue of string 2
2351 LDR R14,sail_stracc ;Get the stracc address
2353 ADD R2,R14,R2,LSR #8 ;Point to the string
2354 ADD R2,R2,R3 ;Point into the string
2355 ADD R5,R14,R5,LSR #8 ;Point to second string
2357 CMP R4,#0 ;Anything to copy?
2358 00 LDRGTB R14,[R5],#1 ;Load a byte
2359 STRGTB R14,[R2],#1 ;Store it again
2360 SUBS R4,R4,#1 ;Reduce the counter
2361 BGT %b00 ;And keep on going
2363 MOV R1,#vType_string ;R0 is a string
2364 BL stracc_free ;We don't need it now
2365 LDMFD R13!,{R0-R5,PC}^ ;Return to caller
2367 ; --- ctrl_leftS ---
2372 ; --- First, read the string variable ---
2374 MOV R0,#1 ;Read an lvalue
2375 BL express_read ;Read it then
2376 BL express_pop ;Get the lvalue
2377 BL ctrl_load ;Load the string into stracc
2378 CMP R3,#vType_string ;Make sure we have a string
2379 BNE ctrl__notAString ;And report the error
2380 AND R6,R2,#&FF ;Get the length too
2381 STMFD R13!,{R0,R1} ;Remember the lvalue
2383 ; --- We need a comma now ---
2385 CMP R9,#',' ;We need a comma now
2386 MOVNE R0,#err_expComma ;If it isn't, moan
2388 BL getToken ;Skip past the comma
2390 ; --- Read the number of characters ---
2392 MOV R1,#0 ;Read an rvalue
2393 BL express_read ;Read it then
2394 BL express_pop ;Pop off the value
2395 CMP R1,#vType_integer ;Is it an integer?
2396 BNE ctrl__notAnInt ;No -- barf then
2397 CMP R0,R6 ;Reading too many?
2398 MOVLE R4,R0 ;Put the number in R4
2399 MOVGT R4,R6 ;Put it in range
2400 MOV R3,#0 ;The index is 0
2402 ; --- Look for ')=' now ---
2404 CMP R9,#')' ;We need a ')' now
2405 MOVNE R0,#err_expBracket ;If it isn't, moan
2407 BL getToken ;Skip past the comma
2408 CMP R9,#'=' ;We need a '=' now
2409 MOVNE R0,#err_expEq ;If it isn't, moan
2411 BL getToken ;Skip past the comma
2413 ; --- Now we need a replacement string ---
2415 MOV R0,#0 ;Read another rvalue
2416 BL express_read ;Read it then
2417 BL express_pop ;Pop off the value
2418 CMP R1,#vType_string ;Is it a string?
2419 BNE ctrl__notAString ;And report the error
2420 MOV R5,R0 ;Put the rvalue in R5
2421 AND R6,R0,#&FF ;Get the length of that one
2422 CMP R4,R6 ;Only copy enough
2423 MOVGT R4,R6 ;To save embarrassment
2425 BL ctrl__alterStr ;Do the string transform
2426 MOV R3,#vType_string ;It is a string
2427 LDMFD R13!,{R0,R1} ;Get the lvalue back
2428 BL ctrl_store ;Store back the new string
2430 B interp_next ;Do the next instruction
2439 ; --- First, read the string variable ---
2441 MOV R0,#1 ;Read an lvalue
2442 BL express_read ;Read it then
2443 BL express_pop ;Get the lvalue
2444 BL ctrl_load ;Load the string into stracc
2445 CMP R3,#vType_string ;Make sure we have a string
2446 BNE ctrl__notAString ;And report the error
2447 AND R6,R2,#&FF ;Get the length too
2448 STMFD R13!,{R0,R1} ;Remember the lvalue
2450 ; --- We need a comma now ---
2452 CMP R9,#',' ;We need a comma now
2453 MOVNE R0,#err_expComma ;If it isn't, moan
2455 BL getToken ;Skip past the comma
2457 ; --- Read the index ---
2459 MOV R1,#0 ;Read an rvalue
2460 BL express_read ;Read it then
2461 BL express_pop ;Pop off the value
2462 CMP R1,#vType_integer ;Is it an integer?
2463 BNE ctrl__notAnInt ;No -- barf then
2464 SUBS R3,R0,#1 ;Put it in R4
2465 MOVLE R3,#0 ;Put it in range
2466 CMP R3,R6 ;Is the index too high?
2467 MOVGT R3,R6 ;Put it in range
2468 SUB R4,R6,R3 ;Get max to read
2470 ; --- We may have a comma now ---
2472 CMP R9,#',' ;We need a comma now
2473 BNE %10ctrl_midS ;And jump ahead
2475 ; --- Read the number of characters ---
2477 BL getToken ;Skip past the comma
2478 MOV R1,#0 ;Read an rvalue
2479 BL express_read ;Read it then
2480 BL express_pop ;Pop off the value
2481 CMP R1,#vType_integer ;Is it an integer?
2482 BNE ctrl__notAnInt ;No -- barf then
2483 CMP R0,R4 ;Is the index too high?
2484 MOVLE R4,R0 ;Put the number in R4
2485 CMP R4,#0 ;Not below 0 either
2488 ; --- Look for ')=' now ---
2490 10ctrl_midS CMP R9,#')' ;We need a ')' now
2491 MOVNE R0,#err_expBracket ;If it isn't, moan
2493 BL getToken ;Skip past the comma
2494 CMP R9,#'=' ;We need a '=' now
2495 MOVNE R0,#err_expEq ;If it isn't, moan
2497 BL getToken ;Skip past the comma
2499 ; --- Now we need a replacement string ---
2501 MOV R0,#0 ;Read another rvalue
2502 BL express_read ;Read it then
2503 BL express_pop ;Pop off the value
2504 CMP R1,#vType_string ;Is it a string?
2505 BNE ctrl__notAString ;And report the error
2506 MOV R5,R0 ;Put the rvalue in R5
2507 AND R6,R0,#&FF ;Get the length of that one
2508 CMP R4,R6 ;Only copy enough
2509 MOVGT R4,R6 ;To save embarrassment
2511 BL ctrl__alterStr ;Do the string transform
2512 MOV R3,#vType_string ;It is a string
2513 LDMFD R13!,{R0,R1} ;Get the lvalue back
2514 BL ctrl_store ;Store back the new string
2516 B interp_next ;Do the next instruction
2520 ; --- ctrl_rightS ---
2525 ; --- First, read the string variable ---
2527 MOV R0,#1 ;Read an lvalue
2528 BL express_read ;Read it then
2529 BL express_pop ;Get the lvalue
2530 BL ctrl_load ;Load the string into stracc
2531 CMP R3,#vType_string ;Make sure we have a string
2532 BNE ctrl__notAString ;And report the error
2533 AND R6,R2,#&FF ;Get the length too
2534 STMFD R13!,{R0,R1} ;Remember the lvalue
2536 ; --- We need a comma now ---
2538 CMP R9,#',' ;We need a comma now
2539 MOVNE R0,#err_expComma ;If it isn't, moan
2541 BL getToken ;Skip past the comma
2543 ; --- Read the number of characters ---
2545 MOV R1,#0 ;Read an rvalue
2546 BL express_read ;Read it then
2547 BL express_pop ;Pop off the value
2548 CMP R1,#vType_integer ;Is it an integer?
2549 BNE ctrl__notAnInt ;No -- barf then
2550 CMP R0,R6 ;Reading too many?
2551 MOVLE R4,R0 ;Put the number in R4
2552 MOVGT R4,R6 ;Put it in range
2553 SUBS R3,R6,R4 ;Work out the index
2555 ; --- Look for ')=' now ---
2557 CMP R9,#')' ;We need a ')' now
2558 MOVNE R0,#err_expBracket ;If it isn't, moan
2560 BL getToken ;Skip past the comma
2561 CMP R9,#'=' ;We need a '=' now
2562 MOVNE R0,#err_expEq ;If it isn't, moan
2564 BL getToken ;Skip past the comma
2566 ; --- Now we need a replacement string ---
2568 MOV R0,#0 ;Read another rvalue
2569 BL express_read ;Read it then
2570 BL express_pop ;Pop off the value
2571 CMP R1,#vType_string ;Is it a string?
2572 BNE ctrl__notAString ;And report the error
2573 MOV R5,R0 ;Put the rvalue in R5
2574 AND R0,R0,#&FF ;Get the length of that one
2575 CMP R4,R0 ;Only copy enough
2576 MOVGT R4,R0 ;To save embarrassment
2579 BL ctrl__alterStr ;Do the string transform
2580 MOV R3,#vType_string ;It is a string
2581 LDMFD R13!,{R0,R1} ;Get the lvalue back
2582 BL ctrl_store ;Store back the new string
2584 B interp_next ;Do the next instruction
2588 ;----- Arrays ---------------------------------------------------------------
2595 ; --- Stash current position ---
2597 LDR R6,sail_line ;Find the current line
2598 STMFD R13!,{R6-R10} ;Save current position info
2600 ; --- Now try reading an identifier ---
2602 ADR R1,sail_misc ;Point to a buffer
2603 MOV R2,#vType_dimInt ;Currently it's an int array
2605 SUBS R14,R9,#'_' ;Allow strange ident chars
2606 SUBNE R14,R9,#'A' ;Check for uppercase letters
2607 CMP R14,#26 ;In range?
2608 SUBCS R14,R9,#'a' ;Check for lowercase letters
2609 CMPCS R14,#26 ;In range?
2610 MOVCS R0,#err_badDim ;No -- get an error
2611 BCS error_report ;And kill the program
2613 00 STRB R9,[R1],#1 ;Store the character away
2614 BL getToken ;Get another token
2615 SUBS R14,R9,#'_' ;Allow strange ident chars
2616 SUBNE R14,R9,#'A' ;Check for uppercase letters
2617 CMP R14,#26 ;In range?
2618 SUBCS R14,R9,#'a' ;Check for lowercase letters
2619 CMPCS R14,#26 ;In range?
2620 SUBCS R14,R9,#'0' ;Check for digits too now
2621 CMPCS R14,#10 ;In range?
2622 BCC %b00 ;We're OK here -- loop
2624 ; --- Found something which stopped us ---
2626 CMP R9,#'$' ;Is it a dollar sign?
2627 MOVEQ R2,#vType_dimStr ;It's a string array now
2628 CMPNE R9,#'%' ;Or a percentage?
2629 STREQB R9,[R1],#1 ;Yes -- store it then
2630 CMPNE R9,#' ' ;Just check for a space
2631 BLEQ getToken ;Valid terminator -- get tok
2633 ; --- Now see if this is an array ---
2635 CMP R9,#'(' ;Defining an array here?
2636 BNE %50ctrl_dim ;No -- allocate a block then
2637 ADD R13,R13,#20 ;Lose positioning info
2638 MOV R14,#0 ;Terminate the identifier
2639 STRB R14,[R1],#1 ;Store zero on the end
2640 BL getToken ;Get the next token
2642 ; --- Ensure that the name isn't already used ---
2644 MOV R0,R2 ;Get the array type
2645 ADR R1,sail_misc ;Point to the name
2646 BL tree_find ;Is it there already?
2647 MOVCS R0,#err_reDim ;Yes -- moan then
2648 BCS error_report ;And kill things off
2650 ; --- Stuff the string on stracc ---
2652 BL stracc_ensure ;Make enough space for it
2653 ADR R3,sail_misc ;Point to the misc buffer
2654 00 LDRB R14,[R3],#1 ;Load the byte out
2655 STRB R14,[R0],#1 ;Store in the buffer
2656 ADD R1,R1,#1 ;And increment the length
2657 CMP R14,#0 ;Finished yet?
2658 BNE %b00 ;No -- then loop round
2659 MOV R0,R1 ;Get the rvalue I made
2660 BL stracc_added ;I've added this string
2661 MOV R5,R1 ;Look after this value
2663 ; --- Now read the subscripts ---
2665 ; We use the stack to keep track of them all. This is
2666 ; fairly crufty, but I don't care.
2668 MOV R3,#0 ;No subscripts so far
2669 MOV R4,#1 ;Number of items we need
2670 00 MOV R0,#0 ;Read an rvalue
2671 BL express_read ;Evaluate an expression
2672 BL express_pop ;Pop the rvalue
2673 CMP R1,#vType_integer ;Ensure it's an integer
2674 MOVNE R0,#err_numNeeded ;No -- moan then
2675 BNE error_report ;And stop the program
2676 ADD R0,R0,#1 ;BASIC subscripts are odd
2677 STMFD R13!,{R0} ;Stash the subscript
2678 ADD R3,R3,#1 ;Increment the counter
2679 MUL R4,R0,R4 ;Update the size we nee
2680 CMP R9,#',' ;Is this a comma?
2681 BLEQ getToken ;Yes -- get a token
2682 BEQ %b00 ;And read another subscript
2683 CMP R9,#')' ;Well, this must be next
2684 MOVNE R0,#err_dimKet ;No -- well, get an error
2685 BNE error_report ;And die horridly
2686 BL getToken ;Get another token
2688 ; --- We now have the subscripts on the stack ---
2690 LDR R14,sail_stracc ;Find the stracc anchor
2691 LDR R14,[R14] ;Bop WimpExtension for fun
2692 ADD R1,R14,R5,LSR #8 ;Find the name base
2693 MOV R0,R2 ;Get the variable type
2694 MOV R2,R13 ;Point to subscripts
2695 BL var_create ;Create the array
2696 MOV R0,R5 ;Get the rvalue again
2697 BL stracc_free ;And release the memory
2698 ADD R13,R13,R3,LSL #2 ;Restore the stack pointer
2699 B %80ctrl_dim ;And possibly go round again
2701 ; --- Allocate a block of memory ---
2703 50ctrl_dim LDMFD R13!,{R6-R10} ;Restore positioning info
2704 STR R6,sail_line ;Restore the line number
2705 MOV R0,#1 ;Read an lvalue
2706 BL express_read ;Read that then
2707 MOV R0,#0 ;Read an rvalue
2708 BL express_read ;And read that too
2709 BL express_pop ;Get the block size
2710 CMP R1,#vType_integer ;Ensure it's an integer
2711 MOVNE R0,#err_numNeeded ;No -- get the error then
2712 BNE error_report ;And moan at the user
2713 ADD R3,R0,#8 ;Add a link word, 1 byte and
2714 BIC R3,R3,#3 ;...word align too
2715 MOV R0,#6 ;Claim some memory
2716 SWI XOS_Module ;From the RMA (bletch)
2717 MOVVS R0,#err_noMem ;If it failed assume no mem
2718 BVS error_report ;So deal appropriately
2719 LDR R14,sail_rmaList ;Load RMA list head
2720 STR R2,sail_rmaList ;Store this block in there
2721 STR R14,[R2],#4 ;Stuff the old link away
2722 BL express_pop ;Pop the lvalue
2723 MOV R3,#vType_integer ;Pointer is an integer
2724 BL ctrl_store ;Store it away
2726 ; --- Do more DIMs if wee need to ---
2728 80ctrl_dim CMP R9,#',' ;Is there a comma now?
2729 BLEQ getToken ;Yes -- get the next token
2730 BEQ ctrl_dim ;Yes -- do another dim then
2732 B interp_next ;Do another instruction
2736 ;----- Other useful routines ------------------------------------------------
2738 ; --- ctrl_copyString ---
2740 ; On entry: R0 == buffer to copy string to
2741 ; R1 == point to the string
2742 ; R2 == length of string to copy
2746 ; Use: Copies the string into the buffer.
2748 EXPORT ctrl_copyString
2749 ctrl_copyString ROUT
2751 STMFD R13!,{R0-R2,R14} ;Stack registers
2752 CMP R2,#0 ;Is this a short string?
2753 00 LDRGTB R14,[R1],#1 ;Load a character
2754 STRGTB R14,[R0],#1 ;And then store it
2755 SUBS R2,R2,#1 ;Reduce the count
2756 BGT %b00 ;And keep on goin'
2757 MOV R14,#0 ;Get a terminator
2758 STRB R14,[R0],#1 ;Store the byte and return
2759 LDMFD R13!,{R0-R2,PC}^ ;Return to caller
2763 ; --- ctrl__notAnInt ---
2769 ; Use: Moans because something isn't an integer.
2773 MOV R0,#err_numNeeded
2778 ; --- ctrl__notAString ---
2784 ; Use: Moans because something isn't a string.
2786 ctrl__notAString ROUT
2788 MOV R0,#err_strNeeded
2793 ; --- ctrl__findFrame ---
2795 ; On entry: R0 == frame type
2797 ; On exit: R0 == frame type we stopped at
2798 ; R1 == pointer to base of frame
2799 ; CS if frame type matched, else CC
2801 ; Use: Finds a frame with the given type. It pops frames from the
2802 ; exec stack until it finds either a frame which matches the
2803 ; type in R0 or a routine frame. The frame which stopped the
2804 ; loop is *not* popped.
2806 ctrl__findFrame ROUT
2808 ORR R14,R14,#C_flag ;Assume a match -- be happy
2809 STMFD R13!,{R2,R14} ;Save some registers
2810 MOV R2,R0 ;Look after the frame type
2811 10 BL ctrl__peekFrame ;Look at the top frame
2812 CMP R0,R2 ;Is this a match?
2813 LDMEQFD R13!,{R2,PC}^ ;Yes -- unstack and return
2814 CMP R0,#cFrame__routine ;Is this a routine frame?
2815 BLCC ctrl__popFrame ;No -- remove it then
2816 BCC %10ctrl__findFrame ;And keep on going
2817 LDMFD R13!,{R2,R14} ;Unstack registers
2818 BICS PC,R14,#C_flag ;And return with C clear
2822 ; --- ctrl_store ---
2824 ; On entry: R0,R1 == lvalue to store in
2825 ; R2,R3 == rvalue to write
2827 ; If bit 31 of R1 is set, then for strings only, the old
2828 ; string is NOT removed from the stracc. This is
2829 ; so that variables can be restored after a procedure.
2833 ; Use: Stores an rvalue into an lvalue.
2838 ; --- First, see what we're storing in ---
2840 STMFD R13!,{R14} ;Save a register
2841 BIC R14,R1,#(1<<31) ;Clear the weird bit
2842 SUB R14,R14,#vType_lvInt ;Get the lvalue index thing
2843 CMP R14,#vType_lvStrArr-vType_lvInt+1
2844 ADDCC PC,PC,R14,LSL #2 ;It's OK, dispatch then
2845 B %00ctrl_store ;Righty ho, on we go
2847 B ctrl__strInt ;Store in an integer var
2848 B ctrl__strStr ;Store in a string var
2849 B ctrl__strWord ;Store in a memory word
2850 B ctrl__strByte ;Store in a memory byte
2851 B ctrl__strBytes ;Store in a memory string
2852 B ctrl__strIntArr ;Store in a whole int array
2853 B ctrl__strStrArr ;Store in a whole str array
2855 00ctrl_store MOV R0,#err_erk ;This should never happen...
2856 B error_report ;Since we always get lvalues
2858 ; --- Store in an integer variable ---
2860 ctrl__strInt CMP R3,#vType_integer ;Make sure we're storing int
2861 LDREQ R14,sail_varTree ;Find the tree base
2862 LDREQ R14,[R14] ;Why is WimpExt so odd?
2863 STREQ R2,[R14,R0] ;Store the value in node
2864 LDMEQFD R13!,{PC}^ ;And return to caller
2867 ; --- Store in a memory word somewhere ---
2869 ctrl__strWord CMP R3,#vType_integer ;Make sure we're storing int
2870 STREQ R2,[R0,#0] ;Save the word away
2871 LDMEQFD R13!,{PC}^ ;And return to caller
2874 ; --- Store in a byte somewhere ---
2876 ctrl__strByte CMP R3,#vType_integer ;Make sure we're storing int
2877 STREQB R2,[R0,#0] ;Save the byte away
2878 LDMEQFD R13!,{PC}^ ;And return to caller
2881 ; --- Store in a string variable ---
2883 ctrl__strStr CMP R3,#vType_string ;Make sure we've got a string
2884 BNE ctrl__notAString ;No -- complain then
2886 ; --- Now do some messing about ---
2888 STMFD R13!,{R0-R5} ;Store some registers
2889 MOV R5,R1 ;Look after our flag bit
2891 LDR R4,sail_varTree ;Find the tree base
2892 LDR R4,[R4] ;Who designed this heap?
2893 ADD R4,R4,R0 ;Work out the node address
2894 LDR R0,[R4,#0] ;Load the old string offset
2895 BL strBucket_free ;Don't want it any more
2897 AND R0,R2,#&FF ;Get the string's length
2898 BL strBucket_alloc ;Get a new string entry
2899 STR R1,[R4,#0] ;Tuck that away nicely
2901 LDR R4,sail_stracc ;Find string accumulator
2902 LDR R4,[R4] ;It must be one of those days
2903 ADD R4,R4,R2,LSR #8 ;Work out string address
2904 ANDS R3,R2,#&FF ;Get the length
2905 00 LDRNEB R14,[R4],#1 ;Load a string byte
2906 STRNEB R14,[R0],#1 ;Save it in the bucket
2907 SUBNES R3,R3,#1 ;Decrement the length count
2908 BNE %b00 ;And loop back again
2910 TST R5,#(1<<31) ;Do we remove from bucket?
2911 MOV R0,R2 ;Get the offset
2912 BLEQ stracc_free ;Free it nicely
2914 LDMFD R13!,{R0-R5,PC}^ ;And return to caller
2918 ; --- Store a string in memory ---
2920 ctrl__strBytes CMP R3,#vType_string ;Make sure we've got a string
2921 BNE ctrl__notAString ;No -- complain then
2923 STMFD R13!,{R0-R4} ;Store some registers
2924 LDR R4,sail_stracc ;Find string accumulator
2925 LDR R4,[R4] ;It must be one of those days
2926 ADD R4,R4,R2,LSR #8 ;Work out string address
2927 ANDS R3,R2,#&FF ;Get the length
2928 00 LDRNEB R14,[R4],#1 ;Load a string byte
2929 STRNEB R14,[R0],#1 ;Save it in the bucket
2930 SUBNES R3,R3,#1 ;Decrement the length count
2931 BNE %b00 ;And loop back again
2932 MOV R14,#13 ;Get the terminator
2933 STRB R14,[R0],#1 ;And store that too
2935 TST R1,#(1<<31) ;Do we remove from bucket?
2936 MOV R0,R2 ;Put offset in R1
2937 BLEQ stracc_free ;Free it nicely
2938 LDMFD R13!,{R0-R4,PC}^ ;Return to caller
2945 MOV R0,#err_arrayBad ;Point to the error message
2946 B error_report ;And report the message
2950 ; On entry: R0,R1 == lvalue to read
2952 ; On exit: R2,R3 == rvalue read from lvalue
2954 ; Use: Loads the current value of the given lvalue.
2959 ; --- First, see what we're storing in ---
2961 SUB R2,R1,#vType_lvInt ;Get the lvalue index thing
2962 CMP R2,#vType_lvStrArr-vType_lvInt+1
2963 ADDCC PC,PC,R2,LSL #2 ;It's OK, dispatch then
2964 B %00ctrl_load ;Righty ho, on we go
2966 B ctrl__ldInt ;Store in an integer var
2967 B ctrl__ldStr ;Store in a string var
2968 B ctrl__ldWord ;Store in a memory word
2969 B ctrl__ldByte ;Store in a memory byte
2970 B ctrl__ldBytes ;Store in a memory string
2971 B ctrl__ldIntArr ;Store in a whole int array
2972 B ctrl__ldStrArr ;Store in a whole str array
2974 00ctrl_load MOV R0,#err_erk ;This should never happen...
2975 B error_report ;Since we always get lvalues
2977 ; --- Load an integer variable ---
2979 ctrl__ldInt MOV R3,#vType_integer ;We're loading an integer
2980 LDR R2,sail_varTree ;Find the tree base
2981 LDR R2,[R2] ;Why is WimpExt so odd?
2982 LDR R2,[R2,R0] ;Load the value out
2983 MOVS PC,R14 ;Return to caller
2985 ; --- Load from a memory word somewhere ---
2987 ctrl__ldWord MOV R3,#vType_integer ;We're loading an integer
2988 LDR R2,[R0,#0] ;Load the word
2989 MOVS PC,R14 ;And return to caller
2991 ; --- Load from a byte somewhere ---
2993 ctrl__ldByte MOV R3,#vType_integer ;We're loading an integer
2994 LDRB R2,[R0,#0] ;Load the byte
2995 MOVS PC,R14 ;And return to caller
2997 ; --- Load a string into stracc ---
2999 ctrl__ldStr STMFD R13!,{R0,R1,R4,R14} ;Save some registers
3001 LDR R14,sail_varTree ;Find the variable tree
3002 LDR R14,[R14] ;Irate? Me?
3003 ADD R3,R14,R0 ;Find the actual node
3004 BL stracc_ensure ;Make sure there's enough
3006 LDR R3,[R3,#0] ;Find the bucket entry
3007 CMP R3,#0 ;Is there a string here
3008 MOVEQ R2,R1 ;Yes -- return 0 length
3009 BEQ %f10 ;...and branch ahead
3010 LDR R14,sail_bucket ;Find the bucket anchor
3011 LDR R14,[R14] ;I hate this! I hate it!
3012 ADD R3,R14,R3 ;Find the actual string
3014 LDRB R4,[R3,#-1] ;Load the string length
3015 ORR R2,R4,R1 ;Build the rvalue ready
3017 00 LDRB R14,[R3],#1 ;Load a byte from string
3018 STRB R14,[R0],#1 ;And store byte in stracc
3019 SUBS R4,R4,#1 ;Decrement the length
3022 10 MOV R3,#vType_string ;This is a string
3023 MOV R0,R2 ;Damn -- we need it in R0,R1
3024 BL stracc_added ;Tell stracc about string
3025 LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
3027 ; --- Load a string from memory ---
3029 ctrl__ldBytes STMFD R13!,{R0,R1,R4,R14} ;Save some registers
3031 MOV R3,R0 ;Remember string pointer
3032 BL stracc_ensure ;Make sure there's enough
3034 MOV R4,#0 ;Make the length 0
3035 00 LDRB R14,[R3],#1 ;Load a byte from string
3036 CMP R14,#13 ;Is it the terminator
3037 BEQ %f10 ;Yes -- jump ahead
3038 STRB R14,[R0],#1 ;And store byte in stracc
3039 ADD R4,R4,#1 ;Decrement the length
3040 CMP R4,#255 ;Are we at the limit
3041 BLT %b00 ;No -- go round for more
3043 10 MOV R3,#vType_string ;This is a string
3044 ORR R2,R1,R4 ;Get the rvalue
3045 MOV R0,R2 ;Damn -- we need it in R0,R1
3046 BL stracc_added ;Tell stracc about string
3047 LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
3053 MOV R0,#err_arrayBad ;Get the error number
3054 B error_report ;And report the error
3056 ; --- ctrl_compare ---
3058 ; On entry: R0,R1 == thing to compare
3059 ; R2,R3 == thing to compare the other thing with
3061 ; On exit: The flags indicate the result of the comparison
3063 ; Use: Compares two things. Note that R3 contains the dominant
3064 ; type. If it is comparing strings, the string in R0,R1
3065 ; will be removed from stracc.
3070 CMP R3,#vType_integer ;Is it an integer?
3071 BNE %10ctrl_compare ;No -- jump ahead
3073 ; --- We are comparing integers ---
3075 CMP R1,#vType_integer ;Make sure we have an int
3076 BNE ctrl__notAnInt ;No -- barf then
3077 CMP R0,R2 ;Do the comparison
3078 MOV PC,R14 ;And return to caller
3080 ; --- Try to compare strings ---
3082 10ctrl_compare CMP R3,#vType_string ;Is it a string?
3083 MOVNE R0,#err_arrayBad ;No -- get the error number
3084 BNE error_report ;...and report the error
3085 CMP R1,#vType_string ;Make sure other is string
3086 MOVNE R0,#err_strNeeded ;Nope -- complain
3089 STMFD R13!,{R0-R5,R14} ;Stack some registers
3090 AND R1,R0,#&FF ;Get length of first string
3091 AND R3,R2,#&FF ;And of the second one
3092 CMP R3,R1 ;Find the lowest
3093 EORLT R1,R1,R3 ;And put lowest in R1
3096 MOVS R5,R1 ;How long is it?
3097 BEQ %50ctrl_compare ;0 length -- jump ahead
3099 LDR R4,sail_stracc ;Find string accumulator
3100 LDR R4,[R4] ;It must be one of those days
3101 ADD R2,R4,R2,LSR #8 ;of both strings
3102 ADD R0,R4,R0,LSR #8 ;Work out string address
3103 00 LDRB R14,[R0],#1 ;Load a string byte
3104 LDRB R4,[R2],#1 ;from both strings
3105 CMP R14,R4 ;Are they the same?
3106 BNE %19ctrl_compare ;Nope -- return failure
3107 SUBS R5,R5,#1 ;Decrement the length count
3108 BNE %b00 ;And loop back again
3109 CMP R1,R3 ;Compare lengths then
3111 19ctrl_compare LDR R0,[R13,#0] ;Load an rvalue
3112 BL stracc_free ;Free it then
3113 LDMFD R13!,{R0-R5,PC} ;Load back registers
3115 50ctrl_compare CMP R1,R3 ;Make another comaprison
3116 B %19ctrl_compare ;And return
3120 ;----- Stack frames ---------------------------------------------------------
3122 ; --- Frame types ---
3141 ; --- Frame formats ---
3209 ;----- That's all, folks ----------------------------------------------------
~mdw / ssr / blob