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/07/28 01:49:59 UTC
[lucy-commits] svn commit: r1151674 - in /incubator/lucy/trunk/clownfish: lib/Clownfish.xs
lib/Clownfish/Binding/Perl/TypeMap.pm src/CFCPerlTypeMap.c
src/CFCPerlTypeMap.h
Author: marvin
Date: Wed Jul 27 23:49:58 2011
New Revision: 1151674
URL: http://svn.apache.org/viewvc?rev=1151674&view=rev
Log:
Finish porting CFCPerlTypeMap to C.
Modified:
incubator/lucy/trunk/clownfish/lib/Clownfish.xs
incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm
incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.c
incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.h
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish.xs
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish.xs?rev=1151674&r1=1151673&r2=1151674&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish.xs (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish.xs Wed Jul 27 23:49:58 2011
@@ -2019,6 +2019,22 @@ PPCODE:
MODULE = Clownfish PACKAGE = Clownfish::Binding::Perl::TypeMap
+SV*
+from_perl(type, xs_var)
+ CFCType *type;
+ const char *xs_var;
+CODE:
+ RETVAL = S_sv_eat_c_string(CFCPerlTypeMap_from_perl(type, xs_var));
+OUTPUT: RETVAL
+
+SV*
+to_perl(type, cf_var)
+ CFCType *type;
+ const char *cf_var;
+CODE:
+ RETVAL = S_sv_eat_c_string(CFCPerlTypeMap_to_perl(type, cf_var));
+OUTPUT: RETVAL
+
void
_write_xs_typemap(hierarchy)
CFCHierarchy *hierarchy;
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm?rev=1151674&r1=1151673&r2=1151674&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm Wed Jul 27 23:49:58 2011
@@ -18,114 +18,9 @@ use warnings;
package Clownfish::Binding::Perl::TypeMap;
use base qw( Exporter );
-use Scalar::Util qw( blessed );
-use Carp;
-use Fcntl;
our @EXPORT_OK = qw( from_perl to_perl );
-# Convert from a Perl scalar to a primitive type.
-my %primitives_from_perl = (
- double => sub {"SvNV($_[0])"},
- float => sub {"(float)SvNV($_[0])"},
- int => sub {"(int)SvIV($_[0])"},
- short => sub {"(short)SvIV($_[0])"},
- long => sub {
- "((sizeof(long) <= sizeof(IV)) ? "
- . "(long)SvIV($_[0]) : (long)SvNV($_[0]))";
- },
- size_t => sub {"(size_t)SvIV($_[0])"},
- uint64_t => sub {"(uint64_t)SvNV($_[0])"},
- uint32_t => sub {"(uint32_t)SvUV($_[0])"},
- uint16_t => sub {"(uint16_t)SvUV($_[0])"},
- uint8_t => sub {"(uint8_t)SvUV($_[0])"},
- int64_t => sub {"(int64_t)SvNV($_[0])"},
- int32_t => sub {"(int32_t)SvIV($_[0])"},
- int16_t => sub {"(int16_t)SvIV($_[0])"},
- int8_t => sub {"(int8_t)SvIV($_[0])"},
- chy_bool_t => sub {"SvTRUE($_[0]) ? 1 : 0"},
-);
-
-# Convert from a primitive type to a Perl scalar.
-my %primitives_to_perl = (
- double => sub {"newSVnv($_[0])"},
- float => sub {"newSVnv($_[0])"},
- int => sub {"newSViv($_[0])"},
- short => sub {"newSViv($_[0])"},
- long => sub {
- "((sizeof(long) <= sizeof(IV)) ? "
- . "newSViv((IV)$_[0]) : newSVnv((NV)$_[0]))";
- },
- size_t => sub {"newSViv($_[0])"},
- uint64_t => sub {
- "sizeof(UV) == 8 ? newSVuv((UV)$_[0]) : newSVnv((NV)$_[0])";
- },
- uint32_t => sub {"newSVuv($_[0])"},
- uint16_t => sub {"newSVuv($_[0])"},
- uint8_t => sub {"newSVuv($_[0])"},
- int64_t => sub {
- "sizeof(IV) == 8 ? newSViv((IV)$_[0]) : newSVnv((NV)$_[0])";
- },
- int32_t => sub {"newSViv($_[0])"},
- int16_t => sub {"newSViv($_[0])"},
- int8_t => sub {"newSViv($_[0])"},
- chy_bool_t => sub {"newSViv($_[0])"},
-);
-
-sub from_perl {
- my ( $type, $xs_var ) = @_;
- confess("Not a Clownfish::Type")
- unless blessed($type) && $type->isa('Clownfish::Type');
-
- if ( $type->is_object ) {
- my $struct_sym = $type->get_specifier;
- my $vtable = uc($struct_sym);
- if ( $struct_sym =~ /^[a-z_]*(Obj|CharBuf)$/ ) {
- # Share buffers rather than copy between Perl scalars and
- # Clownfish string types.
- return "($struct_sym*)XSBind_sv_to_cfish_obj($xs_var, "
- . "$vtable, alloca(cfish_ZCB_size()))";
- }
- else {
- return "($struct_sym*)XSBind_sv_to_cfish_obj($xs_var, "
- . "$vtable, NULL)";
- }
- }
- elsif ( $type->is_primitive ) {
- if ( my $sub = $primitives_from_perl{ $type->to_c } ) {
- return $sub->($xs_var);
- }
- }
-
- confess( "Missing typemap for " . $type->to_c );
-}
-
-sub to_perl {
- my ( $type, $cf_var ) = @_;
- confess("Not a Clownfish::Type")
- unless ref($type) && $type->isa('Clownfish::Type');
- my $type_str = $type->to_c;
-
- if ( $type->is_object ) {
- return "($cf_var == NULL ? newSV(0) : "
- . "XSBind_cfish_to_perl((cfish_Obj*)$cf_var))";
- }
- elsif ( $type->is_primitive ) {
- if ( my $sub = $primitives_to_perl{$type_str} ) {
- return $sub->($cf_var);
- }
- }
- elsif ( $type->is_composite ) {
- if ( $type_str eq 'void*' ) {
- # Assume that void* is a reference SV -- either a hashref or an
- # arrayref.
- return "newRV_inc((SV*)($cf_var))";
- }
- }
-
- confess("Missing typemap for '$type_str'");
-}
-
sub write_xs_typemap {
my ( undef, %args ) = @_;
_write_xs_typemap( $args{hierarchy} );
Modified: incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.c
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.c?rev=1151674&r1=1151673&r2=1151674&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.c (original)
+++ incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.c Wed Jul 27 23:49:58 2011
@@ -15,16 +15,204 @@
*/
#include <string.h>
+#include <stdio.h>
#include "CFCPerlTypeMap.h"
#include "CFCUtil.h"
#include "CFCHierarchy.h"
#include "CFCClass.h"
+#include "CFCType.h"
#ifndef true
#define true 1
#define false 0
#endif
+// Convert from a Perl scalar to a primitive type.
+struct char_map {
+ char *key;
+ char *value;
+};
+
+
+char*
+CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) {
+ char *result = NULL;
+
+ if (CFCType_is_object(type)) {
+ const char *struct_sym = CFCType_get_specifier(type);
+ const char *vtable_var = CFCType_get_vtable_var(type);
+ if (strcmp(struct_sym, "lucy_CharBuf") == 0
+ || strcmp(struct_sym, "cfish_CharBuf") == 0
+ || strcmp(struct_sym, "lucy_Obj") == 0
+ || strcmp(struct_sym, "cfish_Obj") == 0
+ ) {
+ // Share buffers rather than copy between Perl scalars and
+ // Clownfish string types.
+ result = CFCUtil_cat(CFCUtil_strdup(""), "(", struct_sym,
+ "*)XSBind_sv_to_cfish_obj(", xs_var,
+ ", ", vtable_var,
+ ", alloca(cfish_ZCB_size()))", NULL);
+ }
+ else {
+ result = CFCUtil_cat(CFCUtil_strdup(""), "(", struct_sym,
+ "*)XSBind_sv_to_cfish_obj(", xs_var,
+ ", ", vtable_var, ", NULL)", NULL);
+ }
+ }
+ else if (CFCType_is_primitive(type)) {
+ const char *specifier = CFCType_get_specifier(type);
+ size_t size = 80 + strlen(xs_var) * 2;
+ result = (char*)MALLOCATE(size);
+
+ if (strcmp(specifier, "double") == 0) {
+ sprintf(result, "SvNV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "float") == 0) {
+ sprintf(result, "(float)SvNV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "int") == 0) {
+ sprintf(result, "(int)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "short") == 0) {
+ sprintf(result, "(short)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "long") == 0) {
+ const char pattern[] =
+ "((sizeof(long) <= sizeof(IV)) ? (long)SvIV(%s) "
+ ": (long)SvNV(%s))";
+ sprintf(result, pattern, xs_var, xs_var);
+ }
+ else if (strcmp(specifier, "size_t") == 0) {
+ sprintf(result, "(size_t)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "uint64_t") == 0) {
+ sprintf(result, "(uint64_t)SvNV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "uint32_t") == 0) {
+ sprintf(result, "(uint32_t)SvUV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "uint16_t") == 0) {
+ sprintf(result, "(uint16_t)SvUV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "uint8_t") == 0) {
+ sprintf(result, "(uint8_t)SvUV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "int64_t") == 0) {
+ sprintf(result, "(int64_t)SvNV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "int32_t") == 0) {
+ sprintf(result, "(int32_t)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "int16_t") == 0) {
+ sprintf(result, "(int16_t)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "int8_t") == 0) {
+ sprintf(result, "(int8_t)SvIV(%s)", xs_var);
+ }
+ else if (strcmp(specifier, "chy_bool_t") == 0) {
+ sprintf(result, "SvTRUE(%s) ? 1 : 0", xs_var);
+ }
+ else {
+ FREEMEM(result);
+ result = NULL;
+ }
+ }
+
+ if (!result) {
+ CFCUtil_die("Missing typemap for '%s'", CFCType_to_c(type));
+ }
+
+ return result;
+}
+
+char*
+CFCPerlTypeMap_to_perl(CFCType *type, const char *cf_var) {
+ const char *type_str = CFCType_to_c(type);
+ char *result = NULL;
+
+ if (CFCType_is_object(type)) {
+ result = CFCUtil_cat(CFCUtil_strdup(""), "(", cf_var,
+ " == NULL ? newSV(0) : "
+ "XSBind_cfish_to_perl((cfish_Obj*)",
+ cf_var, "))", NULL);
+ }
+ else if (CFCType_is_primitive(type)) {
+ // Convert from a primitive type to a Perl scalar.
+ const char *specifier = CFCType_get_specifier(type);
+ size_t size = 80 + strlen(cf_var) * 2;
+ result = (char*)MALLOCATE(size);
+
+ if (strcmp(specifier, "double") == 0) {
+ sprintf(result, "newSVnv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "float") == 0) {
+ sprintf(result, "newSVnv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "int") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "short") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "long") == 0) {
+ char pattern[] =
+ "((sizeof(long) <= sizeof(IV)) ? "
+ "newSViv((IV)%s) : newSVnv((NV)%s))";
+ sprintf(result, pattern, cf_var, cf_var);
+ }
+ else if (strcmp(specifier, "size_t") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "uint64_t") == 0) {
+ char pattern[] = "sizeof(UV) == 8 ? newSVuv((UV)%s) : newSVnv((NV)%s)";
+ sprintf(result, pattern, cf_var, cf_var);
+ }
+ else if (strcmp(specifier, "uint32_t") == 0) {
+ sprintf(result, "newSVuv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "uint16_t") == 0) {
+ sprintf(result, "newSVuv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "uint8_t") == 0) {
+ sprintf(result, "newSVuv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "int64_t") == 0) {
+ char pattern[] = "sizeof(IV) == 8 ? newSViv((IV)%s) : newSVnv((NV)%s)";
+ sprintf(result, pattern, cf_var, cf_var);
+ }
+ else if (strcmp(specifier, "int32_t") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "int16_t") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "int8_t") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else if (strcmp(specifier, "chy_bool_t") == 0) {
+ sprintf(result, "newSViv(%s)", cf_var);
+ }
+ else {
+ FREEMEM(result);
+ result = NULL;
+ }
+ }
+ else if (CFCType_is_composite(type)) {
+ if (strcmp(type_str, "void*") == 0) {
+ // Assume that void* is a reference SV -- either a hashref or an
+ // arrayref.
+ result = CFCUtil_cat(CFCUtil_strdup(""), "newRV_inc((SV*)",
+ cf_var,")", NULL);
+ }
+ }
+
+ if (!result) {
+ CFCUtil_die("Missing typemap for '%s'", CFCType_to_c(type));
+ }
+
+ return result;
+}
+
static const char typemap_start[] =
"# Auto-generated file.\n"
"\n"
Modified: incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.h?rev=1151674&r1=1151673&r2=1151674&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.h (original)
+++ incubator/lucy/trunk/clownfish/src/CFCPerlTypeMap.h Wed Jul 27 23:49:58 2011
@@ -22,6 +22,13 @@ extern "C" {
#endif
struct CFCHierarchy;
+struct CFCType;
+
+char*
+CFCPerlTypeMap_from_perl(struct CFCType *type, const char *xs_var);
+
+char*
+CFCPerlTypeMap_to_perl(struct CFCType *type, const char *cf_var);
void
CFCPerlTypeMap_write_xs_typemap(struct CFCHierarchy *hierarchy);