1.0.7.33: better handling of ASSOC and MEMBER on empty lists

[sbcl.git] / src / compiler / codegen.lisp

diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp
index 7a17680..2eafcda 100644 (file)
--- a/src/compiler/codegen.lisp
+++ b/src/compiler/codegen.lisp
@@ -18,10 +18,10 @@
 
 ;;; the number of bytes used by the code object header
 (defun component-header-length (&optional
-                               (component *component-being-compiled*))
+                                (component *component-being-compiled*))
   (let* ((2comp (component-info component))
-        (constants (ir2-component-constants 2comp))
-        (num-consts (length constants)))
+         (constants (ir2-component-constants 2comp))
+         (num-consts (length constants)))
     (ash (logandc2 (1+ num-consts) 1) sb!vm:word-shift)))
 
 ;;; the size of the NAME'd SB in the currently compiled component.
@@ -36,8 +36,8 @@
   (unless (zerop (sb-allocated-size 'non-descriptor-stack))
     (let ((block (ir2-block-block (vop-block vop))))
     (when (ir2-physenv-number-stack-p
-          (physenv-info
-           (block-physenv block)))
+           (physenv-info
+            (block-physenv block)))
       (ir2-component-nfp (component-info (block-component block)))))))
 
 ;;; the TN that is used to hold the number stack frame-pointer in the
@@ -72,10 +72,10 @@
       (setf *prev-segment* segment))
     (unless (eq *prev-vop* vop)
       (when vop
-       (format t "~%VOP ")
-       (if (vop-p vop)
-           (print-vop vop)
-           (format *compiler-trace-output* "~S~%" vop)))
+        (format t "~%VOP ")
+        (if (vop-p vop)
+            (print-vop vop)
+            (format *compiler-trace-output* "~S~%" vop)))
       (terpri)
       (setf *prev-vop* vop))
     (case inst
@@ -92,68 +92,68 @@
 ;;; standard defaults for slots of SEGMENT objects
 (defun default-segment-run-scheduler ()
   (and *assembly-optimize*
-       (policy (lambda-bind
-                (block-home-lambda
-                 (block-next (component-head *component-being-compiled*))))
-               (or (> speed compilation-speed) (> space compilation-speed)))))
+        (policy (lambda-bind
+                 (block-home-lambda
+                  (block-next (component-head *component-being-compiled*))))
+                (or (> speed compilation-speed) (> space compilation-speed)))))
 (defun default-segment-inst-hook ()
   (and *compiler-trace-output*
        #'trace-instruction))
 
 (defun init-assembler ()
   (setf *code-segment*
-       (sb!assem:make-segment :name "regular"
-                              :run-scheduler (default-segment-run-scheduler)
-                              :inst-hook (default-segment-inst-hook)))
+        (sb!assem:make-segment :name "regular"
+                               :run-scheduler (default-segment-run-scheduler)
+                               :inst-hook (default-segment-inst-hook)))
   #!+sb-dyncount
   (setf (sb!assem:segment-collect-dynamic-statistics *code-segment*)
-       *collect-dynamic-statistics*)
+        *collect-dynamic-statistics*)
   (setf *elsewhere*
-       (sb!assem:make-segment :name "elsewhere"
-                              :run-scheduler (default-segment-run-scheduler)
-                              :inst-hook (default-segment-inst-hook)))
+        (sb!assem:make-segment :name "elsewhere"
+                               :run-scheduler (default-segment-run-scheduler)
+                               :inst-hook (default-segment-inst-hook)))
   (values))
 
 (defun generate-code (component)
   (when *compiler-trace-output*
     (format *compiler-trace-output*
-           "~|~%assembly code for ~S~2%"
-           component))
+            "~|~%assembly code for ~S~2%"
+            component))
   (let ((prev-env nil)
-       (*trace-table-info* nil)
-       (*prev-segment* nil)
-       (*prev-vop* nil)
-       (*fixup-notes* nil))
+        (*trace-table-info* nil)
+        (*prev-segment* nil)
+        (*prev-vop* nil)
+        (*fixup-notes* nil))
     (let ((label (sb!assem:gen-label)))
       (setf *elsewhere-label* label)
       (sb!assem:assemble (*elsewhere*)
-       (sb!assem:emit-label label)))
+        (sb!assem:emit-label label)))
     (do-ir2-blocks (block component)
       (let ((1block (ir2-block-block block)))
-       (when (and (eq (block-info 1block) block)
-                  (block-start 1block))
-         (sb!assem:assemble (*code-segment*)
-           (sb!assem:emit-label (block-label 1block)))
-         (let ((env (block-physenv 1block)))
-           (unless (eq env prev-env)
-             (let ((lab (gen-label)))
-               (setf (ir2-physenv-elsewhere-start (physenv-info env))
-                     lab)
-               (emit-label-elsewhere lab))
-             (setq prev-env env)))))
+        (when (and (eq (block-info 1block) block)
+                   (block-start 1block))
+          (sb!assem:assemble (*code-segment*)
+            (sb!assem:emit-label (block-label 1block)))
+          (let ((env (block-physenv 1block)))
+            (unless (eq env prev-env)
+              (let ((lab (gen-label)))
+                (setf (ir2-physenv-elsewhere-start (physenv-info env))
+                      lab)
+                (emit-label-elsewhere lab))
+              (setq prev-env env)))))
       (do ((vop (ir2-block-start-vop block) (vop-next vop)))
-         ((null vop))
-       (let ((gen (vop-info-generator-function (vop-info vop))))
-         (if gen
-           (funcall gen vop)
-           (format t
-                   "missing generator for ~S~%"
-                   (template-name (vop-info vop)))))))
+          ((null vop))
+        (let ((gen (vop-info-generator-function (vop-info vop))))
+          (if gen
+            (funcall gen vop)
+            (format t
+                    "missing generator for ~S~%"
+                    (template-name (vop-info vop)))))))
     (sb!assem:append-segment *code-segment* *elsewhere*)
     (setf *elsewhere* nil)
     (values (sb!assem:finalize-segment *code-segment*)
-           (nreverse *trace-table-info*)
-           *fixup-notes*)))
+            (nreverse *trace-table-info*)
+            *fixup-notes*)))
 
 (defun emit-label-elsewhere (label)
   (sb!assem:assemble (*elsewhere*)
@@ -162,7 +162,7 @@
 (defun label-elsewhere-p (label-or-posn)
   (<= (label-position *elsewhere-label*)
       (etypecase label-or-posn
-       (label
-        (label-position label-or-posn))
-       (index
-        label-or-posn))))
+        (label
+         (label-position label-or-posn))
+        (index
+         label-or-posn))))