From c5b1723b27606ba18543dec5c12d34182dba4d1c Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 8 Jun 2001 16:37:07 +0000 Subject: [PATCH] (Oops!): (I screwed up the attributions in two earlier commits. The inline type test stuff referred to in the 0.6.12.24 commit message was originally due to Douglas Thomas Crosher, not Pierre Mai; and although two of the bug fixes in the PCL patch merged in 0.6.12.25 were originally due to Pierre Mai and only ported by Martin Atzmueller, most of that patch was original work by Martin Atzmueller.) 0.6.12.27: DB's bugfix for CIRCULAR-LIST-P sbcl-devel 2001-06-08 minor profiling fixes (The SIGILL problem above seems to've been SBCL/OpenBSD's way of reporting an infinite recursion error. It *would* be nice to catch infinite recursion cleanly someday..) --- src/code/extensions.lisp | 2 +- src/code/profile.lisp | 80 +++++++++++++++++++++--------------- tests/compiler-1.impure-cload.lisp | 18 ++++++-- version.lisp-expr | 2 +- 4 files changed, 64 insertions(+), 38 deletions(-) diff --git a/src/code/extensions.lisp b/src/code/extensions.lisp index 7dd9b95..da44a34 100644 --- a/src/code/extensions.lisp +++ b/src/code/extensions.lisp @@ -98,7 +98,7 @@ (do ((y x (safe-cddr y)) (started-p nil t) (z x (cdr z))) - ((or (not z) (not y)) nil) + ((not (and (consp z) (consp y))) nil) (when (and started-p (eq y z)) (return t)))))) diff --git a/src/code/profile.lisp b/src/code/profile.lisp index d52c13c..6c098bf 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -146,6 +146,12 @@ (defvar *enclosed-profiles* 0) (declaim (type (or pcounter fixnum) *enclosed-profiles*)) +;;; the encapsulated function we're currently computing profiling data +;;; for, recorded so that we can detect the problem of +;;; PROFILE-computing machinery calling a function which has itself +;;; been PROFILEd +(defvar *computing-profiling-data-for*) + ;;; the components of profiling overhead (defstruct (overhead (:copier nil)) ;; the number of ticks a bare function call takes. This is @@ -208,6 +214,13 @@ ;; ENCAPSULATION-FUN (lambda (sb-c:&more arg-context arg-count) (declare (optimize speed safety)) + ;; Make sure that we're not recursing infinitely. + (when (boundp '*computing-profiling-data-for*) + (unprofile-all) ; to avoid further recursion + (error "~@" + *computing-profiling-data-for* + encapsulated-fun + encapsulated-fun)) ;; FIXME: Probably when this is stable, we should optimize (SAFETY 0). (fastbig-incf-pcounter-or-fixnum count 1) (let ((dticks 0) @@ -236,29 +249,33 @@ (sb-c:%more-arg-values arg-context 0 arg-count)) - (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 - (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 - (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 - (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))) + (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* @@ -266,14 +283,10 @@ inner-enclosed-profiles))))) ;; READ-STATS-FUN (lambda () - (format t "/entering READ-STATS-FUN ~S ~S ~S ~S~%" - count ticks consing profiles) ; REMOVEME (and M-V-PROG1 below) - (multiple-value-prog1 - (values (pcounter-or-fixnum->integer count) - (pcounter-or-fixnum->integer ticks) - (pcounter-or-fixnum->integer consing) - (pcounter-or-fixnum->integer profiles)) - (print "/returning from READ-STATS-FUN"))) + (values (pcounter-or-fixnum->integer count) + (pcounter-or-fixnum->integer ticks) + (pcounter-or-fixnum->integer consing) + (pcounter-or-fixnum->integer profiles))) ;; CLEAR-STATS-FUN (lambda () (setf count 0 @@ -499,7 +512,10 @@ a very-long-running Lisp process." ;;;; overhead estimation ;;; We average the timing overhead over this many iterations. -(defconstant +timer-overhead-iterations+ 50000) +(defconstant +timer-overhead-iterations+ + 50 ; REMOVEME + ;;50000 + ) ;;; a dummy function that we profile to find profiling overhead (declaim (notinline compute-overhead-aux)) diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 5a9c05b..1b308f9 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -44,10 +44,10 @@ (assert (= (exercise-valuesify 1.25) 2.25)) ;;; Don Geddis reported this test case 25 December 1999 on a CMU CL -;;; mailing list: dumping circular lists caused an infinite loop. -;;; Douglas Crosher reported a patch 27 Dec 1999. The patch was tested -;;; on SBCL by Martin Atzmueller 2 Nov 2000, and merged in -;;; sbcl-0.6.8.11. +;;; mailing list: dumping circular lists caused the compiler to enter +;;; an infinite loop. Douglas Crosher reported a patch 27 Dec 1999. +;;; The patch was tested on SBCL by Martin Atzmueller 2 Nov 2000, and +;;; merged in sbcl-0.6.8.11. (defun q-dg1999-1 () (dolist (x '#1=("A" "B" . #1#)) x)) (defun q-dg1999-2 () (dolist (x '#1=("C" "D" . #1#)) x)) (defun q-dg1999-3 () (dolist (x '#1=("E" "F" . #1#)) x)) @@ -67,4 +67,14 @@ (declaim (ftype function i-am-just-a-function)) (defun i-am-just-a-function (x y) (+ x y 1)) +;;; Stig E SandPHI (where PHI is some phi-like character not +;;; representable in ASCII) reported in cclan-Bugs-431263 that SBCL +;;; couldn't compile this. sbcl-0.6.12.26 died in CIRCULAR-LIST-P with +;;; "The value \"EST\" is not of type LIST." Dan Barlow fixed it. +(defvar +time-zones+ + '((5 "EDT" . "EST") (6 "CDT" . "CST") (7 "MDT" . +"MST") (8 "PDT" . "PST") + (0 "GMT" . "GDT") (-2 "MET" . "MET DST")) + "*The string representations of the time zones.") + (sb-ext:quit :unix-status 104) ; success diff --git a/version.lisp-expr b/version.lisp-expr index 6d02630..524a610 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.12.26" +"0.6.12.27" -- 1.7.10.4