; ; express.s ; ; Evaluation of BASIC expressions ; ; © 1995 Straylight ; ;----- Standard header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ GET sh.anchor GET sh.ctrl GET sh.divide GET sh.errNum GET sh.error GET sh.getToken GET sh.stracc GET sh.termite GET sh.termScript GET sh.tokenise GET sh.tokens GET sh.upcalls GET sh.mem GET sh.var ;----- Macros --------------------------------------------------------------- MACRO $label GETOP $r,$prec,$branch,$cc ALIGN $label MOV$cc $r,#($prec)<<24 ORR$cc $r,$r,#($branch-exp__bTable)>>2 MEND ;----- Main code ------------------------------------------------------------ AREA |TermScript$$Code|,CODE,READONLY ;----- Stack handling ------------------------------------------------------- ; --- exp__pushOp --- ; ; On entry: R0 == operator thing to push ; ; On exit: R0-R4 corrupted ; ; Use: Pushes an operator onto the stack. exp__pushOp ROUT STMFD R13!,{R14} MOV R3,R0 ;Look after thing to push ADR R1,tsc_opStack ;Point to some stack data LDMIA R1,{R0-R2} ;Load it out ADD R4,R1,#4 ;New used size CMP R4,R2 ;Do we need more stack? BGT %10exp__pushOp ;Yes -- jump ahead 00exp__pushOp STR R4,tsc_opStkPtr ;Store back new size LDR R0,[R0] ;Point to the stack ADD R0,R0,R4 ;Address to put next thing on STR R3,[R0,#-4] ;Store the new operator LDMFD R13!,{PC}^ 10exp__pushOp ADD R1,R4,#255 ;Align to next size thing BIC R1,R1,#255 ;Finish the align BL mem_realloc ;Yes -- get more space then STR R1,tsc_opStkSize ;Store new size maybe B %00exp__pushOp ;Branch back agin LTORG ; --- exp__popOp --- ; ; On entry: -- ; ; On exit: R0 == value popped off ; R1-R4 corrupted ; ; Use: Pops an operator from the stack. exp__popOp ROUT STMFD R13!,{R14} ADR R1,tsc_opStack ;Point to some stack data LDMIA R1,{R0-R2} ;Load it out SUB R4,R1,#4 ;The new size ADD R1,R4,#255 ;Align up again BIC R1,R1,#255 ;Aligned down ADD R1,R1,#256 ;At least this much CMP R1,R2 ;Has this size changed? BLLT mem_realloc ;Yes -- reduce memory reqs. STRLT R1,tsc_opStkSize ;Store new size maybe STR R4,tsc_opStkPtr ;Store back new size LDR R0,[R0] ;Point to the stack LDR R0,[R0,R4] ;Load the value off the stack LDMFD R13!,{PC}^ ;Return to caller LTORG ; --- exp__pushVal --- ; ; On entry: R0 == operator thing to push ; R1 == type of thing to push ; ; On exit: R0-R5 corrupted ; ; Use: Pushes an value onto the stack. exp__pushVal ROUT STMFD R13!,{R5,R14} MOV R3,R0 ;Look after thing to push MOV R4,R1 ADR R1,tsc_calcStack ;Point to some stack data LDMIA R1,{R0-R2} ;Load it out ADD R5,R1,#8 ;New used size CMP R5,R2 BGT %10exp__pushVal 00exp__pushVal STR R5,tsc_calcStkPtr ;Store back new size LDR R0,[R0] ;Point to the stack ADD R0,R0,R5 ;Address to put next thing on STMDB R0,{R3,R4} ;Store the thing LDMFD R13!,{R5,PC}^ 10exp__pushVal ADD R1,R5,#255 ;Align to next size thing BIC R1,R1,#255 ;Finish the align BL mem_realloc ;Yes -- get more space then STR R1,tsc_calcStkSize ;Store new size maybe B %00exp__pushVal LTORG ; --- exp__popVal --- ; ; On entry: -- ; ; On exit: R0,R1 == value popped off ; R2-R4 corrupted ; ; Use: Pops a value from the stack. exp__popVal ROUT STMFD R13!,{R14} ADR R1,tsc_calcStack ;Point to some stack data LDMIA R1,{R0-R2} ;Load it out SUB R4,R1,#8 ;The new size ADD R1,R4,#255 ;Align up again BIC R1,R1,#255 ;Aligned down ADD R1,R1,#256 ;At least this much please CMP R1,R2 ;Has this size changed? BLLT mem_realloc ;Yes -- reduce memory reqs. STRLT R1,tsc_calcStkSize ;Store new size maybe STR R4,tsc_calcStkPtr ;Store back new size LDR R0,[R0] ;Point to the stack ADD R0,R0,R4 ;Point into the stack LDMIA R0,{R0,R1} ;Load values from the stack LDMFD R13!,{PC}^ ;Return to caller LTORG ; --- exp__popTwoVals --- ; ; On entry: -- ; ; On exit: R0-R3 == values popped off ; R4 corrupted ; ; Use: Pops two values from the stack. exp__popTwoVals ROUT STMFD R13!,{R14} ADR R1,tsc_calcStack ;Point to some stack data LDMIA R1,{R0-R2} ;Load it out SUB R4,R1,#16 ;The new size ADD R1,R4,#255 ;Align up again BIC R1,R1,#255 ;Aligned down ADD R1,R1,#256 ;At least his much CMP R1,R2 ;Has this size changed? BLLT mem_realloc ;Yes -- reduce memory reqs. STRLT R1,tsc_calcStkSize ;Store new size maybe STR R4,tsc_calcStkPtr ;Store back new size LDR R0,[R0] ;Point to the stack ADD R0,R0,R4 ;Point into the stack LDMIA R0,{R0-R3} ;Load values from the stack LDMFD R13!,{PC}^ ;Return to caller LTORG ; --- express_pop --- ; ; On entry: -- ; ; On exit: R0,R1 == value popped off ; ; Use: Pops a value from the stack. EXPORT express_pop express_pop ROUT STMFD R13!,{R2-R4,R14} ;Stack registers BL exp__popVal ;Get the value LDMFD R13!,{R2-R4,PC}^ ;Return to caller LTORG ; --- express_popTwo --- ; ; On entry: -- ; ; On exit: R0-R3 == two values popped from the stack ; ; Use: Pops two values from the stack. EXPORT express_popTwo express_popTwo ROUT STMFD R13!,{R4,R14} ;Stack registers BL exp__popTwoVals ;Pop the values LDMFD R13!,{R4,PC}^ ;And return to caller LTORG ; --- express_push --- ; ; On entry: R0,R1 == l/rvalue to push ; ; On exit: -- ; ; Use: Pushes a value onto the expression stack. EXPORT express_push express_push ROUT STMFD R13!,{R0-R4,R14} ;Save some registers BL exp__pushVal ;Do the pushing LDMFD R13!,{R0-R4,PC}^ ;And return to caller LTORG ;----- Space-saving type checking routines ---------------------------------- ; --- exp__chkTwoInts --- ; ; On entry: R1,R3 == types of variable ; ; On exit: -- ; ; Use: Ensures that R1 and R3 are both of type integer, and ; complains otherwise. exp__chkTwoInts ROUT CMP R3,#vType_integer ;Is second an integer? MOVNE R1,R3 ;No -- fiddle the first then ; Drop through here (yuk) ; --- exp__chkInt --- ; ; On entry: R1 == type of a variable ; ; On exit: -- ; ; Use: Ensures that R1 is of type integer, and complains otherwise. exp__chkInt ROUT CMP R1,#vType_integer ;Is it an integer MOVEQS PC,R14 ;Yes -- all OK -- return MOV R0,#err_numNeeded ;No -- get the error B error_report ;And complain at the user LTORG ; --- exp__popInt --- ; ; On entry: -- ; ; On exit: R0,R1 == value popped from the stack ; R2-R4 corrupted ; ; Use: Pops a value from the stack and ensures that it is an ; integer. exp__popInt STMFD R13!,{R14} ;Save the link for a bit BL exp__popVal ;Pop a value from stack LDMFD R13!,{R14} ;Restore link register B exp__chkInt ;And check the value LTORG ; --- exp__popTwoInts --- ; ; On entry: -- ; ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack ; R4 corrupted ; ; Use: Pops two values from the stack and ensures that they are ; integers. exp__popTwoInts ROUT STMFD R13!,{R14} ;Save the link for a bit BL exp__popTwoVals ;Pop two values from stack LDMFD R13!,{R14} ;Restore link register B exp__chkTwoInts ;And check the values LTORG ; --- exp__chkTwoStrs --- ; ; On entry: R1,R3 == types of variable ; ; On exit: -- ; ; Use: Ensures that R1 and R3 are both of type string, and ; complains otherwise. exp__chkTwoStrs ROUT CMP R3,#vType_string ;Is second an integer? MOVNE R1,R3 ;No -- fiddle the first then ; Drop through here (yuk) ; --- exp__chkStr --- ; ; On entry: R1 == type of a variable ; ; On exit: -- ; ; Use: Ensures that R1 is of type string, and complains otherwise. exp__chkStr ROUT CMP R1,#vType_string ;Is it an integer MOVEQS PC,R14 ;Yes -- all OK -- return MOV R0,#err_strNeeded ;No -- get the error B error_report ;And complain at the user LTORG ; --- exp__popStr --- ; ; On entry: -- ; ; On exit: R0,R1 == value popped from the stack ; R2-R4 corrupted ; ; Use: Pops a value from the stack and ensures that it is an ; integer. exp__popStr STMFD R13!,{R14} ;Save the link for a bit BL exp__popVal ;Pop a value from stack LDMFD R13!,{R14} ;Restore link register B exp__chkStr ;And check the value LTORG ; --- exp__popTwoStrs --- ; ; On entry: -- ; ; On exit: R0,R1,R2,R3 == two integers popped from the calc stack ; R4 corrupted ; ; Use: Pops two values from the stack and ensures that they are ; integers. exp__popTwoStrs ROUT STMFD R13!,{R14} ;Save the link for a bit BL exp__popTwoVals ;Pop two values from stack LDMFD R13!,{R14} ;Restore link register B exp__chkTwoStrs ;And check the values LTORG ;----- Expression evaluation routines --------------------------------------- ; --- express_fnCont --- ; ; On entry: Involved ; ; On exit: Similarly involved. ; ; Use: We continue here after executing a function. EXPORT express_fnCont ; --- express_read --- ; ; On entry: R0 == 1 to read an lvalue, 2 to read ident, 0 otherwise ; R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0,R1 == value of expression ; R7, R8, R9 == lookahead token ; R0, R1 == result of expression ; R10 == moved on to first char after expression ; ; Use: Reads an expression for the current position in the ; tokenised file. EXPORT express_read express_read ROUT STMFD R13!,{R0-R6,R14} ;Stack registers MOV R6,#0 ;Current flags word CMP R0,#1 ;Reading an lvalue? ORREQ R6,R6,#eFlag__lval ;Yes -- set the flag then CMP R0,#2 ;Reading an ident? ORREQ R6,R6,#eFlag__parseLval ;Yes -- parse as lval then GETOP R0,255,exp__bExpEnd ;Push a sentinel operand BL exp__pushOp ;To separate this expression exp__mainLoop express_fnCont 10express_read TST R6,#eFlag__done ;Have we finished this? BNE %70express_read ;Yes -- jump ahead TST R6,#eFlag__op ;Are we reading an op? BNE %50express_read ;Yes -- jump ahead ; --- Read an operand then --- SUBS R4,R9,#'_' ;Is it an underscore? SUBNE R4,R9,#'A' ;Or a capital letter? CMP R4,#26 SUBCS R4,R9,#'a' ;Or a lowercase letter? CMPCS R4,#26 BCC exp__readIdent ;Read an identifier CMP R9,#'!' ;Is it an indirection op? CMPNE R9,#'?' CMPNE R9,#'$' BEQ exp__indir ;Yes -- jump ahead TST R6,#eFlag__lval ;Are we reading an lvalue? MOVNE R0,#err_syntax ;Yes -- get the error number BNE error_report ;...and report the error CMP R9,#'"' ;Is it a quote? BEQ exp__string ;Yes -- read string then CMP R9,#'(' ;Is it a bracket? BEQ exp__par ;Yes -- jump ahead CMP R9,#tok_fn ;Is it a function call? BEQ exp__userFn ;Yes -- handle that then CMP R9,#tok_rnd ;Is this the RND fn? BLEQ getToken ;Yes -- gobble that BEQ exp__doRnd ;And deal with it then CMP R9,#'+' ;Is it a unary '+'? BLEQ getToken ;...get another token BEQ %10express_read ;...keep going around again CMP R9,#'-' ;Is it a unary '-'? BEQ exp__uMinus ;Yes -- jump ahead then CMP R7,#tClass_pseud ;Is this a pseudovariable? BEQ exp__pseud ;Yes -- deal with it CMP R7,#tClass_fn ;Is it a function then? BEQ exp__fn ;Yes -- deal with that CMP R7,#tClass_streamOp ;Also check for stream ops BEQ exp__streamOp ;Just for luck CMP R7,#tClass_multArg ;Multiple parameter thing? BEQ exp__multArg ;Yes -- deal with it then CMP R9,#'&' ;Start a hex number? BEQ exp__readHex ;Yes -- jump ahead CMP R9,#'%' ;Start of a binary number? BEQ exp__readBin ;Yes -- jump ahead SUB R14,R9,#'0' ;Set up for a range check CMP R14,#10 ;Is it a number? BCC exp__readDec ;Read a decimal number MOV R0,#err_unknown ;Get all-encompassing error B error_report ;And report the error LTORG ; --- Handle a string --- exp__string BL stracc_ensure ;Ensure stracc is big enough MOV R2,#0 ;The initial length 00 BL getToken ;Read the next token CMP R9,#&0a ;Is this a line end? CMPNE R9,#&ff ;Or an end of file? MOVEQ R0,#err_expQuote ;Yes -- get error number BEQ error_report ;And report it CMP R9,#'"' ;Is it a quote? BEQ %f05 ;Yes -- branch ahead 03 STRB R9,[R0],#1 ;No -- store the byte ADDS R2,R2,#1<<24 ;...increment the length BCC %b00 ;Keep looping for more MOVCS R0,#err_strTooLong ;Get error message BCS error_report ;and report it nicely 05 BL getToken ;Get another token CMP R9,#'"' ;Is this a quote too? BEQ %b03 ;Yes -- jump back upwards ORR R0,R1,R2,LSR #24 ;Get the rvalue word MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about this BL exp__pushVal ;Push the value ORR R6,R6,#eFlag__op ;Read an operator now B %10express_read ;And jump with glee ; --- Handle a function call --- exp__userFn ORR R6,R6,#eFlag__op ;Expect operand next BL getToken ;Gobble the token B ctrl_fn ;And handle it elsewhere ; --- Handle an open bracket --- exp__par GETOP R0,253,exp__bPar ;Do a bracket like thing BL exp__pushOp ;Push that onto the stack ADD R6,R6,#1<<8 ;Bump the paren count BL getToken ;Get another token B %10express_read ;And read the first operand ; --- Handle a unary minus --- exp__uMinus GETOP R0,1,exp__bUMinus ;Do a unary minus BL exp__pushOp ;Push that onto the stack BL getToken ;Get another token B %10express_read ;And read the first operand ; --- Handle a pseudovariable --- exp__pseud MOV R0,R8 ;Look after token index BL getToken ;Move on to next token ORR R6,R6,#eFlag__op ;Now expecting an operator MOV R14,PC ;Set up return address ADD PC,PC,R0,LSL #2 ;Dispatch on token index B %10express_read ;And return to the top B exp__doFalse ;Return 0 B exp__doTime ;Get the current time B exp__doTimeS ;Read time as a string (ouch) B exp__doTrue ;Return -1 ; --- Handle unary functions --- exp__fn MOV R0,#(exp__fns-exp__bTable)>>2 ADD R0,R0,R8 ;Add on the token index ORR R0,R0,#1<<24 ;Use normal unary precedence CMP R9,#tok_strS ;Is this STR$? BLNE exp__pushOp ;Put that on the stack BLNE getToken ;Get the next token BNE %10express_read ;And go back up top BL getToken ;Get another token CMP R9,#'~' ;Hex conversion? ORREQ R0,R0,#1<<16 ;Set a useful flag BLEQ getToken ;And get another token BL exp__pushOp ;Put that on the stack B %10express_read ;And go back up top ; --- Handle stream operations with irritating #s --- exp__streamOp MOV R1,R8 ;Look after token index BL getToken ;Get the next token CMP R9,#'#' ;Is next char a hash? MOVNE R0,#err_expHash ;No -- complain then BNE error_report ;And report an error BL getToken ;Get the next token MOV R0,#(exp__streamOps-exp__bTable)>>2 ADD R0,R0,R1 ;Add on the token index ORR R0,R0,#1<<24 ;Use normal unary precedence BL exp__pushOp ;Put that on the stack B %10express_read ;And go back up top ; --- Deal with multiple parameter commands --- exp__multArg MOV R0,#(exp__multArgs-exp__bTable)>>2 ADD R0,R0,R8 ;Add on the token index ORR R0,R0,#1<<24 ;Use normal unary precedence BL exp__pushOp ;Put that on the stack BL getToken ;Get the next token GETOP R0,254,exp__bMultArg ;Get the operator value TST R6,#eFlag__commaOk ;Are we allowing commas? ORRNE R0,R0,#1<<16 ;Yes -- set the flag then BL exp__pushOp ;Put that on there ORR R6,R6,#eFlag__commaOk ;Allow commas for a while ADD R6,R6,#1<<8 ;Increment the paren count B %10express_read ;And go back up top ; --- Deal with an indirection operator --- exp__indir MOV R0,#0 ;Prepare a zero base TST R6,#eFlag__lval ;Are we reading an lvalue? MOVEQ R1,#vType_integer ;No -- call it an integer MOVNE R1,#vType_lvInt ;Yes -- call it an int lval BICNE R6,R6,#eFlag__lval ;Clear lvalue flag too ORRNE R6,R6,#eFlag__parseLval ;But carry on parsing one! BL exp__pushVal ;Push that on the calc stack CMP R9,#'$' ;Is this a dollar? MOVLT R0,#(exp__bPling-exp__bTable)>>2 MOVEQ R0,#(exp__bDollar-exp__bTable)>>2 MOVGT R0,#(exp__bQuery-exp__bTable)>>2 ORR R0,R0,#1<<24 ;Make it precedence 1 BL exp__pushOp ;Stick that on the op stack BL getToken ;Get another token B %10express_read ;And read the operand ; --- Read a hexadecimal number --- exp__readHex MOV R0,#0 ;Initial value is zero BL getToken ;Get a first token SUB R14,R9,#'A' ;Is this a letter CMP R14,#6 ;If so, make sure it's OK ADDCC R14,R14,#10 ;And move on to 10-15 SUBCS R14,R9,#'0' ;Otherwise check for digit CMPCS R14,#10 ;Make sure that's in range MOVCS R0,#err_badHex ;If not, make an error BCS error_report ;And stop doing this 00express_read ADD R0,R14,R0,LSL #4 ;Accumulate a result BL getToken ;Get another token SUB R14,R9,#'A' ;Is this a letter CMP R14,#6 ;If so, make sure it's OK ADDCC R14,R14,#10 ;And move on to 10-15 SUBCS R14,R9,#'0' ;Otherwise check for digit CMPCS R14,#10 ;Make sure that's in range BCC %b00express_read ;If it was OK, go round more MOV R1,#vType_integer ;Call it an integer BL exp__pushVal ;Stick that on the val stack TST R6,#eFlag__parseLval ;Parsing an lvalue? ORRNE R6,R6,#eFlag__done ;Yes -- we're finished ORR R6,R6,#eFlag__op ;Now look for binary operator B %10express_read ;And read the operator ; --- Read a binary number --- exp__readBin MOV R0,#0 ;Initial value is zero BL getToken ;Get a first token SUB R14,R9,#'0' ;Otherwise check for digit CMP R14,#1 ;Make sure that's in range MOVHI R0,#err_badHex ;If not, make an error BHI error_report ;And stop doing this 00express_read ADC R0,R0,R0 ;Accumulate a result BL getToken ;Get another token SUB R14,R9,#'0' ;Otherwise check for digit CMP R14,#1 ;Make sure that's in range BLS %b00express_read ;If it was OK, go round more MOV R1,#vType_integer ;Call it an integer BL exp__pushVal ;Stick that on the val stack TST R6,#eFlag__parseLval ;Parsing an lvalue? ORRNE R6,R6,#eFlag__done ;Yes -- we're finished ORR R6,R6,#eFlag__op ;Now look for binary operator B %10express_read ;And read the operator ; --- Read a decimal number --- exp__readDec MOV R0,#0 ;Initial value is zero 00express_read ADD R0,R0,R0,LSL #2 ;Multiply accumulator by 5 ADD R0,R14,R0,LSL #1 ;Accumulate the result BL getToken ;Get another token SUB R14,R9,#'0' ;Otherwise check for digit CMP R14,#10 ;Make sure that's in range BCC %b00express_read ;If it was OK, go round more MOV R1,#vType_integer ;Call it an integer BL exp__pushVal ;Stick that on the val stack TST R6,#eFlag__parseLval ;Parsing an lvalue? ORRNE R6,R6,#eFlag__done ;Yes -- we're finished ORR R6,R6,#eFlag__op ;Now look for binary operator B %10express_read ;And read the operator ; --- Read an identifier --- exp__readIdent ADR R1,tsc_misc ;Point to a nice block MOV R2,#vType_integer ;The current variable type 00express_read SUBS R4,R9,#'_' ;Is it an underscore? SUBNE R4,R9,#'0' ;Or a number? CMP R4,#10 SUBCS R4,R9,#'A' ;Or a capital letter? CMPCS R4,#26 SUBCS R4,R9,#'a' ;Or a lowercase letter? CMPCS R4,#26 STRCCB R9,[R1],#1 ;Yes -- store it away BLCC getToken ;Read the next byte MOVCS R0,#err_unknown ;Don't know this -- error! BCS error_report ;So give a bogus error msg CMP R9,#'$' ;Is it a dollar sign? MOVEQ R2,#vType_string ;It's a string now CMPNE R9,#'%' ;Or a percentage? STREQB R9,[R1],#1 ;Yes -- store it then CMPNE R9,#' ' ;Just check for a space BNE %b00express_read ;Go round for more MOV R14,#0 ;The terminator STRB R14,[R1],#0 ;Store that in the var name BL getToken ;Read the next token ready ; --- Check for arrays --- CMP R9,#'(' ;Is this an array? BNE %f05 ;No -- skip on then BL getToken ;Get another token ADD R2,R2,#vType_dimInt-vType_integer MOV R0,R2 ;Put that in R2 ADR R1,tsc_misc ;Point to variable name BL var_find ;Find the variable LDR R14,tsc_varTree ;Find var tree anchor LDR R14,[R14,#0] ;Grrr... SUB R3,R0,R14 ;Convert this to an offset TST R6,#eFlag__lval ;Reading an lvalue? ADDNE R2,R2,#vType_lvIntArr-vType_dimInt CMP R9,#')' ;Is it a whole array? BEQ %f00 ;Yes -- deal with that ; --- Set up for subscripting the array --- STMFD R13!,{R2} ;Save some registers MOV R0,R3 ;Get the array's offset BL exp__pushOp ;Stuff that on op stack (!) LDMFD R13!,{R0} ;And get its type BL exp__pushOp ;Stuff that on op stack too GETOP R0,254,exp__bSubscript ;Get the operator value TST R6,#eFlag__commaOk ;Are we allowing commas? ORRNE R0,R0,#1<<16 ;Yes -- set the flag then TST R6,#eFlag__lval ;Are we reading an value? ORRNE R0,R0,#1<<17 ;Yes -- set that flag BL exp__pushOp ;Put that on there ORR R6,R6,#eFlag__commaOk ;Allow commas for a while BIC R6,R6,#eFlag__lval ;Don't read as lvalues ADD R6,R6,#1<<8 ;Increment the paren count B %10express_read ;Now read the subscripts ; --- Just store the array lvalue --- 00 BL getToken ;Skip over the bracket MOV R1,R2 ;Get the type MOV R0,R3 ;And the tree offset BL exp__pushVal ;Stash it on the stack ORR R6,R6,#eFlag__op ;Expect an operator B %10express_read ;And go read that ; --- Handle strings and things --- 05 TST R6,#eFlag__lval ;Are we reading an lvalue? BNE %f20express_read ;Yes -- jump ahead TST R6,#eFlag__parseLval ;Parsing an lvalue? ORRNE R6,R6,#eFlag__done ;Yes -- we're finished ADR R1,tsc_misc ;Point to variable name MOV R0,R2 ;Get the variable type too BL var_find ;Try to find the variable ; --- Do wildly different things with strings --- CMP R2,#vType_string ;Is this a string BNE %f00 ;No -- jump ahead then LDR R14,tsc_varTree ;Load base of variable tree LDR R14,[R14] SUB R0,R0,R14 ;Get the offset of node ADD R0,R0,#4 ;Point to the actual word MOV R1,#vType_lvString ;The variable type BL ctrl_load ;Load the string into stracc MOV R0,R2 ;Put rvalue into R0,R1 MOV R1,R3 BL exp__pushVal ;Stack that nicely ORR R6,R6,#eFlag__op ;Expect an operator B %10express_read ;And keep on looking 00express_read MOV R1,R2 ;Get the operand type LDR R0,[R0,#4] ;Load the integer value BL exp__pushVal ;Stack that nicely ; --- Now try to cope with indirection --- CMP R9,#'!' ;Is this an indirection op? CMPNE R9,#'?' ;Or maybe a different one ORRNE R6,R6,#eFlag__op ;No -- expect an operator BNE %10express_read ;And go for that then CMP R9,#'?' ;Is this a '?' ? MOVEQ R0,#(exp__bQuery-exp__bTable)>>2 MOVNE R0,#(exp__bPling-exp__bTable)>>2 ORR R0,R0,#1<<24 ;Use unary op precedence BL exp__pushOp ;Stick that on the stack BL getToken ;Get another token B %10express_read ;Return, still expecting val ; --- We are reading an lvalue --- ; ; We only need to create the variable if there is not an ; indirection operator following. 20express_read CMP R9,#'!' ;Is this an indirection op? CMPNE R9,#'?' ;Or maybe a different one ORRNE R6,R6,#eFlag__done ;Yes -- we're finished BIC R6,R6,#eFlag__lval ;Clear lvalue flag too ORR R6,R6,#eFlag__parseLval ;Parse an lvalue-ish now ADR R1,tsc_misc ;Point to variable name MOV R0,R2 ;Get the variable type too BLNE var_create ;Create the variable maybe BLEQ var_find ;Or maybe we just find it ADR R14,exp__indirTran ;Point to the translation LDRB R1,[R14,R2] ;Get the new type LDRNE R14,tsc_varTree ;Get the tree address LDRNE R14,[R14] ;Wimp_Extension is shitty SUBNE R0,R0,R14 ;Find the offset ADDNE R0,R0,#4 ;Point to the actual value LDREQ R0,[R0,#4] ;If indirect op, load value BL exp__pushVal ;Push on the new value CMP R9,#'?' ;Is this a '?' ? MOVEQ R0,#(exp__bQuery-exp__bTable)>>2 MOVNE R0,#(exp__bPling-exp__bTable)>>2 CMPNE R9,#'!' ;Or a '!' ? ORREQ R0,R0,#1<<24 ;Use unary op precedence BLEQ exp__pushOp ;Stick that on the stack BLEQ getToken ;Get a token if we need to B %10express_read ;Return, still expecting val ; --- Try reading an operator --- 50express_read CMP R9,#')' ;Is this a close bracket? BEQ exp__en ;Yes -- deal with that then CMP R9,#',' ;Is it a comma? BEQ exp__comma ;Yes -- deal with that ADRL R5,exp__opTable ;Point to the op table LDR R0,[R5,R7,LSL #3]! ;Load the precedence CMP R0,#0 ;Is this reasonable? ORREQ R6,R6,#eFlag__done ;No -- stop then BEQ %10express_read ;Let things tidy up nicely BL exp__eval ;Evaluate things on the stack LDR R5,[R5,#4] ;Load the branch table offset ORR R0,R5,R0,LSL #24 ;Build the op stack entry ADD R0,R0,R8 ;Add on the op index BL exp__pushOp ;Stick that on the stack BL getToken ;Get another token BIC R6,R6,#eFlag__op ;Expect another operand B %10express_read ;And go round again ; --- Handle a closing bracket --- exp__en SUBS R6,R6,#1<<8 ;Decrement paren counter ORRLT R6,R6,#eFlag__done ;If no parens, then stop BLT %10express_read ;It was someone else's `)' BL getToken ;Get another token MOV R0,#252 ;Stop at the dummy `(' op BL exp__eval ;Force evaluation of that lot BL exp__popOp ;Pop the dummy operator ; --- Check for comma-separated pseudo-ops --- MOV R14,R0,LSR #24 ;Get the op precedence CMP R14,#254 ;Is it a cs-pseudo-op? BNE %10express_read ;No -- keep going then ; --- Reset the flags from the operator --- BIC R6,R6,#eFlag__lval+eFlag__commaOk TST R0,#1<<16 ;Is the comma-ok flag set? ORRNE R6,R6,#eFlag__commaOk ;Yes -- then set it in R6 TST R0,#1<<17 ;Is the lvalue flag set? ORRNE R6,R6,#eFlag__done+eFlag__lval ; --- Now do the required processing --- MOV R5,R0,LSR #8 ;Get the number of arguments ADD R5,R5,#1 ;One less comman than subs AND R5,R5,#&FF ;Clear the other bits AND R0,R0,#&FF ;Also find jump entry ADRL R14,exp__bTable ;Find the op table ADD PC,R14,R0,LSL #2 ;And dispatch ; --- Handle a comma --- exp__comma TST R6,#eFlag__commaOk ;Expecting a comma here? ORREQ R6,R6,#eFlag__done ;No -- must be someone else's BEQ %10express_read ;So let them handle it BL getToken ;Gobble the comma char MOV R0,#253 ;Evaluate up to pseudoop BL exp__eval ;Do lots of evaluating BL exp__popOp ;Pop the pseudoop ADD R0,R0,#1<<8 ;Bump the argument count BL exp__pushOp ;Put the pseudoop back again BIC R6,R6,#eFlag__op ;Read another operand B %10express_read ;Now continue doing things ; --- We have finished reading the expression --- 70express_read MOV R0,#254 ;Choose a suitable prec. BL exp__eval ;Do rest of evaluations BL exp__popOp ;Pop of the expression ; --- See if this was an evaluated string --- AND R14,R0,#&FF ;Get the branch table offset CMP R14,#(exp__bEvalOp-exp__bTable)>>2 BEQ exp__endEval ;Yes -- continue doing that LDMFD R13!,{R0-R6,PC}^ ;Load some registers exp__indirTran DCB vType_lvInt DCB vType_lvString DCB vType_lvIntArr DCB vType_lvStrArr LTORG ; --- exp__eval --- ; ; On entry: R0 == precedence to look for ; R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R1-R4 corrupted ; ; Use: Performs things exp__eval ROUT STMFD R13!,{R0,R14} ;Stack some registers 00exp__eval BL exp__popOp ;Pop an operator LDR R1,[R13,#0] ;Load back thing CMP R1,R0,LSR #24 ;Compare the prec things BLT %10exp__eval ;It's GE so jump ahead MOV R2,R0 ;Put op thing in R2 AND R0,R0,#&FF ;Get the branch offset ADR R1,exp__bTable ;Point to the table ADD PC,R1,R0,LSL #2 ;Branch to the do it routine exp__evalRet BL exp__pushVal ;Push the returned value B %00exp__eval ;And keep on going 10exp__eval BL exp__pushOp ;Push it back on again LDMFD R13!,{R0,PC}^ ;Return to caller LTORG ; --- exp__doMultArg --- ; ; On entry: R5 == number of subscripts provided ; R6 == flags ; R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == upcall block pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Subscripts an array of things to find just one of them. exp__doMultArg ROUT BL exp__popOp ;Pop off the function AND R0,R0,#&FF ;Get the branch offset ADR R1,exp__bTable ;Point to the table MOV R14,PC ;Set up return address ADD PC,R1,R0,LSL #2 ;Branch to the do it routine BL exp__pushVal ;Push the returned value B exp__mainLoop ;Go back to main loop LTORG ; --- A nice precedance table ---- exp__opTable DCD 0,0 DCD 25,(exp__andOps-exp__bTable)>>2 DCD 0,0 DCD 0,0 DCD 0,0 DCD 0,0 DCD 0,0 DCD 10,(exp__multOps-exp__bTable)>>2 DCD 30,(exp__orOps-exp__bTable)>>2 DCD 0,0 DCD 0,0 DCD 0,0 DCD 20,(exp__relOps-exp__bTable)>>2 DCD 15,(exp__addOps-exp__bTable)>>2 DCD 0,0 DCD 5,(exp__powOps-exp__bTable)>>2 ; --- The main dispatch table --- exp__bTable exp__andOps B exp__doAnd exp__multOps B exp__doDiv B exp__doMod B exp__doDiv B exp__doMult exp__orOps B exp__doXor B exp__doOr exp__relOps B exp__doEqual B exp__doLess B exp__doLessEq B exp__doNotEq B exp__doMore B exp__doMoreEq B exp__doLSL B exp__doASR B exp__doLSR exp__addOps B exp__doAdd B exp__doSub exp__fns B exp__doAbs B exp__doAsc B exp__doChrS B exp__doEval B exp__doLen B exp__doNot B exp__doOpenin B exp__doOpenout B exp__doOpenup B exp__doSgn B exp__doStrS B exp__doVal exp__streamOps B exp__doBget B exp__doEof B exp__doExt B exp__doGetS B exp__doPtr exp__multArgs B exp__doInstr B exp__doLeftS B exp__doMidS B exp__doRightS B exp__doStringS exp__powOps B exp__doPow exp__bUMinus B exp__doUMinus exp__bPar B exp__doParen exp__bExpEnd B exp__doEndEval exp__bEvalOp B exp__doEndEval exp__bPling B exp__doPling exp__bQuery B exp__doQuery exp__bDollar B exp__doDollar exp__bSubscript B exp__doSubscript exp__bMultArg B exp__doMultArg ; --- exp__doAdd --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Adds two things. exp__doAdd ROUT BL exp__popTwoVals ;Get two values CMP R1,#vType_integer ;Is this an integer? BNE %10exp__doAdd ;No -- onwards ho CMP R3,#vType_integer ;Is this a integer too? MOVNE R0,#err_numNeeded ;No -- get error number BNE error_report ;...and report the error ADD R0,R0,R2 ;Add the numbers together B exp__evalRet ;Jump back into eval loop ; --- Concatenate strings --- 10exp__doAdd CMP R1,#vType_string ;This is a string I hope MOVNE R0,#err_arrayBad ;Arrays are bad BNE error_report ;So says my mum CMP R3,#vType_string ;Is this a string too? MOVNE R0,#err_strNeeded ;No -- get error number BNE error_report ;...and report the error MOV R14,R2,LSL #24 ;Get the second string len CMN R14,R0,LSL #24 ;Is the string short enough? ADDCC R0,R0,R14,LSR #24 ;Add on second length BCC exp__evalRet ;Finished -- return MOV R0,#err_strTooLong ;String is too long B error_report LTORG ; --- exp__doSub --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Subtracts one thing from another thing. exp__doSub ROUT BL exp__popTwoInts ;Get two integers SUB R0,R0,R2 ;Subtract the things B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doMult --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Multiplies two things together. exp__doMult ROUT BL exp__popTwoInts ;Get two integers MUL R0,R2,R0 ;Multiply the things B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doDiv --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Divides one thing by another thing. exp__doDiv ROUT BL exp__popTwoInts ;Get two integers MOV R1,R2 ;Get the other thing to do BL divide ;Divide the things MOV R1,#vType_integer ;Set the return type B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doMod --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Gives the remainder when one thing is divided by another ; thing. exp__doMod ROUT BL exp__popTwoInts ;Get two integers MOV R1,R2 ;Get the dividend ready BL divide ;Divide the things MOV R0,R1 ;Get the remainder MOV R1,#vType_integer ;Get the type of the thing B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doPow --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Raises one thing to the power of another thing. exp__doPow ROUT BL exp__popTwoInts ;Get two integers ; --- Check for some special cases --- CMP R0,#1 ;Raising 1 ^ anything... CMPNE R2,#0 ;And raising anything ^ 0... MOVEQ R0,#1 ;Gives you 1 BEQ exp__evalRet ;And return to eval loop CMP R2,#0 ;Is the exponent negative? MOVLT R0,#0 ;Yes -- result is fractional BLT exp__evalRet ;And return to eval loop ; --- Now we use a cunning loop to make this quick --- ; ; Basically, we note that x^2y == (x^2)^y MOV R3,R0 ;Look after the x value MOV R0,#1 ;An initial multiplier 10exp__doPow MOVS R2,R2,LSR #1 ;Get bottom bit MULCS R0,R3,R0 ;If set, do multiply MUL R14,R3,R3 ;Square thing to raise MOV R3,R14 ;Can't do in one instr :-( BNE %10exp__doPow ;If not finished, continue B exp__evalRet ;Go back to eval loop LTORG ; --- exp__doAnd --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: ANDs two things. exp__doAnd ROUT BL exp__popTwoInts ;Get two integers AND R0,R0,R2 ;Do the AND op B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doOr --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: ORs two things. exp__doOr ROUT BL exp__popTwoInts ;Get two integers ORR R0,R0,R2 ;Do the OR op B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doXor --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: XORs two things. exp__doXor ROUT BL exp__popTwoInts ;Get two integers EOR R0,R0,R2 ;Do the XOR op B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doPling --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Reads a word from a memory address. exp__doPling ROUT BL exp__popTwoVals ;Get next two values CMP R1,#vType_lvInt ;We can cope with lvalues BEQ %50exp__doPling ;If this is the case, be odd BL exp__chkTwoInts ;Make sure we have integers LDR R0,[R0,R2] ;Load the word B exp__evalRet ;Jump back into eval loop 50exp__doPling CMP R3,#vType_integer ;Make sure other val is int MOVNE R0,#err_numNeeded ;If not, moan at the user BNE error_report ;That's that done then ADD R0,R0,R2 ;Calculate the address MOV R1,#vType_lvWord ;This is a word lvalue B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doQuery --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Reads a byte from a memory address. exp__doQuery ROUT BL exp__popTwoVals ;Get next two values CMP R1,#vType_lvInt ;We can cope with lvalues BEQ %50exp__doQuery ;If this is the case, be odd BL exp__chkTwoInts ;Make sure we have integers LDRB R0,[R0,R2] ;Load the byte B exp__evalRet ;Jump back into eval loop 50exp__doQuery CMP R3,#vType_integer ;Make sure other val is int MOVNE R0,#err_numNeeded ;If not, moan at the user BNE error_report ;That's that done then ADD R0,R0,R2 ;Calculate the address MOV R1,#vType_lvByte ;This is a byte lvalue B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doDollar --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Reads a word from a memory address. exp__doDollar ROUT BL exp__popTwoVals ;Get next two values CMP R1,#vType_lvInt ;We can cope with lvalues BEQ %50exp__doDollar ;If this is the case, be odd BL exp__chkTwoInts ;Make sure we have integers ADD R2,R0,R2 ;Point to the string BL stracc_ensure ;Make sure there is room MOV R3,#0 ;Number so far 00 LDRB R14,[R2],#1 ;Load a byte CMP R14,#13 ;Is this the terminator? BEQ %10exp__doDollar ;Yes -- jump ahead STRB R14,[R0],#1 ;No -- save it away ADD R3,R3,#1 ;Increment the length CMP R3,#255 ;Are we at the maximum? BLT %b00 ;No -- branch back then 10 ORR R0,R1,R3 ;Set up the lvalue MOV R1,#vType_string ;This is a string B exp__evalRet ;Jump back into eval loop ; --- The lvalue form --- 50exp__doDollar CMP R3,#vType_integer ;Make sure other val is int MOVNE R0,#err_numNeeded ;If not, moan at the user BNE error_report ;That's that done then ADD R0,R0,R2 ;Calculate the address MOV R1,#vType_lvBytes ;This is a bytes lvalue B exp__evalRet ;Jump back into eval loop LTORG ; --- RND --- exp__doRnd ROUT CMP R9,#'(' ;Do we have a bracket here? MOVNE R0,#-1 ;No -- range here then BLNE exp__rng ;And generate random number ORRNE R6,R6,#eFlag__op ;Read operator next BNE exp__mainLoop ;And go back up top BL getToken ;Gobble the bracket ; --- Start scanning for an RND multi-op --- GETOP R0,1,exp__rndArg ;Get the operator value BL exp__pushOp ;Put that on the stack GETOP R0,254,exp__bMultArg ;Get the operator value TST R6,#eFlag__commaOk ;Are we allowing commas? ORRNE R0,R0,#1<<16 ;Yes -- set the flag then BL exp__pushOp ;Put that on there BIC R6,R6,#eFlag__commaOk ;Disallow commas for a while ADD R6,R6,#1<<8 ;Increment the paren count B exp__mainLoop ;And go back up top LTORG ; --- RND(arg) --- exp__rndArg ROUT STMFD R13!,{R14} ;Save a register BL exp__popInt ;Pop off the argument CMP R0,#0 ;Is the value negative? BLT %50exp__rndArg ;Yes -- deal with that CMPNE R0,#1 ;Is it one then? BEQ %60exp__rndArg ;Yes -- be odd then BL exp__rng ;And generate random number BL exp__popVal ;Pop the value off LDMFD R13!,{PC}^ ;Return to caller ; --- Store a seed --- 50exp__rndArg STR R0,tsc_rndSeed ;Store the new seed MOV R14,#0 ;Clear the top bit STR R14,tsc_rndSeed+4 ;Store that too LDMFD R13!,{PC}^ ;And return to caller ; --- Request for FP random number --- 60exp__rndArg STMFD R13!,{R5} ;Save another register MOV R0,#0 ;Return zero here MOV R1,#vType_integer ;Say this is an integer LDMFD R13!,{R5,PC}^ ;And return LTORG ; --- exp__rng --- ; ; On entry: R0 == maximum value for random number ; ; On exit: -- ; ; Use: Stacks a random number between 1 and R0. exp__rng ROUT STMFD R13!,{R0-R5,R14} ;Save lots of registers MOV R3,R0 ;Look after this ADR R14,tsc_rndSeed ;Find the random seed LDMIA R14,{R0,R1} ;Load that out TST R1,R1,LSR #1 ;Top bit into carry MOVS R2,R0,RRX ;33-bit rotate right ADC R1,R1,R1 ;Carry into LSB of Rb EOR R2,R2,R0,LSL #12 ;(Involved!) EOR R0,R2,R2,LSR #20 ;(Similarly involved!) STMIA R14,{R0,R1} ;Store new seed back MOV R1,R3 ;Get maximum value again BL div_unsigned ;Do the division we need ADD R0,R1,#1 ;Fit it into range MOV R1,#vType_integer ;This is an integer BL exp__pushVal ;Push it onto the stack LDMFD R13!,{R0-R5,PC}^ ;And return to caller LTORG ; --- Relational operators (and shifts) --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Does comparing. Or shifting. Depending. exp__doLess ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVLT R0,#-1 ;It's less -- that's true MOVGE R0,#0 ;It's more or equal, -- false MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doMore ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVGT R0,#-1 ;It's more -- that's true MOVLE R0,#0 ;It's less or equal, -- false MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doLessEq ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVLE R0,#-1 ;It's less or equal -- true MOVGT R0,#0 ;It's more -- that's false MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doMoreEq ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVGE R0,#-1 ;It's more or equal -- true MOVLT R0,#0 ;It's less -- that's false MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doEqual ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVEQ R0,#-1 ;If equal, return TRUE MOVNE R0,#0 ;Otherwise return FALSE MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doNotEq ROUT BL exp__popTwoVals ;Get two values BL ctrl_compare ;Compare them MOVNE R0,#-1 ;If nonzero, return TRUE MOVEQ R0,#0 ;Otherwise return FALSE MOV R1,#vType_integer ;We are returning an integer B exp__evalRet ;Jump back into eval loop LTORG exp__doLSL ROUT BL exp__popTwoInts ;Get two integers MOV R0,R0,LSL R2 ;Do the shift B exp__evalRet ;Jump back into eval loop LTORG exp__doLSR ROUT BL exp__popTwoInts ;Get two integers MOV R0,R0,LSR R2 ;Do the shift B exp__evalRet ;Jump back into eval loop LTORG exp__doASR ROUT BL exp__popTwoInts ;Get two integers MOV R0,R0,ASR R2 ;Do the shift B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doUMinus --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Negates a thing. exp__doUMinus ROUT BL exp__popInt ;Pop a val RSB R0,R0,#0 ;Negate the thing B exp__evalRet ;Jump back into eval loop LTORG ; --- exp__doSubscript --- ; ; On entry: R5 == number of subscripts provided ; R6 == flags ; R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == upcall block pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Subscripts an array of things to find just one of them. exp__doSubscript ROUT BL exp__popOp ;Read the array's type STMFD R13!,{R0} ;Save that away BL exp__popOp ;Now find the offset too LDMFD R13!,{R2} ;Restore the type word LDR R14,tsc_varTree ;Find the variable tree LDR R14,[R14,#0] ;Grrr... ADD R3,R0,R14 ;Find the actual array ; --- Do some preliminary checking --- LDR R14,[R3,#4] ;Find number of subscripts CMP R14,R5 ;Do they match up? MOVNE R0,#err_numSubs ;No -- get an error BNE error_report ;And report it ; --- Now actually find the element --- STMFD R13!,{R2,R7-R10} ;Save some more registers ADD R10,R3,#12 ;Point to subscripts ADD R10,R10,R5,LSL #2 ;Find topmost subscript MOV R9,R10 ;Do this again MOV R8,#0 ;Current element is 0 MOV R7,R5 ;Get the number of subscripts 00 BL exp__popInt ;Read the next integer LDR R14,[R9,#-4]! ;And load subscript size CMP R0,R14 ;How does this compare? MOVCS R0,#err_subRange ;Out of range -- get error BCS error_report ;And report it MLA R8,R14,R8,R0 ;Accumulate subscript SUBS R7,R7,#1 ;Decrement my counter BGT %b00 ;If more to go, keep on ; --- Finally get an rvalue or lvalue as required --- ADD R0,R10,R8,LSL #2 ;Find the lvalue LDMFD R13!,{R1,R7-R10} ;Restore system registers LDR R14,tsc_varTree ;Find the variable tree LDR R14,[R14,#0] ;Grrr... SUB R0,R0,R14 ;Yes -- turn into offset TST R6,#eFlag__lval ;Reading an lvalue? SUBNE R1,R1,#vType_lvIntArr-vType_lvInt SUBEQ R1,R1,#vType_dimInt-vType_lvInt BLEQ ctrl_load ;No -- load rvalue then MOVEQ R0,R2 ;And shift results around MOVEQ R1,R3 ;Because of strangeness BL exp__pushVal ;Push the result B exp__mainLoop ;Go back to main loop LTORG ; --- exp__doParen --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Complains. exp__doParen ROUT MOV R0,#err_expBracket ;Get the error message B error_report ;And complain bitterly LTORG ; --- exp__doEndEval --- ; ; On entry: R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0-R3 corrupted ; ; Use: Complains. exp__doEndEval ROUT MOV R0,#err_erk ;Get the error message B error_report ;And complain bitterly LTORG ; --- exp__getString --- ; ; On entry: R0 == buffer for string ; R7, R8, R9 == lookahead token ; R10 == pointer into tokenised buffer ; R11 == evaluation stack pointer ; R12 == anchor pointer ; ; On exit: R0 == length of string ; ; Use: Reads a string argument, and copies it into tsc_misc. exp__getString ROUT STMFD R13!,{R1-R5,R14} ;Stack some register MOV R5,R0 ;Look after address BL exp__popStr ;Get a string LDR R1,tsc_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 R3,R0 ;Look after the rvalue MOV R0,R5 ;Point to a buffer BL termite_copyString ;Copy the string over MOV R0,R3 ;Put the rvalue back BL stracc_free ;Won't need it any more MOV R0,R2 ;Put the length in R0 LDMFD R13!,{R1-R5,PC}^ ;Return to caller LTORG ;----- Pseudovariables ------------------------------------------------------ ; --- TIME --- exp__doTime STMFD R13!,{R14} SWI OS_ReadMonotonicTime LDR R1,tsc_timeOff SUB R0,R0,R1 MOV R1,#vType_integer BL exp__pushVal LDMFD R13!,{PC}^ ; --- TIME$ --- exp__doTimeS STMFD R13!,{R14} ;Save some registers ; --- First, read the system clock --- SUB R13,R13,#8 ;Get a nice block MOV R0,#14 ;Read the system clock MOV R1,R13 ;Point to the block MOV R14,#3 ;Get the reason code STRB R14,[R1,#0] ;Store in block SWI OS_Word ;Read the time then ; -- Now put it into stracc --- BL stracc_ensure ;Make sure we have room MOV R4,R1 ;Remember the index MOV R1,R0 ;Put the address in R1 MOV R0,R13 ;Point to time block MOV R2,#255 ;Size of the buffer ADR R3,exp__timeFormat ;Point to the format SWI OS_ConvertDateAndTime ;Convert the date and time ORR R0,R4,#24 ;Set up the rvalue MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about this ADD R13,R13,#8 ;Reclaim my stack BL exp__pushVal ;Push on my value LDMFD R13!,{PC}^ ;Return the caller exp__timeFormat DCB "%W3,%DY %M3 %CE%YR.%24:%MI:%SE",0 ; --- FALSE --- exp__doFalse MOV R0,#0 MOV R1,#vType_integer B exp__pushVal ; --- TRUE --- exp__doTrue MOV R0,#-1 MOV R1,#vType_integer B exp__pushVal ;----- Functions ------------------------------------------------------------ ; --- EVAL --- exp__doEval ROUT ; --- Hack the stack --- ; ; We're called from exp__eval, which has stacked R0 and R14. ; We pop these off the stack, and stuff them onto the op ; stack instead. Yukmeister. LDMFD R13!,{R0} ;Get R0 off the stack BL exp__pushOp ;Push that onto op stack LDMFD R13!,{R0} ;And R14 off too BL exp__pushOp ;Push that onto op stack MOV R0,R5 ;We need to corrupt R5 BL exp__pushOp ;Push that onto op stack ; --- Tokenise the string to evaluate --- BL stracc_ensure ;Make space for tokenised STMFD R13!,{R0,R1} ;Save the address away BL exp__popStr ;Pop the string LDR R14,tsc_stracc ;Load stracc anchor address LDR R14,[R14,#0] ;Grrr.... MOV R5,R0 ;Remember this for a while AND R1,R0,#&FF ;Get the string length ADD R0,R14,R0,LSR #8 ;Work out string address LDMFD R13!,{R2} ;Load the address out MOV R3,#0 ;Just tokenise the expression BL tokenise ;Go and do that then LDMFD R13!,{R0} ;Load the stracc rvalue ADD R0,R0,#&FF ;Say it's very long BL stracc_added ;And record that ; --- Now save state on the op stack --- STMFD R13!,{R2} ;Save the address again MOV R0,R5 ;Save the stracc offset BL exp__pushOp ;Stack that MOV R0,R6 ;Save the eval flags BL exp__pushOp ;Stack that LDR R0,tsc_oldAnchor ;Load the old anchor BL exp__pushOp ;Push that away too LDR R0,tsc_currAnchor ;Load current file anchor STR R0,tsc_oldAnchor ;This is now the old one LDR R0,[R0,#0] ;Load the actual pointer SUB R0,R10,R0 ;Find the file offset BL exp__pushOp ;Push that away too LDR R14,tsc_stracc ;Input is now in stracc STR R14,tsc_currAnchor ;This is the new anchor LDMFD R13!,{R10} ;Load the new address GETOP R0,255,exp__bEvalOp ;Create a pseudoop BL exp__pushOp ;Stuff that on the stack MOV R6,#0 ;Just read an expression MOV R9,#-1 ;Make getToken happy BL getToken ;Prime the first token B exp__mainLoop ;And resume the main loop LTORG ; --- exp__endEval --- exp__endEval ROUT BL exp__popOp ;Pop the file offset MOV R10,R0 ;Look after this LDR R14,tsc_oldAnchor ;Load the previous anchor STR R14,tsc_currAnchor ;This is now the current one LDR R14,[R14,#0] ;Bodge for wimpextension ADD R10,R14,R10 ;Relocate the output pointer BL exp__popOp ;And the anchor pointer STR R0,tsc_oldAnchor ;Remember this now SUB R10,R10,#1 ;Quick hack now MOV R9,#-1 ;Make getToken happy BL getToken ;Prime lookahead token BL exp__popOp ;Pop the express_read flags MOV R6,R0 ;Re-instate them BL exp__popOp ;Get the stracc offset BL stracc_free ;Free *both* the strings BL exp__popOp ;Get preserved R5 value MOV R5,R0 ;Put that back nicely BL exp__popOp ;Get stacked R14 value STMFD R13!,{R0} ;Push that back on the stack BL exp__popOp ;Get stacked R0 value STMFD R13!,{R0} ;Push that back on the stack BL exp__popVal ;Pop the result (odd) B exp__evalRet ;Now leap back into routine LTORG ; --- VAL --- exp__doVal ROUT ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get a string ADR R1,tsc_misc ;Point to the string ; --- Scan the string --- ; ; We skip spaces, and stop at the first non space. ; If that happens to be a minus sign, we remember that. 00 LDRB R14,[R1],#1 ;Read the character CMP R14,#0 ;Are we at the end? MOVEQ R0,#0 ;Yes -- get the rvalue BEQ %20exp__doVal ;And jump ahead a bit CMP R14,#32 ;Is this a space BEQ %b00 ;Yes -- go round for more CMP R14,#'-' ;Is it a minus sign? SUBNE R1,R1,#1 ;No -- backtrack then MOV R0,#10 ;Read as base 10 by default SWI XOS_ReadUnsigned ;Read the value RSBEQ R0,R2,#0 ;Negate if we should MOVNE R0,R2 ;Otherwise don't bother MOVVS R0,#0 ;Return 0 on an error 20 MOV R1,#vType_integer ;This is an integer B exp__evalRet ;Return to eval loop LTORG ;----- Arithmetic routine --------------------------------------------------- ; --- ABS --- exp__doAbs ROUT BL exp__popInt ;Get an integer CMP R0,#0 ;Is the argument <0? RSBLT R0,R0,#0 ;Yes -- negate it then B exp__evalRet ;Return to eval loop LTORG ; --- NOT --- exp__doNot ROUT BL exp__popInt ;Get an integer MVN R0,R0 ;Invert the operand B exp__evalRet ;Return to eval loop LTORG ; --- SGN --- exp__doSgn ROUT BL exp__popInt ;Get an integer CMP R0,#0 ;Compare argument with 0 MOVGT R0,#1 ;If bigger return 1 MOVLT R0,#-1 ;If smaller, return -1 B exp__evalRet ;Return to eval loop LTORG ;----- String associated routines ------------------------------------------- ; --- ASC --- exp__doAsc ROUT BL exp__popStr ;Get a string BL stracc_free ;Won't need it any more MOV R1,#vType_integer ;We will return an int TST R0,#&FF ;Is this a NULL string? MOVEQ R0,#-1 ;Yes -- return -1 then BEQ exp__evalRet LDR R14,tsc_stracc ;Loacte stracc LDR R14,[R14] ADD R14,R14,R0,LSR #8 ;Point to the string LDRB R0,[R14,#0] ;Load a byte B exp__evalRet ;Return this to caller ; --- CHR$ --- exp__doChrS ROUT BL exp__popInt ;Pop an integer MOV R2,R0 ;Look after the value BL stracc_ensure ;Make sure there's space MOVS R14,R2,LSR #8 ;Check the value's OK STREQB R2,[R0,#0] ;If so, store it ORREQ R1,R1,#1 ;And set length one MOV R0,R1 ;Get the rvalue MOV R1,#vType_string ;Say it's a string BL stracc_added ;Say I've added it B exp__evalRet ;And return to eval loop ; --- LEN --- exp__doLen ROUT BL exp__popStr ;Get a string BL stracc_free ;Won't need it any more AND R0,R0,#&FF ;Get the length MOV R1,#vType_integer ;This is an integer B exp__evalRet ;Return to eval loop ; --- STR$ --- exp__doStrS ROUT TST R2,#(1<<16) ;Is this a hex conversion? BL exp__popInt ;Pop an integer MOV R3,R0 ;Put it in R3 BL stracc_ensure ;Make sure we have room MOV R4,R1 ;Look after the offset BNE %10exp__doStrS ;If hex -- jump ahead MOV R1,R0 ;Write result to here MOV R2,#255 ;Buffer is big MOVS R0,R3 ;Put the number in here RSBLT R0,R0,#0 ;If -ve, mak positive MOVLT R14,#'-' ;...get a minus ready STRLTB R14,[R1],#1 ;Store in the buffer SWI OS_ConvertInteger4 ;Convert to a string SUB R14,R1,R0 ;Get the string length ADDLT R14,R14,#1 ;There may be a minus ORR R0,R4,R14 ;Get the rvalue MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about it B exp__evalRet ;Return to eval loop ; --- We need to output as hex --- 10exp__doStrS ADR R1,tsc_misc ;Point to a nice buffer 00 AND R2,R3,#&F ;Get teh remainder MOV R3,R3,LSR #4 ;Divide number by 16 ADD R14,R2,#'0' ;Turn into a digit CMP R14,#'9'+1 ;Is it too big for this? ADDCS R14,R14,#'A'-'9'-1 ;Yes -- turn into a letter STRB R14,[R1],#1 ;Save the next byte CMP R3,#0 ;Have we finished now? BNE %b00 ;Yes -- jump back then ; --- Copy the digits over --- ; ; The characters are now in the buffer in reverse order ADR R2,tsc_misc ;Point to the buffer SUBS R2,R1,R2 ;Get the number of chars ORR R4,R4,R2 ;Put that in the index 00 LDRGTB R14,[R1,#-1]! ;Load out byte STRGTB R14,[R0],#1 ;Store that in the buffer SUBS R2,R2,#1 ;Reduce the number count BGT %b00 ;And keep on doing this MOV R0,R4 ;Get the rvalue MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about it B exp__evalRet ;Return to eval loop LTORG ;----- File operations ------------------------------------------------------ ; --- OPENOUT --- exp__doOpenout ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get the string argument MOV R0,#&81 ;The flags to open with ADR R1,tsc_misc ;Point to the name SWI XOS_Find ;Try to open the file BVS error_reportReal ;Return possible error BL exp__opened ;Remember we opened the file MOV R1,#vType_integer ;We will return an int B exp__evalRet ;Return this to caller LTORG ; --- OPENUP --- exp__doOpenup ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get the string argument MOV R0,#&C7 ;The flags to open with ADR R1,tsc_misc ;Point to the name SWI XOS_Find ;Try to open the file BVS error_reportReal ;Return possible error BL exp__opened ;Remember we opened the file MOV R1,#vType_integer ;We will return an int B exp__evalRet ;Return this to caller LTORG ; --- OPENIN --- exp__doOpenin ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get the string argument MOV R0,#&47 ;The flags to open with ADR R1,tsc_misc ;Point to the name SWI XOS_Find ;Try to open the file BVS error_reportReal ;Return possible error BL exp__opened ;Remember we opened the file MOV R1,#vType_integer ;We will return an int B exp__evalRet ;Return this to caller LTORG ; --- exp__opened --- ; ; On entry: R0 == file handle ; ; On exit: -- ; ; Use: Remembers that a file has been opened. (Bit bashing code ; courtesy of the RISC OS 3.5 Keyboard Drivers, duplicated ; without permission.) exp__opened ROUT STMFD R13!,{R0-R2,R14} ;Save some registers ADR R1,tsc_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 ORR R14,R14,R2,ROR R0 ;Set the correct bit STR R14,[R1,#0] ;Save the word back again LDMFD R13!,{R0-R2,PC}^ ;And return to caller LTORG ;----- Stream operations ---------------------------------------------------- ; --- BGET --- exp__doBget ROUT BL exp__popInt ;Get an integer MOV R1,R0 ;Put it in R1 SWI XOS_BGet ;Get a byte from the file BVS error_reportReal MOV R1,#vType_integer ;It's an integer Jim B exp__evalRet ;Return to eval loop LTORG ; --- EOF --- exp__doEof ROUT BL exp__popInt ;Get an integer MOV R1,R0 ;Put it in R1 MOV R0,#5 ;Read EOF status SWI XOS_Args ;Read it then BVS error_reportReal MOVS R0,R2 ;Put result in R0 MOVNE R0,#-1 ;Make it -1 if TRUE MOV R1,#vType_integer ;It's an integer Jim B exp__evalRet ;Return to eval loop LTORG ; --- EXT --- exp__doExt ROUT BL exp__popInt ;Get an integer MOV R1,R0 ;Put it in R1 MOV R0,#2 ;Read EOF status SWI XOS_Args ;Read it then BVS error_reportReal MOV R0,R2 ;Put result in R0 MOV R1,#vType_integer ;It's an integer Jim B exp__evalRet ;Return to eval loop LTORG ; --- GET$ --- exp__doGetS ROUT BL exp__popInt ;Get an integer MOV R4,R0 ;Put it in R4 BL stracc_ensure ;Ensure there is enough space MOV R2,R0 ;Remember the address MOV R3,R1 ;And the offset MOV R1,R4 ;Put file handle in R1 MOV R4,#0 ;The length so far 00 SWI XOS_BGet ;Geta byte BVS error_reportReal ;Report possible error BCS %10exp__doGetS ;Undefined -- dropout CMP R0,#10 ;Have we reached the end? CMPNE R0,#13 CMPNE R0,#0 BEQ %10exp__doGetS ;Yes -- drop out STRB R0,[R2],#1 ;No -- store the byte ADD R4,R4,#1 ;And increment the count CMP R4,#255 ;Have we read the maximum? BLT %b00 ;No -- keep getting them 10exp__doGetS ORR R0,R3,R4 ;Get the rvalue MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about this B exp__evalRet ;Return to eval loop ; --- PTR --- exp__doPtr ROUT BL exp__popInt ;Get an integer MOV R1,R0 ;Put it in R1 MOV R0,#0 ;Read EOF status SWI XOS_Args ;Read it then BVS error_reportReal MOV R0,R2 ;Put result in R0 MOV R1,#vType_integer ;It's an integer Jim B exp__evalRet ;Return to eval loop LTORG ;---- Multiple argument things ---------------------------------------------- ; --- exp__midString --- ; ; On entry: R1 == index into string ; R2 == number of chars needed ; String is in tsc_misc ; ; On exit: R0, R1 == value to push ; ; Use: Performs a string extraction on the string exp__midString ROUT STMFD R13!,{R14} ;Stack the link ADR R0,tsc_misc ;Point to the string ADD R3,R0,R1 ;Copy from here MOV R4,R2 ;Remember the length BL stracc_ensure ;Make sure we have room CMP R2,#0 ;Anything to copy? 00 LDRGTB R14,[R3],#1 ;Load a byte STRGTB R14,[R0],#1 ;Store it SUBS R2,R2,#1 ;Decrement the count BGT %b00 ;Go round for more ORR R0,R1,R4 ;Get the rvalue MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about this LDMFD R13!,{PC}^ ;Return to caller LTORG ; --- LEFT$ --- exp__doLeftS ROUT STMFD R13!,{R2-R6,R14} ;Stack registers CMP R5,#2 ;Two of them? MOVNE R0,#err_leftSArgs ;No -- get the error number BNE error_report ;And report the error BL exp__popInt ;Get the number of chars MOV R2,R0 ;Put that in R2 MOV R1,#0 ;From the beginning ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get then string CMP R2,R0 ;Are we getting too many? MOVCS R2,R0 ;Yes -- get this many BL exp__midString ;Do the mid$ LDMFD R13!,{R2-R6,PC}^ ;Return to caller LTORG ; --- MID$ --- exp__doMidS ROUT STMFD R13!,{R2-R6,R14} ;Stack registers CMP R5,#2 ;Two of them? CMPNE R5,#3 ;Or maybe 3? MOVNE R0,#err_midSArgs ;No -- get the error number BNE error_report ;And report the error CMP R5,#2 ;Just two args? BEQ %10exp__doMidS ;Yes -- jump ahead BL exp__popTwoInts ;Get the number of chars SUBS R1,R0,#1 ;Put index in R1 MOVLT R1,#0 ;Put it in range ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get then string CMP R1,R0 ;Is the index in range? MOVGT R1,R0 ;No -- put it in range SUB R14,R0,R1 ;Get number of chars left CMP R2,R14 ;Are we getting too many? MOVCS R2,R14 ;Yes -- get this many BL exp__midString ;Do the mid$ LDMFD R13!,{R2-R6,PC}^ ;Return to caller ; --- Deal with 2 arg variation --- 10exp__doMidS BL exp__popInt ;Get the index SUB R1,R0,#1 ;Put it in R1 ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Get the string CMP R1,R0 ;Are we in range? MOVCS R1,R0 ;No -- we are now SUB R2,R0,R1 ;Get the number to get BL exp__midString ;Do the mid$ LDMFD R13!,{R2-R6,PC}^ ;Return to caller LTORG ; --- RIGHT$ --- exp__doRightS ROUT STMFD R13!,{R2-R6,R14} ;Stack registers CMP R5,#2 ;Two of them? MOVNE R0,#err_rightSArgs ;No -- get the error number BNE error_report ;And report the error BL exp__popInt ;Get the number MOV R2,R0 ;Put it in R2 ADR R0,tsc_misc ;Point to the buffer BL exp__getString ;Get the string SUBS R1,R0,R2 ;Work out the index MOVLT R1,#0 ;If getting too many, reduce MOVLT R2,R0 BL exp__midString ;Do the mid$ LDMFD R13!,{R2-R6,PC}^ ;Return to caller LTORG ; --- STRING$ --- exp__doStringS ROUT ; --- Make sure we have the right number of arguments --- STMFD R13!,{R2-R6,R14} ;Stack registers CMP R5,#2 ;Two of them? MOVNE R0,#err_stringSArgs ;No -- get the error number BNE error_report ;And report the error ADR R0,tsc_misc ;Point to a buffer BL exp__getString ;Copy the string into buffer MOV R5,R0 ;Put length in R2 BL exp__popInt ;Pop an integer MOV R3,R0 ;Put number in R3 MUL R6,R5,R0 ;Get the overall length CMP R6,#255 ;Is it too big? MOVGT R0,#err_strTooLong ;Yes -- get error number BGT error_report ;And report it happily ; --- Now copy the string --- CMP R5,#0 ;Is this a 0 length string? MOVEQ R0,#0 ;Yes -- get rvalue BEQ %10exp__doStringS ;And jump ahead BL stracc_ensure ;Make sure we have room MOV R4,R1 ;Look after the offset MOV R2,R5 ;Keep copy of length 00 ADR R1,tsc_misc ;Point to the string 05 LDRB R14,[R1],#1 ;Load a byte STRB R14,[R0],#1 ;Store it SUBS R2,R2,#1 ;Decrement the string length BGT %b05 ;And go round for more MOV R2,R5 ;Get the length back SUBS R3,R3,#1 ;Decrment other counter BGT %b00 ;And go round for more ORR R0,R4,R6 ;Get the rvalue 10 MOV R1,#vType_string ;This is a string BL stracc_added ;Tell stracc about it LDMFD R13!,{R2-R6,PC}^ ;Return to caller LTORG ; --- INSTR --- exp__doInstr ROUT STMFD R13!,{R5,R14} ;Stack registers CMP R5,#2 ;Two of them? CMPNE R5,#3 ;Or maybe 3? MOVNE R0,#err_instrSArgs ;No -- get the error number BNE error_report ;And report the error CMP R5,#3 ;Are there 3 args? BLEQ exp__popInt ;Yes -- get it then SUBEQ R5,R0,#1 ;And reduce by 1 MOVNE R5,#0 ;Otherwise use 0 BL exp__popTwoStrs ;Get two strings STMFD R13!,{R0,R6-R9} ;Stack nice stracc position LDR R14,tsc_stracc ;Get the stracc anchor LDR R14,[R14] AND R1,R0,#&FF ;Get a string length ADD R0,R14,R0,LSR #8 ;Point at the strings AND R3,R2,#&FF ;Do this for... ADD R2,R14,R2,LSR #8 ;...both of them SUB R1,R1,R5 ;Get len of remaining string 05 CMP R1,R3 ;Enough string for a match? BLT %90exp__doInstr ;No match -- jump onwards ADD R6,R0,R5 ;Look after values MOV R7,R2 MOV R9,R3 ;Remember the length too 00 SUBS R9,R9,#1 ;Reduce length count BLT %95exp__doInstr ;We have a match :-) LDRB R8,[R6],#1 ;Load a byte LDRB R14,[R7],#1 ;From both strings CMP R8,R14 ;Do the bytes match? BEQ %b00 ;Yes -- keep on comparing ADD R5,R5,#1 ;Increment the position SUB R1,R1,#1 ;Reduce length B %b05 ;And keep on going ; --- We return failure --- 90 LDMFD R13!,{R0,R6-R9} ;Load back registers BL stracc_free ;Free my strings MOV R0,#0 ;No match MOV R1,#vType_integer ;Return a string please LDMFD R13!,{R5,PC}^ ;Return to caller ; --- Return success then --- 95 LDMFD R13!,{R0,R6-R9} ;Load back registers BL stracc_free ;Free my strings ADD R0,R5,#1 ;No match MOV R1,#vType_integer ;Return a string please LDMFD R13!,{R5,PC}^ ;Return to caller LTORG ;----- Flags and things ----------------------------------------------------- eFlag__commaOk EQU (1<<0) ;We can cope with commas here eFlag__op EQU (1<<1) ;We are reading an operator eFlag__done EQU (1<<2) ;Finished reading expression eFlag__lval EQU (1<<3) ;Reading an lvalue eFlag__parseLval EQU (1<<4) ;We are parsing an lvalue ;----- That's all, folks ---------------------------------------------------- END