; ; termScript.s ; ; Coroutine handling for Termite Script ; ; © 1995 Straylight ; ;----- Standard Header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ GET sh.anchor GET sh.ctrl GET sh.interp GET sh.mem GET sh.strBucket GET sh.termite GET sh.tree GET sh.tokenise GET sh.var ;----- Code header ---------------------------------------------------------- AREA |!!!TermScript$$Header|,CODE,READONLY MOVS PC,R14 ;No initialisation reqd MOVS PC,R14 ;No finalisation either B sail__create ;Create a new script B sail__poll ;Continue execution B termite_remoteInput ;Some input's come for us B sail__stop ;Stop executing now MOVS PC,R14 ;Misc operation B sail_execEnd ;End of an EXEC B sail_getLine ;Get line number ;----- Main code ------------------------------------------------------------ AREA |TermScript$$Code|,CODE,READONLY ; --- sail__create --- ; ; On entry: R2 == pointer to anchor for script file ; R3 == length of script file ; R4 == block with A% to H% ; ; On exit: R0 == pointer to script handle (stack block) ; ; Use: Sets up a new script session. sail__create ROUT STMFD R13!,{R1-R4,R12,R14} ;Save some registers ; --- Allocate an anchor/stack block --- MOV R0,#6 ;Allocate memory MOV R3,#sail_blkSize ;Get the block's size SWI XOS_Module ;Try to allocate the memory BVS %99sail__create ;If it failed, return error MOV R12,R2 ;Point to block in R12 ; --- Set up the coroutine ready to start --- ADD R4,R12,#sail_blkSize ;Point to the very top ADR R3,sail__start ;Install a `return address' MOV R1,R11 ;Pass upcall block pointer STMFD R4!,{R3} ;Save `R11', `R12' and `R14' SUB R4,R4,#40 ;Leave `R1'-`R10' blank STR R4,sail_R13 ;Save the initial stack ptr ; --- Fill in the rest of the block --- LDMIB R13,{R0,R1} ;Load the anchor and length STMIB R12,{R0,R1} ;Save them in my block MOV R0,#512 ;Initial size of var stack STR R0,sail_varSize ;Size of current stack BL mem_alloc ;Try to allocate it BVS %99sail__create ;On error -- return STR R0,sail_varTree ;Store this anchor pointer MOV R14,#7*4 ;A nice NULL value STR R14,sail_varPtr ;Nothing on the stack yet LDR R0,[R0] ;Find block address MOV R14,#0 ;Zero out the tree roots MOV R1,#7 ;Seven type trees to clear 10sail__create STR R14,[R0],#4 ;Clear another one SUBS R1,R1,#1 ;Decrement the counter BGT %10sail__create ;And keep on going MOV R0,#256 ;Space for the execution st. BL mem_alloc ;Try to allocate it BVS %98sail__create ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_execStack ;Point to the stack data STMIA R3,{R0-R2} ;Store the information MOV R0,#256 ;Space for the operators BL mem_alloc ;Try to allocate it BVS %98sail__create ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_opStack ;Point to the stack data STMIA R3,{R0-R2} ;Store the information MOV R0,#256 ;Space for the operands BL mem_alloc ;Try to allocate it BVS %98sail__create ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_calcStack ;Point to the stack data STMIA R3,{R0-R2} ;Store the information MOV R0,#512 ;Space for the operands BL mem_alloc ;Try to allocate it BVS %98sail__create ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#512 ;Total size ADR R3,sail_stracc ;Point to the stack data STMIA R3,{R0-R2} ;Store the information BL strBucket_init ;Set up the string handling MOV R14,#tscFlag_nl+tscFlag_echoLR+tscFlag_echoRL STR R14,sail_flags ;Store the new flags MOV R14,#0 ;A NULL word STR R14,sail_rmaList ;No DIMed blocks yet STR R14,sail_wForState ;State of WATCHFOR STR R14,sail_wForNumber ;No strings being watched for STR R14,sail_spool ;No SPOOL handle ; --- Now tokenise the file --- LDR R0,sail_scSize ;Load the script size ADD R0,R0,#8 ;Put the size in R0 BL mem_alloc ;Allocate a block BVS %98sail__create ;No -- return an error STR R0,sail_tokAnchor ;Store this anchor pointer STR R0,sail_currAnchor ;This is current anchor STR R0,sail_oldAnchor ;This is the `previous' one LDR R2,[R0,#0] ;Get angry with WimpExt_Heap ADR R14,sail_anchor ;Find untokenised script LDMIA R14,{R0,R1} ;Load them out LDR R0,[R0,#0] ;Grrrr... MOV R3,#1 ;Tokenise the whole file BL tokenise ;Tokenise the file [ 1=0 STMFD R13!,{R0-R5} MOV R0,#10 ADR R1,name LDR r2,=&FFF LDR R4,sail_tokAnchor LDR R4,[R4] LDR R5,sail_scSize ADD R5,R4,R5 SWI OS_File LDMFD R13!,{R0-R5} ] ; --- Zero-init the file array --- MOV R14,#0 ;Zero-init the array MOV R0,#8 ;This many words to do ADR R1,sail_files ;Point to the array 00 STR R14,[R1],#4 ;Store SUBS R0,R0,#1 ;Decrement the counter BGT %b00 ;And loop ; --- Finsh setting up, and return --- SWI OS_ReadMonotonicTime ;Read start time of program STR R0,sail_timeOff ;This is initial time offset MOV R1,#0 ;Clear top bit ADR R14,sail_rndSeed ;Point to seed buffer STMIA R14,{R0,R1} ;Save that away STR R1,sail_errorS ;ERROR$="" MOV R0,#2 ;We want a string this big BL strBucket_alloc ;Get it then MOV R14,#13 ;Get char 13 STRB R14,[R0],#1 ;Put in the string MOV R14,#10 ;Get char 10 STRB R14,[R0],#1 ;Put in the string STR R1,sail_lnewline ;Store the offset away MOV R0,#1 ;We want a string this big BL strBucket_alloc ;Get it then MOV R14,#13 ;Get char 13 STRB R14,[R0],#1 ;Put in the string STR R1,sail_rnewline ;Store the offset away MOV R14,#0 ;Current data offset STR R14,sail_dataPtr ;Store that MOV R14,#1 ;Current data line STR R14,sail_dataLine ;Store that too BL ctrl_findDATA ;Set up the pointer ; --- Copy over the A%-H% values --- ADR R1,sail__varNames ;Point to the names MOV R4,#8 ;Number of vars to transfer LDR R2,[R13,#12] ;Load te block ptr 00 MOV R0,#vType_integer ;It's an integer BL var_create ;Try to create it LDR R14,[R2],#4 ;Load the value to transfer STR R14,[R0,#4] ;Store the value ADD R1,R1,#3 ;Point to the next name SUBS R4,R4,#1 ;Reduce the count BGT %00 ;And keep on looking MOV R0,R12 ;Return my block as handle LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers BICS PC,R14,#V_flag ;And return without error ; --- An error occured --- 98sail__create MOV R4,R0 LDR R0,sail_varTree ;Load the stack anchor BL mem_free ;Free it MOV R0,R4 99sail__create LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers ORRS PC,R14,#V_flag ;Return error to caller sail__varNames DCB "A%",0,"B%",0,"C%",0,"D%",0 DCB "E%",0,"F%",0,"G%",0,"H%",0 LTORG ; --- sail__start --- ; ; On entry: R11 == pointer to upcall block ; R12 == pointer to anchor block ; ; On exit: via interpreter ; ; Use: Starts the interpreter coroutine. sail__start ROUT BL interp_start ;Start the interpreter MOV R0,#0 ;Terminate the script B sail_end ;By calling the closedown rtn LTORG ; --- sail__stop --- ; ; On entry: R0 == pointer to script anchor ; ; On exit: -- ; ; Use: Stops a script from going. sail__stop ROUT STMFD R13!,{R0-R2,R12,R14} ;Save some registers MOV R12,R0 ;Put block in R12 ADR R1,sail_rszBlocks ;Find the resizing blocks ADR R2,sail_erszBlocks ;Find the end of them 10sail__stop LDR R0,[R1],#12 ;Load the anchor BL mem_free ;Free this block CMP R1,R2 ;Finished yet? BCC %10sail__stop ;No -- loop ; --- Now free DIMed RMA blocks --- MOV R0,#7 ;Free blocks LDR R2,sail_rmaList ;Load the head of the list CMP R2,#0 ;Is there one here? 00 LDRNE R3,[R2,#0] ;Yes -- load the next link SWINE OS_Module ;...free the block MOVNE R2,R3 ;...put the next in R2 CMP R2,#0 ;Are there more to go? BNE %b00 ;Yes -- do them then ; --- Close any open files --- MOV R0,#0 ;Close these files MOV R1,#0 ;Start at file 1 ADR R2,sail_files ;Point to file array 00 TST R1,#&1F ;Start new word? LDREQ R3,[R2],#4 ;Yes -- load new one then MOVS R3,R3,LSL #1 ;Shift word up by one SWICS OS_Find ;If set, close the file ADD R1,R1,#1 ;Increment file handle CMP R1,#&100 ;Finished yet? BCC %b00 ;No -- keep looping ; --- Close the SPOOL file --- LDR R1,sail_spool ;Load the current handle CMP R1,#0 ;Are we spooling? MOVNE R0,#0 ;Yes -- close current file SWINE XOS_Find ;So do that then ; --- Free the tokenised file --- LDR R0,sail_tokAnchor ;Load anchor of tok'ed file BL mem_free ;Free that block ; --- Free the anchor block --- MOV R2,R12 ;Point to the anchor blk MOV R0,#7 ;Free the anchor SWI XOS_Module ;Do that then LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller LTORG ; --- sail__poll --- ; ; On entry: R0 == address of anchor block ; ; On exit: R0 == event code ; ; Use: Continues running the script for a while. sail__poll ROUT STMFD R13!,{R12,R14} ;Save some registers MOV R12,R0 ;Put anchor block ptr away BL sail__resume ;Switch to other coroutine LDMFD R13!,{R12,R14} ;Restore registers ORRVSS PC,R14,#V_flag ;If error, return that BICVCS PC,R14,#V_flag ;Else return no error LTORG ; --- sail__resume --- ; ; On entry: R0 == event code to pass to interpreter ; R1,R2 == other arguments to pass ; ; On exit: R0, R1 == return values (passed to sail_wait) ; ; Use: Resumes the interpreter, giving it an event. sail__resume ROUT STMFD R13!,{R3-R12,R14} ;Save main corout context LDR R14,sail_R13 ;Load interpreter's R13 STR R13,sail_R13 ;Save our R13 away for a bit MOV R13,R14 ;Switch to interpreter LDMFD R13!,{R1-R10,R14} ;Restore interp registers LDR R0,sail_currAnchor ;Load the token anchor LDR R0,[R0] ;Thump thump thump ADD R10,R0,R10 ;Turn offset into address MOVS PC,R14 ;Return to caller LTORG ; --- sail_wait --- ; ; On entry: -- ; ; On exit: R0, R1, R2 == event and arguments from Termite ; ; Use: Waits for some multitasking and gets something from Termite. EXPORT sail_wait sail_wait ROUT LDR R0,sail_currAnchor ;Find tokenised file anchor LDR R0,[R0] ;Grrrrrrrr SUB R10,R10,R0 ;Turn this into an offset STMFD R13!,{R1-R10,R14} ;Save interpreter's context LDR R14,sail_R13 ;Load main routine's R13 STR R13,sail_R13 ;Save our R13 away for a bit MOV R13,R14 ;Switch back to main routine MOV R0,#0 ;Just continue for a while LDMFD R13!,{R3-R12,R14} ;Restore Termite's regs BICS PC,R14,#V_flag ;And return with no error LTORG ; --- sail_end --- ; ; On entry: R0 == pointer to script to chain (bit 30 set for exec), ; 0 to just end, or -1 to CLOSE ; ; On exit: Doesn't, hopefully (except for exec?) ; ; Use: Ends the script, optionally starting up another one. EXPORT sail_end sail_end ROUT STMFD R13!,{R1-R10,R14} ;Save interpreter's context LDR R14,sail_currAnchor ;Find tokenised file anchor LDR R14,[R14] ;Grrrrrrrr SUB R10,R10,R14 ;Turn this into an offset STR R10,[R13,#36] ;Store R10 value LDR R14,sail_R13 ;Load main routine's R13 STR R13,sail_R13 ;Save our R13 away (useless) MOV R13,R14 ;Switch back to main routine MOV R5,R0 ;Look after the return type ; --- Copy across A% to H% --- ADR R2,sail_misc ;Point to a misc block ADRL R1,sail__varNames ;Point to the names MOV R4,#8 ;Number of vars to transfer 00 MOV R0,#vType_integer ;It's an integer BL tree_find ;Try to find it MOVCC R14,#0 ;Not there -- use 0 LDRCS R14,[R0,#4] ;Otherwise load value STR R14,[R2],#4 ;Store the value ADD R1,R1,#3 ;Point tot he next name SUBS R4,R4,#1 ;Reduce the count BGT %00 ;And keep on looking ADR R2,sail_misc ;Point to the block again MOV R0,R5 ;Put return type in R0 MOV R1,R6 ;And file name in R1 ; --- Now return appropriately --- MOV R1,R5 ;Get the string in R1 CMP R1,#0 ;Is it >0? BLE %10sail_end ;Nope -- jump ahead TST R1,#(1<<30) ;Are we EXECing? MOVEQ R0,#2 ;If chaining, return 2 MOVNE R0,#3 ;Otherwise return 3 BIC R1,R1,#(1<<30) ;Clear bit 30 B %90sail_end ;Just return now 10sail_end MOVEQ R0,#1 ;Else just end the script MOVLT R0,#4 ;Or maybe finish, even 90sail_end LDMFD R13!,{R3-R12,R14} ;Restore Termite's regs BICS PC,R14,#V_flag ;And return with no error LTORG ; --- sail_error --- ; ; On entry: R0 == pointer to error block ; ; On exit: Doesn't, probably ; ; Use: Returns an error to Termite. EXPORT sail_error sail_error ROUT STMFD R13!,{R1-R10,R14} ;Save interpreter's context LDR R14,sail_R13 ;Load main routine's R13 STR R13,sail_R13 ;Save our R13 away (useless) MOV R13,R14 ;Switch back to main routine LDMFD R13!,{R3-R12,R14} ;Restore Termite's registers ORRS PC,R14,#V_flag ;And return with V set LTORG ; --- sail_execEnd --- ; ; On entry: R0 == parent handle ; R4 == 8 word block of A%-H% ; R11 == upcall block ; ; On exit: -- ; ; Use: Update the parents A%-H% sail_execEnd ROUT STMFD R13!,{R0-R4,R12,R14} ;Stack registers MOV R12,R0 ;Put anchor in R12 ADRL R1,sail__varNames ;Point to the names MOV R2,#8 ;Number of vars to transfer 00 MOV R0,#vType_integer ;It's an integer BL var_find ;Try to create it LDR R14,[R4],#4 ;Load the value to transfer STR R14,[R0,#4] ;Store the value ADD R1,R1,#3 ;Point to the next name SUBS R2,R2,#1 ;Reduce the count BGT %00 ;And keep on looking LDMFD R13!,{R0-R4,R12,PC}^ ;Return to caller LTORG ; --- sail_getLine --- ; ; On entry: R0 == handle ; ; On exit: R0 == current line number ; ; Use: Returns the current line number sail_getLine ROUT LDR R0,[R0,#:INDEX:sail_line] MOVS PC,R14 LTORG ;----- That's all, folks ---------------------------------------------------- END