You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2011/06/08 02:17:12 UTC
[lucy-commits] svn commit: r1133216 - in /incubator/lucy/trunk/example-lang/src: CFBind.c
CFBind.h
Author: marvin
Date: Wed Jun 8 00:17:12 2011
New Revision: 1133216
URL: http://svn.apache.org/viewvc?rev=1133216&view=rev
Log:
Gut CFBind.[ch].
Remove all Perl-specific content from CFBind.[ch].
Modified:
incubator/lucy/trunk/example-lang/src/CFBind.c
incubator/lucy/trunk/example-lang/src/CFBind.h
Modified: incubator/lucy/trunk/example-lang/src/CFBind.c
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/example-lang/src/CFBind.c?rev=1133216&r1=1133215&r2=1133216&view=diff
==============================================================================
--- incubator/lucy/trunk/example-lang/src/CFBind.c (original)
+++ incubator/lucy/trunk/example-lang/src/CFBind.c Wed Jun 8 00:17:12 2011
@@ -14,540 +14,6 @@
* limitations under the License.
*/
-#define C_LUCY_OBJ
-#define NEED_newRV_noinc
#include "CFBind.h"
-#include "Lucy/Util/StringHelper.h"
-
-// Convert a Perl hash into a Clownfish Hash. Caller takes responsibility for
-// a refcount.
-static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash);
-
-// Convert a Perl array into a Clownfish VArray. Caller takes responsibility
-// for a refcount.
-static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray);
-
-// Convert a VArray to a Perl array. Caller takes responsibility for a
-// refcount.
-static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray);
-
-// Convert a Hash to a Perl hash. Caller takes responsibility for a refcount.
-static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash);
-
-cfish_Obj*
-CFBind_new_blank_obj(SV *either_sv) {
- cfish_VTable *vtable;
-
- // Get a VTable.
- if (sv_isobject(either_sv)
- && sv_derived_from(either_sv, "Lucy::Object::Obj")
- ) {
- // Use the supplied object's VTable.
- IV iv_ptr = SvIV(SvRV(either_sv));
- cfish_Obj *self = INT2PTR(cfish_Obj*, iv_ptr);
- vtable = self->vtable;
- }
- else {
- // Use the supplied class name string to find a VTable.
- STRLEN len;
- char *ptr = SvPVutf8(either_sv, len);
- cfish_ZombieCharBuf *klass = CFISH_ZCB_WRAP_STR(ptr, len);
- vtable = cfish_VTable_singleton((cfish_CharBuf*)klass, NULL);
- }
-
- // Use the VTable to allocate a new blank object of the right size.
- return Cfish_VTable_Make_Obj(vtable);
-}
-
-cfish_Obj*
-CFBind_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation) {
- cfish_Obj *retval = CFBind_maybe_sv_to_cfish_obj(sv, vtable, allocation);
- if (!retval) {
- THROW(CFISH_ERR, "Not a %o", Cfish_VTable_Get_Name(vtable));
- }
- return retval;
-}
-
-cfish_Obj*
-CFBind_maybe_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation) {
- cfish_Obj *retval = NULL;
- if (CFBind_sv_defined(sv)) {
- if (sv_isobject(sv)
- && sv_derived_from(sv, (char*)Cfish_CB_Get_Ptr8(Cfish_VTable_Get_Name(vtable)))
- ) {
- // Unwrap a real Clownfish object.
- IV tmp = SvIV(SvRV(sv));
- retval = INT2PTR(cfish_Obj*, tmp);
- }
- else if (allocation &&
- (vtable == CFISH_ZOMBIECHARBUF
- || vtable == CFISH_VIEWCHARBUF
- || vtable == CFISH_CHARBUF
- || vtable == CFISH_OBJ)
- ) {
- // Wrap the string from an ordinary Perl scalar inside a
- // ZombieCharBuf.
- STRLEN size;
- char *ptr = SvPVutf8(sv, size);
- retval = (cfish_Obj*)cfish_ZCB_wrap_str(allocation, ptr, size);
- }
- else if (SvROK(sv)) {
- // Attempt to convert Perl hashes and arrays into their Clownfish
- // analogues.
- SV *inner = SvRV(sv);
- if (SvTYPE(inner) == SVt_PVAV && vtable == CFISH_VARRAY) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
- }
- else if (SvTYPE(inner) == SVt_PVHV && vtable == CFISH_HASH) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
- }
-
- if (retval) {
- // Mortalize the converted object -- which is somewhat
- // dangerous, but is the only way to avoid requiring that the
- // caller take responsibility for a refcount.
- SV *mortal = (SV*)Cfish_Obj_To_Host(retval);
- LUCY_DECREF(retval);
- sv_2mortal(mortal);
- }
- }
- }
-
- return retval;
-}
-
-SV*
-CFBind_cfish_to_perl(cfish_Obj *obj) {
- if (obj == NULL) {
- return newSV(0);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_CHARBUF)) {
- return CFBind_cb_to_sv((cfish_CharBuf*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_BYTEBUF)) {
- return CFBind_bb_to_sv((cfish_ByteBuf*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_VARRAY)) {
- return S_cfish_array_to_perl_array((cfish_VArray*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_HASH)) {
- return S_cfish_hash_to_perl_hash((cfish_Hash*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_FLOATNUM)) {
- return newSVnv(Cfish_Obj_To_F64(obj));
- }
- else if (sizeof(IV) == 8 && Cfish_Obj_Is_A(obj, CFISH_INTNUM)) {
- int64_t num = Cfish_Obj_To_I64(obj);
- return newSViv((IV)num);
- }
- else if (sizeof(IV) == 4 && Cfish_Obj_Is_A(obj, CFISH_INTEGER32)) {
- int32_t num = (int32_t)Cfish_Obj_To_I64(obj);
- return newSViv((IV)num);
- }
- else if (sizeof(IV) == 4 && Cfish_Obj_Is_A(obj, CFISH_INTEGER64)) {
- int64_t num = Cfish_Obj_To_I64(obj);
- return newSVnv((double)num); // lossy
- }
- else {
- return (SV*)Cfish_Obj_To_Host(obj);
- }
-}
-
-cfish_Obj*
-CFBind_perl_to_cfish(SV *sv) {
- cfish_Obj *retval = NULL;
-
- if (CFBind_sv_defined(sv)) {
- if (SvROK(sv)) {
- // Deep conversion of references.
- SV *inner = SvRV(sv);
- if (SvTYPE(inner) == SVt_PVAV) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
- }
- else if (SvTYPE(inner) == SVt_PVHV) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
- }
- else if (sv_isobject(sv)
- && sv_derived_from(sv, "Lucy::Object::Obj")
- ) {
- IV tmp = SvIV(inner);
- retval = INT2PTR(cfish_Obj*, tmp);
- (void)LUCY_INCREF(retval);
- }
- }
-
- // It's either a plain scalar or a non-Clownfish Perl object, so
- // stringify.
- if (!retval) {
- STRLEN len;
- char *ptr = SvPVutf8(sv, len);
- retval = (cfish_Obj*)cfish_CB_new_from_trusted_utf8(ptr, len);
- }
- }
- else if (sv) {
- // Deep conversion of raw AVs and HVs.
- if (SvTYPE(sv) == SVt_PVAV) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)sv);
- }
- else if (SvTYPE(sv) == SVt_PVHV) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)sv);
- }
- }
-
- return retval;
-}
-
-SV*
-CFBind_bb_to_sv(const cfish_ByteBuf *bb) {
- return bb
- ? newSVpvn(Cfish_BB_Get_Buf(bb), Cfish_BB_Get_Size(bb))
- : newSV(0);
-}
-
-SV*
-CFBind_cb_to_sv(const cfish_CharBuf *cb) {
- if (!cb) {
- return newSV(0);
- }
- else {
- SV *sv = newSVpvn((char*)Cfish_CB_Get_Ptr8(cb), Cfish_CB_Get_Size(cb));
- SvUTF8_on(sv);
- return sv;
- }
-}
-
-static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash) {
- uint32_t num_keys = hv_iterinit(phash);
- cfish_Hash *retval = cfish_Hash_new(num_keys);
- cfish_ZombieCharBuf *key = CFISH_ZCB_WRAP_STR("", 0);
-
- while (num_keys--) {
- HE *entry = hv_iternext(phash);
- STRLEN key_len = HeKLEN(entry);
- SV *value_sv = HeVAL(entry);
- cfish_Obj *value = CFBind_perl_to_cfish(value_sv); // Recurse.
-
- // Force key to UTF-8 if necessary.
- if (key_len == (STRLEN)HEf_SVKEY) {
- // Key is stored as an SV. Use its UTF-8 flag? Not sure about
- // this.
- SV *key_sv = HeKEY_sv(entry);
- char *key_str = SvPVutf8(key_sv, key_len);
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else if (HeKUTF8(entry)) {
- Cfish_ZCB_Assign_Trusted_Str(key, HeKEY(entry), key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else {
- char *key_str = HeKEY(entry);
- chy_bool_t pure_ascii = true;
- for (STRLEN i = 0; i < key_len; i++) {
- if ((key_str[i] & 0x80) == 0x80) { pure_ascii = false; }
- }
- if (pure_ascii) {
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else {
- SV *key_sv = HeSVKEY_force(entry);
- key_str = SvPVutf8(key_sv, key_len);
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- }
- }
-
- return retval;
-}
-
-static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray) {
- const uint32_t size = av_len(parray) + 1;
- cfish_VArray *retval = cfish_VA_new(size);
- uint32_t i;
-
- // Iterate over array elems.
- for (i = 0; i < size; i++) {
- SV **elem_sv = av_fetch(parray, i, false);
- if (elem_sv) {
- cfish_Obj *elem = CFBind_perl_to_cfish(*elem_sv);
- if (elem) { Cfish_VA_Store(retval, i, elem); }
- }
- }
- Cfish_VA_Resize(retval, size); // needed if last elem is NULL
-
- return retval;
-}
-
-static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray) {
- AV *perl_array = newAV();
- uint32_t num_elems = Cfish_VA_Get_Size(varray);
-
- // Iterate over array elems.
- if (num_elems) {
- uint32_t i;
- av_fill(perl_array, num_elems - 1);
- for (i = 0; i < num_elems; i++) {
- cfish_Obj *val = Cfish_VA_Fetch(varray, i);
- if (val == NULL) {
- continue;
- }
- else {
- // Recurse for each value.
- SV *const val_sv = CFBind_cfish_to_perl(val);
- av_store(perl_array, i, val_sv);
- }
- }
- }
-
- return newRV_noinc((SV*)perl_array);
-}
-
-static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash) {
- HV *perl_hash = newHV();
- SV *key_sv = newSV(1);
- cfish_CharBuf *key;
- cfish_Obj *val;
-
- // Prepare the SV key.
- SvPOK_on(key_sv);
- SvUTF8_on(key_sv);
-
- // Iterate over key-value pairs.
- Cfish_Hash_Iterate(hash);
- while (Cfish_Hash_Next(hash, (cfish_Obj**)&key, &val)) {
- // Recurse for each value.
- SV *val_sv = CFBind_cfish_to_perl(val);
- if (!Cfish_Obj_Is_A((cfish_Obj*)key, CFISH_CHARBUF)) {
- CFISH_THROW(CFISH_ERR,
- "Can't convert a key of class %o to a Perl hash key",
- Cfish_Obj_Get_Class_Name((cfish_Obj*)key));
- }
- else {
- STRLEN key_size = Cfish_CB_Get_Size(key);
- char *key_sv_ptr = SvGROW(key_sv, key_size + 1);
- memcpy(key_sv_ptr, Cfish_CB_Get_Ptr8(key), key_size);
- SvCUR_set(key_sv, key_size);
- *SvEND(key_sv) = '\0';
- (void)hv_store_ent(perl_hash, key_sv, val_sv, 0);
- }
- }
- SvREFCNT_dec(key_sv);
-
- return newRV_noinc((SV*)perl_hash);
-}
-
-void
-CFBind_enable_overload(void *pobj) {
- SV *perl_obj = (SV*)pobj;
- HV *stash = SvSTASH(SvRV(perl_obj));
-#if (PERL_VERSION > 10)
- Gv_AMupdate(stash, false);
-#else
- Gv_AMupdate(stash);
-#endif
- SvAMAGIC_on(perl_obj);
-}
-
-static chy_bool_t
-S_extract_from_sv(SV *value, void *target, const char *label,
- chy_bool_t required, int type, cfish_VTable *vtable,
- void *allocation) {
- chy_bool_t valid_assignment = false;
-
- if (CFBind_sv_defined(value)) {
- switch (type) {
- case CFBIND_WANT_I8:
- *((int8_t*)target) = (int8_t)SvIV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_I16:
- *((int16_t*)target) = (int16_t)SvIV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_I32:
- *((int32_t*)target) = (int32_t)SvIV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_I64:
- if (sizeof(IV) == 8) {
- *((int64_t*)target) = (int64_t)SvIV(value);
- }
- else { // sizeof(IV) == 4
- // lossy.
- *((int64_t*)target) = (int64_t)SvNV(value);
- }
- valid_assignment = true;
- break;
- case CFBIND_WANT_U8:
- *((uint8_t*)target) = (uint8_t)SvUV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_U16:
- *((uint16_t*)target) = (uint16_t)SvUV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_U32:
- *((uint32_t*)target) = (uint32_t)SvUV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_U64:
- if (sizeof(UV) == 8) {
- *((uint64_t*)target) = (uint64_t)SvUV(value);
- }
- else { // sizeof(UV) == 4
- // lossy.
- *((uint64_t*)target) = (uint64_t)SvNV(value);
- }
- valid_assignment = true;
- break;
- case CFBIND_WANT_BOOL:
- *((chy_bool_t*)target) = !!SvTRUE(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_F32:
- *((float*)target) = (float)SvNV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_F64:
- *((double*)target) = SvNV(value);
- valid_assignment = true;
- break;
- case CFBIND_WANT_OBJ: {
- cfish_Obj *object
- = CFBind_maybe_sv_to_cfish_obj(value, vtable,
- allocation);
- if (object) {
- *((cfish_Obj**)target) = object;
- valid_assignment = true;
- }
- else {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS(
- "Invalid value for '%s' - not a %o",
- label, Cfish_VTable_Get_Name(vtable));
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- break;
- case CFBIND_WANT_SV:
- *((SV**)target) = value;
- valid_assignment = true;
- break;
- default: {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Unrecognized type: %i32 for param '%s'",
- (int32_t)type, label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- }
-
- // Enforce that required params cannot be undef and must present valid
- // values.
- if (required && !valid_assignment) {
- cfish_CharBuf *mess = CFISH_MAKE_MESS("Missing required param %s",
- label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
-
- return true;
-}
-
-chy_bool_t
-CFBind_allot_params(SV** stack, int32_t start, int32_t num_stack_elems,
- char* params_hash_name, ...) {
- va_list args;
- HV *params_hash = get_hv(params_hash_name, 0);
- int32_t args_left = (num_stack_elems - start) / 2;
-
- // Retrieve the params hash, which must be a package global.
- if (params_hash == NULL) {
- cfish_CharBuf *mess = CFISH_MAKE_MESS("Can't find hash named %s",
- params_hash_name);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
-
- // Verify that our args come in pairs. Return success if there are no
- // args.
- if (num_stack_elems == start) { return true; }
- if ((num_stack_elems - start) % 2 != 0) {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS(
- "Expecting hash-style params, got odd number of args");
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
-
- // Validate param names.
- for (int32_t i = start; i < num_stack_elems; i += 2) {
- SV *const key_sv = stack[i];
- STRLEN key_len;
- const char *key = SvPV(key_sv, key_len); // assume ASCII labels
- if (!hv_exists(params_hash, key, key_len)) {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Invalid parameter: '%s'", key);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
-
- void *target;
- va_start(args, params_hash_name);
- while (args_left && NULL != (target = va_arg(args, void*))) {
- char *label = va_arg(args, char*);
- int label_len = va_arg(args, int);
- int required = va_arg(args, int);
- int type = va_arg(args, int);
- cfish_VTable *vtable = va_arg(args, cfish_VTable*);
- void *allocation = va_arg(args, void*);
-
- // Iterate through stack looking for a label match. Work backwards so
- // that if the label is doubled up we get the last one.
- chy_bool_t got_arg = false;
- for (int32_t i = num_stack_elems; i >= start + 2; i -= 2) {
- int32_t tick = i - 2;
- SV *const key_sv = stack[tick];
- if (SvCUR(key_sv) == (STRLEN)label_len) {
- if (memcmp(SvPVX(key_sv), label, label_len) == 0) {
- SV *value = stack[tick + 1];
- got_arg = S_extract_from_sv(value, target, label,
- required, type, vtable,
- allocation);
- if (!got_arg) {
- CFISH_ERR_ADD_FRAME(cfish_Err_get_error());
- return false;
- }
- args_left--;
- break;
- }
- }
- }
-
- // Enforce required params.
- if (required && !got_arg) {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Missing required parameter: '%s'", label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- va_end(args);
-
- return true;
-}
Modified: incubator/lucy/trunk/example-lang/src/CFBind.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/example-lang/src/CFBind.h?rev=1133216&r1=1133215&r2=1133216&view=diff
==============================================================================
--- incubator/lucy/trunk/example-lang/src/CFBind.h (original)
+++ incubator/lucy/trunk/example-lang/src/CFBind.h Wed Jun 8 00:17:12 2011
@@ -14,7 +14,7 @@
* limitations under the License.
*/
-/* CFBind.h -- Functions to help bind Clownfish to Perl XS api.
+/* CFBind.h -- Functions to help bind Clownfish to [LANGUAGE_X].
*/
#ifndef H_CFISH_CFBIND
@@ -34,299 +34,9 @@ extern "C" {
#include "Lucy/Object/VArray.h"
#include "Lucy/Object/VTable.h"
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#define NEED_newRV_noinc_GLOBAL
-#include "ppport.h"
-
-/** Given either a class name or a perl object, manufacture a new Clownfish
- * object suitable for supplying to a cfish_Foo_init() function.
- */
-cfish_Obj*
-cfish_CFBind_new_blank_obj(SV *either_sv);
-
-/** Test whether an SV is defined. Handles "get" magic, unlike SvOK on its
- * own.
- */
-static CHY_INLINE chy_bool_t
-cfish_CFBind_sv_defined(SV *sv) {
- if (!sv || !SvANY(sv)) { return false; }
- if (SvGMAGICAL(sv)) { mg_get(sv); }
- return SvOK(sv);
-}
-
-/** If the SV contains a Clownfish object which passes an "isa" test against the
- * passed-in VTable, return a pointer to it. If not, but
- * <code>allocation</code> is non-NULL and a ZombieCharBuf would satisfy the
- * "isa" test, stringify the SV, create a ZombieCharBuf using
- * <code>allocation</code>, assign the SV's string to it, and return that
- * instead. If all else fails, throw an exception.
- */
-cfish_Obj*
-cfish_CFBind_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation);
-
-/** As CFBind_sv_to_cfish_obj above, but returns NULL instead of throwing an
- * exception.
- */
-cfish_Obj*
-cfish_CFBind_maybe_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable,
- void *allocation);
-
-
-/** Derive an SV from a Clownfish object. If the Clownfish object is NULL, the SV
- * will be undef.
- *
- * The new SV has single refcount for which the caller must take
- * responsibility.
- */
-static CHY_INLINE SV*
-cfish_CFBind_cfish_obj_to_sv(cfish_Obj *obj) {
- return obj ? (SV*)Cfish_Obj_To_Host(obj) : newSV(0);
-}
-
-/** CFBind_cfish_obj_to_sv, with a cast.
- */
-#define CFISH_OBJ_TO_SV(_obj) cfish_CFBind_cfish_obj_to_sv((cfish_Obj*)_obj)
-
-/** As CFBind_cfish_obj_to_sv above, except decrements the object's refcount
- * after creating the SV. This is useful when the Clownfish expression creates a new
- * refcount, e.g. a call to a constructor.
- */
-static CHY_INLINE SV*
-cfish_CFBind_cfish_obj_to_sv_noinc(cfish_Obj *obj) {
- SV *retval;
- if (obj) {
- retval = (SV*)Cfish_Obj_To_Host(obj);
- Cfish_Obj_Dec_RefCount(obj);
- }
- else {
- retval = newSV(0);
- }
- return retval;
-}
-
-/** CFBind_cfish_obj_to_sv_noinc, with a cast.
- */
-#define CFISH_OBJ_TO_SV_NOINC(_obj) \
- cfish_CFBind_cfish_obj_to_sv_noinc((cfish_Obj*)_obj)
-
-/** Deep conversion of Clownfish objects to Perl objects -- CharBufs to UTF-8
- * SVs, ByteBufs to SVs, VArrays to Perl array refs, Hashes to Perl hashrefs,
- * and any other object to a Perl object wrapping the Clownfish Obj.
- */
-SV*
-cfish_CFBind_cfish_to_perl(cfish_Obj *obj);
-
-/** Deep conversion of Perl data structures to Clownfish objects -- Perl hash
- * to Hash, Perl array to VArray, Clownfish objects stripped of their
- * wrappers, and everything else stringified and turned to a CharBuf.
- */
-cfish_Obj*
-cfish_CFBind_perl_to_cfish(SV *sv);
-
-/** Convert a ByteBuf into a new string SV.
- */
-SV*
-cfish_CFBind_bb_to_sv(const cfish_ByteBuf *bb);
-
-/** Convert a CharBuf into a new UTF-8 string SV.
- */
-SV*
-cfish_CFBind_cb_to_sv(const cfish_CharBuf *cb);
-
-/** Turn on overloading for the supplied Perl object and its class.
- */
-void
-cfish_CFBind_enable_overload(void *pobj);
-
-/** Process hash-style params passed to an XS subroutine. The varargs must be
- * a NULL-terminated series of ALLOT_ macros.
- *
- * cfish_CFBind_allot_params(stack, start, num_stack_elems,
- * "Lucy::Search::TermQuery::new_PARAMS",
- * ALLOT_OBJ(&field, "field", 5, LUCY_CHARBUF, true, alloca(cfish_ZCB_size()),
- * ALLOT_OBJ(&term, "term", 4, LUCY_CHARBUF, true, alloca(cfish_ZCB_size()),
- * NULL);
- *
- * The following ALLOT_ macros are available for primitive types:
- *
- * ALLOT_I8(ptr, key, keylen, required)
- * ALLOT_I16(ptr, key, keylen, required)
- * ALLOT_I32(ptr, key, keylen, required)
- * ALLOT_I64(ptr, key, keylen, required)
- * ALLOT_U8(ptr, key, keylen, required)
- * ALLOT_U16(ptr, key, keylen, required)
- * ALLOT_U32(ptr, key, keylen, required)
- * ALLOT_U64(ptr, key, keylen, required)
- * ALLOT_BOOL(ptr, key, keylen, required)
- * ALLOT_CHAR(ptr, key, keylen, required)
- * ALLOT_SHORT(ptr, key, keylen, required)
- * ALLOT_INT(ptr, key, keylen, required)
- * ALLOT_LONG(ptr, key, keylen, required)
- * ALLOT_SIZE_T(ptr, key, keylen, required)
- * ALLOT_F32(ptr, key, keylen, required)
- * ALLOT_F64(ptr, key, keylen, required)
- *
- * The four arguments to these ALLOT_ macros have the following meanings:
- *
- * ptr -- A pointer to the variable to be extracted.
- * key -- The name of the parameter as a C string.
- * keylen -- The length of the parameter name in bytes.
- * required -- A boolean indicating whether the parameter is required.
- *
- * If a required parameter is not present, allot_params() will immediately
- * cease processing of parameters, set Err_error and return false.
- *
- * Use the following macro if a Clownfish object is desired:
- *
- * ALLOT_OBJ(ptr, key, keylen, required, vtable, allocation)
- *
- * The "vtable" argument must be the VTable corresponding to the class of the
- * desired object. The "allocation" argument must be a blob of memory
- * allocated on the stack sufficient to hold a ZombieCharBuf. (Use
- * cfish_ZCB_size() to find the allocation size.)
- *
- * To extract a Perl scalar, use the following ALLOT_ macro:
- *
- * ALLOT_SV(ptr, key, keylen, required)
- *
- * @param stack The Perl stack.
- * @param start Where on the Perl stack to start looking for params. For
- * methods, this would typically be 1; for functions, most likely 0.
- * @param num_stack_elems The number of arguments passed to the Perl function
- * (generally, the XS variable "items").
- * @param params_hash_name The name of a package global hash. Any param
- * labels which are not present in this hash will trigger an exception.
- * @return true on success, false on failure (sets Err_error).
- */
-chy_bool_t
-cfish_CFBind_allot_params(SV** stack, int32_t start,
- int32_t num_stack_elems,
- char* params_hash_name, ...);
-
-#define CFBIND_WANT_I8 0x1
-#define CFBIND_WANT_I16 0x2
-#define CFBIND_WANT_I32 0x3
-#define CFBIND_WANT_I64 0x4
-#define CFBIND_WANT_U8 0x5
-#define CFBIND_WANT_U16 0x6
-#define CFBIND_WANT_U32 0x7
-#define CFBIND_WANT_U64 0x8
-#define CFBIND_WANT_BOOL 0x9
-#define CFBIND_WANT_F32 0xA
-#define CFBIND_WANT_F64 0xB
-#define CFBIND_WANT_OBJ 0xC
-#define CFBIND_WANT_SV 0xD
-
-#if (CHY_SIZEOF_CHAR == 1)
- #define CFBIND_WANT_CHAR CFBIND_WANT_I8
-#else
- #error "Can't build unless sizeof(char) == 1"
-#endif
-
-#if (CHY_SIZEOF_SHORT == 2)
- #define CFBIND_WANT_SHORT CFBIND_WANT_I16
-#else
- #error "Can't build unless sizeof(short) == 2"
-#endif
-
-#if (CHY_SIZEOF_INT == 4)
- #define CFBIND_WANT_INT CFBIND_WANT_I32
-#else // sizeof(int) == 8
- #define CFBIND_WANT_INT CFBIND_WANT_I64
-#endif
-
-#if (CHY_SIZEOF_LONG == 4)
- #define CFBIND_WANT_LONG CFBIND_WANT_I32
-#else // sizeof(long) == 8
- #define CFBIND_WANT_LONG CFBIND_WANT_I64
-#endif
-
-#if (CHY_SIZEOF_SIZE_T == 4)
- #define CFBIND_WANT_SIZE_T CFBIND_WANT_U32
-#else // sizeof(long) == 8
- #define CFBIND_WANT_SIZE_T CFBIND_WANT_U64
-#endif
-
-#define CFBIND_ALLOT_I8(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_I8, NULL, NULL
-#define CFBIND_ALLOT_I16(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_I16, NULL, NULL
-#define CFBIND_ALLOT_I32(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_I32, NULL, NULL
-#define CFBIND_ALLOT_I64(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_I64, NULL, NULL
-#define CFBIND_ALLOT_U8(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_U8, NULL, NULL
-#define CFBIND_ALLOT_U16(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_U16, NULL, NULL
-#define CFBIND_ALLOT_U32(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_U32, NULL, NULL
-#define CFBIND_ALLOT_U64(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_U64, NULL, NULL
-#define CFBIND_ALLOT_BOOL(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_BOOL, NULL, NULL
-#define CFBIND_ALLOT_CHAR(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_CHAR, NULL, NULL
-#define CFBIND_ALLOT_SHORT(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_SHORT, NULL, NULL
-#define CFBIND_ALLOT_INT(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_INT, NULL, NULL
-#define CFBIND_ALLOT_LONG(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_LONG, NULL, NULL
-#define CFBIND_ALLOT_SIZE_T(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_SIZE_T, NULL, NULL
-#define CFBIND_ALLOT_F32(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_F32, NULL, NULL
-#define CFBIND_ALLOT_F64(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_F64, NULL, NULL
-#define CFBIND_ALLOT_OBJ(ptr, key, keylen, required, vtable, allocation) \
- ptr, key, keylen, required, CFBIND_WANT_OBJ, vtable, allocation
-#define CFBIND_ALLOT_SV(ptr, key, keylen, required) \
- ptr, key, keylen, required, CFBIND_WANT_SV, NULL, NULL
-
-/* Define short names for most of the symbols in this file. Note that these
- * short names are ALWAYS in effect, since they are only used for Perl and we
- * can be confident they don't conflict with anything. (It's prudent to use
- * full symbols nevertheless in case someone else defines e.g. a function
- * named "CFBind_sv_defined".)
- */
-#define CFBind_new_blank_obj cfish_CFBind_new_blank_obj
-#define CFBind_sv_defined cfish_CFBind_sv_defined
-#define CFBind_sv_to_cfish_obj cfish_CFBind_sv_to_cfish_obj
-#define CFBind_maybe_sv_to_cfish_obj cfish_CFBind_maybe_sv_to_cfish_obj
-#define CFBind_cfish_obj_to_sv cfish_CFBind_cfish_obj_to_sv
-#define CFBind_cfish_obj_to_sv_noinc cfish_CFBind_cfish_obj_to_sv_noinc
-#define CFBind_cfish_to_perl cfish_CFBind_cfish_to_perl
-#define CFBind_perl_to_cfish cfish_CFBind_perl_to_cfish
-#define CFBind_bb_to_sv cfish_CFBind_bb_to_sv
-#define CFBind_cb_to_sv cfish_CFBind_cb_to_sv
-#define CFBind_enable_overload cfish_CFBind_enable_overload
-#define CFBind_allot_params cfish_CFBind_allot_params
-#define ALLOT_I8 CFBIND_ALLOT_I8
-#define ALLOT_I16 CFBIND_ALLOT_I16
-#define ALLOT_I32 CFBIND_ALLOT_I32
-#define ALLOT_I64 CFBIND_ALLOT_I64
-#define ALLOT_U8 CFBIND_ALLOT_U8
-#define ALLOT_U16 CFBIND_ALLOT_U16
-#define ALLOT_U32 CFBIND_ALLOT_U32
-#define ALLOT_U64 CFBIND_ALLOT_U64
-#define ALLOT_BOOL CFBIND_ALLOT_BOOL
-#define ALLOT_CHAR CFBIND_ALLOT_CHAR
-#define ALLOT_SHORT CFBIND_ALLOT_SHORT
-#define ALLOT_INT CFBIND_ALLOT_INT
-#define ALLOT_LONG CFBIND_ALLOT_LONG
-#define ALLOT_SIZE_T CFBIND_ALLOT_SIZE_T
-#define ALLOT_F32 CFBIND_ALLOT_F32
-#define ALLOT_F64 CFBIND_ALLOT_F64
-#define ALLOT_OBJ CFBIND_ALLOT_OBJ
-#define ALLOT_SV CFBIND_ALLOT_SV
-
/* Strip the prefix from some common ClownFish symbols where we know there's
- * no conflict with Perl. It's a little inconsistent to do this rather than
- * leave all symbols at full size, but the succinctness is worth it.
+ * no conflict. It's a little inconsistent to do this rather than leave all
+ * symbols at full size, but the succinctness is worth it.
*/
#define THROW CFISH_THROW
#define WARN CFISH_WARN