(:copier nil))
;; The function to envoke to actually emit this instruction. Gets called
;; with the segment as its one argument.
(:copier nil))
;; The function to envoke to actually emit this instruction. Gets called
;; with the segment as its one argument.
;; The attributes of this instruction.
(attributes (instruction-attributes) :type sb!c:attributes)
;; Number of instructions or cycles of delay before additional
;; The attributes of this instruction.
(attributes (instruction-attributes) :type sb!c:attributes)
;; Number of instructions or cycles of delay before additional
(multiple-value-bind (loc-num size)
(sb!c:location-number read)
#!+sb-show-assem (format *trace-output*
(multiple-value-bind (loc-num size)
(sb!c:location-number read)
#!+sb-show-assem (format *trace-output*
(multiple-value-bind (loc-num size)
(sb!c:location-number write)
#!+sb-show-assem (format *trace-output*
(multiple-value-bind (loc-num size)
(sb!c:location-number write)
#!+sb-show-assem (format *trace-output*
note new-size old-size))
(let ((additional-delta (- old-size new-size)))
(when (< (find-alignment additional-delta)
(chooser-alignment note))
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))
note additional-delta (chooser-alignment note)))
(incf delta additional-delta)
(emit-filler segment additional-delta))
;; The chooser passed on shrinking. Make sure it didn't emit
;; anything.
(unless (= (segment-current-index segment) (chooser-index note))
;; The chooser passed on shrinking. Make sure it didn't emit
;; anything.
(unless (= (segment-current-index segment) (chooser-index note))
(old-size (alignment-size note))
(additional-delta (- old-size size)))
(when (minusp additional-delta)
(old-size (alignment-size note))
(additional-delta (- old-size size)))
(when (minusp additional-delta)
(funcall function segment posn)
(let ((new-size (- (segment-current-index segment) index)))
(unless (= new-size old-size)
(funcall function segment posn)
(let ((new-size (- (segment-current-index segment) index)))
(unless (= new-size old-size)
`((**current-segment** ,seg-var)))
,@(when vop
`((**current-vop** ,vop-var)))
`((**current-segment** ,seg-var)))
,@(when vop
`((**current-vop** ,vop-var)))
new-labels))
(symbol-macrolet ((**current-segment** ,seg-var)
(**current-vop** ,vop-var)
,@(when (or inherited-labels nested-labels)
`((..inherited-labels.. ,nested-labels))))
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))
`((**current-segment** ,seg-var)))
,@(when vop
`((**current-vop** ,vop-var)))
`((**current-segment** ,seg-var)))
,@(when vop
`((**current-vop** ,vop-var)))
new-labels))
(symbol-macrolet ((**current-segment** ,seg-var)
(**current-vop** ,vop-var)
,@(when (or inherited-labels nested-labels)
`((..inherited-labels.. ,nested-labels))))
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))
:environment env)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(%define-instruction ,(symbol-name name)
:environment env)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(%define-instruction ,(symbol-name name)