~ chicken-core (chicken-5) e955b8dc658bf8d1a69a953554721ee7fe100816
commit e955b8dc658bf8d1a69a953554721ee7fe100816
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jan 19 09:42:09 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move gc-related procedures to new chicken.gc module
diff --git a/README b/README
index 4996042a..08740db8 100644
--- a/README
+++ b/README
@@ -294,6 +294,7 @@
| | |-- chicken.files.import.so
| | |-- chicken.foreign.import.so
| | |-- chicken.format.import.so
+ | | |-- chicken.gc.import.so
| | |-- chicken.locative.import.so
| | |-- chicken.lolevel.import.so
| | |-- chicken.internal.import.so
diff --git a/batch-driver.scm b/batch-driver.scm
index 39b26df5..1c3f442c 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -44,6 +44,7 @@
chicken.data-structures
chicken.files
chicken.format
+ chicken.gc
chicken.pretty-print
chicken.compiler.support
chicken.compiler.compiler-syntax
diff --git a/chicken-install.scm b/chicken-install.scm
index 28209635..f5b5df26 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -54,6 +54,7 @@
"chicken.files.import.so"
"chicken.foreign.import.so"
"chicken.format.import.so"
+ "chicken.gc.import.so"
"chicken.import.so"
"chicken.internal.import.so"
"chicken.io.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index 3745a79f..a3a94b9e 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -51,7 +51,6 @@
cpu-time
current-error-port
current-exception-handler
- current-gc-milliseconds
current-milliseconds
current-read-table
current-seconds
@@ -148,7 +147,6 @@
fxshr
fxxor
fxlen
- gc
gensym
get
get-call-chain
@@ -177,7 +175,6 @@
make-promise
make-property-condition
maximum-flonum
- memory-statistics
minimum-flonum
module-environment
most-negative-fixnum
@@ -212,8 +209,6 @@
reset-handler
return-to-host
reverse-list->string
- set-finalizer!
- set-gc-report!
set-parameterized-read-syntax!
set-port-name!
set-read-syntax!
diff --git a/csi.scm b/csi.scm
index 55946669..f72c6656 100644
--- a/csi.scm
+++ b/csi.scm
@@ -56,6 +56,7 @@ EOF
(import chicken.data-structures
chicken.format
+ chicken.gc
chicken.io
chicken.ports
chicken.pretty-print
diff --git a/defaults.make b/defaults.make
index ffe337fa..80325cdc 100644
--- a/defaults.make
+++ b/defaults.make
@@ -264,7 +264,7 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
-DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format io locative posix \
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format gc io locative posix \
pretty-print random
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = data-structures eval repl expand \
continuation files internal irregex lolevel ports tcp utils
diff --git a/distribution/manifest b/distribution/manifest
index 31a09946..8771e47b 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -260,6 +260,8 @@ chicken.foreign.import.scm
chicken.foreign.import.c
chicken.format.import.scm
chicken.format.import.c
+chicken.gc.import.scm
+chicken.gc.import.c
chicken.internal.import.scm
chicken.internal.import.c
chicken.io.import.scm
diff --git a/eval.scm b/eval.scm
index 2225d2a4..71ffc329 100644
--- a/eval.scm
+++ b/eval.scm
@@ -82,6 +82,7 @@
(chicken.files . files)
(chicken.foreign . chicken-ffi-syntax)
(chicken.format . extras)
+ (chicken.gc . library)
(chicken.internal . internal)
(chicken.io . extras)
(chicken.irregex . irregex)
diff --git a/library.scm b/library.scm
index 5f56b3d4..f2337167 100644
--- a/library.scm
+++ b/library.scm
@@ -200,7 +200,6 @@ EOF
(define-foreign-variable main_argv c-pointer "C_main_argv")
(define-foreign-variable strerror c-string "strerror(errno)")
-(define (set-gc-report! flag) (##core#inline "C_set_gc_report" flag))
(define ##sys#gc (##core#primitive "C_gc"))
(define (##sys#setslot x i y) (##core#inline "C_i_setslot" x i y))
(define (##sys#setislot x i y) (##core#inline "C_i_set_i_slot" x i y))
@@ -213,7 +212,6 @@ EOF
(define ##sys#symbol-table-info (##core#primitive "C_get_symbol_table_info"))
(define ##sys#memory-info (##core#primitive "C_get_memory_info"))
(define (current-milliseconds) (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f))
-(define (current-gc-milliseconds) (##sys#fudge 31))
(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
(define get-environment-variable (foreign-lambda c-string "C_getenv" c-string))
(define executable-pathname (foreign-lambda c-string* "C_executable_pathname"))
@@ -5381,6 +5379,27 @@ EOF
x) ) )
+(module chicken.gc
+ (current-gc-milliseconds gc memory-statistics set-finalizer! set-gc-report!)
+
+(import scheme chicken
+ chicken.foreign)
+
+;;; GC info:
+
+(define (current-gc-milliseconds) (##sys#fudge 31))
+
+(define (set-gc-report! flag)
+ (##core#inline "C_set_gc_report" flag))
+
+;;; Memory info:
+
+(define (memory-statistics)
+ (let* ((free (##sys#gc #t))
+ (info (##sys#memory-info))
+ (hsize (##sys#slot info 0)))
+ (vector hsize (fx- hsize free) (##sys#slot info 1))))
+
;;; Finalization:
(define-foreign-variable _max_pending_finalizers int "C_max_pending_finalizers")
@@ -5462,8 +5481,7 @@ EOF
(let ((a (and (pair? arg) (car arg))))
(if a
(##sys#force-finalizers)
- (apply ##sys#gc arg) ) ) )
-
+ (##sys#gc a)))))
;;; Auxilliary definitions for safe use in quasiquoted forms and evaluated code:
@@ -5663,15 +5681,6 @@ EOF
obj) ] ) )
-;;; More memory info
-
-(define (memory-statistics)
- (let* ([free (##sys#gc #t)]
- [info (##sys#memory-info)]
- [hsize (##sys#slot info 0)] )
- (vector hsize (fx- hsize free) (##sys#slot info 1)) ) )
-
-
;;; Property lists
(define (put! sym prop val)
diff --git a/manual/Unit library b/manual/Unit library
index 9064dd19..5abf9890 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -733,15 +733,6 @@ Returns the number of milliseconds since process- or machine startup.
Returns the number of seconds since midnight, Jan. 1, 1970.
-==== current-gc-milliseconds
-
-<procedure>(current-gc-milliseconds)</procedure>
-
-Returns the number of milliseconds spent in major garbage collections since
-the last call of {{current-gc-milliseconds}} and returns an exact
-integer.
-
-
=== Interrupts and error-handling
@@ -837,7 +828,7 @@ continues execution.
=== Garbage collection
-
+The following procedures are provided by the {{(chicken gc)}} module.
==== gc
@@ -848,6 +839,14 @@ The flag specifies whether a minor ({{#f}}) or major ({{#t}}) GC is to be
triggered. If no argument is given, {{#t}} is assumed. An explicit {{#t}}
argument will cause all pending finalizers to be executed.
+==== current-gc-milliseconds
+
+<procedure>(current-gc-milliseconds)</procedure>
+
+Returns the number of milliseconds spent in major garbage collections since
+the last call of {{current-gc-milliseconds}} and returns an exact
+integer.
+
==== memory-statistics
<procedure>(memory-statistics)</procedure>
diff --git a/modules.scm b/modules.scm
index 2bd739e7..7e12ea31 100644
--- a/modules.scm
+++ b/modules.scm
@@ -938,6 +938,7 @@
(##sys#register-module-alias 'files 'chicken.files)
(##sys#register-module-alias 'foreign 'chicken.foreign)
(##sys#register-module-alias 'format 'chicken.format)
+(##sys#register-module-alias 'gc 'chicken.gc)
(##sys#register-module-alias 'io 'chicken.io)
(##sys#register-module-alias 'irregex 'chicken.irregex)
(##sys#register-module-alias 'locative 'chicken.locative)
diff --git a/rules.make b/rules.make
index f66049a9..cbd7f27f 100644
--- a/rules.make
+++ b/rules.make
@@ -519,6 +519,7 @@ $(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\
# special cases for modules not corresponding directly to units
$(eval $(call declare-emitted-import-lib-dependency,chicken.posix,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.io,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras))
@@ -541,7 +542,9 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.compiler.c-backend.import.scm \
chicken.compiler.support.import.scm \
chicken.data-structures.import.scm \
+ chicken.files.import.scm \
chicken.format.import.scm \
+ chicken.gc.import.scm \
chicken.pretty-print.import.scm
c-platform.c: c-platform.scm mini-srfi-1.scm \
chicken.compiler.optimizer.import.scm \
@@ -615,6 +618,7 @@ csc.c: csc.scm \
csi.c: csi.scm \
chicken.data-structures.import.scm \
chicken.format.import.scm \
+ chicken.gc.import.scm \
chicken.io.import.scm \
chicken.ports.import.scm \
chicken.pretty-print.import.scm
@@ -687,7 +691,8 @@ setup-download.c: setup-download.scm \
srfi-4.c: srfi-4.scm \
chicken.bitwise.import.scm \
chicken.expand.import.scm \
- chicken.foreign.import.scm
+ chicken.foreign.import.scm \
+ chicken.gc.import.scm
posixunix.c: posixunix.scm \
chicken.bitwise.import.scm \
chicken.files.import.scm \
@@ -738,7 +743,9 @@ endef
bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
- $(bootstrap-lib) -emit-import-library chicken.bitwise
+ $(bootstrap-lib) \
+ -emit-import-library chicken.bitwise \
+ -emit-import-library chicken.gc
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
diff --git a/srfi-4.scm b/srfi-4.scm
index 5d77a7b4..f86f9d39 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -81,7 +81,8 @@ EOF
(import scheme chicken)
(import chicken.bitwise
chicken.expand
- chicken.foreign)
+ chicken.foreign
+ chicken.gc)
(include "common-declarations.scm")
diff --git a/tests/embedded2.scm b/tests/embedded2.scm
index aae672db..3e44cdcf 100644
--- a/tests/embedded2.scm
+++ b/tests/embedded2.scm
@@ -1,4 +1,4 @@
-(use pretty-print)
+(use gc pretty-print)
#>
#include <assert.h>
diff --git a/tests/embedded4.scm b/tests/embedded4.scm
index cb188116..f1c49812 100644
--- a/tests/embedded4.scm
+++ b/tests/embedded4.scm
@@ -1,7 +1,9 @@
;;; x.scm
-
+
+(use gc)
+
(define (bar x) (gc) (* x x))
-
+
(define-external (baz (int i)) double
(sqrt i))
diff --git a/tests/finalizer-error-test.scm b/tests/finalizer-error-test.scm
index cf24da90..3785dd20 100644
--- a/tests/finalizer-error-test.scm
+++ b/tests/finalizer-error-test.scm
@@ -1,5 +1,7 @@
;;;; finalizer-error-test.scm - by "megane"
+(use gc)
+
(define n 10000)
(define (make-objects n)
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 41c60bfa..c2bc8dc0 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -45,6 +45,7 @@ for x in \
chicken.files.import.so \
chicken.foreign.import.so \
chicken.format.import.so \
+ chicken.gc.import.so \
chicken.internal.import.so \
chicken.io.import.so \
chicken.irregex.import.so \
diff --git a/tests/symbolgc-tests.scm b/tests/symbolgc-tests.scm
index f37074ae..30b32a4a 100644
--- a/tests/symbolgc-tests.scm
+++ b/tests/symbolgc-tests.scm
@@ -2,6 +2,8 @@
;
; - run this with the "-:w" option
+(use gc)
+
(assert (##sys#fudge 15) "please run this test with the `-:w' runtime option")
(define (gcsome #!optional (n 100))
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 3798790b..a20aa567 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1,8 +1,7 @@
;;;; syntax-tests.scm - various macro tests
(use-for-syntax pretty-print)
-(use pretty-print)
-
+(use gc pretty-print)
(define-syntax t
(syntax-rules ()
diff --git a/tests/test-finalizers-2.scm b/tests/test-finalizers-2.scm
index 09efe02d..e0bc32c9 100644
--- a/tests/test-finalizers-2.scm
+++ b/tests/test-finalizers-2.scm
@@ -1,5 +1,6 @@
;;;; test-finalizers-2.scm - test finalizers + GC roots
+(use gc)
(define (list-tabulate n proc)
(let loop ((i 0))
diff --git a/tests/test-finalizers.scm b/tests/test-finalizers.scm
index 36b51220..9539cbea 100644
--- a/tests/test-finalizers.scm
+++ b/tests/test-finalizers.scm
@@ -1,5 +1,7 @@
;;;; test-finalizers.scm
+(use gc)
+
(##sys#eval-debug-level 0) ; disable keeping trace-buffer with frameinfo
(define x (list 1 2 3))
diff --git a/tests/test-gc-hooks.scm b/tests/test-gc-hooks.scm
index 13e865b3..45be9d74 100644
--- a/tests/test-gc-hooks.scm
+++ b/tests/test-gc-hooks.scm
@@ -1,5 +1,7 @@
;;;; test-gc-hooks.scm
+(use gc)
+
#>
static int count = 0;
diff --git a/types.db b/types.db
index 95103c9d..fc64f675 100644
--- a/types.db
+++ b/types.db
@@ -968,7 +968,6 @@
#(tmp1))))
(() ##sys#current-exception-handler))
-(current-gc-milliseconds (#(procedure #:clean) current-gc-milliseconds () integer))
(current-milliseconds (#(procedure #:clean) current-milliseconds () integer))
(current-read-table
@@ -1160,7 +1159,6 @@
(fxshr (#(procedure #:clean #:foldable) fxshr (fixnum fixnum) fixnum))
(fxxor (#(procedure #:clean #:foldable) fxxor (fixnum fixnum) fixnum))
(fxlen (#(procedure #:clean #:foldable) fxlen (fixnum) fixnum))
-(gc (#(procedure #:clean) gc (#!optional *) fixnum))
(gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol))
(get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *)
@@ -1204,7 +1202,6 @@
(make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
(make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
(maximum-flonum float)
-(memory-statistics (#(procedure #:clean) memory-statistics () (vector-of fixnum)))
(minimum-flonum float)
(module-environment (#(procedure #:clean #:enforce) module-environment (symbol #!optional symbol) (struct environment)))
(most-negative-fixnum fixnum)
@@ -1249,8 +1246,14 @@
(reset-handler (#(procedure #:clean #:enforce) reset-handler (#!optional (procedure () . *)) procedure))
(return-to-host (procedure return-to-host () . *))
(reverse-list->string (#(procedure #:clean #:enforce) reverse-list->string ((list-of char)) string))
-(set-finalizer! (#(procedure #:clean #:enforce) set-finalizer! (* (procedure (*) . *)) *))
-(set-gc-report! (#(procedure #:clean) set-gc-report! (*) undefined))
+
+;; gc
+
+(chicken.gc#current-gc-milliseconds (#(procedure #:clean) chicken.gc#current-gc-milliseconds () integer))
+(chicken.gc#gc (#(procedure #:clean) chicken.gc#gc (#!optional *) fixnum))
+(chicken.gc#memory-statistics (#(procedure #:clean) chicken.gc#memory-statistics () (vector-of fixnum)))
+(chicken.gc#set-finalizer! (#(procedure #:clean #:enforce) chicken.gc#set-finalizer! (* (procedure (*) . *)) *))
+(chicken.gc#set-gc-report! (#(procedure #:clean) chicken.gc#set-gc-report! (*) undefined))
(chicken.repl#repl (#(procedure #:enforce) chicken.repl#repl (#!optional (procedure (*) . *)) undefined))
(chicken.repl#repl-prompt (#(procedure #:clean #:enforce) chicken.repl#repl-prompt (#!optional (procedure () string)) procedure))
Trap