giles
b6810e90ab
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
133 lines
3.3 KiB
Plaintext
133 lines
3.3 KiB
Plaintext
;; Phase 5 — Core Extension + memory primitives.
|
|
|
|
(define forth-p5-passed 0)
|
|
(define forth-p5-failed 0)
|
|
(define forth-p5-failures (list))
|
|
|
|
(define
|
|
forth-p5-assert
|
|
(fn
|
|
(label expected actual)
|
|
(if
|
|
(= expected actual)
|
|
(set! forth-p5-passed (+ forth-p5-passed 1))
|
|
(begin
|
|
(set! forth-p5-failed (+ forth-p5-failed 1))
|
|
(set!
|
|
forth-p5-failures
|
|
(concat
|
|
forth-p5-failures
|
|
(list
|
|
(str label ": expected " (str expected) " got " (str actual)))))))))
|
|
|
|
(define
|
|
forth-p5-check-stack
|
|
(fn
|
|
(label src expected)
|
|
(let ((r (forth-run src))) (forth-p5-assert label expected (nth r 2)))))
|
|
|
|
(define
|
|
forth-p5-check-top
|
|
(fn
|
|
(label src expected)
|
|
(let
|
|
((r (forth-run src)))
|
|
(let
|
|
((stk (nth r 2)))
|
|
(forth-p5-assert label expected (nth stk (- (len stk) 1)))))))
|
|
|
|
(define
|
|
forth-p5-create-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-top
|
|
"CREATE pushes HERE-at-creation"
|
|
"HERE CREATE FOO FOO ="
|
|
-1)
|
|
(forth-p5-check-top
|
|
"CREATE + ALLOT advances HERE"
|
|
"HERE 5 ALLOT HERE SWAP -"
|
|
5)
|
|
(forth-p5-check-top
|
|
"CREATE + , stores cell"
|
|
"CREATE FOO 42 , FOO @"
|
|
42)
|
|
(forth-p5-check-stack
|
|
"CREATE multiple ,"
|
|
"CREATE TBL 1 , 2 , 3 , TBL @ TBL CELL+ @ TBL CELL+ CELL+ @"
|
|
(list 1 2 3))
|
|
(forth-p5-check-top
|
|
"C, stores byte"
|
|
"CREATE B 65 C, 66 C, B C@"
|
|
65)))
|
|
|
|
(define
|
|
forth-p5-unsigned-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-top "1 2 U<" "1 2 U<" -1)
|
|
(forth-p5-check-top "2 1 U<" "2 1 U<" 0)
|
|
(forth-p5-check-top "0 1 U<" "0 1 U<" -1)
|
|
(forth-p5-check-top "-1 1 U< (since -1 unsigned is huge)" "-1 1 U<" 0)
|
|
(forth-p5-check-top "1 -1 U<" "1 -1 U<" -1)
|
|
(forth-p5-check-top "1 2 U>" "1 2 U>" 0)
|
|
(forth-p5-check-top "-1 1 U>" "-1 1 U>" -1)))
|
|
|
|
(define
|
|
forth-p5-2bang-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-stack
|
|
"2! / 2@"
|
|
"CREATE X 0 , 0 , 11 22 X 2! X 2@"
|
|
(list 11 22))))
|
|
|
|
(define
|
|
forth-p5-mixed-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-stack "S>D positive" "5 S>D" (list 5 0))
|
|
(forth-p5-check-stack "S>D negative" "-5 S>D" (list -5 -1))
|
|
(forth-p5-check-stack "S>D zero" "0 S>D" (list 0 0))
|
|
(forth-p5-check-top "D>S keeps low" "5 0 D>S" 5)
|
|
(forth-p5-check-stack "M* small positive" "3 4 M*" (list 12 0))
|
|
(forth-p5-check-stack "M* negative" "-3 4 M*" (list -12 -1))
|
|
(forth-p5-check-stack
|
|
"M* negative * negative"
|
|
"-3 -4 M*"
|
|
(list 12 0))
|
|
(forth-p5-check-stack "UM* small" "3 4 UM*" (list 12 0))
|
|
(forth-p5-check-stack
|
|
"UM/MOD: 100 0 / 5"
|
|
"100 0 5 UM/MOD"
|
|
(list 0 20))
|
|
(forth-p5-check-stack
|
|
"FM/MOD: -7 / 2 floored"
|
|
"-7 -1 2 FM/MOD"
|
|
(list 1 -4))
|
|
(forth-p5-check-stack
|
|
"SM/REM: -7 / 2 truncated"
|
|
"-7 -1 2 SM/REM"
|
|
(list -1 -3))
|
|
(forth-p5-check-top "*/ truncated" "7 11 13 */" 5)
|
|
(forth-p5-check-stack "*/MOD" "7 11 13 */MOD" (list 12 5))))
|
|
|
|
(define
|
|
forth-p5-run-all
|
|
(fn
|
|
()
|
|
(set! forth-p5-passed 0)
|
|
(set! forth-p5-failed 0)
|
|
(set! forth-p5-failures (list))
|
|
(forth-p5-create-tests)
|
|
(forth-p5-unsigned-tests)
|
|
(forth-p5-2bang-tests)
|
|
(forth-p5-mixed-tests)
|
|
(dict
|
|
"passed"
|
|
forth-p5-passed
|
|
"failed"
|
|
forth-p5-failed
|
|
"failures"
|
|
forth-p5-failures)))
|