507 lines
12 KiB
C
507 lines
12 KiB
C
#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
|
|
if (input_ptr == NULL) {
|
|
printf("Missing string\n");
|
|
return;
|
|
}
|
|
// Skip whitespace before opening "
|
|
while (*input_ptr != '\0' && isspace((unsigned char)*input_ptr)) {
|
|
input_ptr++;
|
|
}
|
|
if (*input_ptr != '"') {
|
|
printf("Expected \" to start string\n");
|
|
return;
|
|
}
|
|
input_ptr++; // Skip opening "
|
|
char* start = input_ptr;
|
|
// Find closing "
|
|
while (*input_ptr != '\0' && *input_ptr != '"') {
|
|
input_ptr++;
|
|
}
|
|
if (*input_ptr != '"') {
|
|
printf("Unterminated string\n");
|
|
return;
|
|
}
|
|
// Print the string
|
|
while (start < input_ptr) {
|
|
putchar(*start++);
|
|
}
|
|
input_ptr++; // Skip closing "
|
|
fflush(stdout);
|
|
} else { // Compile mode: compile string for runtime
|
|
if (input_ptr == NULL) {
|
|
printf("Missing string\n");
|
|
return;
|
|
}
|
|
// Skip whitespace before opening "
|
|
while (*input_ptr != '\0' && isspace((unsigned char)*input_ptr)) {
|
|
input_ptr++;
|
|
}
|
|
if (*input_ptr != '"') {
|
|
printf("Expected \" to start string\n");
|
|
return;
|
|
}
|
|
input_ptr++; // Skip opening "
|
|
char* start = input_ptr;
|
|
// Find closing "
|
|
while (*input_ptr != '\0' && *input_ptr != '"') {
|
|
input_ptr++;
|
|
}
|
|
if (*input_ptr != '"') {
|
|
printf("Unterminated string\n");
|
|
return;
|
|
}
|
|
size_t len = input_ptr - start;
|
|
// Compile do_dot_quote_inner
|
|
Word* inner_w = lookup_word("do_dot_quote_inner");
|
|
if (inner_w == NULL) {
|
|
printf("Fatal: do_dot_quote_inner not found\n");
|
|
return;
|
|
}
|
|
if (compile_idx + 2 + len > COMPILE_BUF_SIZE) {
|
|
printf("Compile buffer full\n");
|
|
return;
|
|
}
|
|
compile_buf[compile_idx++] = (Cell){.word = inner_w};
|
|
compile_buf[compile_idx++] = (Cell){.num = (int32_t)len};
|
|
// Store string characters in compile buffer (each as a num cell)
|
|
for (size_t i = 0; i < len; i++) {
|
|
compile_buf[compile_idx++] = (Cell){.num = (int32_t)start[i]};
|
|
}
|
|
input_ptr++; // Skip closing "
|
|
}
|
|
}
|
|
|
|
void do_dot_quote_inner(Word* w) {
|
|
// Runtime: ip points to length cell, followed by string characters
|
|
int32_t len = ip->num;
|
|
ip++;
|
|
for (int32_t i = 0; i < len; i++) {
|
|
putchar((char)ip->num);
|
|
ip++;
|
|
}
|
|
fflush(stdout);
|
|
}
|
|
|
|
void do_words(Word* w) {
|
|
printf("Dictionary words:\n");
|
|
for (Word* cur = dict_head; cur != NULL; cur = cur->prev) {
|
|
if (cur->flags & (1 << 6)) continue; // Skip hidden
|
|
printf("%s ", cur->name);
|
|
}
|
|
printf("\n");
|
|
fflush(stdout);
|
|
}
|
|
|
|
// Control flow operations
|
|
void do_exit(Word* w) {
|
|
Cell* ret_addr = ret_pop_ip();
|
|
ip = ret_addr;
|
|
}
|
|
|
|
void do_docolon(Word* w) {
|
|
// Push current ip (return address) onto return stack
|
|
ret_push_ip(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
|
|
}
|
|
|
|
void do_branch(Word* w) {
|
|
// Unconditional branch: ip points to offset cell
|
|
int32_t offset = ip->num;
|
|
ip += offset; // Jump offset cells (offset is relative to after the offset cell)
|
|
}
|
|
|
|
void do_zero_branch(Word* w) {
|
|
// Conditional branch: if top of stack is 0, branch
|
|
int32_t cond = data_pop();
|
|
if (cond == 0) {
|
|
int32_t offset = ip->num;
|
|
ip += offset;
|
|
} else {
|
|
ip++; // Skip offset cell
|
|
}
|
|
}
|
|
|
|
// Memory operations (stubs for now)
|
|
void do_fetch(Word* w) { /* TODO */ }
|
|
void do_store(Word* w) { /* TODO */ }
|
|
void do_plus_store(Word* w) { /* TODO */ }
|
|
void do_cfetch(Word* w) { /* TODO */ }
|
|
void do_cstore(Word* w) { /* TODO */ }
|
|
void do_variable(Word* w) { /* TODO */ }
|
|
void do_constant(Word* w) { /* TODO */ }
|
|
void do_do_var(Word* w) { /* TODO */ }
|
|
void do_do_const(Word* w) { /* TODO */ }
|
|
void do_here(Word* w) { /* TODO */ }
|
|
void do_allot(Word* w) { /* TODO */ }
|
|
|
|
// Return stack operations (stubs for now)
|
|
void do_to_r(Word* w) { /* TODO */ }
|
|
void do_r_from(Word* w) { /* TODO */ }
|
|
void do_r_fetch(Word* w) { /* TODO */ }
|
|
|
|
// Additional control flow stubs
|
|
void do_if(Word* w) { /* TODO */ }
|
|
void do_else(Word* w) { /* TODO */ }
|
|
void do_then(Word* w) { /* TODO */ }
|
|
void do_begin(Word* w) { /* TODO */ }
|
|
void do_until(Word* w) { /* TODO */ }
|
|
void do_while(Word* w) { /* TODO */ }
|
|
void do_repeat(Word* w) { /* TODO */ }
|