static void
S_write_host_c(CFCPerl *self, CFCParcel *parcel) {
CFCClass **ordered = CFCHierarchy_ordered_classes(self->hierarchy);
const char *prefix = CFCParcel_get_prefix(parcel);
const char *privacy_sym = CFCParcel_get_privacy_sym(parcel);
char *includes = CFCUtil_strdup("");
char *cb_defs = CFCUtil_strdup("");
char *alias_adds = CFCUtil_strdup("");
for (size_t i = 0; ordered[i] != NULL; i++) {
CFCClass *klass = ordered[i];
if (CFCClass_inert(klass)) { continue; }
const char *class_prefix = CFCClass_get_prefix(klass);
if (strcmp(class_prefix, prefix) != 0) { continue; }
const char *class_name = CFCClass_get_name(klass);
const char *include_h = CFCClass_include_h(klass);
includes = CFCUtil_cat(includes, "#include \"", include_h,
"\"\n", NULL);
// Callbacks.
CFCMethod **fresh_methods = CFCClass_fresh_methods(klass);
for (int meth_num = 0; fresh_methods[meth_num] != NULL; meth_num++) {
CFCMethod *method = fresh_methods[meth_num];
// Define callback.
if (CFCMethod_novel(method) && !CFCMethod_final(method)) {
char *cb_def = CFCPerlMethod_callback_def(method, klass);
cb_defs = CFCUtil_cat(cb_defs, cb_def, "\n", NULL);
FREEMEM(cb_def);
}
}
// Add class aliases.
CFCPerlClass *class_binding = CFCPerlClass_singleton(class_name);
if (class_binding) {
const char *class_var = CFCClass_full_class_var(klass);
const char **aliases
= CFCPerlClass_get_class_aliases(class_binding);
for (size_t j = 0; aliases[j] != NULL; j++) {
const char *alias = aliases[j];
int alias_len = (int)strlen(alias);
const char pattern[] =
" cfish_Class_add_alias_to_registry("
"%s, \"%s\", %d);\n";
char *alias_add
= CFCUtil_sprintf(pattern, class_var, alias, alias_len);
alias_adds = CFCUtil_cat(alias_adds, alias_add, NULL);
FREEMEM(alias_add);
}
char *metadata_code
= CFCPerlClass_method_metadata_code(class_binding);
alias_adds = CFCUtil_cat(alias_adds, metadata_code, NULL);
FREEMEM(metadata_code);
}
}
const char pattern[] =
"%s"
"\n"
"#define %s\n" // privacy_sym
"\n"
"#include \"%sperl.h\"\n"
"#include \"XSBind.h\"\n"
"#include \"Clownfish/Class.h\"\n"
"#include \"Clownfish/Err.h\"\n"
"#include \"Clownfish/Obj.h\"\n"
"%s"
"\n"
"/* Avoid conflicts with Clownfish bool type. */\n"
"#define HAS_BOOL\n"
"#define PERL_NO_GET_CONTEXT\n"
"#include \"EXTERN.h\"\n"
"#include \"perl.h\"\n"
"#include \"XSUB.h\"\n"
"\n"
"static void\n"
"S_finish_callback_void(pTHX_ const char *meth_name) {\n"
" int count = call_method(meth_name, G_VOID | G_DISCARD);\n"
" if (count != 0) {\n"
" CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
" meth_name, (int32_t)count);\n"
" }\n"
" FREETMPS;\n"
" LEAVE;\n"
"}\n"
"\n"
"static CFISH_INLINE SV*\n"
"SI_do_callback_sv(pTHX_ const char *meth_name) {\n"
" int count = call_method(meth_name, G_SCALAR);\n"
" if (count != 1) {\n"
" CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
" meth_name, (int32_t)count);\n"
" }\n"
" dSP;\n"
" SV *return_sv = POPs;\n"
" PUTBACK;\n"
" return return_sv;\n"
"}\n"
"\n"
"static int64_t\n"
"S_finish_callback_i64(pTHX_ const char *meth_name) {\n"
" SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
" int64_t retval;\n"
" if (sizeof(IV) == 8) {\n"
" retval = (int64_t)SvIV(return_sv);\n"
" }\n"
" else {\n"
" if (SvIOK(return_sv)) {\n"
" // It's already no more than 32 bits, so don't convert.\n"
" retval = SvIV(return_sv);\n"
" }\n"
" else {\n"
" // Maybe lossy.\n"
" double temp = SvNV(return_sv);\n"
" retval = (int64_t)temp;\n"
" }\n"
" }\n"
" FREETMPS;\n"
" LEAVE;\n"
" return retval;\n"
"}\n"
"\n"
"static double\n"
"S_finish_callback_f64(pTHX_ const char *meth_name) {\n"
" SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
" double retval = SvNV(return_sv);\n"
" FREETMPS;\n"
" LEAVE;\n"
" return retval;\n"
"}\n"
"\n"
"static cfish_Obj*\n"
"S_finish_callback_obj(pTHX_ void *vself, const char *meth_name,\n"
" int nullable) {\n"
" SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
" cfish_Obj *retval\n"
" = XSBind_perl_to_cfish_nullable(aTHX_ return_sv, CFISH_OBJ);\n"
" FREETMPS;\n"
" LEAVE;\n"
" if (!nullable && !retval) {\n"
" CFISH_THROW(CFISH_ERR, \"%%o#%%s cannot return NULL\",\n"
" cfish_Obj_get_class_name((cfish_Obj*)vself),\n"
" meth_name);\n"
" }\n"
" return retval;\n"
"}\n"
"\n"
"%s"
"\n"
"void\n"
"%sbootstrap_perl() {\n"
" dTHX;\n"
" %sbootstrap_parcel();\n"
"\n"
"%s"
"}\n"
"\n"
"%s";
char *content
= CFCUtil_sprintf(pattern, self->c_header, privacy_sym, prefix,
includes, cb_defs, prefix, prefix, alias_adds,
self->c_footer);
const char *src_dest = CFCHierarchy_get_source_dest(self->hierarchy);
char *host_c_path = CFCUtil_sprintf("%s" CHY_DIR_SEP "%sperl.c", src_dest,
prefix);
CFCUtil_write_file(host_c_path, content, strlen(content));
FREEMEM(host_c_path);
FREEMEM(content);
FREEMEM(alias_adds);
FREEMEM(cb_defs);
FREEMEM(includes);
FREEMEM(ordered);
}
static void
S_write_callbacks_c(CFCPerl *self) {
CFCClass **ordered = CFCHierarchy_ordered_classes(self->hierarchy);
static const char pattern[] =
"%s"
"\n"
"#include \"XSBind.h\"\n"
"#include \"callbacks.h\"\n"
"\n"
"static void\n"
"S_finish_callback_void(const char *meth_name) {\n"
" int count = call_method(meth_name, G_VOID | G_DISCARD);\n"
" if (count != 0) {\n"
" CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
" meth_name, (int32_t)count);\n"
" }\n"
" FREETMPS;\n"
" LEAVE;\n"
"}\n"
"\n"
"static CFISH_INLINE SV*\n"
"SI_do_callback_sv(const char *meth_name) {\n"
" int count = call_method(meth_name, G_SCALAR);\n"
" if (count != 1) {\n"
" CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
" meth_name, (int32_t)count);\n"
" }\n"
" dSP;\n"
" SV *return_sv = POPs;\n"
" PUTBACK;\n"
" return return_sv;\n"
"}\n"
"\n"
"static int64_t\n"
"S_finish_callback_i64(const char *meth_name) {\n"
" SV *return_sv = SI_do_callback_sv(meth_name);\n"
" int64_t retval;\n"
" if (sizeof(IV) == 8) {\n"
" retval = (int64_t)SvIV(return_sv);\n"
" }\n"
" else {\n"
" if (SvIOK(return_sv)) {\n"
" // It's already no more than 32 bits, so don't convert.\n"
" retval = SvIV(return_sv);\n"
" }\n"
" else {\n"
" // Maybe lossy.\n"
" double temp = SvNV(return_sv);\n"
" retval = (int64_t)temp;\n"
" }\n"
" }\n"
" FREETMPS;\n"
" LEAVE;\n"
" return retval;\n"
"}\n"
"\n"
"static double\n"
"S_finish_callback_f64(const char *meth_name) {\n"
" SV *return_sv = SI_do_callback_sv(meth_name);\n"
" double retval = SvNV(return_sv);\n"
" FREETMPS;\n"
" LEAVE;\n"
" return retval;\n"
"}\n"
"\n"
"static cfish_Obj*\n"
"S_finish_callback_obj(void *vself, const char *meth_name,\n"
" int nullable) {\n"
" SV *return_sv = SI_do_callback_sv(meth_name);\n"
" cfish_Obj *retval = XSBind_perl_to_cfish(return_sv);\n"
" FREETMPS;\n"
" LEAVE;\n"
" if (!nullable && !retval) {\n"
" CFISH_THROW(CFISH_ERR, \"%%o#%%s cannot return NULL\",\n"
" CFISH_Obj_Get_Class_Name((cfish_Obj*)vself),\n"
" meth_name);\n"
" }\n"
" return retval;\n"
"}\n"
"\n";
char *content = CFCUtil_sprintf(pattern, self->header);
for (size_t i = 0; ordered[i] != NULL; i++) {
CFCClass *klass = ordered[i];
if (CFCClass_inert(klass)) { continue; }
CFCMethod **fresh_methods = CFCClass_fresh_methods(klass);
for (int meth_num = 0; fresh_methods[meth_num] != NULL; meth_num++) {
CFCMethod *method = fresh_methods[meth_num];
// Define callback.
if (CFCMethod_novel(method) && !CFCMethod_final(method)) {
char *cb_def = CFCPerlMethod_callback_def(method);
content = CFCUtil_cat(content, cb_def, "\n", NULL);
FREEMEM(cb_def);
}
}
FREEMEM(fresh_methods);
}
content = CFCUtil_cat(content, self->footer, NULL);
// Write if changed.
const char *src_dest = CFCHierarchy_get_source_dest(self->hierarchy);
char *filepath = CFCUtil_sprintf("%s" CHY_DIR_SEP "callbacks.c",
src_dest);
CFCUtil_write_if_changed(filepath, content, strlen(content));
FREEMEM(filepath);
FREEMEM(content);
FREEMEM(ordered);
}
