; ; 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 ; 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