commit ee279aeafca810f2aa70e63a6a29bbc5624fc767
parent 21588fcba332d565b2140bff48cfd019d6badc6f
Author: Christian Ermann <christianermann@gmail.com>
Date: Thu, 21 Nov 2024 13:05:08 -0800
Add core test suite
Diffstat:
4 files changed, 346 insertions(+), 0 deletions(-)
diff --git a/src/bootstrap.fs b/src/bootstrap.fs
@@ -19,6 +19,8 @@
: char parse-word if c@ else 0 then ;
: [char] char postpone literal ; immediate
+: bl 32 ;
+
: ')' [char] ) ;
: '"' [char] " ;
: '\' [char] \ ;
diff --git a/src/forth.s b/src/forth.s
@@ -576,6 +576,12 @@ defword "bootstrap", bootstrap, 0x15C160D9
jal evaluate
exit
+defword "run-tests", run_tests, 0xC7C52582
+ push w
+ li w, 2
+ jal evaluate
+ exit
+
defword "evaluate", evaluate, 0xACE4360A
jal source_id
jal store
@@ -706,6 +712,13 @@ defcode "cell+", cell_plus, 0xB14A8CBA
addi w, w, cell
next
+defcode "chars", chars, 0x5DA9662A
+ next
+
+defcode "char+", char_plus, 0x25A90E02
+ addi w, w, 1
+ next
+
# -----------------------------------------------------------------------------
# dictionary management
# -----------------------------------------------------------------------------
@@ -808,6 +821,11 @@ defcode "r>", from_ret, 0x135408B1
pop_ret w
next
+defcode "r@", fetch_ret, 0x3D544ACF
+ push w
+ load_cell w, 0(rsp)
+ next
+
defcode "2>r" two_to_ret, 0x69F5D439
pop x
push_ret x
@@ -883,11 +901,27 @@ defcode "-", minus, 0x280C9438
sub w, x, w
next
+defcode "abs", abs, 0x2A48023B
+ bgtz w, _abs_positive
+ not w, w
+ addi w, w, 1
+_abs_positive:
+ next
+
+defcode "negate", negate, 0x757CBB5B
+ not w, w
+ addi w, w, 1
+ next
+
defcode "*", times, 0x2F0C9F3D
pop x
mul w, x, w
next
+defcode "not", not_, 0x29B19C8A
+ not w, w
+ next
+
defcode "or", or_, 0x5D342984
pop x
or w, x, w
@@ -898,6 +932,11 @@ defcode "and", and_, 0x0F29C2A6
and w, x, w
next
+defcode "xor", xor_, 0xCC6BDB7E
+ pop x
+ xor w, x, w
+ next
+
defcode "lshift", lshift, 0x8DA53719
pop x
sll w, x, w
@@ -973,6 +1012,13 @@ defcode "min", min, 0xC98F4557
_min_greater_than:
next
+defcode "max", max, 0xD7A2E319
+ pop x
+ blt x, w, _max_less_than
+ mv w, x
+_max_less_than:
+ next
+
# -----------------------------------------------------------------------------
# compiler
# -----------------------------------------------------------------------------
@@ -1251,6 +1297,7 @@ defword "read-line", read_line, 0xAF1308A2 # ( addr len id -- ? )
load_cell x, 3 * cell(x) # offset
# apply offset
add y, y, x
+ sub w, w, x
# len = min(buffer, file)
jal min
@@ -1291,6 +1338,10 @@ _file_table:
.int __file_start # addr
.int __file_end - __file_start # len
.int 0 # offset
+ .int 0x98CD7A4F
+ .int __tests_start
+ .int __tests_end - __tests_start
+ .int 0
.section ".text"
program:
diff --git a/src/riscv32-virt.ld b/src/riscv32-virt.ld
@@ -1,6 +1,7 @@
TARGET(binary)
INPUT("src/bootstrap.fs")
+INPUT("src/tests.fs")
OUTPUT_FORMAT("elf32-littleriscv", "elf32-littleriscv", "elf32-littleriscv")
OUTPUT_ARCH(riscv)
@@ -18,6 +19,7 @@ SECTIONS {
. = ORIGIN(RAM);
.text : { *(.text.boot); *(.text); *(.text.*) } >RAM
.text : { __file_start = .; "src/bootstrap.fs" ; __file_end = .; } >RAM
+ .text : { __tests_start = .; "src/tests.fs" ; __tests_end = .; } >RAM
.rodata : { *(.rodata) } >RAM
. = ALIGN(4);
__here_start = .;
diff --git a/src/tests.fs b/src/tests.fs
@@ -0,0 +1,291 @@
+\ this test suite is adapted from the forth standard test suite. not all tests
+\ are included.
+
+\ f.3.1 - basic assumptions
+t{ -> }t \ this test should pass
+t{ -> 1 }t \ this test should fail
+
+t{ ( a comment)1234 -> 1234 }t
+t{ : pc1 ( a comment)1234 ; pc1 -> 1234 }t
+
+\ f.3.2 - booleans
+t{ false not -> true }t
+t{ true not -> false }t
+
+t{ false false and -> false }t
+t{ false true and -> false }t
+t{ true false and -> false }t
+t{ true true and -> true }t
+
+t{ false false or -> false }t
+t{ false true or -> true }t
+t{ true false or -> true }t
+t{ true true or -> true }t
+
+t{ false false xor -> false }t
+t{ false true xor -> true }t
+t{ true false xor -> true }t
+t{ true true xor -> false }t
+
+\ f.3.3 - shifts
+hex
+t{ 1 0 lshift -> 1 }t
+t{ 1 1 lshift -> 2 }t
+t{ 1 2 lshift -> 4 }t
+t{ 1 F lshift -> 8000 }t
+t{ true 1 lshift 1 xor -> true }t
+
+t{ 1 0 rshift -> 1 }t
+t{ 1 1 rshift -> 0 }t
+t{ 2 1 rshift -> 1 }t
+t{ 4 2 rshift -> 1 }t
+t{ 8000 F rshift -> 1 }t
+
+\ f.3.5 - comparisons
+0 not constant max-uint
+0 not 1 rshift constant max-int
+0 not 1 rshift not constant min-int
+
+t{ 0 0= -> true }t
+t{ 1 0= -> false }t
+t{ 2 0= -> false }t
+t{ -1 0= -> false }t
+t{ max-uint 0= -> false }t
+t{ min-int 0= -> false }t
+t{ max-int 0= -> false }t
+
+t{ 0 0 = -> true }t
+t{ 1 1 = -> true }t
+t{ -1 -1 = -> true }t
+t{ 1 0 = -> false }t
+t{ -1 0 = -> false }t
+t{ 0 1 = -> false }t
+t{ 0 -1 = -> false }t
+t{ 1 -1 = -> false }t
+t{ -1 1 = -> false }t
+
+t{ 0 1 < -> true }t
+t{ 1 2 < -> true }t
+t{ -1 0 < -> true }t
+t{ -1 1 < -> true }t
+t{ 1 0 < -> false }t
+t{ 2 1 < -> false }t
+t{ 0 -1 < -> false }t
+t{ 1 -1 < -> false }t
+t{ 0 0 < -> false }t
+t{ 1 1 < -> false }t
+t{ min-int 0 < -> true }t
+t{ min-int max-int < -> true }t
+t{ 0 max-int < -> true }t
+t{ 0 min-int < -> false }t
+t{ max-int min-int < -> false }t
+t{ max-int 0 < -> false }t
+
+t{ 0 1 > -> false }t
+t{ 1 2 > -> false }t
+t{ -1 0 > -> false }t
+t{ -1 1 > -> false }t
+t{ 1 0 > -> true }t
+t{ 2 1 > -> true }t
+t{ 0 -1 > -> true }t
+t{ 1 -1 > -> true }t
+t{ 0 0 > -> false }t
+t{ 1 1 > -> false }t
+t{ min-int 0 > -> false }t
+t{ min-int max-int > -> false }t
+t{ 0 max-int > -> false }t
+t{ 0 min-int > -> true }t
+t{ max-int min-int > -> true }t
+t{ max-int 0 > -> true }t
+
+t{ 0 1 min -> 0 }t
+t{ 1 2 min -> 1 }t
+t{ -1 0 min -> -1 }t
+t{ -1 1 min -> -1 }t
+t{ 1 0 min -> 0 }t
+t{ 2 1 min -> 1 }t
+t{ 0 -1 min -> -1 }t
+t{ 1 -1 min -> -1 }t
+t{ 0 0 min -> 0 }t
+t{ 1 1 min -> 1 }t
+t{ min-int 0 min -> min-int }t
+t{ min-int max-int min -> min-int }t
+t{ 0 max-int min -> 0 }t
+t{ 0 min-int min -> min-int }t
+t{ max-int min-int min -> min-int }t
+t{ max-int 0 min -> 0 }t
+
+t{ 0 1 max -> 1 }t
+t{ 1 2 max -> 2 }t
+t{ -1 0 max -> 0 }t
+t{ -1 1 max -> 1 }t
+t{ 1 0 max -> 1 }t
+t{ 2 1 max -> 2 }t
+t{ 0 -1 max -> 0 }t
+t{ 1 -1 max -> 1 }t
+t{ 0 0 max -> 0 }t
+t{ 1 1 max -> 1 }t
+t{ min-int 0 max -> 0 }t
+t{ min-int max-int max -> max-int }t
+t{ 0 max-int max -> max-int }t
+t{ 0 min-int max -> 0 }t
+t{ max-int min-int max -> max-int }t
+t{ max-int 0 max -> max-int }t
+
+\ f.3.6 - stack operators
+t{ 1 2 drop -> 1 }t
+t{ 0 drop -> }t
+t{ 1 dup -> 1 1 }t
+t{ 1 2 over -> 1 2 1 }t
+t{ 1 2 swap -> 2 1 }t
+t{ 1 2 nip -> 2 }t
+t{ 1 2 tuck -> 2 1 2 }t
+t{ 1 2 3 2drop -> 1 }t
+t{ 1 2 2drop -> }t
+t{ 1 2 2dup -> 1 2 1 2 }t
+
+\ f.3.7 - return stack operators
+t{ : gr1 >r r> ; -> }t
+t{ : gr2 >r r@ r> drop ; -> }t
+t{ 123 gr1 -> 123 }t
+t{ 123 gr2 -> 123 }t
+t{ true gr1 -> true }t
+
+\ f.3.8 - addition and subtraction (and other math operators)
+t{ 0 5 + -> 5 }t
+t{ 5 0 + -> 5 }t
+t{ 0 -5 + -> -5 }t
+t{ -5 0 + -> -5 }t
+t{ 1 2 + -> 3 }t
+t{ 1 -2 + -> -1 }t
+t{ -1 2 + -> 1 }t
+t{ -1 -2 + -> -3 }t
+t{ -1 1 + -> 0 }t
+
+t{ 0 5 - -> -5 }t
+t{ 5 0 - -> 5 }t
+t{ 0 -5 - -> 5 }t
+t{ -5 0 - -> -5 }t
+t{ 1 2 - -> -1 }t
+t{ 1 -2 - -> 3 }t
+t{ -1 2 - -> -3 }t
+t{ -1 -2 - -> 1 }t
+t{ 1 1 - -> 0 }t
+
+t{ 0 abs -> 0 }t
+t{ 1 abs -> 1 }t
+t{ -1 abs -> 1 }t
+t{ min-int abs -> mid-uint+1 }t
+
+t{ 0 negate -> 0 }t
+t{ 1 negate -> -1 }t
+t{ -1 negate -> 1 }t
+t{ 2 negate -> -2 }t
+t{ -2 negate -> 2 }t
+
+\ f.3.9 - multiplication
+t{ 0 0 * -> 0 }t
+t{ 0 1 * -> 0 }t
+t{ 1 0 * -> 0 }t
+t{ 1 2 * -> 2 }t
+t{ 2 1 * -> 2 }t
+t{ 3 3 * -> 9 }t
+t{ -3 3 * -> -9 }t
+t{ 3 -3 * -> -9 }t
+t{ -3 -3 * -> 9 }t
+
+\ f.3.11 memory
+here 1 ,
+here 2 ,
+constant 2nd
+constant 1st
+
+t{ 1st 2nd < -> true }t
+t{ 1st cell+ -> 2nd }t
+t{ 1st 1 cells + -> 2nd }t
+t{ 1st @ 2nd @ -> 1 2 }t
+t{ 5 1st ! -> }t
+t{ 1st @ 2nd @ -> 5 2 }t
+t{ 6 2nd ! -> }t
+t{ 1st @ 2nd @ -> 5 6 }t
+t{ 1st 2@ -> 6 5 }t
+t{ 2 1 1st 2! -> }t
+t{ 1st 2@ -> 2 1 }t
+t{ true 1st ! 1st @ -> true }t
+
+t{ 0 1st ! -> }t
+t{ 1 1st +! -> }t
+t{ 1st @ -> 1 }t
+t{ -1 1st +! 1st @ -> 0 }t
+
+here 1 c,
+here 2 c,
+align
+constant 2nd-c
+constant 1st-c
+
+t{ 1st-c 2nd-c < -> true }t
+t{ 1st-c char+ -> 2nd-c }t
+t{ 1st-c 1 chars + -> 2nd-c }t
+t{ 1st-c c@ 2nd-c c@ -> 1 2 }t
+t{ 3 1st-c c! -> }t
+t{ 1st-c c@ 2nd-c c@ -> 3 2 }t
+t{ 4 2nd-c c! -> }t
+t{ 1st-c c@ 2nd-c c@ -> 3 4 }t
+
+\ f.3.12 characters
+t{ bl -> hex 20 }t
+
+t{ char x -> hex 78 }t
+t{ char hello -> hex 68 }t
+
+t{ : gc1 [char] x ; -> }t
+t{ : gc2 [char] hello ; -> }t
+t{ gc1 -> hex 78 }t
+t{ gc2 -> hex 68 }t
+
+t{ : gc3 [ gc1 ] literal ; -> }t
+t{ gc3 -> hex 78 }t
+
+t{ : gc4 " xy" ; -> }t
+t{ gc4 nip -> 2 }t
+t{ gc4 drop dup c@ swap char+ c@ -> hex 78 79 }t
+t{ : gc5 " a string"2drop ; -> }t
+t{ gc5 -> }t
+
+\ f.3.14 flow control
+t{ : gi1 if 123 then ; -> }t
+t{ : gi2 if 123 else 234 then ; -> }t
+t{ 0 gi1 -> }t
+t{ 1 gi1 -> 123 }t
+t{ -1 gi1 -> 123 }t
+t{ 0 gi2 -> 234 }t
+t{ 1 gi2 -> 123 }t
+t{ -1 gi2 -> 123 }t
+
+t{ : gi3 begin dup 5 < while dup 1 + repeat ; -> }t
+t{ 0 gi3 -> 0 1 2 3 4 5 }t
+t{ 4 gi3 -> 4 5 }t
+t{ 5 gi3 -> 5 }t
+t{ 6 gi3 -> 6 }t
+
+\ f.3.16 defining words
+t{ : nop : postpone ; ; -> }t
+t{ nop nop1 nop nop2 -> }t
+t{ nop1 -> }t
+t{ nop2 -> }t
+
+t{ : gdx 123 ; -> }t
+t{ : gdx gdx 234 ; -> }t
+t{ gdx -> 123 234 }t
+
+t{ 123 constant x123 -> }t
+t{ x123 -> 123 }t
+t{ : equ constant ; -> }t
+t{ x123 equ y123 -> }t
+t{ y123 -> 123 }t
+
+t{ variable v1 -> }t
+t{ 123 v1 ! -> }t
+t{ v1 @ -> 123 }t
+
