Supersede the old version.

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
-```

build.sh

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

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<const N: usize> {
+    mem: [u16; N],
+    tos: usize
+}
+
+impl<const N: usize> Stack<N> {
+    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
+    dstack: Stack<32>,
-    here: u16, // first unused byte
+    rstack: Stack<32>
-    state: State,
+}
-    next_token: Option<String>,
+
-    post: Post,
+fn new_core() -> Core {
-    dstack: [u16; STACK_WORDS],
+    let c = Core {
-    tds: usize,  // post-incremented; exceeds top by one
+        ram: [0; ADDRESS_SPACE],
-    rstack: [u16; STACK_WORDS],
+        ip: 0,
-    trs: usize,  // post-incremented; exceeds top by one
+        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 {
+enum Op {
-    bytes: [u8; 3],
+    RET = 0xffe0, TOR = 0xffe2, RTO = 0xffe4, LD  = 0xffe6,
-    length: u8
+    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 {
+const PRIMITIVES: [Primitive; 16] = [
-    let name_bytes = name.as_bytes();
+    | x | { /* ret */ x.ip = x.rstack.pop() },
-    let mut out = ShortName {
+    | x | { /* >r  */ x.rstack.push(x.dstack.pop()) },
-        bytes: *b"   ",
+    | x | { /* r>  */ x.dstack.push(x.rstack.pop()) },
-        length: name_bytes.len() as u8 };
+    | x | { // ld
-    let n = std::cmp::min(3, out.length) as usize;
+        let a = x.dstack.pop();
-    out.bytes[0..n].copy_from_slice(&name_bytes[0..n]);
+        x.dstack.push(x.load(a));
-    return out;
+    },
-}
+    | x | { // st
-
+        let a = x.dstack.pop();
-struct TableEntry {
+        let v = x.dstack.pop();
-    f: Primitive,
+        x.store(a, v);
-    name: Option<ShortName>,
+    },
-    immediate: bool
+    | x | { // dup
-}
+        let v = x.dstack.pop();
-
+        x.dstack.push(v);
-const PRIMITIVES: [TableEntry; 31] = [
+        x.dstack.push(v);
-    TableEntry {f: ret     , name: None, immediate: false},
+    },
-    TableEntry {f: lit     , name: None, immediate: false},
+    | x | { // swp
-    TableEntry {f: add     , name: Some(ShortName {bytes: *b"+  ", length: 1}), immediate: false},
+        let v1 = x.dstack.pop();
-    TableEntry {f: call    , name: Some(ShortName {bytes: *b"cal", length: 4}), immediate: false},
+        let v2 = x.dstack.pop();
-    TableEntry {f: comma_d , name: Some(ShortName {bytes: *b",  ", length: 1}), immediate: false},
+        x.dstack.push(v1);
-    TableEntry {f: create_d, name: Some(ShortName {bytes: *b"cre", length: 6}), immediate: false},
+        x.dstack.push(v2);
-    TableEntry {f: div     , name: Some(ShortName {bytes: *b"/  ", length: 1}), immediate: false},
+    },
-    TableEntry {f: dot     , name: Some(ShortName {bytes: *b".  ", length: 1}), immediate: false},
+    | x | { /* drp */ let _ = x.dstack.pop(); },
-    TableEntry {f: dots    , name: Some(ShortName {bytes: *b".s ", length: 2}), immediate: false},
+    | x | { // ?
-    TableEntry {f: drop    , name: Some(ShortName {bytes: *b"dro", length: 4}), immediate: false},
+        let f = x.dstack.pop();
-    TableEntry {f: dup     , name: Some(ShortName {bytes: *b"dup", length: 3}), immediate: false},
+        if f == 0 {
-    TableEntry {f: dump    , name: Some(ShortName {bytes: *b"dum", length: 4}), immediate: false},
+            x.ip = x.ip.wrapping_add(2)
-    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},
+    | x | { // add
-    TableEntry {f: if_skip  ,name: Some(ShortName {bytes: *b"?  ", length: 1}), immediate: false},
+        let v1 = x.dstack.pop();
-    TableEntry {f: immediate,name: Some(ShortName {bytes: *b"imm", length: 9}), immediate: false},
+        let v2 = x.dstack.pop();
-    TableEntry {f: latest  , name: Some(ShortName {bytes: *b"lat", length: 6}), immediate: false},
+        x.dstack.push(v1.wrapping_add(v2));
-    TableEntry {f: lbracket, name: Some(ShortName {bytes: *b"[  ", length: 1}), immediate: true},
+    },
-    TableEntry {f: load    , name: Some(ShortName {bytes: *b"@  ", length: 1}), immediate: false},
+    | x | { // sft
-    TableEntry {f: mul     , name: Some(ShortName {bytes: *b"*  ", length: 1}), immediate: false},
+        let amt = x.dstack.pop();
-    TableEntry {f: ret_d   , name: Some(ShortName {bytes: *b"ret", length: 3}), immediate: false},
+        let val = x.dstack.pop();
-    TableEntry {f: rbracket, name: Some(ShortName {bytes: *b"]  ", length: 1}), immediate: false},
+        x.dstack.push(
-    TableEntry {f: smudge  , name: Some(ShortName {bytes: *b"smu", length: 6}), immediate: false},
+            if amt <= 0xf {
-    TableEntry {f: store   , name: Some(ShortName {bytes: *b"!  ", length: 1}), immediate: false},
+                val << amt
-    TableEntry {f: sub     , name: Some(ShortName {bytes: *b"-  ", length: 1}), immediate: false},
+            } else if amt >= 0xfff0 {
-    TableEntry {f: swap    , name: Some(ShortName {bytes: *b"swa", length: 4}), immediate: false},
+                val >> (0xffff - amt + 1)
-    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}
-];
-
-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);
-
-    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 , ;"
-    ];
-
-    for s in autoexec {
-        outer(&mut c, s);
-    }
-
-    return c;
-}
-
-// --- 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 find(c: &mut Core, name: ShortName) -> Option<u16> {
-    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;
-    }
-    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 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 comma_d(c: &mut Core) {
-    let val = pop(c);
-    comma(c, val);
-}
-
-// --- 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;
+                0
-        return c.dstack[c.tds];
             }
-}
+        );
-
+    },
-fn dup(c: &mut Core) {
+    | x | { // or
-    let val = pop(c);
+        let v1 = x.dstack.pop();
-    push(c, val);
+        let v2 = x.dstack.pop();
-    push(c, val);
+        x.dstack.push(v1 | v2);
-}
+    },
-
+    | x | { // and
-fn swap(c: &mut Core) {
+        let v1 = x.dstack.pop();
-    let val1 = pop(c);
+        let v2 = x.dstack.pop();
-    let val2 = pop(c);
+        x.dstack.push(v1 & v2);
-    push(c, val1);
+    },
-    push(c, val2);
+    | x | { // inv
-}
+        let v1 = x.dstack.pop();
-
+        x.dstack.push(!v1);
-fn drop(c: &mut Core) {
+    },
-    let _ = pop(c);
+    | x | { // geq (unsigned)
-}
+        let v2 = x.dstack.pop();
-
+        let v1 = x.dstack.pop();
-fn to_r(c: &mut Core, val: u16) {
+        x.dstack.push(if v1 >= v2 { 0xffff } else { 0 });
-    c.rstack[c.trs] = val;
+    },
-    c.trs += 1;
+    | x | { // io
-}
+        let port = x.dstack.pop();
-
+        match port {
-fn to_r_d(c: &mut Core) {
+            0 => {
-    let r1 = from_r(c);
+                let mut buf: [u8; 1] = [0];
-    let r2 = pop(c);
+                let _ = io::stdin().read(&mut buf);
-    to_r(c, r2);
+                x.dstack.push(buf[0] as u16);
-    to_r(c, r1);
-}
-
-fn from_r(c: &mut Core) -> u16 {
-    c.trs -= 1;
-    return c.rstack[c.trs];
-}
-
-fn from_r_d(c: &mut Core) {
-    let r1 = from_r(c);
-    let r2 = from_r(c);
-    to_r(c, r1);
-    push(c, r2);
-}
-
-fn call(c: &mut Core) {
-    to_r(c, c.ip);
-    c.ip = pop(c);
-}
-
-// 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);
+            1 => {
-}
+                let val  = x.dstack.pop();
-
+                print!("{}", ((val & 0xff) as u8) as char);
-fn ret_d(c: &mut Core) {
+                let _ = io::stdout().flush();
-    _ = from_r(c);
-    ret(c);
-}
-
-// --- 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 });
-}
-
-// --- I/O ---
-fn dot(c: &mut Core) {
-    print!("{} ", pop(c));
-}
-
-fn dots(c: &mut Core) {
-    for i in &c.dstack[0..c.tds] {
-        print!("{} ", i);
             }
-}
+            2 => {
-
+                println!("{} {:?} {:?}", x.ip, x.dstack, x.rstack);
-fn dump(c: &mut Core) {
+                let _ = io::stdout().flush();
-    println!("{:?}", c);
-}
-
-fn word(c: &mut Core) {
-    match &c.next_token {
-        Some(t) => {
-            println!("{}", t);
-            c.post = Post::EatWord;
             }
             _ => {}
         }
+    }
+];
+
+/* --- The memory map ---
+*/
+
+/* --- The dictionary format ---
+*/
+
+/* --- The threading kind ---
+*/
+
+/* --- Create the dictionary ---
+*/
+
+struct Dict<'a> {
+    dp: u16,
+    here: u16,
+    c: &'a mut Core
 }
 
-// --- Math and logic ---
+enum Item {
-
+    Literal(u16),
-// note: this is an inline primitive, not a dict entry
+    Call(u16),
-fn lit(c: &mut Core) {
+    Opcode(Op)
-    let ip = c.ip as usize;
-    push(c, u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap()));
-    c.ip += 2;
 }
+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) } }
 
-fn add(c: &mut Core) {
+impl Dict<'_> {
-    let v1 = pop(c);
+    fn allot(&mut self, n: u16) {
-    let v2 = pop(c);
+        self.here = self.here.wrapping_add(n);
-    push(c, v1.wrapping_add(v2));
+    }
-}
 
-fn sub(c: &mut Core) {
+    fn comma(&mut self, val: u16) {
-    let v1 = pop(c);
+        self.c.store(self.here, val);
-    let v2 = pop(c);
+        self.allot(2);
-    push(c, v2.wrapping_sub(v1));
+    }
-}
 
-fn mul(c: &mut Core) {
+    fn emit<T: Into<Item>>(&mut self, val: T) {
-    let v1 = pop(c);
+        match val.into() {
-    let v2 = pop(c);
+            Item::Call(val)    => { self.comma(val) }
-    push(c, v1.saturating_mul(v2));
+            Item::Opcode(val)  => { self.comma(val as u16) }
-}
+            Item::Literal(val) => { assert!(val <= 0x7fff);
+                                    self.comma((val << 1) | 1) }
+        }
+    }
 
-fn div(c: &mut Core) {
+    fn name(&mut self, n: u8, val: [u8; 3]) {
-    let v1 = pop(c);
+        self.comma(n as u16 | ((val[0] as u16) << 8));
-    let v2 = pop(c);
+        self.comma(val[1] as u16 | ((val[2] as u16) << 8));
-    push(c, v2.saturating_div(v1));
+    }
-}
 
-// --- Inner interpreter ---
+    fn entry(&mut self) {
-
+        let here = self.here;
-fn fetch(c: &mut Core) -> u16 {
+        self.comma(self.dp);
-    let ip = c.ip as usize;
+        self.dp = here;
-    let opcode = u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap());
-    c.ip += 2;
-    return opcode;
-}
-
-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;
     }
 }
 
-fn step(c: &mut Core) {
+fn build_dictionary(c: &mut Core) {
-    let opcode = fetch(c);
+    use Op::*;
-    execute(c, opcode);
+    use Item::*;
-}
 
-fn inner(c: &mut Core) {
+    let mut d = Dict {dp: 0, here: 2, c: c};
-    loop {
-        step(c);
-        //println!("ip={} trs={}", c.ip, c.trs);
-        if c.trs == 0 {
-            break;
-        }
-    }
-}
 
-// --- Outer interpreter ---
+    macro_rules! forth {
+        ($x:expr) => (d.emit($x));
+        ($x:expr, $($y:expr),+) => (d.emit($x); forth!($($y),+))
+    }
 
-fn lbracket(c: &mut Core) {
+    // key ( -- n )
-    c.state = State::Interpreting;
+    d.entry(); d.name(3, *b"key");  let key = d.here;
-}
+    forth!(Literal(0), IO, RET);
 
-fn rbracket(c: &mut Core) {
+    // emit ( n -- )
-    c.state = State::Compiling;
+    d.entry(); d.name(4, *b"emi");  let emit = d.here;
-}
+    forth!(Literal(1), IO, RET);
 
-fn latest(c: &mut Core) {
+    // - ( a b -- a-b )
-    push(c, c.dp);
+    d.entry(); d.name(1, *b"-  ");  let sub = d.here;
-}
+    forth!(INV, Literal(1), ADD, ADD, RET);
 
-fn here(c: &mut Core) {
+    let zero = d.here;
-    push(c, c.here);
+    forth!(Literal(0), RTO, DRP, RET);
-}
 
-fn outer(c: &mut Core, s: &str) {
+    // 0= ( n -- f )
-    let ss = s.trim();
+    d.entry(); d.name(2, *b"0= ");  let zero_eq = d.here;
-    let mut tokens = ss.split(" ").peekable();
+    forth!(Q, zero, Literal(0), INV, RET);
-    loop {
+
-        c.post = Post::Nothing;
+    // = ( a b -- a=b )
-        match tokens.next() {
+    d.entry(); d.name(1, *b"=  ");  let eq = d.here;
-            Some(t) => {
+    forth!(sub, zero_eq, RET);
-                c.next_token = match tokens.peek() {
+
-                    Some(t) => { Some(t.to_string()) }
+    // Advance past whitespace
-                    None => { None }
+    let skip_helper = d.here;
-                };
+    forth!(RTO, DRP, key, DUP, Literal(33), GEQ, Q, RET, DRP, skip_helper);
-                match find(c, truncate_name(t)) {
+
-                    Some(addr) => {
+    d.entry(); d.name(6, *b"ski");  let skipws = d.here;
-                        if c.state == State::Interpreting || is_immediate(c, addr) {
+    forth!(skip_helper);
-                            to_r(c, c.ip);
+
-                            c.ip = addr;
+    // over ( a b -- a b a )
-                            inner(c);
+    d.entry(); d.name(4, *b"ove");  let over = d.here;
-                        } else {
+    forth!(TOR, DUP, RTO, SWP, RET);
-                            comma(c, addr);
+
-                        }
+    // 2dup ( a b -- a b a b )
-                    }
+    d.entry(); d.name(4, *b"2du");  let twodup = d.here;
-                    None => {
+    forth!(over, over, RET);
-                        let val = t.parse::<u16>();
+
-                        match val {
+    // Buffer for parsing an input word, formatted as Nabcde.
-                            Ok(n) => {
+    let word_buf = d.here;
-                                match c.state {
+    d.allot(6);
-                                    State::Interpreting => { push(c, n) }
+
-                                    State::Compiling => {
+    // min ( a b -- n )
-                                        comma(c, 65534); // lit
+    d.entry(); d.name(3, *b"min");  let min = d.here;
-                                        comma(c, n);
+    forth!(twodup, GEQ, Q, SWP, DRP, RET);
-                                    }
+
-                                }
+    // c@ ( a -- n )
-                            }
+    d.entry(); d.name(2, *b"c@ ");  let cld = d.here;
-                            Err(_) => {
+    forth!(LD, Literal(0xff), AND, RET);
-                                if t != "" {
+
-                                    println!("{}?", t);
+    // c! ( n a -- )
-                                    c.post = Post::WarmReset;
+    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);
-            None => { break ; }
+
-        }
+    // Load letters into buffer until whitespace is hit again.
-        match c.post {
+    // Return the whitespace character that was seen.
-            Post::EatWord => { _ = tokens.next(); }
+    let getcs_helper = d.here;
-            Post::WarmReset => {
+    forth!(RTO, DRP, stchar, key, DUP, Literal(32), SWP, GEQ, Q, RET, getcs_helper);
-                c.tds = 0;
+
-                c.trs = 0;
+    d.entry(); d.name(5, *b"get");  let getcs = d.here;
-                c.state = State::Interpreting;
+    forth!(getcs_helper, RET);
-                break; // discard rest of input line
+
-            }
+    // word ( -- )
-            Post::Nothing => { }
+    // 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 {
-        let mut buf = String::new();
+        c.step();
-        match io::stdin().read_line(&mut buf) {
-            Ok(_) => {
-                outer(&mut c, &buf);
-                match c.state { 
-                    State::Interpreting => {println!(" ok")}
-                    State::Compiling => {}
-                };
-            }
-            Err(_) => { break; }
-        }
     }
 }
 
-/*
-: 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
- */

frustration2.rs

@@ -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<const N: usize> {
-    mem: [u16; N],
-    tos: usize
-}
-
-impl<const N: usize> Stack<N> {
-    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<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);
-    }
-
-    fn comma(&mut self, val: u16) {
-        self.c.store(self.here, val);
-        self.allot(2);
-    }
-
-    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 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();
-    }
-}
-