upgrade winit

.idea/vulcan-emu.iml

@@ -12,6 +12,7 @@
       <sourceFolder url="file://$MODULE_DIR$/vweb/src" isTestSource="false" />
       <sourceFolder url="file://$MODULE_DIR$/vgfx/src" isTestSource="false" />
       <sourceFolder url="file://$MODULE_DIR$/forge_core/src" isTestSource="false" />
+      <sourceFolder url="file://$MODULE_DIR$/novaforth/src" isTestSource="false" />
       <excludeFolder url="file://$MODULE_DIR$/target" />
     </content>
     <orderEntry type="inheritedJdk" />

Cargo.toml

@@ -9,8 +9,8 @@ members = [
     "vlua",
     "vweb",
     "vgfx",
-    "forge_core"
+    "forge_core",
-]
+    "novaforth"]
 
 [profile.test]
 debug-assertions = false

forge_core/src/ast.rs

@@ -58,6 +58,8 @@ pub struct FunctionPrototype {
 
 #[derive(PartialEq, Clone, Debug)]
 pub enum Statement {
+    Break,
+    Continue,
     Return(Return),
     Assignment(Assignment),
     Expr(Expr),
@@ -65,7 +67,8 @@ pub enum Statement {
     Conditional(Conditional),
     WhileLoop(WhileLoop),
     RepeatLoop(RepeatLoop),
-    Asm(Asm)
+    Asm(Asm),
+    Once(Once)
 }
 
 #[derive(PartialEq, Clone, Debug)]
@@ -115,6 +118,11 @@ pub struct Conditional {
     pub alternative: Option<Block>,
 }
 
+#[derive(PartialEq, Clone, Debug)]
+pub struct Once {
+    pub body: Block
+}
+
 #[derive(PartialEq, Clone, Debug)]
 pub struct WhileLoop {
     pub condition: Expr,
@@ -174,6 +182,8 @@ pub enum Expr {
     Call(Call),
     New(BoxExpr),
     Static(BoxExpr),
+    Peek(BoxExpr),
+    Poke(BoxExpr, BoxExpr),
     Subscript(BoxExpr, BoxExpr),
     Infix(BoxExpr, Operator, BoxExpr),
     String(String),
@@ -229,6 +239,8 @@ impl Statement {
     pub fn description(&self) -> String {
         String::from(
             match self {
+                Statement::Break => "break",
+                Statement::Continue => "continue",
                 Statement::Return(_) => "return",
                 Statement::Assignment(_) => "assignment",
                 Statement::Expr(_) => "expr",
@@ -236,7 +248,8 @@ impl Statement {
                 Statement::Conditional(_) => "conditional",
                 Statement::WhileLoop(_) => "whileLoop",
                 Statement::RepeatLoop(_) => "repeatLoop",
-                Statement::Asm(_) => "asm"
+                Statement::Asm(_) => "asm",
+                Statement::Once(_) => "once"
             }
         )
     }

forge_core/src/compiler/ast_nodes/block.rs

@@ -15,6 +15,28 @@ impl Compilable for Block {
             let loc = stmt.location;
             sig.emit_comment(format!(";; {}:{} :: {}", loc.line, loc.col, stmt.ast.description()));
             match stmt.ast {
+                Statement::Break => {
+                    if sig.in_loop() {
+                        sig.emit("#break")
+                    } else {
+                        return Err(CompileError(loc.line, loc.col, "Break outside loop".to_string()))
+                    }
+                }
+                Statement::Continue => {
+                    if sig.in_loop() {
+                        // This is subtle. To "continue" a while or until loop, we simply need to #continue
+                        // and the assembler takes care of the macro for us. Repeat loops are different though
+                        // because the counter inc / dec takes place at the end of the loop, so we can't use
+                        // the macro, we just want to generate a jmpr instead
+                        if let Some(label) = sig.continue_point() {
+                            sig.emit_arg("jmpr", format!("@{}", label))
+                        } else {
+                            sig.emit("#continue")
+                        }
+                    } else {
+                        return Err(CompileError(loc.line, loc.col, "Continue outside loop".to_string()))
+                    }
+                }
                 Statement::Return(ret) => {
                     ret.process(state, Some(sig), loc)?;
                 }
@@ -44,6 +66,9 @@ impl Compilable for Block {
                 Statement::RepeatLoop(repeat_loop) => {
                     repeat_loop.process(state, Some(sig), loc)?;
                 }
+                Statement::Once(once) => {
+                    once.process(state, Some(sig), loc)?;
+                }
             }
         }
 
@@ -59,6 +84,7 @@ impl Compilable for Block {
 
 #[cfg(test)]
 mod test {
+    use crate::compiler::CompileError;
     use crate::compiler::test_utils::*;
 
     #[test]
@@ -74,6 +100,52 @@ mod test {
         )
     }
 
+    #[test]
+    fn test_break_statements() {
+        assert_eq!(
+            test_body(state_for("fn test() { repeat(10) { break; } }")),
+            vec![
+                "push 10", "#while", "dup", "agt 0", "#do", // standard repeat loop header
+                "#break", // the break
+                "_forge_gensym_3:", "sub 1", "#end", "pop" // repeat loop footer
+            ].join("\n")
+        );
+
+        assert_eq!(
+            test_body(state_for("fn test() { while(1) { break; } }")),
+            vec![
+                "#while", "push 1", "#do", // standard repeat loop header
+                "#break", // the break
+                "#end" // repeat loop footer
+            ].join("\n")
+        )
+    }
+
+    #[test]
+    fn test_continue_statements() {
+        assert_eq!(
+            test_body(state_for("fn test() { repeat(10) { continue; } }")),
+            vec![
+                "push 10", "#while", "dup", "agt 0", "#do", // standard repeat loop header
+                "jmpr @_forge_gensym_3", // the continue, jumping to the label
+                "_forge_gensym_3:", // The label demnoting the start of the counter update
+                "sub 1", "#end", "pop" // repeat loop footer
+            ].join("\n")
+        );
+    }
+
+    #[test]
+    fn test_malformed_break_continue_statements() {
+        assert_eq!(
+            test_err("fn test() { break; }"),
+            Some(CompileError(1, 13, "Break outside loop".to_string()))
+        );
+        assert_eq!(
+            test_err("fn test() { continue; }"),
+            Some(CompileError(1, 13, "Continue outside loop".to_string()))
+        );
+    }
+
     #[test]
     fn test_block_scoping() {
         assert_eq!(
@@ -92,6 +164,7 @@ mod test {
                 "#do",
                 "push 2", // Pointless loop body
                 "pop",
+                "_forge_gensym_3:",
                 "peekr", // Load c as an lvalue
                 "dup", // Dup it, load it, add 1
                 "loadw",

forge_core/src/compiler/ast_nodes/const.rs

@@ -49,7 +49,7 @@ pub fn eval_const(expr: Expr, scope: &Scope) -> Result<i32, CompileError> {
             0,
             String::from("Addresses are not known at compile time"),
         )),
-        Expr::Call(_) | Expr::Subscript(_, _) | Expr::New(_) => Err(CompileError(
+        Expr::Call(_) | Expr::Subscript(_, _) | Expr::New(_) | Expr::Peek(_) | Expr::Poke(_, _) => Err(CompileError(
             0,
             0,
             String::from("Constants must be statically defined"),

forge_core/src/compiler/ast_nodes/expr.rs

@@ -90,10 +90,25 @@ impl Compilable for Expr {
                 size_expr.0.process(state, Some(sig), loc)?;
                 compile_alloc(&mut sig);
                 Ok(())
-            },
+            }
             Expr::Static(size_expr) => {
                 compile_static(size_expr, state, sig)
             }
+            Expr::Peek(addr) => {
+                addr.0.process(state, Some(sig), loc)?;
+                sig.emit("load");
+                Ok(())
+            }
+            Expr::Poke(addr, val) => {
+                // To avoid confusion, we'll evaluate the args in this order and swap
+                addr.0.process(state, Some(sig), loc)?;
+                val.0.process(state, Some(sig), loc)?;
+                // This is an expr, so, we have to evaluate to something. So let's evaluate to the value poked.
+                // To that end, we'll grab the addr from the stack
+                sig.emit("pick 1");
+                sig.emit("store"); // The store consumes the new copy of the addr and the value, leaving the value
+                Ok(())
+            }
             Expr::Subscript(array, index) => {
                 array.0.process(state, Some(sig), loc)?;
                 index.0.process(state, Some(sig), loc)?;
@@ -304,4 +319,21 @@ mod test {
             ].join("\n")
         )
     }
+
+    #[test]
+    fn test_peekpoke() {
+        assert_eq!(
+            test_body(state_for("fn test() { peek(10); poke(20, 30); }")),
+            vec![
+                "push 10",
+                "load",
+                "pop",
+                "push 20",
+                "push 30",
+                "pick 1",
+                "store",
+                "pop"
+            ].join("\n")
+        )
+    }
 }

forge_core/src/compiler/ast_nodes/lvalue.rs

@@ -20,6 +20,8 @@ impl Compilable for Lvalue {
             Expr::Call(_) |
             Expr::New(_) |
             Expr::Static(_) |
+            Expr::Peek(_) |
+            Expr::Poke(_, _) |
             Expr::Infix(_, _, _) |
             Expr::String(_) => {
                 Err(CompileError(0, 0, String::from("Not a valid lvalue")))

forge_core/src/compiler/ast_nodes/mod.rs

@@ -14,3 +14,4 @@ mod r#const;
 mod r#return;
 mod conditional;
 mod while_loop;
+mod once;

forge_core/src/compiler/ast_nodes/once.rs

@@ -0,0 +1,48 @@
+use crate::ast::{Once, Location};
+use crate::compiler::compilable::Compilable;
+use crate::compiler::compiled_fn::CompiledFn;
+use crate::compiler::CompileError;
+use crate::compiler::state::State;
+
+impl Compilable for Once {
+    fn process(self, state: &mut State, sig: Option<&mut CompiledFn>, loc: Location) -> Result<(), CompileError> {
+        let sig = sig.expect("Once block outside function");
+
+        let Once { body } = self;
+        let sym = state.add_flag();
+
+        sig.emit_arg("loadw", sym.clone());
+        sig.emit("#if");
+        sig.emit_arg("push", 0);
+        sig.emit_arg("storew", sym);
+        body.process(state, Some(sig), loc)?;
+        sig.emit("#end");
+        Ok(())
+    }
+}
+
+#[cfg(test)]
+mod test {
+    use crate::compiler::test_utils::*;
+
+    #[test]
+    fn test_once() {
+        assert_eq!(
+            test_body(state_for("fn test() { var x = 0; once { x = 1; } }")),
+            vec![
+                "push 0",
+                "peekr",
+                "storew", // x = 0
+                "loadw _forge_gensym_3", // Load the once flag
+                "#if",
+                "push 0", // clear the once flag
+                "storew _forge_gensym_3",
+                "push 1", // x = 1
+                "peekr",
+                "storew",
+                "#end" // end once block
+            ]
+                .join("\n")
+        );
+    }
+}

forge_core/src/compiler/ast_nodes/repeat_loop.rs

@@ -41,7 +41,11 @@ impl Compilable for RepeatLoop {
 
         // Loop body:
         sig.emit("#do");
+        let cp = state.gensym();
+        sig.enter_loop(Some(cp.clone()));
         body.process(state, Some(sig), loc)?;
+        sig.exit_loop();
+        sig.emit(format!("{}:", cp).as_str());
 
         // After the body we need to increment the counter if there is one
         if named_counter {
@@ -113,6 +117,7 @@ mod test {
                 "peekr", // Load x as an lvalue
                 "add 3",
                 "storew", // Store c + x into it
+                "_forge_gensym_3:",
                 "peekr", // Load c as an lvalue
                 "add 6",
                 "dup", // Dup it, load it, add 1
@@ -155,6 +160,7 @@ mod test {
                 "peekr", // Load x as an lvalue
                 "add 3",
                 "storew", // Store 2x into it
+                "_forge_gensym_3:", // Label for the continue point, before the counter change
                 "sub 1", // decrement the counter
                 "#end", // End of the loop body!
                 "pop", // Drop the limit off the top

forge_core/src/compiler/ast_nodes/while_loop.rs

@@ -11,7 +11,9 @@ impl Compilable for WhileLoop {
         sig.emit("#while");
         condition.process(state, Some(sig), loc)?;
         sig.emit("#do");
+        sig.enter_loop(None);
         body.process(state, Some(sig), loc)?;
+        sig.exit_loop();
         sig.emit("#end");
 
         Ok(())

forge_core/src/compiler/compiled_fn.rs

@@ -56,6 +56,7 @@ pub struct CompiledFn {
     pub max_frame_size: usize,
     pub local_scope: Scope,
     pub arity: usize,
+    pub continue_points: Vec<Option<Label>>,
 
     /// The preamble is the area of the function capturing the args, etc
     pub preamble: Text,
@@ -83,6 +84,25 @@ impl CompiledFn {
         }
     }
 
+    pub fn enter_loop(&mut self, continue_point: Option<Label>) {
+        self.continue_points.push(continue_point)
+    }
+    pub fn exit_loop(&mut self) {
+        if self.continue_points.len() > 0 {
+            self.continue_points.pop();
+        } else {
+            // I doubt it's possible for this to happen, since it would be
+            // caught at the parse stage
+            unreachable!()
+        }
+    }
+    pub fn in_loop(&self) -> bool {
+        self.continue_points.len() > 0
+    }
+    pub fn continue_point(&self) -> &Option<Label> {
+        self.continue_points.last().unwrap_or(&None)
+    }
+
     /// Return an iterator over all the
     pub fn text(&self) -> impl Iterator<Item = &str> {
         self.preamble.0.iter().chain(self.body.0.iter()).chain(self.outro.0.iter()).map(String::as_str)

forge_core/src/compiler/mod.rs

@@ -94,6 +94,11 @@ pub fn build_boot(src: &str, include_comments: bool) -> Result<Vec<String>, Comp
             asm.push(format!(".org {} + {}", label, size));
         }
 
+        // Once flags:
+        for label in state.flags {
+            asm.push(format!("{}: .db 1", label));
+        }
+
         // Final thing is to place a label for the stack:
         // (this is just a cell with the address of the following word)
         asm.push("stack: .db 0".into());

forge_core/src/compiler/state.rs

@@ -20,6 +20,8 @@ pub(crate) struct State {
     pub strings: Vec<(Label, String)>,
     /// The statically-allocated buffers (size in bytes)
     pub buffers: Vec<(Label, usize)>,
+    /// The flags for once blocks
+    pub flags: Vec<Label>,
     /// The functions that have been prototyped but not yet defined
     pub prototypes: Scope,
     /// The initialization code for globals
@@ -72,6 +74,12 @@ impl State {
         sym
     }
 
+    pub(crate) fn add_flag(&mut self) -> Label {
+        let sym = self.gensym();
+        self.flags.push(sym.clone());
+        sym
+    }
+
     pub(crate) fn declare_function(&mut self, name: &str, _args: Vec<String>) -> Result<(), CompileError> {
         // If it's not already prototyped, gensym a label and put it in the list. If it is, just
         // ignore this (we don't check arity so it's not like the arglist being different matters)

forge_core/src/compiler/test_utils.rs

@@ -1,4 +1,5 @@
 use crate::compiler::compilable::Compilable;
+use crate::compiler::CompileError;
 use crate::compiler::state::State;
 use crate::parser::parse;
 
@@ -15,6 +16,11 @@ pub(crate) fn test_body(state: State) -> String {
     state.functions.get("test").unwrap().body.0.join("\n")
 }
 
+pub(crate) fn test_err(src: &str) -> Option<CompileError> {
+    let mut state = State::default();
+    parse(src).unwrap().process(&mut state, None, (0, 0).into()).err()
+}
+
 pub(crate) fn test_preamble(state: State) -> String {
     state.functions.get("test").unwrap().preamble.0.join("\n")
 }

forge_core/src/parser/ast_nodes/expr.rs

@@ -20,6 +20,13 @@ impl AstNode for Expr {
                 PestRule::number => Expr::Number(term.into_number()),
                 PestRule::alloc => Expr::New(Expr::from_pair(term.first()).into()),
                 PestRule::static_alloc => Expr::Static(Expr::from_pair(term.first()).into()),
+                PestRule::peek_expr => Expr::Peek(Expr::from_pair(term.first()).into()),
+                PestRule::poke_expr => {
+                    let mut it = term.into_inner();
+                    let first = it.next().unwrap();
+                    let second = it.next().unwrap();
+                    Expr::Poke(Expr::from_pair(first).into(), Expr::from_pair(second).into())
+                },
                 PestRule::name => Expr::Name(String::from(term.as_str())),
                 PestRule::expr => Expr::from_pair(term),
                 PestRule::string => Self::String(term.into_quoted_string()),
@@ -281,4 +288,14 @@ mod test {
     fn static_alloc() {
         assert_eq!(Expr::from_str("static(8)"), Ok(Expr::Static(8.into())));
     }
+
+    #[test]
+    fn peek() {
+        assert_eq!(Expr::from_str("peek(8)"), Ok(Expr::Peek(8.into())));
+    }
+
+    #[test]
+    fn poke() {
+        assert_eq!(Expr::from_str("poke(10, 20)"), Ok(Expr::Poke(10.into(), 20.into())));
+    }
 }

forge_core/src/parser/ast_nodes/mod.rs

@@ -15,3 +15,4 @@ mod repeat_loop;
 mod program;
 mod operator;
 mod expr;
+mod once;

forge_core/src/parser/ast_nodes/once.rs

@@ -0,0 +1,30 @@
+use crate::ast::{Block, Once};
+use crate::parser::{AstNode, Pair, PestRule};
+
+impl AstNode for Once {
+    const RULE: PestRule = PestRule::once;
+    fn from_pair(pair: Pair) -> Self {
+        let mut inner = pair.into_inner().peekable();
+        let body = Block::from_pair(inner.next().unwrap());
+        Self { body }
+    }
+}
+
+#[cfg(test)]
+mod test {
+    use crate::ast::Statement;
+    use crate::parser::test_utils::{dislocate, dislocated_block};
+    use crate::parser::Parseable;
+    use super::*;
+
+    #[test]
+    fn parse_once_blocks() {
+        assert!(match Statement::from_str("once { foo(x); }") {
+            Ok(Statement::Once(Once { body })) => {
+                assert_eq!(dislocate(body.0), dislocated_block("{ foo(x); }"));
+                true
+            },
+            _ => false
+        });
+    }
+}

forge_core/src/parser/ast_nodes/program.rs

@@ -33,4 +33,18 @@ mod test {
             ]
         )
     }
+
+    #[test]
+    fn parse_comments() {
+        // No other good place to put this test...
+        let prog = Program::from_str("global /* I am a comment */ foo; const blah = 3; // also a comment").unwrap();
+        let decls: Vec<_> = dislocate(prog.0);
+        assert_eq!(
+            decls,
+            vec![
+                Declaration::from_str("global foo;").unwrap(),
+                Declaration::from_str("const blah = 3;").unwrap(),
+            ]
+        )
+    }
 }

forge_core/src/parser/ast_nodes/statement.rs

@@ -6,6 +6,8 @@ impl AstNode for Statement {
     fn from_pair(pair: Pair) -> Self {
         let pair = pair.first();
         match pair.as_rule() {
+            PestRule::break_stmt => Self::Break,
+            PestRule::continue_stmt => Self::Continue,
             PestRule::return_stmt => Self::Return(Return::from_pair(pair)),
             PestRule::assignment => Self::Assignment(Assignment::from_pair(pair)),
             PestRule::expr => Self::Expr(Expr::from_pair(pair)),
@@ -13,6 +15,7 @@ impl AstNode for Statement {
             PestRule::conditional => Self::Conditional(Conditional::from_pair(pair)),
             PestRule::while_loop => Self::WhileLoop(WhileLoop::from_pair(pair)),
             PestRule::repeat_loop => Self::RepeatLoop(RepeatLoop::from_pair(pair)),
+            PestRule::once => Self::Once(Once::from_pair(pair)),
             PestRule::asm => Self::Asm(Asm::from_pair(pair)),
             _ => unreachable!(),
         }

forge_core/src/parser/forge.pest

@@ -1,6 +1,6 @@
 // C++-style whitespace and comments
 WHITESPACE = _{ " " | "\t" | NEWLINE }
-COMMENT    = _{ "//" ~ (!"\n" ~ ANY)* }
+COMMENT    = _{ ("//" ~ (!"\n" ~ ANY)*) | ("/*" ~ (!"*/" ~ ANY)* ~ "*/") }
 
 // C-style names
 name_char =  { ASCII_ALPHA_LOWER | ASCII_ALPHA_UPPER | "_" | "$" }
@@ -63,15 +63,17 @@ operator = _{
 }
 
 expr = { prefix* ~ term ~ suffix* ~ (operator ~ prefix* ~ term ~ suffix*)* }
-term = _{ number | alloc | static_alloc | name | "(" ~ expr ~ ")" | string }
+term = _{ number | alloc | static_alloc | peek_expr | poke_expr | name | "(" ~ expr ~ ")" | string }
 alloc = { "new" ~ "(" ~ expr ~ ")" }
 static_alloc = { "static" ~ "(" ~ expr ~ ")" }
+peek_expr = { "peek" ~ "(" ~ expr ~ ")" }
+poke_expr = { "poke" ~ "(" ~ expr ~ "," ~ expr ~ ")" }
 
 suffix    = _{ subscript | arglist }
 subscript = { "[" ~ expr ~ "]" }
 arglist   = { "(" ~ (expr ~ ("," ~ expr)*)? ~ ")" }
 
-statement = { asm | ((return_stmt | var_decl | assignment | expr) ~ ";") | conditional | while_loop | repeat_loop }
+statement = { asm | ((break_stmt | continue_stmt | return_stmt | var_decl | assignment | expr) ~ ";") | conditional | while_loop | repeat_loop | once }
 
 asm      = { "asm" ~ asm_args? ~ "{" ~ asm_body ~ "}" }
 asm_args = _{ "(" ~ expr ~ ("," ~ expr)* ~ ")" }
@@ -87,10 +89,13 @@ function_prototype = { "fn" ~ name ~ argnames ~ ";" }
 declaration = { function | function_prototype | global | const_decl }
 program     = { (COMMENT | WHITESPACE)? ~ declaration* ~ EOI }
 
+break_stmt = { "break" }
+continue_stmt = { "continue" }
 return_stmt = { "return" ~ expr? }
 conditional = { "if" ~ "(" ~ expr ~ ")" ~ block ~ ("else" ~ block)? }
 while_loop  = { "while" ~ "(" ~ expr ~ ")" ~ block }
 repeat_loop = { "repeat" ~ "(" ~ expr ~ ")" ~ name? ~ block }
+once  = { "once" ~ block }
 var_decl    = { "var" ~ name ~ ("=" ~ expr)? }
 global      = { "global" ~ name ~ ("=" ~ expr)? ~ ";" }
 const_decl  = { "const" ~ name ~ "=" ~ (string | expr) ~ ";" }

forge_core/src/parser/pairs_ext.rs

@@ -7,12 +7,8 @@ pub trait PairExt {
     /// Go down one level in the AST, return the first node. Assumes the first node exists
     fn first(self) -> Self;
 
-    /// Returns the first child node as a String; useful for things like names and numbers
-    /// which are really just typed strings
-    fn first_as_string(self) -> String;
-
     /// Just like `first` but panics if there's more than one child node.
-    fn only(self) -> Self;
+    //fn only(self) -> Self;
 
     /// This should really be an AstNode or something, but it's used so often: turn a Pair into
     /// an i32 by parsing the Forge number format (0xwhatever, 0bwhatever, etc)
@@ -30,17 +26,6 @@ impl<'a> PairExt for Pair<'a> {
         self.into_inner().next().unwrap()
     }
 
-    fn first_as_string(self) -> String {
-        String::from(self.first().as_str())
-    }
-
-    fn only(self) -> Pair<'a> {
-        let mut iter = self.into_inner();
-        let child = iter.next().unwrap();
-        debug_assert_eq!(iter.next(), None);
-        child
-    }
-
     fn into_number(self) -> i32 {
         let first = self.into_inner().next().unwrap();
         match first.as_rule() {
@@ -74,18 +59,11 @@ impl<'a> PairExt for Pair<'a> {
 pub trait PairsExt {
     /// Peek the next sibling but only if it matches a given rule: used for things
     /// with optional modifiers following
-    fn next_if_rule(&mut self, rule: PestRule) -> Option<Pair>;
+    fn next_if_rule(&mut self, rule: PestRule) -> Option<Pair<'_>>;
-
-    /// Grab the first thing from the list if you're sure it exists
-    fn first(&mut self) -> Pair;
 }
 
 impl PairsExt for Peekable<Pairs<'_>> {
-    fn next_if_rule(&mut self, rule: PestRule) -> Option<Pair> {
+    fn next_if_rule(&mut self, rule: PestRule) -> Option<Pair<'_>> {
         self.next_if(|p| p.as_rule() == rule)
     }
-
-    fn first(&mut self) -> Pair {
-        self.next().unwrap().first()
-    }
 }

novaforth/Cargo.toml

@@ -0,0 +1,8 @@
+[package]
+name = "novaforth"
+version = "0.1.0"
+edition = "2021"
+
+[build-dependencies]
+vasm_core = { path = "../vasm_core" }
+serde_json = "1.0.91"

novaforth/build.rs

@@ -0,0 +1,38 @@
+use std::collections::BTreeMap;
+use std::env;
+use std::fs::File;
+use std::io::Write;
+use std::path::Path;
+use serde_json::json;
+use vasm_core::assemble_file;
+
+fn main() {
+    env::set_current_dir("src").expect("Can't chdir into src. Am I being run as a build script?");
+    // We're doing test_init because it compiles the Novaforth interpreter but not any code to actually run it,
+    // 0x400 is just "stop: hlt".
+    // TODO: we need a system for building ROMs and actually booting the machine.
+    // This is fine for now, for use by `vweb`.
+    match assemble_file("test_init.asm") {
+        Ok((bytes, scope)) => {
+            println!("Assembled {} bytes", bytes.len());
+            let dir = env::var("OUT_DIR").expect("OUT_DIR not specified. Am I being run as a build script?");
+            let filename = Path::new(dir.as_str()).join("4th.rom");
+            let mut f = File::create(filename).expect("Unable to open output file");
+            f.write(bytes.as_slice()).expect("Unable to write to output file");
+
+            let mut important_symbols : BTreeMap<String, i32> = BTreeMap::new();
+            for (sym, addr) in scope {
+                if !sym.starts_with("__gensym") {
+                    important_symbols.insert(sym, addr);
+                }
+            }
+
+            let mut symfile = File::create(Path::new(dir.as_str()).join("4th.rom.sym")).expect("Unable to open symbol file");
+            let json = json!(important_symbols).to_string();
+            symfile.write(json.as_bytes()).expect("Unable to write to symbol file");
+        }
+        Err(e) => {
+            eprintln!("{}", e)
+        }
+    }
+}

novaforth/src/4th.asm

@@ -0,0 +1,868 @@
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#include "utils.asm"
+#include "dict_utils.asm"
+#include "string.asm"
+#include "compiler_utils.asm"
+#include "numbers.asm"
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Interpret a line of input. The pointer to the (null-terminated) line is at the top of the stack.
+; This cannot be put in the dictionary, because if it calls itself recursively it'll clobber the
+; cursor, but it can be called from outside. It's the primary entry point to Forth.
+eval: ; ( ptr -- ??? )
+    ; First, if the last line left us in linecomment, get out of it:
+    loadw handleword_hook
+    xor linecomment
+    #unless
+        call nova_popr
+        storew handleword_hook
+    #end
+    call skip_nonword ; Skip any leading whitespace
+    storew cursor ; Store the pointer in the cursor, so it's not polluting the stack during handleword calls
+    #while ; While we're not at the end of the string
+        loadw cursor
+        load
+    #do
+        loadw cursor ; Copy the word we care about to the heap
+        push eval_word_buffer
+        call nova_word_to
+        loadw cursor ; Advance cursor by the word we just copied and the following crap
+        call skip_word
+        call skip_nonword
+        storew cursor
+        push eval_word_buffer ; Load the address we just put the word at and execute it
+        loadw handleword_hook
+        call
+    #end
+    ret
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Copy the word at cursor to the heap, null-terminate it, advance cursor to the start
+; of the next word (or the null terminator if this is the last word); do not advance heap.
+nova_word: ; ( -- )
+    loadw cursor
+    loadw heap
+    call nova_word_to
+    loadw cursor
+    call skip_word
+    call skip_nonword
+    storew cursor
+    loadw heap ; But what if the word is empty string?
+    load
+    #unless
+        push expected_word_err
+        call print
+        call cr
+    #end
+    ret
+
+nova_word_to: ; ( src dest -- )
+    pushr ; ( src ) [ dest ]
+    #while
+        dup
+        load
+        dup
+        call word_char
+    #do
+        peekr
+        store
+        popr
+        add 1
+        pushr
+        add 1
+    #end
+    pop ; drop the nonword-char ( src ) [ dest ]
+    pop ; drop the now-useless src
+    popr 0 ; ( 0 dest )
+    store
+    ret
+
+nova_number:
+    call nova_word
+    loadw heap
+    loadw is_number_hook
+    call
+    ret
+
+; Creates a new dictionary entry, pointing at the (new) heap, for the following word
+nova_create: ; ( -- )
+    call nova_word ; consume a word and stick it on the heap
+    loadw heap ; Load the heap ptr and advance it to the place right after the word's null-terminator
+    call skip_word
+    add 1
+    dup ; ( def_ptr def_ptr )
+    add 6 ; ( def_ptr new_heap )
+    pick 1
+    storew ; write the def address, ( def_ptr )
+    loadw dictionary
+    pick 1
+    add 3
+    storew ; point it at the dictionary
+    loadw heap
+    storew dictionary ; point the dictionary at it
+    add 6
+    storew heap ; advance the heap ptr
+    ret
+
+; Enter immediate mode or compile mode
+nova_open_bracket: push immediate_handleword
+    jmpr @+2
+nova_close_bracket: push compile_handleword
+    storew handleword_hook
+    ret
+
+;;; ; Compile a jmp to a word
+
+nova_continue:
+    call nova_tick
+    push $JMP
+    jmpr @compile_instruction_arg
+
+; compile-time word, causes the next word to be compiled instead of it
+; being run. The corollary of that is that an immediate word, where we
+; would normally run it (because we're in compile mode) we compile a call
+; to it; a non-immediate word, we compile some code that will compile a
+; call to it. For example: compiling "postpone emit" should result in
+; push <emit>
+; push $CALL
+; call compile_instruction_arg
+; ...being compiled into the current defn because when run that will
+; compile a call to emit. But "postpone do" causes a call to "do" to be
+; compiled, because when run that will call "do" (whereas normally we'd
+; just call "do" right now because it's immediate).
+nova_postpone:
+    call nova_word
+    loadw heap
+    call tick ; ( ptr-to-word )
+    call dupnz
+    #if ; It's a normal word
+        push $PUSH
+        call compile_instruction_arg ; compile a push of that address
+        push $CALL
+        push $PUSH
+        call compile_instruction_arg ; compile a push of $CALL
+        push compile_instruction_arg
+        push $CALL
+        jmpr @compile_instruction_arg ; compile a call of compile_instruction_arg
+    #else ; It's not a normal word, maybe a compile word?
+        loadw heap
+        call compile_tick
+        call dupnz
+        #if ; It's a compile word
+            push $CALL
+            jmpr @compile_instruction_arg ; Compile a call to it.
+        #else ; It's not a compile word either, error out
+            loadw heap
+            jmpr @missing_word
+        #end
+    #end
+
+; Compile a ret. Needed in order to define semicolon, because you need semicolon to define any
+; other way of defining exit
+nova_exit:
+    push $RET
+    jmpr @compile_instruction
+
+; Immediate is a runtime word that moves the most recently defined word from the
+; runtime dictionary to the compile-time one.
+nova_immediate:
+    loadw dictionary
+    dup ; save a copy, we'll need to set compile_dictionary to this later
+    call skip_word
+    add 4 ; now we're pointing at the next word, meaning, the new dictionary ptr:
+    dup
+    loadw
+    storew dictionary ; dictionary is now pointing at the right place
+    loadw compile_dictionary
+    swap
+    storew ; This definition is now pointing at the old compile_dictionary
+    storew compile_dictionary ; and compile_dictionary is pointing at it!
+    ret
+
+; Compiles the top of stack to the heap
+nova_comma:
+    loadw heap
+    dup
+    add 3
+    storew heap
+    storew
+    ret
+
+; Normal interface for defining words
+nova_colon:
+    call nova_create
+    jmp nova_close_bracket
+
+; Normal interface for ending word definitions
+nova_semicolon:
+    push $RET
+    call compile_instruction
+    jmp nova_open_bracket
+
+; Copy a word of input to the pad and return the pad address
+nova_word_to_pad:
+    loadw cursor
+    push pad
+    call nova_word_to
+    loadw cursor
+    call skip_word
+    call skip_nonword
+    storew cursor
+    ret pad
+
+; This is a runtime word used for defining the behavior of created
+; words. For example: ": foo create does> drop 12 ;" makes a word foo, used as:
+; "foo blah". That call creates another word, blah, which when it's
+; run pushes 12. So then, does> alters the head of the dictionary (because
+; that was just create'd), to set its definition pointer to right after
+; the does>, then compiles a push of the old value of the definition pointer.
+; The expected result of this: ": foo create 15 , does> drop 12 ;" is this:
+; > create a dictionary entry from the next word in input
+; > push a 15 and compile it (the compile-time behavior of the new word)
+; > push the address of label A
+; > jmp to does_at_runtime (which reassigns the def ptr to lbl A)
+; > return
+; > label A:
+; > popr the address of the 15 (where the heap originally was)
+; > drop the address of the 15
+; > push a 12 (runtime behavior of the new word)
+; > return
+does_word:
+    loadw heap
+    add 9 ; to account for the push itself, the call and the ret
+    push $PUSH
+    call compile_instruction_arg ; push the addr right after the does>
+    push does_at_runtime
+    push $JMP
+    call compile_instruction_arg ; jmp does_at_runtime
+    push $RET
+    call compile_instruction ; return
+    ret
+
+; Runtime behavior of does>
+; When we jmp here, the compile-time behavior has left the address
+; we want for the runtime behavior of the new word at the top of stack.
+; So, we need to reassign the def ptr of the new word to (eventually)
+; lead there. But we need to save what it originally was, first! So we
+; grab it and stick it in the R stack, then compile a whole new area
+; which pushes the old ptr and then jmps after the does> addr.
+does_at_runtime: ; ( does-addr -- )
+    loadw dictionary
+    call skip_word
+    add 1 ; find the definition address
+    dup
+    loadw
+    pushr ; stash old in the r stack
+    loadw heap
+    swap
+    storew ; point it at the new definition
+    popr
+    push $PUSH
+    call compile_instruction_arg ; compile pushing the old def ptr value
+    push $JMP
+    call compile_instruction_arg ; compile a jmp to after does>
+    ret
+
+mnemonics:
+.db "push\0"
+.db "add\0"
+.db "sub\0"
+.db "mul\0"
+.db "div\0"
+.db "mod\0"
+.db "copy\0"
+.db "and\0"
+.db "or\0"
+.db "xor\0"
+.db "not\0"
+.db "gt\0"
+.db "lt\0"
+.db "agt\0"
+.db "alt\0"
+.db "lshift\0"
+.db "rshift\0"
+.db "arshift\0"
+.db "pop\0"
+.db "dup\0"
+.db "swap\0"
+.db "pick\0"
+.db "rot\0"
+.db "jmp\0"
+.db "jmpr\0"
+.db "call\0"
+.db "ret\0"
+.db "brz\0"
+.db "brnz\0"
+.db "hlt\0"
+.db "load\0"
+.db "loadw\0"
+.db "store\0"
+.db "storew\0"
+.db "inton\0"
+.db "intoff\0"
+.db "setiv\0"
+.db "sdp\0"
+.db "setsdp\0"
+.db "pushr\0"
+.db "popr\0"
+.db "peekr\0"
+.db "debug\0"
+mnemonics_end:
+
+nova_opcode_for_word: ; ( -- opcode ) -or- ( -- word-ptr -1 ) if it isn't a mnemonic
+    call nova_word
+    pushr 0
+    loadw heap
+    push mnemonics
+    #until ; While our ptr into mnemonics is the different from the heap str
+        pick 1
+        pick 1
+        call compare
+    #do
+        call skip_word
+        add 1
+        dup
+        sub mnemonics_end
+        #unless ; We're at the end and this isn't a mnemonic
+            popr
+            pop
+            pop
+            ret 0xffffff
+        #end
+        popr
+        add 1
+        pushr
+    #end
+    pop
+    pop
+    popr
+    ret
+
+; This is a hideous optimization thing. You have been warned:
+; We need to call opcode for word and check the return value: if
+; it's -1, that's an error, so we need to call invalid_mnemonic and
+; then return. This pattern was all over the asm* words. But, the
+; caller itself needs to do that return, so that if there's an error
+; the rest of our caller doesn't happen. So, we'll try to fetch an
+; opcode and check for a -1, and if we get one, we'll popr/pop and
+; then return.
+nova_safe_opcode:
+    call nova_opcode_for_word
+    dup
+    xor -1
+    #unless ; Thaaaat's not an opcode...
+        pop ; toss the worthless error code
+        popr ; get rid of our return address with a popr / pop, so we're
+        pop  ; now actually returning from the caller's frame...
+        jmp invalid_mnemonic ; and tail-call to invalid_mnemonic
+    #end
+    ret ; We actually got an opcode, just return it
+
+; Don't try to optimize this away; see nova_safe_opcode. We need the
+; extra frame, or a line like `$ blah 3` won't run the rest of the line
+; after the error.
+nova_opcode:
+    call nova_safe_opcode
+    ret
+
+nova_compile_opcode:
+    call nova_safe_opcode
+    jmp nova_literal
+
+; Read a mnemonic and compile that instruction with a 0 arg. The address of the arg
+; gets >r'd, for later resolve-calling
+nova_asm_to: ; ( opcode -- )
+    loadw heap
+    add 1
+    call nova_pushr ; heap + 1 is our arg address, >r it
+    swap 0
+    jmp compile_instruction_arg ; Go ahead and compile the jmp-or-whatever
+
+nova_here:
+    loadw heap
+    ret
+
+find_word:
+    call nova_word
+    loadw heap
+    call tick
+    call dupnz
+    #unless
+        loadw heap
+        call compile_tick
+    #end
+    ret
+
+nova_tick:
+    call find_word
+    call dupnz
+    #unless
+        loadw heap
+        jmp missing_word
+    #end
+    ret
+
+nova_bracket_tick:
+    call find_word
+    call dupnz
+    #unless
+        loadw heap
+        jmp missing_word
+    #end
+    ; Intentionally falls through to nova_literal!
+
+; Compile-time word that reads a word from the stack at compile time and pushes it
+; to the stack at runtime (which is to say, read a word at compile and compile a
+; $PUSH of that word
+nova_literal:
+    push $PUSH
+    jmp compile_instruction_arg
+
+; Switch is_number_hook and itoa_hook between hex and dec mode
+nova_dec:
+    push is_number
+    push itoa
+    jmpr @+4
+nova_hex:
+    push hex_is_number
+    push hex_itoa
+    storew itoa_hook
+    storew is_number_hook
+    ret
+
+; Fetch a single char from the input buffer, advancing the cursor
+; If the cursor is already at the end (null term) don't advance it
+nova_char: ; ( -- ch )
+    loadw cursor
+    load
+    call dupnz
+    #if
+        loadw cursor
+        add 1
+        storew cursor
+        ret
+    #end
+    ret 0
+
+; Copies a string (until the first double quote) to the destination
+; and null-terminates it. Increments cursor accordingly. Returns
+; either the address after the string for success or 0 if it was unterminated.
+nova_quote_string_to: ; ( dest -- flag )
+    pushr
+    #while
+        call nova_char
+        dup
+        dup
+        gt 0
+        swap
+        xor 34 ; ascii double quote
+        gt 0
+        and ; It's not a null-term and it's not a double quote
+    #do
+        peekr
+        store
+        popr
+        add 1
+        pushr
+    #end
+    #unless ; Unterminated string!
+        popr
+        pop
+        push unclosed_error
+        call print
+        ret 0
+    #end
+    loadw cursor ; Skip any junk after the close quote; cursor always points at a valid word
+    call skip_nonword
+    storew cursor
+    popr ; Yoink out our running pointer to the dest so we can null-term it
+    dup ; ( here here )
+    swap 0
+    store ; null-term the string
+    add 1 ; Increment it so we return the point after the string (counting its null-term)
+    ret
+
+; Compiles a string to the heap and pushes a pointer to it
+nova_squote: ; ( -- addr )
+    loadw heap
+    dup
+    pushr
+    call nova_quote_string_to
+    call dupnz
+    #if
+        storew heap
+        popr
+    #else
+        popr
+        pop
+    #end
+    ret
+
+; The s-quote equivalent in compile mode:
+nova_compile_squote:
+    loadw heap
+    pushr
+    push $JMPR
+    call push_jump ; compile a jmpr to get us past the string
+    call nova_squote ; ( addr )
+    ;;;
+    loadw heap ; squote might have failed and not actually compiled anything
+    sub 4          ; (because of an unterminated string) We'll handle that:
+    peekr          ; Detect if our saved heap is the current heap - 4, meaning
+    xor            ; that all we've compiled is that jmp...
+    #unless
+        popr ; So just restore that saved heap
+        storew heap
+        ret
+    #end
+    ;;;
+    call nova_resolve ; Jump to right after the null-terminator
+    ; compile a push with the string start
+    push $PUSH ; ( addr $push )
+    call compile_instruction_arg
+    popr
+    pop
+    ret
+
+; Read a quote string to the pad and then print it
+nova_dotquote:
+    push pad
+    call nova_quote_string_to
+    #if
+        push pad
+        jmp print
+    #end
+    ret
+
+; The dot-quote equivalent in compile mode:
+nova_compile_dotquote:
+    loadw heap ; store the heap at start
+    pushr
+    call nova_compile_squote
+    loadw heap ; see if nova_compile_squote actually changed it
+    popr
+    xor
+    #if ; we actually compiled something, compile a call to print
+        push print
+        push $CALL
+        jmp compile_instruction_arg
+    #end
+    ret
+
+; Print the current stack contents, in order from 256 up, separated by spaces
+; TODO this depends on a 256-based stack and will need to be changed if you call setsdp
+nova_print_stack: ; ( -- )
+    push print_stack_start
+    call print
+    sdp
+    sub 6
+    pushr
+    pop
+    push 256
+    #while
+        dup
+        peekr
+        lt
+    #do
+        dup
+        loadw
+        loadw itoa_hook
+        call
+        push 32
+        call nova_emit
+        add 3
+    #end
+    popr
+    pop
+    pop
+    push print_stack_end
+    call print
+    ret
+
+; The R stack is built manually with these fns, because it can't be the actual
+; CPU return stack for reasons.
+
+; The equivalent of peekr
+nova_peekr:
+    loadw r_stack_ptr
+    sub 3
+    loadw
+    ret
+
+; Pick from the R stack
+nova_rpick: ; ( i -- c_stack[i] ) where the top of the R stack is '0 rpick'
+    loadw r_stack_ptr
+    swap
+    add 1
+    mul 3
+    sub
+    loadw
+    ret
+
+; Equivalent of pushr
+nova_pushr: ; ( val -- )
+    loadw r_stack_ptr
+    dup
+    add 3
+    storew r_stack_ptr
+    storew
+    ret
+
+; Equivalent of popr
+nova_popr: ; ( -- val )
+    loadw r_stack_ptr
+    sub 3
+    dup
+    storew r_stack_ptr
+    loadw
+    ret
+
+nova_emit:
+    loadw emit_hook
+    jmp
+
+; For a temporary function, we compile it to the heap
+; and then move the heap back to the start (so it gets
+; overwritten if we need the memory)
+nova_immediate_open_brace:
+    ; store heap addr
+    loadw heap
+    storew lambda_start_ptr
+    ; enter compile mode
+    jmp nova_close_bracket
+
+; But, if we do this in compile mode, then we want to
+; make a local function: something compiled that can be
+; called, whose address is left on the stack
+nova_compile_open_brace:
+    push $JMPR ; Jmp over the lambda
+    call push_jump
+    loadw heap
+    call nova_pushr ; Store start address of lambda
+    ; increment nesting count
+    loadw lambda_nesting_level
+    add 1
+    storew lambda_nesting_level
+    ret
+
+nova_close_brace:
+    loadw lambda_nesting_level
+    call dupnz
+    #if ; we entered this from compile mode
+        ; decrement nesting level
+        sub 1
+        storew lambda_nesting_level
+        ; compile a ret
+        push $RET
+        call compile_instruction
+        ; Get the lambda addr and temp store it
+        call nova_popr
+        pushr
+        call nova_resolve ; Resolve the earlier jmp so we jmp over the lambda
+        ; Compile a push of the lambda address
+        popr
+        push $PUSH
+        call compile_instruction_arg
+        ret
+    #else
+        push $RET
+        call compile_instruction
+        loadw lambda_start_ptr
+        dup
+        storew heap
+        jmp nova_open_bracket
+    #end
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Handle a word, in immediate mode. The word must be at ptr, and null-terminated
+immediate_handleword: ; ( word-ptr -- ? )
+    dup
+    call tick
+    call dupnz
+    #if ; We found a dict entry for it! ( word-ptr fn-ptr )
+        swap ; clear the now-unneeded word ptr off the stack
+        pop
+        jmp ; actually call the word
+    #else ; No dict entry but it may still be a number ( word-ptr )
+        dup
+        loadw is_number_hook
+        call
+        #if ; It's a number
+            swap
+            pop
+            ret
+        #end ; This isn't a valid word OR a number, so, bail
+    #end
+    jmpr @missing_word
+
+; The word handler for compile mode. This is called for each word in the input if we're in compile
+; mode. We should take the word (which is at heap), look it up in the compile dictionary, and if
+; it's there, call it. If it isn't, look it up in the runtime dictionary and compile a call to it.
+; If it's not there either, try to see if it's a number and compile a push of it. If it's not a
+; number then there's nothing we can do, so error with missing_word
+compile_handleword: ; ( word-ptr -- ? )
+    dup
+    call compile_tick
+    call dupnz
+    #if ; We found it in the compile-mode dictionary! ( word-ptr fn-ptr )
+        swap ; clear the now-unneeded word ptr off the stack
+        pop
+        jmp ; call the word
+    #end
+    dup ; No compile dict entry but it could be a normal word ( word-ptr )
+    call tick
+    call dupnz
+    #if ; It's a normal word, we'll compile a call to it instead
+        swap
+        pop
+        push $CALL
+        jmpr @compile_instruction_arg
+    #end
+    dup ; It's not a normal word either, maybe it's a number
+    loadw is_number_hook
+    call
+    #if ; It's a number
+        swap ; Blow away the now-useless word ptr
+        pop
+        push $PUSH ; Compile a push of the number
+        jmpr @compile_instruction_arg
+    #end
+    jmpr @missing_word ; This isn't a valid word OR a number, so, bail
+
+; Word handler for line-comment mode (backslash to end of line). It doesn't do a whole lot...
+linecomment: ; ( word-start-addr -- )
+    pop
+    ret
+
+; Word handler for paren-comment mode (anything in parens).
+parencomment: ; ( word-start-addr -- )
+    dup
+    load
+    #unless ; Is the word just blank?
+        pop
+        ret
+    #end
+    call tick ; ( entry-addr-or-0 )
+    dup
+    xor open_paren
+    #unless ; Is the new word "("?
+        pop
+        jmp open_paren
+    #end
+    xor close_paren_stub
+    #unless ; Is it the ")" stub?
+        jmp close_paren ; Call close_paren
+    #end
+    ret ; It was something else (or zero) so just ignore it, it's a comment
+
+; Store the current handleword_hook in the R stack, put parencomment in its place.
+; It won't matter because it's not like anything's gonna be looking in the rstack
+; while we eval a comment.
+open_paren:
+    loadw handleword_hook
+    call nova_pushr
+    push parencomment
+    storew handleword_hook
+    ret
+
+; Store the current handleword_hook in the C stack,
+; put parencomment in its place.
+; We also have a "stub" word which is what the dict actually
+; points to, so that a mismatched close paren doesn't end
+; up actually doing anything (it's only callable from / by
+; parencomment)
+close_paren:
+    call nova_popr
+    storew handleword_hook
+close_paren_stub:
+    ret
+
+; Store the current handleword_hook in the C stack,
+; put linecomment in its place. When handleline starts,
+; if it sees that handleword_hook is linecomment, it'll
+; pop the old one back out.
+backslash:
+    loadw handleword_hook
+    call nova_pushr
+    push linecomment
+    storew handleword_hook
+    ret
+
+; Called when we expected to find something in the dictionary and didn't
+invalid_mnemonic:
+    push invalid_mnemonic_str
+    jmpr @+3
+missing_word:
+    push missing_word_str
+    call print
+    call print
+    call cr ; Runs through to quit!
+quit: ; Break out of whatever we were doing and return to the main loop:
+    push 0x400
+    setsdp 0x100 ; Reset the dp / sp to default values
+    push r_stack
+    storew r_stack_ptr ; Clear the Nova rstack
+    call nova_open_bracket ; Get us out of compile mode if we're in it
+    loadw quit_vector
+    jmp ; Go back to the prompt. This will eventually be a prompt.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+data_start: ; Just a marker for the stats to measure how long the text section is
+
+; Some strings for error messages and whatnot
+missing_word_str: .db "Not a word: \0"
+invalid_mnemonic_str: .db "Invalid mnemonic: \0"
+unclosed_error: .db "Unclosed string\0"
+expected_word_err: .db "Expected name, found end of input\0"
+print_stack_start: .db "<< \0"
+print_stack_end: .db ">>\0"
+
+#include "dictionary.asm"
+
+; Assorted support variables
+heap: .db heap_start ; holds the address in which to start the next heap entry
+handleword_hook: .db immediate_handleword ; The current function used to handle / compile words, switches based on mode
+is_number_hook: .db is_number ; The current function used to parse numbers, switches with hex / dec
+itoa_hook: .db itoa ; The current function used to print numbers, switches with hex / dec
+line_len: .db 0
+cursor: .db 0 ; During calls to handleword, this global points to the beginning of the word
+lambda_start_ptr: .db 0 ; After definition of a lambda, reset heap ptr to here
+lambda_nesting_level: .db 0 ; Nesting level of lambdas; 0 means not in a compile-mode lambda
+
+; pointer to head of runtime dictionary
+dictionary: .db dict_start
+
+; pointer to head of compile-time dictionary
+compile_dictionary: .db compile_dict_start
+
+; where to jump when they call `quit`
+quit_vector: .db 0x400
+
+; the place to call to emit a character
+emit_hook: .db emit
+
+; Scratch pad buffer
+pad: .db 0
+.org pad + 0x100
+
+; A buffer to hold the single word currently being evaluated:
+; We need a separate buffer for this because of anonymous fns;
+; we no longer want to carelessly overwrite the bottom of the heap when it might contain
+; a temporary brace-function. One semi-bad side effect of this is that we can no longer
+; handle a word longer than 32 chars, but what can you do?
+eval_word_buffer: .db 0
+.org eval_word_buffer + 32
+
+; A stack for compiling control structures
+r_stack_ptr: .db r_stack
+r_stack: .db 0
+.org r_stack + 96
+
+; Things we define start here:
+heap_start:

novaforth/src/compiler_utils.asm

@@ -0,0 +1,85 @@
+; Assumes there's currently a word on the heap, writes two pointers after it: one to the (new) heap,
+; and one to the current dictionary head. Then makes the dictionary point at the start of that word.
+; This is usually used as: call word_to_heap, call new_dict, and you have added that word to the
+; dictionary pointing at the new heap start.
+new_dict:
+    loadw heap
+    dup
+    load
+    brz @new_dict_error
+    call skip_word
+    add 1
+    dup ; ( def_ptr def_ptr )
+    add 6
+    pick 1
+    storew ; write the def address, ( def_ptr )
+    loadw dictionary
+    pick 1
+    add 3
+    storew ; point it at the dictionary
+    loadw heap
+    storew dictionary ; point the dictionary at it
+    add 6
+    storew heap ; advance the heap ptr
+    ret
+new_dict_error:
+    pop
+    push expected_word_err
+    call print
+    call cr
+    ret
+
+; Compiles a full 4-byte instruction to the heap given an arg and an opcode
+compile_instruction_arg: ; ( arg opcode -- )
+    lshift 2
+    or 3 ; tell it we have a three byte arg
+    loadw heap ; ( arg instr-byte heap )
+    dup
+    add 4
+    storew heap ; Increment the ptr ( arg instr-byte heap )
+    pick 1
+    pick 1
+    store
+    add 1
+    swap
+    pop ; ( arg heap+1 )
+    storew
+    ret
+
+; Compiles an argument-less 1-byte instruction to the heap
+compile_instruction: ; ( opcode -- )
+    lshift 2
+    loadw heap ; ( instr-byte heap )
+    dup
+    add 1
+    storew heap ; Increment the ptr ( instr-byte heap )
+    store
+    ret
+
+; Compiles an instruction with an unresolved argument to the heap. Usually used
+; for compiling jumps / branches
+push_jump: ; ( opcode -- )
+    swap 0
+    call compile_instruction_arg
+    loadw heap
+    sub 3
+    jmp nova_pushr
+
+; Resolve the top arg-address on the control stack to the current heap addr. Meaning,
+; write the relative value of the current heap to that address
+nova_resolve: ; ( -- )
+    loadw heap
+    loadw r_stack_ptr
+    sub 3
+    dup ; ( heap cstack-3 cstack-3 )
+    storew r_stack_ptr
+    loadw ; ( heap arg-addr )
+    dup
+    sub 1 ; ( heap arg-addr instr-addr )
+    pick 2
+    swap
+    sub ; ( heap arg-addr offset )
+    swap
+    storew
+    pop
+    ret

novaforth/src/dict_utils.asm

@@ -0,0 +1,70 @@
+; We often need to pop 1-2 times and then ret a flag, in a brnz / brz.
+; Rather than repeat that everywhere, we'll abstract it and branch
+; to one of these three:
+end0_pop2: pop
+end0_pop1: pop
+ret 0
+end1_pop2: pop
+pop
+ret 1
+
+; Check whether two words (terminated by any non-word-character) are equal
+wordeq: ; ( str1 str2 -- bool )
+    ; check if both chars are nonword
+    pick 1
+    pick 1
+    load
+    call word_char
+    swap
+    load
+    call word_char
+    or
+    brz @end1_pop2 ; both are nonword so we're done
+    ; check if both chars are equal
+    pick 1
+    pick 1
+    load
+    swap
+    load
+    sub
+    brnz @end0_pop2
+    ; they're both equal, inc both pointers
+    add 1
+    swap
+    add 1
+    jmpr @wordeq
+
+; advance a pointer to the next dictionary entry
+advance_entry: ; ( ptr -- next_ptr )
+    call skip_word
+    add 4
+    loadw
+    ret
+
+; Find dictionary entry for word
+find_in_dict: ; ( ptr dict -- addr )
+    call dupnz
+    brz @end0_pop1 ; not found
+    pick 1
+    pick 1
+    call wordeq ; ( ptr dict eq? )
+    brz @find_in_dict_next
+    swap
+    pop
+    call skip_word
+    add 1
+    loadw
+    ret
+find_in_dict_next: ; ( ptr dict )
+    call advance_entry
+    jmpr @find_in_dict
+
+tick:
+    loadw dictionary
+    call find_in_dict
+    ret
+
+compile_tick:
+    loadw compile_dictionary
+    call find_in_dict
+    ret

novaforth/src/dictionary.asm

@@ -0,0 +1,351 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; The initial compile word dictionary:
+
+compile_dict_start:
+
+.db "exit\0"
+.db nova_exit
+.db $+1
+
+.db "[\0"
+.db nova_open_bracket
+.db $+1
+
+.db "continue\0"
+.db nova_continue
+.db $+1
+
+.db "does>\0"
+.db does_word
+.db $+1
+
+.db "postpone\0"
+.db nova_postpone
+.db $+1
+
+.db "[']\0"
+.db nova_bracket_tick
+.db $+1
+
+.db "literal\0"
+.db nova_literal
+.db $+1
+
+.db ";\0"
+.db nova_semicolon
+.db $+1
+
+.db "s\"\0"
+.db nova_compile_squote
+.db $+1
+
+.db ".\"\0"
+.db nova_compile_dotquote
+.db $+1
+
+.db "$\0"
+.db nova_compile_opcode
+.db $+1
+
+.db "{\0"
+.db nova_compile_open_brace
+.db $+1
+
+.db "}\0"
+.db nova_close_brace
+.db $+1
+
+.db "\\\0"
+.db backslash
+.db $+1
+
+.db "(\0"
+.db open_paren
+.db $+1
+
+.db ")\0"
+.db close_paren_stub
+.db 0 ; Sentinel for end of dictionary
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; The initial runtime word dictionary:
+
+dict_start:
+
+; First, a bunch of single-opcode words. These are here
+; even though they could be created in a prelude, simply
+; because it's shorter to define them here:
+.db "+\0"
+.db $+2
+.db $+3
+add
+ret
+
+.db "-\0"
+.db $+2
+.db $+3
+sub
+ret
+
+.db "*\0"
+.db $+2
+.db $+3
+mul
+ret
+
+.db "/\0"
+.db $+2
+.db $+3
+div
+ret
+
+.db "%\0"
+.db $+2
+.db $+3
+mod
+ret
+
+.db "pop\0"
+.db $+2
+.db $+3
+pop
+ret
+
+.db "dup\0"
+.db $+2
+.db $+3
+dup
+ret
+
+.db "swap\0"
+.db $+2
+.db $+3
+swap
+ret
+
+.db "pick\0"
+.db $+2
+.db $+3
+pick
+ret
+
+.db "rot\0"
+.db $+2
+.db $+3
+rot
+ret
+
+.db "@\0"
+.db $+2
+.db $+3
+loadw
+ret
+
+.db "!\0"
+.db $+2
+.db $+3
+storew
+ret
+
+.db "c@\0"
+.db $+2
+.db $+3
+load
+ret
+
+.db "c!\0"
+.db $+2
+.db $+3
+store
+ret
+
+.db ">\0"
+.db $+2
+.db $+3
+agt
+ret
+
+.db "<\0"
+.db $+2
+.db $+3
+alt
+ret
+
+.db "=\0"
+.db $+2
+.db $+4
+xor
+not
+ret
+
+.db "&\0"
+.db $+2
+.db $+3
+and
+ret
+
+.db "|\0"
+.db $+2
+.db $+3
+or
+ret
+
+.db "^\0"
+.db $+2
+.db $+3
+xor
+ret
+
+.db "not\0"
+.db $+2
+.db $+3
+not
+ret
+
+.db "execute\0"
+.db $+2
+.db $+2
+jmp
+
+; Now the normal builtin, atomic words:
+.db "]\0"
+.db nova_close_bracket
+.db $+1
+
+.db "create\0"
+.db nova_create
+.db $+1
+
+.db ",\0"
+.db nova_comma
+.db $+1
+
+.db "'\0"
+.db nova_tick
+.db $+1
+
+.db ":\0"
+.db nova_colon
+.db $+1
+
+.db "immediate\0"
+.db nova_immediate
+.db $+1
+
+.db "$\0"
+.db nova_opcode
+.db $+1
+
+.db "asm\0"
+.db compile_instruction
+.db $+1
+
+.db "#asm\0"
+.db compile_instruction_arg
+.db $+1
+
+.db ">asm\0"
+.db nova_asm_to
+.db $+1
+
+.db "word\0"
+.db nova_word_to_pad
+.db $+1
+
+.db "pad\0"
+.db $+2
+.db $+2
+ret pad
+
+.db "number\0"
+.db nova_number
+.db $+1
+
+.db "hex\0"
+.db nova_hex
+.db $+1
+
+.db "dec\0"
+.db nova_dec
+.db $+1
+
+.db "?dup\0"
+.db dupnz
+.db $+1
+
+.db ".\0"
+.db print_number
+.db $+1
+
+.db "s\"\0"
+.db nova_squote
+.db $+1
+
+.db ".\"\0"
+.db nova_dotquote
+.db $+1
+
+.db "emit\0"
+.db nova_emit
+.db $+1
+
+.db "print\0"
+.db print
+.db $+1
+
+.db "compare\0"
+.db compare
+.db $+1
+
+.db ".s\0"
+.db nova_print_stack
+.db $+1
+
+.db ">r\0"
+.db nova_pushr
+.db $+1
+
+.db "r>\0"
+.db nova_popr
+.db $+1
+
+.db "r@\0"
+.db nova_peekr
+.db $+1
+
+.db "rpick\0"
+.db nova_rpick
+.db $+1
+
+.db "&heap\0"
+.db $+2
+.db $+2
+ret heap
+
+.db "here\0"
+.db nova_here
+.db $+1
+
+.db "resolve\0"
+.db nova_resolve
+.db $+1
+
+.db "{\0"
+.db nova_immediate_open_brace
+.db $+1
+
+.db "quit\0"
+.db quit
+.db $+1
+
+.db "\\\0"
+.db backslash
+.db $+1
+
+.db "(\0"
+.db open_paren
+.db $+1
+
+.db ")\0"
+.db close_paren_stub
+.db 0

novaforth/src/in_forth.f

@@ -0,0 +1,115 @@
+\ Needed words:
+\ DONE: [ ] asm #asm >asm , postpone exit literal (foundational compiler interface)
+\ DONE: create does> immediate ' ['] (foundational dictionary interface)
+\ DONE: word number (foundational parser interface)
+\ DONE: >r r> r@ rpick (because they aren't using the normal stack)
+\ DONE: dec hex pad (because they modify global vars)
+\ DONE: .s (because it uses sdp)
+\ DONE: \ ) ( s" ." (because they deal with parser state)
+\ DONE: . print compare ?dup (because we need asm ones anyway and it's free)
+
+\ New words:
+\ DONE: quit clears the return stack (setsdp), resets hooks, and jmps to the main loop.
+\ DONE: &heap pushes the address of the heap pointer, so `here` is ``&heap @`
+\ DONE: $ turns a mnemonic into an opcode. In normal mode it returns an opcode; in immediate in compiles a push of the opcode
+\ DONE: asm is a word which compiles an opcode without an arg
+\ DONE: #asm compiles an opcode with an arg, ( arg op -- )
+\ DONE: >asm is a word taking an opcode which compiles that instruction, but with a 0 argument. The address of the argument is >r'd
+\ DONE: continue compiles a jmp to a given word (a tail call)
+\ DONE: resolve is an immediate word which pops the top address from the ctrl stack and writes `here` to it as a relative address
+
+\ asm words:
+\   asm compiles an opcode with no arg
+\   #asm compiles an opcode with an arg
+\   >asm compiles an opcode and >r's the address of its arg
+
+\ note 1: why do you need exit?
+\ Because the defn for semicolon needs to postpone something to compile a ret, and you can't use ,asm
+\ because you'd have to pass it a word argument ("ret"). The normal answer to this is to create a new
+\ word, ": exit ,asm ret ; immediate", but you would need semicolon to exist in order to do that.
+
+\ begin again until while repeat do ?do loop +loop
+\ /mod
+\ variable
+\ literal
+\ negate abs even
+\ <= >= 0> 0< 0= != u<= u>=
+\ min max umin umax
+
+create : ] create continue ] [
+: ; postpone exit continue [ [ immediate
+create execute $jmp asm 
+
+\ Control structure words
+: if >asm brz ; immediate
+: then resolve ; immediate
+: else r> >asm jmpr >r resolve ; immediate
+: variable create 0 , does> ;
+
+\ Counted loops, clean up the R stack if we want to early return
+\ Removes the loop counter things from the R stack
+: unloop r> r> drop drop ;
+
+\ Counted loops, cause an early return on the next test
+\ Sets the loop index equal to the counter
+: leave r> drop r@ >r ;
+
+\ Single-opcode words
+: and asm and ;
+: arshift asm arshift ;
+: drop asm pop ;
+: dup asm dup ;
+: lshift asm lshift ;
+: mod asm mod ;
+: or asm or ;
+: pick asm pick ;
+: rot asm rot ;
+: rshift asm rshift ;
+: swap asm swap ;
+: xor asm xor ;
+: + asm add ;
+: - asm sub ;
+: * asm mul ;
+: / asm div ;
+: @ asm loadw ;
+: ! asm storew ;
+: c@ asm load ;
+: c! asm store ;
+: > asm agt ;
+: < asm alt ;
+: u> asm gt ;
+: u< asm lt ;
+
+\ Simple utils
+\ : 2- 2 - ;
+\ : 1- 1 - ;
+\ : 2+ 2 + ;
+\ : 1+ 1 + ;
+\ : even 1 and asm not ;
+: rdrop r> drop ;
+: over 1 pick ;
+: nip swap drop ;
+: -rot rot rot ;
+: tuck dup -rot ;
+: emit 2 c! ;
+: space 32 emit ;
+: cr 10 emit ;
+: +! dup @ rot + swap ! ;
+: here &heap @ ;
+: dup2 1 pick 1 pick ;
+: allot &heap +! here ;
+: negate -1 xor 1+ ;
+: free negate &heap +! here ;
+: c+! dup c@ rot + swap c! ;
+: not -1 xor ;
+: false 0 ;
+: true 1 ;
+: ror dup 1 rshift swap 23 lshift or ;
+: rol dup 23 rshift swap 1 lshift or ;
+\ : cell+ 3 allot ;
+\ : cells 3 * allot ;
+: = xor asm not ;
+
+\ Things that require loops
+: abs dup 0 < if negate then ;
+: spaces 0 do space loop ;

novaforth/src/init.asm

@@ -0,0 +1,287 @@
+.org 0x400 ; start here
+;;;;; Start
+    push on_key
+    setiv 5
+    setint 1
+    call clear_screen
+    call set_video
+    push msg
+    push screen
+    call print_to
+
+    push putc
+    storew emit_hook
+    push vemu_quit
+    storew quit_vector
+wfi_loop: hlt
+    jmpr @wfi_loop
+
+vemu_quit:
+    call clear_tib
+    jmpr @wfi_loop
+
+;;;;;
+
+screen: .equ 0x10000
+reg: .equ 16
+$lshift: .equ 0xe1 ; TODO vasm shouldn't allow syms that are also opcodes
+$rshift: .equ 0xe5
+enter: .equ 0x28
+backspace: .equ 0x2a
+
+default_table: .db "abcdefghijklmnopqrstuvwxyz1234567890???? -=[]\\?;'`,./"
+shift_table: .db "ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()???? _+{}|?:\"~<>?"
+
+screen_cursor: .db screen + 40 ; TODO vasm shouldn't allow redefining syms
+msg: .db "Welcome to NovaForth\0"
+okay: .db "ok\0"
+current_table: .db default_table
+
+set_video:
+    push 30
+    storew reg + 10
+    push 40
+    storew reg + 13
+    ret
+
+clear_screen:
+    push screen
+    #while
+        dup
+        lt screen + 40 * 30
+    #do
+        dup
+        swap 0
+        store
+
+        dup
+        add 40 * 30
+        swap 0b10010010
+        store
+
+        add 1
+    #end
+    pop
+    ret
+
+print_to: ; ( msg addr -- ) TODO this should replace print in 4th
+    pushr
+    #while
+        dup
+        load
+    #do
+        dup
+        load
+        peekr
+        store
+        popr
+        add 1
+        pushr
+        add 1
+    #end
+    pop
+    popr
+    pop
+    ret
+
+on_key:
+    setint 1 ; this can be reentrant, doesn't hurt anything
+    call is_press ; check for press
+    #if
+        call is_ret
+        brnz @handle_enter
+        call is_back
+        brnz @handle_backspace
+        call is_printable
+        brnz @handle_char
+        call is_shift
+        brnz @set_shift
+    ;   if backspace, clear cursor and dec
+        pop
+        ret
+    #else
+        call is_shift
+        brnz @clear_shift
+        pop
+        ret
+    #end
+    ret
+
+newline:
+    loadw screen_cursor
+    sub screen
+    add 40
+    dup
+    gt 40 * 30 - 1
+    #if
+        pop
+        push 40
+    #else
+        dup
+        mod 40
+        sub
+    #end
+    add screen
+    storew screen_cursor
+    ret
+
+set_shift:
+    push shift_table
+    storew current_table
+    ret
+
+clear_shift:
+    push default_table
+    storew current_table
+    ret
+
+is_press: ; ( event -- key bool )
+    dup
+    and 0xff
+    swap
+    and 0xff00
+    ret
+
+is_ret:
+    push enter
+    jmp is_key
+
+is_back:
+    push backspace
+    jmp is_key
+
+is_shift: ; ( key -- 1 ) or ( key -- key 0 )
+    push $lshift
+    call is_key
+    brz @+2
+    ret 1
+    push $rshift
+    jmp is_key
+
+is_key: ; ( key1 key2 -- 1 ) or ( key1 key2 -- key1 0 )
+    swap
+    dup
+    pushr
+    sub
+    #unless ; they're equal
+        popr
+        pop
+        ret 1
+    #else ; they're not
+        popr
+        ret 0
+    #end
+
+is_printable: ; ( key -- ch 1 ) or ( key -- key 0 )
+    dup
+    dup
+    gt 0x03
+    swap
+    lt 0x39
+    and
+    #if
+        sub 0x04
+        loadw current_table
+        add
+        load
+        ret 1
+    #end
+    ret 0
+
+; Print the character we just typed, then put it into tib,
+; increment tib_cursor and re-null-term the string. 
+handle_char: ; ( ch -- ) modifiers cursor too
+    dup
+    call putc
+    loadw tib_cursor
+    store
+    loadw tib_cursor
+    add 1
+    dup
+    swap 0
+    store
+    storew tib_cursor
+    ret
+
+; Backspace on the screen (bracketed to the beginning of
+; the line), and backspace tib_cursor (bracketed to the
+; start of tib)
+handle_backspace:
+    loadw screen_cursor
+    sub screen
+    dup
+    mod 40
+    #if
+        sub 1
+        add screen
+        dup
+        swap 32 ; a space
+        store
+        storew screen_cursor
+    #else
+        pop
+    #end
+    loadw tib_cursor
+    gt tib
+    #if
+        loadw tib_cursor
+        sub 1
+        dup
+        swap 0
+        store
+        storew tib_cursor
+    #end
+    ret
+
+handle_enter:
+    ; Separator before our result
+    call advance_one
+    ; Actually eval the tib
+    push tib
+    call eval
+    ; If the eval was successful, we'll do this:
+    ; clear the tib
+    call clear_tib
+    ; Tell the user we evaluated it
+    call advance_one
+    push okay
+    call print
+    ; Go to another line
+    call newline
+    ret
+
+putc: ; ( ch -- ) (also modifies cursor)
+    dup
+    xor 10 ; newline
+    #if ; normal char, emit it
+        loadw screen_cursor
+        dup
+        pushr
+        store
+        popr
+        add 1
+        storew screen_cursor
+        ret
+    #end
+    jmp newline
+
+; Print a space (by ticking cursor forward some)
+advance_one:
+    loadw screen_cursor
+    add 1
+    storew screen_cursor
+    ret
+
+clear_tib:
+    push tib
+    storew tib_cursor
+    push 0
+    store tib
+    ret
+
+; Terminal input buffer
+tib: .db 0
+.org tib + 0x100
+tib_cursor: .db tib
+
+#include "4th.asm"

novaforth/src/lib.rs

@@ -0,0 +1,8 @@
+/// The actual bytes of the NovaForth ROM, to be placed in memory starting at 0x400
+pub const ROM: &'static [u8] = include_bytes!(concat!(env!("OUT_DIR"), "/4th.rom"));
+
+/// The symbols (other than gensym'd ones) and their byte offsets from 0x400, as a JSON string
+pub const SYMBOLS: &'static str = include_str!(concat!(env!("OUT_DIR"), "/4th.rom.sym"));
+
+/// The "Prelude," words written in Novaforth itself that define part of the language.
+pub const PRELUDE: &'static str = include_str!("prelude.f");

novaforth/src/magic.asm

@@ -0,0 +1,9 @@
+; Magic numbers:
+$PUSH: .equ 0
+$SWAP: .equ 20
+$JMP: .equ 23
+$JMPR: .equ 24
+$CALL: .equ 25
+$RET: .equ 26
+$BRZ: .equ 27
+$BRNZ: .equ 28

novaforth/src/numbers.asm

@@ -0,0 +1,106 @@
+input_number:
+    loadw cursor
+    call nova_word
+    loadw heap
+    loadw is_number_hook
+    call
+    ret
+
+; Prints a number, using whatever the current itoa_hook is
+print_number:
+    loadw itoa_hook
+    jmp
+
+; Print the number on top of the stack, in decimal, with a
+; leading '-' if it's negative
+; TODO: refactor this to use macros
+itoa: ; ( num -- )
+    dup
+    alt 0 ; We less than 0?
+    brz @itoa_pos
+    xor 0xffffff ; Less than zero, so negate it
+    add 1
+    push 45 ; 45 is '-', print a leading dash
+    call nova_emit
+itoa_pos: ; ( num -- )
+    loadw heap ; Gonna build the string on the heap
+    dup
+    swap 0
+    store
+    add 1
+    pushr
+itoa_loop:
+    dup ; ( num num ) [ arr ]
+    mod 10
+    dup
+    alt 0
+    #if
+    xor 0xffffff
+    add 1
+    #end
+    dup
+    add 48 ; ( num mod ch )
+    peekr ; ( num mod ch arr ) [ arr ]
+    store
+    popr ; ( num mod arr ) [ ]
+    add 1
+    pushr ; ( num mod ) [ arr+1 ]
+    sub
+    div 10
+    dup
+    brnz @itoa_loop
+    pop
+    ; Got the array of digits in reverse order, print them out:
+    popr
+    sub 1
+itoa_print_loop:
+    dup
+    load
+    call nova_emit
+    sub 1
+    dup
+    load
+    brnz @itoa_print_loop
+    pop
+    ret
+
+; Print the number on top of the stack, in hex
+hex_itoa: ; ( num -- )
+    loadw heap ; Build the string on the heap, but don't allot the space
+    dup
+    swap 0
+    store ; Store a null terminator as the first char
+    add 1 ; Look at the next char
+    pushr ; Put this on the r stack to be used later
+    #while
+        dup
+    #do
+        dup
+        and 0xf ; ( num low-nibble )
+        dup
+        lt 10
+        #if
+            add 48 ; It's 0-9, so add a '0'
+        #else
+            add 87 ; It's a-f, so add an 'a' - 10
+        #end
+        peekr
+        store
+        popr
+        add 1
+        pushr
+        rshift 4
+    #end
+    pop
+    popr
+    sub 1
+    #while
+        dup
+        load
+        call dupnz
+    #do
+        call nova_emit
+        sub 1
+    #end
+    pop
+    ret

novaforth/src/prelude.f

@@ -2,26 +2,34 @@
 : then resolve ; immediate
 : else r> $ jmpr >asm >r resolve ; immediate
 : variable create 0 , does> ;
-: arshift [ $ arshift asm ] ;
+: unloop r> r> drop drop ;
-: lshift [ $ lshift asm ] ;
+: leave r> drop r@ >r ;
-: rshift [ $ rshift asm ] ;
-: u> [ $ gt asm ] ;
-: u< [ $ lt asm ] ;
-: rdrop r> pop ;
-: over 1 pick ;
-: nip swap pop ;
-: -rot rot rot ;
-: tuck dup -rot ;
-: space 32 emit ;
-: cr 13 emit 10 emit ;
-: +! dup @ rot + swap ! ;
-: 2dup 1 pick 1 pick ;
-: allot here swap &heap +! ;
-: negate -1 ^ 1 + ;
-: free negate &heap +! here ;
-: c+! dup c@ rot + swap c! ;
-: ror dup 1 rshift swap 23 lshift | ;
-: rol dup 23 rshift swap 1 lshift | ;
-: abs dup 0 < if negate then ;
 : begin here >r ; immediate
 : until r> here - $ brz #asm ; immediate
+
+: xor [ $ xor asm ] ;
+: arshift [ $ arshift asm ] ;
+: rshift [ $ rshift asm ] ;
+: lshift [ $ lshift asm ] ;
+: u> [ $ gt asm ] ;
+: u< [ $ lt asm ] ;
+: rdrop r> drop ;
+: over 1 pick ;
+: nip swap drop ;
+: -rot rot rot ;
+: tuck dup -rot ;
+: emit 2 c! ;
+: space 32 emit ;
+: cr 10 emit ;
+: +! dup @ rot + swap ! ;
+: dup2 1 pick 1 pick ;
+: allot &heap +! here ;
+: negate -1 xor 1+ ;
+: free negate &heap +! here ;
+: c+! dup c@ rot + swap c! ;
+: false 0 ;
+: true 1 ;
+: ror dup 1 rshift swap 23 lshift or ;
+: rol dup 23 rshift swap 1 lshift or ;
+: abs dup 0 < if negate then ;
+: spaces 0 do space loop ;

novaforth/src/string.asm

@@ -0,0 +1,168 @@
+; Tries to parse a number out of a string. There's a helper function,
+; pos_is_number, that does a sequence of digits. This checks the first
+; character against '-', and then calls that, and negative-izes if
+; necessary.
+is_number: ; ( ptr -- [num 1] -or- [0] )
+    dup
+    load ; ( ptr first-ch )
+    xor 45 ; 45 is '-', ( ptr not-dash )
+    brnz @pos_is_number ; We're done here, it's positive
+    add 1
+    call pos_is_number ; ( pos-num valid? )
+    #if
+        xor 0xffffff
+        add 1
+        ret 1
+    #end
+    pop
+    ret 0
+
+; The positive-only version of parsing a number. Negative-ness is
+; handled by is_number, at this point we can assume that we just have
+; a sequence of positive digits.
+; TODO: refactor this to use macros
+pos_is_number: ; ( ptr -- num valid? )
+    pushr 0
+pos_is_number_loop:
+    dup
+    load
+    call is_digit
+    brz @pos_is_number_bad
+    dup
+    load
+    sub 48 ; '0' ascii
+    popr
+    mul 10
+    add
+    pushr
+    add 1
+    dup
+    load
+    call word_char
+    brz @pos_is_number_done
+    jmpr @pos_is_number_loop
+pos_is_number_bad:
+    popr
+    pop
+    pop
+    ret 0
+pos_is_number_done:
+    pop
+    popr
+    ret 1
+
+; Attempt to parse a hexadecimal number. This is a sequence of digits 0-9 or a-f or A-F
+hex_is_number: ; ( ptr -- [num 1] -or- [0] )
+    pushr 0
+    #while
+        dup
+        load
+        dup
+        call word_char
+    #do ; It's a word-char
+        call parse_hex_digit
+        #if ; It's a digit even!
+            popr
+            mul 16
+            add
+            pushr
+            add 1
+        #else ; Not a digit, not a \0...
+            popr
+            pop
+            pop
+            ret 0
+        #end
+    #end
+    ; End of string, return the number
+    pop
+    pop
+    popr
+    ret 1
+
+; Returns whether the byte at the top of the stack is a hex digit, and what it is if so
+parse_hex_digit: ; ( byte -- [val 1] if a digit, or [0] if it isn't )
+    dup
+    call is_digit
+    #if ; It's a 0-9
+        sub 48 ; '0' ascii
+        ret 1
+    #else
+        dup
+        gt 96 ; ( ch is-lowercase )
+        #if
+            sub 32
+        #end
+        dup
+        dup
+        gt 64 ; at least 'A'
+        swap
+        lt 71 ; at most 'F'
+        and ; ( ch is-AF )
+        #if
+            sub 55
+            ret 1
+        #end
+    #end
+    pop
+    ret 0
+
+; Takes a pointer to the start of a word, returns a pointer to the
+; first nonword-char after it
+skip_word: ; ( ptr -- first-nonword )
+    #while
+        dup
+        load
+        call word_char
+    #do
+        add 1
+    #end
+    ret
+
+; Takes a pointer to a nonword-char, returns a pointer to the
+; first word-char after it, or the first zero / EOS
+skip_nonword: ; ( ptr -- first-word )
+    dup
+    load ; ( ptr ch )
+    call dupnz
+    #if
+        call word_char
+        #unless
+            add 1
+            jmpr @skip_nonword
+        #end
+        ret
+    #end
+    ret
+
+
+; Return a flag of whether two strings are equal
+compare: ; ( str1 str2 -- equal? )
+    pushr
+    #while
+        dup
+        load
+        peekr
+        load
+        xor
+        not
+    #do
+        ; If we're here, they're equal chars, so first check if they're equal zeroes:
+        dup
+        load
+        #unless
+            popr
+            pop
+            pop
+            ret 1
+        #end
+        ; They're the same, increment both pointers
+        add 1
+        popr
+        add 1
+        pushr
+    #end
+    popr
+    pop
+    pop
+    ret 0

novaforth/src/test_init.asm

@@ -0,0 +1,6 @@
+.org 0x400 ; start here
+stop:
+    hlt ; And get out
+
+#include "4th.asm"
+; TODO the last line being an include should be allowed

novaforth/src/utils.asm

@@ -0,0 +1,53 @@
+#include "magic.asm"
+
+; Emit a single character to stdout
+emit: ; ( ch -- )
+    loadw emit_cursor
+    dup
+    add 1
+    storew emit_cursor
+    add 0x10000
+    store
+    ret
+emit_cursor: .db 0 ; The length of the string in the output buffer
+
+
+; Print a null-term string
+print: ; ( addr -- )
+    #while
+        dup
+        load
+        call dupnz
+    #do
+        call nova_emit
+        add 1
+    #end
+    pop
+    ret
+
+; Print a carriage return
+cr: ; ( -- )
+    push 10
+    call nova_emit
+    ret
+
+dupnz: ; if TOS is nonzero, dup it
+    dup
+    brz @dupnz_done
+    dup
+dupnz_done:
+    ret
+
+; returns whether this character is a word char (nonzero) or a separator between words (space, cr, tab, control chars...)
+word_char: ; ( ch -- bool )
+    gt 32
+    ret
+
+; returns whether this character is a digit 0-9
+is_digit: ; ( ch -- bool )
+    dup
+    gt 47 ; it's at least '0'
+    swap
+    lt 58 ; it's at most '9'
+    and
+    ret

vasm_core/src/ast.rs

@@ -62,6 +62,8 @@ pub enum Macro {
     Until,
     Do,
     End,
+    Break,
+    Continue,
 }
 
 #[derive(Debug, PartialEq, Clone)]

vasm_core/src/vasm.pest

@@ -69,7 +69,7 @@ org_directive = { label_def? ~ ".org" ~ expr }
 equ_directive = { label_def ~ ".equ" ~ expr }
 
 include = { "include" ~ string }
-control = { "if" | "unless" | "while" | "until" | "do" | "else" | "end" }
+control = { "if" | "unless" | "while" | "until" | "do" | "else" | "end" | "break" | "continue" }
 preprocessor = {"#" ~ (control | include) }
 
 blank = { WHITESPACE? ~ COMMENT? }

vasm_core/src/vasm_parser.rs

@@ -208,6 +208,8 @@ fn parse_macro(line: Pair) -> Macro {
             "until" => Macro::Until,
             "do" => Macro::Do,
             "end" => Macro::End,
+            "break" => Macro::Break,
+            "continue" => Macro::Continue,
             _ => unreachable!(),
         },
         Rule::include => Macro::Include(create_string(pre.only())),

vasm_core/src/vasm_preprocessor.rs

@@ -11,7 +11,7 @@ pub struct Line {
 }
 
 #[derive(Debug, Clone, PartialEq)]
-enum LoopType {
+pub enum LoopType {
     While,
     Until,
 }
@@ -27,7 +27,7 @@ impl From<Macro> for LoopType {
 }
 
 #[derive(Debug, Clone, PartialEq)]
-enum ControlStructure {
+pub enum ControlStructure {
     Target(String),
     Loop(String, LoopType),
     LoopDo(String, String),
@@ -81,7 +81,10 @@ impl<T: IntoIterator<Item = String>, F: Fn(String) -> Result<T, AssembleError>>
 
                 // It's a macro, so do it and then try again
                 Ok(VASMLine::Macro(mac)) => {
-                    self.handle_macro(mac);
+                    match self.handle_macro(mac) {
+                        None => {}
+                        Some(err) => return Some(Err(err))
+                    }
                     self.next()
                 }
 
@@ -214,9 +217,32 @@ impl<T: IntoIterator<Item = String>, F: Fn(String) -> Result<T, AssembleError>>
                 }
                 _ => return Some(AssembleError::MacroError(self.current_location())),
             },
+            Macro::Break => {
+                if let Some(ControlStructure::LoopDo(_, after)) = self.innermost_loop() {
+                    self.emit(format!("jmpr @{}", after));
+                } else {
+                    return Some(AssembleError::MacroError(self.current_location()))
+                }
+            }
+            Macro::Continue => {
+                if let Some(ControlStructure::LoopDo(test, _)) = self.innermost_loop() {
+                    self.emit(format!("jmpr @{}", test));
+                } else {
+                    return Some(AssembleError::MacroError(self.current_location()))
+                }
+            }
         }
         None
     }
+
+    pub fn innermost_loop(&self) -> Option<&ControlStructure> {
+        self.control_stack.iter().rev().find(|cs| {
+            match cs {
+                ControlStructure::LoopDo(_, _) => true,
+                _ => false
+            }
+        })
+    }
 }
 
 #[cfg(test)]
@@ -227,10 +253,18 @@ mod tests {
 
     fn lines_for(source: Vec<String>) -> Vec<VASMLine> {
         let include = |_name: String| panic!();
-        let src = LineSource::new("blah", source, include);
+        let src = LineSource::new("<none>", source, include);
         src.map(|line| line.unwrap().line).collect()
     }
 
+    fn error_for(source: Vec<String>) -> Option<AssembleError> {
+        let include = |_name: String| panic!();
+        for line in LineSource::new("<none>", source, include) {
+            if line.is_err() { return line.err() }
+        }
+        None
+    }
+
     fn stringify(a: Vec<&str>) -> Vec<String> {
         a.into_iter().map(String::from).collect()
     }
@@ -325,4 +359,76 @@ mod tests {
             ]
         )
     }
+
+    #[test]
+    fn test_preprocess_break() {
+        // First a working one
+        assert_eq!(
+            lines_for(stringify(vec!["#while", "#do", "#break", "#end"])),
+            vec![
+                VASMLine::LabelDef(Label("__gensym_1".to_string())),
+                VASMLine::Instruction(
+                    None,
+                    Brz,
+                    Some(Node::RelativeLabel("__gensym_2".to_string()))
+                ),
+                VASMLine::Instruction(
+                    None,
+                    Jmpr,
+                    Some(Node::RelativeLabel("__gensym_2".to_string()))
+                ),
+                VASMLine::Instruction(
+                    None,
+                    Jmpr,
+                    Some(Node::RelativeLabel("__gensym_1".to_string()))
+                ),
+                VASMLine::LabelDef(Label::from("__gensym_2"))
+            ]
+        );
+    }
+
+    #[test]
+    fn test_malformed_break() {
+        // Malformed one
+        assert_eq!(
+            error_for(stringify(vec!["#while", "#break"])),
+            Some(AssembleError::MacroError(Location::from(2)))
+        )
+    }
+
+    #[test]
+    fn test_preprocess_continue() {
+        // First a working one
+        assert_eq!(
+            lines_for(stringify(vec!["#while", "#do", "#continue", "#end"])),
+            vec![
+                VASMLine::LabelDef(Label("__gensym_1".to_string())),
+                VASMLine::Instruction(
+                    None,
+                    Brz,
+                    Some(Node::RelativeLabel("__gensym_2".to_string()))
+                ),
+                VASMLine::Instruction(
+                    None,
+                    Jmpr,
+                    Some(Node::RelativeLabel("__gensym_1".to_string()))
+                ),
+                VASMLine::Instruction(
+                    None,
+                    Jmpr,
+                    Some(Node::RelativeLabel("__gensym_1".to_string()))
+                ),
+                VASMLine::LabelDef(Label::from("__gensym_2"))
+            ]
+        );
+    }
+
+    #[test]
+    fn test_malformed_continue() {
+        // Malformed one
+        assert_eq!(
+            error_for(stringify(vec!["#while", "#continue"])),
+            Some(AssembleError::MacroError(Location::from(2)))
+        )
+    }
 }

vemu/Cargo.toml

@@ -10,5 +10,5 @@ vcore = { path = "../vcore" }
 vgfx = { path = "../vgfx" }
 vasm_core = { path = "../vasm_core" }
 rand = "0.8.0"
-winit = "0.26.1"
+winit = "0.30.12"
-pixels = "0.9.0"
+pixels = "0.15.0"

vemu/src/keyboard.rs

@@ -1,117 +1,118 @@
-use winit::event::VirtualKeyCode;
+use winit::keyboard::{KeyCode};
 
-pub fn convert_keycode(vkey: VirtualKeyCode) -> u8 {
+pub fn convert_keycode(vkey: KeyCode) -> u8 {
+    use KeyCode::*;
     match vkey {
-        VirtualKeyCode::A => 0x04,
+        KeyA => 0x04,
-        VirtualKeyCode::B => 0x05,
+        KeyB => 0x05,
-        VirtualKeyCode::C => 0x06,
+        KeyC => 0x06,
-        VirtualKeyCode::D => 0x07,
+        KeyD => 0x07,
-        VirtualKeyCode::E => 0x08,
+        KeyE => 0x08,
-        VirtualKeyCode::F => 0x09,
+        KeyF => 0x09,
-        VirtualKeyCode::G => 0x0a,
+        KeyG => 0x0a,
-        VirtualKeyCode::H => 0x0b,
+        KeyH => 0x0b,
-        VirtualKeyCode::I => 0x0c,
+        KeyI => 0x0c,
-        VirtualKeyCode::J => 0x0d,
+        KeyJ => 0x0d,
-        VirtualKeyCode::K => 0x0e,
+        KeyK => 0x0e,
-        VirtualKeyCode::L => 0x0f,
+        KeyL => 0x0f,
-        VirtualKeyCode::M => 0x10,
+        KeyM => 0x10,
-        VirtualKeyCode::N => 0x11,
+        KeyN => 0x11,
-        VirtualKeyCode::O => 0x12,
+        KeyO => 0x12,
-        VirtualKeyCode::P => 0x13,
+        KeyP => 0x13,
-        VirtualKeyCode::Q => 0x14,
+        KeyQ => 0x14,
-        VirtualKeyCode::R => 0x15,
+        KeyR => 0x15,
-        VirtualKeyCode::S => 0x16,
+        KeyS => 0x16,
-        VirtualKeyCode::T => 0x17,
+        KeyT => 0x17,
-        VirtualKeyCode::U => 0x18,
+        KeyU => 0x18,
-        VirtualKeyCode::V => 0x19,
+        KeyV => 0x19,
-        VirtualKeyCode::W => 0x1a,
+        KeyW => 0x1a,
-        VirtualKeyCode::X => 0x1b,
+        KeyX => 0x1b,
-        VirtualKeyCode::Y => 0x1c,
+        KeyY => 0x1c,
-        VirtualKeyCode::Z => 0x1d,
+        KeyZ => 0x1d,
-        VirtualKeyCode::Key1 => 0x1e,
+        Digit1 => 0x1e,
-        VirtualKeyCode::Key2 => 0x1f,
+        Digit2 => 0x1f,
-        VirtualKeyCode::Key3 => 0x20,
+        Digit3 => 0x20,
-        VirtualKeyCode::Key4 => 0x21,
+        Digit4 => 0x21,
-        VirtualKeyCode::Key5 => 0x22,
+        Digit5 => 0x22,
-        VirtualKeyCode::Key6 => 0x23,
+        Digit6 => 0x23,
-        VirtualKeyCode::Key7 => 0x24,
+        Digit7 => 0x24,
-        VirtualKeyCode::Key8 => 0x25,
+        Digit8 => 0x25,
-        VirtualKeyCode::Key9 => 0x26,
+        Digit9 => 0x26,
-        VirtualKeyCode::Key0 => 0x27,
+        Digit0 => 0x27,
-        VirtualKeyCode::Return => 0x28,
+        Enter => 0x28,
-        VirtualKeyCode::Escape => 0x29,
+        Escape => 0x29,
-        VirtualKeyCode::Back => 0x2a,
+        BrowserBack => 0x2a,
-        VirtualKeyCode::Tab => 0x2b,
+        Tab => 0x2b,
-        VirtualKeyCode::Space => 0x2c,
+        Space => 0x2c,
-        VirtualKeyCode::Minus => 0x2d,
+        Minus => 0x2d,
-        VirtualKeyCode::Equals => 0x2e,
+        Equal => 0x2e,
-        VirtualKeyCode::LBracket => 0x2f,
+        BracketLeft => 0x2f,
-        VirtualKeyCode::RBracket => 0x30,
+        BracketRight => 0x30,
-        VirtualKeyCode::Backslash => 0x31,
+        Backslash => 0x31,
         // 0x32 is a non-US keyboard key: hash and tilde
-        VirtualKeyCode::Semicolon => 0x33,
+        Semicolon => 0x33,
-        VirtualKeyCode::Apostrophe => 0x34,
+        Quote => 0x34,
-        VirtualKeyCode::Grave => 0x35,
+        Backquote => 0x35,
-        VirtualKeyCode::Comma => 0x36,
+        Comma => 0x36,
-        VirtualKeyCode::Period => 0x37,
+        Period => 0x37,
-        VirtualKeyCode::Slash => 0x38,
+        Slash => 0x38,
-        VirtualKeyCode::Capital => 0x39,
+        CapsLock => 0x39,
-        VirtualKeyCode::F1 => 0x3a,
+        F1 => 0x3a,
-        VirtualKeyCode::F2 => 0x3b,
+        F2 => 0x3b,
-        VirtualKeyCode::F3 => 0x3c,
+        F3 => 0x3c,
-        VirtualKeyCode::F4 => 0x3d,
+        F4 => 0x3d,
-        VirtualKeyCode::F5 => 0x3e,
+        F5 => 0x3e,
-        VirtualKeyCode::F6 => 0x3f,
+        F6 => 0x3f,
-        VirtualKeyCode::F7 => 0x40,
+        F7 => 0x40,
-        VirtualKeyCode::F8 => 0x41,
+        F8 => 0x41,
-        VirtualKeyCode::F9 => 0x42,
+        F9 => 0x42,
-        VirtualKeyCode::F10 => 0x43,
+        F10 => 0x43,
-        VirtualKeyCode::F11 => 0x44,
+        F11 => 0x44,
-        VirtualKeyCode::F12 => 0x45,
+        F12 => 0x45,
-        VirtualKeyCode::Sysrq => 0x46,
+        PrintScreen => 0x46,
-        VirtualKeyCode::Scroll => 0x47,
+        ScrollLock => 0x47,
-        VirtualKeyCode::Pause => 0x48,
+        Pause => 0x48,
-        VirtualKeyCode::Insert => 0x49,
+        Insert => 0x49,
-        VirtualKeyCode::Home => 0x4a,
+        Home => 0x4a,
-        VirtualKeyCode::PageUp => 0x4b,
+        PageUp => 0x4b,
-        VirtualKeyCode::Delete => 0x4c,
+        Delete => 0x4c,
-        VirtualKeyCode::End => 0x4d,
+        End => 0x4d,
-        VirtualKeyCode::PageDown => 0x4e,
+        PageDown => 0x4e,
-        VirtualKeyCode::Right => 0x4f,
+        ArrowRight => 0x4f,
-        VirtualKeyCode::Left => 0x50,
+        ArrowLeft => 0x50,
-        VirtualKeyCode::Down => 0x51,
+        ArrowDown => 0x51,
-        VirtualKeyCode::Up => 0x52,
+        ArrowUp => 0x52,
-        VirtualKeyCode::Numlock => 0x53,
+        NumLock => 0x53,
-        VirtualKeyCode::NumpadDivide => 0x54,
+        NumpadDivide => 0x54,
-        VirtualKeyCode::NumpadMultiply => 0x55,
+        NumpadMultiply => 0x55,
-        VirtualKeyCode::NumpadSubtract => 0x56,
+        NumpadSubtract => 0x56,
-        VirtualKeyCode::NumpadAdd => 0x57,
+        NumpadAdd => 0x57,
-        VirtualKeyCode::NumpadEnter => 0x58,
+        NumpadEnter => 0x58,
-        VirtualKeyCode::Numpad1 => 0x59,
+        Numpad1 => 0x59,
-        VirtualKeyCode::Numpad2 => 0x5a,
+        Numpad2 => 0x5a,
-        VirtualKeyCode::Numpad3 => 0x5b,
+        Numpad3 => 0x5b,
-        VirtualKeyCode::Numpad4 => 0x5c,
+        Numpad4 => 0x5c,
-        VirtualKeyCode::Numpad5 => 0x5d,
+        Numpad5 => 0x5d,
-        VirtualKeyCode::Numpad6 => 0x5e,
+        Numpad6 => 0x5e,
-        VirtualKeyCode::Numpad7 => 0x5f,
+        Numpad7 => 0x5f,
-        VirtualKeyCode::Numpad8 => 0x60,
+        Numpad8 => 0x60,
-        VirtualKeyCode::Numpad9 => 0x61,
+        Numpad9 => 0x61,
-        VirtualKeyCode::Numpad0 => 0x62,
+        Numpad0 => 0x62,
-        VirtualKeyCode::NumpadDecimal => 0x63,
+        NumpadDecimal => 0x63,
         // 0x64 is a non-US keyboard key: backslash and bar
-        VirtualKeyCode::Compose => 0x65,
+        Hiragana => 0x65,
         // 0x66 is a non-standard key: power
-        VirtualKeyCode::NumpadEquals => 0x67,
+        NumpadEqual => 0x67,
         // 0x68-0x73 is extended function keys
         // 0x74-0xdf is a bunch of international stuff and keypad stuff
-        VirtualKeyCode::LControl => 0xe0,
+        ControlLeft => 0xe0,
-        VirtualKeyCode::LShift => 0xe1,
+        ShiftLeft => 0xe1,
-        VirtualKeyCode::LAlt => 0xe2,
+        AltLeft => 0xe2,
-        VirtualKeyCode::LWin => 0xe3,
+        SuperLeft => 0xe3,
-        VirtualKeyCode::RControl => 0xe4,
+        ControlRight => 0xe4,
-        VirtualKeyCode::RShift => 0xe5,
+        ShiftRight => 0xe5,
-        VirtualKeyCode::RAlt => 0xe6,
+        AltRight => 0xe6,
-        VirtualKeyCode::RWin => 0xe7,
+        SuperRight => 0xe7,
         _ => 0xff,
     }
 }

vemu/src/main.rs

@@ -4,128 +4,155 @@ use winit::{
     dpi::LogicalSize,
     event::{Event, WindowEvent},
     event_loop::{ControlFlow, EventLoop},
-    window::WindowBuilder,
 };
 
 use crate::keyboard::convert_keycode;
 use pixels::{Pixels, SurfaceTexture};
 use std::collections::VecDeque;
+use std::sync::Arc;
 use std::time::{Duration, Instant};
+use winit::application::ApplicationHandler;
 use vasm_core::assemble_snippet;
 use vcore::cpu::CPU;
 use vcore::memory::{Memory, PeekPoke};
 use vcore::word::Word;
-use winit::event::{DeviceEvent, ElementState};
+use winit::event::{DeviceEvent, DeviceId, ElementState, StartCause};
-use winit::window::Window;
+use winit::event_loop::ActiveEventLoop;
+use winit::keyboard::PhysicalKey;
+use winit::window::{Window, WindowId};
 use vgfx::display;
 
-fn main() {
+struct App<'a> {
-    let event_loop = EventLoop::new();
+    cpu: CPU,
+    pixels: Option<Pixels<'a>>,
+    window: Option<Arc<Window>>,
+    interrupt_events: VecDeque<(usize, Option<Word>)>,
+    focused: bool
+}
 
-    let window = {
+impl<'a> App<'a> {
+    fn new() -> Self {
+        let rng = rand::thread_rng();
+        let memory = Memory::from(rng);
+
+        Self {
+            cpu: CPU::new(memory),
+            pixels: None,
+            window: None,
+            interrupt_events: VecDeque::new(),
+            focused: false
+        }
+    }
+}
+impl<'a> ApplicationHandler for App<'a> {
+    fn resumed(&mut self, event_loop: &ActiveEventLoop) {
         let size = LogicalSize::new(640, 480);
-        WindowBuilder::new()
+
+        let attrs = Window::default_attributes()
             .with_title("Vulcan")
             .with_inner_size(size)
-            .with_min_inner_size(size)
+            .with_min_inner_size(size);
-            .build(&event_loop)
-            .unwrap()
-    };
 
-    let pixels = {
+        self.window = Some(event_loop.create_window(attrs).expect("Failed to create window").into());
-        let winit::dpi::PhysicalSize { width, height } = window.inner_size();
-        let surface_texture = SurfaceTexture::new(width, height, &window);
-        Pixels::new(640, 480, surface_texture).unwrap()
-    };
 
-    let rng = rand::thread_rng();
+        display::init_gfx(&mut self.cpu);
 
-    let memory = Memory::from(rng);
-    let mut cpu = CPU::new(memory);
-    display::init_gfx(&mut cpu);
         let code = assemble_snippet(include_str!("typewriter.asm").lines().map(String::from))
             .expect("Assemble error");
+
         // let code = assemble_file("init.asm").expect("Assemble error");
         // let mut file = File::open("4th.rom").expect("ROM not found");
         // let mut code = Vec::new();
         // file.read_to_end(&mut code).expect("Couldn't read ROM");
         println!("ROM size: {} bytes", code.len());
-    cpu.poke_slice(0x400.into(), code.as_slice());
+        self.cpu.poke_slice(0x400.into(), code.as_slice());
-    cpu.start();
+        self.cpu.start();
-    window_loop(event_loop, window, pixels, cpu)
+
+        let winit::dpi::PhysicalSize { width, height } = self.window.as_ref().unwrap().inner_size();
+        let surface_texture = SurfaceTexture::new(width, height, self.window.as_ref().unwrap().clone());
+
+        self.pixels = Some(Pixels::new(640, 480, surface_texture).unwrap());
+        event_loop.set_control_flow(ControlFlow::WaitUntil(Instant::now() + Duration::from_millis(15)))
     }
 
-fn window_loop(event_loop: EventLoop<()>, window: Window, mut pixels: Pixels, mut cpu: CPU) -> ! {
+    fn new_events(&mut self, event_loop: &ActiveEventLoop, cause: StartCause) {
-    let mut interrupt_events: VecDeque<(usize, Option<Word>)> = VecDeque::new();
+        if let StartCause::ResumeTimeReached { .. } = cause {
-    let mut focused = true;
+            event_loop.set_control_flow(ControlFlow::WaitUntil(Instant::now() + Duration::from_millis(15)));
-
-    event_loop.run(move |event, _, control_flow| {
-        *control_flow = ControlFlow::Poll;
-
-        match event {
-            Event::WindowEvent {
-                event: WindowEvent::CloseRequested,
-                window_id,
-            } if window_id == window.id() => *control_flow = ControlFlow::Exit,
-
-            Event::WindowEvent {
-                event: WindowEvent::Resized(new_size),
-                window_id,
-            } if window_id == window.id() => {
-                pixels.resize_surface(new_size.width, new_size.height);
-            }
-
-            // These are sent regardless of whether the window is focused or not, and are the same regardless of keyboard
-            // layout, so, we have to separately track focus and this will only work as expected for normal US Sholes
-            // keyboards.
-            // If we use the WindowEvent equivalent of this, however, shifted non-letter characters will send no vkeys
-            // at all on Linux. Which is actually worse: this way, someone with a "normal" keyboard can use the app on
-            // any OS, and there are probably more Linux users than Dvorak users.
-            // Also, this won't actually affect me, even on Linux, because the KMAC handles the dvorak mapping in the
-            // keyboard itself, rather than an input map; it generates scancodes as though it were a Sholes board.
-            // See this bug: https://github.com/rust-windowing/winit/issues/1443
-            Event::DeviceEvent {
-                event: DeviceEvent::Key(input),
-                device_id: _device_id,
-            } => {
-                if let (Some(vk), state, true) = (input.virtual_keycode, input.state, focused) {
-                    let byte = convert_keycode(vk);
-                    let word = Word::from_bytes([
-                        byte,
-                        if state == ElementState::Pressed { 1 } else { 0 },
-                        0,
-                    ]);
-                    interrupt_events.push_back((5, Some(word)))
-                }
-            }
-
-            Event::WindowEvent {
-                event: WindowEvent::Focused(new_focus),
-                window_id,
-            } if window_id == window.id() => focused = new_focus,
-
-            Event::MainEventsCleared => {
             let start = Instant::now();
-                draw(pixels.get_frame(), &mut cpu);
+
-                pixels.render().expect("Problem displaying framebuffer");
+            draw(self.pixels.as_mut().unwrap().frame_mut(), &mut self.cpu);
+            self.pixels.as_mut().unwrap().render().expect("Problem displaying framebuffer");
+
             loop {
                 // TODO: this will run the CPU at 100%, need to not spin while halted
-                    if let Some((int, arg)) = interrupt_events.pop_front() {
+                if let Some((int, arg)) = self.interrupt_events.pop_front() {
-                        cpu.interrupt(int, arg)
+                    self.cpu.interrupt(int, arg)
                 }
-                    if cpu.running() {
+                if self.cpu.running() {
                     for _ in 1..1000 {
-                            cpu.tick()
+                        self.cpu.tick()
+                    }
+                } else {
+                    break
+                }
+                if Instant::now() > start + Duration::from_millis(14) {
+                    break
                 }
             }
-                    if Instant::now() > start + Duration::from_millis(25) {
-                        break;
         }
     }
+
+    fn window_event(&mut self, event_loop: &ActiveEventLoop, window_id: WindowId, event: WindowEvent) {
+        match event {
+            WindowEvent::CloseRequested => event_loop.exit(),
+
+            WindowEvent::Resized(new_size) => {
+                self.pixels.as_mut().unwrap().resize_surface(new_size.width, new_size.height).expect("Resize");
+            }
+
+            WindowEvent::Focused(new_focus) => self.focused = new_focus,
+
+            WindowEvent::KeyboardInput { event, .. } => {
+                if let PhysicalKey::Code(key_code) = event.physical_key {
+                    let byte = convert_keycode(key_code);
+                    let word = Word::from_bytes([
+                        byte,
+                        if event.state == ElementState::Pressed { 1 } else { 0 },
+                        0,
+                    ]);
+                    self.interrupt_events.push_back((5, Some(word)))
+                }
             }
             _ => {}
         }
-    })
+    }
+
+    // fn device_event(&mut self, event_loop: &ActiveEventLoop, device_id: DeviceId, event: DeviceEvent) {
+    //     match event {
+    //         // These are sent regardless of whether the window is focused or not, and are the same regardless of keyboard
+    //         // layout, so, we have to separately track focus and this will only work as expected for normal US Sholes
+    //         // keyboards.
+    //         // If we use the WindowEvent equivalent of this, however, shifted non-letter characters will send no vkeys
+    //         // at all on Linux. Which is actually worse: this way, someone with a "normal" keyboard can use the app on
+    //         // any OS, and there are probably more Linux users than Dvorak users.
+    //         // Also, this won't actually affect me, even on Linux, because the KMAC handles the dvorak mapping in the
+    //         // keyboard itself, rather than an input map; it generates scancodes as though it were a Sholes board.
+    //         // See this bug: https://github.com/rust-windowing/winit/issues/1443
+    //         DeviceEvent::Key(input) => {
+    //             println!("foo");
+    //
+    //         }
+    //         _ => {}
+    //     }
+    // }
+}
+
+fn main() {
+    let event_loop = EventLoop::new().expect("Failed to create event loop");
+    let mut app = App::new();
+    if let Err(e) = event_loop.run_app(&mut app) {
+        println!("Event loop error: {}", e.to_string())
+    }
 }
 
 fn draw(frame: &mut [u8], cpu: &mut CPU) {

vgfx/src/display.rs

@@ -92,7 +92,7 @@ fn init_palette<P: PeekPoke>(machine: &mut P) {
 }
 
 fn to_byte_address((x, y): (Word, Word), reg: DisplayRegisters) -> Word {
-    let row_start = (y + reg.row_offset % reg.height) * reg.width + reg.screen;
+    let row_start = ((y + reg.row_offset) % reg.height) * reg.width + reg.screen;
     ((x + reg.col_offset) % reg.width) + row_start
 }
 

vlua/src/lib.rs

@@ -5,7 +5,7 @@ use vcore::memory::{PeekPoke, PeekPokeExt};
 use std::iter::FromIterator;
 
 #[mlua::lua_module]
-fn libvlua(lua: &Lua) -> LuaResult<LuaTable> {
+fn libvlua(lua: &Lua) -> LuaResult<LuaTable<'_>> {
     let exports = lua.create_table()?;
     let cpu_constructor = lua.create_function(|_, _: ()| Ok(LuaCPU(CPU::new_random())))?;
     exports.set("new", cpu_constructor)?;

vtest/src/forge_tests.rs

@@ -146,6 +146,53 @@ fn global_test() {
     )
 }
 
+#[test]
+fn peekpoke_test() {
+    // Poke a byte in, peek it back out. Peek / poke only touches one byte at a time
+    assert_eq!(
+        main_return(
+            "fn main() {
+                    poke(0x10000, 0x1010);
+                    return peek(0x10000);
+                }"),
+        0x10
+    )
+}
+
+#[test]
+fn break_test() {
+    // Loop 0..10? Not quite!
+    assert_eq!(
+        main_return(
+            "fn main() {
+                    var n = 0;
+                    while(n < 10) {
+                        n = n + 1;
+                        if (n == 4) { break; }
+                    }
+                    return n;
+                }"),
+        4
+    )
+}
+
+#[test]
+fn continue_test() {
+    // Loop 0..4, but skip 3
+    assert_eq!(
+        main_return(
+            "fn main() {
+                    var n = 0;
+                    repeat(5) i {
+                        if (i == 3) { continue; }
+                        n = n + i;
+                    }
+                    return n;
+                }"),
+        7
+    )
+}
+
 #[test]
 fn static_test() {
     // Because the static(1) returns the same address each time, a[0] is the same variable
@@ -184,6 +231,27 @@ fn static2_test() {
     );
 }
 
+#[test]
+fn once_test() {
+    // A once block.
+    // We pass a pointer in, it increments the var, but only the first time.
+    let src = "
+        fn foo(n) {
+            once {
+                *n = *n + 1;
+            }
+        }
+        fn main() {
+            var n = 0;
+            foo(&n); foo(&n); foo(&n);
+            return n;
+        }";
+    assert_eq!(
+        main_return(src),
+        1
+    );
+}
+
 //#[test]
 // This is no longer cursed, or a test. The revised calling convention with the pool pointer makes
 // it now perfectly sane. Left here for posterity.

vweb/4th/4th.rom.sym

@@ -1 +0,0 @@
-{"$BRNZ":28,"$BRZ":27,"$CALL":25,"$JMP":23,"$JMPR":24,"$PUSH":0,"$RET":26,"$SWAP":20,"advance_entry":1141,"backslash":3276,"close_paren":3267,"close_paren_stub":3275,"compare":1414,"compile_dict_start":3429,"compile_dictionary":4222,"compile_handleword":3150,"compile_instruction":1537,"compile_instruction_arg":1511,"compile_tick":1196,"cr":1067,"cursor":4210,"data_start":3340,"dict_start":3588,"dictionary":4219,"does_at_runtime":2225,"does_word":2196,"dupnz":1074,"dupnz_done":1080,"emit":1025,"emit_cursor":1042,"emit_hook":4228,"end0_pop1":1093,"end0_pop2":1092,"end1_pop2":1096,"eval":1773,"eval_word_buffer":4487,"expected_word_err":3388,"find_in_dict":1149,"find_in_dict_next":1179,"find_word":2584,"handleword_hook":4198,"heap":4195,"heap_start":4618,"hex_is_number":1280,"hex_itoa":1701,"immediate_handleword":3113,"input_number":1595,"invalid_mnemonic":3293,"invalid_mnemonic_str":3353,"is_digit":1084,"is_number":1205,"is_number_hook":4201,"itoa":1618,"itoa_hook":4204,"itoa_loop":1648,"itoa_pos":1637,"itoa_print_loop":1685,"lambda_nesting_level":4216,"lambda_start_ptr":4213,"line_len":4207,"linecomment":3209,"missing_word":3301,"missing_word_str":3340,"mnemonics":2258,"mnemonics_end":2469,"new_dict":1451,"new_dict_error":1497,"nova_asm_to":2563,"nova_bracket_tick":2634,"nova_char":2689,"nova_close_brace":3049,"nova_close_bracket":1998,"nova_colon":2146,"nova_comma":2133,"nova_compile_dotquote":2877,"nova_compile_opcode":2555,"nova_compile_open_brace":3024,"nova_compile_squote":2810,"nova_continue":2007,"nova_create":1946,"nova_dec":2660,"nova_dotquote":2856,"nova_emit":3007,"nova_exit":2099,"nova_here":2579,"nova_hex":2672,"nova_immediate":2105,"nova_immediate_open_brace":3012,"nova_literal":2654,"nova_number":1932,"nova_opcode":2550,"nova_opcode_for_word":2469,"nova_open_bracket":1990,"nova_peekr":2961,"nova_popr":2994,"nova_postpone":2017,"nova_print_stack":2907,"nova_pushr":2981,"nova_quote_string_to":2715,"nova_resolve":1568,"nova_rpick":2969,"nova_safe_opcode":2529,"nova_semicolon":2154,"nova_squote":2780,"nova_tick":2613,"nova_word":1852,"nova_word_to":1902,"nova_word_to_pad":2164,"open_paren":3250,"pad":4231,"parencomment":3211,"parse_hex_digit":1326,"pos_is_number":1234,"pos_is_number_bad":1271,"pos_is_number_done":1276,"pos_is_number_loop":1236,"print":1045,"print_number":1613,"print_stack_end":3426,"print_stack_start":3422,"push_jump":1552,"quit":3317,"quit_vector":4225,"r_stack":4522,"r_stack_ptr":4519,"skip_nonword":1388,"skip_word":1371,"stop":1024,"tick":1187,"unclosed_error":3372,"word_char":1081,"wordeq":1100}

vweb/Cargo.toml

@@ -13,7 +13,8 @@ vcore = { path = "../vcore" }
 vgfx = { path = "../vgfx" }
 vasm_core = { path = "../vasm_core" }
 forge_core = { path = "../forge_core" }
-wasm-bindgen = "0.2"
+novaforth = { path = "../novaforth" }
+wasm-bindgen = "0.2.105"
 serde = { version = "1.0", features = ["derive"] }
 serde-wasm-bindgen = "0.4"
 

vweb/src/forge_editor_demo.html

@@ -9,10 +9,20 @@
 <body>
 <div class="simulator">
     <pre>
+        // Welcome! Press [run] to run this, or write your own!
+        // User manual coming soon
+        // -- ross.andrews@gmail.com
+        const str = "Hello, world!";
+
         fn main() {
+          repeat(1200) n {
+            poke(0x10000 + 1200 + n, 0x6f);
+            poke(0x10000 + n, 0);
+          }
+
           var n = 0;
-          while (n < 40 * 30) {
+          while(peek(str + n)) {
-            asm(72, n + 0x10000) { store }
+            poke(0x10000 + 41 + n, peek(str + n));
             n = n + 1;
           }
         }

vweb/src/forge_highlighter.js

@@ -16,7 +16,7 @@ export default {
             if (word = stream.match(/^[a-zA-Z_$][a-zA-Z0-9_$]*/)) {
                 // This is either a keyword or an identifier.
                 // All the keywords are valid names, so, check that:
-                if (word[0].match(/^fn|var|new|static|asm|return|if|while|repeat|global|const$/)) {
+                if (word[0].match(/^fn|var|new|static|asm|return|if|while|repeat|global|const|peek|poke|break|continue$/)) {
                     if (word[0] === 'asm') {
                         state.asm = true
                     } // This is the start of an asm control structure

vweb/src/forge_simulator.jsx

@@ -11,6 +11,7 @@ export default function({ src: defaultSrc }) {
     const [cpu, setCpu] = useState(() => new WasmCPU()) // The actual CPU emulator
     const [errors, setErrors] = useState(null) // What's displayed on the compile errors tab
     const [status, setStatus] = useState('') // The contents of the status bar
+    const [stale, setStale] = useState(false) // Whether the editor has been changed since the last build
     // Whether the emulator should be running. Has to be a ref because the CPU setTimeout loop won't ever see changes in it otherwise
     const running = useRef(false)
 
@@ -59,6 +60,7 @@ export default function({ src: defaultSrc }) {
     // When we update the src, also update the key in localStorage
     const updateSrc = useCallback((newSrc) => {
         setSrc(newSrc)
+        setStale(true)
         window.localStorage.setItem(currentFile, newSrc)
     }, [currentFile])
 
@@ -71,6 +73,7 @@ export default function({ src: defaultSrc }) {
             setBinary(bin) // Store that
             setStatus(`Compiled ${bin.length} bytes`) // Success!
             setErrors(null) // Clear the old error messages off the tab
+            setStale(false)
             return { bin, errors: null }
         } catch (err) {
             if (err.message) { err = err.message } // How we get this differs between forge and asm
@@ -84,7 +87,7 @@ export default function({ src: defaultSrc }) {
     // Callback for the run button
     const run = useCallback(() => {
         let bin = binary
-        if (!bin) {
+        if (!bin || stale) {
             const result = build()
             if (result.errors) { return }
             else { bin = result.bin }
@@ -105,7 +108,7 @@ export default function({ src: defaultSrc }) {
             }
         }
         setTimeout(time_slice, 0)
-    }, [cpu, binary, running, build])
+    }, [cpu, binary, running, build, stale])
 
     const reset = useCallback(() => {
         running.current = false

vweb/src/nova_forth.rs

@@ -1,3 +1,4 @@
+use novaforth::{PRELUDE, ROM, SYMBOLS};
 use wasm_bindgen::prelude::wasm_bindgen;
 
 #[wasm_bindgen]
@@ -6,11 +7,10 @@ pub struct NovaForth;
 #[wasm_bindgen]
 impl NovaForth {
     pub fn rom() -> Vec<u8> {
-        Vec::from(*include_bytes!("../4th/4th.rom"))
+        Vec::from(ROM)
     }
-
     pub fn symbols() -> String {
-        include_str!("../4th/4th.rom.sym").into()
+        String::from(SYMBOLS)
     }
-    pub fn prelude() -> String { include_str!("../4th/prelude.f").into() }
+    pub fn prelude() -> String { String::from(PRELUDE) }
 }