mirror of
https://gitlab.cs.washington.edu/fidelp/frustration.git
synced 2025-01-29 08:34:16 +01:00
combine in/out ops into io, add u< op, lots of condensing
This commit is contained in:
psf
parent
60da6e54a9
commit
c093bc96fe
1 changed files with 358 additions and 418 deletions
776
frustration2.rs
776
frustration2.rs
|
|
@ -6,24 +6,23 @@ use std::io::Read;
|
|||
use std::io::Write;
|
||||
use std::convert::TryInto;
|
||||
const ADDRESS_SPACE: usize = 65535;
|
||||
const STACK_WORDS: usize = 16;
|
||||
|
||||
#[derive(Debug)]
|
||||
struct Stack {
|
||||
mem: [u16; STACK_WORDS],
|
||||
struct Stack<const N: usize> {
|
||||
mem: [u16; N],
|
||||
tos: usize
|
||||
}
|
||||
|
||||
impl Stack {
|
||||
impl<const N: usize> Stack<N> {
|
||||
fn push(&mut self, val: u16) {
|
||||
self.tos = (self.tos.wrapping_add(1)) & (STACK_WORDS - 1);
|
||||
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)) & (STACK_WORDS - 1);
|
||||
self.tos = (self.tos.wrapping_sub(1)) & (N - 1);
|
||||
return val;
|
||||
}
|
||||
}
|
||||
|
|
@ -32,16 +31,16 @@ impl Stack {
|
|||
struct Core {
|
||||
ram: [u8; ADDRESS_SPACE],
|
||||
ip: u16,
|
||||
dstack: Stack,
|
||||
rstack: Stack
|
||||
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; STACK_WORDS]},
|
||||
rstack: Stack {tos: 0, mem: [0; STACK_WORDS]}};
|
||||
ip: 0,
|
||||
dstack: Stack {tos: 0, mem: [0; 32]},
|
||||
rstack: Stack {tos: 0, mem: [0; 32]}};
|
||||
return c;
|
||||
}
|
||||
|
||||
|
|
@ -50,7 +49,7 @@ impl Core {
|
|||
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());
|
||||
|
|
@ -76,58 +75,51 @@ 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,
|
||||
Q = 0xfff0, ADD = 0xfff2, SFT = 0xfff4, OR = 0xfff6,
|
||||
INV = 0xfff8, OUT = 0xfffa, IN = 0xfffc, NOP = 0xfffe,
|
||||
INV = 0xfff8, ULT = 0xfffa, IO = 0xfffc, NOP = 0xfffe,
|
||||
}
|
||||
|
||||
const PRIMITIVES: [Primitive; 16] = [
|
||||
| x | { // 0: ret
|
||||
x.ip = x.rstack.pop()
|
||||
},
|
||||
| x | { // 1: >r
|
||||
x.rstack.push(x.dstack.pop())
|
||||
},
|
||||
| x | { // 2: r>
|
||||
x.dstack.push(x.rstack.pop())
|
||||
},
|
||||
| x | { // 3: ld
|
||||
| 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 | { // 4: st
|
||||
| x | { // st
|
||||
let a = x.dstack.pop();
|
||||
let v = x.dstack.pop();
|
||||
x.store(a, v);
|
||||
},
|
||||
| x | { // 5: dup
|
||||
| x | { // dup
|
||||
let v = x.dstack.pop();
|
||||
x.dstack.push(v);
|
||||
x.dstack.push(v);
|
||||
},
|
||||
| x | { // 6: swp
|
||||
| x | { // swp
|
||||
let v1 = x.dstack.pop();
|
||||
let v2 = x.dstack.pop();
|
||||
x.dstack.push(v1);
|
||||
x.dstack.push(v2);
|
||||
},
|
||||
| x | { // 7: drp
|
||||
let _ = x.dstack.pop();
|
||||
},
|
||||
| x | { // 8: ?
|
||||
| x | { /* drp */ let _ = x.dstack.pop(); },
|
||||
| x | { // ?
|
||||
let f = x.dstack.pop();
|
||||
if f == 0 {
|
||||
x.ip = x.ip.wrapping_add(2)
|
||||
};
|
||||
},
|
||||
| x | { // 9: add
|
||||
| x | { // add
|
||||
let v1 = x.dstack.pop();
|
||||
let v2 = x.dstack.pop();
|
||||
x.dstack.push(v1.wrapping_add(v2));
|
||||
},
|
||||
| x | { // a: sft
|
||||
| x | { // sft
|
||||
let amt = x.dstack.pop();
|
||||
let val = x.dstack.pop();
|
||||
x.dstack.push(
|
||||
|
|
@ -140,59 +132,43 @@ const PRIMITIVES: [Primitive; 16] = [
|
|||
}
|
||||
);
|
||||
},
|
||||
| x | { // b: or
|
||||
| x | { // or
|
||||
let v1 = x.dstack.pop();
|
||||
let v2 = x.dstack.pop();
|
||||
x.dstack.push(v1 | v2);
|
||||
},
|
||||
| x | { // c: inv
|
||||
| x | { // inv
|
||||
let v1 = x.dstack.pop();
|
||||
x.dstack.push(!v1);
|
||||
},
|
||||
| x | { // d: out
|
||||
| x | { // ult
|
||||
let v1 = x.dstack.pop();
|
||||
let v2 = x.dstack.pop();
|
||||
x.dstack.push(if v1 < v2 { 0xffff } else { 0 });
|
||||
},
|
||||
| x | { // io
|
||||
let port = x.dstack.pop();
|
||||
let val = x.dstack.pop();
|
||||
if port == 1 {
|
||||
print!("{}", ((val & 0xff) as u8) as char);
|
||||
let _ = io::stdout().flush();
|
||||
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();
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
},
|
||||
| x | { // e: in
|
||||
let port = x.dstack.pop();
|
||||
if port == 0 {
|
||||
let mut buf: [u8; 1] = [0];
|
||||
let _ = io::stdin().read(&mut buf);
|
||||
x.dstack.push(buf[0] as u16);
|
||||
}
|
||||
},
|
||||
| _x | { // f: nop
|
||||
},
|
||||
| _x | { /* nop */ }
|
||||
];
|
||||
|
||||
fn test_stack() {
|
||||
let mut s = Stack {tos: 0, mem: [0; STACK_WORDS]};
|
||||
for i in 1..=20 {
|
||||
s.push(i)
|
||||
}
|
||||
for i in 1..=16 {
|
||||
assert_eq!(s.pop(), (21 - i))
|
||||
}
|
||||
for _i in 1..=4 {
|
||||
assert_eq!(s.pop(), 0)
|
||||
}
|
||||
}
|
||||
|
||||
fn test_core () {
|
||||
let mut c = new_core();
|
||||
println!("{} {:?} {:?}", c.ip, c.dstack, c.rstack);
|
||||
c.step();
|
||||
println!("{} {:?} {:?}", c.ip, c.dstack, c.rstack);
|
||||
c.step();
|
||||
println!("{} {:?} {:?}", c.ip, c.dstack, c.rstack);
|
||||
c.step();
|
||||
println!("{} {:?} {:?}", c.ip, c.dstack, c.rstack);
|
||||
}
|
||||
|
||||
/* --- The memory map ---
|
||||
*/
|
||||
|
||||
|
|
@ -205,7 +181,6 @@ fn test_core () {
|
|||
/* --- Create the dictionary ---
|
||||
*/
|
||||
|
||||
// helper
|
||||
struct Dict<'a> {
|
||||
dp: u16,
|
||||
here: u16,
|
||||
|
|
@ -231,8 +206,7 @@ impl Dict<'_> {
|
|||
}
|
||||
|
||||
fn lit(&mut self, val: u16) {
|
||||
assert!(val & 0x8000 == 0);
|
||||
assert!(val < 0x7ff0);
|
||||
assert!(val <= 0x7fff);
|
||||
self.comma((val << 1) | 1);
|
||||
}
|
||||
|
||||
|
|
@ -248,346 +222,311 @@ impl Dict<'_> {
|
|||
}
|
||||
}
|
||||
|
||||
// for testing only
|
||||
fn run(c: &mut Core, ip: u16) {
|
||||
c.ip = ip;
|
||||
while c.ip != 0 {
|
||||
//println!("{}\n{:?}\n{:?}\n", c.ip, c.dstack, c.rstack);
|
||||
c.step();
|
||||
}
|
||||
println!("{} {:?} {:?}", c.ip, c.dstack, c.rstack);
|
||||
}
|
||||
|
||||
fn build_dictionary(c: &mut Core) {
|
||||
let x = {
|
||||
let mut d = Dict {dp: 0, here: 2, c: c};
|
||||
|
||||
/* --- Putting primitive words in the dictionary ---
|
||||
*/
|
||||
|
||||
d.entry(); d.name(3, *b"ret"); let ret = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(2, *b">r "); let tor = d.here;
|
||||
d.op(Op::RTO); d.op(Op::SWP); d.op(Op::TOR); d.op(Op::TOR); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(2, *b"r> "); let rto = d.here;
|
||||
d.op(Op::RTO); d.op(Op::RTO); d.op(Op::SWP); d.op(Op::TOR); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(1, *b"@ "); let ld = d.here;
|
||||
d.op(Op::LD); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(1, *b"! "); let st = d.here;
|
||||
d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(3, *b"dup"); let dup = d.here;
|
||||
d.op(Op::DUP); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(4, *b"swa"); let swp = d.here;
|
||||
d.op(Op::SWP); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(4, *b"dro"); let drp = d.here;
|
||||
d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(1, *b"+ "); let add = d.here;
|
||||
d.op(Op::ADD); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(5, *b"shi"); let sft = d.here;
|
||||
d.op(Op::SFT); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(2, *b"or "); let or = d.here;
|
||||
d.op(Op::OR); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(6, *b"inv"); let inv = d.here;
|
||||
d.op(Op::INV); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(3, *b"out"); let out = d.here;
|
||||
d.op(Op::OUT); d.op(Op::RET);
|
||||
|
||||
d.entry(); d.name(2, *b"in "); let in_cmd = d.here;
|
||||
d.op(Op::IN); d.op(Op::RET);
|
||||
|
||||
// building up more interesting capabilities from these
|
||||
|
||||
// emit ( n -- )
|
||||
d.entry(); d.name(4, *b"emi"); let emit = d.here;
|
||||
d.lit(1); d.op(Op::OUT); d.op(Op::RET);
|
||||
|
||||
// key ( -- n )
|
||||
d.entry(); d.name(3, *b"key"); let key = d.here;
|
||||
d.lit(0); d.op(Op::IN); d.op(Op::RET);
|
||||
|
||||
// - ( a b -- a-b )
|
||||
d.entry(); d.name(1, *b"- "); let sub = d.here;
|
||||
d.op(Op::INV); d.lit(1); d.op(Op::ADD); d.op(Op::ADD); d.op(Op::RET);
|
||||
|
||||
// and ( a b -- a&b )
|
||||
d.entry(); d.name(3, *b"and"); let and = d.here;
|
||||
d.op(Op::INV); d.op(Op::SWP); d.op(Op::INV); d.op(Op::OR);
|
||||
d.op(Op::INV); d.op(Op::RET);
|
||||
|
||||
let zero = d.here;
|
||||
d.lit(0); d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
// 0= ( n -- f )
|
||||
d.entry(); d.name(2, *b"0= "); let zero_eq = d.here;
|
||||
d.op(Op::Q); d.call(zero); d.lit(0); d.op(Op::INV); d.op(Op::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(Op::DUP); d.op(Op::ADD); d.call(and);
|
||||
d.call(zero_eq); d.op(Op::RET);
|
||||
|
||||
// = ( a b -- a=b )
|
||||
d.entry(); d.name(1, *b"= "); let eq = d.here;
|
||||
d.call(sub); d.call(zero_eq); d.op(Op::RET);
|
||||
|
||||
// Advance past whitespace
|
||||
let skip_helper = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP);
|
||||
d.call(key); d.op(Op::DUP);
|
||||
d.lit(33); d.call(geq); d.op(Op::Q); d.op(Op::RET);
|
||||
d.op(Op::DRP); d.call(skip_helper);
|
||||
|
||||
d.entry(); d.name(6, *b"ski"); let skipws = d.here;
|
||||
d.call(skip_helper);
|
||||
|
||||
// over ( a b -- a b a )
|
||||
d.entry(); d.name(4, *b"ove"); let over = d.here;
|
||||
d.op(Op::TOR); d.op(Op::DUP); d.op(Op::RTO); d.op(Op::SWP);
|
||||
d.op(Op::RET);
|
||||
|
||||
// 2dup ( a b -- a b a b )
|
||||
d.entry(); d.name(4, *b"2du"); let twodup = d.here;
|
||||
d.call(over); d.call(over); d.op(Op::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;
|
||||
d.call(twodup);
|
||||
d.call(geq); d.op(Op::Q); d.op(Op::SWP);
|
||||
d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
// c@ ( a -- n )
|
||||
d.entry(); d.name(2, *b"c@ "); let cld = d.here;
|
||||
d.op(Op::LD); d.lit(0xff); d.call(and); d.op(Op::RET);
|
||||
|
||||
// c! ( n a -- )
|
||||
d.entry(); d.name(2, *b"c! "); let cst = d.here;
|
||||
d.op(Op::DUP); d.op(Op::LD); d.lit(0xff); d.op(Op::INV); d.call(and);
|
||||
d.op(Op::SWP); d.op(Op::TOR); d.op(Op::OR); d.op(Op::RTO);
|
||||
d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// Load 1 letter into buffer.
|
||||
let stchar = d.here;
|
||||
d.lit(word_buf); d.call(cld); d.lit(1); d.op(Op::ADD); d.op(Op::DUP);
|
||||
d.lit(word_buf); d.call(cst);
|
||||
d.lit(5); d.call(min); d.lit(word_buf); d.op(Op::ADD); d.call(cst);
|
||||
d.op(Op::RET);
|
||||
|
||||
// Load letters into buffer until whitespace is hit again.
|
||||
// Return the whitespace character that was seen.
|
||||
let getcs_helper = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP);
|
||||
d.call(stchar);
|
||||
d.call(key); d.op(Op::DUP); d.lit(32); d.op(Op::SWP);
|
||||
d.call(geq); d.op(Op::Q); d.op(Op::RET); d.call(getcs_helper);
|
||||
|
||||
d.entry(); d.name(5, *b"get"); let getcs = d.here;
|
||||
d.call(getcs_helper); d.op(Op::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(Op::DUP); d.lit(2); d.op(Op::ADD);
|
||||
d.lit(0x2020); d.op(Op::SWP); d.op(Op::ST);
|
||||
d.lit(0x2000); d.op(Op::SWP); d.op(Op::ST);
|
||||
// then load it
|
||||
d.call(skipws); d.call(getcs); d.op(Op::RET);
|
||||
|
||||
// latest ( -- a )
|
||||
// Address of "latest" variable. This variable stores the address of
|
||||
// the latest word in the dictionary.
|
||||
let latest_ptr = d.here; d.allot(2);
|
||||
d.entry(); d.name(6, *b"lat"); let latest = d.here;
|
||||
d.lit(latest_ptr); d.op(Op::RET);
|
||||
|
||||
let matches = d.here;
|
||||
d.lit(2); d.op(Op::ADD); d.op(Op::TOR);
|
||||
d.lit(word_buf); d.op(Op::DUP); d.lit(2); d.op(Op::ADD); d.op(Op::LD); d.op(Op::SWP); d.op(Op::LD);
|
||||
d.op(Op::RTO); d.op(Op::DUP); d.op(Op::TOR);
|
||||
d.op(Op::LD); d.lit(0x0080); d.op(Op::INV); d.call(and); d.call(eq);
|
||||
d.op(Op::SWP); d.op(Op::RTO); d.lit(2); d.op(Op::ADD); d.op(Op::LD); d.call(eq); d.call(and); d.op(Op::RET);
|
||||
|
||||
let matched = d.here;
|
||||
d.lit(6); d.op(Op::ADD); d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
let find_helper = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP);
|
||||
d.op(Op::DUP); d.lit(0); d.call(eq); d.op(Op::Q); d.op(Op::RET);
|
||||
d.op(Op::DUP); d.call(matches); d.op(Op::Q); d.call(matched);
|
||||
d.op(Op::LD); d.call(find_helper);
|
||||
|
||||
// find ( -- xt|0 )
|
||||
d.entry(); d.name(4, *b"fin"); let find = d.here;
|
||||
d.call(latest); d.op(Op::LD); d.call(find_helper);
|
||||
|
||||
// ' ( -- xt|0 )
|
||||
d.entry(); d.name(1, *b"' "); let tick = d.here;
|
||||
d.call(word); d.op(Op::DRP); d.call(find); d.op(Op::RET);
|
||||
|
||||
/* --- The outer interpreter ---
|
||||
*/
|
||||
|
||||
// x10 ( n -- n*10 )
|
||||
d.entry(); d.name(3, *b"x10"); let x10 = d.here;
|
||||
d.op(Op::DUP); d.op(Op::DUP);
|
||||
d.lit(3); d.op(Op::SFT); d.op(Op::ADD); d.op(Op::ADD); d.op(Op::RET);
|
||||
|
||||
// here ( -- a )
|
||||
// Address of "here" variable. This variable stores the address of
|
||||
// the first free space in the dictionary
|
||||
let here_ptr = d.here; d.allot(2);
|
||||
d.entry(); d.name(4, *b"her"); let here = d.here;
|
||||
d.lit(here_ptr); d.op(Op::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(Op::RET);
|
||||
|
||||
let word_addr = d.here;
|
||||
d.lit(latest_ptr); d.op(Op::LD); d.lit(2); d.op(Op::ADD);
|
||||
d.op(Op::RET);
|
||||
|
||||
// immediate ( -- )
|
||||
d.entry(); d.name(9 | 0x80, *b"imm"); let immediate = d.here;
|
||||
d.call(word_addr);
|
||||
d.op(Op::DUP); d.op(Op::LD); d.lit(0x0080); d.op(Op::OR);
|
||||
d.op(Op::SWP); d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// smudge ( -- )
|
||||
d.entry(); d.name(6 | 0x80, *b"smu"); let smudge = d.here;
|
||||
d.call(word_addr);
|
||||
d.op(Op::DUP); d.op(Op::LD); d.lit(0x0040); d.op(Op::OR);
|
||||
d.op(Op::SWP); d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// unsmudge ( -- )
|
||||
d.entry(); d.name(8 | 0x80, *b"uns"); let unsmudge = d.here;
|
||||
d.call(word_addr);
|
||||
d.op(Op::DUP); d.op(Op::LD); d.lit(0x0040); d.op(Op::INV); d.call(and);
|
||||
d.op(Op::SWP); d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// [ ( -- )
|
||||
d.entry(); d.name(1 | 0x80, *b"[ "); let lbracket = d.here;
|
||||
d.lit(0); d.op(Op::INV); d.call(state); d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// ] ( -- )
|
||||
d.entry(); d.name(1 | 0x80, *b"] "); let rbracket = d.here;
|
||||
d.lit(0); d.call(state); d.op(Op::ST); d.op(Op::RET);
|
||||
|
||||
// , ( n -- )
|
||||
d.entry(); d.name(1, *b", "); let comma = d.here;
|
||||
d.call(here); d.op(Op::LD); d.op(Op::ST);
|
||||
d.call(here); d.op(Op::LD); d.lit(2); d.op(Op::ADD);
|
||||
d.call(here); d.op(Op::ST);
|
||||
d.op(Op::RET);
|
||||
|
||||
let compile_call = d.here;
|
||||
d.op(Op::DUP); d.lit(4); d.call(sub);
|
||||
d.op(Op::LD); d.lit(0x0080); d.call(and);
|
||||
d.call(state); d.op(Op::LD); d.op(Op::OR);
|
||||
d.op(Op::Q); d.op(Op::RET);
|
||||
d.call(comma); d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
let compile_lit = d.here;
|
||||
d.call(state); d.op(Op::LD); d.op(Op::Q); d.op(Op::RET);
|
||||
d.op(Op::DUP); d.op(Op::ADD); d.lit(1); d.op(Op::ADD);
|
||||
d.call(comma); d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
let end_num = d.here;
|
||||
d.op(Op::DRP); d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
let bad_num = d.here;
|
||||
d.op(Op::DRP); d.op(Op::DRP); d.op(Op::DRP); d.lit(0); d.op(Op::INV);
|
||||
d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
let number_helper = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP);
|
||||
d.op(Op::DUP); d.lit(word_buf); d.op(Op::ADD); d.call(cld);
|
||||
d.lit(48); d.call(sub); d.lit(16383); d.call(and); // "unsigned comparison"
|
||||
d.op(Op::DUP); d.lit(10); d.call(geq); d.op(Op::Q); d.call(bad_num);
|
||||
d.op(Op::SWP); d.op(Op::TOR); d.op(Op::SWP); d.call(x10); d.op(Op::ADD); d.op(Op::RTO);
|
||||
d.op(Op::DUP); d.lit(word_buf); d.call(cld); d.call(geq); d.op(Op::Q); d.call(end_num);
|
||||
d.lit(1); d.op(Op::ADD); d.call(number_helper);
|
||||
|
||||
// number ( -- n|-1 )
|
||||
d.entry(); d.name(6, *b"num"); let number = d.here;
|
||||
d.lit(0); d.lit(1); d.call(number_helper);
|
||||
|
||||
// execute ( xt -- )
|
||||
d.entry(); d.name(7, *b"exe"); let execute = d.here;
|
||||
d.op(Op::TOR); d.op(Op::RET);
|
||||
|
||||
let doit = d.here;
|
||||
d.op(Op::RTO); d.op(Op::DRP);
|
||||
d.call(compile_call); d.call(execute); d.op(Op::RET);
|
||||
|
||||
let bad = d.here;
|
||||
d.op(Op::DRP); d.lit(63); d.call(emit);
|
||||
d.op(Op::RTO); d.op(Op::DRP); d.op(Op::RET);
|
||||
|
||||
// dispatch ( xt -- )
|
||||
d.entry(); d.name(9, *b"int"); let dispatch = d.here;
|
||||
d.op(Op::DUP); d.op(Op::Q); d.call(doit);
|
||||
d.op(Op::DRP);
|
||||
d.call(number); d.op(Op::DUP); d.lit(1); d.op(Op::ADD);
|
||||
d.call(zero_eq); d.op(Op::Q); d.call(bad);
|
||||
d.call(compile_lit);
|
||||
d.op(Op::RET);
|
||||
|
||||
// quit ( -- )
|
||||
d.entry(); d.name(4, *b"qui"); let quit = d.here;
|
||||
d.call(word); d.op(Op::DRP); d.call(find);
|
||||
d.call(dispatch); d.call(quit);
|
||||
|
||||
// create ( -- )
|
||||
d.entry(); d.name(6, *b"cre"); let create = d.here;
|
||||
d.call(word); d.op(Op::DRP);
|
||||
d.call(here); d.op(Op::LD);
|
||||
d.call(latest); d.op(Op::LD); d.call(comma);
|
||||
d.call(latest); d.op(Op::ST);
|
||||
d.lit(word_buf); d.op(Op::DUP); d.op(Op::LD); d.call(comma);
|
||||
d.lit(2); d.op(Op::ADD); d.op(Op::LD); d.call(comma);
|
||||
d.op(Op::RET);
|
||||
|
||||
// : ( -- )
|
||||
d.entry(); d.name(1, *b": "); let colon = d.here;
|
||||
d.call(create); d.call(smudge); d.call(rbracket); d.op(Op::RET);
|
||||
|
||||
// ; ( -- )
|
||||
d.entry(); d.name(1 | 0x80, *b"; "); let semicolon = d.here;
|
||||
d.lit(!(Op::RET as u16)); d.op(Op::INV); d.call(comma);
|
||||
d.call(lbracket); d.call(unsmudge); d.op(Op::RET);
|
||||
|
||||
// ? primitive
|
||||
d.entry(); d.name(1 | 0x80, *b"? "); let q = d.here;
|
||||
d.lit(!(Op::Q as u16)); d.op(Op::INV); d.call(comma); d.op(Op::RET);
|
||||
|
||||
d.c.store(latest_ptr, q-6);
|
||||
d.c.store(here_ptr, d.here);
|
||||
d.c.store(state_ptr, 0xffff);
|
||||
|
||||
quit
|
||||
};
|
||||
|
||||
run(c, x);
|
||||
use Op::*;
|
||||
let mut d = Dict {dp: 0, here: 2, c: c};
|
||||
|
||||
// key ( -- n )
|
||||
d.entry(); d.name(3, *b"key"); let key = d.here;
|
||||
d.lit(0); d.op(IO); d.op(RET);
|
||||
|
||||
// emit ( n -- )
|
||||
d.entry(); d.name(4, *b"emi"); let emit = d.here;
|
||||
d.lit(1); d.op(IO); d.op(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);
|
||||
|
||||
// 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);
|
||||
|
||||
let zero = d.here;
|
||||
d.lit(0); d.op(RTO); d.op(DRP); d.op(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);
|
||||
|
||||
// >= ( 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);
|
||||
|
||||
// = ( a b -- a=b )
|
||||
d.entry(); d.name(1, *b"= "); let eq = d.here;
|
||||
d.call(sub); d.call(zero_eq); d.op(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);
|
||||
|
||||
d.entry(); d.name(6, *b"ski"); let skipws = d.here;
|
||||
d.call(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);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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;
|
||||
d.call(twodup);
|
||||
d.call(geq); d.op(Q); d.op(SWP);
|
||||
d.op(DRP); d.op(RET);
|
||||
|
||||
// c@ ( a -- n )
|
||||
d.entry(); d.name(2, *b"c@ "); let cld = d.here;
|
||||
d.op(LD); d.lit(0xff); d.call(and); d.op(RET);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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);
|
||||
|
||||
d.entry(); d.name(5, *b"get"); let getcs = d.here;
|
||||
d.call(getcs_helper); d.op(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);
|
||||
|
||||
// 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);
|
||||
|
||||
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);
|
||||
|
||||
let matched = d.here;
|
||||
d.lit(6); d.op(ADD); d.op(RTO); d.op(DRP); d.op(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);
|
||||
|
||||
// find ( -- xt|0 )
|
||||
d.entry(); d.name(4, *b"fin"); let find = d.here;
|
||||
d.call(latest); d.op(LD); d.call(find_helper);
|
||||
|
||||
// ' ( -- xt|0 )
|
||||
d.entry(); d.name(1, *b"' ");
|
||||
d.call(word); d.op(DRP); d.call(find); d.op(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);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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);
|
||||
|
||||
let word_addr = d.here;
|
||||
d.lit(latest_ptr); d.op(LD); d.lit(2); d.op(ADD);
|
||||
d.op(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);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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);
|
||||
|
||||
// [ ( -- )
|
||||
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);
|
||||
|
||||
// ] ( -- )
|
||||
d.entry(); d.name(1 | 0x80, *b"] "); let rbracket = d.here;
|
||||
d.lit(0); d.call(state); d.op(ST); d.op(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);
|
||||
|
||||
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);
|
||||
|
||||
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);
|
||||
|
||||
let end_num = d.here;
|
||||
d.op(DRP); d.op(RTO); d.op(DRP); d.op(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);
|
||||
|
||||
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);
|
||||
|
||||
// number ( -- n|-1 )
|
||||
d.entry(); d.name(6, *b"num"); let number = d.here;
|
||||
d.lit(0); d.lit(1); d.call(number_helper);
|
||||
|
||||
// execute ( xt -- )
|
||||
d.entry(); d.name(7, *b"exe"); let execute = d.here;
|
||||
d.op(TOR); d.op(RET);
|
||||
|
||||
let doit = d.here;
|
||||
d.op(RTO); d.op(DRP);
|
||||
d.call(compile_call); d.call(execute); d.op(RET);
|
||||
|
||||
let bad = d.here;
|
||||
d.op(DRP); d.lit(63); d.call(emit);
|
||||
d.op(RTO); d.op(DRP); d.op(RET);
|
||||
|
||||
// dispatch ( xt -- )
|
||||
d.entry(); d.name(9, *b"int"); let dispatch = d.here;
|
||||
d.op(DUP); d.op(Q); d.call(doit);
|
||||
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);
|
||||
|
||||
// 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);
|
||||
|
||||
// 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);
|
||||
|
||||
// : ( -- )
|
||||
d.entry(); d.name(1, *b": ");
|
||||
d.call(create); d.call(smudge); d.call(rbracket); d.op(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);
|
||||
|
||||
// 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(2, *b">r ");
|
||||
d.op(RTO); d.op(SWP); d.op(TOR); d.op(TOR); d.op(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"@ "); 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.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 ;
|
||||
|
|
@ -599,12 +538,13 @@ fn build_dictionary(c: &mut Core) {
|
|||
: done drop rdrop ret ;
|
||||
: stars ( n -- ) loop[ dup 0= ? done 1 - 42 emit ]loop ;
|
||||
*/
|
||||
}
|
||||
|
||||
fn main() {
|
||||
//test_stack();
|
||||
//test_core();
|
||||
let mut c = new_core();
|
||||
build_dictionary(&mut c);
|
||||
c.ip = 0;
|
||||
loop {
|
||||
c.step();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue