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 LDR R1,[R1] ;SODDING WIMPEXTENSION!!!
336 SUB R1,R10,R1 ;Work out current offset
337 LDR R0,sail_line ;Get the current line number
338 STMIA R14,{R0,R1} ;Save these in the frame
340 B interp_next ;Move on to next instruction
349 ; --- First check for identifier ---
351 ; If there is one, we need to search for a specific FOR
352 ; frame. Otherwise any old one will do.
354 SUBS R14,R9,#'_' ;Is this an identifier?
355 SUBNE R14,R9,#'A' ;No -- check for uppercase
357 SUBCS R14,R9,#'a' ;No -- check for lowercase
360 ; --- Read the lvalue given ---
362 MOVCC R0,#1 ;Read an lvalue
363 BLCC express_read ;And put it on the stack
364 BLCC express_pop ;Get it in registers
365 MOVCS R1,#-1 ;Otherwise get bogus value
366 MOV R2,R0 ;Look after the lvalue
367 MOV R3,R1 ;And the type
368 10 MOV R0,#cFrame__for ;Look for a FOR frame
369 BL ctrl__findFrame ;Try to find the frame
370 MOVCC R0,#err_noFor ;Complain if we hit routine
372 ADD R14,R1,#cFor__lval ;Find the lvalue
373 LDMIA R1,{R4,R5} ;Load them out nicely
374 CMP R2,R4 ;Now check for a match
375 CMPEQ R3,R5 ;Check the type too
376 CMPNE R3,#-1 ;Or maybe we don't care
377 BLNE ctrl__popFrame ;No match -- discard frame
378 BNE %10ctrl_next ;And loop back round
380 ; --- Now step the variable ---
382 MOV R6,R1 ;Look after frame base
383 MOV R0,R4 ;Get the original lvalue back
384 MOV R1,R5 ;And its type
385 BL ctrl_load ;Load the current value
386 LDR R4,[R6,#cFor__step] ;Load the step size
387 ADD R2,R2,R4 ;Bump the loop counter
388 BL ctrl_store ;Save the modified counter
389 LDR R14,[R6,#cFor__end] ;Find the end limit
390 CMP R4,#0 ;Are we going backwards?
391 SUBGT R14,R2,R14 ;Yes -- subtract this way
392 SUBLT R14,R14,R2 ;Otherwise the other way
393 CMP R14,#0 ;Now which way do we go?
394 BGT %50ctrl_next ;Finished the loop -- stop
396 ; --- Now resume from the FOR loop ---
398 ADD R14,R6,#cFor__resume ;Find the resume point
399 LDMIA R14,{R0,R1} ;Load the line and offset
400 STR R0,sail_line ;Save the line counter
401 LDR R14,sail_tokAnchor ;Find the anchor of the file
402 LDR R14,[R14] ;Pointless instruction
403 ADD R10,R14,R1 ;Get the new offset
404 SUB R10,R10,#1 ;Backtrack to read prev token
405 MOV R9,#0 ;Give bogus current token
406 BL getToken ;Read this token
407 B interp_next ;And continue merrily
409 ; --- Now see if there's more loops to close ---
411 50ctrl_next BL ctrl__popFrame ;Remove defunct FOR frame
412 CMP R9,#',' ;Do we have more loops?
413 BLEQ getToken ;Yes -- skip the comma
414 BEQ ctrl_next ;And close them too
416 B interp_next ;Finished this instruction
420 ; --- ctrl_repeat ---
425 MOV R0,#cFrame__repeat ;Create a REPEAT frame
426 BL ctrl__pushFrame ;Stick that on the stack
427 LDR R2,sail_tokAnchor ;Find anchor of script buff
428 LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
429 SUB R2,R10,R2 ;Work out current offset
430 LDR R1,sail_line ;Get the current line number
431 STMIA R0,{R1,R2} ;Save these in the frame
432 B interp_exec ;Get the next instruction
441 MOV R0,#0 ;Read an rvalue
442 BL express_read ;Read an expression
443 BL express_pop ;Read it then
444 CMP R1,#vType_integer ;Is it an integer?
445 BNE ctrl__notAnInt ;No -- complain then
446 MOV R2,R0 ;Look after the result
448 ; --- Find the REPEAT frame ---
450 MOV R0,#cFrame__repeat ;Look for a REPEAT frame
451 BL ctrl__findFrame ;Try to find the frame
452 MOVCC R0,#err_noRepeat ;Complain if we hit routine
455 CMP R2,#0 ;Should we REPEAT?
456 BLNE ctrl__popFrame ;No -- pop the repeat frame
457 BNE interp_next ;No -- just continue then
459 ; --- Go back to the REPEAT ---
461 LDMIA R1,{R0,R1} ;Load the line and offset
462 STR R0,sail_line ;Save the line counter
463 LDR R14,sail_tokAnchor ;Find the anchor of the file
464 LDR R14,[R14] ;Pointless instruction
465 ADD R10,R14,R1 ;Get the new offset
466 SUB R10,R10,#1 ;Backtrack to read prev token
467 MOV R9,#-1 ;Give bogus current token
468 BL getToken ;Read this token
469 B interp_exec ;And continue merrily
478 ; --- Push a while frame on the stack ---
480 MOV R0,#cFrame__while ;Create a REPEAT frame
481 BL ctrl__pushFrame ;Stick that on the stack
482 LDR R2,sail_tokAnchor ;Find anchor of script buff
483 LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
484 SUB R2,R10,R2 ;Work out current offset
485 LDR R1,sail_line ;Get the current line number
486 STMIA R0,{R1,R2} ;Save these in the frame
488 ; --- Read the expression ---
490 MOV R0,#0 ;Read an expression
491 BL express_read ;Read it ithen
492 BL express_pop ;Pop the resut
493 CMP R1,#vType_integer ;Is it an integer?
494 BNE ctrl__notAnInt ;No -- that's bad then
495 CMP R0,#0 ;Is is FALSE?
496 BNE interp_exec ;No -- continue then
498 ; --- Scan for the first ENDWHILE then ---
500 MOV R2,#0 ;Keep a nesting count
501 LDR R4,sail_line ;Get current line number
502 10ctrl_while BL getToken ;Get another token
503 CMP R9,#&FF ;Reached the end yet?
504 BEQ %90ctrl_while ;If so, moan about ENDWHILE
505 CMP R9,#tok_while ;Is it a WHILE token?
506 ADDEQ R2,R2,#1 ;Yes -- bump nesting count
508 CMP R9,#tok_endwhile ;Yes -- check for ENDWHILE
509 SUBEQ R2,R2,#1 ;Yes -- decrement nesting
510 CMP R2,#0 ;Have we dropped out?
511 BGE %10ctrl_while ;No -- loop
513 ; --- We found the ENDWHILE ---
515 BL getToken ;Get the next token
516 BL ctrl__popFrame ;Get rid of my WHILE frame
517 B interp_next ;And execute from here
519 ; --- We fell off the end -- oops ---
521 90ctrl_while STR R4,sail_line ;Save bogus line back
522 MOV R0,#err_expEndwhile ;Hmm... should have had an...
523 B error_report ;ENDWHILE somewhere
527 ; --- ctrl_endwhile ---
532 ; --- Find the ENDWHILE frame ---
534 MOV R0,#cFrame__while ;Look for a REPEAT frame
535 BL ctrl__findFrame ;Try to find the frame
536 MOVCC R0,#err_noWhile ;Complain if we hit routine
539 ; --- Remember where we are ---
541 LDR R2,sail_line ;Get the line number
542 MOV R3,R10 ;And our position
544 ; --- Go back to the WHILE ---
546 LDMIA R1,{R0,R1} ;Load the line and offset
547 STR R0,sail_line ;Save the line counter
548 LDR R14,sail_tokAnchor ;Find the anchor of the file
549 LDR R14,[R14] ;Pointless instruction
550 ADD R10,R14,R1 ;Get the new offset
551 SUB R10,R10,#1 ;Backtrack to read prev token
552 MOV R9,#-1 ;Give bogus current token
553 BL getToken ;Read this token
555 ; --- Now read the expression ---
557 MOV R0,#0 ;Read an rvalue
558 BL express_read ;Read it then
559 BL express_pop ;Get the value
560 CMP R0,#0 ;Should we go from here?
561 BNE interp_exec ;Yes -- execute then
563 ; --- Execute from the ENDWHILE ---
565 BL ctrl__popFrame ;Pop the WHILE frame
566 SUB R10,R3,#1 ;Set R10 up
567 STR R2,sail_line ;Store the line number
568 MOV R9,#-1 ;Make getToken happy
569 BL getToken ;Get a token then
570 B interp_next ;And execute happily
574 ; --- ctrl__readLabel ---
578 ; On exit: CS if there was a label and,
579 ; R0 == pointer to the label node
583 ; Use: Reads a label fromthe current position, and looks it
584 ; up inthe symbol table.
588 STMFD R13!,{R14} ;Stack the link
590 ADR R2,sail_misc ;Point to a nice buffer
591 SUBS R14,R9,#'_' ;Is it a valid characer?
598 BCS %90ctrl__readLabel ;No -- bark then
599 STRB R9,[R2],#1 ;And store in the buffer
601 10 BL getToken ;Get the next character
602 SUBS R14,R9,#'_' ;Is it a valid characer?
609 STRCCB R9,[R2],#1 ;Yes -- store in the buffer
610 BCC %10ctrl__readLabel ;...and keep on looping
615 ; --- Now find the node ---
617 MOV R0,#vType_label ;This is a label
618 ADR R1,sail_misc ;Point at the name
619 BL tree_find ;Try to find it
620 MOVCC R0,#err_noLabel ;Not there -- complain
623 LDMFD R13!,{R14} ;Load the link back
624 ORRS PC,R14,#C_flag ;Return 'label here'
626 ; --- The label was bad --
628 90 LDMFD R13!,{R14} ;Load the link back
629 BICS PC,R14,#C_flag ;Return 'no label'
638 ; --- Read the label ---
640 BL ctrl__readLabel ;Read a label
641 BCC %90ctrl_gosub ;No there -- barf
642 MOV R3,R0 ;Look after node address
644 ; --- Push a GOSUB frame ---
646 MOV R0,#cFrame__gosub ;Create a REPEAT frame
647 BL ctrl__pushFrame ;Stick that on the stack
648 LDR R2,sail_tokAnchor ;Find anchor of script buff
649 LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
650 SUB R2,R10,R2 ;Work out current offset
651 LDR R1,sail_line ;Get the current line number
652 STMIA R0,{R1,R2} ;Save these in the frame
654 ; --- Branch off somewhere ---
656 LDMIB R3,{R0,R1} ;Load out address/line
657 STR R1,sail_line ;Store the line number
658 LDR R1,sail_tokAnchor ;Load anchor address
659 LDR R1,[R1,#0] ;WimpExtension is bollocks
660 MOV R9,#-1 ;Don't confuse getToken
661 ADD R10,R0,R1 ;This is where we are
662 BL getToken ;Prime the lookahead token
663 LDR R14,sail_flags ;Load the flags word
664 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
665 STR R14,sail_flags ;Store the flasg back
666 B interp_exec ;Execute from here!
668 90ctrl_gosub MOV R0,#err_expLabel ;Get the error number
669 B error_report ;Report the error
673 ; --- ctrl_return ---
678 MOV R0,#cFrame__gosub ;Look for a GOSUB frame
679 BL ctrl__findFrame ;Try to find the frame
680 MOVCC R0,#err_notInSub ;Complain if not a GOSUB
682 BL ctrl__popFrame ;Pop off the frame
683 LDMIA R1,{R0,R1} ;Load the line and offset
684 STR R0,sail_line ;Save the line counter
685 LDR R14,sail_tokAnchor ;Find the anchor of the file
686 LDR R14,[R14] ;Pointless instruction
687 ADD R10,R14,R1 ;Get the new offset
688 SUB R10,R10,#1 ;Backtrac a little
689 MOV R9,#-1 ;Give bogus current token
690 BL getToken ;Read this token
691 B interp_next ;And continue merrily
698 LDR R14,sail_flags ;Load the flags word
699 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
700 STR R14,sail_flags ;Store the flasg back
702 MOV R0,#0 ;Read an rvalue
704 BL express_pop ;Get that value
705 CMP R1,#vType_integer ;It must be an integer
706 MOVNE R0,#err_numNeeded ;Isn't -- get error
707 BNE error_report ;And report the error
708 CMP R0,#0 ;Should we execute this?
709 BEQ %10ctrl_if ;No -- look for the else
711 CMP R9,#tok_then ;Is there a THEN here?
712 BLEQ getToken ;Yes -- skip over it then
713 B interp_exec ;And just execute from here
715 ; --- Look for an ELSE statement ---
717 10ctrl_if CMP R9,#tok_then ;Do we have a THEN then?
718 BNE %30ctrl_if ;No -- search line for else
720 BL getToken ;Get another token
721 CMP R9,#&0a ;Is this a return?
722 BNE %30ctrl_if ;No -- search line then
724 ; --- Now look for ELSE ... ENDIF structure ---
726 MOV R3,#0 ;My counter thing
727 LDR R4,sail_line ;Get the current line
729 20ctrl_if MOV R2,R9 ;Remmber the previous char
730 BL getToken ;Skip over the return
731 CMP R9,#&FF ;Is this the end of file?
732 BEQ %50ctrl_if ;Yes -- jump ahead
733 CMP R2,#&0a ;Was prev a newline?
734 CMPNE R9,#&0a ;Or even this one?
735 BNE %20ctrl_if ;Neither -- keep looping
737 CMP R2,#tok_then ;Did we just read a then
738 ADDEQ R3,R3,#1 ;Yes -- increment the count
739 BEQ %20ctrl_if ;And keep on looping
741 CMP R9,#tok_else ;Or an else?
742 CMPEQ R3,#0 ;Yes -- at bottom level?
743 CMPNE R9,#tok_endif ;Is this an endif?
744 SUBEQ R3,R3,#1 ;Yes -- decrement the count
745 CMP R3,#0 ;Are we ready to execute?
746 BGE %20ctrl_if ;No -- loop then
748 BL getToken ;Get the next token
749 B interp_next ;Execute from here!
751 ; --- Search on the same line ---
753 30ctrl_if MOV R0,R9 ;Look after this char
754 CMP R9,#&FF ;At end of file?
755 BLNE getToken ;No -- read next token
756 CMPNE R0,#tok_else ;Stop at ELSE tokens
757 CMPNE R0,#&0a ;And at line end
758 BNE %30ctrl_if ;If not, loop back again
759 B interp_exec ;And carry on going
761 ; -- Missing ENDIF ---
763 50ctrl_if STR R4,sail_line ;Store original line number
764 MOV R0,#err_expEndif ;Get the error number
765 B error_report ;And report the error
774 LDR R0,sail_flags ;Load the flags word
775 TST R0,#tscFlag_nl ;Have we just had a newline?
776 BNE %20ctrl_else ;Yes -- look for an ENDIF
778 ; --- Search for the line end ---
780 10ctrl_else MOV R0,R9 ;Look after old token
781 CMP R9,#&FF ;Is this the EOF
782 BLNE getToken ;No - get a token
783 CMP R0,#&0a ;Was it the line end?
784 BNE %10ctrl_else ;No -- keep on looking
785 B interp_next ;Execute from here
787 ; --- Look for an ENDIF ---
789 20ctrl_else MOV R3,#0 ;My counter thing
790 LDR R4,sail_line ;Get the current line
791 MOV R2,#0 ;Dummy previous char
794 40ctrl_else MOV R2,R9 ;Remember the previous token
795 BL getToken ;Get a new one
796 45ctrl_else CMP R9,#&FF ;Is this the end of file?
797 BEQ %50ctrl_else ;Yes -- jump ahead
798 CMP R2,#&0a ;Was prev a newline?
799 CMPNE R9,#&0a ;Or even this one?
800 BNE %40ctrl_else ;Neither -- keep looping
802 CMP R2,#tok_then ;Did we just read a then
803 ADDEQ R3,R3,#1 ;Yes -- increment the count
804 BEQ %40ctrl_else ;And keep on looping
806 CMP R9,#tok_endif ;Is this an endif?
807 SUBEQ R3,R3,#1 ;Yes -- decrement the count
808 CMP R3,#0 ;Are we ready to execute?
809 BGE %40ctrl_else ;No -- loop then
811 BL getToken ;Get the next token
812 B interp_next ;Execute from here!
814 ; -- Missing ENDIF ---
816 50ctrl_else STR R4,sail_line ;Store original line number
817 MOV R0,#err_expEndif ;Get the error number
818 B error_report ;And report the error
827 BL ctrl__readLabel ;Read the label
828 BCC %90ctrl_goto ;Not there -- barf
830 LDMIB R0,{R0,R1} ;Load out address/line
831 STR R1,sail_line ;Store the line number
832 LDR R1,sail_tokAnchor ;Load anchor address
833 LDR R1,[R1,#0] ;WimpExtension is bollocks
834 MOV R9,#-1 ;Don't confuse getToken
835 ADD R10,R0,R1 ;This is where we are
836 BL getToken ;Prime the lookahead token
837 LDR R14,sail_flags ;Load the flags word
838 BIC R14,R14,#tscFlag_nl ;Clear the newline flag
839 STR R14,sail_flags ;Store the flasg back
840 B interp_exec ;Execute from here!
842 90ctrl_goto MOV R0,#err_expLabel ;Get the error number
843 B error_report ;Report the error
852 MOV R0,#0 ;Read the comparand
854 BL express_pop ;Read the value of that
855 CMP R1,#vType_integer ;Is it an integer?
856 CMPNE R1,#vType_string ;Or a string?
857 MOVNE R0,#err_arrayBad ;No -- then point to error
858 BNE error_report ;And report the error
859 MOV R2,R0 ;Look after compare value
860 MOV R3,R1 ;And the type too, please
862 CMP R9,#tok_of ;We pointlessly expect `OF'
863 MOVNE R0,#err_expOf ;If not there, complain
865 BL getToken ;Get the next token
866 CMP R9,#&0A ;This must be the line end
867 MOVNE R0,#err_afterCase ;If not, complain annoyingly
870 ; --- Now keep an eye out for WHENs and OTHERWISEs ---
872 MOV R5,#0 ;Keep a nesting count
873 LDR R6,sail_line ;Get current line number
874 10ctrl_case MOV R4,R9 ;Look after previous char
875 BL getToken ;Get another token
876 CMP R9,#&FF ;Reached the end yet?
877 BEQ %90ctrl_case ;If so, moan about ENDCASE
878 CMP R9,#tok_case ;Is it a CASE token?
879 ADDEQ R5,R5,#1 ;Yes -- bump nesting count
880 CMP R4,#&0A ;Was previous newline?
881 BNE %10ctrl_case ;No -- nothing doing here
883 CMP R5,#0 ;At bottom nesting level?
884 CMPEQ R9,#tok_otherwise ;Yes -- check for OTHERWISE
885 CMPNE R9,#tok_endcase ;Or maybe an ENDCASE?
886 SUBEQ R5,R5,#1 ;Yes -- decrement nesting
887 CMP R5,#0 ;Have we dropped out?
888 BLLT getToken ;Yes -- get the next token
889 BLT %80ctrl_case ;Yes -- start executing
890 CMPEQ R9,#tok_when ;Now check for a W
891 BNE %10ctrl_case ;No -- loop
892 BL getToken ;Get another token
894 ; --- Found a WHEN -- check for a match ---
896 11ctrl_case MOV R0,#0 ;Read an rvalue
898 BL express_pop ;Get result from the stack
899 BL ctrl_compare ;Compare the values
900 BEQ %15ctrl_case ;Match -- skip other exprs
901 CMP R1,#vType_string ;Did we load a string?
902 BLEQ stracc_free ;Yes -- reomve the string
903 CMP R9,#',' ;Comma next?
904 BLEQ getToken ;Yes -- skip it
905 BEQ %11ctrl_case ;And try next expression
906 B %10ctrl_case ;Otherwise hope we get lucky
908 ; --- Skip other expressions ---
910 ; BASIC allows extreme bogosity here, and so shall we.
912 15ctrl_case CMP R1,#vType_string ;Did we load a string?
913 BLEQ stracc_free ;Yes -- reomve the string
914 00 CMP R5,#0 ;Are we quoted?
915 CMPEQ R9,#':' ;No -- check for colon
916 CMPNE R9,#&0A ;Newline?
917 BEQ %80ctrl_case ;Yes -- let it rip
918 CMP R9,#'"' ;Is this a quote?
919 EOREQ R5,R5,#1 ;Yes -- toggle quoted bit
920 BL getToken ;Get another token
921 B %b00 ;And keep going
923 ; --- Return to interp_next, removing str from stracc ---
925 80ctrl_case CMP R3,#vType_string ;Were we dealing with a str?
926 MOVEQ R0,R2 ;Yes -- put it in R0
927 BLEQ stracc_free ;...and remove it from stracc
928 B interp_next ;Keep on interpreting
930 ; --- We fell off the end -- oops ---
932 90ctrl_case STR R6,sail_line ;Save bogus line back
933 MOV R0,#err_expEndcase ;Hmm... should have had an...
934 B error_report ;ENDCASE somewhere
942 ; --- ctrl_otherwise ---
944 EXPORT ctrl_otherwise
949 MOV R3,#0 ;My counter thing
950 LDR R4,sail_line ;Get the current line
951 MOV R2,#0 ;Dummy previous char
954 40ctrl_when MOV R2,R9 ;Remember the previous token
955 BL getToken ;Get a new one
956 45ctrl_when CMP R9,#&FF ;Is this the end of file?
957 BEQ %50ctrl_when ;Yes -- jump ahead
958 CMP R9,#tok_case ;Did we just read a CASE
959 ADDEQ R3,R3,#1 ;Yes -- increment the count
960 BEQ %40ctrl_when ;And keep on looping
961 CMP R2,#&0a ;Was prev a newline?
962 CMPEQ R9,#tok_endcase ;Is this an endcase?
963 SUBEQ R3,R3,#1 ;Yes -- decrement the count
964 CMP R3,#0 ;Are we ready to execute?
965 BGE %40ctrl_when ;No -- loop then
967 BL getToken ;Get the next token
968 B interp_next ;Execute from here!
970 ; -- Missing ENDCASE ---
972 50ctrl_when STR R4,sail_line ;Store original line number
973 MOV R0,#err_expEndcase ;Get the error number
974 B error_report ;And report the error
993 MOV R0,#1 ;Read an lvalue
995 CMP R9,#',' ;Do we have a comma?
996 MOVNE R0,#err_expComma ;No -- get the error number
997 BNE error_report ;And report the error
998 BL getToken ;Skip over the comma
999 MOV R0,#1 ;Read another lvalue
1001 BL express_popTwo ;Pop off the two lvalues
1003 ; --- Swap the contents of the lvalues ---
1005 10ctrl_swap MOV R4,R2 ;Look after parm 2
1007 BL ctrl_load ;Load the parameter
1008 STMFD R13!,{R2,R3} ;Store rvalue
1009 STMFD R13!,{R0,R1} ;And lvalue
1010 MOV R0,R4 ;Get the second one
1012 BL ctrl_load ;Load it's value too
1013 LDMFD R13!,{R0,R1} ;Get back lvalue
1014 BL ctrl_store ;Store rvalue in lvalue
1015 MOV R0,R4 ;Get the second one
1017 LDMFD R13!,{R2,R3} ;Load rvalue
1018 BL ctrl_store ;Complete the swap
1019 B interp_next ;All over and happy
1028 MOV R0,#2 ;Read an rvalue ident
1029 BL express_read ;Read it then
1030 BL express_pop ;And get it off the stack
1031 CMP R1,#vType_integer ;Is this a string?
1032 BNE ctrl__notAnInt ;So if it isn't, complain
1033 MOV R3,R0 ;Remember file handle
1035 CMP R9,#'=' ;Next char must be `='
1036 MOVNE R0,#err_expEq ;If it isn't, moan
1038 BL getToken ;Skip past the equals sign
1039 MOV R0,#0 ;Read the expression
1041 BL express_pop ;Pop the result
1042 CMP R1,#vType_integer ;It must be an integer
1043 BNE ctrl__notAnInt ;So if it isn't, complain
1045 MOV R2,R0 ;Put pointer in R2
1046 MOV R1,R3 ;And handle in R1
1047 MOV R0,#1 ;Write pointer
1048 SWI XOS_Args ;Write the pointer
1049 BVS sail_error ;Report possible error
1051 B interp_next ;And read another instruction
1060 MOV R0,#2 ;Read an rvalue ident
1061 BL express_read ;Read it then
1062 BL express_pop ;And get it off the stack
1063 CMP R1,#vType_integer ;Is this a string?
1064 BNE ctrl__notAnInt ;So if it isn't, complain
1065 MOV R3,R0 ;Remember file handle
1067 CMP R9,#'=' ;Next char must be `='
1068 MOVNE R0,#err_expEq ;If it isn't, moan
1070 BL getToken ;Skip past the equals sign
1071 MOV R0,#0 ;Read the expression
1073 BL express_pop ;Pop the result
1074 CMP R1,#vType_integer ;It must be an integer
1075 BNE ctrl__notAnInt ;So if it isn't, complain
1077 MOV R2,R0 ;Put extent in R2
1078 MOV R1,R3 ;And handle in R1
1079 MOV R0,#3 ;Write pointer
1080 SWI XOS_Args ;Write the extent
1081 BVS sail_error ;Report possible error
1083 B interp_next ;And read another instruction
1087 ; --- ctrl_close ---
1092 MOV R0,#2 ;Read an rvalue ident
1093 BL express_read ;Read it then
1094 BL express_pop ;And get it off the stack
1095 CMP R1,#vType_integer ;Is this a string?
1096 BNE ctrl__notAnInt ;So if it isn't, complain
1097 MOV R1,R0 ;Remember file handle
1098 MOV R0,#0 ;Close file
1099 SWI XOS_Find ;Close it then
1100 BVS interp_next ;And read another instr
1102 AND R0,R0,#&FF ;Make sure this is a byte
1103 ADR R1,sail_files ;Find file bit-array
1104 MOV R14,R0,LSR #5 ;Get word index
1105 LDR R14,[R1,R14,LSL #2]! ;Load the word I want
1106 MOV R2,#(1<<31) ;Set the top bit here
1107 BIC R14,R14,R2,ROR R0 ;Clear the correct bit
1108 STR R14,[R1,#0] ;Save the word back again
1109 B interp_next ;And read another instr
1118 ; --- First, make sure we have a hash ---
1120 CMP R9,#'#' ;We must have a hash
1121 MOVNE R0,#err_expHash ;No -- complain then
1122 BNE error_report ;And report an error
1123 BL getToken ;Get the next token
1125 ; --- Now read the channel number ---
1127 MOV R0,#2 ;Read an rvalue ident
1128 BL express_read ;Read it then
1129 BL express_pop ;And get it off the stack
1130 CMP R1,#vType_integer ;Is this a string?
1131 BNE ctrl__notAnInt ;So if it isn't, complain
1132 MOV R3,R0 ;Remember file handle
1134 ; --- Skip over the comma ---
1136 CMP R9,#',' ;Next char must be `,'
1137 MOVNE R0,#err_expComma ;If it isn't, moan
1139 BL getToken ;Skip past the comma
1141 ; --- Now we read an expression ---
1143 MOV R0,#0 ;Read the expression
1145 BL express_pop ;Pop the result
1146 CMP R1,#vType_integer ;Is it an integer?
1147 BEQ %10ctrl_bput ;Yes -- jump ahead
1148 CMP R1,#vType_string ;Make sure it is a string
1149 MOVNE R0,#err_arrayBad ;Nope -- get error message
1150 BNE error_report ;So if it isn't, complain
1152 ; --- Write a string to the file ---
1154 MOV R5,R0 ;Look after the value
1155 LDR R1,sail_stracc ;Get the stracc address
1157 ADD R4,R1,R0,LSR #8 ;Point to the string
1158 AND R2,R0,#&FF ;Get the length
1160 MOV R1,R3 ;Get the file handle
1161 CMP R2,#0 ;Is this a short string?
1162 00 LDRGTB R0,[R4],#1 ;Load a character
1163 SWIGT XOS_BPut ;Put the byte
1164 BVS error_reportReal ;Report possible error
1165 SUBS R2,R2,#1 ;Reduce the count
1166 BGT %b00 ;And keep on goin'
1168 MOV R0,R5 ;Put the string in R0
1169 BL stracc_free ;Free it from stracc
1171 CMP R9,#';' ;Is there a semicolon now?
1172 BLEQ getToken ;Yes -- get a token
1173 MOVNE R0,#10 ;Get a terminator
1174 SWINE XOS_BPut ;Put the byte
1175 B interp_next ;And read another instruction
1177 ; --- Just write a character ---
1179 10 MOV R1,R3 ;Get the file handle
1180 SWI XOS_BPut ;Put the byte
1181 BVS error_reportReal ;Report possible error
1182 B interp_next ;And read another instruction
1186 ;----- Odds and sods --------------------------------------------------------
1188 ; --- ctrl_error ---
1193 ; --- Read a parameter ---
1195 MOV R0,#0 ;Read an rvalue
1196 BL express_read ;Read it then
1197 BL express_pop ;And get it off the stack
1198 CMP R1,#vType_string ;Is this a string?
1199 MOVNE R0,#err_strNeeded ;Nope -- get error number
1200 BNE error_report ;...and report the error
1202 LDR R1,sail_stracc ;Get the stracc address
1204 ADD R1,R1,R0,LSR #8 ;Point to the string
1205 AND R2,R0,#&FF ;Get the length
1207 MOV R5,R0 ;look after the rvalue
1208 ADR R0,sail_misc ;Point to the misc buffer
1209 MOV R14,#1 ;A sillu error number
1210 STR R14,[R0],#4 ;Store that
1211 BL ctrl_copyString ;Copy the string over
1212 ADR R0,sail_misc ;Point to the misc buffer
1213 B sail_error ;Return the error
1217 ; --- ctrl_oscli ---
1222 ; --- Read a parameter ---
1224 MOV R0,#0 ;Read an rvalue
1225 BL express_read ;Read it then
1226 BL express_pop ;And get it off the stack
1227 CMP R1,#vType_string ;Is this a string?
1228 MOVNE R0,#err_strNeeded ;Nope -- get error number
1229 BNE error_report ;...and report the error
1231 LDR R1,sail_stracc ;Get the stracc address
1233 ADD R1,R1,R0,LSR #8 ;Point to the string
1234 AND R2,R0,#&FF ;Get the length
1236 MOV R5,R0 ;look after the rvalue
1237 ADR R0,sail_misc ;Point to the misc buffer
1238 BL ctrl_copyString ;Copy the string over
1239 SWI OS_CLI ;Do the command
1240 MOV R0,R5 ;Get the rvalue back
1241 BL stracc_free ;Free the string from stracc
1242 B interp_next ;Continue happily
1248 ;----- DATA and the like ----------------------------------------------------
1250 ; --- ctrl__findDATA ---
1252 ; On entry: All the normal things
1254 ; On exit: R0 == *address* in file of next DATA
1256 ; Use: Sets the internal data pointer to the first DATA statement
1257 ; fromthe current position.
1259 EXPORT ctrl_findDATA
1262 STMFD R13!,{R1,R2,R14} ;Save some registers
1263 LDR R0,sail_dataPtr ;Load the current position
1264 LDR R1,sail_tokAnchor ;Load the anchor
1266 ADD R0,R1,R0 ;Point into the file
1267 LDR R2,sail_dataLine ;Line number of DATA
1269 ; --- Search the file for DATA, or EOF ---
1271 00 LDRB R14,[R0],#1 ;Load a byte
1272 CMP R14,#10 ;Are we at a return?
1273 ADDEQ R2,R2,#1 ;Yes -- inc line number
1274 CMP R14,#&FF ;Is this the EOF?
1275 SUBEQ R0,R0,#1 ;Yes -- point to it
1276 CMPNE R14,#tok_data ;Did we read a DATA?
1277 BNE %b00 ;No -- keep on looking
1279 90 SUB R1,R0,R1 ;Get it as an offset
1280 STR R1,sail_dataPtr ;Save this away then
1281 STR R2,sail_dataLine ;And the line number
1282 LDMFD R13!,{R1,R2,PC}^ ;Return to caller
1291 ; --- Point at the current position ---
1293 LDR R4,sail_dataPtr ;Load the current position
1294 LDR R5,sail_tokAnchor ;Load the anchor
1296 ADD R4,R5,R4 ;Point into the file
1298 00ctrl_read LDRB R14,[R4,#0] ;Load the byte there
1299 CMP R14,#&FF ;Is it the EOF?
1300 MOVEQ R0,#err_outOfDATA ;Yes -- get error num
1301 BEQ error_report ;And report the error
1302 CMP R14,#10 ;Are we at the line end?
1303 BLEQ ctrl_findDATA ;Yes -- find next data
1304 MOVEQ R4,R0 ;...put ptr in R0
1305 BEQ %00ctrl_read ;...and start again
1306 CMP R14,#',' ;Is it a comma?
1307 ADDEQ R4,R4,#1 ;Yes -- skip over it
1309 ; --- Read an rvalue from this position ---
1311 LDR R6,sail_line ;Load the line number
1312 STMFD R13!,{R6-R10} ;Stack position details
1313 MOV R10,R4 ;Point just before data
1314 LDR R14,sail_dataLine ;Get the line number
1315 STR R14,sail_line ;Store as actual line
1316 MOV R9,#-1 ;Make getToken happy
1317 BL getToken ;Get a token
1318 MOV R0,#0 ;Read an rvalue
1319 BL express_read ;Read it then
1320 BL express_pop ;Get it off the stack
1321 LDR R14,sail_line ;Get line number
1322 STR R14,sail_dataLine ;Store as DATA line number
1323 SUB R4,R10,#1 ;Restore data pointer
1324 LDMFD R13!,{R6-R10} ;Load back position
1325 STR R6,sail_line ;Restore line number
1326 MOV R2,R0 ;Put rvalue in R2,R3
1329 ; --- We are hopefully pointing at some data ---
1331 MOV R0,#1 ;Prepare to read an lvalue
1332 BL express_read ;Read one then
1333 BL express_pop ;Get it off the stack
1334 BL ctrl_store ;Store the rvalue
1336 SUB R14,R4,R5 ;Get data pointer as offset
1337 STR R14,sail_dataPtr ;Store this away
1338 CMP R9,#',' ;Should we read more?
1339 BLEQ getToken ;Yes -- skip over the comma
1340 BEQ %00ctrl_read ;..and loop back again
1342 B interp_next ;Do next instruction
1346 ; --- ctrl_restore ---
1351 BL ctrl__readLabel ;Read the label
1352 MOVCC R0,#0 ;Not there -- offset is 0
1353 MOVCC R1,#1 ;Line is 1
1354 LDMCSIB R0,{R0,R1} ;Load out address/line
1356 STR R0,sail_dataPtr ;Save the data pointer
1357 STR R1,sail_dataLine ;And the line number
1358 BL ctrl_findDATA ;Find the DATA
1359 B interp_next ;And do the next instruction
1363 ;----- SYS and friends ------------------------------------------------------
1370 BL ctrl_setUpRegs ;Set up the regs then
1372 CMP R10,#vType_integer ;Is this an integer?
1373 MOVNE R0,#err_numNeeded ;No -- get error number
1374 BNE error_report ;...and report the error
1376 MOV R14,PC ;Set up return address
1377 MOV PC,R9 ;Execute the code
1379 ADRL R9,ctrl__returned ;Point to some space
1380 STMIA R9!,{R0-R8} ;Store returned registers
1381 MOV R14,PC,LSR #28 ;Get the flags
1382 STMIA R9,{R14} ;Strore the flags too
1383 LDMFD R13!,{R7-R12} ;Load back position info
1384 LDMFD R13!,{R0} ;Load stracc offset
1385 BL stracc_free ;Free any strings I had
1387 ; --- We have now done the SWI instr ---
1389 ADRL R0,ctrl__returned ;Point to the returned regs
1390 BL ctrl_resolveRegs ;Do the other half now
1391 B interp_next ;If flags -- return
1400 BL ctrl_setUpRegs ;Set up the registers
1401 STMFD R13!,{R0-R8} ;Stack these registers
1403 CMP R10,#vType_integer ;Did user use an integer?
1404 MOVEQ R0,R9 ;Yes -- use that then
1405 BEQ %10ctrl_sys ;And jump ahead
1407 ; --- Convert the name to a number ---
1409 LDR R1,sail_stracc ;Load the stracc address
1411 ADD R1,R1,R9,LSR #8 ;Point to the name
1412 SWI XOS_SWINumberFromString ;Convert it then
1413 BVS error_reportReal ;Report possible error
1415 ; --- We have the SWI number in R0 ---
1417 ; We build the following instructions on the stack:
1422 10 ORR R9,R0,#&EF000000 ;Build the SWI instruction
1423 LDR R10,=&E1A0F00E ;Get the MOV instr too
1424 LDMFD R13!,{R0-R8} ;Load the registers
1425 SUB R13,R13,#8 ;Make some room
1426 STMIA R13,{R9,R10} ;Stack code
1427 MOV R14,PC ;Set up return address
1428 MOV PC,R13 ;Call my code
1430 ADD R13,R13,#8 ;Get rid of my code
1431 ADR R9,ctrl__returned ;Point to some space
1432 STMIA R9!,{R0-R8} ;Store returned registers
1433 MOV R14,PC,LSR #28 ;Get the flags
1434 STMIA R9,{R14} ;Strore the flags too
1435 LDMFD R13!,{R7-R12} ;Load back position info
1436 LDMFD R13!,{R0} ;Load stracc offset
1437 BL stracc_free ;Free any strings I had
1439 ; --- We have now done the SWI instr ---
1441 ADR R0,ctrl__returned ;Point to the returned regs
1442 BL ctrl_resolveRegs ;Do the other half now
1443 B interp_next ;Do the next instruction
1445 ctrl__returned DCD 0,0,0,0,0,0,0,0,0,0,0
1449 ; --- ctrl_setUpRegs ---
1451 ; On entry: R7-R10 == position info
1453 ; On exit: R0-R8 set up for sys call
1454 ; R9,R10 == rvalue of first parameter
1456 ; new position info, R7-R12
1457 ; place to stracc free
1459 ; Use: Sets up all the registers as required by a SYS or SYSCALL
1462 EXPORT ctrl_setUpRegs
1465 MOV R3,R14 ;Look after the link
1466 BL stracc_ensure ;Get current stracc offset
1467 STMFD R13!,{R1} ;Put it on the stack
1468 MOV R5,#0 ;Might be useful
1470 ; --- Read the complusory argument ---
1472 MOV R0,#0 ;It's an rvalue
1473 BL express_read ;Read the expression
1474 BL express_pop ;Pop it
1475 BL express_push ;Push it again
1477 CMP R1,#vType_integer ;Is it an integer?
1478 BEQ %f00 ;Yes -- go round again then
1479 CMP R1,#vType_string ;Was it a string?
1480 MOVNE R0,#err_arrayBad ;No -- get error number
1481 BNE error_report ;And report the error
1482 BL stracc_ensure ;If it was -- ensure room
1483 STRB R5,[R0,#0] ;...store a terminator
1484 AND R0,R0,#3 ;Get the alignment
1486 ORR R0,R1,R0 ;...set up the rvalue
1487 BL stracc_added ;Tell stracc about this
1489 ; --- Now read all other parameters ---
1491 00 MOV R2,#0 ;Mask of regs read
1492 MOV R4,#0 ;Number we have read
1493 00 CMP R9,#',' ;Do we have a comma?
1494 BNE %10ctrl_setUpRegs ;No -- we have finshed then
1495 05 ADD R4,R4,#1 ;Increment the counter
1496 CMP R4,#8 ;Have we read 8?
1497 MOVEQ R0,#err_sysTooManyI ;Yes -- get error number
1498 BEQ error_report ;And report the error
1499 BL getToken ;Skip over the comma
1500 CMP R9,#',' ;Another comma?
1501 MOVEQ R2,R2,LSL #1 ;Yes -- shift R2 along
1502 BEQ %b05 ;And go back for more
1503 MOV R0,#0 ;Read an rvalue
1504 BL express_read ;Read it then
1505 MOV R2,R2,LSL #1 ;Shift R2 along
1506 ORR R2,R2,#1 ;And set the bit
1507 BL express_pop ;Get it off the stack
1508 BL express_push ;Oh -- better not!
1509 CMP R1,#vType_integer ;Is it an integer?
1510 BEQ %b00 ;Yes -- go round again then
1511 CMP R1,#vType_string ;Was it a string?
1512 MOVNE R0,#err_arrayBad ;No -- get error number
1513 BNE error_report ;And report the error
1514 BL stracc_ensure ;If it was -- ensure room
1515 STRB R5,[R0] ;...store a terminator
1516 AND R0,R0,#3 ;Get the alignment
1518 ORR R0,R1,R0 ;...set up the rvalue
1519 BL stracc_added ;Tell stracc about this
1520 B %b00 ;And go round for more
1522 ; --- We have read the input parameters ---
1524 ; We must put the position infor on the stack before
1525 ; the link here, so that it remains on the stack at return
1528 10 STMFD R13!,{R7-R12} ;Stack position info
1529 STMFD R13!,{R3} ;And then stack the link!
1530 LDR R9,sail_stracc ;Load the stracc anchor
1531 LDR R9,[R9] ;Get it's address
1532 MOV R10,R2 ;Put the mask in R10
1534 ; --- Now transfer the info to R0-R8 ---
1536 ; Each routine is padded to eight bytes, for niceness (?)
1537 ; To start, we set everything to
1539 MOV R14,R4 ;Look after number of regs
1550 CMP R14,#0 ;Read no registers?
1551 BEQ %30ctrl_setUpRegs ;Indeed -- jump ahead then
1552 RSB R14,R14,#9 ;Make R4 right
1553 ADD R14,R14,R14,LSL #1 ;Multiply by 3
1554 ADDS PC,PC,R14,LSL #3 ;Jump to the routine (*24)
1555 DCB "TMA!" ;Pad pad pad pad...
1557 28 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1558 BCC %27ctrl_setUpRegs ;No go -- jump ahead then
1559 BL express_pop ;Get the rvalue
1560 CMP R1,#vType_string ;Was it a string?
1561 ADDEQ R8,R9,R0,LSR #8 ;Yes -- point to string
1562 MOVNE R8,R0 ;No -- it's an integer then
1564 27 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1565 BCC %26ctrl_setUpRegs ;No go -- jump ahead then
1566 BL express_pop ;Get the rvalue
1567 CMP R1,#vType_string ;Was it a string?
1568 ADDEQ R7,R9,R0,LSR #8 ;Yes -- point to string
1569 MOVNE R7,R0 ;No -- it's an integer then
1571 26 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1572 BCC %25ctrl_setUpRegs ;No go -- jump ahead then
1573 BL express_pop ;Get the rvalue
1574 CMP R1,#vType_string ;Was it a string?
1575 ADDEQ R6,R9,R0,LSR #8 ;Yes -- point to string
1576 MOVNE R6,R0 ;No -- it's an integer then
1578 25 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1579 BCC %24ctrl_setUpRegs ;No go -- jump ahead then
1580 BL express_pop ;Get the rvalue
1581 CMP R1,#vType_string ;Was it a string?
1582 ADDEQ R5,R9,R0,LSR #8 ;Yes -- point to string
1583 MOVNE R5,R0 ;No -- it's an integer then
1585 24 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1586 BCC %23ctrl_setUpRegs ;No go -- jump ahead then
1587 BL express_pop ;Get the rvalue
1588 CMP R1,#vType_string ;Was it a string?
1589 ADDEQ R4,R9,R0,LSR #8 ;Yes -- point to string
1590 MOVNE R4,R0 ;No -- it's an integer then
1592 23 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1593 BCC %22ctrl_setUpRegs ;No go -- jump ahead then
1594 BL express_pop ;Get the rvalue
1595 CMP R1,#vType_string ;Was it a string?
1596 ADDEQ R3,R9,R0,LSR #8 ;Yes -- point to string
1597 MOVNE R3,R0 ;No -- it's an integer then
1599 22 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1600 BCC %21ctrl_setUpRegs ;No go -- jump ahead then
1601 BL express_pop ;Get the rvalue
1602 CMP R1,#vType_string ;Was it a string?
1603 ADDEQ R2,R9,R0,LSR #8 ;Yes -- point to string
1604 MOVNE R2,R0 ;No -- it's an integer then
1606 21 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1607 BCC %20ctrl_setUpRegs ;No go -- jump ahead then
1608 BL express_pop ;Get the rvalue
1609 CMP R1,#vType_string ;Was it a string?
1610 ADDEQ R1,R9,R0,LSR #8 ;Yes -- point to string
1611 MOVNE R1,R0 ;No -- it's an integer then
1613 20 MOVS R10,R10,LSR #1 ;Shift the mask down a little
1614 BCC %30ctrl_setUpRegs ;No go -- jump ahead then
1615 STMFD R13!,{R1} ;Stack R1
1616 BL express_pop ;Get the rvalue
1617 CMP R1,#vType_string ;Was it a string?
1618 ADDEQ R0,R9,R0,LSR #8 ;Yes -- point to string
1619 LDMFD R13!,{R1} ;Restore R1
1621 ; --- All the registers are now set up, phew! ---
1623 30 STMFD R13!,{R0,R1} ;Stack some registers
1624 BL express_pop ;Get off first arg!
1625 MOV R9,R0 ;Put rvalue in R9,R10
1627 LDMFD R13!,{R0,R1,PC}^ ;Return to caller
1631 ; --- ctrl_resolveRegs ---
1633 ; On entry: R0 == pointer to register block
1635 ; On exit: CS if flags were required, CC otherwise
1637 ; Use: Resolves the registers returned from a SYS or SYSCALL
1638 ; into the appropriate variables. The code assumes that
1639 ; we have possibly just read a TO command, and goes on
1642 EXPORT ctrl_resolveRegs
1643 ctrl_resolveRegs ROUT
1645 ; --- See if we require register return ---
1647 CMP R9,#tok_to ;Do we have a TO?
1648 MOVNES PC,R14 ;No -- return PDQ then
1650 STMFD R13!,{R0-R6,R14} ;Stack registers
1651 BL getToken ;Skip over the TO
1652 MOV R4,R0 ;Put the block in R4
1653 MOV R5,#0 ;Number read so far
1654 ADD R6,R4,#9*4 ;Point tothe flags
1656 00 CMP R9,#':' ;Is this the end?
1660 BEQ %90ctrl_resolveRegs ;Yes -- return then
1661 CMP R9,#',' ;Do we skip this one?
1662 ADDEQ R4,R4,#4 ;Yes -- go onto next reg
1663 ADDEQ R5,R5,#1 ;We have done this many
1664 CMP R5,#9 ;Is this reg 9?
1665 MOVEQ R0,#err_sysTooManyO ;Yes -- get error number
1666 BEQ error_report ;And report then error
1667 CMP R9,#',' ;Compare again with comma
1668 BLEQ getToken ;Yes -- skip the comma
1669 BEQ %b00 ;Keep on going
1671 ; --- We must read one then ---
1673 ; Actually, we may be reading the flags too.
1675 CMP R9,#';' ;Do we have a semicolon?
1676 BEQ %30ctrl_resolveRegs ;Yes -- deal with it then
1678 MOV R0,#1 ;We are reading an lvalue
1679 BL express_read ;Read it
1680 BL express_pop ;Pop it off the stack
1681 BL ctrl_load ;Load the value
1682 CMP R3,#vType_integer ;Is it an integer?
1683 BEQ %20ctrl_resolveRegs ;Yes -- jump ahead
1685 CMP R3,#vType_string ;Is it a string then?
1686 MOVNE R0,#err_arrayBad ;No -- get error number
1687 BNE error_report ;And report the error
1689 ; --- We have to return a string ---
1691 STMFD R13!,{R0,R1} ;Look after the lvalue
1692 MOV R0,R2 ;Put the rvalue in R0
1693 BL stracc_free ;Free the string from stracc
1695 LDR R2,[R4,#0] ;Load the string address
1696 BL stracc_ensure ;Make sure we have room
1697 MOV R3,#0 ;Length so far
1699 10 LDRB R14,[R2],#1 ;Load a byte
1700 CMP R14,#0 ;Is it 0?
1701 STRNEB R14,[R0],#1 ;No -- store it then
1702 ADDNE R3,R3,#1 ;...increment the length
1703 BNE %b10 ;And go round for more
1705 ORR R0,R1,R3 ;Create the rvalue
1706 BL stracc_added ;Tell stracc about this
1707 MOV R2,R0 ;Put rvalue in R2 too
1708 MOV R3,#vType_string ;This is a string
1709 LDMFD R13!,{R0,R1} ;Load the lvalue back
1710 BL ctrl_store ;Store the new value
1711 B %b00 ;Go round again
1713 ; --- It's just an integer then ---
1715 20 LDR R2,[R4,#0] ;Load the integer
1716 BL ctrl_store ;Store this result
1717 B %b00 ;Go round again
1719 ; --- We must read the flags ---
1721 30 BL getToken ;Skip over the ';'
1722 MOV R0,#1 ;Read an lvalue
1723 BL express_read ;Read it then
1724 BL express_pop ;Get it off the stack
1725 BL ctrl_load ;Load the current value
1726 CMP R3,#vType_integer ;Is it an integer?
1727 MOVNE R0,#err_numNeeded ;No -- get error number
1728 BNE error_report ;And report the error
1729 LDR R2,[R6,#0] ;Load the flags word
1730 BL ctrl_store ;Store the new value
1731 LDMFD R13!,{R0-R6,R14} ;Load back registers
1732 ORRS PC,R14,#C_flag ;Return with C set
1734 90 LDMFD R13!,{R0-R6,R14} ;Load back registers
1735 BICS PC,R14,#C_flag ;Return with C clear
1739 ;----- Function/Procedure call ----------------------------------------------
1743 ; OK, maybe it shouldn't be here. I don't really care.
1745 ; Hack warning: This is a hack. We unwind express_read's stack and stuff
1746 ; them away somewhere completely different.
1751 ; --- First we need to make a FN frame ---
1753 ; This involves taking a copy of express_read's stack and
1754 ; stuffing it into the frame so we can restore it afterwards.
1755 ; This basically means that we can recurse mightily without
1756 ; using any R13 stack space. Huzzah!
1758 MOV R0,#cFrame__fn ;Get the frame type
1759 BL ctrl__pushFrame ;Push the frame
1760 LDR R14,sail_oldAnchor ;Load the old anchor address
1761 STR R14,[R0,#cFn__anchor] ;Save it in the frame
1762 STR R6,[R0,#cFn__flags] ;Save express_read's flags
1763 STMFD R13!,{R0} ;Save some register
1764 BL stracc_ensure ;Get current strac position
1765 LDMFD R13!,{R0} ;Load registers back again
1766 STR R1,[R0,#cFn__stracc] ;Save this away
1767 LDR R14,sail_currAnchor ;Load the current anchor
1768 STR R14,sail_oldAnchor ;Save this as the old one
1769 LDR R14,sail_tokAnchor ;Now we work from the file
1770 STR R14,sail_currAnchor ;So set this as current one
1772 ADD R14,R0,#cFn__stack+32 ;Find the stack copy bit
1773 LDMFD R13!,{R1-R4} ;Load some registers
1774 STMFD R14!,{R1-R4} ;Save them into the frame
1775 LDMFD R13!,{R1-R4} ;Load some registers again
1776 STMFD R14!,{R1-R4} ;Save them into the frame
1778 ; --- Now get on with the business of calling ---
1780 LDR R1,sail_execStack ;Load the stack anchor
1781 LDR R1,[R1,#0] ;Tycho bops WimpExtension
1782 SUB R6,R0,R1 ;Turn into an offset
1784 ; --- Substitute the arguments ---
1786 MOV R0,#vType_fn ;This is a FN
1787 BL ctrl__subArgs ;Substitute the args
1789 LDR R0,sail_execStack ;Load the stack anchor
1790 LDR R0,[R0,#0] ;Tycho bops WimpExtension
1791 ADD R0,R0,R6 ;Point to my frame
1792 STMIA R0,{R3,R4} ;Save the return point away
1794 B interp_exec ;Execute next instruction
1803 ; --- First, evaluate the argument ---
1805 MOV R0,#0 ;Get an rvalue for it
1806 BL express_read ;Read the expression
1807 CMP R9,#&0A ;Now at end of line?
1808 CMPNE R9,#':' ;Or end of statement (weird)
1809 CMPNE R9,#&FF ;Or end of file?
1810 CMPNE R9,#tok_else ;Or an ElSE?
1811 MOVNE R0,#err_syntax ;No -- that's a cock-up
1812 BNE error_report ;So be righteous about it
1814 ; --- If the result is a string, copy it ---
1816 BL express_pop ;Pop off the result
1817 MOV R4,R0 ;Put the rvalue in R4
1818 MOV R5,R1 ;And the type in R5
1819 CMP R5,#vType_string ;Is it a string?
1820 BNE %10ctrl_equals ;No -- jump ahead
1822 ; --- Copy the string elsewhere ---
1824 ; We do this since there may be local strings that are
1825 ; removed from stracc, underneath the result.
1827 LDR R1,sail_stracc ;Load stracc's anchor
1828 LDR R1,[R1] ;Load the address
1829 ADD R1,R1,R4,LSR #8 ;Point to the string
1831 ADR R0,sail_misc ;Point to a misc buffer
1832 ANDS R2,R4,#&FF ;Get the length
1833 BEQ %10ctrl_equals ;Nothin' doin', jump
1835 00 LDRB R14,[R1],#1 ;Load a byte
1836 STRB R14,[R0],#1 ;Store a byte
1837 SUBS R2,R2,#1 ;Reduce counter
1838 BNE %b00 ;Do this lots
1839 MOV R0,R4 ;Put the rvalue in R0
1840 BL stracc_free ;Free the string
1842 ; --- Find the frame thing ---
1844 10ctrl_equals MOV R0,#cFrame__fn ;Search for a FN frame
1845 BL ctrl__unwind ;Look for one of these then
1846 MOVCC R0,#err_notInFn ;Get possible error num
1847 BCC error_report ;And report the error
1848 MOV R6,R1 ;Look after frame address
1850 ; --- Put stracc in the right place ---
1852 LDR R0,[R6,#cFn__stracc] ;Load the offset
1853 BL stracc_free ;Okaydokey
1855 ; --- Reset other things ---
1857 LDMIA R1,{R0,R1} ;Load the line and offset
1858 STR R1,sail_line ;Save the line counter
1859 LDR R14,sail_oldAnchor ;Find the anchor of the file
1860 STR R14,sail_currAnchor ;This is the current one
1861 LDR R1,[R6,#cFn__anchor] ;Load the saved anchor
1862 STR R1,sail_oldAnchor ;This is the old one
1863 LDR R14,[R14] ;Pointless instruction
1864 ADD R10,R14,R0 ;Get the new offset
1865 SUB R10,R10,#1 ;Backtrack a little
1866 MOV R9,#-1 ;Give bogus current token
1867 BL getToken ;Read this token
1869 ; --- Put a string result back on stracc ---
1871 MOV R0,R4 ;Get the rvalue
1872 MOV R1,R5 ;And the type
1873 CMP R1,#vType_string ;Was it a string?
1874 BNE %20ctrl_equals ;No -- jump ahead
1876 ; --- Copy the result back into stracc ---
1878 BL stracc_ensure ;Make sure we have room
1879 ADR R2,sail_misc ;Point to our string
1880 ANDS R3,R4,#&FF ;Get the length
1881 BEQ %15ctrl_equals ;Very short -- jump
1882 00 LDRB R14,[R2],#1 ;Load a byte
1883 STRB R14,[R0],#1 ;Store a byte
1884 SUBS R3,R3,#1 ;Reduce a counter
1885 BNE %b00 ;Lots more please
1887 15 ANDS R3,R4,#&FF ;Get the length again
1888 ORR R0,R1,R3 ;Put the rvalue in R0
1889 MOV R1,#vType_string ;This is a string
1890 BL stracc_added ;Tell stracc about this
1891 20 BL express_push ;Push this result
1893 ; --- Now we need to return to express_read ---
1895 ; Hack warning: This is a hack.
1897 ADD R14,R6,#cFn__stack ;Find stack contents
1898 LDMFD R14!,{R0-R3} ;Load contents out
1899 STMFD R13!,{R0-R3} ;Stuff them back on the stack
1902 LDR R6,[R6,#cFn__flags] ;Restore express_read's flags
1903 B express_fnCont ;And resume horridly
1912 ; --- First, we push a PROC frame onto the stack ---
1914 MOV R0,#cFrame__proc ;Push on this type
1915 BL ctrl__pushFrame ;Push on the frame
1916 LDR R14,sail_oldAnchor ;Get the old anchor
1917 STR R14,[R0,#cProc__anchor] ;Save it in the frame
1918 LDR R14,sail_tokAnchor ;Args must be in the file
1919 STR R14,sail_oldAnchor ;So read them from there
1920 STMFD R13!,{R0} ;Save some register
1921 BL stracc_ensure ;Get current strac position
1922 LDMFD R13!,{R0} ;Load registers back again
1923 STR R1,[R0,#cProc__stracc] ;Save this away
1924 LDR R1,sail_execStack ;Load the stack anchor
1925 LDR R1,[R1,#0] ;Tycho bops WimpExtension
1926 SUB R6,R0,R1 ;Turn into an offset
1928 ; --- Substitute the arguments ---
1930 MOV R0,#vType_proc ;This is a PROC
1931 BL ctrl__subArgs ;Substitute the args
1933 LDR R0,sail_execStack ;Load the stack anchor
1934 LDR R0,[R0,#0] ;Tycho bops WimpExtension
1935 ADD R0,R0,R6 ;Point to my frame
1936 STMIA R0,{R3,R4} ;Save the return point away
1937 LDR R14,[R0,#cProc__anchor] ;Load anchor we saved above
1938 STR R14,sail_oldAnchor ;Re-instate this again
1940 B interp_exec ;Execute next instruction
1949 MOV R0,#cFrame__proc ;Search for a PROC frame
1950 BL ctrl__unwind ;Look for one of these then
1951 MOVCC R0,#err_notInProc ;Get possible error num
1952 BCC error_report ;And report the error
1954 LDR R0,[R1,#cProc__stracc] ;Load the offset
1955 BL stracc_free ;Okaydokey
1957 LDMIA R1,{R0,R1} ;Load the line and offset
1958 STR R1,sail_line ;Save the line counter
1959 LDR R14,sail_tokAnchor ;Find the anchor of the file
1960 LDR R14,[R14] ;Pointless instruction
1961 ADD R10,R14,R0 ;Get the new offset
1962 SUB R10,R10,#1 ;Backtrac a little
1963 MOV R9,#-1 ;Give bogus current token
1964 BL getToken ;Read this token
1965 B interp_next ;And continue merrily
1980 ; --- Simply search for a newline! ---
1982 00 CMP R9,#10 ;Is this a newline?
1983 CMPNE R9,#&FF ;Or the EOF?
1984 BNE getToken ;No -- get another token
1985 BNE %b00 ;...get another one then
1986 B interp_next ;And carry on as before
1995 ; --- We read lots of lvalues, and create local frames ---
1997 00 MOV R0,#cFrame__local ;We want a local frame
1998 BL ctrl__pushFrame ;Create the frame then
1999 MOV R5,R0 ;Look after the address
2000 MOV R0,#1 ;Read an lvalue
2001 BL express_read ;Go to it then
2002 BL express_pop ;Pop it off
2003 BL ctrl_load ;Load its value out
2004 STMIA R5,{R0-R3} ;Store this in the frame
2006 CMP R9,#',' ;Do we have a comma now?
2007 BLEQ getToken ;Yes -- gobble it up
2008 BEQ %b00 ;...and do another one
2010 B interp_next ;Do the next instruction
2014 ; --- ctrl__subArgs ---
2016 ; On entry: R0 == type of routine to find
2018 ; On exit: R3 == offset of return point
2019 ; R4 == line number of return point
2020 ; R0-R2, R5 corrupted
2022 ; Use: Performs argument substitution. The next token to read
2023 ; should be the name of the routine to execute. On exit,
2024 ; the interpreter will begin execution of the routine.
2028 ; --- A nasty macro ---
2030 ; Swap between the two states
2034 LDR R0,sail_oldAnchor
2039 LDR R0,sail_currAnchor
2051 LDR R0,sail_currAnchor
2056 LDR R0,sail_oldAnchor
2066 ; --- Now get on with it ---
2068 ; We're calling express_read during the first part of this,
2069 ; so we don't have the luxury of a stack...
2071 MOV R5,R14 ;Remember the return address
2073 ; --- First, get the PROC/FN name ---
2075 ADR R2,sail_misc ;Point to a nice buffer
2076 SUBS R14,R9,#'_' ;Is it a valid characer?
2083 MOVCS R0,#err_badCall ;No -- get error then
2084 BCS error_report ;And report it
2085 STRB R9,[R2],#1 ;And store in the buffer
2087 00 BL getToken ;Get the next character
2088 SUBS R14,R9,#'_' ;Is it a valid characer?
2095 STRCCB R9,[R2],#1 ;Yes -- store in the buffer
2096 BCC %b00 ;...and keep on looping
2101 ; --- Now find the PROC/FN ---
2103 ADR R1,sail_misc ;Point to the name
2104 BL tree_find ;Try to find the thing
2105 MOVCC R0,#err_noProc ;Not there -- complain
2107 LDMIB R0,{R3,R4} ;Load out address/line
2108 ADD R3,R3,#1 ;Skip past the proc
2110 ; --- First, see if we have an open banana ---
2112 SUBS R1,R9,#'(' ;Do we have actual arguments?
2113 BLEQ getToken ;Yes -- gobble the bracket
2114 MOVNE R1,#1 ;No -- remember this then
2115 READDEF ;Swap to the def
2116 SUBS R2,R9,#'(' ;Do we have formal args?
2117 BLEQ getToken ;Yes -- gobble the bracket
2118 MOVNE R2,#1 ;No -- remember this then
2119 CMP R1,R2 ;Are both the same?
2120 MOVNE R0,#err_badArgs ;No -- get an error
2121 BNE error_report ;So report it then
2122 CMP R1,#0 ;Any arguments?
2123 BNE %90ctrl__subArgs ;No -- just tidy up then
2125 MOV R2,#0 ;No arguments read yet
2127 ; --- Stage 1: Read actual and formal arguments ---
2129 ; Here we will build 3 records on the val stack for each
2132 ; If argument is RETURN, lvalue of actual arg, else 0
2133 ; rvalue of actual arg (read to avoid aliassing problems)
2134 ; lvalue of formal arg
2136 10ctrl__subArgs CMP R9,#tok_return ;Is this a RETURN token?
2137 BLEQ getToken ;If so, gobble it
2138 READARG ;Swap back to the call
2139 BNE %f00 ;No -- skip to read rvalue
2141 ; --- Read lvalue for actual arg ---
2143 MOV R0,#1 ;Read the lvalue here
2144 BL express_read ;Read that please
2145 STMFD R13!,{R2,R3} ;Save some registers
2146 BL express_pop ;Pop the lvalue
2147 BL ctrl_load ;Load the rvalue out
2148 BL express_push ;Push the lvalue back
2149 MOV R0,R2 ;Get the rvalue now
2150 MOV R1,R3 ;And its type, please
2151 BL express_push ;Push that too
2152 LDMFD R13!,{R2,R3} ;Restore my registers
2153 B %f01 ;Now skip to handling formal
2155 ; --- Read rvalue for actual arg ---
2157 00 MOV R1,#-1 ;Mark a strange lvalue type
2158 BL express_push ;Push that on
2159 MOV R0,#0 ;Read an rvalue
2160 BL express_read ;Do that then
2162 ; --- Now swap and read the formal argument ---
2164 01 ADD R2,R2,#1 ;Bump argument counter
2165 CMP R9,#')' ;Is this a close bracket?
2166 CMPNE R9,#',' ;Or maybe a comma?
2167 MOVNE R0,#err_badCall ;No -- that's an error
2168 BNE error_report ;So complain about it
2169 MOV R1,R9 ;Look after this token
2170 BL getToken ;Gobble the token
2172 READDEF ;Swap back to the DEF
2173 MOV R0,#1 ;Read an lvalue now
2174 BL express_read ;Read the expression
2176 CMP R9,#')' ;Is this a close bracket?
2177 CMPNE R9,#',' ;Or maybe a comma?
2178 MOVNE R0,#err_expBracket ;No -- error (odd BASIC one)
2179 BNE error_report ;So complain about it
2181 CMP R1,R9 ;Do these match?
2182 MOVNE R0,#err_badArgs ;No -- someone can't count
2183 BNE error_report ;So report that
2184 CMP R9,#',' ;Is there more to come?
2185 BL getToken ;Get the next token
2186 BEQ %10ctrl__subArgs ;Yes -- read the rest then
2188 ; --- Stage 2: Bind arguments, and queue value/returns ---
2190 ; Here, we build the LOCAL frames for the arguments, and
2191 ; store the actual arguments into the formal ones. We also
2192 ; remember which ones are value/return so we can sort them
2193 ; out later. Fortunately we've now done all the messing
2194 ; about with express_read that we need to, so we can stack
2195 ; registers and seriously get down to business...
2197 STMFD R13!,{R0-R10} ;Save loads of registers
2198 MOV R10,R2 ;Look after argument count
2199 MOV R9,#0 ;Counter of valret args
2201 ; --- First, build the LOCAL frame for formal arg ---
2203 00 MOV R0,#cFrame__local ;Create a local frame
2204 BL ctrl__pushFrame ;Push that on the stack
2205 MOV R4,R0 ;Look after the address
2206 BL express_pop ;Pop a formal arg lvalue
2207 BL ctrl_load ;Load the current value
2208 STMIA R4,{R0-R3} ;Save all that lot away
2210 ; --- Now read the rvalue and lvalue of actual arg ---
2212 MOV R4,R0 ;Look after this lvalue
2213 MOV R5,R1 ;Copy it away somewhere
2214 BL express_popTwo ;Pop the lvalue and rvalue
2215 CMP R1,#-1 ;Do we have an actual lvalue?
2216 STMNEFD R13!,{R0,R1,R4,R5} ;Yes -- stack that lot away
2217 ADDNE R9,R9,#1 ;And increment the counter
2218 MOV R0,R4 ;Put formal lvalue in R0,R1
2219 ORR R1,R5,#(1<<31) ;Don't remove strs from strc
2220 BL ctrl_store ;And bind the argument
2222 SUBS R10,R10,#1 ;Decrement arg counter
2223 BGT %b00 ;And loop till all done
2225 ; --- Stage 3: Finally deal with value/return args ---
2227 ; We have to create the value/return frames now. This is
2228 ; complicated by the need to prevent LOCAL from over-
2229 ; zealously restoring values. We transform any LOCAL frames
2230 ; which might do this into deadlocal ones, which won't.
2232 CMP R9,#0 ;Do I need to do any of this?
2233 BEQ %85ctrl__subArgs ;No -- go away then
2234 LDR R8,sail_execStkPtr ;Find ctrl stack pointer
2235 LDR R7,sail_execStack ;And find the anchor
2237 ; --- Check for matching LOCAL frame ---
2239 05 LDR R0,[R13,#0] ;Load the lvalue to match
2240 LDR R14,[R7,#0] ;Load the stack anchor
2241 ADD R14,R14,R8 ;And find the stack top
2242 00 LDR R1,[R14,#-4] ;Load the frame type
2243 CMP R1,#cFrame__local ;Is this a local frame?
2244 CMPNE R1,#cFrame__dead ;Or one we nobbled earlier?
2245 BNE %f00 ;No -- not there then
2247 LDR R1,[R14,#-20]! ;Load the lvalue from here
2248 CMP R1,R0 ;Do these match?
2249 BNE %b00 ;No -- keep looking then
2250 MOV R0,#cFrame__dead ;Nobble this frame
2251 STR R0,[R14,#16] ;Change the type to a dummy
2253 ; --- Now create a value/return frame ---
2255 00 MOV R0,#cFrame__return ;Get the frame type
2256 BL ctrl__pushFrame ;Push this frame
2257 LDMFD R13!,{R1-R4} ;Load the lvalues out
2258 STMIA R0,{R1-R4} ;Save that information away
2259 SUBS R9,R9,#1 ;One less of them to do
2260 BGT %b05 ;If any more to do, do them
2262 ; --- We're done here -- return to caller ---
2264 85 LDMFD R13!,{R0-R10} ;Restore registers
2265 90 MOVS PC,R5 ;And return (slurrrp)
2269 ; --- ctrl__unwind ---
2271 ; On entry: R0 == type of frame to find (PROC or FN)
2273 ; On exit: CS and R1 == address of frame found, else
2274 ; CC and R1 corrupted
2277 ; Use: Pops frames off the stack, until it finds a frame which
2278 ; matches the type specified. Looping constructs are ignored,
2279 ; and locals, deadlocals and return locals are all dealt with.
2280 ; It will stop at any other routine frame, and return CC.
2284 STMFD R13!,{R2-R6,R14} ;Stack registers
2285 MOV R4,R0 ;Look after the routine type
2286 MOV R5,#0 ;Number of return-frames now
2287 00 BL ctrl__popFrame ;Pop the frame off the stack
2288 CMP R0,#cFrame__routine ;Is it a routine frame?
2289 BLT %b00 ;Nope -- keep on looking then
2291 ; --- Now pop off routine frames ---
2293 CMP R0,R4 ;Have we found it?
2294 BEQ %90ctrl__unwind ;Yes -- return success
2296 CMP R0,#cFrame__local ;Is this a local frame?
2297 BNE %10ctrl__unwind ;No -- jump ahead
2299 ; --- Deal with local frames ---
2301 LDMIA R1,{R0-R3} ;Load lvalue/rvalue
2302 ORR R1,R1,#(1<<31) ;Don't remove strings
2303 BL ctrl_store ;Put it back to how it was
2304 B %b00 ;And go round for more
2306 ; --- Check for dead frame ---
2308 10 CMP R0,#cFrame__dead ;Is this frame dead?
2309 BEQ %b00 ;Yes -- ignore it then
2311 15 CMP R0,#cFrame__return ;A return frame?
2312 BNE %95ctrl__unwind ;Nope -- return CC then
2314 ; --- We have a return frame ---
2316 MOV R6,R1 ;Look after frame address
2317 ADD R1,R1,#8 ;Point to formal lvalue
2318 LDMIA R1,{R0,R1} ;Load that out
2319 BL ctrl_load ;Get its value
2320 LDMIA R6,{R0,R1} ;Load destination lvalue
2321 STMFD R13!,{R0-R3} ;Store on the R13 stack
2322 ADD R5,R5,#1 ;Increment number so far
2323 B %b00 ;Yes -- ignore it then
2325 ; --- We found what we were looking for ---
2327 ; Resolve all the value return types ---
2329 90 MOV R6,R1 ;Look after frame address
2330 CMP R5,#0 ;And value returns on stack?
2331 00 LDMNEFD R13!,{R0-R3} ;Load lvalue/rvalue
2332 BLNE ctrl_store ;Store the value away
2333 SUBNES R5,R5,#1 ;Decrement the counter
2334 BNE %b00 ;And do this for all
2336 MOV R1,R6 ;Put address in R1
2337 LDMFD R13!,{R2-R6,R14} ;Load registers
2338 ORRS PC,R14,#C_flag ;Return success then
2340 ; --- We didn't find it :-( ---
2342 95 LDMFD R13!,{R2-R6,R14} ;Load registers
2343 BICS PC,R14,#C_flag ;Return failure
2347 ;----- String manipulation --------------------------------------------------
2349 ; --- ctrl__alterStr ---
2351 ; On entry: R2 == rvalue of string to change
2352 ; R3 == index to copy into
2353 ; R4 == number of chars to copy
2354 ; R5 = rvalue of string to copy from
2360 STMFD R13!,{R0-R5,R14} ;Save some registers
2361 MOV R0,R5 ;Remeber rvalue of string 2
2362 LDR R14,sail_stracc ;Get the stracc address
2364 ADD R2,R14,R2,LSR #8 ;Point to the string
2365 ADD R2,R2,R3 ;Point into the string
2366 ADD R5,R14,R5,LSR #8 ;Point to second string
2368 CMP R4,#0 ;Anything to copy?
2369 00 LDRGTB R14,[R5],#1 ;Load a byte
2370 STRGTB R14,[R2],#1 ;Store it again
2371 SUBS R4,R4,#1 ;Reduce the counter
2372 BGT %b00 ;And keep on going
2374 MOV R1,#vType_string ;R0 is a string
2375 BL stracc_free ;We don't need it now
2376 LDMFD R13!,{R0-R5,PC}^ ;Return to caller
2378 ; --- ctrl_leftS ---
2383 ; --- First, read the string variable ---
2385 MOV R0,#1 ;Read an lvalue
2386 BL express_read ;Read it then
2387 BL express_pop ;Get the lvalue
2388 BL ctrl_load ;Load the string into stracc
2389 CMP R3,#vType_string ;Make sure we have a string
2390 BNE ctrl__notAString ;And report the error
2391 AND R6,R2,#&FF ;Get the length too
2392 STMFD R13!,{R0,R1} ;Remember the lvalue
2394 ; --- We need a comma now ---
2396 CMP R9,#',' ;We need a comma now
2397 MOVNE R0,#err_expComma ;If it isn't, moan
2399 BL getToken ;Skip past the comma
2401 ; --- Read the number of characters ---
2403 MOV R1,#0 ;Read an rvalue
2404 BL express_read ;Read it then
2405 BL express_pop ;Pop off the value
2406 CMP R1,#vType_integer ;Is it an integer?
2407 BNE ctrl__notAnInt ;No -- barf then
2408 CMP R0,R6 ;Reading too many?
2409 MOVLE R4,R0 ;Put the number in R4
2410 MOVGT R4,R6 ;Put it in range
2411 MOV R3,#0 ;The index is 0
2413 ; --- Look for ')=' now ---
2415 CMP R9,#')' ;We need a ')' now
2416 MOVNE R0,#err_expBracket ;If it isn't, moan
2418 BL getToken ;Skip past the comma
2419 CMP R9,#'=' ;We need a '=' now
2420 MOVNE R0,#err_expEq ;If it isn't, moan
2422 BL getToken ;Skip past the comma
2424 ; --- Now we need a replacement string ---
2426 MOV R0,#0 ;Read another rvalue
2427 BL express_read ;Read it then
2428 BL express_pop ;Pop off the value
2429 CMP R1,#vType_string ;Is it a string?
2430 BNE ctrl__notAString ;And report the error
2431 MOV R5,R0 ;Put the rvalue in R5
2432 AND R6,R0,#&FF ;Get the length of that one
2433 CMP R4,R6 ;Only copy enough
2434 MOVGT R4,R6 ;To save embarrassment
2436 BL ctrl__alterStr ;Do the string transform
2437 MOV R3,#vType_string ;It is a string
2438 LDMFD R13!,{R0,R1} ;Get the lvalue back
2439 BL ctrl_store ;Store back the new string
2441 B interp_next ;Do the next instruction
2450 ; --- First, read the string variable ---
2452 MOV R0,#1 ;Read an lvalue
2453 BL express_read ;Read it then
2454 BL express_pop ;Get the lvalue
2455 BL ctrl_load ;Load the string into stracc
2456 CMP R3,#vType_string ;Make sure we have a string
2457 BNE ctrl__notAString ;And report the error
2458 AND R6,R2,#&FF ;Get the length too
2459 STMFD R13!,{R0,R1} ;Remember the lvalue
2461 ; --- We need a comma now ---
2463 CMP R9,#',' ;We need a comma now
2464 MOVNE R0,#err_expComma ;If it isn't, moan
2466 BL getToken ;Skip past the comma
2468 ; --- Read the index ---
2470 MOV R1,#0 ;Read an rvalue
2471 BL express_read ;Read it then
2472 BL express_pop ;Pop off the value
2473 CMP R1,#vType_integer ;Is it an integer?
2474 BNE ctrl__notAnInt ;No -- barf then
2475 SUBS R3,R0,#1 ;Put it in R4
2476 MOVLE R3,#0 ;Put it in range
2477 CMP R3,R6 ;Is the index too high?
2478 MOVGT R3,R6 ;Put it in range
2479 SUB R4,R6,R3 ;Get max to read
2481 ; --- We may have a comma now ---
2483 CMP R9,#',' ;We need a comma now
2484 BNE %10ctrl_midS ;And jump ahead
2486 ; --- Read the number of characters ---
2488 BL getToken ;Skip past the comma
2489 MOV R1,#0 ;Read an rvalue
2490 BL express_read ;Read it then
2491 BL express_pop ;Pop off the value
2492 CMP R1,#vType_integer ;Is it an integer?
2493 BNE ctrl__notAnInt ;No -- barf then
2494 CMP R0,R4 ;Is the index too high?
2495 MOVLE R4,R0 ;Put the number in R4
2496 CMP R4,#0 ;Not below 0 either
2499 ; --- Look for ')=' now ---
2501 10ctrl_midS CMP R9,#')' ;We need a ')' now
2502 MOVNE R0,#err_expBracket ;If it isn't, moan
2504 BL getToken ;Skip past the comma
2505 CMP R9,#'=' ;We need a '=' now
2506 MOVNE R0,#err_expEq ;If it isn't, moan
2508 BL getToken ;Skip past the comma
2510 ; --- Now we need a replacement string ---
2512 MOV R0,#0 ;Read another rvalue
2513 BL express_read ;Read it then
2514 BL express_pop ;Pop off the value
2515 CMP R1,#vType_string ;Is it a string?
2516 BNE ctrl__notAString ;And report the error
2517 MOV R5,R0 ;Put the rvalue in R5
2518 AND R6,R0,#&FF ;Get the length of that one
2519 CMP R4,R6 ;Only copy enough
2520 MOVGT R4,R6 ;To save embarrassment
2522 BL ctrl__alterStr ;Do the string transform
2523 MOV R3,#vType_string ;It is a string
2524 LDMFD R13!,{R0,R1} ;Get the lvalue back
2525 BL ctrl_store ;Store back the new string
2527 B interp_next ;Do the next instruction
2531 ; --- ctrl_rightS ---
2536 ; --- First, read the string variable ---
2538 MOV R0,#1 ;Read an lvalue
2539 BL express_read ;Read it then
2540 BL express_pop ;Get the lvalue
2541 BL ctrl_load ;Load the string into stracc
2542 CMP R3,#vType_string ;Make sure we have a string
2543 BNE ctrl__notAString ;And report the error
2544 AND R6,R2,#&FF ;Get the length too
2545 STMFD R13!,{R0,R1} ;Remember the lvalue
2547 ; --- We need a comma now ---
2549 CMP R9,#',' ;We need a comma now
2550 MOVNE R0,#err_expComma ;If it isn't, moan
2552 BL getToken ;Skip past the comma
2554 ; --- Read the number of characters ---
2556 MOV R1,#0 ;Read an rvalue
2557 BL express_read ;Read it then
2558 BL express_pop ;Pop off the value
2559 CMP R1,#vType_integer ;Is it an integer?
2560 BNE ctrl__notAnInt ;No -- barf then
2561 CMP R0,R6 ;Reading too many?
2562 MOVLE R4,R0 ;Put the number in R4
2563 MOVGT R4,R6 ;Put it in range
2564 SUBS R3,R6,R4 ;Work out the index
2566 ; --- Look for ')=' now ---
2568 CMP R9,#')' ;We need a ')' now
2569 MOVNE R0,#err_expBracket ;If it isn't, moan
2571 BL getToken ;Skip past the comma
2572 CMP R9,#'=' ;We need a '=' now
2573 MOVNE R0,#err_expEq ;If it isn't, moan
2575 BL getToken ;Skip past the comma
2577 ; --- Now we need a replacement string ---
2579 MOV R0,#0 ;Read another rvalue
2580 BL express_read ;Read it then
2581 BL express_pop ;Pop off the value
2582 CMP R1,#vType_string ;Is it a string?
2583 BNE ctrl__notAString ;And report the error
2584 MOV R5,R0 ;Put the rvalue in R5
2585 AND R0,R0,#&FF ;Get the length of that one
2586 CMP R4,R0 ;Only copy enough
2587 MOVGT R4,R0 ;To save embarrassment
2590 BL ctrl__alterStr ;Do the string transform
2591 MOV R3,#vType_string ;It is a string
2592 LDMFD R13!,{R0,R1} ;Get the lvalue back
2593 BL ctrl_store ;Store back the new string
2595 B interp_next ;Do the next instruction
2599 ;----- Arrays ---------------------------------------------------------------
2606 ; --- Stash current position ---
2608 LDR R6,sail_line ;Find the current line
2609 STMFD R13!,{R6-R10} ;Save current position info
2611 ; --- Now try reading an identifier ---
2613 ADR R1,sail_misc ;Point to a buffer
2614 MOV R2,#vType_dimInt ;Currently it's an int array
2616 SUBS R14,R9,#'_' ;Allow strange ident chars
2617 SUBNE R14,R9,#'A' ;Check for uppercase letters
2618 CMP R14,#26 ;In range?
2619 SUBCS R14,R9,#'a' ;Check for lowercase letters
2620 CMPCS R14,#26 ;In range?
2621 MOVCS R0,#err_badDim ;No -- get an error
2622 BCS error_report ;And kill the program
2624 00 STRB R9,[R1],#1 ;Store the character away
2625 BL getToken ;Get another token
2626 SUBS R14,R9,#'_' ;Allow strange ident chars
2627 SUBNE R14,R9,#'A' ;Check for uppercase letters
2628 CMP R14,#26 ;In range?
2629 SUBCS R14,R9,#'a' ;Check for lowercase letters
2630 CMPCS R14,#26 ;In range?
2631 SUBCS R14,R9,#'0' ;Check for digits too now
2632 CMPCS R14,#10 ;In range?
2633 BCC %b00 ;We're OK here -- loop
2635 ; --- Found something which stopped us ---
2637 CMP R9,#'$' ;Is it a dollar sign?
2638 MOVEQ R2,#vType_dimStr ;It's a string array now
2639 CMPNE R9,#'%' ;Or a percentage?
2640 STREQB R9,[R1],#1 ;Yes -- store it then
2641 CMPNE R9,#' ' ;Just check for a space
2642 BLEQ getToken ;Valid terminator -- get tok
2644 ; --- Now see if this is an array ---
2646 CMP R9,#'(' ;Defining an array here?
2647 BNE %50ctrl_dim ;No -- allocate a block then
2648 ADD R13,R13,#20 ;Lose positioning info
2649 MOV R14,#0 ;Terminate the identifier
2650 STRB R14,[R1],#1 ;Store zero on the end
2651 BL getToken ;Get the next token
2653 ; --- Ensure that the name isn't already used ---
2655 MOV R0,R2 ;Get the array type
2656 ADR R1,sail_misc ;Point to the name
2657 BL tree_find ;Is it there already?
2658 MOVCS R0,#err_reDim ;Yes -- moan then
2659 BCS error_report ;And kill things off
2661 ; --- Stuff the string on stracc ---
2663 BL stracc_ensure ;Make enough space for it
2664 ADR R3,sail_misc ;Point to the misc buffer
2665 00 LDRB R14,[R3],#1 ;Load the byte out
2666 STRB R14,[R0],#1 ;Store in the buffer
2667 ADD R1,R1,#1 ;And increment the length
2668 CMP R14,#0 ;Finished yet?
2669 BNE %b00 ;No -- then loop round
2670 MOV R0,R1 ;Get the rvalue I made
2671 BL stracc_added ;I've added this string
2672 MOV R5,R1 ;Look after this value
2674 ; --- Now read the subscripts ---
2676 ; We use the stack to keep track of them all. This is
2677 ; fairly crufty, but I don't care.
2679 MOV R3,#0 ;No subscripts so far
2680 MOV R4,#1 ;Number of items we need
2681 00 MOV R0,#0 ;Read an rvalue
2682 BL express_read ;Evaluate an expression
2683 BL express_pop ;Pop the rvalue
2684 CMP R1,#vType_integer ;Ensure it's an integer
2685 MOVNE R0,#err_numNeeded ;No -- moan then
2686 BNE error_report ;And stop the program
2687 ADD R0,R0,#1 ;BASIC subscripts are odd
2688 STMFD R13!,{R0} ;Stash the subscript
2689 ADD R3,R3,#1 ;Increment the counter
2690 MUL R4,R0,R4 ;Update the size we nee
2691 CMP R9,#',' ;Is this a comma?
2692 BLEQ getToken ;Yes -- get a token
2693 BEQ %b00 ;And read another subscript
2694 CMP R9,#')' ;Well, this must be next
2695 MOVNE R0,#err_dimKet ;No -- well, get an error
2696 BNE error_report ;And die horridly
2697 BL getToken ;Get another token
2699 ; --- We now have the subscripts on the stack ---
2701 LDR R14,sail_stracc ;Find the stracc anchor
2702 LDR R14,[R14] ;Bop WimpExtension for fun
2703 ADD R1,R14,R5,LSR #8 ;Find the name base
2704 MOV R0,R2 ;Get the variable type
2705 MOV R2,R13 ;Point to subscripts
2706 BL var_create ;Create the array
2707 MOV R0,R5 ;Get the rvalue again
2708 BL stracc_free ;And release the memory
2709 ADD R13,R13,R3,LSL #2 ;Restore the stack pointer
2710 B %80ctrl_dim ;And possibly go round again
2712 ; --- Allocate a block of memory ---
2714 50ctrl_dim LDMFD R13!,{R6-R10} ;Restore positioning info
2715 STR R6,sail_line ;Restore the line number
2716 MOV R0,#1 ;Read an lvalue
2717 BL express_read ;Read that then
2718 MOV R0,#0 ;Read an rvalue
2719 BL express_read ;And read that too
2720 BL express_pop ;Get the block size
2721 CMP R1,#vType_integer ;Ensure it's an integer
2722 MOVNE R0,#err_numNeeded ;No -- get the error then
2723 BNE error_report ;And moan at the user
2724 ADD R3,R0,#8 ;Add a link word, 1 byte and
2725 BIC R3,R3,#3 ;...word align too
2726 MOV R0,#6 ;Claim some memory
2727 SWI XOS_Module ;From the RMA (bletch)
2728 MOVVS R0,#err_noMem ;If it failed assume no mem
2729 BVS error_report ;So deal appropriately
2730 LDR R14,sail_rmaList ;Load RMA list head
2731 STR R2,sail_rmaList ;Store this block in there
2732 STR R14,[R2],#4 ;Stuff the old link away
2733 BL express_pop ;Pop the lvalue
2734 MOV R3,#vType_integer ;Pointer is an integer
2735 BL ctrl_store ;Store it away
2737 ; --- Do more DIMs if wee need to ---
2739 80ctrl_dim CMP R9,#',' ;Is there a comma now?
2740 BLEQ getToken ;Yes -- get the next token
2741 BEQ ctrl_dim ;Yes -- do another dim then
2743 B interp_next ;Do another instruction
2747 ;----- Other useful routines ------------------------------------------------
2749 ; --- ctrl_copyString ---
2751 ; On entry: R0 == buffer to copy string to
2752 ; R1 == point to the string
2753 ; R2 == length of string to copy
2757 ; Use: Copies the string into the buffer.
2759 EXPORT ctrl_copyString
2760 ctrl_copyString ROUT
2762 STMFD R13!,{R0-R2,R14} ;Stack registers
2763 CMP R2,#0 ;Is this a short string?
2764 00 LDRGTB R14,[R1],#1 ;Load a character
2765 STRGTB R14,[R0],#1 ;And then store it
2766 SUBS R2,R2,#1 ;Reduce the count
2767 BGT %b00 ;And keep on goin'
2768 MOV R14,#0 ;Get a terminator
2769 STRB R14,[R0],#1 ;Store the byte and return
2770 LDMFD R13!,{R0-R2,PC}^ ;Return to caller
2774 ; --- ctrl__notAnInt ---
2780 ; Use: Moans because something isn't an integer.
2784 MOV R0,#err_numNeeded
2789 ; --- ctrl__notAString ---
2795 ; Use: Moans because something isn't a string.
2797 ctrl__notAString ROUT
2799 MOV R0,#err_strNeeded
2804 ; --- ctrl__findFrame ---
2806 ; On entry: R0 == frame type
2808 ; On exit: R0 == frame type we stopped at
2809 ; R1 == pointer to base of frame
2810 ; CS if frame type matched, else CC
2812 ; Use: Finds a frame with the given type. It pops frames from the
2813 ; exec stack until it finds either a frame which matches the
2814 ; type in R0 or a routine frame. The frame which stopped the
2815 ; loop is *not* popped.
2817 ctrl__findFrame ROUT
2819 ORR R14,R14,#C_flag ;Assume a match -- be happy
2820 STMFD R13!,{R2,R14} ;Save some registers
2821 MOV R2,R0 ;Look after the frame type
2822 10 BL ctrl__peekFrame ;Look at the top frame
2823 CMP R0,R2 ;Is this a match?
2824 LDMEQFD R13!,{R2,PC}^ ;Yes -- unstack and return
2825 CMP R0,#cFrame__routine ;Is this a routine frame?
2826 BLCC ctrl__popFrame ;No -- remove it then
2827 BCC %10ctrl__findFrame ;And keep on going
2828 LDMFD R13!,{R2,R14} ;Unstack registers
2829 BICS PC,R14,#C_flag ;And return with C clear
2833 ; --- ctrl_store ---
2835 ; On entry: R0,R1 == lvalue to store in
2836 ; R2,R3 == rvalue to write
2838 ; If bit 31 of R1 is set, then for strings only, the old
2839 ; string is NOT removed from the stracc. This is
2840 ; so that variables can be restored after a procedure.
2844 ; Use: Stores an rvalue into an lvalue.
2849 ; --- First, see what we're storing in ---
2851 STMFD R13!,{R14} ;Save a register
2852 BIC R14,R1,#(1<<31) ;Clear the weird bit
2853 SUB R14,R14,#vType_lvInt ;Get the lvalue index thing
2854 CMP R14,#vType_lvStrArr-vType_lvInt+1
2855 ADDCC PC,PC,R14,LSL #2 ;It's OK, dispatch then
2856 B %00ctrl_store ;Righty ho, on we go
2858 B ctrl__strInt ;Store in an integer var
2859 B ctrl__strStr ;Store in a string var
2860 B ctrl__strWord ;Store in a memory word
2861 B ctrl__strByte ;Store in a memory byte
2862 B ctrl__strBytes ;Store in a memory string
2863 B ctrl__strIntArr ;Store in a whole int array
2864 B ctrl__strStrArr ;Store in a whole str array
2866 00ctrl_store MOV R0,#err_erk ;This should never happen...
2867 B error_report ;Since we always get lvalues
2869 ; --- Store in an integer variable ---
2871 ctrl__strInt CMP R3,#vType_integer ;Make sure we're storing int
2872 LDREQ R14,sail_varTree ;Find the tree base
2873 LDREQ R14,[R14] ;Why is WimpExt so odd?
2874 STREQ R2,[R14,R0] ;Store the value in node
2875 LDMEQFD R13!,{PC}^ ;And return to caller
2878 ; --- Store in a memory word somewhere ---
2880 ctrl__strWord CMP R3,#vType_integer ;Make sure we're storing int
2881 STREQ R2,[R0,#0] ;Save the word away
2882 LDMEQFD R13!,{PC}^ ;And return to caller
2885 ; --- Store in a byte somewhere ---
2887 ctrl__strByte CMP R3,#vType_integer ;Make sure we're storing int
2888 STREQB R2,[R0,#0] ;Save the byte away
2889 LDMEQFD R13!,{PC}^ ;And return to caller
2892 ; --- Store in a string variable ---
2894 ctrl__strStr CMP R3,#vType_string ;Make sure we've got a string
2895 BNE ctrl__notAString ;No -- complain then
2897 ; --- Now do some messing about ---
2899 STMFD R13!,{R0-R5} ;Store some registers
2900 MOV R5,R1 ;Look after our flag bit
2902 LDR R4,sail_varTree ;Find the tree base
2903 LDR R4,[R4] ;Who designed this heap?
2904 ADD R4,R4,R0 ;Work out the node address
2905 LDR R0,[R4,#0] ;Load the old string offset
2906 BL strBucket_free ;Don't want it any more
2908 AND R0,R2,#&FF ;Get the string's length
2909 BL strBucket_alloc ;Get a new string entry
2910 STR R1,[R4,#0] ;Tuck that away nicely
2912 LDR R4,sail_stracc ;Find string accumulator
2913 LDR R4,[R4] ;It must be one of those days
2914 ADD R4,R4,R2,LSR #8 ;Work out string address
2915 ANDS R3,R2,#&FF ;Get the length
2916 00 LDRNEB R14,[R4],#1 ;Load a string byte
2917 STRNEB R14,[R0],#1 ;Save it in the bucket
2918 SUBNES R3,R3,#1 ;Decrement the length count
2919 BNE %b00 ;And loop back again
2921 TST R5,#(1<<31) ;Do we remove from bucket?
2922 MOV R0,R2 ;Get the offset
2923 BLEQ stracc_free ;Free it nicely
2925 LDMFD R13!,{R0-R5,PC}^ ;And return to caller
2929 ; --- Store a string in memory ---
2931 ctrl__strBytes CMP R3,#vType_string ;Make sure we've got a string
2932 BNE ctrl__notAString ;No -- complain then
2934 STMFD R13!,{R0-R4} ;Store some registers
2935 LDR R4,sail_stracc ;Find string accumulator
2936 LDR R4,[R4] ;It must be one of those days
2937 ADD R4,R4,R2,LSR #8 ;Work out string address
2938 ANDS R3,R2,#&FF ;Get the length
2939 00 LDRNEB R14,[R4],#1 ;Load a string byte
2940 STRNEB R14,[R0],#1 ;Save it in the bucket
2941 SUBNES R3,R3,#1 ;Decrement the length count
2942 BNE %b00 ;And loop back again
2943 MOV R14,#13 ;Get the terminator
2944 STRB R14,[R0],#1 ;And store that too
2946 TST R1,#(1<<31) ;Do we remove from bucket?
2947 MOV R0,R2 ;Put offset in R1
2948 BLEQ stracc_free ;Free it nicely
2949 LDMFD R13!,{R0-R4,PC}^ ;Return to caller
2956 MOV R0,#err_arrayBad ;Point to the error message
2957 B error_report ;And report the message
2961 ; On entry: R0,R1 == lvalue to read
2963 ; On exit: R2,R3 == rvalue read from lvalue
2965 ; Use: Loads the current value of the given lvalue.
2970 ; --- First, see what we're storing in ---
2972 SUB R2,R1,#vType_lvInt ;Get the lvalue index thing
2973 CMP R2,#vType_lvStrArr-vType_lvInt+1
2974 ADDCC PC,PC,R2,LSL #2 ;It's OK, dispatch then
2975 B %00ctrl_load ;Righty ho, on we go
2977 B ctrl__ldInt ;Store in an integer var
2978 B ctrl__ldStr ;Store in a string var
2979 B ctrl__ldWord ;Store in a memory word
2980 B ctrl__ldByte ;Store in a memory byte
2981 B ctrl__ldBytes ;Store in a memory string
2982 B ctrl__ldIntArr ;Store in a whole int array
2983 B ctrl__ldStrArr ;Store in a whole str array
2985 00ctrl_load MOV R0,#err_erk ;This should never happen...
2986 B error_report ;Since we always get lvalues
2988 ; --- Load an integer variable ---
2990 ctrl__ldInt MOV R3,#vType_integer ;We're loading an integer
2991 LDR R2,sail_varTree ;Find the tree base
2992 LDR R2,[R2] ;Why is WimpExt so odd?
2993 LDR R2,[R2,R0] ;Load the value out
2994 MOVS PC,R14 ;Return to caller
2996 ; --- Load from a memory word somewhere ---
2998 ctrl__ldWord MOV R3,#vType_integer ;We're loading an integer
2999 LDR R2,[R0,#0] ;Load the word
3000 MOVS PC,R14 ;And return to caller
3002 ; --- Load from a byte somewhere ---
3004 ctrl__ldByte MOV R3,#vType_integer ;We're loading an integer
3005 LDRB R2,[R0,#0] ;Load the byte
3006 MOVS PC,R14 ;And return to caller
3008 ; --- Load a string into stracc ---
3010 ctrl__ldStr STMFD R13!,{R0,R1,R4,R14} ;Save some registers
3012 LDR R14,sail_varTree ;Find the variable tree
3013 LDR R14,[R14] ;Irate? Me?
3014 ADD R3,R14,R0 ;Find the actual node
3015 BL stracc_ensure ;Make sure there's enough
3017 LDR R3,[R3,#0] ;Find the bucket entry
3018 CMP R3,#0 ;Is there a string here
3019 MOVEQ R2,R1 ;Yes -- return 0 length
3020 BEQ %f10 ;...and branch ahead
3021 LDR R14,sail_bucket ;Find the bucket anchor
3022 LDR R14,[R14] ;I hate this! I hate it!
3023 ADD R3,R14,R3 ;Find the actual string
3025 LDRB R4,[R3,#-1] ;Load the string length
3026 ORR R2,R4,R1 ;Build the rvalue ready
3028 00 LDRB R14,[R3],#1 ;Load a byte from string
3029 STRB R14,[R0],#1 ;And store byte in stracc
3030 SUBS R4,R4,#1 ;Decrement the length
3033 10 MOV R3,#vType_string ;This is a string
3034 MOV R0,R2 ;Damn -- we need it in R0,R1
3035 BL stracc_added ;Tell stracc about string
3036 LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
3038 ; --- Load a string from memory ---
3040 ctrl__ldBytes STMFD R13!,{R0,R1,R4,R14} ;Save some registers
3042 MOV R3,R0 ;Remember string pointer
3043 BL stracc_ensure ;Make sure there's enough
3045 MOV R4,#0 ;Make the length 0
3046 00 LDRB R14,[R3],#1 ;Load a byte from string
3047 CMP R14,#13 ;Is it the terminator
3048 BEQ %f10 ;Yes -- jump ahead
3049 STRB R14,[R0],#1 ;And store byte in stracc
3050 ADD R4,R4,#1 ;Decrement the length
3051 CMP R4,#255 ;Are we at the limit
3052 BLT %b00 ;No -- go round for more
3054 10 MOV R3,#vType_string ;This is a string
3055 ORR R2,R1,R4 ;Get the rvalue
3056 MOV R0,R2 ;Damn -- we need it in R0,R1
3057 BL stracc_added ;Tell stracc about string
3058 LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
3064 MOV R0,#err_arrayBad ;Get the error number
3065 B error_report ;And report the error
3067 ; --- ctrl_compare ---
3069 ; On entry: R0,R1 == thing to compare
3070 ; R2,R3 == thing to compare the other thing with
3072 ; On exit: The flags indicate the result of the comparison
3074 ; Use: Compares two things. Note that R3 contains the dominant
3075 ; type. If it is comparing strings, the string in R0,R1
3076 ; will be removed from stracc.
3081 CMP R3,#vType_integer ;Is it an integer?
3082 BNE %10ctrl_compare ;No -- jump ahead
3084 ; --- We are comparing integers ---
3086 CMP R1,#vType_integer ;Make sure we have an int
3087 BNE ctrl__notAnInt ;No -- barf then
3088 CMP R0,R2 ;Do the comparison
3089 MOV PC,R14 ;And return to caller
3091 ; --- Try to compare strings ---
3093 10ctrl_compare CMP R3,#vType_string ;Is it a string?
3094 MOVNE R0,#err_arrayBad ;No -- get the error number
3095 BNE error_report ;...and report the error
3096 CMP R1,#vType_string ;Make sure other is string
3097 MOVNE R0,#err_strNeeded ;Nope -- complain
3100 STMFD R13!,{R0-R5,R14} ;Stack some registers
3101 AND R1,R0,#&FF ;Get length of first string
3102 AND R3,R2,#&FF ;And of the second one
3103 CMP R3,R1 ;Find the lowest
3104 EORLT R1,R1,R3 ;And put lowest in R1
3107 MOVS R5,R1 ;How long is it?
3108 BEQ %50ctrl_compare ;0 length -- jump ahead
3110 LDR R4,sail_stracc ;Find string accumulator
3111 LDR R4,[R4] ;It must be one of those days
3112 ADD R2,R4,R2,LSR #8 ;of both strings
3113 ADD R0,R4,R0,LSR #8 ;Work out string address
3114 00 LDRB R14,[R0],#1 ;Load a string byte
3115 LDRB R4,[R2],#1 ;from both strings
3116 CMP R14,R4 ;Are they the same?
3117 BNE %19ctrl_compare ;Nope -- return failure
3118 SUBS R5,R5,#1 ;Decrement the length count
3119 BNE %b00 ;And loop back again
3120 CMP R1,R3 ;Compare lengths then
3122 19ctrl_compare LDR R0,[R13,#0] ;Load an rvalue
3123 BL stracc_free ;Free it then
3124 LDMFD R13!,{R0-R5,PC} ;Load back registers
3126 50ctrl_compare CMP R1,R3 ;Make another comaprison
3127 B %19ctrl_compare ;And return
3131 ;----- Stack frames ---------------------------------------------------------
3133 ; --- Frame types ---
3152 ; --- Frame formats ---
3220 ;----- That's all, folks ----------------------------------------------------
~mdw / ssr / blob