From 5241c399e654d473a6e86135937ed7af7965d0a2 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Tue, 25 Oct 2016 12:16:52 +1300 Subject: [PATCH] Primitives are now GC-safe. --- scheme-primitives.4th | 31 ++++++++++++++++++------------- scheme.4th | 6 ++---- 2 files changed, 20 insertions(+), 17 deletions(-) diff --git a/scheme-primitives.4th b/scheme-primitives.4th index b347d8a..1d2e21c 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -64,34 +64,39 @@ drop character-type ; make-primitive integer->char -: num-to-charlist ( num -- charlist ) - ?dup 0= if +: fixnum-to-charlist ( fixnum -- charlist ) + over 0= if + 2drop [char] 0 character-type nil cons exit then - nil rot + nil 2swap ( charlist fixnum ) begin - ?dup 0> + over 0> while - dup 10 mod swap 10 / swap - 2swap rot - [char] 0 + character-type 2swap - cons - rot + 2dup swap 10 mod swap ( charlist fixnum fixnummod ) + 2swap swap 10 / swap ( charlist fixnummod fixnumdiv ) + -2rot ( fixnumdiv charlist fixnummod ) + + drop [char] 0 + character-type 2swap + cons ( fixnumdiv newcharlist ) + + 2swap repeat + + 2drop ; :noname ( args -- string ) 2dup 1 ensure-arg-count car fixnum-type ensure-arg-type - drop + 2dup swap abs swap - dup 0< swap abs ( bool num ) - num-to-charlist - rot if + fixnum-to-charlist ( fixnum charlist ) + 2swap drop 0< if [char] - character-type 2swap cons then diff --git a/scheme.4th b/scheme.4th index 8d28269..74a5b45 100644 --- a/scheme.4th +++ b/scheme.4th @@ -138,10 +138,10 @@ variable nextfree variable gc-enabled false gc-enabled ! -: gc-enable +: enable-gc true gc-enabled ! ; -: gc-disable +: disable-gc false gc-enabled ! ; : gc-enabled? @@ -198,8 +198,6 @@ defer gc-mark-trace \ }}} - - \ ---- Pre-defined symbols ---- {{{ objvar symbol-table -- 2.20.1