[svn:parrot] r48554 - in branches/gsoc_nci: config/auto config/auto/libffi config/gen config/gen/libffi lib/Parrot/Configure/Options lib/Parrot/Configure/Step src/pmc t/steps/auto t/steps/gen tools/dev
ash at svn.parrot.org
ash at svn.parrot.org
Tue Aug 17 18:47:31 UTC 2010
Author: ash
Date: Tue Aug 17 18:47:31 2010
New Revision: 48554
URL: https://trac.parrot.org/parrot/changeset/48554
Log:
GSoC: The majority of my NCI changes in 1 commit.
Added:
branches/gsoc_nci/config/auto/libffi/
branches/gsoc_nci/config/auto/libffi.pm
branches/gsoc_nci/config/auto/libffi/test_c.in
branches/gsoc_nci/config/gen/libffi/
branches/gsoc_nci/config/gen/libffi.pm
branches/gsoc_nci/config/gen/libffi/nci-ffi.pmc.in
branches/gsoc_nci/config/gen/libffi/nci.pmc.in
- copied, changed from r48552, branches/gsoc_nci/src/pmc/nci.pmc
branches/gsoc_nci/t/steps/auto/libffi-01.t
branches/gsoc_nci/t/steps/gen/libffi-01.t
branches/gsoc_nci/tools/dev/nci_thunk_gen.nqp
Modified:
branches/gsoc_nci/lib/Parrot/Configure/Options/Conf.pm
branches/gsoc_nci/lib/Parrot/Configure/Step/List.pm
branches/gsoc_nci/src/pmc/nci.pmc
Added: branches/gsoc_nci/config/auto/libffi.pm
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/config/auto/libffi.pm Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,121 @@
+# Copyright (C) 2005-2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+config/auto/libffi - Check whether libffi
+
+=head1 DESCRIPTION
+
+=cut
+
+package auto::libffi;
+
+use strict;
+use warnings;
+
+use base qw(Parrot::Configure::Step);
+
+use Parrot::Configure::Utils ':auto';
+
+sub _init {
+ my $self = shift;
+ my %data;
+ $data{description} = q{Is libffi installed};
+ $data{result} = q{};
+ return \%data;
+}
+
+my @pkgconfig_variations =
+ defined( $ENV{TEST_PKGCONFIG} )
+ ? @{ $ENV{TEST_PKGCONFIG} }
+ : qw( pkg-config );
+
+sub runstep {
+ my ( $self, $conf ) = @_;
+
+ my ( $verbose, $without ) = $conf->options->get(
+ qw|
+ verbose
+ without-libffi
+ |
+ );
+
+ if ($without) {
+ $conf->data->set( HAS_LIBFFI => 0 );
+ $self->set_result('no');
+ return 1;
+ }
+
+ my $osname = $conf->data->get('osname');
+ print "\n" if $verbose;
+ my $pkgconfig_exec = check_progs([ @pkgconfig_variations ], $verbose);
+
+ my $libffi_options_cflags = '';
+ my $libffi_options_libs = '';
+ my $libffi_options_linkflags = '';
+
+ if ($pkgconfig_exec) {
+ $libffi_options_linkflags = capture_output($pkgconfig_exec, 'libffi --libs-only-L');
+ chomp $libffi_options_linkflags;
+ $libffi_options_libs = capture_output($pkgconfig_exec, 'libffi --libs-only-l');
+ chomp $libffi_options_libs;
+ $libffi_options_cflags = capture_output($pkgconfig_exec, 'libffi --cflags');
+ chomp $libffi_options_cflags;
+ }
+
+ my $extra_libs = $self->_select_lib( {
+ conf => $conf,
+ osname => $osname,
+ cc => $conf->data->get('cc'),
+ default => $libffi_options_libs . ' ' . $libffi_options_cflags,
+ } );
+
+ $conf->cc_gen('config/auto/libffi/test_c.in');
+ eval { $conf->cc_build( $libffi_options_cflags, $libffi_options_libs ) };
+ my $has_libffi = 0;
+ if ( !$@ ) {
+ my $test = $conf->cc_run();
+ $has_libffi = _evaluate_cc_run($test, $verbose);
+ }
+ $conf->cc_clean();
+
+ if ($has_libffi) {
+ $conf->data->set( HAS_LIBFFI => $has_libffi);
+ $conf->data->add( ' ', ccflags => $libffi_options_cflags );
+ $conf->data->add( ' ', libs => $libffi_options_libs );
+ $conf->data->add( ' ', linkflags => $libffi_options_linkflags );
+ $self->set_result('yes');
+ if ($verbose) {
+ print 'libffi cflags: ', $libffi_options_cflags, "libffi libs: ", $libffi_options_libs, "\n";
+ }
+ }
+ else {
+ $conf->data->set( HAS_LIBFFI => 0 );
+ $self->set_result('no');
+ print "No libffi found." if ($verbose);
+ }
+
+ return 1;
+}
+
+sub _evaluate_cc_run {
+ my ($output, $verbose) = @_;
+ my $has_libffi = ( $output =~ m/libffi worked/ ) ? 1 : 0;
+ return $has_libffi;
+}
+
+1;
+
+=head1 AUTHOR
+
+John Harrison <ash.gti at gmail dot com>
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: branches/gsoc_nci/config/auto/libffi/test_c.in
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/config/auto/libffi/test_c.in Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,37 @@
+/*
+Copyright (C) 2008-2010, Parrot Foundation.
+$Id$
+
+seeing if libffi is installed
+*/
+
+#include <stdio.h>
+#include <ffi.h>
+
+int main() {
+ ffi_cif cif;
+ ffi_type *args[1];
+ void *values[1];
+ char *s;
+ int rc;
+
+ /* Initialize the argument info vectors */
+ args[0] = &ffi_type_pointer;
+ values[0] = &s;
+
+ /* Initialize the cif */
+ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1,
+ &ffi_type_uint, args) == FFI_OK) {
+ s = "libffi worked";
+ ffi_call(&cif, FFI_FN(puts), &rc, values);
+ }
+
+ return 0;
+}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Added: branches/gsoc_nci/config/gen/libffi.pm
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/config/gen/libffi.pm Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,55 @@
+# Copyright (C) 2001-2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+config/gen/libffi.pm - Libffi Files
+
+=head1 DESCRIPTION
+
+Moves the appropriate nci files into place.
+
+=cut
+
+package gen::libffi;
+
+use strict;
+use warnings;
+
+use base qw(Parrot::Configure::Step);
+
+use Parrot::Configure::Utils ':gen';
+
+sub _init {
+ my $self = shift;
+ my %data;
+
+ $data{description} = q{Moving approriate NCI files into place};
+
+ return \%data;
+}
+
+sub runstep {
+ my ( $self, $conf ) = @_;
+
+ my $nci_file = 'config/gen/libffi/nci.pmc.in';
+ if ( $conf->data->get("HAS_LIBFFI") ) {
+ $nci_file = 'config/gen/libffi/nci-ffi.pmc.in';
+ }
+ else {
+ }
+
+ copy_if_diff( $nci_file, "src/pmc/nci.pmc" );
+
+ return 1;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Added: branches/gsoc_nci/config/gen/libffi/nci-ffi.pmc.in
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/config/gen/libffi/nci-ffi.pmc.in Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,1503 @@
+/*
+Copyright (C) 2001-2010, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/nci.pmc - Native Call Interface
+
+=head1 DESCRIPTION
+
+The vtable functions for the native C call functions.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+/* Cheat with this include, for whatever reason the space is required */
+# include "ffi.h"
+
+/* HEADERIZER HFILE: none */
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_IGNORABLE_RESULT
+static nci_thunk_t /*@alt void@*/
+build_func(PARROT_INTERP,
+ ARGMOD(Parrot_NCI_attributes *nci_info))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*nci_info);
+
+static void pcc_params(PARROT_INTERP,
+ ARGIN(STRING *sig),
+ ARGMOD(Parrot_NCI_attributes *nci_info),
+ size_t sig_length)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*nci_info);
+
+#define ASSERT_ARGS_build_func __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(nci_info))
+#define ASSERT_ARGS_pcc_params __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sig) \
+ , PARROT_ASSERT_ARG(nci_info))
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+static
+INTVAL
+parse_sig(PARROT_INTERP, STRING *sig, size_t sig_length, Parrot_NCI_attributes *nci_info);
+
+static
+size_t
+parse_return(PARROT_INTERP, STRING* sig, size_t sig_length,
+ Parrot_NCI_attributes * nci_info, ffi_type **return_type);
+
+static
+size_t
+parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types);
+
+static
+size_t
+parse_identifier(PARROT_INTERP,
+ STRING* sig, size_t start, size_t end,
+ ffi_type** sig_obj,
+ char* pmc_type, size_t *pmc_count,
+ char* translation, size_t *translation_length);
+
+static
+size_t
+parse_structure(PARROT_INTERP, STRING* sig, size_t start, size_t end,
+ ffi_type** sig_obj, char* pmc_type);
+
+static
+INTVAL
+parse_prefix(INTVAL c);
+
+static
+size_t
+structure_length(PARROT_INTERP, STRING* sig, size_t start, size_t end);
+
+static
+size_t
+count_args(PARROT_INTERP, STRING* sig, size_t start, size_t end);
+
+static
+size_t
+find_matching(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ INTVAL start_character, INTVAL end_character);
+
+#define IS_DIGIT(x) (((x) == '0') || ((x) == '1') || ((x) == '2') || ((x) == '3') \
+ || ((x) == '4') || ((x) == '5') || ((x) == '6') || ((x) == '7') \
+ || ((x) == '8') || ((x) == '9'))
+
+#define IS_PREFIX(x) (((x) == '*') || ((x) == 'u'))
+
+#define IS_OLD_TYPE(x) (((x) == 'P') || ((x) == 'J') || ((x) == 'N') || ((x) == 'S') \
+ || ((x) == 'O') || ((x) == '@') || ((x) == 'B') || ((x) == 'p') \
+ || ((x) == '2') || ((x) == '3') || ((x) == '4') || ((x) == 'U') \
+ || ((x) == 'V'))
+
+#define IS_TYPE(x) (((x) == 'i') || ((x) == 'v') || ((x) == 'l') || ((x) == 't') \
+ || ((x) == 'c') || ((x) == 'b') || ((x) == 'f') || ((x) == 'd') \
+ || ((x) == 's') || IS_OLD_TYPE(x))
+
+#define IS_POSTFIX(x) ((x) == '{') /* || IS_DIGIT(x)) */
+#define IS_INFIX(x) ((x) == '|')
+#define IS_START_CIRCUMFIX(x) ((x) == '(')
+#define IS_END_CIRCUMFIX(x) ((x) == ')')
+#define IS_NOT_END_CIRCUMFIX(x) ((x) != ')')
+
+#define PREFIX_POINTER (1<<0)
+#define PREFIX_SIGNED ( 0)
+#define PREFIX_UNSIGNED (1<<1)
+#define PREFIX_NATIVE (1<<2)
+
+typedef struct pmc_holder_t {
+ PMC* p;
+ union {
+ INTVAL* ival;
+ void** pval;
+ };
+} pmc_holder_t;
+
+/*
+
+=item C<static INTVAL parse_sig(PARROT_INTERP, STRING *sig,
+ size_t sig_length, Parrot_NCI_attributes *nci_info)>
+
+Parse a full signature. All signatures should contain a return type and a list of
+arguments. "vv" Would be the shortest "void fn(void)" signature you can legally make.
+
+See C<parse_return> and C<parse_args> to see how the signature is broken down.
+
+=cut
+
+*/
+
+static INTVAL
+parse_sig(PARROT_INTERP, STRING *sig, size_t sig_length, Parrot_NCI_attributes *nci_info) {
+ ffi_cif cif;
+ ffi_type *return_type;
+ ffi_type **arg_types;
+
+ if (sig_length) {
+ size_t i = parse_return(interp, sig, sig_length, nci_info, &return_type);
+ if (i < sig_length)
+ parse_args(interp, sig, i, sig_length, nci_info, &arg_types);
+ else {
+ arg_types = mem_internal_allocate_n_zeroed_typed(1, ffi_type*);
+ arg_types[0] = &ffi_type_void;
+ nci_info->pcc_params_signature = string_make(interp, "", 1, NULL, 0);
+ nci_info->arg_translation = NULL;
+ nci_info->arity = 0;
+ }
+ }
+ else {
+ arg_types = mem_internal_allocate_n_zeroed_typed(1, ffi_type*);
+ arg_types[0] = &ffi_type_void;
+ return_type = &ffi_type_void;
+ nci_info->pcc_params_signature = string_make(interp, "", 1, NULL, 0);
+ nci_info->arg_translation = NULL;
+ nci_info->arity = 0;
+ }
+
+ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI,
+ nci_info->arity, return_type, arg_types) == FFI_OK) {
+ nci_info->cif = (void*)mem_internal_allocate_typed(ffi_cif);
+ memcpy(nci_info->cif, &cif, sizeof (ffi_cif));
+ nci_info->arg_types = arg_types;
+
+ return 1;
+ }
+
+ if (arg_types) {
+ mem_sys_free(arg_types);
+ }
+
+ /* TODO: Throw Error here. */
+ printf("Bad signature\n");
+
+ return 0;
+}
+
+/*
+
+=item C<static size_t parse_return(PARROT_INTERP, STRING *sig, size_t sig_length,
+ Parrot_NCI_attributes* nci_info, ffi_type **return_type)>
+
+Parses the return type. This assumes the first identifier is the return type.
+
+See C<parse_identifier> to see how a single identifer is parsed.
+
+=cut
+
+*/
+
+static size_t
+parse_return(PARROT_INTERP, STRING *sig, size_t sig_length,
+ Parrot_NCI_attributes* nci_info, ffi_type **return_type) {
+ char *t = mem_allocate_n_zeroed_typed(2, char);
+ size_t j = 0, k = 0;
+ /* Should be 1 character plus a NULL" */
+ char * result_sig = mem_allocate_n_zeroed_typed(2, char);
+ size_t result_length = parse_identifier(interp,
+ sig, 0, sig_length,
+ return_type,
+ result_sig, &j,
+ t, &k);
+
+ nci_info->pcc_return_signature = string_make(interp, result_sig, 2, NULL, 0);
+ nci_info->return_translation = (void*)t;
+ mem_sys_free(result_sig);
+ return result_length;
+}
+
+/*
+
+=item C<static size_t parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types)>
+
+Parses the signatures arguments. It takes an offset to know where to start looking.
+This should fill out a list of C<ffi_type*> args.
+
+See C<parse_identifier> to see how a single identifer is parsed.
+
+=cut
+
+*/
+
+static size_t
+parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types) {
+ size_t i = start;
+ size_t arg_count = 0;
+ size_t argc = count_args(interp, sig, start, sig_length);
+ char* parrot_types = mem_allocate_n_zeroed_typed(argc + 1, char);
+ size_t parrot_types_length = 0;
+ char* translation_types = mem_allocate_n_zeroed_typed(argc + 1, char);
+ size_t translation_length = 0;
+
+ *arg_types = mem_internal_allocate_n_zeroed_typed(argc + 1, ffi_type*);
+
+ while (i < sig_length) {
+ ffi_type *ident;
+ i = parse_identifier(interp,
+ sig, i, sig_length,
+ &ident,
+ parrot_types, &parrot_types_length,
+ translation_types, &translation_length);
+ (*arg_types)[arg_count] = ident;
+ arg_count++;
+ }
+
+ nci_info->pcc_params_signature = string_make(interp, parrot_types,
+ strlen(parrot_types), NULL, 0);
+ nci_info->arg_translation = translation_types;
+ nci_info->arity = arg_count;
+
+ mem_sys_free(parrot_types);
+
+ return i;
+}
+
+/*
+
+=item C<static size_t parse_identifier(PARROT_INTERP, STRING *sig, size_t start,
+ size_t sig_length, ffi_type **type_obj,
+ char **type, size_t *pmc_count,
+ char **translation, size_t *translation_count)>
+
+Parse an identifier and build its representation used for PCC and any translations
+that are needed.
+
+An example of a transation is "t", it will take a STRING* and convert it to a
+char* for the function call.
+
+=cut
+
+*/
+
+static size_t
+parse_identifier(PARROT_INTERP,
+ STRING *sig, size_t start, size_t sig_length,
+ ffi_type **type_obj,
+ char *type, size_t *pmc_count,
+ char *translation, size_t *translation_count) {
+ size_t i = start;
+ INTVAL done = 0;
+
+ while (!done && i < sig_length) {
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ int prefix = 0;
+ while (IS_PREFIX(c)) {
+ prefix |= parse_prefix(c);
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+
+ if (IS_START_CIRCUMFIX(c)) {
+ i = parse_structure(interp, sig, i + 1, sig_length, type_obj, type);
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+ else if (IS_TYPE(c)) {
+ if (prefix & PREFIX_POINTER) {
+ *type_obj = &ffi_type_pointer;
+ continue;
+ }
+ translation[(*translation_count)++] = ' ';
+ switch (c) {
+ case (INTVAL)' ':
+ case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */
+ break;
+ case (INTVAL)'c':
+ translation[(*translation_count) - 1] = 'c';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uchar;
+ }
+ else {
+ *type_obj = &ffi_type_schar;
+ }
+ break;
+ case (INTVAL)'B':
+ translation[(*translation_count) - 1] = 'B';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'b':
+ translation[(*translation_count) - 1] = 'b';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'s':
+ translation[(*translation_count) - 1] = 's';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_ushort;
+ }
+ else {
+ *type_obj = &ffi_type_sshort;
+ }
+ break;
+ case (INTVAL)'I': /* INTVAL */
+ case (INTVAL)'i':
+ translation[(*translation_count) - 1] = 'i';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uint;
+ }
+ else {
+ *type_obj = &ffi_type_sint;
+ }
+ break;
+ case (INTVAL)'l':
+ translation[(*translation_count) - 1] = 'l';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_ulong;
+ }
+ else {
+ *type_obj = &ffi_type_slong;
+ }
+ break;
+ case (INTVAL)'q':
+ translation[(*translation_count) - 1] = 'q';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uint64;
+ }
+ else {
+ *type_obj = &ffi_type_sint64;
+ }
+ break;
+ case (INTVAL)'J': /* interpreter */
+ translation[(*translation_count) - 1] = 'J';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'p': /* push pmc->data */
+ translation[(*translation_count) - 1] = 'p';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'2':
+ translation[(*translation_count) - 1] = '2';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'3':
+ translation[(*translation_count) - 1] = '3';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'4':
+ translation[(*translation_count) - 1] = '4';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'P': /* push PMC * */
+ translation[(*translation_count) - 1] = 'P';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'V': /* push PMC * */
+ translation[(*translation_count) - 1] = 'V';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'S':
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ case (INTVAL)'t':
+ translation[(*translation_count) - 1] = 't';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'v':
+ type[(*pmc_count)++] = 'v';
+ *type_obj = &ffi_type_void;
+ break;
+#if (DOUBLE_SIZE == 4) /* FLOATVAL is a float */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'f':
+ translation[(*translation_count) - 1] = 'f';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_float;
+ break;
+#if (DOUBLE_SIZE == 8) /* FLOATVAL is a double */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'d':
+ translation[(*translation_count) - 1] = 'd';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_double;
+ break;
+#if (DOUBLE_SIZE > 8) /* FLOATVAL is a long double */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'D':
+ translation[(*translation_count) - 1] = 'D';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_longdouble;
+ break;
+ case (INTVAL)'O': /* push PMC * invocant */
+ *type_obj = &ffi_type_pointer;
+ type[(*pmc_count)++] = 'P';
+ type[(*pmc_count)++] = 'i';
+ break;
+ case (INTVAL)'@': /* push PMC * slurpy */
+ *type_obj = &ffi_type_pointer;
+ type[(*pmc_count)++] = 'P';
+ type[(*pmc_count)++] = 's';
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ break;
+ }
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+ else {
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ }
+
+ /*
+ * Parse postfix ops
+ * TODO: Parse postfix ops, currently I skip them.
+ */
+ while (IS_POSTFIX(c)) {
+ i++;
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+
+ if ((i < sig_length) && (c == (INTVAL)'|')) {
+ /* Its a union, parse it special. */
+ }
+ else {
+ done = 1;
+ }
+ }
+
+ return i;
+}
+
+/*
+
+=item C<static INTVAL parse_prefix(INTVAL c)>
+
+Parse a prefix character.
+
+=cut
+
+*/
+
+static INTVAL
+parse_prefix(INTVAL c) {
+ switch (c) {
+ case '*':
+ return PREFIX_POINTER;
+ break;
+ case 'u':
+ return PREFIX_UNSIGNED;
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ return 0;
+}
+
+/*
+
+=item C<static size_t parse_structure(PARROT_INTERP, STRING* sig, size_t start,
+ size_t sig_length, ffi_type **type_obj, char* pmc_type)>
+
+Parses a stucture.
+TODO: This should auto inflate to an UnmanagedStruct or a ManagedStruct in the future.
+
+=cut
+
+*/
+
+static size_t
+parse_structure(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ ffi_type **type_obj, char* pmc_type) {
+ size_t i = start;
+ size_t struct_len = structure_length(interp, sig, start, sig_length);
+ size_t element_counter = 0;
+ INTVAL c;
+
+ *type_obj = (ffi_type*)mem_internal_allocate_typed(ffi_type*);
+ (*type_obj)->elements = mem_internal_allocate_n_zeroed_typed(struct_len + 1, ffi_type*);
+
+ (*type_obj)->size = (*type_obj)->alignment = 0;
+ (*type_obj)->type = FFI_TYPE_STRUCT;
+
+ c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && IS_NOT_END_CIRCUMFIX(c)) {
+ i = parse_identifier(interp, sig, i, sig_length,
+ &(*type_obj)->elements[element_counter],
+ NULL, 0, NULL, 0);
+ element_counter++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ (*type_obj)->elements[struct_len] = NULL;
+
+ return i;
+}
+
+/*
+
+=item C<static size_t structure_length(PARROT_INTERP, STRING* sig,
+ size_t start, size_t sig_length)>
+
+Calculates the number of items in a stucture for size purposes.
+
+=cut
+
+*/
+
+static size_t
+structure_length(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length) {
+ size_t len = 0;
+ size_t i = start;
+ INTVAL depth = 0;
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && depth != -1) {
+ if (IS_START_CIRCUMFIX(c)) depth++;
+ else if (IS_END_CIRCUMFIX(c)) depth--;
+ else if (depth == 0 && (IS_TYPE(c))) len++;
+ i++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ return len;
+}
+
+/*
+
+=item C<static size_t find_matching(PARROT_INTERP, STRING* sig, size_t start,
+ size_t sig_length, INTVAL start_character, INTVAL end_character)>
+
+Find matching symbols, used for finding the start and stop of a stucture, it is
+also recursive to handle structures inside of structures.
+
+=cut
+
+*/
+
+static size_t
+find_matching(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ INTVAL start_character, INTVAL end_character) {
+ size_t i = start;
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && c != end_character) {
+ if (c == start_character)
+ i = find_matching(interp, sig, i, sig_length, start_character, end_character);
+ i++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ return i;
+}
+
+/*
+
+=item C<size_t count_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length)>
+
+Counts the number of arguments from a given starting point. It only counts
+identiers, not prefix, infix or postfix modifiers. Structures are considered as
+1 item in most cases.
+
+=cut
+
+*/
+
+static size_t
+count_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length) {
+ size_t length = 0;
+ size_t i = start;
+
+ while (i < sig_length) {
+ const INTVAL c = Parrot_str_indexed(interp, sig, i);
+ if (IS_START_CIRCUMFIX(c)) {
+ i = find_matching(interp, sig, i + 1, sig_length, '(', ')');
+ length++;
+ }
+ else if (IS_TYPE(c)) {
+ length++;
+ }
+ i++;
+ }
+
+ return length;
+}
+
+static void
+pcc_params(PARROT_INTERP, ARGIN(STRING *sig), ARGMOD(Parrot_NCI_attributes *nci_info),
+ size_t sig_length)
+{
+ ASSERT_ARGS(pcc_params)
+
+ /* NCI and PCC have a 1 to 1 mapping except an
+ extra char in PCC for invocant and slurpy */
+ size_t buf_length = sig_length + 2 + 1;
+
+ /* avoid malloc churn on common signatures */
+ char static_buf[16];
+ char * const sig_buf = sig_length <= sizeof static_buf ?
+ static_buf :
+ (char *)mem_sys_allocate(buf_length);
+
+ size_t j = 0;
+ size_t i;
+
+ for (i = 0; i < sig_length; ++i) {
+ const INTVAL c = Parrot_str_indexed(interp, sig, i);
+
+ PARROT_ASSERT(j < buf_length - 1);
+
+ switch (c) {
+ case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */
+ break;
+ case (INTVAL)'f':
+ case (INTVAL)'N':
+ case (INTVAL)'d':
+ sig_buf[j++] = 'N';
+ break;
+ case (INTVAL)'I': /* INTVAL */
+ case (INTVAL)'l': /* long */
+ case (INTVAL)'i': /* int */
+ case (INTVAL)'s': /* short */
+ case (INTVAL)'c': /* char */
+ sig_buf[j++] = 'I';
+ break;
+ case (INTVAL)'S':
+ case (INTVAL)'t': /* string, pass a cstring */
+ sig_buf[j++] = 'S';
+ break;
+ case (INTVAL)'J': /* interpreter */
+ break;
+ case (INTVAL)'p': /* push pmc->data */
+ case (INTVAL)'P': /* push PMC * */
+ case (INTVAL)'V': /* push PMC * */
+ case (INTVAL)'2':
+ case (INTVAL)'3':
+ case (INTVAL)'4':
+ sig_buf[j++] = 'P';
+ break;
+ case (INTVAL)'v':
+ /* null return */
+ if (j == 0)
+ sig_buf[j++] = '\0';
+ break;
+ case (INTVAL)'O': /* push PMC * invocant */
+ sig_buf[j++] = 'P';
+ sig_buf[j++] = 'i';
+ break;
+ case (INTVAL)'@': /* push PMC * slurpy */
+ sig_buf[j++] = 'P';
+ sig_buf[j++] = 's';
+ break;
+ case (INTVAL)'b': /* buffer (void*) pass Buffer_bufstart(SReg) */
+ case (INTVAL)'B': /* buffer (void**) pass &Buffer_bufstart(SReg) */
+ sig_buf[j++] = 'S';
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ break;
+ }
+ }
+
+ PARROT_ASSERT(j < buf_length);
+ sig_buf[j++] = '\0';
+
+
+ nci_info->pcc_return_signature =
+ Parrot_str_new(interp, sig_buf, 1);
+
+ nci_info->pcc_params_signature = j ?
+ Parrot_str_new(interp, sig_buf + 1, j - 1) :
+ CONST_STRING(interp, "");
+
+ if (sig_buf != static_buf)
+ mem_sys_free(sig_buf);
+}
+
+PARROT_IGNORABLE_RESULT
+static ffi_cif*
+build_libffi_func(PARROT_INTERP, ARGMOD(Parrot_NCI_attributes *nci_info))
+{
+ ASSERT_ARGS(build_func)
+
+ STRING * const key = nci_info->signature;
+ const size_t key_length = Parrot_str_byte_length(interp, key);
+
+ INTVAL r = parse_sig(interp, nci_info->signature, key_length, nci_info);
+
+ return (ffi_cif*)nci_info->cif;
+}
+
+/* actually build the NCI thunk */
+
+PARROT_IGNORABLE_RESULT
+static nci_thunk_t
+build_func(PARROT_INTERP, ARGMOD(Parrot_NCI_attributes *nci_info))
+{
+ ASSERT_ARGS(build_func)
+
+ STRING * const key = nci_info->signature;
+ const size_t key_length = Parrot_str_byte_length(interp, key);
+
+ pcc_params(interp, key, nci_info, key_length);
+
+ /* Arity is length of that string minus one (the return type). */
+ nci_info->arity = key_length - 1;
+
+ /* Build call function. */
+ nci_info->fb_info = build_call_func(interp, key);
+ nci_info->func = F2DPTR(VTABLE_get_pointer(interp, nci_info->fb_info));
+
+ return (nci_thunk_t)nci_info->func;
+}
+
+
+pmclass NCI auto_attrs provides invokable {
+ /* NCI thunk handling attributes */
+ /* NCI thunk handling attributes */
+ ATTR STRING *signature; /* The signature. */
+ ATTR void *func; /* Function pointer to call. */
+ ATTR void *orig_func;
+ ATTR PMC *fb_info; /* Frame-builder info */
+ ATTR void *cif; /* Function interface */
+ ATTR void *arg_types; /* Used for building the libffi call interface */
+
+ /* Parrot Sub-ish attributes */
+ ATTR STRING *pcc_params_signature;
+ ATTR STRING *pcc_return_signature;
+ ATTR void *arg_translation;
+ ATTR void *return_translation;
+ ATTR INTVAL arity; /* Cached arity of the NCI. */
+
+ /* MMD fields */
+ ATTR STRING *long_signature; /* The full signature. */
+ ATTR PMC *multi_sig; /* type tuple array (?) */
+
+/*
+
+=item C<METHOD get_multisig()>
+
+Return the MMD signature PMC, if any or a Null PMC.
+
+=cut
+
+*/
+
+ METHOD get_multisig() {
+ PMC *sig;
+ GET_ATTR_multi_sig(INTERP, SELF, sig);
+ if (PMC_IS_NULL(sig))
+ sig = PMCNULL;
+ RETURN(PMC *sig);
+ }
+
+/*
+
+=item C<METHOD set_raw_nci_ptr(void *func)>
+
+Sets the specified function pointer and raw flag.
+
+=cut
+
+*/
+
+ METHOD make_raw_nci(PMC *func) {
+ VTABLE_set_pointer(interp, SELF, (void *)func);
+ }
+
+/*
+
+=item C<void init()>
+
+Initializes the NCI with a C<NULL> function pointer.
+
+=cut
+
+*/
+
+ VTABLE void init() {
+ /* Mark that we're not a raw NCI. */
+ PObj_flag_CLEAR(private2, SELF);
+ PObj_custom_mark_SET(SELF);
+ }
+
+/*
+
+=item C<void set_pointer_keyed_str(STRING *key, void *func)>
+
+Sets the specified function pointer and signature (C<*key>).
+
+=cut
+
+*/
+
+ VTABLE void set_pointer(void *ptr) {
+ SET_ATTR_orig_func(INTERP, SELF, ptr);
+ PObj_flag_SET(private2, SELF);
+ }
+
+ VTABLE void *get_pointer() {
+ return PARROT_NCI(SELF)->orig_func;
+ }
+
+ VTABLE void set_pointer_keyed_str(STRING *key, void *func) {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+
+ /* Store the original function and signature. */
+ SET_ATTR_func(INTERP, SELF, func);
+
+ /* ensure that the STRING signature is constant */
+ if (!PObj_constant_TEST(key)) {
+ char * const key_c = Parrot_str_to_cstring(INTERP, key);
+ const size_t key_length = Parrot_str_byte_length(interp, key);
+ key = string_make(interp, key_c, key_length, NULL, 0);
+ Parrot_str_free_cstring(key_c);
+ }
+
+ nci_info->signature = key;
+ }
+
+/*
+
+=item C<void mark()>
+
+Mark any referenced strings and PMCs.
+
+=cut
+
+*/
+ VTABLE void mark() {
+ if (PARROT_NCI(SELF)) {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+
+ Parrot_gc_mark_PMC_alive(interp, nci_info->fb_info);
+ Parrot_gc_mark_STRING_alive(interp, nci_info->signature);
+ Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature);
+ Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_return_signature);
+ Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature);
+ Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig);
+ }
+ }
+
+/*
+
+=item C<void destroy()>
+
+Free all of the memory used internally to store various things, like libffi call signatures.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ if (PARROT_NCI(SELF)) {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ mem_sys_free(nci_info->cif);
+ mem_sys_free(nci_info->arg_translation);
+ mem_sys_free(nci_info->arg_types);
+ mem_sys_free(nci_info->return_translation);
+ }
+ }
+
+
+/*
+
+=item C<PMC *clone()>
+
+Creates and returns a clone of the NCI.
+
+=cut
+
+*/
+
+ VTABLE PMC *clone() {
+ Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF);
+ Parrot_NCI_attributes *nci_info_ret;
+ void *cif;
+
+ PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
+ nci_info_ret = PARROT_NCI(ret);
+
+ /* FIXME if data is malloced (JIT/i386!) then we need
+ * the length of data here, to memcpy it
+ * ManagedStruct or Buffer?
+ */
+ nci_info_ret->func = nci_info_self->func;
+ nci_info_ret->fb_info = nci_info_self->fb_info;
+ nci_info_ret->orig_func = nci_info_self->orig_func;
+ nci_info_ret->cif = nci_info_self->cif;
+ nci_info_ret->signature = nci_info_self->signature;
+ nci_info_ret->pcc_params_signature = nci_info_self->pcc_params_signature;
+ nci_info_ret->pcc_return_signature = nci_info_self->pcc_params_signature;
+ nci_info_ret->arity = nci_info_self->arity;
+ PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x7);
+
+ return ret;
+ }
+
+/*
+
+=item C<INTVAL defined()>
+
+Returns whether the NCI is defined.
+
+=cut
+
+*/
+
+ VTABLE INTVAL defined() {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ return nci_info->orig_func != NULL;
+ }
+
+/*
+
+=item C<opcode_t *invoke(void *next)>
+
+Calls the associated C function, returning C<*next>. If the invocant is a
+class, the PMC arguments are shifted down.
+
+=cut
+
+*/
+
+ VTABLE opcode_t *invoke(void *next) {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ char *sig_str;
+ PMC *cont;
+ INTVAL return_size = sizeof (void*);
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
+ void (*func)(void*,void*,void*); /* a function pointer for our function to call */
+
+ if (PObj_flag_TEST(private2, SELF)) {
+ void *orig_func;
+ PMC *fb_info;
+ GET_ATTR_orig_func(INTERP, SELF, orig_func);
+ GET_ATTR_fb_info(INTERP, SELF, fb_info);
+
+ func = (void (*)(void*, void*, void*))orig_func;
+
+ if (!func) {
+ /* build the thunk only when necessary */
+ func = (void (*)(void*, void*, void*))build_func(interp, nci_info);
+
+ if (!func)
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "attempt to call NULL function");
+ }
+
+ func = (void (*)(void*, void*, void*))(orig_func);
+ func(INTERP, SELF, fb_info);
+ }
+ else {
+ PMC *positional, *arg_iter;
+ STRING *void_return;
+ void **values, **middle_man = NULL, **pcc_ptr, **translation_pointers = NULL, **pcc_val = NULL;
+ void *return_data;
+ size_t count, i, j_offset;
+ char *tmp_sig;
+ ffi_cif *cif, pcc_cif;
+ ffi_type **pcc_args;
+
+ cif = (ffi_cif*)nci_info->cif;
+ func = (void (*)(void*, void*, void*))nci_info->func;
+
+ if (!cif) {
+ /* build the thunk only when necessary */
+ cif = build_libffi_func(interp, nci_info);
+
+ if (!cif && !func)
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+
+ "attempt to call NULL function");
+ }
+
+ if (nci_info->arity > 0) {
+ size_t pcc_argc, pcc_values_offset, pcc_values_size, values_size;
+ /* Function has arguments */
+ pcc_args = mem_internal_allocate_n_zeroed_typed(nci_info->arity + 4, ffi_type*);
+ tmp_sig = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature);
+
+ pcc_args[0] = &ffi_type_pointer;
+ pcc_args[1] = &ffi_type_pointer;
+ pcc_args[2] = &ffi_type_pointer;
+ pcc_values_size = 0;
+ values_size = 0;
+ pcc_argc = Parrot_str_length(interp, nci_info->pcc_params_signature);
+
+ /* Add up the size of memory needed for the actual call */
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ values_size += cif->arg_types[i]->size;
+ }
+
+ pcc_ptr = (void**)mem_internal_allocate_n_zeroed_typed(pcc_argc + 4, void*);
+
+ /* Setup Parrot_pcc_fill_params_from_c_args required arguments */
+ pcc_ptr[0] = &interp;
+ pcc_ptr[1] = &call_object;
+ pcc_ptr[2] = &tmp_sig;
+
+ pcc_val = (void**)mem_internal_allocate_n_zeroed_typed(pcc_argc, void*);
+ values = (void**)mem_internal_allocate_zeroed(values_size + sizeof(void*));
+ /* Middle man is used to contain */
+ middle_man = mem_internal_allocate_n_zeroed_typed(nci_info->arity, void*);
+
+ /* Add up the size of the pcc arguments */
+ for (i = 0; i < pcc_argc; i++) {
+ pcc_args[i + 3] = &ffi_type_pointer;
+ if (tmp_sig[i] == 'N') {
+ pcc_val[i] = malloc(sizeof(FLOATVAL));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ else if (tmp_sig[i] == 'I') {
+ pcc_val[i] = malloc(sizeof(INTVAL));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ else if (tmp_sig[i] == 'P' || tmp_sig[i] == 'S') {
+ pcc_val[i] = malloc(sizeof(void*));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ }
+
+ if (ffi_prep_cif(&pcc_cif, FFI_DEFAULT_ABI, 3 + pcc_argc,
+ &ffi_type_void, pcc_args) != FFI_OK) {
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Bad signature generated for Parrot_pcc_fill_params_from_c_args in NCI");
+ }
+
+ ffi_call(&pcc_cif, FFI_FN(Parrot_pcc_fill_params_from_c_args), NULL, pcc_ptr);
+
+ Parrot_str_free_cstring(tmp_sig);
+
+ /*
+ * Apply Argument Transformations
+ * this is mostly to transform STRING* into char*
+ * and add the parrot interp argument if it needs it
+ * but other transformations might apply later, like packing an
+ * object into a ManagedStruct
+ */
+ j_offset = 0;
+ translation_pointers = mem_internal_allocate_n_zeroed_typed(nci_info->arity, void*);
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ switch ((INTVAL)((char*)nci_info->arg_translation)[i]) {
+ case 'J':
+ values[i] = &interp;
+ j_offset++;
+ break;
+ case 't':
+ if (STRING_IS_NULL(*(STRING**)pcc_val[i - j_offset])) {
+ translation_pointers[i] = (char*) NULL;
+ }
+ else {
+ translation_pointers[i] = Parrot_str_to_cstring(interp, *(STRING**)pcc_val[i - j_offset]);
+ }
+ values[i] = &translation_pointers[i];
+ break;
+ case 'B':
+ if (STRING_IS_NULL(*(STRING**)pcc_val[i - j_offset])) {
+ translation_pointers[i] = (char*) NULL;
+ }
+ else {
+ translation_pointers[i] = Parrot_str_to_cstring(interp, *(STRING**)pcc_val[i - j_offset]);
+ }
+ middle_man[i] = &translation_pointers[i];
+ values[i] = &middle_man[i];
+ break;
+ case 'b':
+ values[i] = &Buffer_bufstart(*(STRING**)pcc_val[i - j_offset]);
+ break;
+ case 'c':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(char);
+ *((char**)translation_pointers)[i] = (char)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '2':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(short);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (short)VTABLE_get_integer(interp, *(PMC**)pcc_ptr[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 's':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(short);
+ *((short**)translation_pointers)[i] = (short)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '3':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(int);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (int)VTABLE_get_integer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 'i':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(int);
+ *((int**)translation_pointers)[i] = (int)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '4':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(long);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (long)VTABLE_get_integer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 'l':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(long);
+ *((long**)translation_pointers)[i] = (long)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'q':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(long long);
+ *((long long**)translation_pointers)[i] = (long long)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'V':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->pval = (void**)mem_internal_allocate_zeroed_typed(void*);
+ *((pmc_holder_t*)translation_pointers[i])->pval = PMC_IS_NULL(*(PMC**)pcc_ptr[i - j_offset]) ?
+ (void *)NULL : (void*)VTABLE_get_pointer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->pval;
+ break;
+ case 'P':
+ translation_pointers[i] = *(PMC**)pcc_val[i - j_offset];
+ values[i] = &translation_pointers[i];
+ break;
+ case 'p':
+ translation_pointers[i] = PMC_IS_NULL(*(PMC**)pcc_ptr[i - j_offset]) ?
+ (void *)NULL : VTABLE_get_pointer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &translation_pointers[i];
+ break;
+ case 'f':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(float);
+ *((float**)translation_pointers)[i] = (float)*(FLOATVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'd':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(double);
+ *((double**)translation_pointers)[i] = *(FLOATVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case ' ':
+ default:
+ break;
+ }
+ }
+
+ if (pcc_args) {
+ mem_sys_free(pcc_args);
+ }
+ if (pcc_ptr) {
+ mem_sys_free(pcc_ptr);
+ }
+ if (pcc_val) {
+ for (i = 0; i < pcc_argc; i++) {
+ mem_sys_free(pcc_val[i]);
+ }
+ mem_sys_free(pcc_val);
+ }
+ }
+ else {
+ /* No arguments */
+ values = NULL;
+ }
+
+ /*
+ * This will allow for any type of datat to be returned.
+ * Including one day Structures
+ */
+ return_data = mem_internal_allocate_zeroed(cif->rtype->size);
+
+ ffi_call(cif, FFI_FN(func), return_data, values);
+
+ if (cif->rtype != &ffi_type_void) {
+ char *s;
+ PMC *ret_object;
+ s = Parrot_str_to_cstring(interp, nci_info->pcc_return_signature);
+ switch (*(char*)nci_info->return_translation) {
+ case 'p':
+ {
+ PMC *final_destination = PMCNULL;
+
+ if (*(void**)return_data != NULL) {
+ final_destination = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
+ VTABLE_set_pointer(interp, final_destination, *(void**)return_data);
+ }
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+
+ }
+ break;
+ case 't':
+ {
+ STRING *final_destination = Parrot_str_new(interp, *(char**)return_data, 0);
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+ }
+ break;
+ case 'f':
+ {
+ FLOATVAL final_destination = *(float*)return_data;
+
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+ }
+ break;
+ default:
+ switch (s[0]) {
+ case 'N':
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(FLOATVAL*)return_data);
+ case 'I':
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(INTVAL*)return_data);
+ case 'P':
+ case 'S':
+ default:
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(void**)return_data);
+ }
+ break;
+ }
+ Parrot_str_free_cstring(s);
+ }
+
+ /*
+ * Free memory used for cstrings,
+ * and any other translations that use temporary memory
+ */
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ switch ((INTVAL)((char*)nci_info->arg_translation)[i]) {
+ case (INTVAL)'B':
+ if (translation_pointers[i]) {
+ Parrot_str_free_cstring((char*)translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'t':
+ if (translation_pointers[i]) {
+ Parrot_str_free_cstring((char*)translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'2':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(short*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'3':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(int*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'4':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(long*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'V':
+ VTABLE_set_pointer(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (PMC*)*((pmc_holder_t*)translation_pointers[i])->pval);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'d':
+ case (INTVAL)'c':
+ case (INTVAL)'s':
+ case (INTVAL)'i':
+ case (INTVAL)'l':
+ case (INTVAL)'q':
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ default:
+ break;
+ }
+ }
+
+ if (nci_info->arity > 0 && middle_man) {
+ mem_sys_free(middle_man);
+ }
+ if (return_data) {
+ mem_sys_free(return_data);
+ }
+ if (values) {
+ mem_sys_free(values);
+ }
+ }
+
+ cont = INTERP->current_cont;
+
+ /*
+ * If the NCI function was tailcalled, the return result
+ * is already passed back to the caller of this frame
+ * - see Parrot_init_ret_nci(). We therefore invoke the
+ * return continuation here, which gets rid of this frame
+ * and returns the real return address
+ */
+ if (cont && cont != NEED_CONTINUATION
+ && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) {
+ cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
+ next = VTABLE_invoke(INTERP, cont, next);
+ }
+
+ return (opcode_t *)next;
+ }
+
+/*
+
+=item C<INTVAL get_integer()>
+
+Returns the function pointer as an integer.
+
+=cut
+
+*/
+
+ VTABLE INTVAL get_integer() {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ if (!nci_info->func)
+ build_func(INTERP, nci_info);
+ return (INTVAL)nci_info->func;
+ }
+
+/*
+
+=item C<INTVAL get_bool()>
+
+Returns the boolean value of the pointer.
+
+=cut
+
+*/
+
+ VTABLE INTVAL get_bool() {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ return (0 != (INTVAL)nci_info->cif);
+ }
+
+/*
+
+=item C<METHOD arity()>
+
+Return the arity of the NCI (the number of arguments).
+
+=cut
+
+*/
+ METHOD arity() {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ INTVAL arity = 0;
+
+ if (nci_info) {
+ if (PObj_flag_TEST(private2, SELF)) {
+ }
+ else {
+ if (!nci_info->cif) {
+ nci_info->cif = build_libffi_func(interp, nci_info);
+ }
+ if (nci_info->cif) {
+ arity = nci_info->arity;
+ RETURN(INTVAL arity);
+ }
+ }
+ }
+
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "You cannot get the arity of an undefined NCI.");
+ }
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<docs/pdds/pdd03_calling_conventions.pod>.
+
+=head1 HISTORY
+
+Initial revision by sean 2002/08/04.
+
+Updates by John Harrison, Summer 2010, GSoC.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
+
+
Copied and modified: branches/gsoc_nci/config/gen/libffi/nci.pmc.in (from r48552, branches/gsoc_nci/src/pmc/nci.pmc)
==============================================================================
--- branches/gsoc_nci/src/pmc/nci.pmc Tue Aug 17 16:37:40 2010 (r48552, copy source)
+++ branches/gsoc_nci/config/gen/libffi/nci.pmc.in Tue Aug 17 18:47:31 2010 (r48554)
@@ -169,7 +169,6 @@
pmclass NCI auto_attrs provides invokable {
/* NCI thunk handling attributes */
- /* NCI thunk handling attributes */
ATTR STRING *signature; /* The signature. */
ATTR void *func; /* Function pointer to call. */
ATTR PMC *fb_info; /* Frame-builder info */
Modified: branches/gsoc_nci/lib/Parrot/Configure/Options/Conf.pm
==============================================================================
--- branches/gsoc_nci/lib/Parrot/Configure/Options/Conf.pm Tue Aug 17 17:28:09 2010 (r48553)
+++ branches/gsoc_nci/lib/Parrot/Configure/Options/Conf.pm Tue Aug 17 18:47:31 2010 (r48554)
@@ -101,6 +101,7 @@
--without-gettext Build parrot without gettext support
--without-gmp Build parrot without GMP support
+ --without-libffi Build parrot without libffi support
--without-opengl Build parrot without OpenGL support (GL/GLU/GLUT)
--without-pcre Build parrot without pcre support
--without-zlib Build parrot without zlib support
Modified: branches/gsoc_nci/lib/Parrot/Configure/Step/List.pm
==============================================================================
--- branches/gsoc_nci/lib/Parrot/Configure/Step/List.pm Tue Aug 17 17:28:09 2010 (r48553)
+++ branches/gsoc_nci/lib/Parrot/Configure/Step/List.pm Tue Aug 17 18:47:31 2010 (r48554)
@@ -61,11 +61,13 @@
auto::ctags
auto::revision
auto::icu
+ auto::libffi
gen::config_h
gen::core_pmcs
gen::opengl
gen::makefiles
gen::platform
+ gen::libffi
gen::config_pm
);
Modified: branches/gsoc_nci/src/pmc/nci.pmc
==============================================================================
--- branches/gsoc_nci/src/pmc/nci.pmc Tue Aug 17 17:28:09 2010 (r48553)
+++ branches/gsoc_nci/src/pmc/nci.pmc Tue Aug 17 18:47:31 2010 (r48554)
@@ -18,6 +18,9 @@
*/
+/* Cheat with this include, for whatever reason the space is required */
+# include "ffi.h"
+
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -49,6 +52,618 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
+static
+INTVAL
+parse_sig(PARROT_INTERP, STRING *sig, size_t sig_length, Parrot_NCI_attributes *nci_info);
+
+static
+size_t
+parse_return(PARROT_INTERP, STRING* sig, size_t sig_length,
+ Parrot_NCI_attributes * nci_info, ffi_type **return_type);
+
+static
+size_t
+parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types);
+
+static
+size_t
+parse_identifier(PARROT_INTERP,
+ STRING* sig, size_t start, size_t end,
+ ffi_type** sig_obj,
+ char* pmc_type, size_t *pmc_count,
+ char* translation, size_t *translation_length);
+
+static
+size_t
+parse_structure(PARROT_INTERP, STRING* sig, size_t start, size_t end,
+ ffi_type** sig_obj, char* pmc_type);
+
+static
+INTVAL
+parse_prefix(INTVAL c);
+
+static
+size_t
+structure_length(PARROT_INTERP, STRING* sig, size_t start, size_t end);
+
+static
+size_t
+count_args(PARROT_INTERP, STRING* sig, size_t start, size_t end);
+
+static
+size_t
+find_matching(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ INTVAL start_character, INTVAL end_character);
+
+#define IS_DIGIT(x) (((x) == '0') || ((x) == '1') || ((x) == '2') || ((x) == '3') \
+ || ((x) == '4') || ((x) == '5') || ((x) == '6') || ((x) == '7') \
+ || ((x) == '8') || ((x) == '9'))
+
+#define IS_PREFIX(x) (((x) == '*') || ((x) == 'u'))
+
+#define IS_OLD_TYPE(x) (((x) == 'P') || ((x) == 'J') || ((x) == 'N') || ((x) == 'S') \
+ || ((x) == 'O') || ((x) == '@') || ((x) == 'B') || ((x) == 'p') \
+ || ((x) == '2') || ((x) == '3') || ((x) == '4') || ((x) == 'U') \
+ || ((x) == 'V'))
+
+#define IS_TYPE(x) (((x) == 'i') || ((x) == 'v') || ((x) == 'l') || ((x) == 't') \
+ || ((x) == 'c') || ((x) == 'b') || ((x) == 'f') || ((x) == 'd') \
+ || ((x) == 's') || IS_OLD_TYPE(x))
+
+#define IS_POSTFIX(x) ((x) == '{') /* || IS_DIGIT(x)) */
+#define IS_INFIX(x) ((x) == '|')
+#define IS_START_CIRCUMFIX(x) ((x) == '(')
+#define IS_END_CIRCUMFIX(x) ((x) == ')')
+#define IS_NOT_END_CIRCUMFIX(x) ((x) != ')')
+
+#define PREFIX_POINTER (1<<0)
+#define PREFIX_SIGNED ( 0)
+#define PREFIX_UNSIGNED (1<<1)
+#define PREFIX_NATIVE (1<<2)
+
+typedef struct pmc_holder_t {
+ PMC* p;
+ union {
+ INTVAL* ival;
+ void** pval;
+ };
+} pmc_holder_t;
+
+/*
+
+=item C<static INTVAL parse_sig(PARROT_INTERP, STRING *sig,
+ size_t sig_length, Parrot_NCI_attributes *nci_info)>
+
+Parse a full signature. All signatures should contain a return type and a list of
+arguments. "vv" Would be the shortest "void fn(void)" signature you can legally make.
+
+See C<parse_return> and C<parse_args> to see how the signature is broken down.
+
+=cut
+
+*/
+
+static INTVAL
+parse_sig(PARROT_INTERP, STRING *sig, size_t sig_length, Parrot_NCI_attributes *nci_info) {
+ ffi_cif cif;
+ ffi_type *return_type;
+ ffi_type **arg_types;
+
+ if (sig_length) {
+ size_t i = parse_return(interp, sig, sig_length, nci_info, &return_type);
+ if (i < sig_length)
+ parse_args(interp, sig, i, sig_length, nci_info, &arg_types);
+ else {
+ arg_types = mem_internal_allocate_n_zeroed_typed(1, ffi_type*);
+ arg_types[0] = &ffi_type_void;
+ nci_info->pcc_params_signature = string_make(interp, "", 1, NULL, 0);
+ nci_info->arg_translation = NULL;
+ nci_info->arity = 0;
+ }
+ }
+ else {
+ arg_types = mem_internal_allocate_n_zeroed_typed(1, ffi_type*);
+ arg_types[0] = &ffi_type_void;
+ return_type = &ffi_type_void;
+ nci_info->pcc_params_signature = string_make(interp, "", 1, NULL, 0);
+ nci_info->arg_translation = NULL;
+ nci_info->arity = 0;
+ }
+
+ if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI,
+ nci_info->arity, return_type, arg_types) == FFI_OK) {
+ nci_info->cif = (void*)mem_internal_allocate_typed(ffi_cif);
+ memcpy(nci_info->cif, &cif, sizeof (ffi_cif));
+ nci_info->arg_types = arg_types;
+
+ return 1;
+ }
+
+ if (arg_types) {
+ mem_sys_free(arg_types);
+ }
+
+ /* TODO: Throw Error here. */
+ printf("Bad signature\n");
+
+ return 0;
+}
+
+/*
+
+=item C<static size_t parse_return(PARROT_INTERP, STRING *sig, size_t sig_length,
+ Parrot_NCI_attributes* nci_info, ffi_type **return_type)>
+
+Parses the return type. This assumes the first identifier is the return type.
+
+See C<parse_identifier> to see how a single identifer is parsed.
+
+=cut
+
+*/
+
+static size_t
+parse_return(PARROT_INTERP, STRING *sig, size_t sig_length,
+ Parrot_NCI_attributes* nci_info, ffi_type **return_type) {
+ char *t = mem_allocate_n_zeroed_typed(2, char);
+ size_t j = 0, k = 0;
+ /* Should be 1 character plus a NULL" */
+ char * result_sig = mem_allocate_n_zeroed_typed(2, char);
+ size_t result_length = parse_identifier(interp,
+ sig, 0, sig_length,
+ return_type,
+ result_sig, &j,
+ t, &k);
+
+ nci_info->pcc_return_signature = string_make(interp, result_sig, 2, NULL, 0);
+ nci_info->return_translation = (void*)t;
+ mem_sys_free(result_sig);
+ return result_length;
+}
+
+/*
+
+=item C<static size_t parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types)>
+
+Parses the signatures arguments. It takes an offset to know where to start looking.
+This should fill out a list of C<ffi_type*> args.
+
+See C<parse_identifier> to see how a single identifer is parsed.
+
+=cut
+
+*/
+
+static size_t
+parse_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ Parrot_NCI_attributes *nci_info, ffi_type ***arg_types) {
+ size_t i = start;
+ size_t arg_count = 0;
+ size_t argc = count_args(interp, sig, start, sig_length);
+ char* parrot_types = mem_allocate_n_zeroed_typed(argc + 1, char);
+ size_t parrot_types_length = 0;
+ char* translation_types = mem_allocate_n_zeroed_typed(argc + 1, char);
+ size_t translation_length = 0;
+
+ *arg_types = mem_internal_allocate_n_zeroed_typed(argc + 1, ffi_type*);
+
+ while (i < sig_length) {
+ ffi_type *ident;
+ i = parse_identifier(interp,
+ sig, i, sig_length,
+ &ident,
+ parrot_types, &parrot_types_length,
+ translation_types, &translation_length);
+ (*arg_types)[arg_count] = ident;
+ arg_count++;
+ }
+
+ nci_info->pcc_params_signature = string_make(interp, parrot_types,
+ strlen(parrot_types), NULL, 0);
+ nci_info->arg_translation = translation_types;
+ nci_info->arity = arg_count;
+
+ mem_sys_free(parrot_types);
+
+ return i;
+}
+
+/*
+
+=item C<static size_t parse_identifier(PARROT_INTERP, STRING *sig, size_t start,
+ size_t sig_length, ffi_type **type_obj,
+ char **type, size_t *pmc_count,
+ char **translation, size_t *translation_count)>
+
+Parse an identifier and build its representation used for PCC and any translations
+that are needed.
+
+An example of a transation is "t", it will take a STRING* and convert it to a
+char* for the function call.
+
+=cut
+
+*/
+
+static size_t
+parse_identifier(PARROT_INTERP,
+ STRING *sig, size_t start, size_t sig_length,
+ ffi_type **type_obj,
+ char *type, size_t *pmc_count,
+ char *translation, size_t *translation_count) {
+ size_t i = start;
+ INTVAL done = 0;
+
+ while (!done && i < sig_length) {
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ int prefix = 0;
+ while (IS_PREFIX(c)) {
+ prefix |= parse_prefix(c);
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+
+ if (IS_START_CIRCUMFIX(c)) {
+ i = parse_structure(interp, sig, i + 1, sig_length, type_obj, type);
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+ else if (IS_TYPE(c)) {
+ if (prefix & PREFIX_POINTER) {
+ *type_obj = &ffi_type_pointer;
+ continue;
+ }
+ translation[(*translation_count)++] = ' ';
+ switch (c) {
+ case (INTVAL)' ':
+ case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */
+ break;
+ case (INTVAL)'c':
+ translation[(*translation_count) - 1] = 'c';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uchar;
+ }
+ else {
+ *type_obj = &ffi_type_schar;
+ }
+ break;
+ case (INTVAL)'B':
+ translation[(*translation_count) - 1] = 'B';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'b':
+ translation[(*translation_count) - 1] = 'b';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'s':
+ translation[(*translation_count) - 1] = 's';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_ushort;
+ }
+ else {
+ *type_obj = &ffi_type_sshort;
+ }
+ break;
+ case (INTVAL)'I': /* INTVAL */
+ case (INTVAL)'i':
+ translation[(*translation_count) - 1] = 'i';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uint;
+ }
+ else {
+ *type_obj = &ffi_type_sint;
+ }
+ break;
+ case (INTVAL)'l':
+ translation[(*translation_count) - 1] = 'l';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_ulong;
+ }
+ else {
+ *type_obj = &ffi_type_slong;
+ }
+ break;
+ case (INTVAL)'q':
+ translation[(*translation_count) - 1] = 'q';
+ type[(*pmc_count)++] = 'I';
+ if (prefix & PREFIX_UNSIGNED) {
+ *type_obj = &ffi_type_uint64;
+ }
+ else {
+ *type_obj = &ffi_type_sint64;
+ }
+ break;
+ case (INTVAL)'J': /* interpreter */
+ translation[(*translation_count) - 1] = 'J';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'p': /* push pmc->data */
+ translation[(*translation_count) - 1] = 'p';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'2':
+ translation[(*translation_count) - 1] = '2';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'3':
+ translation[(*translation_count) - 1] = '3';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'4':
+ translation[(*translation_count) - 1] = '4';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'P': /* push PMC * */
+ translation[(*translation_count) - 1] = 'P';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'V': /* push PMC * */
+ translation[(*translation_count) - 1] = 'V';
+ type[(*pmc_count)++] = 'P';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'S':
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ case (INTVAL)'t':
+ translation[(*translation_count) - 1] = 't';
+ type[(*pmc_count)++] = 'S';
+ *type_obj = &ffi_type_pointer;
+ break;
+ case (INTVAL)'v':
+ type[(*pmc_count)++] = 'v';
+ *type_obj = &ffi_type_void;
+ break;
+#if (DOUBLE_SIZE == 4) /* FLOATVAL is a float */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'f':
+ translation[(*translation_count) - 1] = 'f';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_float;
+ break;
+#if (DOUBLE_SIZE == 8) /* FLOATVAL is a double */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'d':
+ translation[(*translation_count) - 1] = 'd';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_double;
+ break;
+#if (DOUBLE_SIZE > 8) /* FLOATVAL is a long double */
+ case (INTVAL)'N':
+#endif
+ case (INTVAL)'D':
+ translation[(*translation_count) - 1] = 'D';
+ type[(*pmc_count)++] = 'N';
+ *type_obj = &ffi_type_longdouble;
+ break;
+ case (INTVAL)'O': /* push PMC * invocant */
+ *type_obj = &ffi_type_pointer;
+ type[(*pmc_count)++] = 'P';
+ type[(*pmc_count)++] = 'i';
+ break;
+ case (INTVAL)'@': /* push PMC * slurpy */
+ *type_obj = &ffi_type_pointer;
+ type[(*pmc_count)++] = 'P';
+ type[(*pmc_count)++] = 's';
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ break;
+ }
+ i++;
+
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+ else {
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ }
+
+ /*
+ * Parse postfix ops
+ * TODO: Parse postfix ops, currently I skip them.
+ */
+ while (IS_POSTFIX(c)) {
+ i++;
+ if (i < sig_length)
+ c = Parrot_str_indexed(interp, sig, i);
+ else
+ return i;
+ }
+
+ if ((i < sig_length) && (c == (INTVAL)'|')) {
+ /* Its a union, parse it special. */
+ }
+ else {
+ done = 1;
+ }
+ }
+
+ return i;
+}
+
+/*
+
+=item C<static INTVAL parse_prefix(INTVAL c)>
+
+Parse a prefix character.
+
+=cut
+
+*/
+
+static INTVAL
+parse_prefix(INTVAL c) {
+ switch (c) {
+ case '*':
+ return PREFIX_POINTER;
+ break;
+ case 'u':
+ return PREFIX_UNSIGNED;
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ return 0;
+}
+
+/*
+
+=item C<static size_t parse_structure(PARROT_INTERP, STRING* sig, size_t start,
+ size_t sig_length, ffi_type **type_obj, char* pmc_type)>
+
+Parses a stucture.
+TODO: This should auto inflate to an UnmanagedStruct or a ManagedStruct in the future.
+
+=cut
+
+*/
+
+static size_t
+parse_structure(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ ffi_type **type_obj, char* pmc_type) {
+ size_t i = start;
+ size_t struct_len = structure_length(interp, sig, start, sig_length);
+ size_t element_counter = 0;
+ INTVAL c;
+
+ *type_obj = (ffi_type*)mem_internal_allocate_typed(ffi_type*);
+ (*type_obj)->elements = mem_internal_allocate_n_zeroed_typed(struct_len + 1, ffi_type*);
+
+ (*type_obj)->size = (*type_obj)->alignment = 0;
+ (*type_obj)->type = FFI_TYPE_STRUCT;
+
+ c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && IS_NOT_END_CIRCUMFIX(c)) {
+ i = parse_identifier(interp, sig, i, sig_length,
+ &(*type_obj)->elements[element_counter],
+ NULL, 0, NULL, 0);
+ element_counter++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ (*type_obj)->elements[struct_len] = NULL;
+
+ return i;
+}
+
+/*
+
+=item C<static size_t structure_length(PARROT_INTERP, STRING* sig,
+ size_t start, size_t sig_length)>
+
+Calculates the number of items in a stucture for size purposes.
+
+=cut
+
+*/
+
+static size_t
+structure_length(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length) {
+ size_t len = 0;
+ size_t i = start;
+ INTVAL depth = 0;
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && depth != -1) {
+ if (IS_START_CIRCUMFIX(c)) depth++;
+ else if (IS_END_CIRCUMFIX(c)) depth--;
+ else if (depth == 0 && (IS_TYPE(c))) len++;
+ i++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ return len;
+}
+
+/*
+
+=item C<static size_t find_matching(PARROT_INTERP, STRING* sig, size_t start,
+ size_t sig_length, INTVAL start_character, INTVAL end_character)>
+
+Find matching symbols, used for finding the start and stop of a stucture, it is
+also recursive to handle structures inside of structures.
+
+=cut
+
+*/
+
+static size_t
+find_matching(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length,
+ INTVAL start_character, INTVAL end_character) {
+ size_t i = start;
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+ while (i < sig_length && c != end_character) {
+ if (c == start_character)
+ i = find_matching(interp, sig, i, sig_length, start_character, end_character);
+ i++;
+ c = Parrot_str_indexed(interp, sig, i);
+ }
+
+ return i;
+}
+
+/*
+
+=item C<size_t count_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length)>
+
+Counts the number of arguments from a given starting point. It only counts
+identiers, not prefix, infix or postfix modifiers. Structures are considered as
+1 item in most cases.
+
+=cut
+
+*/
+
+static size_t
+count_args(PARROT_INTERP, STRING* sig, size_t start, size_t sig_length) {
+ size_t length = 0;
+ size_t i = start;
+
+ while (i < sig_length) {
+ const INTVAL c = Parrot_str_indexed(interp, sig, i);
+ if (IS_START_CIRCUMFIX(c)) {
+ i = find_matching(interp, sig, i + 1, sig_length, '(', ')');
+ length++;
+ }
+ else if (IS_TYPE(c)) {
+ length++;
+ }
+ i++;
+ }
+
+ return length;
+}
static void
pcc_params(PARROT_INTERP, ARGIN(STRING *sig), ARGMOD(Parrot_NCI_attributes *nci_info),
@@ -143,6 +758,20 @@
mem_sys_free(sig_buf);
}
+PARROT_IGNORABLE_RESULT
+static ffi_cif*
+build_libffi_func(PARROT_INTERP, ARGMOD(Parrot_NCI_attributes *nci_info))
+{
+ ASSERT_ARGS(build_func)
+
+ STRING * const key = nci_info->signature;
+ const size_t key_length = Parrot_str_byte_length(interp, key);
+
+ INTVAL r = parse_sig(interp, nci_info->signature, key_length, nci_info);
+
+ return (ffi_cif*)nci_info->cif;
+}
+
/* actually build the NCI thunk */
PARROT_IGNORABLE_RESULT
@@ -172,12 +801,16 @@
/* NCI thunk handling attributes */
ATTR STRING *signature; /* The signature. */
ATTR void *func; /* Function pointer to call. */
+ ATTR void *orig_func;
ATTR PMC *fb_info; /* Frame-builder info */
- ATTR void *orig_func; /* Function pointer
- * used to create func */
+ ATTR void *cif; /* Function interface */
+ ATTR void *arg_types; /* Used for building the libffi call interface */
+
/* Parrot Sub-ish attributes */
ATTR STRING *pcc_params_signature;
ATTR STRING *pcc_return_signature;
+ ATTR void *arg_translation;
+ ATTR void *return_translation;
ATTR INTVAL arity; /* Cached arity of the NCI. */
/* MMD fields */
@@ -255,14 +888,13 @@
Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
/* Store the original function and signature. */
- SET_ATTR_orig_func(INTERP, SELF, func);
+ SET_ATTR_func(INTERP, SELF, func);
/* ensure that the STRING signature is constant */
if (!PObj_constant_TEST(key)) {
char * const key_c = Parrot_str_to_cstring(INTERP, key);
const size_t key_length = Parrot_str_byte_length(interp, key);
- key = string_make(interp, key_c, key_length,
- NULL, PObj_constant_FLAG);
+ key = string_make(interp, key_c, key_length, NULL, 0);
Parrot_str_free_cstring(key_c);
}
@@ -285,7 +917,7 @@
Parrot_gc_mark_PMC_alive(interp, nci_info->fb_info);
Parrot_gc_mark_STRING_alive(interp, nci_info->signature);
Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature);
- Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature);
+ Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_return_signature);
Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature);
Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig);
}
@@ -293,6 +925,27 @@
/*
+=item C<void destroy()>
+
+Free all of the memory used internally to store various things, like libffi call signatures.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ if (PARROT_NCI(SELF)) {
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
+ mem_sys_free(nci_info->cif);
+ mem_sys_free(nci_info->arg_translation);
+ mem_sys_free(nci_info->arg_types);
+ mem_sys_free(nci_info->return_translation);
+ }
+ }
+
+
+/*
+
=item C<PMC *clone()>
Creates and returns a clone of the NCI.
@@ -304,7 +957,7 @@
VTABLE PMC *clone() {
Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF);
Parrot_NCI_attributes *nci_info_ret;
- void *orig_func;
+ void *cif;
PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
nci_info_ret = PARROT_NCI(ret);
@@ -316,6 +969,7 @@
nci_info_ret->func = nci_info_self->func;
nci_info_ret->fb_info = nci_info_self->fb_info;
nci_info_ret->orig_func = nci_info_self->orig_func;
+ nci_info_ret->cif = nci_info_self->cif;
nci_info_ret->signature = nci_info_self->signature;
nci_info_ret->pcc_params_signature = nci_info_self->pcc_params_signature;
nci_info_ret->pcc_return_signature = nci_info_self->pcc_params_signature;
@@ -352,31 +1006,391 @@
*/
VTABLE opcode_t *invoke(void *next) {
- Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
- nci_thunk_t func;
- PMC *fb_info;
+ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
char *sig_str;
- void *orig_func;
PMC *cont;
+ INTVAL return_size = sizeof (void*);
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
+ void (*func)(void*,void*,void*); /* a function pointer for our function to call */
+
+ if (PObj_flag_TEST(private2, SELF)) {
+ void *orig_func;
+ PMC *fb_info;
+ GET_ATTR_orig_func(INTERP, SELF, orig_func);
+ GET_ATTR_fb_info(INTERP, SELF, fb_info);
+
+ func = (void (*)(void*, void*, void*))orig_func;
+
+ if (!func) {
+ /* build the thunk only when necessary */
+ func = (void (*)(void*, void*, void*))build_func(interp, nci_info);
+
+ if (!func)
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "attempt to call NULL function");
+ }
- GET_ATTR_orig_func(INTERP, SELF, orig_func);
- func = PObj_flag_TEST(private2, SELF)
- ? (nci_thunk_t) D2FPTR(orig_func)
- : (nci_thunk_t) D2FPTR(nci_info->func);
+ func = (void (*)(void*, void*, void*))(orig_func);
+ func(INTERP, SELF, fb_info);
+ }
+ else {
+ PMC *positional, *arg_iter;
+ STRING *void_return;
+ void **values, **middle_man = NULL, **pcc_ptr, **translation_pointers = NULL, **pcc_val = NULL;
+ void *return_data;
+ size_t count, i, j_offset;
+ char *tmp_sig;
+ ffi_cif *cif, pcc_cif;
+ ffi_type **pcc_args;
+
+ cif = (ffi_cif*)nci_info->cif;
+ func = (void (*)(void*, void*, void*))nci_info->func;
+
+ if (!cif) {
+ /* build the thunk only when necessary */
+ cif = build_libffi_func(interp, nci_info);
+
+ if (!cif && !func)
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
- GET_ATTR_fb_info(INTERP, SELF, fb_info);
+ "attempt to call NULL function");
+ }
- if (!func) {
- /* build the thunk only when necessary */
- func = build_func(interp, nci_info);
+ if (nci_info->arity > 0) {
+ size_t pcc_argc, pcc_values_offset, pcc_values_size, values_size;
+ /* Function has arguments */
+ pcc_args = mem_internal_allocate_n_zeroed_typed(nci_info->arity + 4, ffi_type*);
+ tmp_sig = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature);
+
+ pcc_args[0] = &ffi_type_pointer;
+ pcc_args[1] = &ffi_type_pointer;
+ pcc_args[2] = &ffi_type_pointer;
+ pcc_values_size = 0;
+ values_size = 0;
+ pcc_argc = Parrot_str_length(interp, nci_info->pcc_params_signature);
+
+ /* Add up the size of memory needed for the actual call */
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ values_size += cif->arg_types[i]->size;
+ }
+
+ pcc_ptr = (void**)mem_internal_allocate_n_zeroed_typed(pcc_argc + 4, void*);
+
+ /* Setup Parrot_pcc_fill_params_from_c_args required arguments */
+ pcc_ptr[0] = &interp;
+ pcc_ptr[1] = &call_object;
+ pcc_ptr[2] = &tmp_sig;
+
+ pcc_val = (void**)mem_internal_allocate_n_zeroed_typed(pcc_argc, void*);
+ values = (void**)mem_internal_allocate_zeroed(values_size + sizeof(void*));
+ /* Middle man is used to contain */
+ middle_man = mem_internal_allocate_n_zeroed_typed(nci_info->arity, void*);
+
+ /* Add up the size of the pcc arguments */
+ for (i = 0; i < pcc_argc; i++) {
+ pcc_args[i + 3] = &ffi_type_pointer;
+ if (tmp_sig[i] == 'N') {
+ pcc_val[i] = malloc(sizeof(FLOATVAL));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ else if (tmp_sig[i] == 'I') {
+ pcc_val[i] = malloc(sizeof(INTVAL));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ else if (tmp_sig[i] == 'P' || tmp_sig[i] == 'S') {
+ pcc_val[i] = malloc(sizeof(void*));
+ pcc_ptr[i+3] = &pcc_val[i];
+ }
+ }
+
+ if (ffi_prep_cif(&pcc_cif, FFI_DEFAULT_ABI, 3 + pcc_argc,
+ &ffi_type_void, pcc_args) != FFI_OK) {
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Bad signature generated for Parrot_pcc_fill_params_from_c_args in NCI");
+ }
+
+ ffi_call(&pcc_cif, FFI_FN(Parrot_pcc_fill_params_from_c_args), NULL, pcc_ptr);
+
+ Parrot_str_free_cstring(tmp_sig);
+
+ /*
+ * Apply Argument Transformations
+ * this is mostly to transform STRING* into char*
+ * and add the parrot interp argument if it needs it
+ * but other transformations might apply later, like packing an
+ * object into a ManagedStruct
+ */
+ j_offset = 0;
+ translation_pointers = mem_internal_allocate_n_zeroed_typed(nci_info->arity, void*);
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ switch ((INTVAL)((char*)nci_info->arg_translation)[i]) {
+ case 'J':
+ values[i] = &interp;
+ j_offset++;
+ break;
+ case 't':
+ if (STRING_IS_NULL(*(STRING**)pcc_val[i - j_offset])) {
+ translation_pointers[i] = (char*) NULL;
+ }
+ else {
+ translation_pointers[i] = Parrot_str_to_cstring(interp, *(STRING**)pcc_val[i - j_offset]);
+ }
+ values[i] = &translation_pointers[i];
+ break;
+ case 'B':
+ if (STRING_IS_NULL(*(STRING**)pcc_val[i - j_offset])) {
+ translation_pointers[i] = (char*) NULL;
+ }
+ else {
+ translation_pointers[i] = Parrot_str_to_cstring(interp, *(STRING**)pcc_val[i - j_offset]);
+ }
+ middle_man[i] = &translation_pointers[i];
+ values[i] = &middle_man[i];
+ break;
+ case 'b':
+ values[i] = &Buffer_bufstart(*(STRING**)pcc_val[i - j_offset]);
+ break;
+ case 'c':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(char);
+ *((char**)translation_pointers)[i] = (char)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '2':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(short);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (short)VTABLE_get_integer(interp, *(PMC**)pcc_ptr[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 's':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(short);
+ *((short**)translation_pointers)[i] = (short)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '3':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(int);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (int)VTABLE_get_integer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 'i':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(int);
+ *((int**)translation_pointers)[i] = (int)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case '4':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->ival = (INTVAL*)mem_internal_allocate_zeroed_typed(long);
+ *((pmc_holder_t*)translation_pointers[i])->ival = (long)VTABLE_get_integer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->ival;
+ break;
+ case 'l':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(long);
+ *((long**)translation_pointers)[i] = (long)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'q':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(long long);
+ *((long long**)translation_pointers)[i] = (long long)*(INTVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'V':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(pmc_holder_t);
+ ((pmc_holder_t*)translation_pointers[i])->p = *(PMC**)pcc_val[i - j_offset];
+ ((pmc_holder_t*)translation_pointers[i])->pval = (void**)mem_internal_allocate_zeroed_typed(void*);
+ *((pmc_holder_t*)translation_pointers[i])->pval = PMC_IS_NULL(*(PMC**)pcc_val[i - j_offset]) ?
+ (void *)NULL : (void*)VTABLE_get_pointer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &((pmc_holder_t*)translation_pointers[i])->pval;
+ break;
+ case 'P':
+ translation_pointers[i] = *(PMC**)pcc_val[i - j_offset];
+ values[i] = &translation_pointers[i];
+ break;
+ case 'p':
+ translation_pointers[i] = PMC_IS_NULL(*(PMC**)pcc_val[i - j_offset]) ?
+ (void *)NULL : VTABLE_get_pointer(interp, *(PMC**)pcc_val[i - j_offset]);
+ values[i] = &translation_pointers[i];
+ break;
+ case 'f':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(float);
+ *((float**)translation_pointers)[i] = (float)*(FLOATVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case 'd':
+ translation_pointers[i] = mem_internal_allocate_zeroed_typed(double);
+ *((double**)translation_pointers)[i] = *(FLOATVAL*)pcc_val[i - j_offset];
+ values[i] = translation_pointers[i];
+ break;
+ case ' ':
+ default:
+ break;
+ }
+ }
+
+ if (pcc_args) {
+ mem_sys_free(pcc_args);
+ }
+ if (pcc_ptr) {
+ mem_sys_free(pcc_ptr);
+ }
+ if (pcc_val) {
+ for (i = 0; i < pcc_argc; i++) {
+ mem_sys_free(pcc_val[i]);
+ }
+ mem_sys_free(pcc_val);
+ }
+ }
+ else {
+ /* No arguments */
+ values = NULL;
+ }
- if (!func)
- Parrot_ex_throw_from_c_args(INTERP, NULL,
- EXCEPTION_INVALID_OPERATION,
- "attempt to call NULL function");
+ /*
+ * This will allow for any type of datat to be returned.
+ * Including one day Structures
+ */
+ return_data = mem_internal_allocate_zeroed(cif->rtype->size);
+
+ ffi_call(cif, FFI_FN(func), return_data, values);
+
+ if (cif->rtype != &ffi_type_void) {
+ char *s;
+ PMC *ret_object;
+ s = Parrot_str_to_cstring(interp, nci_info->pcc_return_signature);
+ switch (*(char*)nci_info->return_translation) {
+ case 'p':
+ {
+ PMC *final_destination = PMCNULL;
+
+ if (*(void**)return_data != NULL) {
+ final_destination = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
+ VTABLE_set_pointer(interp, final_destination, *(void**)return_data);
+ }
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+
+ }
+ break;
+ case 't':
+ {
+ STRING *final_destination = Parrot_str_new(interp, *(char**)return_data, 0);
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+ }
+ break;
+ case 'f':
+ {
+ FLOATVAL final_destination = *(float*)return_data;
+
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, final_destination);
+ }
+ break;
+ default:
+ switch (s[0]) {
+ case 'N':
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(FLOATVAL*)return_data);
+ case 'I':
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(INTVAL*)return_data);
+ case 'P':
+ case 'S':
+ default:
+ ret_object = Parrot_pcc_build_call_from_c_args(interp,
+ call_object,
+ s, *(void**)return_data);
+ }
+ break;
+ }
+ Parrot_str_free_cstring(s);
+ }
+
+ /*
+ * Free memory used for cstrings,
+ * and any other translations that use temporary memory
+ */
+ for (i = 0; i < (size_t)nci_info->arity; i++) {
+ switch ((INTVAL)((char*)nci_info->arg_translation)[i]) {
+ case (INTVAL)'B':
+ if (translation_pointers[i]) {
+ Parrot_str_free_cstring((char*)translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'t':
+ if (translation_pointers[i]) {
+ Parrot_str_free_cstring((char*)translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'2':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(short*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'3':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(int*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'4':
+ VTABLE_set_integer_native(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (INTVAL)*(long*)((pmc_holder_t*)translation_pointers[i])->ival);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'V':
+ VTABLE_set_pointer(interp,
+ ((pmc_holder_t*)translation_pointers[i])->p,
+ (PMC*)*((pmc_holder_t*)translation_pointers[i])->pval);
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ case (INTVAL)'d':
+ case (INTVAL)'c':
+ case (INTVAL)'s':
+ case (INTVAL)'i':
+ case (INTVAL)'l':
+ case (INTVAL)'q':
+ if (translation_pointers[i]) {
+ mem_sys_free(translation_pointers[i]);
+ }
+ break;
+ default:
+ break;
+ }
+ }
+
+ if (nci_info->arity > 0 && middle_man) {
+ mem_sys_free(middle_man);
+ }
+ if (return_data) {
+ mem_sys_free(return_data);
+ }
+ if (values) {
+ mem_sys_free(values);
+ }
}
- func(INTERP, SELF, fb_info);
cont = INTERP->current_cont;
/*
@@ -424,7 +1438,7 @@
VTABLE INTVAL get_bool() {
Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
- return (0 != (INTVAL)nci_info->orig_func);
+ return (0 != (INTVAL)nci_info->cif);
}
/*
@@ -441,11 +1455,16 @@
INTVAL arity = 0;
if (nci_info) {
- if (!nci_info->func)
- build_func(INTERP, nci_info);
- if (nci_info->func) {
- arity = nci_info->arity;
- RETURN(INTVAL arity);
+ if (PObj_flag_TEST(private2, SELF)) {
+ }
+ else {
+ if (!nci_info->cif) {
+ nci_info->cif = build_libffi_func(interp, nci_info);
+ }
+ if (nci_info->cif) {
+ arity = nci_info->arity;
+ RETURN(INTVAL arity);
+ }
}
}
@@ -467,6 +1486,8 @@
Initial revision by sean 2002/08/04.
+Updates by John Harrison, Summer 2010, GSoC.
+
=cut
*/
@@ -477,3 +1498,6 @@
* End:
* vim: expandtab shiftwidth=4:
*/
+
+
+
Added: branches/gsoc_nci/t/steps/auto/libffi-01.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/t/steps/auto/libffi-01.t Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,89 @@
+#!perl
+# Copyright (C) 2001-2007, Parrot Foundation.
+# $Id$
+# auto/ctags-01.t
+
+use strict;
+use warnings;
+use Test::More tests => 9;
+use Carp;
+use lib qw( lib t/configure/testlib );
+use_ok('config::auto::libffi');
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Step::Test;
+use Parrot::Configure::Test qw(
+ test_step_constructor_and_description
+ );
+
+use IO::CaptureOutput qw| capture |;
+
+################### --without-libffi ###################
+
+my ($args, $step_list_ref) = process_options( {
+ argv => [],
+ mode => q{configure},
+} );
+
+my $conf = Parrot::Configure::Step::Test->new;
+$conf->include_config_results( $args );
+
+my ($task, $step_name, $step, $ret);
+my $pkg = q{auto::libffi};
+
+$conf->add_steps($pkg);
+
+my $serialized = $conf->pcfreeze();
+
+$conf->options->set(%{$args});
+$step = test_step_constructor_and_description($conf);
+
+$step->runstep($conf);
+is( $step->result(), q{yes}, "Got expected result" );
+is( $conf->data->get( 'HAS_LIBFFI' ), 1, "Got expected value for 'libffi'" );
+
+($args, $step_list_ref) = process_options( {
+ argv => [ q{--without-libffi} ],
+ mode => q{configure},
+} );
+
+$conf->options->set(%{$args});
+$step->runstep($conf);
+is( $step->result(), q{no}, "Got expected result" );
+is( $conf->data->get( 'HAS_LIBFFI' ), 0,
+ "'libffi' undefined as expected" );
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+ auto/libffi-01.t - test auto::libffi
+
+=head1 SYNOPSIS
+
+ % prove t/steps/auto/libffi-01.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+
+The tests in this file test configuration step class auto::libffi
+
+=head1 AUTHOR
+
+John Harrison
+
+=head1 SEE ALSO
+
+config::auto::libff, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Added: branches/gsoc_nci/t/steps/gen/libffi-01.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/t/steps/gen/libffi-01.t Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,62 @@
+#! perl
+# Copyright (C) 2007-2008, Parrot Foundation.
+# $Id$
+# gen/platform-01.t
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Path qw( mkpath );
+use File::Temp qw( tempdir );
+use File::Spec;
+use lib qw( lib );
+use_ok('config::gen::libffi');
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Step::Test;
+use Parrot::Configure::Test qw(
+ test_step_constructor_and_description
+);
+use Parrot::Configure::Utils qw( _slurp );
+use IO::CaptureOutput qw( capture );
+
+########## regular ##########
+
+sub
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+gen/libffi-01.t - test gen::libffi
+
+=head1 SYNOPSIS
+
+ % prove t/steps/gen/libffi-01.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+
+The tests in this file test gen::platform.
+
+=head1 AUTHOR
+
+John Harrison
+
+=head1 SEE ALSO
+
+config::gen::libffi, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: branches/gsoc_nci/tools/dev/nci_thunk_gen.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nci/tools/dev/nci_thunk_gen.nqp Tue Aug 17 18:47:31 2010 (r48554)
@@ -0,0 +1,276 @@
+pir::load_bytecode('nqp-setting.pbc');
+
+my $test := 1;
+
+grammar NCI-Thunk::Grammar {
+ token TOP { [\n? <signature> | [\#\N*] ]* }
+
+ token signature { <return> <args> }
+
+ token return { <identifer> }
+
+ token args { <identifer>* }
+
+ token identifer { <prefix> <symbol> }
+
+ token symbol { <[vpfdDbcsilqPV]> }
+
+ token prefix { <[*]>? <[u]>? }
+};
+
+=begin
+
+Sample NCI Thunk:
+
+static void
+pcf_d_JOd(PARROT_INTERP, PMC *nci, SHIM(PMC *self))
+{
+ typedef double(* func_t)(PARROT_INTERP, PMC *, double);
+ func_t fn_pointer;
+ void *orig_func;
+ PMC * ctx = CURRENT_CONTEXT(interp);
+ PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
+ PMC * ret_object = PMCNULL;
+ FLOATVAL return_data;
+
+ PMC * t_1;
+ FLOATVAL t_2;
+ UNUSED(return_data); /* Potentially unused, at least */
+ Parrot_pcc_fill_params_from_c_args(interp, call_object, "PiN", &t_1, &t_2);
+
+ GETATTR_NCI_orig_func(interp, nci, orig_func);
+ fn_pointer = (func_t)D2FPTR(orig_func);
+ return_data = (double)(*fn_pointer)(interp, t_1, t_2);
+ ret_object = Parrot_pcc_build_call_from_c_args(interp, call_object, "N", return_data);
+
+
+
+}
+=end
+
+class NCI-Thunk {
+ has $!sig;
+ has $!return;
+ has $!args;
+
+ method init($sig, $return, $args) {
+ my $r := NCI-Thunk.new;
+ $r.BUILD($sig, $return, $args);
+ return $r;
+ }
+
+ method BUILD($sig, $return, $args) {
+ $!sig := $sig;
+ $!return := $return;
+ $!args := $args;
+ say('args: ', $args);
+ }
+
+ class C-Type {
+ has $!pointer;
+ has $!size;
+ method set-pointer($p = 1) {
+ $!pointer := $p;
+ }
+ }
+
+ class C-Int is C-Type {
+ has $!signed;
+
+ my sub init_sizes() {
+ my %r;
+ %r<8> := 'char';
+ %r<c> := 'char';
+ %r<16> := 'short';
+ %r<s> := 'short';
+ %r<32> := 'int';
+ %r<i> := 'int';
+ %r<l> := 'long';
+ %r<64> := 'long long';
+ %r<q> := 'long long';
+ return %r;
+ }
+
+ our %sizes := init_sizes();
+
+ method set-signed() {
+ $!signed := 1;
+ }
+
+ method set-size(:$size!) {
+ # validate size:
+ # 8 - char
+ # 16 - short
+ # 32 - i int
+ # 32/64 - l long
+ # 64 - long long
+ $!size := %sizes{"$size"};
+ }
+
+ method Str() {
+ my $result;
+
+ if $!pointer {
+ $result := "* ";
+ }
+
+
+ }
+ }
+
+ class C-Num is C-Type {
+ method set-size(:$float, :$double, :$long-doule) {
+ if $float {
+ $!size := 'float';
+ }
+ elsif $double {
+ $!size := 'double';
+ }
+ elsif $long-double {
+ $!size := 'long double';
+ }
+ }
+
+ method Str() {
+ return $!state;
+ }
+ }
+
+ class C-Struct is C-Type {
+ }
+
+ our %type := hash(:i<int>, :q<long long>, :c<char>, );
+
+ my sub build_prototype($key) {
+ if $key ~~ /\{/ {
+ say('structure');
+ }
+ else {
+ say($key<prefix>);
+ say('normal type');
+ }
+
+
+ return %type{"$key"};
+ }
+
+ method Str() {
+ my $thunk := "
+static void
+pcf_" ~ $!return ~ '_' ~ $!args ~ '(PARROT_INTERP, PMC *nci, SHIM(PMC *self)) \{'; # add in proto types for all vars;
+ $thunk := $thunk ~ "
+ func_t fn_pointer;
+ void *orig_func;
+ PMC * ctx = CURRENT_CONTEXT(interp);
+ PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
+ PMC * ret_object = PMCNULL;
+ ";
+
+ if $!return ne 'v' {
+ $thunk := $thunk ~ build_prototype($!return) ~ " result;\n ";
+ }
+
+ $thunk := $thunk ~ "yo";
+
+ my $obj_count := 0;
+ for $!args<identifer> -> $a {
+ say($a);
+ }
+ say($!args<identifer>[0], 'and');
+ for $!args<identifer> -> $arg {
+ say("tes");
+ $thunk := $thunk ~ build_prototype($arg) ~ "\n";
+ }
+
+ if $!return ne 'v' {
+ $thunk := $thunk ~ 'grab result';
+ }
+ else {
+ $thunk := $thunk ~ 'ignore result';
+ }
+
+ $thunk := $thunk ~ "\n return;\n}";
+ return $thunk;
+ }
+}
+
+class NCI-Thunk::Actions {
+ has @!thunks;
+
+ method init() {
+ my $r := NCI-Thunk::Actions.new;
+ $r.BUILD();
+ return $r;
+ }
+
+ method BUILD() {
+ @!thunks := ();
+ }
+
+ method TOP($/) {
+ }
+ method return($/) {
+ }
+ method signature($/) {
+ my $sig := $/;
+ say('Sig is: ', $sig, ' and ', $<return>, ' arg: ', $<args>[0]);
+ @!thunks.push(NCI-Thunk.init($/, $<return>, $<args>));
+ }
+
+ method print_signature() {
+ for @!thunks -> $thunk {
+ say($thunk.Str);
+ }
+ return 'stuff' ~ +@!thunks;
+ }
+};
+
+
+sub tests() {
+ plan(11);
+
+ my $/;
+
+ $/ := NCI-Thunk::Grammar.parse("v");
+
+ ok($/<signature>[0]<return> eq 'v', 'Void with no args');
+
+ $/ := NCI-Thunk::Grammar.parse('vv');
+
+ ok($/<signature>[0]<return> eq 'v', 'Void with void args, return parsed');
+ ok($/<signature>[0]<args> eq 'v', 'Void with void args, args parsed');
+
+ $/ := NCI-Thunk::Grammar.parse('*v');
+
+ ok($/<signature>[0]<return><identifer><symbol> eq 'v', 'Still parses the symbol correctly');
+ ok($/<signature>[0]<return><identifer><prefix> eq '*', 'A void* works');
+
+ $/ := NCI-Thunk::Grammar.parse('iis');
+
+ ok($/<signature>[0]<args>, 'Parsed with multipe args correctly');
+ ok($/<signature>[0]<args><identifer>[0] eq 'i', 'First param is correct.');
+ ok($/<signature>[0]<args><identifer>[1] eq 's', 'Second param is correct.');
+
+ $/ := NCI-Thunk::Grammar.parse("vi\nvs\nis");
+
+ ok($/<signature>[0]<return> eq 'v' && $/<signature>[2]<return> eq 'i', "Multi-line Sig's parse");
+
+ $/ := NCI-Thunk::Grammar.parse("fi# comment is not parsed\nvi# foo");
+
+ ok($/<signature>[1]<return> eq 'v', "Comments parse correctly");
+
+ my $b := NCI-Thunk::Actions.init();
+
+ $/ := NCI-Thunk::Grammar.parse("vi*i", :actions($b));
+
+ my $c := pir::inspect__p_p($/);
+ say($c);
+ say($b.print_signature);
+ say($/.ast);
+}
+
+if $test {
+ tests();
+}
+
+# vim: ft=perl6
More information about the parrot-commits
mailing list