Moved NovaForth into a crate with a build script

.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.lock

@@ -887,6 +887,14 @@ dependencies = [
  "minimal-lexical",
 ]
 
+[[package]]
+name = "novaforth"
+version = "0.1.0"
+dependencies = [
+ "serde_json",
+ "vasm_core",
+]
+
 [[package]]
 name = "ntapi"
 version = "0.3.7"
@@ -1514,6 +1522,7 @@ name = "vweb"
 version = "0.1.0"
 dependencies = [
  "forge_core",
+ "novaforth",
  "serde",
  "serde-wasm-bindgen",
  "vasm_core",

Cargo.toml

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

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

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

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,6 +13,7 @@ vcore = { path = "../vcore" }
 vgfx = { path = "../vgfx" }
 vasm_core = { path = "../vasm_core" }
 forge_core = { path = "../forge_core" }
+novaforth = { path = "../novaforth" }
 wasm-bindgen = "0.2"
 serde = { version = "1.0", features = ["derive"] }
 serde-wasm-bindgen = "0.4"

vweb/src/lib.rs

@@ -21,4 +21,4 @@ pub fn source_map(snippet: String) -> JsValue {
 #[wasm_bindgen]
 pub fn compile_forge(src: String) -> Result<String, String> {
     build_boot(src.as_str(), true).map(|s| s.join("\n")).map_err(|e| format!("{}", e))
-}
+}

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) }
 }