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

Supersede the old version.

Browse source
This commit is contained in:
psf 2022-05-17 23:44:49 -07:00
parent 342490230a
commit e227bfadb1
5 changed files with 420 additions and 994 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
README.md
View file

@ -1,41 +1,2 @@
Forth in Rust. 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
```

2
build.sh
View file

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

0
frustration2.fs → frustration.fs
View file

883
frustration.rs
View file

@ -1,535 +1,490 @@
/* --- The virtual CPU ---
*/
use std::io; use std::io;
use std::io::Read;
use std::io::Write;
use std::convert::TryInto; 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 ADDRESS_SPACE: usize = 65535;
const STACK_WORDS: usize = 16;
const RAM_BYTES: usize = ADDRESS_SPACE - 2*2*STACK_WORDS;
#[derive(Debug)] #[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 { struct Core {
ram: [u8; RAM_BYTES], ram: [u8; ADDRESS_SPACE],
ip: u16, 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); 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}, } else {
TableEntry {f: to_r_d , name: Some(ShortName {bytes: *b">r ", length: 2}), immediate: false}, 0
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} );
},
| 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 { /* --- The memory map ---
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 = [ /* --- The dictionary format ---
"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 { /* --- The threading kind ---
outer(&mut c, s); */
/* --- 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);
} }
return c; fn comma(&mut self, val: u16) {
} self.c.store(self.here, val);
self.allot(2);
}
// --- Dictionary management --- fn emit<T: Into<Item>>(&mut self, val: T) {
match val.into() {
fn init_dictionary(c: &mut Core) { Item::Call(val) => { self.comma(val) }
let mut opcode = 65535; Item::Opcode(val) => { self.comma(val as u16) }
for p in PRIMITIVES { Item::Literal(val) => { assert!(val <= 0x7fff);
match p.name { self.comma((val << 1) | 1) }
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> { fn name(&mut self, n: u8, val: [u8; 3]) {
let mut addr = c.dp as usize; self.comma(n as u16 | ((val[0] as u16) << 8));
while addr != 0 { self.comma(val[1] as u16 | ((val[2] as u16) << 8));
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) { fn entry(&mut self) {
c.ram[(c.dp as usize) + 2] |= 0x40; let here = self.here;
} self.comma(self.dp);
self.dp = here;
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) { fn build_dictionary(c: &mut Core) {
let addr = c.here as usize; use Op::*;
c.ram[addr..=addr+1].copy_from_slice(&val.to_le_bytes()); use Item::*;
c.here += 2;
}
fn comma_d(c: &mut Core) { let mut d = Dict {dp: 0, here: 2, c: c};
let val = pop(c);
comma(c, val);
}
// --- Memory management --- macro_rules! forth {
($x:expr) => (d.emit($x));
fn store(c: &mut Core) { ($x:expr, $($y:expr),+) => (d.emit($x); forth!($($y),+))
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];
} }
}
fn dup(c: &mut Core) { // key ( -- n )
let val = pop(c); d.entry(); d.name(3, *b"key"); let key = d.here;
push(c, val); forth!(Literal(0), IO, RET);
push(c, val);
}
fn swap(c: &mut Core) { // emit ( n -- )
let val1 = pop(c); d.entry(); d.name(4, *b"emi"); let emit = d.here;
let val2 = pop(c); forth!(Literal(1), IO, RET);
push(c, val1);
push(c, val2);
}
fn drop(c: &mut Core) { // - ( a b -- a-b )
let _ = pop(c); 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) { let zero = d.here;
c.rstack[c.trs] = val; forth!(Literal(0), RTO, DRP, RET);
c.trs += 1;
}
fn to_r_d(c: &mut Core) { // 0= ( n -- f )
let r1 = from_r(c); d.entry(); d.name(2, *b"0= "); let zero_eq = d.here;
let r2 = pop(c); forth!(Q, zero, Literal(0), INV, RET);
to_r(c, r2);
to_r(c, r1);
}
fn from_r(c: &mut Core) -> u16 { // = ( a b -- a=b )
c.trs -= 1; d.entry(); d.name(1, *b"= "); let eq = d.here;
return c.rstack[c.trs]; forth!(sub, zero_eq, RET);
}
fn from_r_d(c: &mut Core) { // Advance past whitespace
let r1 = from_r(c); let skip_helper = d.here;
let r2 = from_r(c); forth!(RTO, DRP, key, DUP, Literal(33), GEQ, Q, RET, DRP, skip_helper);
to_r(c, r1);
push(c, r2);
}
fn call(c: &mut Core) { d.entry(); d.name(6, *b"ski"); let skipws = d.here;
to_r(c, c.ip); forth!(skip_helper);
c.ip = pop(c);
}
// note: this is an inline primitive, not a dict entry // over ( a b -- a b a )
fn ret(c: &mut Core) { d.entry(); d.name(4, *b"ove"); let over = d.here;
if c.trs == 0 { forth!(TOR, DUP, RTO, SWP, RET);
std::process::exit(0);
}
c.ip = from_r(c);
}
fn ret_d(c: &mut Core) { // 2dup ( a b -- a b a b )
_ = from_r(c); d.entry(); d.name(4, *b"2du"); let twodup = d.here;
ret(c); forth!(over, over, RET);
}
// --- Control flow --- // Buffer for parsing an input word, formatted as Nabcde.
fn if_skip(c: &mut Core) { let word_buf = d.here;
let truthy = pop(c); d.allot(6);
let retaddr = from_r(c);
to_r(c, retaddr + if truthy == 0 { 2 } else { 0 });
}
// --- I/O --- // min ( a b -- n )
fn dot(c: &mut Core) { d.entry(); d.name(3, *b"min"); let min = d.here;
print!("{} ", pop(c)); forth!(twodup, GEQ, Q, SWP, DRP, RET);
}
fn dots(c: &mut Core) { // c@ ( a -- n )
for i in &c.dstack[0..c.tds] { d.entry(); d.name(2, *b"c@ "); let cld = d.here;
print!("{} ", i); forth!(LD, Literal(0xff), AND, RET);
}
}
fn dump(c: &mut Core) { // c! ( n a -- )
println!("{:?}", c); 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) { // Load 1 letter into buffer.
match &c.next_token { let stchar = d.here;
Some(t) => { forth!(Literal(word_buf), cld, Literal(1), ADD, DUP, Literal(word_buf), cst,
println!("{}", t); Literal(5), min, Literal(word_buf), ADD, cst, RET);
c.post = Post::EatWord;
}
_ => {}
}
}
// --- 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 d.entry(); d.name(5, *b"get"); let getcs = d.here;
fn lit(c: &mut Core) { forth!(getcs_helper, RET);
let ip = c.ip as usize;
push(c, u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap()));
c.ip += 2;
}
fn add(c: &mut Core) { // word ( -- )
let v1 = pop(c); // Not quite standard.
let v2 = pop(c); d.entry(); d.name(4, *b"wor"); let word = d.here;
push(c, v1.wrapping_add(v2)); 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) { // latest ( -- a )
let v1 = pop(c); // Address of "latest" variable. This variable stores the address of
let v2 = pop(c); // the latest word in the dictionary.
push(c, v2.wrapping_sub(v1)); 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 matches = d.here;
let v1 = pop(c); forth!(Literal(2), ADD, TOR,
let v2 = pop(c); Literal(word_buf), DUP, Literal(2), ADD, LD, SWP, LD,
push(c, v1.saturating_mul(v2)); RTO, DUP, TOR,
} LD, Literal(0x0080), INV, AND, eq,
SWP, RTO, Literal(2), ADD, LD, eq, AND, RET);
fn div(c: &mut Core) { let matched = d.here;
let v1 = pop(c); forth!(Literal(6), ADD, RTO, DRP, RET);
let v2 = pop(c);
push(c, v2.saturating_div(v1));
}
// --- 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 { // find ( -- xt|0 )
let ip = c.ip as usize; d.entry(); d.name(4, *b"fin"); let find = d.here;
let opcode = u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap()); forth!(latest, LD, find_helper);
c.ip += 2;
return opcode;
}
fn execute(c: &mut Core, opcode: u16) { // ' ( -- xt|0 )
let primitive_index = (65535 - opcode) as usize; d.entry(); d.name(1, *b"' ");
if primitive_index < PRIMITIVES.len() { forth!(word, find, RET);
(PRIMITIVES[primitive_index].f)(c);
} else {
// call
to_r(c, c.ip);
c.ip = opcode;
}
}
fn step(c: &mut Core) { /* --- The outer interpreter ---
let opcode = fetch(c); */
execute(c, opcode);
}
fn inner(c: &mut Core) { // x10 ( n -- n*10 )
loop { d.entry(); d.name(3, *b"x10"); let x10 = d.here;
step(c); forth!(DUP, DUP, Literal(3), SFT, ADD, ADD, RET);
//println!("ip={} trs={}", c.ip, c.trs);
if c.trs == 0 {
break;
}
}
}
// --- 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) { // state ( -- a )
c.state = State::Interpreting; // 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) { let word_addr = d.here;
c.state = State::Compiling; forth!(Literal(latest_ptr), LD, Literal(2), ADD, RET);
}
fn latest(c: &mut Core) { // immediate ( -- )
push(c, c.dp); d.entry(); d.name(9 | 0x80, *b"imm");
} forth!(word_addr, DUP, LD, Literal(0x0080), OR, SWP, ST, RET);
fn here(c: &mut Core) { // smudge ( -- )
push(c, c.here); 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) { // unsmudge ( -- )
let ss = s.trim(); d.entry(); d.name(8 | 0x80, *b"uns"); let unsmudge = d.here;
let mut tokens = ss.split(" ").peekable(); forth!(word_addr, DUP, LD, Literal(0x0040), INV, AND, SWP, ST, RET);
loop {
c.post = Post::Nothing; // [ ( -- )
match tokens.next() { d.entry(); d.name(1 | 0x80, *b"[ "); let lbracket = d.here;
Some(t) => { forth!(Literal(0), INV, state, ST, RET);
c.next_token = match tokens.peek() {
Some(t) => { Some(t.to_string()) } // ] ( -- )
None => { None } d.entry(); d.name(1 | 0x80, *b"] "); let rbracket = d.here;
}; forth!(Literal(0), state, ST, RET);
match find(c, truncate_name(t)) {
Some(addr) => { // , ( n -- )
if c.state == State::Interpreting || is_immediate(c, addr) { d.entry(); d.name(1, *b", "); let comma = d.here;
to_r(c, c.ip); forth!(here, LD, ST,
c.ip = addr; here, LD, Literal(2), ADD, here, ST, RET);
inner(c);
} else { let compile_call = d.here;
comma(c, addr); forth!(DUP, Literal(4), sub, LD, Literal(0x0080), AND, state, LD, OR, Q, RET,
} comma, RTO, DRP, RET);
}
None => { let compile_lit = d.here;
let val = t.parse::<u16>(); forth!(state, LD, Q, RET,
match val { DUP, ADD, Literal(1), ADD, comma, RTO, DRP, RET);
Ok(n) => {
match c.state { let end_num = d.here;
State::Interpreting => { push(c, n) } forth!(DRP, RTO, DRP, RET);
State::Compiling => {
comma(c, 65534); // lit let bad_num = d.here;
comma(c, n); forth!(DRP, DRP, DRP, Literal(0), INV, RTO, DRP, RET);
}
} let number_helper = d.here;
} forth!(RTO, DRP, DUP, Literal(word_buf), ADD, cld,
Err(_) => { Literal(48), sub, DUP, Literal(10), GEQ, Q, bad_num,
if t != "" { SWP, TOR, SWP, x10, ADD, RTO,
println!("{}?", t); DUP, Literal(word_buf), cld, GEQ, Q, end_num,
c.post = Post::WarmReset; 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 -- )
None => { break ; } d.entry(); d.name(7, *b"exe"); let execute = d.here;
} forth!(TOR, RET);
match c.post {
Post::EatWord => { _ = tokens.next(); } let doit = d.here;
Post::WarmReset => { forth!(RTO, DRP, compile_call, execute, RET);
c.tds = 0;
c.trs = 0; let bad = d.here;
c.state = State::Interpreting; forth!(DRP, Literal(63), emit, RTO, DRP, RET);
break; // discard rest of input line
} // dispatch ( xt -- )
Post::Nothing => { } 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() { fn main() {
let mut c = new_core(); let mut c = new_core();
build_dictionary(&mut c);
c.ip = 0;
loop { 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
*/

490
frustration2.rs
View file

@ -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();
}
}