Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
tweaked PCOUNTER stuff in anticipation of future changes in GET-BYTES-CONSED.. ..moved PCOUNTER code from profile.lisp to new pcounter.lisp ..exported PCOUNTER stuff from SB-INT
- Loading branch information
William Harold Newman
committed
Jun 23, 2001
1 parent
b33fd68
commit f3af39f
Showing
5 changed files
with
106 additions
and
72 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,93 @@ | ||
;;;; PCOUNTERs | ||
;;;; | ||
;;;; a PCOUNTER is used to represent an unsigned integer quantity which | ||
;;;; can grow bigger than a fixnum, but typically does so, if at all, | ||
;;;; in many small steps, where we don't want to cons on every step. | ||
;;;; Such quantities typically arise in profiling, e.g. | ||
;;;; total system consing, time spent in a profiled function, and | ||
;;;; bytes consed in a profiled function are all examples of such | ||
;;;; quantities. The name is an abbreviation for "Profiling COUNTER". | ||
;;;; | ||
;;;; It's not one of my more brilliant names, if you have a better | ||
;;;; suggestion, I might be interested. -- WHN 2001-06-22 | ||
|
||
(in-package "SB!IMPL") | ||
|
||
;;;; basic PCOUNTER stuff | ||
|
||
(/show0 "pcounter.lisp 16") | ||
|
||
(defstruct (pcounter (:copier nil)) | ||
(integer 0);; :type unsigned-byte) | ||
(fixnum 0));; :type (and fixnum unsigned-byte))) | ||
|
||
(/show0 "pcounter.lisp 22") | ||
|
||
(declaim (ftype (function (pcounter unsigned-byte) pcounter) incf-pcounter)) | ||
;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable | ||
(defun incf-pcounter (pcounter delta) | ||
(aver (typep delta 'unsigned-byte)) | ||
(let ((sum (+ (pcounter-fixnum pcounter) delta))) | ||
(aver (typep sum 'unsigned-byte)) | ||
;;(declare (type unsigned-byte sum)) | ||
(cond ((typep sum 'fixnum) | ||
(setf (pcounter-fixnum pcounter) sum)) | ||
(t | ||
(incf (pcounter-integer pcounter) sum) | ||
(setf (pcounter-fixnum pcounter) 0)))) | ||
pcounter) | ||
|
||
(/show0 "pcounter.lisp 36") | ||
|
||
(declaim (ftype (function (pcounter) integer) pcounter->integer)) | ||
;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable | ||
(defun pcounter->integer (pcounter) | ||
(+ (pcounter-integer pcounter) | ||
(pcounter-fixnum pcounter))) | ||
|
||
;;;; operations on (OR PCOUNTER FIXNUM) | ||
;;;; | ||
;;;; When we don't want to cons a PCOUNTER unless we're forced to, we | ||
;;;; start with a FIXNUM counter and only create a PCOUNTER if the | ||
;;;; FIXNUM overflows. | ||
|
||
(/show0 "pcounter.lisp 50") | ||
|
||
(declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum)) | ||
;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable | ||
(defun %incf-pcounter-or-fixnum (x delta) | ||
(etypecase x | ||
(fixnum | ||
(let ((sum (+ x delta))) | ||
(if (typep sum 'fixnum) | ||
sum | ||
(make-pcounter :integer sum)))) | ||
(pcounter | ||
(incf-pcounter x delta)))) | ||
|
||
(define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum) | ||
|
||
(/show0 "pcounter.lisp 64") | ||
|
||
;;; Trade off space for execution time by handling the common fast | ||
;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic | ||
;;; arithmetic as a last resort. | ||
(defmacro fastbig-incf-pcounter-or-fixnum (x delta) | ||
(let ((delta-sym (gensym "DELTA"))) | ||
`(let ((,delta-sym ,delta)) | ||
(aver (typep ,delta-sym 'unsigned-byte)) | ||
;;(declare (type unsigned-byte ,delta-sym)) | ||
(if (typep ,delta-sym 'fixnum) | ||
(incf-pcounter-or-fixnum ,x ,delta) | ||
(incf-pcounter-or-fixnum ,x ,delta))))) | ||
|
||
(/show0 "pcounter.lisp 80") | ||
|
||
(declaim (ftype (function ((or pcounter fixnum)) integer) pcounter-or-fixnum->integer)) | ||
(declaim (maybe-inline pcounter-or-fixnum->integer)) | ||
(defun pcounter-or-fixnum->integer (x) | ||
(etypecase x | ||
(fixnum x) | ||
(pcounter (pcounter->integer x)))) | ||
|
||
(/show0 "pcounter.lisp end") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters