~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / sail / s / sail
1 ;
2 ; sail.s
3 ;
4 ; Main SAIL API
5 ;
6 ; © 1995 Straylight
7 ;
8
9 ;----- Standard header ------------------------------------------------------
10
11 GET libs:header
12 GET libs:swis
13
14 GET libs:stream
15
16 ;----- External dependencies ------------------------------------------------
17
18 ;----- Main code ------------------------------------------------------------
19
20 AREA |Sapphire$$Code|,CODE,READONLY
21
22 ; --- sail_initScript ---
23 ;
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)
28 ;
29 ; On exit: R0 == script handle
30 ; May return an error
31 ;
32 ; Use: Tokenises the script, set up global labels etc.
33
34 EXPORT sail_initScript
35 sail_initScript ROUT
36
37
38 STMFD R13!,{R1-R4,R12,R14} ;Save some registers
39
40 ; --- Find the size of the file ---
41
42 MOV R4,R0 ;Look after the anchor
43 BL flex_size ;Find the file size
44 MOV R1,R0 ;Look after this value
45
46 ; --- Allocate an anchor/stack block ---
47
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
53
54 ; --- Fill in the rest of the block ---
55
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
60
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
70
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
76
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
85
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
94
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
103
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
112
113 BL strBucket_init ;Set up the string handling
114
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
119
120 ; --- Now tokenise the file ---
121
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
133
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
139
140 ; --- Zero-init the file array ---
141
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
147 BGT %b00 ;And loop
148
149 ; --- Finish setting up, and return ---
150
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
156
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
162
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
166
167 ; --- An error occured ---
168
169 94 MOV R4,R0
170 ADR R0,sail_straccStack ;Load the stack anchor
171 BL flex_free ;Free it
172 MOV R0,R4
173 95 MOV R4,R0
174 ADR R0,sail_calcStack ;Load the stack anchor
175 BL flex_free ;Free it
176 MOV R0,R4
177 96 MOV R4,R0
178 ADR R0,sail_opStack ;Load the stack anchor
179 BL flex_free ;Free it
180 MOV R0,R4
181 97 MOV R4,R0
182 ADR R0,sail_execStack ;Load the stack anchor
183 BL flex_free ;Free it
184 MOV R0,R4
185 98 MOV R4,R0
186 ADR R0,sail_varTree ;Load the stack anchor
187 BL flex_free ;Free it
188 MOV R0,R4
189 99 LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers
190 ORRS PC,R14,#V_flag ;Return error to caller
191
192 LTORG
193
194 ; --- sail_killScript ---
195 ;
196 ; On entry: R0 == handle of the script
197 ;
198 ; On exit: --
199 ;
200 ; Use: Removes all the information associates with a given
201 ; script.
202
203 EXPORT sail_killScript
204 sail_killScript ROUT
205
206 STMFD R13!,{{R0-R2,R12,R14} ;Save some register
207 MOV R12,R0 ;Put block in R12
208
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?
214 BCC %b00 ;No -- loop
215
216 ; --- Now free DIMed RMA blocks ---
217
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
226
227 ; --- Close any open files ---
228
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
239
240 ; --- Free the tokenised file ---
241
242 ADR R0,sail_tokAnchor ;Load anchor of tok'ed file
243 BL flex_free ;Free that block
244
245 ; --- Free the anchor block ---
246
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
250
251 LTORG
252
253 ; --- sail_error ---
254 ;
255 ; On entry: R0 == pointer to error block
256 ;
257 ; On exit: Doesn't, probably
258 ;
259 ; Use: Returns an error to the caller.
260
261 EXPORT sail_error
262 sail_error ROUT
263
264 ORRS PC,R14,#V_flag ;And return with V set
265
266 LTORG
267
268 ; --- sail_goto ---
269 ;
270 ; On entry: R0 == script handle
271 ; R1 == pointer to lable name, or 0 for start
272 ;
273 ; On exit: R1 == 0 if finished, else more to go
274 ;
275 ; Use: Starts executing the script from the given label.
276
277 ; --- This routine is rather incomplete at the moment ---
278
279 EXPORT sail_goto
280 sail_goto ROUT
281
282 STMFD R13!,{R0,R2-R12,R14} ;Stack registers
283 MOV R12,R0 ;Put anchor in R12
284 B interp_start ;Start execution
285
286 LTORG
287
288 ; --- sail_continue ---
289 ;
290 ; On entry: R0 == handle of the script
291 ;
292 ; On exit: --
293 ;
294 ; Use: Executes the script from where it left off.
295
296 EXPORT sail_continue
297 sail_continue ROUT
298
299 STMFD R13!,{R0,R2-R12,R14} ;Stack registers
300 MOV R12,R0 ;Put anchor in R12
301 B interp_resume ;Start execution
302
303 LTORG
304
305 ; --- sail_wait ---
306 ;
307 ; On entry: --
308 ;
309 ; On exit: R1 <> 0
310 ;
311 ; Use: Returns to the caller indication that we have *not* yet
312 ; finished.
313
314 EXPORT sail_wait
315 sail_wait ROUT
316
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
320
321 LTORG
322
323 ; --- sail_return ---
324 ;
325 ; On entry: --
326 ;
327 ; On exit: --
328 ;
329 ; Use: Returns to caller once the script has finished.
330
331 EXPORT sail_return
332 sail_return ROUT
333
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
337
338 LTORG
339
340 ;----- That's all, folks ----------------------------------------------------
341
342 END
The Straylight Source Distribution (obsolete software for RISC OS)