Compare commits
4 Commits
a0b535f0a3
...
b115744991
| Author | SHA1 | Date | |
|---|---|---|---|
|
b115744991
|
|||
|
bf3c15ec27
|
|||
|
46e43961fd
|
|||
|
5916a92a4f
|
@@ -1,5 +1,5 @@
|
|||||||
CC = gcc
|
CC = gcc
|
||||||
CFLAGS = -Wall -Wextra -g
|
CFLAGS = -Wall -Wextra -g -std=c11 -D_POSIX_C_SOURCE=200809L
|
||||||
LDFLAGS =
|
LDFLAGS =
|
||||||
SRCS = forth_core.c forth_dict.c forth_words.c forth_interp.c main.c
|
SRCS = forth_core.c forth_dict.c forth_words.c forth_interp.c main.c
|
||||||
OBJS = $(SRCS:.c=.o)
|
OBJS = $(SRCS:.c=.o)
|
||||||
|
|||||||
@@ -10,7 +10,7 @@ This is a toy/subset Forth interpreter designed for educational purposes. It pro
|
|||||||
|
|
||||||
- **Threaded Code**: The interpreter uses an inner/outer interpreter model. Colon definitions are sequences of word addresses (threaded code) traversed by an instruction pointer.
|
- **Threaded Code**: The interpreter uses an inner/outer interpreter model. Colon definitions are sequences of word addresses (threaded code) traversed by an instruction pointer.
|
||||||
- **Architecture**:
|
- **Architecture**:
|
||||||
- 32-bit signed integer cells (`int32_t`)
|
- 64-bit signed integer cells (`int64_t`)
|
||||||
- Separate data and return stacks
|
- Separate data and return stacks
|
||||||
- Fixed-size dictionary, user memory, and compile buffer
|
- Fixed-size dictionary, user memory, and compile buffer
|
||||||
- Dictionary is a singly-linked list searched linearly
|
- Dictionary is a singly-linked list searched linearly
|
||||||
@@ -23,8 +23,8 @@ This is a toy/subset Forth interpreter designed for educational purposes. It pro
|
|||||||
- Memory access (`@`, `!`, `C@`, `C!`, `HERE`, `ALLOT`)
|
- Memory access (`@`, `!`, `C@`, `C!`, `HERE`, `ALLOT`)
|
||||||
- Simple string output (`."`)
|
- Simple string output (`."`)
|
||||||
- **Limitations**:
|
- **Limitations**:
|
||||||
- Fixed memory limits (dictionary, stacks, user memory)
|
- Fixed user memory limit (1M cells); dictionary and stacks grow dynamically
|
||||||
- 32-bit signed integers only; no floating-point support
|
- 64-bit signed integers only; no floating-point support
|
||||||
- No file I/O or operating system interface beyond stdin/stdout
|
- No file I/O or operating system interface beyond stdin/stdout
|
||||||
- No immediate user-defined words or advanced introspection
|
- No immediate user-defined words or advanced introspection
|
||||||
- Single-threaded execution
|
- Single-threaded execution
|
||||||
|
|||||||
@@ -1,384 +0,0 @@
|
|||||||
/*
|
|
||||||
* Small Forth Implementation in C
|
|
||||||
*/
|
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <string.h>
|
|
||||||
#include <ctype.h>
|
|
||||||
#include <stdint.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
|
|
||||||
|
|
||||||
// Core types
|
|
||||||
typedef struct Word Word;
|
|
||||||
typedef union Cell {
|
|
||||||
Word* word;
|
|
||||||
int32_t num;
|
|
||||||
} 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
|
|
||||||
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; // 0=interpret, 1=compile
|
|
||||||
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;
|
|
||||||
|
|
||||||
// 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(Cell* val) {
|
|
||||||
if (rp < RET_STACK_SIZE - 1) {
|
|
||||||
ret_stack[++rp] = val;
|
|
||||||
} else {
|
|
||||||
printf("Return stack overflow\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
Cell* ret_pop(void) {
|
|
||||||
if (rp >= 0) {
|
|
||||||
return ret_stack[rp--];
|
|
||||||
} else {
|
|
||||||
printf("Return stack underflow\n");
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
// Dictionary helpers
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
// Input tokenizer
|
|
||||||
char* next_token(void) {
|
|
||||||
if (input_ptr == NULL) return NULL;
|
|
||||||
while (*input_ptr != '\0' && isspace((unsigned char)*input_ptr)) {
|
|
||||||
input_ptr++;
|
|
||||||
}
|
|
||||||
if (*input_ptr == '\0') return NULL;
|
|
||||||
char* start = input_ptr;
|
|
||||||
while (*input_ptr != '\0' && !isspace((unsigned char)*input_ptr)) {
|
|
||||||
input_ptr++;
|
|
||||||
}
|
|
||||||
if (*input_ptr != '\0') {
|
|
||||||
*input_ptr = '\0';
|
|
||||||
input_ptr++;
|
|
||||||
}
|
|
||||||
return start;
|
|
||||||
}
|
|
||||||
|
|
||||||
// Primitive word implementations
|
|
||||||
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_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_dot(Word* w) {
|
|
||||||
if (sp < 0) return;
|
|
||||||
printf("%d ", data_pop());
|
|
||||||
fflush(stdout);
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_cr(Word* w) {
|
|
||||||
printf("\n");
|
|
||||||
fflush(stdout);
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_exit(Word* w) {
|
|
||||||
Cell* ret_addr = ret_pop();
|
|
||||||
ip = ret_addr;
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_docolon(Word* w) {
|
|
||||||
// Push current ip (return address) onto return stack
|
|
||||||
ret_push(ip);
|
|
||||||
// Set ip to this word's body
|
|
||||||
ip = w->body;
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_lit(Word* w) {
|
|
||||||
// ip points to the number cell (inner interpreter already incremented past lit word)
|
|
||||||
data_push(ip->num);
|
|
||||||
ip++; // Move past number cell
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_colon(Word* w) {
|
|
||||||
char* name = next_token();
|
|
||||||
if (name == NULL) {
|
|
||||||
printf("':' expects a name\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
strncpy(compiling_name, name, MAX_NAME_LEN);
|
|
||||||
compiling_name[MAX_NAME_LEN] = '\0';
|
|
||||||
state = 1; // Enter compile mode
|
|
||||||
compile_idx = 0; // Reset compile buffer
|
|
||||||
}
|
|
||||||
|
|
||||||
void do_semicolon(Word* w) {
|
|
||||||
if (state != 1) {
|
|
||||||
printf("';' is only valid in compile mode\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
Word* exit_w = lookup_word("exit");
|
|
||||||
if (exit_w == NULL) {
|
|
||||||
printf("Fatal: exit word not found\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
if (compile_idx >= COMPILE_BUF_SIZE) {
|
|
||||||
printf("Compile buffer overflow\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
compile_buf[compile_idx++] = (Cell){.word = exit_w};
|
|
||||||
|
|
||||||
// Copy compiled body to dictionary body storage
|
|
||||||
if (body_idx + compile_idx > BODY_SIZE) {
|
|
||||||
printf("Dictionary body storage full\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
memcpy(&dict_bodies[body_idx], compile_buf, compile_idx * sizeof(Cell));
|
|
||||||
|
|
||||||
// Create new word entry
|
|
||||||
if (dict_idx >= DICT_SIZE) {
|
|
||||||
printf("Dictionary full\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
Word* new_w = &dict[dict_idx++];
|
|
||||||
new_w->prev = dict_head;
|
|
||||||
dict_head = new_w;
|
|
||||||
|
|
||||||
size_t len = strlen(compiling_name);
|
|
||||||
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
|
||||||
new_w->flags = (uint8_t)len; // No hidden, no immediate
|
|
||||||
strncpy(new_w->name, compiling_name, len);
|
|
||||||
new_w->name[len] = '\0';
|
|
||||||
new_w->code = do_docolon;
|
|
||||||
new_w->body = &dict_bodies[body_idx];
|
|
||||||
|
|
||||||
body_idx += compile_idx;
|
|
||||||
state = 0; // Back to interpret mode
|
|
||||||
}
|
|
||||||
|
|
||||||
// Interpreter functions
|
|
||||||
void inner_interpreter(void) {
|
|
||||||
while (ip != NULL) {
|
|
||||||
Cell current = *ip;
|
|
||||||
ip++; // Move to next cell
|
|
||||||
current.word->code(current.word);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
void process_token(const char* token) {
|
|
||||||
Word* w = lookup_word(token);
|
|
||||||
if (w != NULL) {
|
|
||||||
if (state == 0) { // Interpret mode
|
|
||||||
if (w->code == do_docolon) { // Colon definition
|
|
||||||
ret_push(NULL); // Return address to stop interpreter
|
|
||||||
ip = w->body;
|
|
||||||
inner_interpreter();
|
|
||||||
} else { // Primitive word
|
|
||||||
w->code(w);
|
|
||||||
}
|
|
||||||
} else { // Compile mode
|
|
||||||
if (w->flags & (1 << 7)) { // Immediate word: execute now
|
|
||||||
if (w->code == do_docolon) {
|
|
||||||
ret_push(NULL);
|
|
||||||
ip = w->body;
|
|
||||||
inner_interpreter();
|
|
||||||
} else {
|
|
||||||
w->code(w);
|
|
||||||
}
|
|
||||||
} else { // Normal word: compile into current definition
|
|
||||||
if (compile_idx >= COMPILE_BUF_SIZE) {
|
|
||||||
printf("Compile buffer full\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
compile_buf[compile_idx++] = (Cell){.word = w};
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else { // Not a known word: try to parse as number
|
|
||||||
char* end;
|
|
||||||
long v = strtol(token, &end, 10);
|
|
||||||
if (end != token && *end == '\0') { // Valid integer
|
|
||||||
if (state == 0) { // Interpret mode: push number
|
|
||||||
data_push((int32_t)v);
|
|
||||||
} else { // Compile mode: compile lit + number
|
|
||||||
Word* lit_w = lookup_word("lit");
|
|
||||||
if (lit_w == NULL) {
|
|
||||||
printf("Fatal: lit word not found\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
if (compile_idx + 2 > COMPILE_BUF_SIZE) {
|
|
||||||
printf("Compile buffer full\n");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
compile_buf[compile_idx++] = (Cell){.word = lit_w};
|
|
||||||
compile_buf[compile_idx++] = (Cell){.num = (int32_t)v};
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
printf("Unknown word: '%s'\n", token);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
void outer_interpreter(void) {
|
|
||||||
while (1) {
|
|
||||||
printf("ok ");
|
|
||||||
fflush(stdout);
|
|
||||||
if (fgets(input_buf, INPUT_BUF_SIZE, stdin) == NULL) {
|
|
||||||
break; // EOF
|
|
||||||
}
|
|
||||||
input_ptr = input_buf;
|
|
||||||
char* tok;
|
|
||||||
while ((tok = next_token()) != NULL) {
|
|
||||||
process_token(tok);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
printf("\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(void) {
|
|
||||||
// Register primitive words
|
|
||||||
// Hidden words first
|
|
||||||
add_primitive("exit", do_exit, 0);
|
|
||||||
add_primitive("docolon", do_docolon, 1 << 6); // Hidden
|
|
||||||
add_primitive("lit", do_lit, 1 << 6); // Hidden
|
|
||||||
|
|
||||||
// Public primitives
|
|
||||||
add_primitive("dup", do_dup, 0);
|
|
||||||
add_primitive("drop", do_drop, 0);
|
|
||||||
add_primitive("swap", do_swap, 0);
|
|
||||||
add_primitive("over", do_over, 0);
|
|
||||||
add_primitive("+", do_add, 0);
|
|
||||||
add_primitive("-", do_sub, 0);
|
|
||||||
add_primitive("*", do_mul, 0);
|
|
||||||
add_primitive("/", do_div, 0);
|
|
||||||
add_primitive(".", do_dot, 0);
|
|
||||||
add_primitive("cr", do_cr, 0);
|
|
||||||
|
|
||||||
// Compilation words
|
|
||||||
add_primitive(":", do_colon, 0);
|
|
||||||
add_primitive(";", do_semicolon, 1 << 7); // Immediate word
|
|
||||||
|
|
||||||
// Start outer interpreter
|
|
||||||
outer_interpreter();
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
@@ -7,10 +7,14 @@
|
|||||||
#include <ctype.h>
|
#include <ctype.h>
|
||||||
#include <stdint.h>
|
#include <stdint.h>
|
||||||
#include <inttypes.h>
|
#include <inttypes.h>
|
||||||
|
#include <sys/types.h>
|
||||||
|
|
||||||
// Configuration (all hard limits removed)
|
// Configuration (all hard limits removed)
|
||||||
#define MAX_NAME_LEN 31
|
#define MAX_NAME_LEN 31
|
||||||
|
|
||||||
|
#define F_IMMEDIATE (1 << 7)
|
||||||
|
#define F_HIDDEN (1 << 6)
|
||||||
|
|
||||||
// Core types
|
// Core types
|
||||||
typedef struct Word Word;
|
typedef struct Word Word;
|
||||||
typedef union Cell {
|
typedef union Cell {
|
||||||
@@ -45,7 +49,8 @@ extern int32_t compile_idx;
|
|||||||
extern int32_t compile_cap;
|
extern int32_t compile_cap;
|
||||||
extern char compiling_name[MAX_NAME_LEN + 1];
|
extern char compiling_name[MAX_NAME_LEN + 1];
|
||||||
|
|
||||||
extern char input_buf[1024]; // fixed for line input
|
extern char* input_buf; // line buffer (dynamic, managed by getline)
|
||||||
|
extern size_t input_buf_cap;
|
||||||
extern char* input_ptr;
|
extern char* input_ptr;
|
||||||
|
|
||||||
extern int64_t *compile_stack; // holds indices into compile_buf
|
extern int64_t *compile_stack; // holds indices into compile_buf
|
||||||
@@ -56,6 +61,14 @@ extern Cell *user_mem;
|
|||||||
extern int64_t user_mem_size; // in cells
|
extern int64_t user_mem_size; // in cells
|
||||||
extern Cell* here;
|
extern Cell* here;
|
||||||
|
|
||||||
|
// Pointers to critical hidden/primitive words (set during init)
|
||||||
|
extern Word* w_exit;
|
||||||
|
extern Word* w_docolon;
|
||||||
|
extern Word* w_lit;
|
||||||
|
extern Word* w_branch;
|
||||||
|
extern Word* w_zbranch;
|
||||||
|
extern Word* w_dot_quote_inner;
|
||||||
|
|
||||||
// Core function prototypes
|
// Core function prototypes
|
||||||
void data_push(int64_t val);
|
void data_push(int64_t val);
|
||||||
int64_t data_pop(void);
|
int64_t data_pop(void);
|
||||||
@@ -166,4 +179,13 @@ void do_until(Word* w);
|
|||||||
void do_while(Word* w);
|
void do_while(Word* w);
|
||||||
void do_repeat(Word* w);
|
void do_repeat(Word* w);
|
||||||
|
|
||||||
|
/* Additional stack words */
|
||||||
|
void do_depth(Word* w);
|
||||||
|
void do_pick(Word* w);
|
||||||
|
void do_roll(Word* w);
|
||||||
|
void do_qdup(Word* w);
|
||||||
|
void do_2dup(Word* w);
|
||||||
|
void do_2drop(Word* w);
|
||||||
|
void do_2swap(Word* w);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
+9
-1
@@ -18,7 +18,8 @@ int32_t compile_idx = 0;
|
|||||||
int32_t compile_cap = 0;
|
int32_t compile_cap = 0;
|
||||||
char compiling_name[MAX_NAME_LEN + 1] = {0};
|
char compiling_name[MAX_NAME_LEN + 1] = {0};
|
||||||
|
|
||||||
char input_buf[1024] = {0};
|
char* input_buf = NULL;
|
||||||
|
size_t input_buf_cap = 0;
|
||||||
char* input_ptr = NULL;
|
char* input_ptr = NULL;
|
||||||
|
|
||||||
int64_t *compile_stack = NULL;
|
int64_t *compile_stack = NULL;
|
||||||
@@ -29,6 +30,13 @@ Cell *user_mem = NULL;
|
|||||||
int64_t user_mem_size = 0;
|
int64_t user_mem_size = 0;
|
||||||
Cell* here = NULL;
|
Cell* here = NULL;
|
||||||
|
|
||||||
|
Word* w_exit = NULL;
|
||||||
|
Word* w_docolon = NULL;
|
||||||
|
Word* w_lit = NULL;
|
||||||
|
Word* w_branch = NULL;
|
||||||
|
Word* w_zbranch = NULL;
|
||||||
|
Word* w_dot_quote_inner = NULL;
|
||||||
|
|
||||||
// ---------- Data stack ----------
|
// ---------- Data stack ----------
|
||||||
void data_push(int64_t val) {
|
void data_push(int64_t val) {
|
||||||
if (data_sp + 1 >= data_cap) {
|
if (data_sp + 1 >= data_cap) {
|
||||||
|
|||||||
+7
-4
@@ -73,13 +73,12 @@ void process_token(const char* token) {
|
|||||||
if (state == 0) {
|
if (state == 0) {
|
||||||
data_push((int64_t)v);
|
data_push((int64_t)v);
|
||||||
} else { // Compile lit + number
|
} else { // Compile lit + number
|
||||||
Word* lit_w = lookup_word_internal("lit");
|
if (!w_lit) {
|
||||||
if (!lit_w) {
|
|
||||||
fprintf(stderr, "Fatal: lit word not found\n");
|
fprintf(stderr, "Fatal: lit word not found\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = lit_w};
|
compile_buf[compile_idx++] = (Cell){.word = w_lit};
|
||||||
compile_buf[compile_idx++] = (Cell){.num = (int64_t)v};
|
compile_buf[compile_idx++] = (Cell){.num = (int64_t)v};
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
@@ -92,9 +91,13 @@ void outer_interpreter(void) {
|
|||||||
while (1) {
|
while (1) {
|
||||||
printf("ok ");
|
printf("ok ");
|
||||||
fflush(stdout);
|
fflush(stdout);
|
||||||
if (fgets(input_buf, sizeof(input_buf), stdin) == NULL) {
|
ssize_t n = getline(&input_buf, &input_buf_cap, stdin);
|
||||||
|
if (n < 0) {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
if (n > 0 && input_buf[n - 1] == '\n') {
|
||||||
|
input_buf[n - 1] = '\0';
|
||||||
|
}
|
||||||
input_ptr = input_buf;
|
input_ptr = input_buf;
|
||||||
char* tok;
|
char* tok;
|
||||||
while ((tok = next_token()) != NULL) {
|
while ((tok = next_token()) != NULL) {
|
||||||
|
|||||||
+114
-54
@@ -60,10 +60,11 @@ void do_nip(Word* w) {
|
|||||||
void do_tuck(Word* w) {
|
void do_tuck(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (data_sp < 1) return;
|
if (data_sp < 1) return;
|
||||||
int64_t a = data_stack[data_sp-1];
|
int64_t x1 = data_stack[data_sp-1];
|
||||||
int64_t b = data_stack[data_sp];
|
int64_t x2 = data_stack[data_sp];
|
||||||
data_push(a);
|
data_stack[data_sp-1] = x2;
|
||||||
data_stack[data_sp-2] = b;
|
data_stack[data_sp] = x1;
|
||||||
|
data_push(x2);
|
||||||
}
|
}
|
||||||
|
|
||||||
// Arithmetic
|
// Arithmetic
|
||||||
@@ -97,7 +98,7 @@ void do_div(Word* w) {
|
|||||||
int64_t b = data_pop();
|
int64_t b = data_pop();
|
||||||
int64_t a = data_pop();
|
int64_t a = data_pop();
|
||||||
if (b == 0) {
|
if (b == 0) {
|
||||||
printf("Division by zero\n");
|
fprintf(stderr, "Division by zero\n");
|
||||||
data_push(a);
|
data_push(a);
|
||||||
data_push(b);
|
data_push(b);
|
||||||
return;
|
return;
|
||||||
@@ -111,7 +112,7 @@ void do_mod(Word* w) {
|
|||||||
int64_t b = data_pop();
|
int64_t b = data_pop();
|
||||||
int64_t a = data_pop();
|
int64_t a = data_pop();
|
||||||
if (b == 0) {
|
if (b == 0) {
|
||||||
printf("Modulo by zero\n");
|
fprintf(stderr, "Modulo by zero\n");
|
||||||
data_push(a);
|
data_push(a);
|
||||||
data_push(b);
|
data_push(b);
|
||||||
return;
|
return;
|
||||||
@@ -125,7 +126,7 @@ void do_slash_mod(Word* w) {
|
|||||||
int64_t b = data_pop();
|
int64_t b = data_pop();
|
||||||
int64_t a = data_pop();
|
int64_t a = data_pop();
|
||||||
if (b == 0) {
|
if (b == 0) {
|
||||||
printf("Modulo by zero\n");
|
fprintf(stderr, "Modulo by zero\n");
|
||||||
data_push(a);
|
data_push(a);
|
||||||
data_push(b);
|
data_push(b);
|
||||||
return;
|
return;
|
||||||
@@ -335,30 +336,29 @@ void do_dot_quote(Word* w) {
|
|||||||
(void)w;
|
(void)w;
|
||||||
if (state == 0) {
|
if (state == 0) {
|
||||||
// Interpret mode: print immediately
|
// Interpret mode: print immediately
|
||||||
if (input_ptr == NULL) { printf("Missing string\n"); return; }
|
if (input_ptr == NULL) { fprintf(stderr, "Missing string\n"); return; }
|
||||||
while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++;
|
while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++;
|
||||||
if (*input_ptr != '"') { printf("Expected \" to start string\n"); return; }
|
if (*input_ptr != '"') { fprintf(stderr, "Expected \" to start string\n"); return; }
|
||||||
input_ptr++;
|
input_ptr++;
|
||||||
char* start = input_ptr;
|
char* start = input_ptr;
|
||||||
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
||||||
if (*input_ptr != '"') { printf("Unterminated string\n"); return; }
|
if (*input_ptr != '"') { fprintf(stderr, "Unterminated string\n"); return; }
|
||||||
while (start < input_ptr) putchar(*start++);
|
while (start < input_ptr) putchar(*start++);
|
||||||
input_ptr++;
|
input_ptr++;
|
||||||
fflush(stdout);
|
fflush(stdout);
|
||||||
} else {
|
} else {
|
||||||
// Compile mode: compile string for runtime
|
// Compile mode: compile string for runtime
|
||||||
if (input_ptr == NULL) { printf("Missing string\n"); return; }
|
if (input_ptr == NULL) { fprintf(stderr, "Missing string\n"); return; }
|
||||||
while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++;
|
while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++;
|
||||||
if (*input_ptr != '"') { printf("Expected \" to start string\n"); return; }
|
if (*input_ptr != '"') { fprintf(stderr, "Expected \" to start string\n"); return; }
|
||||||
input_ptr++;
|
input_ptr++;
|
||||||
char* start = input_ptr;
|
char* start = input_ptr;
|
||||||
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
||||||
if (*input_ptr != '"') { printf("Unterminated string\n"); return; }
|
if (*input_ptr != '"') { fprintf(stderr, "Unterminated string\n"); return; }
|
||||||
size_t len = input_ptr - start;
|
size_t len = input_ptr - start;
|
||||||
Word* inner_w = lookup_word_internal("do_dot_quote_inner");
|
if (!w_dot_quote_inner) { fprintf(stderr, "Fatal: do_dot_quote_inner not found\n"); return; }
|
||||||
if (!inner_w) { printf("Fatal: do_dot_quote_inner not found\n"); return; }
|
|
||||||
ensure_compile_cap(2 + (int32_t)len);
|
ensure_compile_cap(2 + (int32_t)len);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = inner_w};
|
compile_buf[compile_idx++] = (Cell){.word = w_dot_quote_inner};
|
||||||
compile_buf[compile_idx++] = (Cell){.num = (int64_t)len};
|
compile_buf[compile_idx++] = (Cell){.num = (int64_t)len};
|
||||||
for (size_t i = 0; i < len; i++) {
|
for (size_t i = 0; i < len; i++) {
|
||||||
compile_buf[compile_idx++] = (Cell){.num = (int64_t)start[i]};
|
compile_buf[compile_idx++] = (Cell){.num = (int64_t)start[i]};
|
||||||
@@ -394,7 +394,7 @@ void do_fetch(Word* w) {
|
|||||||
(void)w;
|
(void)w;
|
||||||
int64_t addr = data_pop();
|
int64_t addr = data_pop();
|
||||||
if (addr < 0 || addr >= user_mem_size) {
|
if (addr < 0 || addr >= user_mem_size) {
|
||||||
printf("Address out of bounds\n");
|
fprintf(stderr, "Address out of bounds\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
data_push(user_mem[addr].num);
|
data_push(user_mem[addr].num);
|
||||||
@@ -405,7 +405,7 @@ void do_store(Word* w) {
|
|||||||
int64_t addr = data_pop();
|
int64_t addr = data_pop();
|
||||||
int64_t val = data_pop();
|
int64_t val = data_pop();
|
||||||
if (addr < 0 || addr >= user_mem_size) {
|
if (addr < 0 || addr >= user_mem_size) {
|
||||||
printf("Address out of bounds\n");
|
fprintf(stderr, "Address out of bounds\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
user_mem[addr].num = val;
|
user_mem[addr].num = val;
|
||||||
@@ -416,7 +416,7 @@ void do_plus_store(Word* w) {
|
|||||||
int64_t addr = data_pop();
|
int64_t addr = data_pop();
|
||||||
int64_t val = data_pop();
|
int64_t val = data_pop();
|
||||||
if (addr < 0 || addr >= user_mem_size) {
|
if (addr < 0 || addr >= user_mem_size) {
|
||||||
printf("Address out of bounds\n");
|
fprintf(stderr, "Address out of bounds\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
user_mem[addr].num += val;
|
user_mem[addr].num += val;
|
||||||
@@ -427,7 +427,7 @@ void do_cfetch(Word* w) {
|
|||||||
int64_t addr = data_pop(); // byte offset
|
int64_t addr = data_pop(); // byte offset
|
||||||
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
||||||
if (addr < 0 || addr >= max_byte) {
|
if (addr < 0 || addr >= max_byte) {
|
||||||
printf("Address out of bounds\n");
|
fprintf(stderr, "Address out of bounds\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
uint8_t* base = (uint8_t*)user_mem;
|
uint8_t* base = (uint8_t*)user_mem;
|
||||||
@@ -440,7 +440,7 @@ void do_cstore(Word* w) {
|
|||||||
int64_t val = data_pop();
|
int64_t val = data_pop();
|
||||||
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
||||||
if (addr < 0 || addr >= max_byte) {
|
if (addr < 0 || addr >= max_byte) {
|
||||||
printf("Address out of bounds\n");
|
fprintf(stderr, "Address out of bounds\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
uint8_t* base = (uint8_t*)user_mem;
|
uint8_t* base = (uint8_t*)user_mem;
|
||||||
@@ -457,7 +457,7 @@ void do_allot(Word* w) {
|
|||||||
(void)w;
|
(void)w;
|
||||||
int64_t n = data_pop();
|
int64_t n = data_pop();
|
||||||
if (here + n > user_mem + user_mem_size) {
|
if (here + n > user_mem + user_mem_size) {
|
||||||
printf("User memory overflow\n");
|
fprintf(stderr, "User memory overflow\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
here += n;
|
here += n;
|
||||||
@@ -467,11 +467,11 @@ void do_allot(Word* w) {
|
|||||||
void do_variable(Word* w) {
|
void do_variable(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
char* name = next_token();
|
char* name = next_token();
|
||||||
if (!name) { printf("VARIABLE expects a name\n"); return; }
|
if (!name) { fprintf(stderr, "VARIABLE expects a name\n"); return; }
|
||||||
|
|
||||||
// allocate one cell in user memory for the variable's data
|
// allocate one cell in user memory for the variable's data
|
||||||
if (here + 1 > user_mem + user_mem_size) {
|
if (here + 1 > user_mem + user_mem_size) {
|
||||||
printf("User memory overflow\n");
|
fprintf(stderr, "User memory overflow\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
Cell* var_cell = here; // address of the data cell
|
Cell* var_cell = here; // address of the data cell
|
||||||
@@ -497,11 +497,11 @@ void do_constant(Word* w) {
|
|||||||
(void)w;
|
(void)w;
|
||||||
int64_t val = data_pop();
|
int64_t val = data_pop();
|
||||||
char* name = next_token();
|
char* name = next_token();
|
||||||
if (!name) { printf("CONSTANT expects a name\n"); data_push(val); return; }
|
if (!name) { fprintf(stderr, "CONSTANT expects a name\n"); data_push(val); return; }
|
||||||
|
|
||||||
// allocate a cell in user memory to hold the constant value
|
// allocate a cell in user memory to hold the constant value
|
||||||
if (here + 1 > user_mem + user_mem_size) {
|
if (here + 1 > user_mem + user_mem_size) {
|
||||||
printf("User memory overflow\n");
|
fprintf(stderr, "User memory overflow\n");
|
||||||
data_push(val); // restore the value (optional)
|
data_push(val); // restore the value (optional)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@@ -547,7 +547,7 @@ void do_r_from(Word* w) {
|
|||||||
|
|
||||||
void do_r_fetch(Word* w) {
|
void do_r_fetch(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (rp < 0) { printf("Return stack underflow\n"); return; }
|
if (rp < 0) { fprintf(stderr, "Return stack underflow\n"); return; }
|
||||||
data_push(ret_stack[rp].num);
|
data_push(ret_stack[rp].num);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -572,7 +572,7 @@ void do_lit(Word* w) {
|
|||||||
void do_colon(Word* w) {
|
void do_colon(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
char* name = next_token();
|
char* name = next_token();
|
||||||
if (!name) { printf("':' expects a name\n"); return; }
|
if (!name) { fprintf(stderr, "':' expects a name\n"); return; }
|
||||||
size_t len = strlen(name);
|
size_t len = strlen(name);
|
||||||
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
||||||
memcpy(compiling_name, name, len);
|
memcpy(compiling_name, name, len);
|
||||||
@@ -584,12 +584,11 @@ void do_colon(Word* w) {
|
|||||||
|
|
||||||
void do_semicolon(Word* w) {
|
void do_semicolon(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("';' only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "';' only valid in compile mode\n"); return; }
|
||||||
Word* exit_w = lookup_word("exit");
|
if (!w_exit) { fprintf(stderr, "Fatal: exit word not found\n"); return; }
|
||||||
if (!exit_w) { printf("Fatal: exit word not found\n"); return; }
|
|
||||||
|
|
||||||
ensure_compile_cap(1);
|
ensure_compile_cap(1);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = exit_w};
|
compile_buf[compile_idx++] = (Cell){.word = w_exit};
|
||||||
|
|
||||||
// Create body copy of compiled cells
|
// Create body copy of compiled cells
|
||||||
Cell* body_copy = malloc(compile_idx * sizeof(Cell));
|
Cell* body_copy = malloc(compile_idx * sizeof(Cell));
|
||||||
@@ -633,11 +632,10 @@ void do_zero_branch(Word* w) {
|
|||||||
// Control flow using compile stack (indices)
|
// Control flow using compile stack (indices)
|
||||||
void do_if(Word* w) {
|
void do_if(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("IF only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "IF only valid in compile mode\n"); return; }
|
||||||
Word* zbranch = lookup_word_internal("0branch");
|
if (!w_zbranch) { fprintf(stderr, "Fatal: 0branch not found\n"); return; }
|
||||||
if (!zbranch) { printf("Fatal: 0branch not found\n"); return; }
|
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = zbranch};
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
||||||
// compile_push current index (where the offset will be placed)
|
// compile_push current index (where the offset will be placed)
|
||||||
compile_push(compile_idx);
|
compile_push(compile_idx);
|
||||||
compile_idx++; // reserve offset cell
|
compile_idx++; // reserve offset cell
|
||||||
@@ -645,7 +643,7 @@ void do_if(Word* w) {
|
|||||||
|
|
||||||
void do_then(Word* w) {
|
void do_then(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("THEN only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "THEN only valid in compile mode\n"); return; }
|
||||||
int64_t offset_idx = compile_pop();
|
int64_t offset_idx = compile_pop();
|
||||||
if (offset_idx < 0) return;
|
if (offset_idx < 0) return;
|
||||||
compile_buf[offset_idx].num = compile_idx - offset_idx;
|
compile_buf[offset_idx].num = compile_idx - offset_idx;
|
||||||
@@ -653,52 +651,49 @@ void do_then(Word* w) {
|
|||||||
|
|
||||||
void do_else(Word* w) {
|
void do_else(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("ELSE only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "ELSE only valid in compile mode\n"); return; }
|
||||||
int64_t if_offset_idx = compile_pop();
|
int64_t if_offset_idx = compile_pop();
|
||||||
if (if_offset_idx < 0) return;
|
if (if_offset_idx < 0) return;
|
||||||
|
|
||||||
Word* branch_w = lookup_word_internal("branch");
|
if (!w_branch) { fprintf(stderr, "Fatal: branch not found\n"); return; }
|
||||||
if (!branch_w) { printf("Fatal: branch not found\n"); return; }
|
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
|
|
||||||
// resolve IF offset to skip the ELSE branch
|
// resolve IF offset to skip the ELSE branch
|
||||||
compile_buf[if_offset_idx].num = (compile_idx + 2) - if_offset_idx;
|
compile_buf[if_offset_idx].num = (compile_idx + 2) - if_offset_idx;
|
||||||
|
|
||||||
// compile unconditional branch for ELSE part
|
// compile unconditional branch for ELSE part
|
||||||
compile_buf[compile_idx++] = (Cell){.word = branch_w};
|
compile_buf[compile_idx++] = (Cell){.word = w_branch};
|
||||||
compile_push(compile_idx);
|
compile_push(compile_idx);
|
||||||
compile_idx++; // reserve offset cell
|
compile_idx++; // reserve offset cell
|
||||||
}
|
}
|
||||||
|
|
||||||
void do_begin(Word* w) {
|
void do_begin(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("BEGIN only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "BEGIN only valid in compile mode\n"); return; }
|
||||||
compile_push(compile_idx);
|
compile_push(compile_idx);
|
||||||
}
|
}
|
||||||
|
|
||||||
void do_until(Word* w) {
|
void do_until(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("UNTIL only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "UNTIL only valid in compile mode\n"); return; }
|
||||||
int64_t begin_idx = compile_pop();
|
int64_t begin_idx = compile_pop();
|
||||||
if (begin_idx < 0) return;
|
if (begin_idx < 0) return;
|
||||||
|
|
||||||
Word* zbranch = lookup_word_internal("0branch");
|
if (!w_zbranch) { fprintf(stderr, "Fatal: 0branch not found\n"); return; }
|
||||||
if (!zbranch) { printf("Fatal: 0branch not found\n"); return; }
|
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = zbranch};
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
||||||
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx};
|
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx};
|
||||||
}
|
}
|
||||||
|
|
||||||
void do_while(Word* w) {
|
void do_while(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("WHILE only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "WHILE only valid in compile mode\n"); return; }
|
||||||
int64_t begin_idx = compile_pop();
|
int64_t begin_idx = compile_pop();
|
||||||
if (begin_idx < 0) return;
|
if (begin_idx < 0) return;
|
||||||
|
|
||||||
Word* zbranch = lookup_word_internal("0branch");
|
if (!w_zbranch) { fprintf(stderr, "Fatal: 0branch not found\n"); return; }
|
||||||
if (!zbranch) { printf("Fatal: 0branch not found\n"); return; }
|
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = zbranch};
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
||||||
int64_t while_offset_idx = compile_idx;
|
int64_t while_offset_idx = compile_idx;
|
||||||
compile_idx++; // reserve offset
|
compile_idx++; // reserve offset
|
||||||
|
|
||||||
@@ -708,17 +703,82 @@ void do_while(Word* w) {
|
|||||||
|
|
||||||
void do_repeat(Word* w) {
|
void do_repeat(Word* w) {
|
||||||
(void)w;
|
(void)w;
|
||||||
if (state != 1) { printf("REPEAT only valid in compile mode\n"); return; }
|
if (state != 1) { fprintf(stderr, "REPEAT only valid in compile mode\n"); return; }
|
||||||
int64_t begin_idx = compile_pop();
|
int64_t begin_idx = compile_pop();
|
||||||
if (begin_idx < 0) return;
|
if (begin_idx < 0) return;
|
||||||
int64_t while_offset_idx = compile_pop();
|
int64_t while_offset_idx = compile_pop();
|
||||||
if (while_offset_idx < 0) return;
|
if (while_offset_idx < 0) return;
|
||||||
|
|
||||||
Word* branch_w = lookup_word_internal("branch");
|
if (!w_branch) { fprintf(stderr, "Fatal: branch not found\n"); return; }
|
||||||
if (!branch_w) { printf("Fatal: branch not found\n"); return; }
|
|
||||||
ensure_compile_cap(2);
|
ensure_compile_cap(2);
|
||||||
compile_buf[compile_idx++] = (Cell){.word = branch_w};
|
compile_buf[compile_idx++] = (Cell){.word = w_branch};
|
||||||
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx};
|
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx};
|
||||||
|
|
||||||
compile_buf[while_offset_idx].num = compile_idx - while_offset_idx;
|
compile_buf[while_offset_idx].num = compile_idx - while_offset_idx;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void do_depth(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
data_push(data_sp + 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_pick(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
if (data_sp < 0) return;
|
||||||
|
int64_t idx = data_pop();
|
||||||
|
if (idx < 0 || idx > data_sp) return;
|
||||||
|
int64_t value = data_stack[data_sp - (int32_t)idx];
|
||||||
|
data_push(value);
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_roll(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
if (data_sp < 0) return;
|
||||||
|
int64_t n = data_pop();
|
||||||
|
if (n == 0) return;
|
||||||
|
if (n < 0 || n > data_sp) return;
|
||||||
|
int64_t i = data_stack[data_sp - (int32_t)n];
|
||||||
|
int32_t pos = (int32_t)(data_sp - (int32_t)n);
|
||||||
|
while (pos < data_sp) {
|
||||||
|
data_stack[pos] = data_stack[pos + 1];
|
||||||
|
pos++;
|
||||||
|
}
|
||||||
|
data_stack[data_sp] = i;
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_qdup(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
if (data_sp < 0) return;
|
||||||
|
int64_t v = data_stack[data_sp];
|
||||||
|
if (v != 0) {
|
||||||
|
data_push(v);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_2dup(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
if (data_sp < 1) return;
|
||||||
|
int64_t b = data_stack[data_sp];
|
||||||
|
int64_t a = data_stack[data_sp - 1];
|
||||||
|
data_push(a);
|
||||||
|
data_push(b);
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_2drop(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
data_pop();
|
||||||
|
data_pop();
|
||||||
|
}
|
||||||
|
|
||||||
|
void do_2swap(Word* w) {
|
||||||
|
(void)w;
|
||||||
|
if (data_sp < 3) return;
|
||||||
|
int64_t x4 = data_pop();
|
||||||
|
int64_t x3 = data_pop();
|
||||||
|
int64_t x2 = data_pop();
|
||||||
|
int64_t x1 = data_pop();
|
||||||
|
data_push(x3);
|
||||||
|
data_push(x4);
|
||||||
|
data_push(x1);
|
||||||
|
data_push(x2);
|
||||||
|
}
|
||||||
|
|||||||
@@ -11,12 +11,12 @@ int main(void) {
|
|||||||
here = user_mem;
|
here = user_mem;
|
||||||
|
|
||||||
// Hidden words first
|
// Hidden words first
|
||||||
add_primitive("exit", do_exit, 0);
|
w_exit = add_primitive("exit", do_exit, 0);
|
||||||
add_primitive("docolon", do_docolon, 1 << 6);
|
w_docolon = add_primitive("docolon", do_docolon, F_HIDDEN);
|
||||||
add_primitive("lit", do_lit, 1 << 6);
|
w_lit = add_primitive("lit", do_lit, F_HIDDEN);
|
||||||
add_primitive("do_dot_quote_inner", do_dot_quote_inner, 1 << 6);
|
w_dot_quote_inner = add_primitive("do_dot_quote_inner", do_dot_quote_inner, F_HIDDEN);
|
||||||
add_primitive("0branch", do_zero_branch, 1 << 6);
|
w_zbranch = add_primitive("0branch", do_zero_branch, F_HIDDEN);
|
||||||
add_primitive("branch", do_branch, 1 << 6);
|
w_branch = add_primitive("branch", do_branch, F_HIDDEN);
|
||||||
|
|
||||||
// Public primitives
|
// Public primitives
|
||||||
// Stack ops
|
// Stack ops
|
||||||
@@ -69,7 +69,7 @@ int main(void) {
|
|||||||
add_primitive("cr", do_cr, 0);
|
add_primitive("cr", do_cr, 0);
|
||||||
add_primitive("emit", do_emit, 0);
|
add_primitive("emit", do_emit, 0);
|
||||||
add_primitive("key", do_key, 0);
|
add_primitive("key", do_key, 0);
|
||||||
add_primitive(".\"", do_dot_quote, 1 << 7); // immediate
|
add_primitive(".\"", do_dot_quote, F_IMMEDIATE); // immediate
|
||||||
add_primitive("words", do_words, 0);
|
add_primitive("words", do_words, 0);
|
||||||
|
|
||||||
// Memory
|
// Memory
|
||||||
@@ -90,14 +90,23 @@ int main(void) {
|
|||||||
|
|
||||||
// Compilation / control flow
|
// Compilation / control flow
|
||||||
add_primitive(":", do_colon, 0);
|
add_primitive(":", do_colon, 0);
|
||||||
add_primitive(";", do_semicolon, 1 << 7);
|
add_primitive(";", do_semicolon, F_IMMEDIATE);
|
||||||
add_primitive("if", do_if, 1 << 7);
|
add_primitive("if", do_if, F_IMMEDIATE);
|
||||||
add_primitive("else", do_else, 1 << 7);
|
add_primitive("else", do_else, F_IMMEDIATE);
|
||||||
add_primitive("then", do_then, 1 << 7);
|
add_primitive("then", do_then, F_IMMEDIATE);
|
||||||
add_primitive("begin", do_begin, 1 << 7);
|
add_primitive("begin", do_begin, F_IMMEDIATE);
|
||||||
add_primitive("until", do_until, 1 << 7);
|
add_primitive("until", do_until, F_IMMEDIATE);
|
||||||
add_primitive("while", do_while, 1 << 7);
|
add_primitive("while", do_while, F_IMMEDIATE);
|
||||||
add_primitive("repeat", do_repeat, 1 << 7);
|
add_primitive("repeat", do_repeat, F_IMMEDIATE);
|
||||||
|
|
||||||
|
/* Additional words */
|
||||||
|
add_primitive("depth", do_depth, 0);
|
||||||
|
add_primitive("pick", do_pick, 0);
|
||||||
|
add_primitive("roll", do_roll, 0);
|
||||||
|
add_primitive("?dup", do_qdup, 0);
|
||||||
|
add_primitive("2dup", do_2dup, 0);
|
||||||
|
add_primitive("2drop", do_2drop, 0);
|
||||||
|
add_primitive("2swap", do_2swap, 0);
|
||||||
|
|
||||||
// Start outer interpreter
|
// Start outer interpreter
|
||||||
outer_interpreter();
|
outer_interpreter();
|
||||||
|
|||||||
Reference in New Issue
Block a user