Miroirs/frustration
1
0
Fork 0
mirror of https://gitlab.cs.washington.edu/fidelp/frustration.git synced 2024-12-25 21:58:11 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
psf 2022-05-17 22:30:29 -07:00
parent c093bc96fe
commit cd1310e803
3 changed files with 120 additions and 164 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
build.sh Normal file
View file

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

9
frustration2.fs Normal file
View file

@ -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 ;

272
frustration2.rs
View file

@ -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) {
self.comma(val);
fn emit<T: Into<Item>>(&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 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 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();