commit 62415f4715d11c83c98e5b05cdb038fe1da96833 Spenser Truex <truex@equwal.com> 2026-10-04 17:09:58 +0000 String ports and import; GC leak fix; heap rebalance
forth-tests.txt | 1 + kernel-tests.txt | 2 +- kernel.lisp | 12 ++++++++---- 3 files changed, 10 insertions(+), 5 deletions(-)
diff --git a/forth-tests.txt b/forth-tests.txt index 1d1d95b..560e486 100644 --- a/forth-tests.txt +++ b/forth-tests.txt @@ -72,3 +72,4 @@ drop ==> Stack underflow 16 s>f fsqrt f>s . ==> 4 1 s>f 2 s>f f< . 2 s>f 1 s>f f< . 2 s>f 2 s>f f= . ==> -1 0 -1 : sq2 1 ; : sq2 2 ; sq2 . ==> Redefine sq2. 2 +' drop emit-hook ! 65 emit 0 emit-hook ! 66 emit ==> B diff --git a/kernel-tests.txt b/kernel-tests.txt index 019204e..13a17dd 100644 --- a/kernel-tests.txt +++ b/kernel-tests.txt @@ -1 +1 @@ -kernel tests: 71 passed, 0 failed, 71 total +kernel tests: 72 passed, 0 failed, 72 total diff --git a/kernel.lisp b/kernel.lisp index 4bc4843..175c8c1 100644 --- a/kernel.lisp +++ b/kernel.lisp @@ -19,7 +19,7 @@ (defconstant +rstop+ #x2001FFE0) ; return stack: 4 KiB below this (QEMU: keep off the last 32 bytes) (defconstant +dict-limit+ #x2001DEE0) ; dictionary stops 256 bytes above the data stack (defconstant +usart2+ #x40004400) -(defparameter *sysvars* '("state" "base" "latest" "dp" ">in" "#tib" "hld" "nneg")) +(defparameter *sysvars* '("state" "base" "latest" "dp" ">in" "#tib" "hld" "nneg" "emit-hook")) ;;; ---------- dictionary ---------- (defvar *xts* (make-hash-table :test 'equal)) @@ -208,11 +208,14 @@ (defcode "f<" () (fcmp :mi)) (defcode "f=" () (fcmp :eq))) ;; console: USART2, polled - (defcode "emit" () - (let ((wait (label))) + (defcode "emit" () ; emit-hook = 0: USART2; else execute the hook with c on the stack + (let ((wait (label)) (hook (label)) (done (label))) + (li :r1 (+ +sysvars+ 32)) (ldr :r1 :r1) (cmp-imm8 :r1 0) (bcc :ne hook) (li :r1 +usart2+) (movw :r2 #x80) (mark wait) (ldr :r0 :r1) (tst-reg :r0 :r2) (bcc :eq wait) - (str :tos :r1 4) (dpop :tos))) + (str :tos :r1 4) (dpop :tos) (b done) + (mark hook) (mov :w :r1) (ldr :r0 :w) (bx :r0) + (mark done))) (defcode "key" () (let ((wait (label))) (li :r1 +usart2+) (movw :r2 #x20) @@ -239,6 +242,7 @@ (movw :r0 10) (str :r0 :r1 4) ; base (li :r0 *last-link*) (str :r0 :r1 8) ; latest (li :r0 +ram-dict+) (str :r0 :r1 12) ; dp + (movw :r0 0) (str :r0 :r1 32) ; emit-hook: console (li :psp +dstop+) (movw :tos 0) (li :ip cold-thread) (next) (mark fault) ; print FAULT, then system reset