forth!() macro, startup .fs, add build.sh

build.sh

@@ -0,0 +1 @@
+rustc frustration2.rs && cat frustration2.fs - | ./frustration2

frustration2.fs

@@ -0,0 +1,9 @@
+: lit  dup + 1 + , ;
+: setup  r>  r> dup >r >r  >r ;
+: rdrop  r>  r> drop  >r ;
+: loop[  [ ' setup lit ] , [ ' rdrop lit ] , ; immediate
+: ]loop  latest @ 8 + , ; immediate
+: (  loop[ 41 key = ? ret ]loop ; immediate
+
+: done  drop rdrop ret ;
+: stars ( n -- ) loop[ dup 0= ? done  1 -  42 emit ]loop ;

frustration2.rs

@@ -27,7 +27,6 @@ impl<const N: usize> Stack<N> {
     }
 }
 
-#[derive(Debug)]
 struct Core {
     ram: [u8; ADDRESS_SPACE],
     ip: u16,
@@ -75,7 +74,6 @@ impl Core {
 
 type Primitive = fn(&mut Core);
 
-#[derive(Copy, Clone)]
 enum Op {
     RET = 0xffe0, TOR = 0xffe2, RTO = 0xffe4, LD  = 0xffe6,
     ST  = 0xffe8, DUP = 0xffea, SWP = 0xffec, DRP = 0xffee,
@@ -187,6 +185,14 @@ struct Dict<'a> {
     c: &'a mut Core
 }
 
+enum Item {
+    Literal(u16),
+    Call(u16),
+    Opcode(Op)
+}
+impl From<u16> for Item { fn from(a: u16) -> Self { Item::Call(a) } }
+impl From<Op>  for Item { fn from(o: Op)  -> Self { Item::Opcode(o) } }
+
 impl Dict<'_> {
     fn allot(&mut self, n: u16) {
         self.here = self.here.wrapping_add(n);
@@ -197,17 +203,13 @@ impl Dict<'_> {
         self.allot(2);
     }
 
-    fn call(&mut self, val: u16) {
+    fn emit<T: Into<Item>>(&mut self, val: T) {
-        self.comma(val);
+        match val.into() {
-    }
+            Item::Call(val)    => { self.comma(val) }
-
+            Item::Opcode(val)  => { self.comma(val as u16) }
-    fn op(&mut self, val: Op) {
+            Item::Literal(val) => { assert!(val <= 0x7fff);
-        self.comma(val as u16);
+                                    self.comma((val << 1) | 1) }
-    }
+        }
-
-    fn lit(&mut self, val: u16) {
-        assert!(val <= 0x7fff);
-        self.comma((val << 1) | 1);
     }
 
     fn name(&mut self, n: u8, val: [u8; 3]) {
@@ -224,59 +226,60 @@ impl Dict<'_> {
 
 fn build_dictionary(c: &mut Core) {
     use Op::*;
+    use Item::*;
+
     let mut d = Dict {dp: 0, here: 2, c: c};
 
+    macro_rules! forth {
+        ($x:expr) => (d.emit($x));
+        ($x:expr, $($y:expr),+) => (d.emit($x); forth!($($y),+))
+    }
+
     // key ( -- n )
     d.entry(); d.name(3, *b"key");  let key = d.here;
-    d.lit(0); d.op(IO); d.op(RET);
+    forth!(Literal(0), IO, RET);
 
     // emit ( n -- )
     d.entry(); d.name(4, *b"emi");  let emit = d.here;
-    d.lit(1); d.op(IO); d.op(RET);
+    forth!(Literal(1), IO, RET);
 
     // - ( a b -- a-b )
     d.entry(); d.name(1, *b"-  ");  let sub = d.here;
-    d.op(INV); d.lit(1); d.op(ADD); d.op(ADD); d.op(RET);
+    forth!(INV, Literal(1), ADD, ADD, RET);
 
     // and ( a b -- a&b )
     d.entry(); d.name(3, *b"and");  let and = d.here;
-    d.op(INV); d.op(SWP); d.op(INV);
+    forth!(INV, SWP, INV, OR, INV, RET);
-    d.op(OR);
-    d.op(INV); d.op(RET);
 
     let zero = d.here;
-    d.lit(0); d.op(RTO); d.op(DRP); d.op(RET);
+    forth!(Literal(0), RTO, DRP, RET);
 
     // 0= ( n -- f )
     d.entry(); d.name(2, *b"0= ");  let zero_eq = d.here;
-    d.op(Q); d.call(zero); d.lit(0); d.op(INV); d.op(RET);
+    forth!(Q, zero, Literal(0), INV, RET);
 
     // >= ( a b -- a>=b )  // note: signed comparison
     d.entry(); d.name(2, *b">= ");  let geq = d.here;
-    d.call(sub); d.lit(0x4000); d.op(DUP); d.op(ADD); d.call(and);
+    forth!(sub, Literal(0x4000), DUP, ADD, and, zero_eq, RET);
-    d.call(zero_eq); d.op(RET);
 
     // = ( a b -- a=b )
     d.entry(); d.name(1, *b"=  ");  let eq = d.here;
-    d.call(sub); d.call(zero_eq); d.op(RET);
+    forth!(sub, zero_eq, RET);
 
     // Advance past whitespace
     let skip_helper = d.here;
-    d.op(RTO); d.op(DRP);
+    forth!(RTO, DRP, key, DUP, Literal(33), geq, Q, RET, DRP, skip_helper);
-    d.call(key); d.op(DUP); d.lit(33); d.call(geq); d.op(Q); d.op(RET);
-    d.op(DRP); d.call(skip_helper);
 
     d.entry(); d.name(6, *b"ski");  let skipws = d.here;
-    d.call(skip_helper);
+    forth!(skip_helper);
 
     // over ( a b -- a b a )
     d.entry(); d.name(4, *b"ove");  let over = d.here;
-    d.op(TOR); d.op(DUP); d.op(RTO); d.op(SWP);
+    forth!(TOR, DUP, RTO, SWP, RET);
-    d.op(RET);
 
     // 2dup ( a b -- a b a b )
     d.entry(); d.name(4, *b"2du");  let twodup = d.here;
-    d.call(over); d.call(over); d.op(RET);
+    forth!(over, over, RET);
 
     // Buffer for parsing an input word, formatted as Nabcde.
     let word_buf = d.here;
@@ -284,260 +287,203 @@ fn build_dictionary(c: &mut Core) {
 
     // min ( a b -- n )
     d.entry(); d.name(3, *b"min");  let min = d.here;
-    d.call(twodup);
+    forth!(twodup, geq, Q, SWP, DRP, RET);
-    d.call(geq); d.op(Q); d.op(SWP);
-    d.op(DRP); d.op(RET);
 
     // c@ ( a -- n )
     d.entry(); d.name(2, *b"c@ ");  let cld = d.here;
-    d.op(LD); d.lit(0xff); d.call(and); d.op(RET);
+    forth!(LD, Literal(0xff), and, RET);
 
     // c! ( n a -- )
     d.entry(); d.name(2, *b"c! ");  let cst = d.here;
-    d.op(DUP); d.op(LD); d.lit(0xff); d.op(INV); d.call(and);
+    forth!(DUP, LD, Literal(0xff), INV, and, SWP, TOR, OR, RTO, ST, RET);
-    d.op(SWP); d.op(TOR); d.op(OR); d.op(RTO);
-    d.op(ST); d.op(RET);
 
     // Load 1 letter into buffer.
     let stchar = d.here;
-    d.lit(word_buf); d.call(cld); d.lit(1); d.op(ADD); d.op(DUP);
+    forth!(Literal(word_buf), cld, Literal(1), ADD, DUP, Literal(word_buf), cst,
-    d.lit(word_buf); d.call(cst);
+           Literal(5), min, Literal(word_buf), ADD, cst, RET);
-    d.lit(5); d.call(min); d.lit(word_buf); d.op(ADD); d.call(cst);
-    d.op(RET);
 
     // Load letters into buffer until whitespace is hit again.
     // Return the whitespace character that was seen.
     let getcs_helper = d.here;
-    d.op(RTO); d.op(DRP);
+    forth!(RTO, DRP, stchar, key, DUP, Literal(32), SWP, geq, Q, RET, getcs_helper);
-    d.call(stchar);
-    d.call(key); d.op(DUP); d.lit(32); d.op(SWP);
-    d.call(geq); d.op(Q); d.op(RET); d.call(getcs_helper);
 
     d.entry(); d.name(5, *b"get");  let getcs = d.here;
-    d.call(getcs_helper); d.op(RET);
+    forth!(getcs_helper, RET);
 
     // word ( -- c )
     // Not quite standard.
     d.entry(); d.name(4, *b"wor");  let word = d.here;
-    // first clear the buffer
+    forth!(Literal(word_buf), DUP, Literal(2), ADD,
-    d.lit(word_buf); d.op(DUP); d.lit(2); d.op(ADD);
+           Literal(0x2020), SWP, ST, Literal(0x2000), SWP, ST,
-    d.lit(0x2020); d.op(SWP); d.op(ST);
+           skipws, getcs, RET);
-    d.lit(0x2000); d.op(SWP); d.op(ST);
-    // then load it
-    d.call(skipws); d.call(getcs); d.op(RET);
 
     // latest ( -- a )
     // Address of "latest" variable.  This variable stores the address of
     // the latest word in the dictionary.
     let latest_ptr = d.here; d.allot(2);
     d.entry(); d.name(6, *b"lat");  let latest = d.here;
-    d.lit(latest_ptr); d.op(RET);
+    forth!(Literal(latest_ptr), RET);
 
     let matches = d.here;
-    d.lit(2); d.op(ADD); d.op(TOR);
+    forth!(Literal(2), ADD, TOR,
-    d.lit(word_buf); d.op(DUP); d.lit(2); d.op(ADD); d.op(LD); d.op(SWP); d.op(LD);
+           Literal(word_buf), DUP, Literal(2), ADD, LD, SWP, LD,
-    d.op(RTO); d.op(DUP); d.op(TOR);
+           RTO, DUP, TOR,
-    d.op(LD); d.lit(0x0080); d.op(INV);  d.call(and); d.call(eq);
+           LD, Literal(0x0080), INV, and, eq,
-    d.op(SWP); d.op(RTO); d.lit(2); d.op(ADD); d.op(LD); d.call(eq); d.call(and); d.op(RET);
+           SWP, RTO, Literal(2), ADD, LD, eq, and, RET);
 
     let matched = d.here;
-    d.lit(6); d.op(ADD); d.op(RTO); d.op(DRP); d.op(RET);
+    forth!(Literal(6), ADD, RTO, DRP, RET);
 
     let find_helper = d.here;
-    d.op(RTO); d.op(DRP);
+    forth!(RTO, DRP,
-    d.op(DUP); d.lit(0); d.call(eq); d.op(Q); d.op(RET);
+           DUP, Literal(0), eq, Q, RET,
-    d.op(DUP); d.call(matches); d.op(Q); d.call(matched);
+           DUP, matches, Q, matched,
-    d.op(LD); d.call(find_helper);
+           LD, find_helper);
 
     // find ( -- xt|0 )
     d.entry(); d.name(4, *b"fin");  let find = d.here;
-    d.call(latest); d.op(LD); d.call(find_helper);
+    forth!(latest, LD, find_helper);
 
     // ' ( -- xt|0 )
     d.entry(); d.name(1, *b"'  ");
-    d.call(word); d.op(DRP); d.call(find); d.op(RET);
+    forth!(word, DRP, find, RET);
 
     /* --- The outer interpreter ---
     */
 
     // x10 ( n -- n*10 )
     d.entry(); d.name(3, *b"x10");  let x10 = d.here;
-    d.op(DUP); d.op(DUP);
+    forth!(DUP, DUP, Literal(3), SFT, ADD, ADD, RET);
-    d.lit(3); d.op(SFT); d.op(ADD); d.op(ADD); d.op(RET);
 
     // here ( -- a )
     // Address of "here" variable.  This variable stores the address of
     // the first free space in the dictionary
     let here_ptr = d.here; d.allot(2);
     d.entry(); d.name(4, *b"her");  let here = d.here;
-    d.lit(here_ptr); d.op(RET);
+    forth!(Literal(here_ptr), RET);
 
     // state ( -- a )
     // Address of "state" variable.  This variable stores -1 if
     // interpreting or 0 if compiling.
     let state_ptr = d.here; d.allot(2);
     d.entry(); d.name(5, *b"sta");  let state = d.here;
-    d.lit(state_ptr); d.op(RET);
+    forth!(Literal(state_ptr), RET);
 
     let word_addr = d.here;
-    d.lit(latest_ptr); d.op(LD); d.lit(2); d.op(ADD);
+    forth!(Literal(latest_ptr), LD, Literal(2), ADD, RET);
-    d.op(RET);
 
     // immediate ( -- )
     d.entry(); d.name(9 | 0x80, *b"imm");
-    d.call(word_addr);
+    forth!(word_addr, DUP, LD, Literal(0x0080), OR, SWP, ST, RET);
-    d.op(DUP); d.op(LD); d.lit(0x0080); d.op(OR);
-    d.op(SWP); d.op(ST); d.op(RET);
 
     // smudge ( -- )
     d.entry(); d.name(6 | 0x80, *b"smu");  let smudge = d.here;
-    d.call(word_addr);
+    forth!(word_addr, DUP, LD, Literal(0x0040), OR, SWP, ST, RET);
-    d.op(DUP); d.op(LD); d.lit(0x0040); d.op(OR);
-    d.op(SWP); d.op(ST); d.op(RET);
 
     // unsmudge ( -- )
     d.entry(); d.name(8 | 0x80, *b"uns");  let unsmudge = d.here;
-    d.call(word_addr);
+    forth!(word_addr, DUP, LD, Literal(0x0040), INV, and, SWP, ST, RET);
-    d.op(DUP); d.op(LD); d.lit(0x0040); d.op(INV); d.call(and);
-    d.op(SWP); d.op(ST); d.op(RET);
 
     // [ ( -- )
     d.entry(); d.name(1 | 0x80, *b"[  ");  let lbracket = d.here;
-    d.lit(0); d.op(INV); d.call(state); d.op(ST); d.op(RET);
+    forth!(Literal(0), INV, state, ST, RET);
 
     // ] ( -- )
     d.entry(); d.name(1 | 0x80, *b"]  ");  let rbracket = d.here;
-    d.lit(0); d.call(state); d.op(ST); d.op(RET);
+    forth!(Literal(0), state, ST, RET);
 
     // , ( n -- )
     d.entry(); d.name(1, *b",  "); let comma = d.here;
-    d.call(here); d.op(LD); d.op(ST);
+    forth!(here, LD, ST,
-    d.call(here); d.op(LD); d.lit(2); d.op(ADD);
+           here, LD, Literal(2), ADD, here, ST, RET);
-    d.call(here); d.op(ST);
-    d.op(RET);
 
     let compile_call = d.here;
-    d.op(DUP); d.lit(4); d.call(sub);
+    forth!(DUP, Literal(4), sub, LD, Literal(0x0080), and, state, LD, OR, Q, RET,
-    d.op(LD); d.lit(0x0080); d.call(and);
+           comma, RTO, DRP, RET);
-    d.call(state); d.op(LD); d.op(OR);
-    d.op(Q); d.op(RET);
-    d.call(comma); d.op(RTO); d.op(DRP); d.op(RET);
 
     let compile_lit = d.here;
-    d.call(state); d.op(LD);  d.op(Q); d.op(RET);
+    forth!(state, LD, Q, RET,
-    d.op(DUP); d.op(ADD); d.lit(1); d.op(ADD);
+           DUP, ADD, Literal(1), ADD, comma, RTO, DRP, RET);
-    d.call(comma); d.op(RTO); d.op(DRP); d.op(RET);
 
     let end_num = d.here;
-    d.op(DRP); d.op(RTO); d.op(DRP); d.op(RET);
+    forth!(DRP, RTO, DRP, RET);
 
     let bad_num = d.here;
-    d.op(DRP); d.op(DRP); d.op(DRP); d.lit(0); d.op(INV);
+    forth!(DRP, DRP, DRP, Literal(0), INV, RTO, DRP, RET);
-    d.op(RTO); d.op(DRP); d.op(RET);
 
     let number_helper = d.here;
-    d.op(RTO); d.op(DRP);
+    forth!(RTO, DRP, DUP, Literal(word_buf), ADD, cld,
-    d.op(DUP); d.lit(word_buf); d.op(ADD); d.call(cld);
+           Literal(48), sub, Literal(16383), and, // "unsigned comparison"
-    d.lit(48); d.call(sub); d.lit(16383); d.call(and); // "unsigned comparison"
+           DUP, Literal(10), geq, Q, bad_num,
-    d.op(DUP); d.lit(10); d.call(geq); d.op(Q); d.call(bad_num);
+           SWP, TOR, SWP, x10, ADD, RTO,
-    d.op(SWP); d.op(TOR); d.op(SWP); d.call(x10); d.op(ADD); d.op(RTO);
+           DUP, Literal(word_buf), cld, geq, Q, end_num,
-    d.op(DUP); d.lit(word_buf); d.call(cld); d.call(geq); d.op(Q); d.call(end_num);
+           Literal(1), ADD, number_helper);
-    d.lit(1); d.op(ADD); d.call(number_helper);
 
     // number ( -- n|-1 )
     d.entry(); d.name(6, *b"num");  let number = d.here;
-    d.lit(0); d.lit(1); d.call(number_helper);
+    forth!(Literal(0), Literal(1), number_helper);
 
     // execute ( xt -- )
     d.entry(); d.name(7, *b"exe");  let execute = d.here;
-    d.op(TOR); d.op(RET);
+    forth!(TOR, RET);
 
     let doit = d.here;
-    d.op(RTO); d.op(DRP);
+    forth!(RTO, DRP, compile_call, execute, RET);
-    d.call(compile_call); d.call(execute); d.op(RET);
 
     let bad = d.here;
-    d.op(DRP); d.lit(63); d.call(emit);
+    forth!(DRP, Literal(63), emit, RTO, DRP, RET);
-    d.op(RTO); d.op(DRP); d.op(RET);
 
     // dispatch ( xt -- )
     d.entry(); d.name(9, *b"int");  let dispatch = d.here;
-    d.op(DUP); d.op(Q); d.call(doit);
+    forth!(DUP, Q, doit,
-    d.op(DRP); d.call(number); d.op(DUP); d.lit(1); d.op(ADD);
+           DRP, number, DUP, Literal(1), ADD, zero_eq, Q, bad,
-    d.call(zero_eq); d.op(Q); d.call(bad);
+           compile_lit, RET);
-    d.call(compile_lit);
-    d.op(RET);
 
     // quit ( -- )
     d.entry(); d.name(4, *b"qui");  let quit = d.here;
-    d.call(word); d.op(DRP); d.call(find);
+    forth!(word, DRP, find, dispatch, quit);
-    d.call(dispatch); d.call(quit);
 
     // create ( -- )
     d.entry(); d.name(6, *b"cre");  let create = d.here;
-    d.call(word); d.op(DRP);
+    forth!(word, DRP,
-    d.call(here); d.op(LD);
+           here, LD, latest, LD, comma, latest, ST,
-    d.call(latest); d.op(LD); d.call(comma);
+           Literal(word_buf), DUP, LD, comma, Literal(2), ADD, LD, comma, RET);
-    d.call(latest); d.op(ST);
-    d.lit(word_buf); d.op(DUP); d.op(LD); d.call(comma);
-    d.lit(2); d.op(ADD); d.op(LD); d.call(comma);
-    d.op(RET);
 
     // : ( -- )
     d.entry(); d.name(1, *b":  ");
-    d.call(create); d.call(smudge); d.call(rbracket); d.op(RET);
+    forth!(create, smudge, rbracket, RET);
 
     // ; ( -- )
     d.entry(); d.name(1 | 0x80, *b";  ");
-    d.lit(!(RET as u16)); d.op(INV); d.call(comma);
+    forth!(Literal(!(RET as u16)), INV, comma, lbracket, unsmudge, RET);
-    d.call(lbracket); d.call(unsmudge); d.op(RET);
 
     // Finally put the primitives in the dictionary so they can be called directly.
-    d.entry(); d.name(3, *b"ret");
+    d.entry(); d.name(3, *b"ret"); forth!(RTO, DRP, RET);
-    d.op(RTO); d.op(DRP); d.op(RET);
+    d.entry(); d.name(2, *b">r "); forth!(RTO, SWP, TOR, TOR, RET);
+    d.entry(); d.name(2, *b"r> "); forth!(RTO, RTO, SWP, TOR, RET);
+    d.entry(); d.name(1, *b"@  "); forth!(LD, RET);
+    d.entry(); d.name(1, *b"!  "); forth!(ST, RET);
+    d.entry(); d.name(3, *b"dup"); forth!(DUP, RET);
+    d.entry(); d.name(4, *b"swa"); forth!(SWP, RET);
+    d.entry(); d.name(4, *b"dro"); forth!(DRP, RET);
 
-    d.entry(); d.name(2, *b">r ");
+    d.entry(); d.name(1 | 0x80, *b"?  "); // This one only works in-line.
-    d.op(RTO); d.op(SWP); d.op(TOR); d.op(TOR); d.op(RET);
+    forth!(Literal(!(Q as u16)), INV, comma, RET);
 
-    d.entry(); d.name(2, *b"r> ");
+    d.entry(); d.name(1, *b"+  "); forth!(ADD, RET);
-    d.op(RTO); d.op(RTO); d.op(SWP); d.op(TOR); d.op(RET);
+    d.entry(); d.name(5, *b"shi"); forth!(SFT, RET);
+    d.entry(); d.name(2, *b"or "); forth!(OR, RET);
+    d.entry(); d.name(6, *b"inv"); forth!(INV, RET);
+    d.entry(); d.name(2, *b"u< "); forth!(ULT, RET);
+    d.entry(); d.name(2, *b"io "); forth!(IO, RET);
 
-    d.entry(); d.name(1, *b"@  "); d.op(LD); d.op(RET);
+    d.entry(); d.name(3, *b"nop"); let nop = d.here; forth!(NOP, RET);
-    d.entry(); d.name(1, *b"!  "); d.op(ST); d.op(RET);
-    d.entry(); d.name(3, *b"dup"); d.op(DUP); d.op(RET);
-    d.entry(); d.name(4, *b"swa"); d.op(SWP); d.op(RET);
-    d.entry(); d.name(4, *b"dro"); d.op(DRP); d.op(RET);
-
-    d.entry(); d.name(1 | 0x80, *b"?  ");  // q is special
-    d.lit(!(Q as u16)); d.op(INV); d.call(comma); d.op(RET);
-
-    d.entry(); d.name(1, *b"+  "); d.op(ADD); d.op(RET);
-    d.entry(); d.name(5, *b"shi"); d.op(SFT); d.op(RET);
-    d.entry(); d.name(2, *b"or "); d.op(OR); d.op(RET);
-    d.entry(); d.name(6, *b"inv"); d.op(INV); d.op(RET);
-    d.entry(); d.name(2, *b"u< "); d.op(ULT); d.op(RET);
-    d.entry(); d.name(2, *b"io "); d.op(IO); d.op(RET);
-
-    d.entry(); d.name(3, *b"nop"); let nop = d.here;
-    d.op(NOP); d.op(RET);
 
     d.c.store(latest_ptr, nop-6);
     d.c.store(here_ptr, d.here);
     d.c.store(state_ptr, 0xffff);
-
     d.c.store(0, quit);
 }
-/*---
-: lit  dup + 1 + , ;
-: setup  r>  r> dup >r >r  >r ;
-: rdrop  r>  r> drop  >r ;
-: loop[  [ ' setup lit ] , [ ' rdrop lit ] , ; immediate
-: ]loop  latest @ 8 + , ; immediate
-: (  loop[ 41 key = ? ret ]loop ; immediate
-
-: done  drop rdrop ret ;
-: stars ( n -- ) loop[ dup 0= ? done  1 -  42 emit ]loop ;
-*/
 
 fn main() {
     let mut c = new_core();