10 Commits

Author SHA1 Message Date
Oleksandr Kozachuk 9b10723a95 Merge pull request #4 from ok2/fix/web-error-messages
CI / check (push) Has been cancelled
fix(web): surface Forth messages from host-word throws
2026-08-06 20:46:11 +02:00
Oleksandr Kozachuk 15f8005b6d Merge pull request #3 from ok2/fix/release-strip-breaks-proc-macros
fix(build): exempt build scripts and proc-macros from release strip
2026-08-06 20:46:08 +02:00
Oleksandr Kozachuk 4769987b20 fix(web): surface Forth messages from host-word throws
A host word signals failure by throwing across the JS boundary, and the
browser runtime reported that exception with its Debug form, so an
empty-stack RESIZE surfaced as

    call_func(134) failed: JsValue(Error: Stack underflow ...)

with the engine's JS stack trace glued on. The thrown message IS the
Forth message, so take it verbatim: 'Stack underflow', the same text the
native CLI prints. Exceptions without a message keep the call context --
those are genuine runtime faults, not Forth throws.

CATCH is unaffected: it reads the throw code from its own channel rather
than parsing messages. Verified against a fresh VM in Node (initSync +
WaferRepl): host-word underflow, compiled-guard underflow, THROW,
unknown word and ' RESIZE CATCH . all match the native CLI.

Ships as v0.2.4.
2026-08-06 20:45:27 +02:00
Oleksandr Kozachuk d55a27873e fix(build): exempt build scripts and proc-macros from release strip
`wasm-pack build --release` died with "can't find crate" for rustversion,
then thiserror_impl, then every other proc-macro. Cargo strips debuginfo
from release artifacts by default and on macOS that takes the metadata
proc-macro dylibs need to be loadable with it, so rustc could no longer
open them.

Debug builds are unstripped, which is why the whole test suite stayed
green while the browser REPL could not be built for production at all.

Stripping buys nothing for build scripts and proc-macros, so
[profile.release.build-override] exempts them; release binaries stay
stripped.

Also pins wafer-core to 0.2.3 in wafer-web and wafer-cli — both still
asked for 0.2.1. The caret requirement resolved, so nothing broke.
2026-08-06 20:16:41 +02:00
Oleksandr Kozachuk 645b00d6e8 Merge pull request #2 from ok2/feature/swiftforth-number-conversion
feat(core): SwiftForth input number conversion, DPL and NH
2026-08-06 19:57:04 +02:00
Oleksandr Kozachuk 9efb92ddc8 docs(core): correct sign handling note in number conversion docs
The doc comments still claimed a leading + binds as a sign. It does not:
sf64 converts +7 as the double 7 with DPL 1, and the code follows that.
Only a leading - is a sign.
2026-08-06 19:25:48 +02:00
Oleksandr Kozachuk 706c73ce2a feat(core): SwiftForth input number conversion, DPL and NH
Punctuation (`,` `.` `+` `/` `:` and an embedded `-`) after the leftmost
digit now forces double-cell conversion, so `12.34`, `1,234`, `12:30:45`
and `2026-08-06` convert as doubles. Only a trailing `.` worked before,
and `1.5` was an "unknown word" error.

The punctuation is a double-cell marker, not a fractional point, so the
scale has to travel separately: DPL carries the digit count right of the
rightmost punctuation character (negative when there was none), which is
what lets `<# #>` place the point back on output. NH carries the high
cell a single-cell conversion drops, so a token that overflows a cell is
still recoverable as a double.

parse_number and parse_double_number duplicated the prefix and sign
handling and could not share a DPL counter, so they collapse into one
parse_numeric_literal that reports which kind it converted.

Verified token-for-token against sf64. One deliberate divergence: WAFER
keeps accepting a sign before a base prefix (`-$FF`), which sf64 rejects.
2026-08-06 19:19:41 +02:00
Oleksandr Kozachuk a89d7ca704 chore(ci): dprint-format changelog; dedupe sha crates; deny skips for wasmtime 47
CI / check (push) Has been cancelled
2026-08-06 16:15:02 +02:00
Oleksandr Kozachuk 20b8754e27 chore(release): v0.2.1 — changelog + version bump
CI / check (push) Has been cancelled
2026-08-06 16:05:02 +02:00
Oleksandr Kozachuk 17852ed459 fix(core): search order is authoritative; host words validate stack args
- Dictionary::find no longer falls back to the newest entry across all
  wordlists when the search order has no match (Forth 2012 16.3.3;
  gforth and SwiftForth agree). Cross-engine corpus program guards it.
- ~40 argument-taking host words (RND-SEED, ACCEPT, RESIZE, ALLOCATE,
  SEARCH, SUBSTITUTE, ROLL, M*, UM/MOD, SF@/SF!/DF@/DF!, F./FE./FS./F~,
  2R@, ...) popped or read stack cells with no underflow check; on an
  empty stack the pointer silently drifted past its base. New host_need/
  host_fneed/host_fpop checked helpers; class-wide regression test
  drives every word on an empty stack.
2026-08-06 16:04:58 +02:00
13 changed files with 654 additions and 281 deletions
+80 -1
View File
@@ -5,6 +5,84 @@ All notable changes to WAFER are documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.2.4] - 2026-08-06
### Fixed
- **Errors from host words in the browser build read like Forth errors
again.** A host word signals failure by throwing across the JS
boundary, and the browser runtime reported the exception with its
`Debug` form, so an empty-stack `RESIZE` came back as
`call_func(134) failed: JsValue(Error: Stack underflow ...)` trailed by
an engine stack trace. The thrown message is the Forth message, so it
is now surfaced verbatim — `Stack underflow`, exactly what the native
CLI prints. Exceptions that carry no message keep the call context,
since those are genuine runtime faults rather than Forth throws.
`CATCH` was never affected: it reads the throw code from its own
channel, not from the message.
## [0.2.3] - 2026-08-06
### Fixed
- **Release builds of `wafer-web` no longer fail on proc-macro loading.**
Cargo strips debuginfo from release artifacts by default, and on macOS
that also strips the metadata proc-macro dylibs need to be loadable, so
`wasm-pack build --release` died with `can't find crate` for
`rustversion`, `thiserror_impl` and every other proc-macro. Build
scripts and proc-macros gain nothing from stripping, so
`[profile.release.build-override]` now exempts them; release binaries
stay stripped. Debug builds were never affected, which is why the test
suite stayed green while the browser REPL could not be built for
production.
- `wafer-web` and `wafer-cli` requested `wafer-core` version `0.2.1`
while the workspace had moved to `0.2.2`. The caret requirement still
resolved, so nothing broke, but the pin is now kept in step.
## [0.2.2] - 2026-08-06
### Added
- **SwiftForth-style input number conversion.** Punctuation (`,` `.` `+`
`/` `:` and an embedded `-`) anywhere after the leftmost digit now forces
double-cell conversion, so `12.34`, `1,234`, `12:30:45` and `2026-08-06`
all convert as doubles without a custom parser. Previously only a
trailing `.` worked and `1.5` was an "unknown word" error. The
punctuation is a double-cell marker, not a fractional point: every
spelling of `1234` (`1234.`, `123.4`, `.1234`) yields the same value.
- **`DPL`** ( -- addr ): digits to the right of the rightmost punctuation
character in the last converted number, negative when the token carried
none. Seeded at -1024 and bumped once per digit, matching `sf64`.
Together with `<# #>` this is how fixed-point input is scaled.
- **`NH`** ( -- addr ): the high-order cell dropped by a single-cell
conversion, so a token that overflows a cell can be recovered as a
double (`4000000000 NH @ D.`).
Verified token-for-token against SwiftForth `sf64`: DPL values, double
promotion and sign handling agree on every probed form. One deliberate
divergence — WAFER also accepts a sign before a base prefix (`-$FF`), which
`sf64` rejects; the Forth 2012 spelling `$-FF` works in both. A leading `+`
is punctuation rather than a sign in both engines, so `+7` is the double 7
with `DPL` = 1.
## [0.2.1] - 2026-08-06
### Fixed
- **The search order is now authoritative** (Forth 2012 §16.3.3): a word
whose wordlist is not in the search order is no longer findable.
Previously lookup fell back to the newest entry across all wordlists,
making word hiding impossible. Verified against gforth and SwiftForth,
and guarded by a cross-engine corpus program.
- **Host words validate their stack arguments.** Around 40 host-implemented
words (`RND-SEED`, `ACCEPT`, `RESIZE`, `ALLOCATE`, `FREE`, `SEARCH`,
`SUBSTITUTE`, `ROLL`, `M*`, `UM/MOD`, `SF@ SF! DF@ DF!`, `F. FE. FS. F~`,
`2R@`, and friends) performed raw stack-pointer arithmetic with no
underflow check — calling them on an empty stack silently corrupted the
stack pointer (the compiled-code guards from 0.2.0 do not cover host
words). All argument-taking host words now fail with a clean, CATCHable
underflow error, enforced by a class-wide regression test.
## [0.2.0] - 2026-08-06 ## [0.2.0] - 2026-08-06
The usability release: introspection, source files, honest errors, and a The usability release: introspection, source files, honest errors, and a
@@ -60,7 +138,7 @@ safety net under every compiled word.
### Fixed ### Fixed
- Multi-line command output in the CLI REPL starts on its own line - Multi-line command output in the CLI REPL starts on its own line
(inline ` ok` echo only for single-line output). (inline `ok` echo only for single-line output).
- `.S` printed in decimal regardless of `BASE`. - `.S` printed in decimal regardless of `BASE`.
- A bare interpreted `R>` underflowed silently (exposed by the new stack - A bare interpreted `R>` underflowed silently (exposed by the new stack
guards; compliance baseline updated). guards; compliance baseline updated).
@@ -86,5 +164,6 @@ compliance suite, `CONSOLIDATE` whole-program recompilation, `wafer build`
AOT export (WASM / native / JS loader), browser REPL, SHA-1/256/512 words, AOT export (WASM / native / JS loader), browser REPL, SHA-1/256/512 words,
and cross-engine benchmark lanes against gforth and SwiftForth. and cross-engine benchmark lanes against gforth and SwiftForth.
[0.2.1]: https://github.com/ok2/wafer/compare/v0.2.0...v0.2.1
[0.2.0]: https://github.com/ok2/wafer/compare/v0.1.0...v0.2.0 [0.2.0]: https://github.com/ok2/wafer/compare/v0.1.0...v0.2.0
[0.1.0]: https://github.com/ok2/wafer/releases/tag/v0.1.0 [0.1.0]: https://github.com/ok2/wafer/releases/tag/v0.1.0
+1 -1
View File
@@ -79,7 +79,7 @@ Handle in `interpret_token_immediate()` or `compile_token()` as a special case.
## Testing ## Testing
- Run `cargo test --workspace` before committing (currently 542 unit + 1 benchmark + 11 compliance + 9 comparison + 5 crypto) - Run `cargo test --workspace` before committing (currently 562 unit + 1 benchmark + 11 compliance + 9 comparison + 5 crypto)
- Forth 2012 compliance: `cargo test -p wafer-core --test compliance` - Forth 2012 compliance: `cargo test -p wafer-core --test compliance`
- Cross-engine comparison (vs gforth): `cargo test -p wafer-core --test comparison` - Cross-engine comparison (vs gforth): `cargo test -p wafer-core --test comparison`
- Performance benchmarks (release mode): `cargo test -p wafer-core --test comparison -- --nocapture --ignored` - Performance benchmarks (release mode): `cargo test -p wafer-core --test comparison -- --nocapture --ignored`
Generated
+23 -87
View File
@@ -132,15 +132,6 @@ dependencies = [
"generic-array", "generic-array",
] ]
[[package]]
name = "block-buffer"
version = "0.12.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d2f6c7dbe95a6ed67ad9f18e57daf93a2f034c524b99fd2b76d18fdfeb6660aa"
dependencies = [
"hybrid-array",
]
[[package]] [[package]]
name = "bumpalo" name = "bumpalo"
version = "3.20.3" version = "3.20.3"
@@ -182,9 +173,9 @@ checksum = "f079e83a288787bcd14a6aea84cee5c87a67c5a3e660c30f557a3d24761b3527"
[[package]] [[package]]
name = "clap" name = "clap"
version = "4.6.5" version = "4.6.6"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "301b56658598e48f3648647ac6fc887be7e7108eddfa4e9b63fcf3ec58c0cadf" checksum = "473c7e07f409a8d772161724aa8db6a765a2532a70f9667eeb7b49d3d02fbdca"
dependencies = [ dependencies = [
"clap_builder", "clap_builder",
"clap_derive", "clap_derive",
@@ -192,9 +183,9 @@ dependencies = [
[[package]] [[package]]
name = "clap_builder" name = "clap_builder"
version = "4.6.5" version = "4.6.6"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "94a65403d1a1bd28f7dc68eb8506e8874808ee5eecb59298de588e2e1407a078" checksum = "7b48fea5a88e9ae728a2dcbedbfc0e730f7d60da42e1cb049a83c9fb8b789889"
dependencies = [ dependencies = [
"anstream", "anstream",
"anstyle", "anstyle",
@@ -255,12 +246,6 @@ dependencies = [
"windows-sys", "windows-sys",
] ]
[[package]]
name = "const-oid"
version = "0.10.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a6ef517f0926dd24a1582492c791b6a4818a4d94e789a334894aa15b0d12f55c"
[[package]] [[package]]
name = "cpp_demangle" name = "cpp_demangle"
version = "0.5.1" version = "0.5.1"
@@ -279,15 +264,6 @@ dependencies = [
"libc", "libc",
] ]
[[package]]
name = "cpufeatures"
version = "0.3.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8b2a41393f66f16b0823bb79094d54ac5fbd34ab292ddafb9a0456ac9f87d201"
dependencies = [
"libc",
]
[[package]] [[package]]
name = "cranelift-assembler-x64" name = "cranelift-assembler-x64"
version = "0.134.3" version = "0.134.3"
@@ -352,7 +328,7 @@ dependencies = [
"rustc-hash", "rustc-hash",
"serde", "serde",
"serde_derive", "serde_derive",
"sha2 0.10.9", "sha2",
"smallvec", "smallvec",
"target-lexicon", "target-lexicon",
"wasmtime-internal-core", "wasmtime-internal-core",
@@ -478,15 +454,6 @@ dependencies = [
"typenum", "typenum",
] ]
[[package]]
name = "crypto-common"
version = "0.2.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ce6e4c961d6cd6c9a86db418387425e8bdeaf05b3c8bc1411e6dca4c252f1453"
dependencies = [
"hybrid-array",
]
[[package]] [[package]]
name = "debugid" name = "debugid"
version = "0.8.0" version = "0.8.0"
@@ -502,19 +469,8 @@ version = "0.10.7"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9ed9a281f7bc9b7576e61468ba615a66a5c8cfdff42420a70aa82701a3b1e292" checksum = "9ed9a281f7bc9b7576e61468ba615a66a5c8cfdff42420a70aa82701a3b1e292"
dependencies = [ dependencies = [
"block-buffer 0.10.4", "block-buffer",
"crypto-common 0.1.7", "crypto-common",
]
[[package]]
name = "digest"
version = "0.11.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f1dd6dbb5841937940781866fa1281a1ff7bd3bf827091440879f9994983d5c2"
dependencies = [
"block-buffer 0.12.1",
"const-oid",
"crypto-common 0.2.2",
] ]
[[package]] [[package]]
@@ -795,15 +751,6 @@ dependencies = [
"windows-sys", "windows-sys",
] ]
[[package]]
name = "hybrid-array"
version = "0.4.14"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "707114b52a152fa7bdb290cd7cd5912d9467273b6d74e21b8d81aca1f8533f6b"
dependencies = [
"typenum",
]
[[package]] [[package]]
name = "id-arena" name = "id-arena"
version = "2.3.0" version = "2.3.0"
@@ -1400,13 +1347,13 @@ dependencies = [
[[package]] [[package]]
name = "sha1" name = "sha1"
version = "0.11.0" version = "0.10.7"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "aacc4cc499359472b4abe1bf11d0b12e688af9a805fa5e3016f9a386dc2d0214" checksum = "a978451301f4db1d02937a4ab3ccce137717b81826e79b7d49ffe3244a13c3b8"
dependencies = [ dependencies = [
"cfg-if", "cfg-if",
"cpufeatures 0.3.0", "cpufeatures",
"digest 0.11.3", "digest",
] ]
[[package]] [[package]]
@@ -1416,19 +1363,8 @@ source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a7507d819769d01a365ab707794a4084392c824f54a7a6a7862f8c3d0892b283" checksum = "a7507d819769d01a365ab707794a4084392c824f54a7a6a7862f8c3d0892b283"
dependencies = [ dependencies = [
"cfg-if", "cfg-if",
"cpufeatures 0.2.17", "cpufeatures",
"digest 0.10.7", "digest",
]
[[package]]
name = "sha2"
version = "0.11.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "446ba717509524cb3f22f17ecc096f10f4822d76ab5c0b9822c5f9c284e825f4"
dependencies = [
"cfg-if",
"cpufeatures 0.3.0",
"digest 0.11.3",
] ]
[[package]] [[package]]
@@ -1653,7 +1589,7 @@ checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a"
[[package]] [[package]]
name = "wafer" name = "wafer"
version = "0.2.0" version = "0.2.4"
dependencies = [ dependencies = [
"anyhow", "anyhow",
"clap", "clap",
@@ -1664,13 +1600,13 @@ dependencies = [
[[package]] [[package]]
name = "wafer-core" name = "wafer-core"
version = "0.2.0" version = "0.2.4"
dependencies = [ dependencies = [
"anyhow", "anyhow",
"insta", "insta",
"proptest", "proptest",
"sha1", "sha1",
"sha2 0.11.0", "sha2",
"thiserror 2.0.19", "thiserror 2.0.19",
"wasm-encoder 0.255.0", "wasm-encoder 0.255.0",
"wasmparser 0.255.0", "wasmparser 0.255.0",
@@ -1679,7 +1615,7 @@ dependencies = [
[[package]] [[package]]
name = "wafer-web" name = "wafer-web"
version = "0.2.0" version = "0.2.4"
dependencies = [ dependencies = [
"anyhow", "anyhow",
"js-sys", "js-sys",
@@ -1966,7 +1902,7 @@ dependencies = [
"semver", "semver",
"serde", "serde",
"serde_derive", "serde_derive",
"sha2 0.10.9", "sha2",
"smallvec", "smallvec",
"target-lexicon", "target-lexicon",
"wasm-encoder 0.252.0", "wasm-encoder 0.252.0",
@@ -1989,7 +1925,7 @@ dependencies = [
"rustix", "rustix",
"serde", "serde",
"serde_derive", "serde_derive",
"sha2 0.10.9", "sha2",
"toml", "toml",
"wasmtime-environ", "wasmtime-environ",
"windows-sys", "windows-sys",
@@ -2239,18 +2175,18 @@ dependencies = [
[[package]] [[package]]
name = "zerocopy" name = "zerocopy"
version = "0.8.55" version = "0.8.56"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b5a105cd7b140f6eeec8acff2ea38135d3cab283ada58540f629fe51e46696eb" checksum = "556764e583adb45a9f8d413c2a147fa7e8d821e48e12b14fd560b607998b75eb"
dependencies = [ dependencies = [
"zerocopy-derive", "zerocopy-derive",
] ]
[[package]] [[package]]
name = "zerocopy-derive" name = "zerocopy-derive"
version = "0.8.55" version = "0.8.56"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0fe976fb70c78cd64cccfe3a6fc142244e8a77b70959b30faf9d0ac37ee228eb" checksum = "f2ab42fc20575779bd240faa45f94a74256f755c0fa9e89f0ede20d91d0cdfc1"
dependencies = [ dependencies = [
"proc-macro2", "proc-macro2",
"quote", "quote",
+11 -3
View File
@@ -3,7 +3,7 @@ members = ["crates/*"]
resolver = "2" resolver = "2"
[workspace.package] [workspace.package]
version = "0.2.0" version = "0.2.4"
edition = "2024" edition = "2024"
license = "MIT OR Apache-2.0" license = "MIT OR Apache-2.0"
repository = "https://github.com/ok2/wafer" repository = "https://github.com/ok2/wafer"
@@ -48,6 +48,14 @@ anyhow = "1"
thiserror = "2" thiserror = "2"
proptest = "1" proptest = "1"
insta = "1" insta = "1"
sha1 = "0.11" sha1 = "0.10"
sha2 = "0.11" sha2 = "0.10"
send_wrapper = "0.6" send_wrapper = "0.6"
# Cargo strips debuginfo from release artifacts by default, and on macOS that
# also strips the metadata proc-macro dylibs need to be loadable — release
# builds then fail with "can't find crate" for every proc-macro (rustversion,
# thiserror_impl, ...). Build scripts and proc-macros gain nothing from
# stripping, so exempt them; the release binaries stay stripped.
[profile.release.build-override]
strip = false
+1 -1
View File
@@ -9,7 +9,7 @@ license.workspace = true
workspace = true workspace = true
[dependencies] [dependencies]
wafer-core = { path = "../core", version = "0.2.0" } wafer-core = { path = "../core", version = "0.2.4" }
wasmtime = { workspace = true } wasmtime = { workspace = true }
anyhow = { workspace = true } anyhow = { workspace = true }
clap = { version = "4", features = ["derive"] } clap = { version = "4", features = ["derive"] }
+3 -4
View File
@@ -192,10 +192,9 @@ impl Dictionary {
} }
} }
} }
// Fallback: return newest entry across all wordlists // In no wordlist of the search order: not findable
if let Some(&(_wid, word_addr, fn_index, is_immediate)) = entries.last() { // (Forth 2012 §16.3.3 — the order is authoritative).
return Some((word_addr, WordId(fn_index), is_immediate)); return None;
}
} }
// Fallback: linked-list walk (for words not yet in the index) // Fallback: linked-list walk (for words not yet in the index)
+20
View File
@@ -108,6 +108,23 @@ pub const SYSVAR_HLD: u32 = SYSVAR_BASE + 28;
pub const SYSVAR_LEAVE_FLAG: u32 = SYSVAR_BASE + 32; pub const SYSVAR_LEAVE_FLAG: u32 = SYSVAR_BASE + 32;
/// Throw code left by a compiled stack-guard fault for `_STACK_FAULT_`. /// Throw code left by a compiled stack-guard fault for `_STACK_FAULT_`.
pub const SYSVAR_FAULT_CODE: u32 = SYSVAR_BASE + 36; pub const SYSVAR_FAULT_CODE: u32 = SYSVAR_BASE + 36;
/// DPL: digits right of the rightmost punctuation in the last converted
/// number; negative when the token carried no punctuation.
pub const SYSVAR_DPL: u32 = SYSVAR_BASE + 40;
/// NH: high-order cell of the last single-cell conversion, so an
/// out-of-range token can be recovered as a double.
pub const SYSVAR_NH: u32 = SYSVAR_BASE + 44;
/// Seed for [`SYSVAR_DPL`] before conversion starts.
///
/// `SwiftForth` seeds DPL with a negative value and bumps it once per digit,
/// so an unpunctuated token still ends up negative. Punctuation resets the
/// counter to zero, which makes the final value the digit count right of the
/// rightmost punctuation character.
///
/// The exact seed is observable: `sf64` reports DPL as -1020 after `1234`
/// and -1023 after `-1`, both of which pin it to -1024.
pub const DPL_INIT: i32 = -1024;
#[cfg(test)] #[cfg(test)]
mod tests { mod tests {
@@ -149,6 +166,9 @@ mod tests {
SYSVAR_NUM_TIB, SYSVAR_NUM_TIB,
SYSVAR_HLD, SYSVAR_HLD,
SYSVAR_LEAVE_FLAG, SYSVAR_LEAVE_FLAG,
SYSVAR_FAULT_CODE,
SYSVAR_DPL,
SYSVAR_NH,
]; ];
for offset in all_offsets { for offset in all_offsets {
assert!(offset + CELL_SIZE <= SYSVAR_BASE + SYSVAR_SIZE); assert!(offset + CELL_SIZE <= SYSVAR_BASE + SYSVAR_SIZE);
+460 -171
View File
@@ -23,12 +23,64 @@ use crate::ir::IrOp;
#[cfg(feature = "crypto")] #[cfg(feature = "crypto")]
use crate::memory::HASH_SCRATCH_BASE; use crate::memory::HASH_SCRATCH_BASE;
use crate::memory::{ use crate::memory::{
CELL_SIZE, DATA_STACK_TOP, FLOAT_SIZE, FLOAT_STACK_BASE, FLOAT_STACK_TOP, INPUT_BUFFER_BASE, CELL_SIZE, DATA_STACK_TOP, DPL_INIT, FLOAT_SIZE, FLOAT_STACK_BASE, FLOAT_STACK_TOP,
INPUT_BUFFER_SIZE, RETURN_STACK_TOP, SYSVAR_BASE_VAR, SYSVAR_FAULT_CODE, SYSVAR_HERE, INPUT_BUFFER_BASE, INPUT_BUFFER_SIZE, RETURN_STACK_TOP, SYSVAR_BASE_VAR, SYSVAR_DPL,
SYSVAR_LEAVE_FLAG, SYSVAR_NUM_TIB, SYSVAR_STATE, SYSVAR_TO_IN, SYSVAR_FAULT_CODE, SYSVAR_HERE, SYSVAR_LEAVE_FLAG, SYSVAR_NH, SYSVAR_NUM_TIB, SYSVAR_STATE,
SYSVAR_TO_IN,
}; };
use crate::optimizer::optimize; use crate::optimizer::optimize;
// ---------------------------------------------------------------------------
// Number conversion
// ---------------------------------------------------------------------------
/// Characters that force double-cell conversion, following `SwiftForth`'s
/// input number conversion rules.
///
/// A leading `-` is the one exception: it binds as a sign, which keeps `-1`
/// a single-cell number while `1-2` converts as a double.
const DOUBLE_PUNCTUATION: [u8; 6] = *b",.+-/:";
/// Split a leading minus off a token, returning whether it was negative.
///
/// Only `-` is a sign. A leading `+` stays punctuation, matching `sf64`,
/// where `+7` converts as the double 7 with `DPL` = 1.
///
/// The sign may sit between a base-override prefix and the digits (`$-FF`,
/// the Forth 2012 spelling) or, as a WAFER extension, before the prefix
/// (`-$FF`), so this runs at both positions.
fn strip_sign(s: &str) -> (bool, &str) {
match s.as_bytes().first() {
Some(b'-') => (true, &s[1..]),
_ => (false, s),
}
}
/// A numeric token that converted successfully.
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
struct NumberLiteral {
/// The accumulated 64-bit value, sign applied.
value: i64,
/// Digits right of the rightmost punctuation character. Negative when the
/// token carried no punctuation, which is how `DPL` reports "single-cell".
dpl: i32,
/// Whether punctuation forced double-cell conversion.
is_double: bool,
}
impl NumberLiteral {
/// Low-order cell — the value a single-cell conversion leaves on the stack.
fn lo(self) -> i32 {
self.value as i32
}
/// High-order cell. For a single-cell conversion this is what `NH` holds,
/// letting an out-of-range token be recovered as a double.
fn hi(self) -> i32 {
(self.value >> 32) as i32
}
}
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// Control-flow compilation state // Control-flow compilation state
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
@@ -521,6 +573,40 @@ fn host_pop(ctx: &mut dyn HostAccess) -> anyhow::Result<i32> {
Ok(v) Ok(v)
} }
/// Ensure the data stack holds at least `n` cells; returns the stack
/// pointer for the caller's reads. Host words must check before raw
/// pointer arithmetic — compiled-code guards do not cover them.
fn host_need(ctx: &mut dyn HostAccess, n: u32) -> anyhow::Result<u32> {
let sp = ctx.get_dsp();
match n.checked_mul(CELL_SIZE).and_then(|b| sp.checked_add(b)) {
Some(end) if end <= DATA_STACK_TOP => Ok(sp),
_ => anyhow::bail!("Stack underflow"),
}
}
/// Ensure the float stack holds at least `n` floats; returns the pointer.
fn host_fneed(ctx: &mut dyn HostAccess, n: u32) -> anyhow::Result<u32> {
let sp = ctx.get_fsp();
match n.checked_mul(FLOAT_SIZE).and_then(|b| sp.checked_add(b)) {
Some(end) if end <= FLOAT_STACK_TOP => Ok(sp),
_ => anyhow::bail!("Float stack underflow"),
}
}
/// Checked float-stack pop for host words.
fn host_fpop(ctx: &mut dyn HostAccess) -> anyhow::Result<f64> {
let sp = ctx.get_fsp();
if sp >= FLOAT_STACK_TOP {
anyhow::bail!("Float stack underflow");
}
let bytes: [u8; 8] = ctx
.mem_read_slice(sp, 8)
.try_into()
.map_err(|_| anyhow::anyhow!("float stack read failed"))?;
ctx.set_fsp(sp + FLOAT_SIZE);
Ok(f64::from_le_bytes(bytes))
}
/// Advance past the next `\n` in `buf`, starting at `from`. Returns the /// Advance past the next `\n` in `buf`, starting at `from`. Returns the
/// byte index of the first character on the next line (or `buf.len()` if /// byte index of the first character on the next line (or `buf.len()` if
/// there's no more newline). Used by the `\` line-comment handler per /// there's no more newline). Used by the `\` line-comment handler per
@@ -1160,22 +1246,18 @@ impl<R: Runtime> ForthVM<R> {
return Ok(()); return Ok(());
} }
// Try to parse as double-number (trailing dot) // Try to convert as a number; punctuation makes it double-cell
if let Some((lo, hi)) = self.parse_double_number(token) { if let Some(lit) = self.parse_numeric_literal(token) {
self.push_data_stack(lo)?; self.record_number_conversion(lit);
self.push_data_stack(hi)?; self.push_data_stack(lit.lo())?;
if self.recording_toplevel && self.state == 0 { if self.recording_toplevel && self.state == 0 {
self.toplevel_ir.push(IrOp::PushI32(lo)); self.toplevel_ir.push(IrOp::PushI32(lit.lo()));
self.toplevel_ir.push(IrOp::PushI32(hi));
} }
return Ok(()); if lit.is_double {
} self.push_data_stack(lit.hi())?;
// Try to parse as number
if let Some(n) = self.parse_number(token) {
self.push_data_stack(n)?;
if self.recording_toplevel && self.state == 0 { if self.recording_toplevel && self.state == 0 {
self.toplevel_ir.push(IrOp::PushI32(n)); self.toplevel_ir.push(IrOp::PushI32(lit.hi()));
}
} }
return Ok(()); return Ok(());
} }
@@ -1537,16 +1619,13 @@ impl<R: Runtime> ForthVM<R> {
return Ok(()); return Ok(());
} }
// Try to parse as double-number (trailing dot) // Try to convert as a number; punctuation makes it double-cell
if let Some((lo, hi)) = self.parse_double_number(token) { if let Some(lit) = self.parse_numeric_literal(token) {
self.push_ir(IrOp::PushI32(lo)); self.record_number_conversion(lit);
self.push_ir(IrOp::PushI32(hi)); self.push_ir(IrOp::PushI32(lit.lo()));
return Ok(()); if lit.is_double {
self.push_ir(IrOp::PushI32(lit.hi()));
} }
// Try to parse as number
if let Some(n) = self.parse_number(token) {
self.push_ir(IrOp::PushI32(n));
return Ok(()); return Ok(());
} }
@@ -2697,85 +2776,111 @@ impl<R: Runtime> ForthVM<R> {
// Number parsing // Number parsing
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
/// Try to parse a token as a number. /// Try to convert a token to a number, following `SwiftForth`'s input
fn parse_number(&self, token: &str) -> Option<i32> { /// number conversion rules.
///
/// Punctuation (`,` `.` `+` `-` `/` `:`) forces double-cell conversion, so
/// `12.34`, `1,234`, `12:30:45` and `2026-08-06` all convert as doubles.
/// Only a leading `-` escapes this and binds as a sign, which keeps `-1`
/// single-cell; a leading `+` stays punctuation, so `+7` is the double 7.
///
/// `DPL` counts up once per digit from [`DPL_INIT`] and resets to zero at
/// every punctuation character, so it ends up holding the digit count right
/// of the rightmost punctuation, and stays negative for unpunctuated tokens.
fn parse_numeric_literal(&self, token: &str) -> Option<NumberLiteral> {
let token = token.trim(); let token = token.trim();
if token.is_empty() { if token.is_empty() {
return None; return None;
} }
// Check for negative prefix // A leading sign binds to the number; it is not double punctuation.
let (negative, rest) = if let Some(stripped) = token.strip_prefix('-') { let (neg_outer, rest) = strip_sign(token);
(true, stripped)
} else {
(false, token)
};
if rest.is_empty() { if rest.is_empty() {
return None; return None;
} }
// Parse based on prefix // Character literal: 'x' → ASCII value of x. No digits, so DPL stays
let result = if let Some(hex) = rest.strip_prefix('$') { // at its seed and the result is always single-cell.
i64::from_str_radix(hex, 16).ok() if rest.len() == 3 && rest.as_bytes()[0] == b'\'' && rest.as_bytes()[2] == b'\'' {
} else if let Some(dec) = rest.strip_prefix('#') { let value = i64::from(rest.as_bytes()[1]);
dec.parse::<i64>().ok() return Some(NumberLiteral {
} else if let Some(bin) = rest.strip_prefix('%') { value: if neg_outer { -value } else { value },
i64::from_str_radix(bin, 2).ok() dpl: DPL_INIT,
} else if rest.len() == 3 && rest.as_bytes()[0] == b'\'' && rest.as_bytes()[2] == b'\'' { is_double: false,
// Character literal: 'x' → ASCII value of x });
Some(rest.as_bytes()[1] as i64)
} else {
i64::from_str_radix(rest, self.base).ok()
};
result.map(|n| if negative { -(n as i32) } else { n as i32 })
} }
/// Try to parse a token as a double-number (token ends with `.`). // A base-override prefix sits before the leftmost digit.
/// Returns (lo, hi) where the double-cell value is (hi << 32) | lo. let (radix, after_prefix) = match rest.as_bytes()[0] {
fn parse_double_number(&self, token: &str) -> Option<(i32, i32)> { b'$' => (16, &rest[1..]),
let token = token.trim(); b'#' => (10, &rest[1..]),
if token.is_empty() { b'%' => (2, &rest[1..]),
_ => (self.base, rest),
};
// Forth 2012 spells a signed based number `#-1289`, so the sign can
// also follow the prefix. Either way it precedes the leftmost digit
// and so is a sign rather than double punctuation.
let (neg_inner, digits) = strip_sign(after_prefix);
let negative = neg_outer ^ neg_inner;
if digits.is_empty() {
return None; return None;
} }
// Check for trailing dot (double-number indicator) // Walk the digit string, stripping punctuation and tracking DPL.
let without_dot = token.strip_suffix('.')?; let mut buf = String::with_capacity(digits.len());
if without_dot.is_empty() { let mut dpl = DPL_INIT;
let mut is_double = false;
for &b in digits.as_bytes() {
if DOUBLE_PUNCTUATION.contains(&b) {
is_double = true;
dpl = 0;
} else {
buf.push(char::from(b));
dpl += 1;
}
}
if buf.is_empty() {
return None; return None;
} }
// Check for negative prefix // i128 accumulation so the full u64 range survives conversion.
let (negative, rest) = if let Some(stripped) = without_dot.strip_prefix('-') { let magnitude = i128::from_str_radix(&buf, radix).ok()?;
(true, stripped) let value = if negative {
-(magnitude as i64)
} else { } else {
(false, without_dot) magnitude as i64
}; };
if rest.is_empty() { Some(NumberLiteral {
return None; value,
} dpl,
is_double,
// Parse based on prefix -- use i128 to handle the full u64 range
let result: Option<i128> = if let Some(hex) = rest.strip_prefix('$') {
i128::from_str_radix(hex, 16).ok()
} else if let Some(dec) = rest.strip_prefix('#') {
dec.parse::<i128>().ok()
} else if let Some(bin) = rest.strip_prefix('%') {
i128::from_str_radix(bin, 2).ok()
} else {
i128::from_str_radix(rest, self.base).ok()
};
result.map(|n| {
let val: i64 = if negative { -(n as i64) } else { n as i64 };
let lo = val as i32;
let hi = (val >> 32) as i32;
(lo, hi)
}) })
} }
/// Publish the outcome of a conversion in `DPL` and `NH`.
///
/// `NH` only carries meaning after a single-cell conversion, where it holds
/// the high-order cell that the stack result dropped.
fn record_number_conversion(&mut self, lit: NumberLiteral) {
self.rt.mem_write_i32(SYSVAR_DPL, lit.dpl);
if !lit.is_double {
self.rt.mem_write_i32(SYSVAR_NH, lit.hi());
}
}
/// Try to parse a token as a single-cell number, ignoring `DPL`/`NH`.
/// Used where only a plain cell value is meaningful.
fn parse_number(&self, token: &str) -> Option<i32> {
self.parse_numeric_literal(token)
.filter(|lit| !lit.is_double)
.map(NumberLiteral::lo)
}
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Float literal parsing // Float literal parsing
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@@ -3058,6 +3163,7 @@ impl<R: Runtime> ForthVM<R> {
self.register_to_in()?; self.register_to_in()?;
self.register_state_var()?; self.register_state_var()?;
self.register_base_var()?; self.register_base_var()?;
self.register_number_conversion_vars()?;
// Double-cell arithmetic // Double-cell arithmetic
self.register_m_star()?; self.register_m_star()?;
@@ -3325,7 +3431,7 @@ impl<R: Runtime> ForthVM<R> {
let digest_len = algo.digest_len as i32; let digest_len = algo.digest_len as i32;
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop ( c-addr u ) // Pop ( c-addr u )
let dsp = ctx.get_dsp(); let dsp = host_need(ctx, 2)?;
let u = ctx.mem_read_i32(dsp) as u32; let u = ctx.mem_read_i32(dsp) as u32;
let c_addr = ctx.mem_read_i32(dsp + CELL_SIZE) as u32; let c_addr = ctx.mem_read_i32(dsp + CELL_SIZE) as u32;
@@ -4077,8 +4183,9 @@ impl<R: Runtime> ForthVM<R> {
fn register_roll(&mut self) -> anyhow::Result<()> { fn register_roll(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop u from stack // Pop u from stack
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let u = ctx.mem_read_i32(sp as u32) as u32; let u = ctx.mem_read_i32(sp as u32) as u32;
host_need(ctx, u.saturating_add(2))?;
let sp = sp + CELL_SIZE; // pop u let sp = sp + CELL_SIZE; // pop u
if u == 0 { if u == 0 {
@@ -4263,7 +4370,7 @@ impl<R: Runtime> ForthVM<R> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop xt from data stack // Pop xt from data stack
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let xt = ctx.mem_read_i32(sp as u32) as u32; let xt = ctx.mem_read_i32(sp as u32) as u32;
// Look up PFA for this xt // Look up PFA for this xt
@@ -4283,7 +4390,7 @@ impl<R: Runtime> ForthVM<R> {
/// ENVIRONMENT? -- ( c-addr u -- false | value true ) query system parameters. /// ENVIRONMENT? -- ( c-addr u -- false | value true ) query system parameters.
fn register_environment_q(&mut self) -> anyhow::Result<()> { fn register_environment_q(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let u = ctx.mem_read_i32(sp as u32) as u32; let u = ctx.mem_read_i32(sp as u32) as u32;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
let addr = u32::from_le_bytes(b); let addr = u32::from_le_bytes(b);
@@ -5116,10 +5223,26 @@ impl<R: Runtime> ForthVM<R> {
Ok(()) Ok(())
} }
/// DPL ( -- addr ) and NH ( -- addr ): input number conversion results.
///
/// `DPL` holds the digit count right of the rightmost punctuation
/// character in the last converted number, or a negative value when the
/// token carried none. `NH` holds the high-order cell dropped by a
/// single-cell conversion, so an out-of-range token can be recovered as a
/// double.
fn register_number_conversion_vars(&mut self) -> anyhow::Result<()> {
self.rt.mem_write_i32(SYSVAR_DPL, DPL_INIT);
self.rt.mem_write_i32(SYSVAR_NH, 0);
self.register_primitive("DPL", false, vec![IrOp::PushI32(SYSVAR_DPL as i32)])?;
self.register_primitive("NH", false, vec![IrOp::PushI32(SYSVAR_NH as i32)])?;
Ok(())
}
/// M* ( n1 n2 -- d ) signed multiply producing double-cell result. /// M* ( n1 n2 -- d ) signed multiply producing double-cell result.
fn register_m_star(&mut self) -> anyhow::Result<()> { fn register_m_star(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let n2 = ctx.mem_read_i32(sp as u32) as i64; let n2 = ctx.mem_read_i32(sp as u32) as i64;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
let n1 = i32::from_le_bytes(b) as i64; let n1 = i32::from_le_bytes(b) as i64;
@@ -5140,7 +5263,7 @@ impl<R: Runtime> ForthVM<R> {
/// UM* ( u1 u2 -- ud ) unsigned multiply producing double-cell result. /// UM* ( u1 u2 -- ud ) unsigned multiply producing double-cell result.
fn register_um_star(&mut self) -> anyhow::Result<()> { fn register_um_star(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let u2 = ctx.mem_read_i32(sp as u32) as u32 as u64; let u2 = ctx.mem_read_i32(sp as u32) as u32 as u64;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
let u1 = u32::from_le_bytes(b) as u64; let u1 = u32::from_le_bytes(b) as u64;
@@ -5159,7 +5282,7 @@ impl<R: Runtime> ForthVM<R> {
/// UM/MOD ( ud u -- rem quot ) unsigned double-cell divide. /// UM/MOD ( ud u -- rem quot ) unsigned double-cell divide.
fn register_um_div_mod(&mut self) -> anyhow::Result<()> { fn register_um_div_mod(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 3)?;
// Pop u (divisor) // Pop u (divisor)
let divisor = ctx.mem_read_i32(sp as u32) as u32 as u64; let divisor = ctx.mem_read_i32(sp as u32) as u32 as u64;
// Pop ud (double-cell): high at sp+4, low at sp+8 // Pop ud (double-cell): high at sp+4, low at sp+8
@@ -5247,7 +5370,7 @@ impl<R: Runtime> ForthVM<R> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop xt from data stack // Pop xt from data stack
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let xt = ctx.mem_read_i32(sp as u32) as u32; let xt = ctx.mem_read_i32(sp as u32) as u32;
// Drop top of stack // Drop top of stack
let new_sp = sp + 4; let new_sp = sp + 4;
@@ -5332,7 +5455,7 @@ impl<R: Runtime> ForthVM<R> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// ( c-addr u -- ) — pop both cells. // ( c-addr u -- ) — pop both cells.
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let u = ctx.mem_read_i32(sp) as u32; let u = ctx.mem_read_i32(sp) as u32;
let addr = ctx.mem_read_i32(sp + CELL_SIZE) as u32; let addr = ctx.mem_read_i32(sp + CELL_SIZE) as u32;
ctx.set_dsp(sp + 2 * CELL_SIZE); ctx.set_dsp(sp + 2 * CELL_SIZE);
@@ -5453,10 +5576,7 @@ impl<R: Runtime> ForthVM<R> {
/// WORD ( char -- c-addr ) reads from the WASM input buffer and updates >IN. /// WORD ( char -- c-addr ) reads from the WASM input buffer and updates >IN.
fn register_word_word(&mut self) -> anyhow::Result<()> { fn register_word_word(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop delimiter from data stack let delim = host_pop(ctx)? as u8;
let sp = ctx.get_dsp();
let delim = ctx.mem_read_i32(sp as u32) as u8;
ctx.set_dsp(((sp + CELL_SIZE) as i32) as u32);
// Read >IN and #TIB from WASM memory // Read >IN and #TIB from WASM memory
let b: [u8; 4] = ctx.mem_read_i32(SYSVAR_TO_IN as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32(SYSVAR_TO_IN as u32).to_le_bytes();
@@ -5502,8 +5622,8 @@ impl<R: Runtime> ForthVM<R> {
ctx.mem_write_u8((dst_start + i) as u32, byte); ctx.mem_write_u8((dst_start + i) as u32, byte);
} }
// Push c-addr onto data stack // Push c-addr onto data stack (reuse the popped delim's slot)
let new_sp = sp; // We already popped delim, now push c-addr let new_sp = ctx.get_dsp() - CELL_SIZE;
ctx.mem_write_i32(new_sp, buf_addr as i32); ctx.mem_write_i32(new_sp, buf_addr as i32);
ctx.set_dsp(new_sp); ctx.set_dsp(new_sp);
@@ -5856,6 +5976,9 @@ impl<R: Runtime> ForthVM<R> {
fn register_2r_fetch(&mut self) -> anyhow::Result<()> { fn register_2r_fetch(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let rsp_val = ctx.get_rsp(); let rsp_val = ctx.get_rsp();
if rsp_val + 2 * CELL_SIZE > RETURN_STACK_TOP {
anyhow::bail!("Return stack underflow");
}
let sp = ctx.get_dsp(); let sp = ctx.get_dsp();
// Return stack: x2 at rsp, x1 at rsp+4 // Return stack: x2 at rsp, x1 at rsp+4
let b: [u8; 4] = ctx.mem_read_i32(rsp_val as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32(rsp_val as u32).to_le_bytes();
@@ -5963,9 +6086,7 @@ impl<R: Runtime> ForthVM<R> {
let state = Arc::clone(&self.rng_state); let state = Arc::clone(&self.rng_state);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let seed = host_pop(ctx)? as u32 as u64;
let seed = ctx.mem_read_i32(sp as u32) as u32 as u64;
ctx.set_dsp(sp + CELL_SIZE);
let mut s = state.lock().unwrap(); let mut s = state.lock().unwrap();
*s = if seed == 0 { *s = if seed == 0 {
0xDEAD_BEEF_CAFE_BABE 0xDEAD_BEEF_CAFE_BABE
@@ -5982,7 +6103,7 @@ impl<R: Runtime> ForthVM<R> {
fn register_parse_host(&mut self) -> anyhow::Result<()> { fn register_parse_host(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop delimiter from data stack // Pop delimiter from data stack
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let delim = ctx.mem_read_i32(sp as u32) as u8; let delim = ctx.mem_read_i32(sp as u32) as u8;
let sp = sp + CELL_SIZE; // pop delimiter let sp = sp + CELL_SIZE; // pop delimiter
@@ -6100,7 +6221,7 @@ impl<R: Runtime> ForthVM<R> {
// In non-interactive mode, return 0 (no input). // In non-interactive mode, return 0 (no input).
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop +n1 (max count) and c-addr from stack // Pop +n1 (max count) and c-addr from stack
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let new_sp = sp + CELL_SIZE; // pop +n1 let new_sp = sp + CELL_SIZE; // pop +n1
let new_sp = new_sp + CELL_SIZE; // pop c-addr let new_sp = new_sp + CELL_SIZE; // pop c-addr
// Push 0 (no characters received) // Push 0 (no characters received)
@@ -6125,7 +6246,7 @@ impl<R: Runtime> ForthVM<R> {
fn register_memory_alloc(&mut self) -> anyhow::Result<()> { fn register_memory_alloc(&mut self) -> anyhow::Result<()> {
// ALLOCATE ( u -- a-addr ior ) // ALLOCATE ( u -- a-addr ior )
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let size = ctx.mem_read_i32(sp as u32) as u32; let size = ctx.mem_read_i32(sp as u32) as u32;
let mem_len = ctx.mem_len() as u32; let mem_len = ctx.mem_len() as u32;
@@ -6184,7 +6305,7 @@ impl<R: Runtime> ForthVM<R> {
// FREE ( a-addr -- ior ) // FREE ( a-addr -- ior )
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Simple allocator: FREE is a no-op (arena style), return ior=0 // Simple allocator: FREE is a no-op (arena style), return ior=0
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
// Replace a-addr with ior=0 // Replace a-addr with ior=0
ctx.mem_write_i32(sp as u32, 0i32 as i32); ctx.mem_write_i32(sp as u32, 0i32 as i32);
Ok(()) Ok(())
@@ -6193,7 +6314,7 @@ impl<R: Runtime> ForthVM<R> {
// RESIZE ( a-addr u -- a-addr2 ior ) // RESIZE ( a-addr u -- a-addr2 ior )
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let new_size = ctx.mem_read_i32(sp as u32) as u32; let new_size = ctx.mem_read_i32(sp as u32) as u32;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
let old_addr = u32::from_le_bytes(b); let old_addr = u32::from_le_bytes(b);
@@ -6614,8 +6735,14 @@ impl<R: Runtime> ForthVM<R> {
{ {
let so = Arc::clone(&self.search_order); let so = Arc::clone(&self.search_order);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let n = ctx.mem_read_i32(sp as u32); let n = ctx.mem_read_i32(sp as u32);
if !(-1..=64).contains(&n) {
anyhow::bail!("SET-ORDER: bad wordlist count: {n}");
}
if n != -1 {
host_need(ctx, 1 + n as u32)?;
}
if n == -1 { if n == -1 {
*so.lock().unwrap() = vec![1]; *so.lock().unwrap() = vec![1];
@@ -6718,8 +6845,9 @@ impl<R: Runtime> ForthVM<R> {
fn register_n_to_r(&mut self) -> anyhow::Result<()> { fn register_n_to_r(&mut self) -> anyhow::Result<()> {
// N>R ( xn..x1 n -- ; R: -- x1..xn n ) // N>R ( xn..x1 n -- ; R: -- x1..xn n )
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let n = ctx.mem_read_i32(sp as u32) as u32; let n = ctx.mem_read_i32(sp as u32) as u32;
host_need(ctx, n.saturating_add(1))?;
let mut rsp_val = ctx.get_rsp(); let mut rsp_val = ctx.get_rsp();
@@ -6803,7 +6931,7 @@ impl<R: Runtime> ForthVM<R> {
// UNESCAPE ( c-addr1 u1 c-addr2 -- c-addr2 u2 ) // UNESCAPE ( c-addr1 u1 c-addr2 -- c-addr2 u2 )
// Copy string escaping each % as %% // Copy string escaping each % as %%
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 3)?;
let dest = ctx.mem_read_i32(sp as u32) as u32; let dest = ctx.mem_read_i32(sp as u32) as u32;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
let u1 = u32::from_le_bytes(b); let u1 = u32::from_le_bytes(b);
@@ -6841,7 +6969,7 @@ impl<R: Runtime> ForthVM<R> {
// Define substitution: name (c-addr2 u2) → replacement (c-addr1 u1) // Define substitution: name (c-addr2 u2) → replacement (c-addr1 u1)
let subs = Arc::clone(&self.substitutions); let subs = Arc::clone(&self.substitutions);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 4)?;
// Stack: u2(sp), c-addr2(sp+4), u1(sp+8), c-addr1(sp+12) // Stack: u2(sp), c-addr2(sp+4), u1(sp+8), c-addr1(sp+12)
let u2 = ctx.mem_read_i32(sp as u32) as u32; let u2 = ctx.mem_read_i32(sp as u32) as u32;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
@@ -6869,7 +6997,7 @@ impl<R: Runtime> ForthVM<R> {
// Replace %name% patterns, %% → % // Replace %name% patterns, %% → %
let subs = Arc::clone(&self.substitutions); let subs = Arc::clone(&self.substitutions);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 4)?;
// Stack: u2/capacity(sp), c-addr2/dest(sp+4), u1(sp+8), c-addr1(sp+12) // Stack: u2/capacity(sp), c-addr2/dest(sp+4), u1(sp+8), c-addr1(sp+12)
let capacity = ctx.mem_read_i32(sp as u32) as u32 as usize; let capacity = ctx.mem_read_i32(sp as u32) as u32 as usize;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
@@ -6957,7 +7085,7 @@ impl<R: Runtime> ForthVM<R> {
/// M*/ ( d n1 n2 -- d ) multiply d by n1, divide by n2. /// M*/ ( d n1 n2 -- d ) multiply d by n1, divide by n2.
fn register_m_star_slash(&mut self) -> anyhow::Result<()> { fn register_m_star_slash(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 4)?;
// Stack: n2(sp), n1(sp+4), d-hi(sp+8), d-lo(sp+12) // Stack: n2(sp), n1(sp+4), d-hi(sp+8), d-lo(sp+12)
let n2 = ctx.mem_read_i32(sp as u32) as i128; let n2 = ctx.mem_read_i32(sp as u32) as i128;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
@@ -7093,7 +7221,7 @@ impl<R: Runtime> ForthVM<R> {
/// SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) search for substring. /// SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) search for substring.
fn register_search(&mut self) -> anyhow::Result<()> { fn register_search(&mut self) -> anyhow::Result<()> {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 4)?;
// Stack: u2(sp), c-addr2(sp+4), u1(sp+8), c-addr1(sp+12) // Stack: u2(sp), c-addr2(sp+4), u1(sp+8), c-addr1(sp+12)
let u2 = ctx.mem_read_i32(sp as u32) as usize; let u2 = ctx.mem_read_i32(sp as u32) as usize;
let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes(); let b: [u8; 4] = ctx.mem_read_i32((sp + 4) as u32).to_le_bytes();
@@ -7244,7 +7372,7 @@ impl<R: Runtime> ForthVM<R> {
// FROT ( F: r1 r2 r3 -- r2 r3 r1 ) // FROT ( F: r1 r2 r3 -- r2 r3 r1 )
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_fsp(); let sp = host_fneed(ctx, 3)?;
let c: [u8; 8] = ctx.mem_read_slice(sp, 8).try_into().unwrap(); let c: [u8; 8] = ctx.mem_read_slice(sp, 8).try_into().unwrap();
let b: [u8; 8] = ctx.mem_read_slice(sp + 8, 8).try_into().unwrap(); let b: [u8; 8] = ctx.mem_read_slice(sp + 8, 8).try_into().unwrap();
let a: [u8; 8] = ctx.mem_read_slice(sp + 16, 8).try_into().unwrap(); let a: [u8; 8] = ctx.mem_read_slice(sp + 16, 8).try_into().unwrap();
@@ -7311,14 +7439,9 @@ impl<R: Runtime> ForthVM<R> {
// If r3 < 0: true if |r1-r2| < |r3|*(|r1|+|r2|) // If r3 < 0: true if |r1-r2| < |r3|*(|r1|+|r2|)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_fsp(); let r3 = host_fpop(ctx)?;
let r3_bytes: [u8; 8] = ctx.mem_read_slice(sp, 8).try_into().unwrap(); let r2 = host_fpop(ctx)?;
let r2_bytes: [u8; 8] = ctx.mem_read_slice(sp + 8, 8).try_into().unwrap(); let r1 = host_fpop(ctx)?;
let r1_bytes: [u8; 8] = ctx.mem_read_slice(sp + 16, 8).try_into().unwrap();
let r3 = f64::from_le_bytes(r3_bytes);
let r2 = f64::from_le_bytes(r2_bytes);
let r1 = f64::from_le_bytes(r1_bytes);
ctx.set_fsp(((sp + 24) as i32) as u32);
let result = if r3 > 0.0 { let result = if r3 > 0.0 {
(r1 - r2).abs() < r3 (r1 - r2).abs() < r3
@@ -7366,7 +7489,7 @@ impl<R: Runtime> ForthVM<R> {
// FALIGNED ( addr -- f-addr ) align to float boundary (8 bytes) // FALIGNED ( addr -- f-addr ) align to float boundary (8 bytes)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let addr = ctx.mem_read_i32(sp as u32) as u32; let addr = ctx.mem_read_i32(sp as u32) as u32;
let aligned = (addr + 7) & !7; let aligned = (addr + 7) & !7;
ctx.mem_write_i32(sp as u32, aligned as i32); ctx.mem_write_i32(sp as u32, aligned as i32);
@@ -7411,7 +7534,7 @@ impl<R: Runtime> ForthVM<R> {
// D>F ( d -- ) ( F: -- r ) convert double-cell integer to float // D>F ( d -- ) ( F: -- r ) convert double-cell integer to float
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
// Double-cell: hi on top, lo below // Double-cell: hi on top, lo below
let hi_bytes: [u8; 4] = ctx.mem_read_slice(sp, 4).try_into().unwrap(); let hi_bytes: [u8; 4] = ctx.mem_read_slice(sp, 4).try_into().unwrap();
let lo_bytes: [u8; 4] = ctx.mem_read_slice(sp + 4, 4).try_into().unwrap(); let lo_bytes: [u8; 4] = ctx.mem_read_slice(sp + 4, 4).try_into().unwrap();
@@ -7434,11 +7557,7 @@ impl<R: Runtime> ForthVM<R> {
// F>D ( -- d ) ( F: r -- ) convert float to double-cell integer // F>D ( -- d ) ( F: r -- ) convert float to double-cell integer
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Pop from float stack let f = host_fpop(ctx)?;
let fsp_val = ctx.get_fsp();
let bytes: [u8; 8] = ctx.mem_read_slice(fsp_val, 8).try_into().unwrap();
let f = f64::from_le_bytes(bytes);
ctx.set_fsp(fsp_val + FLOAT_SIZE);
// Convert to i64 // Convert to i64
let d = f as i64; let d = f as i64;
let lo = d as i32; let lo = d as i32;
@@ -7524,10 +7643,7 @@ impl<R: Runtime> ForthVM<R> {
let output = Arc::clone(&self.output); let output = Arc::clone(&self.output);
let precision = Arc::clone(&self.float_precision); let precision = Arc::clone(&self.float_precision);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_fsp(); let val = host_fpop(ctx)?;
let bytes: [u8; 8] = ctx.mem_read_slice(sp as u32, 8).try_into().unwrap();
let val = f64::from_le_bytes(bytes);
ctx.set_fsp(((sp + 8) as i32) as u32);
let prec = *precision.lock().unwrap(); let prec = *precision.lock().unwrap();
let s = format!("{val:.prec$} "); let s = format!("{val:.prec$} ");
output.lock().unwrap().push_str(&s); output.lock().unwrap().push_str(&s);
@@ -7541,10 +7657,7 @@ impl<R: Runtime> ForthVM<R> {
let output = Arc::clone(&self.output); let output = Arc::clone(&self.output);
let precision = Arc::clone(&self.float_precision); let precision = Arc::clone(&self.float_precision);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_fsp(); let val = host_fpop(ctx)?;
let bytes: [u8; 8] = ctx.mem_read_slice(sp as u32, 8).try_into().unwrap();
let val = f64::from_le_bytes(bytes);
ctx.set_fsp(((sp + 8) as i32) as u32);
let prec = *precision.lock().unwrap(); let prec = *precision.lock().unwrap();
let s = format_engineering(val, prec); let s = format_engineering(val, prec);
output.lock().unwrap().push_str(&s); output.lock().unwrap().push_str(&s);
@@ -7558,10 +7671,7 @@ impl<R: Runtime> ForthVM<R> {
let output = Arc::clone(&self.output); let output = Arc::clone(&self.output);
let precision = Arc::clone(&self.float_precision); let precision = Arc::clone(&self.float_precision);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_fsp(); let val = host_fpop(ctx)?;
let bytes: [u8; 8] = ctx.mem_read_slice(sp as u32, 8).try_into().unwrap();
let val = f64::from_le_bytes(bytes);
ctx.set_fsp(((sp + 8) as i32) as u32);
let prec = *precision.lock().unwrap(); let prec = *precision.lock().unwrap();
let s = format!("{val:.prec$E} "); let s = format!("{val:.prec$E} ");
output.lock().unwrap().push_str(&s); output.lock().unwrap().push_str(&s);
@@ -7588,9 +7698,7 @@ impl<R: Runtime> ForthVM<R> {
{ {
let precision = Arc::clone(&self.float_precision); let precision = Arc::clone(&self.float_precision);
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let n = host_pop(ctx)? as usize;
let n = ctx.mem_read_i32(sp as u32) as usize;
ctx.set_dsp(((sp + CELL_SIZE) as i32) as u32);
*precision.lock().unwrap() = n; *precision.lock().unwrap() = n;
Ok(()) Ok(())
}); });
@@ -7600,17 +7708,12 @@ impl<R: Runtime> ForthVM<R> {
// REPRESENT ( c-addr u -- n flag1 flag2 ) ( F: r -- ) // REPRESENT ( c-addr u -- n flag1 flag2 ) ( F: r -- )
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
// Read all values from memory first let sp = host_need(ctx, 2)?;
let sp = ctx.get_dsp();
let fsp_val = ctx.get_fsp();
let u = ctx.mem_read_i32(sp) as usize; let u = ctx.mem_read_i32(sp) as usize;
let c_addr = ctx.mem_read_i32(sp + 4) as u32; let c_addr = ctx.mem_read_i32(sp + 4) as u32;
let f_bytes: [u8; 8] = ctx.mem_read_slice(fsp_val, 8).try_into().unwrap(); let val = host_fpop(ctx)?;
let val = f64::from_le_bytes(f_bytes); // Pop the 2 data cells
// Update stack pointers: pop 2 data cells, pop 1 float
ctx.set_dsp(sp + 8); ctx.set_dsp(sp + 8);
ctx.set_fsp(fsp_val + FLOAT_SIZE);
let (digits, exp, is_negative, is_valid) = represent_float(val, u); let (digits, exp, is_negative, is_valid) = represent_float(val, u);
@@ -7638,7 +7741,7 @@ impl<R: Runtime> ForthVM<R> {
// >FLOAT ( c-addr u -- flag ) ( F: -- r | ) parse string as float // >FLOAT ( c-addr u -- flag ) ( F: -- r | ) parse string as float
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 2)?;
let u = ctx.mem_read_i32(sp) as usize; let u = ctx.mem_read_i32(sp) as usize;
let c_addr = ctx.mem_read_i32(sp + 4) as u32; let c_addr = ctx.mem_read_i32(sp + 4) as u32;
let s_bytes = ctx.mem_read_slice(c_addr, u); let s_bytes = ctx.mem_read_slice(c_addr, u);
@@ -7679,14 +7782,9 @@ impl<R: Runtime> ForthVM<R> {
// SF! ( sf-addr -- ) ( F: r -- ) store as single-precision float (f32) // SF! ( sf-addr -- ) ( F: r -- ) store as single-precision float (f32)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let addr = host_pop(ctx)? as u32;
let fsp_val = ctx.get_fsp(); let val = host_fpop(ctx)?;
let addr = ctx.mem_read_i32(sp) as u32;
let f_bytes: [u8; 8] = ctx.mem_read_slice(fsp_val, 8).try_into().unwrap();
let val = f64::from_le_bytes(f_bytes);
let f32_bytes = (val as f32).to_le_bytes(); let f32_bytes = (val as f32).to_le_bytes();
ctx.set_dsp(sp + CELL_SIZE);
ctx.set_fsp(fsp_val + FLOAT_SIZE);
ctx.mem_write_slice(addr, &f32_bytes); ctx.mem_write_slice(addr, &f32_bytes);
Ok(()) Ok(())
}); });
@@ -7696,12 +7794,10 @@ impl<R: Runtime> ForthVM<R> {
// SF@ ( sf-addr -- ) ( F: -- r ) fetch single-precision float (f32) // SF@ ( sf-addr -- ) ( F: -- r ) fetch single-precision float (f32)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let addr = host_pop(ctx)? as u32;
let fsp_val = ctx.get_fsp(); let fsp_val = ctx.get_fsp();
let addr = ctx.mem_read_i32(sp) as u32;
let f32_bytes: [u8; 4] = ctx.mem_read_slice(addr, 4).try_into().unwrap(); let f32_bytes: [u8; 4] = ctx.mem_read_slice(addr, 4).try_into().unwrap();
let val = f32::from_le_bytes(f32_bytes) as f64; let val = f32::from_le_bytes(f32_bytes) as f64;
ctx.set_dsp(sp + CELL_SIZE);
let new_fsp = fsp_val - FLOAT_SIZE; let new_fsp = fsp_val - FLOAT_SIZE;
ctx.set_fsp(new_fsp); ctx.set_fsp(new_fsp);
ctx.mem_write_slice(new_fsp, &val.to_le_bytes()); ctx.mem_write_slice(new_fsp, &val.to_le_bytes());
@@ -7713,12 +7809,8 @@ impl<R: Runtime> ForthVM<R> {
// DF! ( df-addr -- ) ( F: r -- ) same as F! (our floats are already f64) // DF! ( df-addr -- ) ( F: r -- ) same as F! (our floats are already f64)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let addr = host_pop(ctx)? as u32;
let fsp_val = ctx.get_fsp(); let float_bytes = host_fpop(ctx)?.to_le_bytes();
let addr = ctx.mem_read_i32(sp) as u32;
let float_bytes: [u8; 8] = ctx.mem_read_slice(fsp_val, 8).try_into().unwrap();
ctx.set_dsp(sp + CELL_SIZE);
ctx.set_fsp(fsp_val + FLOAT_SIZE);
ctx.mem_write_slice(addr, &float_bytes); ctx.mem_write_slice(addr, &float_bytes);
Ok(()) Ok(())
}); });
@@ -7728,12 +7820,10 @@ impl<R: Runtime> ForthVM<R> {
// DF@ ( df-addr -- ) ( F: -- r ) same as F@ (our floats are already f64) // DF@ ( df-addr -- ) ( F: -- r ) same as F@ (our floats are already f64)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let addr = host_pop(ctx)? as u32;
let fsp_val = ctx.get_fsp(); let fsp_val = ctx.get_fsp();
let addr = ctx.mem_read_i32(sp) as u32;
let float_bytes: [u8; 8] = ctx.mem_read_slice(addr, 8).try_into().unwrap(); let float_bytes: [u8; 8] = ctx.mem_read_slice(addr, 8).try_into().unwrap();
let val = f64::from_le_bytes(float_bytes); let val = f64::from_le_bytes(float_bytes);
ctx.set_dsp(sp + CELL_SIZE);
let new_fsp = fsp_val - FLOAT_SIZE; let new_fsp = fsp_val - FLOAT_SIZE;
ctx.set_fsp(new_fsp); ctx.set_fsp(new_fsp);
ctx.mem_write_slice(new_fsp, &val.to_le_bytes()); ctx.mem_write_slice(new_fsp, &val.to_le_bytes());
@@ -7745,7 +7835,7 @@ impl<R: Runtime> ForthVM<R> {
// SFALIGNED, DFALIGNED (alignment words for single/double floats) // SFALIGNED, DFALIGNED (alignment words for single/double floats)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let addr = ctx.mem_read_i32(sp as u32) as u32; let addr = ctx.mem_read_i32(sp as u32) as u32;
let aligned = (addr + 3) & !3; // 4-byte alignment for single float let aligned = (addr + 3) & !3; // 4-byte alignment for single float
ctx.mem_write_i32(sp as u32, aligned as i32); ctx.mem_write_i32(sp as u32, aligned as i32);
@@ -7757,7 +7847,7 @@ impl<R: Runtime> ForthVM<R> {
// DFALIGNED is the same as FALIGNED (8-byte alignment) // DFALIGNED is the same as FALIGNED (8-byte alignment)
{ {
let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| { let func: HostFn = Box::new(move |ctx: &mut dyn HostAccess| {
let sp = ctx.get_dsp(); let sp = host_need(ctx, 1)?;
let addr = ctx.mem_read_i32(sp as u32) as u32; let addr = ctx.mem_read_i32(sp as u32) as u32;
let aligned = (addr + 7) & !7; let aligned = (addr + 7) & !7;
ctx.mem_write_i32(sp as u32, aligned as i32); ctx.mem_write_i32(sp as u32, aligned as i32);
@@ -9549,6 +9639,100 @@ mod tests {
assert!(!output.contains("__CTRL__")); assert!(!output.contains("__CTRL__"));
} }
#[test]
fn test_rnd_seed_underflow_is_clean_error() {
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
let err = vm.evaluate("RND-SEED").unwrap_err();
assert!(err.to_string().contains("underflow"), "{err}");
// The stack pointer must not have drifted above the base.
vm.evaluate("RANDOM .S").unwrap();
assert!(vm.take_output().starts_with("<1>"), "dsp drifted");
}
#[test]
fn test_host_words_underflow_cleanly() {
// Every argument-taking host word must fail cleanly on an empty
// stack and leave both stack pointers at their bases (host words
// are outside the compiled-code guards).
let words = [
"RND-SEED",
"WORD",
"SET-ORDER",
"SET-PRECISION",
"REPRESENT",
">FLOAT",
"SF!",
"SF@",
"DF!",
"DF@",
"D>F",
"F.",
"FE.",
"FS.",
"F~",
"ROLL",
">BODY",
"ENVIRONMENT?",
"M*",
"UM*",
"UM/MOD",
"COMPILE,",
"ACCEPT",
"ALLOCATE",
"FREE",
"RESIZE",
"N>R",
"UNESCAPE",
"REPLACES",
"SUBSTITUTE",
"M*/",
"SEARCH",
"FALIGNED",
"SFALIGNED",
"DFALIGNED",
"FROT",
"F>D",
"2R@",
// WORD and PARSE are intercepted by the outer interpreter in
// interpret mode; exercise their host variants compiled.
": T_ WORD ; T_",
": T_ PARSE ; T_",
#[cfg(feature = "crypto")]
"SHA256",
];
for w in words {
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
let r = vm.evaluate(w);
assert!(r.is_err(), "{w}: silent underflow accepted");
vm.evaluate("DEPTH FDEPTH + .").unwrap();
assert_eq!(vm.take_output(), "0 ", "{w}: stack pointer drifted");
}
}
// -- Search order is authoritative (matches gforth + SwiftForth) --
#[test]
fn test_search_order_hides_unlisted_wordlists() {
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
vm.evaluate(
"WORDLIST CONSTANT MY-WL MY-WL SET-CURRENT : SECRET 42 ; FORTH-WORDLIST SET-CURRENT",
)
.unwrap();
// MY-WL was never in the search order: SECRET must not resolve.
let err = vm.evaluate("SECRET").unwrap_err();
assert!(err.to_string().contains("unknown word"), "{err}");
// Push MY-WL onto the order: now it resolves.
vm.evaluate("GET-ORDER MY-WL SWAP 1+ SET-ORDER SECRET .")
.unwrap();
assert_eq!(vm.take_output(), "42 ");
// Back to the default order: hidden again.
vm.evaluate("-1 SET-ORDER").unwrap();
assert!(vm.evaluate("SECRET").is_err());
// FORTH words stay findable throughout.
vm.evaluate("1 2 + .").unwrap();
assert_eq!(vm.take_output(), "3 ");
}
// -- Error reporting (WS-008) -- // -- Error reporting (WS-008) --
#[test] #[test]
@@ -10732,6 +10916,111 @@ mod tests {
assert_eq!(eval_stack("1E 2.5E 1E F~"), vec![0]); // |1-2.5| = 1.5 >= 1 assert_eq!(eval_stack("1E 2.5E 1E F~"), vec![0]); // |1-2.5| = 1.5 >= 1
} }
#[test]
fn punctuation_anywhere_converts_as_double() {
// The punctuation is a double-cell marker, not a fractional point:
// every form below carries the same digits, so the value is the same.
// eval_stack reports top-first, so a double reads as [hi, lo].
for token in ["1234.", "123.4", "12.34", "1.234", ".1234"] {
assert_eq!(eval_stack(token), vec![0, 1234], "token {token}");
}
// SwiftForth accepts comma, colon, slash, plus and dash too, which is
// what makes dates and times convert without a custom parser.
assert_eq!(eval_stack("1,234"), vec![0, 1234]);
assert_eq!(eval_stack("12:30:45"), vec![0, 123045]);
assert_eq!(eval_stack("2026-08-06"), vec![0, 20260806]);
assert_eq!(eval_stack("12/34"), vec![0, 1234]);
assert_eq!(eval_stack("1+234"), vec![0, 1234]);
}
#[test]
fn dpl_counts_digits_right_of_last_punctuation() {
for (token, dpl) in [("1234.", 0), ("123.4", 1), ("12.34", 2), (".1234", 4)] {
assert_eq!(eval_stack(&format!("{token} 2DROP DPL @")), vec![dpl]);
}
// Only the rightmost punctuation counts.
assert_eq!(eval_stack("12:30:45 2DROP DPL @"), vec![2]);
}
#[test]
fn dpl_stays_negative_for_unpunctuated_numbers() {
// A leading minus is a sign, not punctuation, so these stay single-cell.
for token in ["1234", "-1", "$FF"] {
let dpl = eval_stack(&format!("{token} DROP DPL @"))[0];
assert!(dpl < 0, "token {token} left DPL = {dpl}");
}
assert_eq!(eval_stack("-1"), vec![-1]);
// DPL counts up from its seed once per digit.
assert_eq!(eval_stack("1234 DROP DPL @"), vec![DPL_INIT + 4]);
assert_eq!(eval_stack("-1 DROP DPL @"), vec![DPL_INIT + 1]);
}
#[test]
fn leading_plus_is_punctuation_not_a_sign() {
// sf64 converts `+7` as the double 7 with DPL = 1: unlike `-`, a
// leading `+` does not bind to the number.
assert_eq!(eval_stack("+7"), vec![0, 7]);
assert_eq!(eval_stack("+7 2DROP DPL @"), vec![1]);
// Same after a base prefix.
assert_eq!(eval_stack("#+7"), vec![0, 7]);
assert_eq!(eval_stack("$+F"), vec![0, 15]);
}
#[test]
fn repeated_punctuation_only_counts_from_the_last_one() {
// sf64: `12..34` is 1234 with DPL 2, `1-2-3` is 123 with DPL 1.
assert_eq!(eval_stack("12..34"), vec![0, 1234]);
assert_eq!(eval_stack("12..34 2DROP DPL @"), vec![2]);
assert_eq!(eval_stack("1-2-3"), vec![0, 123]);
assert_eq!(eval_stack("1-2-3 2DROP DPL @"), vec![1]);
}
#[test]
fn nh_recovers_an_out_of_range_single_number() {
// 4000000000 overflows a signed cell, so the stack value is truncated.
assert_eq!(eval_stack("4000000000"), vec![-294967296]);
// NH carries the high cell, making the true value recoverable.
assert_eq!(eval_stack("4000000000 NH @"), vec![0, -294967296]);
assert_eq!(eval_output("4000000000 NH @ D."), "4000000000 ");
}
#[test]
fn float_literals_still_win_over_double_punctuation() {
// `1.5E0` has an embedded dot, but "15E0" is not a decimal number,
// so conversion falls through to the float parser.
assert_eq!(eval_output("1.5E0 F."), "1.500000 ");
assert_eq!(eval_output("-3.25E0 F."), "-3.250000 ");
assert_eq!(eval_output("1E-3 F."), "0.001000 ");
}
#[test]
fn double_punctuation_respects_base_prefixes() {
assert_eq!(eval_stack("$FF."), vec![0, 255]);
assert_eq!(eval_stack("$F.F"), vec![0, 255]);
assert_eq!(eval_stack("%1010."), vec![0, 10]);
assert_eq!(eval_stack("#12.34"), vec![0, 1234]);
assert_eq!(eval_stack("-$FF."), vec![-1, -255]);
}
#[test]
fn sign_after_a_base_prefix_is_a_sign_not_punctuation() {
// Forth 2012 spells signed based numbers with the sign after the
// prefix. The dash precedes the leftmost digit, so it must not
// trigger double-cell conversion.
assert_eq!(eval_stack("#-1289"), vec![-1289]);
assert_eq!(eval_stack("$-12eF"), vec![-4847]);
assert_eq!(eval_stack("%-10010110"), vec![-150]);
// The sign may also precede the prefix, and both spellings cancel.
assert_eq!(eval_stack("-$FF"), vec![-255]);
assert_eq!(eval_stack("-$-FF"), vec![255]);
}
#[test]
fn punctuated_numbers_compile_into_definitions() {
assert_eq!(eval_stack(": D1 12.34 ; D1"), vec![0, 1234]);
assert_eq!(eval_output(": STAMP 2026-08-06 D. ; STAMP"), "20260806 ");
}
#[test] #[test]
fn optimizer_doesnt_break_basic_arithmetic() { fn optimizer_doesnt_break_basic_arithmetic() {
assert_eq!(eval_stack("5 3 +"), vec![8]); assert_eq!(eval_stack("5 3 +"), vec![8]);
+10
View File
@@ -350,6 +350,16 @@ pub const WORD_DOCS: &[(&str, &str, &str)] = &[
"Convert digits, accumulating into ud.", "Convert digits, accumulating into ud.",
), ),
("BASE", "( -- addr )", "Variable holding the number base."), ("BASE", "( -- addr )", "Variable holding the number base."),
(
"DPL",
"( -- addr )",
"Variable: digits right of the last punctuation; negative if none.",
),
(
"NH",
"( -- addr )",
"Variable: high cell dropped by the last single-cell conversion.",
),
("HEX", "( -- )", "Set BASE to sixteen."), ("HEX", "( -- )", "Set BASE to sixteen."),
("DECIMAL", "( -- )", "Set BASE to ten."), ("DECIMAL", "( -- )", "Set BASE to ten."),
// -- Core: strings -- // -- Core: strings --
+15
View File
@@ -453,6 +453,21 @@ fn programs() -> Vec<Program> {
expected: "99 \n", expected: "99 \n",
category: Category::Definitions, category: Category::Definitions,
}, },
Program {
name: "search-order-hides",
code: "WORDLIST CONSTANT MY-WL\n\
MY-WL SET-CURRENT\n\
: SECRET 42 ;\n\
FORTH-WORDLIST SET-CURRENT\n\
[UNDEFINED] SECRET . CR\n\
GET-ORDER MY-WL SWAP 1+ SET-ORDER\n\
[DEFINED] SECRET . CR\n\
SECRET . CR\n\
-1 SET-ORDER\n\
[UNDEFINED] SECRET . CR",
expected: "-1 \n-1 \n42 \n-1 \n",
category: Category::Definitions,
},
// -- Strings -- // -- Strings --
Program { Program {
name: "s-quote-type", name: "s-quote-type",
+1 -1
View File
@@ -12,7 +12,7 @@ workspace = true
crate-type = ["cdylib", "rlib"] crate-type = ["cdylib", "rlib"]
[dependencies] [dependencies]
wafer-core = { path = "../core", version = "0.2.0", default-features = false, features = ["crypto"] } wafer-core = { path = "../core", version = "0.2.4", default-features = false, features = ["crypto"] }
wasm-bindgen = "0.2" wasm-bindgen = "0.2"
js-sys = "0.3" js-sys = "0.3"
send_wrapper = { workspace = true } send_wrapper = { workspace = true }
+19 -2
View File
@@ -38,6 +38,23 @@ impl WebHostAccess {
} }
} }
/// An exception on its way back out of compiled code. Host words rethrow the
/// Forth message (`Stack underflow`, an `ABORT"` text, a `THROW` description),
/// so surface exactly that and nothing else — the JS `Error` carries the whole
/// engine stack in its message, which is noise to a Forth programmer. Anything
/// without a message is a genuine runtime fault and keeps the call context.
fn call_error(fn_index: u32, e: &JsValue) -> anyhow::Error {
match Reflect::get(e, &"message".into())
.ok()
.and_then(|m| m.as_string())
.and_then(|m| m.lines().next().map(str::trim).map(str::to_string))
.filter(|m| !m.is_empty())
{
Some(msg) => anyhow::anyhow!("{msg}"),
None => anyhow::anyhow!("call_func({fn_index}) failed: {e:?}"),
}
}
impl HostAccess for WebHostAccess { impl HostAccess for WebHostAccess {
fn mem_read_i32(&mut self, addr: u32) -> i32 { fn mem_read_i32(&mut self, addr: u32) -> i32 {
let view = js_sys::Int32Array::new(&self.buffer()); let view = js_sys::Int32Array::new(&self.buffer());
@@ -134,7 +151,7 @@ impl HostAccess for WebHostAccess {
.dyn_into() .dyn_into()
.map_err(|_| anyhow::anyhow!("table entry {fn_index} is not a function"))?; .map_err(|_| anyhow::anyhow!("table entry {fn_index} is not a function"))?;
func.call0(&JsValue::NULL) func.call0(&JsValue::NULL)
.map_err(|e| anyhow::anyhow!("call_func({fn_index}) failed: {e:?}"))?; .map_err(|e| call_error(fn_index, &e))?;
Ok(()) Ok(())
} }
} }
@@ -406,7 +423,7 @@ impl Runtime for WebRuntime {
.dyn_into() .dyn_into()
.map_err(|_| anyhow::anyhow!("table entry {fn_index} is not callable"))?; .map_err(|_| anyhow::anyhow!("table entry {fn_index} is not callable"))?;
func.call0(&JsValue::NULL) func.call0(&JsValue::NULL)
.map_err(|e| anyhow::anyhow!("call_func({fn_index}) failed: {e:?}"))?; .map_err(|e| call_error(fn_index, &e))?;
Ok(()) Ok(())
} }
+2 -2
View File
@@ -18,11 +18,11 @@ confidence-threshold = 0.8
[bans] [bans]
multiple-versions = "deny" multiple-versions = "deny"
wildcards = "deny" wildcards = "deny"
# Transitive duplicates from wasmtime v31 -- will resolve when upgrading # Transitive duplicates from wasmtime v47 dependencies
skip = [ skip = [
"getrandom", "getrandom",
"syn",
"hashbrown", "hashbrown",
"r-efi",
"thiserror", "thiserror",
"thiserror-impl", "thiserror-impl",
"wasm-encoder", "wasm-encoder",