[svn:parrot] r44161 - in trunk: . config/gen/makefiles src/nci t/codingstd tools/build tools/dev

plobsing at svn.parrot.org plobsing at svn.parrot.org
Fri Feb 19 06:04:09 UTC 2010


Author: plobsing
Date: Fri Feb 19 06:04:05 2010
New Revision: 44161
URL: https://trac.parrot.org/parrot/changeset/44161

Log:
rename tools/build/nativecall.pir to tools/dev/nci_thunk_gen.pir
make nci_thunk_gen.pir part of install as parrot_nci_thunk_gen

Added:
   trunk/tools/dev/nci_thunk_gen.pir
      - copied, changed from r44158, trunk/tools/build/nativecall.pir
Deleted:
   trunk/tools/build/nativecall.pir
Modified:
   trunk/   (props changed)
   trunk/MANIFEST
   trunk/MANIFEST.SKIP
   trunk/MANIFEST.generated
   trunk/config/gen/makefiles/root.in
   trunk/src/nci/core_thunks.c
   trunk/src/nci/extra_thunks.c
   trunk/t/codingstd/linelength.t
   trunk/t/codingstd/trailing_space.t
   trunk/tools/dev/mk_nci_thunks.pl

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/MANIFEST	Fri Feb 19 06:04:05 2010	(r44161)
@@ -2135,7 +2135,6 @@
 tools/build/fixup_gen_file.pl                               []
 tools/build/h2inc.pl                                        []
 tools/build/headerizer.pl                                   []
-tools/build/nativecall.pir                                  []
 tools/build/ops2c.pl                                        [devel]
 tools/build/ops2pm.pl                                       []
 tools/build/parrot_config_c.pl                              []
@@ -2170,6 +2169,7 @@
 tools/dev/mk_nci_thunks.pl                                  []
 tools/dev/mk_rpm_manifests.pl                               []
 tools/dev/nci_test_gen.pl                                   []
+tools/dev/nci_thunk_gen.pir                                 []
 tools/dev/nm.pl                                             []
 tools/dev/nopaste.pl                                        []
 tools/dev/ops_not_tested.pl                                 []

Modified: trunk/MANIFEST.SKIP
==============================================================================
--- trunk/MANIFEST.SKIP	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/MANIFEST.SKIP	Fri Feb 19 06:04:05 2010	(r44161)
@@ -1,6 +1,6 @@
 # ex: set ro:
 # $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Fri Feb 19 01:11:00 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Feb 19 05:52:57 2010 UT
 #
 # This file should contain a transcript of the svn:ignore properties
 # of the directories in the Parrot subversion repository. (Needed for
@@ -105,6 +105,12 @@
 ^parrot_config\.pbc/
 ^parrot_debugger$
 ^parrot_debugger/
+^parrot_nci_thunk_gen$
+^parrot_nci_thunk_gen/
+^parrot_nci_thunk_gen\.c$
+^parrot_nci_thunk_gen\.c/
+^parrot_nci_thunk_gen\.pbc$
+^parrot_nci_thunk_gen\.pbc/
 ^parrot_test_run\.tar\.gz$
 ^parrot_test_run\.tar\.gz/
 ^pbc_disassemble$

Modified: trunk/MANIFEST.generated
==============================================================================
--- trunk/MANIFEST.generated	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/MANIFEST.generated	Fri Feb 19 06:04:05 2010	(r44161)
@@ -64,6 +64,7 @@
 installable_pbc_merge                             [main]bin
 installable_pbc_to_exe.exe                        [main]bin
 installable_pbc_to_exe                            [main]bin
+installable_parrot_nci_thunk_gen		  [main]bin
 installable_parrot-nqp.exe                        [main]bin
 installable_parrot-nqp                            [main]bin
 lib/Parrot/Config/Generated.pm                    [devel]lib

Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/config/gen/makefiles/root.in	Fri Feb 19 06:04:05 2010	(r44161)
@@ -526,6 +526,7 @@
 PARROT_CONFIG       = ./parrot_config$(EXE)
 PIRC                = ./pirc$(EXE)
 NQP_RX              = ./parrot-nqp$(EXE)
+PARROT_NCI_THUNK_GEN = ./parrot_nci_thunk_gen$(EXE)
 
 # Installable executables
 INSTALLABLEPARROT    = ./installable_parrot$(EXE)
@@ -536,6 +537,7 @@
 INSTALLABLEPDB       = ./installable_parrot_debugger$(EXE)
 INSTALLABLECONFIG    = ./installable_parrot_config$(EXE)
 INSTALLABLENQP       = ./installable_parrot-nqp$(EXE)
+INSTALLABLENCITHUNKGEN = ./installable_parrot_nci_thunk_gen$(EXE)
 
 # Libraries
 LIBPARROT_STATIC    = @blib_dir@/@libparrot_static@
@@ -804,7 +806,7 @@
 
 parrot_utils : $(PDUMP) $(DIS) $(PDB) $(PBC_MERGE) $(PBC_TO_EXE) $(PARROT_CONFIG) src/install_config$(O)
 
-installable: all $(INSTALLABLEPARROT) $(INSTALLABLEPDUMP) $(INSTALLABLEDIS) $(INSTALLABLEPDB) $(INSTALLABLEPBC_MERGE) $(INSTALLABLEPBCTOEXE) $(INSTALLABLECONFIG) $(INSTALLABLENQP)
+installable: all $(INSTALLABLEPARROT) $(INSTALLABLEPDUMP) $(INSTALLABLEDIS) $(INSTALLABLEPDB) $(INSTALLABLEPBC_MERGE) $(INSTALLABLEPBCTOEXE) $(INSTALLABLECONFIG) $(INSTALLABLENQP) $(INSTALLABLENCITHUNKGEN)
 
 
 flags_dummy :
@@ -829,6 +831,12 @@
 	$(PARROT) -o pbc_to_exe.pbc tools/dev/pbc_to_exe.pir
 	$(PARROT) pbc_to_exe.pbc pbc_to_exe.pbc
 
+parrot_nci_thunk_gen.pbc : tools/dev/nci_thunk_gen.pir $(LIBRARY_DIR)/data_json.pbc $(PARROT)
+	$(PARROT) -o parrot_nci_thunk_gen.pbc tools/dev/nci_thunk_gen.pir
+
+$(PARROT_NCI_THUNK_GEN) : parrot_nci_thunk_gen.pbc $(PBC_TO_EXE)
+	$(PBC_TO_EXE) parrot_nci_thunk_gen.pbc
+
 $(PARROT_CONFIG) : tools/util/parrot-config.pir $(PARROT) $(PBC_TO_EXE)
 	$(PARROT) -o parrot_config.pbc tools/util/parrot-config.pir
 	$(PARROT) pbc_to_exe.pbc parrot_config.pbc
@@ -941,6 +949,9 @@
 $(INSTALLABLEPBCTOEXE) : $(PBC_TO_EXE) src/install_config$(O)
 	$(PBC_TO_EXE) pbc_to_exe.pbc --install
 
+$(INSTALLABLENCITHUNKGEN) : parrot_nci_thunk_gen.pbc $(PBC_TO_EXE) src/install_config$(O)
+	$(PBC_TO_EXE) parrot_nci_thunk_gen.pbc --install
+
 #
 # Parrot Debugger
 #
@@ -1833,8 +1844,11 @@
     $(INSTALLABLEPDB) \
     $(INSTALLABLECONFIG) \
     $(INSTALLABLENQP) \
+    $(INSTALLABLENCITHUNKGEN) \
     pbc_to_exe.pbc pbc_to_exe.c pbc_to_exe$(O) pbc_to_exe$(EXE) \
     parrot_config$(EXE) parrot_config.c parrot_config$(O) parrot_config.pbc \
+    parrot_nci_thunk_gen$(EXE) parrot_nci_thunk_gen.c \
+    parrot_nci_thunk_gen$(O) parrot_nci_thunk_gen.pbc \
     compilers/imcc/main$(O) \
     $(PDUMP) src/pbc_dump$(O) src/packdump$(O) \
     $(PDB) src/parrot_debugger$(O) \
@@ -1871,6 +1885,7 @@
     $(INSTALLABLEPDB) \
     $(INSTALLABLECONFIG) \
     $(INSTALLABLENQP) \
+    $(INSTALLABLENCITHUNKGEN) \
     compilers/imcc/main$(O) \
     $(PDUMP) src/pbc_dump$(O) src/packdump$(O) \
     $(PDB) src/parrot_debugger$(O) \
@@ -2414,8 +2429,8 @@
 # for use by runtime/parrot/library/OpenGL.pir
 src/glut_callbacks$(O): $(GENERAL_H_FILES)
 
-src/glut_nci_thunks.c: $(PARROT) runtime/parrot/library/data_json.pbc tools/build/nativecall.pir
-	$(PARROT) tools/build/nativecall.pir \
+src/glut_nci_thunks.c: $(PARROT_NCI_THUNK_GEN)
+	$(PARROT_NCI_THUNK_GEN) \
 	    --loader-name=Parrot_glut_nci_loader \
 	    --loader-storage-class=PARROT_DYNEXT_EXPORT \
 	    --output=src/glut_nci_thunks.c \

Modified: trunk/src/nci/core_thunks.c
==============================================================================
--- trunk/src/nci/core_thunks.c	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/src/nci/core_thunks.c	Fri Feb 19 06:04:05 2010	(r44161)
@@ -1,7 +1,7 @@
 /* ex: set ro ft=c:
  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  *
- * This file is generated automatically by tools/build/nativecall.pir
+ * This file is generated automatically by parrot_nci_thunk_gen
  *
  * Any changes made here will be lost!
  *

Modified: trunk/src/nci/extra_thunks.c
==============================================================================
--- trunk/src/nci/extra_thunks.c	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/src/nci/extra_thunks.c	Fri Feb 19 06:04:05 2010	(r44161)
@@ -1,7 +1,7 @@
 /* ex: set ro ft=c:
  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  *
- * This file is generated automatically by tools/build/nativecall.pir
+ * This file is generated automatically by parrot_nci_thunk_gen
  *
  * Any changes made here will be lost!
  *

Modified: trunk/t/codingstd/linelength.t
==============================================================================
--- trunk/t/codingstd/linelength.t	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/t/codingstd/linelength.t	Fri Feb 19 06:04:05 2010	(r44161)
@@ -125,7 +125,7 @@
 compilers/pirc/macro/macroparser.h
 compilers/pirc/src/hdocprep.l
 compilers/pirc/src/hdocprep.c
-# generated by tools/build/nativecall.pir
+# generated by tools/dev/nci_thunk_gen.pir
 src/nci/core_thunks.c
 src/nci/extra_thunks.c
 # these ones include long POD

Modified: trunk/t/codingstd/trailing_space.t
==============================================================================
--- trunk/t/codingstd/trailing_space.t	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/t/codingstd/trailing_space.t	Fri Feb 19 06:04:05 2010	(r44161)
@@ -70,7 +70,7 @@
 # vim: expandtab shiftwidth=4:
 
 __DATA__
-# generated by tools/build/nativecall.pir
+# generated by tools/dev/nci_thunk_gen.pir
 src/nci/core_thunks.c
 src/nci/extra_thunks.c
 

Deleted: trunk/tools/build/nativecall.pir
==============================================================================
--- trunk/tools/build/nativecall.pir	Fri Feb 19 06:04:05 2010	(r44160)
+++ /dev/null	00:00:00 1970	(deleted)
@@ -1,1017 +0,0 @@
-# Copyright (C) 2010, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-tools/build/nativecall.pir - Build up the native call routines
-
-=head1 SYNOPSIS
-
-    % ./parrot tools/build/nativecall.pir -o src/nci/extra_thunks.c <src/nci/extra_thunks.nci
-
-=head1 DESCRIPTION
-
-This script creates Native Call Interface files. It parses a file of function
-signatures of the form:
-
- <return-type-specifier><ws><parameter-type-specifiers>[<ws>][#<comment>]
-    ...
-Empty lines and lines containing only whitespace or comment are ignored.
-The types specifiers are documented in F<src/nci/extra_thunks.nci>.
-
-=head1 SEE ALSO
-
-F<src/nci/extra_thunks.nci>.
-F<docs/pdds/pdd16_native_call.pod>.
-
-=cut
-
-.macro_const VERSION 0.01
-
-.macro_const SIG_TABLE_GLOBAL_NAME  'signature_table'
-.macro_const OPTS_GLOBAL_NAME       'options'
-
-.sub 'main' :main
-    .param pmc argv
-
-    # initialize global variables
-    'gen_sigtable'()
-    'get_options'(argv)
-
-    .local string targ
-    targ = 'read_from_opts'('target')
-
-    .local pmc sigs
-    sigs = 'read_sigs'()
-
-    $S0 = 'read_from_opts'('output')
-    $P0 = open $S0, 'w'
-    setstdout $P0
-
-    if targ == 'head'   goto get_targ
-    if targ == 'thunks' goto get_targ
-    if targ == 'loader' goto get_targ
-    if targ == 'coda'   goto get_targ
-    if targ == 'all'    goto all
-    if targ == 'names'  goto names
-    if targ == 'signatures'   goto signatures
-
-    # unknown target
-    $S0 = 'sprintf'("Unknown target type '%s'", targ)
-    die $S0
-
-  all:
-    $S0 = 'get_head'(sigs)
-    say $S0
-    $S0 = 'get_thunks'(sigs)
-    say $S0
-    $S0 = 'get_loader'(sigs)
-    say $S0
-    $S0 = 'get_coda'(sigs)
-    say $S0
-    exit 0
-
-  get_targ:
-    $S0 = concat 'get_', targ
-    $P0 = get_global $S0
-    $S1 = $P0(sigs)
-    say $S1
-    exit 0
-
-  names:
-    die "names not yet implemented"
-  signatures:
-    die "signatures not yet implemented"
-.end
-
-# getopt stuff {{{
-
-.macro_const OUTPUT                 'output'
-.macro_const THUNK_STORAGE_CLASS    'thunk-storage-class'
-.macro_const THUNK_NAME_PROTO       'thunk-name-proto'
-.macro_const LOADER_STORAGE_CLASS   'loader-storage-class'
-.macro_const LOADER_NAME            'loader-name'
-.macro_const CORE                   'core'
-
-.sub 'get_options'
-    .param pmc argv
-
-    load_bytecode 'Getopt/Obj.pbc'
-
-    .local pmc getopt
-    getopt = new ['Getopt';'Obj']
-    push getopt, 'help|h'
-    push getopt, 'version|v'
-    push getopt, 'core'
-    push getopt, 'output|o=s'
-    push getopt, 'target=s'
-    push getopt, 'thunk-storage-class=s'
-    push getopt, 'thunk-name-proto=s'
-    push getopt, 'loader-storage-class=s'
-    push getopt, 'loader-name=s'
-
-    .local string prog_name
-    prog_name = shift argv
-
-    .local pmc opt
-    opt = getopt.'get_options'(argv)
-
-    $I0 = opt['help']
-    if $I0 goto print_help
-
-    $I0 = opt['version']
-    if $I0 goto print_version
-
-    'fixup_opts'(opt)
-
-    set_global .OPTS_GLOBAL_NAME, opt
-    .return()
-
-  print_help:
-    'usage'(prog_name)
-  print_version:
-    'version'(prog_name)
-.end
-
-.sub 'usage'
-    .param string prog_name
-    print prog_name
-    say ' - Parrot NCI thunk library creation utility'
-    say <<'USAGE'
-
-Creates a C file of routines suitable for use as Parrot NCI thunks.
-
-Usage ./parrot nativecall.pir [options] -o output_c_file.c <input_signature_list.nci
-
-Options
-    --help              print this message and exit
-    --version           print the version number of this utility
-    --core              output a thunks file suitable for inclusion in Parrot core. Default is no.
-    -o --output <file>  specify output file to use.
-    --target <target>   select what to output (valid options are 'head', 'thunks',
-                        'loader', 'coda', 'all', 'names', and 'signatures'). Default value is 'all'
-    --thunk-storage-class <storage class>
-                        set the storage class used for the thunks. Default value is 'static'.
-    --thunk-name-proto <printf prototype>
-                        set the prototype used for the thunk function names. Must be a printf
-                        format with arity 1. Default value is 'pcf_%s'
-    --loader-storage-class
-                        set the storage class used for the loader function. Default value is none.
-    --loader-name       set the name used for the loader function. Default value is 'Parrot_load_nci_thunks'.
-USAGE
-    exit 0
-.end
-
-.sub 'version'
-    .param string prog_name
-    print prog_name
-    print ' version '
-    say .VERSION
-    exit 0
-.end
-
-.sub 'fixup_opts'
-    .param pmc opts
-
-    $I0 = defined opts['core']
-    if $I0 goto in_core
-        opts['core'] = ''
-        goto end_core
-    in_core:
-        opts['core'] = 'true'
-    end_core:
-
-    $I0 = defined opts['target']
-    if $I0 goto end_target
-        opts['target'] = 'all'
-    end_target:
-
-    $I0 = defined opts['thunk-storage-class']
-    if $I0 goto end_thunk_storage_class
-        opts['thunk-storage-class'] = 'static'
-    end_thunk_storage_class:
-
-    $I0 = defined opts['thunk-name-proto']
-    if $I0 goto end_thunk_name_proto
-        opts['thunk-name-proto'] = 'pcf_%s'
-    end_thunk_name_proto:
-
-    $S0 = opts['thunk-name-proto']
-    $I0 = 'printf_arity'($S0)
-    if $I0 == 1 goto end_thunk_name_proto_printf_arity
-        'sprintf'("Provided proto for 'thunk-name-proto' is of incorrect arity %i (expected 1)", $I0)
-        die $S0
-    end_thunk_name_proto_printf_arity:
-
-    $I0 = defined opts['loader-storage-class']
-    if $I0 goto end_loader_storage_class
-        opts['loader-storage-class'] = ''
-    end_loader_storage_class:
-
-    $I0 = defined opts['loader-name']
-    if $I0 goto end_loader_name
-        opts['loader-name'] = 'Parrot_load_nci_thunks'
-    end_loader_name:
-.end
-
-.sub 'read_from_opts'
-    .param string key
-
-    .local pmc opts
-    opts = get_global .OPTS_GLOBAL_NAME
-
-    $I0 = defined opts[key]
-    unless $I0 goto not_present
-
-    $S0 = opts[key]
-    .return ($S0)
-
-  not_present:
-    $S0 = 'sprintf'("Parameter '%s' required but not provided", key)
-    die $S0
-.end
-
-# }}}
-
-# get_{head,thunks,loader,coda} {{{
-
-.sub 'get_head'
-    .param pmc ignored :slurpy
-
-    .local string in_core
-    in_core = 'read_from_opts'(.CORE)
-
-    .local string ext_defn
-    ext_defn = ''
-    if in_core goto end_ext_defn
-        ext_defn = '#define PARROT_IN_EXTENSION'
-    end_ext_defn:
-
-    .local string c_file
-    c_file = 'read_from_opts'(.OUTPUT)
-
-    .local string str_file
-    str_file = clone c_file
-    substr str_file, -2, 2, '.str'
-    strip_str_file_loop:
-        $I0 = index str_file, '/'
-        if $I0 < 0 goto end_strip_str_file_loop
-        $I0 += 1
-        str_file = substr str_file, $I0
-        goto strip_str_file_loop
-    end_strip_str_file_loop:
-
-    .local string head
-    head = 'sprintf'(<<'HEAD', c_file, ext_defn, str_file)
-/* ex: set ro ft=c:
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *
- * This file is generated automatically by tools/build/nativecall.pir
- *
- * Any changes made here will be lost!
- *
- */
-
-/* %s
- *  Copyright (C) 2010, Parrot Foundation.
- *  SVN Info
- *     $Id$
- *  Overview:
- *     Native Call Interface routines. The code needed to build a
- *     parrot to C call frame is in here
- *  Data Structure and Algorithms:
- *  History:
- *  Notes:
- *  References:
- */
-
-%s
-#include "parrot/parrot.h"
-#include "pmc/pmc_nci.h"
-
-
-#ifdef PARROT_IN_EXTENSION
-/* external libraries can't have strings statically compiled into parrot */
-#  define CONST_STRING(i, s) Parrot_str_new_constant((i), (s))
-#else
-#  include "%s"
-#endif
-
-/* HEADERIZER HFILE: none */
-/* HEADERIZER STOP */
-
-/* All our static functions that call in various ways. Yes, terribly
-   hackish, but that is just fine */
-
-HEAD
-    .return (head)
-.end
-
-.sub 'get_thunks'
-    .param pmc sigs
-    .local string code
-    .local int i, n
-    code = ''
-    i = 0
-    n = sigs
-    loop:
-        if i >= n goto end_loop
-
-        .local pmc sig
-        sig = sigs[i]
-        $S0 = 'sig_to_fn_code'(sig :flat)
-        code = concat code, $S0
-
-        inc i
-        goto loop
-    end_loop:
-    .return (code)
-.end
-
-.sub 'get_loader'
-    .param pmc sigs
-
-    $S0 = 'read_from_opts'(.LOADER_STORAGE_CLASS)
-    $S1 = 'read_from_opts'(.LOADER_NAME)
-    .local string code
-    code = 'sprintf'(<<'FN_HEADER', $S0, $S1)
-
-%s void
-%s(PARROT_INTERP)
-{
-    PMC        *iglobals;
-    PMC        *temp_pmc;
-
-    PMC        *HashPointer   = NULL;
-
-    iglobals = interp->iglobals;
-    if (PMC_IS_NULL(iglobals))
-        PANIC(interp, "iglobals isn't created yet");
-
-    HashPointer = VTABLE_get_pmc_keyed_int(interp, iglobals,
-            IGLOBALS_NCI_FUNCS);
-    if (PMC_IS_NULL(HashPointer))
-        PANIC(interp, "iglobals.nci_funcs isn't created yet");
-
-FN_HEADER
-
-    .local int i, n
-    i = 0
-    n = sigs
-    loop:
-        if i >= n goto end_loop
-
-        .local pmc sig
-        sig = shift sigs
-
-        .local string fn_name
-        fn_name = 'sig_to_fn_name'(sig :flat)
-
-        .local string key
-        key = join '', sig
-
-        $S0 = 'sprintf'(<<'TEMPLATE', fn_name, key)
-    temp_pmc = pmc_new(interp, enum_class_UnManagedStruct);
-    VTABLE_set_pointer(interp, temp_pmc, (void *)%s);
-    VTABLE_set_pmc_keyed_str(interp, HashPointer, CONST_STRING(interp, "%s"), temp_pmc);
-
-TEMPLATE
-        code = concat code, $S0
-
-        inc i
-        goto loop
-    end_loop:
-
-    code = concat code, <<'FN_FOOTER'
-}
-FN_FOOTER
-
-    .return (code)
-.end
-
-.sub 'get_coda'
-    .param pmc ignored :slurpy
-    .return (<<'CODA')
-
-/*
- * Local variables:
- *   c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-CODA
-.end
-
-# }}}
-
-# sig_to_* {{{
-
-.sub 'sig_to_fn_code'
-    .param pmc args :slurpy
-
-    .local string fn_decl
-    fn_decl = 'sig_to_fn_decl'(args :flat)
-
-    .local string var_decls
-    var_decls = 'sig_to_var_decls'(args :flat)
-
-    .local string preamble
-    preamble = 'sig_to_preamble'(args :flat)
-
-    .local string call
-    call = 'sig_to_call'(args :flat)
-
-    .local string postamble
-    postamble = 'sig_to_postamble'(args :flat)
-
-    .local string fn_code
-    fn_code = 'sprintf'("%s{\n%s%s%s%s}\n", fn_decl, var_decls, preamble, call, postamble)
-
-    .return (fn_code)
-.end
-
-.sub 'sig_to_postamble'
-    .param string ret
-    .param string params
-
-    .local string final_assign
-    $P0 = 'map_from_sig_table'(ret, 'ret_assign')
-    final_assign = $P0[0]
-
-    .local string extra_postamble
-    $P0 = 'map_from_sig_table'(params, 'postamble_tmpl')
-    'fill_tmpls_ascending_ints'($P0)
-    extra_postamble = join "\n", $P0
-
-    .local string postamble
-    postamble = 'sprintf'(<<'TEMPLATE', final_assign, extra_postamble)
-    %s
-    %s
-TEMPLATE
-    .return (postamble)
-.end
-
-.sub 'sig_to_call'
-    .param string ret
-    .param string params
-
-    .local string return_assign
-    $P0 = 'map_from_sig_table'(ret, 'func_call_assign')
-    return_assign = $P0[0]
-
-    .local string ret_cast
-    $P0 = 'map_from_sig_table'(ret, 'as_return')
-    ret_cast = $P0[0]
-    if ret_cast == 'void' goto void_fn
-        ret_cast = 'sprintf'('(%s)', ret_cast)
-        goto end_ret_cast
-    void_fn:
-        ret_cast = ''
-    end_ret_cast:
-
-    .local string call_params
-    $P0 = 'map_from_sig_table'(params, 'call_param_tmpl')
-    'fill_tmpls_ascending_ints'($P0)
-    call_params = join ', ', $P0
-
-    .local string call
-    call = 'sprintf'(<<'TEMPLATE', return_assign, ret_cast, call_params)
-    GETATTR_NCI_orig_func(interp, self, orig_func);
-    fn_pointer = (func_t)D2FPTR(orig_func);
-    %s %s(*fn_pointer)(%s);
-TEMPLATE
-    .return (call)
-.end
-
-.sub 'sig_to_preamble'
-    .param string ret
-    .param string params
-
-    unless params goto return
-
-    .local string sig
-    $P0 = 'map_from_sig_table'(params, 'sig_char')
-    sig = join "", $P0
-
-    .local string fill_params
-    $P0 = 'map_from_sig_table'(params, 'fill_params_tmpl')
-    'fill_tmpls_ascending_ints'($P0)
-    fill_params = join "", $P0
-
-    .local string extra_preamble
-    $P0 = 'map_from_sig_table'(params, 'preamble_tmpl')
-    'fill_tmpls_ascending_ints'($P0)
-    extra_preamble = join "", $P0
-
-    .local string preamble
-    preamble = 'sprintf'(<<'TEMPLATE', sig, fill_params, extra_preamble)
-    Parrot_pcc_fill_params_from_c_args(interp, call_object, "%s"%s);
-    %s
-TEMPLATE
-
-  return:
-    .return (preamble)
-.end
-
-.sub 'sig_to_var_decls'
-    .param string ret
-    .param string params
-
-    .local string ret_csig
-    $P0 = 'map_from_sig_table'(ret, 'as_return')
-    ret_csig = $P0[0]
-
-    .local string params_csig
-    $P0 = 'map_from_sig_table'(params, 'as_proto')
-    params_csig = join ', ', $P0
-
-    .local string ret_tdecl
-    ret_tdecl = ""
-    $P0 = 'map_from_sig_table'(ret, 'return_type')
-    $S0 = $P0[0]
-    unless $S0 goto end_ret_type
-    if $S0 == 'void' goto end_ret_type
-        $S0 = 'sprintf'("%s return_data;\n", $S0)
-        ret_tdecl = concat ret_tdecl, $S0
-    end_ret_type:
-    $P0 = 'map_from_sig_table'(ret, 'final_dest')
-    $S0 = $P0[0]
-    unless $S0 goto end_final_dest
-        $S0 = concat $S0, "\n"
-        ret_tdecl = concat ret_tdecl, $S0
-    end_final_dest:
-
-    .local string params_tdecl
-    $P0 = 'map_from_sig_table'(params, 'temp_tmpl')
-    'fill_tmpls_ascending_ints'($P0)
-    $P0 = 'grep_for_true'($P0)
-    params_tdecl = join ";\n    ", $P0
-
-    .local string var_decls
-    var_decls = 'sprintf'(<<'TEMPLATE', ret_csig, params_csig, ret_tdecl, params_tdecl)
-    typedef %s(* func_t)(%s);
-    func_t fn_pointer;
-    void *orig_func;
-    PMC *ctx         = CURRENT_CONTEXT(interp);
-    PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
-    %s
-    %s;
-TEMPLATE
-
-    .return (var_decls)
-.end
-
-.sub 'sig_to_fn_decl'
-    .param pmc sig :slurpy
-    .local string storage_class, fn_name, fn_decl
-    storage_class = 'read_from_opts'(.THUNK_STORAGE_CLASS)
-    fn_name = 'sig_to_fn_name'(sig :flat)
-    fn_decl = 'sprintf'(<<'TEMPLATE', storage_class, fn_name)
-%s void
-%s(PARROT_INTERP, PMC *self)
-TEMPLATE
-    .return (fn_decl)
-.end
-
-.sub 'sig_to_fn_name'
-    .param string ret
-    .param string params
-
-    .local string fix_params
-    $P0 = 'map_from_sig_table'(params, 'cname')
-    fix_params = join '', $P0
-
-
-    $S0 = 'sprintf'('%s_%s', ret, fix_params)
-    $S1 = 'read_from_opts'(.THUNK_NAME_PROTO)
-    $S2 = 'sprintf'($S1, $S0)
-    .return ($S2)
-.end
-
-.sub 'map_from_sig_table'
-    .param string sig
-    .param string field_name
-
-    .local pmc sig_table
-    sig_table = get_global .SIG_TABLE_GLOBAL_NAME
-
-    $P0 = split '', sig
-
-    .local pmc result
-    result = new ['ResizableStringArray']
-    $I0 = $P0
-    result = $I0
-
-    $I0 = $P0
-    $I1 = 0
-    loop:
-        if $I1 >= $I0 goto end_loop
-        $S0 = $P0[$I1]
-        $S1 = sig_table[$S0; field_name]
-        result[$I1] = $S1
-        inc $I1
-        goto loop
-    end_loop:
-
-    .return (result)
-.end
-
-# }}}
-
-# read_sigs {{{
-
-.sub 'read_sigs'
-    .local pmc stdin, seen, sigs
-    stdin = getstdin
-    seen  = new ['Hash']
-    sigs  = new ['ResizablePMCArray']
-
-    .local int lineno
-    lineno = 0
-    read_loop:
-        unless stdin goto end_read_loop
-
-        .local string ret_sig, param_sig, full_sig
-        (ret_sig, param_sig) = 'read_one_sig'(stdin)
-        inc lineno
-        full_sig = concat ret_sig, param_sig
-
-        # filter out empty sigs (and empty lines)
-        unless full_sig goto read_loop
-
-        # de-dup sigs
-        $I0 = seen[full_sig]
-        unless $I0 goto unseen
-            $S0 = 'sprintf'("Ignored signature '%s' on line %d (previously seen on line %d)\n", full_sig, lineno, $I0)
-            printerr $S0
-            goto read_loop
-        unseen:
-        seen[full_sig] = lineno
-
-        .local pmc sig
-        sig = new ['ResizableStringArray']
-        sig = 2
-        sig[0] = ret_sig
-        sig[1] = param_sig
-        push sigs, sig
-
-        goto read_loop
-    end_read_loop:
-
-    .return (sigs)
-.end
-
-.sub 'read_one_sig'
-    .param pmc fh
-
-    .local string line
-    line = readline fh
-
-    # handle comments
-    $I0 = index line, '#'
-    if $I0 < 0 goto end_comment
-        line = substr line, 0, $I0
-    end_comment:
-
-    # convert whitespace into spaces
-    $S0 = '\t'
-    whitespace_loop:
-        $I0 = index line, $S0
-        if $I0 < 0 goto end_whitespace_loop
-        substr line, $I0, 1, ' '
-        goto whitespace_loop
-    end_whitespace_loop:
-
-    if $S0 == "\n" goto end_whitespace
-        $S0 = "\n"
-        goto whitespace_loop
-    end_whitespace:
-
-    # turn multiple spaces into a single space
-    multispace_loop:
-        $I0 = index line, '  '
-        if $I0 < 0 goto end_multispace_loop
-        $S0 = substr line, $I0, 2, ' '
-        goto multispace_loop
-    end_multispace_loop:
-
-    # remove leading whitespace
-    $S0 = substr line, 0, 1
-    unless $S0 == ' ' goto end_leading
-        $S0 = substr line, 0, 1, ''
-    end_leading:
-
-    # handle empty (or whitespace only) lines
-    if line == '' goto ret
-    if line == ' ' goto ret
-
-    # remove trailing whitespace
-    $S0 = substr line, -1, 1
-    unless $S0 == ' ' goto end_trailing
-        $S0 = substr line, -1, 1, ''
-    end_trailing:
-
-    # read the signature
-    .local string ret_sig, param_sig
-    $P0 = split ' ', line
-    ret_sig   = $P0[0]
-    param_sig = $P0[1]
-
-  ret:
-    .return (ret_sig, param_sig)
-.end
-
-#}}}
-
-# gen_sigtable {{{
-
-.sub 'gen_sigtable'
-    $S0 = 'sigtable_json'()
-    $P0 = 'decode_table'($S0)
-    'fixup_table'($P0)
-    set_global .SIG_TABLE_GLOBAL_NAME, $P0
-.end
-
-.sub 'decode_table'
-    .param string json
-
-    .local pmc compiler
-    load_bytecode 'data_json.pbc'
-    compiler = compreg 'data_json'
-
-    .local pmc table
-    $P0 = compiler.'compile'(json)
-    table = $P0()
-
-    .return (table)
-.end
-
-.sub 'fixup_table'
-    .param pmc table
-
-    .local pmc table_iter
-    table_iter = iter table
-  iter_loop:
-    unless table_iter goto iter_end
-
-    .local string k
-    .local pmc v
-    k = shift table_iter
-    v = table[k]
-
-    $I0 = exists v['cname']
-    if $I0 goto has_cname
-        v['cname'] = k
-    has_cname:
-
-    $I0 = exists v['as_return']
-    if $I0 goto has_as_return
-        $S0 = v['as_proto']
-        v['as_return'] = $S0
-    has_as_return:
-
-    $I0 = exists v['return_type']
-    if $I0 goto has_return_type
-        $S0 = v['as_proto']
-        v['return_type'] = $S0
-    has_return_type:
-
-    $I0 = exists v['ret_assign']
-    $I1 = exists v['sig_char']
-    $I1 = !$I1
-    $I0 = $I0 || $I1 # not (not exists v[ret_assign] and exists v[sig_char])
-    if $I0 goto has_ret_assign
-        $S0 = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
-        $S1 = v['sig_char']
-        $S0 = concat $S0, $S1
-        $S0 = concat $S0, '", return_data);'
-        v['ret_assign'] = $S0
-    has_ret_assign:
-
-    $I0 = exists v['func_call_assign']
-    if $I0 goto has_func_call_assign
-        v['func_call_assign'] = 'return_data = '
-    has_func_call_assign:
-
-    $I0 = exists v['temp_tmpl']
-    if $I0 goto has_temp_tmpl
-        $S0 = v['return_type']
-        $S0 = concat $S0, " t_%i"
-        v['temp_tmpl'] = $S0
-    has_temp_tmpl:
-
-    $I0 = exists v['fill_params_tmpl']
-    if $I0 goto has_fill_params_tmpl
-        v['fill_params_tmpl'] = ', &t_%i'
-    has_fill_params_tmpl:
-
-    $I0 = exists v['call_param_tmpl']
-    if $I0 goto has_call_param_tmpl
-        v['call_param_tmpl'] = 't_%i'
-    has_call_param_tmpl:
-
-    goto iter_loop
-  iter_end:
-
-    .return ()
-.end
-
-.sub 'sigtable_json'
-    .const string retv = <<'JSON'
-{
-    "p": { "as_proto":   "void *",
-           "final_dest": "PMC * final_destination = PMCNULL;",
-           "temp_tmpl": "PMC *t_%i",
-           "sig_char":   "P",
-           "call_param_tmpl": "PMC_IS_NULL((PMC*)t_%i) ? (void *)NULL : VTABLE_get_pointer(interp, t_%i)",
-           "ret_assign": "if (return_data != NULL) {
-                             final_destination = pmc_new(interp, enum_class_UnManagedStruct);
-                             VTABLE_set_pointer(interp, final_destination, return_data);
-                          }
-                          Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);" },
-    "i": { "as_proto": "int", "sig_char": "I",
-           "return_type": "INTVAL" },
-    "l": { "as_proto": "long",   "sig_char": "I", "return_type": "INTVAL" },
-    "c": { "as_proto": "char",   "sig_char": "I", "return_type": "INTVAL" },
-    "s": { "as_proto": "short",  "sig_char": "I", "return_type": "INTVAL" },
-    "f": { "as_proto": "float",  "sig_char": "N", "return_type": "FLOATVAL" },
-    "d": { "as_proto": "double", "sig_char": "N", "return_type": "FLOATVAL" },
-    "t": { "as_proto": "char *",
-           "final_dest": "STRING *final_destination;",
-           "ret_assign": "final_destination = Parrot_str_new(interp, return_data, 0);
-                          Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
-           "sig_char": "S",
-           "temp_tmpl": "char *t_%i; STRING *ts_%i",
-           "fill_params_tmpl": ", &ts_%i",
-           "preamble_tmpl": "t_%i = ts_%i ? Parrot_str_to_cstring(interp, ts_%i) : (char *)NULL;",
-           "postamble_tmpl": "if (t_%i) Parrot_str_free_cstring(t_%i);" },
-    "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": "",
-           "fill_params_tmpl": "",
-           "call_param_tmpl": "interp",
-           "temp_tmpl": "",
-           "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",
-           "temp_tmpl":"STRING *t_%i",
-           "call_param_tmpl": "Buffer_bufstart(t_%i)" },
-    "B": { "as_proto": "char **",
-           "as_return": "",
-           "sig_char": "S",
-           "fill_params_tmpl": ", &ts_%i",
-           "temp_tmpl": "char *t_%i; STRING *ts_%i",
-           "preamble_tmpl": "t_%i = ts_%i ? Parrot_str_to_cstring(interp, ts_%i) : (char *) NULL;",
-           "call_param_tmpl": "&t_%i",
-           "postamble_tmpl": "if (t_%i) Parrot_str_free_cstring(t_%i);" },
-    "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);",
-           "temp_tmpl": "PMC *t_%i; short i_%i",
-           "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
-           "call_param_tmpl": "&i_%i",
-           "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
-    "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);",
-           "temp_tmpl": "PMC *t_%i; int i_%i",
-           "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
-           "call_param_tmpl": "&i_%i",
-           "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
-    "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);",
-           "temp_tmpl": "PMC *t_%i; long i_%i",
-           "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
-           "call_param_tmpl": "&i_%i",
-           "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
-    "L": { "as_proto": "long *", "as_return": "" },
-    "T": { "as_proto": "char **", "as_return": "" },
-    "V": { "as_proto": "void **",
-           "as_return": "",
-           "sig_char": "P",
-           "temp_tmpl": "PMC *t_%i; void *v_%i",
-           "preamble_tmpl": "v_%i = VTABLE_get_pointer(interp, t_%i);",
-           "call_param_tmpl": "&v_%i",
-           "postamble_tmpl": "VTABLE_set_pointer(interp, t_%i, v_%i);" },
-    "@": { "as_proto": "PMC *", "as_return": "", "cname": "xAT_", "sig_char": "Ps" }
-}
-JSON
-    .return (retv)
-.end
-
-# }}}
-
-# utility fn's {{{
-
-.sub 'sprintf'
-    .param string tmpl
-    .param pmc args :slurpy
-    $S0 = sprintf tmpl, args
-    .return ($S0)
-.end
-
-.sub 'fill_tmpls_ascending_ints'
-    .param pmc tmpls
-    .local int idx, n
-
-    idx = 0
-    n = tmpls
-    loop:
-        if idx >= n goto end_loop
-        $S0 = tmpls[idx]
-        $I0 = 'printf_arity'($S0)
-        $P0 = 'xtimes'(idx, $I0)
-        $S1 = sprintf $S0, $P0
-        tmpls[idx] = $S1
-        inc idx
-        goto loop
-    end_loop:
-.end
-
-.sub 'printf_arity'
-    .param string tmpl
-
-    .local int count, idx
-    idx = 0
-    count = 0
-
-    loop:
-        idx = index tmpl, '%', idx
-        if idx < 0 goto end_loop
-
-        # check against '%%' escapes
-        $I0 = idx + 1
-        $S0 = substr tmpl, $I0, 1
-        unless $S0 == '%' goto is_valid_placeholder
-            idx = idx + 2 # skip both '%'s
-            goto loop
-        is_valid_placeholder:
-
-        inc idx
-        inc count
-        goto loop
-    end_loop:
-
-    .return (count)
-.end
-
-.sub 'xtimes'
-    .param pmc what
-    .param int times
-
-    .local pmc retv
-    retv = new ['ResizablePMCArray']
-    retv = times
-
-    $I0 = 0
-    loop:
-        if $I0 >= times goto end_loop
-        retv[$I0] = what
-        inc $I0
-        goto loop
-    end_loop:
-
-    .return (retv)
-.end
-
-.sub 'grep_for_true'
-    .param pmc input
-    .local pmc output
-    .local int i, n
-    output = new ['ResizableStringArray']
-    i = 0
-    n = input
-    loop:
-        if i >= n goto end_loop
-        $S0 = input[i]
-        unless $S0 goto end_cond
-            push output, $S0
-        end_cond:
-        inc i
-        goto loop
-    end_loop:
-    .return (output)
-.end
-
-# }}}
-
-# Local Variables:
-#   mode: pir
-#   fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
-

Modified: trunk/tools/dev/mk_nci_thunks.pl
==============================================================================
--- trunk/tools/dev/mk_nci_thunks.pl	Fri Feb 19 04:12:17 2010	(r44160)
+++ trunk/tools/dev/mk_nci_thunks.pl	Fri Feb 19 06:04:05 2010	(r44161)
@@ -25,7 +25,7 @@
     my $nci_file = "src/nci/$_.nci";
     my $loader_name = "Parrot_nci_load_$_";
     print "$nci_file > $c_file\n";
-    system("./parrot tools/build/nativecall.pir " .
+    system("./parrot_nci_thunk_gen " .
             "--core " .
             "--loader-name=$loader_name " .
             "--output=$c_file " .

Copied and modified: trunk/tools/dev/nci_thunk_gen.pir (from r44158, trunk/tools/build/nativecall.pir)
==============================================================================
--- trunk/tools/build/nativecall.pir	Fri Feb 19 03:20:35 2010	(r44158, copy source)
+++ trunk/tools/dev/nci_thunk_gen.pir	Fri Feb 19 06:04:05 2010	(r44161)
@@ -3,11 +3,11 @@
 
 =head1 NAME
 
-tools/build/nativecall.pir - Build up the native call routines
+tools/dev/nci_thunk_gen.pir - Build up native call routine thunks
 
 =head1 SYNOPSIS
 
-    % ./parrot tools/build/nativecall.pir -o src/nci/extra_thunks.c <src/nci/extra_thunks.nci
+    % parrot_nci_thunk_gen -o src/nci/extra_thunks.c <src/nci/extra_thunks.nci
 
 =head1 DESCRIPTION
 
@@ -28,14 +28,12 @@
 
 .macro_const VERSION 0.01
 
-.macro_const SIG_TABLE_GLOBAL_NAME  'signature_table'
 .macro_const OPTS_GLOBAL_NAME       'options'
 
 .sub 'main' :main
     .param pmc argv
 
     # initialize global variables
-    'gen_sigtable'()
     'get_options'(argv)
 
     .local string targ
@@ -141,7 +139,7 @@
 
 Creates a C file of routines suitable for use as Parrot NCI thunks.
 
-Usage ./parrot nativecall.pir [options] -o output_c_file.c <input_signature_list.nci
+Usage parrot_nci_thunk_gen [options] -o output_c_file.c <input_signature_list.nci
 
 Options
     --help              print this message and exit
@@ -266,7 +264,7 @@
 /* ex: set ro ft=c:
  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  *
- * This file is generated automatically by tools/build/nativecall.pir
+ * This file is generated automatically by parrot_nci_thunk_gen
  *
  * Any changes made here will be lost!
  *
@@ -593,7 +591,7 @@
     .param string field_name
 
     .local pmc sig_table
-    sig_table = get_global .SIG_TABLE_GLOBAL_NAME
+    .const 'Sub' sig_table = 'get_sigtable'
 
     $P0 = split '', sig
 
@@ -723,101 +721,10 @@
 
 #}}}
 
-# gen_sigtable {{{
+# get_sigtable {{{
 
-.sub 'gen_sigtable'
-    $S0 = 'sigtable_json'()
-    $P0 = 'decode_table'($S0)
-    'fixup_table'($P0)
-    set_global .SIG_TABLE_GLOBAL_NAME, $P0
-.end
-
-.sub 'decode_table'
-    .param string json
-
-    .local pmc compiler
-    load_bytecode 'data_json.pbc'
-    compiler = compreg 'data_json'
-
-    .local pmc table
-    $P0 = compiler.'compile'(json)
-    table = $P0()
-
-    .return (table)
-.end
-
-.sub 'fixup_table'
-    .param pmc table
-
-    .local pmc table_iter
-    table_iter = iter table
-  iter_loop:
-    unless table_iter goto iter_end
-
-    .local string k
-    .local pmc v
-    k = shift table_iter
-    v = table[k]
-
-    $I0 = exists v['cname']
-    if $I0 goto has_cname
-        v['cname'] = k
-    has_cname:
-
-    $I0 = exists v['as_return']
-    if $I0 goto has_as_return
-        $S0 = v['as_proto']
-        v['as_return'] = $S0
-    has_as_return:
-
-    $I0 = exists v['return_type']
-    if $I0 goto has_return_type
-        $S0 = v['as_proto']
-        v['return_type'] = $S0
-    has_return_type:
-
-    $I0 = exists v['ret_assign']
-    $I1 = exists v['sig_char']
-    $I1 = !$I1
-    $I0 = $I0 || $I1 # not (not exists v[ret_assign] and exists v[sig_char])
-    if $I0 goto has_ret_assign
-        $S0 = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
-        $S1 = v['sig_char']
-        $S0 = concat $S0, $S1
-        $S0 = concat $S0, '", return_data);'
-        v['ret_assign'] = $S0
-    has_ret_assign:
-
-    $I0 = exists v['func_call_assign']
-    if $I0 goto has_func_call_assign
-        v['func_call_assign'] = 'return_data = '
-    has_func_call_assign:
-
-    $I0 = exists v['temp_tmpl']
-    if $I0 goto has_temp_tmpl
-        $S0 = v['return_type']
-        $S0 = concat $S0, " t_%i"
-        v['temp_tmpl'] = $S0
-    has_temp_tmpl:
-
-    $I0 = exists v['fill_params_tmpl']
-    if $I0 goto has_fill_params_tmpl
-        v['fill_params_tmpl'] = ', &t_%i'
-    has_fill_params_tmpl:
-
-    $I0 = exists v['call_param_tmpl']
-    if $I0 goto has_call_param_tmpl
-        v['call_param_tmpl'] = 't_%i'
-    has_call_param_tmpl:
-
-    goto iter_loop
-  iter_end:
-
-    .return ()
-.end
-
-.sub 'sigtable_json'
-    .const string retv = <<'JSON'
+.sub 'get_sigtable' :anon :immediate 
+    .const string json_table = <<'JSON'
 {
     "p": { "as_proto":   "void *",
            "final_dest": "PMC * final_destination = PMCNULL;",
@@ -910,7 +817,83 @@
     "@": { "as_proto": "PMC *", "as_return": "", "cname": "xAT_", "sig_char": "Ps" }
 }
 JSON
-    .return (retv)
+
+    # decode table
+    .local pmc compiler
+    load_bytecode 'data_json.pbc'
+    compiler = compreg 'data_json'
+
+    .local pmc table
+    $P0 = compiler.'compile'(json_table)
+    table = $P0()
+
+    # fixup_table
+    .local pmc table_iter
+    table_iter = iter table
+    iter_loop:
+        unless table_iter goto iter_end
+
+        .local string k
+        .local pmc v
+        k = shift table_iter
+        v = table[k]
+
+        $I0 = exists v['cname']
+        if $I0 goto has_cname
+            v['cname'] = k
+        has_cname:
+
+        $I0 = exists v['as_return']
+        if $I0 goto has_as_return
+            $S0 = v['as_proto']
+            v['as_return'] = $S0
+        has_as_return:
+
+        $I0 = exists v['return_type']
+        if $I0 goto has_return_type
+            $S0 = v['as_proto']
+            v['return_type'] = $S0
+        has_return_type:
+
+        $I0 = exists v['ret_assign']
+        $I1 = exists v['sig_char']
+        $I1 = !$I1
+        $I0 = $I0 || $I1 # not (not exists v[ret_assign] and exists v[sig_char])
+        if $I0 goto has_ret_assign
+            $S0 = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
+            $S1 = v['sig_char']
+            $S0 = concat $S0, $S1
+            $S0 = concat $S0, '", return_data);'
+            v['ret_assign'] = $S0
+        has_ret_assign:
+
+        $I0 = exists v['func_call_assign']
+        if $I0 goto has_func_call_assign
+            v['func_call_assign'] = 'return_data = '
+        has_func_call_assign:
+
+        $I0 = exists v['temp_tmpl']
+        if $I0 goto has_temp_tmpl
+            $S0 = v['return_type']
+            $S0 = concat $S0, " t_%i"
+            v['temp_tmpl'] = $S0
+        has_temp_tmpl:
+
+        $I0 = exists v['fill_params_tmpl']
+        if $I0 goto has_fill_params_tmpl
+            v['fill_params_tmpl'] = ', &t_%i'
+        has_fill_params_tmpl:
+
+        $I0 = exists v['call_param_tmpl']
+        if $I0 goto has_call_param_tmpl
+            v['call_param_tmpl'] = 't_%i'
+        has_call_param_tmpl:
+
+        goto iter_loop
+    iter_end:
+
+
+    .return (table)
 .end
 
 # }}}


More information about the parrot-commits mailing list