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; }