Home | History | Annotate | Download | only in forth
      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 }
    462