kaizenkodo/WAFER
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Forth 2012 compliance: 3→10 word sets passing (44→1 errors)

Browse Source 
Major compliance push bringing WAFER from 3 to 10 passing Forth 2012
compliance test suites (Core, Core Extensions, Core Plus, Double,
Exception, Facility, Locals, Memory, Search Order, String).

Compiler/runtime fixes:
- DEFER: host function via pending_define, works inside colon defs
- COMPILE,: handle_pending_compile in execute_word for [...] sequences
- MARKER: full save/restore with pending_marker_restore mechanism
- IMMEDIATE: changed from XOR toggle to OR set per Forth 2012 spec
- ABORT": throw -2 via THROW, no message display when caught
- M*/: symmetric division to match WAFER's / behavior
- pending_define: single i32 flag → Vec<i32> queue for multi-action words
- Optimizer: prevent inlining words containing EXIT or ForthLocal ops
- +LOOP: corrected boundary check formula with AND step comparison
- REPEAT: accept bare BEGIN (unstructured IF...BEGIN...REPEAT)
- Auto-close unclosed IFs at ; for unstructured control flow
- _create_part_: use reserve_fn_index to preserve dictionary.latest()

Memory layout:
- Separate PICT_BUF and WORD_BUF regions to prevent PAD overlap
- Updated DEPTH hardcoded DATA_STACK_TOP in boot.fth

New word sets:
- [IF]/[ELSE]/[THEN]/[DEFINED]/[UNDEFINED]: conditional compilation
- UNESCAPE/SUBSTITUTE/REPLACES: string substitution (host functions)
- Locals {: syntax: parser, ForthLocalGet/Set IR ops, WASM local codegen
- ENVIRONMENT? support for #LOCALS (returns 16)
- N>R/NR>/SYNONYM: programming-tools extensions
- Search Order: ONLY, ALSO, PREVIOUS, DEFINITIONS, FORTH,
  FORTH-WORDLIST, GET-ORDER, SET-ORDER, GET-CURRENT, SET-CURRENT,
  WORDLIST, SEARCH-WORDLIST with full multi-wordlist dictionary support
  via Arc<Mutex> shared state for immediate effect from compiled code

Remaining: 1 cascade error in Programming-Tools from CS-PICK/CS-ROLL
(unstructured control-flow stack manipulation, requires flat IR).
This commit is contained in:
Oleksandr Kozachuk
2026-04-09 10:10:24 +02:00
parent 3bef345e86
commit 52698cd409
7 changed files with 1278 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files
crates/core/boot.fth
+5 -5
View File
@@ -8,8 +8,8 @@
\ DEPTH ( -- n ) number of items on the data stack
\ SP@ must come first so it reads the dsp before DEPTH's own literal push.
\ DATA_STACK_TOP = 5440, uses arithmetic right shift for / 4
: DEPTH SP@ 5440 SWAP - 2 RSHIFT ;
\ DATA_STACK_TOP = 5632 (0x1600), uses arithmetic right shift for / 4
: DEPTH SP@ 5632 SWAP - 2 RSHIFT ;
\ PICK ( xn..x0 n -- xn..x0 xn ) copy nth stack item
: PICK 1+ CELLS SP@ + @ ;
@@ -188,10 +188,10 @@
: SPACES 0 ?DO SPACE LOOP ;
\ Pictured numeric output constants
\ PAD_BASE = 0x0440, PAD_SIZE = 256, SYSVAR_HLD = 28
\ PICT_BUF_TOP = 0x05C0 = 1472, SYSVAR_HLD = 28
\ <# ( -- ) begin pictured numeric output
: <# 1344 28 ! ;
: <# 1472 28 ! ;
\ HOLD ( char -- ) add character to pictured output
: HOLD 28 @ 1- DUP 28 ! C! ;
@@ -220,7 +220,7 @@
: #S BEGIN # 2DUP OR 0= UNTIL ;
\ #> ( ud -- c-addr u ) end pictured output, return string
: #> 2DROP 28 @ 1344 OVER - ;
: #> 2DROP 28 @ 1472 OVER - ;
\ Formatted output built on pictured numeric output
crates/core/src/codegen.rs
+85 -13
View File
@@ -229,6 +229,9 @@ fn bool_to_forth_flag(f: &mut Function, tmp: u32) {
struct EmitCtx {
f64_local_0: u32,
f64_local_1: u32,
/// Base WASM local index for Forth locals ({: ... :}).
/// Forth local N maps to WASM local `forth_local_base + N`.
forth_local_base: u32,
}
/// Decrement the FSP global by 8 (allocate space for one f64).
@@ -661,6 +664,15 @@ fn emit_op(f: &mut Function, op: &IrOp, ctx: &EmitCtx) {
f.instruction(&Instruction::Return);
}
// -- Forth locals ({: ... :}) -----------------------------------------
IrOp::ForthLocalGet(n) => {
f.instruction(&Instruction::LocalGet(ctx.forth_local_base + n));
push_via_local(f, SCRATCH_BASE);
}
IrOp::ForthLocalSet(n) => {
pop_to(f, ctx.forth_local_base + n);
}
// -- Return stack ---------------------------------------------------
IrOp::ToR => {
pop(f);
@@ -941,20 +953,26 @@ fn emit_do_loop(f: &mut Function, body: &[IrOp], is_plus_loop: bool, ctx: &EmitC
.instruction(&Instruction::I32Add)
.instruction(&Instruction::LocalSet(SCRATCH_BASE));
// Push updated index to return stack
// Push updated index to return stack (use SCRATCH_BASE+4 as temp to preserve step)
f.instruction(&Instruction::LocalGet(SCRATCH_BASE));
rpush_via_local(f, SCRATCH_BASE + 2);
rpush_via_local(f, SCRATCH_BASE + 4);
// Compute new_index - limit
// (old_index - limit) XOR (new_index - limit)
// If sign bit set (negative), exit
// Forth 2012 +LOOP termination:
// exit = ((old-limit) XOR (new-limit)) AND ((old-limit) XOR step) < 0
// xor1 = (old-limit) XOR (new-limit)
f.instruction(&Instruction::LocalGet(SCRATCH_BASE + 3)) // old - limit
.instruction(&Instruction::LocalGet(SCRATCH_BASE)) // new_index
.instruction(&Instruction::LocalGet(SCRATCH_BASE + 1)) // limit
.instruction(&Instruction::I32Sub) // new - limit
.instruction(&Instruction::I32Xor) // (old-limit) XOR (new-limit)
.instruction(&Instruction::I32Xor); // xor1
// xor2 = (old-limit) XOR step
f.instruction(&Instruction::LocalGet(SCRATCH_BASE + 3)) // old - limit
.instruction(&Instruction::LocalGet(SCRATCH_BASE + 2)) // step (preserved!)
.instruction(&Instruction::I32Xor); // xor2
// exit = (xor1 AND xor2) < 0
f.instruction(&Instruction::I32And)
.instruction(&Instruction::I32Const(0))
.instruction(&Instruction::I32LtS) // < 0 means sign bit set
.instruction(&Instruction::I32LtS)
.instruction(&Instruction::BrIf(1)) // break to $exit
.instruction(&Instruction::Br(0)) // continue loop
.instruction(&Instruction::End) // end loop
@@ -1015,6 +1033,7 @@ fn is_promotable(ops: &[IrOp]) -> bool {
| IrOp::BeginDoubleWhileRepeat { .. } => return false,
IrOp::Exit => return false,
IrOp::ToR | IrOp::FromR | IrOp::RFetch => return false,
IrOp::ForthLocalGet(_) | IrOp::ForthLocalSet(_) => return false,
IrOp::Emit | IrOp::Dot | IrOp::Cr | IrOp::Type => return false,
IrOp::PushI64(_) | IrOp::PushF64(_) => return false,
IrOp::FDup
@@ -1659,7 +1678,13 @@ fn count_scratch_locals(ops: &[IrOp]) -> u32 {
for op in ops {
match op {
IrOp::Rot | IrOp::Tuck => max = max.max(4),
IrOp::DoLoop { body, .. } => max = max.max(count_scratch_locals(body)),
IrOp::DoLoop { body, is_plus_loop } => {
// +LOOP needs 5 scratch locals (SCRATCH_BASE..SCRATCH_BASE+4)
if *is_plus_loop {
max = max.max(5);
}
max = max.max(count_scratch_locals(body));
}
IrOp::BeginUntil { body } => max = max.max(count_scratch_locals(body)),
IrOp::BeginAgain { body } => max = max.max(count_scratch_locals(body)),
IrOp::BeginWhileRepeat { test, body } => {
@@ -1698,6 +1723,36 @@ fn count_scratch_locals(ops: &[IrOp]) -> u32 {
max
}
/// Count the number of Forth locals used in an IR body.
/// Returns the maximum local index + 1 (0 if no locals used).
fn count_forth_locals(ops: &[IrOp]) -> u32 {
let mut max: u32 = 0;
for op in ops {
match op {
IrOp::ForthLocalGet(n) | IrOp::ForthLocalSet(n) => max = max.max(*n + 1),
IrOp::If {
then_body,
else_body,
} => {
max = max.max(count_forth_locals(then_body));
if let Some(eb) = else_body {
max = max.max(count_forth_locals(eb));
}
}
IrOp::DoLoop { body, .. } | IrOp::BeginUntil { body } | IrOp::BeginAgain { body } => {
max = max.max(count_forth_locals(body));
}
IrOp::BeginWhileRepeat { test, body } => {
max = max
.max(count_forth_locals(test))
.max(count_forth_locals(body));
}
_ => {}
}
}
max
}
/// Generate a complete WASM module for a single compiled word.
///
/// This is the JIT path: each word gets its own module that imports
@@ -1794,13 +1849,14 @@ pub fn compile_word(
// Determine whether to use stack-to-local promotion
let promoted = config.stack_to_local_promotion && is_promotable(body);
let scratch_count = count_scratch_locals(body);
let forth_local_count = count_forth_locals(body);
let num_locals = if promoted {
let (preload, _) = compute_stack_needs(body);
let promoted_count = count_promoted_locals(body, preload);
// 1 (cached DSP) + promoted locals (scratch locals not needed in promoted path)
1 + promoted_count
1 + promoted_count + forth_local_count
} else {
1 + scratch_count
1 + scratch_count + forth_local_count
};
let has_floats = needs_f64_locals(body);
let num_f64: u32 = if has_floats { 2 } else { 0 };
@@ -1809,9 +1865,17 @@ pub fn compile_word(
locals_decl.push((num_f64, ValType::F64));
}
let mut func = Function::new(locals_decl);
let forth_local_base = if promoted {
let (preload, _) = compute_stack_needs(body);
let promoted_count = count_promoted_locals(body, preload);
1 + promoted_count
} else {
1 + scratch_count
};
let ctx = EmitCtx {
f64_local_0: num_locals,
f64_local_1: num_locals + 1,
forth_local_base,
};
// Prologue: cache $dsp global into local 0
@@ -2057,13 +2121,18 @@ fn emit_consolidated_do_loop(
.instruction(&Instruction::LocalSet(SCRATCH_BASE));
f.instruction(&Instruction::LocalGet(SCRATCH_BASE));
rpush_via_local(f, SCRATCH_BASE + 2);
rpush_via_local(f, SCRATCH_BASE + 4);
// Forth 2012: ((old-limit) XOR (new-limit)) AND ((old-limit) XOR step) < 0
f.instruction(&Instruction::LocalGet(SCRATCH_BASE + 3))
.instruction(&Instruction::LocalGet(SCRATCH_BASE))
.instruction(&Instruction::LocalGet(SCRATCH_BASE + 1))
.instruction(&Instruction::I32Sub)
.instruction(&Instruction::I32Xor)
.instruction(&Instruction::I32Xor);
f.instruction(&Instruction::LocalGet(SCRATCH_BASE + 3))
.instruction(&Instruction::LocalGet(SCRATCH_BASE + 2))
.instruction(&Instruction::I32Xor);
f.instruction(&Instruction::I32And)
.instruction(&Instruction::I32Const(0))
.instruction(&Instruction::I32LtS)
.instruction(&Instruction::BrIf(1))
@@ -2250,7 +2319,9 @@ fn compile_multi_word_module(
// -- Code section: emit each function body --
let mut code = CodeSection::new();
for (_word_id, body) in words {
let num_locals = 1 + count_scratch_locals(body);
let scratch_count = count_scratch_locals(body);
let forth_local_count = count_forth_locals(body);
let num_locals = 1 + scratch_count + forth_local_count;
let has_floats = needs_f64_locals(body);
let num_f64: u32 = if has_floats { 2 } else { 0 };
let mut locals_decl = vec![(num_locals, ValType::I32)];
@@ -2261,6 +2332,7 @@ fn compile_multi_word_module(
let ctx = EmitCtx {
f64_local_0: num_locals,
f64_local_1: num_locals + 1,
forth_local_base: 1 + scratch_count,
};
// Prologue: cache $dsp global into local 0
crates/core/src/dictionary.rs
+110 -19
View File
@@ -38,8 +38,13 @@ pub struct Dictionary {
here: u32,
/// Next available function table index.
next_fn_index: u32,
/// Hash index for O(1) word lookup: name -> (`word_addr`, `fn_index`, `is_immediate`).
index: HashMap<String, (u32, u32, bool)>,
/// Hash index: name -> Vec of (wid, word_addr, fn_index, is_immediate).
/// Multiple entries per name support different wordlists.
index: HashMap<String, Vec<(u32, u32, u32, bool)>>,
/// Current compilation wordlist ID.
current_wid: u32,
/// Current search order (list of wordlist IDs, first = top).
search_order: Vec<u32>,
}
/// Align an address upward to a 4-byte boundary.
@@ -58,6 +63,8 @@ impl Dictionary {
here: DICTIONARY_BASE,
next_fn_index: 0,
index: HashMap::new(),
current_wid: 1, // FORTH wordlist
search_order: vec![1],
}
}
@@ -116,6 +123,11 @@ impl Dictionary {
Ok(WordId(fn_index))
}
/// Get the next available function index (without consuming it).
pub fn next_fn_index(&self) -> u32 {
self.next_fn_index
}
/// Reserve a function index without creating a dictionary entry.
/// Used for anonymous host functions (e.g., float literals during compilation).
pub fn reserve_fn_index(&mut self) {
@@ -157,15 +169,25 @@ impl Dictionary {
}
}
/// Look up a word by name. Returns (`word_address`, `word_id`, `is_immediate`).
/// Uses the hash index for O(1) lookup, with linked-list fallback.
/// Skips HIDDEN words.
/// Look up a word by name using the current search order.
/// Falls back to searching all wordlists if not found in search order.
pub fn find(&self, name: &str) -> Option<(u32, WordId, bool)> {
let search_name = name.to_ascii_uppercase();
// Fast path: hash index lookup
if let Some(&(word_addr, fn_index, is_immediate)) = self.index.get(&search_name) {
return Some((word_addr, WordId(fn_index), is_immediate));
// Fast path: hash index lookup with search order
if let Some(entries) = self.index.get(&search_name) {
// Search in order: first matching wordlist wins
for &wid in &self.search_order {
for &(w, word_addr, fn_index, is_imm) in entries.iter().rev() {
if w == wid {
return Some((word_addr, WordId(fn_index), is_imm));
}
}
}
// Fallback: return newest entry across all wordlists
if let Some(&(_wid, word_addr, fn_index, is_immediate)) = entries.last() {
return Some((word_addr, WordId(fn_index), is_immediate));
}
}
// Fallback: linked-list walk (for words not yet in the index)
@@ -208,6 +230,41 @@ impl Dictionary {
None
}
/// Look up a word searching only the given wordlist order.
pub fn find_in_order(&self, name: &str, order: &[u32]) -> Option<(u32, WordId, bool)> {
let search_name = name.to_ascii_uppercase();
if let Some(entries) = self.index.get(&search_name) {
for &wid in order {
for &(w, word_addr, fn_index, is_imm) in entries.iter().rev() {
if w == wid {
return Some((word_addr, WordId(fn_index), is_imm));
}
}
}
}
None
}
/// Look up a word in a single wordlist. Used by SEARCH-WORDLIST.
pub fn find_in_wid(&self, name: &str, wid: u32) -> Option<(u32, WordId, bool)> {
self.find_in_order(name, &[wid])
}
/// Get/set the current compilation wordlist.
pub fn current_wid(&self) -> u32 {
self.current_wid
}
/// Set the current compilation wordlist.
pub fn set_current_wid(&mut self, wid: u32) {
self.current_wid = wid;
}
/// Set the search order.
pub fn set_search_order(&mut self, order: &[u32]) {
self.search_order = order.to_vec();
}
/// Get the current HERE pointer.
pub fn here(&self) -> u32 {
self.here
@@ -336,7 +393,7 @@ impl Dictionary {
}
/// Toggle the IMMEDIATE flag on the most recent word.
pub fn toggle_immediate(&mut self) -> WaferResult<()> {
pub fn set_immediate(&mut self) -> WaferResult<()> {
if self.latest == 0 && self.here == DICTIONARY_BASE {
return Err(WaferError::CompileError("no word defined yet".to_string()));
}
@@ -344,7 +401,7 @@ impl Dictionary {
if flags_addr >= self.memory.len() {
return Err(WaferError::InvalidAddress(self.latest + 4));
}
self.memory[flags_addr] ^= flags::IMMEDIATE;
self.memory[flags_addr] |= flags::IMMEDIATE;
// Update the index if the word is visible (not hidden)
if self.memory[flags_addr] & flags::HIDDEN == 0 {
self.update_index(self.latest);
@@ -382,7 +439,14 @@ impl Dictionary {
let is_immediate = flags_byte & flags::IMMEDIATE != 0;
let code_addr = align4(word_addr + 5 + name_len as u32);
let fn_index = self.read_u32_unchecked(code_addr);
self.index.insert(name, (word_addr, fn_index, is_immediate));
let wid = self.current_wid;
let entries = self.index.entry(name).or_default();
// Update existing entry for this wordlist, or add new one
if let Some(entry) = entries.iter_mut().find(|e| e.0 == wid && e.1 == word_addr) {
entry.3 = is_immediate; // update immediate flag
} else {
entries.push((wid, word_addr, fn_index, is_immediate));
}
}
/// Compute the address of the code field for the word at `word_addr`.
@@ -415,6 +479,33 @@ impl Dictionary {
self.memory[a + 3],
])
}
/// Save a snapshot of the dictionary state for MARKER.
pub fn save_state(&self) -> DictionaryState {
DictionaryState {
latest: self.latest,
here: self.here,
next_fn_index: self.next_fn_index,
index: self.index.clone(),
}
}
/// Restore a previously saved dictionary state (for MARKER).
pub fn restore_state(&mut self, state: DictionaryState) {
self.latest = state.latest;
self.here = state.here;
self.next_fn_index = state.next_fn_index;
self.index = state.index;
}
}
/// Snapshot of dictionary state saved by MARKER.
#[derive(Clone)]
pub struct DictionaryState {
latest: u32,
here: u32,
next_fn_index: u32,
index: HashMap<String, Vec<(u32, u32, u32, bool)>>,
}
impl Default for Dictionary {
@@ -514,7 +605,7 @@ mod tests {
}
#[test]
fn toggle_immediate() {
fn set_immediate() {
let mut dict = Dictionary::new();
dict.create("MYWORD", false).unwrap();
dict.reveal();
@@ -523,15 +614,15 @@ mod tests {
let (_, _, is_imm) = dict.find("MYWORD").unwrap();
assert!(!is_imm);
// Toggle to immediate
dict.toggle_immediate().unwrap();
// Set to immediate
dict.set_immediate().unwrap();
let (_, _, is_imm) = dict.find("MYWORD").unwrap();
assert!(is_imm);
// Toggle back
dict.toggle_immediate().unwrap();
// Calling again keeps it immediate (set, not toggle)
dict.set_immediate().unwrap();
let (_, _, is_imm) = dict.find("MYWORD").unwrap();
assert!(!is_imm);
assert!(is_imm);
}
#[test]
@@ -807,9 +898,9 @@ mod tests {
}
#[test]
fn toggle_immediate_no_word_errors() {
fn set_immediate_no_word_errors() {
let mut dict = Dictionary::new();
let result = dict.toggle_immediate();
let result = dict.set_immediate();
assert!(result.is_err());
}
}
crates/core/src/ir.rs
+6
View File
@@ -120,6 +120,12 @@ pub enum IrOp {
/// Copy from return stack: ( -- x ) ( R: x -- x )
RFetch,
// -- Forth locals (from {: ... :} syntax) --
/// Get Forth local variable N: ( -- x )
ForthLocalGet(u32),
/// Set Forth local variable N: ( x -- )
ForthLocalSet(u32),
// -- I/O --
/// Output character: ( char -- )
Emit,
crates/core/src/memory.rs
+13 -1
View File
@@ -31,9 +31,21 @@ pub const PAD_BASE: u32 = INPUT_BUFFER_BASE + INPUT_BUFFER_SIZE; // 0x0440
/// Size of PAD.
pub const PAD_SIZE: u32 = 256;
/// Pictured numeric output buffer (<# ... #>). Grows downward from top.
pub const PICT_BUF_BASE: u32 = PAD_BASE + PAD_SIZE; // 0x0540
/// Size of pictured output buffer (2*BITS_PER_CELL + 2 = 66 min, 128 for margin).
pub const PICT_BUF_SIZE: u32 = 128;
/// Top of pictured output buffer (HLD starts here, grows down).
pub const PICT_BUF_TOP: u32 = PICT_BUF_BASE + PICT_BUF_SIZE;
/// WORD buffer — transient counted-string area for WORD output.
pub const WORD_BUF_BASE: u32 = PICT_BUF_TOP; // 0x05C0
/// Size of WORD buffer (max name 31 + 1 length + padding).
pub const WORD_BUF_SIZE: u32 = 64;
/// Data stack region (fallback when types are unknown).
/// Grows downward from the top of this region.
pub const DATA_STACK_BASE: u32 = PAD_BASE + PAD_SIZE; // 0x0540
pub const DATA_STACK_BASE: u32 = WORD_BUF_BASE + WORD_BUF_SIZE; // 0x0600
/// Size of data stack region.
pub const DATA_STACK_SIZE: u32 = 4096; // 1024 cells
crates/core/src/optimizer.rs
+37
View File
@@ -504,6 +504,7 @@ fn inline(ops: Vec<IrOp>, bodies: &HashMap<WordId, Vec<IrOp>>, max_size: usize)
if let Some(body) = bodies.get(id)
&& body.len() <= max_size
&& !contains_call_to(body, *id)
&& !contains_exit(body)
{
// Inline the body, recursively converting TailCall back to Call
// (tail position in the callee is not tail position in the caller).
@@ -626,6 +627,42 @@ fn contains_call_to(ops: &[IrOp], target: WordId) -> bool {
false
}
/// Check if an IR body contains ops that prevent safe inlining.
/// - `Exit`: WASM `return` would exit the caller's function
/// - `ForthLocalGet/Set`: would collide with the caller's WASM locals
fn contains_exit(ops: &[IrOp]) -> bool {
for op in ops {
match op {
IrOp::Exit | IrOp::ForthLocalGet(_) | IrOp::ForthLocalSet(_) => return true,
IrOp::If {
then_body,
else_body,
} => {
if contains_exit(then_body) {
return true;
}
if let Some(eb) = else_body
&& contains_exit(eb)
{
return true;
}
}
IrOp::DoLoop { body, .. } | IrOp::BeginUntil { body } | IrOp::BeginAgain { body } => {
if contains_exit(body) {
return true;
}
}
IrOp::BeginWhileRepeat { test, body } => {
if contains_exit(test) || contains_exit(body) {
return true;
}
}
_ => {}
}
}
false
}
// ---------------------------------------------------------------------------
// Pass 7: Tail call detection
// ---------------------------------------------------------------------------
crates/core/src/outer.rs
+1022 -86
View File
File diff suppressed because it is too large Load Diff