X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;h=f25e4909875a08f07b5022b23c78dbd0f835cd99;hb=11b8fcf55c80cb2686fb49663fa4d96f9b152ce4;hp=30bfebb0bb6b04bf2454e77de5930034328ddef3;hpb=0a82f2db352cc348d2107a882e50af222ff97ed3;p=sbcl.git

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 30bfebb..f25e490 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -13,7 +13,7 @@
 
 ;;; types and defaults
 
-(defconstant label-column-width 7)
+(def!constant label-column-width 7)
 
 (deftype text-width () '(integer 0 1000))
 (deftype alignment () '(integer 0 64))
@@ -22,7 +22,7 @@
 (deftype length () '(unsigned-byte 24))
 (deftype column () '(integer 0 1000))
 
-(defconstant max-filtered-value-index 32)
+(def!constant max-filtered-value-index 32)
 (deftype filtered-value-index ()
   `(integer 0 ,max-filtered-value-index))
 (deftype filtered-value-vector ()
@@ -85,7 +85,7 @@
          ;; these are not in the params because they only exist at compile time
          (defparameter ,(format-table-name) (make-hash-table))
          (defparameter ,(arg-type-table-name) nil)
-         (defparameter ,(function-cache-name) (make-function-cache)))
+         (defparameter ,(fun-cache-name) (make-fun-cache)))
        (let ((params
               (or sb!c:*backend-disassem-params*
                   (setf sb!c:*backend-disassem-params* (make-params)))))
@@ -102,14 +102,18 @@
 |#
 
 ;;;; cached functions
+;;;;
+;;;; FIXME: Is it important to cache these? For performance? Or why?
+;;;; If performance: *Really*? How fast does disassembly need to be??
+;;;; So: Could we just punt this?
 
-(defstruct (function-cache (:copier nil))
+(defstruct (fun-cache (:copier nil))
   (printers nil :type list)
   (labellers nil :type list)
   (prefilters nil :type list))
 
-(defvar *disassem-function-cache* (make-function-cache))
-(declaim (type function-cache *disassem-function-cache*))
+(defvar *disassem-fun-cache* (make-fun-cache))
+(declaim (type fun-cache *disassem-fun-cache*))
 
 ;;;; A DCHUNK contains the bits we look at to decode an
 ;;;; instruction.
@@ -128,15 +132,15 @@
                  dchunk=
                  dchunk-count-bits))
 
-(defconstant dchunk-bits 32)
+(def!constant dchunk-bits 32)
 
 (deftype dchunk ()
   `(unsigned-byte ,dchunk-bits))
 (deftype dchunk-index ()
   `(integer 0 ,dchunk-bits))
 
-(defconstant dchunk-zero 0)
-(defconstant dchunk-one #xFFFFFFFF)
+(def!constant dchunk-zero 0)
+(def!constant dchunk-one #xFFFFFFFF)
 
 (defun dchunk-extract (from pos)
   (declare (type dchunk from))
@@ -236,7 +240,7 @@
   ;; disassembly functions
   (prefilter nil :type (or null function))
   (labeller nil :type (or null function))
-  (printer (required-argument) :type (or null function))
+  (printer (missing-arg) :type (or null function))
   (control nil :type (or null function))
 
   ;; instructions that are the same as this instruction but with more
@@ -259,7 +263,7 @@
 (defstruct (inst-space-choice (:conc-name ischoice-)
                               (:copier nil))
   (common-id dchunk-zero :type dchunk)  ; applies to *parent's* mask
-  (subspace (required-argument) :type (or inst-space instruction)))
+  (subspace (missing-arg) :type (or inst-space instruction)))
 
 ;;;; These are the kind of values we can compute for an argument, and
 ;;;; how to compute them. The :CHECKER functions make sure that a given
@@ -269,8 +273,8 @@
 
 (defstruct (arg-form-kind (:copier nil))
   (names nil :type list)
-  (producer (required-argument) :type function)
-  (checker (required-argument) :type function))
+  (producer (missing-arg) :type function)
+  (checker (missing-arg) :type function))
 
 (defun arg-form-kind-or-lose (kind)
   (or (getf *arg-form-kinds* kind)
@@ -292,10 +296,10 @@
 
 (defvar *disassem-inst-formats* (make-hash-table))
 (defvar *disassem-arg-types* nil)
-(defvar *disassem-function-cache* (make-function-cache))
+(defvar *disassem-fun-cache* (make-fun-cache))
 
-(defstruct (argument (:conc-name arg-)
-		     (:copier nil))
+(defstruct (arg (:copier nil)
+		(:predicate nil))
   (name nil :type symbol)
   (fields nil :type list)
 
@@ -336,16 +340,16 @@
   (%make-funstate :args args))
 
 (defun funstate-compatible-p (funstate args)
-  (every #'(lambda (this-arg-temps)
-             (let* ((old-arg (car this-arg-temps))
-                    (new-arg (find (arg-name old-arg) args :key #'arg-name)))
-               (and new-arg
-                    (every #'(lambda (this-kind-temps)
-                               (funcall (find-arg-form-checker
-                                         (car this-kind-temps))
-                                        new-arg
-                                        old-arg))
-                           (cdr this-arg-temps)))))
+  (every (lambda (this-arg-temps)
+	   (let* ((old-arg (car this-arg-temps))
+		  (new-arg (find (arg-name old-arg) args :key #'arg-name)))
+	     (and new-arg
+		  (every (lambda (this-kind-temps)
+			   (funcall (find-arg-form-checker
+				     (car this-kind-temps))
+				    new-arg
+				    old-arg))
+			 (cdr this-arg-temps)))))
          (funstate-arg-temps funstate)))
 
 (defun arg-or-lose (name funstate)
@@ -418,12 +422,12 @@
         (values wrapper-name `(defparameter ,wrapper-name ,form)))))
 
 (defun filter-overrides (overrides evalp)
-  (mapcar #'(lambda (override)
-              (list* (car override) (cadr override)
-                     (munge-fun-refs (cddr override) evalp)))
+  (mapcar (lambda (override)
+	    (list* (car override) (cadr override)
+		   (munge-fun-refs (cddr override) evalp)))
           overrides))
 
-(defparameter *arg-function-params*
+(defparameter *arg-fun-params*
   '((:printer . (value stream dstate))
     (:use-label . (value dstate))
     (:prefilter . (value dstate))))
@@ -434,7 +438,7 @@
          (wrapper-defs nil))
         ((null tail)
          (values params (nreverse wrapper-defs)))
-      (let ((fun-arg (assoc (car tail) *arg-function-params*)))
+      (let ((fun-arg (assoc (car tail) *arg-fun-params*)))
         (when fun-arg
           (let* ((fun-form (cadr tail))
                  (quoted-fun-form `',fun-form))
@@ -452,12 +456,12 @@
 (defun gen-args-def-form (overrides format-form &optional (evalp t))
   (let ((args-var (gensym)))
     `(let ((,args-var (copy-list (format-args ,format-form))))
-       ,@(mapcar #'(lambda (override)
-                     (update-args-form args-var
-                                       `',(car override)
-                                       (and (cdr override)
-                                            (cons :value (cdr override)))
-                                       evalp))
+       ,@(mapcar (lambda (override)
+		   (update-args-form args-var
+				     `',(car override)
+				     (and (cdr override)
+					  (cons :value (cdr override)))
+				     evalp))
                  overrides)
        ,args-var)))
 
@@ -479,7 +483,7 @@
       `(let* ((*current-instruction-flavor* ',(cons base-name format-name))
               (,format-var (format-or-lose ',format-name))
               (args ,(gen-args-def-form field-defs format-var evalp))
-              (funcache *disassem-function-cache*))
+              (funcache *disassem-fun-cache*))
          (multiple-value-bind (printer-fun printer-defun)
              (find-printer-fun ',uniquified-name
 			       ',format-name
@@ -580,7 +584,7 @@
       fields, they are all sign-extended.
 
   :TYPE arg-type-name
-      Inherit any properties of the given argument-type.
+      Inherit any properties of the given argument type.
 
   :PREFILTER function
       A function which is called (along with all other prefilters, in the
@@ -638,10 +642,10 @@
                       :args ,args-var))
                (eval
                 `(progn
-                   ,@(mapcar #'(lambda (arg)
-                                 (when (arg-fields arg)
-                                   (gen-arg-access-macro-def-form
-                                    arg ,args-var ',name)))
+                   ,@(mapcar (lambda (arg)
+			       (when (arg-fields arg)
+				 (gen-arg-access-macro-def-form
+				  arg ,args-var ',name)))
                              ,args-var))))))))))
 
 ;;; FIXME: probably needed only at build-the-system time, not in
@@ -662,7 +666,7 @@
   (let* ((arg-pos (position arg-name args :key #'arg-name))
          (arg
           (if (null arg-pos)
-              (let ((arg (make-argument :name arg-name)))
+              (let ((arg (make-arg :name arg-name)))
                 (if (null args)
                     (setf args (list arg))
                     (push arg (cdr (last args))))
@@ -691,20 +695,20 @@
           can't specify fields except using DEFINE-INSTRUCTION-FORMAT~:>"
          arg-name))
       (setf (arg-fields arg)
-            (mapcar #'(lambda (bytespec)
-                        (when (> (+ (byte-position bytespec)
-                                    (byte-size bytespec))
-                                 format-length)
-                          (error "~@<in arg ~S: ~3I~:_~
+            (mapcar (lambda (bytespec)
+		      (when (> (+ (byte-position bytespec)
+				  (byte-size bytespec))
+			       format-length)
+			(error "~@<in arg ~S: ~3I~:_~
                                      The field ~S doesn't fit in an ~
-                                     instruction-format ~D bits wide.~:>"
-                                 arg-name
-                                 bytespec
-                                 format-length))
-                        (correct-dchunk-bytespec-for-endianness
-                         bytespec
-                         format-length
-                         sb!c:*backend-byte-order*))
+                                     instruction-format ~W bits wide.~:>"
+			       arg-name
+			       bytespec
+			       format-length))
+		      (correct-dchunk-bytespec-for-endianness
+		       bytespec
+		       format-length
+		       sb!c:*backend-byte-order*))
                     fields)))
     args))
 
@@ -752,8 +756,8 @@
               ((atom (cadr atk))
                (push `(,(cadr atk) ,(cddr atk)) bindings))
               (t
-               (mapc #'(lambda (var form)
-                         (push `(,var ,form) bindings))
+               (mapc (lambda (var form)
+		       (push `(,var ,form) bindings))
                      (cadr atk)
                      (cddr atk))))))
     bindings))
@@ -812,39 +816,38 @@
                (car (push (cons kind nil) (cdr this-arg-temps))))))
       (setf (cdr this-kind-temps) (cons vars forms)))))
 
-(defmacro define-argument-type (name &rest args)
-  #!+sb-doc
-  "DEFINE-ARGUMENT-TYPE Name {Key Value}*
-  Define a disassembler argument type NAME (which can then be referenced in
-  another argument definition using the :TYPE argument). &KEY args are:
-
-  :SIGN-EXTEND boolean
-      If non-NIL, the raw value of this argument is sign-extended.
-
-  :TYPE arg-type-name
-      Inherit any properties of given argument-type.
-
-  :PREFILTER function
-      A function which is called (along with all other prefilters, in the
-      order that their arguments appear in the instruction- format) before
-      any printing is done, to filter the raw value. Any uses of READ-SUFFIX
-      must be done inside a prefilter.
-
-  :PRINTER function-string-or-vector
-      A function, string, or vector which is used to print an argument of
-      this type.
-
-  :USE-LABEL
-      If non-NIL, the value of an argument of this type is used as an
-      address, and if that address occurs inside the disassembled code, it is
-      replaced by a label. If this is a function, it is called to filter the
-      value."
+;;; DEFINE-ARG-TYPE Name {Key Value}*
+;;;
+;;; Define a disassembler argument type NAME (which can then be referenced in
+;;; another argument definition using the :TYPE argument). &KEY args are:
+;;;
+;;;  :SIGN-EXTEND boolean
+;;;     If non-NIL, the raw value of this argument is sign-extended.
+;;;
+;;;  :TYPE arg-type-name
+;;;     Inherit any properties of given arg-type.
+;;; 
+;;; :PREFILTER function
+;;;     A function which is called (along with all other prefilters,
+;;;     in the order that their arguments appear in the instruction-
+;;;     format) before any printing is done, to filter the raw value.
+;;;     Any uses of READ-SUFFIX must be done inside a prefilter.
+;;; 
+;;; :PRINTER function-string-or-vector
+;;;     A function, string, or vector which is used to print an argument of
+;;;     this type.
+;;; 
+;;; :USE-LABEL
+;;;     If non-NIL, the value of an argument of this type is used as
+;;;     an address, and if that address occurs inside the disassembled
+;;;     code, it is replaced by a label. If this is a function, it is
+;;;     called to filter the value.
+(defmacro define-arg-type (name &rest args)
   (gen-arg-type-def-form name args))
 
+;;; Generate a form to define a disassembler argument type. See
+;;; DEFINE-ARG-TYPE for more information.
 (defun gen-arg-type-def-form (name args &optional (evalp t))
-  #!+sb-doc
-  "Generate a form to define a disassembler argument type. See
-  DEFINE-ARGUMENT-TYPE for more info."
   (multiple-value-bind (args wrapper-defs)
       (munge-fun-refs args evalp t name)
     `(progn
@@ -855,35 +858,35 @@
 
 (defmacro def-arg-form-kind ((&rest names) &rest inits)
   `(let ((kind (make-arg-form-kind :names ',names ,@inits)))
-     ,@(mapcar #'(lambda (name)
-                   `(setf (getf *arg-form-kinds* ',name) kind))
+     ,@(mapcar (lambda (name)
+		 `(setf (getf *arg-form-kinds* ',name) kind))
                names)))
 
 (def-arg-form-kind (:raw)
-  :producer #'(lambda (arg funstate)
-                (declare (ignore funstate))
-                (mapcar #'(lambda (bytespec)
-                            `(the (unsigned-byte ,(byte-size bytespec))
-                                  (local-extract ',bytespec)))
-                        (arg-fields arg)))
-  :checker #'(lambda (new-arg old-arg)
-               (equal (arg-fields new-arg)
-                      (arg-fields old-arg))))
+  :producer (lambda (arg funstate)
+	      (declare (ignore funstate))
+	      (mapcar (lambda (bytespec)
+			`(the (unsigned-byte ,(byte-size bytespec))
+			   (local-extract ',bytespec)))
+		      (arg-fields arg)))
+  :checker (lambda (new-arg old-arg)
+	     (equal (arg-fields new-arg)
+		    (arg-fields old-arg))))
 
 (def-arg-form-kind (:sign-extended :unfiltered)
-  :producer #'(lambda (arg funstate)
-                (let ((raw-forms (gen-arg-forms arg :raw funstate)))
-                  (if (and (arg-sign-extend-p arg) (listp raw-forms))
-                      (mapcar #'(lambda (form field)
-                                  `(the (signed-byte ,(byte-size field))
-                                        (sign-extend ,form
-                                                     ,(byte-size field))))
-                              raw-forms
-                              (arg-fields arg))
-                      raw-forms)))
-  :checker #'(lambda (new-arg old-arg)
-               (equal (arg-sign-extend-p new-arg)
-                      (arg-sign-extend-p old-arg))))
+  :producer (lambda (arg funstate)
+	      (let ((raw-forms (gen-arg-forms arg :raw funstate)))
+		(if (and (arg-sign-extend-p arg) (listp raw-forms))
+		    (mapcar (lambda (form field)
+			      `(the (signed-byte ,(byte-size field))
+				 (sign-extend ,form
+					      ,(byte-size field))))
+			    raw-forms
+			    (arg-fields arg))
+		    raw-forms)))
+  :checker (lambda (new-arg old-arg)
+	     (equal (arg-sign-extend-p new-arg)
+		    (arg-sign-extend-p old-arg))))
 
 (defun valsrc-equal (f1 f2)
   (if (null f1)
@@ -892,73 +895,73 @@
              (value-or-source f2))))
 
 (def-arg-form-kind (:filtering)
-  :producer #'(lambda (arg funstate)
-                (let ((sign-extended-forms
-                       (gen-arg-forms arg :sign-extended funstate))
-                      (pf (arg-prefilter arg)))
-                  (if pf
-                      (values
-                       `(local-filter ,(maybe-listify sign-extended-forms)
-                                      ,(source-form pf))
-                       t)
-                      (values sign-extended-forms nil))))
-  :checker #'(lambda (new-arg old-arg)
-               (valsrc-equal (arg-prefilter new-arg) (arg-prefilter old-arg))))
+  :producer (lambda (arg funstate)
+	      (let ((sign-extended-forms
+		     (gen-arg-forms arg :sign-extended funstate))
+		    (pf (arg-prefilter arg)))
+		(if pf
+		    (values
+		     `(local-filter ,(maybe-listify sign-extended-forms)
+				    ,(source-form pf))
+		     t)
+		    (values sign-extended-forms nil))))
+  :checker (lambda (new-arg old-arg)
+	     (valsrc-equal (arg-prefilter new-arg) (arg-prefilter old-arg))))
 
 (def-arg-form-kind (:filtered :unadjusted)
-  :producer #'(lambda (arg funstate)
-                (let ((pf (arg-prefilter arg)))
-                  (if pf
-                      (values `(local-filtered-value ,(arg-position arg)) t)
-                      (gen-arg-forms arg :sign-extended funstate))))
-  :checker #'(lambda (new-arg old-arg)
-               (let ((pf1 (arg-prefilter new-arg))
-                     (pf2 (arg-prefilter old-arg)))
-                 (if (null pf1)
-                     (null pf2)
-                     (= (arg-position new-arg)
-                        (arg-position old-arg))))))
+  :producer (lambda (arg funstate)
+	      (let ((pf (arg-prefilter arg)))
+		(if pf
+		    (values `(local-filtered-value ,(arg-position arg)) t)
+		    (gen-arg-forms arg :sign-extended funstate))))
+  :checker (lambda (new-arg old-arg)
+	     (let ((pf1 (arg-prefilter new-arg))
+		   (pf2 (arg-prefilter old-arg)))
+	       (if (null pf1)
+		   (null pf2)
+		   (= (arg-position new-arg)
+		      (arg-position old-arg))))))
 
 (def-arg-form-kind (:adjusted :numeric :unlabelled)
-  :producer #'(lambda (arg funstate)
-                (let ((filtered-forms (gen-arg-forms arg :filtered funstate))
-                      (use-label (arg-use-label arg)))
-                  (if (and use-label (not (eq use-label t)))
-                      (list
-                       `(adjust-label ,(maybe-listify filtered-forms)
-                                      ,(source-form use-label)))
-                      filtered-forms)))
-  :checker #'(lambda (new-arg old-arg)
-               (valsrc-equal (arg-use-label new-arg) (arg-use-label old-arg))))
+  :producer (lambda (arg funstate)
+	      (let ((filtered-forms (gen-arg-forms arg :filtered funstate))
+		    (use-label (arg-use-label arg)))
+		(if (and use-label (not (eq use-label t)))
+		    (list
+		     `(adjust-label ,(maybe-listify filtered-forms)
+				    ,(source-form use-label)))
+		    filtered-forms)))
+  :checker (lambda (new-arg old-arg)
+	     (valsrc-equal (arg-use-label new-arg) (arg-use-label old-arg))))
 
 (def-arg-form-kind (:labelled :final)
-  :producer #'(lambda (arg funstate)
-                (let ((adjusted-forms
-                       (gen-arg-forms arg :adjusted funstate))
-                      (use-label (arg-use-label arg)))
-                  (if use-label
-                      (let ((form (maybe-listify adjusted-forms)))
-                        (if (and (not (eq use-label t))
-                                 (not (atom adjusted-forms))
-                                 (/= (Length adjusted-forms) 1))
-                            (pd-error
-                             "cannot label a multiple-field argument ~
+  :producer (lambda (arg funstate)
+	      (let ((adjusted-forms
+		     (gen-arg-forms arg :adjusted funstate))
+		    (use-label (arg-use-label arg)))
+		(if use-label
+		    (let ((form (maybe-listify adjusted-forms)))
+		      (if (and (not (eq use-label t))
+			       (not (atom adjusted-forms))
+			       (/= (Length adjusted-forms) 1))
+			  (pd-error
+			   "cannot label a multiple-field argument ~
                               unless using a function: ~S" arg)
-                            `((lookup-label ,form))))
-                      adjusted-forms)))
-  :checker #'(lambda (new-arg old-arg)
-               (let ((lf1 (arg-use-label new-arg))
-                     (lf2 (arg-use-label old-arg)))
-                 (if (null lf1) (null lf2) t))))
+			  `((lookup-label ,form))))
+		    adjusted-forms)))
+  :checker (lambda (new-arg old-arg)
+	     (let ((lf1 (arg-use-label new-arg))
+		   (lf2 (arg-use-label old-arg)))
+	       (if (null lf1) (null lf2) t))))
 
 ;;; This is a bogus kind that's just used to ensure that printers are
 ;;; compatible...
 (def-arg-form-kind (:printed)
-  :producer #'(lambda (&rest noise)
-                (declare (ignore noise))
-                (pd-error "bogus! can't use the :printed value of an arg!"))
-  :checker #'(lambda (new-arg old-arg)
-               (valsrc-equal (arg-printer new-arg) (arg-printer old-arg))))
+  :producer (lambda (&rest noise)
+	      (declare (ignore noise))
+	      (pd-error "bogus! can't use the :printed value of an arg!"))
+  :checker (lambda (new-arg old-arg)
+	     (valsrc-equal (arg-printer new-arg) (arg-printer old-arg))))
 
 (defun remember-printer-use (arg funstate)
   (set-arg-temps nil nil arg :printed funstate))
@@ -985,13 +988,13 @@
       (valsrc-value thing)
       thing))
 
-(defstruct (cached-function (:conc-name cached-fun-)
-                            (:copier nil))
+(defstruct (cached-fun (:conc-name cached-fun-)
+		       (:copier nil))
   (funstate nil :type (or null funstate))
   (constraint nil :type list)
   (name nil :type (or null symbol)))
 
-(defun find-cached-function (cached-funs args constraint)
+(defun find-cached-fun (cached-funs args constraint)
   (dolist (cached-fun cached-funs nil)
     (let ((funstate (cached-fun-funstate cached-fun)))
       (when (and (equal constraint (cached-fun-constraint cached-fun))
@@ -999,29 +1002,29 @@
                      (funstate-compatible-p funstate args)))
         (return cached-fun)))))
 
-(defmacro !with-cached-function ((name-var
-				  funstate-var
-				  cache
-				  cache-slot
-				  args
-				  &key
-				  constraint
-				  (stem (required-argument)))
-                                 &body defun-maker-forms)
+(defmacro !with-cached-fun ((name-var
+			     funstate-var
+			     cache
+			     cache-slot
+			     args
+			     &key
+			     constraint
+			     (stem (missing-arg)))
+			    &body defun-maker-forms)
   (let ((cache-var (gensym))
         (constraint-var (gensym)))
     `(let* ((,constraint-var ,constraint)
-            (,cache-var (find-cached-function (,cache-slot ,cache)
-                                              ,args ,constraint-var)))
+            (,cache-var (find-cached-fun (,cache-slot ,cache)
+					 ,args ,constraint-var)))
        (cond (,cache-var
               (values (cached-fun-name ,cache-var) nil))
              (t
               (let* ((,name-var (symbolicate "CACHED-FUN--" ,stem))
                      (,funstate-var (make-funstate ,args))
                      (,cache-var
-                      (make-cached-function :name ,name-var
-                                            :funstate ,funstate-var
-                                            :constraint ,constraint-var)))
+                      (make-cached-fun :name ,name-var
+				       :funstate ,funstate-var
+				       :constraint ,constraint-var)))
                 (values ,name-var
                         `(progn
                            ,(progn ,@defun-maker-forms)
@@ -1034,8 +1037,8 @@
   (if (null printer-source)
       (values nil nil)
       (let ((printer-source (preprocess-printer printer-source args)))
-	(!with-cached-function
-	   (name funstate cache function-cache-printers args
+	(!with-cached-fun
+	   (name funstate cache fun-cache-printers args
 		 :constraint printer-source
 		 :stem (concatenate 'string
 				    (string %name)
@@ -1122,8 +1125,8 @@
            test
            key
            (sharing-mapcar
-            #'(lambda (sub-test)
-                (preprocess-test subj sub-test args))
+            (lambda (sub-test)
+	      (preprocess-test subj sub-test args))
             body))))
         (t form)))))
 
@@ -1147,24 +1150,24 @@
           printer
           :cond
           (sharing-mapcar
-           #'(lambda (clause)
-               (let ((filtered-body
-                      (sharing-mapcar
-                       #'(lambda (sub-printer)
-                           (preprocess-conditionals sub-printer args))
-                       (cdr clause))))
-                 (sharing-cons
-                  clause
-                  (preprocess-test (find-first-field-name filtered-body)
-                                   (car clause)
-                                   args)
-                  filtered-body)))
+           (lambda (clause)
+	     (let ((filtered-body
+		    (sharing-mapcar
+		     (lambda (sub-printer)
+		       (preprocess-conditionals sub-printer args))
+		     (cdr clause))))
+	       (sharing-cons
+		clause
+		(preprocess-test (find-first-field-name filtered-body)
+				 (car clause)
+				 args)
+		filtered-body)))
            (cdr printer))))
         (quote printer)
         (t
          (sharing-mapcar
-          #'(lambda (sub-printer)
-              (preprocess-conditionals sub-printer args))
+          (lambda (sub-printer)
+	    (preprocess-conditionals sub-printer args))
           printer)))))
 
 ;;; Return a version of the disassembly-template PRINTER with
@@ -1196,7 +1199,7 @@
         ((eq (car printer) :choose)
          (pick-printer-choice (cdr printer) args))
         (t
-         (sharing-mapcar #'(lambda (sub) (preprocess-chooses sub args))
+         (sharing-mapcar (lambda (sub) (preprocess-chooses sub args))
                          printer))))
 
 ;;;; some simple functions that help avoid consing when we're just
@@ -1226,7 +1229,7 @@
         ((symbolp printer)
          (find printer args :key #'arg-name))
         ((listp printer)
-         (every #'(lambda (x) (all-arg-refs-relevant-p x args))
+         (every (lambda (x) (all-arg-refs-relevant-p x args))
                 printer))
         (t t)))
 
@@ -1292,13 +1295,13 @@
         ((eq (car source) 'function)
          `(local-call-global-printer ,source))
         ((eq (car source) :cond)
-         `(cond ,@(mapcar #'(lambda (clause)
-                              `(,(compile-test (find-first-field-name
-                                                (cdr clause))
-                                               (car clause)
-                                               funstate)
-                                ,@(compile-printer-list (cdr clause)
-                                                        funstate)))
+         `(cond ,@(mapcar (lambda (clause)
+			    `(,(compile-test (find-first-field-name
+					      (cdr clause))
+					     (car clause)
+					     funstate)
+			      ,@(compile-printer-list (cdr clause)
+						      funstate)))
                           (cdr source))))
         ;; :IF, :UNLESS, and :WHEN are replaced by :COND during preprocessing
         (t
@@ -1347,7 +1350,7 @@
            `(equal ,(listify-fields val-form-1)
                    ,(listify-fields val-form-2)))
           (t
-           `(and ,@(mapcar #'(lambda (v1 v2) `(= ,v1 ,v2))
+           `(and ,@(mapcar (lambda (v1 v2) `(= ,v1 ,v2))
                            val-form-1 val-form-2))))))
 
 (defun compile-test (subj test funstate)
@@ -1381,8 +1384,8 @@
                  (arg2 (arg-or-lose (car body) funstate)))
              (unless (and (= (length (arg-fields arg1))
                              (length (arg-fields arg2)))
-                          (every #'(lambda (bs1 bs2)
-                                     (= (byte-size bs1) (byte-size bs2)))
+                          (every (lambda (bs1 bs2)
+				   (= (byte-size bs1) (byte-size bs2)))
                                  (arg-fields arg1)
                                  (arg-fields arg2)))
                (pd-error "can't compare differently sized fields: ~
@@ -1390,10 +1393,10 @@
              (compare-fields-form (gen-arg-forms arg1 :numeric funstate)
                                   (gen-arg-forms arg2 :numeric funstate))))
           ((eq key :or)
-           `(or ,@(mapcar #'(lambda (sub) (compile-test subj sub funstate))
+           `(or ,@(mapcar (lambda (sub) (compile-test subj sub funstate))
                           body)))
           ((eq key :and)
-           `(and ,@(mapcar #'(lambda (sub) (compile-test subj sub funstate))
+           `(and ,@(mapcar (lambda (sub) (compile-test subj sub funstate))
                            body)))
           ((eq key :not)
            `(not ,(compile-test subj (car body) funstate)))
@@ -1407,8 +1410,8 @@
          (mapcar #'arg-name (remove-if-not #'arg-use-label args))))
     (if (null labelled-fields)
         (values nil nil)
-        (!with-cached-function
-            (name funstate cache function-cache-labellers args
+        (!with-cached-fun
+            (name funstate cache fun-cache-labellers args
              :stem (concatenate 'string "LABELLER-" (string %name))
              :constraint labelled-fields)
           (let ((labels-form 'labels))
@@ -1445,8 +1448,8 @@
 			       (remove-if-not #'arg-prefilter args))))
     (if (null filtered-args)
         (values nil nil)
-        (!with-cached-function
-            (name funstate cache function-cache-prefilters args
+        (!with-cached-fun
+            (name funstate cache fun-cache-prefilters args
              :stem (concatenate 'string
 				(string %name)
 				"-"
@@ -1476,7 +1479,7 @@
                 (declare (ignorable #'local-filter #'local-extract)
                          (inline (setf local-filtered-value)
                                  local-filter local-extract))
-                ;; Use them for side-effects only.
+                ;; Use them for side effects only.
                 (let* ,(make-arg-temp-bindings funstate)
                   ,@(forms)))))))))
 
@@ -1513,7 +1516,7 @@
   (multiple-value-bind (bytes rbits)
       (truncate bits sb!vm:n-byte-bits)
     (when (not (zerop rbits))
-      (error "~D bits is not a byte-multiple." bits))
+      (error "~W bits is not a byte-multiple." bits))
     bytes))
 
 (defun sign-extend (int size)