From 47bcbbb709e9e35e38e34ef2ea658f5a8eb0804d Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 5 Jan 2002 02:21:00 +0000 Subject: [PATCH] 0.pre7.113: minor tweaks while hunting bug 138... ...gave PREV-LINK a painfully explicitly mnemonic name ...s/with-ir1-environment/with-belated-ir1-environment/ --- BUGS | 25 +++++++++++++++++++++++++ src/code/early-extensions.lisp | 3 +-- src/compiler/checkgen.lisp | 4 ++-- src/compiler/dfo.lisp | 3 +-- src/compiler/ir1-translators.lisp | 14 +++++++------- src/compiler/ir1opt.lisp | 15 ++++++++------- src/compiler/ir1tran.lisp | 13 ++++++------- src/compiler/ir1util.lisp | 6 +++--- src/compiler/locall.lisp | 10 +++++----- src/compiler/macros.lisp | 4 ++-- version.lisp-expr | 2 +- 11 files changed, 61 insertions(+), 38 deletions(-) diff --git a/BUGS b/BUGS index e50ba73..aa4c59b 100644 --- a/BUGS +++ b/BUGS @@ -1367,6 +1367,31 @@ Error in function C::GET-LAMBDA-TO-COMPILE: to do without explicit wildcards, e.g. (DIRECTORY "/tmp/"), now needs explicit wildcards, e.g. (DIRECTORY "/tmp/*.*"). +140: + (reported by Alexey Dejneka sbcl-devel 2002-01-03) + + SUBTYPEP does not work well with redefined classes: + --- + * (defclass a () ()) + # + * (defclass b () ()) + # + * (subtypep 'b 'a) + NIL + T + * (defclass b (a) ()) + # + * (subtypep 'b 'a) + T + T + * (defclass b () ()) + # + + ;;; And now... + * (subtypep 'b 'a) + T + T + KNOWN BUGS RELATED TO THE IR1 INTERPRETER diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 6ebac24..8c1b308 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -711,8 +711,7 @@ ;;; guts of complex systems anyway, I replaced it too.) (defmacro aver (expr) `(unless ,expr - (%failed-aver ,(let ((*package* (find-package :keyword))) - (format nil "~S" expr))))) + (%failed-aver ,(format nil "~A" expr)))) (defun %failed-aver (expr-as-string) (error "~@" expr-as-string)) (defmacro enforce-type (value type) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 2d98377..3234820 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -319,7 +319,7 @@ ;;; passes them on to CONT. (defun convert-type-check (cont types) (declare (type continuation cont) (type list types)) - (with-ir1-environment (continuation-dest cont) + (with-belated-ir1-environment (continuation-dest cont) ;; Ensuring that CONT starts a block lets us freely manipulate its uses. (ensure-block-start cont) @@ -360,7 +360,7 @@ ;; said that somewhere in here we ;; Set the new block's start and end cleanups to the *start* ;; cleanup of PREV's block. This overrides the incorrect - ;; default from WITH-IR1-ENVIRONMENT. + ;; default from WITH-BELATED-IR1-ENVIRONMENT. ;; Unfortunately I can't find any code which corresponds to this. ;; Perhaps it was a stale comment? Or perhaps I just don't ;; understand.. -- WHN 19990521 diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index 8cd45d4..d128011 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -384,8 +384,7 @@ ;; initial component tail (due NIL function terminated blocks) ;; are moved to the appropriate new component tail. (dolist (toplevel-lambda toplevel-lambdas) - (let* ((block (lambda-block toplevel-lambda)) - (old-component (block-component block)) + (let* ((old-component (lambda-component toplevel-lambda)) (old-component-lambdas (component-lambdas old-component)) (new-component nil)) (aver (member toplevel-lambda old-component-lambdas)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index f615c1b..412eb93 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -37,7 +37,7 @@ :alternative else-block))) (setf (continuation-dest pred) node) (ir1-convert start pred test) - (prev-link node pred) + (link-node-to-previous-continuation node pred) (use-continuation node dummy-cont) (let ((start-block (continuation-block pred))) @@ -75,7 +75,7 @@ :mess-up entry))) (push entry (lambda-entries (lexenv-lambda *lexenv*))) (setf (entry-cleanup entry) cleanup) - (prev-link entry start) + (link-node-to-previous-continuation entry start) (use-continuation entry dummy) (let* ((env-entry (list entry cont)) @@ -115,7 +115,7 @@ (push exit (entry-exits entry)) (setf (continuation-dest value-cont) exit) (ir1-convert start value-cont value) - (prev-link exit value-cont) + (link-node-to-previous-continuation exit value-cont) (let ((home-lambda (continuation-home-lambda-or-null start))) (when home-lambda (push entry (lambda-calls-or-closes home-lambda)))) @@ -169,7 +169,7 @@ :mess-up entry))) (push entry (lambda-entries (lexenv-lambda *lexenv*))) (setf (entry-cleanup entry) cleanup) - (prev-link entry start) + (link-node-to-previous-continuation entry start) (use-continuation entry dummy) (collect ((tags) @@ -204,7 +204,7 @@ (entry (first found)) (exit (make-exit :entry entry))) (push exit (entry-exits entry)) - (prev-link exit start) + (link-node-to-previous-continuation exit start) (let ((home-lambda (continuation-home-lambda-or-null start))) (when home-lambda (push entry (lambda-calls-or-closes home-lambda)))) @@ -822,7 +822,7 @@ (setf (continuation-dest dest) res) (setf (leaf-ever-used var) t) (push res (basic-var-sets var)) - (prev-link res dest) + (link-node-to-previous-continuation res dest) (use-continuation res cont)))) ;;;; CATCH, THROW and UNWIND-PROTECT @@ -971,7 +971,7 @@ (ir1-convert this-start this-cont arg) (setq this-start this-cont) (arg-conts this-cont))) - (prev-link node this-start) + (link-node-to-previous-continuation node this-start) (use-continuation node cont) (setf (basic-combination-args node) (arg-conts)))))) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index ff7fb3a..c9188e3 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -568,7 +568,7 @@ ;;; become unreachable, resulting in a spurious note. (defun convert-if-if (use node) (declare (type node use) (type cif node)) - (with-ir1-environment node + (with-belated-ir1-environment node (let* ((block (node-block node)) (test (if-test node)) (cblock (if-consequent node)) @@ -580,7 +580,7 @@ :consequent cblock :alternative ablock)) (new-block (continuation-starts-block new-cont))) - (prev-link new-node new-cont) + (link-node-to-previous-continuation new-node new-cont) (setf (continuation-dest new-cont) new-node) (add-continuation-use new-node dummy-cont) (setf (block-last new-block) new-node) @@ -818,7 +818,7 @@ (change-ref-leaf ref res)))) (if ir1-p (frob) - (with-ir1-environment call + (with-belated-ir1-environment call (frob) (locall-analyze-component *current-component*)))) @@ -1083,7 +1083,7 @@ ;;; integrated into the control flow. (defun transform-call (node res) (declare (type combination node) (list res)) - (with-ir1-environment node + (with-belated-ir1-environment node (let ((new-fun (ir1-convert-inline-lambda res :debug-name "")) @@ -1481,7 +1481,7 @@ min) (t nil)))) (when count - (with-ir1-environment node + (with-belated-ir1-environment node (let* ((dums (make-gensym-list count)) (ignore (gensym)) (fun (ir1-convert-lambda @@ -1525,7 +1525,7 @@ (mapc #'flush-dest (subseq vals nvars)) (setq vals (subseq vals 0 nvars))) ((< nvals nvars) - (with-ir1-environment use + (with-belated-ir1-environment use (let ((node-prev (node-prev use))) (setf (node-prev use) nil) (setf (continuation-next node-prev) nil) @@ -1536,7 +1536,8 @@ do (reference-constant prev cont nil) (res cont)) (setq vals (res))) - (prev-link use (car (last vals))))))) + (link-node-to-previous-continuation use + (car (last vals))))))) (setf (combination-args use) vals) (flush-dest (combination-fun use)) (let ((fun-cont (basic-combination-fun call))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 0f40ec0..1a7927f 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -256,8 +256,7 @@ ;;; This function sets up the back link between the node and the ;;; continuation which continues at it. -#!-sb-fluid (declaim (inline prev-link)) -(defun prev-link (node cont) +(defun link-node-to-previous-continuation (node cont) (declare (type node node) (type continuation cont)) (aver (not (continuation-next cont))) (setf (continuation-next cont) node) @@ -482,7 +481,7 @@ (let* ((leaf (find-constant value)) (res (make-ref (leaf-type leaf) leaf))) (push res (leaf-refs leaf)) - (prev-link res start) + (link-node-to-previous-continuation res start) (use-continuation res cont))) (values))) @@ -511,7 +510,7 @@ leaf))) (push res (leaf-refs leaf)) (setf (leaf-ever-used leaf) t) - (prev-link res start) + (link-node-to-previous-continuation res start) (use-continuation res cont))) ;;; Convert a reference to a symbolic constant or variable. If the @@ -710,7 +709,7 @@ (ir1-convert this-start this-cont arg) (setq this-start this-cont) (arg-conts this-cont))) - (prev-link node this-start) + (link-node-to-previous-continuation node this-start) (use-continuation node cont) (setf (combination-args node) (arg-conts)))) node)) @@ -1392,7 +1391,7 @@ (let ((cont1 (make-continuation)) (cont2 (make-continuation))) (continuation-starts-block cont1) - (prev-link bind cont1) + (link-node-to-previous-continuation bind cont1) (use-continuation bind cont2) (ir1-convert-special-bindings cont2 result body aux-vars aux-vals (svars))) @@ -1406,7 +1405,7 @@ (setf (lambda-return lambda) return) (setf (continuation-dest result) return) (setf (block-last block) return) - (prev-link return result) + (link-node-to-previous-continuation return result) (use-continuation return dummy)) (link-blocks block (component-tail *current-component*)))))) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 4328b58..fe51581 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -36,7 +36,7 @@ (declare (type cblock block1 block2) (type node node) (type (or cleanup null) cleanup)) (setf (component-reanalyze (block-component block1)) t) - (with-ir1-environment node + (with-belated-ir1-environment node (let* ((start (make-continuation)) (block (continuation-starts-block start)) (cont (make-continuation)) @@ -1072,11 +1072,11 @@ (aver (and succ (null (cdr succ)))) (cond ((member block succ) - (with-ir1-environment node + (with-belated-ir1-environment node (let ((exit (make-exit)) (dummy (make-continuation))) (setf (continuation-next prev) nil) - (prev-link exit prev) + (link-node-to-previous-continuation exit prev) (add-continuation-use exit dummy) (setf (block-last block) exit))) (setf (node-prev node) nil) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 855a877..5351b32 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -178,7 +178,7 @@ (defun make-external-entry-point (fun) (declare (type functional fun)) (aver (not (functional-entry-fun fun))) - (with-ir1-environment (lambda-bind (main-entry fun)) + (with-belated-ir1-environment (lambda-bind (main-entry fun)) (let ((res (ir1-convert-lambda (make-xep-lambda-expression fun) :debug-name (debug-namify "XEP for ~A" @@ -277,7 +277,7 @@ (t ;; Fix/check FUN's relationship to COMPONENT-LAMDBAS. (cond ((not (lambda-p fun)) - ;; Since FUN's not a LAMBDA, this doesn't apply: no-op. + ;; Since FUN isn't a LAMBDA, this doesn't apply: no-op. (values)) (new-fun ; FUN came from NEW-FUNS, hence is new. ;; FUN becomes part of COMPONENT-LAMBDAS now. @@ -296,7 +296,7 @@ ;; expansions of local functions might in ;; COMPONENT-LAMBDAS?) (values)) - (t ; FUN's old. + (t ; FUN is old. ;; FUN should be in COMPONENT-LAMBDAS already. (aver (member fun (component-lambdas component))))) (locall-analyze-fun-1 fun) @@ -330,7 +330,7 @@ (and (>= speed space) (>= speed compilation-speed))) (not (eq (functional-kind (node-home-lambda call)) :external)) (inline-expansion-ok call)) - (with-ir1-environment call + (with-belated-ir1-environment call (let* ((*lexenv* (functional-lexenv fun)) (won nil) (res (catch 'local-call-lossage @@ -523,7 +523,7 @@ (declare (list vars ignores args) (type ref ref) (type combination call) (type clambda entry)) (let ((new-fun - (with-ir1-environment call + (with-belated-ir1-environment call (ir1-convert-lambda `(lambda ,vars (declare (ignorable . ,ignores)) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index e51c8eb..51a4a5b 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -678,7 +678,7 @@ ;;; after the main conversion pass has finished. ;;; ;;; The lexical environment is presumably already null... -(defmacro with-ir1-environment (node &rest forms) +(defmacro with-belated-ir1-environment (node &rest forms) (let ((n-node (gensym))) `(let* ((,n-node ,node) (*current-component* (block-component (node-block ,n-node))) @@ -687,7 +687,7 @@ ,@forms))) ;;; Bind the hashtables used for keeping track of global variables, -;;; functions, &c. Also establish condition handlers. +;;; functions, etc. Also establish condition handlers. (defmacro with-ir1-namespace (&body forms) `(let ((*free-variables* (make-hash-table :test 'eq)) (*free-functions* (make-hash-table :test 'equal)) diff --git a/version.lisp-expr b/version.lisp-expr index 67a3ebe..b23e666 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.112" +"0.pre7.113" -- 1.7.10.4