- (dolist (spec specs)
- (unless (consp spec)
- (error "malformed option specification: ~S" spec))
- (case (first spec)
- (:args
- (multiple-value-bind (fixed more)
- (!parse-vop-operands parse (rest spec) :argument)
- (setf (vop-parse-args parse) fixed)
- (setf (vop-parse-more-args parse) more)))
- (:results
- (multiple-value-bind (fixed more)
- (!parse-vop-operands parse (rest spec) :result)
- (setf (vop-parse-results parse) fixed)
- (setf (vop-parse-more-results parse) more))
- (setf (vop-parse-conditional-p parse) nil))
- (:conditional
- (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))
- (:temporary
- (parse-temporary spec parse))
- (:generator
- (setf (vop-parse-cost parse)
- (vop-spec-arg spec 'unsigned-byte 1 nil))
- (setf (vop-parse-body parse) (cddr spec)))
- (:effects
- (setf (vop-parse-effects parse) (rest spec)))
- (:affected
- (setf (vop-parse-affected parse) (rest spec)))
- (:info
- (setf (vop-parse-info-args parse) (rest spec)))
- (:ignore
- (setf (vop-parse-ignores parse) (rest spec)))
- (:variant
- (setf (vop-parse-variant parse) (rest spec)))
- (:variant-vars
- (let ((vars (rest spec)))
- (setf (vop-parse-variant-vars parse) vars)
- (setf (vop-parse-variant parse)
- (make-list (length vars) :initial-element nil))))
- (:variant-cost
- (setf (vop-parse-cost parse) (vop-spec-arg spec 'unsigned-byte)))
- (:vop-var
- (setf (vop-parse-vop-var parse) (vop-spec-arg spec 'symbol)))
- (:move-args
- (setf (vop-parse-move-args parse)
- (vop-spec-arg spec '(member nil :local-call :full-call
- :known-return))))
- (:node-var
- (setf (vop-parse-node-var parse) (vop-spec-arg spec 'symbol)))
- (:note
- (setf (vop-parse-note parse) (vop-spec-arg spec '(or string null))))
- (:arg-types
- (setf (vop-parse-arg-types parse)
- (!parse-vop-operand-types (rest spec) t)))
- (:result-types
- (setf (vop-parse-result-types parse)
- (!parse-vop-operand-types (rest spec) nil)))
- (:translate
- (setf (vop-parse-translate parse) (rest spec)))
- (:guard
- (setf (vop-parse-guard parse) (vop-spec-arg spec t)))
- ;; FIXME: :LTN-POLICY would be a better name for this. It would
- ;; probably be good to leave it unchanged for a while, though,
- ;; at least until the first port to some other architecture,
- ;; since the renaming would be a change to the interface between
- (:policy
- (setf (vop-parse-ltn-policy parse)
- (vop-spec-arg spec 'ltn-policy)))
- (:save-p
- (setf (vop-parse-save-p parse)
- (vop-spec-arg spec
- '(member t nil :compute-only :force-to-stack))))
- (t
- (error "unknown option specifier: ~S" (first spec)))))
- (values))
+ (let ((*parse-vop-operand-count* (compute-parse-vop-operand-count parse)))
+ (dolist (spec specs)
+ (unless (consp spec)
+ (error "malformed option specification: ~S" spec))
+ (case (first spec)
+ (:args
+ (multiple-value-bind (fixed more)
+ (!parse-vop-operands parse (rest spec) :argument)
+ (setf (vop-parse-args parse) fixed)
+ (setf (vop-parse-more-args parse) more)))
+ (:results
+ (multiple-value-bind (fixed more)
+ (!parse-vop-operands parse (rest spec) :result)
+ (setf (vop-parse-results parse) fixed)
+ (setf (vop-parse-more-results parse) more))
+ (setf (vop-parse-conditional-p parse) nil))
+ (:conditional
+ (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))
+ (:temporary
+ (parse-temporary spec parse))
+ (:generator
+ (setf (vop-parse-cost parse)
+ (vop-spec-arg spec 'unsigned-byte 1 nil))
+ (setf (vop-parse-body parse) (cddr spec)))
+ (:effects
+ (setf (vop-parse-effects parse) (rest spec)))
+ (:affected
+ (setf (vop-parse-affected parse) (rest spec)))
+ (:info
+ (setf (vop-parse-info-args parse) (rest spec)))
+ (:ignore
+ (setf (vop-parse-ignores parse) (rest spec)))
+ (:variant
+ (setf (vop-parse-variant parse) (rest spec)))
+ (:variant-vars
+ (let ((vars (rest spec)))
+ (setf (vop-parse-variant-vars parse) vars)
+ (setf (vop-parse-variant parse)
+ (make-list (length vars) :initial-element nil))))
+ (:variant-cost
+ (setf (vop-parse-cost parse) (vop-spec-arg spec 'unsigned-byte)))
+ (:vop-var
+ (setf (vop-parse-vop-var parse) (vop-spec-arg spec 'symbol)))
+ (:move-args
+ (setf (vop-parse-move-args parse)
+ (vop-spec-arg spec '(member nil :local-call :full-call
+ :known-return))))
+ (:node-var
+ (setf (vop-parse-node-var parse) (vop-spec-arg spec 'symbol)))
+ (:note
+ (setf (vop-parse-note parse) (vop-spec-arg spec '(or string null))))
+ (:arg-types
+ (setf (vop-parse-arg-types parse)
+ (!parse-vop-operand-types (rest spec) t)))
+ (:result-types
+ (setf (vop-parse-result-types parse)
+ (!parse-vop-operand-types (rest spec) nil)))
+ (:translate
+ (setf (vop-parse-translate parse) (rest spec)))
+ (:guard
+ (setf (vop-parse-guard parse) (vop-spec-arg spec t)))
+ ;; FIXME: :LTN-POLICY would be a better name for this. It
+ ;; would probably be good to leave it unchanged for a while,
+ ;; though, at least until the first port to some other
+ ;; architecture, since the renaming would be a change to the
+ ;; interface between
+ (:policy
+ (setf (vop-parse-ltn-policy parse)
+ (vop-spec-arg spec 'ltn-policy)))
+ (:save-p
+ (setf (vop-parse-save-p parse)
+ (vop-spec-arg spec
+ '(member t nil :compute-only :force-to-stack))))
+ (t
+ (error "unknown option specifier: ~S" (first spec)))))
+ (values)))