~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / sail / s / value
1 ;
2 ; value.s
3 ;
4 ; Table drive expression evaluator for TermScript
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 |Termscript$$Code|,CODE,READONLY
21
22 ; --- val_readExp ---
23 ;
24 ; On entry: R7, R8, R9 == lookahead token
25 ; R10 == pointer into tokenised buffer
26 ; R11 == evaluation stack pointer
27 ; R12 == anchor pointer
28 ;
29 ; On exit: R7, R8, R9 == lookahead token
30 ; R0, R1 == result of expression
31 ; R10 == moved on to first char after expression
32 ;
33 ; Use: Reads an expression for the current point in the tokenised
34 ; file, and returns it's result. The implementation is
35 ; table driven and should be very fast.
36
37 EXPORT val_readExp
38 val_readExp ROUT
39
40 10val_readExp BL val__operand
41 BLCS val__operator
42 BCS val_readExp
43
44 ; --- Now work out the result ---
45
46 BL val__copyRest ;Copy rest of tokens over
47
48
49 LTORG
50
51 ; --- val__operand ---
52 ;
53 ; On entry: R7, R8, R9 == lookahead token
54 ; R10 == pointer into tokenised buffer
55 ; R11 == evaluation stack pointer
56 ; R12 == anchor pointer
57 ;
58 ; On exit: R0 corrupted
59 ; R7, R8, R9 == lookahead token
60 ; R10 modified appropriately
61 ; CS if operand found,
62 ; CC otherwise
63 ;
64 ; Use: Reads an operand from the input, and does appropriate
65 ; stack like things with it.
66
67 val__operand ROUT
68
69 STMFD R13!,{R14} ;Stack registers
70 00val__operand CMP R9,#'&' ;Start a hex number?
71 BEQ %10val__operand ;Yes -- jump ahead
72 CMP R9,#'%' ;Start of a binary number?
73 BEQ %20val__operand ;Yes -- jump ahead
74 CMP R9,#'!' ;An indirection operand?
75 CMPNE R9,#'?'
76 CMPNE R9,#'$'
77 BEQ %40val__operand ;Yes -- jump ahead
78 CMP R9,#'+' ;Unary operator then?
79 CMPNE R9,#'-'
80 BEQ %50val__operand ;Yes -- jump ahead
81 CMPNE R9,#'(' ;A nice bracket?
82 BEQ %60val__operand ;Yes -- jump ahead
83 SUB R14,R9,#'0' ;Set up for a range check
84 CMP R14,#10 ;Is it a digit?
85 MOVCC R0,#0 ;Yes -- set up accumulator
86 BCC %30val__operand ;Yes -- deal with that
87 B %70val__operand ;Assume it's an identifier
88
89 ; --- Read a hex number ---
90
91 10val__operand BL getToken ;Get another token
92 MOV R0,#0 ;The number so far
93 SUB R14,R9,#'A' ;Check if it's a letter
94 CMP R14,#6 ;But only A-F
95 ADDCC R14,R14,#10 ;If so, add 10 on
96 SUBCS R14,R9,#'0' ;Otherwise check for digit
97 CMPCS R14,#10 ;Make sure it's OK
98 BCC %12val__operand ;And jump head
99 MOV R0,#err_badHex ;Point to error message
100 B error_report ;And return the error
101
102 11val__operand SUB R14,R9,#'A' ;Check if it's a letter
103 CMP R14,#6 ;But only A-F
104 ADDCC R14,R14,#10 ;If so, add 10 on
105 SUBCS R14,R9,#'0' ;Otherwise check for digit
106 CMPCS R14,#10 ;Make sure it's OK
107 BCS %35val__readSimple ;No -- that's it then
108
109 12val__operand ADD R0,R14,R0,LSL #4 ;Multiply by 16 and add digit
110 BL getToken ;Load a character
111 B %11val__readSimple ;Keep on reading more
112
113 ; --- Read a binary number ---
114
115 20val__operand BL getToken ;Get another token
116 MOV R0,#0 ;The number so far
117 SUB R14,R9,#'0' ;Set up for a range check
118 CMP R14,#1 ;Is it a digit
119 BLS %22val__readSimple ;Yes -- jump ahead
120 MOV R0,#err_badBinary ;Point to error message
121 B error_report ;And return the error
122
123 21val__operand SUB R14,R9,#'0' ;Set up for a range check
124 CMP R14,#1 ;Is it a digit
125 BHI %35val__readSimple ;Nope -- jump ahead then
126
127 22val__operand ADC R0,R0,R0 ;Multiply by 2
128 BL getToken ;Load a character
129 B %21val__readSimple ;Keep on reading more
130
131 ; --- Read a decimal number ---
132
133 30val__operand SUB R14,R9,#'0' ;Set up for a range check
134 CMP R14,#10 ;Is it a digit
135 BCS %35val__readSimple ;Nope -- jump ahead then
136
137 32val__operand ADD R0,R0,R0,LSL #2 ;Multiply by 5
138 ADD R0,R14,R0,LSL #1 ;And then by 2 (* 10)
139 BL getToken ;Load the next token
140 B %30val__readSimple ;Keep on reading more
141
142 ; --- Finished reading a number ---
143
144 35val__operand BL val__stackNumber ;Put a number on the stack
145 B %90val__operand ;Jump ahead
146
147 ; --- Read an indirection operator ---
148
149 40val__operand MOV R0,#0 ;Get the offset ready
150 BL val__stackNumber ;Put it on the stack
151 BL val__stackToken ;And put operator on too
152 BL getToken ;Get the next token
153 B %00val__operand ;Need another operand
154
155 ; --- Deal with unary signs ---
156
157 50val__operand CMP R9,#'-' ;Is is a unary minus
158 BLEQ val__stackToken ;Yes -- put it on the stack
159 BL getToken ;Get another token
160 B %00val__operand ;Need another operand
161
162 ; --- We have just read a '(' ---
163
164 60val__operand BL val__stackToken ;Stackit immediately
165 BL getToken ;Get another token
166 B %00val__operand ;Need another operand
167
168 ; --- Assume it's an identifier then ---
169
170 70val__operand ADR R1,sail_misc ;Point to a nice block
171 MOV R0,#vType_integer ;The current variable type
172
173 75val__operand SUBS R14,R9,#'_' ;Is it an underscore?
174 SUBNE R14,R9,#'0' ;Or a number?
175 CMP R14,#10
176 SUBCS R14,R9,#'A' ;Or a capital letter?
177 CMPCS R14,#26
178 SUBCS R14,R9,#'a' ;Or a lowercase letter?
179 CMPCS R14,#26
180 STRCCB R9,[R1],#1 ;Yes -- store it away
181 BLCC getToken ;Read the next byte
182 BCS %95val_readLvalue ;Ouch -- not an identifier
183
184 CMP R9,#'$' ;Is it a dollar sign?
185 MOVEQ R0,#vType_string ;It's a string now
186 CMPNE R9,#'%' ;Or a percentage?
187 STREQB R9,[R2],#1 ;Yes -- store it then
188 CMPNE R9,#' ' ;Just check for a space
189
190 BNE %75val_readLvalue ;Go round for more
191
192 MOV R14,#0 ;The terminator
193 STRB R14,[R1],#0 ;Store that in the var name
194 BL getToken ;Read the next token ready
195
196 ; --- The identifier name is in the buffer ---
197
198 ADR R1,sail_misc ;Point to the name
199 BL var_find ;Try to find the variable
200 MOVCC R0,#err_unknown ;Not there, get the error
201 BCC error_report ;And report a possible error
202
203 LDR R1,[R0,#0] ;Load out the variable type
204 LDR R0,[R0,#4] ;Load out the value
205 CMP R1,#vType_integer ;Is it an integer?
206 BLEQ val__stackInteger ;Yes -- stack it
207 BLNE val__stackString ;No -- it's a string then
208
209 90val__operand LDMFD R13!,{R14} ;Load back registers
210 ORRS PC,R14,#C_flag ;We found an operand
211
212 95val__operand LDMFD R13!,{R14} ;Load back registers
213 BICS PC,R14,#C_flag ;No operand was found
214
215 LTORG
216
217 ; --- val__operator ---
218 ;
219 ; On entry: R7, R8, R9 == lookahead token
220 ; R10 == pointer into tokenised buffer
221 ; R11 == evaluation stack pointer
222 ; R12 == anchor pointer
223 ;
224 ; On exit: R7, R8, R9 == lookahead token
225 ; R10 modified appropriately
226 ; CS if operator found,
227 ; CC otherwise
228 ;
229 ; Use: Reads an operator from the input, and does appropriate
230 ; stack like things with it.
231
232 ROUT
233
234 val__operator STMFD R13!,{R14} ;Stack registers
235 00val__operator CMP R9,#')' ;Is it a close bracket?
236 BEQ %10val__operator ;Yes -- jump ahead
237 ; --- Make sure we recognise it ---
238
239 CMP R9,#'!' ;An indirection operator?
240 CMPNE R9,#'?'
241 CMPNE R7,#tClass__andOp
242 CMPNE R7,#tClass__orOp
243 CMPNE R7,#tClass__addOp
244 CMPNE R7,#tClass__multOp
245 CMPNE R7,#tClass__relOp
246 BNE %95val__operator ;Nope -- just return
247 BL val__stackToken ;Stack this token
248 BL getToken ;Get another one
249 B %90val__operator ;And return success
250
251 ; --- We have read a ')' ---
252
253 BL val__stackToken ;Stack this token
254 BL getToken ;Get another one
255 B %00val__operator ;We expect another operator
256
257 90val__operator LDMFD R13!,{R14} ;Load back registers
258 ORRS PC,R14,#C_flag ;We found an operand
259
260 95val__operator LDMFD R13!,{R14} ;Load back registers
261 BICS PC,R14,#C_flag ;No operand was found
262
263 LTORG
264
265 ;----- Workspace ------------------------------------------------------------
266
267 val__precTable DCD val__andOp-val__precTable
268 DCD 0
269 DCD 0
270 DCD 0
271 DCD val__multOp-val__precTable
272 DCD val__orOp-val__precTable
273 DCD 0
274 DCD val__relOp-val__precTable
275 DCD val__addOp-val__precTable
276 DCD 0
277
278 ; --- The precedence tables ---
279 ;
280 ; Each byte indicates whether or not the given type of
281 ; toke has a higher or lower precedence than another type.
282 ; The order of the bytes is:
283 ;
284 ; and,-,-,-,mult,or,-,-,rel,add,-
285
286 val__andOp DCB 0, 0, 0, 0,-1, 1, 0, 0,-1,-1, 0
287 val__multOp DCB 1, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0
288 val__orOp DCB -1, 0, 0, 0,-1, 0, 0, 0,-1,-1, 0
289 val__relOp DCB 1, 0, 0, 0,-1, 1, 0, 0, 0,-1, 0
290 val__addOp DCB 1, 0, 0, 0,-1, 1, 0, 0, 1, 0, 0
291
292 ;----- That's all, folks ----------------------------------------------------
293
294 END
The Straylight Source Distribution (obsolete software for RISC OS)