Replace I/O and pictured output with Forth, add runner host funcs (Phase 5)

Move to boot.fth: TYPE, SPACES, <#, HOLD, HOLDS, SIGN, #, #S, #>,
., U., .R, U.R, D., D.R. The Forth . now uses pictured numeric output
(standard Forth approach) instead of a Rust formatting closure.

Add M*, UM*, UM/MOD host functions to the WASM runner so that the
Forth # word (which calls UM/MOD) works in standalone mode.

Removed 660 lines of Rust closures + 5 dead helper functions.
All 426 tests pass.
This commit is contained in:
2026-04-07 15:25:27 +02:00
parent 0c6c643e07
commit 922708d179
3 changed files with 153 additions and 660 deletions
+65
View File
@@ -148,3 +148,68 @@
: HERE 12 @ ; : HERE 12 @ ;
\ ALIGNED is already an IR primitive in the compiler. \ ALIGNED is already an IR primitive in the compiler.
\ ---------------------------------------------------------------
\ Phase 5: I/O, pictured numeric output, formatted output
\ ---------------------------------------------------------------
\ TYPE ( c-addr u -- ) output u characters
: TYPE 0 ?DO DUP C@ EMIT 1+ LOOP DROP ;
\ SPACES ( n -- ) output n spaces
: SPACES 0 ?DO SPACE LOOP ;
\ Pictured numeric output constants
\ PAD_BASE = 0x0440, PAD_SIZE = 256, SYSVAR_HLD = 28
\ <# ( -- ) begin pictured numeric output
: <# 1344 28 ! ;
\ HOLD ( char -- ) add character to pictured output
: HOLD 28 @ 1- DUP 28 ! C! ;
\ HOLDS ( addr u -- ) add string to pictured output
: HOLDS
BEGIN DUP 0> WHILE
1- 2DUP + C@ HOLD
REPEAT 2DROP ;
\ SIGN ( n -- ) if negative, add '-'
: SIGN 0< IF 45 HOLD THEN ;
\ # ( ud -- ud2 ) extract one digit from ud, convert to char, HOLD it.
\ Double-cell division by BASE using two UM/MODs:
\ First UM/MOD divides (0 ud-hi) by BASE -> rem1, quot-hi
\ Second UM/MOD divides (rem1 ud-lo) by BASE -> digit, quot-lo
: #
BASE @
>R 0 R@ UM/MOD R> SWAP >R
UM/MOD
SWAP DUP 9 > IF 7 + THEN 48 + HOLD
R> ;
\ #S ( ud -- 0 0 ) convert all digits
: #S BEGIN # 2DUP OR 0= UNTIL ;
\ #> ( ud -- c-addr u ) end pictured output, return string
: #> 2DROP 28 @ 1344 OVER - ;
\ Formatted output built on pictured numeric output
\ . ( n -- ) print signed number and space
: . DUP ABS 0 <# #S ROT SIGN #> TYPE SPACE ;
\ U. ( u -- ) print unsigned number and space
: U. 0 <# #S #> TYPE SPACE ;
\ .R ( n width -- ) print right-justified signed number
: .R >R DUP ABS 0 <# #S ROT SIGN #> R> OVER - SPACES TYPE ;
\ U.R ( u width -- ) print right-justified unsigned number
: U.R >R 0 <# #S #> R> OVER - SPACES TYPE ;
\ D. ( d -- ) print signed double number and space
: D. SWAP OVER DABS <# #S ROT SIGN #> TYPE SPACE ;
\ D.R ( d width -- ) print right-justified signed double
: D.R >R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - SPACES TYPE ;
+7 -660
View File
@@ -117,51 +117,6 @@ struct DoesDefinition {
has_create: bool, has_create: bool,
} }
// ---------------------------------------------------------------------------
// ---------------------------------------------------------------------------
// Number formatting helpers
// ---------------------------------------------------------------------------
/// Format a signed integer in the given base, followed by a space.
fn format_signed(value: i32, base: u32) -> String {
if base == 10 {
format!("{value} ")
} else if value < 0 {
let abs = -(value as i64);
format!("-{} ", format_unsigned_digits(abs as u32, base))
} else {
format!("{} ", format_unsigned_digits(value as u32, base))
}
}
/// Format an unsigned integer in the given base, followed by a space.
fn format_unsigned(value: u32, base: u32) -> String {
if base == 10 {
format!("{value} ")
} else {
format!("{} ", format_unsigned_digits(value, base))
}
}
/// Convert an unsigned value to a digit string in the given base.
fn format_unsigned_digits(mut value: u32, base: u32) -> String {
if value == 0 {
return "0".to_string();
}
let mut digits = Vec::new();
while value > 0 {
let rem = (value % base) as u8;
let ch = if rem < 10 {
b'0' + rem
} else {
b'A' + rem - 10
};
digits.push(ch as char);
value /= base;
}
digits.iter().rev().collect()
}
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// ForthVM // ForthVM
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
@@ -2148,16 +2103,14 @@ impl ForthVM {
self.register_immediate_word()?; self.register_immediate_word()?;
self.register_decimal()?; self.register_decimal()?;
self.register_hex()?; self.register_hex()?;
self.register_type_word()?; // TYPE, SPACES: defined in boot.fth
self.register_spaces()?;
self.register_tick()?; self.register_tick()?;
self.register_to_body()?; self.register_to_body()?;
self.register_environment_q()?; self.register_environment_q()?;
self.register_source()?; self.register_source()?;
self.register_abort()?; self.register_abort()?;
// -- I/O: . (dot) needs host function because it does number-to-string -- // . (dot): defined in boot.fth
self.register_dot()?;
self.register_dot_s()?; self.register_dot_s()?;
self.register_depth()?; self.register_depth()?;
@@ -2177,7 +2130,7 @@ impl ForthVM {
// FM/MOD, SM/REM, */, */MOD: defined in boot.fth // FM/MOD, SM/REM, */, */MOD: defined in boot.fth
// U. (unsigned dot) // U. (unsigned dot)
self.register_u_dot()?; // U.: defined in boot.fth
// >NUMBER // >NUMBER
self.register_to_number()?; self.register_to_number()?;
@@ -2201,7 +2154,7 @@ impl ForthVM {
// 2@, 2!: defined in boot.fth // 2@, 2!: defined in boot.fth
// Pictured numeric output // Pictured numeric output
self.register_pictured_numeric()?; // Pictured numeric output (<# # #S #> HOLD SIGN): defined in boot.fth
// Exception word set: CATCH and THROW // Exception word set: CATCH and THROW
self.register_catch_throw()?; self.register_catch_throw()?;
@@ -2235,14 +2188,13 @@ impl ForthVM {
// ERASE: defined in boot.fth // ERASE: defined in boot.fth
// .R and U.R // .R and U.R
self.register_dot_r()?; // .R, U.R: defined in boot.fth
self.register_u_dot_r()?;
// UNUSED // UNUSED
self.register_unused()?; self.register_unused()?;
// HOLDS // HOLDS
self.register_holds()?; // HOLDS: defined in boot.fth
// PARSE as a host function (for compiled code) // PARSE as a host function (for compiled code)
self.register_parse_host()?; self.register_parse_host()?;
@@ -2278,8 +2230,7 @@ impl ForthVM {
// DMAX, DMIN, M+, DU<, 2ROT: defined in boot.fth // DMAX, DMIN, M+, DU<, 2ROT: defined in boot.fth
self.register_d_to_s()?; self.register_d_to_s()?;
self.register_m_star_slash()?; self.register_m_star_slash()?;
self.register_d_dot()?; // D., D.R: defined in boot.fth
self.register_d_dot_r()?;
// -- String word set -- // -- String word set --
self.register_compare()?; self.register_compare()?;
@@ -2303,38 +2254,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// Register the `.` (dot) word as a host function.
fn register_dot(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
if sp >= DATA_STACK_TOP {
return Err(wasmtime::Error::msg("stack underflow"));
}
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let value = i32::from_le_bytes(b);
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + CELL_SIZE) as i32))?;
let s = format_signed(value, base_val);
output.lock().unwrap().push_str(&s);
Ok(())
},
);
self.register_host_primitive(".", false, func)?;
Ok(())
}
/// Register `.S` (print stack without consuming). /// Register `.S` (print stack without consuming).
fn register_dot_s(&mut self) -> anyhow::Result<()> { fn register_dot_s(&mut self) -> anyhow::Result<()> {
let memory = self.memory; let memory = self.memory;
@@ -3311,71 +3230,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// TYPE -- ( c-addr u -- ) output a string from memory.
fn register_type_word(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
// Pop u (length)
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let len = i32::from_le_bytes(b) as usize;
// Pop c-addr
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let addr = i32::from_le_bytes(b) as u32 as usize;
dsp.set(&mut caller, Val::I32((sp + 8) as i32))?;
// Read string from memory and output
if len > 0 {
let data = memory.data(&caller);
if addr.saturating_add(len) > data.len() {
return Err(wasmtime::Error::msg("TYPE: address out of range"));
}
let s = String::from_utf8_lossy(&data[addr..addr + len]).to_string();
output.lock().unwrap().push_str(&s);
}
Ok(())
},
);
self.register_host_primitive("TYPE", false, func)?;
Ok(())
}
/// SPACES -- ( n -- ) output n spaces.
fn register_spaces(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let n = i32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + CELL_SIZE) as i32))?;
if n > 0 {
let spaces = " ".repeat(n as usize);
output.lock().unwrap().push_str(&spaces);
}
Ok(())
},
);
self.register_host_primitive("SPACES", false, func)?;
Ok(())
}
/// ' (tick) in interpret mode -- push the xt (function table index) of the next word. /// ' (tick) in interpret mode -- push the xt (function table index) of the next word.
fn register_tick(&mut self) -> anyhow::Result<()> { fn register_tick(&mut self) -> anyhow::Result<()> {
// Tick is handled as a special token in interpret_token_immediate. // Tick is handled as a special token in interpret_token_immediate.
@@ -4345,36 +4199,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// U. ( u -- ) unsigned dot.
fn register_u_dot(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let value = u32::from_le_bytes(b);
// Read BASE from WASM memory
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + CELL_SIZE) as i32))?;
let s = format_unsigned(value, base_val);
output.lock().unwrap().push_str(&s);
Ok(())
},
);
self.register_host_primitive("U.", false, func)?;
Ok(())
}
/// >NUMBER ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) convert string to number. /// >NUMBER ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) convert string to number.
fn register_to_number(&mut self) -> anyhow::Result<()> { fn register_to_number(&mut self) -> anyhow::Result<()> {
let memory = self.memory; let memory = self.memory;
@@ -4790,240 +4614,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
// -----------------------------------------------------------------------
// Pictured numeric output: <# # #S #> HOLD SIGN
// -----------------------------------------------------------------------
/// Register pictured numeric output words.
fn register_pictured_numeric(&mut self) -> anyhow::Result<()> {
use crate::memory::{PAD_BASE, PAD_SIZE, SYSVAR_HLD};
// <# ( -- ) Initialize pictured numeric output
{
let memory = self.memory;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let data = memory.data_mut(&mut caller);
// HLD points to end of PAD area (we build string backwards)
let hld = PAD_BASE + PAD_SIZE;
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
Ok(())
},
);
self.register_host_primitive("<#", false, func)?;
}
// HOLD ( char -- ) Add character to pictured output
{
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let ch = i32::from_le_bytes(b) as u8;
// Read HLD
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let mut hld = u32::from_le_bytes(b);
hld -= 1;
let data = memory.data_mut(&mut caller);
data[hld as usize] = ch;
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
dsp.set(&mut caller, Val::I32((sp + 4) as i32))?;
Ok(())
},
);
self.register_host_primitive("HOLD", false, func)?;
}
// SIGN ( n -- ) If n is negative, add '-' to pictured output
{
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let n = i32::from_le_bytes(b);
// Pop n
dsp.set(&mut caller, Val::I32((sp + 4) as i32))?;
if n < 0 {
// Add '-' like HOLD would
let data = memory.data(&caller);
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let mut hld = u32::from_le_bytes(b);
hld -= 1;
let data = memory.data_mut(&mut caller);
data[hld as usize] = b'-';
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
}
Ok(())
},
);
self.register_host_primitive("SIGN", false, func)?;
}
// # ( ud1 -- ud2 ) Divide ud by BASE, convert remainder to char, HOLD it
{
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
// ud is on the stack as two cells: hi at sp, lo at sp+4
// Stack: ud-hi at sp (TOS), ud-lo at sp+4
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let ud_hi = u32::from_le_bytes(b) as u64;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let ud_lo = u32::from_le_bytes(b) as u64;
let ud = (ud_hi << 32) | ud_lo;
// Read BASE from WASM memory (not base_cell)
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base = u32::from_le_bytes(b) as u64;
let rem = (ud % base) as u32;
let quot = ud / base;
// Convert remainder to digit character
let ch = if rem < 10 {
b'0' + rem as u8
} else {
b'A' + (rem as u8 - 10)
};
// HOLD the character
let data = memory.data(&caller);
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let mut hld = u32::from_le_bytes(b);
hld -= 1;
let data = memory.data_mut(&mut caller);
data[hld as usize] = ch;
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
// Write quotient back
let new_hi = (quot >> 32) as u32;
let new_lo = quot as u32;
data[sp as usize..sp as usize + 4].copy_from_slice(&new_hi.to_le_bytes());
data[(sp + 4) as usize..(sp + 8) as usize]
.copy_from_slice(&new_lo.to_le_bytes());
Ok(())
},
);
self.register_host_primitive("#", false, func)?;
}
// #S ( ud1 -- 0 0 ) Convert all remaining digits
{
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let ud_hi = u32::from_le_bytes(b) as u64;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let ud_lo = u32::from_le_bytes(b) as u64;
let mut ud = (ud_hi << 32) | ud_lo;
// Read BASE from WASM memory (not base_cell)
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base = u32::from_le_bytes(b) as u64;
loop {
let rem = (ud % base) as u32;
ud /= base;
let ch = if rem < 10 {
b'0' + rem as u8
} else {
b'A' + (rem as u8 - 10)
};
let data = memory.data(&caller);
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let mut hld = u32::from_le_bytes(b);
hld -= 1;
let data = memory.data_mut(&mut caller);
data[hld as usize] = ch;
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
if ud == 0 {
break;
}
}
let data = memory.data_mut(&mut caller);
data[sp as usize..sp as usize + 4].copy_from_slice(&0u32.to_le_bytes());
data[(sp + 4) as usize..(sp + 8) as usize].copy_from_slice(&0u32.to_le_bytes());
Ok(())
},
);
self.register_host_primitive("#S", false, func)?;
}
// #> ( xd -- c-addr u ) Finish pictured output, return string
{
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
// Drop the double-cell, read HLD
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let hld = u32::from_le_bytes(b);
let end = PAD_BASE + PAD_SIZE;
let len = end - hld;
// Replace the double on stack with (c-addr u)
let data = memory.data_mut(&mut caller);
data[(sp + 4) as usize..(sp + 8) as usize]
.copy_from_slice(&(hld as i32).to_le_bytes());
data[sp as usize..sp as usize + 4].copy_from_slice(&(len as i32).to_le_bytes());
Ok(())
},
);
self.register_host_primitive("#>", false, func)?;
}
Ok(())
}
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Improved SOURCE // Improved SOURCE
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@@ -5153,89 +4743,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// .R ( n width -- ) right-justified signed number output.
fn register_dot_r(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let width = i32::from_le_bytes(b) as usize;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let n = i32::from_le_bytes(b);
// Read BASE
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + 8) as i32))?;
// Format number without trailing space
let s = format_signed(n, base_val);
let s = s.trim_end(); // remove trailing space
let mut out = output.lock().unwrap();
if s.len() < width {
for _ in 0..width - s.len() {
out.push(' ');
}
}
out.push_str(s);
Ok(())
},
);
self.register_host_primitive(".R", false, func)?;
Ok(())
}
/// U.R ( u width -- ) right-justified unsigned number output.
fn register_u_dot_r(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let width = i32::from_le_bytes(b) as usize;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let u = u32::from_le_bytes(b);
// Read BASE
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + 8) as i32))?;
let s = format_unsigned(u, base_val);
let s = s.trim_end();
let mut out = output.lock().unwrap();
if s.len() < width {
for _ in 0..width - s.len() {
out.push(' ');
}
}
out.push_str(s);
Ok(())
},
);
self.register_host_primitive("U.R", false, func)?;
Ok(())
}
/// UNUSED ( -- u ) return available dictionary space. /// UNUSED ( -- u ) return available dictionary space.
fn register_unused(&mut self) -> anyhow::Result<()> { fn register_unused(&mut self) -> anyhow::Result<()> {
let memory = self.memory; let memory = self.memory;
@@ -5266,47 +4773,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// HOLDS ( c-addr u -- ) add string to pictured output.
fn register_holds(&mut self) -> anyhow::Result<()> {
use crate::memory::SYSVAR_HLD;
let memory = self.memory;
let dsp = self.dsp;
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let u = i32::from_le_bytes(b) as usize;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let c_addr = i32::from_le_bytes(b) as usize;
// Read HLD
let b: [u8; 4] = data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.try_into()
.unwrap();
let mut hld = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + 8) as i32))?;
// Add string to pictured output (backwards)
let data = memory.data_mut(&mut caller);
for i in (0..u).rev() {
hld -= 1;
data[hld as usize] = data[c_addr + i];
}
data[SYSVAR_HLD as usize..SYSVAR_HLD as usize + 4]
.copy_from_slice(&hld.to_le_bytes());
Ok(())
},
);
self.register_host_primitive("HOLDS", false, func)?;
Ok(())
}
/// PARSE as a host function for compiled code. /// PARSE as a host function for compiled code.
fn register_parse_host(&mut self) -> anyhow::Result<()> { fn register_parse_host(&mut self) -> anyhow::Result<()> {
let pending = Arc::clone(&self.pending_define); let pending = Arc::clone(&self.pending_define);
@@ -5504,88 +4970,6 @@ impl ForthVM {
Ok(()) Ok(())
} }
/// D. ( d -- ) print double-cell number.
fn register_d_dot(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let hi = i32::from_le_bytes(b) as i64;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let lo = u32::from_le_bytes(b) as i64;
let d = (hi << 32) | (lo & 0xFFFF_FFFF);
// Read BASE
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + 8) as i32))?;
let s = format_signed_64(d, base_val);
output.lock().unwrap().push_str(&s);
Ok(())
},
);
self.register_host_primitive("D.", false, func)?;
Ok(())
}
/// D.R ( d width -- ) right-justified double-cell number output.
fn register_d_dot_r(&mut self) -> anyhow::Result<()> {
let memory = self.memory;
let dsp = self.dsp;
let output = Arc::clone(&self.output);
let func = Func::new(
&mut self.store,
FuncType::new(&self.engine, [], []),
move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let data = memory.data(&caller);
// Stack: width(sp), d-hi(sp+4), d-lo(sp+8)
let b: [u8; 4] = data[sp as usize..sp as usize + 4].try_into().unwrap();
let width = i32::from_le_bytes(b) as usize;
let b: [u8; 4] = data[(sp + 4) as usize..(sp + 8) as usize]
.try_into()
.unwrap();
let hi = i32::from_le_bytes(b) as i64;
let b: [u8; 4] = data[(sp + 8) as usize..(sp + 12) as usize]
.try_into()
.unwrap();
let lo = u32::from_le_bytes(b) as i64;
let d = (hi << 32) | (lo & 0xFFFF_FFFF);
// Read BASE
let b: [u8; 4] = data[SYSVAR_BASE_VAR as usize..SYSVAR_BASE_VAR as usize + 4]
.try_into()
.unwrap();
let base_val = u32::from_le_bytes(b);
dsp.set(&mut caller, Val::I32((sp + 12) as i32))?;
let s = format_signed_64(d, base_val);
let s = s.trim_end();
let mut out = output.lock().unwrap();
if s.len() < width {
for _ in 0..width - s.len() {
out.push(' ');
}
}
out.push_str(s);
Ok(())
},
);
self.register_host_primitive("D.R", false, func)?;
Ok(())
}
/// 2CONSTANT ( x1 x2 "name" -- ) define a double-cell constant. /// 2CONSTANT ( x1 x2 "name" -- ) define a double-cell constant.
fn define_2constant(&mut self) -> anyhow::Result<()> { fn define_2constant(&mut self) -> anyhow::Result<()> {
let name = self let name = self
@@ -7105,43 +6489,6 @@ fn represent_float(val: f64, buf_len: usize) -> (String, i32, bool, bool) {
(padded, exp, is_negative, true) (padded, exp, is_negative, true)
} }
/// Format a signed 64-bit integer in the given base, followed by a space.
fn format_signed_64(value: i64, base: u32) -> String {
if base == 10 {
format!("{value} ")
} else if value < 0 {
let abs = if value == i64::MIN {
// Handle overflow: i64::MIN cannot be negated
(value as u64).to_string()
} else {
format_unsigned_digits_64((-value) as u64, base)
};
format!("-{abs} ")
} else {
format!("{} ", format_unsigned_digits_64(value as u64, base))
}
}
/// Convert an unsigned 64-bit value to a digit string in the given base.
fn format_unsigned_digits_64(mut value: u64, base: u32) -> String {
if value == 0 {
return "0".to_string();
}
let mut digits = Vec::new();
let base = base as u64;
while value > 0 {
let rem = (value % base) as u8;
let ch = if rem < 10 {
b'0' + rem
} else {
b'A' + rem - 10
};
digits.push(ch as char);
value /= base;
}
digits.iter().rev().collect()
}
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// Tests // Tests
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
+81
View File
@@ -270,6 +270,87 @@ fn create_host_func(
}) })
} }
"M*" => {
// ( n1 n2 -- d ) signed multiply producing double-cell result
Func::new(store, void_type, move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let (n1, n2) = {
let data = memory.data(&caller);
let n2 =
i32::from_le_bytes(data[sp as usize..sp as usize + 4].try_into().unwrap())
as i64;
let n1 = i32::from_le_bytes(
data[sp as usize + 4..sp as usize + 8].try_into().unwrap(),
) as i64;
(n1, n2)
};
let result = n1 * n2;
let lo = result as i32;
let hi = (result >> 32) as i32;
let data = memory.data_mut(&mut caller);
data[sp as usize + 4..sp as usize + 8].copy_from_slice(&lo.to_le_bytes());
data[sp as usize..sp as usize + 4].copy_from_slice(&hi.to_le_bytes());
Ok(())
})
}
"UM*" => {
// ( u1 u2 -- ud ) unsigned multiply producing double-cell result
Func::new(store, void_type, move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let (u1, u2) = {
let data = memory.data(&caller);
let u2 =
u32::from_le_bytes(data[sp as usize..sp as usize + 4].try_into().unwrap())
as u64;
let u1 = u32::from_le_bytes(
data[sp as usize + 4..sp as usize + 8].try_into().unwrap(),
) as u64;
(u1, u2)
};
let result = u1 * u2;
let lo = result as u32;
let hi = (result >> 32) as u32;
let data = memory.data_mut(&mut caller);
data[sp as usize + 4..sp as usize + 8].copy_from_slice(&lo.to_le_bytes());
data[sp as usize..sp as usize + 4].copy_from_slice(&hi.to_le_bytes());
Ok(())
})
}
"UM/MOD" => {
// ( ud u -- rem quot ) unsigned double-cell divide
Func::new(store, void_type, move |mut caller, _params, _results| {
let sp = dsp.get(&mut caller).unwrap_i32() as u32;
let (dividend, divisor) = {
let data = memory.data(&caller);
let divisor =
u32::from_le_bytes(data[sp as usize..sp as usize + 4].try_into().unwrap())
as u64;
let hi = u32::from_le_bytes(
data[sp as usize + 4..sp as usize + 8].try_into().unwrap(),
) as u64;
let lo = u32::from_le_bytes(
data[sp as usize + 8..sp as usize + 12].try_into().unwrap(),
) as u64;
((hi << 32) | lo, divisor)
};
if divisor == 0 {
anyhow::bail!("division by zero");
}
let quot = (dividend / divisor) as u32;
let rem = (dividend % divisor) as u32;
let new_sp = sp + CELL_SIZE;
let data = memory.data_mut(&mut caller);
data[new_sp as usize + 4..new_sp as usize + 8]
.copy_from_slice(&(rem as i32).to_le_bytes());
data[new_sp as usize..new_sp as usize + 4]
.copy_from_slice(&(quot as i32).to_le_bytes());
dsp.set(&mut caller, Val::I32(new_sp as i32))?;
Ok(())
})
}
"DEPTH" => { "DEPTH" => {
// ( -- n ) push current stack depth // ( -- n ) push current stack depth
Func::new(store, void_type, move |mut caller, _params, _results| { Func::new(store, void_type, move |mut caller, _params, _results| {