;;; This structure holds the state of the assembler.
(defstruct (segment (:copier nil))
;; the name of this segment (for debugging output and stuff)
- (name "Unnamed" :type simple-base-string)
+ (name "unnamed" :type simple-base-string)
;; 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.
;; have to be emitted at a specific place (e.g. one slot before the
;; end of the block).
(queued-branches nil :type list)
- ;; *** state used by the scheduler during instruction scheduling.
+ ;; *** state used by the scheduler during instruction scheduling
;;
;; 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
- ;; variable length, and therefore better never be used in a branch
- ;; delay slot.
- variable-length)
+ ;; variable length, and therefore had better never be used in a
+ ;; branch delay slot.
+ var-length)
(defstruct (instruction
(:include sset-element)
(when countdown
(decf countdown)
(aver (not (instruction-attributep (inst-attributes inst)
- variable-length))))
+ var-length))))
(cond ((instruction-attributep (inst-attributes inst) branch)
(unless countdown
(setf countdown (inst-delay inst)))
(let ((inst (car remaining)))
(unless (and delay-slot-p
(instruction-attributep (inst-attributes inst)
- variable-length))
+ var-length))
;; 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.
(:predicate alignment-p)
(:constructor make-alignment (bits size fill-byte))
(:copier nil))
- ;; The minimum number of low-order bits that must be zero.
+ ;; the minimum number of low-order bits that must be zero
(bits 0 :type alignment)
- ;; The amount of filler we are assuming this alignment op will take.
+ ;; the amount of filler we are assuming this alignment op will take
(size 0 :type (integer 0 #.(1- (ash 1 max-alignment))))
- ;; The byte used as filling.
+ ;; the byte used as filling
(fill-byte 0 :type (or assembly-unit (signed-byte #.assembly-unit-bits))))
;;; a reference to someplace that needs to be back-patched when
(:include annotation)
(:constructor make-back-patch (size function))
(:copier nil))
- ;; The area effected by this back-patch.
+ ;; the area effected by this back-patch
(size 0 :type index)
- ;; The function to use to generate the real data
+ ;; the function to use to generate the real data
(function nil :type function))
;;; This is similar to a BACK-PATCH, but also an indication that the
;;; necessary.
(defun emit-byte (segment byte)
(declare (type segment segment))
- ;; We could use DECLARE instead of CHECK-TYPE here, but (1) CMU CL's
- ;; inspired decision to treat DECLARE as ASSERT by default has not
- ;; been copied by other compilers, and this code runs in the
- ;; cross-compilation host Common Lisp, not just CMU CL, and (2)
- ;; classic CMU CL allowed more things here than this, and I haven't
- ;; tried to proof-read all the calls to EMIT-BYTE to ensure that
- ;; they're passing appropriate. -- WHN 19990323
- (check-type byte possibly-signed-assembly-unit)
+ (declare (type possibly-signed-assembly-unit byte))
(vector-push-extend (logand byte assembly-unit-mask)
(segment-buffer segment))
(incf (segment-current-posn segment))
(when lambda-list
(let ((param (car lambda-list)))
(cond
- ((member param lambda-list-keywords)
+ ((member param sb!xc:lambda-list-keywords)
(new-lambda-list param)
(grovel param (cdr lambda-list)))
(t
(multiple-value-bind (key var)
(if (consp name)
(values (first name) (second name))
- (values (intern (symbol-name name) :keyword)
- name))
+ (values (keywordicate name) name))
`(append (and ,supplied-p (list ',key ,var))
,(grovel state (cdr lambda-list))))))
(&rest
(error "You can only specify :VOP-VAR once per instruction.")
(setf vop-var (car args))))
(:printer
+ (sb!int:/noshow "uniquifying :PRINTER with" args)
(push (eval `(list (multiple-value-list
,(sb!disassem:gen-printer-def-forms-def-form
name
+ (format nil "~A[~A]" name args)
(cdr option-spec)))))
pdefs))
(:printer-list
(push
(eval
`(eval
- `(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)))
,(cadr option-spec)))))
pdefs))
(t
projects / sbcl.git / blobdiff