diff --git a/.idea/vulcan-emu.iml b/.idea/vulcan-emu.iml index 461e447..d3a8661 100644 --- a/.idea/vulcan-emu.iml +++ b/.idea/vulcan-emu.iml @@ -12,6 +12,7 @@ + diff --git a/Cargo.lock b/Cargo.lock index dbd78d5..acc25e9 100644 --- a/Cargo.lock +++ b/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", diff --git a/Cargo.toml b/Cargo.toml index 1776b1a..1a2ad8f 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -9,8 +9,8 @@ members = [ "vlua", "vweb", "vgfx", - "forge_core" -] + "forge_core", + "novaforth"] [profile.test] debug-assertions = false diff --git a/novaforth/Cargo.toml b/novaforth/Cargo.toml new file mode 100644 index 0000000..a91b39d --- /dev/null +++ b/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" diff --git a/novaforth/build.rs b/novaforth/build.rs new file mode 100644 index 0000000..4de844b --- /dev/null +++ b/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 = 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) + } + } +} \ No newline at end of file diff --git a/novaforth/src/4th.asm b/novaforth/src/4th.asm new file mode 100644 index 0000000..b93fc40 --- /dev/null +++ b/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 +; 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: diff --git a/novaforth/src/compiler_utils.asm b/novaforth/src/compiler_utils.asm new file mode 100644 index 0000000..6388238 --- /dev/null +++ b/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 diff --git a/novaforth/src/dict_utils.asm b/novaforth/src/dict_utils.asm new file mode 100644 index 0000000..7ef37b2 --- /dev/null +++ b/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 diff --git a/novaforth/src/dictionary.asm b/novaforth/src/dictionary.asm new file mode 100644 index 0000000..be135b7 --- /dev/null +++ b/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 diff --git a/novaforth/src/in_forth.f b/novaforth/src/in_forth.f new file mode 100644 index 0000000..5d961a2 --- /dev/null +++ b/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 ; diff --git a/novaforth/src/init.asm b/novaforth/src/init.asm new file mode 100644 index 0000000..ed10293 --- /dev/null +++ b/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" diff --git a/novaforth/src/lib.rs b/novaforth/src/lib.rs new file mode 100644 index 0000000..8139d4c --- /dev/null +++ b/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"); diff --git a/novaforth/src/magic.asm b/novaforth/src/magic.asm new file mode 100644 index 0000000..74cb59c --- /dev/null +++ b/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 diff --git a/novaforth/src/numbers.asm b/novaforth/src/numbers.asm new file mode 100644 index 0000000..a93d58c --- /dev/null +++ b/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 diff --git a/vweb/4th/prelude.f b/novaforth/src/prelude.f similarity index 55% rename from vweb/4th/prelude.f rename to novaforth/src/prelude.f index d4b8c60..758e71a 100644 --- a/vweb/4th/prelude.f +++ b/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 ; -: allot here swap &heap +! ; -: negate -1 ^ 1 + ; +: dup2 1 pick 1 pick ; +: allot &heap +! here ; +: negate -1 xor 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 | ; +: 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 ; -: begin here >r ; immediate -: until r> here - $ brz #asm ; immediate \ No newline at end of file +: spaces 0 do space loop ; diff --git a/novaforth/src/string.asm b/novaforth/src/string.asm new file mode 100644 index 0000000..b08f28c --- /dev/null +++ b/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 diff --git a/novaforth/src/test_init.asm b/novaforth/src/test_init.asm new file mode 100644 index 0000000..2cacf41 --- /dev/null +++ b/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 diff --git a/novaforth/src/utils.asm b/novaforth/src/utils.asm new file mode 100644 index 0000000..02737d7 --- /dev/null +++ b/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 diff --git a/vweb/4th/4th.rom b/vweb/4th/4th.rom deleted file mode 100644 index 9797f95..0000000 Binary files a/vweb/4th/4th.rom and /dev/null differ diff --git a/vweb/4th/4th.rom.sym b/vweb/4th/4th.rom.sym deleted file mode 100644 index e21e6b0..0000000 --- a/vweb/4th/4th.rom.sym +++ /dev/null @@ -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} \ No newline at end of file diff --git a/vweb/Cargo.toml b/vweb/Cargo.toml index 0642808..b523bc1 100644 --- a/vweb/Cargo.toml +++ b/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" diff --git a/vweb/src/lib.rs b/vweb/src/lib.rs index 14e1f2c..5946e9b 100644 --- a/vweb/src/lib.rs +++ b/vweb/src/lib.rs @@ -21,4 +21,4 @@ pub fn source_map(snippet: String) -> JsValue { #[wasm_bindgen] pub fn compile_forge(src: String) -> Result { build_boot(src.as_str(), true).map(|s| s.join("\n")).map_err(|e| format!("{}", e)) -} \ No newline at end of file +} diff --git a/vweb/src/nova_forth.rs b/vweb/src/nova_forth.rs index cf2d14f..717b836 100644 --- a/vweb/src/nova_forth.rs +++ b/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 { - 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) } }