enable function wrappers for access to globals under MULTIPLICITY

(provides binary compatibility in the face of changes in interpreter
structure)

p4raw-id: //depot/perl@4878

1 files changed, 45 insertions, 25 deletions

diff --git a/embed.pl b/embed.pl
index 52ab63a186..c1ea2e6e2f 100755
--- a/embed.pl
+++ b/embed.pl
@@ -259,7 +259,7 @@ sub hide ($$) {
     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
 }
 
-sub objxsub_var ($$) {
+sub bincompat_var ($$) {
     my ($pfx, $sym) = @_;
     my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHXo');
     undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
@@ -710,27 +710,9 @@ print OBX <<'EOT';
 #ifndef __objXSUB_h__
 #define __objXSUB_h__
 
-/* Variables */
+/* method calls via pPerl (static functions without a "this" pointer need these) */
 
-EOT
-
-foreach my $sym (sort keys %intrp) {
-    print OBX objxsub_var('I',$sym);
-}
-
-foreach my $sym (sort keys %thread) {
-    print OBX objxsub_var('T',$sym);
-}
-
-foreach my $sym (sort keys %globvar) {
-    print OBX objxsub_var('G',$sym);
-}
-
-print OBX <<'EOT';
-
-/* Functions */
-
-#if defined(PERL_OBJECT)
+#if defined(PERL_CORE) && defined(PERL_OBJECT)
 
 /* XXX soon to be eliminated, only a few things in PERLCORE need these now */
 
@@ -765,7 +747,7 @@ for $sym (sort keys %ppsym) {
 
 print OBX <<'EOT';
 
-#endif  /* PERL_OBJECT */
+#endif  /* PERL_CORE && PERL_OBJECT */
 #endif	/* __objXSUB_h__ */
 EOT
 
@@ -783,8 +765,10 @@ print CAPIH <<'EOT';
 */
 
 /* declare accessor functions for Perl variables */
+#ifndef __perlapi_h__
+#define __perlapi_h__
 
-#if defined(PERL_OBJECT) || defined (PERL_CAPI)
+#if defined(PERL_OBJECT) || defined (MULTIPLICITY)
 
 #if defined(PERL_OBJECT)
 #  undef  aTHXo
@@ -816,10 +800,32 @@ START_EXTERN_C
 
 END_EXTERN_C
 
-#endif /* PERL_OBJECT || PERL_CAPI */
+#if !defined(PERL_CORE)
+
+/* accessor functions for Perl variables (provides binary compatibility) */
 
 EOT
 
+foreach my $sym (sort keys %intrp) {
+    print CAPIH bincompat_var('I',$sym);
+}
+
+foreach my $sym (sort keys %thread) {
+    print CAPIH bincompat_var('T',$sym);
+}
+
+foreach my $sym (sort keys %globvar) {
+    print CAPIH bincompat_var('G',$sym);
+}
+
+print CAPIH <<'EOT';
+
+#endif /* !PERL_CORE */
+#endif /* PERL_OBJECT || MULTIPLICITY */
+
+#endif /* __perlapi_h__ */
+
+EOT
 
 print CAPI <<'EOT';
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
@@ -831,7 +837,7 @@ print CAPI <<'EOT';
 #include "perl.h"
 #include "perlapi.h"
 
-#if defined(PERL_OBJECT)
+#if defined(PERL_OBJECT) || defined (MULTIPLICITY)
 
 /* accessor functions for Perl variables (provides binary compatibility) */
 START_EXTERN_C
@@ -840,10 +846,19 @@ START_EXTERN_C
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+
+#if defined(PERL_OBJECT)
 #define PERLVAR(v,t)	t* Perl_##v##_ptr(pTHXo)			\
 			{ return &(aTHXo->interp.v); }
 #define PERLVARA(v,n,t)	PL_##v##_t* Perl_##v##_ptr(pTHXo)		\
 			{ return &(aTHXo->interp.v); }
+#else	/* MULTIPLICITY */
+#define PERLVAR(v,t)	t* Perl_##v##_ptr(pTHX)				\
+			{ return &(aTHX->v); }
+#define PERLVARA(v,n,t)	PL_##v##_t* Perl_##v##_ptr(pTHX)		\
+			{ return &(aTHX->v); }
+#endif
+
 #define PERLVARI(v,t,i)	PERLVAR(v,t)
 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
 
@@ -863,6 +878,10 @@ START_EXTERN_C
 #undef PERLVARI
 #undef PERLVARIC
 
+#if defined(PERL_OBJECT)
+
+/* C-API layer for PERL_OBJECT */
+
 EOT
 
 # functions that take va_list* for implementing vararg functions
@@ -999,6 +1018,7 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 END_EXTERN_C
 
 #endif /* PERL_OBJECT */
+#endif /* PERL_OBJECT || MULTIPLICITY */
 EOT
 
 __END__