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 2012/01/17 18:32:05 UTC
[lucy-commits] svn commit: r1232502 - in /incubator/lucy/trunk/clownfish: include/CFC.h
perl/lib/Clownfish/CFC.pm perl/lib/Clownfish/CFC.xs
perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm
Author: marvin
Date: Tue Jan 17 17:32:04 2012
New Revision: 1232502
URL: http://svn.apache.org/viewvc?rev=1232502&view=rev
Log:
Go back to C version of Perl binding typemap.
Modified:
incubator/lucy/trunk/clownfish/include/CFC.h
incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.pm
incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.xs
incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm
Modified: incubator/lucy/trunk/clownfish/include/CFC.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/include/CFC.h?rev=1232502&r1=1232501&r2=1232502&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/include/CFC.h (original)
+++ incubator/lucy/trunk/clownfish/include/CFC.h Tue Jan 17 17:32:04 2012
@@ -39,3 +39,5 @@
#include "CFCBindFunction.h"
#include "CFCBindMethod.h"
+#include "CFCPerlTypeMap.h"
+
Modified: incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.pm?rev=1232502&r1=1232501&r2=1232502&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.pm (original)
+++ incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.pm Tue Jan 17 17:32:04 2012
@@ -82,6 +82,18 @@ BEGIN { XSLoader::load( 'Clownfish::CFC'
}
{
+ package Clownfish::CFC::Binding::Perl::TypeMap;
+ use base qw( Exporter );
+
+ BEGIN { our @EXPORT_OK = qw( from_perl to_perl ) }
+
+ sub write_xs_typemap {
+ my ( undef, %args ) = @_;
+ _write_xs_typemap( $args{hierarchy} );
+ }
+}
+
+{
package Clownfish::CFC::Base;
}
@@ -648,11 +660,6 @@ BEGIN { XSLoader::load( 'Clownfish::CFC'
use Clownfish::CFC::Binding::Perl::Subroutine;
}
-{
- package Clownfish::CFC::Binding::Perl::TypeMap;
- use Clownfish::CFC::Binding::Perl::TypeMap;
-}
-
1;
=head1 NAME
Modified: incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.xs
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.xs?rev=1232502&r1=1232501&r2=1232502&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.xs (original)
+++ incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC.xs Tue Jan 17 17:32:04 2012
@@ -1752,6 +1752,31 @@ PPCODE:
CFCBindFile_write_h(file, dest, header, footer);
+MODULE = Clownfish PACKAGE = Clownfish::CFC::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;
+PPCODE:
+ CFCPerlTypeMap_write_xs_typemap(hierarchy);
+
+
MODULE = Clownfish::CFC PACKAGE = Clownfish::CFC::Parser
SV*
Modified: incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm?rev=1232502&r1=1232501&r2=1232502&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm (original)
+++ incubator/lucy/trunk/clownfish/perl/lib/Clownfish/CFC/Binding/Perl/TypeMap.pm Tue Jan 17 17:32:04 2012
@@ -13,213 +13,8 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-use strict;
-use warnings;
-
package Clownfish::CFC::Binding::Perl::TypeMap;
-use base qw( Exporter );
-use Scalar::Util qw( blessed );
-use Carp;
-use Fcntl;
-
-BEGIN { 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::CFC::Type")
- unless blessed($type) && $type->isa('Clownfish::CFC::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::CFC::Type")
- unless ref($type) && $type->isa('Clownfish::CFC::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 ) = @_;
- my $hierarchy = $args{hierarchy};
-
- my $class_typemap_start = "";
- my $class_typemap_input = "";
- my $class_typemap_output = "";
-
- for my $class ( @{ $hierarchy->ordered_classes } ) {
- my $full_struct_sym = $class->full_struct_sym;
- my $vtable = $class->full_vtable_var;
- my $label = $vtable . "_";
- $class_typemap_start .= "$full_struct_sym*\t$label\n";
- $class_typemap_input .= <<END_INPUT;
-$label
- \$var = ($full_struct_sym*)XSBind_sv_to_cfish_obj(\$arg, $vtable, NULL);
-
-END_INPUT
-
- $class_typemap_output .= <<END_OUTPUT;
-$label
- \$arg = (SV*)Cfish_Obj_To_Host((cfish_Obj*)\$var);
- CFISH_DECREF(\$var);
-
-END_OUTPUT
- }
-
- # Blast it out.
- sysopen( my $typemap_fh, 'typemap', O_CREAT | O_WRONLY | O_EXCL )
- or die "Couldn't open 'typemap' for writing: $!";
- print $typemap_fh <<END_STUFF;
-# Auto-generated file.
-
-TYPEMAP
-chy_bool_t\tCHY_BOOL
-int8_t\tCHY_SIGNED_INT
-int16_t\tCHY_SIGNED_INT
-int32_t\tCHY_SIGNED_INT
-int64_t\tCHY_BIG_SIGNED_INT
-uint8_t\tCHY_UNSIGNED_INT
-uint16_t\tCHY_UNSIGNED_INT
-uint32_t\tCHY_UNSIGNED_INT
-uint64_t\tCHY_BIG_UNSIGNED_INT
-
-const lucy_CharBuf*\tCONST_CHARBUF
-$class_typemap_start
-
-INPUT
-
-CHY_BOOL
- \$var = (\$type)SvTRUE(\$arg);
-
-CHY_SIGNED_INT
- \$var = (\$type)SvIV(\$arg);
-
-CHY_UNSIGNED_INT
- \$var = (\$type)SvUV(\$arg);
-
-CHY_BIG_SIGNED_INT
- \$var = (sizeof(IV) == 8) ? (\$type)SvIV(\$arg) : (\$type)SvNV(\$arg);
-
-CHY_BIG_UNSIGNED_INT
- \$var = (sizeof(UV) == 8) ? (\$type)SvUV(\$arg) : (\$type)SvNV(\$arg);
-
-CONST_CHARBUF
- \$var = (const cfish_CharBuf*)CFISH_ZCB_WRAP_STR(SvPVutf8_nolen(\$arg), SvCUR(\$arg));
-
-$class_typemap_input
-
-OUTPUT
-
-CHY_BOOL
- sv_setiv(\$arg, (IV)\$var);
-
-CHY_SIGNED_INT
- sv_setiv(\$arg, (IV)\$var);
-
-CHY_UNSIGNED_INT
- sv_setuv(\$arg, (UV)\$var);
-
-CHY_BIG_SIGNED_INT
- if (sizeof(IV) == 8) { sv_setiv(\$arg, (IV)\$var); }
- else { sv_setnv(\$arg, (NV)\$var); }
-
-CHY_BIG_UNSIGNED_INT
- if (sizeof(UV) == 8) { sv_setuv(\$arg, (UV)\$var); }
- else { sv_setnv(\$arg, (NV)\$var); }
-
-$class_typemap_output
-
-END_STUFF
-
- close $typemap_fh or die $!;
-}
+use Clownfish::CFC;
1;
@@ -296,4 +91,3 @@ them when checking arguments. Keeping t
classes come and go would be a pain.
=cut
-