#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 a = data_stack[data_sp-1]; int64_t b = data_stack[data_sp]; data_push(a); data_stack[data_sp-2] = b; } // 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) { 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) { 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) { 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; printf("%" PRId64 " ", data_pop()); fflush(stdout); } void do_cr(Word* w) { (void)w; printf("\n"); fflush(stdout); } void do_emit(Word* w) { (void)w; if (data_sp < 0) return; putchar((char)data_pop()); fflush(stdout); } void do_key(Word* w) { (void)w; int c = getchar(); data_push(c == EOF ? -1 : c); } void do_dot_quote(Word* w) { (void)w; if (state == 0) { // Interpret mode: print immediately if (input_ptr == NULL) { printf("Missing string\n"); return; } while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++; if (*input_ptr != '"') { printf("Expected \" to start string\n"); return; } input_ptr++; char* start = input_ptr; while (*input_ptr && *input_ptr != '"') input_ptr++; if (*input_ptr != '"') { printf("Unterminated string\n"); return; } while (start < input_ptr) putchar(*start++); input_ptr++; fflush(stdout); } else { // Compile mode: compile string for runtime if (input_ptr == NULL) { printf("Missing string\n"); return; } while (*input_ptr && isspace((unsigned char)*input_ptr)) input_ptr++; if (*input_ptr != '"') { printf("Expected \" to start string\n"); return; } input_ptr++; char* start = input_ptr; while (*input_ptr && *input_ptr != '"') input_ptr++; if (*input_ptr != '"') { printf("Unterminated string\n"); return; } size_t len = input_ptr - start; Word* inner_w = lookup_word_internal("do_dot_quote_inner"); if (!inner_w) { printf("Fatal: do_dot_quote_inner not found\n"); return; } ensure_compile_cap(2 + (int32_t)len); compile_buf[compile_idx++] = (Cell){.word = inner_w}; 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++) { putchar((char)ip->num); ip++; } fflush(stdout); } void do_words(Word* w) { (void)w; printf("Dictionary words:\n"); for (Word* cur = dict_head; cur != NULL; cur = cur->prev) { if (cur->flags & (1 << 6)) continue; printf("%s ", cur->name); } printf("\n"); fflush(stdout); } // Memory operations void do_fetch(Word* w) { (void)w; int64_t addr = data_pop(); if (addr < 0 || addr >= user_mem_size) { 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) { 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) { 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) { 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) { 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(); if (here + n > user_mem + user_mem_size) { printf("User memory overflow\n"); return; } here += n; } // Variable and constant void do_variable(Word* w) { (void)w; char* name = next_token(); if (!name) { 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) { 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 = malloc(sizeof(Word)); if (!new_w) { printf("Out of memory\n"); exit(1); } 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) { 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) { 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 = malloc(sizeof(Word)); if (!new_w) { printf("Out of memory\n"); exit(1); } 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) { 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) { 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) { printf("';' only valid in compile mode\n"); return; } Word* exit_w = lookup_word("exit"); if (!exit_w) { printf("Fatal: exit word not found\n"); return; } ensure_compile_cap(1); compile_buf[compile_idx++] = (Cell){.word = exit_w}; // Create body copy of compiled cells Cell* body_copy = malloc(compile_idx * sizeof(Cell)); if (!body_copy) { printf("Out of memory\n"); exit(1); } memcpy(body_copy, compile_buf, compile_idx * sizeof(Cell)); // Create new word entry Word* new_w = malloc(sizeof(Word)); if (!new_w) { printf("Out of memory\n"); free(body_copy); exit(1); } 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) { printf("IF only valid in compile mode\n"); return; } Word* zbranch = lookup_word_internal("0branch"); if (!zbranch) { printf("Fatal: 0branch not found\n"); return; } ensure_compile_cap(2); compile_buf[compile_idx++] = (Cell){.word = 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) { 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) { printf("ELSE only valid in compile mode\n"); return; } int64_t if_offset_idx = compile_pop(); if (if_offset_idx < 0) return; Word* branch_w = lookup_word_internal("branch"); if (!branch_w) { printf("Fatal: branch not found\n"); return; } ensure_compile_cap(2); // 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 = branch_w}; compile_push(compile_idx); compile_idx++; // reserve offset cell } void do_begin(Word* w) { (void)w; if (state != 1) { printf("BEGIN only valid in compile mode\n"); return; } compile_push(compile_idx); } void do_until(Word* w) { (void)w; if (state != 1) { printf("UNTIL only valid in compile mode\n"); return; } int64_t begin_idx = compile_pop(); if (begin_idx < 0) return; Word* zbranch = lookup_word_internal("0branch"); if (!zbranch) { printf("Fatal: 0branch not found\n"); return; } ensure_compile_cap(2); compile_buf[compile_idx++] = (Cell){.word = zbranch}; compile_buf[compile_idx++] = (Cell){.num = begin_idx - compile_idx}; } void do_while(Word* w) { (void)w; if (state != 1) { printf("WHILE only valid in compile mode\n"); return; } int64_t begin_idx = compile_pop(); if (begin_idx < 0) return; Word* zbranch = lookup_word_internal("0branch"); if (!zbranch) { printf("Fatal: 0branch not found\n"); return; } ensure_compile_cap(2); compile_buf[compile_idx++] = (Cell){.word = 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) { 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; Word* branch_w = lookup_word_internal("branch"); if (!branch_w) { printf("Fatal: branch not found\n"); return; } ensure_compile_cap(2); compile_buf[compile_idx++] = (Cell){.word = branch_w}; 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_pop(); if (v != 0) { data_push(v); 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 d = data_pop(); // x4 int64_t c = data_pop(); // x3 int64_t b = data_pop(); // x2 int64_t a = data_pop(); // x1 data_push(b); data_push(a); data_push(d); data_push(c); }