; ; choices.options.s ; ; Read options from an options chunk (MDW) ; ; © 1995 Straylight ; ;----- Standard header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ GET sapphire:chunk GET sapphire:divide GET sapphire:flex GET sapphire:string GET sapphire:xfer.xsave ;----- Main code ------------------------------------------------------------ AREA |Sapphire$$Code|,CODE,READONLY ; --- options_read --- ; ; On entry: R0 == chunk file handle ; R1 == pointer to a chunk name ; R2 == pointer to options definition ; R3,R4 specify address of output block ; ; On exit: -- ; ; Use: Claims the specified options chunk, and reads the data in ; it into a binary block. Because the output data might be ; in a flex block, the two registers R3,R4 which define its ; address work as follows: ; ; R3 == address or offset of data ; R4 == -1 if R3 is address, else flex anchor address EXPORT options_read options_read ROUT STMFD R13!,{R0-R10,R14} ;Save some registers MOV R5,R3 ;Move output block address MOV R6,R4 ;Somewhere safe MOV R3,R2 ;Put definition in R10 MOV R4,#0 ;I have no workspace ADR R2,options__saver ;Point to options saver BL chunk_claim ;Claim this chunk BVS %90options_read ;If it failed, return STMIB R1,{R3,R5,R6} ;Save def and output block STMFD R13!,{R1} ;Look after this address ; --- Start work on parsing the block --- CMP R6,#-1 ;Is this a flex block? LDRNE R6,[R6] ;Yes -- load the anchor ADDNE R5,R6,R5 ;And find the output address MOV R6,R5 ;Copy address over to R6 MOV R0,R1 ;Point to flex anchor BL flex_size ;Find the block size LDR R4,[R1] ;Load the block base ADD R5,R4,R0 ;Find limit of anchor ; --- State 0: Newline --- opt__newline ADR R7,%f00 ;Where to go on newline ADR R8,opt__end ;Where to go on EOF ADR R9,opt__comment ;Where to go on comment ADR R10,%f00 ;Where to go on whitespace 00 BL opt__nextChar ;Get another character ADR R7,opt__newline ;Start all over on newline ; --- State 1: Read an option name --- opt__optName MOV R1,R11 ;Find start of name buffer ADR R10,opt__equals ;On whitespace, find equals 00 STRB R0,[R1],#1 ;Save this first byte BL opt__nextChar ;Get the next byte ready CMP R0,#'=' ;Is this an equals BNE %b00 ;Otherwise branch back B opt__wsArg ;Yes -- skip ws and get arg ; --- State 2: Skip optional `=' sign --- opt__equals BL opt__nextChar ;Get another character CMP R0,#'=' ;Is this an equals BNE opt__arg ;No -- start on the argument ; --- State 3: Skip leading whitespace on argument --- opt__wsArg ADR R10,%f00 ;On whitespace, loop 00 BL opt__nextChar ;Get another character ; --- State 4: Read the argument --- ; ; Here we just sort out what to do next; we don't actually ; read anything. opt__arg MOV R14,#0 ;Null terminate the name STRB R14,[R1],#1 ;Stuff that on the end BL str_buffer ;Get a string buffer MOV R2,R1 ;Look after its address ADR R7,opt__readArg ;Stop reading at newline ADR R8,opt__readArg ;Or at end of file CMP R0,#'`' ;A leading backquote is... MOVEQ R0,#''' ;... the same as a quote CMPNE R0,#''' ;Is string in single quotes? CMPNE R0,#'"' ;Is string in double quotes? BEQ opt__quote ;Yes -- handle that ; --- State 5: Read undelimited argument --- opt__undelim ADR R9,opt__readArg ;Stop at comment chars too ADR R10,%f00 ;But whitespace is important 00 STRB R0,[R1],#1 ;Store byte in buffer BL opt__nextChar ;Get another character B %b00 ;And keep on going ; --- State 6: Read quote delimited argument --- ; ; Here we don't use the normal nextChar system, because (a) ; we'd need to turn most of it off, and (b) I need a ; register! opt__quote MOV R14,R0 ;Look after delimiter 00 CMP R4,R5 ;Finished yet? LDRCCB R0,[R4],#1 ;Load a byte from the block MOVCS R0,#-1 ;Otherwise say it's -1 CMP R0,#&0A ;Found a newline here? CMPNE R0,#-1 ;Or the end of file? BEQ opt__readArg ;Yes -- stop going then CMP R0,R14 ;Is this a quote character? STRNEB R0,[R1],#1 ;No -- stuff it in the buffer BNE %b00 ;And leap backwards CMP R4,R5 ;Finished yet? LDRCCB R0,[R4],#1 ;Load a byte from the block MOVCS R0,#-1 ;Otherwise say it's -1 CMP R0,R14 ;Is the quote doubled? STREQB R0,[R1],#1 ;Yes -- stuff in the buffer BEQ %b00 ;And leap backwards ; --- State 7: Skip the rest of the line --- ; ; We must have (a) reached the end of the line/file, (b) ; found a comment start, or (c) finished a delimited string. ; In all these cases we should skip on until the start of ; a line (unless we're already there, of course). opt__readArg CMP R0,#&0A ;Was that a line end? CMPNE R0,#-1 ;Or the end of it all? CMPNE R4,R5 ;Finished yet? LDRNEB R0,[R4],#1 ;Load a byte from the block BNE opt__readArg ;And see if we skip that too ; --- State 8: Finally we can get on with the search --- opt__search MOV R14,#0 ;Terminate the string STRB R14,[R1],#1 ;Store that on the end MOV R10,R3 ;Find the option block base 00 ADD R0,R10,#opt_name ;Find the option name MOV R1,R11 ;Point to our option name BL str_icmp ;Compare the strings BEQ opt__read ;Match -- handle that LDMIA R10,{R7,R8} ;Load flags and size TST R7,#optFlag_last ;Is this the last entry? ADDEQ R10,R10,R8 ;No -- move on to next one BEQ %b00 ;And loop back again B opt__newline ;No joy -- try the next line ; --- Found a matching block -- call parser --- opt__read LDMIA R10,{R0,R1,R7,R8} ;Load all the data out TST R7,#optFlag_ignore ;Are we meant to read this? BNE opt__newline ;No -- ignore it then MOV R1,R2 ;Point to argument string MOV R2,R8 ;Look after the type addr ADD R8,R10,#opt_name ;Point to official name ADD R10,R6,R7 ;Find binary rep buffer MOV R9,R8 ;Point to name start MOV R7,R0 ;And get the flags word 00 LDRB R14,[R9],#1 ;Load byte from name CMP R14,#&20 ;Is this the end yet? BCS %b00 ;No -- keep looking then ADD R9,R9,#3 ;Now word align pointer BIC R9,R9,#3 ;This is type-specific ptr MOV R0,#optReason_read ;Tell routine to read MOV R14,PC ;Set up return address MOV PC,R2 ;And call the routine B opt__newline ;And try the next line ; --- Read a comment --- opt__comment CMP R4,R5 ;Finished yet? LDRNEB R0,[R4],#1 ;Load a byte from the block CMPNE R0,#&0A ;Was that a line end? BNE opt__comment ;And see if we skip that too B opt__newline ;Try the next line now ; --- Reached the very end finally --- opt__end LDMFD R13!,{R0} ;Load the anchor block MOV R1,#0 ;Don't free -- just reduce BL flex_extend ;No longer need this MOV R14,#0 ;Zero the anchor now STR R14,[R0,#0] ;To make things happy 90options_read LDMFD R13!,{R0-R10,PC}^ ;Return to caller at last ; --- opt__nextChar --- ; ; In a somewhat strange attempt to keep code size down, we ; do checking for lots of strange characters here. Addresses ; of bits of code to call on newlines, comments etc. are ; held in registers. Most of the time, then, you don't ; even need an explicit loop. For example ; ; ADR R10,{PC}+4 ; BL opt__nextChar ; ; skips whitespace all by itself. opt__nextChar CMP R4,R5 ;Finished yet? LDRCCB R0,[R4],#1 ;Load a byte from the block MOVCS R0,#-1 ;Otherwise say it's -1 CMP R0,#';' ;Maybe this is a comment CMPNE R0,#'#' ;Or maybe a different comment CMPNE R0,#'|' ;Or yet another one MOVEQ PC,R9 ;Yes -- handle that then CMP R0,#&0A ;Found a newline here? MOVEQ PC,R7 ;Yes -- don't mind that CMP R0,#-1 ;Is this end-of-file? MOVEQ PC,R8 ;Yes -- tidy up then CMP R0,#&20 ;Is this a space CMPNE R0,#&09 ;Or maybe a tab MOVEQ PC,R10 ;Yes -- handle that MOVS PC,R14 ;Otherwise return to caller LTORG ; --- options__saver --- ; ; On entry: R0 == address of chunk anchor ; R10 == pointer to options definition ; ; On exit: May return an error ; ; Use: Saves a binary block of data as textual options. options__saver ROUT STMFD R13!,{R0-R10,R14} ;Save loads of registers LDMIB R0,{R4-R6} ;Load data from the anchor CMP R6,#-1 ;Is data in a flex block? LDRNE R6,[R6,#0] ;Yes -- load block base ADDNE R5,R6,R5 ;And add that to the offset MOV R6,R5 ;Put base in different reg ; --- Start work now --- 10 LDMFD R4,{R7-R10} ;Load values from table MOV R2,R10 ;Look after call address ADD R10,R6,R9 ;Find the binary data field ADD R9,R4,#opt_name ;Find the option name ADD R4,R4,R8 ;Move on to next block MOV R8,R9 ;Point to the name again 00 LDRB R14,[R9],#1 ;Load byte from the name CMP R14,#&20 ;Reached the end yet? BCS %b00 ;No -- keep looking ADD R9,R9,#3 ;Word align to find the BIC R9,R9,#3 ;Type-specific data MOV R0,#optReason_write ;Tell parser to write MOV R14,PC ;Set up return address MOV PC,R2 ;And call the routine MOVVC R0,#&0A ;Write final newline BLVC xsave_byte ;Write that out BVS %99options__saver ;If it failed, stop now TST R7,#optFlag_last ;Was that the last block? BEQ %b10 ;No -- skip back then MOV R0,#&0A ;Terminate with two newlines BL xsave_byte ;Write that out LDMVCFD R13!,{R0-R10,R14} ;Restore registers BICVCS PC,R14,#V_flag ;And return with no errors 99 ADD R13,R13,#4 ;Don't restore R0 on exit LDMFD R13!,{R1-R10,R14} ;Restore registers ORRS PC,R14,#V_flag ;And return with the error LTORG ; --- options_write --- ; ; On entry: R0 == terminator character to write, 0 for none, or -1 for ; quoting with 's ; R1 == pointer to name to save ; ; On exit: May return an error ; ; Use: Writes out an option name, terminated with the character ; given in R0 (which will normally be a space or an `=' sign). EXPORT options_write options_write ROUT STMFD R13!,{R0-R2,R14} ;Save some registers MOV R2,R0 ;Look after terminator CMP R2,#-1 ;Are we quoting strings? MOVEQ R0,#''' ;Yes -- write initial ' BLEQ xsave_byte ;Write that out BVS %90options_write ;If it failed, return error 00 LDRB R0,[R1],#1 ;Load next byte of string CMP R0,#&20 ;Is this the end yet? BCC %f00 ;Yes -- deal with that BL xsave_byte ;Write that out BVS %90options_write ;If it failed, return error CMP R2,#-1 ;Are we quoting? CMPEQ R0,#''' ;Writing a quote? BNE %b00 ;No -- skip back then BL xsave_byte ;Write out a second quote BVC %b00 ;And loop back round BVS %90options_write ;If it failed, return error 00 CMP R2,#-1 ;Are we quoting? MOVEQ R2,#''' ;Yes -- terminate with ' MOVS R0,R2 ;Get terminator char BLNE xsave_byte ;Write that byte out LDMVCFD R13!,{R0-R2,R14} ;If OK, restore registers BICVCS PC,R14,#V_flag ;And return without error 90options_write ADD R13,R13,#4 ;Don't restore R0 on exit LDMFD R13!,{R1,R2,R14} ;Restore registers ORRS PC,R14,#V_flag ;And return LTORG ;----- Standard data types -------------------------------------------------- ; --- optType_string --- ; ; Flags: -- ; ; Data: (word) buffer size of string ; ; Use: Handles string data. The binary representation is a ctrl ; terminated string. The textual representation is a sequence ; of characters, which is always output in single quotes, ; although this is not necessary for the input. The string ; will be truncated to fit in the buffer during reading. EXPORT optType_string optType_string ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return B %50optType_string ;Read a string ; --- Write the string out --- STMFD R13!,{R14} ;Save some registers MOV R0,#'=' ;Write a trailing `=' sign MOV R1,R8 ;Point to option name BL options_write ;Write the name out MOVVC R0,#-1 ;Now quote output string MOVVC R1,R10 ;Get string to write BLVC options_write ;Write the string out too LDMFD R13!,{PC} ;And return to caller ; --- Read a string in --- 50 LDR R2,[R9,#0] ;Load the buffer size 00 LDRB R0,[R1],#1 ;Load next byte from string CMP R0,#&20 ;Is this the end yet? SUBCSS R2,R2,#1 ;No -- decrement size MOVCC R0,#0 ;If at end, write a 0 STRB R0,[R10],#1 ;Write that out nicely BCS %b00 ;And loop round for more MOVS PC,R14 ;Return to caller finally LTORG ; --- optType_integer --- ; ; Flags: bit 8 == use given default base ; ; Data: (word) default base, if bit 8 set ; ; Use: Handles integer data. The binary representation is a 32- ; bit integer value. The textual representation is the normal ; RISC OS style of numbers (i.e. the base_value notation is ; supported). Numbers are always output in the default base ; given (or in decimal if there is none given). Numbers ; being read may always have a sign; numbers will only be ; output with a sign if the default base is decimal. Uppercase ; letters will be used for output, but any case is acceptable ; for input. ; ; Special prefixes allowed are `%' for binary and `&' for hex. ; Such numbers are always output with these prefixes. EXPORT optType_integer optType_integer ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return B %50optType_integer ;Read an integer ; --- Write an integer --- STMFD R13!,{R3-R5,R14} ;Save some registers MOV R0,#'=' ;Write a trailing `=' sign MOV R1,R8 ;Point to the option name BL options_write ;Write the name out LDMVSFD R13!,{R3-R5,PC} ;If it failed, die ; --- Write out a suitable prefix --- TST R7,#(1<<8) ;Is there a base given? LDRNE R5,[R9],#4 ;Yes -- load the base MOVEQ R5,#10 ;Otherwise use decimal LDR R3,[R10,#0] ;Load the integer CMP R5,#10 ;Writing in decimal? TSTEQ R3,#(1<<31) ;And the number's positive? BEQ %10optType_integer ;Yes -- skip onwards MOV R0,#0 ;Initially, no char to write CMP R5,#10 ;Now, is it decimal? EOREQ R0,R0,#'-' :EOR: '&' ;Yes -- write a `-' RSBEQ R3,R3,#0 ;And also negate it CMPNE R5,#16 ;Or maybe hex? EOREQ R0,R0,#'&' :EOR: '%' ;Yes -- write a `&' CMPNE R5,#2 ;Or lastly binary? EOREQ R0,R0,#'%' ;Yes -- write a `%' BLEQ xsave_byte ;Write that byte out LDMVSFD R13!,{R3-R5,PC} ;If it failed, die BEQ %10optType_integer ;And skip onwards MOV R0,R5 ;Get the base in decimal MOV R1,R11 ;Point into scratchpad MOV R2,#256 ;Give typical size for this SWI OS_ConvertInteger4 ;Convert it to an integer MOV R1,R11 ;Point to the buffer 00 LDRB R0,[R1],#1 ;Load next byte CMP R0,#&20 ;Finished yet? MOVCC R0,#'_' ;Yes -- finish with `_' BL xsave_byte ;Write out the byte LDMVSFD R13!,{R3-R5,PC} ;If it failed, die BCS %b00 ;And keep on going ; --- Build the string in the scratchpad --- 10 MOV R4,R11 ;Start a pointer into R11 MOV R0,R3 ;Get the number to write 00 MOV R1,R5 ;Get the base too BL div_unsigned ;Get next digit in R1 ADD R1,R1,#'0' ;Turn into a digit CMP R1,#'9'+1 ;Is it too big for this? ADDCS R1,R1,#'A'-'9'-1 ;Yes -- turn into letter STRB R1,[R4],#1 ;Save in next byte of R11 CMP R0,#0 ;Have we finished yet? BNE %b00 ;No -- do another digit then ; --- Now write out the digits --- ; ; They're all in the scratchpad in *reverse* order. 00 LDRB R0,[R4,#-1]! ;Load next character BL xsave_byte ;Write that out nicely LDMVSFD R13!,{R3-R5,PC} ;If it failed, die CMP R4,R11 ;Have we finished yet? BHI %b00 ;No -- do the rest then LDMFD R13!,{R3-R5,PC}^ ;Return to caller ; --- Read an integer in --- 50 STMFD R13!,{R3-R5,R14} ;Save a register MOV R5,R1 ;Look after string pointer TST R7,#(1<<8) ;Is there a base given? LDRNE R3,[R9],#4 ;Yes -- load the base MOVEQ R3,#10 ;Otherwise use decimal MOV R1,#0 ;Value starts at 0 MOV R2,#0 ;Keep decimal check in case MOV R4,#0 ;Clear a flags word 00 LDRB R0,[R5],#1 ;Load next byte CMP R0,#'&' ;Check for base prefix CMPNE R0,#'%' ;Either will do BEQ %60optType_integer ;Yes -- handle that then CMP R0,#'_' ;Was that a base spec? BEQ %65optType_integer ;Yes -- handle that then CMP R0,#'-' ;Is it a minus sign? CMPNE R0,#'+' ;Might as well allow + too BEQ %70optType_integer ;Yes -- deal with it SUB R14,R0,#'A' ;First check letters CMP R14,#26 ;Is this in range? SUBCS R14,R0,#'a' ;No -- also do lowercase CMPCS R14,#26 ;Check that too ORRCC R4,R4,#(1<<0) ;Yes -- can't be a base then ADDCC R14,R14,#10 ;Put into letter position SUBCS R14,R0,#'0' ;Otherwise check digits CMPCS R14,#10 ;Make sure of them too BCS %90optType_integer ;Got something strange CMP R14,#10 ;Is it a valid base 10 digit? ADDCC R2,R2,R2,LSL #2 ;Also accumulate base 10 vsn ADDCC R2,R14,R2,LSL #1 ;In case of a base ORRCC R4,R4,#(1<<2) ;Yup -- got a decimal digit ORRCS R4,R4,#(1<<4) ;Otherwise say this is bad TST R4,#(1<<3) ;Is accumulator OK? BNE %b00 ;No -- don't change it CMP R14,R3 ;Is it OK in our base? MLACC R1,R3,R1,R14 ;Accumulate result ORRCC R4,R4,#(1<<1) ;Yup -- got a real digit ORRCS R4,R4,#(1<<3) ;Otherwise say this is bad B %b00 ;If it was a digit, loop ; --- Change of base with shorthand base char --- 60 TST R4,#&3f ;Any digits read so far? BNE %90optType_integer ;Yes -- this is naughty then CMP R0,#'&' ;Entering hex mode? MOVEQ R3,#16 ;Yes -- base 16 then MOVNE R3,#2 ;No -- base 2 is the other ORR R4,R4,#(1<<5) ;Say we have a firm base B %b00 ;Now go back to read digits ; --- Change of base with `_' thing --- 65 TST R4,#(1<<4) + (1<<5) ;Check base is valid, and... BNE %90optType_integer ;we haven't got one already TST R4,#(1<<2) ;Make sure we read a digit BEQ %90optType_integer ;No -- nothing to do then MOV R3,R2 ;Make decimal number the base ORR R4,R4,#(1<<5) ;Say we have a firm base BIC R4,R4,#(1<<1) + (1<<3) ;Clear accumulator flags MOV R1,#0 ;And clear accumulator B %b00 ;Now go back to read digits ; --- Read a `-' or `+' sign --- 70 TST R4,#&7f ;Any digits read so far? BNE %90optType_integer ;Yes -- this is naughty then ORR R4,R4,#(1<<6) ;Say we read a sign CMP R0,#'-' ;Is it a minus? ORREQ R4,R4,#(1<<7) ;Yes -- set `-' flag then B %b00 ;Now go back to read digits ; --- We've stopped -- if we read something, store it --- 90 TST R4,#(1<<7) ;Must we negate the result? RSBNE R1,R1,#0 ;Yes -- do this TST R4,#(1<<1) ;Did we read anything? STRNE R1,[R10,#0] ;Yes -- stuff it away then LDMFD R13!,{R3-R5,PC}^ ;And return to caller LTORG ; --- optType_literal --- ; ; Flags: -- ; ; Data: (string) data to write out (*null* terminated) ; ; Use: Reads nothing; leave the name blank. Writes out the data ; literally. Note that an extra linefeed is added to the ; end, so don't overdo it. EXPORT optType_literal optType_literal ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return MOVS PC,R14 ;You can't read a literal ; --- Write the literal data --- STMFD R13!,{R14} ;Save a register 00 LDRB R0,[R9],#1 ;Load a byte CMP R0,#0 ;Is that the end? BLNE xsave_byte ;No -- write out the byte LDMVSFD R13!,{PC} ;If it failed, return BNE %b00 ;If not finished, loop LDMFD R13!,{PC}^ ;Return when done LTORG ; --- optType_enum --- ; ; Flags: bit 8 == quote output string ; bit 9 == don't put an `=' sign in output ; ; Data: See below ; ; Use: The data is a collection of ctrl-terminated strings, itself ; terminated by a zero-length entry. The textual ; representation is one of these strings, or an abbreviation ; of one. The binary representation is a word containing the ; index into the list. EXPORT optType_enum optType_enum ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return B %50optType_enum ;Read one of the strings ; --- Write the appropriate string --- STMFD R13!,{R2,R14} ;Stack a register MOV R0,R9 ;Point to the table LDR R1,[R10,#0] ;Load the current value BL str_index ;Find the correct string LDMCCFD R13!,{R2,PC}^ ;If that failed, do nothing MOV R2,R0 ;Look after the index TST R7,#(1<<9) ;Do we want an equals? MOVEQ R0,#'=' ;Write an equals after name MOVNE R0,#' ' ;Or maybe a space instead MOV R1,R8 ;Point to option name BL options_write ;Write that out LDMVSFD R13!,{R2,PC} ;If it failed, return ANDS R0,R7,#(1<<8) ;Are we quoting strings? MOVNE R0,#-1 ;Yes -- quote output MOV R1,R2 ;Point to the string BL options_write ;Write that out LDMFD R13!,{R2,PC} ;And return to caller ; --- Read one of the strings --- 50optType_enum STMFD R13!,{R14} ;Stack a register MOV R0,R9 ;Point to the table BL str_match ;Look up the string STRCS R0,[R10,#0] ;If found, store index LDMFD R13!,{PC}^ ;And return to caller LTORG ; --- optType_bool --- ; ; Flags: bit 8 == make flag active low ; bit 9 == use `on'/`off' rather than `true'/`false'; also ; suppresses the `=' sign ; ; Data: (word) bit mask to OR or BIC within word ; ; Use: Handles a boolean option. It will translate between the ; strings `true' or `false' and a bit (or set of bits) within ; a word. EXPORT optType_bool optType_bool ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return B %50optType_bool ;Read one of the strings ; --- Write a boolean value --- STMFD R13!,{R14} ;Save a register TST R7,#(1<<9) ;Write on/off, not true/false MOVNE R0,#' ' ;Yes -- use a space then MOVEQ R0,#'=' ;Else terminate with an `=' MOV R1,R8 ;Point to the option name BL options_write ;Write that out LDMVSFD R13!,{PC} ;If it failed, return LDR R0,[R10,#0] ;Load the flags word LDR R14,[R9],#4 ;Load the mask TST R7,#(1<<8) ;Is flag active low? EORNE R0,R0,R14 ;Yes -- toggle it then ANDS R1,R0,R14 ;Is the option set? MOVNE R1,#1 ;Yes -- use true string TST R7,#(1<<9) ;Write on/off, not true/false ORRNE R1,R1,#2 ;Yes -- use second set then ADR R0,opt__boolTbl ;Point to boolean table BL str_index ;Find correct string MOV R1,R0 ;Point to the string it found MOV R0,#0 ;Don't terminate string BL options_write ;Write that out LDMFD R13!,{PC} ;And return ; --- Read a boolean value --- 50optType_bool STMFD R13!,{R14} ;Save a register ADR R0,opt__boolTbl ;Point to the table BL str_match ;Match a string LDMCCFD R13!,{PC}^ ;If no match, return TST R0,#1 ;Is the value false? LDR R0,[R10,#0] ;Load the flags word LDR R14,[R9],#4 ;Load the mask BICEQ R0,R0,R14 ;False -- clear flag ORRNE R0,R0,R14 ;True -- set flag TST R7,#(1<<8) ;Is flag active low? EORNE R0,R0,R14 ;Yes -- toggle it then STR R0,[R10,#0] ;Save new flags back LDMFD R13!,{PC}^ ;And return opt__boolTbl DCB "false",0, "true",0 DCB "off",0, "on",0 DCB "no",0, "yes",0 DCB 0 LTORG ; --- optType_version --- ; ; Flags: -- ; ; Data: -- ; ; Use: Converts between version number strings (of the form ; [.[[]]]) and integers. The version ; number is stored multiplied by 100. EXPORT optType_version optType_version ROUT CMP R0,#2 ;Do I understand this? ADDCC PC,PC,R0,LSL #2 ;Yes -- dispatch then MOVS PC,R14 ;Otherwise just return B %50optType_version ;Read a version number ; --- Write a version number --- STMFD R13!,{R2-R4,R14} ;Save some registers MOV R0,#'=' ;Write an equals sign MOV R1,R8 ;Point to option name BL options_write ;Write that string out LDMVSFD R13!,{R2-R4,PC} ;If it failed, return LDR R0,[R10,#0] ;Load the version value BL div10 ;Get bottom minor vsn digit MOV R4,R1 ;Look after that BL div10 ;Get top minor vsn digit MOV R3,R1 ;Look after that too MOV R2,R0 ;And get major version MOV R1,R11 ;Output to scratchpad ADR R0,opt__vsnSkel ;Point to skeleton string BL str_subst ;Build the output string MOV R1,R0 ;Point to output string MOV R0,#0 ;Don't terminate this BL options_write ;Write that out nicely LDMFD R13!,{R2-R4,PC} ;And return to caller opt__vsnSkel DCB "%i0.%i1%i2",0 ; --- Read a version number --- 50 STMFD R13!,{R2,R14} ;Save some registers ; --- Read major version --- MOV R2,#0 ;Start an accumulator MOV R0,#0 ;Clear some flags 00 LDRB R14,[R1],#1 ;Load next byte of input CMP R14,#'.' ;Is this the separator? BEQ %f00 ;Yes -- sip forwards then SUB R14,R14,#'0' ;Turn into an integer CMP R14,#10 ;Is it in range? ORRCC R0,R0,#1 ;Yes -- we have a valid vsn ADDCC R2,R2,R2,LSL #2 ;So accumulate major vsn ADDCC R2,R14,R2,LSL #1 BCC %b00 ;And loop back again ; --- Found something unexpected --- TST R0,#1 ;Do we have a version number? ADDNE R2,R2,R2,LSL #2 ;Multiply major version by 5 ADDNE R2,R2,R2,LSL #2 ;And again (x25) MOVNE R2,R2,LSL #2 ;And by 4 (x100) STRNE R2,[R10,#0] ;And write out this value LDMFD R13!,{R2,PC}^ ;Return to caller finally ; --- Read minor version number --- 00 LDRB R14,[R1],#1 ;Load next byte of input SUB R14,R14,#'0' ;Turn into an integer CMP R14,#10 ;Is it in range? MOVCS R14,#0 ;No -- treat it as zero then ADD R2,R2,R2,LSL #2 ;Accumulate *anyway*; this ADD R2,R14,R2,LSL #1 ;puts zeroes on the end LDRCCB R14,[R1],#1 ;Maybe load the next one SUBCC R14,R14,#'0' ;Turn into an integer CMPCC R14,#10 ;Is it in range? MOVCS R14,#0 ;No -- treat it as zero then ADD R2,R2,R2,LSL #2 ;Accumulate again ADD R2,R14,R2,LSL #1 STR R2,[R10,#0] ;And write out this value LDMFD R13!,{R2,PC}^ ;Return to caller finally LTORG ;----- Data structures ------------------------------------------------------ ; --- Options definition block --- ^ 0 opt_flags # 4 ;Flags for this item opt_length # 4 ;Size of this table entry opt_offset # 4 ;Offset in block of data opt_type # 4 ;Address of type handler opt_name # 0 ;Name of this option ; --- Option block flags --- optFlag_last EQU (1<<0) ;This is the last block optFlag_ignore EQU (1<<1) ;Don't read this option ; --- Integer type flags --- intFlag_base EQU (1<<8) ;Default base specified ; --- Enumeration type flags --- enumFlag_quote EQU (1<<8) ;Quote the output string enumFlag_noEq EQU (1<<9) ;Don't output an `=' sign ; --- Boolean type flags --- boolFlag_cpl EQU (1<<8) ;Flag is complemented boolFlag_onOff EQU (1<<9) ;Use `on'/`off' notation ; --- Type handler reason codes --- ; ; All enter with: ; ; R0 == reason code ; R7 == flags read from table ; R8 == address of option name ; R9 == address of type-specific data ; R10 == address of binary option ^ 0 optReason_read # 1 ;Read from option string ;R1 == pointer to string optReason_write # 1 ;Write data to xsave file ;----- That's all, folks ---------------------------------------------------- END