795 lines
19 KiB
C
795 lines
19 KiB
C
#include "forth.h"
|
|
|
|
// Stack operations
|
|
void do_dup(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
int64_t v = data_stack[data_sp];
|
|
data_push(v);
|
|
}
|
|
|
|
void do_drop(Word* w) {
|
|
(void)w;
|
|
data_pop();
|
|
}
|
|
|
|
void do_swap(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t a = data_stack[data_sp-1];
|
|
int64_t b = data_stack[data_sp];
|
|
data_stack[data_sp-1] = b;
|
|
data_stack[data_sp] = a;
|
|
}
|
|
|
|
void do_over(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
data_push(data_stack[data_sp-1]);
|
|
}
|
|
|
|
void do_rot(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 2) return;
|
|
int64_t a = data_stack[data_sp-2];
|
|
int64_t b = data_stack[data_sp-1];
|
|
int64_t c = data_stack[data_sp];
|
|
data_stack[data_sp-2] = c;
|
|
data_stack[data_sp-1] = a;
|
|
data_stack[data_sp] = b;
|
|
}
|
|
|
|
void do_minus_rot(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 2) return;
|
|
int64_t a = data_stack[data_sp-2];
|
|
int64_t b = data_stack[data_sp-1];
|
|
int64_t c = data_stack[data_sp];
|
|
data_stack[data_sp-2] = b;
|
|
data_stack[data_sp-1] = c;
|
|
data_stack[data_sp] = a;
|
|
}
|
|
|
|
void do_nip(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
data_stack[data_sp-1] = data_stack[data_sp];
|
|
data_sp--;
|
|
}
|
|
|
|
void do_tuck(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t x1 = data_stack[data_sp-1];
|
|
int64_t x2 = data_stack[data_sp];
|
|
data_stack[data_sp-1] = x2;
|
|
data_stack[data_sp] = x1;
|
|
data_push(x2);
|
|
}
|
|
|
|
// Arithmetic
|
|
void do_add(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a + b);
|
|
}
|
|
|
|
void do_sub(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a - b);
|
|
}
|
|
|
|
void do_mul(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a * b);
|
|
}
|
|
|
|
void do_div(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
if (b == 0) {
|
|
forth_printf("Division by zero\n");
|
|
data_push(a);
|
|
data_push(b);
|
|
return;
|
|
}
|
|
data_push(a / b);
|
|
}
|
|
|
|
void do_mod(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
if (b == 0) {
|
|
forth_printf("Modulo by zero\n");
|
|
data_push(a);
|
|
data_push(b);
|
|
return;
|
|
}
|
|
data_push(a % b);
|
|
}
|
|
|
|
void do_slash_mod(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
if (b == 0) {
|
|
forth_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) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp]++;
|
|
}
|
|
|
|
void do_one_minus(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp]--;
|
|
}
|
|
|
|
void do_two_plus(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp] += 2;
|
|
}
|
|
|
|
void do_two_minus(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp] -= 2;
|
|
}
|
|
|
|
void do_negate(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp] = -data_stack[data_sp];
|
|
}
|
|
|
|
void do_abs(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
int64_t v = data_pop();
|
|
data_push(v < 0 ? -v : v);
|
|
}
|
|
|
|
void do_min(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a < b ? a : b);
|
|
}
|
|
|
|
void do_max(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a > b ? a : b);
|
|
}
|
|
|
|
// Logic
|
|
void do_and(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a & b);
|
|
}
|
|
|
|
void do_or(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a | b);
|
|
}
|
|
|
|
void do_xor(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a ^ b);
|
|
}
|
|
|
|
void do_invert(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
data_stack[data_sp] = ~data_stack[data_sp];
|
|
}
|
|
|
|
void do_lshift(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a << b);
|
|
}
|
|
|
|
void do_rshift(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push((int64_t)((uint64_t)a >> b));
|
|
}
|
|
|
|
// Comparison
|
|
void do_eq(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a == b ? -1 : 0);
|
|
}
|
|
|
|
void do_neq(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a != b ? -1 : 0);
|
|
}
|
|
|
|
void do_lt(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a < b ? -1 : 0);
|
|
}
|
|
|
|
void do_gt(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a > b ? -1 : 0);
|
|
}
|
|
|
|
void do_lte(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a <= b ? -1 : 0);
|
|
}
|
|
|
|
void do_gte(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 1) return;
|
|
int64_t b = data_pop();
|
|
int64_t a = data_pop();
|
|
data_push(a >= b ? -1 : 0);
|
|
}
|
|
|
|
void do_zero_eq(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
int64_t a = data_pop();
|
|
data_push(a == 0 ? -1 : 0);
|
|
}
|
|
|
|
void do_zero_lt(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
int64_t a = data_pop();
|
|
data_push(a < 0 ? -1 : 0);
|
|
}
|
|
|
|
void do_zero_gt(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
int64_t a = data_pop();
|
|
data_push(a > 0 ? -1 : 0);
|
|
}
|
|
|
|
// I/O
|
|
void do_dot(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
forth_printf("%lld ", (long long)data_pop());
|
|
forth_fflush();
|
|
}
|
|
|
|
void do_cr(Word* w) {
|
|
(void)w;
|
|
forth_printf("\n");
|
|
forth_fflush();
|
|
}
|
|
|
|
void do_emit(Word* w) {
|
|
(void)w;
|
|
if (data_sp < 0) return;
|
|
forth_putchar((char)data_pop());
|
|
forth_fflush();
|
|
}
|
|
|
|
void do_key(Word* w) {
|
|
(void)w;
|
|
int c = forth_getchar();
|
|
data_push(c == FORTH_EOF ? -1 : c);
|
|
}
|
|
|
|
void do_dot_quote(Word* w) {
|
|
(void)w;
|
|
if (state == 0) {
|
|
// Interpret mode: print immediately
|
|
if (input_ptr == NULL) { forth_printf("Missing string\n"); return; }
|
|
while (*input_ptr && forth_isspace((unsigned char)*input_ptr)) input_ptr++;
|
|
if (*input_ptr != '"') { forth_printf("Expected \" to start string\n"); return; }
|
|
input_ptr++;
|
|
char* start = input_ptr;
|
|
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
|
if (*input_ptr != '"') { forth_printf("Unterminated string\n"); return; }
|
|
while (start < input_ptr) forth_putchar(*start++);
|
|
input_ptr++;
|
|
forth_fflush();
|
|
} else {
|
|
// Compile mode: compile string for runtime
|
|
if (input_ptr == NULL) { forth_printf("Missing string\n"); return; }
|
|
while (*input_ptr && forth_isspace((unsigned char)*input_ptr)) input_ptr++;
|
|
if (*input_ptr != '"') { forth_printf("Expected \" to start string\n"); return; }
|
|
input_ptr++;
|
|
char* start = input_ptr;
|
|
while (*input_ptr && *input_ptr != '"') input_ptr++;
|
|
if (*input_ptr != '"') { forth_printf("Unterminated string\n"); return; }
|
|
size_t len = input_ptr - start;
|
|
if (!w_dot_quote_inner) { forth_printf("Fatal: do_dot_quote_inner not found\n"); return; }
|
|
if (!ensure_compile_cap(2 + (int32_t)len)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_dot_quote_inner};
|
|
compile_buf[compile_idx++] = (Cell){.num = (int64_t)len};
|
|
for (size_t i = 0; i < len; i++) {
|
|
compile_buf[compile_idx++] = (Cell){.num = (int64_t)start[i]};
|
|
}
|
|
input_ptr++;
|
|
}
|
|
}
|
|
|
|
void do_dot_quote_inner(Word* w) {
|
|
(void)w;
|
|
int64_t len = ip->num;
|
|
ip++;
|
|
for (int64_t i = 0; i < len; i++) {
|
|
forth_putchar((char)ip->num);
|
|
ip++;
|
|
}
|
|
forth_fflush();
|
|
}
|
|
|
|
void do_words(Word* w) {
|
|
(void)w;
|
|
forth_printf("Dictionary words:\n");
|
|
for (Word* cur = dict_head; cur != NULL; cur = cur->prev) {
|
|
if (cur->flags & (1 << 6)) continue;
|
|
forth_printf("%s ", cur->name);
|
|
}
|
|
forth_printf("\n");
|
|
forth_fflush();
|
|
}
|
|
|
|
// Memory operations
|
|
void do_fetch(Word* w) {
|
|
(void)w;
|
|
int64_t addr = data_pop();
|
|
if (addr < 0 || addr >= user_mem_size) {
|
|
forth_printf("Address out of bounds\n");
|
|
return;
|
|
}
|
|
data_push(user_mem[addr].num);
|
|
}
|
|
|
|
void do_store(Word* w) {
|
|
(void)w;
|
|
int64_t addr = data_pop();
|
|
int64_t val = data_pop();
|
|
if (addr < 0 || addr >= user_mem_size) {
|
|
forth_printf("Address out of bounds\n");
|
|
return;
|
|
}
|
|
user_mem[addr].num = val;
|
|
}
|
|
|
|
void do_plus_store(Word* w) {
|
|
(void)w;
|
|
int64_t addr = data_pop();
|
|
int64_t val = data_pop();
|
|
if (addr < 0 || addr >= user_mem_size) {
|
|
forth_printf("Address out of bounds\n");
|
|
return;
|
|
}
|
|
user_mem[addr].num += val;
|
|
}
|
|
|
|
void do_cfetch(Word* w) {
|
|
(void)w;
|
|
int64_t addr = data_pop(); // byte offset
|
|
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
|
if (addr < 0 || addr >= max_byte) {
|
|
forth_printf("Address out of bounds\n");
|
|
return;
|
|
}
|
|
uint8_t* base = (uint8_t*)user_mem;
|
|
data_push((int64_t)base[addr]);
|
|
}
|
|
|
|
void do_cstore(Word* w) {
|
|
(void)w;
|
|
int64_t addr = data_pop();
|
|
int64_t val = data_pop();
|
|
int64_t max_byte = user_mem_size * (int64_t)sizeof(Cell);
|
|
if (addr < 0 || addr >= max_byte) {
|
|
forth_printf("Address out of bounds\n");
|
|
return;
|
|
}
|
|
uint8_t* base = (uint8_t*)user_mem;
|
|
base[addr] = (uint8_t)val;
|
|
}
|
|
|
|
void do_here(Word* w) {
|
|
(void)w;
|
|
// push the cell offset index
|
|
data_push(here - user_mem);
|
|
}
|
|
|
|
void do_allot(Word* w) {
|
|
(void)w;
|
|
int64_t n = data_pop();
|
|
int64_t idx = here - user_mem;
|
|
if (idx + n < 0 || idx + n > user_mem_size) {
|
|
forth_printf("User memory out of bounds\n");
|
|
return;
|
|
}
|
|
here += n;
|
|
}
|
|
|
|
void do_comma(Word* w) {
|
|
(void)w;
|
|
int64_t val = data_pop();
|
|
if (here + 1 > user_mem + user_mem_size) {
|
|
forth_printf("User memory overflow\n");
|
|
return;
|
|
}
|
|
here->num = val;
|
|
here++;
|
|
}
|
|
|
|
// Variable and constant
|
|
void do_variable(Word* w) {
|
|
(void)w;
|
|
char* name = next_token();
|
|
if (!name) { forth_printf("VARIABLE expects a name\n"); return; }
|
|
|
|
// allocate one cell in user memory for the variable's data
|
|
if (here + 1 > user_mem + user_mem_size) {
|
|
forth_printf("User memory overflow\n");
|
|
return;
|
|
}
|
|
Cell* var_cell = here; // address of the data cell
|
|
var_cell->num = 0; // initialise to 0 (optional)
|
|
here++;
|
|
|
|
// create dictionary entry
|
|
Word* new_w = forth_alloc_word();
|
|
new_w->prev = dict_head;
|
|
dict_head = new_w;
|
|
|
|
size_t len = strlen(name);
|
|
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
|
new_w->flags = (uint8_t)len;
|
|
memcpy(new_w->name, name, len);
|
|
new_w->name[len] = '\0';
|
|
new_w->code = do_do_var;
|
|
new_w->body = var_cell; // body points directly to the data cell in user_mem
|
|
}
|
|
|
|
void do_constant(Word* w) {
|
|
(void)w;
|
|
int64_t val = data_pop();
|
|
char* name = next_token();
|
|
if (!name) { forth_printf("CONSTANT expects a name\n"); data_push(val); return; }
|
|
|
|
// allocate a cell in user memory to hold the constant value
|
|
if (here + 1 > user_mem + user_mem_size) {
|
|
forth_printf("User memory overflow\n");
|
|
data_push(val); // restore the value (optional)
|
|
return;
|
|
}
|
|
Cell* val_cell = here;
|
|
val_cell->num = val;
|
|
here++;
|
|
|
|
Word* new_w = forth_alloc_word();
|
|
new_w->prev = dict_head;
|
|
dict_head = new_w;
|
|
|
|
size_t len = strlen(name);
|
|
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
|
new_w->flags = (uint8_t)len;
|
|
memcpy(new_w->name, name, len);
|
|
new_w->name[len] = '\0';
|
|
new_w->code = do_do_const;
|
|
new_w->body = val_cell; // body points to the cell that holds the value
|
|
}
|
|
|
|
void do_do_var(Word* w) {
|
|
// push the address (cell index into user_mem) of the variable's data cell
|
|
data_push(w->body - user_mem);
|
|
}
|
|
|
|
void do_do_const(Word* w) {
|
|
data_push(w->body->num); // push the constant value
|
|
}
|
|
|
|
// Return stack ops
|
|
void do_to_r(Word* w) {
|
|
(void)w;
|
|
int64_t val = data_pop();
|
|
ret_push_num(val);
|
|
}
|
|
|
|
void do_r_from(Word* w) {
|
|
(void)w;
|
|
int64_t val = ret_pop_num();
|
|
data_push(val);
|
|
}
|
|
|
|
void do_r_fetch(Word* w) {
|
|
(void)w;
|
|
if (rp < 0) { forth_printf("Return stack underflow\n"); return; }
|
|
data_push(ret_stack[rp].num);
|
|
}
|
|
|
|
// Control flow
|
|
void do_exit(Word* w) {
|
|
(void)w;
|
|
Cell* ret_addr = ret_pop_ip();
|
|
ip = ret_addr;
|
|
}
|
|
|
|
void do_docolon(Word* w) {
|
|
ret_push_ip(ip);
|
|
ip = w->body;
|
|
}
|
|
|
|
void do_lit(Word* w) {
|
|
(void)w;
|
|
data_push(ip->num);
|
|
ip++;
|
|
}
|
|
|
|
void do_colon(Word* w) {
|
|
(void)w;
|
|
char* name = next_token();
|
|
if (!name) { forth_printf("':' expects a name\n"); return; }
|
|
size_t len = strlen(name);
|
|
if (len > MAX_NAME_LEN) len = MAX_NAME_LEN;
|
|
memcpy(compiling_name, name, len);
|
|
compiling_name[len] = '\0';
|
|
state = 1;
|
|
compile_idx = 0;
|
|
ensure_compile_cap(0); // make sure compile_buf exists
|
|
}
|
|
|
|
void do_semicolon(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("';' only valid in compile mode\n"); return; }
|
|
if (!w_exit) { forth_printf("Fatal: exit word not found\n"); return; }
|
|
|
|
if (!ensure_compile_cap(1)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_exit};
|
|
|
|
// Create body copy of compiled cells
|
|
Cell* body_copy = forth_alloc_body(compile_idx);
|
|
if (!body_copy) { forth_printf("Out of memory\n"); return; }
|
|
memcpy(body_copy, compile_buf, compile_idx * sizeof(Cell));
|
|
|
|
// Create new word entry
|
|
Word* new_w = forth_alloc_word();
|
|
if (!new_w) { forth_printf("Out of memory\n"); return; }
|
|
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
|
|
memcpy(new_w->name, compiling_name, len);
|
|
new_w->name[len] = '\0';
|
|
new_w->code = do_docolon;
|
|
new_w->body = body_copy;
|
|
|
|
state = 0; // back to interpret mode
|
|
}
|
|
|
|
void do_branch(Word* w) {
|
|
(void)w;
|
|
int64_t offset = ip->num;
|
|
ip += offset;
|
|
}
|
|
|
|
void do_zero_branch(Word* w) {
|
|
(void)w;
|
|
int64_t cond = data_pop();
|
|
if (cond == 0) {
|
|
int64_t offset = ip->num;
|
|
ip += offset;
|
|
} else {
|
|
ip++;
|
|
}
|
|
}
|
|
|
|
// Control flow using compile stack (indices)
|
|
void do_if(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("IF only valid in compile mode\n"); return; }
|
|
if (!w_zbranch) { forth_printf("Fatal: 0branch not found\n"); return; }
|
|
if (!ensure_compile_cap(2)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
|
// compile_push current index (where the offset will be placed)
|
|
compile_push(compile_idx);
|
|
compile_idx++; // reserve offset cell
|
|
}
|
|
|
|
void do_then(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("THEN only valid in compile mode\n"); return; }
|
|
int64_t offset_idx = compile_pop();
|
|
if (offset_idx < 0) return;
|
|
compile_buf[offset_idx].num = compile_idx - offset_idx;
|
|
}
|
|
|
|
void do_else(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("ELSE only valid in compile mode\n"); return; }
|
|
int64_t if_offset_idx = compile_pop();
|
|
if (if_offset_idx < 0) return;
|
|
|
|
if (!w_branch) { forth_printf("Fatal: branch not found\n"); return; }
|
|
if (!ensure_compile_cap(2)) return;
|
|
|
|
// resolve IF offset to skip the ELSE branch
|
|
compile_buf[if_offset_idx].num = (compile_idx + 2) - if_offset_idx;
|
|
|
|
// compile unconditional branch for ELSE part
|
|
compile_buf[compile_idx++] = (Cell){.word = w_branch};
|
|
compile_push(compile_idx);
|
|
compile_idx++; // reserve offset cell
|
|
}
|
|
|
|
void do_begin(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("BEGIN only valid in compile mode\n"); return; }
|
|
compile_push(compile_idx);
|
|
}
|
|
|
|
void do_until(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("UNTIL only valid in compile mode\n"); return; }
|
|
int64_t begin_idx = compile_pop();
|
|
if (begin_idx < 0) return;
|
|
|
|
if (!w_zbranch) { forth_printf("Fatal: 0branch not found\n"); return; }
|
|
if (!ensure_compile_cap(2)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
|
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx};
|
|
}
|
|
|
|
void do_while(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("WHILE only valid in compile mode\n"); return; }
|
|
int64_t begin_idx = compile_pop();
|
|
if (begin_idx < 0) return;
|
|
|
|
if (!w_zbranch) { forth_printf("Fatal: 0branch not found\n"); return; }
|
|
if (!ensure_compile_cap(2)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_zbranch};
|
|
int64_t while_offset_idx = compile_idx;
|
|
compile_idx++; // reserve offset
|
|
|
|
compile_push(while_offset_idx);
|
|
compile_push(begin_idx);
|
|
}
|
|
|
|
void do_repeat(Word* w) {
|
|
(void)w;
|
|
if (state != 1) { forth_printf("REPEAT only valid in compile mode\n"); return; }
|
|
int64_t begin_idx = compile_pop();
|
|
if (begin_idx < 0) return;
|
|
int64_t while_offset_idx = compile_pop();
|
|
if (while_offset_idx < 0) return;
|
|
|
|
if (!w_branch) { forth_printf("Fatal: branch not found\n"); return; }
|
|
if (!ensure_compile_cap(2)) return;
|
|
compile_buf[compile_idx++] = (Cell){.word = w_branch};
|
|
compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_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);
|
|
}
|