randrews/vulcan
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Moved NovaForth into a crate with a build script

Browse Source
This commit is contained in:
Ross Andrews
2024-08-11 21:08:21 -05:00
parent bd54ae1ef0
commit 98c95b55f4
23 changed files with 2209 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.idea/vulcan-emu.iml
Generated
+1
View File
@@ -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
Generated
+9
View File
@@ -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
+2 -2
View File
@@ -9,8 +9,8 @@ members = [
"vlua",
"vweb",
"vgfx",
"forge_core"
]
"forge_core",
"novaforth"]
[profile.test]
debug-assertions = false
novaforth/Cargo.toml
+8
View File
@@ -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
+38
View File
@@ -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
+868
View File
@@ -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
+85
View File
@@ -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
+70
View File
@@ -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
+351
View File
@@ -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
+115
View File
@@ -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
+287
View File
@@ -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
+8
View File
@@ -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
+9
View File
@@ -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
+106
View File
@@ -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
vweb/4th/prelude.f → novaforth/src/prelude.f
+19 -11
View File
@@ -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
: spaces 0 do space loop ;
novaforth/src/string.asm
+168
View File
@@ -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
+6
View File
@@ -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
+53
View File
@@ -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
BIN
View File
Binary file not shown.
vweb/4th/4th.rom.sym
-1
View File
@@ -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
+1
View File
@@ -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
+1 -1
View File
@@ -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
+4 -4
View File
@@ -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) }
}