;;; 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
(inst-write-dependencies inst))
(writes write))
(writes)))
- (assert (segment-run-scheduler segment))
+ (aver (segment-run-scheduler segment))
(let ((countdown (segment-branch-countdown segment)))
(when countdown
(decf countdown)
- (assert (not (instruction-attributep (inst-attributes inst)
- variable-length))))
+ (aver (not (instruction-attributep (inst-attributes inst)
+ variable-length))))
(cond ((instruction-attributep (inst-attributes inst) branch)
(unless countdown
(setf countdown (inst-delay inst)))
;;; instructions would sit there until the scheduler was turned back
;;; on, and emitted in the wrong place).
(defun schedule-pending-instructions (segment)
- (assert (segment-run-scheduler segment))
+ (aver (segment-run-scheduler segment))
;; Quick blow-out if nothing to do.
(when (and (sset-empty (segment-emittable-insts-sset segment))
;;; remove this instruction from their dependents list. If we were the
;;; last dependent, then that dependency can be emitted now.
(defun note-resolved-dependencies (segment inst)
- (assert (sset-empty (inst-read-dependents inst)))
- (assert (sset-empty (inst-write-dependents inst)))
+ (aver (sset-empty (inst-read-dependents inst)))
+ (aver (sset-empty (inst-write-dependents inst)))
(do-sset-elements (dep (inst-write-dependencies inst))
;; These are the instructions who have to be completed before our
;; write fires. Doesn't matter how far before, just before.
(: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))
(emit-skip segment (- (ash 1 alignment) slop) fill-byte)))
(let ((size (logand (1- (ash 1 bits))
(lognot (1- (ash 1 alignment))))))
- (assert (> size 0))
+ (aver (> size 0))
(emit-annotation segment (make-alignment bits size fill-byte))
(emit-skip segment size fill-byte))
(setf (segment-alignment segment) bits)
(size (- new-posn posn))
(old-size (alignment-size note))
(additional-delta (- old-size size)))
- (assert (<= 0 size old-size))
+ (aver (<= 0 size old-size))
(unless (zerop additional-delta)
(setf (segment-last-annotation segment) prev)
(incf delta additional-delta)
(let ((forms nil))
(dotimes (i num-bytes)
(let ((pieces (svref bytes i)))
- (assert pieces)
+ (aver pieces)
(push `(emit-byte ,segment-arg
,(if (cdr pieces)
`(logior ,@pieces)
(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