X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fassem.lisp;h=a02c49d5d8a34288c136e18a1a3e9363d46d16a5;hb=89eb73c035f05ae53b1148ef8a83e1d4030b2dd8;hp=a6137b0338f3f6e253e4d2d92d2abd734079e21c;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index a6137b0..a02c49d 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -27,7 +27,7 @@ ;;; 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. @@ -91,7 +91,7 @@ ;; 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 @@ -139,9 +139,9 @@ ;; 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) @@ -316,7 +316,7 @@ (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))) @@ -529,7 +529,7 @@ p ;; the branch has two dependents and one of them dpends on (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. @@ -654,11 +654,11 @@ p ;; the branch has two dependents and one of them dpends on (: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 @@ -667,9 +667,9 @@ p ;; the branch has two dependents and one of them dpends on (: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 @@ -709,14 +709,7 @@ p ;; the branch has two dependents and one of them dpends on ;;; 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)) @@ -1411,7 +1404,7 @@ p ;; the branch has two dependents and one of them dpends on (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 @@ -1445,8 +1438,7 @@ p ;; the branch has two dependents and one of them dpends on (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 @@ -1512,9 +1504,11 @@ p ;; the branch has two dependents and one of them dpends on (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 @@ -1523,10 +1517,13 @@ p ;; the branch has two dependents and one of them dpends on (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