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
BEGIN_WORD(drop)21 BEGIN_WORD(drop) {
22 (void)fe->pop();
23 } END_WORD
24
BEGIN_WORD(over)25 BEGIN_WORD(over) {
26 fe->push(fe->peek(1));
27 } END_WORD
28
BEGIN_WORD(dup)29 BEGIN_WORD(dup) {
30 fe->push(fe->top());
31 } END_WORD
32
BEGIN_WORD(swap)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
BEGIN_WORD(rot)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
BEGIN_WORD(rrot)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
BEGIN_WORD(swap2)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
BEGIN_WORD(dup2)69 BEGIN_WORD(dup2) {
70 fe->push(fe->peek(1));
71 fe->push(fe->peek(1));
72 } END_WORD
73
BEGIN_WORD(over2)74 BEGIN_WORD(over2) {
75 fe->push(fe->peek(3));
76 fe->push(fe->peek(3));
77 } END_WORD
78
BEGIN_WORD(drop2)79 BEGIN_WORD(drop2) {
80 (void)fe->pop();
81 (void)fe->pop();
82 } END_WORD
83
84 ///////////////// logicals
85
BEGIN_WORD(logical_and)86 BEGIN_WORD(logical_and) {
87 intptr_t tmp = fe->pop();
88 fe->setTop(-(tmp && fe->top()));
89 } END_WORD
90
BEGIN_WORD(logical_or)91 BEGIN_WORD(logical_or) {
92 intptr_t tmp = fe->pop();
93 fe->setTop(-(tmp || fe->top()));
94 } END_WORD
95
BEGIN_WORD(logical_not)96 BEGIN_WORD(logical_not) {
97 fe->setTop(-(!fe->top()));
98 } END_WORD
99
BEGIN_WORD(if_dup)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)163 virtual void exec(ForthEngine* fe) {
164 fe->setTop(-fe->top());
165 }};
166
167 class min_ForthWord : public ForthWord { public:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)260 virtual void exec(ForthEngine* fe) {
261 fe->fsetTop(floorf(fe->ftop()));
262 }
263 };
264
265 class ceil_ForthWord : public ForthWord {
266 public:
exec(ForthEngine * fe)267 virtual void exec(ForthEngine* fe) {
268 fe->fsetTop(ceilf(fe->ftop()));
269 }
270 };
271
272 class round_ForthWord : public ForthWord {
273 public:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)281 virtual void exec(ForthEngine* fe) {
282 fe->setTop((int)fe->ftop());
283 }
284 };
285
286 class i2f_ForthWord : public ForthWord {
287 public:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)296 virtual void exec(ForthEngine* fe) {
297 fe->push(-(fe->pop() == fe->pop()));
298 }
299 };
300
301 class neq_ForthWord : public ForthWord { public:
exec(ForthEngine * fe)302 virtual void exec(ForthEngine* fe) {
303 fe->push(-(fe->pop() != fe->pop()));
304 }
305 };
306
307 class lt_ForthWord : public ForthWord { public:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)329 virtual void exec(ForthEngine* fe) {
330 intptr_t tmp = fe->pop();
331 fe->setTop(-(fe->top() >= tmp));
332 }
333 };
334
BEGIN_WORD(lt0)335 BEGIN_WORD(lt0) {
336 fe->setTop(fe->top() >> 31);
337 } END_WORD
338
BEGIN_WORD(ge0)339 BEGIN_WORD(ge0) {
340 fe->setTop(~(fe->top() >> 31));
341 } END_WORD
342
BEGIN_WORD(gt0)343 BEGIN_WORD(gt0) {
344 fe->setTop(-(fe->top() > 0));
345 } END_WORD
346
BEGIN_WORD(le0)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:
exec(ForthEngine * fe)356 virtual void exec(ForthEngine* fe) {
357 fe->push(-(fe->fpop() == fe->fpop()));
358 }
359 };
360
361 class fneq_ForthWord : public ForthWord { public:
exec(ForthEngine * fe)362 virtual void exec(ForthEngine* fe) {
363 fe->push(-(fe->fpop() != fe->fpop()));
364 }
365 };
366
367 class flt_ForthWord : public ForthWord { public:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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:
exec(ForthEngine * fe)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
addStdWords()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 }
462