~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / sail / _s / termScript
1 ;
2 ; termScript.s
3 ;
4 ; Coroutine handling for Termite Script
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 GET sh.anchor
19 GET sh.ctrl
20 GET sh.interp
21 GET sh.mem
22 GET sh.strBucket
23 GET sh.termite
24 GET sh.tree
25 GET sh.tokenise
26 GET sh.var
27
28 ;----- Code header ----------------------------------------------------------
29
30 AREA |!!!TermScript$$Header|,CODE,READONLY
31
32 MOVS PC,R14 ;No initialisation reqd
33 MOVS PC,R14 ;No finalisation either
34 B tsc__create ;Create a new script
35 B tsc__poll ;Continue execution
36 B termite_remoteInput ;Some input's come for us
37 B tsc__stop ;Stop executing now
38 MOVS PC,R14 ;Misc operation
39 B tsc_execEnd ;End of an EXEC
40 B tsc_getLine ;Get line number
41
42 ;----- Main code ------------------------------------------------------------
43
44 AREA |TermScript$$Code|,CODE,READONLY
45
46 ; --- tsc__create ---
47 ;
48 ; On entry: R2 == pointer to anchor for script file
49 ; R3 == length of script file
50 ; R4 == block with A% to H%
51 ;
52 ; On exit: R0 == pointer to script handle (stack block)
53 ;
54 ; Use: Sets up a new script session.
55
56 tsc__create ROUT
57
58 STMFD R13!,{R1-R4,R12,R14} ;Save some registers
59
60 ; --- Allocate an anchor/stack block ---
61
62 MOV R0,#6 ;Allocate memory
63 MOV R3,#tsc_blkSize ;Get the block's size
64 SWI XOS_Module ;Try to allocate the memory
65 BVS %99tsc__create ;If it failed, return error
66 MOV R12,R2 ;Point to block in R12
67
68 ; --- Set up the coroutine ready to start ---
69
70 ADD R4,R12,#tsc_blkSize ;Point to the very top
71 ADR R3,tsc__start ;Install a `return address'
72 MOV R1,R11 ;Pass upcall block pointer
73 STMFD R4!,{R3} ;Save `R11', `R12' and `R14'
74 SUB R4,R4,#40 ;Leave `R1'-`R10' blank
75 STR R4,tsc_R13 ;Save the initial stack ptr
76
77 ; --- Fill in the rest of the block ---
78
79 LDMIB R13,{R0,R1} ;Load the anchor and length
80 STMIB R12,{R0,R1} ;Save them in my block
81
82 MOV R0,#512 ;Initial size of var stack
83 STR R0,tsc_varSize ;Size of current stack
84 BL mem_alloc ;Try to allocate it
85 BVS %99tsc__create ;On error -- return
86 STR R0,tsc_varTree ;Store this anchor pointer
87 MOV R14,#7*4 ;A nice NULL value
88 STR R14,tsc_varPtr ;Nothing on the stack yet
89 LDR R0,[R0] ;Find block address
90
91 MOV R14,#0 ;Zero out the tree roots
92 MOV R1,#7 ;Seven type trees to clear
93 10tsc__create STR R14,[R0],#4 ;Clear another one
94 SUBS R1,R1,#1 ;Decrement the counter
95 BGT %10tsc__create ;And keep on going
96
97 MOV R0,#256 ;Space for the execution st.
98 BL mem_alloc ;Try to allocate it
99 BVS %98tsc__create ;On error -- return
100 MOV R1,#0 ;Amount used so far
101 MOV R2,#256 ;Total size
102 ADR R3,tsc_execStack ;Point to the stack data
103 STMIA R3,{R0-R2} ;Store the information
104
105 MOV R0,#256 ;Space for the operators
106 BL mem_alloc ;Try to allocate it
107 BVS %98tsc__create ;On error -- return
108 MOV R1,#0 ;Amount used so far
109 MOV R2,#256 ;Total size
110 ADR R3,tsc_opStack ;Point to the stack data
111 STMIA R3,{R0-R2} ;Store the information
112
113 MOV R0,#256 ;Space for the operands
114 BL mem_alloc ;Try to allocate it
115 BVS %98tsc__create ;On error -- return
116 MOV R1,#0 ;Amount used so far
117 MOV R2,#256 ;Total size
118 ADR R3,tsc_calcStack ;Point to the stack data
119 STMIA R3,{R0-R2} ;Store the information
120
121 MOV R0,#512 ;Space for the operands
122 BL mem_alloc ;Try to allocate it
123 BVS %98tsc__create ;On error -- return
124 MOV R1,#0 ;Amount used so far
125 MOV R2,#512 ;Total size
126 ADR R3,tsc_stracc ;Point to the stack data
127 STMIA R3,{R0-R2} ;Store the information
128
129 BL strBucket_init ;Set up the string handling
130
131 MOV R14,#tscFlag_nl+tscFlag_echoLR+tscFlag_echoRL
132 STR R14,tsc_flags ;Store the new flags
133 MOV R14,#0 ;A NULL word
134 STR R14,tsc_rmaList ;No DIMed blocks yet
135 STR R14,tsc_wForState ;State of WATCHFOR
136 STR R14,tsc_wForNumber ;No strings being watched for
137 STR R14,tsc_spool ;No SPOOL handle
138
139 ; --- Now tokenise the file ---
140
141 LDR R0,tsc_scSize ;Load the script size
142 ADD R0,R0,#8 ;Put the size in R0
143 BL mem_alloc ;Allocate a block
144 BVS %98tsc__create ;No -- return an error
145 STR R0,tsc_tokAnchor ;Store this anchor pointer
146 STR R0,tsc_currAnchor ;This is current anchor
147 STR R0,tsc_oldAnchor ;This is the `previous' one
148
149 LDR R2,[R0,#0] ;Get angry with WimpExt_Heap
150 ADR R14,tsc_anchor ;Find untokenised script
151 LDMIA R14,{R0,R1} ;Load them out
152 LDR R0,[R0,#0] ;Grrrr...
153 MOV R3,#1 ;Tokenise the whole file
154 BL tokenise ;Tokenise the file
155
156 [ 1=0
157 STMFD R13!,{R0-R5}
158 MOV R0,#10
159 ADR R1,name
160 LDR r2,=&FFF
161 LDR R4,tsc_tokAnchor
162 LDR R4,[R4]
163 LDR R5,tsc_scSize
164 ADD R5,R4,R5
165 SWI OS_File
166 LDMFD R13!,{R0-R5}
167 ]
168
169 ; --- Zero-init the file array ---
170
171 MOV R14,#0 ;Zero-init the array
172 MOV R0,#8 ;This many words to do
173 ADR R1,tsc_files ;Point to the array
174 00 STR R14,[R1],#4 ;Store
175 SUBS R0,R0,#1 ;Decrement the counter
176 BGT %b00 ;And loop
177
178 ; --- Finsh setting up, and return ---
179
180 SWI OS_ReadMonotonicTime ;Read start time of program
181 STR R0,tsc_timeOff ;This is initial time offset
182 MOV R1,#0 ;Clear top bit
183 ADR R14,tsc_rndSeed ;Point to seed buffer
184 STMIA R14,{R0,R1} ;Save that away
185
186 STR R1,tsc_errorS ;ERROR$=""
187
188 MOV R0,#2 ;We want a string this big
189 BL strBucket_alloc ;Get it then
190 MOV R14,#13 ;Get char 13
191 STRB R14,[R0],#1 ;Put in the string
192 MOV R14,#10 ;Get char 10
193 STRB R14,[R0],#1 ;Put in the string
194 STR R1,tsc_lnewline ;Store the offset away
195
196 MOV R0,#1 ;We want a string this big
197 BL strBucket_alloc ;Get it then
198 MOV R14,#13 ;Get char 13
199 STRB R14,[R0],#1 ;Put in the string
200 STR R1,tsc_rnewline ;Store the offset away
201
202 MOV R14,#0 ;Current data offset
203 STR R14,tsc_dataPtr ;Store that
204 MOV R14,#1 ;Current data line
205 STR R14,tsc_dataLine ;Store that too
206 BL ctrl_findDATA ;Set up the pointer
207
208 ; --- Copy over the A%-H% values ---
209
210 ADR R1,tsc__varNames ;Point to the names
211 MOV R4,#8 ;Number of vars to transfer
212 LDR R2,[R13,#12] ;Load te block ptr
213 00 MOV R0,#vType_integer ;It's an integer
214 BL var_create ;Try to create it
215 LDR R14,[R2],#4 ;Load the value to transfer
216 STR R14,[R0,#4] ;Store the value
217 ADD R1,R1,#3 ;Point to the next name
218 SUBS R4,R4,#1 ;Reduce the count
219 BGT %00 ;And keep on looking
220
221 MOV R0,R12 ;Return my block as handle
222 LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers
223 BICS PC,R14,#V_flag ;And return without error
224
225 ; --- An error occured ---
226
227 98tsc__create MOV R4,R0
228 LDR R0,tsc_varTree ;Load the stack anchor
229 BL mem_free ;Free it
230 MOV R0,R4
231 99tsc__create LDMFD R13!,{R1-R4,R12,R14} ;Unstack registers
232 ORRS PC,R14,#V_flag ;Return error to caller
233
234 tsc__varNames DCB "A%",0,"B%",0,"C%",0,"D%",0
235 DCB "E%",0,"F%",0,"G%",0,"H%",0
236
237 LTORG
238
239 ; --- tsc__start ---
240 ;
241 ; On entry: R11 == pointer to upcall block
242 ; R12 == pointer to anchor block
243 ;
244 ; On exit: via interpreter
245 ;
246 ; Use: Starts the interpreter coroutine.
247
248 tsc__start ROUT
249
250 BL interp_start ;Start the interpreter
251 MOV R0,#0 ;Terminate the script
252 B tsc_end ;By calling the closedown rtn
253
254 LTORG
255
256 ; --- tsc__stop ---
257 ;
258 ; On entry: R0 == pointer to script anchor
259 ;
260 ; On exit: --
261 ;
262 ; Use: Stops a script from going.
263
264 tsc__stop ROUT
265
266 STMFD R13!,{R0-R2,R12,R14} ;Save some registers
267 MOV R12,R0 ;Put block in R12
268
269 ADR R1,tsc_rszBlocks ;Find the resizing blocks
270 ADR R2,tsc_erszBlocks ;Find the end of them
271 10tsc__stop LDR R0,[R1],#12 ;Load the anchor
272 BL mem_free ;Free this block
273 CMP R1,R2 ;Finished yet?
274 BCC %10tsc__stop ;No -- loop
275
276 ; --- Now free DIMed RMA blocks ---
277
278 MOV R0,#7 ;Free blocks
279 LDR R2,tsc_rmaList ;Load the head of the list
280 CMP R2,#0 ;Is there one here?
281 00 LDRNE R3,[R2,#0] ;Yes -- load the next link
282 SWINE OS_Module ;...free the block
283 MOVNE R2,R3 ;...put the next in R2
284 CMP R2,#0 ;Are there more to go?
285 BNE %b00 ;Yes -- do them then
286
287 ; --- Close any open files ---
288
289 MOV R0,#0 ;Close these files
290 MOV R1,#0 ;Start at file 1
291 ADR R2,tsc_files ;Point to file array
292 00 TST R1,#&1F ;Start new word?
293 LDREQ R3,[R2],#4 ;Yes -- load new one then
294 MOVS R3,R3,LSL #1 ;Shift word up by one
295 SWICS OS_Find ;If set, close the file
296 ADD R1,R1,#1 ;Increment file handle
297 CMP R1,#&100 ;Finished yet?
298 BCC %b00 ;No -- keep looping
299
300 ; --- Close the SPOOL file ---
301
302 LDR R1,tsc_spool ;Load the current handle
303 CMP R1,#0 ;Are we spooling?
304 MOVNE R0,#0 ;Yes -- close current file
305 SWINE XOS_Find ;So do that then
306
307 ; --- Free the tokenised file ---
308
309 LDR R0,tsc_tokAnchor ;Load anchor of tok'ed file
310 BL mem_free ;Free that block
311
312 ; --- Free the anchor block ---
313
314 MOV R2,R12 ;Point to the anchor blk
315 MOV R0,#7 ;Free the anchor
316 SWI XOS_Module ;Do that then
317 LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller
318
319 LTORG
320
321 ; --- tsc__poll ---
322 ;
323 ; On entry: R0 == address of anchor block
324 ;
325 ; On exit: R0 == event code
326 ;
327 ; Use: Continues running the script for a while.
328
329 tsc__poll ROUT
330
331 STMFD R13!,{R12,R14} ;Save some registers
332 MOV R12,R0 ;Put anchor block ptr away
333 BL tsc__resume ;Switch to other coroutine
334 LDMFD R13!,{R12,R14} ;Restore registers
335 ORRVSS PC,R14,#V_flag ;If error, return that
336 BICVCS PC,R14,#V_flag ;Else return no error
337
338 LTORG
339
340 ; --- tsc__resume ---
341 ;
342 ; On entry: R0 == event code to pass to interpreter
343 ; R1,R2 == other arguments to pass
344 ;
345 ; On exit: R0, R1 == return values (passed to tsc_wait)
346 ;
347 ; Use: Resumes the interpreter, giving it an event.
348
349 tsc__resume ROUT
350
351 STMFD R13!,{R3-R12,R14} ;Save main corout context
352 LDR R14,tsc_R13 ;Load interpreter's R13
353 STR R13,tsc_R13 ;Save our R13 away for a bit
354 MOV R13,R14 ;Switch to interpreter
355 LDMFD R13!,{R1-R10,R14} ;Restore interp registers
356 LDR R0,tsc_currAnchor ;Load the token anchor
357 LDR R0,[R0] ;Thump thump thump
358 ADD R10,R0,R10 ;Turn offset into address
359 MOVS PC,R14 ;Return to caller
360
361 LTORG
362
363 ; --- tsc_wait ---
364 ;
365 ; On entry: --
366 ;
367 ; On exit: R0, R1, R2 == event and arguments from Termite
368 ;
369 ; Use: Waits for some multitasking and gets something from Termite.
370
371 EXPORT tsc_wait
372 tsc_wait ROUT
373
374 LDR R0,tsc_currAnchor ;Find tokenised file anchor
375 LDR R0,[R0] ;Grrrrrrrr
376 SUB R10,R10,R0 ;Turn this into an offset
377 STMFD R13!,{R1-R10,R14} ;Save interpreter's context
378 LDR R14,tsc_R13 ;Load main routine's R13
379 STR R13,tsc_R13 ;Save our R13 away for a bit
380 MOV R13,R14 ;Switch back to main routine
381 MOV R0,#0 ;Just continue for a while
382 LDMFD R13!,{R3-R12,R14} ;Restore Termite's regs
383 BICS PC,R14,#V_flag ;And return with no error
384
385 LTORG
386
387 ; --- tsc_end ---
388 ;
389 ; On entry: R0 == pointer to script to chain (bit 30 set for exec),
390 ; 0 to just end, or -1 to CLOSE
391 ;
392 ; On exit: Doesn't, hopefully (except for exec?)
393 ;
394 ; Use: Ends the script, optionally starting up another one.
395
396 EXPORT tsc_end
397 tsc_end ROUT
398
399 STMFD R13!,{R1-R10,R14} ;Save interpreter's context
400 LDR R14,tsc_currAnchor ;Find tokenised file anchor
401 LDR R14,[R14] ;Grrrrrrrr
402 SUB R10,R10,R14 ;Turn this into an offset
403 STR R10,[R13,#36] ;Store R10 value
404 LDR R14,tsc_R13 ;Load main routine's R13
405 STR R13,tsc_R13 ;Save our R13 away (useless)
406 MOV R13,R14 ;Switch back to main routine
407
408 MOV R5,R0 ;Look after the return type
409
410 ; --- Copy across A% to H% ---
411
412 ADR R2,tsc_misc ;Point to a misc block
413 ADRL R1,tsc__varNames ;Point to the names
414 MOV R4,#8 ;Number of vars to transfer
415 00 MOV R0,#vType_integer ;It's an integer
416 BL tree_find ;Try to find it
417 MOVCC R14,#0 ;Not there -- use 0
418 LDRCS R14,[R0,#4] ;Otherwise load value
419 STR R14,[R2],#4 ;Store the value
420 ADD R1,R1,#3 ;Point tot he next name
421 SUBS R4,R4,#1 ;Reduce the count
422 BGT %00 ;And keep on looking
423 ADR R2,tsc_misc ;Point to the block again
424 MOV R0,R5 ;Put return type in R0
425 MOV R1,R6 ;And file name in R1
426
427 ; --- Now return appropriately ---
428
429 MOV R1,R5 ;Get the string in R1
430 CMP R1,#0 ;Is it >0?
431 BLE %10tsc_end ;Nope -- jump ahead
432
433 TST R1,#(1<<30) ;Are we EXECing?
434 MOVEQ R0,#2 ;If chaining, return 2
435 MOVNE R0,#3 ;Otherwise return 3
436 BIC R1,R1,#(1<<30) ;Clear bit 30
437
438 B %90tsc_end ;Just return now
439
440 10tsc_end MOVEQ R0,#1 ;Else just end the script
441 MOVLT R0,#4 ;Or maybe finish, even
442 90tsc_end LDMFD R13!,{R3-R12,R14} ;Restore Termite's regs
443 BICS PC,R14,#V_flag ;And return with no error
444
445 LTORG
446
447 ; --- tsc_error ---
448 ;
449 ; On entry: R0 == pointer to error block
450 ;
451 ; On exit: Doesn't, probably
452 ;
453 ; Use: Returns an error to Termite.
454
455 EXPORT tsc_error
456 tsc_error ROUT
457
458 STMFD R13!,{R1-R10,R14} ;Save interpreter's context
459 LDR R14,tsc_R13 ;Load main routine's R13
460 STR R13,tsc_R13 ;Save our R13 away (useless)
461 MOV R13,R14 ;Switch back to main routine
462 LDMFD R13!,{R3-R12,R14} ;Restore Termite's registers
463 ORRS PC,R14,#V_flag ;And return with V set
464
465 LTORG
466
467 ; --- tsc_execEnd ---
468 ;
469 ; On entry: R0 == parent handle
470 ; R4 == 8 word block of A%-H%
471 ; R11 == upcall block
472 ;
473 ; On exit: --
474 ;
475 ; Use: Update the parents A%-H%
476
477 tsc_execEnd ROUT
478
479 STMFD R13!,{R0-R4,R12,R14} ;Stack registers
480 MOV R12,R0 ;Put anchor in R12
481 ADRL R1,tsc__varNames ;Point to the names
482 MOV R2,#8 ;Number of vars to transfer
483 00 MOV R0,#vType_integer ;It's an integer
484 BL var_find ;Try to create it
485 LDR R14,[R4],#4 ;Load the value to transfer
486 STR R14,[R0,#4] ;Store the value
487 ADD R1,R1,#3 ;Point to the next name
488 SUBS R2,R2,#1 ;Reduce the count
489 BGT %00 ;And keep on looking
490
491 LDMFD R13!,{R0-R4,R12,PC}^ ;Return to caller
492
493 LTORG
494
495 ; --- tsc_getLine ---
496 ;
497 ; On entry: R0 == handle
498 ;
499 ; On exit: R0 == current line number
500 ;
501 ; Use: Returns the current line number
502
503 tsc_getLine ROUT
504
505 LDR R0,[R0,#:INDEX:tsc_line]
506 MOVS PC,R14
507
508 LTORG
509
510 ;----- That's all, folks ----------------------------------------------------
511
512 END
The Straylight Source Distribution (obsolete software for RISC OS)