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
21BEGIN_WORD(drop) {
22    (void)fe->pop();
23} END_WORD
24
25BEGIN_WORD(over) {
26    fe->push(fe->peek(1));
27} END_WORD
28
29BEGIN_WORD(dup) {
30    fe->push(fe->top());
31} END_WORD
32
33BEGIN_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
40BEGIN_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
49BEGIN_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
58BEGIN_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
69BEGIN_WORD(dup2) {
70    fe->push(fe->peek(1));
71    fe->push(fe->peek(1));
72} END_WORD
73
74BEGIN_WORD(over2) {
75    fe->push(fe->peek(3));
76    fe->push(fe->peek(3));
77} END_WORD
78
79BEGIN_WORD(drop2) {
80    (void)fe->pop();
81    (void)fe->pop();
82} END_WORD
83
84///////////////// logicals
85
86BEGIN_WORD(logical_and) {
87    intptr_t tmp = fe->pop();
88    fe->setTop(-(tmp && fe->top()));
89} END_WORD
90
91BEGIN_WORD(logical_or) {
92    intptr_t tmp = fe->pop();
93    fe->setTop(-(tmp || fe->top()));
94} END_WORD
95
96BEGIN_WORD(logical_not) {
97    fe->setTop(-(!fe->top()));
98} END_WORD
99
100BEGIN_WORD(if_dup) {
101    intptr_t tmp = fe->top();
102    if (tmp) {
103        fe->push(tmp);
104    }
105} END_WORD
106
107///////////////// ints
108
109class 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
115class 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
121class 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
127class 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
133class 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
139class 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
147class 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
154class 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
162class negate_ForthWord : public ForthWord { public:
163    virtual void exec(ForthEngine* fe) {
164        fe->setTop(-fe->top());
165    }};
166
167class 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
175class max_ForthWord : public ForthWord {
176public:
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
187class fadd_ForthWord : public ForthWord {
188public:
189    virtual void exec(ForthEngine* fe) {
190        float tmp = fe->fpop();
191        fe->fsetTop(fe->ftop() + tmp);
192    }
193};
194
195class fsub_ForthWord : public ForthWord {
196public:
197    virtual void exec(ForthEngine* fe) {
198        float tmp = fe->fpop();
199        fe->fsetTop(fe->ftop() - tmp);
200    }
201};
202
203class fmul_ForthWord : public ForthWord {
204public:
205    virtual void exec(ForthEngine* fe) {
206        float tmp = fe->fpop();
207        fe->fsetTop(fe->ftop() * tmp);
208    }
209};
210
211class fdiv_ForthWord : public ForthWord {
212public:
213    virtual void exec(ForthEngine* fe) {
214        float tmp = fe->fpop();
215        fe->fsetTop(fe->ftop() / tmp);
216    }
217};
218
219class fdot_ForthWord : public ForthWord {
220public:
221    virtual void exec(ForthEngine* fe) {
222        SkString str;
223        str.printf("%g ", fe->fpop());
224        fe->sendOutput(str.c_str());
225    }
226};
227
228class fabs_ForthWord : public ForthWord {
229public:
230    virtual void exec(ForthEngine* fe) {
231        float value = fe->ftop();
232        if (value < 0) {
233            fe->fsetTop(-value);
234        }
235    }
236};
237
238class fmin_ForthWord : public ForthWord {
239public:
240    virtual void exec(ForthEngine* fe) {
241        float value = fe->fpop();
242        if (value < fe->ftop()) {
243            fe->fsetTop(value);
244        }
245    }
246};
247
248class fmax_ForthWord : public ForthWord {
249public:
250    virtual void exec(ForthEngine* fe) {
251        float value = fe->fpop();
252        if (value > fe->ftop()) {
253            fe->fsetTop(value);
254        }
255    }
256};
257
258class floor_ForthWord : public ForthWord {
259public:
260    virtual void exec(ForthEngine* fe) {
261        fe->fsetTop(floorf(fe->ftop()));
262    }
263};
264
265class ceil_ForthWord : public ForthWord {
266public:
267    virtual void exec(ForthEngine* fe) {
268        fe->fsetTop(ceilf(fe->ftop()));
269    }
270};
271
272class round_ForthWord : public ForthWord {
273public:
274    virtual void exec(ForthEngine* fe) {
275        fe->fsetTop(floorf(fe->ftop() + 0.5f));
276    }
277};
278
279class f2i_ForthWord : public ForthWord {
280public:
281    virtual void exec(ForthEngine* fe) {
282        fe->setTop((int)fe->ftop());
283    }
284};
285
286class i2f_ForthWord : public ForthWord {
287public:
288    virtual void exec(ForthEngine* fe) {
289        fe->fsetTop((float)fe->top());
290    }
291};
292
293////////////////////////////// int compares
294
295class eq_ForthWord : public ForthWord { public:
296    virtual void exec(ForthEngine* fe) {
297        fe->push(-(fe->pop() == fe->pop()));
298    }
299};
300
301class neq_ForthWord : public ForthWord { public:
302    virtual void exec(ForthEngine* fe) {
303        fe->push(-(fe->pop() != fe->pop()));
304    }
305};
306
307class 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
314class 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
321class 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
328class 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
335BEGIN_WORD(lt0) {
336    fe->setTop(fe->top() >> 31);
337} END_WORD
338
339BEGIN_WORD(ge0) {
340    fe->setTop(~(fe->top() >> 31));
341} END_WORD
342
343BEGIN_WORD(gt0) {
344    fe->setTop(-(fe->top() > 0));
345} END_WORD
346
347BEGIN_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
355class feq_ForthWord : public ForthWord { public:
356    virtual void exec(ForthEngine* fe) {
357        fe->push(-(fe->fpop() == fe->fpop()));
358    }
359};
360
361class fneq_ForthWord : public ForthWord { public:
362    virtual void exec(ForthEngine* fe) {
363        fe->push(-(fe->fpop() != fe->fpop()));
364    }
365};
366
367class 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
374class 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
381class 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
388class 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
400void 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