Skip to content
Snippets Groups Projects
Commit 45380dbb authored by rtoy's avatar rtoy
Browse files

First cut at GCing static vectors, including static simple-arrays.

This is done by a simple mark-and-sweep GC of the static vectors.
When scavenging the spaces, we mark any static vectors by setting the
MSB of the header word.  After GC is done, an *after-gc-hooks*
function finds all of the static vectors that are not marked and frees
them.  For marked static vectors, we clear the mark bit.

code/array.lisp:
o Add *STATIC-VECTORS* to keep track of all static vectors that have
  been allocated.
o Update MAKE-ARRAY
  - to allow generation of static simple unboxed arrays (1D arrays
    without an array header).
  - Push a weak pointer to the static vector onto *STATIC-VECTORS*
o Add function FREE-STATIC-VECTOR
o Add function FINALIZE-STATIC-VECTORS to free static vectors when
  they are no longer referenced.

lisp/gencgc.c:
o Update scavenge to check for static vectors.  If we find a static
  vector, mark the static vector by setting the MSB of the header
  word.
parent c9b51edb
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.48 2009/12/01 14:14:59 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.49 2009/12/05 03:20:36 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -158,6 +158,9 @@ ...@@ -158,6 +158,9 @@
(bit #.vm:complex-bit-vector-type) (bit #.vm:complex-bit-vector-type)
(t #.vm:complex-vector-type))) (t #.vm:complex-vector-type)))
(defvar *static-vectors* nil
"List of weak-pointers to static vectors. Needed for GCing static vectors")
(defun make-array (dimensions &key (defun make-array (dimensions &key
(element-type t) (element-type t)
(initial-element nil initial-element-p) (initial-element nil initial-element-p)
...@@ -194,8 +197,7 @@ ...@@ -194,8 +197,7 @@
(static-array-p (eq allocation :malloc)) (static-array-p (eq allocation :malloc))
(simple (and (null fill-pointer) (simple (and (null fill-pointer)
(not adjustable) (not adjustable)
(null displaced-to) (null displaced-to))))
(not static-array-p))))
(declare (fixnum array-rank)) (declare (fixnum array-rank))
(when (and displaced-index-offset (null displaced-to)) (when (and displaced-index-offset (null displaced-to))
(error "Can't specify :displaced-index-offset without :displaced-to")) (error "Can't specify :displaced-index-offset without :displaced-to"))
...@@ -210,14 +212,19 @@ ...@@ -210,14 +212,19 @@
(declare (type (unsigned-byte 8) type) (declare (type (unsigned-byte 8) type)
(type (integer 1 256) bits)) (type (integer 1 256) bits))
(let* ((length (car dimensions)) (let* ((length (car dimensions))
(array (allocate-vector (array (if static-array-p
type (let ((v (make-static-vector length element-type)))
length (system::without-gcing
(ceiling (* (if (= type vm:simple-string-type) (push (make-weak-pointer v) *static-vectors*))
(1+ length) v)
length) (allocate-vector
bits) type
vm:word-bits)))) length
(ceiling (* (if (= type vm:simple-string-type)
(1+ length)
length)
bits)
vm:word-bits)))))
(declare (type index length)) (declare (type index length))
(when initial-element-p (when initial-element-p
(fill array initial-element)) (fill array initial-element))
...@@ -268,16 +275,9 @@ ...@@ -268,16 +275,9 @@
(setf (%array-available-elements array) total-size) (setf (%array-available-elements array) total-size)
(setf (%array-data-vector array) data) (setf (%array-data-vector array) data)
(when static-array-p (when static-array-p
;; Add finalizer to the static array to GC it when the array header is GCed. ;; Add weak-pointer to static vector for GC support.
(finalize array #'(lambda () (system:without-gcing
(let ((addr (logandc1 vm:lowtag-mask (kernel:get-lisp-obj-address data)))) (push (make-weak-pointer data) *static-vectors*)))
(format t "~&Freeing foreign vector at #x~X~%"
addr)
(alien:alien-funcall
(alien:extern-alien "free"
(function c-call:void
sys:system-area-pointer))
(sys:int-sap addr))))))
(cond (displaced-to (cond (displaced-to
(when (or initial-element-p initial-contents-p) (when (or initial-element-p initial-contents-p)
(error "Neither :initial-element nor :initial-contents ~ (error "Neither :initial-element nor :initial-contents ~
...@@ -360,6 +360,54 @@ ...@@ -360,6 +360,54 @@
(- (* 2 vm:word-bytes))))) (- (* 2 vm:word-bytes)))))
(logbitp vm:type-bits header))))) (logbitp vm:type-bits header)))))
(defun free-static-vector (vector)
(let ((addr (logandc1 vm:lowtag-mask (kernel:get-lisp-obj-address vector))))
(format t "~&Freeing foreign vector at #x~X~%"
addr)
(alien:alien-funcall
(alien:extern-alien "free"
(function c-call:void
sys:system-area-pointer))
(sys:int-sap addr))))
(defun finalize-static-vectors ()
;; Run down the list of weak-pointers to static vectors. Look at
;; the static vector and see if vector is marked. If so, clear the
;; mark, and do nothing. If the mark is not set, then the vector is
;; free, so free it, and remove this weak-pointer from the list.
;; The mark bit the MSB of the header word. Look at scavenge in
;; gencgc.c.
(when *static-vectors*
(let ((*print-array* nil))
(format t "Finalizing static vectors ~S~%" *static-vectors*))
(setf *static-vectors*
(delete-if
#'(lambda (wp)
(let ((vector (weak-pointer-value wp)))
(when vector
(let* ((sap (sys:vector-sap vector))
(header (sys:sap-ref-32 sap (* -2 vm:word-bytes))))
(format t "static vector ~A. header = ~X~%"
vector header)
(cond ((logbitp 31 header)
;; Clear mark
(setf (sys:sap-ref-32 sap (* -2 vm:word-bytes))
(logand header #x7fffffff))
(let ((*print-array* nil))
(format t "static vector ~A in use~%" vector))
nil)
(t
;; Mark was clear so free the vector
(setf (weak-pointer-value wp) nil)
(let ((*print-array* nil))
(format t "Free static vector ~A~%" vector))
(free-static-vector vector)
t))))))
*static-vectors*))))
(pushnew 'finalize-static-vectors *after-gc-hooks*)
;;; DATA-VECTOR-FROM-INITS returns a simple vector that has the specified array ;;; DATA-VECTOR-FROM-INITS returns a simple vector that has the specified array
;;; characteristics. Dimensions is only used to pass to FILL-DATA-VECTOR ;;; characteristics. Dimensions is only used to pass to FILL-DATA-VECTOR
;;; for error checking on the structure of initial-contents. ;;; for error checking on the structure of initial-contents.
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
* *
* Douglas Crosher, 1996, 1997, 1998, 1999. * Douglas Crosher, 1996, 1997, 1998, 1999.
* *
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.101 2009/11/02 15:05:07 rtoy Exp $ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.102 2009/12/05 03:20:37 rtoy Exp $
* *
*/ */
...@@ -1950,6 +1950,58 @@ new_space_p(lispobj obj) ...@@ -1950,6 +1950,58 @@ new_space_p(lispobj obj)
(unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages
&& PAGE_GENERATION(page_index) == new_space; && PAGE_GENERATION(page_index) == new_space;
} }
static inline boolean
dynamic_space_p(lispobj obj)
{
lispobj end = DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE;
return (obj >= DYNAMIC_0_SPACE_START) && (obj < end);
}
static inline boolean
static_space_p(lispobj obj)
{
lispobj end = SymbolValue(STATIC_SPACE_FREE_POINTER);
return (obj >= STATIC_SPACE_START) && (obj < end);
}
static inline boolean
read_only_space_p(lispobj obj)
{
lispobj end = SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
return (obj >= READ_ONLY_SPACE_START) && (obj < end);
}
static inline boolean
control_stack_space_p(lispobj obj)
{
lispobj end = CONTROL_STACK_START + CONTROL_STACK_SIZE;
return (obj >= CONTROL_STACK_START) && (obj < end);
}
static inline boolean
binding_stack_space_p(lispobj obj)
{
lispobj end = BINDING_STACK_START + BINDING_STACK_SIZE;
return (obj >= BINDING_STACK_START) && (obj < end);
}
static inline boolean
signal_space_p(lispobj obj)
{
#ifdef SIGNAL_STACK_START
lispobj end = SIGNAL_STACK_START + SIGSTKSZ;
return (obj >= SIGNAL_STACK_START) && (obj < end);
#else
return FALSE;
#endif
}
/* Copying Objects */ /* Copying Objects */
...@@ -2357,10 +2409,73 @@ scavenge(void *start_obj, long nwords) ...@@ -2357,10 +2409,73 @@ scavenge(void *start_obj, long nwords)
if (first_word == 0x01) { if (first_word == 0x01) {
*start = ptr[1]; *start = ptr[1];
words_scavenged = 1; words_scavenged = 1;
} else } else {
words_scavenged = scavtab[TypeOf(object)] (start, object); words_scavenged = scavtab[TypeOf(object)] (start, object);
} else }
words_scavenged = 1; } else if (dynamic_space_p(object) || new_space_p(object) || static_space_p(object)
|| read_only_space_p(object) || control_stack_space_p(object)
|| binding_stack_space_p(object) || signal_space_p(object)) {
words_scavenged = 1;
} else {
lispobj *ptr = (lispobj *) PTR(object);
words_scavenged = 1;
fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", (void*)object, ptr);
if (object < 0xf0000000) {
lispobj header = *ptr;
fprintf(stderr, " Header value = 0x%x\n", header);
switch (TypeOf(header)) {
/*
* This needs to be coordinated to the set of allowed
* static vectors in make-array.
*/
case type_SimpleString:
case type_SimpleArrayUnsignedByte8:
case type_SimpleArrayUnsignedByte16:
case type_SimpleArrayUnsignedByte32:
#ifdef type_SimpleArraySignedByte8
case type_SimpleArraySignedByte8:
#endif
#ifdef type_SimpleArraySignedByte16
case type_SimpleArraySignedByte16:
#endif
#ifdef type_SimpleArraySignedByte32
case type_SimpleArraySignedByte32:
#endif
case type_SimpleArraySingleFloat:
case type_SimpleArrayDoubleFloat:
#ifdef type_SimpleArrayLongFloat
case type_SimpleArrayLongFloat:
#endif
#ifdef type_SimpleArrayComplexSingleFloat
case type_SimpleArrayComplexSingleFloat:
#endif
#ifdef type_SimpleArrayComplexDoubleFloat
case type_SimpleArrayComplexDoubleFloat:
#endif
#ifdef type_SimpleArrayComplexLongFloat
case type_SimpleArrayComplexLongFloat:
#endif
{
int static_p;
fprintf(stderr, "Possible static vector at %p. header = 0x%x\n",
ptr, header);
static_p = (HeaderValue(header) & 1) == 1;
if (static_p) {
/*
* We have a static vector. Mark it as
* reachable by setting the MSB of the header.
*/
*ptr = header | 0x80000000;
fprintf(stderr, "Scavenged static vector @%p, header = 0x%x\n",
ptr, header);
}
}
}
}
}
} else if ((object & 3) == 0) } else if ((object & 3) == 0)
words_scavenged = 1; words_scavenged = 1;
else else
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment