(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
(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)
(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.
;; *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
;;; non-local entry.
(!def-vm-support-routine make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
-
\f
;;;; save and restoring the dynamic environment
;;;;
(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)
(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)))
(do ((conf confs (global-conflicts-next-tnwise conf)))
((null conf))
(format t "~&#<block ~D kind ~S>~%"
- (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)
(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))
\f
;;;; flow analysis
;; 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
(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.
;;;
(!def-vm-support-routine make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
-
\f
;;; Save and restore dynamic environment.
;;;
(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*)
(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)
(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.
*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))
;; 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))
(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
;;; 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"
projects / sbcl.git / commitdiff