From: Malcolm Beattie Date: Tue, 11 Nov 1997 17:46:59 +0000 (+0000) Subject: Fix up ansiperl integration. Back to passing all expected tests X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12f917ad6d7e3aea6f84bc265d3b6d1b415c7598;p=p5sagit%2Fp5-mst-13.2.git Fix up ansiperl integration. Back to passing all expected tests with usethreads. Untested with non-threaded perl. p4raw-id: //depot/perl@231 --- diff --git a/embed.h b/embed.h index 46709be..32c2fcc 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 bd0c933..959f342 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 d3305ec..ac1ca8c 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 3fe2c50..7264648 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 0a9a512..d562a31 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 e518d73..819aea7 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 old mode 100644 new mode 100755 diff --git a/t/op/nothread.t b/t/op/nothread.t old mode 100644 new mode 100755 diff --git a/util.c b/util.c index 665fa88..721f945 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; }