/* --- The virtual CPU --- */ use std::io; 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], tos: usize } impl Stack { fn push(&mut self, val: u16) { self.tos = (self.tos.wrapping_add(1)) & (STACK_WORDS - 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); return val; } } #[derive(Debug)] struct Core { ram: [u8; ADDRESS_SPACE], ip: u16, dstack: Stack, rstack: Stack } 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]}}; 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, INV = 0xfff8, OUT = 0xfffa, IN = 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 let a = x.dstack.pop(); x.dstack.push(x.load(a)); }, | x | { // 4: st let a = x.dstack.pop(); let v = x.dstack.pop(); x.store(a, v); }, | x | { // 5: dup let v = x.dstack.pop(); x.dstack.push(v); x.dstack.push(v); }, | x | { // 6: 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: ? let f = x.dstack.pop(); if f == 0 { x.ip = x.ip.wrapping_add(2) }; }, | x | { // 9: add let v1 = x.dstack.pop(); let v2 = x.dstack.pop(); x.dstack.push(v1.wrapping_add(v2)); }, | x | { // a: 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 | { // b: or let v1 = x.dstack.pop(); let v2 = x.dstack.pop(); x.dstack.push(v1 | v2); }, | x | { // c: inv let v1 = x.dstack.pop(); x.dstack.push(!v1); }, | x | { // d: out let port = x.dstack.pop(); let val = x.dstack.pop(); if port == 1 { print!("{}", ((val & 0xff) as u8) as char); 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 }, ]; 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 --- */ /* --- The dictionary format --- */ /* --- The threading kind --- */ /* --- Create the dictionary --- */ // helper struct Dict<'a> { dp: u16, here: u16, c: &'a mut Core } 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 call(&mut self, val: u16) { self.comma(val); } fn op(&mut self, val: Op) { self.comma(val as u16); } fn lit(&mut self, val: u16) { assert!(val & 0x8000 == 0); assert!(val < 0x7ff0); 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; } } // 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); /*--- : lit dup + 1 + , ; : setup r> r> dup >r >r >r ; : rdrop r> r> drop >r ; : loop[ [ ' setup lit ] , [ ' rdrop lit ] , ; immediate : ]loop latest @ 8 + , ; immediate : ( loop[ 41 key = ? ret ]loop ; immediate : done drop rdrop ret ; : stars ( n -- ) loop[ dup 0= ? done 1 - 42 emit ]loop ; */ } fn main() { //test_stack(); //test_core(); let mut c = new_core(); build_dictionary(&mut c); }