~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / sail / s / interp
1 ;
2 ; interp.s
3 ;
4 ; Main entry point for the interpreter
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.errNum
21 GET sh.error
22 GET sh.express
23 GET sh.getToken
24 GET sh.sail
25 GET sh.tokens
26 GET sh.upcalls
27
28 ;----- Main code ------------------------------------------------------------
29
30 AREA |Sapphire$$Code|,CODE,READONLY
31
32 ; --- interp_start ---
33 ;
34 ; On entry: R12 == pointer to our anchor block
35 ;
36 ; On exit: R7-R9 == next token
37 ;
38 ; Use: Prepares for execution, and even does some too.
39
40 EXPORT interp_start
41 interp_start ROUT
42
43 LDR R10,sail_tokAnchor ;Load the anchor
44
45 MOV R14,#1 ;The current line number
46 STR R14,sail_line ;Store it
47 MOV R9,#-1 ;Prepare for the first line
48 BL getToken ;Get the first token ready
49 SWI OS_ReadMonotonicTime ;Read the current time
50 STR R0,sail_timeSoFar ;Remember this time
51 B interp_exec ;Do some execution
52
53 LTORG
54
55 ; --- interp_resume ---
56 ;
57 ; On entry: R12 == script anchor
58 ;
59 ; On exit: --
60 ;
61 ; Use: Resumes the script from where it left off.
62
63 EXPORT interp_resume
64
65 ; --- interp_exec ---
66 ;
67 ; On entry: R7-R9 == token to deal with
68 ; R11 == offset in file to execute from
69 ; R12 == pointer to the anchor block
70 ;
71 ; On exit: R0 == type code (eg. 0 == we are still executing
72 ; R7-R9 == next token to deal with
73 ;
74 ; Use: Executes some of the file.
75
76 EXPORT interp_exec
77 interp_exec ROUT
78
79 LDR R1,sail_preempt ;Load the pre-emption time
80 CMP R1,#-1 ;Do we need to return?
81 BEQ %10interp_exec ;No -- jump onwards then
82 SWI OS_ReadMonotonicTime ;Read the current time
83 LDR R14,sail_timeSoFar ;Load the time we started
84 SUB R0,R0,R14 ;Thie we have been executing
85 CMP R0,R1 ;Time up yet?
86 BCC %10interp_exec ;No -- keep on going then
87
88 ; --- Return control for a little while then ---
89
90 00interp_exec B sail_wait ;Yes -- wait some then
91 interp_resume SWI OS_ReadMonotonicTime ;Read the current time
92 STR R0,sail_timeSoFar ;Remember this time
93
94 10interp_exec CMP R7,#tClass_instr ;Is this an instruction?
95 BNE %50interp_exec ;No -- could be other things
96
97 ; --- We have an instruction ---
98
99 MOV R0,R8 ;Look after index
100 BL getToken ;Get the next tokem
101 ADD PC,PC,R0,LSL #2 ;Branch to the correct code
102 DCB "Jive"
103
104 ; --- The main dispatch table ---
105
106 B ctrl_bput
107 B ctrl_case
108 B ctrl_close
109 B ctrl_call ;CALL
110 B ctrl_data
111 B ctrl_def
112 B ctrl_dim
113 B ctrl_end
114 B ctrl_endproc
115 B ctrl_endwhile
116 B interp_next ;ENDIF
117 B interp_next ;ENDCASE
118 B ctrl_else
119 B interp_notImpl ;B ctrl_error
120 B ctrl_for
121 B ctrl_goto
122 B ctrl_gosub
123 B ctrl_if
124 B ctrl_let
125 B ctrl_local
126 B ctrl_next
127 B ctrl_oscli ;OSCLI
128 B ctrl_otherwise
129 B ctrl_proc
130 B ctrl_return
131 B ctrl_repeat
132 B ctrl_read
133 B ctrl_restore
134 B ctrl_swap
135 B ctrl_sys
136 B ctrl_until
137 B ctrl_while
138 B ctrl_when
139
140 ; --- Handle pseudo varaible and the like ---
141
142 50interp_exec SUBS R4,R9,#'_' ;Is it an underscore?
143 SUBNES R4,R9,#'!'
144 SUBNES R4,R9,#'?'
145 SUBNES R4,R9,#'$'
146 SUBNE R4,R9,#'A' ;Or a capital letter?
147 CMP R4,#26
148 SUBCS R4,R9,#'a' ;Or a lowercase letter?
149 CMPCS R4,#26
150 BCC ctrl_let ;If so, assume assignment
151
152 CMP R9,#tok_time ;Is this a TIME pseudovar?
153 BLEQ getToken ;Yes -- done with this token
154 BEQ ctrl_timeEq ;Yes -- assign that then
155
156 CMP R7,#tClass_streamOp ;Is it a streamOp?
157 BNE %60interp_exec ;No -- jump ahead
158
159 MOV R0,R9 ;Remember the tokoen
160 BL getToken ;Get another token
161 CMP R9,#'#' ;Do we have a hash next?
162 MOVNE R0,#err_expHash ;No -- complain then
163 BNE error_report ;And report an error
164 BL getToken ;Get the next token
165 CMP R0,#tok_ptr ;Setting of pointer?
166 BEQ ctrl_ptr ;Yes -- do that then
167 CMP R0,#tok_ext ;Setting of extent?
168 BEQ ctrl_ext ;Yes -- do that
169 BNE interp_next ;Probably emtpy statement
170
171 60interp_exec CMP R7,#tClass_multArg ;A multiple argument thing?
172 BNE %70interp_exec ;No -- jump ahead
173
174 ; --- Deal with a multiple argument command ---
175
176 CMP R9,#tok_leftS ;Is it LEFT$?
177 BLEQ getToken ;Yes -- get a token
178 BEQ ctrl_leftS ;Yes -- deal with it
179 CMP R9,#tok_midS ;Is it MID$?
180 BLEQ getToken ;Yes -- get a token
181 BEQ ctrl_midS ;Yes -- deal with it
182 CMP R9,#tok_rightS ;Is it RIGHT$?
183 BLEQ getToken ;Yes -- get a token
184 BEQ ctrl_rightS ;Yes -- deal with it
185 BNE interp_next ;Probably emtpy statement
186
187 70interp_exec CMP R9,#'=' ;Is it a return-from-fn?
188 BLEQ getToken ;Yes -- gobble it then
189 BEQ ctrl_equals ;Yes -- return then
190
191 CMP R9,#'*' ;Is this a star command?
192 BNE interp_next ;Probably emtpy statement
193
194 ; --- We have a star command ---
195 ;
196 ; We copy the command into a buffer, until we reach
197 ; a terminating character.
198
199 ADR R0,sail_misc ;Point to the destination
200 00 BL getToken ;Get a token
201 CMP R9,#10 ;Is this the end of the line?
202 CMPNE R9,#&FF ;Or the end of the file
203 STRNEB R9,[R0],#1 ;No -- store the byte
204 BNE %b00 ;And keep on going
205
206 ; --- We have the string in the buffer ---
207
208 MOV R14,#0 ;We had better terminate it
209 STRB R14,[R0],#1 ;By store a NULL char
210 ADR R0,sail_misc ;Point to the command
211 SWI OS_CLI ;Perform the command
212
213 B interp_next ;Just keep on goin' then
214
215 LTORG
216
217 ; --- interp_notImpl ---
218
219 EXPORT interp_notImpl
220 interp_notImpl MOV R0,#err_lazy
221
222 B error_report
223
224 ; --- interp_next ---
225 ;
226 ; On entry: R7-R9 == token to deal with
227 ; R11 == offset in file to execute from
228 ; R12 == pointer to the anchor block
229 ;
230 ; On exit: R0 == type code (eg. 0 == we are still executing)
231 ; R7-R9 == next token to deal with
232 ;
233 ; Use: Checks the next instruction and acts approriately.
234
235 EXPORT interp_next
236 interp_next ROUT
237
238 CMP R9,#10 ;Is this newline?
239 LDR R14,sail_flags ;Load the flags word
240 ORREQ R14,R14,#tscFlag_nl ;Newline just arrived
241 BICNE R14,R14,#tscFlag_nl ;Or maybe not
242 STR R14,sail_flags ;Store the new flags back
243 CMPNE R9,#':' ;Is this a ':'?
244 BLEQ getToken ;Either -- get a token
245 BEQ interp_exec ;...and keep on looping
246
247 CMP R9,#tok_else ;Is this an ELSE?
248 BLEQ getToken ;Yes -- read a token
249 BEQ ctrl_else ;...and branch to else ctrl
250 SUBS R0,R9,#&FF ;Is this the end?
251 BEQ sail_return ;Yes -- just end then
252 MOV R0,#err_syntax ;This is a synatx error
253 B error_report ;So report it
254
255 LTORG
256
257 ;----- That's all, folks ----------------------------------------------------
258
259 END
The Straylight Source Distribution (obsolete software for RISC OS)