An optional Closure parameter, but otherwise works the same way as Closure. --- generator/generator | 54 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 44 insertions(+), 10 deletions(-) diff --git a/generator/generator b/generator/generator index 01da1c3..3add9a4 100755 --- a/generator/generator +++ b/generator/generator @@ -867,6 +867,7 @@ and arg = | UInt32 of string (* 32 bit unsigned int *) | UInt64 of string (* 64 bit unsigned int *) and optarg = +| OClosure of closure (* optional closure *) | OFlags of string * flags (* optional flags, uint32_t in C *) and ret = | RBool (* return a boolean, or error *) @@ -3184,16 +3185,6 @@ end = struct (* Check the API definition. *) let () = - (* Currently optargs can only be [] or [OFlags]. This condition - * will be relaxed later when we support more optional arguments. - *) - List.iter ( - function - | _, { optargs = [] } | _, { optargs = [OFlags _] } -> () - | (name, _) -> - failwithf "%s: optargs can only be empty list or [OFlags]" name - ) handle_calls; - (* Check functions using may_set_error. *) List.iter ( function @@ -3377,6 +3368,12 @@ let rec print_arg_list ?(handle = false) ?(types = true) args optargs = if !comma then pr ", "; comma := true; match optarg with + | OClosure { cbname; cbargs } -> + if types then pr "nbd_%s_callback " cbname; + pr "%s_callback" cbname; + pr ", "; + if types then pr "void *"; + pr "%s_user_data" cbname | OFlags (n, _) -> if types then pr "uint32_t "; pr "%s" n @@ -3707,6 +3704,7 @@ let generate_lib_api_c () = ) args; List.iter ( function + | OClosure _ -> () | OFlags (n, flags) -> print_flags_check n flags ) optargs; @@ -3756,6 +3754,7 @@ let generate_lib_api_c () = ) args; List.iter ( function + | OClosure { cbname } -> pr " %s=%%s" cbname | OFlags (n, _) -> pr " %s=0x%%x" n ) optargs; pr "\""; @@ -3778,6 +3777,7 @@ let generate_lib_api_c () = ) args; List.iter ( function + | OClosure { cbname } -> pr ", %s_callback ? \"<fun>\" : \"NULL\"" cbname | OFlags (n, _) -> pr ", %s" n ) optargs; pr ");\n" @@ -4286,6 +4286,8 @@ let print_python_binding name { args; optargs; ret; may_set_error } = ) args; List.iter ( function + | OClosure { cbname } -> + pr " PyObject *%s_user_data;\n" cbname | OFlags (n, _) -> pr " uint32_t %s_u32;\n" n; pr " unsigned int %s; /* really uint32_t */\n" n @@ -4316,6 +4318,7 @@ let print_python_binding name { args; optargs; ret; may_set_error } = ) args; List.iter ( function + | OClosure _ -> pr " \"O\"" | OFlags _ -> pr " \"I\"" ) optargs; pr "\n"; @@ -4342,6 +4345,7 @@ let print_python_binding name { args; optargs; ret; may_set_error } = ) args; List.iter ( function + | OClosure { cbname } -> pr ", &%s_user_data" cbname | OFlags (n, _) -> pr ", &%s" n ) optargs; pr "))\n"; @@ -4383,6 +4387,16 @@ let print_python_binding name { args; optargs; ret; may_set_error } = ) args; List.iter ( function + | OClosure { cbname } -> + pr " if (%s_user_data) {\n" cbname; + pr " /* Increment refcount since pointer may be saved by libnbd. */\n"; + pr " Py_INCREF (%s_user_data);\n" cbname; + pr " if (!PyCallable_Check (%s_user_data)) {\n" cbname; + pr " PyErr_SetString (PyExc_TypeError,\n"; + pr " \"callback parameter %s is not callable\");\n" cbname; + pr " return NULL;\n"; + pr " }\n"; + pr " }\n" | OFlags (n, _) -> pr " %s_u32 = %s;\n" n n ) optargs; @@ -4412,6 +4426,9 @@ let print_python_binding name { args; optargs; ret; may_set_error } = ) args; List.iter ( function + | OClosure { cbname } -> + pr ", %s_user_data ? %s_wrapper : NULL" cbname cbname; + pr ", %s_user_data" cbname | OFlags (n, _) -> pr ", %s_u32" n ) optargs; pr ");\n"; @@ -4668,6 +4685,7 @@ class NBD (object): let optargs = List.map ( function + | OClosure { cbname } -> cbname, Some "None", None | OFlags (n, _) -> n, Some "0", None ) optargs in let args = args @ optargs in @@ -4756,6 +4774,8 @@ and ocaml_ret_to_string = function | RUInt -> "int" and ocaml_optarg_to_string = function + | OClosure { cbname; cbargs } -> + sprintf "?%s:(%s)" cbname (ocaml_closuredecl_to_string cbargs) | OFlags (n, { flag_prefix }) -> sprintf "?%s:%s.t list" n flag_prefix and ocaml_closuredecl_to_string cbargs = @@ -4794,6 +4814,7 @@ let ocaml_name_of_arg = function | UInt64 n -> n let ocaml_name_of_optarg = function + | OClosure { cbname } -> cbname | OFlags (n, _) -> n let num_params args optargs = @@ -5202,6 +5223,19 @@ let print_ocaml_binding (name, { args; optargs; ret }) = List.iter ( function + | OClosure { cbname } -> + pr " const void *%s_callback = NULL;\n" cbname; + pr " value *%s_user_data = NULL;\n" cbname; + pr " if (%sv != Val_int (0)) { /* Some closure */\n" cbname; + pr " /* The function may save a reference to the closure, so we\n"; + pr " * must treat it as a possible GC root.\n"; + pr " */\n"; + pr " %s_user_data = malloc (sizeof (value));\n" cbname; + pr " if (%s_user_data == NULL) caml_raise_out_of_memory ();\n" cbname; + pr " *%s_user_data = Field (%sv, 0);\n" cbname cbname; + pr " caml_register_generational_global_root (%s_user_data);\n" cbname; + pr " %s_callback = %s_wrapper;\n" cbname cbname; + pr " }\n"; | OFlags (n, { flag_prefix }) -> pr " uint32_t %s;\n" n; pr " if (%sv != Val_int (0)) /* Some [ list of %s.t ] */\n" -- 2.22.0