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
;
:noname
- ." GC! "
-
- trace
+ \ ." GC! "
gc-unmark
gc-sweep
- ." (" gc-count-marked . ." pairs marked as used.)" cr
+ \ ." (" gc-count-marked . ." pairs marked as used.)" cr
; is collect-garbage
\ }}}
begin
\ DEBUG
- bold fg blue ." READ from " 2over drop . ." ==> " reset-term
+ \ bold fg blue ." READ from " 2over drop . ." ==> " reset-term
2over read-port ( port res obj )
\ DEBUG
- 2dup print cr
+ \ 2dup print cr
2dup EOF character-type objeq? if
2drop 2swap close-port
include scheme-primitives.4th
+ enable-gc
+
s" scheme-library.scm" load 2drop
+
+ disable-gc
\ }}}
enable-gc
\ Display welcome message
- \ welcome-symbol nil cons global-env obj@ eval 2drop
+ welcome-symbol nil cons global-env obj@ eval 2drop
begin
['] repl-body catch
throw false
endcase
until
+
+ disable-gc
;
forth definitions