+;
+; ctrl.s
+;
+; Control flow handling
+;
+; © 1995 Straylight
+;
+
+;----- Standard header ------------------------------------------------------
+
+ GET libs:header
+ GET libs:swis
+
+ GET libs:stream
+
+;----- External dependencies ------------------------------------------------
+
+ GET sh.anchor
+ GET sh.divide
+ GET sh.errNum
+ GET sh.error
+ GET sh.express
+ GET sh.getToken
+ GET sh.interp
+ GET sh.mem
+ GET sh.stracc
+ GET sh.strBucket
+ GET sh.termite
+ GET sh.termscript
+ GET sh.tokens
+ GET sh.tree
+ GET sh.var
+
+;----- Main code ------------------------------------------------------------
+
+ AREA |TermScript$$Code|,CODE,READONLY
+
+;----- Execution stack handling ---------------------------------------------
+
+; --- ctrl__pushFrame ---
+;
+; On entry: R0 == type of frame to create
+;
+; On exit: R0 == address of frame data to fill in
+;
+; Use: Creates a new frame of the given type on the execution stack.
+
+ctrl__pushFrame ROUT
+
+ STMFD R13!,{R1-R5,R14} ;Save some registers
+ MOV R3,R0 ;Look after thing to push
+ ADR R14,ctrl__frSize ;Point to frame size table
+ LDRB R4,[R14,R3] ;Load the frame size
+ ADR R1,sail_execStack ;Point to some stack data
+ LDMIA R1,{R0-R2} ;Load it out
+
+ ADD R5,R1,R4 ;New used size
+ ADD R1,R5,#255 ;Align to next size thing
+ BIC R1,R1,#255 ;Finish the align
+ CMP R1,R2 ;Has it got too big?
+ BLGT mem_realloc ;Yes -- get more space then
+ STRGT R1,sail_execStkSize ;Store new size maybe
+ STR R5,sail_execStkPtr ;Store back new size
+ LDR R0,[R0] ;Point to the stack
+ ADD R0,R0,R5 ;Address to put next thing on
+ STR R3,[R0,#-4] ;Store the new frame type
+ SUB R0,R0,R4 ;And return frame base addr
+ LDMFD R13!,{R1-R5,PC}^ ;And return to caller
+
+ LTORG
+
+; --- ctrl__peekFrame ---
+;
+; On entry: --
+;
+; On exit: R0 == type of topmost frame
+; R1 == base address of frame
+;
+; Use: Returns the type of the topmost frame, so a routine can
+; work out if it needs to be removed.
+
+ctrl__peekFrame ROUT
+
+ STMFD R13!,{R14} ;Save a register
+ ADR R0,sail_execStack ;Point to stack info block
+ LDMIA R0,{R0,R1} ;Load anchor addr and sp
+ LDR R0,[R0] ;WimpExt_Heap's oddness again
+ ADD R14,R0,R1 ;Find top of the stack
+ LDR R0,[R14,#-4] ;Load the frame type
+ ADR R1,ctrl__frSize ;Find the frame size table
+ LDRB R1,[R1,R0] ;Load the size of this entry
+ SUB R1,R14,R1 ;Find base of this frame
+ LDMFD R13!,{PC}^ ;And return to caller
+
+ LTORG
+
+; --- ctrl__popFrame ---
+;
+; On entry: --
+;
+; On exit: R0 == frame type
+; R1 == base address of frame
+;
+; Use: Pops the top stack frame off the execution stack. A pointer
+; to the frame's data is returned; this data is *still on
+; the stack*, so be careful about pushing more on.
+
+ctrl__popFrame ROUT
+
+ STMFD R13!,{R2-R5,R14} ;Save some registers
+ ADR R1,sail_execStack ;Point to some stack data
+ LDMIA R1,{R0-R2} ;Load it out
+ LDR R14,[R0] ;Load the actual base address
+ ADD R14,R14,R1 ;Find the top of the stack
+ LDR R3,[R14,#-4] ;Load type of top frame
+ ADR R14,ctrl__frSize ;Point to frame size table
+ LDRB R5,[R14,R3] ;And get the frame size
+
+ SUB R4,R1,R5 ;The new size
+ ADD R1,R4,#255 ;Align up again
+ BIC R1,R1,#255 ;Aligned down
+ ADD R1,R1,#256 ;At more than we need
+ CMP R1,R2 ;Has this size changed?
+ BLLT mem_realloc ;Yes -- reduce memory reqs.
+ STRLT R1,sail_execStkSize ;Store new size maybe
+ STR R4,sail_execStkPtr ;Store back new size
+ LDR R0,[R0] ;Point to the stack
+ ADD R1,R0,R4 ;Find the frame base address
+ MOV R0,R3 ;And get the frame type
+ LDMFD R13!,{R2-R5,PC}^ ;And return to caller
+
+ LTORG
+
+ctrl__frSize DCB cFor__size+4
+ DCB cWhile__size+4
+ DCB cRepeat__size+4
+
+ DCB cGosub__size+4
+ DCB cLocal__size+4
+ DCB cReturn__size+4
+ DCB cProc__size+4
+ DCB cFn__size+4
+ DCB cDead__size+4
+
+;----- Command handlers -----------------------------------------------------
+
+; --- ctrl_let ---
+
+ EXPORT ctrl_let
+ctrl_let ROUT
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Leave that on the stack
+ CMP R9,#'=' ;Is this an assignment op?
+ BNE %10ctrl_let ;No -- maybe more complex
+ BL getToken ;Get another token
+ MOV R0,#0 ;Read a general expression
+ BL express_read ;Read that nicely
+
+ BL express_popTwo ;Pop two values off the stack
+ BL ctrl_store ;Stuff one into the other
+ B interp_next ;Move on to next instruction
+
+ ; --- Try other assignment ops then ---
+
+10 CMP R7,#tClass_assign ;Is it an assign op?
+ MOVNE R0,#err_mistake ;No -- that's a mistake
+ BNE error_report ;So complain at someone
+
+ ; --- Read the rvalue ---
+
+ MOV R6,R8 ;Look after the index
+ BL getToken ;Get another token
+ BL express_pop ;Pop off the lvalue
+ BL ctrl_load ;Load it's value
+ STMFD R13!,{R0,R1} ;Look after the lvalue
+ MOV R0,#0 ;Read a general expression
+ BL express_read ;Read that nicely
+ BL express_pop ;Pop the rvalue
+ MOV R4,R0 ;Look after rvalue
+ MOV R5,R1
+ LDMFD R13!,{R0,R1} ;Load the lvalue back
+
+ ADD PC,PC,R6,LSL #2 ;Jump to the right routine
+ DCB "TMA!"
+
+ B %20ctrl_let ;+=
+ B %30ctrl_let ;-=
+ B %40ctrl_let ;*=
+ B %50ctrl_let ;/=
+
+ ; --- The operations ---
+ ;
+ ; Addition.
+
+20 CMP R3,#vType_string
+ BEQ %25ctrl_let
+ CMP R3,#vType_integer
+ MOVNE R0,#err_arrayBad
+ BNE error_report
+ CMP R5,#vType_integer
+ MOVNE R0,#err_numNeeded
+ BNE error_report
+ ADD R2,R2,R4
+ BL ctrl_store
+ B interp_next
+
+25 CMP R5,#vType_string ;This is a string I hope
+ MOVNE R0,#err_strNeeded ;No -- get error number
+ BNE error_report ;...and report the error
+
+ MOV R14,R4,LSL #24 ;Get the second string len
+ CMN R14,R2,LSL #24 ;Is the string short enough?
+ ADDCC R2,R2,R14,LSR #24 ;Add on second length
+ BLCC ctrl_store
+ BCC interp_next
+
+ MOV R0,#err_strTooLong ;String is too long
+ B error_report
+
+ ; --- Subtraction ---
+
+30 CMP R3,#vType_integer
+ CMPEQ R5,#vType_integer
+ MOVNE R0,#err_numNeeded
+ BNE error_report
+ SUB R2,R2,R4
+ BL ctrl_store
+ B interp_next
+
+ ; --- Multiplication ---
+
+40 CMP R3,#vType_integer
+ CMPEQ R5,#vType_integer
+ MOVNE R0,#err_numNeeded
+ BNE error_report
+ MUL R2,R4,R2
+ BL ctrl_store
+ B interp_next
+
+ ; --- Division ---
+
+50 CMP R3,#vType_integer
+ CMPEQ R5,#vType_integer
+ MOVNE R0,#err_numNeeded
+ BNE error_report
+ STMFD R13!,{R0,R1}
+ MOV R0,R2
+ MOV R1,R4
+ BL divide
+ MOV R2,R0
+ LDMFD R13!,{R0,R1}
+ BL ctrl_store
+ B interp_next
+
+ LTORG
+
+; --- ctrl_timeEq ---
+
+ EXPORT ctrl_timeEq
+ctrl_timeEq ROUT
+
+ CMP R9,#'=' ;Next char must be `='
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the equals sign
+ MOV R0,#0 ;Read the expression
+ BL express_read
+ BL express_pop ;Pop the result
+ CMP R1,#vType_integer ;It must be an integer
+ BNE ctrl__notAnInt ;So if it isn't, complain
+ MOV R1,R0 ;Look after this result
+ SWI OS_ReadMonotonicTime ;Find the current real time
+ SUB R0,R0,R1 ;Work out the correct offset
+ STR R0,sail_timeOff ;Store it away nicely
+ B interp_next ;And read another instruction
+
+ LTORG
+
+; --- ctrl_for ---
+
+ EXPORT ctrl_for
+ctrl_for ROUT
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Leave that on the stack
+ CMP R9,#'=' ;We now need an equals
+ MOVNE R0,#err_eqInFor ;If we don't have it, moan
+ BNE error_report
+ BL getToken ;Skip over the equals sign
+ MOV R0,#0 ;Read the base value
+ BL express_read
+ CMP R9,#tok_to ;Make sure we have a TO
+ MOVNE R0,#err_expTo ;If we don't have it, moan
+ BNE error_report
+ BL getToken ;Skip over the TO token
+ MOV R0,#0 ;Read the end value
+ BL express_read
+ CMP R9,#tok_step ;Is there a STEP?
+ BLEQ getToken ;Yes -- get another token
+ MOVEQ R0,#0 ;...read another rvalue
+ BLEQ express_read
+ BLEQ express_pop ;...and get this value
+ MOVNE R0,#1 ;Otherwise use sensible value
+ MOVNE R1,#vType_integer
+
+ ; --- Create the stack frame ---
+
+ STMFD R13!,{R0,R1} ;Save step again for a bit
+ MOV R0,#cFrame__for ;Create a FOR loop frame
+ BL ctrl__pushFrame ;Stick that on the stack
+ MOV R4,R0 ;Look after the frame pointer
+ LDMFD R13!,{R0,R1} ;Load the step value again
+ CMP R1,#vType_integer ;Check it's an integer
+ BNE ctrl__notAnInt ;If not, complain
+ STR R0,[R4,#cFor__step] ;Save the step away
+
+ BL express_pop ;Find the end marker
+ CMP R1,#vType_integer ;Check it's an integer
+ BNE ctrl__notAnInt ;If not, complain
+ STR R0,[R4,#cFor__end] ;Stuff that in the end pos
+
+ BL express_popTwo ;Get ctrl var and start pos
+ CMP R1,#vType_lvInt ;Ensure lvalue is integral
+ CMPNE R1,#vType_lvWord
+ CMPNE R1,#vType_lvByte
+ MOVNE R0,#err_badForVar ;If not, find suitable error
+ BNE error_report ;And tell the user
+ BL ctrl_store ;Initialise it nicely
+ ADD R14,R4,#cFor__lval ;Find the lvalue position
+ STMIA R14,{R0,R1} ;Save that away too
+
+ ADD R14,R4,#cFor__resume ;Point to resume buffer
+ LDR R1,sail_tokAnchor ;Find anchor of script buff
+ LDR R1,[R1] ;SODDING WIMPEXTENSION!!!
+ SUB R1,R10,R1 ;Work out current offset
+ LDR R0,sail_line ;Get the current line number
+ STMIA R14,{R0,R1} ;Save these in the frame
+
+ B interp_next ;Move on to next instruction
+
+ LTORG
+
+; --- ctrl_next ---
+
+ EXPORT ctrl_next
+ctrl_next ROUT
+
+ ; --- First check for identifier ---
+ ;
+ ; If there is one, we need to search for a specific FOR
+ ; frame. Otherwise any old one will do.
+
+ SUBS R14,R9,#'_' ;Is this an identifier?
+ SUBNE R14,R9,#'A' ;No -- check for uppercase
+ CMP R14,#26
+ SUBCS R14,R9,#'a' ;No -- check for lowercase
+ CMPCS R14,#26
+
+ ; --- Read the lvalue given ---
+
+ MOVCC R0,#1 ;Read an lvalue
+ BLCC express_read ;And put it on the stack
+ BLCC express_pop ;Get it in registers
+ MOVCS R1,#-1 ;Otherwise get bogus value
+ MOV R2,R0 ;Look after the lvalue
+ MOV R3,R1 ;And the type
+10 MOV R0,#cFrame__for ;Look for a FOR frame
+ BL ctrl__findFrame ;Try to find the frame
+ MOVCC R0,#err_noFor ;Complain if we hit routine
+ BCC error_report
+ ADD R14,R1,#cFor__lval ;Find the lvalue
+ LDMIA R1,{R4,R5} ;Load them out nicely
+ CMP R2,R4 ;Now check for a match
+ CMPEQ R3,R5 ;Check the type too
+ CMPNE R3,#-1 ;Or maybe we don't care
+ BLNE ctrl__popFrame ;No match -- discard frame
+ BNE %10ctrl_next ;And loop back round
+
+ ; --- Now step the variable ---
+
+ MOV R6,R1 ;Look after frame base
+ MOV R0,R4 ;Get the original lvalue back
+ MOV R1,R5 ;And its type
+ BL ctrl_load ;Load the current value
+ LDR R4,[R6,#cFor__step] ;Load the step size
+ ADD R2,R2,R4 ;Bump the loop counter
+ BL ctrl_store ;Save the modified counter
+ LDR R14,[R6,#cFor__end] ;Find the end limit
+ CMP R4,#0 ;Are we going backwards?
+ SUBGT R14,R2,R14 ;Yes -- subtract this way
+ SUBLT R14,R14,R2 ;Otherwise the other way
+ CMP R14,#0 ;Now which way do we go?
+ BGT %50ctrl_next ;Finished the loop -- stop
+
+ ; --- Now resume from the FOR loop ---
+
+ ADD R14,R6,#cFor__resume ;Find the resume point
+ LDMIA R14,{R0,R1} ;Load the line and offset
+ STR R0,sail_line ;Save the line counter
+ LDR R14,sail_tokAnchor ;Find the anchor of the file
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R1 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrack to read prev token
+ MOV R9,#0 ;Give bogus current token
+ BL getToken ;Read this token
+ B interp_next ;And continue merrily
+
+ ; --- Now see if there's more loops to close ---
+
+50ctrl_next BL ctrl__popFrame ;Remove defunct FOR frame
+ CMP R9,#',' ;Do we have more loops?
+ BLEQ getToken ;Yes -- skip the comma
+ BEQ ctrl_next ;And close them too
+
+ B interp_next ;Finished this instruction
+
+ LTORG
+
+; --- ctrl_repeat ---
+
+ EXPORT ctrl_repeat
+ctrl_repeat ROUT
+
+ MOV R0,#cFrame__repeat ;Create a REPEAT frame
+ BL ctrl__pushFrame ;Stick that on the stack
+ LDR R2,sail_tokAnchor ;Find anchor of script buff
+ LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
+ SUB R2,R10,R2 ;Work out current offset
+ LDR R1,sail_line ;Get the current line number
+ STMIA R0,{R1,R2} ;Save these in the frame
+ B interp_exec ;Get the next instruction
+
+ LTORG
+
+; --- ctrl_until ---
+
+ EXPORT ctrl_until
+ctrl_until ROUT
+
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read an expression
+ BL express_pop ;Read it then
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- complain then
+ MOV R2,R0 ;Look after the result
+
+ ; --- Find the REPEAT frame ---
+
+ MOV R0,#cFrame__repeat ;Look for a REPEAT frame
+ BL ctrl__findFrame ;Try to find the frame
+ MOVCC R0,#err_noRepeat ;Complain if we hit routine
+ BCC error_report
+
+ CMP R2,#0 ;Should we REPEAT?
+ BLNE ctrl__popFrame ;No -- pop the repeat frame
+ BNE interp_next ;No -- just continue then
+
+ ; --- Go back to the REPEAT ---
+
+ LDMIA R1,{R0,R1} ;Load the line and offset
+ STR R0,sail_line ;Save the line counter
+ LDR R14,sail_tokAnchor ;Find the anchor of the file
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R1 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrack to read prev token
+ MOV R9,#-1 ;Give bogus current token
+ BL getToken ;Read this token
+ B interp_exec ;And continue merrily
+
+ LTORG
+
+; --- ctrl_while ---
+
+ EXPORT ctrl_while
+ctrl_while ROUT
+
+ ; --- Push a while frame on the stack ---
+
+ MOV R0,#cFrame__while ;Create a REPEAT frame
+ BL ctrl__pushFrame ;Stick that on the stack
+ LDR R2,sail_tokAnchor ;Find anchor of script buff
+ LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
+ SUB R2,R10,R2 ;Work out current offset
+ LDR R1,sail_line ;Get the current line number
+ STMIA R0,{R1,R2} ;Save these in the frame
+
+ ; --- Read the expression ---
+
+ MOV R0,#0 ;Read an expression
+ BL express_read ;Read it ithen
+ BL express_pop ;Pop the resut
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- that's bad then
+ CMP R0,#0 ;Is is FALSE?
+ BNE interp_exec ;No -- continue then
+
+ ; --- Scan for the first ENDWHILE then ---
+
+ MOV R2,#0 ;Keep a nesting count
+ LDR R4,sail_line ;Get current line number
+10ctrl_while BL getToken ;Get another token
+ CMP R9,#&FF ;Reached the end yet?
+ BEQ %90ctrl_while ;If so, moan about ENDWHILE
+ CMP R9,#tok_while ;Is it a WHILE token?
+ ADDEQ R2,R2,#1 ;Yes -- bump nesting count
+
+ CMP R9,#tok_endwhile ;Yes -- check for ENDWHILE
+ SUBEQ R2,R2,#1 ;Yes -- decrement nesting
+ CMP R2,#0 ;Have we dropped out?
+ BGE %10ctrl_while ;No -- loop
+
+ ; --- We found the ENDWHILE ---
+
+ BL getToken ;Get the next token
+ BL ctrl__popFrame ;Get rid of my WHILE frame
+ B interp_next ;And execute from here
+
+ ; --- We fell off the end -- oops ---
+
+90ctrl_while STR R4,sail_line ;Save bogus line back
+ MOV R0,#err_expEndwhile ;Hmm... should have had an...
+ B error_report ;ENDWHILE somewhere
+
+ LTORG
+
+; --- ctrl_endwhile ---
+
+ EXPORT ctrl_endwhile
+ctrl_endwhile ROUT
+
+ ; --- Find the ENDWHILE frame ---
+
+ MOV R0,#cFrame__while ;Look for a REPEAT frame
+ BL ctrl__findFrame ;Try to find the frame
+ MOVCC R0,#err_noWhile ;Complain if we hit routine
+ BCC error_report
+
+ ; --- Remember where we are ---
+
+ LDR R2,sail_line ;Get the line number
+ MOV R3,R10 ;And our position
+
+ ; --- Go back to the WHILE ---
+
+ LDMIA R1,{R0,R1} ;Load the line and offset
+ STR R0,sail_line ;Save the line counter
+ LDR R14,sail_tokAnchor ;Find the anchor of the file
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R1 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrack to read prev token
+ MOV R9,#-1 ;Give bogus current token
+ BL getToken ;Read this token
+
+ ; --- Now read the expression ---
+
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get the value
+ CMP R0,#0 ;Should we go from here?
+ BNE interp_exec ;Yes -- execute then
+
+ ; --- Execute from the ENDWHILE ---
+
+ BL ctrl__popFrame ;Pop the WHILE frame
+ SUB R10,R3,#1 ;Set R10 up
+ STR R2,sail_line ;Store the line number
+ MOV R9,#-1 ;Make getToken happy
+ BL getToken ;Get a token then
+ B interp_next ;And execute happily
+
+ LTORG
+
+; --- ctrl__readLabel ---
+;
+; On entry: --
+;
+; On exit: CS if there was a label and,
+; R0 == pointer to the label node
+; R1, R2 corrupted
+; CC otherwise
+;
+; Use: Reads a label fromthe current position, and looks it
+; up inthe symbol table.
+
+ctrl__readLabel ROUT
+
+ STMFD R13!,{R14} ;Stack the link
+
+ ADR R2,sail_misc ;Point to a nice buffer
+ SUBS R14,R9,#'_' ;Is it a valid characer?
+ SUBNE R14,R9,#'A'
+ CMP R14,#26
+ SUBCS R14,R9,#'a'
+ CMPCS R14,#26
+ SUBCS R14,R9,#'0'
+ CMPCS R14,#10
+ BCS %90ctrl__readLabel ;No -- bark then
+ STRB R9,[R2],#1 ;And store in the buffer
+
+10 BL getToken ;Get the next character
+ SUBS R14,R9,#'_' ;Is it a valid characer?
+ SUBNE R14,R9,#'A'
+ CMP R14,#26
+ SUBCS R14,R9,#'a'
+ CMPCS R14,#26
+ SUBCS R14,R9,#'0'
+ CMPCS R14,#10
+ STRCCB R9,[R2],#1 ;Yes -- store in the buffer
+ BCC %10ctrl__readLabel ;...and keep on looping
+
+ MOV R14,#0
+ STRB R14,[R2],#1
+
+ ; --- Now find the node ---
+
+ MOV R0,#vType_label ;This is a label
+ ADR R1,sail_misc ;Point at the name
+ BL tree_find ;Try to find it
+ MOVCC R0,#err_noLabel ;Not there -- complain
+ BCC error_report
+
+ LDMFD R13!,{R14} ;Load the link back
+ ORRS PC,R14,#C_flag ;Return 'label here'
+
+ ; --- The label was bad --
+
+90 LDMFD R13!,{R14} ;Load the link back
+ BICS PC,R14,#C_flag ;Return 'no label'
+
+ LTORG
+
+; --- ctrl_gosub ---
+
+ EXPORT ctrl_gosub
+ctrl_gosub ROUT
+
+ ; --- Read the label ---
+
+ BL ctrl__readLabel ;Read a label
+ BCC %90ctrl_gosub ;No there -- barf
+ MOV R3,R0 ;Look after node address
+
+ ; --- Push a GOSUB frame ---
+
+ MOV R0,#cFrame__gosub ;Create a REPEAT frame
+ BL ctrl__pushFrame ;Stick that on the stack
+ LDR R2,sail_tokAnchor ;Find anchor of script buff
+ LDR R2,[R2] ;SODDING WIMPEXTENSION!!!
+ SUB R2,R10,R2 ;Work out current offset
+ LDR R1,sail_line ;Get the current line number
+ STMIA R0,{R1,R2} ;Save these in the frame
+
+ ; --- Branch off somewhere ---
+
+ LDMIB R3,{R0,R1} ;Load out address/line
+ STR R1,sail_line ;Store the line number
+ LDR R1,sail_tokAnchor ;Load anchor address
+ LDR R1,[R1,#0] ;WimpExtension is bollocks
+ MOV R9,#-1 ;Don't confuse getToken
+ ADD R10,R0,R1 ;This is where we are
+ BL getToken ;Prime the lookahead token
+ LDR R14,sail_flags ;Load the flags word
+ BIC R14,R14,#tscFlag_nl ;Clear the newline flag
+ STR R14,sail_flags ;Store the flasg back
+ B interp_exec ;Execute from here!
+
+90ctrl_gosub MOV R0,#err_expLabel ;Get the error number
+ B error_report ;Report the error
+
+ LTORG
+
+; --- ctrl_return ---
+
+ EXPORT ctrl_return
+ctrl_return ROUT
+
+ MOV R0,#cFrame__gosub ;Look for a GOSUB frame
+ BL ctrl__findFrame ;Try to find the frame
+ MOVCC R0,#err_notInSub ;Complain if not a GOSUB
+ BCC error_report
+ BL ctrl__popFrame ;Pop off the frame
+ LDMIA R1,{R0,R1} ;Load the line and offset
+ STR R0,sail_line ;Save the line counter
+ LDR R14,sail_tokAnchor ;Find the anchor of the file
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R1 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrac a little
+ MOV R9,#-1 ;Give bogus current token
+ BL getToken ;Read this token
+ B interp_next ;And continue merrily
+
+; --- ctrl_if ---
+
+ EXPORT ctrl_if
+ctrl_if ROUT
+
+ LDR R14,sail_flags ;Load the flags word
+ BIC R14,R14,#tscFlag_nl ;Clear the newline flag
+ STR R14,sail_flags ;Store the flasg back
+
+ MOV R0,#0 ;Read an rvalue
+ BL express_read
+ BL express_pop ;Get that value
+ CMP R1,#vType_integer ;It must be an integer
+ MOVNE R0,#err_numNeeded ;Isn't -- get error
+ BNE error_report ;And report the error
+ CMP R0,#0 ;Should we execute this?
+ BEQ %10ctrl_if ;No -- look for the else
+
+ CMP R9,#tok_then ;Is there a THEN here?
+ BLEQ getToken ;Yes -- skip over it then
+ B interp_exec ;And just execute from here
+
+ ; --- Look for an ELSE statement ---
+
+10ctrl_if CMP R9,#tok_then ;Do we have a THEN then?
+ BNE %30ctrl_if ;No -- search line for else
+
+ BL getToken ;Get another token
+ CMP R9,#&0a ;Is this a return?
+ BNE %30ctrl_if ;No -- search line then
+
+ ; --- Now look for ELSE ... ENDIF structure ---
+
+ MOV R3,#0 ;My counter thing
+ LDR R4,sail_line ;Get the current line
+
+20ctrl_if MOV R2,R9 ;Remmber the previous char
+ BL getToken ;Skip over the return
+ CMP R9,#&FF ;Is this the end of file?
+ BEQ %50ctrl_if ;Yes -- jump ahead
+ CMP R2,#&0a ;Was prev a newline?
+ CMPNE R9,#&0a ;Or even this one?
+ BNE %20ctrl_if ;Neither -- keep looping
+
+ CMP R2,#tok_then ;Did we just read a then
+ ADDEQ R3,R3,#1 ;Yes -- increment the count
+ BEQ %20ctrl_if ;And keep on looping
+
+ CMP R9,#tok_else ;Or an else?
+ CMPEQ R3,#0 ;Yes -- at bottom level?
+ CMPNE R9,#tok_endif ;Is this an endif?
+ SUBEQ R3,R3,#1 ;Yes -- decrement the count
+ CMP R3,#0 ;Are we ready to execute?
+ BGE %20ctrl_if ;No -- loop then
+
+ BL getToken ;Get the next token
+ B interp_next ;Execute from here!
+
+ ; --- Search on the same line ---
+
+30ctrl_if MOV R0,R9 ;Look after this char
+ CMP R9,#&FF ;At end of file?
+ BLNE getToken ;No -- read next token
+ CMPNE R0,#tok_else ;Stop at ELSE tokens
+ CMPNE R0,#&0a ;And at line end
+ BNE %30ctrl_if ;If not, loop back again
+ B interp_exec ;And carry on going
+
+ ; -- Missing ENDIF ---
+
+50ctrl_if STR R4,sail_line ;Store original line number
+ MOV R0,#err_expEndif ;Get the error number
+ B error_report ;And report the error
+
+ LTORG
+
+; --- ctrl_else ---
+
+ EXPORT ctrl_else
+ctrl_else ROUT
+
+ LDR R0,sail_flags ;Load the flags word
+ TST R0,#tscFlag_nl ;Have we just had a newline?
+ BNE %20ctrl_else ;Yes -- look for an ENDIF
+
+ ; --- Search for the line end ---
+
+10ctrl_else MOV R0,R9 ;Look after old token
+ CMP R9,#&FF ;Is this the EOF
+ BLNE getToken ;No - get a token
+ CMP R0,#&0a ;Was it the line end?
+ BNE %10ctrl_else ;No -- keep on looking
+ B interp_next ;Execute from here
+
+ ; --- Look for an ENDIF ---
+
+20ctrl_else MOV R3,#0 ;My counter thing
+ LDR R4,sail_line ;Get the current line
+ MOV R2,#0 ;Dummy previous char
+ B %45ctrl_else
+
+40ctrl_else MOV R2,R9 ;Remember the previous token
+ BL getToken ;Get a new one
+45ctrl_else CMP R9,#&FF ;Is this the end of file?
+ BEQ %50ctrl_else ;Yes -- jump ahead
+ CMP R2,#&0a ;Was prev a newline?
+ CMPNE R9,#&0a ;Or even this one?
+ BNE %40ctrl_else ;Neither -- keep looping
+
+ CMP R2,#tok_then ;Did we just read a then
+ ADDEQ R3,R3,#1 ;Yes -- increment the count
+ BEQ %40ctrl_else ;And keep on looping
+
+ CMP R9,#tok_endif ;Is this an endif?
+ SUBEQ R3,R3,#1 ;Yes -- decrement the count
+ CMP R3,#0 ;Are we ready to execute?
+ BGE %40ctrl_else ;No -- loop then
+
+ BL getToken ;Get the next token
+ B interp_next ;Execute from here!
+
+ ; -- Missing ENDIF ---
+
+50ctrl_else STR R4,sail_line ;Store original line number
+ MOV R0,#err_expEndif ;Get the error number
+ B error_report ;And report the error
+
+ LTORG
+
+; --- ctrl_goto ---
+
+ EXPORT ctrl_goto
+ctrl_goto ROUT
+
+ BL ctrl__readLabel ;Read the label
+ BCC %90ctrl_goto ;Not there -- barf
+
+ LDMIB R0,{R0,R1} ;Load out address/line
+ STR R1,sail_line ;Store the line number
+ LDR R1,sail_tokAnchor ;Load anchor address
+ LDR R1,[R1,#0] ;WimpExtension is bollocks
+ MOV R9,#-1 ;Don't confuse getToken
+ ADD R10,R0,R1 ;This is where we are
+ BL getToken ;Prime the lookahead token
+ LDR R14,sail_flags ;Load the flags word
+ BIC R14,R14,#tscFlag_nl ;Clear the newline flag
+ STR R14,sail_flags ;Store the flasg back
+ B interp_exec ;Execute from here!
+
+90ctrl_goto MOV R0,#err_expLabel ;Get the error number
+ B error_report ;Report the error
+
+ LTORG
+
+; --- ctrl_case ---
+
+ EXPORT ctrl_case
+ctrl_case ROUT
+
+ MOV R0,#0 ;Read the comparand
+ BL express_read
+ BL express_pop ;Read the value of that
+ CMP R1,#vType_integer ;Is it an integer?
+ CMPNE R1,#vType_string ;Or a string?
+ MOVNE R0,#err_arrayBad ;No -- then point to error
+ BNE error_report ;And report the error
+ MOV R2,R0 ;Look after compare value
+ MOV R3,R1 ;And the type too, please
+
+ CMP R9,#tok_of ;We pointlessly expect `OF'
+ MOVNE R0,#err_expOf ;If not there, complain
+ BNE error_report
+ BL getToken ;Get the next token
+ CMP R9,#&0A ;This must be the line end
+ MOVNE R0,#err_afterCase ;If not, complain annoyingly
+ BNE error_report
+
+ ; --- Now keep an eye out for WHENs and OTHERWISEs ---
+
+ MOV R5,#0 ;Keep a nesting count
+ LDR R6,sail_line ;Get current line number
+10ctrl_case MOV R4,R9 ;Look after previous char
+ BL getToken ;Get another token
+ CMP R9,#&FF ;Reached the end yet?
+ BEQ %90ctrl_case ;If so, moan about ENDCASE
+ CMP R9,#tok_case ;Is it a CASE token?
+ ADDEQ R5,R5,#1 ;Yes -- bump nesting count
+ CMP R4,#&0A ;Was previous newline?
+ BNE %10ctrl_case ;No -- nothing doing here
+
+ CMP R5,#0 ;At bottom nesting level?
+ CMPEQ R9,#tok_otherwise ;Yes -- check for OTHERWISE
+ CMPNE R9,#tok_endcase ;Or maybe an ENDCASE?
+ SUBEQ R5,R5,#1 ;Yes -- decrement nesting
+ CMP R5,#0 ;Have we dropped out?
+ BLLT getToken ;Yes -- get the next token
+ BLT %80ctrl_case ;Yes -- start executing
+ CMPEQ R9,#tok_when ;Now check for a W
+ BNE %10ctrl_case ;No -- loop
+ BL getToken ;Get another token
+
+ ; --- Found a WHEN -- check for a match ---
+
+11ctrl_case MOV R0,#0 ;Read an rvalue
+ BL express_read
+ BL express_pop ;Get result from the stack
+ BL ctrl_compare ;Compare the values
+ BEQ %15ctrl_case ;Match -- skip other exprs
+ CMP R1,#vType_string ;Did we load a string?
+ BLEQ stracc_free ;Yes -- reomve the string
+ CMP R9,#',' ;Comma next?
+ BLEQ getToken ;Yes -- skip it
+ BEQ %11ctrl_case ;And try next expression
+ B %10ctrl_case ;Otherwise hope we get lucky
+
+ ; --- Skip other expressions ---
+ ;
+ ; BASIC allows extreme bogosity here, and so shall we.
+
+15ctrl_case CMP R1,#vType_string ;Did we load a string?
+ BLEQ stracc_free ;Yes -- reomve the string
+00 CMP R5,#0 ;Are we quoted?
+ CMPEQ R9,#':' ;No -- check for colon
+ CMPNE R9,#&0A ;Newline?
+ BEQ %80ctrl_case ;Yes -- let it rip
+ CMP R9,#'"' ;Is this a quote?
+ EOREQ R5,R5,#1 ;Yes -- toggle quoted bit
+ BL getToken ;Get another token
+ B %b00 ;And keep going
+
+ ; --- Return to interp_next, removing str from stracc ---
+
+80ctrl_case CMP R3,#vType_string ;Were we dealing with a str?
+ MOVEQ R0,R2 ;Yes -- put it in R0
+ BLEQ stracc_free ;...and remove it from stracc
+ B interp_next ;Keep on interpreting
+
+ ; --- We fell off the end -- oops ---
+
+90ctrl_case STR R6,sail_line ;Save bogus line back
+ MOV R0,#err_expEndcase ;Hmm... should have had an...
+ B error_report ;ENDCASE somewhere
+
+ LTORG
+
+; --- ctrl_when ---
+
+ EXPORT ctrl_when
+
+; --- ctrl_otherwise ---
+
+ EXPORT ctrl_otherwise
+
+ctrl_when ROUT
+ctrl_otherwise
+
+ MOV R3,#0 ;My counter thing
+ LDR R4,sail_line ;Get the current line
+ MOV R2,#0 ;Dummy previous char
+ B %45ctrl_when
+
+40ctrl_when MOV R2,R9 ;Remember the previous token
+ BL getToken ;Get a new one
+45ctrl_when CMP R9,#&FF ;Is this the end of file?
+ BEQ %50ctrl_when ;Yes -- jump ahead
+ CMP R9,#tok_case ;Did we just read a CASE
+ ADDEQ R3,R3,#1 ;Yes -- increment the count
+ BEQ %40ctrl_when ;And keep on looping
+ CMP R2,#&0a ;Was prev a newline?
+ CMPEQ R9,#tok_endcase ;Is this an endcase?
+ SUBEQ R3,R3,#1 ;Yes -- decrement the count
+ CMP R3,#0 ;Are we ready to execute?
+ BGE %40ctrl_when ;No -- loop then
+
+ BL getToken ;Get the next token
+ B interp_next ;Execute from here!
+
+ ; -- Missing ENDCASE ---
+
+50ctrl_when STR R4,sail_line ;Store original line number
+ MOV R0,#err_expEndcase ;Get the error number
+ B error_report ;And report the error
+
+ LTORG
+
+; --- ctrl_end ---
+
+ EXPORT ctrl_end
+ctrl_end ROUT
+
+ MOV R0,#0
+ B sail_end
+
+ LTORG
+
+; --- ctrl_swap ---
+
+ EXPORT ctrl_swap
+ctrl_swap ROUT
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read
+ CMP R9,#',' ;Do we have a comma?
+ MOVNE R0,#err_expComma ;No -- get the error number
+ BNE error_report ;And report the error
+ BL getToken ;Skip over the comma
+ MOV R0,#1 ;Read another lvalue
+ BL express_read
+ BL express_popTwo ;Pop off the two lvalues
+
+ ; --- Swap the contents of the lvalues ---
+
+10ctrl_swap MOV R4,R2 ;Look after parm 2
+ MOV R5,R3
+ BL ctrl_load ;Load the parameter
+ STMFD R13!,{R2,R3} ;Store rvalue
+ STMFD R13!,{R0,R1} ;And lvalue
+ MOV R0,R4 ;Get the second one
+ MOV R1,R5
+ BL ctrl_load ;Load it's value too
+ LDMFD R13!,{R0,R1} ;Get back lvalue
+ BL ctrl_store ;Store rvalue in lvalue
+ MOV R0,R4 ;Get the second one
+ MOV R1,R5
+ LDMFD R13!,{R2,R3} ;Load rvalue
+ BL ctrl_store ;Complete the swap
+ B interp_next ;All over and happy
+
+ LTORG
+
+; --- ctrl_ptr ---
+
+ EXPORT ctrl_ptr
+ctrl_ptr ROUT
+
+ MOV R0,#2 ;Read an rvalue ident
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_integer ;Is this a string?
+ BNE ctrl__notAnInt ;So if it isn't, complain
+ MOV R3,R0 ;Remember file handle
+
+ CMP R9,#'=' ;Next char must be `='
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the equals sign
+ MOV R0,#0 ;Read the expression
+ BL express_read
+ BL express_pop ;Pop the result
+ CMP R1,#vType_integer ;It must be an integer
+ BNE ctrl__notAnInt ;So if it isn't, complain
+
+ MOV R2,R0 ;Put pointer in R2
+ MOV R1,R3 ;And handle in R1
+ MOV R0,#1 ;Write pointer
+ SWI XOS_Args ;Write the pointer
+ BVS sail_error ;Report possible error
+
+ B interp_next ;And read another instruction
+
+ LTORG
+
+; --- ctrl_ext ---
+
+ EXPORT ctrl_ext
+ctrl_ext ROUT
+
+ MOV R0,#2 ;Read an rvalue ident
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_integer ;Is this a string?
+ BNE ctrl__notAnInt ;So if it isn't, complain
+ MOV R3,R0 ;Remember file handle
+
+ CMP R9,#'=' ;Next char must be `='
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the equals sign
+ MOV R0,#0 ;Read the expression
+ BL express_read
+ BL express_pop ;Pop the result
+ CMP R1,#vType_integer ;It must be an integer
+ BNE ctrl__notAnInt ;So if it isn't, complain
+
+ MOV R2,R0 ;Put extent in R2
+ MOV R1,R3 ;And handle in R1
+ MOV R0,#3 ;Write pointer
+ SWI XOS_Args ;Write the extent
+ BVS sail_error ;Report possible error
+
+ B interp_next ;And read another instruction
+
+ LTORG
+
+; --- ctrl_close ---
+
+ EXPORT ctrl_close
+ctrl_close ROUT
+
+ MOV R0,#2 ;Read an rvalue ident
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_integer ;Is this a string?
+ BNE ctrl__notAnInt ;So if it isn't, complain
+ MOV R1,R0 ;Remember file handle
+ MOV R0,#0 ;Close file
+ SWI XOS_Find ;Close it then
+ BVS interp_next ;And read another instr
+
+ AND R0,R0,#&FF ;Make sure this is a byte
+ ADR R1,sail_files ;Find file bit-array
+ MOV R14,R0,LSR #5 ;Get word index
+ LDR R14,[R1,R14,LSL #2]! ;Load the word I want
+ MOV R2,#(1<<31) ;Set the top bit here
+ BIC R14,R14,R2,ROR R0 ;Clear the correct bit
+ STR R14,[R1,#0] ;Save the word back again
+ B interp_next ;And read another instr
+
+ LTORG
+
+; --- ctrl_bput ---
+
+ EXPORT ctrl_bput
+ctrl_bput ROUT
+
+ ; --- First, make sure we have a hash ---
+
+ CMP R9,#'#' ;We must have a hash
+ MOVNE R0,#err_expHash ;No -- complain then
+ BNE error_report ;And report an error
+ BL getToken ;Get the next token
+
+ ; --- Now read the channel number ---
+
+ MOV R0,#2 ;Read an rvalue ident
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_integer ;Is this a string?
+ BNE ctrl__notAnInt ;So if it isn't, complain
+ MOV R3,R0 ;Remember file handle
+
+ ; --- Skip over the comma ---
+
+ CMP R9,#',' ;Next char must be `,'
+ MOVNE R0,#err_expComma ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Now we read an expression ---
+
+ MOV R0,#0 ;Read the expression
+ BL express_read
+ BL express_pop ;Pop the result
+ CMP R1,#vType_integer ;Is it an integer?
+ BEQ %10ctrl_bput ;Yes -- jump ahead
+ CMP R1,#vType_string ;Make sure it is a string
+ MOVNE R0,#err_arrayBad ;Nope -- get error message
+ BNE error_report ;So if it isn't, complain
+
+ ; --- Write a string to the file ---
+
+ MOV R5,R0 ;Look after the value
+ LDR R1,sail_stracc ;Get the stracc address
+ LDR R1,[R1]
+ ADD R4,R1,R0,LSR #8 ;Point to the string
+ AND R2,R0,#&FF ;Get the length
+
+ MOV R1,R3 ;Get the file handle
+ CMP R2,#0 ;Is this a short string?
+00 LDRGTB R0,[R4],#1 ;Load a character
+ SWIGT XOS_BPut ;Put the byte
+ BVS error_reportReal ;Report possible error
+ SUBS R2,R2,#1 ;Reduce the count
+ BGT %b00 ;And keep on goin'
+
+ MOV R0,R5 ;Put the string in R0
+ BL stracc_free ;Free it from stracc
+
+ CMP R9,#';' ;Is there a semicolon now?
+ BLEQ getToken ;Yes -- get a token
+ MOVNE R0,#10 ;Get a terminator
+ SWINE XOS_BPut ;Put the byte
+ B interp_next ;And read another instruction
+
+ ; --- Just write a character ---
+
+10 MOV R1,R3 ;Get the file handle
+ SWI XOS_BPut ;Put the byte
+ BVS error_reportReal ;Report possible error
+ B interp_next ;And read another instruction
+
+ LTORG
+
+;----- Odds and sods --------------------------------------------------------
+
+; --- ctrl_error ---
+
+ EXPORT ctrl_error
+ctrl_error ROUT
+
+ ; --- Read a parameter ---
+
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_string ;Is this a string?
+ MOVNE R0,#err_strNeeded ;Nope -- get error number
+ BNE error_report ;...and report the error
+
+ LDR R1,sail_stracc ;Get the stracc address
+ LDR R1,[R1]
+ ADD R1,R1,R0,LSR #8 ;Point to the string
+ AND R2,R0,#&FF ;Get the length
+
+ MOV R5,R0 ;look after the rvalue
+ ADR R0,sail_misc ;Point to the misc buffer
+ MOV R14,#1 ;A sillu error number
+ STR R14,[R0],#4 ;Store that
+ BL ctrl_copyString ;Copy the string over
+ ADR R0,sail_misc ;Point to the misc buffer
+ B sail_error ;Return the error
+
+ LTORG
+
+; --- ctrl_oscli ---
+
+ EXPORT ctrl_oscli
+ctrl_oscli ROUT
+
+ ; --- Read a parameter ---
+
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;And get it off the stack
+ CMP R1,#vType_string ;Is this a string?
+ MOVNE R0,#err_strNeeded ;Nope -- get error number
+ BNE error_report ;...and report the error
+
+ LDR R1,sail_stracc ;Get the stracc address
+ LDR R1,[R1]
+ ADD R1,R1,R0,LSR #8 ;Point to the string
+ AND R2,R0,#&FF ;Get the length
+
+ MOV R5,R0 ;look after the rvalue
+ ADR R0,sail_misc ;Point to the misc buffer
+ BL ctrl_copyString ;Copy the string over
+ SWI OS_CLI ;Do the command
+ MOV R0,R5 ;Get the rvalue back
+ BL stracc_free ;Free the string from stracc
+ B interp_next ;Continue happily
+
+ LTORG
+
+
+
+;----- DATA and the like ----------------------------------------------------
+
+; --- ctrl__findDATA ---
+;
+; On entry: All the normal things
+;
+; On exit: R0 == *address* in file of next DATA
+;
+; Use: Sets the internal data pointer to the first DATA statement
+; fromthe current position.
+
+ EXPORT ctrl_findDATA
+ctrl_findDATA ROUT
+
+ STMFD R13!,{R1,R2,R14} ;Save some registers
+ LDR R0,sail_dataPtr ;Load the current position
+ LDR R1,sail_tokAnchor ;Load the anchor
+ LDR R1,[R1]
+ ADD R0,R1,R0 ;Point into the file
+ LDR R2,sail_dataLine ;Line number of DATA
+
+ ; --- Search the file for DATA, or EOF ---
+
+00 LDRB R14,[R0],#1 ;Load a byte
+ CMP R14,#10 ;Are we at a return?
+ ADDEQ R2,R2,#1 ;Yes -- inc line number
+ CMP R14,#&FF ;Is this the EOF?
+ SUBEQ R0,R0,#1 ;Yes -- point to it
+ CMPNE R14,#tok_data ;Did we read a DATA?
+ BNE %b00 ;No -- keep on looking
+
+90 SUB R1,R0,R1 ;Get it as an offset
+ STR R1,sail_dataPtr ;Save this away then
+ STR R2,sail_dataLine ;And the line number
+ LDMFD R13!,{R1,R2,PC}^ ;Return to caller
+
+ LTORG
+
+; --- ctrl_read ---
+
+ EXPORT ctrl_read
+ctrl_read ROUT
+
+ ; --- Point at the current position ---
+
+ LDR R4,sail_dataPtr ;Load the current position
+ LDR R5,sail_tokAnchor ;Load the anchor
+ LDR R5,[R5]
+ ADD R4,R5,R4 ;Point into the file
+
+00ctrl_read LDRB R14,[R4,#0] ;Load the byte there
+ CMP R14,#&FF ;Is it the EOF?
+ MOVEQ R0,#err_outOfDATA ;Yes -- get error num
+ BEQ error_report ;And report the error
+ CMP R14,#10 ;Are we at the line end?
+ BLEQ ctrl_findDATA ;Yes -- find next data
+ MOVEQ R4,R0 ;...put ptr in R0
+ BEQ %00ctrl_read ;...and start again
+ CMP R14,#',' ;Is it a comma?
+ ADDEQ R4,R4,#1 ;Yes -- skip over it
+
+ ; --- Read an rvalue from this position ---
+
+ LDR R6,sail_line ;Load the line number
+ STMFD R13!,{R6-R10} ;Stack position details
+ MOV R10,R4 ;Point just before data
+ LDR R14,sail_dataLine ;Get the line number
+ STR R14,sail_line ;Store as actual line
+ MOV R9,#-1 ;Make getToken happy
+ BL getToken ;Get a token
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get it off the stack
+ LDR R14,sail_line ;Get line number
+ STR R14,sail_dataLine ;Store as DATA line number
+ SUB R4,R10,#1 ;Restore data pointer
+ LDMFD R13!,{R6-R10} ;Load back position
+ STR R6,sail_line ;Restore line number
+ MOV R2,R0 ;Put rvalue in R2,R3
+ MOV R3,R1
+
+ ; --- We are hopefully pointing at some data ---
+
+ MOV R0,#1 ;Prepare to read an lvalue
+ BL express_read ;Read one then
+ BL express_pop ;Get it off the stack
+ BL ctrl_store ;Store the rvalue
+
+ SUB R14,R4,R5 ;Get data pointer as offset
+ STR R14,sail_dataPtr ;Store this away
+ CMP R9,#',' ;Should we read more?
+ BLEQ getToken ;Yes -- skip over the comma
+ BEQ %00ctrl_read ;..and loop back again
+
+ B interp_next ;Do next instruction
+
+ LTORG
+
+; --- ctrl_restore ---
+
+ EXPORT ctrl_restore
+ctrl_restore ROUT
+
+ BL ctrl__readLabel ;Read the label
+ MOVCC R0,#0 ;Not there -- offset is 0
+ MOVCC R1,#1 ;Line is 1
+ LDMCSIB R0,{R0,R1} ;Load out address/line
+
+ STR R0,sail_dataPtr ;Save the data pointer
+ STR R1,sail_dataLine ;And the line number
+ BL ctrl_findDATA ;Find the DATA
+ B interp_next ;And do the next instruction
+
+ LTORG
+
+;----- SYS and friends ------------------------------------------------------
+
+; --- ctrl_call ---
+
+ EXPORT ctrl_call
+ctrl_call ROUT
+
+ BL ctrl_setUpRegs ;Set up the regs then
+
+ CMP R10,#vType_integer ;Is this an integer?
+ MOVNE R0,#err_numNeeded ;No -- get error number
+ BNE error_report ;...and report the error
+
+ MOV R14,PC ;Set up return address
+ MOV PC,R9 ;Execute the code
+
+ ADRL R9,ctrl__returned ;Point to some space
+ STMIA R9!,{R0-R8} ;Store returned registers
+ MOV R14,PC,LSR #28 ;Get the flags
+ STMIA R9,{R14} ;Strore the flags too
+ LDMFD R13!,{R7-R12} ;Load back position info
+ LDMFD R13!,{R0} ;Load stracc offset
+ BL stracc_free ;Free any strings I had
+
+ ; --- We have now done the SWI instr ---
+
+ ADRL R0,ctrl__returned ;Point to the returned regs
+ BL ctrl_resolveRegs ;Do the other half now
+ B interp_next ;If flags -- return
+
+ LTORG
+
+; --- ctrl_sys ---
+
+ EXPORT ctrl_sys
+ctrl_sys ROUT
+
+ BL ctrl_setUpRegs ;Set up the registers
+ STMFD R13!,{R0-R8} ;Stack these registers
+
+ CMP R10,#vType_integer ;Did user use an integer?
+ MOVEQ R0,R9 ;Yes -- use that then
+ BEQ %10ctrl_sys ;And jump ahead
+
+ ; --- Convert the name to a number ---
+
+ LDR R1,sail_stracc ;Load the stracc address
+ LDR R1,[R1]
+ ADD R1,R1,R9,LSR #8 ;Point to the name
+ SWI XOS_SWINumberFromString ;Convert it then
+ BVS error_reportReal ;Report possible error
+
+ ; --- We have the SWI number in R0 ---
+ ;
+ ; We build the following instructions on the stack:
+ ;
+ ; SWI <R0>
+ ; MOV PC,R14
+
+10 ORR R9,R0,#&EF000000 ;Build the SWI instruction
+ LDR R10,=&E1A0F00E ;Get the MOV instr too
+ LDMFD R13!,{R0-R8} ;Load the registers
+ SUB R13,R13,#8 ;Make some room
+ STMIA R13,{R9,R10} ;Stack code
+ MOV R14,PC ;Set up return address
+ MOV PC,R13 ;Call my code
+
+ ADD R13,R13,#8 ;Get rid of my code
+ ADR R9,ctrl__returned ;Point to some space
+ STMIA R9!,{R0-R8} ;Store returned registers
+ MOV R14,PC,LSR #28 ;Get the flags
+ STMIA R9,{R14} ;Strore the flags too
+ LDMFD R13!,{R7-R12} ;Load back position info
+ LDMFD R13!,{R0} ;Load stracc offset
+ BL stracc_free ;Free any strings I had
+
+ ; --- We have now done the SWI instr ---
+
+ ADR R0,ctrl__returned ;Point to the returned regs
+ BL ctrl_resolveRegs ;Do the other half now
+ B interp_next ;Do the next instruction
+
+ctrl__returned DCD 0,0,0,0,0,0,0,0,0,0,0
+
+ LTORG
+
+; --- ctrl_setUpRegs ---
+;
+; On entry: R7-R10 == position info
+;
+; On exit: R0-R8 set up for sys call
+; R9,R10 == rvalue of first parameter
+; On the stack:
+; new position info, R7-R12
+; place to stracc free
+;
+; Use: Sets up all the registers as required by a SYS or SYSCALL
+; command.
+
+ EXPORT ctrl_setUpRegs
+ctrl_setUpRegs ROUT
+
+ MOV R3,R14 ;Look after the link
+ BL stracc_ensure ;Get current stracc offset
+ STMFD R13!,{R1} ;Put it on the stack
+ MOV R5,#0 ;Might be useful
+
+ ; --- Read the complusory argument ---
+
+ MOV R0,#0 ;It's an rvalue
+ BL express_read ;Read the expression
+ BL express_pop ;Pop it
+ BL express_push ;Push it again
+
+ CMP R1,#vType_integer ;Is it an integer?
+ BEQ %f00 ;Yes -- go round again then
+ CMP R1,#vType_string ;Was it a string?
+ MOVNE R0,#err_arrayBad ;No -- get error number
+ BNE error_report ;And report the error
+ BL stracc_ensure ;If it was -- ensure room
+ STRB R5,[R0,#0] ;...store a terminator
+ AND R0,R0,#3 ;Get the alignment
+ RSB R0,R0,#4
+ ORR R0,R1,R0 ;...set up the rvalue
+ BL stracc_added ;Tell stracc about this
+
+ ; --- Now read all other parameters ---
+
+00 MOV R2,#0 ;Mask of regs read
+ MOV R4,#0 ;Number we have read
+00 CMP R9,#',' ;Do we have a comma?
+ BNE %10ctrl_setUpRegs ;No -- we have finshed then
+05 ADD R4,R4,#1 ;Increment the counter
+ CMP R4,#8 ;Have we read 8?
+ MOVEQ R0,#err_sysTooManyI ;Yes -- get error number
+ BEQ error_report ;And report the error
+ BL getToken ;Skip over the comma
+ CMP R9,#',' ;Another comma?
+ MOVEQ R2,R2,LSL #1 ;Yes -- shift R2 along
+ BEQ %b05 ;And go back for more
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ MOV R2,R2,LSL #1 ;Shift R2 along
+ ORR R2,R2,#1 ;And set the bit
+ BL express_pop ;Get it off the stack
+ BL express_push ;Oh -- better not!
+ CMP R1,#vType_integer ;Is it an integer?
+ BEQ %b00 ;Yes -- go round again then
+ CMP R1,#vType_string ;Was it a string?
+ MOVNE R0,#err_arrayBad ;No -- get error number
+ BNE error_report ;And report the error
+ BL stracc_ensure ;If it was -- ensure room
+ STRB R5,[R0] ;...store a terminator
+ AND R0,R0,#3 ;Get the alignment
+ RSB R0,R0,#4
+ ORR R0,R1,R0 ;...set up the rvalue
+ BL stracc_added ;Tell stracc about this
+ B %b00 ;And go round for more
+
+ ; --- We have read the input parameters ---
+ ;
+ ; We must put the position infor on the stack before
+ ; the link here, so that it remains on the stack at return
+ ; time.
+
+10 STMFD R13!,{R7-R12} ;Stack position info
+ STMFD R13!,{R3} ;And then stack the link!
+ LDR R9,sail_stracc ;Load the stracc anchor
+ LDR R9,[R9] ;Get it's address
+ MOV R10,R2 ;Put the mask in R10
+
+ ; --- Now transfer the info to R0-R8 ---
+ ;
+ ; Each routine is padded to eight bytes, for niceness (?)
+ ; To start, we set everything to
+
+ MOV R14,R4 ;Look after number of regs
+ MOV R0,#0
+ MOV R1,#0
+ MOV R2,#0
+ MOV R3,#0
+ MOV R4,#0
+ MOV R5,#0
+ MOV R6,#0
+ MOV R7,#0
+ MOV R8,#0
+
+ CMP R14,#0 ;Read no registers?
+ BEQ %30ctrl_setUpRegs ;Indeed -- jump ahead then
+ RSB R14,R14,#9 ;Make R4 right
+ ADD R14,R14,R14,LSL #1 ;Multiply by 3
+ ADDS PC,PC,R14,LSL #3 ;Jump to the routine (*24)
+ DCB "TMA!" ;Pad pad pad pad...
+
+28 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %27ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R8,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R8,R0 ;No -- it's an integer then
+
+27 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %26ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R7,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R7,R0 ;No -- it's an integer then
+
+26 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %25ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R6,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R6,R0 ;No -- it's an integer then
+
+25 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %24ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R5,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R5,R0 ;No -- it's an integer then
+
+24 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %23ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R4,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R4,R0 ;No -- it's an integer then
+
+23 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %22ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R3,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R3,R0 ;No -- it's an integer then
+
+22 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %21ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R2,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R2,R0 ;No -- it's an integer then
+
+21 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %20ctrl_setUpRegs ;No go -- jump ahead then
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R1,R9,R0,LSR #8 ;Yes -- point to string
+ MOVNE R1,R0 ;No -- it's an integer then
+
+20 MOVS R10,R10,LSR #1 ;Shift the mask down a little
+ BCC %30ctrl_setUpRegs ;No go -- jump ahead then
+ STMFD R13!,{R1} ;Stack R1
+ BL express_pop ;Get the rvalue
+ CMP R1,#vType_string ;Was it a string?
+ ADDEQ R0,R9,R0,LSR #8 ;Yes -- point to string
+ LDMFD R13!,{R1} ;Restore R1
+
+ ; --- All the registers are now set up, phew! ---
+
+30 STMFD R13!,{R0,R1} ;Stack some registers
+ BL express_pop ;Get off first arg!
+ MOV R9,R0 ;Put rvalue in R9,R10
+ MOV R10,R1
+ LDMFD R13!,{R0,R1,PC}^ ;Return to caller
+
+ LTORG
+
+; --- ctrl_resolveRegs ---
+;
+; On entry: R0 == pointer to register block
+;
+; On exit: CS if flags were required, CC otherwise
+;
+; Use: Resolves the registers returned from a SYS or SYSCALL
+; into the appropriate variables. The code assumes that
+; we have possibly just read a TO command, and goes on
+; from there.
+
+ EXPORT ctrl_resolveRegs
+ctrl_resolveRegs ROUT
+
+ ; --- See if we require register return ---
+
+ CMP R9,#tok_to ;Do we have a TO?
+ MOVNES PC,R14 ;No -- return PDQ then
+
+ STMFD R13!,{R0-R6,R14} ;Stack registers
+ BL getToken ;Skip over the TO
+ MOV R4,R0 ;Put the block in R4
+ MOV R5,#0 ;Number read so far
+ ADD R6,R4,#9*4 ;Point tothe flags
+
+00 CMP R9,#':' ;Is this the end?
+ CMPNE R9,#10
+ CMPNE R9,#&FF
+ CMPNE R9,#tok_else
+ BEQ %90ctrl_resolveRegs ;Yes -- return then
+ CMP R9,#',' ;Do we skip this one?
+ ADDEQ R4,R4,#4 ;Yes -- go onto next reg
+ ADDEQ R5,R5,#1 ;We have done this many
+ CMP R5,#9 ;Is this reg 9?
+ MOVEQ R0,#err_sysTooManyO ;Yes -- get error number
+ BEQ error_report ;And report then error
+ CMP R9,#',' ;Compare again with comma
+ BLEQ getToken ;Yes -- skip the comma
+ BEQ %b00 ;Keep on going
+
+ ; --- We must read one then ---
+ ;
+ ; Actually, we may be reading the flags too.
+
+ CMP R9,#';' ;Do we have a semicolon?
+ BEQ %30ctrl_resolveRegs ;Yes -- deal with it then
+
+ MOV R0,#1 ;We are reading an lvalue
+ BL express_read ;Read it
+ BL express_pop ;Pop it off the stack
+ BL ctrl_load ;Load the value
+ CMP R3,#vType_integer ;Is it an integer?
+ BEQ %20ctrl_resolveRegs ;Yes -- jump ahead
+
+ CMP R3,#vType_string ;Is it a string then?
+ MOVNE R0,#err_arrayBad ;No -- get error number
+ BNE error_report ;And report the error
+
+ ; --- We have to return a string ---
+
+ STMFD R13!,{R0,R1} ;Look after the lvalue
+ MOV R0,R2 ;Put the rvalue in R0
+ BL stracc_free ;Free the string from stracc
+
+ LDR R2,[R4,#0] ;Load the string address
+ BL stracc_ensure ;Make sure we have room
+ MOV R3,#0 ;Length so far
+
+10 LDRB R14,[R2],#1 ;Load a byte
+ CMP R14,#0 ;Is it 0?
+ STRNEB R14,[R0],#1 ;No -- store it then
+ ADDNE R3,R3,#1 ;...increment the length
+ BNE %b10 ;And go round for more
+
+ ORR R0,R1,R3 ;Create the rvalue
+ BL stracc_added ;Tell stracc about this
+ MOV R2,R0 ;Put rvalue in R2 too
+ MOV R3,#vType_string ;This is a string
+ LDMFD R13!,{R0,R1} ;Load the lvalue back
+ BL ctrl_store ;Store the new value
+ B %b00 ;Go round again
+
+ ; --- It's just an integer then ---
+
+20 LDR R2,[R4,#0] ;Load the integer
+ BL ctrl_store ;Store this result
+ B %b00 ;Go round again
+
+ ; --- We must read the flags ---
+
+30 BL getToken ;Skip over the ';'
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get it off the stack
+ BL ctrl_load ;Load the current value
+ CMP R3,#vType_integer ;Is it an integer?
+ MOVNE R0,#err_numNeeded ;No -- get error number
+ BNE error_report ;And report the error
+ LDR R2,[R6,#0] ;Load the flags word
+ BL ctrl_store ;Store the new value
+ LDMFD R13!,{R0-R6,R14} ;Load back registers
+ ORRS PC,R14,#C_flag ;Return with C set
+
+90 LDMFD R13!,{R0-R6,R14} ;Load back registers
+ BICS PC,R14,#C_flag ;Return with C clear
+
+ LTORG
+
+;----- Function/Procedure call ----------------------------------------------
+
+; --- FN ---
+;
+; OK, maybe it shouldn't be here. I don't really care.
+;
+; Hack warning: This is a hack. We unwind express_read's stack and stuff
+; them away somewhere completely different.
+
+ EXPORT ctrl_fn
+ctrl_fn ROUT
+
+ ; --- First we need to make a FN frame ---
+ ;
+ ; This involves taking a copy of express_read's stack and
+ ; stuffing it into the frame so we can restore it afterwards.
+ ; This basically means that we can recurse mightily without
+ ; using any R13 stack space. Huzzah!
+
+ MOV R0,#cFrame__fn ;Get the frame type
+ BL ctrl__pushFrame ;Push the frame
+ LDR R14,sail_oldAnchor ;Load the old anchor address
+ STR R14,[R0,#cFn__anchor] ;Save it in the frame
+ STR R6,[R0,#cFn__flags] ;Save express_read's flags
+ STMFD R13!,{R0} ;Save some register
+ BL stracc_ensure ;Get current strac position
+ LDMFD R13!,{R0} ;Load registers back again
+ STR R1,[R0,#cFn__stracc] ;Save this away
+ LDR R14,sail_currAnchor ;Load the current anchor
+ STR R14,sail_oldAnchor ;Save this as the old one
+ LDR R14,sail_tokAnchor ;Now we work from the file
+ STR R14,sail_currAnchor ;So set this as current one
+
+ ADD R14,R0,#cFn__stack+32 ;Find the stack copy bit
+ LDMFD R13!,{R1-R4} ;Load some registers
+ STMFD R14!,{R1-R4} ;Save them into the frame
+ LDMFD R13!,{R1-R4} ;Load some registers again
+ STMFD R14!,{R1-R4} ;Save them into the frame
+
+ ; --- Now get on with the business of calling ---
+
+ LDR R1,sail_execStack ;Load the stack anchor
+ LDR R1,[R1,#0] ;Tycho bops WimpExtension
+ SUB R6,R0,R1 ;Turn into an offset
+
+ ; --- Substitute the arguments ---
+
+ MOV R0,#vType_fn ;This is a FN
+ BL ctrl__subArgs ;Substitute the args
+
+ LDR R0,sail_execStack ;Load the stack anchor
+ LDR R0,[R0,#0] ;Tycho bops WimpExtension
+ ADD R0,R0,R6 ;Point to my frame
+ STMIA R0,{R3,R4} ;Save the return point away
+
+ B interp_exec ;Execute next instruction
+
+ LTORG
+
+; --- = ---
+
+ EXPORT ctrl_equals
+ctrl_equals ROUT
+
+ ; --- First, evaluate the argument ---
+
+ MOV R0,#0 ;Get an rvalue for it
+ BL express_read ;Read the expression
+ CMP R9,#&0A ;Now at end of line?
+ CMPNE R9,#':' ;Or end of statement (weird)
+ CMPNE R9,#&FF ;Or end of file?
+ CMPNE R9,#tok_else ;Or an ElSE?
+ MOVNE R0,#err_syntax ;No -- that's a cock-up
+ BNE error_report ;So be righteous about it
+
+ ; --- If the result is a string, copy it ---
+
+ BL express_pop ;Pop off the result
+ MOV R4,R0 ;Put the rvalue in R4
+ MOV R5,R1 ;And the type in R5
+ CMP R5,#vType_string ;Is it a string?
+ BNE %10ctrl_equals ;No -- jump ahead
+
+ ; --- Copy the string elsewhere ---
+ ;
+ ; We do this since there may be local strings that are
+ ; removed from stracc, underneath the result.
+
+ LDR R1,sail_stracc ;Load stracc's anchor
+ LDR R1,[R1] ;Load the address
+ ADD R1,R1,R4,LSR #8 ;Point to the string
+
+ ADR R0,sail_misc ;Point to a misc buffer
+ ANDS R2,R4,#&FF ;Get the length
+ BEQ %10ctrl_equals ;Nothin' doin', jump
+
+00 LDRB R14,[R1],#1 ;Load a byte
+ STRB R14,[R0],#1 ;Store a byte
+ SUBS R2,R2,#1 ;Reduce counter
+ BNE %b00 ;Do this lots
+ MOV R0,R4 ;Put the rvalue in R0
+ BL stracc_free ;Free the string
+
+ ; --- Find the frame thing ---
+
+10ctrl_equals MOV R0,#cFrame__fn ;Search for a FN frame
+ BL ctrl__unwind ;Look for one of these then
+ MOVCC R0,#err_notInFn ;Get possible error num
+ BCC error_report ;And report the error
+ MOV R6,R1 ;Look after frame address
+
+ ; --- Put stracc in the right place ---
+
+ LDR R0,[R6,#cFn__stracc] ;Load the offset
+ BL stracc_free ;Okaydokey
+
+ ; --- Reset other things ---
+
+ LDMIA R1,{R0,R1} ;Load the line and offset
+ STR R1,sail_line ;Save the line counter
+ LDR R14,sail_oldAnchor ;Find the anchor of the file
+ STR R14,sail_currAnchor ;This is the current one
+ LDR R1,[R6,#cFn__anchor] ;Load the saved anchor
+ STR R1,sail_oldAnchor ;This is the old one
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R0 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrack a little
+ MOV R9,#-1 ;Give bogus current token
+ BL getToken ;Read this token
+
+ ; --- Put a string result back on stracc ---
+
+ MOV R0,R4 ;Get the rvalue
+ MOV R1,R5 ;And the type
+ CMP R1,#vType_string ;Was it a string?
+ BNE %20ctrl_equals ;No -- jump ahead
+
+ ; --- Copy the result back into stracc ---
+
+ BL stracc_ensure ;Make sure we have room
+ ADR R2,sail_misc ;Point to our string
+ ANDS R3,R4,#&FF ;Get the length
+ BEQ %15ctrl_equals ;Very short -- jump
+00 LDRB R14,[R2],#1 ;Load a byte
+ STRB R14,[R0],#1 ;Store a byte
+ SUBS R3,R3,#1 ;Reduce a counter
+ BNE %b00 ;Lots more please
+
+15 ANDS R3,R4,#&FF ;Get the length again
+ ORR R0,R1,R3 ;Put the rvalue in R0
+ MOV R1,#vType_string ;This is a string
+ BL stracc_added ;Tell stracc about this
+20 BL express_push ;Push this result
+
+ ; --- Now we need to return to express_read ---
+ ;
+ ; Hack warning: This is a hack.
+
+ ADD R14,R6,#cFn__stack ;Find stack contents
+ LDMFD R14!,{R0-R3} ;Load contents out
+ STMFD R13!,{R0-R3} ;Stuff them back on the stack
+ LDMFD R14!,{R0-R3}
+ STMFD R13!,{R0-R3}
+ LDR R6,[R6,#cFn__flags] ;Restore express_read's flags
+ B express_fnCont ;And resume horridly
+
+ LTORG
+
+; --- PROC ---
+
+ EXPORT ctrl_proc
+ctrl_proc ROUT
+
+ ; --- First, we push a PROC frame onto the stack ---
+
+ MOV R0,#cFrame__proc ;Push on this type
+ BL ctrl__pushFrame ;Push on the frame
+ LDR R14,sail_oldAnchor ;Get the old anchor
+ STR R14,[R0,#cProc__anchor] ;Save it in the frame
+ LDR R14,sail_tokAnchor ;Args must be in the file
+ STR R14,sail_oldAnchor ;So read them from there
+ STMFD R13!,{R0} ;Save some register
+ BL stracc_ensure ;Get current strac position
+ LDMFD R13!,{R0} ;Load registers back again
+ STR R1,[R0,#cProc__stracc] ;Save this away
+ LDR R1,sail_execStack ;Load the stack anchor
+ LDR R1,[R1,#0] ;Tycho bops WimpExtension
+ SUB R6,R0,R1 ;Turn into an offset
+
+ ; --- Substitute the arguments ---
+
+ MOV R0,#vType_proc ;This is a PROC
+ BL ctrl__subArgs ;Substitute the args
+
+ LDR R0,sail_execStack ;Load the stack anchor
+ LDR R0,[R0,#0] ;Tycho bops WimpExtension
+ ADD R0,R0,R6 ;Point to my frame
+ STMIA R0,{R3,R4} ;Save the return point away
+ LDR R14,[R0,#cProc__anchor] ;Load anchor we saved above
+ STR R14,sail_oldAnchor ;Re-instate this again
+
+ B interp_exec ;Execute next instruction
+
+ LTORG
+
+; --- ENDPROC ---
+
+ EXPORT ctrl_endproc
+ctrl_endproc ROUT
+
+ MOV R0,#cFrame__proc ;Search for a PROC frame
+ BL ctrl__unwind ;Look for one of these then
+ MOVCC R0,#err_notInProc ;Get possible error num
+ BCC error_report ;And report the error
+
+ LDR R0,[R1,#cProc__stracc] ;Load the offset
+ BL stracc_free ;Okaydokey
+
+ LDMIA R1,{R0,R1} ;Load the line and offset
+ STR R1,sail_line ;Save the line counter
+ LDR R14,sail_tokAnchor ;Find the anchor of the file
+ LDR R14,[R14] ;Pointless instruction
+ ADD R10,R14,R0 ;Get the new offset
+ SUB R10,R10,#1 ;Backtrac a little
+ MOV R9,#-1 ;Give bogus current token
+ BL getToken ;Read this token
+ B interp_next ;And continue merrily
+
+ LTORG
+
+; --- DATA ---
+
+ EXPORT ctrl_data
+ctrl_data
+
+; --- DEF ---
+
+ EXPORT ctrl_def
+
+ctrl_def ROUT
+
+ ; --- Simply search for a newline! ---
+
+00 CMP R9,#10 ;Is this a newline?
+ CMPNE R9,#&FF ;Or the EOF?
+ BNE getToken ;No -- get another token
+ BNE %b00 ;...get another one then
+ B interp_next ;And carry on as before
+
+ LTORG
+
+; --- LOCAL ---
+
+ EXPORT ctrl_local
+ctrl_local ROUT
+
+ ; --- We read lots of lvalues, and create local frames ---
+
+00 MOV R0,#cFrame__local ;We want a local frame
+ BL ctrl__pushFrame ;Create the frame then
+ MOV R5,R0 ;Look after the address
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Go to it then
+ BL express_pop ;Pop it off
+ BL ctrl_load ;Load its value out
+ STMIA R5,{R0-R3} ;Store this in the frame
+
+ CMP R9,#',' ;Do we have a comma now?
+ BLEQ getToken ;Yes -- gobble it up
+ BEQ %b00 ;...and do another one
+
+ B interp_next ;Do the next instruction
+
+ LTORG
+
+; --- ctrl__subArgs ---
+;
+; On entry: R0 == type of routine to find
+;
+; On exit: R3 == offset of return point
+; R4 == line number of return point
+; R0-R2, R5 corrupted
+;
+; Use: Performs argument substitution. The next token to read
+; should be the name of the routine to execute. On exit,
+; the interpreter will begin execution of the routine.
+
+ctrl__subArgs ROUT
+
+ ; --- A nasty macro ---
+ ;
+ ; Swap between the two states
+
+ MACRO
+ READARG
+ LDR R0,sail_oldAnchor
+ LDR R0,[R0]
+ MOV R14,R10
+ SUB R10,R3,#1
+ ADD R10,R10,R0
+ LDR R0,sail_currAnchor
+ LDR R0,[R0]
+ SUB R3,R14,R0
+ LDR R14,sail_line
+ STR R4,sail_line
+ MOV R4,R14
+ MOV R9,#-1
+ BL getToken
+ MEND
+
+ MACRO
+ READDEF
+ LDR R0,sail_currAnchor
+ LDR R0,[R0]
+ MOV R14,R10
+ SUB R10,R3,#1
+ ADD R10,R10,R0
+ LDR R0,sail_oldAnchor
+ LDR R0,[R0]
+ SUB R3,R14,R0
+ LDR R14,sail_line
+ STR R4,sail_line
+ MOV R4,R14
+ MOV R9,#-1
+ BL getToken
+ MEND
+
+ ; --- Now get on with it ---
+ ;
+ ; We're calling express_read during the first part of this,
+ ; so we don't have the luxury of a stack...
+
+ MOV R5,R14 ;Remember the return address
+
+ ; --- First, get the PROC/FN name ---
+
+ ADR R2,sail_misc ;Point to a nice buffer
+ SUBS R14,R9,#'_' ;Is it a valid characer?
+ SUBNE R14,R9,#'A'
+ CMP R14,#26
+ SUBCS R14,R9,#'a'
+ CMPCS R14,#26
+ SUBCS R14,R9,#'0'
+ CMPCS R14,#10
+ MOVCS R0,#err_badCall ;No -- get error then
+ BCS error_report ;And report it
+ STRB R9,[R2],#1 ;And store in the buffer
+
+00 BL getToken ;Get the next character
+ SUBS R14,R9,#'_' ;Is it a valid characer?
+ SUBNE R14,R9,#'A'
+ CMP R14,#26
+ SUBCS R14,R9,#'a'
+ CMPCS R14,#26
+ SUBCS R14,R9,#'0'
+ CMPCS R14,#10
+ STRCCB R9,[R2],#1 ;Yes -- store in the buffer
+ BCC %b00 ;...and keep on looping
+
+ MOV R14,#0
+ STRB R14,[R2],#1
+
+ ; --- Now find the PROC/FN ---
+
+ ADR R1,sail_misc ;Point to the name
+ BL tree_find ;Try to find the thing
+ MOVCC R0,#err_noProc ;Not there -- complain
+ BCC error_report
+ LDMIB R0,{R3,R4} ;Load out address/line
+ ADD R3,R3,#1 ;Skip past the proc
+
+ ; --- First, see if we have an open banana ---
+
+ SUBS R1,R9,#'(' ;Do we have actual arguments?
+ BLEQ getToken ;Yes -- gobble the bracket
+ MOVNE R1,#1 ;No -- remember this then
+ READDEF ;Swap to the def
+ SUBS R2,R9,#'(' ;Do we have formal args?
+ BLEQ getToken ;Yes -- gobble the bracket
+ MOVNE R2,#1 ;No -- remember this then
+ CMP R1,R2 ;Are both the same?
+ MOVNE R0,#err_badArgs ;No -- get an error
+ BNE error_report ;So report it then
+ CMP R1,#0 ;Any arguments?
+ BNE %90ctrl__subArgs ;No -- just tidy up then
+
+ MOV R2,#0 ;No arguments read yet
+
+ ; --- Stage 1: Read actual and formal arguments ---
+ ;
+ ; Here we will build 3 records on the val stack for each
+ ; argument:
+ ;
+ ; If argument is RETURN, lvalue of actual arg, else 0
+ ; rvalue of actual arg (read to avoid aliassing problems)
+ ; lvalue of formal arg
+
+10ctrl__subArgs CMP R9,#tok_return ;Is this a RETURN token?
+ BLEQ getToken ;If so, gobble it
+ READARG ;Swap back to the call
+ BNE %f00 ;No -- skip to read rvalue
+
+ ; --- Read lvalue for actual arg ---
+
+ MOV R0,#1 ;Read the lvalue here
+ BL express_read ;Read that please
+ STMFD R13!,{R2,R3} ;Save some registers
+ BL express_pop ;Pop the lvalue
+ BL ctrl_load ;Load the rvalue out
+ BL express_push ;Push the lvalue back
+ MOV R0,R2 ;Get the rvalue now
+ MOV R1,R3 ;And its type, please
+ BL express_push ;Push that too
+ LDMFD R13!,{R2,R3} ;Restore my registers
+ B %f01 ;Now skip to handling formal
+
+ ; --- Read rvalue for actual arg ---
+
+00 MOV R1,#-1 ;Mark a strange lvalue type
+ BL express_push ;Push that on
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;Do that then
+
+ ; --- Now swap and read the formal argument ---
+
+01 ADD R2,R2,#1 ;Bump argument counter
+ CMP R9,#')' ;Is this a close bracket?
+ CMPNE R9,#',' ;Or maybe a comma?
+ MOVNE R0,#err_badCall ;No -- that's an error
+ BNE error_report ;So complain about it
+ MOV R1,R9 ;Look after this token
+ BL getToken ;Gobble the token
+
+ READDEF ;Swap back to the DEF
+ MOV R0,#1 ;Read an lvalue now
+ BL express_read ;Read the expression
+
+ CMP R9,#')' ;Is this a close bracket?
+ CMPNE R9,#',' ;Or maybe a comma?
+ MOVNE R0,#err_expBracket ;No -- error (odd BASIC one)
+ BNE error_report ;So complain about it
+
+ CMP R1,R9 ;Do these match?
+ MOVNE R0,#err_badArgs ;No -- someone can't count
+ BNE error_report ;So report that
+ CMP R9,#',' ;Is there more to come?
+ BL getToken ;Get the next token
+ BEQ %10ctrl__subArgs ;Yes -- read the rest then
+
+ ; --- Stage 2: Bind arguments, and queue value/returns ---
+ ;
+ ; Here, we build the LOCAL frames for the arguments, and
+ ; store the actual arguments into the formal ones. We also
+ ; remember which ones are value/return so we can sort them
+ ; out later. Fortunately we've now done all the messing
+ ; about with express_read that we need to, so we can stack
+ ; registers and seriously get down to business...
+
+ STMFD R13!,{R0-R10} ;Save loads of registers
+ MOV R10,R2 ;Look after argument count
+ MOV R9,#0 ;Counter of valret args
+
+ ; --- First, build the LOCAL frame for formal arg ---
+
+00 MOV R0,#cFrame__local ;Create a local frame
+ BL ctrl__pushFrame ;Push that on the stack
+ MOV R4,R0 ;Look after the address
+ BL express_pop ;Pop a formal arg lvalue
+ BL ctrl_load ;Load the current value
+ STMIA R4,{R0-R3} ;Save all that lot away
+
+ ; --- Now read the rvalue and lvalue of actual arg ---
+
+ MOV R4,R0 ;Look after this lvalue
+ MOV R5,R1 ;Copy it away somewhere
+ BL express_popTwo ;Pop the lvalue and rvalue
+ CMP R1,#-1 ;Do we have an actual lvalue?
+ STMNEFD R13!,{R0,R1,R4,R5} ;Yes -- stack that lot away
+ ADDNE R9,R9,#1 ;And increment the counter
+ MOV R0,R4 ;Put formal lvalue in R0,R1
+ ORR R1,R5,#(1<<31) ;Don't remove strs from strc
+ BL ctrl_store ;And bind the argument
+
+ SUBS R10,R10,#1 ;Decrement arg counter
+ BGT %b00 ;And loop till all done
+
+ ; --- Stage 3: Finally deal with value/return args ---
+ ;
+ ; We have to create the value/return frames now. This is
+ ; complicated by the need to prevent LOCAL from over-
+ ; zealously restoring values. We transform any LOCAL frames
+ ; which might do this into deadlocal ones, which won't.
+
+ CMP R9,#0 ;Do I need to do any of this?
+ BEQ %85ctrl__subArgs ;No -- go away then
+ LDR R8,sail_execStkPtr ;Find ctrl stack pointer
+ LDR R7,sail_execStack ;And find the anchor
+
+ ; --- Check for matching LOCAL frame ---
+
+05 LDR R0,[R13,#0] ;Load the lvalue to match
+ LDR R14,[R7,#0] ;Load the stack anchor
+ ADD R14,R14,R8 ;And find the stack top
+00 LDR R1,[R14,#-4] ;Load the frame type
+ CMP R1,#cFrame__local ;Is this a local frame?
+ CMPNE R1,#cFrame__dead ;Or one we nobbled earlier?
+ BNE %f00 ;No -- not there then
+
+ LDR R1,[R14,#-20]! ;Load the lvalue from here
+ CMP R1,R0 ;Do these match?
+ BNE %b00 ;No -- keep looking then
+ MOV R0,#cFrame__dead ;Nobble this frame
+ STR R0,[R14,#16] ;Change the type to a dummy
+
+ ; --- Now create a value/return frame ---
+
+00 MOV R0,#cFrame__return ;Get the frame type
+ BL ctrl__pushFrame ;Push this frame
+ LDMFD R13!,{R1-R4} ;Load the lvalues out
+ STMIA R0,{R1-R4} ;Save that information away
+ SUBS R9,R9,#1 ;One less of them to do
+ BGT %b05 ;If any more to do, do them
+
+ ; --- We're done here -- return to caller ---
+
+85 LDMFD R13!,{R0-R10} ;Restore registers
+90 MOVS PC,R5 ;And return (slurrrp)
+
+ LTORG
+
+; --- ctrl__unwind ---
+;
+; On entry: R0 == type of frame to find (PROC or FN)
+;
+; On exit: CS and R1 == address of frame found, else
+; CC and R1 corrupted
+; R0 corrupted
+;
+; Use: Pops frames off the stack, until it finds a frame which
+; matches the type specified. Looping constructs are ignored,
+; and locals, deadlocals and return locals are all dealt with.
+; It will stop at any other routine frame, and return CC.
+
+ctrl__unwind ROUT
+
+ STMFD R13!,{R2-R6,R14} ;Stack registers
+ MOV R4,R0 ;Look after the routine type
+ MOV R5,#0 ;Number of return-frames now
+00 BL ctrl__popFrame ;Pop the frame off the stack
+ CMP R0,#cFrame__routine ;Is it a routine frame?
+ BLT %b00 ;Nope -- keep on looking then
+
+ ; --- Now pop off routine frames ---
+
+ CMP R0,R4 ;Have we found it?
+ BEQ %90ctrl__unwind ;Yes -- return success
+
+ CMP R0,#cFrame__local ;Is this a local frame?
+ BNE %10ctrl__unwind ;No -- jump ahead
+
+ ; --- Deal with local frames ---
+
+ LDMIA R1,{R0-R3} ;Load lvalue/rvalue
+ ORR R1,R1,#(1<<31) ;Don't remove strings
+ BL ctrl_store ;Put it back to how it was
+ B %b00 ;And go round for more
+
+ ; --- Check for dead frame ---
+
+10 CMP R0,#cFrame__dead ;Is this frame dead?
+ BEQ %b00 ;Yes -- ignore it then
+
+15 CMP R0,#cFrame__return ;A return frame?
+ BNE %95ctrl__unwind ;Nope -- return CC then
+
+ ; --- We have a return frame ---
+
+ MOV R6,R1 ;Look after frame address
+ ADD R1,R1,#8 ;Point to formal lvalue
+ LDMIA R1,{R0,R1} ;Load that out
+ BL ctrl_load ;Get its value
+ LDMIA R6,{R0,R1} ;Load destination lvalue
+ STMFD R13!,{R0-R3} ;Store on the R13 stack
+ ADD R5,R5,#1 ;Increment number so far
+ B %b00 ;Yes -- ignore it then
+
+ ; --- We found what we were looking for ---
+ ;
+ ; Resolve all the value return types ---
+
+90 MOV R6,R1 ;Look after frame address
+ CMP R5,#0 ;And value returns on stack?
+00 LDMNEFD R13!,{R0-R3} ;Load lvalue/rvalue
+ BLNE ctrl_store ;Store the value away
+ SUBNES R5,R5,#1 ;Decrement the counter
+ BNE %b00 ;And do this for all
+
+ MOV R1,R6 ;Put address in R1
+ LDMFD R13!,{R2-R6,R14} ;Load registers
+ ORRS PC,R14,#C_flag ;Return success then
+
+ ; --- We didn't find it :-( ---
+
+95 LDMFD R13!,{R2-R6,R14} ;Load registers
+ BICS PC,R14,#C_flag ;Return failure
+
+ LTORG
+
+;----- String manipulation --------------------------------------------------
+
+; --- ctrl__alterStr ---
+;
+; On entry: R2 == rvalue of string to change
+; R3 == index to copy into
+; R4 == number of chars to copy
+; R5 = rvalue of string to copy from
+;
+; On exit: --
+
+ctrl__alterStr ROUT
+
+ STMFD R13!,{R0-R5,R14} ;Save some registers
+ MOV R0,R5 ;Remeber rvalue of string 2
+ LDR R14,sail_stracc ;Get the stracc address
+ LDR R14,[R14]
+ ADD R2,R14,R2,LSR #8 ;Point to the string
+ ADD R2,R2,R3 ;Point into the string
+ ADD R5,R14,R5,LSR #8 ;Point to second string
+
+ CMP R4,#0 ;Anything to copy?
+00 LDRGTB R14,[R5],#1 ;Load a byte
+ STRGTB R14,[R2],#1 ;Store it again
+ SUBS R4,R4,#1 ;Reduce the counter
+ BGT %b00 ;And keep on going
+
+ MOV R1,#vType_string ;R0 is a string
+ BL stracc_free ;We don't need it now
+ LDMFD R13!,{R0-R5,PC}^ ;Return to caller
+
+; --- ctrl_leftS ---
+
+ EXPORT ctrl_leftS
+ctrl_leftS ROUT
+
+ ; --- First, read the string variable ---
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get the lvalue
+ BL ctrl_load ;Load the string into stracc
+ CMP R3,#vType_string ;Make sure we have a string
+ BNE ctrl__notAString ;And report the error
+ AND R6,R2,#&FF ;Get the length too
+ STMFD R13!,{R0,R1} ;Remember the lvalue
+
+ ; --- We need a comma now ---
+
+ CMP R9,#',' ;We need a comma now
+ MOVNE R0,#err_expComma ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Read the number of characters ---
+
+ MOV R1,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- barf then
+ CMP R0,R6 ;Reading too many?
+ MOVLE R4,R0 ;Put the number in R4
+ MOVGT R4,R6 ;Put it in range
+ MOV R3,#0 ;The index is 0
+
+ ; --- Look for ')=' now ---
+
+ CMP R9,#')' ;We need a ')' now
+ MOVNE R0,#err_expBracket ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+ CMP R9,#'=' ;We need a '=' now
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Now we need a replacement string ---
+
+ MOV R0,#0 ;Read another rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_string ;Is it a string?
+ BNE ctrl__notAString ;And report the error
+ MOV R5,R0 ;Put the rvalue in R5
+ AND R6,R0,#&FF ;Get the length of that one
+ CMP R4,R6 ;Only copy enough
+ MOVGT R4,R6 ;To save embarrassment
+
+ BL ctrl__alterStr ;Do the string transform
+ MOV R3,#vType_string ;It is a string
+ LDMFD R13!,{R0,R1} ;Get the lvalue back
+ BL ctrl_store ;Store back the new string
+
+ B interp_next ;Do the next instruction
+
+ LTORG
+
+; --- ctrl_midS ---
+
+ EXPORT ctrl_midS
+ctrl_midS ROUT
+
+ ; --- First, read the string variable ---
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get the lvalue
+ BL ctrl_load ;Load the string into stracc
+ CMP R3,#vType_string ;Make sure we have a string
+ BNE ctrl__notAString ;And report the error
+ AND R6,R2,#&FF ;Get the length too
+ STMFD R13!,{R0,R1} ;Remember the lvalue
+
+ ; --- We need a comma now ---
+
+ CMP R9,#',' ;We need a comma now
+ MOVNE R0,#err_expComma ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Read the index ---
+
+ MOV R1,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- barf then
+ SUBS R3,R0,#1 ;Put it in R4
+ MOVLE R3,#0 ;Put it in range
+ CMP R3,R6 ;Is the index too high?
+ MOVGT R3,R6 ;Put it in range
+ SUB R4,R6,R3 ;Get max to read
+
+ ; --- We may have a comma now ---
+
+ CMP R9,#',' ;We need a comma now
+ BNE %10ctrl_midS ;And jump ahead
+
+ ; --- Read the number of characters ---
+
+ BL getToken ;Skip past the comma
+ MOV R1,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- barf then
+ CMP R0,R4 ;Is the index too high?
+ MOVLE R4,R0 ;Put the number in R4
+ CMP R4,#0 ;Not below 0 either
+ MOVLT R4,#0
+
+ ; --- Look for ')=' now ---
+
+10ctrl_midS CMP R9,#')' ;We need a ')' now
+ MOVNE R0,#err_expBracket ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+ CMP R9,#'=' ;We need a '=' now
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Now we need a replacement string ---
+
+ MOV R0,#0 ;Read another rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_string ;Is it a string?
+ BNE ctrl__notAString ;And report the error
+ MOV R5,R0 ;Put the rvalue in R5
+ AND R6,R0,#&FF ;Get the length of that one
+ CMP R4,R6 ;Only copy enough
+ MOVGT R4,R6 ;To save embarrassment
+
+ BL ctrl__alterStr ;Do the string transform
+ MOV R3,#vType_string ;It is a string
+ LDMFD R13!,{R0,R1} ;Get the lvalue back
+ BL ctrl_store ;Store back the new string
+
+ B interp_next ;Do the next instruction
+
+ LTORG
+
+; --- ctrl_rightS ---
+
+ EXPORT ctrl_rightS
+ctrl_rightS ROUT
+
+ ; --- First, read the string variable ---
+
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Read it then
+ BL express_pop ;Get the lvalue
+ BL ctrl_load ;Load the string into stracc
+ CMP R3,#vType_string ;Make sure we have a string
+ BNE ctrl__notAString ;And report the error
+ AND R6,R2,#&FF ;Get the length too
+ STMFD R13!,{R0,R1} ;Remember the lvalue
+
+ ; --- We need a comma now ---
+
+ CMP R9,#',' ;We need a comma now
+ MOVNE R0,#err_expComma ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Read the number of characters ---
+
+ MOV R1,#0 ;Read an rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_integer ;Is it an integer?
+ BNE ctrl__notAnInt ;No -- barf then
+ CMP R0,R6 ;Reading too many?
+ MOVLE R4,R0 ;Put the number in R4
+ MOVGT R4,R6 ;Put it in range
+ SUBS R3,R6,R4 ;Work out the index
+
+ ; --- Look for ')=' now ---
+
+ CMP R9,#')' ;We need a ')' now
+ MOVNE R0,#err_expBracket ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+ CMP R9,#'=' ;We need a '=' now
+ MOVNE R0,#err_expEq ;If it isn't, moan
+ BNE error_report
+ BL getToken ;Skip past the comma
+
+ ; --- Now we need a replacement string ---
+
+ MOV R0,#0 ;Read another rvalue
+ BL express_read ;Read it then
+ BL express_pop ;Pop off the value
+ CMP R1,#vType_string ;Is it a string?
+ BNE ctrl__notAString ;And report the error
+ MOV R5,R0 ;Put the rvalue in R5
+ AND R0,R0,#&FF ;Get the length of that one
+ CMP R4,R0 ;Only copy enough
+ MOVGT R4,R0 ;To save embarrassment
+ SUBGT R3,R6,R4
+
+ BL ctrl__alterStr ;Do the string transform
+ MOV R3,#vType_string ;It is a string
+ LDMFD R13!,{R0,R1} ;Get the lvalue back
+ BL ctrl_store ;Store back the new string
+
+ B interp_next ;Do the next instruction
+
+ LTORG
+
+;----- Arrays ---------------------------------------------------------------
+
+; --- ctrl_dim ---
+
+ EXPORT ctrl_dim
+ctrl_dim ROUT
+
+ ; --- Stash current position ---
+
+ LDR R6,sail_line ;Find the current line
+ STMFD R13!,{R6-R10} ;Save current position info
+
+ ; --- Now try reading an identifier ---
+
+ ADR R1,sail_misc ;Point to a buffer
+ MOV R2,#vType_dimInt ;Currently it's an int array
+
+ SUBS R14,R9,#'_' ;Allow strange ident chars
+ SUBNE R14,R9,#'A' ;Check for uppercase letters
+ CMP R14,#26 ;In range?
+ SUBCS R14,R9,#'a' ;Check for lowercase letters
+ CMPCS R14,#26 ;In range?
+ MOVCS R0,#err_badDim ;No -- get an error
+ BCS error_report ;And kill the program
+
+00 STRB R9,[R1],#1 ;Store the character away
+ BL getToken ;Get another token
+ SUBS R14,R9,#'_' ;Allow strange ident chars
+ SUBNE R14,R9,#'A' ;Check for uppercase letters
+ CMP R14,#26 ;In range?
+ SUBCS R14,R9,#'a' ;Check for lowercase letters
+ CMPCS R14,#26 ;In range?
+ SUBCS R14,R9,#'0' ;Check for digits too now
+ CMPCS R14,#10 ;In range?
+ BCC %b00 ;We're OK here -- loop
+
+ ; --- Found something which stopped us ---
+
+ CMP R9,#'$' ;Is it a dollar sign?
+ MOVEQ R2,#vType_dimStr ;It's a string array now
+ CMPNE R9,#'%' ;Or a percentage?
+ STREQB R9,[R1],#1 ;Yes -- store it then
+ CMPNE R9,#' ' ;Just check for a space
+ BLEQ getToken ;Valid terminator -- get tok
+
+ ; --- Now see if this is an array ---
+
+ CMP R9,#'(' ;Defining an array here?
+ BNE %50ctrl_dim ;No -- allocate a block then
+ ADD R13,R13,#20 ;Lose positioning info
+ MOV R14,#0 ;Terminate the identifier
+ STRB R14,[R1],#1 ;Store zero on the end
+ BL getToken ;Get the next token
+
+ ; --- Ensure that the name isn't already used ---
+
+ MOV R0,R2 ;Get the array type
+ ADR R1,sail_misc ;Point to the name
+ BL tree_find ;Is it there already?
+ MOVCS R0,#err_reDim ;Yes -- moan then
+ BCS error_report ;And kill things off
+
+ ; --- Stuff the string on stracc ---
+
+ BL stracc_ensure ;Make enough space for it
+ ADR R3,sail_misc ;Point to the misc buffer
+00 LDRB R14,[R3],#1 ;Load the byte out
+ STRB R14,[R0],#1 ;Store in the buffer
+ ADD R1,R1,#1 ;And increment the length
+ CMP R14,#0 ;Finished yet?
+ BNE %b00 ;No -- then loop round
+ MOV R0,R1 ;Get the rvalue I made
+ BL stracc_added ;I've added this string
+ MOV R5,R1 ;Look after this value
+
+ ; --- Now read the subscripts ---
+ ;
+ ; We use the stack to keep track of them all. This is
+ ; fairly crufty, but I don't care.
+
+ MOV R3,#0 ;No subscripts so far
+ MOV R4,#1 ;Number of items we need
+00 MOV R0,#0 ;Read an rvalue
+ BL express_read ;Evaluate an expression
+ BL express_pop ;Pop the rvalue
+ CMP R1,#vType_integer ;Ensure it's an integer
+ MOVNE R0,#err_numNeeded ;No -- moan then
+ BNE error_report ;And stop the program
+ ADD R0,R0,#1 ;BASIC subscripts are odd
+ STMFD R13!,{R0} ;Stash the subscript
+ ADD R3,R3,#1 ;Increment the counter
+ MUL R4,R0,R4 ;Update the size we nee
+ CMP R9,#',' ;Is this a comma?
+ BLEQ getToken ;Yes -- get a token
+ BEQ %b00 ;And read another subscript
+ CMP R9,#')' ;Well, this must be next
+ MOVNE R0,#err_dimKet ;No -- well, get an error
+ BNE error_report ;And die horridly
+ BL getToken ;Get another token
+
+ ; --- We now have the subscripts on the stack ---
+
+ LDR R14,sail_stracc ;Find the stracc anchor
+ LDR R14,[R14] ;Bop WimpExtension for fun
+ ADD R1,R14,R5,LSR #8 ;Find the name base
+ MOV R0,R2 ;Get the variable type
+ MOV R2,R13 ;Point to subscripts
+ BL var_create ;Create the array
+ MOV R0,R5 ;Get the rvalue again
+ BL stracc_free ;And release the memory
+ ADD R13,R13,R3,LSL #2 ;Restore the stack pointer
+ B %80ctrl_dim ;And possibly go round again
+
+ ; --- Allocate a block of memory ---
+
+50ctrl_dim LDMFD R13!,{R6-R10} ;Restore positioning info
+ STR R6,sail_line ;Restore the line number
+ MOV R0,#1 ;Read an lvalue
+ BL express_read ;Read that then
+ MOV R0,#0 ;Read an rvalue
+ BL express_read ;And read that too
+ BL express_pop ;Get the block size
+ CMP R1,#vType_integer ;Ensure it's an integer
+ MOVNE R0,#err_numNeeded ;No -- get the error then
+ BNE error_report ;And moan at the user
+ ADD R3,R0,#8 ;Add a link word, 1 byte and
+ BIC R3,R3,#3 ;...word align too
+ MOV R0,#6 ;Claim some memory
+ SWI XOS_Module ;From the RMA (bletch)
+ MOVVS R0,#err_noMem ;If it failed assume no mem
+ BVS error_report ;So deal appropriately
+ LDR R14,sail_rmaList ;Load RMA list head
+ STR R2,sail_rmaList ;Store this block in there
+ STR R14,[R2],#4 ;Stuff the old link away
+ BL express_pop ;Pop the lvalue
+ MOV R3,#vType_integer ;Pointer is an integer
+ BL ctrl_store ;Store it away
+
+ ; --- Do more DIMs if wee need to ---
+
+80ctrl_dim CMP R9,#',' ;Is there a comma now?
+ BLEQ getToken ;Yes -- get the next token
+ BEQ ctrl_dim ;Yes -- do another dim then
+
+ B interp_next ;Do another instruction
+
+ LTORG
+
+;----- Other useful routines ------------------------------------------------
+
+; --- ctrl_copyString ---
+;
+; On entry: R0 == buffer to copy string to
+; R1 == point to the string
+; R2 == length of string to copy
+;
+; On exit: --
+;
+; Use: Copies the string into the buffer.
+
+ EXPORT ctrl_copyString
+ctrl_copyString ROUT
+
+ STMFD R13!,{R0-R2,R14} ;Stack registers
+ CMP R2,#0 ;Is this a short string?
+00 LDRGTB R14,[R1],#1 ;Load a character
+ STRGTB R14,[R0],#1 ;And then store it
+ SUBS R2,R2,#1 ;Reduce the count
+ BGT %b00 ;And keep on goin'
+ MOV R14,#0 ;Get a terminator
+ STRB R14,[R0],#1 ;Store the byte and return
+ LDMFD R13!,{R0-R2,PC}^ ;Return to caller
+
+ LTORG
+
+; --- ctrl__notAnInt ---
+;
+; On entry: --
+;
+; On exit: --
+;
+; Use: Moans because something isn't an integer.
+
+ctrl__notAnInt ROUT
+
+ MOV R0,#err_numNeeded
+ B error_report
+
+ LTORG
+
+; --- ctrl__notAString ---
+;
+; On entry: --
+;
+; On exit: --
+;
+; Use: Moans because something isn't a string.
+
+ctrl__notAString ROUT
+
+ MOV R0,#err_strNeeded
+ B error_report
+
+ LTORG
+
+; --- ctrl__findFrame ---
+;
+; On entry: R0 == frame type
+;
+; On exit: R0 == frame type we stopped at
+; R1 == pointer to base of frame
+; CS if frame type matched, else CC
+;
+; Use: Finds a frame with the given type. It pops frames from the
+; exec stack until it finds either a frame which matches the
+; type in R0 or a routine frame. The frame which stopped the
+; loop is *not* popped.
+
+ctrl__findFrame ROUT
+
+ ORR R14,R14,#C_flag ;Assume a match -- be happy
+ STMFD R13!,{R2,R14} ;Save some registers
+ MOV R2,R0 ;Look after the frame type
+10 BL ctrl__peekFrame ;Look at the top frame
+ CMP R0,R2 ;Is this a match?
+ LDMEQFD R13!,{R2,PC}^ ;Yes -- unstack and return
+ CMP R0,#cFrame__routine ;Is this a routine frame?
+ BLCC ctrl__popFrame ;No -- remove it then
+ BCC %10ctrl__findFrame ;And keep on going
+ LDMFD R13!,{R2,R14} ;Unstack registers
+ BICS PC,R14,#C_flag ;And return with C clear
+
+ LTORG
+
+; --- ctrl_store ---
+;
+; On entry: R0,R1 == lvalue to store in
+; R2,R3 == rvalue to write
+;
+; If bit 31 of R1 is set, then for strings only, the old
+; string is NOT removed from the stracc. This is
+; so that variables can be restored after a procedure.
+;
+; On exit: --
+;
+; Use: Stores an rvalue into an lvalue.
+
+ EXPORT ctrl_store
+ctrl_store ROUT
+
+ ; --- First, see what we're storing in ---
+
+ STMFD R13!,{R14} ;Save a register
+ BIC R14,R1,#(1<<31) ;Clear the weird bit
+ SUB R14,R14,#vType_lvInt ;Get the lvalue index thing
+ CMP R14,#vType_lvStrArr-vType_lvInt+1
+ ADDCC PC,PC,R14,LSL #2 ;It's OK, dispatch then
+ B %00ctrl_store ;Righty ho, on we go
+
+ B ctrl__strInt ;Store in an integer var
+ B ctrl__strStr ;Store in a string var
+ B ctrl__strWord ;Store in a memory word
+ B ctrl__strByte ;Store in a memory byte
+ B ctrl__strBytes ;Store in a memory string
+ B ctrl__strIntArr ;Store in a whole int array
+ B ctrl__strStrArr ;Store in a whole str array
+
+00ctrl_store MOV R0,#err_erk ;This should never happen...
+ B error_report ;Since we always get lvalues
+
+ ; --- Store in an integer variable ---
+
+ctrl__strInt CMP R3,#vType_integer ;Make sure we're storing int
+ LDREQ R14,sail_varTree ;Find the tree base
+ LDREQ R14,[R14] ;Why is WimpExt so odd?
+ STREQ R2,[R14,R0] ;Store the value in node
+ LDMEQFD R13!,{PC}^ ;And return to caller
+ B ctrl__notAnInt
+
+ ; --- Store in a memory word somewhere ---
+
+ctrl__strWord CMP R3,#vType_integer ;Make sure we're storing int
+ STREQ R2,[R0,#0] ;Save the word away
+ LDMEQFD R13!,{PC}^ ;And return to caller
+ B ctrl__notAnInt
+
+ ; --- Store in a byte somewhere ---
+
+ctrl__strByte CMP R3,#vType_integer ;Make sure we're storing int
+ STREQB R2,[R0,#0] ;Save the byte away
+ LDMEQFD R13!,{PC}^ ;And return to caller
+ B ctrl__notAnInt
+
+ ; --- Store in a string variable ---
+
+ctrl__strStr CMP R3,#vType_string ;Make sure we've got a string
+ BNE ctrl__notAString ;No -- complain then
+
+ ; --- Now do some messing about ---
+
+ STMFD R13!,{R0-R5} ;Store some registers
+ MOV R5,R1 ;Look after our flag bit
+
+ LDR R4,sail_varTree ;Find the tree base
+ LDR R4,[R4] ;Who designed this heap?
+ ADD R4,R4,R0 ;Work out the node address
+ LDR R0,[R4,#0] ;Load the old string offset
+ BL strBucket_free ;Don't want it any more
+
+ AND R0,R2,#&FF ;Get the string's length
+ BL strBucket_alloc ;Get a new string entry
+ STR R1,[R4,#0] ;Tuck that away nicely
+
+ LDR R4,sail_stracc ;Find string accumulator
+ LDR R4,[R4] ;It must be one of those days
+ ADD R4,R4,R2,LSR #8 ;Work out string address
+ ANDS R3,R2,#&FF ;Get the length
+00 LDRNEB R14,[R4],#1 ;Load a string byte
+ STRNEB R14,[R0],#1 ;Save it in the bucket
+ SUBNES R3,R3,#1 ;Decrement the length count
+ BNE %b00 ;And loop back again
+
+ TST R5,#(1<<31) ;Do we remove from bucket?
+ MOV R0,R2 ;Get the offset
+ BLEQ stracc_free ;Free it nicely
+
+ LDMFD R13!,{R0-R5,PC}^ ;And return to caller
+
+ LTORG
+
+ ; --- Store a string in memory ---
+
+ctrl__strBytes CMP R3,#vType_string ;Make sure we've got a string
+ BNE ctrl__notAString ;No -- complain then
+
+ STMFD R13!,{R0-R4} ;Store some registers
+ LDR R4,sail_stracc ;Find string accumulator
+ LDR R4,[R4] ;It must be one of those days
+ ADD R4,R4,R2,LSR #8 ;Work out string address
+ ANDS R3,R2,#&FF ;Get the length
+00 LDRNEB R14,[R4],#1 ;Load a string byte
+ STRNEB R14,[R0],#1 ;Save it in the bucket
+ SUBNES R3,R3,#1 ;Decrement the length count
+ BNE %b00 ;And loop back again
+ MOV R14,#13 ;Get the terminator
+ STRB R14,[R0],#1 ;And store that too
+
+ TST R1,#(1<<31) ;Do we remove from bucket?
+ MOV R0,R2 ;Put offset in R1
+ BLEQ stracc_free ;Free it nicely
+ LDMFD R13!,{R0-R4,PC}^ ;Return to caller
+
+ LTORG
+
+ctrl__strIntArr
+ctrl__strStrArr
+
+ MOV R0,#err_arrayBad ;Point to the error message
+ B error_report ;And report the message
+
+; --- ctrl_load ---
+;
+; On entry: R0,R1 == lvalue to read
+;
+; On exit: R2,R3 == rvalue read from lvalue
+;
+; Use: Loads the current value of the given lvalue.
+
+ EXPORT ctrl_load
+ctrl_load ROUT
+
+ ; --- First, see what we're storing in ---
+
+ SUB R2,R1,#vType_lvInt ;Get the lvalue index thing
+ CMP R2,#vType_lvStrArr-vType_lvInt+1
+ ADDCC PC,PC,R2,LSL #2 ;It's OK, dispatch then
+ B %00ctrl_load ;Righty ho, on we go
+
+ B ctrl__ldInt ;Store in an integer var
+ B ctrl__ldStr ;Store in a string var
+ B ctrl__ldWord ;Store in a memory word
+ B ctrl__ldByte ;Store in a memory byte
+ B ctrl__ldBytes ;Store in a memory string
+ B ctrl__ldIntArr ;Store in a whole int array
+ B ctrl__ldStrArr ;Store in a whole str array
+
+00ctrl_load MOV R0,#err_erk ;This should never happen...
+ B error_report ;Since we always get lvalues
+
+ ; --- Load an integer variable ---
+
+ctrl__ldInt MOV R3,#vType_integer ;We're loading an integer
+ LDR R2,sail_varTree ;Find the tree base
+ LDR R2,[R2] ;Why is WimpExt so odd?
+ LDR R2,[R2,R0] ;Load the value out
+ MOVS PC,R14 ;Return to caller
+
+ ; --- Load from a memory word somewhere ---
+
+ctrl__ldWord MOV R3,#vType_integer ;We're loading an integer
+ LDR R2,[R0,#0] ;Load the word
+ MOVS PC,R14 ;And return to caller
+
+ ; --- Load from a byte somewhere ---
+
+ctrl__ldByte MOV R3,#vType_integer ;We're loading an integer
+ LDRB R2,[R0,#0] ;Load the byte
+ MOVS PC,R14 ;And return to caller
+
+ ; --- Load a string into stracc ---
+
+ctrl__ldStr STMFD R13!,{R0,R1,R4,R14} ;Save some registers
+
+ LDR R14,sail_varTree ;Find the variable tree
+ LDR R14,[R14] ;Irate? Me?
+ ADD R3,R14,R0 ;Find the actual node
+ BL stracc_ensure ;Make sure there's enough
+
+ LDR R3,[R3,#0] ;Find the bucket entry
+ CMP R3,#0 ;Is there a string here
+ MOVEQ R2,R1 ;Yes -- return 0 length
+ BEQ %f10 ;...and branch ahead
+ LDR R14,sail_bucket ;Find the bucket anchor
+ LDR R14,[R14] ;I hate this! I hate it!
+ ADD R3,R14,R3 ;Find the actual string
+
+ LDRB R4,[R3,#-1] ;Load the string length
+ ORR R2,R4,R1 ;Build the rvalue ready
+
+00 LDRB R14,[R3],#1 ;Load a byte from string
+ STRB R14,[R0],#1 ;And store byte in stracc
+ SUBS R4,R4,#1 ;Decrement the length
+ BNE %b00
+
+10 MOV R3,#vType_string ;This is a string
+ MOV R0,R2 ;Damn -- we need it in R0,R1
+ BL stracc_added ;Tell stracc about string
+ LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
+
+ ; --- Load a string from memory ---
+
+ctrl__ldBytes STMFD R13!,{R0,R1,R4,R14} ;Save some registers
+
+ MOV R3,R0 ;Remember string pointer
+ BL stracc_ensure ;Make sure there's enough
+
+ MOV R4,#0 ;Make the length 0
+00 LDRB R14,[R3],#1 ;Load a byte from string
+ CMP R14,#13 ;Is it the terminator
+ BEQ %f10 ;Yes -- jump ahead
+ STRB R14,[R0],#1 ;And store byte in stracc
+ ADD R4,R4,#1 ;Decrement the length
+ CMP R4,#255 ;Are we at the limit
+ BLT %b00 ;No -- go round for more
+
+10 MOV R3,#vType_string ;This is a string
+ ORR R2,R1,R4 ;Get the rvalue
+ MOV R0,R2 ;Damn -- we need it in R0,R1
+ BL stracc_added ;Tell stracc about string
+ LDMFD R13!,{R0,R1,R4,PC}^ ;And return to caller
+
+ LTORG
+
+ctrl__ldIntArr
+ctrl__ldStrArr
+ MOV R0,#err_arrayBad ;Get the error number
+ B error_report ;And report the error
+
+; --- ctrl_compare ---
+;
+; On entry: R0,R1 == thing to compare
+; R2,R3 == thing to compare the other thing with
+;
+; On exit: The flags indicate the result of the comparison
+;
+; Use: Compares two things. Note that R3 contains the dominant
+; type. If it is comparing strings, the string in R0,R1
+; will be removed from stracc.
+
+ EXPORT ctrl_compare
+ctrl_compare ROUT
+
+ CMP R3,#vType_integer ;Is it an integer?
+ BNE %10ctrl_compare ;No -- jump ahead
+
+ ; --- We are comparing integers ---
+
+ CMP R1,#vType_integer ;Make sure we have an int
+ BNE ctrl__notAnInt ;No -- barf then
+ CMP R0,R2 ;Do the comparison
+ MOV PC,R14 ;And return to caller
+
+ ; --- Try to compare strings ---
+
+10ctrl_compare CMP R3,#vType_string ;Is it a string?
+ MOVNE R0,#err_arrayBad ;No -- get the error number
+ BNE error_report ;...and report the error
+ CMP R1,#vType_string ;Make sure other is string
+ MOVNE R0,#err_strNeeded ;Nope -- complain
+ BNE error_report
+
+ STMFD R13!,{R0-R5,R14} ;Stack some registers
+ AND R1,R0,#&FF ;Get length of first string
+ AND R3,R2,#&FF ;And of the second one
+ CMP R3,R1 ;Find the lowest
+ EORLT R1,R1,R3 ;And put lowest in R1
+ EORLT R3,R1,R3
+ EORLT R1,R3,R1
+ MOVS R5,R1 ;How long is it?
+ BEQ %50ctrl_compare ;0 length -- jump ahead
+
+ LDR R4,sail_stracc ;Find string accumulator
+ LDR R4,[R4] ;It must be one of those days
+ ADD R2,R4,R2,LSR #8 ;of both strings
+ ADD R0,R4,R0,LSR #8 ;Work out string address
+00 LDRB R14,[R0],#1 ;Load a string byte
+ LDRB R4,[R2],#1 ;from both strings
+ CMP R14,R4 ;Are they the same?
+ BNE %19ctrl_compare ;Nope -- return failure
+ SUBS R5,R5,#1 ;Decrement the length count
+ BNE %b00 ;And loop back again
+ CMP R1,R3 ;Compare lengths then
+
+19ctrl_compare LDR R0,[R13,#0] ;Load an rvalue
+ BL stracc_free ;Free it then
+ LDMFD R13!,{R0-R5,PC} ;Load back registers
+
+50ctrl_compare CMP R1,R3 ;Make another comaprison
+ B %19ctrl_compare ;And return
+
+ LTORG
+
+;----- Stack frames ---------------------------------------------------------
+
+; --- Frame types ---
+
+ ^ 0
+
+cFrame__loop # 0
+
+cFrame__for # 1
+cFrame__while # 1
+cFrame__repeat # 1
+
+cFrame__routine # 0
+
+cFrame__gosub # 1
+cFrame__local # 1
+cFrame__return # 1
+cFrame__proc # 1
+cFrame__fn # 1
+cFrame__dead # 1
+
+; --- Frame formats ---
+
+ ; --- FOR ---
+
+ ^ 0
+cFor__lval # 8
+cFor__end # 4
+cFor__step # 4
+cFor__resume # 8
+cFor__size # 0
+
+ ; --- PROC ---
+
+ ^ 0
+cProc__resume # 8
+cProc__anchor # 4
+cProc__stracc # 4
+cProc__size # 0
+
+ ; --- FN ---
+
+ ^ 0
+cFn__resume # 8
+cFn__flags # 4
+cFn__anchor # 4
+cFn__stracc # 4
+cFn__stack # 32
+cFn__size # 0
+
+ ; --- REPEAT ---
+
+ ^ 0
+cRepeat__resume # 8
+cRepeat__size # 0
+
+ ; --- WHILE ---
+
+ ^ 0
+cWhile__resume # 8
+cWhile__size # 0
+
+ ; --- GOSUB ---
+
+ ^ 0
+cGosub__resume # 8
+cGosub__size # 0
+
+ ; --- LOCAL ---
+
+ ^ 0
+cLocal__lval # 8
+cLocal__rval # 8
+cLocal__size # 0
+
+ ; --- RETURN ---
+
+ ^ 0
+cReturn__lvalA # 8
+cReturn__lvalF # 8
+cReturn__size # 0
+
+ ; --- DEAD ---
+
+ ^ 0
+cDead__lval # 8
+cDead__rval # 8
+cDead__size # 0
+
+;----- That's all, folks ----------------------------------------------------
+
+ END
~mdw / ssr / commitdiff