X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=27d08c79210dc37d15b8adf61f5f607ec5c90fb7;hb=6973177fbe23d007655345c1fe2e0d6a5e397aa5;hp=45a8a36932e080b01affb414d1192c6adfd38211;hpb=adf0d51d2bde8b723276bacf94641df9aa5ae561;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 45a8a36..27d08c7 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!KERNEL") - -(file-comment - "$Header$") ;;;; DYNAMIC-USAGE and friends @@ -26,18 +23,7 @@ (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 () @@ -46,17 +32,17 @@ (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) + control-stack-start) + #!+x86 (- 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)) ;;;; ROOM @@ -254,25 +240,11 @@ (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.