frustration/frustration2.rs

/* --- 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);
}