(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:
;;;
;;; 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
(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)
\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
(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
(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))
(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)))
(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)
(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))