commit cb3cf75cb1b204679c9a679108866ab94624dbf8
parent a51e3023252990a63e7edd8c406b46abc739a307
Author: Christian Ermann <christianermann@gmail.com>
Date: Mon, 18 Nov 2024 17:17:46 -0800
Refactor build scripts to support building with or without Docker
Diffstat:
10 files changed, 1414 insertions(+), 1363 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,3 @@
+bin/*
+obj/*
+*.qcow2
diff --git a/Dockerfile b/Dockerfile
@@ -1,4 +1,4 @@
-FROM debian:stable-slim as build-tools
+FROM debian:stable-slim AS build-toolchain
RUN apt-get update && apt-get -y upgrade && \
apt-get --no-install-recommends -y install \
@@ -35,28 +35,23 @@ RUN ./configure --prefix=/opt/riscv
RUN make
WORKDIR "/"
-FROM build-tools as build
-
-ENV PATH="$PATH:/opt/riscv/bin"
-COPY ns16550a.s .
-COPY forth.s .
-COPY forth.f .
-COPY riscv32-virt.ld .
-RUN riscv64-unknown-elf-gcc -ggdb -static -nostdlib -nostdinc -nostartfiles -x assembler-with-cpp -march=rv32im -mabi=ilp32 -T riscv32-virt.ld -o forth.elf ns16550a.s forth.s
-
-FROM build-tools as run-base
+FROM build-toolchain AS install-tools
RUN apt-get update && apt-get -y upgrade && \
apt-get --no-install-recommends -y install \
- device-tree-compiler \
- qemu-system-misc
+ qemu-system-misc \
+ qemu-utils
-FROM run-base as run
+FROM install-tools AS build
-COPY --from=build forth.elf forth.elf
ENV PATH="$PATH:/opt/riscv/bin"
-#RUN qemu-system-riscv32 -machine virt -machine dumpdtb=riscv32-virt.dtb -bios none
-#RUN dtc -I dtb -O dts -o riscv32-virt.dts riscv32-virt.dtb
-CMD ["qemu-system-riscv32", "-gdb", "tcp::1234", "-nographic", "-bios", "none", "-machine", "virt", "-kernel", "forth.elf"]
-#CMD ["/bin/sh"]
+WORKDIR "/forth-riscv"
+COPY Makefile .
+COPY src src/
+COPY disk0.qcow[2] .
+RUN make
+
+FROM build AS run
+COPY run .
+CMD ["./run"]
diff --git a/Makefile b/Makefile
@@ -1,4 +1,46 @@
-all:
+CC := riscv64-unknown-elf-gcc
+
+CPPFLAGS := -x assembler-with-cpp
+CFLAGS := -Wall -ggdb -mcmodel=medany -march=rv32im -mabi=ilp32
+LDFLAGS := -static -nostartfiles
+
+SRC_DIR := src
+OBJ_DIR := obj
+BIN_DIR := bin
+
+KERNEL_SRC := $(wildcard $(SRC_DIR)/*.s)
+KERNEL_OBJ := $(KERNEL_SRC:$(SRC_DIR)/%.s=$(OBJ_DIR)/%.o)
+KERNEL_ELF := $(BIN_DIR)/forth.elf
+
+BOARD := riscv32-virt
+LINK_SCRIPT := $(SRC_DIR)/$(BOARD).ld
+
+DISK := disk0.qcow2
+
+.PHONY: all clean docker run
+
+all: clean $(KERNEL_ELF) $(DISK)
+
+docker:
+ docker stop forth-repl || true
docker build . --tag forth-riscv32
docker image prune -f
- docker run --interactive --rm forth-riscv32
+ docker run --name forth-repl --interactive --rm forth-riscv32
+
+run: $(KERNEL_ELF) $(DISK)
+ ./run
+
+$(KERNEL_ELF): $(KERNEL_OBJ) | $(BIN_DIR)
+ $(CC) $(LDFLAGS) -T $(LINK_SCRIPT) $(KERNEL_OBJ) -o $@
+
+$(OBJ_DIR)/%.o: $(SRC_DIR)/%.s | $(OBJ_DIR)
+ $(CC) $(CPPFLAGS) $(CFLAGS) -c $< -o $@
+
+$(BIN_DIR) $(OBJ_DIR):
+ mkdir -p $@
+
+$(DISK):
+ qemu-img create -f qcow2 $@ 256M
+
+clean:
+ @$(RM) -rv $(BIN_DIR) $(OBJ_DIR)
diff --git a/forth.s b/forth.s
@@ -1,1314 +0,0 @@
-.option norelax
-
-.extern uart_put_char
-.extern uart_get_char
-.extern uart_put_string
-
-#define w a0
-#define x a1
-#define y a2
-#define ip s1
-#define psp sp
-#define rsp s2
-
-#define cell 4
-#define dcell 8
-
-#define link_offset 0
-#define hash_offset 4
-#define meta_offset 8
-#define flag_offset 12
-#define code_offset 16
-
-#define load_cell lw
-#define store_cell sw
-
-.equ state_immediate, 0
-.equ state_compile, 1
-
-.equ flag_hidden, 0x20
-.equ flag_immediate, 0x40
-
-.macro next
- ret
-.endm
-
-.macro push_addr addr
- push w
- la w, \addr
-.endm
-
-.macro push_imm imm
- push w
- li w, \imm
-.endm
-
-.macro push reg
- store_cell \reg, -cell(psp)
- addi psp, psp, -cell
-.endm
-
-.macro pop reg
- load_cell \reg, 0(psp)
- addi psp, psp, cell
-.endm
-
-.macro push_ret reg
- store_cell \reg, -cell(rsp)
- addi rsp, rsp, -cell
-.endm
-
-.macro pop_ret reg
- load_cell \reg, 0(rsp)
- addi rsp, rsp, cell
-.endm
-
-
-.macro this_link
- .globl link_\+
-link_\+:
-.endm
-
-.macro prev_link
- .int link_\+
-.endm
-
-.macro link
- this_link
- prev_link
-.endm
-
-this_link
-
-.macro defhead name, label, hash, code, flags=0
- .section ".rodata"
- .balign cell
- .globl name_\label
-name_\label:
- link
- .int \hash
- .int meta_\label
- .byte \flags
-
- .balign cell
- .globl code_\label
-code_\label:
- .int \label
-
- .section ".text"
- .balign cell
- .globl \label
-\label:
-.endm
-
-.macro defmeta name, label
- .section ".rodata.meta"
- .global meta_\label
-meta_\label:
- .byte length_\@
-1:
- .ascii "\name"
- .equ length_\@, . - 1b
-.endm
-
-.macro defcode name, label, hash, flags=0
- defmeta "\name", \label
- defhead "\name", \label, \hash, code_\label, flags=\flags
-.endm
-
-.macro defword name, label, hash, flags=0
- defmeta "\name", \label
- defhead "\name", \label, \hash, docol, flags=\flags
- docol
-.endm
-
-.macro defvar name, label, hash, flags=0, initial=0
- defmeta "\name", \label
- defhead "\name", \label, \hash, dovar, flags=\flags
- push_ret ra
- jal dovar
- .globl _\label
-_\label:
-.endm
-
-.macro defconst name, label, hash, flags=0, value=0
- defmeta "\name", \label
- defhead "\name", \label, \hash, docon, flags=\flags
- push_ret ra
- jal docon
- .globl _\label
-_\label:
-.endm
-
-.macro docol
- push_ret ra
-.endm
-
-.macro exit
- pop_ret ra
- ret
-.endm
-
-dovar:
- push w
- mv w, ra
- pop_ret ra
- ret
-
-docon:
- push w
- load_cell w, 0(ra)
- pop_ret ra
- ret
-
-dodoes:
- push_ret ip # save old ip
- addi w, w, cell # make w point to parameter field
- push w # push w onto param. stack
- mv ip, ra # set new ip
- next
-
-defcode "break", break, 0xC9648178
- next
-
-# -----------------------------------------------------------------------------
-# constants and variables
-# -----------------------------------------------------------------------------
-
-defconst "sp0", sp_top, 0x0C41B8B2
- .int __stacktop
-
-defconst "rp0", rp_top, 0x8AD91EDD
- .int __stacktop_ret
-
-defconst "bl", bl, 0x412BAEAB
- .int 0x20
-
-defvar "state", state, 0x783132F6
- .int state_immediate
-
-defvar "dp", dp, 0x491CB0B9
- .int __here_start
-
-defvar "latest", latest, 0x41704246
- .int name_read_line
-
-defvar "base", base, 0x3DDC94D8
- .int 10
-
-defvar "delimiter", delimiter, 0x6C15B5FA
- .int 0x20 # space
-
-defvar "'source", tick_source, 0xEB4FEC0B
- .int 0 # length
- .int 0 # address
-
-defvar "source-offset", source_offset, 0x7F8C1674
- .int 0
-
-defvar "source-id", source_id, 0x965ED1E2
- .int 0
-
-# -----------------------------------------------------------------------------
-# input and output
-# -----------------------------------------------------------------------------
-
-defcode "type", type, 0x5127F14D
- mv x, w
- pop w
- push_ret ra
- jal uart_put_string
- pop_ret ra
- pop w
- next
-
-defcode "emit", emit, 0x2D88474A
- jal uart_put_char
- pop w
- next
-
-defcode "key", key, 0x6815C86C
- jal uart_get_char
- next
-
-defcode "accept", accept, 0x08247E29
- pop x # address
- push_ret ra
- jal accept_impl
- pop_ret ra
- next
-
-accept_impl:
- push_ret ra
- mv s4, w
- mv s5, w
- beqz s5, 2f
- li s6, 0x0A # '\n'
- li s7, 0x0D # '\r'
-1:
- push x
- jal uart_get_char
- pop x
- beq w, s6, 2f
- beq w, s7, 2f
- sb w, 0(x)
- addi x, x, 1
- addi s5, s5, -1
- bnez s5, 1b
-2:
- sub w, s4, s5
- pop_ret ra
- ret
-
-defword "refill", refill, 0x238BAA91
- jal source_id
- jal fetch
- jal q_branch
- .int _refill_tib
-_refill_fib:
- jal fib
- jal read_line
- jal q_branch
- .int _refill_failed
- jal fib
- jal drop
- jal swap
- jal branch
- .int _refill_success
-_refill_tib:
- jal tib
- jal accept
- jal dup
- jal q_branch
- .int _refill_failed
- jal tib
- jal drop
- jal swap
-_refill_success:
- jal tick_source
- jal two_store
- jal lit
- .int 0
- jal source_offset
- jal store
- jal lit
- .int -1
- exit
-_refill_failed:
- jal drop
- jal lit
- .int 0
- exit
-
-defword "source", source, 0x1BCF29D8
- jal tick_source
- jal two_fetch
- exit
-
-defcode "tib", tib, 0xC90B0194
- # ( -- addr len )
- push w
- la w, _tib
- push w
- la w, _tib_len
- load_cell w, 0(w)
- next
-
-defcode "fib", fib, 0xBCE49236
- # ( -- addr len )
- push w
- la w, _fib
- push w
- la w, _fib_len
- load_cell w, 0(w)
- next
-
-defword "skip-while", skip_while, 0xBBFD4B86
- # ( addr1 len1 -- addr2 len2 )
-_skip_while_loop:
- jal dup
- jal q_branch
- .int _skip_while_done
- jal over
- jal char_fetch
- jal delimiter
- jal fetch
- jal equal
- jal q_branch
- .int _skip_while_done
- jal lit
- .int 1
- jal apply_offset
- jal branch
- .int _skip_while_loop
-_skip_while_done:
- exit
-
-defword "skip-until", skip_until, 0x661A5D67
- # ( addr1 len1 -- addr2 len2 )
-_skip_until_loop:
- jal dup
- jal q_branch
- .int _skip_until_done
- jal over
- jal char_fetch
- jal delimiter
- jal fetch
- jal not_equal
- jal q_branch
- .int _skip_until_done
- jal lit
- .int 1
- jal apply_offset
- jal branch
- .int _skip_until_loop
-_skip_until_done:
- exit
-
-defword "apply-offset", apply_offset, 0x605143A5
- # ( addr1 len1 offset -- addr2 len2 )
- jal tuck
- jal minus
- jal to_ret
- jal plus
- jal from_ret
- exit
-
-defword "parse-offset", parse_offset, 0x9E5C3F80
- # ( addr1 len1 -- offset )
- jal lit
- .int 1
- jal min
- jal plus
- jal source
- jal drop
- jal minus
- exit
-
-defword "parse", parse, 0x423B42EC
- jal delimiter
- jal store
- jal source
- jal source_offset
- jal fetch
- jal apply_offset
- jal skip_while
- jal over
- jal to_ret
- jal skip_until
- jal two_dup
- jal parse_offset
- jal source_offset
- jal store
- jal drop
- jal from_ret
- jal tuck
- jal minus
- exit
-
-defword "parse-word", parse_word, 0xB218226F
- jal bl
- jal parse
- exit
-
-defcode ">number", to_number, 0x2F770E4C
- mv x, w
- pop w
- mv y, zero # initial value
- mv s3, zero # sign flag
- la s4, _base
- load_cell s4, 0(s4)
-
- beqz x, _to_number_empty_string
-
- lb t0, 0(w)
- addi w, w, 1
- addi x, x, -1
- li t1, 0x2D # '-'
- bne t0, t1, _to_number_digit_value
- addi s3, s3, -1
- bnez x, _to_number_loop
-
-_to_number_empty_string:
- addi x, x, -1
- j _to_number_done
-
-_to_number_invalid:
- addi x, x, 1
- j _to_number_sign
-
-_to_number_loop:
- mul y, y, s4
- lb t0, 0(w)
- addi w, w, 1
- addi x, x, -1
-
-_to_number_digit_value:
- addi t0, t0, -48
- bltz t0, _to_number_invalid
- addi t1, t0, -10
- bltz t1, _to_number_base
- addi t0, t0, -7
- addi t1, t0, -10
- bltz t1, _to_number_invalid
-
-_to_number_base:
- bgt t0, s4, _to_number_invalid
- add y, y, t0
- bnez x, _to_number_loop
-
-_to_number_sign:
- beqz s3, _to_number_done
- neg y, y
-
-_to_number_done:
- push y
- mv w, x
- next
-
-defcode "word>hash", word_to_hash, 0x50E0A245
- load_cell w, hash_offset(w)
- next
-
-defword "find", find, 0xBDF0855A
- jal hash
- jal latest
- jal fetch
-_find_loop:
- jal dup
- jal zero_equal
- jal q_branch
- .int _find_check_hidden
- jal swap
- jal drop
- exit
-_find_check_hidden:
- jal dup
- jal hidden_q
- jal zero_equal
- jal q_branch
- .int _find_next_word
-_find_check_hash:
- jal two_dup
- jal word_to_hash
- jal equal
- jal q_branch
- .int _find_next_word
- jal swap
- jal drop
- exit
-_find_next_word:
- jal fetch
- jal branch
- .int _find_loop
-
-defcode ">cfa", to_cfa, 0x8CAC3233
- addi w, w, code_offset
- next
-
-defcode "execute", execute, 0xA01E3D98
- load_cell x, 0(w)
- pop w
- jr x
- # 'next' should be called by the executed word
-
-defword "interpret", interpret, 0x1F98C57A
-_interpret_start:
- jal parse_word
- beqz w, _interpret_parse_area_empty
- jal two_dup
- jal find
- beqz w, _interpret_word_not_found
-_interpret_word_found:
- addi psp, psp, 2 * cell # nip, nip
- addi w, w, code_offset
- load_cell w, 0(w)
- # compiling?
- la x, _state
- load_cell x, 0(x)
- beqz x, _interpret_execute_word
- # immediate?
- addi x, w, flag_offset - code_offset
- lb x, 0(x)
- andi x, x, flag_immediate
- bnez x, _interpret_execute_word
-_interpret_compile_word:
- jal jal_to
- jal comma
- j _interpret_start
-_interpret_execute_word:
- mv x, w
- pop w
- jalr x
- j _interpret_start
-_interpret_word_not_found:
- pop w
- jal to_number
- bnez w, _interpret_retry
- pop w
- # compiling?
- la x, _state
- load_cell x, 0(x)
- beqz x, _interpret_start
-_interpret_compile_number:
- jal lit
- .int lit
- jal comma
- jal comma
- j _interpret_start
-_interpret_retry:
- addi psp, psp, cell
- load_cell w, 0(psp)
- j _interpret_start
-_interpret_parse_area_empty:
- addi psp, psp, cell
- pop w
- exit
-
-defword "evaluate", evaluate, 0xACE4360A
- jal lit
- .int 1
- jal source_id
- jal store
-_evaluate_loop:
- jal refill
- jal q_branch
- .int _evaluate_done
- jal interpret
- jal branch
- .int _evaluate_loop
-_evaluate_done:
- jal lit
- .int 0
- jal source_id
- jal store
- exit
-
-defcode "branch", branch, 0xB6873945
- load_cell ra, 0(ra)
- next
-
-defcode "?branch", q_branch, 0x6AF3C1DE
- bnez w, _branch_done
- pop w
- load_cell ra, 0(ra)
- next
-_branch_done:
- pop w
- addi ra, ra, cell
- next
-
-defcode "prompt", prompt, 0xDFE6493B
- push w
- la w, _prompt
- la x, _prompt_len
- push_ret ra
- call uart_put_string
- pop_ret ra
- pop w
- next
-
-defcode "okay", okay, 0xBA9EEB49
- push w
- la w, _okay
- la x, _okay_len
- push_ret ra
- call uart_put_string
- pop_ret ra
- pop w
- next
-
-defword "quit", quit, 0x47878736
- jal rp_top
- jal rp_store
- jal prompt
- jal refill
- jal drop # TODO: What should happen when 'refill' fails?
- jal interpret
- jal okay
- jal branch
- .int quit
-
-defword "abort", abort, 0xA52BCAF9
- jal sp_top
- jal sp_store
- jal quit
-
-# -----------------------------------------------------------------------------
-# memory access
-# -----------------------------------------------------------------------------
-
-defcode "!", store, 0x240C8DEC
- pop x
- store_cell x, 0(w)
- pop w
- next
-
-defcode "@", fetch, 0xC50BF85F
- load_cell w, 0(w)
- next
-
-defcode "c!", char_store, 0x9829F909
- pop x
- sb x, 0(w)
- pop w
- next
-
-defcode "c@", char_fetch, 0x37296056
- lb w, 0(w)
- next
-
-defcode "2!", two_store, 0x9CF2B11C
- pop x
- pop y
- store_cell x, 0(w)
- store_cell y, cell(w)
- pop w
- next
-
-defcode "2@", two_fetch, 0x3DF21B8F
- load_cell y, cell(w)
- load_cell w, 0(w)
- push y
- next
-
-defcode "+!", add_store, 0x08DC01D1
- pop x
- load_cell y, 0(w)
- add y, y, x
- store_cell y, 0(w)
- pop w
- next
-
-defcode "-!", sub_store, 0x24CD235B
- pop x
- load_cell y, 0(w)
- sub y, y, x
- store_cell y, 0(w)
- pop w
- next
-
-defcode "cells", cells, 0xD94ACBB2
- li x, cell
- mul w, w, x
- next
-
-defcode "cell+", cell_plus, 0xB14A8CBA
- addi w, w, cell
- next
-
-# -----------------------------------------------------------------------------
-# dictionary management
-# -----------------------------------------------------------------------------
-
-defword "here", here, 0x213B65CB
- jal dp
- jal fetch
- exit
-
-defcode "lit", lit, 0x404CD5B6
- push w
- load_cell w, 0(ra)
- addi ra, ra, cell
- next
-
-defcode "lit-string", lit_string, 0xC7BE567C # TODO: ip -> ra, w=tos
- load_cell x, 0(ip) # len
- addi ip, ip, cell
- mv w, ip # addr
- add ip, ip, x
- # re-align ip
- addi ip, ip, cell - 1
- andi ip, ip, -cell
- push w
- push x
- next
-
-defword "allot", allot, 0xADB1A69F
- jal dp
- jal add_store
- exit
-
-defcode ",", comma, 0x290C95CB
- la y, _dp
- load_cell x, 0(y)
- store_cell w, 0(x)
- addi x, x, cell
- store_cell x, 0(y)
- pop w
- next
-
-defcode "c,", char_comma, 0xA32A0A5A
- la y, _dp
- load_cell x, 0(y)
- sb w, 0(x)
- addi x, x, 1
- store_cell x, 0(y)
- pop w
- next
-
-defword "align", align, 0x602C63DE
- jal dp
- jal dup
- jal fetch
- jal lit
- .int 3
- jal plus
- jal lit
- .int -4
- jal and_
- jal swap
- jal store
- exit
-
-# -----------------------------------------------------------------------------
-# stack manipulation
-# -----------------------------------------------------------------------------
-
-defcode "sp@", sp_fetch, 0xFC419F82
- # ( -- addr )
- push w
- mv w, psp
- next
-
-defcode "sp!", sp_store, 0x1D41D375
- # ( addr -- )
- mv psp, w
- pop w
- next
-
-defcode "rp@", rp_fetch, 0x7AD905AD
- # ( -- addr )
- push w
- mv w, rsp
- next
-
-defcode "rp!", rp_store, 0x99D9367A
- # ( addr -- )
- mv rsp, w
- pop w
- next
-
-defcode ">r", to_ret, 0x47FCB8A9
- push_ret w
- pop w
- next
-
-defcode "r>", from_ret, 0x135408B1
- push w
- pop_ret w
- next
-
-defcode "2>r" two_to_ret, 0x69F5D439
- pop x
- push_ret x
- push_ret w
- pop w
- next
-
-defcode "2r>", two_from_ret, 0xB54DEDC1
- push w
- pop_ret w
- pop_ret x
- push x
- next
-
-defcode "dup", dup, 0xD330F226
- push w
- load_cell w, 0(psp)
- next
-
-defcode "?dup", q_dup, 0xFD2928D3
- beqz w, _q_dup_done
- push w
-_q_dup_done:
- next
-
-defcode "swap", swap, 0x64ED874E
- load_cell x, 0(psp)
- store_cell w, 0(psp)
- mv w, x
- next
-
-defcode "drop", drop, 0xA9A58D8C
- pop w
- next
-
-defcode "over", over, 0x31F6520F
- push w
- load_cell w, cell(psp)
- next
-
-defcode "nip", nip, 0x21A41868
- addi psp, psp, cell
- next
-
-defcode "tuck", tuck, 0x8E26FCE8
- load_cell x, 0(psp)
- store_cell w, 0(psp)
- push x
- next
-
-defcode "2dup", two_dup, 0x5E46F4D6
- load_cell x, 0(psp)
- push w
- push x
- next
-
-defcode "2drop", two_drop, 0xECFD129C
- addi psp, psp, cell
- pop w
- next
-
-# -----------------------------------------------------------------------------
-# math and logic
-# -----------------------------------------------------------------------------
-
-defcode "+", plus, 0x2E0C9DAA
- pop x
- add w, x, w
- next
-
-defcode "-", minus, 0x280C9438
- pop x
- sub w, x, w
- next
-
-defcode "*", times, 0x2F0C9F3D
- pop x
- mul w, x, w
- next
-
-defcode "or", or_, 0x5D342984
- pop x
- or w, x, w
- next
-
-defcode "and", and_, 0x0F29C2A6
- pop x
- and w, x, w
- next
-
-defcode "lshift", lshift, 0x8DA53719
- pop x
- sll w, x, w
- next
-
-defcode "rshift", rshift, 0x86294EF7
- pop x
- srl w, x, w
- next
-
-defcode "ashift", ashift, 0x46A0EC68
- pop x
- sra w, x, w
- next
-
-defcode "aligned", aligned, 0xC73174DF
- addi w, w, cell - 1
- andi w, w, -cell
- next
-
-# -----------------------------------------------------------------------------
-# comparison
-# -----------------------------------------------------------------------------
-
-defcode "0=", zero_equal, 0x14ED5DD6
- mv x, zero
- bnez w, _zero_done
- addi x, x, -1
-_zero_done:
- mv w, x
- next
-
-defcode "=", equal, 0x380CAD68
- pop x
- beq w, x, _equal
- mv w, zero
- next
-_equal:
- li w, -1
- next
-
-defcode "<>", not_equal, 0x93F7201F
- pop x
- bne w, x, _not_equal
- mv w, zero
- next
-_not_equal:
- li w, -1
- next
-
-defcode ">", greater_than, 0x3B0CB221
- pop x
- bgt x, w, _greater_than
- mv w, zero
- next
-_greater_than:
- li w, -1
- next
-
-defcode "<", less_than, 0x390CAEFB
- pop x
- blt x, w, _less_than
- mv w, zero
- next
-_less_than:
- li w, -1
- next
-
-defcode "min", min, 0xC98F4557
- pop x
- bgt x, w, _min_greater_than
- mv w, x
-_min_greater_than:
- next
-
-# -----------------------------------------------------------------------------
-# compiler
-# -----------------------------------------------------------------------------
-
-defcode "jal-immed", jal_immed, 0xA914EF13
- # encode a value as an immediate for a 'jal' instruction
- mv x, w
- li y, 0x000FF000 # imm[19:12]
- and w, x, y
- li y, 0x00100000 # imm[20]
- and y, x, y
- slli y, y, 11
- add w, w, y
- li y, 0x00000800 # imm[11]
- and y, x, y
- slli y, y, 9
- add w, w, y
- andi y, x, 0x000007FE # imm[10:1]
- slli y, y, 20
- add w, w, y
- next
-
-defword "jal-to", jal_to, 0xC38EF054
- # generate a 'jal ra, addr' instruction
- la x, _dp
- load_cell x, 0(x)
- sub w, w, x
- jal jal_immed
- addi w, w, 0x000000EF # jal ra, imm
- exit
-
-defword "jal-dovar", jal_dovar, 0x668658A5
- # generate a 'jal ra, dovar' instruction
- push w
- la w, dovar
- jal jal_to
- exit
-
-defword "dovar,", dovar_comma, 0x1F514E5B
- jal jal_dovar
- jal comma
- exit
-
-defword "docol,", docol_comma, 0xFAE1EE9E
- push w
- li w, 0xFE192E23 # sw ra, -4(s2)
- jal comma
- push w
- li w, 0xFFC90913 # addi s2, s2, -4
- jal comma
- exit
-
-defword "exit,", exit_comma, 0xD540F80B
- push w
- li w, 0x00092083 # lw ra, 0(s2)
- jal comma
- push w
- li w, 0x00490913 # addi s2, s2, 4
- jal comma
- push w
- li w, 0x00008067 # ret
- jal comma
- exit
-
-defword "create", create, 0x26BB595D
- jal parse_word
- jal latest # link
- jal fetch
- jal comma
- jal hash # hash
- jal comma
- push_imm 0 # meta
- jal comma
- push_imm 0 # flags
- jal char_comma
- jal align
- # update latest
- la x, _dp
- load_cell x, 0(x)
- addi x, x, -code_offset
- la y, _latest
- store_cell x, 0(y)
- # code field
- la x, _dp
- load_cell y, 0(x)
- addi y, y, cell
- store_cell y, -cell(y)
- store_cell y, 0(x)
- # append 'dovar'
- jal dovar_comma
- exit
-
-defcode "hash", hash, 0xEDBF0FE3
- mv x, w
- pop w
- push_ret ra
- jal hash_impl
- pop_ret ra
- next
-
-hash_impl: # 32-bit fnv1a
- li t0, 2166136261 # hash
- li t1, 16777619 # prime
-_hash_char:
- lb t2, 0(w)
- addi w, w, 1
- addi x, x, -1
- xor t0, t0, t2
- mul t0, t0, t1
- bgtz x, _hash_char
- mv w, t0
- ret
-
-defcode "[", l_bracket, 0xDE0C1FBA, flags=flag_immediate
- la x, _state
- li y, state_immediate
- store_cell y, 0(x)
- next
-
-defcode "]", r_bracket, 0xD80C1648
- la x, _state
- li y, state_compile
- store_cell y, 0(x)
- next
-
-defcode "hidden", hidden, 0xF618F139
- addi w, w, flag_offset
- lb x, 0(w)
- xori x, x, flag_hidden
- sb x, 0(w)
- pop w
- next
-
-defcode "hidden?", hidden_q, 0x6F436C72
- addi w, w, flag_offset
- lb w, 0(w)
- andi w, w, flag_hidden
- next
-
-defword ":", colon, 0x3F0CB86D
- jal create # create header
- push_imm -cell
- jal allot
- jal docol_comma # append 'docol'
- jal latest
- jal fetch
- jal hidden # hide word
- jal r_bracket # enter 'compile' mode
- exit
-
-defword ";", semicolon, 0x3E0CB6DA, flags=flag_immediate
- jal exit_comma
- jal latest
- jal fetch
- jal hidden
- jal l_bracket
- exit
-
-defcode "compiling?", compiling_q, 0x94652AE2
- la w, _state
- load_cell w, 0(w)
- andi w, w, state_compile
- push w
- next
-
-defcode "immediate?", immediate_q, 0x89F23E9F
- pop w
- addi w, w, flag_offset - code_offset
- lb w, 0(w)
- andi w, w, flag_immediate
- push w
- next
-
-# TODO: everything after this needs updated to work with subroutine threading
-# and with w=tos
-
-defword "postpone", postpone, 0x933F531F, flags=flag_immediate
- .int parse_word, find # TODO: was word actually found?
- .int to_cfa, dup
- .int immediate_q, q_branch, _postpone_compile
-_postpone_execute:
- # stores "<xt>" into the current definition
- #.int comma, exit
-_postpone_compile:
- # stores "lit <xt> ," into the current definition
- #.int lit, lit, comma, comma, lit, comma, comma, exit
-
-defword "immediate", immediate, 0xF232267A
- .int latest, fetch, lit, flag_offset, plus, dup
- .int fetch, lit, flag_immediate, or_
- .int swap, store
- exit
-
-defword "variable", variable, 0x19385305
- .int create # create header
- .int lit, 0, comma # initialize to zero
- exit
-
-defword "constant", constant, 0x0691EA25
- .int create # create header
- .int lit, -cell, allot
- #.int lit, docon, comma # append 'docon'
- .int comma # initialize to value on stack
- exit
-
-defcode "jal-dodoes", jal_dodoes, 0x4F82E787
- pop w
- la x, dodoes
- sub x, x, w
- li y, 0x000FF000 # imm[19:12]
- and w, x, y
- li y, 0x00100000 # imm[20]
- and y, x, y
- slli y, y, 11
- add w, w, y
- li y, 0x00000800 # imm[11]
- and y, x, y
- slli y, y, 9
- add w, w, y
- andi y, x, 0x000007FE # imm[10:1]
- slli y, y, 20
- add w, w, y
- addi w, w, 0x000000EF # jal ra, imm
- push w
- next
-
-defword ";does", does, 0xF5BCD777, flags=flag_immediate
- .int lit, does_internal, comma
- .int here, jal_dodoes, comma
- exit
-
-defword "(;does)", does_internal, 0xED4B7678
- .int from_ret
- .int latest, fetch, lit, code_offset, plus, store
- exit
-
-defcode "read-char", read_char, 0xF07E2044
- jal _read_char_impl
- push w
- next
-
-_read_char_impl:
- la w, _bootstrap
- load_cell w, 0(w)
- la x, _bootstrap_len
- load_cell x, 0(x)
- sub x, x, w
- la y, _bootstrap_offset
- load_cell y, 0(y)
- add w, w, y
- sub x, x, y
- beqz x, _read_char_eof
-
- lb w, 0(w)
- addi y, y, 1
- la x, _bootstrap_offset
- store_cell y, 0(x)
- ret
-_read_char_eof:
- mv w, zero
- ret
-
-defword "buffer-open", buffer_open, 0x79AAD9CA
- # ( addr len -- addr end-addr cur-addr )
- .int over, plus, over
- exit
-
-defword "buffer-close", buffer_close, 0x42B7429E
- # ( open-buffer -- len )
- .int nip, swap, minus
- exit
-
-defword "buffer-emit", buffer_emit, 0xEA240555
- # ( open-buffer char -- open-buffer )
- .int over, store, lit, 1, plus
- exit
-
-defword "buffer-full?", buffer_full_q, 0x070A2E6C
- # ( open-buffer -- flag )
- .int two_dup, greater_than # TODO: >=
- exit
-
-defword "read-line", read_line, 0xAF1308A2
- .int buffer_open
-_read_line_loop:
- .int read_char
- .int dup, lit, 0x0A, not_equal, q_branch, _read_line_newline
- .int dup, lit, 0x00, not_equal, q_branch, _read_line_eof
- .int buffer_emit
- .int buffer_full_q, q_branch, _read_line_buffer_full
- .int branch, _read_line_loop
-_read_line_newline:
- #.int drop, buffer_close, lit, -1, exit
-_read_line_eof:
- .int drop, buffer_close, dup, q_branch, _read_line_eof_fail
- #.int lit, -1, exit
-_read_line_eof_fail:
- #.int lit, 0, exit
-_read_line_buffer_full:
- #.int buffer_close, lit, 0, exit
-
-.section ".text"
-program:
- jal type
- jal quit
-
-.section ".rodata"
-version_string:
- .ascii "soup forth rv32\n"
- version_string_len = (. - version_string)
-
-_prompt:
- .ascii "> "
- _prompt_len = (. - _prompt)
-
-_okay:
- .ascii "ok\n"
- _okay_len = (. - _okay)
-
-word_buffer: .space 255
-.balign cell
-_meta: .int __meta_start
-
-_bootstrap: .int __file_start
-_bootstrap_len: .int __file_len
-_bootstrap_offset: .int 0
-
-_tib: .space 255
-_tib_len: .int 255
-
-_fib: .space 255
-_fib_len: .int 255
-
-.section ".text.boot"
-start:
- la psp, __stacktop
- la rsp, __stacktop_ret
- la ip, program
- li w, 0xDEADC0DE
-
- push_addr version_string
- push_imm version_string_len
-
- push_addr version_string
- push_imm version_string_len
-
- jal program
-
diff --git a/riscv32-virt.ld b/riscv32-virt.ld
@@ -1,28 +0,0 @@
-
-TARGET(binary)
-INPUT("forth.f")
-
-OUTPUT_FORMAT("elf32-littleriscv", "elf32-littleriscv", "elf32-littleriscv")
-OUTPUT_ARCH(riscv)
-ENTRY(start)
-
-MEMORY {
- RAM (rwx) : ORIGIN = 0x80000000, LENGTH = 128M
-}
-
-SECTIONS {
- __stacksize = 256;
- __stacktop = ORIGIN(RAM) + LENGTH(RAM);
- __stacktop_ret = __stacktop - __stacksize;
-
- . = ORIGIN(RAM);
- .text : { *(.text.boot); *(.text); *(.text.*) } >RAM
- .text : { __file_start = .; "forth.f" ; __file_len = . - __file_start; } >RAM
- .rodata : { *(.rodata) } >RAM
- . = ALIGN(4);
- __here_start = .;
- __meta_start = __here_start + 0x7000000;
-
- link_0 = 0;
-}
-
diff --git a/run b/run
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+exec qemu-system-riscv32 \
+ -gdb tcp::1234 \
+ -nographic \
+ -bios none \
+ -machine virt \
+ -kernel bin/forth.elf \
+ -device virtio-blk-device,drive=drive0 \
+ -drive file=disk0.qcow2,format=raw,id=drive0
diff --git a/forth.f b/src/forth.f
diff --git a/src/forth.s b/src/forth.s
@@ -0,0 +1,1315 @@
+.option norelax
+
+.extern uart_put_char
+.extern uart_get_char
+.extern uart_put_string
+
+#define w a0
+#define x a1
+#define y a2
+#define ip s1
+#define psp sp
+#define rsp s2
+
+#define cell 4
+#define dcell 8
+
+#define link_offset 0
+#define hash_offset 4
+#define meta_offset 8
+#define flag_offset 12
+#define code_offset 16
+
+#define load_cell lw
+#define store_cell sw
+
+.equ state_immediate, 0
+.equ state_compile, 1
+
+.equ flag_hidden, 0x20
+.equ flag_immediate, 0x40
+
+.macro next
+ ret
+.endm
+
+.macro push_addr addr
+ push w
+ la w, \addr
+.endm
+
+.macro push_imm imm
+ push w
+ li w, \imm
+.endm
+
+.macro push reg
+ store_cell \reg, -cell(psp)
+ addi psp, psp, -cell
+.endm
+
+.macro pop reg
+ load_cell \reg, 0(psp)
+ addi psp, psp, cell
+.endm
+
+.macro push_ret reg
+ store_cell \reg, -cell(rsp)
+ addi rsp, rsp, -cell
+.endm
+
+.macro pop_ret reg
+ load_cell \reg, 0(rsp)
+ addi rsp, rsp, cell
+.endm
+
+
+.macro this_link
+ .globl link_\+
+link_\+:
+.endm
+
+.macro prev_link
+ .int link_\+
+.endm
+
+.macro link
+ this_link
+ prev_link
+.endm
+
+this_link
+
+.macro defhead name, label, hash, code, flags=0
+ .section ".rodata"
+ .balign cell
+ .globl name_\label
+name_\label:
+ link
+ .int \hash
+ .int meta_\label
+ .byte \flags
+
+ .balign cell
+ .globl code_\label
+code_\label:
+ .int \label
+
+ .section ".text"
+ .balign cell
+ .globl \label
+\label:
+.endm
+
+.macro defmeta name, label
+ .section ".rodata.meta"
+ .global meta_\label
+meta_\label:
+ .byte length_\@
+1:
+ .ascii "\name"
+ .equ length_\@, . - 1b
+.endm
+
+.macro defcode name, label, hash, flags=0
+ defmeta "\name", \label
+ defhead "\name", \label, \hash, code_\label, flags=\flags
+.endm
+
+.macro defword name, label, hash, flags=0
+ defmeta "\name", \label
+ defhead "\name", \label, \hash, docol, flags=\flags
+ docol
+.endm
+
+.macro defvar name, label, hash, flags=0, initial=0
+ defmeta "\name", \label
+ defhead "\name", \label, \hash, dovar, flags=\flags
+ push_ret ra
+ jal dovar
+ .globl _\label
+_\label:
+.endm
+
+.macro defconst name, label, hash, flags=0, value=0
+ defmeta "\name", \label
+ defhead "\name", \label, \hash, docon, flags=\flags
+ push_ret ra
+ jal docon
+ .globl _\label
+_\label:
+.endm
+
+.macro docol
+ push_ret ra
+.endm
+
+.macro exit
+ pop_ret ra
+ ret
+.endm
+
+dovar:
+ push w
+ mv w, ra
+ pop_ret ra
+ ret
+
+docon:
+ push w
+ load_cell w, 0(ra)
+ pop_ret ra
+ ret
+
+dodoes:
+ push_ret ip # save old ip
+ addi w, w, cell # make w point to parameter field
+ push w # push w onto param. stack
+ mv ip, ra # set new ip
+ next
+
+defcode "break", break, 0xC9648178
+ next
+
+# -----------------------------------------------------------------------------
+# constants and variables
+# -----------------------------------------------------------------------------
+
+defconst "sp0", sp_top, 0x0C41B8B2
+ .int __stacktop
+
+defconst "rp0", rp_top, 0x8AD91EDD
+ .int __stacktop_ret
+
+defconst "bl", bl, 0x412BAEAB
+ .int 0x20
+
+defvar "state", state, 0x783132F6
+ .int state_immediate
+
+defvar "dp", dp, 0x491CB0B9
+ .int __here_start
+
+defvar "latest", latest, 0x41704246
+ .int name_read_line
+
+defvar "base", base, 0x3DDC94D8
+ .int 10
+
+defvar "delimiter", delimiter, 0x6C15B5FA
+ .int 0x20 # space
+
+defvar "'source", tick_source, 0xEB4FEC0B
+ .int 0 # length
+ .int 0 # address
+
+defvar "source-offset", source_offset, 0x7F8C1674
+ .int 0
+
+defvar "source-id", source_id, 0x965ED1E2
+ .int 0
+
+# -----------------------------------------------------------------------------
+# input and output
+# -----------------------------------------------------------------------------
+
+defcode "type", type, 0x5127F14D
+ mv x, w
+ pop w
+ push_ret ra
+ jal uart_put_string
+ pop_ret ra
+ pop w
+ next
+
+defcode "emit", emit, 0x2D88474A
+ jal uart_put_char
+ pop w
+ next
+
+defcode "key", key, 0x6815C86C
+ jal uart_get_char
+ next
+
+defcode "accept", accept, 0x08247E29
+ pop x # address
+ push_ret ra
+ jal accept_impl
+ pop_ret ra
+ next
+
+accept_impl:
+ push_ret ra
+ mv s4, w
+ mv s5, w
+ beqz s5, 2f
+ li s6, 0x0A # '\n'
+ li s7, 0x0D # '\r'
+1:
+ push x
+ jal uart_get_char
+ pop x
+ beq w, s6, 2f
+ beq w, s7, 2f
+ sb w, 0(x)
+ addi x, x, 1
+ addi s5, s5, -1
+ bnez s5, 1b
+2:
+ sub w, s4, s5
+ pop_ret ra
+ ret
+
+defword "refill", refill, 0x238BAA91
+ jal source_id
+ jal fetch
+ jal q_branch
+ .int _refill_tib
+_refill_fib:
+ jal fib
+ jal read_line
+ jal q_branch
+ .int _refill_failed
+ jal fib
+ jal drop
+ jal swap
+ jal branch
+ .int _refill_success
+_refill_tib:
+ jal tib
+ jal accept
+ jal dup
+ jal q_branch
+ .int _refill_failed
+ jal tib
+ jal drop
+ jal swap
+_refill_success:
+ jal tick_source
+ jal two_store
+ jal lit
+ .int 0
+ jal source_offset
+ jal store
+ jal lit
+ .int -1
+ exit
+_refill_failed:
+ jal drop
+ jal lit
+ .int 0
+ exit
+
+defword "source", source, 0x1BCF29D8
+ jal tick_source
+ jal two_fetch
+ exit
+
+defcode "tib", tib, 0xC90B0194
+ # ( -- addr len )
+ push w
+ la w, _tib
+ push w
+ la w, _tib_len
+ load_cell w, 0(w)
+ next
+
+defcode "fib", fib, 0xBCE49236
+ # ( -- addr len )
+ push w
+ la w, _fib
+ push w
+ la w, _fib_len
+ load_cell w, 0(w)
+ next
+
+defword "skip-while", skip_while, 0xBBFD4B86
+ # ( addr1 len1 -- addr2 len2 )
+_skip_while_loop:
+ jal dup
+ jal q_branch
+ .int _skip_while_done
+ jal over
+ jal char_fetch
+ jal delimiter
+ jal fetch
+ jal equal
+ jal q_branch
+ .int _skip_while_done
+ jal lit
+ .int 1
+ jal apply_offset
+ jal branch
+ .int _skip_while_loop
+_skip_while_done:
+ exit
+
+defword "skip-until", skip_until, 0x661A5D67
+ # ( addr1 len1 -- addr2 len2 )
+_skip_until_loop:
+ jal dup
+ jal q_branch
+ .int _skip_until_done
+ jal over
+ jal char_fetch
+ jal delimiter
+ jal fetch
+ jal not_equal
+ jal q_branch
+ .int _skip_until_done
+ jal lit
+ .int 1
+ jal apply_offset
+ jal branch
+ .int _skip_until_loop
+_skip_until_done:
+ exit
+
+defword "apply-offset", apply_offset, 0x605143A5
+ # ( addr1 len1 offset -- addr2 len2 )
+ jal tuck
+ jal minus
+ jal to_ret
+ jal plus
+ jal from_ret
+ exit
+
+defword "parse-offset", parse_offset, 0x9E5C3F80
+ # ( addr1 len1 -- offset )
+ jal lit
+ .int 1
+ jal min
+ jal plus
+ jal source
+ jal drop
+ jal minus
+ exit
+
+defword "parse", parse, 0x423B42EC
+ jal delimiter
+ jal store
+ jal source
+ jal source_offset
+ jal fetch
+ jal apply_offset
+ jal skip_while
+ jal over
+ jal to_ret
+ jal skip_until
+ jal two_dup
+ jal parse_offset
+ jal source_offset
+ jal store
+ jal drop
+ jal from_ret
+ jal tuck
+ jal minus
+ exit
+
+defword "parse-word", parse_word, 0xB218226F
+ jal bl
+ jal parse
+ exit
+
+defcode ">number", to_number, 0x2F770E4C
+ mv x, w
+ pop w
+ mv y, zero # initial value
+ mv s3, zero # sign flag
+ la s4, _base
+ load_cell s4, 0(s4)
+
+ beqz x, _to_number_empty_string
+
+ lb t0, 0(w)
+ addi w, w, 1
+ addi x, x, -1
+ li t1, 0x2D # '-'
+ bne t0, t1, _to_number_digit_value
+ addi s3, s3, -1
+ bnez x, _to_number_loop
+
+_to_number_empty_string:
+ addi x, x, -1
+ j _to_number_done
+
+_to_number_invalid:
+ addi x, x, 1
+ j _to_number_sign
+
+_to_number_loop:
+ mul y, y, s4
+ lb t0, 0(w)
+ addi w, w, 1
+ addi x, x, -1
+
+_to_number_digit_value:
+ addi t0, t0, -48
+ bltz t0, _to_number_invalid
+ addi t1, t0, -10
+ bltz t1, _to_number_base
+ addi t0, t0, -7
+ addi t1, t0, -10
+ bltz t1, _to_number_invalid
+
+_to_number_base:
+ bgt t0, s4, _to_number_invalid
+ add y, y, t0
+ bnez x, _to_number_loop
+
+_to_number_sign:
+ beqz s3, _to_number_done
+ neg y, y
+
+_to_number_done:
+ push y
+ mv w, x
+ next
+
+defcode "word>hash", word_to_hash, 0x50E0A245
+ load_cell w, hash_offset(w)
+ next
+
+defword "find", find, 0xBDF0855A
+ jal hash
+ jal latest
+ jal fetch
+_find_loop:
+ jal dup
+ jal zero_equal
+ jal q_branch
+ .int _find_check_hidden
+ jal swap
+ jal drop
+ exit
+_find_check_hidden:
+ jal dup
+ jal hidden_q
+ jal zero_equal
+ jal q_branch
+ .int _find_next_word
+_find_check_hash:
+ jal two_dup
+ jal word_to_hash
+ jal equal
+ jal q_branch
+ .int _find_next_word
+ jal swap
+ jal drop
+ exit
+_find_next_word:
+ jal fetch
+ jal branch
+ .int _find_loop
+
+defcode ">cfa", to_cfa, 0x8CAC3233
+ addi w, w, code_offset
+ next
+
+defcode "execute", execute, 0xA01E3D98
+ load_cell x, 0(w)
+ pop w
+ jr x
+ # 'next' should be called by the executed word
+
+defword "interpret", interpret, 0x1F98C57A
+_interpret_start:
+ jal parse_word
+ beqz w, _interpret_parse_area_empty
+ jal two_dup
+ jal find
+ beqz w, _interpret_word_not_found
+_interpret_word_found:
+ addi psp, psp, 2 * cell # nip, nip
+ addi w, w, code_offset
+ load_cell w, 0(w)
+ # compiling?
+ la x, _state
+ load_cell x, 0(x)
+ beqz x, _interpret_execute_word
+ # immediate?
+ addi x, w, flag_offset - code_offset
+ lb x, 0(x)
+ andi x, x, flag_immediate
+ bnez x, _interpret_execute_word
+_interpret_compile_word:
+ jal jal_to
+ jal comma
+ j _interpret_start
+_interpret_execute_word:
+ mv x, w
+ pop w
+ jalr x
+ j _interpret_start
+_interpret_word_not_found:
+ pop w
+ jal to_number
+ bnez w, _interpret_retry
+ pop w
+ # compiling?
+ la x, _state
+ load_cell x, 0(x)
+ beqz x, _interpret_start
+_interpret_compile_number:
+ jal lit
+ .int lit
+ jal comma
+ jal comma
+ j _interpret_start
+_interpret_retry:
+ addi psp, psp, cell
+ load_cell w, 0(psp)
+ j _interpret_start
+_interpret_parse_area_empty:
+ addi psp, psp, cell
+ pop w
+ exit
+
+defword "evaluate", evaluate, 0xACE4360A
+ jal lit
+ .int 1
+ jal source_id
+ jal store
+_evaluate_loop:
+ jal refill
+ jal q_branch
+ .int _evaluate_done
+ jal interpret
+ jal branch
+ .int _evaluate_loop
+_evaluate_done:
+ jal lit
+ .int 0
+ jal source_id
+ jal store
+ exit
+
+defcode "branch", branch, 0xB6873945
+ load_cell ra, 0(ra)
+ next
+
+defcode "?branch", q_branch, 0x6AF3C1DE
+ bnez w, _branch_done
+ pop w
+ load_cell ra, 0(ra)
+ next
+_branch_done:
+ pop w
+ addi ra, ra, cell
+ next
+
+defcode "prompt", prompt, 0xDFE6493B
+ push w
+ la w, _prompt
+ la x, _prompt_len
+ push_ret ra
+ call uart_put_string
+ pop_ret ra
+ pop w
+ next
+
+defcode "okay", okay, 0xBA9EEB49
+ push w
+ la w, _okay
+ la x, _okay_len
+ push_ret ra
+ call uart_put_string
+ pop_ret ra
+ pop w
+ next
+
+defword "quit", quit, 0x47878736
+ jal rp_top
+ jal rp_store
+ jal prompt
+ jal refill
+ jal drop # TODO: What should happen when 'refill' fails?
+ jal interpret
+ jal okay
+ jal branch
+ .int quit
+
+defword "abort", abort, 0xA52BCAF9
+ jal sp_top
+ jal sp_store
+ jal quit
+
+# -----------------------------------------------------------------------------
+# memory access
+# -----------------------------------------------------------------------------
+
+defcode "!", store, 0x240C8DEC
+ pop x
+ store_cell x, 0(w)
+ pop w
+ next
+
+defcode "@", fetch, 0xC50BF85F
+ load_cell w, 0(w)
+ next
+
+defcode "c!", char_store, 0x9829F909
+ pop x
+ sb x, 0(w)
+ pop w
+ next
+
+defcode "c@", char_fetch, 0x37296056
+ lb w, 0(w)
+ next
+
+defcode "2!", two_store, 0x9CF2B11C
+ pop x
+ pop y
+ store_cell x, 0(w)
+ store_cell y, cell(w)
+ pop w
+ next
+
+defcode "2@", two_fetch, 0x3DF21B8F
+ load_cell y, cell(w)
+ load_cell w, 0(w)
+ push y
+ next
+
+defcode "+!", add_store, 0x08DC01D1
+ pop x
+ load_cell y, 0(w)
+ add y, y, x
+ store_cell y, 0(w)
+ pop w
+ next
+
+defcode "-!", sub_store, 0x24CD235B
+ pop x
+ load_cell y, 0(w)
+ sub y, y, x
+ store_cell y, 0(w)
+ pop w
+ next
+
+defcode "cells", cells, 0xD94ACBB2
+ li x, cell
+ mul w, w, x
+ next
+
+defcode "cell+", cell_plus, 0xB14A8CBA
+ addi w, w, cell
+ next
+
+# -----------------------------------------------------------------------------
+# dictionary management
+# -----------------------------------------------------------------------------
+
+defword "here", here, 0x213B65CB
+ jal dp
+ jal fetch
+ exit
+
+defcode "lit", lit, 0x404CD5B6
+ push w
+ load_cell w, 0(ra)
+ addi ra, ra, cell
+ next
+
+defcode "lit-string", lit_string, 0xC7BE567C # TODO: ip -> ra, w=tos
+ load_cell x, 0(ip) # len
+ addi ip, ip, cell
+ mv w, ip # addr
+ add ip, ip, x
+ # re-align ip
+ addi ip, ip, cell - 1
+ andi ip, ip, -cell
+ push w
+ push x
+ next
+
+defword "allot", allot, 0xADB1A69F
+ jal dp
+ jal add_store
+ exit
+
+defcode ",", comma, 0x290C95CB
+ la y, _dp
+ load_cell x, 0(y)
+ store_cell w, 0(x)
+ addi x, x, cell
+ store_cell x, 0(y)
+ pop w
+ next
+
+defcode "c,", char_comma, 0xA32A0A5A
+ la y, _dp
+ load_cell x, 0(y)
+ sb w, 0(x)
+ addi x, x, 1
+ store_cell x, 0(y)
+ pop w
+ next
+
+defword "align", align, 0x602C63DE
+ jal dp
+ jal dup
+ jal fetch
+ jal lit
+ .int 3
+ jal plus
+ jal lit
+ .int -4
+ jal and_
+ jal swap
+ jal store
+ exit
+
+# -----------------------------------------------------------------------------
+# stack manipulation
+# -----------------------------------------------------------------------------
+
+defcode "sp@", sp_fetch, 0xFC419F82
+ # ( -- addr )
+ push w
+ mv w, psp
+ next
+
+defcode "sp!", sp_store, 0x1D41D375
+ # ( addr -- )
+ mv psp, w
+ pop w
+ next
+
+defcode "rp@", rp_fetch, 0x7AD905AD
+ # ( -- addr )
+ push w
+ mv w, rsp
+ next
+
+defcode "rp!", rp_store, 0x99D9367A
+ # ( addr -- )
+ mv rsp, w
+ pop w
+ next
+
+defcode ">r", to_ret, 0x47FCB8A9
+ push_ret w
+ pop w
+ next
+
+defcode "r>", from_ret, 0x135408B1
+ push w
+ pop_ret w
+ next
+
+defcode "2>r" two_to_ret, 0x69F5D439
+ pop x
+ push_ret x
+ push_ret w
+ pop w
+ next
+
+defcode "2r>", two_from_ret, 0xB54DEDC1
+ push w
+ pop_ret w
+ pop_ret x
+ push x
+ next
+
+defcode "dup", dup, 0xD330F226
+ push w
+ load_cell w, 0(psp)
+ next
+
+defcode "?dup", q_dup, 0xFD2928D3
+ beqz w, _q_dup_done
+ push w
+_q_dup_done:
+ next
+
+defcode "swap", swap, 0x64ED874E
+ load_cell x, 0(psp)
+ store_cell w, 0(psp)
+ mv w, x
+ next
+
+defcode "drop", drop, 0xA9A58D8C
+ pop w
+ next
+
+defcode "over", over, 0x31F6520F
+ push w
+ load_cell w, cell(psp)
+ next
+
+defcode "nip", nip, 0x21A41868
+ addi psp, psp, cell
+ next
+
+defcode "tuck", tuck, 0x8E26FCE8
+ load_cell x, 0(psp)
+ store_cell w, 0(psp)
+ push x
+ next
+
+defcode "2dup", two_dup, 0x5E46F4D6
+ load_cell x, 0(psp)
+ push w
+ push x
+ next
+
+defcode "2drop", two_drop, 0xECFD129C
+ addi psp, psp, cell
+ pop w
+ next
+
+# -----------------------------------------------------------------------------
+# math and logic
+# -----------------------------------------------------------------------------
+
+defcode "+", plus, 0x2E0C9DAA
+ pop x
+ add w, x, w
+ next
+
+defcode "-", minus, 0x280C9438
+ pop x
+ sub w, x, w
+ next
+
+defcode "*", times, 0x2F0C9F3D
+ pop x
+ mul w, x, w
+ next
+
+defcode "or", or_, 0x5D342984
+ pop x
+ or w, x, w
+ next
+
+defcode "and", and_, 0x0F29C2A6
+ pop x
+ and w, x, w
+ next
+
+defcode "lshift", lshift, 0x8DA53719
+ pop x
+ sll w, x, w
+ next
+
+defcode "rshift", rshift, 0x86294EF7
+ pop x
+ srl w, x, w
+ next
+
+defcode "ashift", ashift, 0x46A0EC68
+ pop x
+ sra w, x, w
+ next
+
+defcode "aligned", aligned, 0xC73174DF
+ addi w, w, cell - 1
+ andi w, w, -cell
+ next
+
+# -----------------------------------------------------------------------------
+# comparison
+# -----------------------------------------------------------------------------
+
+defcode "0=", zero_equal, 0x14ED5DD6
+ mv x, zero
+ bnez w, _zero_done
+ addi x, x, -1
+_zero_done:
+ mv w, x
+ next
+
+defcode "=", equal, 0x380CAD68
+ pop x
+ beq w, x, _equal
+ mv w, zero
+ next
+_equal:
+ li w, -1
+ next
+
+defcode "<>", not_equal, 0x93F7201F
+ pop x
+ bne w, x, _not_equal
+ mv w, zero
+ next
+_not_equal:
+ li w, -1
+ next
+
+defcode ">", greater_than, 0x3B0CB221
+ pop x
+ bgt x, w, _greater_than
+ mv w, zero
+ next
+_greater_than:
+ li w, -1
+ next
+
+defcode "<", less_than, 0x390CAEFB
+ pop x
+ blt x, w, _less_than
+ mv w, zero
+ next
+_less_than:
+ li w, -1
+ next
+
+defcode "min", min, 0xC98F4557
+ pop x
+ bgt x, w, _min_greater_than
+ mv w, x
+_min_greater_than:
+ next
+
+# -----------------------------------------------------------------------------
+# compiler
+# -----------------------------------------------------------------------------
+
+defcode "jal-immed", jal_immed, 0xA914EF13
+ # encode a value as an immediate for a 'jal' instruction
+ mv x, w
+ li y, 0x000FF000 # imm[19:12]
+ and w, x, y
+ li y, 0x00100000 # imm[20]
+ and y, x, y
+ slli y, y, 11
+ add w, w, y
+ li y, 0x00000800 # imm[11]
+ and y, x, y
+ slli y, y, 9
+ add w, w, y
+ andi y, x, 0x000007FE # imm[10:1]
+ slli y, y, 20
+ add w, w, y
+ next
+
+defword "jal-to", jal_to, 0xC38EF054
+ # generate a 'jal ra, addr' instruction
+ la x, _dp
+ load_cell x, 0(x)
+ sub w, w, x
+ jal jal_immed
+ addi w, w, 0x000000EF # jal ra, imm
+ exit
+
+defword "jal-dovar", jal_dovar, 0x668658A5
+ # generate a 'jal ra, dovar' instruction
+ push w
+ la w, dovar
+ jal jal_to
+ exit
+
+defword "dovar,", dovar_comma, 0x1F514E5B
+ jal jal_dovar
+ jal comma
+ exit
+
+defword "docol,", docol_comma, 0xFAE1EE9E
+ push w
+ li w, 0xFE192E23 # sw ra, -4(s2)
+ jal comma
+ push w
+ li w, 0xFFC90913 # addi s2, s2, -4
+ jal comma
+ exit
+
+defword "exit,", exit_comma, 0xD540F80B
+ push w
+ li w, 0x00092083 # lw ra, 0(s2)
+ jal comma
+ push w
+ li w, 0x00490913 # addi s2, s2, 4
+ jal comma
+ push w
+ li w, 0x00008067 # ret
+ jal comma
+ exit
+
+defword "create", create, 0x26BB595D
+ jal parse_word
+ jal latest # link
+ jal fetch
+ jal comma
+ jal hash # hash
+ jal comma
+ push_imm 0 # meta
+ jal comma
+ push_imm 0 # flags
+ jal char_comma
+ jal align
+ # update latest
+ la x, _dp
+ load_cell x, 0(x)
+ addi x, x, -code_offset
+ la y, _latest
+ store_cell x, 0(y)
+ # code field
+ la x, _dp
+ load_cell y, 0(x)
+ addi y, y, cell
+ store_cell y, -cell(y)
+ store_cell y, 0(x)
+ # append 'dovar'
+ jal dovar_comma
+ exit
+
+defcode "hash", hash, 0xEDBF0FE3
+ mv x, w
+ pop w
+ push_ret ra
+ jal hash_impl
+ pop_ret ra
+ next
+
+hash_impl: # 32-bit fnv1a
+ li t0, 2166136261 # hash
+ li t1, 16777619 # prime
+_hash_char:
+ lb t2, 0(w)
+ addi w, w, 1
+ addi x, x, -1
+ xor t0, t0, t2
+ mul t0, t0, t1
+ bgtz x, _hash_char
+ mv w, t0
+ ret
+
+defcode "[", l_bracket, 0xDE0C1FBA, flags=flag_immediate
+ la x, _state
+ li y, state_immediate
+ store_cell y, 0(x)
+ next
+
+defcode "]", r_bracket, 0xD80C1648
+ la x, _state
+ li y, state_compile
+ store_cell y, 0(x)
+ next
+
+defcode "hidden", hidden, 0xF618F139
+ addi w, w, flag_offset
+ lb x, 0(w)
+ xori x, x, flag_hidden
+ sb x, 0(w)
+ pop w
+ next
+
+defcode "hidden?", hidden_q, 0x6F436C72
+ addi w, w, flag_offset
+ lb w, 0(w)
+ andi w, w, flag_hidden
+ next
+
+defword ":", colon, 0x3F0CB86D
+ jal create # create header
+ push_imm -cell
+ jal allot
+ jal docol_comma # append 'docol'
+ jal latest
+ jal fetch
+ jal hidden # hide word
+ jal r_bracket # enter 'compile' mode
+ exit
+
+defword ";", semicolon, 0x3E0CB6DA, flags=flag_immediate
+ jal exit_comma
+ jal latest
+ jal fetch
+ jal hidden
+ jal l_bracket
+ exit
+
+defcode "compiling?", compiling_q, 0x94652AE2
+ la w, _state
+ load_cell w, 0(w)
+ andi w, w, state_compile
+ push w
+ next
+
+defcode "immediate?", immediate_q, 0x89F23E9F
+ pop w
+ addi w, w, flag_offset - code_offset
+ lb w, 0(w)
+ andi w, w, flag_immediate
+ push w
+ next
+
+# TODO: everything after this needs updated to work with subroutine threading
+# and with w=tos
+
+defword "postpone", postpone, 0x933F531F, flags=flag_immediate
+ .int parse_word, find # TODO: was word actually found?
+ .int to_cfa, dup
+ .int immediate_q, q_branch, _postpone_compile
+_postpone_execute:
+ # stores "<xt>" into the current definition
+ #.int comma, exit
+_postpone_compile:
+ # stores "lit <xt> ," into the current definition
+ #.int lit, lit, comma, comma, lit, comma, comma, exit
+
+defword "immediate", immediate, 0xF232267A
+ .int latest, fetch, lit, flag_offset, plus, dup
+ .int fetch, lit, flag_immediate, or_
+ .int swap, store
+ exit
+
+defword "variable", variable, 0x19385305
+ .int create # create header
+ .int lit, 0, comma # initialize to zero
+ exit
+
+defword "constant", constant, 0x0691EA25
+ .int create # create header
+ .int lit, -cell, allot
+ #.int lit, docon, comma # append 'docon'
+ .int comma # initialize to value on stack
+ exit
+
+defcode "jal-dodoes", jal_dodoes, 0x4F82E787
+ pop w
+ la x, dodoes
+ sub x, x, w
+ li y, 0x000FF000 # imm[19:12]
+ and w, x, y
+ li y, 0x00100000 # imm[20]
+ and y, x, y
+ slli y, y, 11
+ add w, w, y
+ li y, 0x00000800 # imm[11]
+ and y, x, y
+ slli y, y, 9
+ add w, w, y
+ andi y, x, 0x000007FE # imm[10:1]
+ slli y, y, 20
+ add w, w, y
+ addi w, w, 0x000000EF # jal ra, imm
+ push w
+ next
+
+defword ";does", does, 0xF5BCD777, flags=flag_immediate
+ .int lit, does_internal, comma
+ .int here, jal_dodoes, comma
+ exit
+
+defword "(;does)", does_internal, 0xED4B7678
+ .int from_ret
+ .int latest, fetch, lit, code_offset, plus, store
+ exit
+
+defcode "read-char", read_char, 0xF07E2044
+ jal _read_char_impl
+ push w
+ next
+
+_read_char_impl:
+ la w, _bootstrap
+ load_cell w, 0(w)
+ la x, _bootstrap_len
+ load_cell x, 0(x)
+ sub x, x, w
+ la y, _bootstrap_offset
+ load_cell y, 0(y)
+ add w, w, y
+ sub x, x, y
+ beqz x, _read_char_eof
+
+ lb w, 0(w)
+ addi y, y, 1
+ la x, _bootstrap_offset
+ store_cell y, 0(x)
+ ret
+_read_char_eof:
+ mv w, zero
+ ret
+
+defword "buffer-open", buffer_open, 0x79AAD9CA
+ # ( addr len -- addr end-addr cur-addr )
+ .int over, plus, over
+ exit
+
+defword "buffer-close", buffer_close, 0x42B7429E
+ # ( open-buffer -- len )
+ .int nip, swap, minus
+ exit
+
+defword "buffer-emit", buffer_emit, 0xEA240555
+ # ( open-buffer char -- open-buffer )
+ .int over, store, lit, 1, plus
+ exit
+
+defword "buffer-full?", buffer_full_q, 0x070A2E6C
+ # ( open-buffer -- flag )
+ .int two_dup, greater_than # TODO: >=
+ exit
+
+defword "read-line", read_line, 0xAF1308A2
+ .int buffer_open
+_read_line_loop:
+ .int read_char
+ .int dup, lit, 0x0A, not_equal, q_branch, _read_line_newline
+ .int dup, lit, 0x00, not_equal, q_branch, _read_line_eof
+ .int buffer_emit
+ .int buffer_full_q, q_branch, _read_line_buffer_full
+ .int branch, _read_line_loop
+_read_line_newline:
+ #.int drop, buffer_close, lit, -1, exit
+_read_line_eof:
+ .int drop, buffer_close, dup, q_branch, _read_line_eof_fail
+ #.int lit, -1, exit
+_read_line_eof_fail:
+ #.int lit, 0, exit
+_read_line_buffer_full:
+ #.int buffer_close, lit, 0, exit
+
+.section ".text"
+program:
+ jal type
+ jal quit
+
+.section ".rodata"
+version_string:
+ .ascii "soup forth rv32\n"
+ version_string_len = (. - version_string)
+
+_prompt:
+ .ascii "> "
+ _prompt_len = (. - _prompt)
+
+_okay:
+ .ascii "ok\n"
+ _okay_len = (. - _okay)
+
+word_buffer: .space 255
+.balign cell
+_meta: .int __meta_start
+
+_bootstrap: .int __file_start
+_bootstrap_len: .int __file_len
+_bootstrap_offset: .int 0
+
+_tib: .space 255
+_tib_len: .int 255
+
+_fib: .space 255
+_fib_len: .int 255
+
+.section ".text.boot"
+.globl start
+start:
+ la psp, __stacktop
+ la rsp, __stacktop_ret
+ la ip, program
+ li w, 0xDEADC0DE
+
+ push_addr version_string
+ push_imm version_string_len
+
+ push_addr version_string
+ push_imm version_string_len
+
+ jal program
+
diff --git a/ns16550a.s b/src/ns16550a.s
diff --git a/src/riscv32-virt.ld b/src/riscv32-virt.ld
@@ -0,0 +1,28 @@
+
+TARGET(binary)
+INPUT("src/forth.f")
+
+OUTPUT_FORMAT("elf32-littleriscv", "elf32-littleriscv", "elf32-littleriscv")
+OUTPUT_ARCH(riscv)
+ENTRY(start)
+
+MEMORY {
+ RAM (rwx) : ORIGIN = 0x80000000, LENGTH = 128M
+}
+
+SECTIONS {
+ __stacksize = 256;
+ __stacktop = ORIGIN(RAM) + LENGTH(RAM);
+ __stacktop_ret = __stacktop - __stacksize;
+
+ . = ORIGIN(RAM);
+ .text : { *(.text.boot); *(.text); *(.text.*) } >RAM
+ .text : { __file_start = .; "src/forth.f" ; __file_len = . - __file_start; } >RAM
+ .rodata : { *(.rodata) } >RAM
+ . = ALIGN(4);
+ __here_start = .;
+ __meta_start = __here_start + 0x7000000;
+
+ link_0 = 0;
+}
+
