feat: add modular Forth interpreter implementation

Co-authored-by: aider (openrouter/tencent/hy3-preview:free) <aider@aider.chat>
2026-05-03 16:50:43 +03:00
parent c9584ccb26
commit 0d9b7e3424
5 changed files with 619 additions and 0 deletions
@@ -0,0 +1,19 @@
+CC = gcc
+CFLAGS = -Wall -Wextra -g
+LDFLAGS =
+SRCS = forth_core.c forth_dict.c forth_words.c forth_interp.c main.c
+OBJS = $(SRCS:.c=.o)
+TARGET = forth
+
+all: $(TARGET)
+
+$(TARGET): $(OBJS)
+	$(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS)
+
+%.o: %.c forth.h
+	$(CC) $(CFLAGS) -c $< -o $@
+
+clean:
+	rm -f $(OBJS) $(TARGET)
+
+.PHONY: all clean
@@ -0,0 +1,173 @@
+#ifndef FORTH_H
+#define FORTH_H
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+// Configuration
+#define DATA_STACK_SIZE 256
+#define RET_STACK_SIZE 256
+#define DICT_SIZE 256
+#define BODY_SIZE 1024
+#define COMPILE_BUF_SIZE 1024
+#define INPUT_BUF_SIZE 256
+#define MAX_NAME_LEN 31
+#define COMPILE_STACK_SIZE 256
+#define USER_MEMORY_SIZE 1024
+
+// Core types
+typedef struct Word Word;
+typedef union Cell {
+    Word* word;
+    int32_t num;
+    Cell* cell_ptr; // For storing ip (Cell*) in return stack
+} Cell;
+
+struct Word {
+    Word* prev;
+    uint8_t flags; // Bit7=immediate, Bit6=hidden, Bits0-5=name length
+    char name[MAX_NAME_LEN + 1];
+    void (*code)(Word*);
+    Cell* body;
+};
+
+// Globals
+extern int32_t data_stack[DATA_STACK_SIZE];
+extern int sp;
+extern Cell ret_stack[RET_STACK_SIZE];
+extern int rp;
+extern Cell* ip;
+
+extern Word dict[DICT_SIZE];
+extern int dict_idx;
+extern Word* dict_head;
+extern Cell dict_bodies[BODY_SIZE];
+extern int body_idx;
+
+extern int state; // 0=interpret, 1=compile
+extern Cell compile_buf[COMPILE_BUF_SIZE];
+extern int compile_idx;
+extern char compiling_name[MAX_NAME_LEN + 1];
+
+extern char input_buf[INPUT_BUF_SIZE];
+extern char* input_ptr;
+
+extern Cell* compile_stack[COMPILE_STACK_SIZE];
+extern int compile_sp;
+
+extern int32_t user_mem[USER_MEMORY_SIZE];
+extern int32_t* here;
+
+// Core function prototypes
+void data_push(int32_t val);
+int32_t data_pop(void);
+void ret_push_ip(Cell* val);
+Cell* ret_pop_ip(void);
+void ret_push_num(int32_t val);
+int32_t ret_pop_num(void);
+void compile_push(Cell* addr);
+Cell* compile_pop(void);
+
+Word* add_primitive(const char* name, void (*code)(Word*), uint8_t flags);
+Word* lookup_word(const char* name);
+
+char* next_token(void);
+
+void inner_interpreter(void);
+void process_token(const char* token);
+void outer_interpreter(void);
+
+// Primitive word prototypes
+// Stack ops
+void do_dup(Word* w);
+void do_drop(Word* w);
+void do_swap(Word* w);
+void do_over(Word* w);
+void do_rot(Word* w);
+void do_minus_rot(Word* w);
+void do_nip(Word* w);
+void do_tuck(Word* w);
+
+// Arithmetic
+void do_add(Word* w);
+void do_sub(Word* w);
+void do_mul(Word* w);
+void do_div(Word* w);
+void do_mod(Word* w);
+void do_slash_mod(Word* w);
+void do_one_plus(Word* w);
+void do_one_minus(Word* w);
+void do_two_plus(Word* w);
+void do_two_minus(Word* w);
+void do_negate(Word* w);
+void do_abs(Word* w);
+void do_min(Word* w);
+void do_max(Word* w);
+
+// Logic
+void do_and(Word* w);
+void do_or(Word* w);
+void do_xor(Word* w);
+void do_invert(Word* w);
+void do_lshift(Word* w);
+void do_rshift(Word* w);
+
+// Comparison
+void do_eq(Word* w);
+void do_neq(Word* w);
+void do_lt(Word* w);
+void do_gt(Word* w);
+void do_lte(Word* w);
+void do_gte(Word* w);
+void do_zero_eq(Word* w);
+void do_zero_lt(Word* w);
+void do_zero_gt(Word* w);
+
+// I/O
+void do_dot(Word* w);
+void do_cr(Word* w);
+void do_emit(Word* w);
+void do_key(Word* w);
+void do_dot_quote(Word* w);
+void do_dot_quote_inner(Word* w);
+void do_words(Word* w);
+
+// Memory
+void do_fetch(Word* w);
+void do_store(Word* w);
+void do_plus_store(Word* w);
+void do_cfetch(Word* w);
+void do_cstore(Word* w);
+void do_variable(Word* w);
+void do_constant(Word* w);
+void do_do_var(Word* w);
+void do_do_const(Word* w);
+void do_here(Word* w);
+void do_allot(Word* w);
+
+// Return stack
+void do_to_r(Word* w);
+void do_r_from(Word* w);
+void do_r_fetch(Word* w);
+
+// Control flow
+void do_exit(Word* w);
+void do_docolon(Word* w);
+void do_lit(Word* w);
+void do_colon(Word* w);
+void do_semicolon(Word* w);
+void do_branch(Word* w);
+void do_zero_branch(Word* w);
+void do_if(Word* w);
+void do_else(Word* w);
+void do_then(Word* w);
+void do_begin(Word* w);
+void do_until(Word* w);
+void do_while(Word* w);
+void do_repeat(Word* w);
+
+#endif // FORTH_H
@@ -0,0 +1,103 @@
+#include "forth.h"
+
+// Global variables
+int32_t data_stack[DATA_STACK_SIZE];
+int sp = -1;
+Cell ret_stack[RET_STACK_SIZE];
+int rp = -1;
+Cell* ip = NULL;
+
+Word dict[DICT_SIZE];
+int dict_idx = 0;
+Word* dict_head = NULL;
+Cell dict_bodies[BODY_SIZE];
+int body_idx = 0;
+
+int state = 0;
+Cell compile_buf[COMPILE_BUF_SIZE];
+int compile_idx = 0;
+char compiling_name[MAX_NAME_LEN + 1];
+
+char input_buf[INPUT_BUF_SIZE];
+char* input_ptr = NULL;
+
+Cell* compile_stack[COMPILE_STACK_SIZE];
+int compile_sp = -1;
+
+int32_t user_mem[USER_MEMORY_SIZE];
+int32_t* here = &user_mem[0];
+
+// Stack helpers
+void data_push(int32_t val) {
+    if (sp < DATA_STACK_SIZE - 1) {
+        data_stack[++sp] = val;
+    } else {
+        printf("Data stack overflow\n");
+    }
+}
+
+int32_t data_pop(void) {
+    if (sp >= 0) {
+        return data_stack[sp--];
+    } else {
+        printf("Data stack underflow\n");
+        return 0;
+    }
+}
+
+void ret_push_ip(Cell* val) {
+    if (rp < RET_STACK_SIZE - 1) {
+        rp++;
+        ret_stack[rp].cell_ptr = val;
+    } else {
+        printf("Return stack overflow\n");
+    }
+}
+
+Cell* ret_pop_ip(void) {
+    if (rp >= 0) {
+        Cell* res = ret_stack[rp].cell_ptr;
+        rp--;
+        return res;
+    } else {
+        printf("Return stack underflow\n");
+        return NULL;
+    }
+}
+
+void ret_push_num(int32_t val) {
+    if (rp < RET_STACK_SIZE - 1) {
+        rp++;
+        ret_stack[rp].num = val;
+    } else {
+        printf("Return stack overflow\n");
+    }
+}
+
+int32_t ret_pop_num(void) {
+    if (rp >= 0) {
+        int32_t res = ret_stack[rp].num;
+        rp--;
+        return res;
+    } else {
+        printf("Return stack underflow\n");
+        return 0;
+    }
+}
+
+void compile_push(Cell* addr) {
+    if (compile_sp < COMPILE_STACK_SIZE - 1) {
+        compile_stack[++compile_sp] = addr;
+    } else {
+        printf("Compile stack overflow\n");
+    }
+}
+
+Cell* compile_pop(void) {
+    if (compile_sp >= 0) {
+        return compile_stack[compile_sp--];
+    } else {
+        printf("Compile stack underflow\n");
+        return NULL;
+    }
+}
@@ -0,0 +1,28 @@
+#include "forth.h"
+
+Word* add_primitive(const char* name, void (*code)(Word*), uint8_t flags) {
+    if (dict_idx >= DICT_SIZE) {
+        printf("Dictionary full\n");
+        return NULL;
+    }
+    Word* w = &dict[dict_idx++];
+    w->prev = dict_head;
+    dict_head = w;
+
+    size_t len = strlen(name);
+    if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
+    w->flags = flags | (uint8_t)len;
+    strncpy(w->name, name, len);
+    w->name[len] = '\0';
+    w->code = code;
+    w->body = NULL;
+    return w;
+}
+
+Word* lookup_word(const char* name) {
+    for (Word* w = dict_head; w != NULL; w = w->prev) {
+        if (w->flags & (1 << 6)) continue; // Skip hidden words
+        if (strcmp(w->name, name) == 0) return w;
+    }
+    return NULL;
+}
@@ -0,0 +1,296 @@
+#include "forth.h"
+
+// Stack operations
+void do_dup(Word* w) {
+    if (sp < 0) return;
+    int32_t v = data_stack[sp];
+    data_push(v);
+}
+
+void do_drop(Word* w) {
+    data_pop();
+}
+
+void do_swap(Word* w) {
+    if (sp < 1) return;
+    int32_t a = data_stack[sp-1];
+    int32_t b = data_stack[sp];
+    data_stack[sp-1] = b;
+    data_stack[sp] = a;
+}
+
+void do_over(Word* w) {
+    if (sp < 1) return;
+    data_push(data_stack[sp-1]);
+}
+
+void do_rot(Word* w) {
+    if (sp < 2) return;
+    int32_t a = data_stack[sp-2];
+    int32_t b = data_stack[sp-1];
+    int32_t c = data_stack[sp];
+    data_stack[sp-2] = c;
+    data_stack[sp-1] = a;
+    data_stack[sp] = b;
+}
+
+void do_minus_rot(Word* w) {
+    if (sp < 2) return;
+    int32_t a = data_stack[sp-2];
+    int32_t b = data_stack[sp-1];
+    int32_t c = data_stack[sp];
+    data_stack[sp-2] = b;
+    data_stack[sp-1] = c;
+    data_stack[sp] = a;
+}
+
+void do_nip(Word* w) {
+    if (sp < 1) return;
+    data_stack[sp-1] = data_stack[sp];
+    sp--;
+}
+
+void do_tuck(Word* w) {
+    if (sp < 1) return;
+    int32_t a = data_stack[sp-1];
+    int32_t b = data_stack[sp];
+    data_push(a);
+    data_stack[sp-2] = b;
+}
+
+// Arithmetic operations
+void do_add(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a + b);
+}
+
+void do_sub(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a - b);
+}
+
+void do_mul(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a * b);
+}
+
+void do_div(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    if (b == 0) {
+        printf("Division by zero\n");
+        data_push(a);
+        data_push(b);
+        return;
+    }
+    data_push(a / b);
+}
+
+void do_mod(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    if (b == 0) {
+        printf("Modulo by zero\n");
+        data_push(a);
+        data_push(b);
+        return;
+    }
+    data_push(a % b);
+}
+
+void do_slash_mod(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    if (b == 0) {
+        printf("Modulo by zero\n");
+        data_push(a);
+        data_push(b);
+        return;
+    }
+    data_push(a / b);
+    data_push(a % b);
+}
+
+void do_one_plus(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp]++;
+}
+
+void do_one_minus(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp]--;
+}
+
+void do_two_plus(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp] += 2;
+}
+
+void do_two_minus(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp] -= 2;
+}
+
+void do_negate(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp] = -data_stack[sp];
+}
+
+void do_abs(Word* w) {
+    if (sp < 0) return;
+    int32_t v = data_pop();
+    data_push(v < 0 ? -v : v);
+}
+
+void do_min(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a < b ? a : b);
+}
+
+void do_max(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a > b ? a : b);
+}
+
+// Logic operations
+void do_and(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a & b);
+}
+
+void do_or(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a | b);
+}
+
+void do_xor(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a ^ b);
+}
+
+void do_invert(Word* w) {
+    if (sp < 0) return;
+    data_stack[sp] = ~data_stack[sp];
+}
+
+void do_lshift(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a << b);
+}
+
+void do_rshift(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push((int32_t)((uint32_t)a >> b));
+}
+
+// Comparison operations
+void do_eq(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a == b ? -1 : 0); // Forth uses -1 for true, 0 for false
+}
+
+void do_neq(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a != b ? -1 : 0);
+}
+
+void do_lt(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a < b ? -1 : 0);
+}
+
+void do_gt(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a > b ? -1 : 0);
+}
+
+void do_lte(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a <= b ? -1 : 0);
+}
+
+void do_gte(Word* w) {
+    if (sp < 1) return;
+    int32_t b = data_pop();
+    int32_t a = data_pop();
+    data_push(a >= b ? -1 : 0);
+}
+
+void do_zero_eq(Word* w) {
+    if (sp < 0) return;
+    int32_t a = data_pop();
+    data_push(a == 0 ? -1 : 0);
+}
+
+void do_zero_lt(Word* w) {
+    if (sp < 0) return;
+    int32_t a = data_pop();
+    data_push(a < 0 ? -1 : 0);
+}
+
+void do_zero_gt(Word* w) {
+    if (sp < 0) return;
+    int32_t a = data_pop();
+    data_push(a > 0 ? -1 : 0);
+}
+
+// I/O operations
+void do_dot(Word* w) {
+    if (sp < 0) return;
+    printf("%d ", data_pop());
+    fflush(stdout);
+}
+
+void do_cr(Word* w) {
+    printf("\n");
+    fflush(stdout);
+}
+
+void do_emit(Word* w) {
+    if (sp < 0) return;
+    putchar((char)data_pop());
+    fflush(stdout);
+}
+
+void do_key(Word* w) {
+    int c = getchar();
+    data_push(c == EOF ? -1 : c);
+}
+
+void do_dot_quote(Word* w) {
+    // Immediate word: parse string until " and print/compile
+    if (state == 0) { // Interpret mode: print immediately
+        //