Skip to content

Instantly share code, notes, and snippets.

@typeswitch-dev

typeswitch-dev/Makefile

Created December 28, 2021 22:08
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save typeswitch-dev/6bfc927707ea23da509e676d5a3a2f92 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save typeswitch-dev/6bfc927707ea23da509e676d5a3a2f92 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. typeswitch-dev created this gist Dec 28, 2021.
    8 changes: 8 additions & 0 deletions Makefile
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,8 @@
    CFLAGS=-std=c99 -pedantic -Wall -Werror
    .PHONY: run forth

    run: forth
    ./forth test.fs

    forth: forth.c
    $(CC) $(CFLAGS) -o forth forth.c
    367 changes: 367 additions & 0 deletions forth.c
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,367 @@
    #include <stdio.h>
    #include <stdlib.h>
    #include <string.h>
    #include <ctype.h>

    #define EXPECT(test,msg) \
    do { \
    if (!(test)) { \
    fprintf(stderr, "%s:%d: error: %s\n", \
    __FILE__, __LINE__, (msg)); \
    exit(EXIT_FAILURE); \
    } \
    } while(0)

    typedef union Cell {
    long ilong;
    unsigned long ulong;
    void* voidptr;
    struct Dict* dictptr;
    } Cell;

    typedef struct Stack {
    Cell *buf0; // bottom of buffer
    Cell *buf1; // top of buffer
    Cell *head; // last pushed item
    // the stack grows down, so:
    // head == buf1 when the stack is empty
    // head == buf0 when the stack is full
    // otherwise head is somewhere in between
    } Stack;

    static void stack_init (Stack *stack, size_t ncells) {
    EXPECT(stack, "stack is NULL");
    EXPECT(ncells > 0, "ncells is 0");
    stack->buf0 = calloc(ncells, sizeof(Cell));
    EXPECT(stack->buf0, "failed to allocate stack");
    stack->buf1 = stack->buf0 + ncells;
    stack->head = stack->buf1;
    }
    static int stack_is_empty (Stack *stack) {
    return (stack->head == stack->buf1);
    }
    static void stack_push (Stack *stack, Cell cell) {
    EXPECT(stack, "stack is NULL");
    EXPECT(stack->head > stack->buf0, "stack overflow");
    stack->head--;
    *stack->head = cell;
    }
    static void stack_push_long (Stack *stack, long n) {
    Cell c = { .ilong = n };
    stack_push(stack, c);
    }
    static void stack_push_ptr (Stack *stack, void* p) {
    Cell c = { .voidptr = p };
    stack_push(stack, c);
    }
    static Cell stack_pop (Stack *stack) {
    EXPECT(stack, "stack is NULL");
    EXPECT(stack->head < stack->buf1, "stack underflow");
    Cell result = *stack->head;
    stack->head++;
    return result;
    }
    static long stack_pop_long (Stack *stack) {
    return stack_pop(stack).ilong;
    }
    static void* stack_pop_ptr (Stack *stack) {
    return stack_pop(stack).voidptr;
    }

    typedef void (*Code)(void*);

    #define IMMEDIATE 0x01

    typedef struct Dict {
    struct Dict* next;
    const char* name;
    Code compile;
    Code execute;
    void *data;
    } Dict;

    static Dict* dict_new(Dict* next, const char* name,
    Code compile, Code execute, void* data)
    {
    Dict* dict = malloc(sizeof(Dict));
    EXPECT(dict, "failed to allocate dictionary");
    dict->next = next;
    dict->name = name;
    dict->compile = compile;
    dict->execute = execute;
    dict->data = data;
    return dict;
    }

    static Dict* dict_find(Dict* dict, const char* name) {
    while (dict) {
    if (strcmp(dict->name, name) == 0)
    return dict;
    dict = dict->next;
    }
    return NULL;
    }

    struct {
    FILE* FP;
    Stack DS;
    Stack RS;
    Cell* IP;
    Dict* DICT;
    Cell* MEM0;
    Cell* MEM1;
    Cell* HERE;
    long STATE; // (STATE > 0) means "compiler mode"
    } GLOBAL;

    void op_drop (void* data) {
    (void)(data);
    stack_pop(&GLOBAL.DS);
    }
    void op_dup (void* data) {
    (void)(data);
    Cell x = stack_pop(&GLOBAL.DS);
    stack_push(&GLOBAL.DS, x);
    stack_push(&GLOBAL.DS, x);
    }
    void op_swap (void* data) {
    (void)(data);
    Cell b = stack_pop(&GLOBAL.DS);
    Cell a = stack_pop(&GLOBAL.DS);
    stack_push(&GLOBAL.DS, b);
    stack_push(&GLOBAL.DS, a);
    }
    void op_tor (void* data) {
    (void)(data);
    Cell x = stack_pop(&GLOBAL.DS);
    stack_push(&GLOBAL.RS, x);
    }
    void op_rfrom (void* data) {
    (void)(data);
    Cell x = stack_pop(&GLOBAL.RS);
    stack_push(&GLOBAL.DS, x);
    }
    void op_add (void* data) {
    (void)(data);
    long b = stack_pop_long(&GLOBAL.DS);
    long a = stack_pop_long(&GLOBAL.DS);
    stack_push_long(&GLOBAL.DS, a+b);
    }
    void op_sub (void* data) {
    (void)(data);
    long b = stack_pop_long(&GLOBAL.DS);
    long a = stack_pop_long(&GLOBAL.DS);
    stack_push_long(&GLOBAL.DS, a-b);
    }
    void op_mul (void* data) {
    (void)(data);
    long b = stack_pop_long(&GLOBAL.DS);
    long a = stack_pop_long(&GLOBAL.DS);
    stack_push_long(&GLOBAL.DS, a*b);
    }
    void op_div (void* data) {
    (void)(data);
    long b = stack_pop_long(&GLOBAL.DS);
    long a = stack_pop_long(&GLOBAL.DS);
    EXPECT(b != 0, "division by zero");
    stack_push_long(&GLOBAL.DS, a/b);
    }
    void op_mod (void* data) {
    (void)(data);
    long b = stack_pop_long(&GLOBAL.DS);
    long a = stack_pop_long(&GLOBAL.DS);
    EXPECT(b != 0, "division by zero");
    stack_push_long(&GLOBAL.DS, a%b);
    }
    void op_lit (void* data) {
    (void)(data);
    stack_push(&GLOBAL.DS, *GLOBAL.IP++);
    }

    void op_const (void* data) {
    stack_push_ptr(&GLOBAL.DS, data);
    }
    void op_load (void* data) {
    (void)(data);
    Cell* addr = stack_pop_ptr(&GLOBAL.DS);
    EXPECT(addr, "dereferencing NULL pointer");
    stack_push(&GLOBAL.DS, *addr);
    }
    void op_store (void* data) {
    Cell* addr = stack_pop_ptr(&GLOBAL.DS);
    Cell value = stack_pop(&GLOBAL.DS);
    EXPECT(addr, "dereferencing NULL pointer");
    *addr = value;
    }

    void op_enter (void* data) {
    if (GLOBAL.IP)
    stack_push_ptr(&GLOBAL.RS, GLOBAL.IP);
    GLOBAL.IP = data;
    }
    void op_exit (void* data) {
    (void)(data);
    if (stack_is_empty(&GLOBAL.RS)) {
    GLOBAL.IP = NULL;
    } else {
    GLOBAL.IP = stack_pop_ptr(&GLOBAL.RS);
    }
    }

    void op_comma (void* data) {
    (void)(data);
    Cell value = stack_pop(&GLOBAL.DS);
    EXPECT(GLOBAL.HERE < GLOBAL.MEM1, "ran out of program memory");
    *GLOBAL.HERE++ = value;
    }
    void op_create (void* data) {
    (void)(data);
    char token[256];
    int scanf_result = fscanf(GLOBAL.FP, "%255s", token);
    EXPECT(scanf_result == 1, "failed to read token");
    char* name = strdup(token);
    EXPECT(name, "failed to allocate word name");
    GLOBAL.DICT = dict_new(GLOBAL.DICT, name, op_comma, op_enter, GLOBAL.HERE);
    }
    void op_quote (void* data) {
    (void)(data);
    char token[256];
    int scanf_result = fscanf(GLOBAL.FP, "%255s", token);
    EXPECT(scanf_result == 1, "failed to read token");
    Dict* val = dict_find(GLOBAL.DICT, token);
    if (!val) {
    fprintf(stderr, "unknown word: %s\n", token);
    exit(1);
    };
    stack_push_ptr(&GLOBAL.DS, val);
    }

    // invoke compiler mode semantics from word on top of stack
    void op_compile (void* data) {
    (void)(data);
    Dict* word = stack_pop_ptr(&GLOBAL.DS);
    EXPECT(word, "attempt to execute NULL word");
    stack_push_ptr(&GLOBAL.DS, word);
    word->compile(word->data);
    }

    // invoke execution semantics from word on top of stack
    void op_execute (void* data) {
    (void)(data);
    Dict* word = stack_pop_ptr(&GLOBAL.DS);
    EXPECT(word, "attempt to execute NULL word");
    word->execute(word->data);
    }

    // set the last word's compiler mode semantics to op_execute
    void op_immediate (void* data) {
    (void)(data);
    EXPECT(GLOBAL.DICT, "DICT is null");
    GLOBAL.DICT->compile = op_execute;
    }

    void op_increment_state (void* data) {
    (void)(data);
    GLOBAL.STATE += 5000;
    }
    void op_decrement_state (void* data) {
    (void)(data);
    GLOBAL.STATE -= 5000;
    }

    int main (int argc, char** argv)
    {
    EXPECT(argc == 2, "usage: ./forth FILENAME");
    GLOBAL.FP = fopen(argv[1], "rb");
    EXPECT(GLOBAL.FP, "failed to open file");

    // initialize stack
    stack_init(&GLOBAL.DS, 1024);
    stack_init(&GLOBAL.RS, 1024);
    GLOBAL.IP = NULL;

    // initialize memory
    size_t memn = 0x10000;
    GLOBAL.MEM0 = calloc(memn, sizeof(Cell));
    EXPECT(GLOBAL.MEM0, "failed to allocate MEM0");
    GLOBAL.MEM1 = GLOBAL.MEM0 + memn;
    GLOBAL.HERE = GLOBAL.MEM0;
    GLOBAL.STATE = 0;

    // initialize dictionary
    GLOBAL.DICT = NULL;
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "swap", op_comma, op_swap, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "drop", op_comma, op_drop, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "dup", op_comma, op_dup, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, ">r", op_comma, op_tor, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "r>", op_comma, op_rfrom, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "+", op_comma, op_add, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "-", op_comma, op_sub, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "*", op_comma, op_mul, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "/", op_comma, op_div, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "%", op_comma, op_mod, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "exit", op_comma, op_exit, NULL);

    GLOBAL.DICT = dict_new(GLOBAL.DICT, "DICT", op_comma, op_const, &GLOBAL.DICT);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "HERE", op_comma, op_const, &GLOBAL.HERE);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "@", op_comma, op_load, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "!", op_comma, op_store, NULL);

    GLOBAL.DICT = dict_new(GLOBAL.DICT, "IMMEDIATE", op_execute, op_immediate, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "CREATE:", op_comma, op_create, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "'", op_comma, op_quote, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, ",", op_comma, op_comma, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "lit", op_comma, op_lit, NULL);
    Dict* op_lit_dict = GLOBAL.DICT;

    GLOBAL.DICT = dict_new(GLOBAL.DICT, "compile", op_comma, op_compile, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "execute", op_comma, op_execute, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "]", op_execute, op_increment_state, NULL);
    GLOBAL.DICT = dict_new(GLOBAL.DICT, "[", op_execute, op_decrement_state, NULL);

    char token[256];
    while (fscanf(GLOBAL.FP, "%255s", token) == 1) {
    Dict* word = dict_find(GLOBAL.DICT, token);
    if (word) {
    if (GLOBAL.STATE > 0) {
    stack_push_ptr(&GLOBAL.DS, word);
    word->compile(word->data);
    } else {
    word->execute(word->data);
    }
    } else {
    char* p = token;
    if (*p == '-') p++;
    for (; *p; p++) {
    if (!isdigit(*p)) {
    fprintf(stderr, "unknown word: %s\n", token);
    exit(EXIT_FAILURE);
    }
    }
    if (GLOBAL.STATE > 0) {
    EXPECT(GLOBAL.HERE+1 < GLOBAL.MEM1,
    "ran out of program memory");
    *GLOBAL.HERE++ = (Cell) {.dictptr = op_lit_dict};
    *GLOBAL.HERE++ = (Cell) {.ilong = atol(token)};
    } else {
    stack_push_long(&GLOBAL.DS, atol(token));
    }
    }

    while (GLOBAL.IP) {
    Dict* word = (GLOBAL.IP++)->dictptr;
    EXPECT(word, "IP points to NULL");
    word->execute(word->data);
    }
    }

    if (GLOBAL.DS.head < GLOBAL.DS.buf1) {
    Cell* dsp = GLOBAL.DS.buf1;
    while (GLOBAL.DS.head < dsp) {
    printf("%ld ", (--dsp)->ilong);
    }
    printf("\n");
    }

    return EXIT_SUCCESS;
    }
    14 changes: 14 additions & 0 deletions test.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,14 @@
    CREATE: : IMMEDIATE
    ' CREATE: ,
    ' ] ,
    ' exit ,

    CREATE: ; IMMEDIATE
    ' [ ,
    ' lit , ' exit ,
    ' , ,
    ' exit ,

    : add10 10 + ;

    32 add10