more complete support for implicit thread/interpreter pointer,

enabled via -DPERL_IMPLICIT_CONTEXT (all changes are noops
without that enabled):
  - USE_THREADS now enables PERL_IMPLICIT_CONTEXT, so dTHR
    is a noop; tests pass on Solaris; should be faster now!
  - MULTIPLICITY has been tested with and without
    PERL_IMPLICIT_CONTEXT on Solaris
  - improved function database now merged with embed.pl
  - everything except the varargs functions have foo(a,b,c) macros
    to provide compatibility
  - varargs functions default to compatibility variants that
    get the context pointer using dTHX
  - there should be almost no source compatibility issues as a
    result of all this
  - dl_foo.xs changes other than dl_dlopen.xs untested
  - still needs documentation, fixups for win32 etc
Next step: migrate most non-mutex variables from perlvars.h
to intrpvar.h

p4raw-id: //depot/perl@3524

2 files changed, 26 insertions, 16 deletions

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 36d61f3a57..f9193ae692 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -86,7 +86,7 @@ static int walkoptree_debug = 0;	/* Flag for walkoptree debug hook */
 static SV *specialsv_list[4];
 
 static opclass
-cc_opclass(OP *o)
+cc_opclass(pTHX_ OP *o)
 {
     if (!o)
 	return OPc_NULL;
@@ -188,13 +188,13 @@ cc_opclass(OP *o)
 }
 
 static char *
-cc_opclassname(OP *o)
+cc_opclassname(pTHX_ OP *o)
 {
-    return opclassnames[cc_opclass(o)];
+    return opclassnames[cc_opclass(aTHX_ o)];
 }
 
 static SV *
-make_sv_object(SV *arg, SV *sv)
+make_sv_object(pTHX_ SV *arg, SV *sv)
 {
     char *type = 0;
     IV iv;
@@ -214,14 +214,14 @@ make_sv_object(SV *arg, SV *sv)
 }
 
 static SV *
-make_mg_object(SV *arg, MAGIC *mg)
+make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 {
     sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
     return arg;
 }
 
 static SV *
-cstring(SV *sv)
+cstring(pTHX_ SV *sv)
 {
     SV *sstr = newSVpvn("", 0);
     STRLEN len;
@@ -274,7 +274,7 @@ cstring(SV *sv)
 }
 
 static SV *
-cchar(SV *sv)
+cchar(pTHX_ SV *sv)
 {
     SV *sstr = newSVpvn("'", 1);
     STRLEN n_a;
@@ -314,7 +314,7 @@ cchar(SV *sv)
 }
 
 void
-walkoptree(SV *opsv, char *method)
+walkoptree(pTHX_ SV *opsv, char *method)
 {
     dSP;
     OP *o;
@@ -337,8 +337,8 @@ walkoptree(SV *opsv, char *method)
 	OP *kid;
 	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
 	    /* Use the same opsv. Rely on methods not to mess it up. */
-	    sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
-	    walkoptree(opsv, method);
+	    sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)kid);
+	    walkoptree(aTHX_ opsv, method);
 	}
     }
 }
@@ -431,6 +431,8 @@ void
 walkoptree(opsv, method)
 	SV *	opsv
 	char *	method
+    CODE:
+	walkoptree(aTHX_ opsv, method);
 
 int
 walkoptree_debug(...)
@@ -527,10 +529,18 @@ minus_c()
 SV *
 cstring(sv)
 	SV *	sv
+    CODE:
+	RETVAL = cstring(aTHX_ sv);
+    OUTPUT:
+	RETVAL
 
 SV *
 cchar(sv)
 	SV *	sv
+    CODE:
+	RETVAL = cchar(aTHX_ sv);
+    OUTPUT:
+	RETVAL
 
 void
 threadsv_names()
@@ -664,7 +674,7 @@ PMOP_pmreplroot(o)
 		     (IV)root);
 	}
 	else {
-	    sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root);
+	    sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)root);
 	}
 
 B::OP
@@ -864,7 +874,7 @@ SvMAGIC(sv)
 	MAGIC *	mg = NO_INIT
     PPCODE:
 	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
-	    XPUSHs(make_mg_object(sv_newmortal(), mg));
+	    XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
 
 MODULE = B	PACKAGE = B::PVMG
 
@@ -1103,7 +1113,7 @@ AvARRAY(av)
 	    SV **svp = AvARRAY(av);
 	    I32 i;
 	    for (i = 0; i <= AvFILL(av); i++)
-		XPUSHs(make_sv_object(sv_newmortal(), svp[i]));
+		XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
 	}
 
 MODULE = B	PACKAGE = B::AV
@@ -1204,6 +1214,6 @@ HvARRAY(hv)
 	    EXTEND(sp, HvKEYS(hv) * 2);
 	    while (sv = hv_iternextsv(hv, &key, &len)) {
 		PUSHs(newSVpvn(key, len));
-		PUSHs(make_sv_object(sv_newmortal(), sv));
+		PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
 	    }
 	}
diff --git a/ext/B/typemap b/ext/B/typemap
index 7206a6a2e1..3531c49fb2 100644
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -59,10 +59,10 @@ T_MG_OBJ
 
 OUTPUT
 T_OP_OBJ
-	sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var);
+	sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), (IV)$var);
 
 T_SV_OBJ
-	make_sv_object(($arg), (SV*)($var));
+	make_sv_object(aTHX_ ($arg), (SV*)($var));
 
 
 T_MG_OBJ