Merge Perl callback and boot code
Merge callback and boot code into a single .c and .h file per parcel
named ${parcel_nick}_perl.[ch].
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/37aa3d30
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/37aa3d30
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/37aa3d30
Branch: refs/heads/master
Commit: 37aa3d302c2ce0ad3f8b9d9e4a2f9d8dcb99eadd
Parents: 3c18e2f
Author: Nick Wellnhofer <[email protected]>
Authored: Mon May 30 14:18:30 2016 +0200
Committer: Nick Wellnhofer <[email protected]>
Committed: Mon May 30 14:18:30 2016 +0200
----------------------------------------------------------------------
compiler/perl/lib/Clownfish/CFC.xs | 10 +-
compiler/perl/lib/Clownfish/CFC/Perl/Build.pm | 3 +-
compiler/src/CFCPerl.c | 270 +++++++++------------
compiler/src/CFCPerl.h | 17 +-
runtime/common/charmonizer.c | 5 +-
runtime/common/charmonizer.main | 5 +-
6 files changed, 130 insertions(+), 180 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/compiler/perl/lib/Clownfish/CFC.xs
----------------------------------------------------------------------
diff --git a/compiler/perl/lib/Clownfish/CFC.xs
b/compiler/perl/lib/Clownfish/CFC.xs
index 3a60db1..52cb5f5 100644
--- a/compiler/perl/lib/Clownfish/CFC.xs
+++ b/compiler/perl/lib/Clownfish/CFC.xs
@@ -1972,10 +1972,10 @@ CODE:
OUTPUT: RETVAL
void
-write_boot(self)
+write_host_code(self)
CFCPerl *self;
PPCODE:
- CFCPerl_write_boot(self);
+ CFCPerl_write_host_code(self);
void
write_hostdefs(self)
@@ -1990,12 +1990,6 @@ PPCODE:
CFCPerl_write_bindings(self);
void
-write_callbacks(self)
- CFCPerl *self;
-PPCODE:
- CFCPerl_write_callbacks(self);
-
-void
write_xs_typemap(self)
CFCPerl *self;
PPCODE:
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
----------------------------------------------------------------------
diff --git a/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
b/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
index 6f2557a..045c0aa 100644
--- a/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
+++ b/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
@@ -310,8 +310,7 @@ sub ACTION_clownfish {
if ( $cfh_modified || $buildlib_modified ) {
$self->add_to_cleanup($xs_filepath);
- $perl_binding->write_callbacks;
- $perl_binding->write_boot;
+ $perl_binding->write_host_code;
$perl_binding->write_hostdefs;
$perl_binding->write_bindings;
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/compiler/src/CFCPerl.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerl.c b/compiler/src/CFCPerl.c
index 284fdc5..d14cf84 100644
--- a/compiler/src/CFCPerl.c
+++ b/compiler/src/CFCPerl.c
@@ -65,9 +65,6 @@ S_write_class_pod(CFCPerl *self);
static CFCPerlPodFile*
S_write_standalone_pod(CFCPerl *self);
-static void
-S_write_callbacks_c(CFCPerl *self);
-
static const CFCMeta CFCPERL_META = {
"Clownfish::CFC::Binding::Perl",
sizeof(CFCPerl),
@@ -265,7 +262,7 @@ S_write_standalone_pod(CFCPerl *self) {
}
static void
-S_write_boot_h(CFCPerl *self, CFCParcel *parcel) {
+S_write_host_h(CFCPerl *self, CFCParcel *parcel) {
const char *prefix = CFCParcel_get_prefix(parcel);
const char *PREFIX = CFCParcel_get_PREFIX(parcel);
@@ -296,21 +293,23 @@ S_write_boot_h(CFCPerl *self, CFCParcel *parcel) {
self->c_footer);
const char *inc_dest = CFCHierarchy_get_include_dest(self->hierarchy);
- char *boot_h_path = CFCUtil_sprintf("%s" CHY_DIR_SEP "%sboot.h", inc_dest,
+ char *host_h_path = CFCUtil_sprintf("%s" CHY_DIR_SEP "%sperl.h", inc_dest,
prefix);
- CFCUtil_write_file(boot_h_path, content, strlen(content));
- FREEMEM(boot_h_path);
+ CFCUtil_write_file(host_h_path, content, strlen(content));
+ FREEMEM(host_h_path);
FREEMEM(content);
FREEMEM(guard);
}
static void
-S_write_boot_c(CFCPerl *self, CFCParcel *parcel) {
+S_write_host_c(CFCPerl *self, CFCParcel *parcel) {
CFCClass **ordered = CFCHierarchy_ordered_classes(self->hierarchy);
- const char *prefix = CFCParcel_get_prefix(parcel);
- char *alias_adds = CFCUtil_strdup("");
- char *isa_pushes = CFCUtil_strdup("");
+ const char *prefix = CFCParcel_get_prefix(parcel);
+ char *includes = CFCUtil_strdup("");
+ char *cb_defs = CFCUtil_strdup("");
+ char *alias_adds = CFCUtil_strdup("");
+ char *isa_pushes = CFCUtil_strdup("");
for (size_t i = 0; ordered[i] != NULL; i++) {
CFCClass *klass = ordered[i];
@@ -320,6 +319,23 @@ S_write_boot_c(CFCPerl *self, CFCParcel *parcel) {
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) {
@@ -359,9 +375,12 @@ S_write_boot_c(CFCPerl *self, CFCParcel *parcel) {
const char pattern[] =
"%s"
"\n"
- "#include \"%sboot.h\"\n"
- "#include \"%sparcel.h\"\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"
@@ -370,6 +389,80 @@ S_write_boot_c(CFCPerl *self, CFCParcel *parcel) {
"#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"
@@ -383,19 +476,21 @@ S_write_boot_c(CFCPerl *self, CFCParcel *parcel) {
"\n"
"%s";
char *content
- = CFCUtil_sprintf(pattern, self->c_header, prefix, prefix,
+ = CFCUtil_sprintf(pattern, self->c_header, prefix, includes, cb_defs,
prefix, prefix, alias_adds, isa_pushes,
self->c_footer);
const char *src_dest = CFCHierarchy_get_source_dest(self->hierarchy);
- char *boot_c_path = CFCUtil_sprintf("%s" CHY_DIR_SEP "%sboot.c", src_dest,
+ char *host_c_path = CFCUtil_sprintf("%s" CHY_DIR_SEP "%sperl.c", src_dest,
prefix);
- CFCUtil_write_file(boot_c_path, content, strlen(content));
- FREEMEM(boot_c_path);
+ CFCUtil_write_file(host_c_path, content, strlen(content));
+ FREEMEM(host_c_path);
FREEMEM(content);
FREEMEM(isa_pushes);
FREEMEM(alias_adds);
+ FREEMEM(cb_defs);
+ FREEMEM(includes);
FREEMEM(ordered);
}
@@ -434,15 +529,15 @@ CFCPerl_write_hostdefs(CFCPerl *self) {
}
void
-CFCPerl_write_boot(CFCPerl *self) {
+CFCPerl_write_host_code(CFCPerl *self) {
CFCParcel **parcels = CFCParcel_all_parcels();
for (size_t i = 0; parcels[i]; ++i) {
CFCParcel *parcel = parcels[i];
if (!CFCParcel_included(parcel)) {
- S_write_boot_h(self, parcel);
- S_write_boot_c(self, parcel);
+ S_write_host_h(self, parcel);
+ S_write_host_c(self, parcel);
}
}
}
@@ -516,13 +611,13 @@ CFCPerl_write_bindings(CFCPerl *self) {
}
generated_xs = CFCUtil_cat(generated_xs, "\n", NULL);
- // Include XSBind.h and boot.h.
+ // Include XSBind.h and *_perl.h.
generated_xs = CFCUtil_cat(generated_xs, "#include \"XSBind.h\"\n", NULL);
for (size_t i = 0; parcels[i]; ++i) {
if (!CFCParcel_included(parcels[i])) {
const char *prefix = CFCParcel_get_prefix(parcels[i]);
generated_xs = CFCUtil_cat(generated_xs, "#include \"", prefix,
- "boot.h\"\n", NULL);
+ "perl.h\"\n", NULL);
}
}
@@ -599,137 +694,6 @@ CFCPerl_write_bindings(CFCPerl *self) {
}
void
-CFCPerl_write_callbacks(CFCPerl *self) {
- S_write_callbacks_c(self);
-}
-
-static void
-S_write_callbacks_c(CFCPerl *self) {
- CFCClass **ordered = CFCHierarchy_ordered_classes(self->hierarchy);
- char *includes = CFCUtil_strdup("");
- char *cb_defs = CFCUtil_strdup("");
-
- for (size_t i = 0; ordered[i] != NULL; i++) {
- CFCClass *klass = ordered[i];
- if (CFCClass_included(klass) || CFCClass_inert(klass)) { continue; }
-
- const char *include_h = CFCClass_include_h(klass);
- includes = CFCUtil_cat(includes, "#include \"", include_h,
- "\"\n", NULL);
-
- 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);
- }
- }
- }
-
- static const char pattern[] =
- "%s"
- "\n"
- "#include \"XSBind.h\"\n"
- "#include \"Clownfish/Err.h\"\n"
- "#include \"Clownfish/Obj.h\"\n"
- "%s"
- "\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" // Callback definitions.
- "%s" // Footer.
- "\n";
- char *content = CFCUtil_sprintf(pattern, self->c_header, includes, cb_defs,
- self->c_footer);
-
- // 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(cb_defs);
- FREEMEM(includes);
- FREEMEM(ordered);
-}
-
-void
CFCPerl_write_xs_typemap(CFCPerl *self) {
CFCPerlTypeMap_write_xs_typemap(self->hierarchy);
}
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/compiler/src/CFCPerl.h
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerl.h b/compiler/src/CFCPerl.h
index eef10ac..ea8bf21 100644
--- a/compiler/src/CFCPerl.h
+++ b/compiler/src/CFCPerl.h
@@ -48,9 +48,9 @@ struct CFCHierarchy;
* # Generated by write_bindings()
* $lib_dir/Crustacean.xs
*
- * # Generated by write_boot()
- * $hierarchy_dest_dir/crust_boot.h
- * $hierarchy_dest_dir/crust_boot.c
+ * # Generated by write_host_code()
+ * $hierarchy_dest_dir/include/crust_perl.h
+ * $hierarchy_dest_dir/source/crust_perl.c
*/
/**
@@ -86,22 +86,17 @@ CFCPerl_destroy(CFCPerl *self);
char**
CFCPerl_write_pod(CFCPerl *self);
-/** Write out "boot" files to the Hierarchy's "dest_dir" which contain code
- * for bootstrapping Clownfish classes.
+/** Write out host-specific files to the Hierarchy's "dest_dir" which contain
+ * code for calling back from C into Perl and bootstrapping Clownfish classes.
*/
void
-CFCPerl_write_boot(CFCPerl *self);
+CFCPerl_write_host_code(CFCPerl *self);
/** Generate the XS bindings for all classes in the hierarchy.
*/
void
CFCPerl_write_bindings(CFCPerl *self);
-/** Generate routines which call back from C into Perl for all methods.
- */
-void
-CFCPerl_write_callbacks(CFCPerl *self);
-
/** Generate hostdefs file.
*/
void
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/runtime/common/charmonizer.c
----------------------------------------------------------------------
diff --git a/runtime/common/charmonizer.c b/runtime/common/charmonizer.c
index 4cce9da..3ab542d 100644
--- a/runtime/common/charmonizer.c
+++ b/runtime/common/charmonizer.c
@@ -8354,11 +8354,10 @@ cfish_MakeFile_new(chaz_CLI *cli) {
}
else if (chaz_CLI_defined(cli, "enable-perl")) {
static const char *perl_autogen_src_files[] = {
- "callbacks",
- "cfish_boot",
"cfish_parcel",
- "testcfish_boot",
+ "cfish_perl",
"testcfish_parcel",
+ "testcfish_perl",
NULL
};
self->host_src_dir = "xs";
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/37aa3d30/runtime/common/charmonizer.main
----------------------------------------------------------------------
diff --git a/runtime/common/charmonizer.main b/runtime/common/charmonizer.main
index f065153..adcc95e 100644
--- a/runtime/common/charmonizer.main
+++ b/runtime/common/charmonizer.main
@@ -300,11 +300,10 @@ cfish_MakeFile_new(chaz_CLI *cli) {
}
else if (chaz_CLI_defined(cli, "enable-perl")) {
static const char *perl_autogen_src_files[] = {
- "callbacks",
- "cfish_boot",
"cfish_parcel",
- "testcfish_boot",
+ "cfish_perl",
"testcfish_parcel",
+ "testcfish_perl",
NULL
};
self->host_src_dir = "xs";
