+ . tail))))
+
+(defgeneric effective-method-keyword-parser-function-name (method)
+ (:documentation
+ "Return the name of the keyword-parsing function for an effective METHOD.
+
+ See `make-keyword-parser-function' for details of what this function
+ actually does."))
+
+(defmethod effective-method-keyword-parser-function-name
+ ((method basic-effective-method))
+ (with-slots ((class %class) message) method
+ (format nil "~A__kwparse_~A__~A"
+ class
+ (sod-class-nickname (sod-message-class message))
+ (sod-message-name message))))
+
+(defun make-keyword-parser-function (codegen method tag set keywords)
+ "Construct and return a keyword-argument parsing function.
+
+ The function is contributed to the CODEGEN, with the name constructed from
+ the effective METHOD. It will populate an argument structure with the
+ given TAG. In case of error, it will mention the name SET in its report.
+ The KEYWORDS are a list of `argument' objects naming the keywords to be
+ accepted.
+
+ The generated function has the signature
+
+ void NAME(struct TAG *kw, va_list *ap, struct kwval *v, size_t n)
+
+ It assumes that AP includes the first keyword name. (This makes it
+ different from the keyword-parsing functions generated by the
+ `KWSET_PARSEFN' macro, but this interface is slightly more convenient and
+ we don't need to cope with functions which accept no required
+ arguments.)"
+
+ ;; Let's start, then.
+ (codegen-push codegen)
+
+ ;; Set up the local variables we'll need.
+ (macrolet ((var (name type)
+ `(ensure-var codegen ,name (c-type ,type))))
+ (var "k" const-string)
+ (var "aap" (* va-list))
+ (var "t" (* (struct "kwtab" :const)))
+ (var "vv" (* (struct "kwval" :const)))
+ (var "nn" size-t))
+
+ (flet ((call (target func &rest args)
+ ;; Call FUNC with ARGS; return result in TARGET.
+
+ (apply #'deliver-call codegen target func args))
+
+ (convert (target type)
+ ;; Fetch the object of TYPE pointed to by `v->val', and store it
+ ;; in TARGET.
+
+ (deliver-expr codegen target
+ (format nil "*(~A)v->val"
+ (make-pointer-type (qualify-c-type
+ type (list :const))))))
+
+ (namecheck (var name conseq alt)
+ ;; Return an instruction: if VAR matches the string NAME then do
+ ;; CONSEQ; otherwise do ALT.
+
+ (make-if-inst (make-call-inst "!strcmp"
+ var (prin1-to-string name))
+ conseq alt)))
+
+ ;; Prepare the main parsing loops. We're going to construct them both at
+ ;; the same time. They're not quite similar enough for it to be
+ ;; worthwhile abstracting this further, but carving up the keywords is
+ ;; too tedious to write out more than once.
+ (let ((va-act (make-expr-inst (make-call-inst "kw_unknown" set "k")))
+ (tab-act (make-expr-inst (make-call-inst "kw_unknown"
+ set "v->kw")))
+ (name (effective-method-keyword-parser-function-name method)))
+
+ ;; Work through the keywords. We're going to be building up the
+ ;; conditional dispatch from the end, so reverse the (nicely sorted)
+ ;; list before processing it.
+ (dolist (key (reverse keywords))
+ (let* ((key-name (argument-name key))
+ (key-type (argument-type key)))
+
+ ;; Handle the varargs case.
+ (codegen-push codegen)
+ (deliver-expr codegen (format nil "kw->~A__suppliedp" key-name) 1)
+ (call (format nil "kw->~A" key-name) "va_arg" "*ap" key-type)
+ (setf va-act (namecheck "k" key-name
+ (codegen-pop-block codegen) va-act))
+
+ ;; Handle the table case.
+ (codegen-push codegen)
+ (deliver-expr codegen (format nil "kw->~A__suppliedp" key-name) 1)
+ (convert (format nil "kw->~A" key-name) key-type)
+ (setf tab-act (namecheck "v->kw" key-name
+ (codegen-pop-block codegen) tab-act))))
+
+ ;; Deal with the special `kw.' keywords read via varargs.
+ (codegen-push codegen)
+ (call "vv" "va_arg" "*ap" (c-type (* (struct "kwval" :const))))
+ (call "nn" "va_arg" "*ap" c-type-size-t)
+ (call :void name "kw" *null-pointer* "vv" "nn")
+ (setf va-act (namecheck "k" "kw.tab"
+ (codegen-pop-block codegen) va-act))
+
+ (codegen-push codegen)
+ (call "aap" "va_arg" "*ap" (c-type (* va-list)))
+ (call :void name "kw" "aap" *null-pointer* 0)
+ (setf va-act (namecheck "k" "kw.valist"
+ (codegen-pop-block codegen) va-act))
~mdw / sod / blobdiff