X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fassem.lisp;h=3033cb44f07972efe84ec73b8ae862b921b0dec9;hb=5edd74f6911093805a009a152b32216b3dba59f7;hp=a02c49d5d8a34288c136e18a1a3e9363d46d16a5;hpb=89eb73c035f05ae53b1148ef8a83e1d4030b2dd8;p=sbcl.git diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index a02c49d..3033cb4 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -150,7 +150,7 @@ (:copier nil)) ;; The function to envoke to actually emit this instruction. Gets called ;; with the segment as its one argument. - (emitter (required-argument) :type (or null function)) + (emitter (missing-arg) :type (or null function)) ;; The attributes of this instruction. (attributes (instruction-attributes) :type sb!c:attributes) ;; Number of instructions or cycles of delay before additional @@ -192,7 +192,7 @@ name) '))) (when (inst-depth inst) - (format stream ", depth=~D" (inst-depth inst))))) + (format stream ", depth=~W" (inst-depth inst))))) #!+sb-show-assem (defun reset-inst-ids () @@ -230,7 +230,7 @@ (multiple-value-bind (loc-num size) (sb!c:location-number read) #!+sb-show-assem (format *trace-output* - "~&~S reads ~S[~D for ~D]~%" + "~&~S reads ~S[~W for ~W]~%" inst read loc-num size) (when loc-num ;; Iterate over all the locations for this TN. @@ -267,7 +267,7 @@ (multiple-value-bind (loc-num size) (sb!c:location-number write) #!+sb-show-assem (format *trace-output* - "~&~S writes ~S[~D for ~D]~%" + "~&~S writes ~S[~W for ~W]~%" inst write loc-num size) (when loc-num ;; Iterate over all the locations for this TN. @@ -908,13 +908,13 @@ p ;; the branch has two dependents and one of them dpends on (chooser-index note))) (old-size (chooser-size note))) (when (> new-size old-size) - (error "~S emitted ~D bytes, but claimed its max was ~D." + (error "~S emitted ~W bytes, but claimed its max was ~W." note new-size old-size)) (let ((additional-delta (- old-size new-size))) (when (< (find-alignment additional-delta) (chooser-alignment note)) - (error "~S shrunk by ~D bytes, but claimed that it ~ - preserve ~D bits of alignment." + (error "~S shrunk by ~W bytes, but claimed that it ~ + preserves ~W bits of alignment." note additional-delta (chooser-alignment note))) (incf delta additional-delta) (emit-filler segment additional-delta)) @@ -927,7 +927,7 @@ p ;; the branch has two dependents and one of them dpends on ;; The chooser passed on shrinking. Make sure it didn't emit ;; anything. (unless (= (segment-current-index segment) (chooser-index note)) - (error "Chooser ~S passed, but not before emitting ~D bytes." + (error "Chooser ~S passed, but not before emitting ~W bytes." note (- (segment-current-index segment) (chooser-index note)))) @@ -955,8 +955,8 @@ p ;; the branch has two dependents and one of them dpends on (old-size (alignment-size note)) (additional-delta (- old-size size))) (when (minusp additional-delta) - (error "Alignment ~S needs more space now? It was ~D, ~ - and is ~D now." + (error "Alignment ~S needs more space now? It was ~W, ~ + and is ~W now." note old-size size)) (when (plusp additional-delta) (emit-filler segment additional-delta) @@ -1027,7 +1027,7 @@ p ;; the branch has two dependents and one of them dpends on (funcall function segment posn) (let ((new-size (- (segment-current-index segment) index))) (unless (= new-size old-size) - (error "~S emitted ~D bytes, but claimed it was ~D." + (error "~S emitted ~W bytes, but claimed it was ~W." note new-size old-size))) (let ((tail (segment-last-annotation segment))) (if tail @@ -1110,17 +1110,17 @@ p ;; the branch has two dependents and one of them dpends on `((**current-segment** ,seg-var))) ,@(when vop `((**current-vop** ,vop-var))) - ,@(mapcar #'(lambda (name) - `(,name (gen-label))) + ,@(mapcar (lambda (name) + `(,name (gen-label))) new-labels)) (symbol-macrolet ((**current-segment** ,seg-var) (**current-vop** ,vop-var) ,@(when (or inherited-labels nested-labels) `((..inherited-labels.. ,nested-labels)))) - ,@(mapcar #'(lambda (form) - (if (label-name-p form) - `(emit-label ,form) - form)) + ,@(mapcar (lambda (form) + (if (label-name-p form) + `(emit-label ,form) + form)) body)))))) #+sb-xc-host (sb!xc:defmacro assemble ((&optional segment vop &key labels) @@ -1152,17 +1152,17 @@ p ;; the branch has two dependents and one of them dpends on `((**current-segment** ,seg-var))) ,@(when vop `((**current-vop** ,vop-var))) - ,@(mapcar #'(lambda (name) - `(,name (gen-label))) + ,@(mapcar (lambda (name) + `(,name (gen-label))) new-labels)) (symbol-macrolet ((**current-segment** ,seg-var) (**current-vop** ,vop-var) ,@(when (or inherited-labels nested-labels) `((..inherited-labels.. ,nested-labels)))) - ,@(mapcar #'(lambda (form) - (if (label-name-p form) - `(emit-label ,form) - form)) + ,@(mapcar (lambda (form) + (if (label-name-p form) + `(emit-label ,form) + form)) body)))))) (defmacro inst (&whole whole instruction &rest args &environment env) @@ -1316,7 +1316,7 @@ p ;; the branch has two dependents and one of them dpends on (num-bytes (multiple-value-bind (quo rem) (truncate total-bits assembly-unit-bits) (unless (zerop rem) - (error "~D isn't an even multiple of ~D." + (error "~W isn't an even multiple of ~W." total-bits assembly-unit-bits)) quo)) (bytes (make-array num-bytes :initial-element nil)) @@ -1452,11 +1452,11 @@ p ;; the branch has two dependents and one of them dpends on reconstructor)))))) (defun extract-nths (index glue list-of-lists-of-lists) - (mapcar #'(lambda (list-of-lists) - (cons glue - (mapcar #'(lambda (list) - (nth index list)) - list-of-lists))) + (mapcar (lambda (list-of-lists) + (cons glue + (mapcar (lambda (list) + (nth index list)) + list-of-lists))) list-of-lists-of-lists)) (defmacro define-instruction (name lambda-list &rest options) @@ -1624,10 +1624,10 @@ p ;; the branch has two dependents and one of them dpends on :environment env) `(eval-when (:compile-toplevel :load-toplevel :execute) (%define-instruction ,(symbol-name name) - #'(lambda (,whole ,env) - ,@local-defs - (block ,name - ,body))))))) + (lambda (,whole ,env) + ,@local-defs + (block ,name + ,body))))))) (defun %define-instruction (name defun) (setf (gethash name *assem-instructions*) defun)