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/22 07:58:27 UTC
[lucy-commits] svn commit: r1149471 - in /incubator/lucy/trunk/clownfish: lib/Clownfish.xs
lib/Clownfish/Binding/Perl/Subroutine.pm src/CFCPerlSub.c src/CFCPerlSub.h
Author: marvin
Date: Fri Jul 22 05:58:26 2011
New Revision: 1149471
URL: http://svn.apache.org/viewvc?rev=1149471&view=rev
Log:
Port build_allot_params() to C.
Modified:
incubator/lucy/trunk/clownfish/lib/Clownfish.xs
incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm
incubator/lucy/trunk/clownfish/src/CFCPerlSub.c
incubator/lucy/trunk/clownfish/src/CFCPerlSub.h
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish.xs
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish.xs?rev=1149471&r1=1149470&r2=1149471&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish.xs (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish.xs Fri Jul 22 05:58:26 2011
@@ -1921,3 +1921,10 @@ CODE:
RETVAL = S_sv_eat_c_string(CFCPerlSub_params_hash_def(self));
OUTPUT: RETVAL
+SV*
+build_allot_params(self)
+ CFCPerlSub *self;
+CODE:
+ RETVAL = S_sv_eat_c_string(CFCPerlSub_build_allot_params(self));
+OUTPUT: RETVAL
+
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=1149471&r1=1149470&r2=1149471&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Subroutine.pm Fri Jul 22 05:58:26 2011
@@ -46,92 +46,6 @@ sub new {
@args{qw( param_list class_name alias use_labeled_params )} );
}
-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)|;
- }
- }
- 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->get_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" }
1;
Modified: incubator/lucy/trunk/clownfish/src/CFCPerlSub.c
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCPerlSub.c?rev=1149471&r1=1149470&r2=1149471&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCPerlSub.c (original)
+++ incubator/lucy/trunk/clownfish/src/CFCPerlSub.c Fri Jul 22 05:58:26 2011
@@ -15,12 +15,19 @@
*/
#include <string.h>
+#include <stdio.h>
#define CFC_NEED_BASE_STRUCT_DEF
#include "CFCBase.h"
#include "CFCPerlSub.h"
#include "CFCUtil.h"
#include "CFCParamList.h"
#include "CFCVariable.h"
+#include "CFCType.h"
+
+#ifndef true
+ #define true 1
+ #define false 0
+#endif
struct CFCPerlSub {
CFCBase base;
@@ -124,6 +131,138 @@ CFCPerlSub_params_hash_def(CFCPerlSub *s
return def;
}
+struct allot_macro_map {
+ char *prim_type;
+ char *allot_macro;
+};
+
+struct allot_macro_map 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" },
+ { NULL, NULL }
+};
+
+static char*
+S_allot_params_arg(CFCType *type, const char *label, int required) {
+ const char *type_c_string = CFCType_to_c(type);
+ unsigned label_len = strlen(label);
+ const char *req_string = required ? "true" : "false";
+
+ if (CFCType_is_object(type)) {
+ const char *struct_sym = CFCType_get_specifier(type);
+ const char *vtable_var = CFCType_get_vtable_var(type);
+
+ // Share buffers rather than copy between Perl scalars and Clownfish
+ // string types.
+ int use_sv_buffer = false;
+ 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
+ ) {
+ use_sv_buffer = true;
+ }
+ const char *zcb_allocation = use_sv_buffer
+ ? "alloca(cfish_ZCB_size())"
+ : "NULL";
+ const char pattern[] = "ALLOT_OBJ(&%s, \"%s\", %u, %s, %s, %s)";
+ size_t size = sizeof(pattern)
+ + label_len * 2
+ + 20
+ + 5
+ + strlen(vtable_var)
+ + strlen(zcb_allocation)
+ + 50;
+ char *arg = MALLOCATE(size);
+ sprintf(arg, pattern, label, label, label_len, req_string, vtable_var,
+ zcb_allocation);
+ return arg;
+ }
+ else if (CFCType_is_primitive(type)) {
+ for (int i = 0; prim_type_to_allot_macro[i].prim_type != NULL; i++) {
+ const char *prim_type = prim_type_to_allot_macro[i].prim_type;
+ if (strcmp(prim_type, type_c_string) == 0) {
+ const char *allot = prim_type_to_allot_macro[i].allot_macro;
+ char pattern[] = "%s(&%s, \"%s\", %u, %s)";
+ size_t size = sizeof(pattern)
+ + strlen(allot)
+ + label_len * 2
+ + 20
+ + 5
+ + 20; // extra
+ char *arg = (char*)MALLOCATE(size);
+ sprintf(arg, pattern, allot, label, label, label_len,
+ req_string);
+ return arg;
+ }
+ }
+ }
+
+ CFCUtil_die("Missing typemap for %s", type_c_string);
+}
+
+char*
+CFCPerlSub_build_allot_params(CFCPerlSub *self) {
+ CFCParamList *param_list = self->param_list;
+ CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
+ const char **arg_inits = CFCParamList_get_initial_values(param_list);
+ size_t num_vars = CFCParamList_num_vars(param_list);
+ char *allot_params = CFCUtil_strdup("");
+
+ // Declare variables and assign default values.
+ for (int i = 1; i < num_vars; i++) {
+ CFCVariable *arg_var = arg_vars[i];
+ const char *val = arg_inits[i];
+ const char *local_c = CFCVariable_local_c(arg_var);
+ if (val == NULL) {
+ CFCType *arg_type = CFCVariable_get_type(arg_var);
+ val = CFCType_is_object(arg_type)
+ ? "NULL"
+ : "0";
+ allot_params = CFCUtil_cat(allot_params, local_c, " = ", val,
+ ";\n ", NULL);
+ }
+ }
+
+ // Iterate over args in param list.
+ allot_params
+ = CFCUtil_cat(allot_params,
+ "chy_bool_t args_ok = XSBind_allot_params(\n"
+ " &(ST(0)), 1, items, \"",
+ self->perl_name, "_PARAMS\",\n", NULL);
+ for (int i = 1; i < num_vars; i++) {
+ CFCVariable *var = arg_vars[i];
+ const char *val = arg_inits[i];
+ int required = val ? 0 : 1;
+ const char *name = CFCVariable_micro_sym(var);
+ CFCType *type = CFCVariable_get_type(var);
+ char *arg = S_allot_params_arg(type, name, required);
+ allot_params
+ = CFCUtil_cat(allot_params, " ", arg, ",\n", NULL);
+ FREEMEM(arg);
+ }
+ allot_params
+ = CFCUtil_cat(allot_params, " NULL);\n",
+ " if (!args_ok) {\n"
+ " CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));\n"
+ " }\n", NULL);
+
+ return allot_params;
+}
+
CFCParamList*
CFCPerlSub_get_param_list(CFCPerlSub *self) {
return self->param_list;
Modified: incubator/lucy/trunk/clownfish/src/CFCPerlSub.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCPerlSub.h?rev=1149471&r1=1149470&r2=1149471&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCPerlSub.h (original)
+++ incubator/lucy/trunk/clownfish/src/CFCPerlSub.h Fri Jul 22 05:58:26 2011
@@ -23,6 +23,7 @@ extern "C" {
typedef struct CFCPerlSub CFCPerlSub;
struct CFCParamList;
+struct CFCType;
CFCPerlSub*
CFCPerlSub_new(const char *klass, struct CFCParamList *param_list,
@@ -40,6 +41,9 @@ CFCPerlSub_destroy(CFCPerlSub *self);
char*
CFCPerlSub_params_hash_def(CFCPerlSub *self);
+char*
+CFCPerlSub_build_allot_params(CFCPerlSub *self);
+
struct CFCParamList*
CFCPerlSub_get_param_list(CFCPerlSub *self);