frustration/frustration.rs

use std::io;
use std::convert::TryInto;

#[derive(Debug, Eq, PartialEq)]
enum State {
    Compiling,
    Interpreting
}

#[derive(Debug)]
enum Post {
    Nothing,
    EatWord,
    WarmReset,
}

const ADDRESS_SPACE: usize = 65535;
const STACK_WORDS: usize = 16;
const RAM_BYTES: usize = ADDRESS_SPACE - 2*2*STACK_WORDS;

#[derive(Debug)]
struct Core {
    ram: [u8; RAM_BYTES],
    ip: u16,
    dp: u16,  // newest link field, or 0
    here: u16, // first unused byte
    state: State,
    next_token: Option<String>,
    post: Post,
    dstack: [u16; STACK_WORDS],
    tds: usize,  // post-incremented; exceeds top by one
    rstack: [u16; STACK_WORDS],
    trs: usize,  // post-incremented; exceeds top by one
}

type Primitive = fn(&mut Core);

struct ShortName {
    bytes: [u8; 3],
    length: u8
}

fn truncate_name(name: &str) -> ShortName {
    let name_bytes = name.as_bytes();
    let mut out = ShortName {
        bytes: *b"   ",
        length: name_bytes.len() as u8 };
    let n = std::cmp::min(3, out.length) as usize;
    out.bytes[0..n].copy_from_slice(&name_bytes[0..n]);
    return out;
}

struct TableEntry {
    f: Primitive,
    name: Option<ShortName>,
    immediate: bool
}

const PRIMITIVES: [TableEntry; 31] = [
    TableEntry {f: ret     , name: None, immediate: false},
    TableEntry {f: lit     , name: None, immediate: false},
    TableEntry {f: add     , name: Some(ShortName {bytes: *b"+  ", length: 1}), immediate: false},
    TableEntry {f: call    , name: Some(ShortName {bytes: *b"cal", length: 4}), immediate: false},
    TableEntry {f: comma_d , name: Some(ShortName {bytes: *b",  ", length: 1}), immediate: false},
    TableEntry {f: create_d, name: Some(ShortName {bytes: *b"cre", length: 6}), immediate: false},
    TableEntry {f: div     , name: Some(ShortName {bytes: *b"/  ", length: 1}), immediate: false},
    TableEntry {f: dot     , name: Some(ShortName {bytes: *b".  ", length: 1}), immediate: false},
    TableEntry {f: dots    , name: Some(ShortName {bytes: *b".s ", length: 2}), immediate: false},
    TableEntry {f: drop    , name: Some(ShortName {bytes: *b"dro", length: 4}), immediate: false},
    TableEntry {f: dup     , name: Some(ShortName {bytes: *b"dup", length: 3}), immediate: false},
    TableEntry {f: dump    , name: Some(ShortName {bytes: *b"dum", length: 4}), immediate: false},
    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},
    TableEntry {f: if_skip  ,name: Some(ShortName {bytes: *b"?  ", length: 1}), immediate: false},
    TableEntry {f: immediate,name: Some(ShortName {bytes: *b"imm", length: 9}), immediate: false},
    TableEntry {f: latest  , name: Some(ShortName {bytes: *b"lat", length: 6}), immediate: false},
    TableEntry {f: lbracket, name: Some(ShortName {bytes: *b"[  ", length: 1}), immediate: true},
    TableEntry {f: load    , name: Some(ShortName {bytes: *b"@  ", length: 1}), immediate: false},
    TableEntry {f: mul     , name: Some(ShortName {bytes: *b"*  ", length: 1}), immediate: false},
    TableEntry {f: ret_d   , name: Some(ShortName {bytes: *b"ret", length: 3}), immediate: false},
    TableEntry {f: rbracket, name: Some(ShortName {bytes: *b"]  ", length: 1}), immediate: false},
    TableEntry {f: smudge  , name: Some(ShortName {bytes: *b"smu", length: 6}), immediate: false},
    TableEntry {f: store   , name: Some(ShortName {bytes: *b"!  ", length: 1}), immediate: false},
    TableEntry {f: sub     , name: Some(ShortName {bytes: *b"-  ", length: 1}), immediate: false},
    TableEntry {f: swap    , name: Some(ShortName {bytes: *b"swa", length: 4}), immediate: false},
    TableEntry {f: tick    , name: Some(ShortName {bytes: *b"'  ", length: 1}), immediate: false},
    TableEntry {f: to_r_d  , name: Some(ShortName {bytes: *b">r ", length: 2}), immediate: false},
    TableEntry {f: unsmudge, name: Some(ShortName {bytes: *b"uns", length: 8}), immediate: false},
    TableEntry {f: word    , name: Some(ShortName {bytes: *b"wor", length: 4}), immediate: false}
];

fn new_core() -> Core {
    let mut c = Core {
        ram: [0; RAM_BYTES], ip: 0, dp: 0, here: 2, state: State::Interpreting,
        next_token: None,
        post: Post::Nothing,
        dstack: [0; STACK_WORDS], tds: 0,
        rstack: [0; STACK_WORDS], trs: 0 };
    init_dictionary(&mut c);

    let autoexec = [
        "create :  ] create smudge ] [ 65535 ,",
        "create ;  ] unsmudge 65535 , [ ' [ , 65535 , immediate",
        ": recursive  unsmudge ; immediate",
        ": literal  65534 , , ; immediate",
        ": constant  create [ ' literal , ] [ ' ret ] literal , ;",
        ": variable  create  here 6 +  [ ' literal , ]  [ ' ret ] literal , 0 , ;"
    ];

    for s in autoexec {
        outer(&mut c, s);
    }

    return c;
}

// --- Dictionary management ---

fn init_dictionary(c: &mut Core) {
    let mut opcode = 65535;
    for p in PRIMITIVES {
        match p.name {
	        Some(name) => {
                create(c, name);
                if p.immediate {
                    immediate(c);
                }
                comma(c, opcode);
                comma(c, 65535); // ret
	        }
            None => {}
        }
        opcode -= 1;
	}
}

fn create(c: &mut Core, name: ShortName) {
    let addr: usize = c.here as usize;
    c.ram[addr+0..=addr+1].copy_from_slice(&c.dp.to_le_bytes());
    c.dp = addr as u16;
    c.ram[addr+2] = name.length & 0x7f;
    c.ram[addr+3..=addr+5].copy_from_slice(&name.bytes);
    c.here = (addr+6) as u16;
}

fn create_d(c: &mut Core) {
    match &c.next_token {
        Some(t) => {
            let short_name = truncate_name(t);
            create(c, short_name);
            c.post = Post::EatWord;
        }
        _ => {
            println!(" create needs an argument");
            c.post = Post::WarmReset;
        }
    }
}

fn find(c: &mut Core, name: ShortName) -> Option<u16> {
    let mut addr = c.dp as usize;
    while addr != 0 {
        if (c.ram[addr+2] & 0x7f) == name.length {
            if c.ram[addr+3..=addr+5] == name.bytes {
                return Some((addr+6) as u16);
            }
        }
        addr = u16::from_le_bytes(c.ram[addr..=addr+1].try_into().unwrap()) as usize;
    }
    return None;
}

fn smudge(c: &mut Core) {
    c.ram[(c.dp as usize) + 2] |= 0x40;
}

fn unsmudge(c: &mut Core) {
    c.ram[(c.dp as usize) + 2] &= 0xbf;
}

fn immediate(c: &mut Core) {
    c.ram[(c.dp as usize) + 2] ^= 0x80;
}

fn is_immediate(c: &mut Core, addr: u16) -> bool {
    return (c.ram[(addr as usize) - 4] & 0x80) != 0;
}

fn tick(c: &mut Core) {
    match &c.next_token {
        Some(t) => {
            let name = t.to_string();
            let addr = find(c, truncate_name(&name));
            match addr {
                Some(xt) => {
                    push(c, xt);
                    c.post = Post::EatWord;
                }
                None => {
                    println!(" ' cannot find {}", name);
                    c.post = Post::WarmReset;
                }
            }
        }
        _ => {
            println!(" ' needs an argument");
            c.post = Post::WarmReset;
        }
    }
}

fn comma(c: &mut Core, val: u16) {
    let addr = c.here as usize;
    c.ram[addr..=addr+1].copy_from_slice(&val.to_le_bytes());
    c.here += 2;
}

fn comma_d(c: &mut Core) {
    let val = pop(c);
    comma(c, val);
}

// --- Memory management ---

fn store(c: &mut Core) {
    let addr = pop(c) as usize;
    let val = pop(c);
    c.ram[addr..=addr+1].copy_from_slice(&val.to_le_bytes());
}

fn load(c: &mut Core) {
    let addr = pop(c) as usize;
    push(c, u16::from_le_bytes(c.ram[addr..=addr+1].try_into().unwrap()));
}

fn forget(c: &mut Core) {
    let xt = pop(c);
    c.here = xt - 6;
    let i = c.here as usize;
    c.dp = u16::from_le_bytes(c.ram[i..=i+1].try_into().unwrap());
}

// --- Stack management ---

fn push(c: &mut Core, val: u16) {
    c.dstack[c.tds] = val;
    c.tds += 1;
}

fn pop(c: &mut Core) -> u16 {
    if c.tds == 0 {
        println!(" stack underflow");
        c.post = Post::WarmReset; // note: could get overwritten later :(
        return 0; // half-assed, should really return straight to interpreter
    } else {
        c.tds -= 1;
        return c.dstack[c.tds];
    }
}

fn dup(c: &mut Core) {
    let val = pop(c);
    push(c, val);
    push(c, val);
}

fn swap(c: &mut Core) {
    let val1 = pop(c);
    let val2 = pop(c);
    push(c, val1);
    push(c, val2);
}

fn drop(c: &mut Core) {
    let _ = pop(c);
}

fn to_r(c: &mut Core, val: u16) {
    c.rstack[c.trs] = val;
    c.trs += 1;
}

fn to_r_d(c: &mut Core) {
    let r1 = from_r(c);
    let r2 = pop(c);
    to_r(c, r2);
    to_r(c, r1);
}

fn from_r(c: &mut Core) -> u16 {
    c.trs -= 1;
    return c.rstack[c.trs];
}

fn from_r_d(c: &mut Core) {
    let r1 = from_r(c);
    let r2 = from_r(c);
    to_r(c, r1);
    push(c, r2);
}

fn call(c: &mut Core) {
    to_r(c, c.ip);
    c.ip = pop(c);
}

// note: this is an inline primitive, not a dict entry
fn ret(c: &mut Core) {
    if c.trs == 0 {
        std::process::exit(0);
    }
    c.ip = from_r(c);
}

fn ret_d(c: &mut Core) {
    _ = from_r(c);
    ret(c);
}

// --- Control flow ---
fn if_skip(c: &mut Core) {
    let truthy = pop(c);
    let retaddr = from_r(c);
    to_r(c, retaddr + if truthy == 0 { 2 } else { 0 });
}

// --- I/O ---
fn dot(c: &mut Core) {
    print!("{} ", pop(c));
}

fn dots(c: &mut Core) {
    for i in &c.dstack[0..c.tds] {
        print!("{} ", i);
    }
}

fn dump(c: &mut Core) {
    println!("{:?}", c);
}

fn word(c: &mut Core) {
    match &c.next_token {
        Some(t) => {
            println!("{}", t);
            c.post = Post::EatWord;
        }
        _ => {}
    }
}

// --- Math and logic ---

// note: this is an inline primitive, not a dict entry
fn lit(c: &mut Core) {
    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) {
    let v1 = pop(c);
    let v2 = pop(c);
    push(c, v1.wrapping_add(v2));
}

fn sub(c: &mut Core) {
    let v1 = pop(c);
    let v2 = pop(c);
    push(c, v2.wrapping_sub(v1));
}

fn mul(c: &mut Core) {
    let v1 = pop(c);
    let v2 = pop(c);
    push(c, v1.saturating_mul(v2));
}

fn div(c: &mut Core) {
    let v1 = pop(c);
    let v2 = pop(c);
    push(c, v2.saturating_div(v1));
}

// --- Inner interpreter ---

fn fetch(c: &mut Core) -> u16 {
    let ip = c.ip as usize;
    let opcode = u16::from_le_bytes(c.ram[ip..=ip+1].try_into().unwrap());
    c.ip += 2;
    return opcode;
}

fn execute(c: &mut Core, opcode: u16) {
    let primitive_index = (65535 - opcode) as usize;
    if primitive_index < PRIMITIVES.len() {
        (PRIMITIVES[primitive_index].f)(c);
    } else {
        // call
        to_r(c, c.ip);
        c.ip = opcode;
    }
}

fn step(c: &mut Core) {
    let opcode = fetch(c);
    execute(c, opcode);
}

fn inner(c: &mut Core) {
    loop {
        step(c);
        //println!("ip={} trs={}", c.ip, c.trs);
        if c.trs == 0 {
            break;
        }
    }
}

// --- Outer interpreter ---

fn lbracket(c: &mut Core) {
    c.state = State::Interpreting;
}

fn rbracket(c: &mut Core) {
    c.state = State::Compiling;
}

fn latest(c: &mut Core) {
    push(c, c.dp);
}

fn here(c: &mut Core) {
    push(c, c.here);
}

fn outer(c: &mut Core, s: &str) {
    let ss = s.trim();
    let mut tokens = ss.split(" ").peekable();
    loop {
        c.post = Post::Nothing;
        match tokens.next() {
            Some(t) => {
                c.next_token = match tokens.peek() {
                    Some(t) => { Some(t.to_string()) }
                    None => { None }
                };
                match find(c, truncate_name(t)) {
                    Some(addr) => {
                        if c.state == State::Interpreting || is_immediate(c, addr) {
                            to_r(c, c.ip);
                            c.ip = addr;
                            inner(c);
                        } else {
                            comma(c, addr);
                        }
                    }
                    None => {
                        let val = t.parse::<u16>();
                        match val {
                            Ok(n) => {
                                match c.state {
                                    State::Interpreting => { push(c, n) }
                                    State::Compiling => {
                                        comma(c, 65534); // lit
                                        comma(c, n);
                                    }
                                }
                            }
                            Err(_) => {
                                if t != "" {
                                    println!("{}?", t);
                                    c.post = Post::WarmReset;
                                }
                            }
                        }
                    }
                }
            }
            None => { break ; }
        }
        match c.post {
            Post::EatWord => { _ = tokens.next(); }
            Post::WarmReset => {
                c.tds = 0;
                c.trs = 0;
                c.state = State::Interpreting;
                break; // discard rest of input line
            }
            Post::Nothing => { }
        };
    }
}

fn main() {
    let mut c = new_core();
    loop {
        let mut buf = String::new();
        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
 */