X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=b7318fe7901c80364bae0c3d98fbcbaa999bde80;hb=7f6e75c553b4465ced41c3640292834d803761eb;hp=41270d2967fe8b014f31bcf81a8f6ca54cde16a8;hpb=de01f09401517c1a96de3faeac585e46895940ec;p=sbcl.git diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 41270d2..b7318fe 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -389,7 +389,9 @@ (operands nil :type list) ;; names of variables that should be declared IGNORE (ignores () :type list) - ;; true if this is a :CONDITIONAL VOP + ;; true if this is a :CONDITIONAL VOP. T if a branchful VOP, + ;; a list of condition descriptor otherwise. See $ARCH/pred.lisp + ;; for more information. (conditional-p nil) ;; argument and result primitive types. These are pulled out of the ;; operands, since we often want to change them without respecifying @@ -669,16 +671,16 @@ (incf index) (refs (cons (cons born t) index)))) (incf index))) - (let* ((sorted (sort (refs) - (lambda (x y) - (let ((x-time (car x)) - (y-time (car y))) - (if (time-spec-order x-time y-time) - (if (time-spec-order y-time x-time) - (and (not (cdr x)) (cdr y)) - nil) - t))) - :key #'car)) + (let* ((sorted (stable-sort (refs) + (lambda (x y) + (let ((x-time (car x)) + (y-time (car y))) + (if (time-spec-order x-time y-time) + (if (time-spec-order y-time x-time) + (and (not (cdr x)) (cdr y)) + nil) + t))) + :key #'car)) ;; :REF-ORDERING element type ;; ;; KLUDGE: was (MOD #.MAX-VOP-TN-REFS), which is still right @@ -1083,7 +1085,7 @@ (setf (vop-parse-result-types parse) ()) (setf (vop-parse-results parse) ()) (setf (vop-parse-more-results parse) nil) - (setf (vop-parse-conditional-p parse) t)) + (setf (vop-parse-conditional-p parse) (or (rest spec) t))) (:temporary (parse-temporary spec parse)) (:generator @@ -1460,9 +1462,12 @@ `(:type (specifier-type '(function () nil)) :arg-types (list ,@(mapcar #'make-operand-type args)) :more-args-type ,(when more-args (make-operand-type more-arg)) - :result-types ,(if conditional - :conditional - `(list ,@(mapcar #'make-operand-type results))) + :result-types ,(cond ((eq conditional t) + :conditional) + (conditional + `'(:conditional . ,conditional)) + (t + `(list ,@(mapcar #'make-operand-type results)))) :more-results-type ,(when more-results (make-operand-type more-result))))) @@ -1572,7 +1577,7 @@ ;;; (:ARGUMENT N)/(:RESULT N). These options are necessary ;;; primarily when operands are read or written out of order. ;;; -;;; :CONDITIONAL +;;; :CONDITIONAL [Condition-descriptor+] ;;; This is used in place of :RESULTS with conditional branch VOPs. ;;; There are no result values: the result is a transfer of control. ;;; The target label is passed as the first :INFO arg. The second @@ -1580,6 +1585,10 @@ ;;; A side effect is to set the PREDICATE attribute for functions ;;; in the :TRANSLATE option. ;;; +;;; If some condition descriptors are provided, this is a flag-setting +;;; VOP. Descriptors are interpreted in an architecture-dependent +;;; manner. See the BRANCH-IF VOP in $ARCH/pred.lisp. +;;; ;;; :TEMPORARY ({Key Value}*) Name* ;;; Allocate a temporary TN for each Name, binding that variable to ;;; the TN within the body of the generators. In addition to :TARGET @@ -1590,7 +1599,7 @@ ;;; :OFFSET SB-Offset ;;; Force the temporary to be allocated in the specified SC ;;; with the specified offset. Offset is evaluated at -;;; macroexpand time. If Offset is emitted, the register +;;; macroexpand time. If Offset is omitted, the register ;;; allocator chooses a free location in SC. If both SC and ;;; Offset are omitted, then the temporary is packed according ;;; to its primitive type. @@ -1600,7 +1609,7 @@ ;;; Similar to the argument/result option, this specifies the ;;; start and end of the temporaries' lives. The defaults are ;;; :LOAD and :SAVE, i.e. the duration of the VOP. The other -;;; intervening phases are :ARGUMENT,:EVAL and :RESULT. +;;; intervening phases are :ARGUMENT, :EVAL and :RESULT. ;;; Non-zero sub-phases can be specified by a list, e.g. by ;;; default the second argument's life ends at (:ARGUMENT 1). ;;; @@ -1682,7 +1691,7 @@ ;;; :MOVE-ARGS {NIL | :FULL-CALL | :LOCAL-CALL | :KNOWN-RETURN} ;;; Indicates if and how the more args should be moved into a ;;; different frame. -(def!macro define-vop ((name &optional inherits) &rest specs) +(def!macro define-vop ((name &optional inherits) &body specs) (declare (type symbol name)) ;; Parse the syntax into a VOP-PARSE structure, and then expand into ;; code that creates the appropriate VOP-INFO structure at load time. @@ -1750,16 +1759,15 @@ ;;; Call the emit function for TEMPLATE, linking the result in at the ;;; end of BLOCK. (defmacro emit-template (node block template args results &optional info) - (let ((n-first (gensym)) - (n-last (gensym))) + (with-unique-names (first last) (once-only ((n-node node) (n-block block) (n-template template)) - `(multiple-value-bind (,n-first ,n-last) + `(multiple-value-bind (,first ,last) (funcall (template-emit-function ,n-template) ,n-node ,n-block ,n-template ,args ,results ,@(when info `(,info))) - (insert-vop-sequence ,n-first ,n-last ,n-block nil))))) + (insert-vop-sequence ,first ,last ,n-block nil))))) ;;; VOP Name Node Block Arg* Info* Result* ;;; @@ -1925,37 +1933,34 @@ ;;; represented by a local conflicts bit-vector and the IR2-BLOCK ;;; containing the location. (defmacro do-live-tns ((tn-var live block &optional result) &body body) - (let ((n-conf (gensym)) - (n-bod (gensym)) - (i (gensym)) - (ltns (gensym))) + (with-unique-names (conf bod i ltns) (once-only ((n-live live) (n-block block)) `(block nil - (flet ((,n-bod (,tn-var) ,@body)) + (flet ((,bod (,tn-var) ,@body)) ;; Do component-live TNs. (dolist (,tn-var (ir2-component-component-tns (component-info (block-component (ir2-block-block ,n-block))))) - (,n-bod ,tn-var)) + (,bod ,tn-var)) (let ((,ltns (ir2-block-local-tns ,n-block))) ;; Do TNs always-live in this block and live :MORE TNs. - (do ((,n-conf (ir2-block-global-tns ,n-block) - (global-conflicts-next-blockwise ,n-conf))) - ((null ,n-conf)) - (when (or (eq (global-conflicts-kind ,n-conf) :live) - (let ((,i (global-conflicts-number ,n-conf))) + (do ((,conf (ir2-block-global-tns ,n-block) + (global-conflicts-next-blockwise ,conf))) + ((null ,conf)) + (when (or (eq (global-conflicts-kind ,conf) :live) + (let ((,i (global-conflicts-number ,conf))) (and (eq (svref ,ltns ,i) :more) (not (zerop (sbit ,n-live ,i)))))) - (,n-bod (global-conflicts-tn ,n-conf)))) + (,bod (global-conflicts-tn ,conf)))) ;; Do TNs locally live in the designated live set. (dotimes (,i (ir2-block-local-tn-count ,n-block) ,result) (unless (zerop (sbit ,n-live ,i)) (let ((,tn-var (svref ,ltns ,i))) (when (and ,tn-var (not (eq ,tn-var :more))) - (,n-bod ,tn-var))))))))))) + (,bod ,tn-var))))))))))) ;;; Iterate over all the IR2 blocks in PHYSENV, in emit order. (defmacro do-physenv-ir2-blocks ((block-var physenv &optional result)