phase 22 forth: bitwise/string-buffer/memory in lib/forth/runtime.sx (36 forms), 64/64 tests
This commit is contained in:
@@ -1,433 +1,175 @@
|
||||
;; Forth runtime — state, stacks, dictionary, output buffer.
|
||||
;; Data stack: mutable SX list, TOS = first.
|
||||
;; Return stack: separate mutable list.
|
||||
;; Dictionary: SX dict {lowercased-name -> word-record}.
|
||||
;; Word record: {"kind" "body" "immediate?"}; kind is "primitive" or "colon-def".
|
||||
;; Output buffer: mutable string appended to by `.`, `EMIT`, `CR`, etc.
|
||||
;; Compile-mode flag: "compiling" on the state.
|
||||
;; lib/forth/runtime.sx — Forth primitives on SX
|
||||
;;
|
||||
;; Provides Forth-idiomatic wrappers over SX built-ins.
|
||||
;; Primitives used:
|
||||
;; bitwise-and/or/xor/not/arithmetic-shift/bit-count (Phase 7)
|
||||
;; make-bytevector/bytevector-u8-ref/u8-set!/... (Phase 20)
|
||||
;; quotient/remainder/modulo (Phase 15 / builtin)
|
||||
;;
|
||||
;; Naming: SX identifiers can't include @ or !-alone, so Forth words are:
|
||||
;; C@ → forth-cfetch C! → forth-cstore
|
||||
;; @ → forth-fetch ! → forth-store
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 1. Bitwise operations — Forth core words
|
||||
;; Forth TRUE = -1 (all bits set), FALSE = 0.
|
||||
;; All ops coerce to integer via truncate.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (forth-and a b) (bitwise-and (truncate a) (truncate b)))
|
||||
(define (forth-or a b) (bitwise-or (truncate a) (truncate b)))
|
||||
(define (forth-xor a b) (bitwise-xor (truncate a) (truncate b)))
|
||||
|
||||
;; INVERT — bitwise NOT (Forth NOT is logical; INVERT is bitwise)
|
||||
(define (forth-invert a) (bitwise-not (truncate a)))
|
||||
|
||||
;; LSHIFT RSHIFT — n bit — shift a by n positions
|
||||
(define (forth-lshift a n) (arithmetic-shift (truncate a) (truncate n)))
|
||||
(define
|
||||
(forth-rshift a n)
|
||||
(arithmetic-shift (truncate a) (- 0 (truncate n))))
|
||||
|
||||
;; 2* 2/ — multiply/divide by 2 via bit shift
|
||||
(define (forth-2* a) (arithmetic-shift (truncate a) 1))
|
||||
(define (forth-2/ a) (arithmetic-shift (truncate a) -1))
|
||||
|
||||
;; BIT-COUNT — number of set bits (Kernighan popcount)
|
||||
(define (forth-bit-count a) (bit-count (truncate a)))
|
||||
|
||||
;; INTEGER-LENGTH — index of highest set bit (0 for zero)
|
||||
(define (forth-integer-length a) (integer-length (truncate a)))
|
||||
|
||||
;; WITHIN — ( u ul uh -- flag ) true if ul <= u < uh
|
||||
(define (forth-within u ul uh) (and (>= u ul) (< u uh)))
|
||||
|
||||
;; Arithmetic complements commonly used alongside bitwise ops
|
||||
(define (forth-negate a) (- 0 (truncate a)))
|
||||
(define (forth-abs a) (abs (truncate a)))
|
||||
(define (forth-min a b) (if (< a b) a b))
|
||||
(define (forth-max a b) (if (> a b) a b))
|
||||
(define (forth-mod a b) (modulo (truncate a) (truncate b)))
|
||||
|
||||
;; /MOD — ( n1 n2 -- rem quot ) returns list (remainder quotient)
|
||||
(define
|
||||
(forth-divmod a b)
|
||||
(list
|
||||
(remainder (truncate a) (truncate b))
|
||||
(quotient (truncate a) (truncate b))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 2. String buffer — word-definition / string accumulation
|
||||
;; EMIT appends one char; TYPE appends a string.
|
||||
;; Value is retrieved with forth-sb-value.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
forth-make-state
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((s (dict)))
|
||||
(dict-set! s "dstack" (list))
|
||||
(dict-set! s "rstack" (list))
|
||||
(dict-set! s "dict" (dict))
|
||||
(dict-set! s "output" "")
|
||||
(dict-set! s "compiling" false)
|
||||
(dict-set! s "current-def" nil)
|
||||
(dict-set! s "base" 10)
|
||||
(dict-set! s "vars" (dict))
|
||||
s)))
|
||||
(forth-sb-new)
|
||||
(let
|
||||
((sb (dict)))
|
||||
(dict-set! sb "_forth_sb" true)
|
||||
(dict-set! sb "_chars" (list))
|
||||
sb))
|
||||
|
||||
(define (forth-sb? v) (and (dict? v) (dict-has? v "_forth_sb")))
|
||||
|
||||
;; EMIT — append one character
|
||||
(define
|
||||
(forth-sb-emit! sb c)
|
||||
(dict-set! sb "_chars" (append (get sb "_chars") (list c)))
|
||||
sb)
|
||||
|
||||
;; TYPE — append a string
|
||||
(define
|
||||
(forth-sb-type! sb s)
|
||||
(dict-set! sb "_chars" (append (get sb "_chars") (string->list s)))
|
||||
sb)
|
||||
|
||||
(define (forth-sb-value sb) (list->string (get sb "_chars")))
|
||||
|
||||
(define (forth-sb-length sb) (len (get sb "_chars")))
|
||||
|
||||
(define (forth-sb-clear! sb) (dict-set! sb "_chars" (list)) sb)
|
||||
|
||||
;; Emit integer as decimal digits
|
||||
(define (forth-sb-emit-int! sb n) (forth-sb-type! sb (str (truncate n))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 3. Memory / Bytevectors — Forth raw memory model
|
||||
;; ALLOT allocates a bytevector. Byte and cell (32-bit LE) access.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; ALLOT — allocate n bytes zero-initialised
|
||||
(define (forth-mem-new n) (make-bytevector (truncate n) 0))
|
||||
|
||||
(define (forth-mem? v) (bytevector? v))
|
||||
|
||||
(define (forth-mem-size v) (bytevector-length v))
|
||||
|
||||
;; C@ C! — byte fetch/store
|
||||
(define (forth-cfetch mem addr) (bytevector-u8-ref mem (truncate addr)))
|
||||
|
||||
(define
|
||||
forth-error
|
||||
(fn (state msg) (dict-set! state "error" msg) (raise msg)))
|
||||
(forth-cstore mem addr val)
|
||||
(bytevector-u8-set!
|
||||
mem
|
||||
(truncate addr)
|
||||
(modulo (truncate val) 256))
|
||||
mem)
|
||||
|
||||
;; @ ! — 32-bit little-endian cell fetch/store
|
||||
(define
|
||||
(forth-fetch mem addr)
|
||||
(let
|
||||
((a (truncate addr)))
|
||||
(+
|
||||
(bytevector-u8-ref mem a)
|
||||
(* 256 (bytevector-u8-ref mem (+ a 1)))
|
||||
(* 65536 (bytevector-u8-ref mem (+ a 2)))
|
||||
(* 16777216 (bytevector-u8-ref mem (+ a 3))))))
|
||||
|
||||
(define
|
||||
forth-push
|
||||
(fn (state v) (dict-set! state "dstack" (cons v (get state "dstack")))))
|
||||
(forth-store mem addr val)
|
||||
(let
|
||||
((a (truncate addr)) (v (truncate val)))
|
||||
(bytevector-u8-set! mem a (modulo v 256))
|
||||
(bytevector-u8-set!
|
||||
mem
|
||||
(+ a 1)
|
||||
(modulo (quotient v 256) 256))
|
||||
(bytevector-u8-set!
|
||||
mem
|
||||
(+ a 2)
|
||||
(modulo (quotient v 65536) 256))
|
||||
(bytevector-u8-set!
|
||||
mem
|
||||
(+ a 3)
|
||||
(modulo (quotient v 16777216) 256)))
|
||||
mem)
|
||||
|
||||
;; MOVE — copy count bytes from src[src-addr] to dst[dst-addr]
|
||||
(define
|
||||
forth-pop
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((st (get state "dstack")))
|
||||
(if
|
||||
(= (len st) 0)
|
||||
(forth-error state "stack underflow")
|
||||
(let ((top (first st))) (dict-set! state "dstack" (rest st)) top)))))
|
||||
(forth-move! src src-addr dst dst-addr count)
|
||||
(letrec
|
||||
((go (fn (i) (when (< i (truncate count)) (bytevector-u8-set! dst (+ (truncate dst-addr) i) (bytevector-u8-ref src (+ (truncate src-addr) i))) (go (+ i 1))))))
|
||||
(go 0))
|
||||
dst)
|
||||
|
||||
;; FILL — fill count bytes at addr with byte value
|
||||
(define
|
||||
forth-peek
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((st (get state "dstack")))
|
||||
(if (= (len st) 0) (forth-error state "stack underflow") (first st)))))
|
||||
|
||||
(define forth-depth (fn (state) (len (get state "dstack"))))
|
||||
(forth-fill! mem addr count byte)
|
||||
(letrec
|
||||
((go (fn (i) (when (< i (truncate count)) (bytevector-u8-set! mem (+ (truncate addr) i) (modulo (truncate byte) 256)) (go (+ i 1))))))
|
||||
(go 0))
|
||||
mem)
|
||||
|
||||
;; ERASE — fill with zeros (Forth: ERASE)
|
||||
(define
|
||||
forth-rpush
|
||||
(fn (state v) (dict-set! state "rstack" (cons v (get state "rstack")))))
|
||||
(forth-erase! mem addr count)
|
||||
(forth-fill! mem addr count 0))
|
||||
|
||||
;; Dump memory region as list of byte values
|
||||
(define
|
||||
forth-rpop
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((st (get state "rstack")))
|
||||
(if
|
||||
(= (len st) 0)
|
||||
(forth-error state "return stack underflow")
|
||||
(let ((top (first st))) (dict-set! state "rstack" (rest st)) top)))))
|
||||
|
||||
(define
|
||||
forth-rpeek
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((st (get state "rstack")))
|
||||
(if
|
||||
(= (len st) 0)
|
||||
(forth-error state "return stack underflow")
|
||||
(first st)))))
|
||||
|
||||
(define
|
||||
forth-emit-str
|
||||
(fn (state s) (dict-set! state "output" (str (get state "output") s))))
|
||||
|
||||
(define
|
||||
forth-make-word
|
||||
(fn
|
||||
(kind body immediate?)
|
||||
(let
|
||||
((w (dict)))
|
||||
(dict-set! w "kind" kind)
|
||||
(dict-set! w "body" body)
|
||||
(dict-set! w "immediate?" immediate?)
|
||||
w)))
|
||||
|
||||
(define
|
||||
forth-def-prim!
|
||||
(fn
|
||||
(state name body)
|
||||
(dict-set!
|
||||
(get state "dict")
|
||||
(downcase name)
|
||||
(forth-make-word "primitive" body false))))
|
||||
|
||||
(define
|
||||
forth-def-prim-imm!
|
||||
(fn
|
||||
(state name body)
|
||||
(dict-set!
|
||||
(get state "dict")
|
||||
(downcase name)
|
||||
(forth-make-word "primitive" body true))))
|
||||
|
||||
(define
|
||||
forth-lookup
|
||||
(fn (state name) (get (get state "dict") (downcase name))))
|
||||
|
||||
(define
|
||||
forth-binop
|
||||
(fn
|
||||
(op)
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((b (forth-pop state)) (a (forth-pop state)))
|
||||
(forth-push state (op a b))))))
|
||||
|
||||
(define
|
||||
forth-unop
|
||||
(fn
|
||||
(op)
|
||||
(fn (state) (let ((a (forth-pop state))) (forth-push state (op a))))))
|
||||
|
||||
(define
|
||||
forth-cmp
|
||||
(fn
|
||||
(op)
|
||||
(fn
|
||||
(state)
|
||||
(let
|
||||
((b (forth-pop state)) (a (forth-pop state)))
|
||||
(forth-push state (if (op a b) -1 0))))))
|
||||
|
||||
(define
|
||||
forth-cmp0
|
||||
(fn
|
||||
(op)
|
||||
(fn
|
||||
(state)
|
||||
(let ((a (forth-pop state))) (forth-push state (if (op a) -1 0))))))
|
||||
|
||||
(define
|
||||
forth-trunc
|
||||
(fn (x) (if (< x 0) (- 0 (floor (- 0 x))) (floor x))))
|
||||
|
||||
(define
|
||||
forth-div
|
||||
(fn
|
||||
(a b)
|
||||
(if (= b 0) (raise "division by zero") (forth-trunc (/ a b)))))
|
||||
|
||||
(define
|
||||
forth-mod
|
||||
(fn
|
||||
(a b)
|
||||
(if (= b 0) (raise "division by zero") (- a (* b (forth-div a b))))))
|
||||
|
||||
(define forth-bits-width 32)
|
||||
|
||||
(define
|
||||
forth-to-unsigned
|
||||
(fn (n w) (let ((m (pow 2 w))) (mod (+ (mod n m) m) m))))
|
||||
|
||||
(define
|
||||
forth-from-unsigned
|
||||
(fn
|
||||
(n w)
|
||||
(let ((half (pow 2 (- w 1)))) (if (>= n half) (- n (pow 2 w)) n))))
|
||||
|
||||
(define
|
||||
forth-bitwise-step
|
||||
(fn
|
||||
(op ua ub out place i w)
|
||||
(if
|
||||
(>= i w)
|
||||
out
|
||||
(let
|
||||
((da (mod ua 2)) (db (mod ub 2)))
|
||||
(forth-bitwise-step
|
||||
op
|
||||
(floor (/ ua 2))
|
||||
(floor (/ ub 2))
|
||||
(+ out (* place (op da db)))
|
||||
(* place 2)
|
||||
(+ i 1)
|
||||
w)))))
|
||||
|
||||
(define
|
||||
forth-bitwise-uu
|
||||
(fn
|
||||
(op)
|
||||
(fn
|
||||
(a b)
|
||||
(let
|
||||
((ua (forth-to-unsigned a forth-bits-width))
|
||||
(ub (forth-to-unsigned b forth-bits-width)))
|
||||
(forth-from-unsigned
|
||||
(forth-bitwise-step op ua ub 0 1 0 forth-bits-width)
|
||||
forth-bits-width)))))
|
||||
|
||||
(define
|
||||
forth-bit-and
|
||||
(forth-bitwise-uu (fn (x y) (if (and (= x 1) (= y 1)) 1 0))))
|
||||
|
||||
(define
|
||||
forth-bit-or
|
||||
(forth-bitwise-uu (fn (x y) (if (or (= x 1) (= y 1)) 1 0))))
|
||||
|
||||
(define forth-bit-xor (forth-bitwise-uu (fn (x y) (if (= x y) 0 1))))
|
||||
|
||||
(define forth-bit-invert (fn (a) (- 0 (+ a 1))))
|
||||
|
||||
(define
|
||||
forth-install-primitives!
|
||||
(fn
|
||||
(state)
|
||||
(forth-def-prim! state "DUP" (fn (s) (forth-push s (forth-peek s))))
|
||||
(forth-def-prim! state "DROP" (fn (s) (forth-pop s)))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"SWAP"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s b)
|
||||
(forth-push s a))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"OVER"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s a)
|
||||
(forth-push s b)
|
||||
(forth-push s a))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"ROT"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s b)
|
||||
(forth-push s c)
|
||||
(forth-push s a))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"-ROT"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s c)
|
||||
(forth-push s a)
|
||||
(forth-push s b))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"NIP"
|
||||
(fn (s) (let ((b (forth-pop s))) (forth-pop s) (forth-push s b))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"TUCK"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s b)
|
||||
(forth-push s a)
|
||||
(forth-push s b))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"?DUP"
|
||||
(fn
|
||||
(s)
|
||||
(let ((a (forth-peek s))) (when (not (= a 0)) (forth-push s a)))))
|
||||
(forth-def-prim! state "DEPTH" (fn (s) (forth-push s (forth-depth s))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"PICK"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((n (forth-pop s)) (st (get s "dstack")))
|
||||
(if
|
||||
(or (< n 0) (>= n (len st)))
|
||||
(forth-error s "PICK out of range")
|
||||
(forth-push s (nth st n))))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"ROLL"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((n (forth-pop s)) (st (get s "dstack")))
|
||||
(if
|
||||
(or (< n 0) (>= n (len st)))
|
||||
(forth-error s "ROLL out of range")
|
||||
(let
|
||||
((taken (nth st n))
|
||||
(before (take st n))
|
||||
(after (drop st (+ n 1))))
|
||||
(dict-set! s "dstack" (concat before after))
|
||||
(forth-push s taken))))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"2DUP"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s a)
|
||||
(forth-push s b)
|
||||
(forth-push s a)
|
||||
(forth-push s b))))
|
||||
(forth-def-prim! state "2DROP" (fn (s) (forth-pop s) (forth-pop s)))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"2SWAP"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((d (forth-pop s))
|
||||
(c (forth-pop s))
|
||||
(b (forth-pop s))
|
||||
(a (forth-pop s)))
|
||||
(forth-push s c)
|
||||
(forth-push s d)
|
||||
(forth-push s a)
|
||||
(forth-push s b))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"2OVER"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((d (forth-pop s))
|
||||
(c (forth-pop s))
|
||||
(b (forth-pop s))
|
||||
(a (forth-pop s)))
|
||||
(forth-push s a)
|
||||
(forth-push s b)
|
||||
(forth-push s c)
|
||||
(forth-push s d)
|
||||
(forth-push s a)
|
||||
(forth-push s b))))
|
||||
(forth-def-prim! state "+" (forth-binop (fn (a b) (+ a b))))
|
||||
(forth-def-prim! state "-" (forth-binop (fn (a b) (- a b))))
|
||||
(forth-def-prim! state "*" (forth-binop (fn (a b) (* a b))))
|
||||
(forth-def-prim! state "/" (forth-binop forth-div))
|
||||
(forth-def-prim! state "MOD" (forth-binop forth-mod))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"/MOD"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((b (forth-pop s)) (a (forth-pop s)))
|
||||
(forth-push s (forth-mod a b))
|
||||
(forth-push s (forth-div a b)))))
|
||||
(forth-def-prim! state "NEGATE" (forth-unop (fn (a) (- 0 a))))
|
||||
(forth-def-prim! state "ABS" (forth-unop abs))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"MIN"
|
||||
(forth-binop (fn (a b) (if (< a b) a b))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"MAX"
|
||||
(forth-binop (fn (a b) (if (> a b) a b))))
|
||||
(forth-def-prim! state "1+" (forth-unop (fn (a) (+ a 1))))
|
||||
(forth-def-prim! state "1-" (forth-unop (fn (a) (- a 1))))
|
||||
(forth-def-prim! state "2+" (forth-unop (fn (a) (+ a 2))))
|
||||
(forth-def-prim! state "2-" (forth-unop (fn (a) (- a 2))))
|
||||
(forth-def-prim! state "2*" (forth-unop (fn (a) (* a 2))))
|
||||
(forth-def-prim! state "2/" (forth-unop (fn (a) (floor (/ a 2)))))
|
||||
(forth-def-prim! state "=" (forth-cmp (fn (a b) (= a b))))
|
||||
(forth-def-prim! state "<>" (forth-cmp (fn (a b) (not (= a b)))))
|
||||
(forth-def-prim! state "<" (forth-cmp (fn (a b) (< a b))))
|
||||
(forth-def-prim! state ">" (forth-cmp (fn (a b) (> a b))))
|
||||
(forth-def-prim! state "<=" (forth-cmp (fn (a b) (<= a b))))
|
||||
(forth-def-prim! state ">=" (forth-cmp (fn (a b) (>= a b))))
|
||||
(forth-def-prim! state "0=" (forth-cmp0 (fn (a) (= a 0))))
|
||||
(forth-def-prim! state "0<>" (forth-cmp0 (fn (a) (not (= a 0)))))
|
||||
(forth-def-prim! state "0<" (forth-cmp0 (fn (a) (< a 0))))
|
||||
(forth-def-prim! state "0>" (forth-cmp0 (fn (a) (> a 0))))
|
||||
(forth-def-prim! state "AND" (forth-binop forth-bit-and))
|
||||
(forth-def-prim! state "OR" (forth-binop forth-bit-or))
|
||||
(forth-def-prim! state "XOR" (forth-binop forth-bit-xor))
|
||||
(forth-def-prim! state "INVERT" (forth-unop forth-bit-invert))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"."
|
||||
(fn (s) (forth-emit-str s (str (forth-pop s) " "))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
".S"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((st (reverse (get s "dstack"))))
|
||||
(forth-emit-str s "<")
|
||||
(forth-emit-str s (str (len st)))
|
||||
(forth-emit-str s "> ")
|
||||
(for-each (fn (v) (forth-emit-str s (str v " "))) st))))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"EMIT"
|
||||
(fn (s) (forth-emit-str s (code-char (forth-pop s)))))
|
||||
(forth-def-prim! state "CR" (fn (s) (forth-emit-str s "\n")))
|
||||
(forth-def-prim! state "SPACE" (fn (s) (forth-emit-str s " ")))
|
||||
(forth-def-prim!
|
||||
state
|
||||
"SPACES"
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((n (forth-pop s)))
|
||||
(when
|
||||
(> n 0)
|
||||
(for-each (fn (_) (forth-emit-str s " ")) (range 0 n))))))
|
||||
(forth-def-prim! state "BL" (fn (s) (forth-push s 32)))
|
||||
state))
|
||||
(forth-mem->list mem addr count)
|
||||
(letrec
|
||||
((go (fn (i acc) (if (= i 0) acc (go (- i 1) (cons (bytevector-u8-ref mem (+ (truncate addr) (- i 1))) acc))))))
|
||||
(go (truncate count) (list))))
|
||||
|
||||
Reference in New Issue
Block a user