-\ ---- Garbage Collection ---- {{{
-
-variable gc-enabled
-false gc-enabled !
-
-: enable-gc
- true gc-enabled ! ;
-
-: 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
- symbol-type istype? if true exit then
- compound-proc-type istype? if true exit then
-
- false
-;
-
-: pairlike-marked? ( obj -- obj bool )
- over nextfrees + @ 0=
-;
-
-: mark-pairlike ( obj -- obj )
- over nextfrees + 0 swap !
-;
-
-: gc-unmark ( -- )
- scheme-memsize 0 do
- 1 nextfrees i + !
- loop
-;
-
-defer gc-mark-trace
-: gc-mark-obj ( obj -- )
-
- gc-mark-trace
-
- pairlike? invert if 2drop exit then
- pairlike-marked? if 2drop exit then
-
- mark-pairlike
-
- drop pair-type 2dup
-
- car recurse
- cdr recurse
-;
-
-: gc-sweep
- scheme-memsize nextfree !
- 0 scheme-memsize 1- do
- nextfrees i + @ 0<> if
- nextfree @ nextfrees i + !
- i nextfree !
- then
- -1 +loop
-;
-
-\ }}}