From: Malcolm Beattie Date: Tue, 11 Nov 1997 16:36:22 +0000 (+0000) Subject: Initial integration of ansi branch into mainline (untested). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e5687acb0c7cb7e00d80dde70d5d9163677bffea;p=p5sagit%2Fp5-mst-13.2.git Initial integration of ansi branch into mainline (untested). p4raw-id: //depot/perl@230 --- e5687acb0c7cb7e00d80dde70d5d9163677bffea diff --cc opcode.h index b560369,dedc5ca..e243548 --- a/opcode.h +++ b/opcode.h @@@ -1439,12 -1441,14 +1441,14 @@@ OP * pp_egrent _((ARGSproto)) OP * pp_getlogin _((ARGSproto)); OP * pp_syscall _((ARGSproto)); OP * pp_lock _((ARGSproto)); -OP * pp_specific _((ARGSproto)); +OP * pp_threadsv _((ARGSproto)); + END_EXTERN_C + #ifndef DOINIT - EXT OP * (*ppaddr[])(); + EXT OP * (*ppaddr[])(ARGSproto); #else - EXT OP * (*ppaddr[])() = { + EXT OP * (*ppaddr[])(ARGSproto) = { pp_null, pp_stub, pp_scalar, diff --cc perl.c index 3f30f6d,f6cef35..3fe2c50 --- a/perl.c +++ b/perl.c @@@ -1082,21 -1078,9 +1078,19 @@@ perl_run(PerlInterpreter *sv_interp } SV* - perl_get_sv(name, create) - char* name; - I32 create; + perl_get_sv(char *name, I32 create) { - GV* gv = gv_fetchpv(name, create, SVt_PV); + GV *gv; +#ifdef USE_THREADS + if (name[1] == '\0' && !isALPHA(name[0])) { + PADOFFSET tmp = find_thread_magical(name); + if (tmp != NOT_IN_PAD) { + dTHR; + return *av_fetch(thr->magicals, tmp, FALSE); + } + } +#endif /* USE_THREADS */ + gv = gv_fetchpv(name, create, SVt_PV); if (gv) return GvSV(gv); return Nullsv; @@@ -1813,11 -1781,11 +1791,11 @@@ init_main_stash(void incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV))); GvMULTI_on(incgv); defgv = gv_fetchpv("_",TRUE, SVt_PVAV); - errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV)); - GvMULTI_on(errgv); + errsv = newSVpv("", 0); + errhv = newHV(); (void)form("%240s",""); /* Preallocate temp - for immediate signals. */ - sv_grow(errsv, 240); /* Preallocate - for immediate signals. */ - sv_setpvn(errsv, "", 0); + sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */ + sv_setpvn(ERRSV, "", 0); curstash = defstash; compiling.cop_stash = defstash; debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV)); @@@ -2915,10 -2870,9 +2882,10 @@@ call_list(I32 oldscope, AV *list JMPENV_PUSH(ret); switch (ret) { case 0: { + SV* atsv = ERRSV; PUSHMARK(stack_sp); perl_call_sv((SV*)cv, G_EVAL|G_DISCARD); - (void)SvPV(atsv, len); + (void)SvPV(errsv, len); if (len) { JMPENV_POP; curcop = &compiling; diff --cc util.c index b6b27a6,62b0f00..665fa88 --- a/util.c +++ b/util.c @@@ -2499,92 -2407,111 +2407,206 @@@ condpair_magic(SV *sv * thread calling new_struct_thread) clearly satisfies this constraint. */ struct thread * +new_struct_thread(t) +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); + /* Zero(thr, 1, struct thread); */ + + /* 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(thr); + + curcop = &compiling; + thr->cvcache = newHV(); + thr->magicals = newAV(); + thr->specific = newAV(); + thr->errsv = newSVpv("", 0); + thr->errhv = newHV(); + 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. The particular value doesn't matter */ + top_env = t->Ttop_env; + runlevel = 1; /* XXX should be safe ? */ + 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\n",i)); + } + } + + 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); + +#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; + } #endif /* USE_THREADS */ #ifdef HUGE_VAL