Index: tools/build/nativecall.pl
===================================================================
--- tools/build/nativecall.pl	(revision 42132)
+++ tools/build/nativecall.pl	(working copy)
@@ -30,6 +30,9 @@
 use strict;
 use warnings;
 
+use lib 'lib';
+use Parrot::NativeCall;
+
 my $opt_warndups = 0;
 
 # This file will eventually be compiled
@@ -37,65 +40,8 @@
 
 print_head( \@ARGV );
 
+my %sig_table = %Parrot::NativeCall::signature_table;
 
-my %sig_table = (
-    p => {
-        as_proto => "void *",
-        other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);",
-        sig_char => "P",
-        ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);",
-    },
-    i => { as_proto => "int",    sig_char => "I" },
-    l => { as_proto => "long",   sig_char => "I" },
-    c => { as_proto => "char",   sig_char => "I" },
-    s => { as_proto => "short",  sig_char => "I" },
-    f => { as_proto => "float",  sig_char => "N" },
-    d => { as_proto => "double", sig_char => "N" },
-    t => { as_proto => "char *",
-           other_decl => "STRING *final_destination;",
-           ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
-           sig_char => "S" },
-    v => { as_proto => "void",
-           return_type => "void *",
-           sig_char => "v",
-           ret_assign => "",
-           func_call_assign => ""
-         },
-    P => { as_proto => "PMC *", sig_char => "P" },
-    O => { as_proto => "PMC *", returns => "", sig_char => "Pi" },
-    J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" },
-    S => { as_proto => "STRING *", sig_char => "S" },
-    I => { as_proto => "INTVAL", sig_char => "I" },
-    N => { as_proto => "FLOATVAL", sig_char => "N" },
-    b => { as_proto => "void *", as_return => "", sig_char => "S" },
-    B => { as_proto => "char **", as_return => "", sig_char => "S" },
-    # These should be replaced by modifiers in the future
-    2 => { as_proto => "short *",  sig_char => "P", return_type => "short",
-           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
-    3 => { as_proto => "int *",  sig_char => "P", return_type => "int",
-           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
-    4 => { as_proto => "long *",  sig_char => "P", return_type => "long",
-           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
-    L => { as_proto => "long *", as_return => "" },
-    T => { as_proto => "char **", as_return => "" },
-    V => { as_proto => "void **", as_return => "", sig_char => "P" },
-    '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' },
-);
-
-for (values %sig_table) {
-    if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} }
-    if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} }
-    if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} }
-    if (not exists $_->{ret_assign} and exists $_->{sig_char}) {
-        $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
-                           . $_->{sig_char} . '", return_data);';
-    }
-    if (not exists $_->{func_call_assign}) {
-        $_->{func_call_assign} = "return_data = "
-    }
-}
-
-
 my $temp_cnt = 0;
 my (@put_pointer, @put_pointer_nci_too, @nci_defs);
 my %seen;
Index: lib/Parrot/NativeCall.pm
===================================================================
--- lib/Parrot/NativeCall.pm	(revision 0)
+++ lib/Parrot/NativeCall.pm	(revision 0)
@@ -0,0 +1,128 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+package Parrot::NativeCall;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+our @EXPORT_OK = qw{ signature_nci_to_pcc };
+
+=head1 NAME
+
+Parrot::NativeCall - Tools for building native call routines
+
+=head1 SYNOPSIS
+
+  use Parrot::NativeCall 'signature_nci_to_pcc';
+
+  my $pcc_sig = signature_nci_to_pcc("v  VVV");
+
+=head1 DESCRIPTION
+
+C<Parrot::NativeCall> knows how to map NCI signatures to nci frame
+functions.
+
+=head1 GLOBAL VARIABLES
+
+=over
+
+=item C<%signature_table>
+
+Maps NCI signature items to elements of a native call routine.
+
+For use by F<tools/build/nativecall.pl>. New code should probably write
+a wrapper in this module to encapsulate the access.
+
+=cut
+
+our %signature_table = (
+    p => {
+        as_proto => "void *",
+        other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);",
+        sig_char => "P",
+        ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);",
+    },
+    i => { as_proto => "int",    sig_char => "I" },
+    l => { as_proto => "long",   sig_char => "I" },
+    c => { as_proto => "char",   sig_char => "I" },
+    s => { as_proto => "short",  sig_char => "I" },
+    f => { as_proto => "float",  sig_char => "N" },
+    d => { as_proto => "double", sig_char => "N" },
+    t => { as_proto => "char *",
+           other_decl => "STRING *final_destination;",
+           ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
+           sig_char => "S" },
+    v => { as_proto => "void",
+           return_type => "void *",
+           sig_char => "v",
+           ret_assign => "",
+           func_call_assign => ""
+         },
+    P => { as_proto => "PMC *", sig_char => "P" },
+    O => { as_proto => "PMC *", returns => "", sig_char => "Pi" },
+    J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" },
+    S => { as_proto => "STRING *", sig_char => "S" },
+    I => { as_proto => "INTVAL", sig_char => "I" },
+    N => { as_proto => "FLOATVAL", sig_char => "N" },
+    b => { as_proto => "void *", as_return => "", sig_char => "S" },
+    B => { as_proto => "char **", as_return => "", sig_char => "S" },
+    # These should be replaced by modifiers in the future
+    2 => { as_proto => "short *",  sig_char => "P", return_type => "short",
+           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+    3 => { as_proto => "int *",  sig_char => "P", return_type => "int",
+           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+    4 => { as_proto => "long *",  sig_char => "P", return_type => "long",
+           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+    L => { as_proto => "long *", as_return => "" },
+    T => { as_proto => "char **", as_return => "" },
+    V => { as_proto => "void **", as_return => "", sig_char => "P" },
+    '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' },
+);
+
+for (values %signature_table) {
+    if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} }
+    if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} }
+    if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} }
+    if (not exists $_->{ret_assign} and exists $_->{sig_char}) {
+        $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
+                           . $_->{sig_char} . '", return_data);';
+    }
+    if (not exists $_->{func_call_assign}) {
+        $_->{func_call_assign} = "return_data = "
+    }
+}
+
+=back
+
+=head1 FUNCTIONS
+
+=over
+
+=item C<signature_nci_to_pcc>
+
+Converts an NCI signature to a PCC signature.
+
+=cut
+
+sub signature_nci_to_pcc {
+    my $nci_sig = shift;
+    my ($nci_ret, $nci_params) = $nci_sig =~ /^(.)\s*(\S*)/;
+    my $pcc_ret =  $signature_table{$nci_ret}{sig_char};
+    my $pcc_params = join '', map $signature_table{$_}{sig_char}, split //, $nci_params;
+    return "${pcc_params}->${pcc_ret}";
+}
+
+1;
+
+=back
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Index: t/pmc/nci.t
===================================================================
--- t/pmc/nci.t	(revision 42132)
+++ t/pmc/nci.t	(working copy)
@@ -5,8 +5,19 @@
 use strict;
 use warnings;
 use lib qw( . lib ../lib ../../lib );
+use Parrot::BuildUtil;
+use Parrot::NativeCall 'signature_nci_to_pcc';
+
+my @nci_sigs;
+BEGIN {
+    @nci_sigs =
+        grep {$_}
+        map {chomp; s/^\s*//; s/\s*$//; s/#.*$//; $_}
+        split /\n/, Parrot::BuildUtil::slurp_file('src/call_list.txt');
+}
+
 use Test::More;
-use Parrot::Test tests => 70;
+use Parrot::Test tests => (70 + @nci_sigs);
 use Parrot::Config qw(%PConfig);
 
 =head1 NAME
@@ -32,6 +43,27 @@
 
 $ENV{TEST_PROG_ARGS} ||= '';
 
+foreach my $nci_sig (@nci_sigs) {
+    my ($nci_ret, $nci_params) = $nci_sig =~ /\S+/g;
+    $nci_params ||= '';
+    my $pcc_sig = signature_nci_to_pcc($nci_sig);
+    pir_output_is( << "CODE", "$pcc_sig\n", "NCI PMC signatures equivalent to nativecall.pl ('$nci_sig')" );
+.include "nci.pasm"
+.sub test :main
+    .local pmc nci
+    nci = new ['NCI']
+    nci = "${nci_ret}${nci_params}"
+    .local string s
+    s = nci[ .PARROT_NCI_PCC_SIGNATURE_PARAMS ]
+    print s
+    print "->"
+    s = nci[ .PARROT_NCI_PCC_SIGNATURE_RET ]
+    print s
+    print "\\n"
+.end
+CODE
+}
+
 SKIP: {
     unless ( -e "runtime/parrot/dynext/libnci_test$PConfig{load_ext}" ) {
         skip( "Please make libnci_test$PConfig{load_ext}", Test::Builder->expected_tests() );