From 237ecea4a44f33d40440ea40c67c54e9e23358b3 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 17 Nov 2002 13:56:56 +0000 Subject: [PATCH] 0.7.9.53: tidying left over from failed hunt for bug #226 some more renaming to make LEXENV vs. PHYSENV distinction --- BUGS | 1 + src/code/bignum.lisp | 2 +- src/code/target-pathname.lisp | 7 +++++-- src/compiler/alpha/nlx.lisp | 1 - src/compiler/debug.lisp | 9 +++++---- src/compiler/life.lisp | 16 ++++++++-------- src/compiler/locall.lisp | 14 +++++++------- src/compiler/mips/nlx.lisp | 1 - src/compiler/pack.lisp | 2 +- src/compiler/tn.lisp | 30 +++++++++++++++--------------- src/compiler/vop.lisp | 2 +- src/compiler/x86/call.lisp | 13 ++++++------- version.lisp-expr | 2 +- 13 files changed, 51 insertions(+), 49 deletions(-) diff --git a/BUGS b/BUGS index c3ad6f9..3a0c0bf 100644 --- a/BUGS +++ b/BUGS @@ -1329,6 +1329,7 @@ WORKAROUND: (fixed in 0.7.9.42) 226: "AVER failure in COMPILE-FILE of clocc-ansi-test/tests.lisp" + (APD points out that this seems to be another symptom of bug #115.) sbcl-0.7.9.43 dies with failed AVER "(EQ (TN-PHYSENV TN) TN-ENV)" when trying to compile clocc-ansi-test/tests.lisp. sbcl-0.7.9.31 was able to to compile it. A smaller test case exhibiting the same problem is diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index cf70586..719f369 100644 --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -812,7 +812,7 @@ (bignum-ashift-left-unaligned bignum digits n-bits res-len)))) ;; Left shift by a number too big to be represented as a fixnum ;; would exceed our memory capacity, since a fixnum is big enough - ;; index any array, including a bit array. + ;; to index any array, including a bit array. (error "can't represent result of left shift"))) (defun bignum-ashift-left-digits (bignum bignum-len digits) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index eaa6cb6..9121c1c 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -625,7 +625,7 @@ a host-structure or string." (let ((potential-host (logical-word-or-lose (subseq namestr start colon)))) ;; depending on the outcome of CSR comp.lang.lisp post - ;; "can PARSE-NAMESTRING create logical hosts, we may need + ;; "can PARSE-NAMESTRING create logical hosts", we may need ;; to do things with potential-host (create it ;; temporarily, parse the namestring and unintern the ;; logical host potential-host on failure. @@ -683,7 +683,10 @@ a host-structure or string." ;; *DEFAULT-PATHNAME-DEFAULTS has a SB-IMPL::UNIX-HOST ;; for a host. ((pathname-host defaults) - (funcall (host-parse (pathname-host defaults)) namestr start end)) + (funcall (host-parse (pathname-host defaults)) + namestr + start + end)) ;; I don't think we should ever get here, as the default ;; host will always have a non-null HOST, given that we ;; can't create a new pathname without going through diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index 6f33302..a293dda 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -22,7 +22,6 @@ ;;; non-local entry. (!def-vm-support-routine make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) - ;;;; save and restoring the dynamic environment ;;;; diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index 7f67f0f..9c84d29 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -1134,8 +1134,8 @@ (defvar *list-conflicts-table* (make-hash-table :test 'eq)) -;;; Add all ALWAYS-LIVE TNs in Block to the conflicts. TN is ignored when -;;; it appears in the global conflicts. +;;; Add all ALWAYS-LIVE TNs in BLOCK to the conflicts. TN is ignored +;;; when it appears in the global conflicts. (defun add-always-live-tns (block tn) (declare (type ir2-block block) (type tn tn)) (do ((conf (ir2-block-global-tns block) @@ -1147,7 +1147,7 @@ (setf (gethash btn *list-conflicts-table*) t))))) (values)) -;;; Add all local TNs in block to the conflicts. +;;; Add all local TNs in BLOCK to the conflicts. (defun add-all-local-tns (block) (declare (type ir2-block block)) (let ((ltns (ir2-block-local-tns block))) @@ -1176,7 +1176,8 @@ (do ((conf confs (global-conflicts-next-tnwise conf))) ((null conf)) (format t "~&#~%" - (block-number (ir2-block-block (global-conflicts-block conf))) + (block-number (ir2-block-block (global-conflicts-block + conf))) (global-conflicts-kind conf)) (let ((block (global-conflicts-block conf))) (add-always-live-tns block tn) diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 7c2a903..afd27fb 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -440,21 +440,21 @@ (values)) ;;; Convert a :NORMAL or :DEBUG-ENVIRONMENT TN to an :ENVIRONMENT TN. -;;; This requires adding :LIVE conflicts to all blocks in TN-ENV. -(defun convert-to-environment-tn (tn tn-env) - (declare (type tn tn) (type physenv tn-env)) +;;; This requires adding :LIVE conflicts to all blocks in TN-PHYSENV. +(defun convert-to-environment-tn (tn tn-physenv) + (declare (type tn tn) (type physenv tn-physenv)) (aver (member (tn-kind tn) '(:normal :debug-environment))) (when (eq (tn-kind tn) :debug-environment) - (aver (eq (tn-physenv tn) tn-env)) - (let ((2env (physenv-info tn-env))) + (aver (eq (tn-physenv tn) tn-physenv)) + (let ((2env (physenv-info tn-physenv))) (setf (ir2-physenv-debug-live-tns 2env) (delete tn (ir2-physenv-debug-live-tns 2env))))) - (setup-environment-tn-conflicts *component-being-compiled* tn tn-env nil) + (setup-environment-tn-conflicts *component-being-compiled* tn tn-physenv nil) (setf (tn-local tn) nil) (setf (tn-local-number tn) nil) (setf (tn-kind tn) :environment) - (setf (tn-physenv tn) tn-env) - (push tn (ir2-physenv-live-tns (physenv-info tn-env))) + (setf (tn-physenv tn) tn-physenv) + (push tn (ir2-physenv-live-tns (physenv-info tn-physenv))) (values)) ;;;; flow analysis diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 304142d..e16d8d6 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -781,10 +781,10 @@ ;; information. (setf (tail-set-info (lambda-tail-set clambda)) nil)) -;;; Handle the environment semantics of LET conversion. We add CLAMBDA -;;; and its LETs to LETs for the CALL's home function. We merge the -;;; calls for CLAMBDA with the calls for the home function, removing -;;; CLAMBDA in the process. We also merge the ENTRIES. +;;; Handle the PHYSENV semantics of LET conversion. We add CLAMBDA and +;;; its LETs to LETs for the CALL's home function. We merge the calls +;;; for CLAMBDA with the calls for the home function, removing CLAMBDA +;;; in the process. We also merge the ENTRIES. ;;; ;;; We also unlink the function head from the component head and set ;;; COMPONENT-REANALYZE to true to indicate that the DFO should be @@ -803,20 +803,20 @@ (depart-from-tail-set clambda) (let* ((home (node-home-lambda call)) - (home-env (lambda-physenv home))) + (home-physenv (lambda-physenv home))) (aver (not (eq home clambda))) ;; CLAMBDA belongs to HOME now. (push clambda (lambda-lets home)) (setf (lambda-home clambda) home) - (setf (lambda-physenv clambda) home-env) + (setf (lambda-physenv clambda) home-physenv) ;; All of CLAMBDA's LETs belong to HOME now. (let ((lets (lambda-lets clambda))) (dolist (let lets) (setf (lambda-home let) home) - (setf (lambda-physenv let) home-env)) + (setf (lambda-physenv let) home-physenv)) (setf (lambda-lets home) (nconc lets (lambda-lets home)))) ;; CLAMBDA no longer has an independent existence as an entity ;; which has LETs. diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp index ccdb61c..03c8a64 100644 --- a/src/compiler/mips/nlx.lisp +++ b/src/compiler/mips/nlx.lisp @@ -11,7 +11,6 @@ ;;; (!def-vm-support-routine make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) - ;;; Save and restore dynamic environment. ;;; diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index 01cafe4..c963ee1 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -805,7 +805,7 @@ (defvar *repack-blocks*) (declaim (type (or hash-table null) *repack-blocks*)) -;;; Set the Live-TNs vectors in all :FINITE SBs to represent the TNs +;;; Set the LIVE-TNS vectors in all :FINITE SBs to represent the TNs ;;; live at the end of BLOCK. (defun init-live-tns (block) (dolist (sb *backend-sb-list*) diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index 3b07aac..d5e6f77 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -52,7 +52,7 @@ (setf (ir2-component-wired-tns instance) value)) ;;; Remove all TNs with no references from the lists of unpacked TNs. -;;; We null out the Offset so that nobody will mistake deleted wired +;;; We null out the OFFSET so that nobody will mistake deleted wired ;;; TNs for properly packed TNs. We mark non-deleted alias TNs so that ;;; aliased TNs aren't considered to be unreferenced. (defun delete-unreferenced-tns (component) @@ -154,24 +154,24 @@ (push-in tn-next res (ir2-component-restricted-tns component)) res)) -;;; Make TN be live throughout environment. Return TN. In the DEBUG -;;; case, the TN is treated normally in blocks in the environment -;;; which reference the TN, allowing targeting to/from the TN. This -;;; results in move efficient code, but may result in the TN sometimes -;;; not being live when you want it. -(defun physenv-live-tn (tn env) - (declare (type tn tn) (type physenv env)) +;;; Make TN be live throughout PHYSENV. Return TN. In the DEBUG case, +;;; the TN is treated normally in blocks in the environment which +;;; reference the TN, allowing targeting to/from the TN. This results +;;; in move efficient code, but may result in the TN sometimes not +;;; being live when you want it. +(defun physenv-live-tn (tn physenv) + (declare (type tn tn) (type physenv physenv)) (aver (eq (tn-kind tn) :normal)) (setf (tn-kind tn) :environment) - (setf (tn-physenv tn) env) - (push tn (ir2-physenv-live-tns (physenv-info env))) + (setf (tn-physenv tn) physenv) + (push tn (ir2-physenv-live-tns (physenv-info physenv))) tn) -(defun physenv-debug-live-tn (tn env) - (declare (type tn tn) (type physenv env)) +(defun physenv-debug-live-tn (tn physenv) + (declare (type tn tn) (type physenv physenv)) (aver (eq (tn-kind tn) :normal)) (setf (tn-kind tn) :debug-environment) - (setf (tn-physenv tn) env) - (push tn (ir2-physenv-debug-live-tns (physenv-info env))) + (setf (tn-physenv tn) physenv) + (push tn (ir2-physenv-debug-live-tns (physenv-info physenv))) tn) ;;; Make TN be live throughout the current component. Return TN. @@ -183,7 +183,7 @@ *component-being-compiled*))) tn) -;;; Specify that Save be used as the save location for TN. TN is returned. +;;; Specify that SAVE be used as the save location for TN. TN is returned. (defun specify-save-tn (tn save) (declare (type tn tn save)) (aver (eq (tn-kind save) :normal)) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index c6c6509..c2174a9 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -881,7 +881,7 @@ ;; wired TNs. (primitive-type nil :type (or primitive-type null)) ;; If this TN represents a variable or constant, then this is the - ;; corresponding Leaf. + ;; corresponding LEAF. (leaf nil :type (or leaf null)) ;; thread that links TNs together so that we can find them (next nil :type (or tn null)) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 173e485..a2efd33 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -43,23 +43,22 @@ (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset)) -;;; Make the TNs used to hold Old-FP and Return-PC within the current +;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current ;;; function. We treat these specially so that the debugger can find ;;; them at a known location. ;;; ;;; Without using a save-tn - which does not make much sense if it is -;;; wire to the stack? -(!def-vm-support-routine make-old-fp-save-location (env) +;;; wired to the stack? +(!def-vm-support-routine make-old-fp-save-location (physenv) (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset) - env)) - -(!def-vm-support-routine make-return-pc-save-location (env) + physenv)) +(!def-vm-support-routine make-return-pc-save-location (physenv) (physenv-debug-live-tn (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset) - env)) + physenv)) ;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we diff --git a/version.lisp-expr b/version.lisp-expr index 01f351a..963f73d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.52" +"0.7.9.53" -- 1.7.10.4