0.6.11.10:

[sbcl.git] / src / compiler / byte-comp.lisp

diff --git a/src/compiler/byte-comp.lisp b/src/compiler/byte-comp.lisp
index fa70dfd..750f007 100644 (file)
--- a/src/compiler/byte-comp.lisp
+++ b/src/compiler/byte-comp.lisp
@@ -13,9 +13,10 @@
 (in-package "SB!C")
 
 ;;;; the fasl file format that we use
-(defconstant byte-fasl-file-version 2)
+(defconstant byte-fasl-file-version 3)
 ;;; 1 = before about sbcl-0.6.9.8
 ;;; 2 = merged package SB-CONDITIONS into SB-KERNEL around sbcl-0.6.9.8
+;;; 3 = deleted obsolete CONS-UNIQUE-TAG bytecode in sbcl-0.6.11.8
 
 ;;; ### remaining work:
 ;;;
@@ -193,7 +194,7 @@
 ;;; number of bits devoted to coding byte-inline functions.
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
-  (defstruct inline-function-info
+  (defstruct (inline-function-info (:copier nil))
     ;; the name of the function that we convert into calls to this
     (function (required-argument) :type symbol)
     ;; the name of the function that the interpreter should call to
@@ -222,7 +223,6 @@
               (setf-symbol-value (t symbol) (values))
               (%byte-special-bind (t symbol) (values))
               (%byte-special-unbind () (values))
-              (cons-unique-tag () t)   ; obsolete...
               (%negate (fixnum) fixnum)
               (< (fixnum fixnum) t)
               (> (fixnum fixnum) t)
@@ -269,10 +269,10 @@
 \f
 ;;;; annotations hung off the IR1 while compiling
 
-(defstruct byte-component-info
+(defstruct (byte-component-info (:copier nil))
   (constants (make-array 10 :adjustable t :fill-pointer 0)))
 
-(defstruct byte-lambda-info
+(defstruct (byte-lambda-info (:copier nil))
   (label nil :type (or null label))
   (stack-size 0 :type index)
   ;; FIXME: should be INTERESTING-P T :TYPE BOOLEAN
@@ -281,16 +281,17 @@
 (defun block-interesting (block)
   (byte-lambda-info-interesting (lambda-info (block-home-lambda block))))
 
-(defstruct byte-lambda-var-info
+(defstruct (byte-lambda-var-info (:copier nil))
   (argp nil :type (member t nil))
   (offset 0 :type index))
 
-(defstruct byte-nlx-info
+(defstruct (byte-nlx-info (:copier nil))
   (stack-slot nil :type (or null index))
   (label (sb!assem:gen-label) :type sb!assem:label)
   (duplicate nil :type (member t nil)))
 
 (defstruct (byte-block-info
+           (:copier nil)
            (:include block-annotation)
            (:constructor make-byte-block-info
                          (block &key produces produces-sset consumes
@@ -337,7 +338,8 @@
 (defstruct (byte-continuation-info
            (:include sset-element)
            (:constructor make-byte-continuation-info
-                         (continuation results placeholders)))
+                         (continuation results placeholders))
+           (:copier nil))
   (continuation (required-argument) :type continuation)
   (results (required-argument)
           :type (or (member :fdefinition :eq-test :unknown) index))
@@ -1229,8 +1231,8 @@
                      (output-push-constant segment (leaf-name leaf))
                      (output-do-inline-function segment 'symbol-value))))
            (clambda
-            (let* ((refered-env (lambda-environment leaf))
-                   (closure (environment-closure refered-env)))
+            (let* ((referred-env (lambda-environment leaf))
+                   (closure (environment-closure referred-env)))
               (if (null closure)
                   (output-push-load-time-constant segment :entry leaf)
                   (let ((my-env (node-environment ref)))
@@ -1266,25 +1268,24 @@
         (values (if info
                     (byte-continuation-info-results info)
                     0)))
-    (unless (eql values 0)
-      ;; Someone wants the value, so copy it.
-      (output-do-xop segment 'dup))
     (etypecase leaf
       (global-var
        (ecase (global-var-kind leaf)
         ((:special :global)
          (output-push-constant segment (global-var-name leaf))
          (output-do-inline-function segment 'setf-symbol-value))))
-      ;;; MNA: cmucl-commit: Tue, 26 Sep 2000 09:41:00 -0700 (PDT)
-      ;;; Within generate-byte-code-for-set, avoid trying to set a lexical
-      ;;; variable with no refs since the compiler deletes such variables.
       (lambda-var
-        (cond ((leaf-refs leaf)
+       ;; Note: It's important to test for whether there are any
+       ;; references to the variable before we actually try to set it.
+       ;; (Setting a lexical variable with no refs caused bugs ca. CMU
+       ;; CL 18c, because the compiler deletes such variables.)
+       (cond ((leaf-refs leaf)
              (unless (eql values 0)
                ;; Someone wants the value, so copy it.
                (output-do-xop segment 'dup))
              (output-set-lambda-var segment leaf (node-environment set)))
-            ;; If no-one wants the value then pop it else leave it for them.
+            ;; If no one wants the value, then pop it, else leave it
+            ;; for them.
             ((eql values 0)
              (output-byte-with-operand segment byte-pop-n 1)))))
     (unless (eql values 0)