From cd1310e80396dc8773279f43bfc3d355c0c61695 Mon Sep 17 00:00:00 2001 From: psf Date: Tue, 17 May 2022 22:30:29 -0700 Subject: [PATCH] forth!() macro, startup .fs, add build.sh --- build.sh | 1 + frustration2.fs | 9 ++ frustration2.rs | 274 +++++++++++++++++++----------------------------- 3 files changed, 120 insertions(+), 164 deletions(-) create mode 100644 build.sh create mode 100644 frustration2.fs diff --git a/build.sh b/build.sh new file mode 100644 index 0000000..c945510 --- /dev/null +++ b/build.sh @@ -0,0 +1 @@ +rustc frustration2.rs && cat frustration2.fs - | ./frustration2 diff --git a/frustration2.fs b/frustration2.fs new file mode 100644 index 0000000..c4708b1 --- /dev/null +++ b/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 ; diff --git a/frustration2.rs b/frustration2.rs index b62ea36..368bfae 100644 --- a/frustration2.rs +++ b/frustration2.rs @@ -27,7 +27,6 @@ impl Stack { } } -#[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 for Item { fn from(a: u16) -> Self { Item::Call(a) } } +impl From 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) { - self.comma(val); - } - - fn op(&mut self, val: Op) { - self.comma(val as u16); - } - - fn lit(&mut self, val: u16) { - assert!(val <= 0x7fff); - self.comma((val << 1) | 1); + fn emit>(&mut self, val: T) { + match val.into() { + Item::Call(val) => { self.comma(val) } + Item::Opcode(val) => { self.comma(val as u16) } + Item::Literal(val) => { 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); - d.op(OR); - d.op(INV); d.op(RET); + forth!(INV, SWP, INV, OR, INV, 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); - d.call(zero_eq); d.op(RET); + forth!(sub, Literal(0x4000), DUP, ADD, and, zero_eq, 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); - 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); + forth!(RTO, DRP, key, DUP, Literal(33), geq, Q, RET, DRP, 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); - d.op(RET); + forth!(TOR, DUP, RTO, SWP, 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); - d.call(geq); d.op(Q); d.op(SWP); - d.op(DRP); d.op(RET); + forth!(twodup, geq, Q, SWP, DRP, 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); - d.op(SWP); d.op(TOR); d.op(OR); d.op(RTO); - d.op(ST); d.op(RET); + forth!(DUP, LD, Literal(0xff), INV, and, SWP, TOR, OR, RTO, ST, 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); - d.lit(word_buf); d.call(cst); - d.lit(5); d.call(min); d.lit(word_buf); d.op(ADD); d.call(cst); - d.op(RET); + forth!(Literal(word_buf), cld, Literal(1), ADD, DUP, Literal(word_buf), cst, + Literal(5), min, Literal(word_buf), ADD, cst, 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); - 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); + forth!(RTO, DRP, stchar, key, DUP, Literal(32), SWP, geq, Q, RET, 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 - d.lit(word_buf); d.op(DUP); d.lit(2); d.op(ADD); - d.lit(0x2020); d.op(SWP); d.op(ST); - d.lit(0x2000); d.op(SWP); d.op(ST); - // then load it - d.call(skipws); d.call(getcs); d.op(RET); + forth!(Literal(word_buf), DUP, Literal(2), ADD, + Literal(0x2020), SWP, ST, Literal(0x2000), SWP, ST, + skipws, getcs, 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); - d.lit(word_buf); d.op(DUP); d.lit(2); d.op(ADD); d.op(LD); d.op(SWP); d.op(LD); - d.op(RTO); d.op(DUP); d.op(TOR); - d.op(LD); d.lit(0x0080); d.op(INV); d.call(and); d.call(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); + forth!(Literal(2), ADD, TOR, + Literal(word_buf), DUP, Literal(2), ADD, LD, SWP, LD, + RTO, DUP, TOR, + LD, Literal(0x0080), INV, and, eq, + 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); - d.op(DUP); d.lit(0); d.call(eq); d.op(Q); d.op(RET); - d.op(DUP); d.call(matches); d.op(Q); d.call(matched); - d.op(LD); d.call(find_helper); + forth!(RTO, DRP, + DUP, Literal(0), eq, Q, RET, + DUP, matches, Q, matched, + 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); - d.lit(3); d.op(SFT); d.op(ADD); d.op(ADD); d.op(RET); + forth!(DUP, DUP, Literal(3), SFT, ADD, ADD, 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); - d.op(RET); + forth!(Literal(latest_ptr), LD, Literal(2), ADD, RET); // immediate ( -- ) d.entry(); d.name(9 | 0x80, *b"imm"); - d.call(word_addr); - d.op(DUP); d.op(LD); d.lit(0x0080); d.op(OR); - d.op(SWP); d.op(ST); d.op(RET); + forth!(word_addr, DUP, LD, Literal(0x0080), OR, SWP, ST, RET); // smudge ( -- ) d.entry(); d.name(6 | 0x80, *b"smu"); let smudge = d.here; - d.call(word_addr); - d.op(DUP); d.op(LD); d.lit(0x0040); d.op(OR); - d.op(SWP); d.op(ST); d.op(RET); + forth!(word_addr, DUP, LD, Literal(0x0040), OR, SWP, ST, RET); // unsmudge ( -- ) d.entry(); d.name(8 | 0x80, *b"uns"); let unsmudge = d.here; - d.call(word_addr); - d.op(DUP); d.op(LD); d.lit(0x0040); d.op(INV); d.call(and); - d.op(SWP); d.op(ST); d.op(RET); + forth!(word_addr, DUP, LD, Literal(0x0040), INV, and, SWP, ST, 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); - d.call(here); d.op(LD); d.lit(2); d.op(ADD); - d.call(here); d.op(ST); - d.op(RET); + forth!(here, LD, ST, + here, LD, Literal(2), ADD, here, ST, RET); let compile_call = d.here; - d.op(DUP); d.lit(4); d.call(sub); - d.op(LD); d.lit(0x0080); d.call(and); - 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); + forth!(DUP, Literal(4), sub, LD, Literal(0x0080), and, state, LD, OR, Q, RET, + comma, RTO, DRP, RET); let compile_lit = d.here; - d.call(state); d.op(LD); d.op(Q); d.op(RET); - d.op(DUP); d.op(ADD); d.lit(1); d.op(ADD); - d.call(comma); d.op(RTO); d.op(DRP); d.op(RET); + forth!(state, LD, Q, RET, + DUP, ADD, Literal(1), ADD, comma, RTO, DRP, 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); - d.op(RTO); d.op(DRP); d.op(RET); + forth!(DRP, DRP, DRP, Literal(0), INV, RTO, DRP, RET); let number_helper = d.here; - d.op(RTO); d.op(DRP); - d.op(DUP); d.lit(word_buf); d.op(ADD); d.call(cld); - d.lit(48); d.call(sub); d.lit(16383); d.call(and); // "unsigned comparison" - d.op(DUP); d.lit(10); d.call(geq); d.op(Q); d.call(bad_num); - d.op(SWP); d.op(TOR); d.op(SWP); d.call(x10); d.op(ADD); d.op(RTO); - d.op(DUP); d.lit(word_buf); d.call(cld); d.call(geq); d.op(Q); d.call(end_num); - d.lit(1); d.op(ADD); d.call(number_helper); + forth!(RTO, DRP, DUP, Literal(word_buf), ADD, cld, + Literal(48), sub, Literal(16383), and, // "unsigned comparison" + DUP, Literal(10), geq, Q, bad_num, + SWP, TOR, SWP, x10, ADD, RTO, + DUP, Literal(word_buf), cld, geq, Q, end_num, + Literal(1), ADD, 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); - d.call(compile_call); d.call(execute); d.op(RET); + forth!(RTO, DRP, compile_call, execute, RET); let bad = d.here; - d.op(DRP); d.lit(63); d.call(emit); - d.op(RTO); d.op(DRP); d.op(RET); + forth!(DRP, Literal(63), emit, RTO, DRP, RET); // dispatch ( xt -- ) d.entry(); d.name(9, *b"int"); let dispatch = d.here; - d.op(DUP); d.op(Q); d.call(doit); - d.op(DRP); d.call(number); d.op(DUP); d.lit(1); d.op(ADD); - d.call(zero_eq); d.op(Q); d.call(bad); - d.call(compile_lit); - d.op(RET); + forth!(DUP, Q, doit, + DRP, number, DUP, Literal(1), ADD, zero_eq, Q, bad, + compile_lit, RET); // quit ( -- ) d.entry(); d.name(4, *b"qui"); let quit = d.here; - d.call(word); d.op(DRP); d.call(find); - d.call(dispatch); d.call(quit); + forth!(word, DRP, find, dispatch, quit); // create ( -- ) d.entry(); d.name(6, *b"cre"); let create = d.here; - d.call(word); d.op(DRP); - d.call(here); d.op(LD); - d.call(latest); d.op(LD); d.call(comma); - 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); + forth!(word, DRP, + here, LD, latest, LD, comma, latest, ST, + Literal(word_buf), DUP, LD, comma, Literal(2), ADD, LD, comma, 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); - d.call(lbracket); d.call(unsmudge); d.op(RET); + forth!(Literal(!(RET as u16)), INV, comma, lbracket, unsmudge, RET); // Finally put the primitives in the dictionary so they can be called directly. - d.entry(); d.name(3, *b"ret"); - d.op(RTO); d.op(DRP); d.op(RET); + d.entry(); d.name(3, *b"ret"); forth!(RTO, DRP, 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.op(RTO); d.op(SWP); d.op(TOR); d.op(TOR); d.op(RET); + d.entry(); d.name(1 | 0x80, *b"? "); // This one only works in-line. + forth!(Literal(!(Q as u16)), INV, comma, RET); - d.entry(); d.name(2, *b"r> "); - d.op(RTO); d.op(RTO); d.op(SWP); d.op(TOR); d.op(RET); + d.entry(); d.name(1, *b"+ "); forth!(ADD, 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(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.entry(); d.name(3, *b"nop"); let nop = d.here; forth!(NOP, 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();