make-exception recoverable-exception
make-exception unrecoverable-exception
-: throw reset-term throw ;
+: throw reset-term cr throw ;
\ }}}
create cdr-cells scheme-memsize allot
create cdr-type-cells scheme-memsize allot
+variable gc-enabled
+false gc-enabled !
+
+: gc-enabled?
+ gc-enabled @ ;
+
create nextfrees scheme-memsize allot
:noname
scheme-memsize 0 do
nextfree !
nextfree @ scheme-memsize >= if
- collect-garbage
+ gc-enabled? if
+ collect-garbage
+ then
then
nextfree @ scheme-memsize >= if
\ ---- Garbage Collection ---- {{{
-variable gc-enabled
-false gc-enabled !
-
variable gc-stack-depth
: enable-gc
: disable-gc
false gc-enabled ! ;
-: gc-enabled?
- gc-enabled @ ;
-
: pairlike? ( obj -- obj bool )
pair-type istype? if true exit then
string-type istype? if true exit then
ok-symbol ( port res )
begin
+ \ DEBUG
+ \ bold fg blue ." READ from " 2over drop . ." ==> " reset-term
+
2over read-port ( port res obj )
+ \ DEBUG
+ \ 2dup print cr
+
2dup EOF character-type objeq? if
2drop 2swap close-port
exit
include scheme-primitives.4th
+ enable-gc
+
s" scheme-library.scm" load 2drop
+
+ disable-gc
\ }}}
throw false
endcase
until
+
+ disable-gc
;
forth definitions