[asperl] add AS patch#17

p4raw-id: //depot/asperl@893

1 files changed, 38 insertions, 2 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 58b3a08705..fafa9cc2d5 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>]... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>] [B<-perlobject>]... file.xs
 
 =head1 DESCRIPTION
 
@@ -59,7 +59,11 @@ number.
 
 Prevents the inclusion of `#line' directives in the output.
 
-=back
+=item B<-perlobject>
+
+Compile code as C in a PERL_OBJECT environment.
+
+back
 
 =head1 ENVIRONMENT
 
@@ -122,6 +126,7 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
     $WantVersionChk = 0, next SWITCH	if $flag eq 'noversioncheck';
     $WantVersionChk = 1, next SWITCH	if $flag eq 'versioncheck';
+    $WantCAPI = 1, next SWITCH    if $flag eq 'perlobject';
     $except = " TRY",	next SWITCH	if $flag eq 'except';
     push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
     $WantLineNumbers = 0, next SWITCH	if $flag eq 'nolinenumbers';
@@ -1175,6 +1180,19 @@ EOF
 }
 
 # print initialization routine
+if ($WantCAPI) {
+print Q<<"EOF";
+#
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XS(boot__CAPI_entry)
+#[[
+#    dXSARGS;
+#    char* file = __FILE__;
+#
+EOF
+} else {
 print Q<<"EOF";
 ##ifdef __cplusplus
 #extern "C"
@@ -1185,6 +1203,7 @@ print Q<<"EOF";
 #    char* file = __FILE__;
 #
 EOF
+}
 
 print Q<<"EOF" if $WantVersionChk ;
 #    XS_VERSION_BOOTCHECK ;
@@ -1215,7 +1234,24 @@ print Q<<"EOF";;
 #    ST(0) = &sv_yes;
 #    XSRETURN(1);
 #]]
+#
+EOF
+
+if ($WantCAPI) { 
+print Q<<"EOF";
+#
+##define XSCAPI(name) void name(void* pPerl, CV* cv)
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XSCAPI(boot_$Module_cname)
+#[[
+#    SetCPerlObj(pPerl);
+#    boot__CAPI_entry(cv);
+#]]
+#
 EOF
+}
 
 warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
     unless $ProtoUsed ;