0.6.11.6:

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

diff --git a/src/compiler/byte-comp.lisp b/src/compiler/byte-comp.lisp
index b428064..f8eb793 100644 (file)
--- a/src/compiler/byte-comp.lisp
+++ b/src/compiler/byte-comp.lisp
@@ -12,11 +12,10 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
 ;;;; the fasl file format that we use
-(defconstant byte-fasl-file-version 1)
+(defconstant byte-fasl-file-version 2)
+;;; 1 = before about sbcl-0.6.9.8
+;;; 2 = merged package SB-CONDITIONS into SB-KERNEL around sbcl-0.6.9.8
 
 ;;; ### remaining work:
 ;;;
@@ -856,29 +855,31 @@
 
 (defvar *byte-component-info*)
 
-(eval-when (#+sb-xc :compile-toplevel :load-toplevel :execute)
-  (defconstant byte-push-local           #b00000000)
-  (defconstant byte-push-arg             #b00010000)
-  (defconstant byte-push-constant        #b00100000)
-  (defconstant byte-push-system-constant  #b00110000)
-  (defconstant byte-push-int             #b01000000)
-  (defconstant byte-push-neg-int         #b01010000)
-  (defconstant byte-pop-local            #b01100000)
-  (defconstant byte-pop-n                #b01110000)
-  (defconstant byte-call                 #b10000000)
-  (defconstant byte-tail-call            #b10010000)
-  (defconstant byte-multiple-call        #b10100000)
-  (defconstant byte-named                #b00001000)
-  (defconstant byte-local-call           #b10110000)
-  (defconstant byte-local-tail-call       #b10111000)
-  (defconstant byte-local-multiple-call   #b11000000)
-  (defconstant byte-return               #b11001000)
-  (defconstant byte-branch-always        #b11010000)
-  (defconstant byte-branch-if-true       #b11010010)
-  (defconstant byte-branch-if-false       #b11010100)
-  (defconstant byte-branch-if-eq         #b11010110)
-  (defconstant byte-xop                          #b11011000)
-  (defconstant byte-inline-function       #b11100000))
+;;; FIXME: These might as well be generated with DEFENUM, right?
+;;; It would also be nice to give them less ambiguous names, perhaps
+;;; with a "BYTEOP-" prefix instead of "BYTE-".
+(defconstant byte-push-local          #b00000000)
+(defconstant byte-push-arg            #b00010000)
+(defconstant byte-push-constant               #b00100000)
+(defconstant byte-push-system-constant #b00110000)
+(defconstant byte-push-int            #b01000000)
+(defconstant byte-push-neg-int        #b01010000)
+(defconstant byte-pop-local           #b01100000)
+(defconstant byte-pop-n                       #b01110000)
+(defconstant byte-call                #b10000000)
+(defconstant byte-tail-call           #b10010000)
+(defconstant byte-multiple-call               #b10100000)
+(defconstant byte-named                       #b00001000)
+(defconstant byte-local-call          #b10110000)
+(defconstant byte-local-tail-call      #b10111000)
+(defconstant byte-local-multiple-call  #b11000000)
+(defconstant byte-return              #b11001000)
+(defconstant byte-branch-always               #b11010000)
+(defconstant byte-branch-if-true       #b11010010)
+(defconstant byte-branch-if-false      #b11010100)
+(defconstant byte-branch-if-eq        #b11010110)
+(defconstant byte-xop                 #b11011000)
+(defconstant byte-inline-function      #b11100000)
 
 (defun output-push-int (segment int)
   (declare (type sb!assem:segment segment)
@@ -1222,10 +1223,14 @@
         (t
          (etypecase leaf
            (constant
-            (output-push-constant-leaf segment leaf))
+             (cond ((legal-immediate-constant-p leaf)
+                     (output-push-constant-leaf segment leaf))
+                   (t
+                     (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)))
@@ -1271,7 +1276,19 @@
          (output-push-constant segment (global-var-name leaf))
          (output-do-inline-function segment 'setf-symbol-value))))
       (lambda-var
-       (output-set-lambda-var segment leaf (node-environment set))))
+       ;; 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.
+             ((eql values 0)
+              (output-byte-with-operand segment byte-pop-n 1)))))
     (unless (eql values 0)
       (checked-canonicalize-values segment cont 1)))
   (values))