OLD | NEW |
| (Empty) |
1 | |
2 /* | |
3 * Copyright 2011 Google Inc. | |
4 * | |
5 * Use of this source code is governed by a BSD-style license that can be | |
6 * found in the LICENSE file. | |
7 */ | |
8 #include "Forth.h" | |
9 #include "ForthParser.h" | |
10 #include "SkString.h" | |
11 | |
12 #define BEGIN_WORD(name) \ | |
13 class name##_ForthWord : public ForthWord { \ | |
14 public: \ | |
15 virtual void exec(ForthEngine* fe) | |
16 | |
17 #define END_WORD }; | |
18 | |
19 /////////////////////////////////////////////////////////////////////////////// | |
20 | |
21 BEGIN_WORD(drop) { | |
22 (void)fe->pop(); | |
23 } END_WORD | |
24 | |
25 BEGIN_WORD(over) { | |
26 fe->push(fe->peek(1)); | |
27 } END_WORD | |
28 | |
29 BEGIN_WORD(dup) { | |
30 fe->push(fe->top()); | |
31 } END_WORD | |
32 | |
33 BEGIN_WORD(swap) { | |
34 intptr_t a = fe->pop(); | |
35 intptr_t b = fe->top(); | |
36 fe->setTop(a); | |
37 fe->push(b); | |
38 } END_WORD | |
39 | |
40 BEGIN_WORD(rot) { | |
41 intptr_t c = fe->pop(); | |
42 intptr_t b = fe->pop(); | |
43 intptr_t a = fe->pop(); | |
44 fe->push(b); | |
45 fe->push(c); | |
46 fe->push(a); | |
47 } END_WORD | |
48 | |
49 BEGIN_WORD(rrot) { | |
50 intptr_t c = fe->pop(); | |
51 intptr_t b = fe->pop(); | |
52 intptr_t a = fe->pop(); | |
53 fe->push(c); | |
54 fe->push(a); | |
55 fe->push(b); | |
56 } END_WORD | |
57 | |
58 BEGIN_WORD(swap2) { | |
59 intptr_t d = fe->pop(); | |
60 intptr_t c = fe->pop(); | |
61 intptr_t b = fe->pop(); | |
62 intptr_t a = fe->pop(); | |
63 fe->push(c); | |
64 fe->push(d); | |
65 fe->push(a); | |
66 fe->push(b); | |
67 } END_WORD | |
68 | |
69 BEGIN_WORD(dup2) { | |
70 fe->push(fe->peek(1)); | |
71 fe->push(fe->peek(1)); | |
72 } END_WORD | |
73 | |
74 BEGIN_WORD(over2) { | |
75 fe->push(fe->peek(3)); | |
76 fe->push(fe->peek(3)); | |
77 } END_WORD | |
78 | |
79 BEGIN_WORD(drop2) { | |
80 (void)fe->pop(); | |
81 (void)fe->pop(); | |
82 } END_WORD | |
83 | |
84 ///////////////// logicals | |
85 | |
86 BEGIN_WORD(logical_and) { | |
87 intptr_t tmp = fe->pop(); | |
88 fe->setTop(-(tmp && fe->top())); | |
89 } END_WORD | |
90 | |
91 BEGIN_WORD(logical_or) { | |
92 intptr_t tmp = fe->pop(); | |
93 fe->setTop(-(tmp || fe->top())); | |
94 } END_WORD | |
95 | |
96 BEGIN_WORD(logical_not) { | |
97 fe->setTop(-(!fe->top())); | |
98 } END_WORD | |
99 | |
100 BEGIN_WORD(if_dup) { | |
101 intptr_t tmp = fe->top(); | |
102 if (tmp) { | |
103 fe->push(tmp); | |
104 } | |
105 } END_WORD | |
106 | |
107 ///////////////// ints | |
108 | |
109 class add_ForthWord : public ForthWord { public: | |
110 virtual void exec(ForthEngine* fe) { | |
111 intptr_t tmp = fe->pop(); | |
112 fe->setTop(fe->top() + tmp); | |
113 }}; | |
114 | |
115 class sub_ForthWord : public ForthWord { public: | |
116 virtual void exec(ForthEngine* fe) { | |
117 intptr_t tmp = fe->pop(); | |
118 fe->setTop(fe->top() - tmp); | |
119 }}; | |
120 | |
121 class mul_ForthWord : public ForthWord { public: | |
122 virtual void exec(ForthEngine* fe) { | |
123 intptr_t tmp = fe->pop(); | |
124 fe->setTop(fe->top() * tmp); | |
125 }}; | |
126 | |
127 class div_ForthWord : public ForthWord { public: | |
128 virtual void exec(ForthEngine* fe) { | |
129 intptr_t tmp = fe->pop(); | |
130 fe->setTop(fe->top() / tmp); | |
131 }}; | |
132 | |
133 class mod_ForthWord : public ForthWord { public: | |
134 virtual void exec(ForthEngine* fe) { | |
135 intptr_t tmp = fe->pop(); | |
136 fe->setTop(fe->top() % tmp); | |
137 }}; | |
138 | |
139 class divmod_ForthWord : public ForthWord { public: | |
140 virtual void exec(ForthEngine* fe) { | |
141 intptr_t denom = fe->pop(); | |
142 intptr_t numer = fe->pop(); | |
143 fe->push(numer % denom); | |
144 fe->push(numer / denom); | |
145 }}; | |
146 | |
147 class dot_ForthWord : public ForthWord { public: | |
148 virtual void exec(ForthEngine* fe) { | |
149 SkString str; | |
150 str.printf("%d ", fe->pop()); | |
151 fe->sendOutput(str.c_str()); | |
152 }}; | |
153 | |
154 class abs_ForthWord : public ForthWord { public: | |
155 virtual void exec(ForthEngine* fe) { | |
156 int32_t value = fe->top(); | |
157 if (value < 0) { | |
158 fe->setTop(-value); | |
159 } | |
160 }}; | |
161 | |
162 class negate_ForthWord : public ForthWord { public: | |
163 virtual void exec(ForthEngine* fe) { | |
164 fe->setTop(-fe->top()); | |
165 }}; | |
166 | |
167 class min_ForthWord : public ForthWord { public: | |
168 virtual void exec(ForthEngine* fe) { | |
169 int32_t value = fe->pop(); | |
170 if (value < fe->top()) { | |
171 fe->setTop(value); | |
172 } | |
173 }}; | |
174 | |
175 class max_ForthWord : public ForthWord { | |
176 public: | |
177 virtual void exec(ForthEngine* fe) { | |
178 int32_t value = fe->pop(); | |
179 if (value > fe->top()) { | |
180 fe->setTop(value); | |
181 } | |
182 } | |
183 }; | |
184 | |
185 ///////////////// floats | |
186 | |
187 class fadd_ForthWord : public ForthWord { | |
188 public: | |
189 virtual void exec(ForthEngine* fe) { | |
190 float tmp = fe->fpop(); | |
191 fe->fsetTop(fe->ftop() + tmp); | |
192 } | |
193 }; | |
194 | |
195 class fsub_ForthWord : public ForthWord { | |
196 public: | |
197 virtual void exec(ForthEngine* fe) { | |
198 float tmp = fe->fpop(); | |
199 fe->fsetTop(fe->ftop() - tmp); | |
200 } | |
201 }; | |
202 | |
203 class fmul_ForthWord : public ForthWord { | |
204 public: | |
205 virtual void exec(ForthEngine* fe) { | |
206 float tmp = fe->fpop(); | |
207 fe->fsetTop(fe->ftop() * tmp); | |
208 } | |
209 }; | |
210 | |
211 class fdiv_ForthWord : public ForthWord { | |
212 public: | |
213 virtual void exec(ForthEngine* fe) { | |
214 float tmp = fe->fpop(); | |
215 fe->fsetTop(fe->ftop() / tmp); | |
216 } | |
217 }; | |
218 | |
219 class fdot_ForthWord : public ForthWord { | |
220 public: | |
221 virtual void exec(ForthEngine* fe) { | |
222 SkString str; | |
223 str.printf("%g ", fe->fpop()); | |
224 fe->sendOutput(str.c_str()); | |
225 } | |
226 }; | |
227 | |
228 class fabs_ForthWord : public ForthWord { | |
229 public: | |
230 virtual void exec(ForthEngine* fe) { | |
231 float value = fe->ftop(); | |
232 if (value < 0) { | |
233 fe->fsetTop(-value); | |
234 } | |
235 } | |
236 }; | |
237 | |
238 class fmin_ForthWord : public ForthWord { | |
239 public: | |
240 virtual void exec(ForthEngine* fe) { | |
241 float value = fe->fpop(); | |
242 if (value < fe->ftop()) { | |
243 fe->fsetTop(value); | |
244 } | |
245 } | |
246 }; | |
247 | |
248 class fmax_ForthWord : public ForthWord { | |
249 public: | |
250 virtual void exec(ForthEngine* fe) { | |
251 float value = fe->fpop(); | |
252 if (value > fe->ftop()) { | |
253 fe->fsetTop(value); | |
254 } | |
255 } | |
256 }; | |
257 | |
258 class floor_ForthWord : public ForthWord { | |
259 public: | |
260 virtual void exec(ForthEngine* fe) { | |
261 fe->fsetTop(floorf(fe->ftop())); | |
262 } | |
263 }; | |
264 | |
265 class ceil_ForthWord : public ForthWord { | |
266 public: | |
267 virtual void exec(ForthEngine* fe) { | |
268 fe->fsetTop(ceilf(fe->ftop())); | |
269 } | |
270 }; | |
271 | |
272 class round_ForthWord : public ForthWord { | |
273 public: | |
274 virtual void exec(ForthEngine* fe) { | |
275 fe->fsetTop(floorf(fe->ftop() + 0.5f)); | |
276 } | |
277 }; | |
278 | |
279 class f2i_ForthWord : public ForthWord { | |
280 public: | |
281 virtual void exec(ForthEngine* fe) { | |
282 fe->setTop((int)fe->ftop()); | |
283 } | |
284 }; | |
285 | |
286 class i2f_ForthWord : public ForthWord { | |
287 public: | |
288 virtual void exec(ForthEngine* fe) { | |
289 fe->fsetTop((float)fe->top()); | |
290 } | |
291 }; | |
292 | |
293 ////////////////////////////// int compares | |
294 | |
295 class eq_ForthWord : public ForthWord { public: | |
296 virtual void exec(ForthEngine* fe) { | |
297 fe->push(-(fe->pop() == fe->pop())); | |
298 } | |
299 }; | |
300 | |
301 class neq_ForthWord : public ForthWord { public: | |
302 virtual void exec(ForthEngine* fe) { | |
303 fe->push(-(fe->pop() != fe->pop())); | |
304 } | |
305 }; | |
306 | |
307 class lt_ForthWord : public ForthWord { public: | |
308 virtual void exec(ForthEngine* fe) { | |
309 intptr_t tmp = fe->pop(); | |
310 fe->setTop(-(fe->top() < tmp)); | |
311 } | |
312 }; | |
313 | |
314 class le_ForthWord : public ForthWord { public: | |
315 virtual void exec(ForthEngine* fe) { | |
316 intptr_t tmp = fe->pop(); | |
317 fe->setTop(-(fe->top() <= tmp)); | |
318 } | |
319 }; | |
320 | |
321 class gt_ForthWord : public ForthWord { public: | |
322 virtual void exec(ForthEngine* fe) { | |
323 intptr_t tmp = fe->pop(); | |
324 fe->setTop(-(fe->top() > tmp)); | |
325 } | |
326 }; | |
327 | |
328 class ge_ForthWord : public ForthWord { public: | |
329 virtual void exec(ForthEngine* fe) { | |
330 intptr_t tmp = fe->pop(); | |
331 fe->setTop(-(fe->top() >= tmp)); | |
332 } | |
333 }; | |
334 | |
335 BEGIN_WORD(lt0) { | |
336 fe->setTop(fe->top() >> 31); | |
337 } END_WORD | |
338 | |
339 BEGIN_WORD(ge0) { | |
340 fe->setTop(~(fe->top() >> 31)); | |
341 } END_WORD | |
342 | |
343 BEGIN_WORD(gt0) { | |
344 fe->setTop(-(fe->top() > 0)); | |
345 } END_WORD | |
346 | |
347 BEGIN_WORD(le0) { | |
348 fe->setTop(-(fe->top() <= 0)); | |
349 } END_WORD | |
350 | |
351 /////////////////////////////// float compares | |
352 | |
353 /* negative zero is our nemesis, otherwise we could use = and <> from ints */ | |
354 | |
355 class feq_ForthWord : public ForthWord { public: | |
356 virtual void exec(ForthEngine* fe) { | |
357 fe->push(-(fe->fpop() == fe->fpop())); | |
358 } | |
359 }; | |
360 | |
361 class fneq_ForthWord : public ForthWord { public: | |
362 virtual void exec(ForthEngine* fe) { | |
363 fe->push(-(fe->fpop() != fe->fpop())); | |
364 } | |
365 }; | |
366 | |
367 class flt_ForthWord : public ForthWord { public: | |
368 virtual void exec(ForthEngine* fe) { | |
369 float tmp = fe->fpop(); | |
370 fe->setTop(-(fe->ftop() < tmp)); | |
371 } | |
372 }; | |
373 | |
374 class fle_ForthWord : public ForthWord { public: | |
375 virtual void exec(ForthEngine* fe) { | |
376 float tmp = fe->fpop(); | |
377 fe->setTop(-(fe->ftop() <= tmp)); | |
378 } | |
379 }; | |
380 | |
381 class fgt_ForthWord : public ForthWord { public: | |
382 virtual void exec(ForthEngine* fe) { | |
383 float tmp = fe->fpop(); | |
384 fe->setTop(-(fe->ftop() > tmp)); | |
385 } | |
386 }; | |
387 | |
388 class fge_ForthWord : public ForthWord { public: | |
389 virtual void exec(ForthEngine* fe) { | |
390 float tmp = fe->fpop(); | |
391 fe->setTop(-(fe->ftop() >= tmp)); | |
392 } | |
393 }; | |
394 | |
395 /////////////////////////////////////////////////////////////////////////////// | |
396 | |
397 #define ADD_LITERAL_WORD(sym, name) \ | |
398 this->add(sym, sizeof(sym)-1, new name##_ForthWord) | |
399 | |
400 void ForthParser::addStdWords() { | |
401 ADD_LITERAL_WORD("DROP", drop); | |
402 ADD_LITERAL_WORD("DUP", dup); | |
403 ADD_LITERAL_WORD("SWAP", swap); | |
404 ADD_LITERAL_WORD("OVER", over); | |
405 ADD_LITERAL_WORD("ROT", rot); | |
406 ADD_LITERAL_WORD("-ROT", rrot); | |
407 ADD_LITERAL_WORD("2SWAP", swap2); | |
408 ADD_LITERAL_WORD("2DUP", dup2); | |
409 ADD_LITERAL_WORD("2OVER", over2); | |
410 ADD_LITERAL_WORD("2DROP", drop2); | |
411 | |
412 ADD_LITERAL_WORD("+", add); | |
413 ADD_LITERAL_WORD("-", sub); | |
414 ADD_LITERAL_WORD("*", mul); | |
415 ADD_LITERAL_WORD("/", div); | |
416 ADD_LITERAL_WORD("MOD", mod); | |
417 ADD_LITERAL_WORD("/MOD", divmod); | |
418 | |
419 ADD_LITERAL_WORD(".", dot); | |
420 ADD_LITERAL_WORD("ABS", abs); | |
421 ADD_LITERAL_WORD("NEGATE", negate); | |
422 ADD_LITERAL_WORD("MIN", min); | |
423 ADD_LITERAL_WORD("MAX", max); | |
424 | |
425 ADD_LITERAL_WORD("AND", logical_and); | |
426 ADD_LITERAL_WORD("OR", logical_or); | |
427 ADD_LITERAL_WORD("0=", logical_not); | |
428 ADD_LITERAL_WORD("?DUP", if_dup); | |
429 | |
430 this->add("f+", 2, new fadd_ForthWord); | |
431 this->add("f-", 2, new fsub_ForthWord); | |
432 this->add("f*", 2, new fmul_ForthWord); | |
433 this->add("f/", 2, new fdiv_ForthWord); | |
434 this->add("f.", 2, new fdot_ForthWord); | |
435 this->add("fabs", 4, new fabs_ForthWord); | |
436 this->add("fmin", 4, new fmin_ForthWord); | |
437 this->add("fmax", 4, new fmax_ForthWord); | |
438 this->add("floor", 5, new floor_ForthWord); | |
439 this->add("ceil", 4, new ceil_ForthWord); | |
440 this->add("round", 5, new round_ForthWord); | |
441 this->add("f>i", 3, new f2i_ForthWord); | |
442 this->add("i>f", 3, new i2f_ForthWord); | |
443 | |
444 this->add("=", 1, new eq_ForthWord); | |
445 this->add("<>", 2, new neq_ForthWord); | |
446 this->add("<", 1, new lt_ForthWord); | |
447 this->add("<=", 2, new le_ForthWord); | |
448 this->add(">", 1, new gt_ForthWord); | |
449 this->add(">=", 2, new ge_ForthWord); | |
450 ADD_LITERAL_WORD("0<", lt0); | |
451 ADD_LITERAL_WORD("0>", gt0); | |
452 ADD_LITERAL_WORD("0<=", le0); | |
453 ADD_LITERAL_WORD("0>=", ge0); | |
454 | |
455 this->add("f=", 2, new feq_ForthWord); | |
456 this->add("f<>", 3, new fneq_ForthWord); | |
457 this->add("f<", 2, new flt_ForthWord); | |
458 this->add("f<=", 3, new fle_ForthWord); | |
459 this->add("f>", 2, new fgt_ForthWord); | |
460 this->add("f>=", 3, new fge_ForthWord); | |
461 } | |
OLD | NEW |