boot: add structure words (Facility-ext 10.6.2.0935)
BEGIN-STRUCTURE, END-STRUCTURE, +FIELD, FIELD:, CFIELD:, FFIELD:, SFFIELD:, DFFIELD: — the Forth 2012 structure-definition family plus the float-typed variants for symmetry with WAFER's float wordset. Each defining word carries its own inline CREATE .. DOES> — factoring through a shared +FIELD helper doesn't work in WAFER, because DOES>- defining words only dispatch at the outer interpreter, not from compiled IR. So FIELD: can't call +FIELD and have the DOES> action fire; each FIELD:/CFIELD:/... repeats the pattern directly. Three tests cover size computation, field offsets, and mixed cell + char fields with alignment.
This commit is contained in:
@@ -310,3 +310,39 @@
|
||||
\ State-smart string literal for the next whitespace-delimited token.
|
||||
\ Handled in Rust (outer.rs interpret_token_immediate / compile_token)
|
||||
\ so the string survives REFILL in interpret mode.
|
||||
|
||||
\ ---------------------------------------------------------------
|
||||
\ Structures (Forth 2012 Facility-ext 10.6.2.0935 family)
|
||||
\ ---------------------------------------------------------------
|
||||
\ Usage:
|
||||
\ BEGIN-STRUCTURE POINT FIELD: P.X FIELD: P.Y END-STRUCTURE
|
||||
\ CREATE ORIGIN POINT ALLOT
|
||||
\ 1 ORIGIN P.X ! 2 ORIGIN P.Y !
|
||||
|
||||
\ Each defining word factored inline (CREATE .. DOES>). WAFER dispatches
|
||||
\ DOES>-defining words only at the outer interpreter, so they can't be
|
||||
\ factored through other compiled words (FIELD: -> +FIELD would no-op).
|
||||
|
||||
: BEGIN-STRUCTURE ( "name" -- struct-sys 0 )
|
||||
CREATE HERE 0 0 , DOES> @ ;
|
||||
|
||||
: END-STRUCTURE ( struct-sys +n -- )
|
||||
SWAP ! ;
|
||||
|
||||
: +FIELD ( n1 "name" n2 -- n3 )
|
||||
CREATE OVER , + DOES> @ + ;
|
||||
|
||||
: FIELD: ( n1 "name" -- n2 )
|
||||
CREATE ALIGNED DUP , 1 CELLS + DOES> @ + ;
|
||||
|
||||
: CFIELD: ( n1 "name" -- n2 )
|
||||
CREATE DUP , 1 CHARS + DOES> @ + ;
|
||||
|
||||
: FFIELD: ( n1 "name" -- n2 )
|
||||
CREATE FALIGNED DUP , 1 FLOATS + DOES> @ + ;
|
||||
|
||||
: SFFIELD: ( n1 "name" -- n2 )
|
||||
CREATE SFALIGNED DUP , 1 SFLOATS + DOES> @ + ;
|
||||
|
||||
: DFFIELD: ( n1 "name" -- n2 )
|
||||
CREATE DFALIGNED DUP , 1 DFLOATS + DOES> @ + ;
|
||||
|
||||
@@ -7675,6 +7675,42 @@ mod tests {
|
||||
assert_eq!(vm.take_output(), "test");
|
||||
}
|
||||
|
||||
// ===================================================================
|
||||
// Structures (BEGIN-STRUCTURE / +FIELD / FIELD: / CFIELD: / END-STRUCTURE)
|
||||
// ===================================================================
|
||||
|
||||
#[test]
|
||||
fn test_struct_basic_point() {
|
||||
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
|
||||
vm.evaluate("BEGIN-STRUCTURE POINT FIELD: P.X FIELD: P.Y END-STRUCTURE")
|
||||
.unwrap();
|
||||
vm.evaluate("POINT").unwrap();
|
||||
assert_eq!(vm.pop_data_stack().unwrap(), 8);
|
||||
|
||||
vm.evaluate("CREATE ORIGIN POINT ALLOT").unwrap();
|
||||
vm.evaluate("1 ORIGIN P.X ! 2 ORIGIN P.Y !").unwrap();
|
||||
vm.evaluate("ORIGIN P.X @ ORIGIN P.Y @").unwrap();
|
||||
assert_eq!(vm.data_stack(), vec![2, 1]);
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn test_struct_field_offsets() {
|
||||
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
|
||||
vm.evaluate("BEGIN-STRUCTURE REC FIELD: A FIELD: B FIELD: C END-STRUCTURE")
|
||||
.unwrap();
|
||||
vm.evaluate("REC 0 A 0 B 0 C").unwrap();
|
||||
assert_eq!(vm.data_stack(), vec![8, 4, 0, 12]);
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn test_struct_mixed_cfield() {
|
||||
let mut vm = ForthVM::<NativeRuntime>::new().unwrap();
|
||||
vm.evaluate("BEGIN-STRUCTURE MIX CFIELD: TAG FIELD: VAL END-STRUCTURE")
|
||||
.unwrap();
|
||||
vm.evaluate("MIX 0 TAG 0 VAL").unwrap();
|
||||
assert_eq!(vm.data_stack(), vec![4, 0, 8]);
|
||||
}
|
||||
|
||||
// ===================================================================
|
||||
// New words: RANDOM / RND-SEED
|
||||
// ===================================================================
|
||||
|
||||
Reference in New Issue
Block a user