;;;; files for more information.
(in-package "SB!KERNEL")
-
-(file-comment
- "$Header$")
\f
;;;; DYNAMIC-USAGE and friends
(defun ,lisp-fun ()
(sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))))
-(def-c-var-frob sb!vm:control-stack-start "control_stack")
-#!+x86 (def-c-var-frob control-stack-end "control_stack_end")
-(def-c-var-frob sb!vm:binding-stack-start "binding_stack")
-(def-c-var-frob sb!vm:current-dynamic-space-start "current_dynamic_space")
-
#!-sb-fluid (declaim (inline dynamic-usage))
-#!-(or cgc gencgc)
-(defun dynamic-usage ()
- (the (unsigned-byte 32)
- (- (sb!sys:sap-int (sb!c::dynamic-space-free-pointer))
- (sb!vm:current-dynamic-space-start))))
-#!+(or cgc gencgc)
(def-c-var-frob dynamic-usage "bytes_allocated")
(defun static-space-usage ()
(- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)
- sb!vm:*static-space-start*))
+ sb!vm:static-space-start))
(defun read-only-space-usage ()
(- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
- sb!vm:*read-only-space-start*))
+ sb!vm:read-only-space-start))
(defun control-stack-usage ()
#!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
- (control-stack-start))
- #!+x86 (- (control-stack-end)
+ sb!vm:control-stack-start)
+ #!+x86 (- sb!vm:control-stack-end
(sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
(defun binding-stack-usage ()
(- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
- (sb!vm:binding-stack-start)))
+ sb!vm:binding-stack-start))
\f
;;;; ROOM
(sb!alien:def-alien-routine collect-garbage sb!c-call:int
#!+gencgc (last-gen sb!c-call:int))
-#!-ibmrt
(sb!alien:def-alien-routine set-auto-gc-trigger sb!c-call:void
(dynamic-usage sb!c-call:unsigned-long))
-#!+ibmrt
-(defun set-auto-gc-trigger (bytes)
- (let ((words (ash (+ (sb!vm:current-dynamic-space-start) bytes) -2)))
- (unless (and (fixnump words) (plusp words))
- (clear-auto-gc-trigger)
- (warn "attempt to set GC trigger to something bogus: ~S" bytes))
- (setf %rt::*internal-gc-trigger* words)))
-
-#!-ibmrt
(sb!alien:def-alien-routine clear-auto-gc-trigger sb!c-call:void)
-#!+ibmrt
-(defun clear-auto-gc-trigger ()
- (setf %rt::*internal-gc-trigger* -1))
-
;;; This variable contains the function that does the real GC. This is
;;; for low-level GC experimentation. Do not touch it if you do not
;;; know what you are doing.
(set-auto-gc-trigger *gc-trigger*)
(dolist (hook *after-gc-hooks*)
(/show0 "doing a hook from *AFTER-GC--HOOKS*")
- ;; FIXME: This hook should be called with the
- ;; same kind of information as *GC-NOTIFY-AFTER*.
- ;; In particular, it would be nice for the
- ;; hook function to be able to adjust *GC-TRIGGER*
- ;; intelligently to e.g. 108% of total memory usage.
+ ;; FIXME: This hook should be called with the same
+ ;; kind of information as *GC-NOTIFY-AFTER*. In
+ ;; particular, it would be nice for the hook function
+ ;; to be able to adjust *GC-TRIGGER* intelligently to
+ ;; e.g. 108% of total memory usage.
(carefully-funcall hook))
(when *gc-notify-stream*
(/show0 "doing the *GC-NOTIFY-AFTER* thing")
(incf *gc-run-time* (- (get-internal-run-time)
start-time))))
;; FIXME: should probably return (VALUES), here and in RETURN-FROM
- (/show "returning from tail of SUB-GC")
+ (/show0 "returning from tail of SUB-GC")
nil)
;;; This routine is called by the allocation miscops to decide whether