int
CFCType_equals(CFCType *self, CFCType *other) {
if ((CFCType_const(self) ^ CFCType_const(other))
|| (CFCType_nullable(self) ^ CFCType_nullable(other))
|| (CFCType_is_void(self) ^ CFCType_is_void(other))
|| (CFCType_is_object(self) ^ CFCType_is_object(other))
|| (CFCType_is_primitive(self) ^ CFCType_is_primitive(other))
|| (CFCType_is_integer(self) ^ CFCType_is_integer(other))
|| (CFCType_is_floating(self) ^ CFCType_is_floating(other))
|| (CFCType_is_va_list(self) ^ CFCType_is_va_list(other))
|| (CFCType_is_arbitrary(self) ^ CFCType_is_arbitrary(other))
|| (CFCType_is_composite(self) ^ CFCType_is_composite(other))
|| (CFCType_incremented(self) ^ CFCType_incremented(other))
|| (CFCType_decremented(self) ^ CFCType_decremented(other))
|| !!self->child ^ !!other->child
|| !!self->array ^ !!other->array
) {
return false;
}
if (self->indirection != other->indirection) { return false; }
if (strcmp(self->specifier, other->specifier) != 0) { return false; }
if (self->child) {
if (!CFCType_equals(self->child, other->child)) { return false; }
}
if (self->array) {
if (strcmp(self->array, other->array) != 0) { return false; }
}
return true;
}
int
CFCType_similar(CFCType *self, CFCType *other) {
if (!CFCType_is_object(self)) {
CFCUtil_die("Attempt to call 'similar' on a non-object type");
}
if ((CFCType_const(self) ^ CFCType_const(other))
|| (CFCType_nullable(self) ^ CFCType_nullable(other))
|| (CFCType_incremented(self) ^ CFCType_incremented(other))
|| (CFCType_decremented(self) ^ CFCType_decremented(other))
|| (CFCType_is_object(self) ^ CFCType_is_object(other))
) {
return false;
}
return true;
}
static char*
S_callback_refcount_mods(CFCParamList *param_list) {
char *refcount_mods = CFCUtil_strdup("");
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
// Adjust refcounts of arguments per method signature, so that Perl code
// does not have to.
for (int i = 0; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
CFCType *type = CFCVariable_get_type(var);
const char *name = CFCVariable_get_name(var);
if (!CFCType_is_object(type)) {
continue;
}
else if (CFCType_incremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, " CFISH_INCREF(",
name, ");\n", NULL);
}
else if (CFCType_decremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, " CFISH_DECREF(",
name, ");\n", NULL);
}
}
return refcount_mods;
}
char*
CFCPerlConstructor_xsub_def(CFCPerlConstructor *self) {
const char *c_name = self->sub.c_name;
CFCParamList *param_list = self->sub.param_list;
const char *name_list = CFCParamList_name_list(param_list);
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
const char *func_sym = CFCFunction_full_func_sym(self->init_func);
char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self);
CFCVariable *self_var = arg_vars[0];
CFCType *self_type = CFCVariable_get_type(self_var);
const char *self_type_str = CFCType_to_c(self_type);
// Compensate for swallowed refcounts.
char *refcount_mods = CFCUtil_strdup("");
for (size_t i = 0; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
CFCType *type = CFCVariable_get_type(var);
if (CFCType_is_object(type) && CFCType_decremented(type)) {
const char *name = CFCVariable_micro_sym(var);
refcount_mods = CFCUtil_cat(refcount_mods, "\n CFISH_INCREF(",
name, ");", NULL);
}
}
const char pattern[] =
"XS(%s);\n"
"XS(%s) {\n"
" dXSARGS;\n"
" CFISH_UNUSED_VAR(cv);\n"
" if (items < 1) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(class_name, ...)\", GvNAME(CvGV(cv))); }\n"
" SP -= items;\n"
"\n"
" %s\n"
// Create "self" last, so that earlier exceptions while fetching
// params don't trigger a bad invocation of DESTROY.
" %s self = (%s)XSBind_new_blank_obj(ST(0));%s\n"
"\n"
" %s retval = %s(%s);\n"
" if (retval) {\n"
" ST(0) = (SV*)CFISH_Obj_To_Host((cfish_Obj*)retval);\n"
" CFISH_Obj_Dec_RefCount((cfish_Obj*)retval);\n"
" }\n"
" else {\n"
" ST(0) = newSV(0);\n"
" }\n"
" sv_2mortal(ST(0));\n"
" XSRETURN(1);\n"
"}\n\n";
char *xsub_def
= CFCUtil_sprintf(pattern, c_name, c_name, allot_params, self_type_str,
self_type_str, refcount_mods, self_type_str,
func_sym, name_list);
FREEMEM(refcount_mods);
FREEMEM(allot_params);
return xsub_def;
}
static char*
S_gen_arg_increfs(CFCParamList *param_list, int first_tick) {
CFCVariable **vars = CFCParamList_get_variables(param_list);
int num_vars = CFCParamList_num_vars(param_list);
char *content = CFCUtil_strdup("");
for (int i = first_tick;i < num_vars; i++) {
CFCType *type = CFCVariable_get_type(vars[i]);
if (CFCType_decremented(type)) {
const char *name = CFCVariable_get_name(vars[i]);
const char *specifier = CFCType_get_specifier(type);
char pattern[] =
" %s_ARG = (%s*)CFISH_INCREF(%s_ARG);\n";
char *incref = CFCUtil_sprintf(pattern, name, specifier, name);
content = CFCUtil_cat(content, incref, NULL);
FREEMEM(incref);
}
}
return content;
}
static char*
S_callback_refcount_mods(CFCMethod *method) {
char *refcount_mods = CFCUtil_strdup("");
CFCType *return_type = CFCMethod_get_return_type(method);
CFCParamList *param_list = CFCMethod_get_param_list(method);
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
// `XSBind_perl_to_cfish()` returns an incremented object. If this method
// does not return an incremented object, we must cancel out that
// refcount. (No function can return a decremented object.)
if (CFCType_is_object(return_type) && !CFCType_incremented(return_type)) {
refcount_mods = CFCUtil_cat(refcount_mods,
"\n CFISH_DECREF(retval);", NULL);
}
// Adjust refcounts of arguments per method signature, so that Perl code
// does not have to.
for (int i = 0; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
CFCType *type = CFCVariable_get_type(var);
const char *name = CFCVariable_micro_sym(var);
if (!CFCType_is_object(type)) {
continue;
}
else if (CFCType_incremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, "\n CFISH_INCREF(",
name, ");", NULL);
}
else if (CFCType_decremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, "\n CFISH_DECREF(",
name, ");", NULL);
}
}
return refcount_mods;
}
static char*
S_callback_refcount_mods(CFCMethod *method) {
char *refcount_mods = CFCUtil_strdup("");
CFCType *return_type = CFCMethod_get_return_type(method);
CFCParamList *param_list = CFCMethod_get_param_list(method);
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
// Host_callback_obj returns an incremented object. If this method does
// not return an incremented object, we must cancel out that refcount.
// (No function can return a decremented object.)
if (CFCType_is_object(return_type) && !CFCType_incremented(return_type)) {
refcount_mods = CFCUtil_cat(refcount_mods,
"\n CFISH_DECREF(retval);", NULL);
}
// The Host_callback_xxx functions have no effect on the refcounts of
// arguments, so we need to adjust them after the fact.
for (int i = 0; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
CFCType *type = CFCVariable_get_type(var);
const char *name = CFCVariable_micro_sym(var);
if (!CFCType_is_object(type)) {
continue;
}
else if (CFCType_incremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, "\n CFISH_INCREF(",
name, ");", NULL);
}
else if (CFCType_decremented(type)) {
refcount_mods = CFCUtil_cat(refcount_mods, "\n CFISH_DECREF(",
name, ");", NULL);
}
}
return refcount_mods;
}
static char*
S_xsub_body(CFCPerlMethod *self) {
CFCMethod *method = self->method;
CFCParamList *param_list = CFCMethod_get_param_list(method);
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
const char *name_list = CFCParamList_name_list(param_list);
char *body = CFCUtil_strdup("");
CFCParcel *parcel = CFCMethod_get_parcel(method);
const char *class_name = CFCMethod_get_class_name(method);
CFCClass *klass = CFCClass_fetch_singleton(parcel, class_name);
if (!klass) {
CFCUtil_die("Can't find a CFCClass for '%s'", class_name);
}
// Extract the method function pointer.
char *full_typedef = CFCMethod_full_typedef(method, klass);
char *full_meth = CFCMethod_full_method_sym(method, klass);
char *method_ptr
= CFCUtil_sprintf("%s method = CFISH_METHOD_PTR(%s, %s);\n ",
full_typedef, CFCClass_full_vtable_var(klass),
full_meth);
body = CFCUtil_cat(body, method_ptr, NULL);
FREEMEM(full_typedef);
FREEMEM(full_meth);
FREEMEM(method_ptr);
// Compensate for functions which eat refcounts.
for (int i = 0; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
CFCType *type = CFCVariable_get_type(var);
if (CFCType_is_object(type) && CFCType_decremented(type)) {
body = CFCUtil_cat(body, "CFISH_INCREF(",
CFCVariable_micro_sym(var), ");\n ", NULL);
}
}
if (CFCType_is_void(CFCMethod_get_return_type(method))) {
// Invoke method in void context.
body = CFCUtil_cat(body, "method(", name_list,
");\n XSRETURN(0);", NULL);
}
else {
// Return a value for method invoked in a scalar context.
CFCType *return_type = CFCMethod_get_return_type(method);
const char *type_str = CFCType_to_c(return_type);
char *assignment = CFCPerlTypeMap_to_perl(return_type, "retval");
if (!assignment) {
CFCUtil_die("Can't find typemap for '%s'", type_str);
}
body = CFCUtil_cat(body, type_str, " retval = method(",
name_list, ");\n ST(0) = ", assignment, ";",
NULL);
if (CFCType_is_object(return_type)
&& CFCType_incremented(return_type)
) {
body = CFCUtil_cat(body, "\n CFISH_DECREF(retval);", NULL);
}
body = CFCUtil_cat(body, "\n sv_2mortal( ST(0) );\n XSRETURN(1);",
NULL);
FREEMEM(assignment);
}
return body;
}