Author: nicholas
Date: Fri Oct 28 07:04:19 2005
New Revision: 9614
Added:
trunk/build_tools/vtable_extend.pl
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/root.in
trunk/include/parrot/extend.h
trunk/lib/Parrot/Vtable.pm
Log:
Apply a revised version of chromatic's patch to autogenerate C wrappers for the
vtable functions.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Fri Oct 28 07:04:19 2005
@@ -42,6 +42,7 @@ build_tools/parrotdef.pl
build_tools/pbc2c.pl [devel]
build_tools/pmc2c.pl []
build_tools/revision_c.pl [devel]
+build_tools/vtable_extend.pl []
build_tools/vtable_h.pl []
charset/ascii.c []
charset/ascii.h []
Added: trunk/build_tools/vtable_extend.pl
==============================================================================
--- (empty file)
+++ trunk/build_tools/vtable_extend.pl Fri Oct 28 07:04:19 2005
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 'lib';
+use Parrot::Vtable;
+
+my $vtable = parse_vtable( 'vtable.tbl' );
+
+my ($funcs, $protos) = vtbl_embed( $vtable );
+
+my $header = <<'EOH';
+/*
+** !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+**
+** This file is generated automatically from 'vtable.tbl' by
+** build_tools/vtable_extend.pl
+*/
+EOH
+
+open OUT, ">include/parrot/extend_vtable.h" or die $!;
+
+print OUT $header, <<'EOF';
+
+/*
+Copyright: 2005 The Perl Foundation. All Rights Reserved.
+*/
+#if !defined(PARROT_EXTEND_VTABLE_H_GUARD)
+#define PARROT_EXTEND_VTABLE_H_GUARD
+
+/* Need size_t */
+#include <stddef.h>
+
+EOF
+
+print OUT $protos;
+
+print OUT <<'EOF';
+
+#endif
+EOF
+
+close OUT or die $!;
+
+open OUT, ">src/extend_vtable.c" or die $!;
+
+print OUT $header, <<'EOF';
+
+/*
+Copyright: 2001-2003, 2005 The Perl Foundation. All Rights Reserved.
+
+=head1 NAME
+
+src/extend.c - Parrot extension interface
+
+=head1 DESCRIPTION
+
+These are the functions that Parrot extensions (that is, Parrot subroutines
+written in C, or some other compiled language, rather than in Parrot
+bytecode) may access.
+
+There is a deliberate distancing from the internals here. Don't go
+peeking inside -- you've as much access as bytecode does, but no more,
+so we can provide backwards compatibility for as long as we possibly
+can.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+/* Some internal notes. Parrot will die a horrible and bizarre death
+ if the stack start pointer's not set and a DOD run is
+ triggered. The pointer *will* be set by the interpreter if the
+ interpreter calls code which calls these functions, so most
+ extension code is safe, no problem.
+
+ The problem comes in if these routines are called from *outside*
+ an interpreter. This happens when an embedding application calls
+ them to do stuff with PMCs, STRINGS, interpreter contents, and
+ suchlike things. This is perfectly legal -- in fact it's what
+ we've documented should be done -- but the problem is that the
+ stack base pointer will be NULL. This is Very Bad.
+
+ To deal with this there are two macros that are defined to handle
+ the problem.
+
+ PARROT_CALLIN_START(interpreter) will figure out if the stack
+ anchor needs setting and, if so, will set it. It must *always*
+ come immediately after the last variable declared in the block
+ making the calls into the interpreter, as it declares a variable
+ and has some code.
+
+ PARROT_CALLIN_END(interpreter) will put the stack anchor back to
+ the way it was, and should always be the last statement before a
+ return. (If you have multiple returns have it in multiple times)
+
+ Not doing this is a good way to introduce bizarre heisenbugs, so
+ just do it. This is the only place they ought to have to be put
+ in, and most of the functions are already written, so it's not
+ like it's an onerous requirement.
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/extend.h"
+
+EOF
+
+print OUT $funcs;
+
+print OUT <<'EOF';
+/*
+
+=back
+
+=head1 SEE ALSO
+
+See F<include/parrot/extend.h> and F<docs/pdds/pdd11_extending.pod>.
+
+=head1 HISTORY
+
+Initial version by Dan Sugalski.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
+EOF
+
+close OUT or die $!;
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in (original)
+++ trunk/config/gen/makefiles/root.in Fri Oct 28 07:04:19 2005
@@ -224,7 +224,8 @@ GEN_HEADERS = \
$(INC_DIR)/vtable.h \
$(INC_DIR)/oplib/core_ops.h \
$(INC_DIR)/oplib/ops.h \
- $(INC_DIR)/oplib/core_ops_switch.h
+ $(INC_DIR)/oplib/core_ops_switch.h \
+ $(INC_DIR)/extend_vtable.h
GEN_SOURCES = \
$(SRC_DIR)/core_ops.c \
@@ -235,7 +236,8 @@ GEN_SOURCES = \
$(SRC_DIR)/parrot_config.c \
$(SRC_DIR)/null_config.c \
$(SRC_DIR)/install_config.c \
- $(SRC_DIR)/exec_cpu.c
+ $(SRC_DIR)/exec_cpu.c \
+ $(SRC_DIR)/extend_vtable.c
GEN_MODULES = \
lib/Parrot/OpLib/core.pm
@@ -426,6 +428,7 @@ INTERP_O_FILES = \
$(SRC_DIR)/mmd$(O) \
$(SRC_DIR)/builtin$(O) \
$(SRC_DIR)/extend$(O) \
+ $(SRC_DIR)/extend_vtable$(O) \
$(SRC_DIR)/revision$(O) \
$(PF_DIR)/pf_items$(O) \
$(OPS_DIR)/core_ops$(O) \
@@ -897,6 +900,9 @@ $(SRC_DIR)/exec$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/exec_cpu$(O) : $(GENERAL_H_FILES) ${TEMP_exec_h} ${TEMP_jit_h}
$(INC_DIR)/jit_emit.h
+$(INC_DIR)/extend_vtable.h $(SRC_DIR)/extend_vtable.c $(SRC_DIR)/vtable.h :
vtable.tbl $(BUILD_TOOLS_DIR)/vtable_extend.pl lib/Parrot/Vtable.pm
+ $(PERL) $(BUILD_TOOLS_DIR)/vtable_extend.pl
+
$(SRC_DIR)/exec_start$(O) : $(GENERAL_H_FILES) ${TEMP_exec_h}
$(SRC_DIR)/exec_save$(O) : $(GENERAL_H_FILES) ${TEMP_exec_h}
Modified: trunk/include/parrot/extend.h
==============================================================================
--- trunk/include/parrot/extend.h (original)
+++ trunk/include/parrot/extend.h Fri Oct 28 07:04:19 2005
@@ -55,6 +55,8 @@ typedef const void * Parrot_VTABLE;
#endif
+#include "parrot/extend_vtable.h" /* the auto-generated prototypes */
+
Parrot_VTABLE Parrot_get_vtable(Parrot_INTERP, Parrot_Int);
Parrot_PMC Parrot_PMC_get_pmc_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int);
Parrot_STRING Parrot_PMC_get_string(Parrot_INTERP, Parrot_PMC);
Modified: trunk/lib/Parrot/Vtable.pm
==============================================================================
--- trunk/lib/Parrot/Vtable.pm (original)
+++ trunk/lib/Parrot/Vtable.pm Fri Oct 28 07:04:19 2005
@@ -293,6 +293,9 @@ sub vtbl_embed
{
my $vtable = shift;
+ my $funcs = '';
+ my $protos = '';
+
for my $entry (@$vtable)
{
my ($return_type, $name, $params, $section, $mmd) = @$entry;
@@ -304,26 +307,49 @@ sub vtbl_embed
while (my ($type, $name) = splice( @params, 0, 2 ))
{
- push @sig, find_type( $type ) . ' ' . $name;
- push @args, $name;
+ eval
+ {
+ push @sig, find_type( $type ) . ' ' . $name;
+ push @args, $name;
+ };
}
+ next if $@;
+
my $signature = join( ', ', @sig );
my $arguments = join( ', ', @args );
my $ret_type = find_type( $return_type );
- printf
-"%s Parrot_PMC_%s( %s )
+ $protos .= sprintf "extern %s Parrot_PMC_%s( %s );\n",
+ $ret_type, $name, $signature;
+
+ $funcs .= sprintf
+"/*
+
+=item C<%s
+%s(%s)>
+
+=cut
+
+*/
+
+%s Parrot_PMC_%s( %s )
{
- %s retval;
- PARROT_CALLIN_START( interp );
- retval = VTABLE_%s( %s );
+", ($ret_type, $name, $signature) x 2;
+
+ $funcs .= " $ret_type retval;\n" unless $ret_type eq 'void';
+ $funcs .= " PARROT_CALLIN_START( interp );\n ";
+ $funcs .= "retval = " unless $ret_type eq 'void';
+ $funcs .= "VTABLE_$name( $arguments );
PARROT_CALLIN_END( interp );
- return retval;
-}\n\n", $ret_type, $name, $signature, $ret_type, $name, $arguments;
+ return";
+ $funcs .= " retval" unless $ret_type eq 'void';
+ $funcs .= ";\n}\n\n";
}
+
+ return ($funcs, $protos);
}
sub find_type
@@ -339,6 +365,7 @@ sub find_type
'FLOATVAL' => 'Parrot_Float',
'void' => 'void',
'UINTVAL' => 'Parrot_Int',
+ 'size_t' => 'size_t',
);
die "Unknown type $type\n" unless exists $typemap{ $type };
