static char*
S_callback_start(CFCMethod *method) {
CFCParamList *param_list = CFCMethod_get_param_list(method);
static const char pattern[] =
" dSP;\n"
" EXTEND(SP, %d);\n"
" ENTER;\n"
" SAVETMPS;\n"
" PUSHMARK(SP);\n"
" mPUSHs((SV*)Cfish_Obj_To_Host((cfish_Obj*)self));\n";
int num_args = (int)CFCParamList_num_vars(param_list) - 1;
int num_to_extend = num_args == 0 ? 1
: num_args == 1 ? 2
: 1 + (num_args * 2);
char *params = CFCUtil_sprintf(pattern, num_to_extend);
// Iterate over arguments, mapping them to Perl scalars.
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
for (int i = 1; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
const char *name = CFCVariable_micro_sym(var);
CFCType *type = CFCVariable_get_type(var);
const char *c_type = CFCType_to_c(type);
// Add labels when there are two or more parameters.
if (num_args > 1) {
char num_buf[20];
sprintf(num_buf, "%d", (int)strlen(name));
params = CFCUtil_cat(params, " mPUSHp(\"", name, "\", ",
num_buf, ");\n", NULL);
}
if (CFCType_is_string_type(type)) {
// Convert Clownfish string type to UTF-8 Perl string scalars.
params = CFCUtil_cat(params, " mPUSHs(XSBind_cb_to_sv(",
"(cfish_CharBuf*)", name, "));\n", NULL);
}
else if (CFCType_is_object(type)) {
// Wrap other Clownfish object types in Perl objects.
params = CFCUtil_cat(params, " mPUSHs(XSBind_cfish_to_perl(",
"(cfish_Obj*)", name, "));\n", NULL);
}
else if (CFCType_is_integer(type)) {
// Convert primitive integer types to IV Perl scalars.
int width = (int)CFCType_get_width(type);
if (width != 0 && width <= 4) {
params = CFCUtil_cat(params, " mPUSHi(",
name, ");\n", NULL);
}
else {
// If the Perl IV integer type is not wide enough, use
// doubles. This may be lossy if the value is above 2**52,
// but practically speaking, it's important to handle numbers
// between 2**32 and 2**52 cleanly.
params = CFCUtil_cat(params,
" if (sizeof(IV) >= sizeof(", c_type,
")) { mPUSHi(", name, "); }\n",
" else { mPUSHn((double)", name,
"); } // lossy \n", NULL);
}
}
else if (CFCType_is_floating(type)) {
// Convert primitive floating point types to NV Perl scalars.
params = CFCUtil_cat(params, " mPUSHn(",
name, ");\n", NULL);
}
else {
// Can't map variable type. Signal to caller.
FREEMEM(params);
return NULL;
}
}
// Restore the Perl stack pointer.
params = CFCUtil_cat(params, " PUTBACK;\n", NULL);
return params;
}
static char*
S_callback_params(CFCMethod *method) {
const char *micro_sym = CFCSymbol_micro_sym((CFCSymbol*)method);
CFCParamList *param_list = CFCMethod_get_param_list(method);
unsigned num_params = CFCParamList_num_vars(param_list) - 1;
size_t needed = strlen(micro_sym) + 30;
char *params = (char*)MALLOCATE(needed);
// TODO: use something other than micro_sym here.
sprintf(params, "self, \"%s\", %u", micro_sym, num_params);
// Iterate over arguments, mapping them to various arg wrappers which
// conform to Host's callback interface.
CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
for (int i = 1; arg_vars[i] != NULL; i++) {
CFCVariable *var = arg_vars[i];
const char *name = CFCVariable_micro_sym(var);
size_t name_len = strlen(name);
CFCType *type = CFCVariable_get_type(var);
const char *c_type = CFCType_to_c(type);
size_t size = strlen(params)
+ strlen(c_type)
+ name_len * 2
+ 30;
char *new_buf = (char*)MALLOCATE(size);
if (CFCType_is_string_type(type)) {
sprintf(new_buf, "%s, CFISH_ARG_STR(\"%s\", %s)", params, name, name);
}
else if (CFCType_is_object(type)) {
sprintf(new_buf, "%s, CFISH_ARG_OBJ(\"%s\", %s)", params, name, name);
}
else if (CFCType_is_integer(type)) {
int width = CFCType_get_width(type);
if (width) {
if (width <= 4) {
sprintf(new_buf, "%s, CFISH_ARG_I32(\"%s\", %s)", params,
name, name);
}
else {
sprintf(new_buf, "%s, CFISH_ARG_I64(\"%s\", %s)", params,
name, name);
}
}
else {
sprintf(new_buf, "%s, CFISH_ARG_I(%s, \"%s\", %s)", params,
c_type, name, name);
}
}
else if (CFCType_is_floating(type)) {
sprintf(new_buf, "%s, CFISH_ARG_F64(\"%s\", %s)", params, name, name);
}
else {
// Can't map variable type. Signal to caller.
FREEMEM(params);
FREEMEM(new_buf);
return NULL;
}
FREEMEM(params);
params = new_buf;
}
return params;
}
