From bde2d08778488aba0ff0c30bc0afb17fbdacb4e4 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 1 Aug 2001 02:06:18 +0000 Subject: [PATCH] 0.6.12.59: simplified *N-BYTES-FREED-OR-PURIFIED-PCOUNTER* to *N-BYTES-FREED-OR-PURIFIED*, an ordinary UNSIGNED-BYTE cleared *N-BYTES-FREED-OR-PURIFIED* on program startup --- package-data-list.lisp-expr | 2 +- src/code/gc.lisp | 19 ++++++++++---- src/code/print.lisp | 58 ++++++++++++++++++++----------------------- src/code/profile.lisp | 26 +++---------------- version.lisp-expr | 2 +- 5 files changed, 47 insertions(+), 60 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 21a6d6f..588d14a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -704,7 +704,7 @@ retained, possibly temporariliy, because it might be used internally." "PCOUNTER->INTEGER" "PCOUNTER-OR-FIXNUM->INTEGER" "PCOUNTER-P" - "*N-BYTES-FREED-OR-PURIFIED-PCOUNTER*" + "*N-BYTES-FREED-OR-PURIFIED*" ;; miscellaneous non-standard but handy user-level functions.. "ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ" diff --git a/src/code/gc.lisp b/src/code/gc.lisp index c3a5998..5ed0b35 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -109,8 +109,17 @@ ;;; (We save this so that we can calculate the total number of bytes ;;; ever allocated by adding this to the number of bytes currently ;;; allocated and never freed.) -(declaim (type pcounter *n-bytes-freed-or-purified-pcounter*)) -(defvar *n-bytes-freed-or-purified-pcounter* (make-pcounter)) +(declaim (type unsigned-byte *n-bytes-freed-or-purified*)) +(defvar *n-bytes-freed-or-purified* 0) +(push (lambda () + (setf *n-bytes-freed-or-purified* 0)) + ;; KLUDGE: It's probably not quite safely right either to do + ;; this in *BEFORE-SAVE-INITIALIZATIONS* (since consing, or even + ;; worse, something which depended on (GET-BYTES-CONSED), might + ;; happen after that) or in *AFTER-SAVE-INITIALIZATIONS*. But + ;; it's probably not a big problem, and there seems to be no + ;; other obvious time to do it. -- WHN 2001-07-30 + *after-save-initializations*) (declaim (ftype (function () unsigned-byte) get-bytes-consed)) (defun get-bytes-consed () @@ -122,7 +131,7 @@ probably want either to hack in at a lower level (as the code in the SB-PROFILE package does), or to design a more microefficient interface and submit it as a patch." (+ (dynamic-usage) - (pcounter->integer *n-bytes-freed-or-purified-pcounter*))) + *n-bytes-freed-or-purified*)) ;;;; variables and constants @@ -338,8 +347,8 @@ has finished GC'ing.") (eff-n-bytes-freed (max 0 n-bytes-freed))) (declare (ignore ignore-me)) (/show0 "got (DYNAMIC-USAGE) and EFF-N-BYTES-FREED") - (incf-pcounter *n-bytes-freed-or-purified-pcounter* - eff-n-bytes-freed) + (incf *n-bytes-freed-or-purified* + eff-n-bytes-freed) (/show0 "clearing *NEED-TO-COLLECT-GARBAGE*") (setf *need-to-collect-garbage* nil) (/show0 "calculating NEW-GC-TRIGGER") diff --git a/src/code/print.lisp b/src/code/print.lisp index 66c865e..ef0fb4e 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -148,13 +148,13 @@ ((:pprint-dispatch *print-pprint-dispatch*) *print-pprint-dispatch*)) #!+sb-doc - "Outputs OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*" + "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*" (output-object object (out-synonym-of stream)) object) (defun prin1 (object &optional stream) #!+sb-doc - "Outputs a mostly READable printed representation of OBJECT on the specified + "Output a mostly READable printed representation of OBJECT on the specified STREAM." (let ((*print-escape* T)) (output-object object (out-synonym-of stream))) @@ -162,7 +162,7 @@ (defun princ (object &optional stream) #!+sb-doc - "Outputs an aesthetic but not necessarily READable printed representation + "Output an aesthetic but not necessarily READable printed representation of OBJECT on the specified STREAM." (let ((*print-escape* NIL) (*print-readably* NIL)) @@ -171,7 +171,7 @@ (defun print (object &optional stream) #!+sb-doc - "Outputs a terpri, the mostly READable printed represenation of OBJECT, and + "Output a newline, the mostly READable printed representation of OBJECT, and space to the specified STREAM." (let ((stream (out-synonym-of stream))) (terpri stream) @@ -181,7 +181,7 @@ (defun pprint (object &optional stream) #!+sb-doc - "Prettily outputs OBJECT preceded by a newline." + "Prettily output OBJECT preceded by a newline." (let ((*print-pretty* t) (*print-escape* t) (stream (out-synonym-of stream))) @@ -208,18 +208,18 @@ ((:pprint-dispatch *print-pprint-dispatch*) *print-pprint-dispatch*)) #!+sb-doc - "Returns the printed representation of OBJECT as a string." + "Return the printed representation of OBJECT as a string." (stringify-object object)) (defun prin1-to-string (object) #!+sb-doc - "Returns the printed representation of OBJECT as a string with + "Return the printed representation of OBJECT as a string with slashification on." (stringify-object object t)) (defun princ-to-string (object) #!+sb-doc - "Returns the printed representation of OBJECT as a string with + "Return the printed representation of OBJECT as a string with slashification off." (stringify-object object nil)) @@ -288,18 +288,17 @@ ;;; marker, it is incremented. (defvar *circularity-counter* nil) +;;; Check to see whether OBJECT is a circular reference, and return something +;;; non-NIL if it is. If ASSIGN is T, then the number to use in the #n= and +;;; #n# noise is assigned at this time. Note: CHECK-FOR-CIRCULARITY must +;;; be called *EXACTLY* once with ASSIGN T, or the circularity detection noise +;;; will get confused about when to use #n= and when to use #n#. If this +;;; returns non-NIL when ASSIGN is T, then you must call HANDLE-CIRCULARITY +;;; on it. If you are not using this inside a WITH-CIRCULARITY-DETECTION, +;;; then you have to be prepared to handle a return value of :INITIATE which +;;; means it needs to initiate the circularity detection noise. See the +;;; source for info on how to do that. (defun check-for-circularity (object &optional assign) - #!+sb-doc - "Check to see whether OBJECT is a circular reference, and return something - non-NIL if it is. If ASSIGN is T, then the number to use in the #n= and - #n# noise is assigned at this time. Note: CHECK-FOR-CIRCULARITY must - be called *EXACTLY* once with ASSIGN T, or the circularity detection noise - will get confused about when to use #n= and when to use #n#. If this - returns non-NIL when ASSIGN is T, then you must call HANDLE-CIRCULARITY - on it. If you are not using this inside a WITH-CIRCULARITY-DETECTION, - then you have to be prepared to handle a return value of :INITIATE which - means it needs to initiate the circularity detection noise. See the - source for info on how to do that." (cond ((null *print-circle*) ;; Don't bother, nobody cares. nil) @@ -344,11 +343,10 @@ ;; Second or later occurance. (- value))))))) +;;; Handle the results of CHECK-FOR-CIRCULARITY. If this returns T then +;;; you should go ahead and print the object. If it returns NIL, then +;;; you should blow it off. (defun handle-circularity (marker stream) - #!+sb-doc - "Handle the results of CHECK-FOR-CIRCULARITY. If this returns T then - you should go ahead and print the object. If it returns NIL, then - you should blow it off." (case marker (:initiate ;; Someone forgot to initiate circularity detection. @@ -379,9 +377,8 @@ arguments (the object and the stream) or NIL to indicate that there is no pretty printer installed.") +;;; Output OBJECT to STREAM observing all printer control variables. (defun output-object (object stream) - #!+sb-doc - "Output OBJECT to STREAM observing all printer control variables." (labels ((print-it (stream) (if *print-pretty* (if *pretty-printer* @@ -423,12 +420,11 @@ (t (print-it stream))))) +;;; Output OBJECT to STREAM observing all printer control variables +;;; except for *PRINT-PRETTY*. Note: if *PRINT-PRETTY* is non-NIL, +;;; then the pretty printer will be used for any components of OBJECT, +;;; just not for OBJECT itself. (defun output-ugly-object (object stream) - #!+sb-doc - "Output OBJECT to STREAM observing all printer control variables except - for *PRINT-PRETTY*. Note: if *PRINT-PRETTY* is non-NIL, then the pretty - printer will be used for any components of OBJECT, just not for OBJECT - itself." (typecase object ;; KLUDGE: The TYPECASE approach here is non-ANSI; the ANSI definition of ;; PRINT-OBJECT says it provides printing and we're supposed to provide @@ -610,7 +606,7 @@ (declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit)) *character-attributes*)) -;;; Constants which are a bit-mask for each interesting character attribute. +;;; constants which are a bit-mask for each interesting character attribute (defconstant other-attribute (ash 1 0)) ; Anything else legal. (defconstant number-attribute (ash 1 1)) ; A numeric digit. (defconstant uppercase-attribute (ash 1 2)) ; An uppercase letter. diff --git a/src/code/profile.lisp b/src/code/profile.lisp index 524b5fd..02fc54a 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -169,18 +169,7 @@ (*enclosed-ticks* 0) (*enclosed-consing* 0) (*enclosed-profiles* 0) - (nbf-pcounter *n-bytes-freed-or-purified-pcounter*) - ;; Typically NBF-PCOUNTER will represent a bignum. - ;; In general we don't want to cons up a new - ;; bignum for every encapsulated call, so instead - ;; we keep track of the PCOUNTER internals, so - ;; that as long as we only cons small amounts, - ;; we'll almost always just do fixnum arithmetic. - ;; (And for encapsulated functions which cons - ;; large amounts, then a single extra consed - ;; bignum tends to be proportionally negligible.) - (nbf0-integer (pcounter-integer nbf-pcounter)) - (nbf0-fixnum (pcounter-fixnum nbf-pcounter)) + (nbf0 *n-bytes-freed-or-purified*) (dynamic-usage-0 (sb-kernel:dynamic-usage))) (declare (inline pcounter-or-fixnum->integer)) (multiple-value-prog1 @@ -192,19 +181,12 @@ (dynamic-usage-1 (sb-kernel:dynamic-usage))) (setf dticks (fastbig- (get-internal-ticks) start-ticks)) (setf dconsing - (if (and (eq (pcounter-integer nbf-pcounter) - nbf0-integer) - (eq (pcounter-fixnum nbf-pcounter) - nbf0-fixnum)) + (if (eql *n-bytes-freed-or-purified* nbf0) ;; common special case where we can avoid ;; bignum arithmetic - (- dynamic-usage-1 - dynamic-usage-0) + (- dynamic-usage-1 dynamic-usage-0) ;; general case - (- (get-bytes-consed) - nbf0-integer - nbf0-fixnum - dynamic-usage-0))) + (- (get-bytes-consed) nbf0 dynamic-usage-0))) (setf inner-enclosed-profiles (pcounter-or-fixnum->integer *enclosed-profiles*)) (let ((net-dticks (fastbig- dticks *enclosed-ticks*))) diff --git a/version.lisp-expr b/version.lisp-expr index 15245d5..753e5a1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; four numeric fields, is used for versions which aren't released ;;; but correspond only to CVS tags or snapshots. -"0.6.12.58" +"0.6.12.59" -- 1.7.10.4