diff options
| -rw-r--r-- | sanctuary.fs | 2 | ||||
| -rw-r--r-- | sanctuary.s | 15 | ||||
| -rw-r--r-- | test.fs | 227 |
3 files changed, 243 insertions, 1 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index 43e632c..6f94aca 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -357,7 +357,7 @@ privatise 1 -to include-depth r> to source-id ; : included ( a u -- ) s>z r/o open-file 0= if dup >r include-file - r> close-file + r> close-file drop else drop abort" file open for include failed" then ; diff --git a/sanctuary.s b/sanctuary.s index 3df31ba..b453ff0 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -1106,6 +1106,21 @@ defcode "u>=", ugreatereq, 0 neg r11 pspush r11 ret + +; todo doc +defcode "lshift", lshift, 0 + pspop rcx ; u + pspop r12 ; x1 + shl r12, cl + pspush r12 + ret + +defcode "rshift", rshift, 0 + pspop rcx ; u + pspop r12 ; x1 + shr r12, cl + pspush r12 + ret ; }}} ; todo doc @@ -4,8 +4,12 @@ \ ↑ some of the tests are lifted from the test suite and the standard \ no point in coming up with my own when this is here +\ commented out ones are for words that do not currently exist but Should + true verbose ! +hex + testing basic assumptions t{ -> }t @@ -50,3 +54,226 @@ t{ x123 -> 123 }t t{ : equ constant ; -> }t t{ x123 equ y123 -> }t t{ y123 -> 123 }t + +testing bit shifting + +1s 1 rshift invert constant msb +t{ msb bitsset? -> 0 0 }t + +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{ 1s 1 lshift 1 xor -> 1s }t +t{ msb 1 lshift -> 0 }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 +t{ msb 1 rshift msb and -> 0 }t + +testing comparison + +0 invert constant max-uint +0 invert 1 rshift constant max-int +0 invert 1 rshift invert constant min-int +0 invert 1 rshift constant mid-uint +0 invert 1 rshift invert constant mid-uint+1 + +0s constant <false> +1s constant <true> + +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{ 0 0< -> <false> }t +t{ -1 0< -> <true> }t +t{ min-int 0< -> <true> }t +t{ 1 0< -> <false> }t +t{ max-int 0< -> <false> }t + +t{ 0 1 < -> <true> }t +t{ 1 2 < -> <true> }t +t{ -1 0 < -> <true> }t +t{ -1 1 < -> <true> }t +t{ min-int 0 < -> <true> }t +t{ min-int max-int < -> <true> }t +t{ 0 max-int < -> <true> }t +t{ 0 0 < -> <false> }t +t{ 1 1 < -> <false> }t +t{ 1 0 < -> <false> }t +t{ 2 1 < -> <false> }t +t{ 0 -1 < -> <false> }t +t{ 1 -1 < -> <false> }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{ min-int 0 > -> <false> }t +t{ min-int max-int > -> <false> }t +t{ 0 max-int > -> <false> }t +t{ 0 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 min-int > -> <true> }t +t{ max-int min-int > -> <true> }t +t{ max-int 0 > -> <true> }t + +t{ 0 1 u< -> <true> }t +t{ 1 2 u< -> <true> }t +t{ 0 mid-uint u< -> <true> }t +t{ 0 max-uint u< -> <true> }t +t{ mid-uint max-uint u< -> <true> }t +t{ 0 0 u< -> <false> }t +t{ 1 1 u< -> <false> }t +t{ 1 0 u< -> <false> }t +t{ 2 1 u< -> <false> }t +t{ mid-uint 0 u< -> <false> }t +t{ max-uint 0 u< -> <false> }t +t{ max-uint mid-uint u< -> <false> }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{ 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 0 min -> 0 }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 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{ 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 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 min-int max -> 0 }t +\ t{ max-int min-int max -> max-int }t +\ t{ max-int 0 max -> max-int }t + +testing stack manipulation + +t{ 1 2 2drop -> }t +t{ 1 2 2dup -> 1 2 1 2 }t +\ t{ 1 2 3 4 2over -> 1 2 3 4 1 2 }t +t{ 1 2 3 4 2swap -> 3 4 1 2 }t +t{ 0 ?dup -> 0 }t +t{ 1 ?dup -> 1 1 }t +t{ -1 ?dup -> -1 -1 }t +t{ depth -> 0 }t +t{ 0 depth -> 0 1 }t +t{ 0 1 depth -> 0 1 2 }t +t{ 0 drop -> }t +t{ 1 2 drop -> 1 }t +t{ 1 dup -> 1 1 }t +t{ 1 2 over -> 1 2 1 }t +t{ 1 2 3 rot -> 2 3 1 }t +t{ 1 2 swap -> 2 1 }t + +testing return stack manipulation + +t{ : gr1 >r r> ; -> }t +t{ : gr2 >r r@ r> drop ; -> }t +t{ 123 gr1 -> 123 }t +t{ 123 gr2 -> 123 }t +t{ 1s gr1 -> 1s }t ( return stack holds cells ) + +testing basic math + +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{ mid-uint 1 + -> mid-uint+1 }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{ 0 1 - -> -1 }t +t{ mid-uint+1 1 - -> mid-uint }t + +t{ 0 1+ -> 1 }t +t{ -1 1+ -> 0 }t +t{ 1 1+ -> 2 }t +t{ mid-uint 1+ -> mid-uint+1 }t + +t{ 2 1- -> 1 }t +t{ 1 1- -> 0 }t +t{ 0 1- -> -1 }t +t{ mid-uint+1 1- -> mid-uint }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 + +t{ 0 abs -> 0 }t +t{ 1 abs -> 1 }t +t{ -1 abs -> 1 }t +t{ min-int abs -> mid-uint+1 }t + +testing multiplication + +t{ 0 0 * -> 0 }t \ test identities +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 + +t{ mid-uint+1 1 rshift 2 * -> mid-uint+1 }t +t{ mid-uint+1 2 rshift 4 * -> mid-uint+1 }t +t{ mid-uint+1 1 rshift mid-uint+1 or 2 * -> mid-uint+1 }t + +decimal |