Fix up ansiperl integration. Back to passing all expected tests

with usethreads. Untested with non-threaded perl.

p4raw-id: //depot/perl@231

9 files changed, 14 insertions, 139 deletions

diff --git a/embed.h b/embed.h
index 46709be1c1..32c2fcca92 100644
--- a/embed.h
+++ b/embed.h
@@ -1267,8 +1267,7 @@
 #define e_tmpname		(curinterp->Ie_tmpname)
 #define endav			(curinterp->Iendav)
 #define envgv			(curinterp->Ienvgv)
-#define errhv			(curinterp->Ierrhv)
-#define errsv			(curinterp->Ierrsv)
+#define errgv			(curinterp->Ierrgv)
 #define eval_root		(curinterp->Ieval_root)
 #define eval_start		(curinterp->Ieval_start)
 #define fdpid			(curinterp->Ifdpid)
@@ -1420,8 +1419,7 @@
 #define Ie_tmpname		e_tmpname
 #define Iendav			endav
 #define Ienvgv			envgv
-#define Ierrhv			errhv
-#define Ierrsv			errsv
+#define Ierrgv			errgv
 #define Ieval_root		eval_root
 #define Ieval_start		eval_start
 #define Ifdpid			fdpid
@@ -1582,8 +1580,7 @@
 #define e_fp			Perl_e_fp
 #define e_tmpname		Perl_e_tmpname
 #define endav			Perl_endav
-#define errhv			Perl_errhv
-#define errsv			Perl_errsv
+#define errgv			Perl_errgv
 #define eval_root		Perl_eval_root
 #define eval_start		Perl_eval_start
 #define fdpid			Perl_fdpid
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index bd0c933329..959f3425eb 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -140,7 +140,6 @@ btree_compare(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
-    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -188,7 +187,6 @@ btree_prefix(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
-    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -236,7 +234,6 @@ hash_cb(data, size)
 const void * data ;
 size_t size ;
 {
-    dTHR ;
     dSP ;
     int retval ;
     int count ;
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index d3305ec38d..ac1ca8c68d 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -20,7 +20,7 @@ typedef GDBM_FILE GDBM_File;
 
 typedef datum gdatum;
 
-typedef void (*FATALFUNC)(...);
+typedef void (*FATALFUNC)();
 
 static int
 not_here(char *s)
diff --git a/perl.c b/perl.c
index 3fe2c50281..7264648fbf 100644
--- a/perl.c
+++ b/perl.c
@@ -472,8 +472,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errhv = Nullhv;
-    errsv = Nullsv;
+    errgv = Nullgv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -1791,8 +1790,8 @@ init_main_stash(void)
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errsv = newSVpv("", 0);
-    errhv = newHV();
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
     (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
@@ -2885,18 +2884,18 @@ call_list(I32 oldscope, AV *list)
 		SV* atsv = ERRSV;
 		PUSHMARK(stack_sp);
 		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-		(void)SvPV(errsv, len);
+		(void)SvPV(atsv, len);
 		if (len) {
 		    JMPENV_POP;
 		    curcop = &compiling;
 		    curcop->cop_line = oldline;
 		    if (list == beginav)
-			sv_catpv(errsv, "BEGIN failed--compilation aborted");
+			sv_catpv(atsv, "BEGIN failed--compilation aborted");
 		    else
-			sv_catpv(errsv, "END failed--cleanup aborted");
+			sv_catpv(atsv, "END failed--cleanup aborted");
 		    while (scopestack_ix > oldscope)
 			LEAVE;
-		    croak("%s", SvPVX(errsv));
+		    croak("%s", SvPVX(atsv));
 		}
 	    }
 	    break;
diff --git a/perl.h b/perl.h
index 0a9a51282f..d562a31a49 100644
--- a/perl.h
+++ b/perl.h
@@ -1878,8 +1878,7 @@ IEXT I32	Imaxscream IINIT(-1);
 IEXT SV *	Ilastscream;
 
 /* shortcuts to misc objects */
-IEXT HV *	Ierrhv;
-IEXT SV *	Ierrsv;
+IEXT GV *	Ierrgv;
 
 /* shortcuts to debugging objects */
 IEXT GV *	IDBgv;
diff --git a/pp.c b/pp.c
index e518d737d9..819aea7817 100644
--- a/pp.c
+++ b/pp.c
@@ -4297,7 +4297,7 @@ PP(pp_lock)
 
 PP(pp_threadsv)
 {
-    dSP;
+    djSP;
 #ifdef USE_THREADS
     SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE);
     if (!svp)
diff --git a/t/lib/thread.t b/t/lib/thread.t
index 798adc12be..798adc12be 100644..100755
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
diff --git a/t/op/nothread.t b/t/op/nothread.t
index acc20890ae..acc20890ae 100644..100755
--- a/t/op/nothread.t
+++ b/t/op/nothread.t
diff --git a/util.c b/util.c
index 665fa88acc..721f945433 100644
--- a/util.c
+++ b/util.c
@@ -2407,8 +2407,7 @@ condpair_magic(SV *sv)
  * thread calling new_struct_thread) clearly satisfies this constraint.
  */
 struct thread *
-new_struct_thread(t)
-struct thread *t;
+new_struct_thread(struct thread *t)
 {
     struct thread *thr;
     SV *sv;
@@ -2488,122 +2487,6 @@ struct thread *t;
 
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
-#else
-    thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
-    return thr;
-}
-
-/*
- * Make a new perl thread structure using t as a prototype. Some of the
- * fields for the new thread are copied from the prototype thread, t,
- * so t should not be running in perl at the time this function is
- * called. The use by ext/Thread/Thread.xs in core perl (where t is the
- * thread calling new_struct_thread) clearly satisfies this constraint.
- */
-struct thread *
-new_struct_thread(struct thread *t)
-{
-    struct thread *thr;
-    SV *sv;
-    SV **svp;
-    I32 i;
-
-    sv = newSVpv("", 0);
-    SvGROW(sv, sizeof(struct thread) + 1);
-    SvCUR_set(sv, sizeof(struct thread));
-    thr = (Thread) SvPVX(sv);
-    /* debug */
-    memset(thr, 0xab, sizeof(struct thread));
-    markstack = 0;
-    scopestack = 0;
-    savestack = 0;
-    retstack = 0;
-    dirty = 0;
-    localizing = 0;
-    /* end debug */
-
-    thr->oursv = sv;
-    init_stacks(ARGS);
-
-    curcop = &compiling;
-    thr->cvcache = newHV();
-    thr->magicals = newAV();
-    thr->specific = newAV();
-    thr->flags = THRf_R_JOINABLE;
-    MUTEX_INIT(&thr->mutex);
-
-    curcop = t->Tcurcop;       /* XXX As good a guess as any? */
-    defstash = t->Tdefstash;   /* XXX maybe these should */
-    curstash = t->Tcurstash;   /* always be set to main? */
-
-
-    /* top_env needs to be non-zero. It points to an area
-       in which longjmp() stuff is stored, as C callstack
-       info there at least is thread specific this has to
-       be per-thread. Otherwise a 'die' in a thread gives
-       that thread the C stack of last thread to do an eval {}!
-       See comments in scope.h    
-       Initialize top entry (as in perl.c for main thread)
-     */
-    start_env.je_prev = NULL;
-    start_env.je_ret = -1;
-    start_env.je_mustcatch = TRUE;
-    top_env  = &start_env;
-
-    runlevel = 0;		/* Let entering sub do increment */
-
-    in_eval = FALSE;
-    restartop = 0;
-
-    tainted = t->Ttainted;
-    curpm = t->Tcurpm;         /* XXX No PMOP ref count */
-    nrs = newSVsv(t->Tnrs);
-    rs = newSVsv(t->Trs);
-    last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
-    ofslen = t->Tofslen;
-    ofs = savepvn(t->Tofs, ofslen);
-    defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
-    chopset = t->Tchopset;
-    formtarget = newSVsv(t->Tformtarget);
-    bodytarget = newSVsv(t->Tbodytarget);
-    toptarget = newSVsv(t->Ttoptarget);
-    
-    /* Initialise all per-thread magicals that the template thread used */
-    svp = AvARRAY(t->magicals);
-    for (i = 0; i <= AvFILL(t->magicals); i++, svp++) {
-	if (*svp && *svp != &sv_undef) {
-	    SV *sv = newSVsv(*svp);
-	    av_store(thr->magicals, i, sv);
-	    sv_magic(sv, 0, 0, &per_thread_magicals[i], 1);
-	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-				  "new_struct_thread: copied magical %d %p->%p\n",i,
-                                  t, thr));
-	}
-    } 
-
-    MUTEX_LOCK(&threads_mutex);
-    nthreads++;
-    thr->tid = ++threadnum;
-    thr->next = t->next;
-    thr->prev = t;
-    t->next = thr;
-    thr->next->prev = thr;
-    MUTEX_UNLOCK(&threads_mutex);
-
-/*
- * This is highly suspect - new_struct_thread is executed
- * by creating thread so pthread_self() or equivalent
- * is parent thread not the child.
- * In particular this should _NOT_ change dTHR value of calling thread.
- * 
- * But a good place to have a 'hook' for filling in port-private
- * fields of thr. 
- */
-#ifdef INIT_THREAD_INTERN
-    INIT_THREAD_INTERN(thr);
-#else
-    thr->self = pthread_self();
 #endif /* HAVE_THREAD_INTERN */
     return thr;
 }