diff --git a/README.md b/README.md index 34cc98e..e333aba 100644 --- a/README.md +++ b/README.md @@ -1,41 +1,2 @@ Forth in Rust. -FRUSTRATION has got a foot standing on its own tail because writing a -monolithic outer interpreter in a high level language makes it really -annoying to monkey with the functioning of the interpreter from within -the language it's interpreting. PARSE/WORD and the input stream -handling was the first place this became obvious. This design is a -dead end. The path forward would be stripping it back to primitives -and rewriting the outer interpreter in Forth. - -Here are things it can do today: - -Print some terms of the fibonacci sequence: -``` -: over >r dup r> swap ; -: fib recursive r> drop over + swap dup . dup 144 - ? fib ; -: fib 1 0 fib ; - -fib -1 1 2 3 5 8 13 21 34 55 89 144 ok -``` - -Compute the number of cans in a triangular stack of height n. -For example a stack of height 3 contains 6 cans. -``` - x - x x -x x x -``` - -``` -variable cans -: c recursive r> drop dup cans @ + cans ! 1 - dup ? c ; -: c c ; -: can-stack 0 cans ! c cans @ ; - -3 can-stack . -6 ok -10 can-stack . -55 ok -``` diff --git a/build.sh b/build.sh index c945510..134fe28 100644 --- a/build.sh +++ b/build.sh @@ -1 +1 @@ -rustc frustration2.rs && cat frustration2.fs - | ./frustration2 +rustc frustration.rs && cat frustration.fs - | ./frustration diff --git a/frustration2.fs b/frustration.fs similarity index 100% rename from frustration2.fs rename to frustration.fs diff --git a/frustration.rs b/frustration.rs index 38d7db1..5c63679 100644 --- a/frustration.rs +++ b/frustration.rs @@ -1,535 +1,490 @@ +/* --- The virtual CPU --- +*/ + use std::io; +use std::io::Read; +use std::io::Write; use std::convert::TryInto; - -#[derive(Debug, Eq, PartialEq)] -enum State { - Compiling, - Interpreting -} - -#[derive(Debug)] -enum Post { - Nothing, - EatWord, - WarmReset, -} - const ADDRESS_SPACE: usize = 65535; -const STACK_WORDS: usize = 16; -const RAM_BYTES: usize = ADDRESS_SPACE - 2*2*STACK_WORDS; #[derive(Debug)] +struct Stack { + mem: [u16; N], + tos: usize +} + +impl Stack { + fn push(&mut self, val: u16) { + self.tos = (self.tos.wrapping_add(1)) & (N - 1); + self.mem[self.tos] = val; + } + + fn pop(&mut self) -> u16 { + let val = self.mem[self.tos]; + self.mem[self.tos] = 0; + self.tos = (self.tos.wrapping_sub(1)) & (N - 1); + return val; + } +} + struct Core { - ram: [u8; RAM_BYTES], + ram: [u8; ADDRESS_SPACE], ip: u16, - dp: u16, // newest link field, or 0 - here: u16, // first unused byte - state: State, - next_token: Option, - post: Post, - dstack: [u16; STACK_WORDS], - tds: usize, // post-incremented; exceeds top by one - rstack: [u16; STACK_WORDS], - trs: usize, // post-incremented; exceeds top by one + dstack: Stack<32>, + rstack: Stack<32> +} + +fn new_core() -> Core { + let c = Core { + ram: [0; ADDRESS_SPACE], + ip: 0, + dstack: Stack {tos: 0, mem: [0; 32]}, + rstack: Stack {tos: 0, mem: [0; 32]}}; + return c; +} + +impl Core { + fn load(&self, addr: u16) -> u16 { + let a = addr as usize; + return u16::from_le_bytes(self.ram[a..=a+1].try_into().unwrap()); + } + + fn store(&mut self, addr: u16, val: u16) { + let a = addr as usize; + self.ram[a..=a+1].copy_from_slice(&val.to_le_bytes()); + } + + fn step(&mut self) { + let opcode = self.load(self.ip); + self.ip = self.ip.wrapping_add(2); + if (opcode >= 0xffe0) && (opcode & 1 == 0) { + PRIMITIVES[((opcode - 0xffe0) >> 1) as usize](self); + } + else if (opcode & 1) == 1 { + // Literal + self.dstack.push(opcode >> 1); + } + else { + // Call + self.rstack.push(self.ip); + self.ip = opcode; + } + } } type Primitive = fn(&mut Core); -struct ShortName { - bytes: [u8; 3], - length: u8 +enum Op { + RET = 0xffe0, TOR = 0xffe2, RTO = 0xffe4, LD = 0xffe6, + ST = 0xffe8, DUP = 0xffea, SWP = 0xffec, DRP = 0xffee, + Q = 0xfff0, ADD = 0xfff2, SFT = 0xfff4, OR = 0xfff6, + AND = 0xfff8, INV = 0xfffa, GEQ = 0xfffc, IO = 0xfffe, } -fn truncate_name(name: &str) -> ShortName { - let name_bytes = name.as_bytes(); - let mut out = ShortName { - bytes: *b" ", - length: name_bytes.len() as u8 }; - let n = std::cmp::min(3, out.length) as usize; - out.bytes[0..n].copy_from_slice(&name_bytes[0..n]); - return out; -} - -struct TableEntry { - f: Primitive, - name: Option, - immediate: bool -} - -const PRIMITIVES: [TableEntry; 31] = [ - TableEntry {f: ret , name: None, immediate: false}, - TableEntry {f: lit , name: None, immediate: false}, - TableEntry {f: add , name: Some(ShortName {bytes: *b"+ ", length: 1}), immediate: false}, - TableEntry {f: call , name: Some(ShortName {bytes: *b"cal", length: 4}), immediate: false}, - TableEntry {f: comma_d , name: Some(ShortName {bytes: *b", ", length: 1}), immediate: false}, - TableEntry {f: create_d, name: Some(ShortName {bytes: *b"cre", length: 6}), immediate: false}, - TableEntry {f: div , name: Some(ShortName {bytes: *b"/ ", length: 1}), immediate: false}, - TableEntry {f: dot , name: Some(ShortName {bytes: *b". ", length: 1}), immediate: false}, - TableEntry {f: dots , name: Some(ShortName {bytes: *b".s ", length: 2}), immediate: false}, - TableEntry {f: drop , name: Some(ShortName {bytes: *b"dro", length: 4}), immediate: false}, - TableEntry {f: dup , name: Some(ShortName {bytes: *b"dup", length: 3}), immediate: false}, - TableEntry {f: dump , name: Some(ShortName {bytes: *b"dum", length: 4}), immediate: false}, - TableEntry {f: forget , name: Some(ShortName {bytes: *b"for", length: 6}), immediate: false}, - TableEntry {f: from_r_d, name: Some(ShortName {bytes: *b"r> ", length: 2}), immediate: false}, - TableEntry {f: here , name: Some(ShortName {bytes: *b"her", length: 4}), immediate: false}, - TableEntry {f: if_skip ,name: Some(ShortName {bytes: *b"? ", length: 1}), immediate: false}, - TableEntry {f: immediate,name: Some(ShortName {bytes: *b"imm", length: 9}), immediate: false}, - TableEntry {f: latest , name: Some(ShortName {bytes: *b"lat", length: 6}), immediate: false}, - TableEntry {f: lbracket, name: Some(ShortName {bytes: *b"[ ", length: 1}), immediate: true}, - TableEntry {f: load , name: Some(ShortName {bytes: *b"@ ", length: 1}), immediate: false}, - TableEntry {f: mul , name: Some(ShortName {bytes: *b"* ", length: 1}), immediate: false}, - TableEntry {f: ret_d , name: Some(ShortName {bytes: *b"ret", length: 3}), immediate: false}, - TableEntry {f: rbracket, name: Some(ShortName {bytes: *b"] ", length: 1}), immediate: false}, - TableEntry {f: smudge , name: Some(ShortName {bytes: *b"smu", length: 6}), immediate: false}, - TableEntry {f: store , name: Some(ShortName {bytes: *b"! ", length: 1}), immediate: false}, - TableEntry {f: sub , name: Some(ShortName {bytes: *b"- ", length: 1}), immediate: false}, - TableEntry {f: swap , name: Some(ShortName {bytes: *b"swa", length: 4}), immediate: false}, - TableEntry {f: tick , name: Some(ShortName {bytes: *b"' ", length: 1}), immediate: false}, - TableEntry {f: to_r_d , name: Some(ShortName {bytes: *b">r ", length: 2}), immediate: false}, - TableEntry {f: unsmudge, name: Some(ShortName {bytes: *b"uns", length: 8}), immediate: false}, - TableEntry {f: word , name: Some(ShortName {bytes: *b"wor", length: 4}), immediate: false} +const PRIMITIVES: [Primitive; 16] = [ + | x | { /* ret */ x.ip = x.rstack.pop() }, + | x | { /* >r */ x.rstack.push(x.dstack.pop()) }, + | x | { /* r> */ x.dstack.push(x.rstack.pop()) }, + | x | { // ld + let a = x.dstack.pop(); + x.dstack.push(x.load(a)); + }, + | x | { // st + let a = x.dstack.pop(); + let v = x.dstack.pop(); + x.store(a, v); + }, + | x | { // dup + let v = x.dstack.pop(); + x.dstack.push(v); + x.dstack.push(v); + }, + | x | { // swp + let v1 = x.dstack.pop(); + let v2 = x.dstack.pop(); + x.dstack.push(v1); + x.dstack.push(v2); + }, + | x | { /* drp */ let _ = x.dstack.pop(); }, + | x | { // ? + let f = x.dstack.pop(); + if f == 0 { + x.ip = x.ip.wrapping_add(2) + }; + }, + | x | { // add + let v1 = x.dstack.pop(); + let v2 = x.dstack.pop(); + x.dstack.push(v1.wrapping_add(v2)); + }, + | x | { // sft + let amt = x.dstack.pop(); + let val = x.dstack.pop(); + x.dstack.push( + if amt <= 0xf { + val << amt + } else if amt >= 0xfff0 { + val >> (0xffff - amt + 1) + } else { + 0 + } + ); + }, + | x | { // or + let v1 = x.dstack.pop(); + let v2 = x.dstack.pop(); + x.dstack.push(v1 | v2); + }, + | x | { // and + let v1 = x.dstack.pop(); + let v2 = x.dstack.pop(); + x.dstack.push(v1 & v2); + }, + | x | { // inv + let v1 = x.dstack.pop(); + x.dstack.push(!v1); + }, + | x | { // geq (unsigned) + let v2 = x.dstack.pop(); + let v1 = x.dstack.pop(); + x.dstack.push(if v1 >= v2 { 0xffff } else { 0 }); + }, + | x | { // io + let port = x.dstack.pop(); + match port { + 0 => { + let mut buf: [u8; 1] = [0]; + let _ = io::stdin().read(&mut buf); + x.dstack.push(buf[0] as u16); + } + 1 => { + let val = x.dstack.pop(); + print!("{}", ((val & 0xff) as u8) as char); + let _ = io::stdout().flush(); + } + 2 => { + println!("{} {:?} {:?}", x.ip, x.dstack, x.rstack); + let _ = io::stdout().flush(); + } + _ => {} + } + } ]; -fn new_core() -> Core { - let mut c = Core { - ram: [0; RAM_BYTES], ip: 0, dp: 0, here: 2, state: State::Interpreting, - next_token: None, - post: Post::Nothing, - dstack: [0; STACK_WORDS], tds: 0, - rstack: [0; STACK_WORDS], trs: 0 }; - init_dictionary(&mut c); +/* --- The memory map --- +*/ - let autoexec = [ - "create : ] create smudge ] [ 65535 ,", - "create ; ] unsmudge 65535 , [ ' [ , 65535 , immediate", - ": recursive unsmudge ; immediate", - ": literal 65534 , , ; immediate", - ": constant create [ ' literal , ] [ ' ret ] literal , ;", - ": variable create here 6 + [ ' literal , ] [ ' ret ] literal , 0 , ;" - ]; +/* --- The dictionary format --- +*/ - for s in autoexec { - outer(&mut c, s); +/* --- The threading kind --- +*/ + +/* --- Create the dictionary --- +*/ + +struct Dict<'a> { + dp: u16, + here: u16, + 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); } - return c; -} + fn comma(&mut self, val: u16) { + self.c.store(self.here, val); + self.allot(2); + } -// --- Dictionary management --- - -fn init_dictionary(c: &mut Core) { - let mut opcode = 65535; - for p in PRIMITIVES { - match p.name { - Some(name) => { - create(c, name); - if p.immediate { - immediate(c); - } - comma(c, opcode); - comma(c, 65535); // ret - } - None => {} - } - opcode -= 1; - } -} - -fn create(c: &mut Core, name: ShortName) { - let addr: usize = c.here as usize; - c.ram[addr+0..=addr+1].copy_from_slice(&c.dp.to_le_bytes()); - c.dp = addr as u16; - c.ram[addr+2] = name.length & 0x7f; - c.ram[addr+3..=addr+5].copy_from_slice(&name.bytes); - c.here = (addr+6) as u16; -} - -fn create_d(c: &mut Core) { - match &c.next_token { - Some(t) => { - let short_name = truncate_name(t); - create(c, short_name); - c.post = Post::EatWord; - } - _ => { - println!(" create needs an argument"); - c.post = Post::WarmReset; + 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 find(c: &mut Core, name: ShortName) -> Option { - let mut addr = c.dp as usize; - while addr != 0 { - if (c.ram[addr+2] & 0x7f) == name.length { - if c.ram[addr+3..=addr+5] == name.bytes { - return Some((addr+6) as u16); - } - } - addr = u16::from_le_bytes(c.ram[addr..=addr+1].try_into().unwrap()) as usize; + fn name(&mut self, n: u8, val: [u8; 3]) { + self.comma(n as u16 | ((val[0] as u16) << 8)); + self.comma(val[1] as u16 | ((val[2] as u16) << 8)); } - return None; -} -fn smudge(c: &mut Core) { - c.ram[(c.dp as usize) + 2] |= 0x40; -} - -fn unsmudge(c: &mut Core) { - c.ram[(c.dp as usize) + 2] &= 0xbf; -} - -fn immediate(c: &mut Core) { - c.ram[(c.dp as usize) + 2] ^= 0x80; -} - -fn is_immediate(c: &mut Core, addr: u16) -> bool { - return (c.ram[(addr as usize) - 4] & 0x80) != 0; -} - -fn tick(c: &mut Core) { - match &c.next_token { - Some(t) => { - let name = t.to_string(); - let addr = find(c, truncate_name(&name)); - match addr { - Some(xt) => { - push(c, xt); - c.post = Post::EatWord; - } - None => { - println!(" ' cannot find {}", name); - c.post = Post::WarmReset; - } - } - } - _ => { - println!(" ' needs an argument"); - c.post = Post::WarmReset; - } + fn entry(&mut self) { + let here = self.here; + self.comma(self.dp); + self.dp = here; } } -fn comma(c: &mut Core, val: u16) { - let addr = c.here as usize; - c.ram[addr..=addr+1].copy_from_slice(&val.to_le_bytes()); - c.here += 2; -} +fn build_dictionary(c: &mut Core) { + use Op::*; + use Item::*; -fn comma_d(c: &mut Core) { - let val = pop(c); - comma(c, val); -} + let mut d = Dict {dp: 0, here: 2, c: c}; -// --- Memory management --- - -fn store(c: &mut Core) { - let addr = pop(c) as usize; - let val = pop(c); - c.ram[addr..=addr+1].copy_from_slice(&val.to_le_bytes()); -} - -fn load(c: &mut Core) { - let addr = pop(c) as usize; - push(c, u16::from_le_bytes(c.ram[addr..=addr+1].try_into().unwrap())); -} - -fn forget(c: &mut Core) { - let xt = pop(c); - c.here = xt - 6; - let i = c.here as usize; - c.dp = u16::from_le_bytes(c.ram[i..=i+1].try_into().unwrap()); -} - -// --- Stack management --- - -fn push(c: &mut Core, val: u16) { - c.dstack[c.tds] = val; - c.tds += 1; -} - -fn pop(c: &mut Core) -> u16 { - if c.tds == 0 { - println!(" stack underflow"); - c.post = Post::WarmReset; // note: could get overwritten later :( - return 0; // half-assed, should really return straight to interpreter - } else { - c.tds -= 1; - return c.dstack[c.tds]; + macro_rules! forth { + ($x:expr) => (d.emit($x)); + ($x:expr, $($y:expr),+) => (d.emit($x); forth!($($y),+)) } -} -fn dup(c: &mut Core) { - let val = pop(c); - push(c, val); - push(c, val); -} + // key ( -- n ) + d.entry(); d.name(3, *b"key"); let key = d.here; + forth!(Literal(0), IO, RET); -fn swap(c: &mut Core) { - let val1 = pop(c); - let val2 = pop(c); - push(c, val1); - push(c, val2); -} + // emit ( n -- ) + d.entry(); d.name(4, *b"emi"); let emit = d.here; + forth!(Literal(1), IO, RET); -fn drop(c: &mut Core) { - let _ = pop(c); -} + // - ( a b -- a-b ) + d.entry(); d.name(1, *b"- "); let sub = d.here; + forth!(INV, Literal(1), ADD, ADD, RET); -fn to_r(c: &mut Core, val: u16) { - c.rstack[c.trs] = val; - c.trs += 1; -} + let zero = d.here; + forth!(Literal(0), RTO, DRP, RET); -fn to_r_d(c: &mut Core) { - let r1 = from_r(c); - let r2 = pop(c); - to_r(c, r2); - to_r(c, r1); -} + // 0= ( n -- f ) + d.entry(); d.name(2, *b"0= "); let zero_eq = d.here; + forth!(Q, zero, Literal(0), INV, RET); -fn from_r(c: &mut Core) -> u16 { - c.trs -= 1; - return c.rstack[c.trs]; -} + // = ( a b -- a=b ) + d.entry(); d.name(1, *b"= "); let eq = d.here; + forth!(sub, zero_eq, RET); -fn from_r_d(c: &mut Core) { - let r1 = from_r(c); - let r2 = from_r(c); - to_r(c, r1); - push(c, r2); -} + // Advance past whitespace + let skip_helper = d.here; + forth!(RTO, DRP, key, DUP, Literal(33), GEQ, Q, RET, DRP, skip_helper); -fn call(c: &mut Core) { - to_r(c, c.ip); - c.ip = pop(c); -} + d.entry(); d.name(6, *b"ski"); let skipws = d.here; + forth!(skip_helper); -// note: this is an inline primitive, not a dict entry -fn ret(c: &mut Core) { - if c.trs == 0 { - std::process::exit(0); - } - c.ip = from_r(c); -} + // over ( a b -- a b a ) + d.entry(); d.name(4, *b"ove"); let over = d.here; + forth!(TOR, DUP, RTO, SWP, RET); -fn ret_d(c: &mut Core) { - _ = from_r(c); - ret(c); -} + // 2dup ( a b -- a b a b ) + d.entry(); d.name(4, *b"2du"); let twodup = d.here; + forth!(over, over, RET); -// --- Control flow --- -fn if_skip(c: &mut Core) { - let truthy = pop(c); - let retaddr = from_r(c); - to_r(c, retaddr + if truthy == 0 { 2 } else { 0 }); -} + // Buffer for parsing an input word, formatted as Nabcde. + let word_buf = d.here; + d.allot(6); -// --- I/O --- -fn dot(c: &mut Core) { - print!("{} ", pop(c)); -} + // min ( a b -- n ) + d.entry(); d.name(3, *b"min"); let min = d.here; + forth!(twodup, GEQ, Q, SWP, DRP, RET); -fn dots(c: &mut Core) { - for i in &c.dstack[0..c.tds] { - print!("{} ", i); - } -} + // c@ ( a -- n ) + d.entry(); d.name(2, *b"c@ "); let cld = d.here; + forth!(LD, Literal(0xff), AND, RET); -fn dump(c: &mut Core) { - println!("{:?}", c); -} + // c! ( n a -- ) + d.entry(); d.name(2, *b"c! "); let cst = d.here; + forth!(DUP, LD, Literal(0xff), INV, AND, SWP, TOR, OR, RTO, ST, RET); -fn word(c: &mut Core) { - match &c.next_token { - Some(t) => { - println!("{}", t); - c.post = Post::EatWord; - } - _ => {} - } -} + // Load 1 letter into buffer. + let stchar = d.here; + forth!(Literal(word_buf), cld, Literal(1), ADD, DUP, Literal(word_buf), cst, + Literal(5), min, Literal(word_buf), ADD, cst, RET); -// --- Math and logic --- + // Load letters into buffer until whitespace is hit again. + // Return the whitespace character that was seen. + let getcs_helper = d.here; + forth!(RTO, DRP, stchar, key, DUP, Literal(32), SWP, GEQ, Q, RET, getcs_helper); -// note: this is an inline primitive, not a dict entry -fn lit(c: &mut Core) { - let ip = c.ip as usize; - push(c, u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap())); - c.ip += 2; -} + d.entry(); d.name(5, *b"get"); let getcs = d.here; + forth!(getcs_helper, RET); -fn add(c: &mut Core) { - let v1 = pop(c); - let v2 = pop(c); - push(c, v1.wrapping_add(v2)); -} + // word ( -- ) + // Not quite standard. + d.entry(); d.name(4, *b"wor"); let word = d.here; + forth!(Literal(word_buf), DUP, Literal(2), ADD, + Literal(0x2020), SWP, ST, Literal(0x2000), SWP, ST, + skipws, getcs, DRP, RET); -fn sub(c: &mut Core) { - let v1 = pop(c); - let v2 = pop(c); - push(c, v2.wrapping_sub(v1)); -} + // 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; + forth!(Literal(latest_ptr), RET); -fn mul(c: &mut Core) { - let v1 = pop(c); - let v2 = pop(c); - push(c, v1.saturating_mul(v2)); -} + let matches = d.here; + 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); -fn div(c: &mut Core) { - let v1 = pop(c); - let v2 = pop(c); - push(c, v2.saturating_div(v1)); -} + let matched = d.here; + forth!(Literal(6), ADD, RTO, DRP, RET); -// --- Inner interpreter --- + let find_helper = d.here; + forth!(RTO, DRP, + DUP, Literal(0), eq, Q, RET, + DUP, matches, Q, matched, + LD, find_helper); -fn fetch(c: &mut Core) -> u16 { - let ip = c.ip as usize; - let opcode = u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap()); - c.ip += 2; - return opcode; -} + // find ( -- xt|0 ) + d.entry(); d.name(4, *b"fin"); let find = d.here; + forth!(latest, LD, find_helper); -fn execute(c: &mut Core, opcode: u16) { - let primitive_index = (65535 - opcode) as usize; - if primitive_index < PRIMITIVES.len() { - (PRIMITIVES[primitive_index].f)(c); - } else { - // call - to_r(c, c.ip); - c.ip = opcode; - } -} + // ' ( -- xt|0 ) + d.entry(); d.name(1, *b"' "); + forth!(word, find, RET); -fn step(c: &mut Core) { - let opcode = fetch(c); - execute(c, opcode); -} + /* --- The outer interpreter --- + */ -fn inner(c: &mut Core) { - loop { - step(c); - //println!("ip={} trs={}", c.ip, c.trs); - if c.trs == 0 { - break; - } - } -} + // x10 ( n -- n*10 ) + d.entry(); d.name(3, *b"x10"); let x10 = d.here; + forth!(DUP, DUP, Literal(3), SFT, ADD, ADD, RET); -// --- Outer interpreter --- + // 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; + forth!(Literal(here_ptr), RET); -fn lbracket(c: &mut Core) { - c.state = State::Interpreting; -} + // 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; + forth!(Literal(state_ptr), RET); -fn rbracket(c: &mut Core) { - c.state = State::Compiling; -} + let word_addr = d.here; + forth!(Literal(latest_ptr), LD, Literal(2), ADD, RET); -fn latest(c: &mut Core) { - push(c, c.dp); -} + // immediate ( -- ) + d.entry(); d.name(9 | 0x80, *b"imm"); + forth!(word_addr, DUP, LD, Literal(0x0080), OR, SWP, ST, RET); -fn here(c: &mut Core) { - push(c, c.here); -} + // smudge ( -- ) + d.entry(); d.name(6 | 0x80, *b"smu"); let smudge = d.here; + forth!(word_addr, DUP, LD, Literal(0x0040), OR, SWP, ST, RET); -fn outer(c: &mut Core, s: &str) { - let ss = s.trim(); - let mut tokens = ss.split(" ").peekable(); - loop { - c.post = Post::Nothing; - match tokens.next() { - Some(t) => { - c.next_token = match tokens.peek() { - Some(t) => { Some(t.to_string()) } - None => { None } - }; - match find(c, truncate_name(t)) { - Some(addr) => { - if c.state == State::Interpreting || is_immediate(c, addr) { - to_r(c, c.ip); - c.ip = addr; - inner(c); - } else { - comma(c, addr); - } - } - None => { - let val = t.parse::(); - match val { - Ok(n) => { - match c.state { - State::Interpreting => { push(c, n) } - State::Compiling => { - comma(c, 65534); // lit - comma(c, n); - } - } - } - Err(_) => { - if t != "" { - println!("{}?", t); - c.post = Post::WarmReset; - } - } - } - } - } - } - None => { break ; } - } - match c.post { - Post::EatWord => { _ = tokens.next(); } - Post::WarmReset => { - c.tds = 0; - c.trs = 0; - c.state = State::Interpreting; - break; // discard rest of input line - } - Post::Nothing => { } - }; - } + // unsmudge ( -- ) + d.entry(); d.name(8 | 0x80, *b"uns"); let unsmudge = d.here; + forth!(word_addr, DUP, LD, Literal(0x0040), INV, AND, SWP, ST, RET); + + // [ ( -- ) + d.entry(); d.name(1 | 0x80, *b"[ "); let lbracket = d.here; + forth!(Literal(0), INV, state, ST, RET); + + // ] ( -- ) + d.entry(); d.name(1 | 0x80, *b"] "); let rbracket = d.here; + forth!(Literal(0), state, ST, RET); + + // , ( n -- ) + d.entry(); d.name(1, *b", "); let comma = d.here; + forth!(here, LD, ST, + here, LD, Literal(2), ADD, here, ST, RET); + + let compile_call = d.here; + forth!(DUP, Literal(4), sub, LD, Literal(0x0080), AND, state, LD, OR, Q, RET, + comma, RTO, DRP, RET); + + let compile_lit = d.here; + forth!(state, LD, Q, RET, + DUP, ADD, Literal(1), ADD, comma, RTO, DRP, RET); + + let end_num = d.here; + forth!(DRP, RTO, DRP, RET); + + let bad_num = d.here; + forth!(DRP, DRP, DRP, Literal(0), INV, RTO, DRP, RET); + + let number_helper = d.here; + forth!(RTO, DRP, DUP, Literal(word_buf), ADD, cld, + Literal(48), sub, 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; + forth!(Literal(0), Literal(1), number_helper); + + // execute ( xt -- ) + d.entry(); d.name(7, *b"exe"); let execute = d.here; + forth!(TOR, RET); + + let doit = d.here; + forth!(RTO, DRP, compile_call, execute, RET); + + let bad = d.here; + forth!(DRP, Literal(63), emit, RTO, DRP, RET); + + // dispatch ( xt -- ) + d.entry(); d.name(9, *b"int"); let dispatch = d.here; + 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; + forth!(word, find, dispatch, quit); + + // create ( -- ) + d.entry(); d.name(6, *b"cre"); let create = d.here; + forth!(word, + 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": "); + forth!(create, smudge, rbracket, RET); + + // ; ( -- ) + d.entry(); d.name(1 | 0x80, *b"; "); + 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"); 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(1 | 0x80, *b"? "); // This one only works in-line. + forth!(Literal(!(Q as u16)), INV, comma, 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(3, *b"and"); forth!(AND, RET); + d.entry(); d.name(3, *b"inv"); forth!(INV, RET); + d.entry(); d.name(3, *b"u>="); forth!(GEQ, RET); + d.entry(); d.name(2, *b"io "); let io = d.here; forth!(IO, RET); + + d.c.store(latest_ptr, io-6); + d.c.store(here_ptr, d.here); + d.c.store(state_ptr, 0xffff); + d.c.store(0, quit); } fn main() { let mut c = new_core(); + build_dictionary(&mut c); + c.ip = 0; loop { - let mut buf = String::new(); - match io::stdin().read_line(&mut buf) { - Ok(_) => { - outer(&mut c, &buf); - match c.state { - State::Interpreting => {println!(" ok")} - State::Compiling => {} - }; - } - Err(_) => { break; } - } + c.step(); } } -/* -: dog recursive r> drop dup . 1 - dup ? dog ; -: dog dog ; -100 dog -*/ - -/* TODO LIST - * 0= - * allot, cell, cells - * base - * c@ and c! - * comments ( ) - * comments \ - * emit - * forth-style line parsing, instead of pre-baked str::split(" "). - * key - * recursive with more creature comforts - * see - * startup message "XXXXX bytes free" - * strings ." this", s" that", etc. - * words - */ diff --git a/frustration2.rs b/frustration2.rs deleted file mode 100644 index 5c63679..0000000 --- a/frustration2.rs +++ /dev/null @@ -1,490 +0,0 @@ -/* --- The virtual CPU --- -*/ - -use std::io; -use std::io::Read; -use std::io::Write; -use std::convert::TryInto; -const ADDRESS_SPACE: usize = 65535; - -#[derive(Debug)] -struct Stack { - mem: [u16; N], - tos: usize -} - -impl Stack { - fn push(&mut self, val: u16) { - self.tos = (self.tos.wrapping_add(1)) & (N - 1); - self.mem[self.tos] = val; - } - - fn pop(&mut self) -> u16 { - let val = self.mem[self.tos]; - self.mem[self.tos] = 0; - self.tos = (self.tos.wrapping_sub(1)) & (N - 1); - return val; - } -} - -struct Core { - ram: [u8; ADDRESS_SPACE], - ip: u16, - dstack: Stack<32>, - rstack: Stack<32> -} - -fn new_core() -> Core { - let c = Core { - ram: [0; ADDRESS_SPACE], - ip: 0, - dstack: Stack {tos: 0, mem: [0; 32]}, - rstack: Stack {tos: 0, mem: [0; 32]}}; - return c; -} - -impl Core { - fn load(&self, addr: u16) -> u16 { - let a = addr as usize; - return u16::from_le_bytes(self.ram[a..=a+1].try_into().unwrap()); - } - - fn store(&mut self, addr: u16, val: u16) { - let a = addr as usize; - self.ram[a..=a+1].copy_from_slice(&val.to_le_bytes()); - } - - fn step(&mut self) { - let opcode = self.load(self.ip); - self.ip = self.ip.wrapping_add(2); - if (opcode >= 0xffe0) && (opcode & 1 == 0) { - PRIMITIVES[((opcode - 0xffe0) >> 1) as usize](self); - } - else if (opcode & 1) == 1 { - // Literal - self.dstack.push(opcode >> 1); - } - else { - // Call - self.rstack.push(self.ip); - self.ip = opcode; - } - } -} - -type Primitive = fn(&mut Core); - -enum Op { - RET = 0xffe0, TOR = 0xffe2, RTO = 0xffe4, LD = 0xffe6, - ST = 0xffe8, DUP = 0xffea, SWP = 0xffec, DRP = 0xffee, - Q = 0xfff0, ADD = 0xfff2, SFT = 0xfff4, OR = 0xfff6, - AND = 0xfff8, INV = 0xfffa, GEQ = 0xfffc, IO = 0xfffe, -} - -const PRIMITIVES: [Primitive; 16] = [ - | x | { /* ret */ x.ip = x.rstack.pop() }, - | x | { /* >r */ x.rstack.push(x.dstack.pop()) }, - | x | { /* r> */ x.dstack.push(x.rstack.pop()) }, - | x | { // ld - let a = x.dstack.pop(); - x.dstack.push(x.load(a)); - }, - | x | { // st - let a = x.dstack.pop(); - let v = x.dstack.pop(); - x.store(a, v); - }, - | x | { // dup - let v = x.dstack.pop(); - x.dstack.push(v); - x.dstack.push(v); - }, - | x | { // swp - let v1 = x.dstack.pop(); - let v2 = x.dstack.pop(); - x.dstack.push(v1); - x.dstack.push(v2); - }, - | x | { /* drp */ let _ = x.dstack.pop(); }, - | x | { // ? - let f = x.dstack.pop(); - if f == 0 { - x.ip = x.ip.wrapping_add(2) - }; - }, - | x | { // add - let v1 = x.dstack.pop(); - let v2 = x.dstack.pop(); - x.dstack.push(v1.wrapping_add(v2)); - }, - | x | { // sft - let amt = x.dstack.pop(); - let val = x.dstack.pop(); - x.dstack.push( - if amt <= 0xf { - val << amt - } else if amt >= 0xfff0 { - val >> (0xffff - amt + 1) - } else { - 0 - } - ); - }, - | x | { // or - let v1 = x.dstack.pop(); - let v2 = x.dstack.pop(); - x.dstack.push(v1 | v2); - }, - | x | { // and - let v1 = x.dstack.pop(); - let v2 = x.dstack.pop(); - x.dstack.push(v1 & v2); - }, - | x | { // inv - let v1 = x.dstack.pop(); - x.dstack.push(!v1); - }, - | x | { // geq (unsigned) - let v2 = x.dstack.pop(); - let v1 = x.dstack.pop(); - x.dstack.push(if v1 >= v2 { 0xffff } else { 0 }); - }, - | x | { // io - let port = x.dstack.pop(); - match port { - 0 => { - let mut buf: [u8; 1] = [0]; - let _ = io::stdin().read(&mut buf); - x.dstack.push(buf[0] as u16); - } - 1 => { - let val = x.dstack.pop(); - print!("{}", ((val & 0xff) as u8) as char); - let _ = io::stdout().flush(); - } - 2 => { - println!("{} {:?} {:?}", x.ip, x.dstack, x.rstack); - let _ = io::stdout().flush(); - } - _ => {} - } - } -]; - -/* --- The memory map --- -*/ - -/* --- The dictionary format --- -*/ - -/* --- The threading kind --- -*/ - -/* --- Create the dictionary --- -*/ - -struct Dict<'a> { - dp: u16, - here: u16, - 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); - } - - fn comma(&mut self, val: u16) { - self.c.store(self.here, val); - self.allot(2); - } - - 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]) { - self.comma(n as u16 | ((val[0] as u16) << 8)); - self.comma(val[1] as u16 | ((val[2] as u16) << 8)); - } - - fn entry(&mut self) { - let here = self.here; - self.comma(self.dp); - self.dp = here; - } -} - -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; - forth!(Literal(0), IO, RET); - - // emit ( n -- ) - d.entry(); d.name(4, *b"emi"); let emit = d.here; - forth!(Literal(1), IO, RET); - - // - ( a b -- a-b ) - d.entry(); d.name(1, *b"- "); let sub = d.here; - forth!(INV, Literal(1), ADD, ADD, RET); - - let zero = d.here; - forth!(Literal(0), RTO, DRP, RET); - - // 0= ( n -- f ) - d.entry(); d.name(2, *b"0= "); let zero_eq = d.here; - forth!(Q, zero, Literal(0), INV, RET); - - // = ( a b -- a=b ) - d.entry(); d.name(1, *b"= "); let eq = d.here; - forth!(sub, zero_eq, RET); - - // Advance past whitespace - let skip_helper = d.here; - forth!(RTO, DRP, key, DUP, Literal(33), GEQ, Q, RET, DRP, skip_helper); - - d.entry(); d.name(6, *b"ski"); let skipws = d.here; - forth!(skip_helper); - - // over ( a b -- a b a ) - d.entry(); d.name(4, *b"ove"); let over = d.here; - forth!(TOR, DUP, RTO, SWP, RET); - - // 2dup ( a b -- a b a b ) - d.entry(); d.name(4, *b"2du"); let twodup = d.here; - forth!(over, over, RET); - - // Buffer for parsing an input word, formatted as Nabcde. - let word_buf = d.here; - d.allot(6); - - // min ( a b -- n ) - d.entry(); d.name(3, *b"min"); let min = d.here; - forth!(twodup, GEQ, Q, SWP, DRP, RET); - - // c@ ( a -- n ) - d.entry(); d.name(2, *b"c@ "); let cld = d.here; - forth!(LD, Literal(0xff), AND, RET); - - // c! ( n a -- ) - d.entry(); d.name(2, *b"c! "); let cst = d.here; - forth!(DUP, LD, Literal(0xff), INV, AND, SWP, TOR, OR, RTO, ST, RET); - - // Load 1 letter into buffer. - let stchar = d.here; - 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; - 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; - forth!(getcs_helper, RET); - - // word ( -- ) - // Not quite standard. - d.entry(); d.name(4, *b"wor"); let word = d.here; - forth!(Literal(word_buf), DUP, Literal(2), ADD, - Literal(0x2020), SWP, ST, Literal(0x2000), SWP, ST, - skipws, getcs, DRP, 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; - forth!(Literal(latest_ptr), RET); - - let matches = d.here; - 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; - forth!(Literal(6), ADD, RTO, DRP, RET); - - let find_helper = d.here; - 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; - forth!(latest, LD, find_helper); - - // ' ( -- xt|0 ) - d.entry(); d.name(1, *b"' "); - forth!(word, find, RET); - - /* --- The outer interpreter --- - */ - - // x10 ( n -- n*10 ) - d.entry(); d.name(3, *b"x10"); let x10 = d.here; - 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; - 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; - forth!(Literal(state_ptr), RET); - - let word_addr = d.here; - forth!(Literal(latest_ptr), LD, Literal(2), ADD, RET); - - // immediate ( -- ) - d.entry(); d.name(9 | 0x80, *b"imm"); - forth!(word_addr, DUP, LD, Literal(0x0080), OR, SWP, ST, RET); - - // smudge ( -- ) - d.entry(); d.name(6 | 0x80, *b"smu"); let smudge = d.here; - forth!(word_addr, DUP, LD, Literal(0x0040), OR, SWP, ST, RET); - - // unsmudge ( -- ) - d.entry(); d.name(8 | 0x80, *b"uns"); let unsmudge = d.here; - forth!(word_addr, DUP, LD, Literal(0x0040), INV, AND, SWP, ST, RET); - - // [ ( -- ) - d.entry(); d.name(1 | 0x80, *b"[ "); let lbracket = d.here; - forth!(Literal(0), INV, state, ST, RET); - - // ] ( -- ) - d.entry(); d.name(1 | 0x80, *b"] "); let rbracket = d.here; - forth!(Literal(0), state, ST, RET); - - // , ( n -- ) - d.entry(); d.name(1, *b", "); let comma = d.here; - forth!(here, LD, ST, - here, LD, Literal(2), ADD, here, ST, RET); - - let compile_call = d.here; - forth!(DUP, Literal(4), sub, LD, Literal(0x0080), AND, state, LD, OR, Q, RET, - comma, RTO, DRP, RET); - - let compile_lit = d.here; - forth!(state, LD, Q, RET, - DUP, ADD, Literal(1), ADD, comma, RTO, DRP, RET); - - let end_num = d.here; - forth!(DRP, RTO, DRP, RET); - - let bad_num = d.here; - forth!(DRP, DRP, DRP, Literal(0), INV, RTO, DRP, RET); - - let number_helper = d.here; - forth!(RTO, DRP, DUP, Literal(word_buf), ADD, cld, - Literal(48), sub, 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; - forth!(Literal(0), Literal(1), number_helper); - - // execute ( xt -- ) - d.entry(); d.name(7, *b"exe"); let execute = d.here; - forth!(TOR, RET); - - let doit = d.here; - forth!(RTO, DRP, compile_call, execute, RET); - - let bad = d.here; - forth!(DRP, Literal(63), emit, RTO, DRP, RET); - - // dispatch ( xt -- ) - d.entry(); d.name(9, *b"int"); let dispatch = d.here; - 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; - forth!(word, find, dispatch, quit); - - // create ( -- ) - d.entry(); d.name(6, *b"cre"); let create = d.here; - forth!(word, - 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": "); - forth!(create, smudge, rbracket, RET); - - // ; ( -- ) - d.entry(); d.name(1 | 0x80, *b"; "); - 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"); 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(1 | 0x80, *b"? "); // This one only works in-line. - forth!(Literal(!(Q as u16)), INV, comma, 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(3, *b"and"); forth!(AND, RET); - d.entry(); d.name(3, *b"inv"); forth!(INV, RET); - d.entry(); d.name(3, *b"u>="); forth!(GEQ, RET); - d.entry(); d.name(2, *b"io "); let io = d.here; forth!(IO, RET); - - d.c.store(latest_ptr, io-6); - d.c.store(here_ptr, d.here); - d.c.store(state_ptr, 0xffff); - d.c.store(0, quit); -} - -fn main() { - let mut c = new_core(); - build_dictionary(&mut c); - c.ip = 0; - loop { - c.step(); - } -} -