; ; sail.s ; ; Main SAIL API ; ; © 1995 Straylight ; ;----- Standard header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ ;----- Main code ------------------------------------------------------------ AREA |Sapphire$$Code|,CODE,READONLY ; --- sail_initScript --- ; ; On entry: R0 == flex block handle of file ; R1 == environment handle to attach script to ; R2 == flex anchor of global variable pool ; R3 == how often to pre-empt the script (-1 == don't) ; ; On exit: R0 == script handle ; May return an error ; ; Use: Tokenises the script, set up global labels etc. EXPORT sail_initScript sail_initScript ROUT STMFD R13!,{R1-R4,R12,R14} ;Save some registers ; --- Find the size of the file --- MOV R4,R0 ;Look after the anchor BL flex_size ;Find the file size MOV R1,R0 ;Look after this value ; --- Allocate an anchor/stack block --- MOV R0,#sail_blkSize ;Get the block's size BL alloc ;Try to allocate memory BLCS alloc_error ;Allocate memory BCS %99 ;If it failed, return error MOV R12,R0 ;Point to block in R12 ; --- Fill in the rest of the block --- LDMIB R13,{R0-R2} ;Load other inforamtion STR R0,sail_env ;Store environment handle STR R1,sail_global ;Store ptr to global anchor STR R2,sail_preempt ;Store the pre-empt time MOV R1,#512 ;Initial size of var stack STR R1,sail_varSize ;Size of current stack ADR R0,sail_varTree ;Point tothe anchor BL flex_alloc ;Try to allocate it BLCS alloc_error ;Get the error message BCS %99 ;On error -- return MOV R14,#7*4 ;A nice NULL value STR R14,sail_varPtr ;Nothing on the stack yet LDR R0,sail_varTree ;Find block address MOV R14,#0 ;Zero out the tree roots MOV R1,#7 ;Seven type trees to clear 10 STR R14,[R0],#4 ;Clear another one SUBS R1,R1,#1 ;Decrement the counter BGT %10 ;And keep on going ADR R0,sail_execStack ;Point to the anchor MOV R1,#256 ;Space for the execution st. BL flex_alloc ;Try to allocate it BVS %98 ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_execStack ;Point to the stack data STMIB R3,{R1,R2} ;Store the information ADR R0,sail_opStack ;Point to the anchor MOV R1,#256 ;Space for the operators BL flex_alloc ;Try to allocate it BVS %97 ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_opStack ;Point to the stack data STMIB R3,{R1,R2} ;Store the information ADR R0,sail_calcStack ;Point to the anchor MOV R1,#256 ;Space for the operands BL flex_alloc ;Try to allocate it BVS %96 ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#256 ;Total size ADR R3,sail_calcStack ;Point to the stack data STMIB R3,{R1,R2} ;Store the information ADR R0,sail_stracc ;POint tothe anchor MOV R1,#512 ;Space for the operands BL flex_alloc ;Try to allocate it BVS %95 ;On error -- return MOV R1,#0 ;Amount used so far MOV R2,#512 ;Total size ADR R3,sail_stracc ;Point to the stack data STMIB R3,{R1,R2} ;Store the information BL strBucket_init ;Set up the string handling MOV R14,#tscFlag_nl ;Start with this flags word STR R14,sail_flags ;Store the new flags MOV R14,#0 ;A NULL word STR R14,sail_rmaList ;No DIMed blocks yet ; --- Now tokenise the file --- LDR R2,[R13,#0] ;Load the flex address MOV R0,R1 ;Put it in R0 BL flex_size ;Get the file size ADD R1,R0,#8 ;Put the size in R1 ADR R0,sail_tokAnchor ;Point to the anchor BL flex_alloc ;Allocate a block BLCS alloc_error ;Get the error message BCS %94 ;No -- return an error ADR R0,sail_tokAnchor ;Point to the anchor again STR R0,sail_currAnchor ;This is current anchor STR R0,sail_oldAnchor ;This is the `previous' one LDR R0,[R2,#0] ;POint to the text file LDR R2,sail_tokAnchor ;Point to the output buffer MOV R3,#1 ;Tokenise the whole file BL tokenise ;Tokenise the file BVS %94 ;Report possible error ; --- 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 ; --- Finish 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 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 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 --- 94 MOV R4,R0 ADR R0,sail_straccStack ;Load the stack anchor BL flex_free ;Free it MOV R0,R4 95 MOV R4,R0 ADR R0,sail_calcStack ;Load the stack anchor BL flex_free ;Free it MOV R0,R4 96 MOV R4,R0 ADR R0,sail_opStack ;Load the stack anchor BL flex_free ;Free it MOV R0,R4 97 MOV R4,R0 ADR R0,sail_execStack ;Load the stack anchor BL flex_free ;Free it MOV R0,R4 98 MOV R4,R0 ADR R0,sail_varTree ;Load the stack anchor BL flex_free ;Free it MOV R0,R4 99 LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers ORRS PC,R14,#V_flag ;Return error to caller LTORG ; --- sail_killScript --- ; ; On entry: R0 == handle of the script ; ; On exit: -- ; ; Use: Removes all the information associates with a given ; script. EXPORT sail_killScript sail_killScript ROUT STMFD R13!,{{R0-R2,R12,R14} ;Save some register MOV R12,R0 ;Put block in R12 ADR R0,sail_rszBlocks ;Find the resizing blocks ADR R1,sail_erszBlocks ;Find the end of them 00 BL flex_free ;Free this block ADD R0,R0,#12 ;Point to the next one CMP R0,R1 ;Finished yet? BCC %b00 ;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 ; --- Free the tokenised file --- ADR R0,sail_tokAnchor ;Load anchor of tok'ed file BL flex_free ;Free that block ; --- Free the anchor block --- MOV R0,R12 ;Point to the anchor blk BL free ;Free it nicely LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller LTORG ; --- sail_error --- ; ; On entry: R0 == pointer to error block ; ; On exit: Doesn't, probably ; ; Use: Returns an error to the caller. EXPORT sail_error sail_error ROUT ORRS PC,R14,#V_flag ;And return with V set LTORG ; --- sail_goto --- ; ; On entry: R0 == script handle ; R1 == pointer to lable name, or 0 for start ; ; On exit: R1 == 0 if finished, else more to go ; ; Use: Starts executing the script from the given label. ; --- This routine is rather incomplete at the moment --- EXPORT sail_goto sail_goto ROUT STMFD R13!,{R0,R2-R12,R14} ;Stack registers MOV R12,R0 ;Put anchor in R12 B interp_start ;Start execution LTORG ; --- sail_continue --- ; ; On entry: R0 == handle of the script ; ; On exit: -- ; ; Use: Executes the script from where it left off. EXPORT sail_continue sail_continue ROUT STMFD R13!,{R0,R2-R12,R14} ;Stack registers MOV R12,R0 ;Put anchor in R12 B interp_resume ;Start execution LTORG ; --- sail_wait --- ; ; On entry: -- ; ; On exit: R1 <> 0 ; ; Use: Returns to the caller indication that we have *not* yet ; finished. EXPORT sail_wait sail_wait ROUT MOV R1,#1 ;More to go LDMFD R13!,{R0,R2-R12,R14} ;Load back registers BICS PC,R14,#V_flag ;Return happily LTORG ; --- sail_return --- ; ; On entry: -- ; ; On exit: -- ; ; Use: Returns to caller once the script has finished. EXPORT sail_return sail_return ROUT MOV R1,#0 ;No more to do LDMFD R13!,{R0,R2-R12,R14} ;Load back registers BICS PC,R14,#V_flag ;Return happily LTORG ;----- That's all, folks ---------------------------------------------------- END