Skip to content

Commit

Permalink
0.6.12.38:
Browse files Browse the repository at this point in the history
	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
Show file tree
Hide file tree
Showing 5 changed files with 106 additions and 72 deletions.
10 changes: 10 additions & 0 deletions package-data-list.lisp-expr
Expand Up @@ -690,6 +690,16 @@ retained, possibly temporariliy, because it might be used internally."
"PHYSICALIZE-PATHNAME"
"SANE-DEFAULT-PATHNAME-DEFAULTS"

;; PCOUNTERs
"FASTBIG-INCF-PCOUNTER-OR-FIXNUM"
"INCF-PCOUNTER"
"INCF-PCOUNTER-OR-FIXNUM"
"MAKE-PCOUNTER"
"PCOUNTER"
"PCOUNTER->INTEGER"
"PCOUNTER-OR-FIXNUM->INTEGER"
"PCOUNTER-P"

;; miscellaneous non-standard but handy user-level functions..
"ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ"
"%FIND-PACKAGE-OR-LOSE" "FIND-UNDELETED-PACKAGE-OR-LOSE"
Expand Down
93 changes: 93 additions & 0 deletions src/code/pcounter.lisp
@@ -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")
71 changes: 0 additions & 71 deletions src/code/profile.lisp
Expand Up @@ -21,77 +21,6 @@
(declaim (inline get-internal-ticks))
(defun get-internal-ticks () (get-internal-run-time))

;;;; PCOUNTER

;;; 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.
;;; (Total system consing, time spent in a profiled function, and
;;; bytes consed in a profiled function are all examples of such
;;; quantities.)
(defstruct (pcounter (:copier nil))
(integer 0);; :type unsigned-byte)
(fixnum 0));; :type (and fixnum unsigned-byte)))

;;;(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)

(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.

(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)

;;; 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)))))

(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))))

;;;; implementation-dependent interfaces

#|
Expand Down
2 changes: 2 additions & 0 deletions stems-and-flags.lisp-expr
Expand Up @@ -127,6 +127,8 @@
;; accessors.)
("src/code/type-class")

("src/code/pcounter" :not-host)

("src/code/lisp-stream" :not-host)

("src/code/sysmacs" :not-host)
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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.37"
"0.6.12.38"

0 comments on commit f3af39f

Please sign in to comment.