#include #include #define NAKED __attribute__((naked)) #define END_OF(arr) ((arr) + (sizeof((arr)) / sizeof(*(arr)))) #define NEXT { goto *(*++pp); } #define LIT(x) push, (void *)(x) #define FTH(w) enter, (w##_body) #define EXIT doexit #define ATTR_NATIVE (1 << 7) #define ATTR_IMMEDIATE (1 << 6) #define ATTR_LEN (0x3F) #define WORD(name, tname, prev, attr) \ extern const void *name##_body[]; \ struct word_t w_##name = { \ name##_body, prev, attr + sizeof(tname) - 1, tname \ }; \ const void *name##_body[] = { #define END EXIT, }; #define W(name, tname, prev) WORD(name, tname, prev, 0) #define N(name, tname, prev) WORD(name, tname, prev, ATTR_NATIVE) #define I(name, tname, prev) WORD(name, tname, prev, ATTR_IMMEDIATE) struct word_t { const void **body; struct word_t *prev; unsigned char attr; char name[]; } __attribute__ ((packed)); intptr_t dstack[32]; intptr_t **rstack[32]; intptr_t dict[8192]; register intptr_t tmp asm("r12"); register intptr_t * sp asm("r13"); // pointer to stack cells register intptr_t *** rp asm("r14"); // stack of pp register intptr_t ** pp asm("r15"); // pointer to ip #define STASH asm("push %r12; push %r13; push %r14; push %r15") #define RESTORE asm("pop %r15; pop %r14; pop %r13; pop %r12") NAKED void push() { *--sp = (intptr_t)*++pp; NEXT; } NAKED void sp_at() { *sp = (intptr_t)sp; sp = sp - 1; NEXT; } NAKED void enter() { *--rp = ++pp; pp = (intptr_t **)*pp; goto *(*pp); } void doexit() { if (rp < END_OF(rstack)) { pp = *rp++; NEXT; } pp = 0; } intptr_t state = 0; intptr_t *here = dict; NAKED void drop() { ++sp; NEXT; } NAKED void swap() { tmp = sp[0]; sp[0] = sp[1]; sp[1] = tmp; NEXT; } NAKED void add() { sp[1] += sp[0]; ++sp; NEXT; } NAKED void sub() { sp[1] -= sp[0]; ++sp; NEXT; } NAKED void mul() { sp[1] *= sp[0]; ++sp; NEXT; } NAKED void div() { sp[1] /= sp[0]; ++sp; NEXT; } NAKED void mod() { sp[1] %= sp[0]; ++sp; NEXT; } NAKED void and() { sp[1] &= sp[0]; ++sp; NEXT; } NAKED void or() { sp[1] |= sp[0]; ++sp; NEXT; } NAKED void xor() { sp[1] ^= sp[0]; ++sp; NEXT; } NAKED void cell() { *--sp = sizeof(*sp); NEXT; } NAKED void peek() { *sp = *(intptr_t *)*sp; NEXT; } NAKED void poke() { *(intptr_t *)sp[0] = sp[1]; sp -= 2; NEXT; } NAKED void cpeek() { *sp = *(char *)*sp; NEXT; } NAKED void cpoke() { *(char *)sp[0] = sp[1]; sp -= 2; NEXT; } NAKED void comp() { state = -1; NEXT; } NAKED void intr() { state = 0; NEXT; } NAKED void dot() { printf("%ld ", *sp++); NEXT; } NAKED void comma() { *here++ = *sp++; NEXT; } NAKED void align() { here = (intptr_t *)(((intptr_t)here + sizeof(intptr_t) - 1) & ~(sizeof(intptr_t) - 1)); NEXT; } NAKED void colon() { extern struct word_t *latest; static int ch; tmp = (intptr_t)here++; // body *here++ = (intptr_t)latest; STASH; for (;;) { ch = getchar(); if (ch <= 0x20) break; *(unsigned char *)here += 1; ((char *)here)[*(unsigned char *)here] = ch; } RESTORE; here = (intptr_t *)(((intptr_t)here + sizeof(intptr_t) - 1) & ~(sizeof(intptr_t) - 1)); *(intptr_t *)tmp = (intptr_t)here; NEXT; } //W(two, "2", &w_dup) LIT(2), FTH(dup), END W(dup, "dup", 0) sp_at, peek, END W(drop, "drop", &w_dup) drop, END W(swap, "swap", &w_drop) swap, END W(peek, "@", &w_swap) peek, END W(poke, "!", &w_peek) poke, END W(cpeek, "c@", &w_poke) cpeek, END W(cpoke, "c!", &w_cpeek) cpoke, END W(add, "+", &w_cpoke) add, END W(sub, "-", &w_add) sub, END W(mul, "*", &w_sub) mul, END W(div, "/", &w_mul) div, END W(mod, "mod", &w_div) mod, END W(and, "and", &w_mod) and, END W(or, "or", &w_and) or, END W(xor, "xor", &w_or) xor, END W(cell, "cell", &w_xor) cell, END W(cellp, "cell+", &w_cell) cell, add, END W(cells, "cells", &w_cellp) cell, mul, END W(dict, "_d", &w_cells) LIT(dict), END W(here, "here", &w_dict) LIT(&here), peek, END I(intr, "[", &w_here) intr, END W(comp, "]", &w_intr) comp, END W(dot, ".", &w_comp) dot, END W(colon, ":", &w_dot) colon, END W(align, "align", &w_colon) align, END W(comma, ",", &w_align) comma, END struct word_t *latest = &w_comma; void init() { sp = END_OF(dstack); rp = END_OF(rstack); pp = 0; } void dump() { //printf("IP: %ld\n", (intptr_t)pp); printf("DS: "); intptr_t *it = END_OF(dstack) - 1; while (it >= sp) { printf("%ld ", *it); --it; } putchar('\n'); //printf("RS: "); //intptr_t ***rt = END_OF(rstack) - 1; //while (rt >= rp) { // printf("%ld ", (intptr_t)*rt); // --rt; //} //putchar('\n'); } void call(void *ptr) { pp = ptr; ((void (*)())*pp)(); } //struct word_t //{ // const void **body; // struct word_t *prev; // unsigned char attr; // char name[]; //} __attribute__ ((packed)); //NAKED void key() { *--sp = getchar(); NEXT; } #include #include extern long strtol(char *, char **, int); int base = 10; int main() { char buf[128]; init(); for (;;) { //dump(); printf("> "); char c; do c = getchar(); while (!isgraph(c)); char *s = buf; do { *s++ = c; c = getchar(); } while (isgraph(c)); *s = '\0'; if (strcmp(buf, "bye") == 0) break; struct word_t *l; for (l = latest; l; l = l->prev) { if (strncmp(buf, l->name, l->attr & ATTR_LEN) == 0) break; } 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)) { *here++ = (intptr_t)l->body; } else { call(l->body); } } puts(state ? "compiled" : "ok"); } return 0; }