;;; This structure holds the state of the assembler.
(defstruct (segment (:copier nil))
;; the name of this segment (for debugging output and stuff)
;;; This structure holds the state of the assembler.
(defstruct (segment (:copier nil))
;; the name of this segment (for debugging output and stuff)
;; Ordinarily this is a vector where instructions are written. If
;; the segment is made invalid (e.g. by APPEND-SEGMENT) then the
;; vector can be replaced by NIL.
;; Ordinarily this is a vector where instructions are written. If
;; the segment is made invalid (e.g. by APPEND-SEGMENT) then the
;; vector can be replaced by NIL.
;;
;; the instructions who would have had a read dependent removed if
;; it were not for a delay slot. This is a list of lists. Each
;;
;; the instructions who would have had a read dependent removed if
;; it were not for a delay slot. This is a list of lists. Each
;; how many instructions follow the branch.
branch
;; This attribute indicates that this ``instruction'' can be
;; how many instructions follow the branch.
branch
;; This attribute indicates that this ``instruction'' can be
(: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*
(let ((inst (car remaining)))
(unless (and delay-slot-p
(instruction-attributep (inst-attributes inst)
(let ((inst (car remaining)))
(unless (and delay-slot-p
(instruction-attributep (inst-attributes inst)
;; We've got us a live one here. Go for it.
#!+sb-show-assem (format *trace-output* "emitting ~S~%" inst)
;; Delete it from the list of insts.
;; We've got us a live one here. Go for it.
#!+sb-show-assem (format *trace-output* "emitting ~S~%" inst)
;; Delete it from the list of insts.
(fill-byte 0 :type (or assembly-unit (signed-byte #.assembly-unit-bits))))
;;; a reference to someplace that needs to be back-patched when
(fill-byte 0 :type (or assembly-unit (signed-byte #.assembly-unit-bits))))
;;; a reference to someplace that needs to be back-patched when
(function nil :type function))
;;; This is similar to a BACK-PATCH, but also an indication that the
(function nil :type function))
;;; This is similar to a BACK-PATCH, but also an indication that the
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))
(push (eval `(list (multiple-value-list
,(sb!disassem:gen-printer-def-forms-def-form
name
(push (eval `(list (multiple-value-list
,(sb!disassem:gen-printer-def-forms-def-form
name
- `(list ,@(mapcar #'(lambda (printer)
- `(multiple-value-list
- ,(sb!disassem:gen-printer-def-forms-def-form
- ',name printer nil)))
+ `(list ,@(mapcar (lambda (printer)
+ `(multiple-value-list
+ ,(sb!disassem:gen-printer-def-forms-def-form
+ ',name
+ (format nil "~A[~A]" ',name printer)
+ printer
+ nil)))
: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)