lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject [lucy-commits] svn commit: r1060453 - in /incubator/lucy/trunk: clownfish/lib/Clownfish/Binding/Perl/ perl/lib/Lucy/Analysis/ perl/lib/Lucy/Document/ perl/lib/Lucy/Index/ perl/lib/Lucy/Object/ perl/xs/
Date Tue, 18 Jan 2011 16:33:48 GMT
Author: marvin
Date: Tue Jan 18 16:33:47 2011
New Revision: 1060453

URL: http://svn.apache.org/viewvc?rev=1060453&view=rev
Log:
LUCY-131
Refactor XSBind_allot_params() so that it assigns to C-space variables
directly instead of parceling out Perl scalars for the caller to extract from.

Modified:
    incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Method.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm
    incubator/lucy/trunk/perl/lib/Lucy/Analysis/Inversion.pm
    incubator/lucy/trunk/perl/lib/Lucy/Analysis/Token.pm
    incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm
    incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm
    incubator/lucy/trunk/perl/lib/Lucy/Index/Indexer.pm
    incubator/lucy/trunk/perl/lib/Lucy/Index/SortCache.pm
    incubator/lucy/trunk/perl/lib/Lucy/Object/I32Array.pm
    incubator/lucy/trunk/perl/xs/XSBind.c
    incubator/lucy/trunk/perl/xs/XSBind.h

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm Tue Jan 18 16:33:47
2011
@@ -19,7 +19,6 @@ use warnings;
 package Clownfish::Binding::Perl::Constructor;
 use base qw( Clownfish::Binding::Perl::Subroutine );
 use Carp;
-use Clownfish::Binding::Perl::TypeMap qw( from_perl );
 use Clownfish::ParamList;
 
 sub new {
@@ -57,66 +56,26 @@ sub xsub_def {
     my $param_list = $self->{param_list};
     my $name_list  = $param_list->name_list;
     my $arg_inits  = $param_list->get_initial_values;
-    my $num_args   = $param_list->num_vars;
     my $arg_vars   = $param_list->get_variables;
     my $func_sym   = $self->{init_func}->full_func_sym;
+    my $allot_params = $self->build_allot_params;
 
-    # Create code for allocating labeled parameters.
-    my $var_declarations = $self->var_declarations;
-    my $params_hash_name = $self->perl_name . "_PARAMS";
-    my @var_assignments;
-    my @refcount_mods;
-    my $allot_params = qq|chy_bool_t args_ok = XSBind_allot_params(\n|
-        . qq|        &(ST(0)), 1, items, "$params_hash_name",\n|;
-
-    # Iterate over args in param list.
+    # Compensate for swallowed refcounts.
+    my $refcount_mods = "";
     for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
-        my $var     = $arg_vars->[$i];
-        my $val     = $arg_inits->[$i];
-        my $name    = $var->micro_sym;
-        my $sv_name = $name . "_sv";
-        my $type    = $var->get_type;
-        my $len     = length $name;
-
-        # Create snippet for extracting sv from stack, if supplied.
-        $allot_params .= qq|        &$sv_name, "$name", $len,\n|;
-
-        # Create code for determining and validating value.
-        my $statement = "$name = " . from_perl( $type, $sv_name ) . ";";
-        if ( defined $val ) {
-            my $assignment = qq|if ($sv_name && XSBind_sv_defined($sv_name)) {
-        $statement
-    }
-    else {
-        $name = $val;
-    }|;
-            push @var_assignments, $assignment;
-        }
-        else {
-            my $assignment
-                = qq#if ( !$sv_name || !XSBind_sv_defined($sv_name) ) {
-       CFISH_THROW(CFISH_ERR, "Missing required param '$name'");
-    }
-    $statement#;
-            push @var_assignments, $assignment;
-        }
-
-        # Compensate for the fact that the method will swallow a refcount.
+        my $var      = $arg_vars->[$i];
+        my $type     = $var->get_type;
         if ( $type->is_object and $type->decremented ) {
-            push @refcount_mods, "LUCY_INCREF($name);";
+            my $name     = $var->micro_sym;
+            $refcount_mods .= "\n    LUCY_INCREF($name);";
         }
     }
-    $allot_params .= "        NULL);";
 
     # Last, so that earlier exceptions while fetching params don't trigger bad
     # DESTROY.
-    my $self_var  = $arg_vars->[0];
-    my $self_type = $self_var->get_type->to_c;
-    push @var_assignments,
-        qq|$self_type self = ($self_type)XSBind_new_blank_obj( ST(0) );|;
-
-    # Bundle up variable assignment statments and refcount modifications.
-    my $var_assignments = join( "\n    ", @var_assignments, @refcount_mods );
+    my $self_var    = $arg_vars->[0];
+    my $self_type   = $self_var->get_type->to_c;
+    my $self_assign = qq|$self_type self = ($self_type)XSBind_new_blank_obj( ST(0) );|;
 
     return <<END_STUFF;
 XS($c_name);
@@ -127,12 +86,8 @@ XS($c_name)
     if (items < 1) { CFISH_THROW(CFISH_ERR, "Usage: %s(class_name, ...)",  GvNAME(CvGV(cv)));
}
     SP -= items;
 
-    $var_declarations
     $allot_params
-    if (!args_ok) {
-        CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
-    }
-    $var_assignments
+    $self_assign$refcount_mods
 
     $self_type retval = $func_sym($name_list);
     if (retval) {

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Method.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Method.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Method.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Method.pm Tue Jan 18 16:33:47
2011
@@ -184,68 +184,24 @@ END_STUFF
 }
 
 sub _xsub_def_labeled_params {
-    my $self       = shift;
-    my $c_name     = $self->c_name;
-    my $param_list = $self->{param_list};
-    my $arg_inits  = $param_list->get_initial_values;
-    my $num_args   = $param_list->num_vars;
-    my $arg_vars   = $param_list->get_variables;
-    my $body       = $self->_xsub_body;
+    my $self        = shift;
+    my $c_name      = $self->c_name;
+    my $param_list  = $self->{param_list};
+    my $arg_inits   = $param_list->get_initial_values;
+    my $arg_vars    = $param_list->get_variables;
+    my $self_var    = $arg_vars->[0];
+    my $self_assign = _self_assign_statement( $self_var->get_type,
+        $self->{method}->micro_sym );
+    my $allot_params = $self->build_allot_params;
+    my $body         = $self->_xsub_body;
 
     # Prepare error message for incorrect args.
-    my $name_list = $arg_vars->[0]->micro_sym . ", ...";
+    my $name_list = $self_var->micro_sym . ", ...";
     my $num_args_check
         = qq|if (items < 1) { |
         . qq|CFISH_THROW(CFISH_ERR, "Usage: %s(%s)",  GvNAME(CvGV(cv)), |
         . qq|"$name_list"); }|;
 
-    # Create code for allocating labeled parameters.
-    my $var_declarations = $self->var_declarations;
-    my $self_var         = $arg_vars->[0];
-    my $self_type        = $self_var->get_type;
-    my $params_hash_name = $self->perl_name . "_PARAMS";
-    my $self_assignment
-        = _self_assign_statement( $self_type, $self->{method}->micro_sym );
-    my @var_assignments;
-    my $allot_params = qq|chy_bool_t args_ok = XSBind_allot_params(\n|
-        . qq|        &(ST(0)), 1, items, "$params_hash_name",\n|;
-
-    # Iterate over args in param list.
-    for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
-        my $var     = $arg_vars->[$i];
-        my $val     = $arg_inits->[$i];
-        my $name    = $var->micro_sym;
-        my $sv_name = $name . "_sv";
-        my $type    = $var->get_type;
-        my $len     = length $name;
-
-        # Code for extracting sv from stack, if supplied.
-        $allot_params .= qq|        &$sv_name, "$name", $len,\n|;
-
-        # Code for determining and validating value.
-        my $statement = "$name = " . from_perl( $type, $sv_name ) . ";";
-        if ( defined $val ) {
-            my $assignment
-            = qq|if ( $sv_name && XSBind_sv_defined($sv_name) ) {
-        $statement;
-    }
-    else {
-        $name = $val;
-    }|;
-            push @var_assignments, $assignment;
-        }
-        else {
-            my $assignment
-                = qq#if ( !$sv_name || !XSBind_sv_defined($sv_name) ) { #
-                . qq#CFISH_THROW(CFISH_ERR, "Missing required param '$name'"); }\n#
-                . qq#     $statement;#;
-            push @var_assignments, $assignment;
-        }
-    }
-    $allot_params .= "        NULL);";
-    my $var_assignments
-        = join( "\n    ", $self_assignment, @var_assignments, );
-
     return <<END_STUFF;
 XS($c_name);
 XS($c_name)
@@ -256,12 +212,8 @@ XS($c_name)
     SP -= items;
 
     /* Extract vars from Perl stack. */
-    $var_declarations
     $allot_params
-    if (!args_ok) {
-        CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
-    }
-    $var_assignments
+    $self_assign
 
     /* Execute */
     $body

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm Tue Jan 18 16:33:47
2011
@@ -18,6 +18,7 @@ use warnings;
 
 package Clownfish::Binding::Perl::Subroutine;
 use Carp;
+use Scalar::Util qw( blessed );
 use Clownfish::Class;
 use Clownfish::Function;
 use Clownfish::Method;
@@ -98,17 +99,91 @@ sub params_hash_def {
     }
 }
 
-sub var_declarations {
-    my $self     = shift;
-    my $arg_vars = $self->{param_list}->get_variables;
-    my @var_declarations
-        = map { $_->local_declaration } @$arg_vars[ 1 .. $#$arg_vars ];
-    if ( $self->{use_labeled_params} ) {
-        push @var_declarations,
-            map { "SV* " . $_->micro_sym . "_sv = NULL;" }
-            @$arg_vars[ 1 .. $#$arg_vars ];
+
+my %prim_type_to_allot_macro = (
+    double     => 'ALLOT_F64',
+    float      => 'ALLOT_F32',
+    int        => 'ALLOT_INT',
+    short      => 'ALLOT_SHORT',
+    long       => 'ALLOT_LONG',
+    size_t     => 'ALLOT_SIZE_T',
+    uint64_t   => 'ALLOT_U64',
+    uint32_t   => 'ALLOT_U32',
+    uint16_t   => 'ALLOT_U16',
+    uint8_t    => 'ALLOT_U8',
+    int64_t    => 'ALLOT_I64',
+    int32_t    => 'ALLOT_I32',
+    int16_t    => 'ALLOT_I16',
+    int8_t     => 'ALLOT_I8',
+    chy_bool_t => 'ALLOT_BOOL',
+);
+
+sub _allot_params_arg {
+    my ( $type, $label, $required ) = @_;
+    confess("Not a Clownfish::Type")
+        unless blessed($type) && $type->isa('Clownfish::Type');
+    my $len = length($label);
+    my $req_string = $required ? 'true' : 'false';
+
+    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 qq|ALLOT_OBJ(\&$label, "$label", $len, $req_string, |
+                . qq|$vtable, alloca(cfish_ZCB_size()))|;
+        }
+        else {
+            return qq|ALLOT_OBJ(\&$label, "$label", $len, $req_string, |
+                . qq|$vtable, NULL)|;
+        }
     }
-    return join( "\n    ", @var_declarations );
+    elsif ( $type->is_primitive ) {
+        if ( my $allot = $prim_type_to_allot_macro{ $type->to_c } ) {
+            return qq|$allot(\&$label, "$label", $len, $req_string)|;
+        }
+    }
+
+    confess( "Missing typemap for " . $type->to_c );
+}
+
+sub build_allot_params {
+    my $self         = shift;
+    my $param_list   = $self->{param_list};
+    my $arg_inits    = $param_list->get_initial_values;
+    my $arg_vars     = $param_list->get_variables;
+    my $params_hash  = $self->perl_name . "_PARAMS";
+    my $allot_params = "";
+
+    # Declare variables and assign default values.
+    for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
+        my $arg_var = $arg_vars->[$i];
+        my $val     = $arg_inits->[$i];
+        if ( !defined($val) ) {
+            $val = $arg_var->get_type->is_object ? 'NULL' : '0';
+        }
+        $allot_params .= $arg_var->local_c . " = $val;\n    ";
+    }
+
+    # Iterate over args in param list.
+    $allot_params .= qq|chy_bool_t args_ok = XSBind_allot_params(\n|
+        . qq|        &(ST(0)), 1, items, "$params_hash",\n|;
+    for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
+        my $var      = $arg_vars->[$i];
+        my $val      = $arg_inits->[$i];
+        my $required = defined $val ? 0 : 1;
+        my $name     = $var->micro_sym;
+        my $type     = $var->get_type;
+        $allot_params .= "        "
+            . _allot_params_arg( $type, $name, $required ) . ",\n";
+    }
+    $allot_params .= qq|        NULL);
+    if (!args_ok) {
+        CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
+    }|;
+
+    return $allot_params;
 }
 
 sub xsub_def { confess "Abstract method" }
@@ -168,11 +243,6 @@ labeled parameters, false if it should t
 
 Abstract method which must return C code (not XS code) defining the Perl XSUB.
 
-=head2 var_declarations
-
-Generate C code containing declarations for subroutine-specific automatic
-variables needed by the XSUB.
-
 =head2 get_class_name use_labeled_params
 
 Accessors.

Modified: incubator/lucy/trunk/perl/lib/Lucy/Analysis/Inversion.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Analysis/Inversion.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Analysis/Inversion.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Analysis/Inversion.pm Tue Jan 18 16:33:47 2011
@@ -35,7 +35,7 @@ CODE:
         SV *text_sv = NULL;
         chy_bool_t args_ok = XSBind_allot_params(
             &(ST(0)), 1, items, "Lucy::Analysis::Inversion::new_PARAMS",
-            &text_sv, "text", 4,
+            ALLOT_SV(&text_sv, "text", 4, false),
             NULL);
         if (!args_ok) {
             CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));

Modified: incubator/lucy/trunk/perl/lib/Lucy/Analysis/Token.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Analysis/Token.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Analysis/Token.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Analysis/Token.pm Tue Jan 18 16:33:47 2011
@@ -30,41 +30,27 @@ new(either_sv, ...)
     SV *either_sv;
 CODE:
 {
-    SV *text_sv         = NULL;
-    SV *start_offset_sv = NULL;
-    SV *end_offset_sv   = NULL;
-    SV *pos_inc_sv      = NULL;
-    SV *boost_sv        = NULL;
+    SV       *text_sv   = NULL;
+    uint32_t  start_off = 0;
+    uint32_t  end_off   = 0;
+    int32_t   pos_inc   = 1;
+    float     boost     = 1.0f;
 
     chy_bool_t args_ok = XSBind_allot_params(
         &(ST(0)), 1, items, "Lucy::Analysis::Token::new_PARAMS",
-        &text_sv, "text", 4,
-        &start_offset_sv, "start_offset", 12, 
-        &end_offset_sv, "end_offset", 10, 
-        &pos_inc_sv, "pos_inc", 7, 
-        &boost_sv, "boost", 5, 
+        ALLOT_SV(&text_sv, "text", 4, true),
+        ALLOT_U32(&start_off, "start_offset", 12, true),
+        ALLOT_U32(&end_off, "end_offset", 10, true),
+        ALLOT_I32(&pos_inc, "pos_inc", 7, false),
+        ALLOT_F32(&boost, "boost", 5, false),
         NULL);
     if (!args_ok) {
         CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
     }
 
-    if (!XSBind_sv_defined(text_sv)) { 
-        THROW(LUCY_ERR, "Missing required param 'text'"); 
-    }
-    if (!XSBind_sv_defined(start_offset_sv)) { 
-        THROW(LUCY_ERR, "Missing required param 'start_offset'"); 
-    }
-    if (!XSBind_sv_defined(end_offset_sv)) { 
-        THROW(LUCY_ERR, "Missing required param 'end_offset'"); 
-    }
-
     STRLEN      len;
-    char       *text      = SvPVutf8(text_sv, len);
-    uint32_t    start_off = SvUV(start_offset_sv);
-    uint32_t    end_off   = SvUV(end_offset_sv);
-    int32_t     pos_inc   = pos_inc_sv ? SvIV(pos_inc_sv) : 1;
-    float       boost     = boost_sv ? (float)SvNV(boost_sv) : 1.0f;
-    lucy_Token *self   = (lucy_Token*)XSBind_new_blank_obj(either_sv);
+    char       *text = SvPVutf8(text_sv, len);
+    lucy_Token *self = (lucy_Token*)XSBind_new_blank_obj(either_sv);
     lucy_Token_init(self, text, len, start_off, end_off, boost, 
         pos_inc);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(self);

Modified: incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm Tue Jan 18 16:33:47 2011
@@ -31,18 +31,17 @@ new(either_sv, ...)
 CODE:
 {
     SV* fields_sv = NULL; 
-    SV* doc_id_sv = NULL; 
+    int32_t doc_id = 0;
     chy_bool_t args_ok = XSBind_allot_params(
         &(ST(0)), 1, items, "Lucy::Document::Doc::new_PARAMS",
-        &fields_sv, "fields", 6,
-        &doc_id_sv, "doc_id", 6,
+        ALLOT_SV(&fields_sv, "fields", 6, false),
+        ALLOT_I32(&doc_id, "doc_id", 6, false),
         NULL);
     if (!args_ok) {
         CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
     }     
 
-    HV      *fields = NULL;
-    int32_t  doc_id = 0;
+    HV *fields = NULL;
     if (fields_sv && XSBind_sv_defined(fields_sv)) {
         if (SvROK(fields_sv)) {
             fields = (HV*)SvRV(fields_sv);
@@ -51,9 +50,6 @@ CODE:
             CFISH_THROW(CFISH_ERR, "fields is not a hashref");
         }
     }     
-    if (doc_id_sv && XSBind_sv_defined(doc_id_sv)) {
-        doc_id = (int32_t)SvIV( doc_id_sv );
-    }     
 
     lucy_Doc *self = (lucy_Doc*)XSBind_new_blank_obj(either_sv);
     lucy_Doc_init(self, fields, doc_id);

Modified: incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm Tue Jan 18 16:33:47 2011
@@ -30,22 +30,20 @@ new(either_sv, ...)
     SV *either_sv;
 CODE:
 {
-    SV* fields_sv = NULL; 
-    SV* doc_id_sv = NULL; 
-    SV* score_sv  = NULL; 
+    SV *fields_sv = NULL; 
+    int32_t doc_id = 0;
+    float score = 0.0f;
     chy_bool_t args_ok = XSBind_allot_params(
         &(ST(0)), 1, items, "Lucy::Document::HitDoc::new_PARAMS",
-        &fields_sv, "fields", 6,
-        &doc_id_sv, "doc_id", 6,
-        &score_sv, "score", 5,
+        ALLOT_SV(&fields_sv, "fields", 6, false),
+        ALLOT_I32(&doc_id, "doc_id", 6, false),
+        ALLOT_F32(&score, "score", 5, false),
         NULL);
     if (!args_ok) {
         CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
     }     
 
-    HV      *fields = NULL;
-    int32_t  doc_id = 0;
-    float    score  = 0.0f;
+    HV *fields = NULL;
     if (fields_sv && XSBind_sv_defined(fields_sv)) {
         if (SvROK(fields_sv)) {
             fields = (HV*)SvRV(fields_sv);
@@ -54,12 +52,6 @@ CODE:
             CFISH_THROW(CFISH_ERR, "fields is not a hashref");
         }
     }     
-    if (doc_id_sv && XSBind_sv_defined(doc_id_sv)) {
-        doc_id = (int32_t)SvIV( doc_id_sv );
-    }     
-    if (score_sv && XSBind_sv_defined(score_sv)) {
-        score = (float)SvNV( score_sv );
-    }     
 
     lucy_HitDoc *self = (lucy_HitDoc*)XSBind_new_blank_obj(either_sv);
     lucy_HitDoc_init(self, fields, doc_id, score);

Modified: incubator/lucy/trunk/perl/lib/Lucy/Index/Indexer.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Index/Indexer.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Index/Indexer.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Index/Indexer.pm Tue Jan 18 16:33:47 2011
@@ -52,18 +52,14 @@ PPCODE:
         doc_sv = ST(1);
     }
     else if (items > 2) {
-        SV* boost_sv = NULL; 
         chy_bool_t args_ok = XSBind_allot_params(
             &(ST(0)), 1, items, "Lucy::Index::Indexer::add_doc_PARAMS", 
-            &doc_sv, "doc", 3,
-            &boost_sv, "boost", 5, 
+            ALLOT_SV(&doc_sv, "doc", 3, true),
+            ALLOT_F32(&boost, "boost", 5, false),
             NULL);
         if (!args_ok) {
             CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
         }
-        if (boost_sv) {
-            boost = (float)SvNV(boost_sv);
-        }
     }
     else if (items == 1) {
         CFISH_THROW(LUCY_ERR, "Missing required argument 'doc'");

Modified: incubator/lucy/trunk/perl/lib/Lucy/Index/SortCache.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Index/SortCache.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Index/SortCache.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Index/SortCache.pm Tue Jan 18 16:33:47 2011
@@ -30,19 +30,14 @@ value(self, ...)
     lucy_SortCache *self;
 CODE:
 {
-    SV *ord_sv = NULL;
     int32_t ord = 0;
-
     chy_bool_t args_ok = XSBind_allot_params(
         &(ST(0)), 1, items, "Lucy::Index::SortCache::value_PARAMS",
-        &ord_sv, "ord", 3, 
+        ALLOT_I32(&ord, "ord", 3, false),
         NULL);
     if (!args_ok) {
         CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
     }
-    if (ord_sv) { ord = SvIV(ord_sv); }
-    else { THROW(LUCY_ERR, "Missing required param 'ord'"); }
-
     {
         lucy_Obj *blank = Lucy_SortCache_Make_Blank(self);
         lucy_Obj *value = Lucy_SortCache_Value(self, ord, blank);

Modified: incubator/lucy/trunk/perl/lib/Lucy/Object/I32Array.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Object/I32Array.pm?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Object/I32Array.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Object/I32Array.pm Tue Jan 18 16:33:47 2011
@@ -31,20 +31,20 @@ new(either_sv, ...) 
 CODE:
 {
     SV *ints_sv = NULL;
-    AV *ints_av = NULL;
     lucy_I32Array *self = NULL;
 
     chy_bool_t args_ok = XSBind_allot_params(
         &(ST(0)), 1, items, "Lucy::Object::I32Array::new_PARAMS",
-        &ints_sv, "ints", 4,
+        ALLOT_SV(&ints_sv, "ints", 4, true),
         NULL);
     if (!args_ok) {
         CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
     }
-    if (XSBind_sv_defined(ints_sv) && SvROK(ints_sv)) {
+
+    AV *ints_av = NULL;
+    if (SvROK(ints_sv)) {
         ints_av = (AV*)SvRV(ints_sv);
     }
-
     if (ints_av && SvTYPE(ints_av) == SVt_PVAV) {
         int32_t size  = av_len(ints_av) + 1;
         int32_t *ints = (int32_t*)LUCY_MALLOCATE(size * sizeof(int32_t));

Modified: incubator/lucy/trunk/perl/xs/XSBind.c
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/xs/XSBind.c?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/xs/XSBind.c (original)
+++ incubator/lucy/trunk/perl/xs/XSBind.c Tue Jan 18 16:33:47 2011
@@ -371,14 +371,119 @@ XSBind_enable_overload(void *pobj)
     SvAMAGIC_on(perl_obj);
 }
 
+static chy_bool_t
+S_extract_from_sv(SV *value, void *target, const char *label, int label_len,
+                  chy_bool_t required, int type, cfish_VTable *vtable, 
+                  void *allocation)
+{
+    chy_bool_t valid_assignment = false;
+
+    if (XSBind_sv_defined(value)) {
+        switch (type) {
+            case XSBIND_WANT_I8:
+                *((int8_t*)target) = (int8_t)SvIV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_I16:
+                *((int16_t*)target) = (int16_t)SvIV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_I32:
+                *((int32_t*)target) = (int32_t)SvIV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_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 XSBIND_WANT_U8:
+                *((uint8_t*)target) = (uint8_t)SvUV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_U16:
+                *((uint16_t*)target) = (uint16_t)SvUV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_U32:
+                *((uint32_t*)target) = (uint32_t)SvUV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_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 XSBIND_WANT_BOOL:
+                *((chy_bool_t*)target) = !!SvTRUE(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_F32:
+                *((float*)target) = (float)SvNV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_F64:
+                *((double*)target) = SvNV(value);
+                valid_assignment = true;
+                break;
+            case XSBIND_WANT_OBJ: {
+                    cfish_Obj *object = XSBind_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 XSBIND_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
 XSBind_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);
-    SV **target;
-    int32_t i;
     int32_t args_left = (num_stack_elems - start) / 2;
 
     // Retrieve the params hash, which must be a package global. 
@@ -400,7 +505,7 @@ XSBind_allot_params(SV** stack, int32_t 
     }
 
     // Validate param names. 
-    for (i = start; i < num_stack_elems; i += 2) {
+    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 
@@ -412,24 +517,44 @@ XSBind_allot_params(SV** stack, int32_t 
         }
     }
 
+    void *target;
     va_start(args, params_hash_name); 
-    while (args_left && NULL != (target = va_arg(args, SV**))) {
-        char *label = va_arg(args, char*);
-        int label_len = va_arg(args, int);
+    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.
-        for (i = num_stack_elems; i >= start + 2; i -= 2) {
+        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) {
-                    *target = stack[tick + 1];
+                    SV *value = stack[tick + 1];
+                    got_arg = S_extract_from_sv(value, target, label, 
+                        label_len, 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);
 

Modified: incubator/lucy/trunk/perl/xs/XSBind.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/xs/XSBind.h?rev=1060453&r1=1060452&r2=1060453&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/xs/XSBind.h (original)
+++ incubator/lucy/trunk/perl/xs/XSBind.h Tue Jan 18 16:33:47 2011
@@ -144,19 +144,57 @@ cfish_XSBind_cb_to_sv(const cfish_CharBu
 void
 cfish_XSBind_enable_overload(void *pobj);
 
-/** Process hash-style params passed to an XS subroutine.  The varargs must
- * come batched in groups of three: an SV**, the name of the parameter, and
- * length of the paramter name.  A NULL pointer terminates the list:
+/** Process hash-style params passed to an XS subroutine.  The varargs must be
+ * a NULL-terminated series of ALLOT_ macros.
  *
  *     cfish_XSBind_allot_params(stack, start, num_stack_elems, 
  *         "Lucy::Search::TermQuery::new_PARAMS", 
- *          &field_sv, "field", 5,
- *          &term_sv, "term", 4,
+ *          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:
  *
- * All labeled params found on the stack will be assigned to the appropriate
- * SV**.
- *
+ *     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.
@@ -171,7 +209,88 @@ cfish_XSBind_allot_params(SV** stack, in
                           int32_t num_stack_elems, 
                           char* params_hash_name, ...);
 
-/* Define short names for all the functions in this file.  Note that these
+#define XSBIND_WANT_I8       0x1
+#define XSBIND_WANT_I16      0x2
+#define XSBIND_WANT_I32      0x3
+#define XSBIND_WANT_I64      0x4
+#define XSBIND_WANT_U8       0x5
+#define XSBIND_WANT_U16      0x6
+#define XSBIND_WANT_U32      0x7
+#define XSBIND_WANT_U64      0x8
+#define XSBIND_WANT_BOOL     0x9
+#define XSBIND_WANT_F32      0xA
+#define XSBIND_WANT_F64      0xB
+#define XSBIND_WANT_OBJ      0xC 
+#define XSBIND_WANT_SV       0xD 
+
+#if (CHY_SIZEOF_CHAR == 1)
+  #define XSBIND_WANT_CHAR XSBIND_WANT_I8
+#else
+  #error Can't build unless sizeof(char) == 1
+#endif
+
+#if (CHY_SIZEOF_SHORT == 2)
+  #define XSBIND_WANT_SHORT XSBIND_WANT_I16
+#else
+  #error Can't build unless sizeof(short) == 2
+#endif
+
+#if (CHY_SIZEOF_INT == 4)
+  #define XSBIND_WANT_INT XSBIND_WANT_I32
+#else // sizeof(int) == 8
+  #define XSBIND_WANT_INT XSBIND_WANT_I64
+#endif
+
+#if (CHY_SIZEOF_LONG == 4)
+  #define XSBIND_WANT_LONG XSBIND_WANT_I32
+#else // sizeof(long) == 8
+  #define XSBIND_WANT_LONG XSBIND_WANT_I64
+#endif
+
+#if (CHY_SIZEOF_SIZE_T == 4)
+  #define XSBIND_WANT_SIZE_T XSBIND_WANT_U32
+#else // sizeof(long) == 8
+  #define XSBIND_WANT_SIZE_T XSBIND_WANT_U64
+#endif
+
+#define XSBIND_ALLOT_I8(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_I8, NULL, NULL
+#define XSBIND_ALLOT_I16(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_I16, NULL, NULL
+#define XSBIND_ALLOT_I32(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_I32, NULL, NULL
+#define XSBIND_ALLOT_I64(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_I64, NULL, NULL
+#define XSBIND_ALLOT_U8(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_U8, NULL, NULL
+#define XSBIND_ALLOT_U16(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_U16, NULL, NULL
+#define XSBIND_ALLOT_U32(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_U32, NULL, NULL
+#define XSBIND_ALLOT_U64(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_U64, NULL, NULL
+#define XSBIND_ALLOT_BOOL(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_BOOL, NULL, NULL
+#define XSBIND_ALLOT_CHAR(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_CHAR, NULL, NULL
+#define XSBIND_ALLOT_SHORT(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_SHORT, NULL, NULL
+#define XSBIND_ALLOT_INT(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_INT, NULL, NULL
+#define XSBIND_ALLOT_LONG(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_LONG, NULL, NULL
+#define XSBIND_ALLOT_SIZE_T(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_SIZE_T, NULL, NULL
+#define XSBIND_ALLOT_F32(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_F32, NULL, NULL
+#define XSBIND_ALLOT_F64(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_WANT_F64, NULL, NULL
+#define XSBIND_ALLOT_OBJ(ptr, key, keylen, required, vtable, allocation) \
+    ptr, key, keylen, required, XSBIND_WANT_OBJ, vtable, allocation
+#define XSBIND_ALLOT_SV(ptr, key, keylen, required) \
+    ptr, key, keylen, required, XSBIND_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
@@ -189,6 +308,24 @@ cfish_XSBind_allot_params(SV** stack, in
 #define XSBind_cb_to_sv                cfish_XSBind_cb_to_sv
 #define XSBind_enable_overload         cfish_XSBind_enable_overload
 #define XSBind_allot_params            cfish_XSBind_allot_params
+#define ALLOT_I8                       XSBIND_ALLOT_I8
+#define ALLOT_I16                      XSBIND_ALLOT_I16
+#define ALLOT_I32                      XSBIND_ALLOT_I32 
+#define ALLOT_I64                      XSBIND_ALLOT_I64
+#define ALLOT_U8                       XSBIND_ALLOT_U8
+#define ALLOT_U16                      XSBIND_ALLOT_U16
+#define ALLOT_U32                      XSBIND_ALLOT_U32 
+#define ALLOT_U64                      XSBIND_ALLOT_U64
+#define ALLOT_BOOL                     XSBIND_ALLOT_BOOL
+#define ALLOT_CHAR                     XSBIND_ALLOT_CHAR
+#define ALLOT_SHORT                    XSBIND_ALLOT_SHORT
+#define ALLOT_INT                      XSBIND_ALLOT_INT
+#define ALLOT_LONG                     XSBIND_ALLOT_LONG
+#define ALLOT_SIZE_T                   XSBIND_ALLOT_SIZE_T
+#define ALLOT_F32                      XSBIND_ALLOT_F32 
+#define ALLOT_F64                      XSBIND_ALLOT_F64
+#define ALLOT_OBJ                      XSBIND_ALLOT_OBJ
+#define ALLOT_SV                       XSBIND_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



Mime
View raw message