isolate foci code

1 files changed, 168 insertions, 0 deletions

diff --git a/foci.c b/foci.c
new file mode 100644
index 0000000..bcb8ae5
--- /dev/null
+++ b/foci.c
@@ -0,0 +1,168 @@
+#include "foci.h"
+
+#include <stdio.h> // puts
+#include <stdlib.h> // strtol
+#include <string.h> // strncmp
+
+#define END_OF(arr) ((arr) + (sizeof((arr)) / sizeof(*(arr))))
+
+static intptr_t dstack[32];
+static intptr_t **rstack[32];
+static intptr_t dict[8192] = {
+    0, 10
+};
+#define state dict[0]
+#define base  dict[1]
+#define begin dict[2]
+static intptr_t *here = &begin;
+static struct word_t *latest;
+
+static intptr_t     saved_tmp;
+static intptr_t *   saved_sp;
+static intptr_t *** saved_rp;
+static intptr_t **  saved_pp;
+
+NAKED void enter(void) { *--rp = ++pp; pp = (intptr_t **)*pp; goto *(*pp); }
+NAKED void  push(void) { *--sp = (intptr_t)*++pp; NEXT; }
+      void fexit(void) { if (rp < END_OF(rstack)) { pp = *rp++; NEXT; } }
+
+NAKED void compname(void)
+{
+    static int ch;
+
+    STASH;
+    for (;;) {
+        extern int getchar(void);
+        ch = getchar();
+
+        if (ch <= 0x20)
+            break;
+
+        *(unsigned char *)here += 1;
+        ((char *)here)[*(unsigned char *)here] = ch;
+    }
+    here = (intptr_t *)((intptr_t)here + *(unsigned char *)here);
+    RESTORE;
+
+    NEXT;
+}
+
+N(dup,    "dup",    0)        { --sp; sp[0] = sp[1]; NEXT; }
+N(drop,   "drop",   &w_dup)   { ++sp; NEXT; }
+N(swap,   "swap",   &w_drop)  { tmp = sp[0]; sp[0] = sp[1]; sp[1] = tmp; NEXT; }
+N(rot,    "rot",    &w_swap)  { tmp = sp[0]; sp[0] = sp[2]; sp[2] = sp[1];
+                                sp[1] = tmp; NEXT; }
+N(peek,   "@",      &w_rot)   { *sp = *(intptr_t *)*sp; NEXT; }
+N(poke,   "!",      &w_peek)  { *(intptr_t *)sp[0] = sp[1]; sp += 2; NEXT; }
+N(cpeek,  "c@",     &w_poke)  { *sp = *(char *)*sp; NEXT; }
+N(cpoke,  "c!",     &w_cpeek) { *(char *)sp[0] = (char)sp[1]; sp += 2; NEXT; }
+N(add,    "+",      &w_cpoke) { sp[1] += sp[0]; ++sp; NEXT; }
+N(sub,    "-",      &w_add)   { sp[1] -= sp[0]; ++sp; NEXT; }
+N(mul,    "*",      &w_sub)   { sp[1] *= sp[0]; ++sp; NEXT; }
+N(ndiv,   "/",      &w_mul)   { sp[1] /= sp[0]; ++sp; NEXT; }
+N(mod,    "mod",    &w_ndiv)  { sp[1] %= sp[0]; ++sp; NEXT; }
+N(and,    "and",    &w_mod)   { sp[1] &= sp[0]; ++sp; NEXT; }
+N(or,     "or",     &w_and)   { sp[1] |= sp[0]; ++sp; NEXT; }
+N(xor,    "xor",    &w_or)    { sp[1] ^= sp[0]; ++sp; NEXT; }
+C(intr,   "[",      &w_xor)   { state = 0; NEXT; }
+N(comp,   "]",      &w_intr)  { state = -1; NEXT; }
+N(comma,  ",",      &w_comp)  { *here++ = *sp++; NEXT; }
+W(cell,   "cell",   &w_comma)   LIT(sizeof(*sp)),   END
+W(cellp,  "cell+",  &w_cell)    FTH(cell), add,     END
+W(cells,  "cells",  &w_cellp)   FTH(cell), mul,     END
+W(dict,   "_d",     &w_cells)   LIT(dict),          END
+W(here,   "here",   &w_dict)    LIT(&here), peek,   END
+W(latest, "latest", &w_here)    LIT(&latest), peek, END
+W(negate, "negate", &w_latest)  LIT(-1), mul, END
+W(invert, "invert", &w_negate)  LIT(-1), xor, END
+W(dec,    "1-",     &w_invert)  LIT(1), sub,  END
+W(inc,    "1+",     &w_dec)     LIT(1), add,  END
+W(aligned, "aligned", &w_inc)   LIT(sizeof(*sp) - 1), add, LIT(~(sizeof(*sp) - 1)),
+                                and, END
+W(align,  "align",  &w_aligned) FTH(here), FTH(aligned), LIT(&here), poke, END
+W(colon,  ":",      &w_align)   FTH(here), LIT(0), comma, FTH(latest), comma,
+                                compname, FTH(align), dup, FTH(here), swap,
+                                poke, comp, END
+I(semic,  ";",      &w_colon)   LIT(fexit), comma, LIT(&latest), poke, intr, END
+I(literal, "literal", &w_semic) LIT(push), comma, comma, END
+#define LATEST      &w_literal
+
+void call(void *ptr)
+{
+    pp = ptr;
+    ((void (*)())*pp)();
+}
+
+void parse_word(const char *buf, const char *s)
+{
+    struct word_t *l;
+    for (l = latest; l; l = l->prev) {
+        const int ln = l->attr & ATTR_LEN;
+
+        if (s - buf == ln && !strncmp(buf, l->name, ln))
+            break;
+    }
+
+    tmp = saved_tmp;
+    sp = saved_sp;
+    rp = saved_rp;
+    pp = saved_pp;
+
+    if (l == 0) {
+        char *end;
+        long n = strtol(buf, &end, base);
+        if (*end == '\0') {
+            if (state) {
+                *here++ = (intptr_t)push;
+                *here++ = n;
+            } else {
+                *--sp = n;
+            }
+        } else {
+            puts("word not found");
+        }
+    } else {
+        if (state && !(l->attr & ATTR_IMMEDIATE)) {
+            if (!(l->attr & ATTR_NATIVE)) {
+                *here++ = (intptr_t)enter;
+                *here++ = (intptr_t)l->body;
+            } else {
+                *here++ = (intptr_t)l->body[0];
+            }
+        } else {
+            call(l->body);
+        }
+    }
+
+    saved_tmp = tmp;
+    saved_sp = sp;
+    saved_rp = rp;
+    saved_pp = pp;
+}
+
+void init(void)
+{
+    saved_tmp = 0;
+    saved_sp = END_OF(dstack);
+    saved_rp = END_OF(rstack);
+    saved_pp = 0;
+
+    latest = LATEST;
+}
+
+int depth(void)
+{
+    return END_OF(dstack) - saved_sp;
+}
+
+int compiling(void)
+{
+    return state;
+}
+
+void define(struct word_t *w)
+{
+    w->prev = latest;
+    latest = w;
+}
+