/[cmucl]/src/code/gc.lisp
ViewVC logotype

Diff of /src/code/gc.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.1.2 by wlott, Mon Jun 25 20:56:00 1990 UTC revision 1.3.1.3 by wlott, Fri Jun 29 10:58:41 1990 UTC
# Line 136  Line 136 
136    
137  ;;;; Variables and Constants.  ;;;; Variables and Constants.
138    
 #|  
   
139  ;;; The default value of *BYTES-CONSED-BETWEEN-GCS* and *GC-TRIGGER*.  ;;; The default value of *BYTES-CONSED-BETWEEN-GCS* and *GC-TRIGGER*.
140  ;;;  ;;;
141  (defconstant default-bytes-consed-between-gcs 2000000)  (defconstant default-bytes-consed-between-gcs 2000000)
# Line 156  Line 154 
154  ;;;  ;;;
155  (defvar *gc-trigger* default-bytes-consed-between-gcs)  (defvar *gc-trigger* default-bytes-consed-between-gcs)
156    
 |#  
157    
158  ;;;  ;;;
159  ;;; The following specials are used to control when garbage collection  ;;; The following specials are used to control when garbage collection
# Line 290  Line 287 
287         (warn "(FUNCALL ~S~{ ~S~}) lost:~%~A" ',function ',args cond)         (warn "(FUNCALL ~S~{ ~S~}) lost:~%~A" ',function ',args cond)
288         nil)))         nil)))
289    
 #|  
   
290  ;;;  ;;;
291  ;;; SUB-GC -- Internal  ;;; SUB-GC -- Internal
292  ;;;  ;;;
# Line 320  Line 315 
315                     (carefully-funcall *gc-inhibit-hook* pre-gc-dyn-usage))                     (carefully-funcall *gc-inhibit-hook* pre-gc-dyn-usage))
316            (return-from sub-gc nil))            (return-from sub-gc nil))
317          (setf *gc-inhibit* nil) ; Reset *GC-INHIBIT*          (setf *gc-inhibit* nil) ; Reset *GC-INHIBIT*
         (multiple-value-bind  
             (winp old-mask)  
             (mach:unix-sigsetmask lockout-interrupts)  
           (unwind-protect  
               (progn  
                 (unless winp (warn "Could not set sigmask!"))  
                 (let ((*standard-output* *terminal-io*))  
                   (when verbose-p  
                     (carefully-funcall *gc-notify-before* pre-gc-dyn-usage))  
                   (dolist (hook *before-gc-hooks*)  
                     (carefully-funcall hook))  
                   (funcall *internal-gc*)  
                   (let* ((post-gc-dyn-usage (dynamic-usage))  
                          (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))  
                     (setf *need-to-collect-garbage* nil)  
                     (setf *gc-trigger*  
                           (+ post-gc-dyn-usage *bytes-consed-between-gcs*))  
                     (dolist (hook *after-gc-hooks*)  
                       (carefully-funcall hook))  
                     (when verbose-p  
                       (carefully-funcall *gc-notify-after*  
                                          post-gc-dyn-usage bytes-freed  
                                          *gc-trigger*)))))  
             (when winp  
               (unless (values (mach:unix-sigsetmask old-mask))  
                 (warn "Could not restore sigmask!"))))))))  
   nil)  
   
 |#  
   
 (defun sub-gc (verbose-p force-p)  
   (unless *already-maybe-gcing*  
     (let* ((*already-maybe-gcing* t)  
            (pre-gc-dyn-usage (dynamic-usage)))  
       (setf *need-to-collect-garbage* t)  
       (when (or force-p  
                 (and *need-to-collect-garbage* (not *gc-inhibit*)))  
         (setf *gc-inhibit* t) ; Set *GC-INHIBIT* to T before calling the hook  
         (when (and (not force-p)  
                    *gc-inhibit-hook*  
                    (carefully-funcall *gc-inhibit-hook* pre-gc-dyn-usage))  
           (return-from sub-gc nil))  
         (setf *gc-inhibit* nil) ; Reset *GC-INHIBIT*  
318          (let ((*standard-output* *terminal-io*))          (let ((*standard-output* *terminal-io*))
319            (when verbose-p            (when verbose-p
320              (carefully-funcall *gc-notify-before* pre-gc-dyn-usage))              (carefully-funcall *gc-notify-before* pre-gc-dyn-usage))
# Line 372  Line 324 
324            (let* ((post-gc-dyn-usage (dynamic-usage))            (let* ((post-gc-dyn-usage (dynamic-usage))
325                   (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))                   (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
326              (setf *need-to-collect-garbage* nil)              (setf *need-to-collect-garbage* nil)
327                (setf *gc-trigger*
328                      (+ post-gc-dyn-usage *bytes-consed-between-gcs*))
329              (dolist (hook *after-gc-hooks*)              (dolist (hook *after-gc-hooks*)
330                (carefully-funcall hook))                (carefully-funcall hook))
331              (when verbose-p              (when verbose-p
332                (carefully-funcall *gc-notify-after*                (carefully-funcall *gc-notify-after*
333                                   post-gc-dyn-usage bytes-freed 0)))))))                                   post-gc-dyn-usage bytes-freed
334                                     *gc-trigger*)))))))
335    nil)    nil)
336    
   
337  ;;;  ;;;
338  ;;; MAYBE-GC -- Internal  ;;; MAYBE-GC -- Internal
339  ;;;  ;;;
# Line 387  Line 341 
341  ;;; should occur.  The argument, object, is the newly allocated object  ;;; should occur.  The argument, object, is the newly allocated object
342  ;;; which must be returned to the caller.  ;;; which must be returned to the caller.
343  ;;;  ;;;
344  (defun maybe-gc (object)  (defun maybe-gc (&optional object)
345    (sub-gc *gc-verbose* nil)    (sub-gc *gc-verbose* nil)
346    object)    object)
347    

Legend:
Removed from v.1.3.1.2  
changed lines
  Added in v.1.3.1.3

  ViewVC Help
Powered by ViewVC 1.1.5