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

MANIFEST

@@ -157,7 +157,7 @@ emacs/cperl-mode.el	An alternate perl-mode
 emacs/e2ctags.pl	etags to ctags converter
 emacs/ptags		Creates smart TAGS file
 embed.h			Maps symbols to safer names
-embed.pl		Produces embed.h
+embed.pl		Produces {embed,embedvar,objXSUB,proto}.h, global.sym
 embedvar.h		C namespace management
 ext/B/B.pm		Compiler backend support functions and methods
 ext/B/B.xs		Compiler backend external subroutines
@@ -1025,7 +1025,6 @@ pp_hot.c		Push/Pop code for heavily used opcodes
 pp_proto.h		C++ definitions for Push/Pop code
 pp_sys.c		Push/Pop code for system interaction
 proto.h			Prototypes
-proto.pl		Produces proto.h and global.sym
 qnx/ar			QNX implementation of "ar" utility
 qnx/cpp			QNX implementation of preprocessor filter
 regcomp.c		Regular expression compiler

XSUB.h

@@ -1,17 +1,13 @@
 #define ST(off) PL_stack_base[ax + (off)]
 
-#ifdef CAN_PROTOTYPE
-#  ifdef PERL_OBJECT
-#    define XS(name) void name(CV* cv, CPerlObj* pPerl)
+#ifdef PERL_OBJECT
+#  define XS(name) void name(CV* cv, CPerlObj* pPerl)
+#else
+#  if defined(CYGWIN32) && defined(USE_DYNAMIC_LOADING)
+#    define XS(name) __declspec(dllexport) void name(pTHX_ CV* cv)
 #  else
-#    if defined(CYGWIN32) && defined(USE_DYNAMIC_LOADING)
-#      define XS(name) __declspec(dllexport) void name(CV* cv)
-#    else
-#      define XS(name) void name(CV* cv)
-#    endif
+#    define XS(name) void name(pTHX_ CV* cv)
 #  endif
-#else
-#  define XS(name) void name(cv) CV* cv;
 #endif
 
 #define dXSARGS				\
@@ -31,7 +27,7 @@
 #define dXSFUNCTION(ret)		XSINTERFACE_CVT(ret,XSFUNCTION)
 #define XSINTERFACE_FUNC(ret,cv,f)	((XSINTERFACE_CVT(ret,))(f))
 #define XSINTERFACE_FUNC_SET(cv,f)	\
-		CvXSUBANY(cv).any_dptr = (void (*) (void*))(f)
+		CvXSUBANY(cv).any_dptr = (void (*) (pTHX_ void*))(f)
 
 #define XSRETURN(off)					\
     STMT_START {					\
@@ -69,14 +65,14 @@
 	    tmpsv = ST(1);						\
 	else {								\
 	    /* XXX GV_ADDWARN */					\
-	    tmpsv = get_sv(form("%s::%s", module,			\
+	    tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module,		\
 				vn = "XS_VERSION"), FALSE);		\
 	    if (!tmpsv || !SvOK(tmpsv))					\
-		tmpsv = get_sv(form("%s::%s", module,			\
+		tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module,	\
 				    vn = "VERSION"), FALSE);		\
 	}								\
 	if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a))))	\
-	    croak("%s object version %s does not match %s%s%s%s %_",	\
+	    Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %_",	\
 		  module, XS_VERSION,					\
 		  vn ? "$" : "", vn ? module : "", vn ? "::" : "",	\
 		  vn ? vn : "bootstrap parameter", tmpsv);		\

av.c

@@ -26,7 +26,7 @@ Perl_av_reify(pTHX_ AV *av)
 	return;
 #ifdef DEBUGGING
     if (SvTIED_mg((SV*)av, 'P'))
-	warn("av_reify called on tied array");
+	Perl_warn(aTHX_ "av_reify called on tied array");
 #endif
     key = AvMAX(av) + 1;
     while (key > AvFILLp(av) + 1)
@@ -215,7 +215,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
 
     if (SvRMAGICAL(av)) {
 	if (mg_find((SV*)av,'P')) {
@@ -326,15 +326,15 @@ Perl_av_clear(pTHX_ register AV *av)
 
 #ifdef DEBUGGING
     if (SvREFCNT(av) <= 0) {
-	warn("Attempt to clear deleted array");
+	Perl_warn(aTHX_ "Attempt to clear deleted array");
     }
 #endif
     if (!av)
 	return;
     /*SUPPRESS 560*/
 
     if (SvREADONLY(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av))
@@ -394,7 +394,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
     if (!av)
 	return;
     if (SvREADONLY(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
 
     if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
@@ -422,7 +422,7 @@ Perl_av_pop(pTHX_ register AV *av)
     if (!av || AvFILL(av) < 0)
 	return &PL_sv_undef;
     if (SvREADONLY(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
     if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;    
 	PUSHSTACKi(PERLSI_MAGIC);
@@ -456,7 +456,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     if (!av || num <= 0)
 	return;
     if (SvREADONLY(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
 
     if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
@@ -508,7 +508,7 @@ Perl_av_shift(pTHX_ register AV *av)
     if (!av || AvFILL(av) < 0)
 	return &PL_sv_undef;
     if (SvREADONLY(av))
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
     if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
 	PUSHSTACKi(PERLSI_MAGIC);
@@ -547,7 +547,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 {
     MAGIC *mg;
     if (!av)
-	croak("panic: null array");
+	Perl_croak(aTHX_ "panic: null array");
     if (fill < 0)
 	fill = -1;
     if (mg = SvTIED_mg((SV*)av, 'P')) {
@@ -596,11 +596,11 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
  */
 
 STATIC I32
-avhv_index_sv(pTHX_ SV* sv)
+S_avhv_index_sv(pTHX_ SV* sv)
 {
     I32 index = SvIV(sv);
     if (index < 1)
-	croak("Bad index while coercing array into hash");
+	Perl_croak(aTHX_ "Bad index while coercing array into hash");
     return index;    
 }
 
@@ -618,7 +618,7 @@ Perl_avhv_keys(pTHX_ AV *av)
 		return (HV*)sv;
 	}
     }
-    croak("Can't coerce array into hash");
+    Perl_croak(aTHX_ "Can't coerce array into hash");
     return Nullhv;
 }
 
@@ -631,7 +631,7 @@ Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
 
     he = hv_fetch_ent(keys, keysv, FALSE, hash);
     if (!he)
-        croak("No such array field");
+        Perl_croak(aTHX_ "No such array field");
     return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
 }
 

bytecode.pl

@@ -102,7 +102,8 @@ package B::Asmdata;
     return obj;
 }
 
-void byterun(struct bytestream bs)
+void
+byterun(pTHX_ struct bytestream bs)
 {
     dTHR;
     int insn;
@@ -173,7 +174,7 @@ package B::Asmdata;
 #
 print BYTERUN_C <<'EOT';
 	  default:
-	    croak("Illegal bytecode instruction %d\n", insn);
+	    Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
 	    /* NOTREACHED */
 	}
     }

cv.h

@@ -21,7 +21,7 @@ struct xpvcv {
     HV *	xcv_stash;
     OP *	xcv_start;
     OP *	xcv_root;
-    void      (*xcv_xsub) (CV* _CPERLproto);
+    void      (*xcv_xsub) (pTHX_ CV*);
     ANY		xcv_xsubany;
     GV *	xcv_gv;
     GV *	xcv_filegv;