- (dconsing 0)
- (inner-enclosed-profiles 0))
- ;;(declare (type unsigned-byte dticks dconsing))
- ;;(declare (type unsigned-byte inner-enclosed-profiles))
- (aver (typep dticks 'unsigned-byte))
- (aver (typep dconsing 'unsigned-byte))
- (aver (typep inner-enclosed-profiles 'unsigned-byte))
- (multiple-value-prog1
- (let ((start-ticks (get-internal-ticks))
- ;; KLUDGE: We add (THE UNSIGNED-BYTE ..) wrappers
- ;; around GET-BYTES-CONSED because as of
- ;; sbcl-0.6.4, at the time that the FTYPE of
- ;; GET-BYTES-CONSED is DECLAIMed, the
- ;; cross-compiler's type system isn't mature enough
- ;; to do anything about it. -- WHN 20000503
- (start-consing (the unsigned-byte (get-bytes-consed)))
- (*enclosed-ticks* 0)
- (*enclosed-consing* 0)
- (*enclosed-profiles* 0))
- (declare (inline pcounter-or-fixnum->integer))
- (multiple-value-prog1
- (multiple-value-call encapsulated-fun
- (sb-c:%more-arg-values arg-context
- 0
- arg-count))
- (let ((*computing-profiling-data-for* encapsulated-fun))
- (setf dticks (fastbig- (get-internal-ticks) start-ticks)
- dconsing (fastbig- (the unsigned-byte
- (get-bytes-consed))
- start-consing))
- (setf inner-enclosed-profiles
- (pcounter-or-fixnum->integer *enclosed-profiles*))
- (when (minusp dticks) ; REMOVEME
- (unprofile-all)
- (error "huh? (GET-INTERNAL-TICKS)=~S START-TICKS=~S"
- (get-internal-ticks) start-ticks))
- (aver (not (minusp dconsing))) ; REMOVEME
- (aver (not (minusp inner-enclosed-profiles))) ; REMOVEME
- (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
- (when (minusp net-dticks) ; REMOVEME
- (unprofile-all)
- (error "huh? DTICKS=~S, *ENCLOSED-TICKS*=~S"
- dticks *enclosed-ticks*))
- (fastbig-incf-pcounter-or-fixnum ticks net-dticks))
- (let ((net-dconsing (fastbig- dconsing *enclosed-consing*)))
- (when (minusp net-dconsing) ; REMOVEME
- (unprofile-all)
- (error "huh? DCONSING=~S, *ENCLOSED-CONSING*=~S"
- dticks *enclosed-ticks*))
- (fastbig-incf-pcounter-or-fixnum consing net-dconsing))
- (fastbig-incf-pcounter-or-fixnum profiles
- inner-enclosed-profiles))))
- (fastbig-incf-pcounter-or-fixnum *enclosed-ticks* dticks)
- (fastbig-incf-pcounter-or-fixnum *enclosed-consing* dconsing)
- (fastbig-incf-pcounter-or-fixnum *enclosed-profiles*
- (fastbig-1+
- inner-enclosed-profiles)))))
+ (dconsing 0)
+ (inner-enclosed-profiles 0)
+ (dgc-run-time 0))
+ (declare (truly-dynamic-extent dticks dconsing inner-enclosed-profiles))
+ (unwind-protect
+ (let* ((start-ticks (get-internal-ticks))
+ (start-gc-run-time *gc-run-time*)
+ (*enclosed-ticks* (make-counter))
+ (*enclosed-consing* (make-counter))
+ (*enclosed-profiles* (make-counter))
+ (nbf0 *n-bytes-freed-or-purified*)
+ (dynamic-usage-0 (sb-kernel:dynamic-usage))
+ (*enclosed-gc-run-time* (make-counter)))
+ (declare (dynamic-extent *enclosed-ticks* *enclosed-consing* *enclosed-profiles* *enclosed-gc-run-time*))
+ (unwind-protect
+ (multiple-value-call encapsulated-fun
+ (sb-c:%more-arg-values arg-context
+ 0
+ arg-count))
+ (let ((*computing-profiling-data-for* encapsulated-fun)
+ (dynamic-usage-1 (sb-kernel:dynamic-usage)))
+ (setf dticks (- (get-internal-ticks) start-ticks)
+ dconsing (if (eql *n-bytes-freed-or-purified* nbf0)
+ ;; common special case where we can avoid
+ ;; bignum arithmetic
+ (- dynamic-usage-1 dynamic-usage-0)
+ ;; general case
+ (- (get-bytes-consed) nbf0 dynamic-usage-0))
+ inner-enclosed-profiles (counter-count *enclosed-profiles*)
+ dgc-run-time (- *gc-run-time* start-gc-run-time))
+ (incf-counter ticks (- dticks (counter-count *enclosed-ticks*)))
+ (incf-counter gc-run-time (- dgc-run-time (counter-count *enclosed-gc-run-time*)))
+ (incf-counter consing (- dconsing (counter-count *enclosed-consing*)))
+ (incf-counter profiles inner-enclosed-profiles))))
+ (when (boundp '*enclosed-ticks*)
+ (incf-counter *enclosed-ticks* dticks)
+ (incf-counter *enclosed-consing* dconsing)
+ (incf-counter *enclosed-profiles* (1+ inner-enclosed-profiles))
+ (incf-counter *enclosed-gc-run-time* dgc-run-time)))))