#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)
#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
#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
envgv = Nullgv;
siggv = Nullgv;
incgv = Nullgv;
- errhv = Nullhv;
- errsv = Nullsv;
+ errgv = Nullgv;
argvgv = Nullgv;
argvoutgv = Nullgv;
stdingv = Nullgv;
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);
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;
* 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;
#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;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff