Here's a proposed patch that seems to work okay for me on Linux. It's not
great or beautiful, mostly because of the Makefile hackery. It's a starting
point though. I suspect Windows might complain.
I don't have any particular attachment to any approach here, only that this
get in the repository somehow.
-- c
=== MANIFEST
==================================================================
--- MANIFEST (revision 20216)
+++ MANIFEST (local)
@@ -201,6 +201,7 @@
config/gen/makefiles/dynpmc.in []
config/gen/makefiles/dynpmc_pl.in []
config/gen/makefiles/editor.in []
+config/gen/makefiles/ext.in []
config/gen/makefiles/languages.in []
config/gen/makefiles/parrot.pc.in []
config/gen/makefiles/past.in []
@@ -637,6 +638,15 @@
examples/tge/branch/lib/Branch.pir [main]doc
examples/tge/branch/lib/Leaf.pir [main]doc
examples/tge/branch/transform.pir [main]doc
+ext/Parrot-Embed/t/embed.t [devel]
+ext/Parrot-Embed/t/greet.pir [devel]
+ext/Parrot-Embed/lib/Parrot/Embed.xs [devel]
+ext/Parrot-Embed/lib/Parrot/Embed.pm [devel]
+ext/Parrot-Embed/Changes [devel]
+ext/Parrot-Embed/MANIFEST [devel]
+ext/Parrot-Embed/typemap [devel]
+ext/Parrot-Embed/Build.PL [devel]
+ext/Parrot-Embed/README [devel]
include/parrot/builtin.h [main]include
include/parrot/caches.h [main]include
include/parrot/cclass.h [main]include
=== config/gen/makefiles/root.in
==================================================================
--- config/gen/makefiles/root.in (revision 20216)
+++ config/gen/makefiles/root.in (local)
@@ -186,6 +186,7 @@
compilers/tge/Makefile \
compilers/bcg/Makefile \
editor/Makefile \
+ ext/Makefile \
languages/Makefile \
languages/amber/Makefile \
languages/APL/Makefile \
=== config/gen/makefiles/ext.in
==================================================================
--- config/gen/makefiles/ext.in (revision 20216)
+++ config/gen/makefiles/ext.in (local)
@@ -0,0 +1,64 @@
+# $Id: /parrotcode/offline/config/gen/makefiles/languages.in 19764 2006-08-03T18:17:04.907999Z chromatic $
+
+# setup of commands
[EMAIL PROTECTED]@
+PERL = @perl@
+MAKE = @make_c@
+RM_F = @rm_f@
+
+# add new languages here
+# remove obsolete languages here
+EXT = \
+ Parrot-Embed
+
+# the default target
+all: $(EXT)
+
+# hard-code these for now
+test: Parrot-Embed
+ - cd Parrot-Embed && $(PERL) Build test
+
+clean: Parrot-Embed
+ - cd Parrot-Embed && $(PERL) Build clean
+
+# This is a listing of all targets, that are meant to be called by users
+help:
+ @echo ""
+ @echo "Following targets are available for the user:"
+ @echo ""
+ @echo " all: Make a lot of language implementations."
+ @echo " This is the default."
+ @echo " test: Unified test suite for a lot of languages."
+ @echo ""
+ @echo " clean: Clean up a lot of languages."
+ @echo ""
+ @echo " help: Print this help message."
+ @echo ""
+ @echo " smoke: Run the test suite and send smoke.html to "
+ @echo " http://smoke.parrotcode.org/";
+ @echo ""
+ @echo " smoke-clean: clean up smoke.html"
+ @echo ""
+ @echo ""
+ @echo "Following languages are available:"
+ @echo " $(LANGUAGES)"
+ @echo "A particular language <lang> can be built, tested and cleand up"
+ @echo " make <lang>"
+ @echo " make <lang>.test"
+ @echo " make <lang>.clean"
+ @echo "For the status of individual languages see LANGUAGES.STATUS.pod"
+ @echo ""
+
+clean: \
+ Parrot-Embed.clean
+
+#
+# Extension specific targets
+#
+
+# The *.dummy targets are a replacement for the target .PHONY in 'GNU make'
+
+Parrot-Embed : Parrot-Embed.dummy
+
+Parrot-Embed.dummy:
+ - cd ext/Parrot-Embed && $(PERL) Build.PL && $(PERL) Build
=== config/gen/makefiles.pm
==================================================================
--- config/gen/makefiles.pm (revision 20216)
+++ config/gen/makefiles.pm (local)
@@ -117,6 +117,11 @@
replace_slashes => 1
);
genfile(
+ 'config/gen/makefiles/ext.in' => 'ext/Makefile',
+ commentType => '#',
+ replace_slashes => 1
+ );
+ genfile(
'config/gen/makefiles/parrot.pc.in' => 'parrot.pc'
);
=== ext/Parrot-Embed/Build.PL
==================================================================
--- ext/Parrot-Embed/Build.PL (revision 20216)
+++ ext/Parrot-Embed/Build.PL (local)
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+
+use Module::Build;
+use ExtUtils::PkgConfig;
+
+my %pkg_info = ExtUtils::PkgConfig->find( 'parrot' );
+
+my $class = Module::Build->subclass(
+ code => <<'END_HERE',
+ use Cwd;
+
+ sub ACTION_build
+ {
+ my $self = shift;
+ my $old_dir = cwd();
+ chdir 't';
+
+ system(qw( parrot -o greet.pbc greet.pir ) ) == 0
+ or die "Cannot compile PBC for test: $?";
+
+ chdir $old_dir;
+ $self->SUPER::ACTION_build( @_ );
+ }
+END_HERE
+);
+
+my $builder = $class->new(
+ module_name => 'Parrot::Embed',
+ license => 'perl',
+ dist_author => 'chromatic <[EMAIL PROTECTED]>',
+ dist_version_from => 'lib/Parrot/Embed.pm',
+ build_requires => {
+ 'Test::More' => 0,
+ },
+ add_to_cleanup => [ 'Parrot-Embed-*' ],
+ extra_compiler_flags => $pkg_info{cflags},
+ extra_linker_flags => $pkg_info{libs},
+);
+
+$builder->create_build_script();
=== ext/Parrot-Embed/Changes
==================================================================
--- ext/Parrot-Embed/Changes (revision 20216)
+++ ext/Parrot-Embed/Changes (local)
@@ -0,0 +1,5 @@
+Revision history for Parrot-Embed
+
+0.01 Date/time
+ First version, released on an unsuspecting world.
+
=== ext/Parrot-Embed/MANIFEST
==================================================================
--- ext/Parrot-Embed/MANIFEST (revision 20216)
+++ ext/Parrot-Embed/MANIFEST (local)
@@ -0,0 +1,10 @@
+Build.PL
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+README
+lib/Parrot/Embed.pm
+lib/Parrot/Embed.xs
+t/embed.t
+t/greet.pir
+typemap
=== ext/Parrot-Embed/README
==================================================================
--- ext/Parrot-Embed/README (revision 20216)
+++ ext/Parrot-Embed/README (local)
@@ -0,0 +1,22 @@
+Parrot::Embed
+-------------
+
+This is the first version of an embedding interface to use Parrot from Perl 5.
+
+Be afraid.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Build.PL
+ perl ./Build
+ perl ./Build test
+ perl ./Build install
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006 The Perl Foundation/chromatic
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Parrot itself.
=== ext/Parrot-Embed/lib/Parrot/Embed.pm
==================================================================
--- ext/Parrot-Embed/lib/Parrot/Embed.pm (revision 20216)
+++ ext/Parrot-Embed/lib/Parrot/Embed.pm (local)
@@ -0,0 +1,44 @@
+package Parrot::Embed;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use base 'DynaLoader';
+
+Parrot::Embed->bootstrap( $VERSION );
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parrot::Embed - use Parrot from Perl 5
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 SYNOPSIS
+
+This module embeds libparrot in Perl 5 programs. You can load Parrot bytecode,
+compile your own code, and call Parrot subroutines and send and receive values
+to them.
+
+=head1 AUTHOR
+
+chromatic, C<< <chromatic at wgz.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to the Parrot Porters mailing list.
+Someday there may be a CPAN version of this code. Who knows?
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2006 The Perl Foundation / chromatic, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Parrot itself.
=== ext/Parrot-Embed/lib/Parrot/Embed.xs
==================================================================
--- ext/Parrot-Embed/lib/Parrot/Embed.xs (revision 20216)
+++ ext/Parrot-Embed/lib/Parrot/Embed.xs (local)
@@ -0,0 +1,133 @@
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+#include "parrot/extend.h"
+
+MODULE = Parrot::Embed PACKAGE = Parrot::Embed
+
+Parrot_Interp
+create_interpreter( ... )
+INIT:
+ Parrot_Interp parent;
+ Parrot_Interp interp;
+ Parrot_PackFile pf;
+CODE:
+ if (items == 0)
+ {
+ parent = 0;
+ }
+ else if ( items == 1 )
+ {
+ parent = INT2PTR( Parrot_Interp, SvIV( ST(0) ) );
+ }
+ else
+ {
+ Perl_croak( aTHX_
+ "Usage: Parrot::Embed::create_interpreter( [ parent ] )" );
+ }
+ interp = Parrot_new( parent );
+ pf = PackFile_new( interp, 0 );
+ Parrot_loadbc( interp, pf );
+ RETVAL = interp;
+OUTPUT:
+ RETVAL
+
+Parrot_STRING
+create_string( interp, string )
+ Parrot_Interp interp
+ SV * string
+INIT:
+ int length;
+CODE:
+ length = SvLEN( string );
+ RETVAL = const_string( interp, SvPVX( string ) );
+OUTPUT:
+ RETVAL
+
+Parrot_PackFile
+read_bytecode( interp, filename )
+ Parrot_Interp interp
+ char * filename
+CODE:
+ RETVAL = Parrot_readbc( interp, filename );
+OUTPUT:
+ RETVAL
+
+void
+load_bytecode( interp, packfile )
+ Parrot_Interp interp
+ Parrot_PackFile packfile
+CODE:
+ Parrot_loadbc( interp, packfile );
+
+Parrot_PMC
+find_global( interp, ... )
+ Parrot_Interp interp
+INIT:
+ SV * namespace;
+ Parrot_STRING p_namespace;
+ Parrot_STRING p_global;
+CODE:
+ if ( items < 2 || items > 3 )
+ {
+ Perl_croak( aTHX_
+ "Usage: Parrot::Embed::find_global( interp, name, [ namespace ] )");
+ }
+
+ p_global = const_string( interp, SvPVX( ST(1) ) );
+
+ if ( items == 3 )
+ namespace = ST(2);
+ else
+ namespace = &PL_sv_undef;
+
+ if (namespace != &PL_sv_undef )
+ {
+ p_namespace = const_string( interp, SvPVX( namespace ) );
+ RETVAL = Parrot_find_global_s( interp, p_namespace, p_global );
+ }
+ else
+ {
+ RETVAL = Parrot_find_global_cur( interp, p_global );
+ }
+OUTPUT:
+ RETVAL
+
+Parrot_PMC
+call_sub( interp, sub, signature, argument )
+ Parrot_Interp interp
+ Parrot_PMC sub
+ const char * signature
+ const char * argument
+INIT:
+ Parrot_STRING arg_string;
+CODE:
+ arg_string = const_string( interp, argument );
+ RETVAL = Parrot_call_sub( interp, sub, signature, arg_string );
+OUTPUT:
+ RETVAL
+
+char *
+get_string_from_pmc( interp, pmc )
+ Parrot_Interp interp
+ Parrot_PMC pmc
+CODE:
+ RETVAL = Parrot_PMC_get_cstring( interp, pmc );
+OUTPUT:
+ RETVAL
+
+Parrot_PMC
+compile_string( interp, code )
+ Parrot_Interp interp
+ char * code
+INIT:
+ STRING *code_type;
+ STRING *error;
+CODE:
+ code_type = const_string( interp, "PIR" );
+ RETVAL = Parrot_compile_string( interp, code_type, code, &error );
+OUTPUT:
+ RETVAL
=== ext/Parrot-Embed/t/embed.t
==================================================================
--- ext/Parrot-Embed/t/embed.t (revision 20216)
+++ ext/Parrot-Embed/t/embed.t (local)
@@ -0,0 +1,105 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+use File::Spec;
+
+my $hello_pbc = File::Spec->catfile( 't', 'greet.pbc' );
+
+my $module = 'Parrot::Embed';
+use_ok( $module ) or exit;
+
+diag( "Testing Parrot::Embed $Parrot::Embed::VERSION, Perl $], $^X" );
+
+can_ok( $module, 'create_interpreter' );
+my $interp = Parrot::Embed::create_interpreter( 0 );
+ok( $interp, 'create_interpreter() should return a valid interpreter' );
+
+my $i2 = Parrot::Embed::create_interpreter( $interp );
+isnt( $interp, $i2, '... but not always the same one' );
+
+eval { Parrot::Embed::create_interpreter( 0, 1, 2 ) };
+like( $@, qr/Usage: .+create_interpreter/,
+ '... and should croak when given invalid arguments' );
+
+can_ok( $module, 'read_bytecode' );
+my $bc = Parrot::Embed::read_bytecode( $interp, $hello_pbc );
+ok( $bc, 'read_bytecode() should work on valid file' );
+
+TODO:
+{
+ local $TODO = 'Cannot catch Parrot exceptions yet';
+
+ # XXX - can you not see that I am serious?
+ close STDERR;
+
+ eval { Parrot::Embed::read_bytecode( $interp, $0 ) };
+ like( $@, qr/Can't unpack packfile/, '... but not on non-PBC file' );
+
+ eval { Parrot::Embed::read_bytecode( $interp, 'not_a_file' ) };
+ like( $@, qr/Can't unpack packfile/, '... or a non-existent file' );
+}
+
+can_ok( $module, 'load_bytecode' );
+eval { Parrot::Embed::load_bytecode( $interp, $bc ) };
+is( $@, '', 'load_bytecode() should work on read bytecode' );
+
+TODO:
+{
+ local $TODO = 'Cannot catch Parrot exceptions yet';
+
+ eval { Parrot::Embed::load_bytecode( $interp, undef ) };
+ like( $@, qr/Invalid packfile/, '... but not on non-packfile' );
+
+}
+
+can_ok( $module, 'find_global' );
+my $global_greet = Parrot::Embed::find_global( $interp, 'greet' );
+ok( $global_greet,
+ 'find_global() should return non-namespaced global, if found' );
+
+ok( ! Parrot::Embed::find_global( $interp, 'goat' ),
+ '... or nothing, if there is no non-namespaced global of that name' );
+
+my $else_greet = Parrot::Embed::find_global( $interp, 'greet', 'Elsewhere' );
+ok( $else_greet, '... or a namespaced global, if it exists in the namespace' );
+isnt( $global_greet, $else_greet, '... and definitely the namespaced version' );
+
+ok( ! Parrot::Embed::find_global( $interp, 'goat', 'Elsewhere' ),
+ '... but again, not if there is no global of that name there' );
+
+can_ok( $module, 'call_sub' );
+my $pmc = Parrot::Embed::call_sub( $interp, $global_greet, 'PS', 'Bob' );
+ok( $pmc, 'call_sub() should return a PMC, given that signature' );
+
+can_ok( $module, 'get_string_from_pmc' );
+is( Parrot::Embed::get_string_from_pmc( $interp, $pmc ), 'Hello, Bob!',
+ '... containing a string returned as a PMC' );
+
+$pmc = Parrot::Embed::call_sub( $interp, $else_greet, 'P', '' );
+is( Parrot::Embed::get_string_from_pmc( $interp, $pmc ), 'Hiya!',
+ '... calling the passed-in subroutine' );
+
+can_ok( $module, 'compile_string' );
+my $eval = Parrot::Embed::compile_string( $interp, <<END_PIR );
+.sub foo
+ .param pmc in_string
+
+ .local string string_s
+ string_s = in_string
+ string_s .= ' FOO '
+
+ .return( string_s )
+.end
+END_PIR
+ok( $eval, 'compile_string() should compile PIR code and return a PMC' );
+
+ok( ! Parrot::Embed::compile_string( $i2, 'blah' ),
+ '... but only for valid PIR' );
+
+my $foo = Parrot::Embed::find_global( $interp, 'foo' );
+$pmc = Parrot::Embed::call_sub( $interp, $foo, 'PS', 'BAR' );
+is( Parrot::Embed::get_string_from_pmc( $interp, $pmc ), 'BAR FOO ',
+ '... and compiled sub should work just like any other Sub pmc' );
Property changes on: ext/Parrot-Embed/t/embed.t
___________________________________________________________________
Name: svn:mime-type
+text/plain
=== ext/Parrot-Embed/t/greet.pir
==================================================================
--- ext/Parrot-Embed/t/greet.pir (revision 20216)
+++ ext/Parrot-Embed/t/greet.pir (local)
@@ -0,0 +1,20 @@
+.sub greet
+ .param pmc name
+
+ .local string name_str
+ name_str = name
+
+ .local pmc greeting
+ greeting = new .String
+ greeting = 'Hello, '
+ greeting .= name_str
+ greeting .= '!'
+
+ .return( greeting )
+.end
+
+.namespace [ 'Elsewhere' ]
+
+.sub greet
+ .return( 'Hiya!' )
+.end
=== ext/Parrot-Embed/typemap
==================================================================
--- ext/Parrot-Embed/typemap (revision 20216)
+++ ext/Parrot-Embed/typemap (local)
@@ -0,0 +1,5 @@
+TYPEMAP
+Parrot_Interp T_PTR
+Parrot_PackFile T_PTR
+Parrot_STRING T_PTR
+Parrot_PMC T_PTR
