9 ;----- Standard header ------------------------------------------------------
16 ;----- External dependencies ------------------------------------------------
18 ;----- Main code ------------------------------------------------------------
20 AREA |Sapphire$$Code|,CODE,READONLY
22 ; --- sail_initScript ---
24 ; On entry: R0 == flex block handle of file
25 ; R1 == environment handle to attach script to
26 ; R2 == flex anchor of global variable pool
27 ; R3 == how often to pre-empt the script (-1 == don't)
29 ; On exit: R0 == script handle
32 ; Use: Tokenises the script, set up global labels etc.
34 EXPORT sail_initScript
38 STMFD R13!,{R1-R4,R12,R14} ;Save some registers
40 ; --- Find the size of the file ---
42 MOV R4,R0 ;Look after the anchor
43 BL flex_size ;Find the file size
44 MOV R1,R0 ;Look after this value
46 ; --- Allocate an anchor/stack block ---
48 MOV R0,#sail_blkSize ;Get the block's size
49 BL alloc ;Try to allocate memory
50 BLCS alloc_error ;Allocate memory
51 BCS %99 ;If it failed, return error
52 MOV R12,R0 ;Point to block in R12
54 ; --- Fill in the rest of the block ---
56 LDMIB R13,{R0-R2} ;Load other inforamtion
57 STR R0,sail_env ;Store environment handle
58 STR R1,sail_global ;Store ptr to global anchor
59 STR R2,sail_preempt ;Store the pre-empt time
61 MOV R1,#512 ;Initial size of var stack
62 STR R1,sail_varSize ;Size of current stack
63 ADR R0,sail_varTree ;Point tothe anchor
64 BL flex_alloc ;Try to allocate it
65 BLCS alloc_error ;Get the error message
66 BCS %99 ;On error -- return
67 MOV R14,#7*4 ;A nice NULL value
68 STR R14,sail_varPtr ;Nothing on the stack yet
69 LDR R0,sail_varTree ;Find block address
71 MOV R14,#0 ;Zero out the tree roots
72 MOV R1,#7 ;Seven type trees to clear
73 10 STR R14,[R0],#4 ;Clear another one
74 SUBS R1,R1,#1 ;Decrement the counter
75 BGT %10 ;And keep on going
77 ADR R0,sail_execStack ;Point to the anchor
78 MOV R1,#256 ;Space for the execution st.
79 BL flex_alloc ;Try to allocate it
80 BVS %98 ;On error -- return
81 MOV R1,#0 ;Amount used so far
82 MOV R2,#256 ;Total size
83 ADR R3,sail_execStack ;Point to the stack data
84 STMIB R3,{R1,R2} ;Store the information
86 ADR R0,sail_opStack ;Point to the anchor
87 MOV R1,#256 ;Space for the operators
88 BL flex_alloc ;Try to allocate it
89 BVS %97 ;On error -- return
90 MOV R1,#0 ;Amount used so far
91 MOV R2,#256 ;Total size
92 ADR R3,sail_opStack ;Point to the stack data
93 STMIB R3,{R1,R2} ;Store the information
95 ADR R0,sail_calcStack ;Point to the anchor
96 MOV R1,#256 ;Space for the operands
97 BL flex_alloc ;Try to allocate it
98 BVS %96 ;On error -- return
99 MOV R1,#0 ;Amount used so far
100 MOV R2,#256 ;Total size
101 ADR R3,sail_calcStack ;Point to the stack data
102 STMIB R3,{R1,R2} ;Store the information
104 ADR R0,sail_stracc ;POint tothe anchor
105 MOV R1,#512 ;Space for the operands
106 BL flex_alloc ;Try to allocate it
107 BVS %95 ;On error -- return
108 MOV R1,#0 ;Amount used so far
109 MOV R2,#512 ;Total size
110 ADR R3,sail_stracc ;Point to the stack data
111 STMIB R3,{R1,R2} ;Store the information
113 BL strBucket_init ;Set up the string handling
115 MOV R14,#tscFlag_nl ;Start with this flags word
116 STR R14,sail_flags ;Store the new flags
117 MOV R14,#0 ;A NULL word
118 STR R14,sail_rmaList ;No DIMed blocks yet
120 ; --- Now tokenise the file ---
122 LDR R2,[R13,#0] ;Load the flex address
123 MOV R0,R1 ;Put it in R0
124 BL flex_size ;Get the file size
125 ADD R1,R0,#8 ;Put the size in R1
126 ADR R0,sail_tokAnchor ;Point to the anchor
127 BL flex_alloc ;Allocate a block
128 BLCS alloc_error ;Get the error message
129 BCS %94 ;No -- return an error
130 ADR R0,sail_tokAnchor ;Point to the anchor again
131 STR R0,sail_currAnchor ;This is current anchor
132 STR R0,sail_oldAnchor ;This is the `previous' one
134 LDR R0,[R2,#0] ;POint to the text file
135 LDR R2,sail_tokAnchor ;Point to the output buffer
136 MOV R3,#1 ;Tokenise the whole file
137 BL tokenise ;Tokenise the file
138 BVS %94 ;Report possible error
140 ; --- Zero-init the file array ---
142 MOV R14,#0 ;Zero-init the array
143 MOV R0,#8 ;This many words to do
144 ADR R1,sail_files ;Point to the array
145 00 STR R14,[R1],#4 ;Store
146 SUBS R0,R0,#1 ;Decrement the counter
149 ; --- Finish setting up, and return ---
151 SWI OS_ReadMonotonicTime ;Read start time of program
152 STR R0,sail_timeOff ;This is initial time offset
153 MOV R1,#0 ;Clear top bit
154 ADR R14,sail_rndSeed ;Point to seed buffer
155 STMIA R14,{R0,R1} ;Save that away
157 MOV R14,#0 ;Current data offset
158 STR R14,sail_dataPtr ;Store that
159 MOV R14,#1 ;Current data line
160 STR R14,sail_dataLine ;Store that too
161 BL ctrl_findDATA ;Set up the pointer
163 MOV R0,R12 ;Return my block as handle
164 LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers
165 BICS PC,R14,#V_flag ;And return without error
167 ; --- An error occured ---
170 ADR R0,sail_straccStack ;Load the stack anchor
171 BL flex_free ;Free it
174 ADR R0,sail_calcStack ;Load the stack anchor
175 BL flex_free ;Free it
178 ADR R0,sail_opStack ;Load the stack anchor
179 BL flex_free ;Free it
182 ADR R0,sail_execStack ;Load the stack anchor
183 BL flex_free ;Free it
186 ADR R0,sail_varTree ;Load the stack anchor
187 BL flex_free ;Free it
189 99 LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers
190 ORRS PC,R14,#V_flag ;Return error to caller
194 ; --- sail_killScript ---
196 ; On entry: R0 == handle of the script
200 ; Use: Removes all the information associates with a given
203 EXPORT sail_killScript
206 STMFD R13!,{{R0-R2,R12,R14} ;Save some register
207 MOV R12,R0 ;Put block in R12
209 ADR R0,sail_rszBlocks ;Find the resizing blocks
210 ADR R1,sail_erszBlocks ;Find the end of them
211 00 BL flex_free ;Free this block
212 ADD R0,R0,#12 ;Point to the next one
213 CMP R0,R1 ;Finished yet?
216 ; --- Now free DIMed RMA blocks ---
218 MOV R0,#7 ;Free blocks
219 LDR R2,sail_rmaList ;Load the head of the list
220 CMP R2,#0 ;Is there one here?
221 00 LDRNE R3,[R2,#0] ;Yes -- load the next link
222 SWINE OS_Module ;...free the block
223 MOVNE R2,R3 ;...put the next in R2
224 CMP R2,#0 ;Are there more to go?
225 BNE %b00 ;Yes -- do them then
227 ; --- Close any open files ---
229 MOV R0,#0 ;Close these files
230 MOV R1,#0 ;Start at file 1
231 ADR R2,sail_files ;Point to file array
232 00 TST R1,#&1F ;Start new word?
233 LDREQ R3,[R2],#4 ;Yes -- load new one then
234 MOVS R3,R3,LSL #1 ;Shift word up by one
235 SWICS OS_Find ;If set, close the file
236 ADD R1,R1,#1 ;Increment file handle
237 CMP R1,#&100 ;Finished yet?
238 BCC %b00 ;No -- keep looping
240 ; --- Free the tokenised file ---
242 ADR R0,sail_tokAnchor ;Load anchor of tok'ed file
243 BL flex_free ;Free that block
245 ; --- Free the anchor block ---
247 MOV R0,R12 ;Point to the anchor blk
248 BL free ;Free it nicely
249 LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller
255 ; On entry: R0 == pointer to error block
257 ; On exit: Doesn't, probably
259 ; Use: Returns an error to the caller.
264 ORRS PC,R14,#V_flag ;And return with V set
270 ; On entry: R0 == script handle
271 ; R1 == pointer to lable name, or 0 for start
273 ; On exit: R1 == 0 if finished, else more to go
275 ; Use: Starts executing the script from the given label.
277 ; --- This routine is rather incomplete at the moment ---
282 STMFD R13!,{R0,R2-R12,R14} ;Stack registers
283 MOV R12,R0 ;Put anchor in R12
284 B interp_start ;Start execution
288 ; --- sail_continue ---
290 ; On entry: R0 == handle of the script
294 ; Use: Executes the script from where it left off.
299 STMFD R13!,{R0,R2-R12,R14} ;Stack registers
300 MOV R12,R0 ;Put anchor in R12
301 B interp_resume ;Start execution
311 ; Use: Returns to the caller indication that we have *not* yet
317 MOV R1,#1 ;More to go
318 LDMFD R13!,{R0,R2-R12,R14} ;Load back registers
319 BICS PC,R14,#V_flag ;Return happily
323 ; --- sail_return ---
329 ; Use: Returns to caller once the script has finished.
334 MOV R1,#0 ;No more to do
335 LDMFD R13!,{R0,R2-R12,R14} ;Load back registers
336 BICS PC,R14,#V_flag ;Return happily
340 ;----- That's all, folks ----------------------------------------------------