diff options
| -rw-r--r-- | XSUB.h | 2 | ||||
| -rw-r--r-- | av.c | 7 | ||||
| -rw-r--r-- | cv.h | 10 | ||||
| -rw-r--r-- | deb.c | 23 | ||||
| -rw-r--r-- | doio.c | 10 | ||||
| -rw-r--r-- | doop.c | 1 | ||||
| -rw-r--r-- | dump.c | 154 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | gv.c | 11 | ||||
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | malloc.c | 8 | ||||
| -rw-r--r-- | mg.c | 9 | ||||
| -rw-r--r-- | op.c | 1430 | ||||
| -rw-r--r-- | op.h | 14 | ||||
| -rw-r--r-- | opcode.h | 742 | ||||
| -rwxr-xr-x | opcode.pl | 4 | ||||
| -rw-r--r-- | perl.c | 140 | ||||
| -rw-r--r-- | perl.h | 23 | ||||
| -rw-r--r-- | pp.h | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 66 | ||||
| -rw-r--r-- | pp_hot.c | 157 | ||||
| -rw-r--r-- | pp_sys.c | 12 | ||||
| -rw-r--r-- | proto.h | 56 | ||||
| -rw-r--r-- | regcomp.c | 20 | ||||
| -rw-r--r-- | regexec.c | 3 | ||||
| -rw-r--r-- | run.c | 31 | ||||
| -rw-r--r-- | scope.c | 39 | ||||
| -rw-r--r-- | sv.c | 68 | ||||
| -rw-r--r-- | sv.h | 4 | ||||
| -rw-r--r-- | thread.h | 206 | ||||
| -rw-r--r-- | toke.c | 49 | ||||
| -rw-r--r-- | util.c | 20 |
32 files changed, 2085 insertions, 1244 deletions
@@ -7,7 +7,7 @@ #endif #define dXSARGS \ - dSP; dMARK; \ + dTHR; dSP; dMARK; \ I32 ax = mark - stack_base + 1; \ I32 items = sp - mark @@ -30,8 +30,10 @@ AV* av; while (key) { sv = AvARRAY(av)[--key]; assert(sv); - if (sv != &sv_undef) + if (sv != &sv_undef) { + dTHR; (void)SvREFCNT_inc(sv); + } } AvREAL_on(av); } @@ -41,6 +43,7 @@ av_extend(av,key) AV *av; I32 key; { + dTHR; /* only necessary if we have to extend stack */ if (key > AvMAX(av)) { SV** ary; I32 tmp; @@ -131,6 +134,7 @@ I32 lval; if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { + dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); Sv = sv; @@ -196,6 +200,7 @@ SV *val; ary = AvARRAY(av); if (AvFILL(av) < key) { if (!AvREAL(av)) { + dTHR; if (av == stack && key > stack_sp - stack_base) stack_sp = stack_base + key; /* XPUSH in disguise */ do @@ -26,6 +26,11 @@ struct xpvcv { long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; CV * xcv_outside; +#ifdef USE_THREADS + pthread_mutex_t * xcv_mutexp; + pthread_cond_t * xcv_condp; /* signalled when owner leaves CV */ + struct thread * xcv_owner; /* current owner thread */ +#endif /* USE_THREADS */ U8 xcv_flags; }; @@ -41,6 +46,11 @@ struct xpvcv { #define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth #define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist #define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside +#ifdef USE_THREADS +#define CvMUTEXP(sv) ((XPVCV*)SvANY(sv))->xcv_mutexp +#define CvCONDP(sv) ((XPVCV*)SvANY(sv))->xcv_condp +#define CvOWNER(sv) ((XPVCV*)SvANY(sv))->xcv_owner +#endif /* USE_THREADS */ #define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags #define CVf_CLONE 0x01 /* anon CV uses external lexicals */ @@ -27,12 +27,20 @@ void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) char *pat; { + dTHR; register I32 i; GV* gv = curcop->cop_filegv; +#ifdef USE_THREADS + fprintf(stderr,"0x%lx (%s:%ld)\t", + (unsigned long) thr, + SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", + (long)curcop->cop_line); +#else fprintf(stderr,"(%s:%ld)\t", SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", (long)curcop->cop_line); +#endif /* USE_THREADS */ for (i=0; i<dlevel; i++) fprintf(stderr,"%c%c ",debname[i],debdelim[i]); fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8); @@ -51,13 +59,21 @@ deb(pat, va_alist) va_dcl # endif { + dTHR; va_list args; register I32 i; GV* gv = curcop->cop_filegv; +#ifdef USE_THREADS + fprintf(stderr,"0x%lx (%s:%ld)\t", + (unsigned long) thr, + SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", + (long)curcop->cop_line); +#else fprintf(stderr,"(%s:%ld)\t", SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", (long)curcop->cop_line); +#endif /* USE_THREADS */ for (i=0; i<dlevel; i++) fprintf(stderr,"%c%c ",debname[i],debdelim[i]); @@ -82,6 +98,7 @@ deb_growlevel() I32 debstackptrs() { + dTHR; fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)stack, (unsigned long)stack_base, (long)*markstack_ptr, (long)(stack_sp-stack_base), @@ -95,6 +112,7 @@ debstackptrs() I32 debstack() { + dTHR; I32 top = stack_sp - stack_base; register I32 i = top - 30; I32 *markscan = markstack; @@ -106,7 +124,12 @@ debstack() if (*markscan >= i) break; +#ifdef USE_THREADS + fprintf(stderr, i ? "0x%lx => ... " : "0x%lx => ", + (unsigned long) thr); +#else fprintf(stderr, i ? " => ... " : " => "); +#endif /* USE_THREADS */ if (stack_base[0] != &sv_undef || stack_sp < stack_base) fprintf(stderr, " [STACK UNDERFLOW!!!]\n"); do { @@ -353,6 +353,7 @@ register GV *gv; } filemode = 0; while (av_len(GvAV(gv)) >= 0) { + dTHR; STRLEN len; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); @@ -587,6 +588,7 @@ bool do_eof(gv) GV *gv; { + dTHR; register IO *io; int ch; @@ -918,6 +920,7 @@ register SV **sp; char *tmps; if (sp > mark) { + dTHR; New(401,Argv, sp - mark + 1, char*); a = Argv; while (++mark <= sp) { @@ -1048,6 +1051,7 @@ I32 type; register SV **mark; register SV **sp; { + dTHR; register I32 val; register I32 val2; register I32 tot = 0; @@ -1293,6 +1297,7 @@ I32 optype; SV **mark; SV **sp; { + dTHR; key_t key; I32 n, flags; @@ -1328,6 +1333,7 @@ I32 optype; SV **mark; SV **sp; { + dTHR; SV *astr; char *a; I32 id, n, cmd, infosize, getinfo; @@ -1430,6 +1436,7 @@ SV **mark; SV **sp; { #ifdef HAS_MSG + dTHR; SV *mstr; char *mbuf; I32 id, msize, flags; @@ -1454,6 +1461,7 @@ SV **mark; SV **sp; { #ifdef HAS_MSG + dTHR; SV *mstr; char *mbuf; long mtype; @@ -1492,6 +1500,7 @@ SV **mark; SV **sp; { #ifdef HAS_SEM + dTHR; SV *opstr; char *opbuf; I32 id; @@ -1519,6 +1528,7 @@ SV **mark; SV **sp; { #ifdef HAS_SHM + dTHR; SV *mstr; char *mbuf, *shm; I32 id, mpos, msize; @@ -31,6 +31,7 @@ do_trans(sv,arg) SV *sv; OP *arg; { + dTHR; register short *tbl; register U8 *s; register U8 *send; @@ -27,6 +27,7 @@ static void dump(); void dump_all() { + dTHR; #ifdef HAS_SETLINEBUF setlinebuf(stderr); #else @@ -41,6 +42,7 @@ void dump_packsubs(stash) HV* stash; { + dTHR; I32 i; HE *entry; @@ -100,115 +102,115 @@ dump_eval() } void -dump_op(op) -register OP *op; +dump_op(o) +register OP *o; { SV *tmpsv; dump("{\n"); - if (op->op_seq) - fprintf(stderr, "%-4d", op->op_seq); + if (o->op_seq) + fprintf(stderr, "%-4d", o->op_seq); else fprintf(stderr, " "); - dump("TYPE = %s ===> ", op_name[op->op_type]); - if (op->op_next) { - if (op->op_seq) - fprintf(stderr, "%d\n", op->op_next->op_seq); + dump("TYPE = %s ===> ", op_name[o->op_type]); + if (o->op_next) { + if (o->op_seq) + fprintf(stderr, "%d\n", o->op_next->op_seq); else - fprintf(stderr, "(%d)\n", op->op_next->op_seq); + fprintf(stderr, "(%d)\n", o->op_next->op_seq); } else fprintf(stderr, "DONE\n"); dumplvl++; - if (op->op_targ) { - if (op->op_type == OP_NULL) - dump(" (was %s)\n", op_name[op->op_targ]); + if (o->op_targ) { + if (o->op_type == OP_NULL) + dump(" (was %s)\n", op_name[o->op_targ]); else - dump("TARG = %d\n", op->op_targ); + dump("TARG = %d\n", o->op_targ); } #ifdef DUMPADDR - dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next); + dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next); #endif - if (op->op_flags) { + if (o->op_flags) { *buf = '\0'; - if (op->op_flags & OPf_KNOW) { - if (op->op_flags & OPf_LIST) + if (o->op_flags & OPf_KNOW) { + if (o->op_flags & OPf_LIST) (void)strcat(buf,"LIST,"); else (void)strcat(buf,"SCALAR,"); } else (void)strcat(buf,"UNKNOWN,"); - if (op->op_flags & OPf_KIDS) + if (o->op_flags & OPf_KIDS) (void)strcat(buf,"KIDS,"); - if (op->op_flags & OPf_PARENS) + if (o->op_flags & OPf_PARENS) (void)strcat(buf,"PARENS,"); - if (op->op_flags & OPf_STACKED) + if (o->op_flags & OPf_STACKED) (void)strcat(buf,"STACKED,"); - if (op->op_flags & OPf_REF) + if (o->op_flags & OPf_REF) (void)strcat(buf,"REF,"); - if (op->op_flags & OPf_MOD) + if (o->op_flags & OPf_MOD) (void)strcat(buf,"MOD,"); - if (op->op_flags & OPf_SPECIAL) + if (o->op_flags & OPf_SPECIAL) (void)strcat(buf,"SPECIAL,"); if (*buf) buf[strlen(buf)-1] = '\0'; dump("FLAGS = (%s)\n",buf); } - if (op->op_private) { + if (o->op_private) { *buf = '\0'; - if (op->op_type == OP_AASSIGN) { - if (op->op_private & OPpASSIGN_COMMON) + if (o->op_type == OP_AASSIGN) { + if (o->op_private & OPpASSIGN_COMMON) (void)strcat(buf,"COMMON,"); } - else if (op->op_type == OP_SASSIGN) { - if (op->op_private & OPpASSIGN_BACKWARDS) + else if (o->op_type == OP_SASSIGN) { + if (o->op_private & OPpASSIGN_BACKWARDS) (void)strcat(buf,"BACKWARDS,"); } - else if (op->op_type == OP_TRANS) { - if (op->op_private & OPpTRANS_SQUASH) + else if (o->op_type == OP_TRANS) { + if (o->op_private & OPpTRANS_SQUASH) (void)strcat(buf,"SQUASH,"); - if (op->op_private & OPpTRANS_DELETE) + if (o->op_private & OPpTRANS_DELETE) (void)strcat(buf,"DELETE,"); - if (op->op_private & OPpTRANS_COMPLEMENT) + if (o->op_private & OPpTRANS_COMPLEMENT) (void)strcat(buf,"COMPLEMENT,"); } - else if (op->op_type == OP_REPEAT) { - if (op->op_private & OPpREPEAT_DOLIST) + else if (o->op_type == OP_REPEAT) { + if (o->op_private & OPpREPEAT_DOLIST) (void)strcat(buf,"DOLIST,"); } - else if (op->op_type == OP_ENTERSUB || - op->op_type == OP_RV2SV || - op->op_type == OP_RV2AV || - op->op_type == OP_RV2HV || - op->op_type == OP_RV2GV || - op->op_type == OP_AELEM || - op->op_type == OP_HELEM ) + else if (o->op_type == OP_ENTERSUB || + o->op_type == OP_RV2SV || + o->op_type == OP_RV2AV || + o->op_type == OP_RV2HV || + o->op_type == OP_RV2GV || + o->op_type == OP_AELEM || + o->op_type == OP_HELEM ) { - if (op->op_private & OPpENTERSUB_AMPER) + if (o->op_private & OPpENTERSUB_AMPER) (void)strcat(buf,"AMPER,"); - if (op->op_private & OPpENTERSUB_DB) + if (o->op_private & OPpENTERSUB_DB) (void)strcat(buf,"DB,"); - if (op->op_private & OPpDEREF_AV) + if (o->op_private & OPpDEREF_AV) (void)strcat(buf,"AV,"); - if (op->op_private & OPpDEREF_HV) + if (o->op_private & OPpDEREF_HV) (void)strcat(buf,"HV,"); - if (op->op_private & HINT_STRICT_REFS) + if (o->op_private & HINT_STRICT_REFS) (void)strcat(buf,"STRICT_REFS,"); } - else if (op->op_type == OP_CONST) { - if (op->op_private & OPpCONST_BARE) + else if (o->op_type == OP_CONST) { + if (o->op_private & OPpCONST_BARE) (void)strcat(buf,"BARE,"); } - else if (op->op_type == OP_FLIP) { - if (op->op_private & OPpFLIP_LINENUM) + else if (o->op_type == OP_FLIP) { + if (o->op_private & OPpFLIP_LINENUM) (void)strcat(buf,"LINENUM,"); } - else if (op->op_type == OP_FLOP) { - if (op->op_private & OPpFLIP_LINENUM) + else if (o->op_type == OP_FLOP) { + if (o->op_private & OPpFLIP_LINENUM) (void)strcat(buf,"LINENUM,"); } - if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO) + if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) (void)strcat(buf,"INTRO,"); if (*buf) { buf[strlen(buf)-1] = '\0'; @@ -216,14 +218,14 @@ register OP *op; } } - switch (op->op_type) { + switch (o->op_type) { case OP_GVSV: case OP_GV: - if (cGVOP->op_gv) { + if (cGVOPo->op_gv) { ENTER; tmpsv = NEWSV(0,0); SAVEFREESV(tmpsv); - gv_fullname(tmpsv,cGVOP->op_gv); + gv_fullname(tmpsv,cGVOPo->op_gv); dump("GV = %s\n", SvPV(tmpsv, na)); LEAVE; } @@ -231,41 +233,41 @@ register OP *op; dump("GV = NULL\n"); break; case OP_CONST: - dump("SV = %s\n", SvPEEK(cSVOP->op_sv)); + dump("SV = %s\n", SvPEEK(cSVOPo->op_sv)); break; case OP_NEXTSTATE: case OP_DBSTATE: - if (cCOP->cop_line) - dump("LINE = %d\n",cCOP->cop_line); - if (cCOP->cop_label) - dump("LABEL = \"%s\"\n",cCOP->cop_label); + if (cCOPo->cop_line) + dump("LINE = %d\n",cCOPo->cop_line); + if (cCOPo->cop_label) + dump("LABEL = \"%s\"\n",cCOPo->cop_label); break; case OP_ENTERLOOP: dump("REDO ===> "); - if (cLOOP->op_redoop) - fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq); + if (cLOOPo->op_redoop) + fprintf(stderr, "%d\n", cLOOPo->op_redoop->op_seq); else fprintf(stderr, "DONE\n"); dump("NEXT ===> "); - if (cLOOP->op_nextop) - fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq); + if (cLOOPo->op_nextop) + fprintf(stderr, "%d\n", cLOOPo->op_nextop->op_seq); else fprintf(stderr, "DONE\n"); dump("LAST ===> "); - if (cLOOP->op_lastop) - fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq); + if (cLOOPo->op_lastop) + fprintf(stderr, "%d\n", cLOOPo->op_lastop->op_seq); else fprintf(stderr, "DONE\n"); break; case OP_COND_EXPR: dump("TRUE ===> "); - if (cCONDOP->op_true) - fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq); + if (cCONDOPo->op_true) + fprintf(stderr, "%d\n", cCONDOPo->op_true->op_seq); else fprintf(stderr, "DONE\n"); dump("FALSE ===> "); - if (cCONDOP->op_false) - fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq); + if (cCONDOPo->op_false) + fprintf(stderr, "%d\n", cCONDOPo->op_false->op_seq); else fprintf(stderr, "DONE\n"); break; @@ -274,22 +276,22 @@ register OP *op; case OP_OR: case OP_AND: dump("OTHER ===> "); - if (cLOGOP->op_other) - fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq); + if (cLOGOPo->op_other) + fprintf(stderr, "%d\n", cLOGOPo->op_other->op_seq); else fprintf(stderr, "DONE\n"); break; case OP_PUSHRE: case OP_MATCH: case OP_SUBST: - dump_pm((PMOP*)op); + dump_pm(cPMOPo); break; default: break; } - if (op->op_flags & OPf_KIDS) { + if (o->op_flags & OPf_KIDS) { OP *kid; - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) dump_op(kid); } dumplvl--; diff --git a/global.sym b/global.sym index 70d07c0034..ea39192c79 100644 --- a/global.sym +++ b/global.sym @@ -436,6 +436,7 @@ hv_store hv_undef ibcmp ingroup +init_stacks instr intuit_more invert @@ -261,6 +261,7 @@ char* name; sv_catpvn(tmpstr, "::ISA", 5); gv = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV); if (gv) { + dTHR; GvAV(gv) = (AV*)SvREFCNT_inc(av); /* ... and re-try lookup */ gv = gv_fetchmeth(stash, name, nend - name, 0); @@ -331,6 +332,7 @@ char *nambeg; I32 add; I32 sv_type; { + dTHR; register char *name = nambeg; register GV *gv = 0; GV**gvp; @@ -695,6 +697,7 @@ GV *gv; IO * newIO() { + dTHR; IO *io; GV *iogv; @@ -711,6 +714,7 @@ void gv_check(stash) HV* stash; { + dTHR; register HE *entry; register I32 i; register GV *gv; @@ -824,6 +828,7 @@ bool Gv_AMupdate(stash) HV* stash; { + dTHR; GV** gvp; HV* hv; GV* gv; @@ -935,6 +940,7 @@ SV* right; int method; int flags; { + dTHR; MAGIC *mg; CV *cv; CV **cvp=NULL, **ocvp=NULL; @@ -1120,6 +1126,7 @@ int flags; || inc_dec_ass) RvDEEPCP(left); } { + dTHR; dSP; BINOP myop; SV* res; @@ -1133,7 +1140,7 @@ int flags; SAVESPTR(op); op = (OP *) &myop; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); @@ -1145,7 +1152,7 @@ int flags; PUSHs((SV*)cv); PUTBACK; - if (op = pp_entersub()) + if (op = pp_entersub(ARGS)) runops(); LEAVE; SPAGAIN; @@ -74,6 +74,7 @@ I32 lval; if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { + dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); Sv = sv; @@ -278,6 +279,7 @@ U32 klen; if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { + dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); magic_existspack(sv, mg_find(sv, 'p')); @@ -126,6 +126,7 @@ malloc(nbytes) #endif #endif /* safemalloc */ + MUTEX_LOCK(&malloc_mutex); /* * Convert amount of memory requested into * closest block size stored in hash buckets @@ -145,6 +146,7 @@ malloc(nbytes) if (nextf[bucket] == NULL) morecore(bucket); if ((p = (union overhead *)nextf[bucket]) == NULL) { + MUTEX_UNLOCK(&malloc_mutex); #ifdef safemalloc if (!nomemok) { fputs("Out of memory!\n", stderr); @@ -182,6 +184,7 @@ malloc(nbytes) p->ov_rmagic = RMAGIC; *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC; #endif + MUTEX_UNLOCK(&malloc_mutex); return ((Malloc_t)(p + 1)); } @@ -281,6 +284,7 @@ free(mp) return; /* sanity */ } #endif + MUTEX_LOCK(&malloc_mutex); #ifdef RCHECK ASSERT(op->ov_rmagic == RMAGIC); if (op->ov_index <= 13) @@ -294,6 +298,7 @@ free(mp) #ifdef DEBUGGING_MSTATS nmalloc[size]--; #endif + MUTEX_UNLOCK(&malloc_mutex); } /* @@ -340,6 +345,7 @@ realloc(mp, nbytes) #endif #endif /* safemalloc */ + MUTEX_LOCK(&malloc_mutex); op = (union overhead *)((caddr_t)cp - sizeof (union overhead)); if (op->ov_magic == MAGIC) { was_alloced++; @@ -383,8 +389,10 @@ realloc(mp, nbytes) } #endif res = cp; + MUTEX_UNLOCK(&malloc_mutex); } else { + MUTEX_UNLOCK(&malloc_mutex); if ((res = (char*)malloc(nbytes)) == NULL) return (NULL); if (cp != res) /* common optimization */ @@ -636,6 +636,7 @@ magic_setsig(sv,mg) SV* sv; MAGIC* mg; { + dTHR; register char *s; I32 i; SV** svp; @@ -726,6 +727,7 @@ SV* sv; MAGIC* mg; char *meth; { + dTHR; dSP; ENTER; @@ -763,6 +765,7 @@ magic_setpack(sv,mg) SV* sv; MAGIC* mg; { + dTHR; dSP; PUSHMARK(sp); @@ -792,6 +795,7 @@ int magic_wipepack(sv,mg) SV* sv; MAGIC* mg; { + dTHR; dSP; PUSHMARK(sp); @@ -809,6 +813,7 @@ SV* sv; MAGIC* mg; SV* key; { + dTHR; dSP; char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; @@ -842,6 +847,7 @@ magic_setdbline(sv,mg) SV* sv; MAGIC* mg; { + dTHR; OP *o; I32 i; GV* gv; @@ -996,6 +1002,7 @@ magic_settaint(sv,mg) SV* sv; MAGIC* mg; { + dTHR; if (localizing) { if (localizing == 1) mg->mg_len <<= 1; @@ -1055,6 +1062,7 @@ magic_set(sv,mg) SV* sv; MAGIC* mg; { + dTHR; register char *s; I32 i; STRLEN len; @@ -1356,6 +1364,7 @@ Signal_t sighandler(sig) int sig; { + dTHR; dSP; GV *gv; HV *st; @@ -25,22 +25,22 @@ * In the following definition, the ", (OP *) op" is just to make the compiler * think the expression is of the right type: croak actually does a Siglongjmp. */ -#define CHECKOP(type,op) \ +#define CHECKOP(type,o) \ ((op_mask && op_mask[type]) \ - ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \ - : (*check[type])((OP*)op)) + ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)o) \ + : (*check[type])((OP*)o)) #else -#define CHECKOP(type,op) (*check[type])(op) +#define CHECKOP(type,o) (*check[type])(o) #endif /* USE_OP_MASK */ -static I32 list_assignment _((OP *op)); -static OP *bad_type _((I32 n, char *t, char *name, OP *kid)); -static OP *modkids _((OP *op, I32 type)); -static OP *no_fh_allowed _((OP *op)); -static OP *scalarboolean _((OP *op)); -static OP *too_few_arguments _((OP *op, char* name)); -static OP *too_many_arguments _((OP *op, char* name)); -static void null _((OP* op)); +static I32 list_assignment _((OP *o)); +static void bad_type _((I32 n, char *t, char *name, OP *kid)); +static OP *modkids _((OP *o, I32 type)); +static OP *no_fh_allowed _((OP *o)); +static OP *scalarboolean _((OP *o)); +static OP *too_few_arguments _((OP *o, char* name)); +static OP *too_many_arguments _((OP *o, char* name)); +static void null _((OP* o)); static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)); @@ -54,36 +54,36 @@ CV* cv; } static OP * -no_fh_allowed(op) -OP *op; +no_fh_allowed(o) +OP *o; { sprintf(tokenbuf,"Missing comma after first argument to %s function", - op_desc[op->op_type]); + op_desc[o->op_type]); yyerror(tokenbuf); - return op; + return o; } static OP * -too_few_arguments(op, name) -OP* op; +too_few_arguments(o, name) +OP* o; char* name; { sprintf(tokenbuf,"Not enough arguments for %s", name); yyerror(tokenbuf); - return op; + return o; } static OP * -too_many_arguments(op, name) -OP *op; +too_many_arguments(o, name) +OP *o; char* name; { sprintf(tokenbuf,"Too many arguments for %s", name); yyerror(tokenbuf); - return op; + return o; } -static OP * +static void bad_type(n, t, name, kid) I32 n; char *t; @@ -93,14 +93,13 @@ OP *kid; sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", (int) n, name, t, op_desc[kid->op_type]); yyerror(tokenbuf); - return op; } void -assertref(op) -OP *op; +assertref(o) +OP *o; { - int type = op->op_type; + int type = o->op_type; if (type != OP_AELEM && type != OP_HELEM) { sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]); yyerror(tokenbuf); @@ -116,6 +115,7 @@ PADOFFSET pad_allocmy(name) char *name; { + dTHR; PADOFFSET off; SV *sv; @@ -154,6 +154,7 @@ I32 cx_ix; pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) #endif { + dTHR; CV *cv; I32 off; SV *sv; @@ -237,11 +238,25 @@ PADOFFSET pad_findmy(name) char *name; { + dTHR; I32 off; SV *sv; SV **svp = AvARRAY(comppad_name); I32 seq = cop_seqmax; +#ifdef USE_THREADS + /* + * Special case to get lexical (and hence per-thread) @_. + * XXX I need to find out how to tell at parse-time whether use + * of @_ should refer to a lexical (from a sub) or defgv (global + * scope and maybe weird sub-ish things like formats). See + * startsub in perly.y. It's possible that @_ could be lexical + * (at least from subs) even in non-threaded perl. + */ + if (strEQ(name, "@_")) + return 0; /* success. (NOT_IN_PAD indicates failure) */ +#endif /* USE_THREADS */ + /* The one we're looking for is probably just before comppad_name_fill. */ for (off = AvFILL(comppad_name); off > 0; off--) { if ((sv = svp[off]) && @@ -257,9 +272,9 @@ char *name; /* See if it's in a nested scope */ off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix); if (off) - return off; + return off; /* pad_findlex returns 0 for failure...*/ - return 0; + return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */ } void @@ -287,6 +302,7 @@ pad_alloc(optype,tmptype) I32 optype; U32 tmptype; { + dTHR; SV *sv; I32 retval; @@ -308,7 +324,13 @@ U32 tmptype; } SvFLAGS(sv) |= tmptype; curpad = AvARRAY(comppad); +#ifdef USE_THREADS + DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx alloc %ld for %s\n", + (unsigned long) thr, (unsigned long) curpad, + (long) retval, op_name[optype])); +#else DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype])); +#endif /* USE_THREADS */ return (PADOFFSET)retval; } @@ -320,9 +342,15 @@ PADOFFSET po; pad_sv(PADOFFSET po) #endif /* CAN_PROTOTYPE */ { + dTHR; +#ifdef USE_THREADS + DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx sv %d\n", + (unsigned long) thr, (unsigned long) curpad, po)); +#else if (!po) croak("panic: pad_sv po"); DEBUG_X(fprintf(stderr, "Pad sv %d\n", po)); +#endif /* USE_THREADS */ return curpad[po]; /* eventually we'll turn this into a macro */ } @@ -334,13 +362,19 @@ PADOFFSET po; pad_free(PADOFFSET po) #endif /* CAN_PROTOTYPE */ { + dTHR; if (!curpad) return; if (AvARRAY(comppad) != curpad) croak("panic: pad_free curpad"); if (!po) croak("panic: pad_free po"); +#ifdef USE_THREADS + DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx free %d\n", + (unsigned long) thr, (unsigned long) curpad, po)); +#else DEBUG_X(fprintf(stderr, "Pad free %d\n", po)); +#endif /* USE_THREADS */ if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); if ((I32)po < padix) @@ -355,11 +389,17 @@ PADOFFSET po; pad_swipe(PADOFFSET po) #endif /* CAN_PROTOTYPE */ { + dTHR; if (AvARRAY(comppad) != curpad) croak("panic: pad_swipe curpad"); if (!po) croak("panic: pad_swipe po"); +#ifdef USE_THREADS + DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx swipe %d\n", + (unsigned long) thr, (unsigned long) curpad, po)); +#else DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po)); +#endif /* USE_THREADS */ SvPADTMP_off(curpad[po]); curpad[po] = NEWSV(1107,0); SvPADTMP_on(curpad[po]); @@ -370,11 +410,17 @@ pad_swipe(PADOFFSET po) void pad_reset() { + dTHR; register I32 po; if (AvARRAY(comppad) != curpad) croak("panic: pad_reset curpad"); +#ifdef USE_THREADS + DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx reset\n", + (unsigned long) thr, (unsigned long) curpad)); +#else DEBUG_X(fprintf(stderr, "Pad reset\n")); +#endif /* USE_THREADS */ if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */ for (po = AvMAX(comppad); po > padix_floor; po--) { if (curpad[po] && curpad[po] != &sv_undef) @@ -388,76 +434,76 @@ pad_reset() /* Destructor */ void -op_free(op) -OP *op; +op_free(o) +OP *o; { register OP *kid, *nextkid; - if (!op) + if (!o) return; - if (op->op_flags & OPf_KIDS) { - for (kid = cUNOP->op_first; kid; kid = nextkid) { + if (o->op_flags & OPf_KIDS) { + for (kid = cUNOPo->op_first; kid; kid = nextkid) { nextkid = kid->op_sibling; /* Get before next freeing kid */ op_free(kid); } } - switch (op->op_type) { + switch (o->op_type) { case OP_NULL: - op->op_targ = 0; /* Was holding old type, if any. */ + o->op_targ = 0; /* Was holding old type, if any. */ break; case OP_ENTEREVAL: - op->op_targ = 0; /* Was holding hints. */ + o->op_targ = 0; /* Was holding hints. */ break; case OP_GVSV: case OP_GV: - SvREFCNT_dec(cGVOP->op_gv); + SvREFCNT_dec(cGVOPo->op_gv); break; case OP_NEXTSTATE: case OP_DBSTATE: - SvREFCNT_dec(cCOP->cop_filegv); + SvREFCNT_dec(cCOPo->cop_filegv); break; case OP_CONST: - SvREFCNT_dec(cSVOP->op_sv); + SvREFCNT_dec(cSVOPo->op_sv); break; case OP_GOTO: case OP_NEXT: case OP_LAST: case OP_REDO: - if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) + if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) break; /* FALL THROUGH */ case OP_TRANS: - Safefree(cPVOP->op_pv); + Safefree(cPVOPo->op_pv); break; case OP_SUBST: - op_free(cPMOP->op_pmreplroot); + op_free(cPMOPo->op_pmreplroot); /* FALL THROUGH */ case OP_PUSHRE: case OP_MATCH: - pregfree(cPMOP->op_pmregexp); - SvREFCNT_dec(cPMOP->op_pmshort); + pregfree(cPMOPo->op_pmregexp); + SvREFCNT_dec(cPMOPo->op_pmshort); break; default: break; } - if (op->op_targ > 0) - pad_free(op->op_targ); + if (o->op_targ > 0) + pad_free(o->op_targ); - Safefree(op); + Safefree(o); } static void -null(op) -OP* op; +null(o) +OP* o; { - if (op->op_type != OP_NULL && op->op_targ > 0) - pad_free(op->op_targ); - op->op_targ = op->op_type; - op->op_type = OP_NULL; - op->op_ppaddr = ppaddr[OP_NULL]; + if (o->op_type != OP_NULL && o->op_targ > 0) + pad_free(o->op_targ); + o->op_targ = o->op_type; + o->op_type = OP_NULL; + o->op_ppaddr = ppaddr[OP_NULL]; } /* Contextualizers */ @@ -465,48 +511,48 @@ OP* op; #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) OP * -linklist(op) -OP *op; +linklist(o) +OP *o; { register OP *kid; - if (op->op_next) - return op->op_next; + if (o->op_next) + return o->op_next; /* establish postfix order */ - if (cUNOP->op_first) { - op->op_next = LINKLIST(cUNOP->op_first); - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { + if (cUNOPo->op_first) { + o->op_next = LINKLIST(cUNOPo->op_first); + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) kid->op_next = LINKLIST(kid->op_sibling); else - kid->op_next = op; + kid->op_next = o; } } else - op->op_next = op; + o->op_next = o; - return op->op_next; + return o->op_next; } OP * -scalarkids(op) -OP *op; +scalarkids(o) +OP *o; { OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + if (o && o->op_flags & OPf_KIDS) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) scalar(kid); } - return op; + return o; } static OP * -scalarboolean(op) -OP *op; +scalarboolean(o) +OP *o; { if (dowarn && - op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) { + o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { line_t oldline = curcop->cop_line; if (copline != NOLINE) @@ -514,36 +560,36 @@ OP *op; warn("Found = in conditional, should be =="); curcop->cop_line = oldline; } - return scalar(op); + return scalar(o); } OP * -scalar(op) -OP *op; +scalar(o) +OP *o; { OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) - return op; + if (!o || (o->op_flags & OPf_KNOW) || error_count) + return o; - op->op_flags &= ~OPf_LIST; - op->op_flags |= OPf_KNOW; + o->op_flags &= ~OPf_LIST; + o->op_flags |= OPf_KNOW; - switch (op->op_type) { + switch (o->op_type) { case OP_REPEAT: - if (op->op_private & OPpREPEAT_DOLIST) - null(((LISTOP*)cBINOP->op_first)->op_first); - scalar(cBINOP->op_first); + if (o->op_private & OPpREPEAT_DOLIST) + null(((LISTOP*)cBINOPo->op_first)->op_first); + scalar(cBINOPo->op_first); break; case OP_OR: case OP_AND: case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) scalar(kid); break; case OP_SPLIT: - if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) deprecate("implicit split to @_"); } @@ -552,19 +598,19 @@ OP *op; case OP_SUBST: case OP_NULL: default: - if (op->op_flags & OPf_KIDS) { - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) + if (o->op_flags & OPf_KIDS) { + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) scalar(kid); } break; case OP_LEAVE: case OP_LEAVETRY: - scalar(cLISTOP->op_first); + scalar(cLISTOPo->op_first); /* FALL THROUGH */ case OP_SCOPE: case OP_LINESEQ: case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) scalarvoid(kid); else @@ -573,29 +619,29 @@ OP *op; curcop = &compiling; break; } - return op; + return o; } OP * -scalarvoid(op) -OP *op; +scalarvoid(o) +OP *o; { OP *kid; char* useless = 0; SV* sv; - if (!op || error_count) - return op; - if (op->op_flags & OPf_LIST) - return op; + if (!o || error_count) + return o; + if (o->op_flags & OPf_LIST) + return o; - op->op_flags |= OPf_KNOW; + o->op_flags |= OPf_KNOW; - switch (op->op_type) { + switch (o->op_type) { default: - if (!(opargs[op->op_type] & OA_FOLDCONST)) + if (!(opargs[o->op_type] & OA_FOLDCONST)) break; - if (op->op_flags & OPf_STACKED) + if (o->op_flags & OPf_STACKED) break; /* FALL THROUGH */ case OP_GVSV: @@ -668,26 +714,26 @@ OP *op; case OP_GGRNAM: case OP_GGRGID: case OP_GETLOGIN: - if (!(op->op_private & OPpLVAL_INTRO)) - useless = op_desc[op->op_type]; + if (!(o->op_private & OPpLVAL_INTRO)) + useless = op_desc[o->op_type]; break; case OP_RV2GV: case OP_RV2SV: case OP_RV2AV: case OP_RV2HV: - if (!(op->op_private & OPpLVAL_INTRO) && - (!op->op_sibling || op->op_sibling->op_type != OP_READLINE)) + if (!(o->op_private & OPpLVAL_INTRO) && + (!o->op_sibling || o->op_sibling->op_type != OP_READLINE)) useless = "a variable"; break; case OP_NEXTSTATE: case OP_DBSTATE: - curcop = ((COP*)op); /* for warning below */ + curcop = ((COP*)o); /* for warning below */ break; case OP_CONST: - sv = cSVOP->op_sv; + sv = cSVOPo->op_sv; if (dowarn) { useless = "a constant"; if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) @@ -699,121 +745,121 @@ OP *op; useless = 0; } } - null(op); /* don't execute a constant */ + null(o); /* don't execute a constant */ SvREFCNT_dec(sv); /* don't even remember it */ break; case OP_POSTINC: - op->op_type = OP_PREINC; /* pre-increment is faster */ - op->op_ppaddr = ppaddr[OP_PREINC]; + o->op_type = OP_PREINC; /* pre-increment is faster */ + o->op_ppaddr = ppaddr[OP_PREINC]; break; case OP_POSTDEC: - op->op_type = OP_PREDEC; /* pre-decrement is faster */ - op->op_ppaddr = ppaddr[OP_PREDEC]; + o->op_type = OP_PREDEC; /* pre-decrement is faster */ + o->op_ppaddr = ppaddr[OP_PREDEC]; break; case OP_REPEAT: - scalarvoid(cBINOP->op_first); - useless = op_desc[op->op_type]; + scalarvoid(cBINOPo->op_first); + useless = op_desc[o->op_type]; break; case OP_OR: case OP_AND: case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) scalarvoid(kid); break; case OP_NULL: - if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE) - curcop = ((COP*)op); /* for warning below */ - if (op->op_flags & OPf_STACKED) + if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) + curcop = ((COP*)o); /* for warning below */ + if (o->op_flags & OPf_STACKED) break; case OP_ENTERTRY: case OP_ENTER: case OP_SCALAR: - if (!(op->op_flags & OPf_KIDS)) + if (!(o->op_flags & OPf_KIDS)) break; case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LEAVELOOP: - op->op_private |= OPpLEAVE_VOID; + o->op_private |= OPpLEAVE_VOID; case OP_LINESEQ: case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) scalarvoid(kid); break; case OP_SPLIT: - if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) deprecate("implicit split to @_"); } break; case OP_DELETE: - op->op_private |= OPpLEAVE_VOID; + o->op_private |= OPpLEAVE_VOID; break; } if (useless && dowarn) warn("Useless use of %s in void context", useless); - return op; + return o; } OP * -listkids(op) -OP *op; +listkids(o) +OP *o; { OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + if (o && o->op_flags & OPf_KIDS) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) list(kid); } - return op; + return o; } OP * -list(op) -OP *op; +list(o) +OP *o; { OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) - return op; + if (!o || (o->op_flags & OPf_KNOW) || error_count) + return o; - op->op_flags |= (OPf_KNOW | OPf_LIST); + o->op_flags |= (OPf_KNOW | OPf_LIST); - switch (op->op_type) { + switch (o->op_type) { case OP_FLOP: case OP_REPEAT: - list(cBINOP->op_first); + list(cBINOPo->op_first); break; case OP_OR: case OP_AND: case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) list(kid); break; default: case OP_MATCH: case OP_SUBST: case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) + if (!(o->op_flags & OPf_KIDS)) break; - if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) { - list(cBINOP->op_first); - return gen_constant_list(op); + if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) { + list(cBINOPo->op_first); + return gen_constant_list(o); } case OP_LIST: - listkids(op); + listkids(o); break; case OP_LEAVE: case OP_LEAVETRY: - list(cLISTOP->op_first); + list(cLISTOPo->op_first); /* FALL THROUGH */ case OP_SCOPE: case OP_LINESEQ: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) scalarvoid(kid); else @@ -822,67 +868,68 @@ OP *op; curcop = &compiling; break; } - return op; + return o; } OP * -scalarseq(op) -OP *op; +scalarseq(o) +OP *o; { OP *kid; - if (op) { - if (op->op_type == OP_LINESEQ || - op->op_type == OP_SCOPE || - op->op_type == OP_LEAVE || - op->op_type == OP_LEAVETRY) + if (o) { + if (o->op_type == OP_LINESEQ || + o->op_type == OP_SCOPE || + o->op_type == OP_LEAVE || + o->op_type == OP_LEAVETRY) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) { scalarvoid(kid); } } curcop = &compiling; } - op->op_flags &= ~OPf_PARENS; + o->op_flags &= ~OPf_PARENS; if (hints & HINT_BLOCK_SCOPE) - op->op_flags |= OPf_PARENS; + o->op_flags |= OPf_PARENS; } else - op = newOP(OP_STUB, 0); - return op; + o = newOP(OP_STUB, 0); + return o; } static OP * -modkids(op, type) -OP *op; +modkids(o, type) +OP *o; I32 type; { OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + if (o && o->op_flags & OPf_KIDS) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) mod(kid, type); } - return op; + return o; } static I32 modcount; OP * -mod(op, type) -OP *op; +mod(o, type) +OP *o; I32 type; { + dTHR; OP *kid; SV *sv; char mtype; - if (!op || error_count) - return op; + if (!o || error_count) + return o; - switch (op->op_type) { + switch (o->op_type) { case OP_CONST: - if (!(op->op_private & (OPpCONST_ARYBASE))) + if (!(o->op_private & (OPpCONST_ARYBASE))) goto nomod; if (eval_start && eval_start->op_type == OP_CONST) { compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv); @@ -899,11 +946,11 @@ I32 type; break; case OP_ENTERSUB: if ((type == OP_UNDEF || type == OP_REFGEN) && - !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersub => rv2cv */ - op->op_ppaddr = ppaddr[OP_RV2CV]; - assert(cUNOP->op_first->op_type == OP_NULL); - null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ + !(o->op_flags & OPf_STACKED)) { + o->op_type = OP_RV2CV; /* entersub => rv2cv */ + o->op_ppaddr = ppaddr[OP_RV2CV]; + assert(cUNOPo->op_first->op_type == OP_NULL); + null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */ break; } /* FALL THROUGH */ @@ -913,10 +960,10 @@ I32 type; if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) break; sprintf(tokenbuf, "Can't modify %s in %s", - op_desc[op->op_type], + op_desc[o->op_type], type ? op_desc[type] : "local"); yyerror(tokenbuf); - return op; + return o; case OP_PREINC: case OP_PREDEC: @@ -938,25 +985,25 @@ I32 type; case OP_I_MODULO: case OP_I_ADD: case OP_I_SUBTRACT: - if (!(op->op_flags & OPf_STACKED)) + if (!(o->op_flags & OPf_STACKED)) goto nomod; modcount++; break; case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) mod(kid, type); break; case OP_RV2AV: case OP_RV2HV: - if (type == OP_REFGEN && op->op_flags & OPf_PARENS) { + if (type == OP_REFGEN && o->op_flags & OPf_PARENS) { modcount = 10000; - return op; /* Treat \(@foo) like ordinary list. */ + return o; /* Treat \(@foo) like ordinary list. */ } /* FALL THROUGH */ case OP_RV2GV: - ref(cUNOP->op_first, op->op_type); + ref(cUNOPo->op_first, o->op_type); /* FALL THROUGH */ case OP_AASSIGN: case OP_ASLICE: @@ -968,9 +1015,9 @@ I32 type; modcount = 10000; break; case OP_RV2SV: - if (!type && cUNOP->op_first->op_type != OP_GV) + if (!type && cUNOPo->op_first->op_type != OP_GV) croak("Can't localize a reference"); - ref(cUNOP->op_first, op->op_type); + ref(cUNOPo->op_first, o->op_type); /* FALL THROUGH */ case OP_UNDEF: case OP_GV: @@ -988,7 +1035,7 @@ I32 type; modcount++; if (!type) croak("Can't localize lexical variable %s", - SvPV(*av_fetch(comppad_name, op->op_targ, 4), na)); + SvPV(*av_fetch(comppad_name, o->op_targ, 4), na)); break; case OP_PUSHMARK: @@ -1003,129 +1050,129 @@ I32 type; case OP_SUBSTR: mtype = 'x'; makelv: - pad_free(op->op_targ); - op->op_targ = pad_alloc(op->op_type, SVs_PADMY); - sv = PAD_SV(op->op_targ); + pad_free(o->op_targ); + o->op_targ = pad_alloc(o->op_type, SVs_PADMY); + sv = PAD_SV(o->op_targ); sv_upgrade(sv, SVt_PVLV); sv_magic(sv, Nullsv, mtype, Nullch, 0); - curpad[op->op_targ] = sv; - if (op->op_flags & OPf_KIDS) - mod(cBINOP->op_first->op_sibling, type); + curpad[o->op_targ] = sv; + if (o->op_flags & OPf_KIDS) + mod(cBINOPo->op_first->op_sibling, type); break; case OP_AELEM: case OP_HELEM: - ref(cBINOP->op_first, op->op_type); + ref(cBINOPo->op_first, o->op_type); modcount++; break; case OP_SCOPE: case OP_LEAVE: case OP_ENTER: - if (op->op_flags & OPf_KIDS) - mod(cLISTOP->op_last, type); + if (o->op_flags & OPf_KIDS) + mod(cLISTOPo->op_last, type); break; case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) + if (!(o->op_flags & OPf_KIDS)) break; - if (op->op_targ != OP_LIST) { - mod(cBINOP->op_first, type); + if (o->op_targ != OP_LIST) { + mod(cBINOPo->op_first, type); break; } /* FALL THROUGH */ case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) mod(kid, type); break; } - op->op_flags |= OPf_MOD; + o->op_flags |= OPf_MOD; if (type == OP_AASSIGN || type == OP_SASSIGN) - op->op_flags |= OPf_SPECIAL|OPf_REF; + o->op_flags |= OPf_SPECIAL|OPf_REF; else if (!type) { - op->op_private |= OPpLVAL_INTRO; - op->op_flags &= ~OPf_SPECIAL; + o->op_private |= OPpLVAL_INTRO; + o->op_flags &= ~OPf_SPECIAL; } else if (type != OP_GREPSTART && type != OP_ENTERSUB) - op->op_flags |= OPf_REF; - return op; + o->op_flags |= OPf_REF; + return o; } OP * -refkids(op, type) -OP *op; +refkids(o, type) +OP *o; I32 type; { OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + if (o && o->op_flags & OPf_KIDS) { + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) ref(kid, type); } - return op; + return o; } OP * -ref(op, type) -OP *op; +ref(o, type) +OP *o; I32 type; { OP *kid; - if (!op || error_count) - return op; + if (!o || error_count) + return o; - switch (op->op_type) { + switch (o->op_type) { case OP_ENTERSUB: if ((type == OP_DEFINED) && - !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersub => rv2cv */ - op->op_ppaddr = ppaddr[OP_RV2CV]; - assert(cUNOP->op_first->op_type == OP_NULL); - null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ - op->op_flags |= OPf_SPECIAL; + !(o->op_flags & OPf_STACKED)) { + o->op_type = OP_RV2CV; /* entersub => rv2cv */ + o->op_ppaddr = ppaddr[OP_RV2CV]; + assert(cUNOPo->op_first->op_type == OP_NULL); + null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */ + o->op_flags |= OPf_SPECIAL; } break; case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) ref(kid, type); break; case OP_RV2SV: - ref(cUNOP->op_first, op->op_type); + ref(cUNOPo->op_first, o->op_type); /* FALL THROUGH */ case OP_PADSV: if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); - op->op_flags |= OPf_MOD; + o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + o->op_flags |= OPf_MOD; } break; case OP_RV2AV: case OP_RV2HV: - op->op_flags |= OPf_REF; + o->op_flags |= OPf_REF; /* FALL THROUGH */ case OP_RV2GV: - ref(cUNOP->op_first, op->op_type); + ref(cUNOPo->op_first, o->op_type); break; case OP_PADAV: case OP_PADHV: - op->op_flags |= OPf_REF; + o->op_flags |= OPf_REF; break; case OP_SCALAR: case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) + if (!(o->op_flags & OPf_KIDS)) break; - ref(cBINOP->op_first, type); + ref(cBINOPo->op_first, type); break; case OP_AELEM: case OP_HELEM: - ref(cBINOP->op_first, op->op_type); + ref(cBINOPo->op_first, o->op_type); if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); - op->op_flags |= OPf_MOD; + o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + o->op_flags |= OPf_MOD; } break; @@ -1133,30 +1180,30 @@ I32 type; case OP_LEAVE: case OP_ENTER: case OP_LIST: - if (!(op->op_flags & OPf_KIDS)) + if (!(o->op_flags & OPf_KIDS)) break; - ref(cLISTOP->op_last, type); + ref(cLISTOPo->op_last, type); break; default: break; } - return scalar(op); + return scalar(o); } OP * -my(op) -OP *op; +my(o) +OP *o; { OP *kid; I32 type; - if (!op || error_count) - return op; + if (!o || error_count) + return o; - type = op->op_type; + type = o->op_type; if (type == OP_LIST) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) my(kid); } else if (type != OP_PADSV && @@ -1164,13 +1211,13 @@ OP *op; type != OP_PADHV && type != OP_PUSHMARK) { - sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]); + sprintf(tokenbuf, "Can't declare %s in my", op_desc[o->op_type]); yyerror(tokenbuf); - return op; + return o; } - op->op_flags |= OPf_MOD; - op->op_private |= OPpLVAL_INTRO; - return op; + o->op_flags |= OPf_MOD; + o->op_private |= OPpLVAL_INTRO; + return o; } OP * @@ -1188,7 +1235,7 @@ I32 type; OP *left; OP *right; { - OP *op; + OP *o; if (right->op_type == OP_MATCH || right->op_type == OP_SUBST || @@ -1197,12 +1244,12 @@ OP *right; if (right->op_type != OP_MATCH) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) - op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); + o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); else - op = prepend_elem(right->op_type, scalar(left), right); + o = prepend_elem(right->op_type, scalar(left), right); if (type == OP_NOT) - return newUNOP(OP_NOT, 0, scalar(op)); - return op; + return newUNOP(OP_NOT, 0, scalar(o)); + return o; } else return bind_match(type, left, @@ -1210,13 +1257,13 @@ OP *right; } OP * -invert(op) -OP *op; +invert(o) +OP *o; { - if (!op) - return op; + if (!o) + return o; /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */ - return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op)); + return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o)); } OP * @@ -1250,6 +1297,7 @@ OP *o; int block_start() { + dTHR; int retval = savestack_ix; comppad_name_fill = AvFILL(comppad_name); SAVEINT(min_intro_pending); @@ -1270,6 +1318,7 @@ int line; int floor; OP* seq; { + dTHR; int needblockscope = hints & HINT_BLOCK_SCOPE; OP* retval = scalarseq(seq); if (copline > (line_t)line) @@ -1283,21 +1332,22 @@ OP* seq; } void -newPROG(op) -OP *op; +newPROG(o) +OP *o; { + dTHR; if (in_eval) { - eval_root = newUNOP(OP_LEAVEEVAL, 0, op); + eval_root = newUNOP(OP_LEAVEEVAL, 0, o); eval_start = linklist(eval_root); eval_root->op_next = 0; peep(eval_start); } else { - if (!op) { + if (!o) { main_start = 0; return; } - main_root = scope(sawparens(scalarvoid(op))); + main_root = scope(sawparens(scalarvoid(o))); curcop = &compiling; main_start = LINKLIST(main_root); main_root->op_next = 0; @@ -1347,6 +1397,7 @@ OP * fold_constants(o) register OP *o; { + dTHR; register OP *curop; I32 type = o->op_type; SV *sv; @@ -1445,6 +1496,7 @@ OP * gen_constant_list(o) register OP *o; { + dTHR; register OP *curop; I32 oldtmps_floor = tmps_floor; @@ -1454,10 +1506,10 @@ register OP *o; op = curop = LINKLIST(o); o->op_next = 0; - pp_pushmark(); + pp_pushmark(ARGS); runops(); op = curop; - pp_anonlist(); + pp_anonlist(ARGS); tmps_floor = oldtmps_floor; o->op_type = OP_RV2AV; @@ -1470,38 +1522,38 @@ register OP *o; } OP * -convert(type, flags, op) +convert(type, flags, o) I32 type; I32 flags; -OP* op; +OP* o; { OP *kid; OP *last = 0; - if (!op || op->op_type != OP_LIST) - op = newLISTOP(OP_LIST, 0, op, Nullop); + if (!o || o->op_type != OP_LIST) + o = newLISTOP(OP_LIST, 0, o, Nullop); else - op->op_flags &= ~(OPf_KNOW|OPf_LIST); + o->op_flags &= ~(OPf_KNOW|OPf_LIST); if (!(opargs[type] & OA_MARK)) - null(cLISTOP->op_first); + null(cLISTOPo->op_first); - op->op_type = type; - op->op_ppaddr = ppaddr[type]; - op->op_flags |= flags; + o->op_type = type; + o->op_ppaddr = ppaddr[type]; + o->op_flags |= flags; - op = CHECKOP(type, op); - if (op->op_type != type) - return op; + o = CHECKOP(type, o); + if (o->op_type != type) + return o; - if (cLISTOP->op_children < 7) { + if (cLISTOPo->op_children < 7) { /* XXX do we really need to do this if we're done appending?? */ - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) last = kid; - cLISTOP->op_last = last; /* in case check substituted last arg */ + cLISTOPo->op_last = last; /* in case check substituted last arg */ } - return fold_constants(op); + return fold_constants(o); } /* List constructors */ @@ -1601,13 +1653,13 @@ newNULLLIST() } OP * -force_list(op) -OP* op; +force_list(o) +OP *o; { - if (!op || op->op_type != OP_LIST) - op = newLISTOP(OP_LIST, 0, op, Nullop); - null(op); - return op; + if (!o || o->op_type != OP_LIST) + o = newLISTOP(OP_LIST, 0, o, Nullop); + null(o); + return o; } OP * @@ -1654,19 +1706,19 @@ newOP(type, flags) I32 type; I32 flags; { - OP *op; - Newz(1101, op, 1, OP); - op->op_type = type; - op->op_ppaddr = ppaddr[type]; - op->op_flags = flags; - - op->op_next = op; - op->op_private = 0 + (flags >> 8); + OP *o; + Newz(1101, o, 1, OP); + o->op_type = type; + o->op_ppaddr = ppaddr[type]; + o->op_flags = flags; + + o->op_next = o; + o->op_private = 0 + (flags >> 8); if (opargs[type] & OA_RETSCALAR) - scalar(op); + scalar(o); if (opargs[type] & OA_TARGET) - op->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, op); + o->op_targ = pad_alloc(type, SVs_PADTMP); + return CHECKOP(type, o); } OP * @@ -1732,8 +1784,8 @@ OP* last; } OP * -pmtrans(op, expr, repl) -OP *op; +pmtrans(o, expr, repl) +OP *o; OP *expr; OP *repl; { @@ -1749,10 +1801,10 @@ OP *repl; I32 complement; register short *tbl; - tbl = (short*)cPVOP->op_pv; - complement = op->op_private & OPpTRANS_COMPLEMENT; - delete = op->op_private & OPpTRANS_DELETE; - /* squash = op->op_private & OPpTRANS_SQUASH; */ + tbl = (short*)cPVOPo->op_pv; + complement = o->op_private & OPpTRANS_COMPLEMENT; + delete = o->op_private & OPpTRANS_DELETE; + /* squash = o->op_private & OPpTRANS_SQUASH; */ if (complement) { Zero(tbl, 256, short); @@ -1795,7 +1847,7 @@ OP *repl; op_free(expr); op_free(repl); - return op; + return o; } OP * @@ -1803,6 +1855,7 @@ newPMOP(type, flags) I32 type; I32 flags; { + dTHR; PMOP *pmop; Newz(1101, pmop, 1, PMOP); @@ -1821,24 +1874,24 @@ I32 flags; } OP * -pmruntime(op, expr, repl) -OP *op; +pmruntime(o, expr, repl) +OP *o; OP *expr; OP *repl; { PMOP *pm; LOGOP *rcop; - if (op->op_type == OP_TRANS) - return pmtrans(op, expr, repl); + if (o->op_type == OP_TRANS) + return pmtrans(o, expr, repl); - pm = (PMOP*)op; + pm = (PMOP*)o; if (expr->op_type == OP_CONST) { STRLEN plen; SV *pat = ((SVOP*)expr)->op_sv; char *p = SvPV(pat, plen); - if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) { + if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) { sv_setpvn(pat, "\\s+", 3); p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; @@ -1859,7 +1912,7 @@ OP *repl; rcop->op_first = scalar(expr); rcop->op_flags |= OPf_KIDS; rcop->op_private = 1; - rcop->op_other = op; + rcop->op_other = o; /* establish postfix order */ if (pm->op_pmflags & PMf_KEEP) { @@ -1872,7 +1925,7 @@ OP *repl; expr->op_next = (OP*)rcop; } - prepend_elem(op->op_type, scalar((OP*)rcop), op); + prepend_elem(o->op_type, scalar((OP*)rcop), o); } if (repl) { @@ -1914,7 +1967,7 @@ OP *repl; if (curop == repl) { pm->op_pmflags |= PMf_CONST; /* const for long enough */ pm->op_pmpermflags |= PMf_CONST; /* const for long enough */ - prepend_elem(op->op_type, scalar(repl), op); + prepend_elem(o->op_type, scalar(repl), o); } else { Newz(1101, rcop, 1, LOGOP); @@ -1923,7 +1976,7 @@ OP *repl; rcop->op_first = scalar(repl); rcop->op_flags |= OPf_KIDS; rcop->op_private = 1; - rcop->op_other = op; + rcop->op_other = o; /* establish postfix order */ rcop->op_next = LINKLIST(repl); @@ -1964,6 +2017,7 @@ I32 type; I32 flags; GV *gv; { + dTHR; GVOP *gvop; Newz(1101, gvop, 1, GVOP); gvop->op_type = type; @@ -1999,21 +2053,22 @@ char *pv; } void -package(op) -OP *op; +package(o) +OP *o; { + dTHR; SV *sv; save_hptr(&curstash); save_item(curstname); - if (op) { + if (o) { STRLEN len; char *name; - sv = cSVOP->op_sv; + sv = cSVOPo->op_sv; name = SvPV(sv, len); curstash = gv_stashpv(name,TRUE); sv_setpvn(curstname, name, len); - op_free(op); + op_free(o); } else { sv_setpv(curstname,"<none>"); @@ -2083,18 +2138,18 @@ OP *listval; } static I32 -list_assignment(op) -register OP *op; +list_assignment(o) +register OP *o; { - if (!op) + if (!o) return TRUE; - if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS) - op = cUNOP->op_first; + if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS) + o = cUNOPo->op_first; - if (op->op_type == OP_COND_EXPR) { - I32 t = list_assignment(cCONDOP->op_first->op_sibling); - I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling); + if (o->op_type == OP_COND_EXPR) { + I32 t = list_assignment(cCONDOPo->op_first->op_sibling); + I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling); if (t && f) return TRUE; @@ -2103,15 +2158,15 @@ register OP *op; return FALSE; } - if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS || - op->op_type == OP_RV2AV || op->op_type == OP_RV2HV || - op->op_type == OP_ASLICE || op->op_type == OP_HSLICE) + if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS || + o->op_type == OP_RV2AV || o->op_type == OP_RV2HV || + o->op_type == OP_ASLICE || o->op_type == OP_HSLICE) return TRUE; - if (op->op_type == OP_PADAV || op->op_type == OP_PADHV) + if (o->op_type == OP_PADAV || o->op_type == OP_PADHV) return TRUE; - if (op->op_type == OP_RV2SV) + if (o->op_type == OP_RV2SV) return FALSE; return FALSE; @@ -2124,7 +2179,7 @@ OP *left; I32 optype; OP *right; { - OP *op; + OP *o; if (optype) { if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) { @@ -2149,16 +2204,16 @@ OP *right; op_free(right); return Nullop; } - op = newBINOP(OP_AASSIGN, flags, + o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), list(force_list(left)) ); - op->op_private = 0 | (flags >> 8); + o->op_private = 0 | (flags >> 8); if (!(left->op_private & OPpLVAL_INTRO)) { static int generation = 100; OP *curop; - OP *lastop = op; + OP *lastop = o; generation++; - for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) { + for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (opargs[curop->op_type] & OA_DANGEROUS) { if (curop->op_type == OP_GV) { GV *gv = ((GVOP*)curop)->op_gv; @@ -2190,8 +2245,8 @@ OP *right; } lastop = curop; } - if (curop != op) - op->op_private = OPpASSIGN_COMMON; + if (curop != o) + o->op_private = OPpASSIGN_COMMON; } if (right && right->op_type == OP_SPLIT) { OP* tmpop; @@ -2201,17 +2256,17 @@ OP *right; PMOP *pm = (PMOP*)tmpop; if (left->op_type == OP_RV2AV && !(left->op_private & OPpLVAL_INTRO) && - !(op->op_private & OPpASSIGN_COMMON) ) + !(o->op_private & OPpASSIGN_COMMON) ) { tmpop = ((UNOP*)left)->op_first; if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) { pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv; pm->op_pmflags |= PMf_ONCE; - tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */ + tmpop = cUNOPo->op_first; /* to list (nulled) */ tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ tmpop->op_sibling = Nullop; /* don't free split */ right->op_next = tmpop->op_next; /* fix starting loc */ - op_free(op); /* blow off assign */ + op_free(o); /* blow off assign */ right->op_flags &= ~(OPf_KNOW|OPf_LIST); /* "I don't know and I don't care." */ return right; @@ -2228,7 +2283,7 @@ OP *right; } } } - return op; + return o; } if (!right) right = newOP(OP_UNDEF, 0); @@ -2238,24 +2293,25 @@ OP *right; } else { eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ - op = newBINOP(OP_SASSIGN, flags, + o = newBINOP(OP_SASSIGN, flags, scalar(right), mod(scalar(left), OP_SASSIGN) ); if (eval_start) eval_start = 0; else { - op_free(op); + op_free(o); return Nullop; } } - return op; + return o; } OP * -newSTATEOP(flags, label, op) +newSTATEOP(flags, label, o) I32 flags; char *label; -OP *op; +OP *o; { + dTHR; register COP *cop; /* Introduce my variables. */ @@ -2311,7 +2367,7 @@ OP *op; } } - return prepend_elem(OP_LINESEQ, (OP*)cop, op); + return prepend_elem(OP_LINESEQ, (OP*)cop, o); } OP * @@ -2321,8 +2377,9 @@ I32 flags; OP* first; OP* other; { + dTHR; LOGOP *logop; - OP *op; + OP *o; if (type == OP_XOR) /* Not short circuit, but here by precedence. */ return newBINOP(type, flags, scalar(first), scalar(other)); @@ -2335,12 +2392,12 @@ OP* other; type = OP_OR; else type = OP_AND; - op = first; - first = cUNOP->op_first; - if (op->op_next) - first->op_next = op->op_next; - cUNOP->op_first = Nullop; - op_free(op); + o = first; + first = cUNOPo->op_first; + if (o->op_next) + first->op_next = o->op_next; + cUNOPo->op_first = Nullop; + op_free(o); } } if (first->op_type == OP_CONST) { @@ -2382,10 +2439,10 @@ OP* other; first->op_next = (OP*)logop; first->op_sibling = other; - op = newUNOP(OP_NULL, 0, (OP*)logop); - other->op_next = op; + o = newUNOP(OP_NULL, 0, (OP*)logop); + other->op_next = o; - return op; + return o; } OP * @@ -2395,8 +2452,9 @@ OP* first; OP* true; OP* false; { + dTHR; CONDOP *condop; - OP *op; + OP *o; if (!false) return newLOGOP(OP_AND, 0, first, true); @@ -2436,12 +2494,12 @@ OP* false; first->op_sibling = true; true->op_sibling = false; - op = newUNOP(OP_NULL, 0, (OP*)condop); + o = newUNOP(OP_NULL, 0, (OP*)condop); - true->op_next = op; - false->op_next = op; + true->op_next = o; + false->op_next = o; - return op; + return o; } OP * @@ -2453,7 +2511,7 @@ OP *right; CONDOP *condop; OP *flip; OP *flop; - OP *op; + OP *o; Newz(1101, condop, 1, CONDOP); @@ -2470,7 +2528,7 @@ OP *right; condop->op_next = (OP*)condop; flip = newUNOP(OP_FLIP, flags, (OP*)condop); flop = newUNOP(OP_FLOP, 0, flip); - op = newUNOP(OP_NULL, 0, flop); + o = newUNOP(OP_NULL, 0, flop); linklist(flop); left->op_next = flip; @@ -2484,11 +2542,11 @@ OP *right; flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; - flip->op_next = op; + flip->op_next = o; if (!flip->op_private || !flop->op_private) - linklist(op); /* blow off optimizer unless constant */ + linklist(o); /* blow off optimizer unless constant */ - return op; + return o; } OP * @@ -2498,8 +2556,9 @@ I32 debuggable; OP *expr; OP *block; { + dTHR; OP* listop; - OP* op; + OP* o; int once = block && block->op_flags & OPf_SPECIAL && (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL); @@ -2511,20 +2570,20 @@ OP *block; } listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); - op = newLOGOP(OP_AND, 0, expr, listop); + o = newLOGOP(OP_AND, 0, expr, listop); - ((LISTOP*)listop)->op_last->op_next = LINKLIST(op); + ((LISTOP*)listop)->op_last->op_next = LINKLIST(o); - if (once && op != listop) - op->op_next = ((LOGOP*)cUNOP->op_first)->op_other; + if (once && o != listop) + o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other; - if (op == listop) - op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */ + if (o == listop) + o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */ - op->op_flags |= flags; - op = scope(op); - op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/ - return op; + o->op_flags |= flags; + o = scope(o); + o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/ + return o; } OP * @@ -2536,10 +2595,11 @@ OP *expr; OP *block; OP *cont; { + dTHR; OP *redo; OP *next = 0; OP *listop; - OP *op; + OP *o; OP *condop; if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) { @@ -2559,19 +2619,19 @@ OP *cont; redo = LINKLIST(listop); if (expr) { - op = newLOGOP(OP_AND, 0, expr, scalar(listop)); - if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) { + o = newLOGOP(OP_AND, 0, expr, scalar(listop)); + if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) { op_free(expr); /* oops, it's a while (0) */ op_free((OP*)loop); return Nullop; /* (listop already freed by newLOGOP) */ } ((LISTOP*)listop)->op_last->op_next = condop = - (op == listop ? redo : LINKLIST(op)); + (o == listop ? redo : LINKLIST(o)); if (!next) next = condop; } else - op = listop; + o = listop; if (!loop) { Newz(1101,loop,1,LOOP); @@ -2581,19 +2641,19 @@ OP *cont; loop->op_next = (OP*)loop; } - op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op); + o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o); loop->op_redoop = redo; - loop->op_lastop = op; + loop->op_lastop = o; if (next) loop->op_nextop = next; else - loop->op_nextop = op; + loop->op_nextop = o; - op->op_flags |= flags; - op->op_private |= (flags >> 8); - return op; + o->op_flags |= flags; + o->op_private |= (flags >> 8); + return o; } OP * @@ -2650,9 +2710,10 @@ newLOOPEX(type, label) I32 type; OP* label; { - OP *op; + dTHR; + OP *o; if (type != OP_GOTO || label->op_type == OP_CONST) { - op = newPVOP(type, 0, savepv( + o = newPVOP(type, 0, savepv( label->op_type == OP_CONST ? SvPVx(((SVOP*)label)->op_sv, na) : "" )); @@ -2661,19 +2722,34 @@ OP* label; else { if (label->op_type == OP_ENTERSUB) label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN)); - op = newUNOP(type, OPf_STACKED, label); + o = newUNOP(type, OPf_STACKED, label); } hints |= HINT_BLOCK_SCOPE; - return op; + return o; } void cv_undef(cv) CV *cv; { + dTHR; +#ifdef USE_THREADS + MUTEX_DESTROY(CvMUTEXP(cv)); + Safefree(CvMUTEXP(cv)); + if (CvCONDP(cv)) { + COND_DESTROY(CvCONDP(cv)); + Safefree(CvCONDP(cv)); + } +#endif /* USE_THREADS */ + if (!CvXSUB(cv) && CvROOT(cv)) { +#ifdef USE_THREADS + if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr)) + croak("Can't undef active subroutine"); +#else if (CvDEPTH(cv)) croak("Can't undef active subroutine"); +#endif /* USE_THREADS */ ENTER; SAVESPTR(curpad); @@ -2704,6 +2780,7 @@ CV * cv_clone(proto) CV* proto; { + dTHR; AV* av; I32 ix; AV* protopadlist = CvPADLIST(proto); @@ -2722,6 +2799,13 @@ CV* proto; sv_upgrade((SV *)cv, SVt_PVCV); CvCLONED_on(cv); +#ifdef USE_THREADS + New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(cv)); + New(666, CvCONDP(cv), 1, pthread_cond_t); + COND_INIT(CvCONDP(cv)); + CvOWNER(cv) = 0; +#endif /* USE_THREADS */ CvFILEGV(cv) = CvFILEGV(proto); CvGV(cv) = SvREFCNT_inc(CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); @@ -2777,20 +2861,21 @@ CV* proto; } CV * -newSUB(floor,op,proto,block) +newSUB(floor,o,proto,block) I32 floor; -OP *op; +OP *o; OP *proto; OP *block; { + dTHR; register CV *cv; - char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; + char *name = o ? SvPVx(cSVOPo->op_sv, na) : "__ANON__"; GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); AV* av; char *s; I32 ix; - if (op) + if (o) sub_generation++; if (cv = GvCV(gv)) { if (GvCVGEN(gv)) @@ -2825,6 +2910,13 @@ OP *block; CvFILEGV(cv) = curcop->cop_filegv; CvGV(cv) = SvREFCNT_inc(gv); CvSTASH(cv) = curstash; +#ifdef USE_THREADS + CvOWNER(cv) = 0; + New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(cv)); + New(666, CvCONDP(cv), 1, pthread_cond_t); + COND_INIT(CvCONDP(cv)); +#endif /* USE_THREADS */ if (proto) { char *p = SvPVx(((SVOP*)proto)->op_sv, na); @@ -2840,7 +2932,7 @@ OP *block; } if (!block) { CvROOT(cv) = 0; - op_free(op); + op_free(o); copline = NOLINE; LEAVE_SCOPE(floor); return cv; @@ -2905,10 +2997,10 @@ OP *block; gv_efullname(tmpstr,gv); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); } - op_free(op); + op_free(o); copline = NOLINE; LEAVE_SCOPE(floor); - if (!op) { + if (!o) { GvCV(gv) = 0; /* Will remember in SVOP instead. */ CvANON_on(cv); } @@ -2936,6 +3028,7 @@ char *name; void (*subaddr) _((CV*)); char *filename; { + dTHR; register CV *cv; GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV); char *s; @@ -2968,6 +3061,13 @@ char *filename; GvCV(gv) = cv; CvGV(cv) = SvREFCNT_inc(gv); GvCVGEN(gv) = 0; +#ifdef USE_THREADS + New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(cv)); + New(666, CvCONDP(cv), 1, pthread_cond_t); + COND_INIT(CvCONDP(cv)); + CvOWNER(cv) = 0; +#endif /* USE_THREADS */ CvFILEGV(cv) = gv_fetchfile(filename); CvXSUB(cv) = subaddr; if (!name) @@ -2995,18 +3095,19 @@ char *filename; } void -newFORM(floor,op,block) +newFORM(floor,o,block) I32 floor; -OP *op; +OP *o; OP *block; { + dTHR; register CV *cv; char *name; GV *gv; I32 ix; - if (op) - name = SvPVx(cSVOP->op_sv, na); + if (o) + name = SvPVx(cSVOPo->op_sv, na); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); @@ -3036,25 +3137,25 @@ OP *block; CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); FmLINES(cv) = 0; - op_free(op); + op_free(o); copline = NOLINE; LEAVE_SCOPE(floor); } OP * -newANONLIST(op) -OP* op; +newANONLIST(o) +OP* o; { return newUNOP(OP_REFGEN, 0, - mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN)); } OP * -newANONHASH(op) -OP* op; +newANONHASH(o) +OP* o; { return newUNOP(OP_REFGEN, 0, - mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN)); } OP * @@ -3181,23 +3282,23 @@ OP *o; /* Check routines. */ OP * -ck_concat(op) -OP *op; +ck_concat(o) +OP *o; { - if (cUNOP->op_first->op_type == OP_CONCAT) - op->op_flags |= OPf_STACKED; - return op; + if (cUNOPo->op_first->op_type == OP_CONCAT) + o->op_flags |= OPf_STACKED; + return o; } OP * -ck_spair(op) -OP *op; +ck_spair(o) +OP *o; { - if (op->op_flags & OPf_KIDS) { + if (o->op_flags & OPf_KIDS) { OP* newop; OP* kid; - op = modkids(ck_fun(op), op->op_type); - kid = cUNOP->op_first; + o = modkids(ck_fun(o), o->op_type); + kid = cUNOPo->op_first; newop = kUNOP->op_first->op_sibling; if (newop && (newop->op_sibling || @@ -3205,64 +3306,64 @@ OP *op; newop->op_type == OP_PADAV || newop->op_type == OP_PADHV || newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) { - return op; + return o; } op_free(kUNOP->op_first); kUNOP->op_first = newop; } - op->op_ppaddr = ppaddr[++op->op_type]; - return ck_fun(op); + o->op_ppaddr = ppaddr[++o->op_type]; + return ck_fun(o); } OP * -ck_delete(op) -OP *op; +ck_delete(o) +OP *o; { - op = ck_fun(op); - if (op->op_flags & OPf_KIDS) { - OP *kid = cUNOP->op_first; + o = ck_fun(o); + if (o->op_flags & OPf_KIDS) { + OP *kid = cUNOPo->op_first; if (kid->op_type != OP_HELEM) - croak("%s argument is not a HASH element", op_desc[op->op_type]); + croak("%s argument is not a HASH element", op_desc[o->op_type]); null(kid); } - return op; + return o; } OP * -ck_eof(op) -OP *op; +ck_eof(o) +OP *o; { - I32 type = op->op_type; + I32 type = o->op_type; - if (op->op_flags & OPf_KIDS) { - if (cLISTOP->op_first->op_type == OP_STUB) { - op_free(op); - op = newUNOP(type, OPf_SPECIAL, + if (o->op_flags & OPf_KIDS) { + if (cLISTOPo->op_first->op_type == OP_STUB) { + op_free(o); + o = newUNOP(type, OPf_SPECIAL, newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV))); } - return ck_fun(op); + return ck_fun(o); } - return op; + return o; } OP * -ck_eval(op) -OP *op; +ck_eval(o) +OP *o; { hints |= HINT_BLOCK_SCOPE; - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; + if (o->op_flags & OPf_KIDS) { + SVOP *kid = (SVOP*)cUNOPo->op_first; if (!kid) { - op->op_flags &= ~OPf_KIDS; - null(op); + o->op_flags &= ~OPf_KIDS; + null(o); } else if (kid->op_type == OP_LINESEQ) { LOGOP *enter; - kid->op_next = op->op_next; - cUNOP->op_first = 0; - op_free(op); + kid->op_next = o->op_next; + cUNOPo->op_first = 0; + op_free(o); Newz(1101, enter, 1, LOGOP); enter->op_type = OP_ENTERTRY; @@ -3272,35 +3373,35 @@ OP *op; /* establish postfix order */ enter->op_next = (OP*)enter; - op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid); - op->op_type = OP_LEAVETRY; - op->op_ppaddr = ppaddr[OP_LEAVETRY]; - enter->op_other = op; - return op; + o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid); + o->op_type = OP_LEAVETRY; + o->op_ppaddr = ppaddr[OP_LEAVETRY]; + enter->op_other = o; + return o; } } else { - op_free(op); - op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); + op_free(o); + o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); } - op->op_targ = (PADOFFSET)hints; - return op; + o->op_targ = (PADOFFSET)hints; + return o; } OP * -ck_exec(op) -OP *op; +ck_exec(o) +OP *o; { OP *kid; - if (op->op_flags & OPf_STACKED) { - op = ck_fun(op); - kid = cUNOP->op_first->op_sibling; + if (o->op_flags & OPf_STACKED) { + o = ck_fun(o); + kid = cUNOPo->op_first->op_sibling; if (kid->op_type == OP_RV2GV) null(kid); } else - op = listkids(op); - return op; + o = listkids(o); + return o; } OP * @@ -3314,14 +3415,15 @@ register OP *o; } OP * -ck_rvconst(op) -register OP *op; +ck_rvconst(o) +register OP *o; { - SVOP *kid = (SVOP*)cUNOP->op_first; + dTHR; + SVOP *kid = (SVOP*)cUNOPo->op_first; - op->op_private |= (hints & HINT_STRICT_REFS); + o->op_private |= (hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { - int iscv = (op->op_type==OP_RV2CV)*2; + int iscv = (o->op_type==OP_RV2CV)*2; GV *gv = 0; kid->op_type = OP_GV; for (gv = 0; !gv; iscv++) { @@ -3337,78 +3439,80 @@ register OP *op; iscv | !(kid->op_private & OPpCONST_ENTERED), iscv ? SVt_PVCV - : op->op_type == OP_RV2SV + : o->op_type == OP_RV2SV ? SVt_PV - : op->op_type == OP_RV2AV + : o->op_type == OP_RV2AV ? SVt_PVAV - : op->op_type == OP_RV2HV + : o->op_type == OP_RV2HV ? SVt_PVHV : SVt_PVGV); } SvREFCNT_dec(kid->op_sv); kid->op_sv = SvREFCNT_inc(gv); } - return op; + return o; } OP * -ck_formline(op) -OP *op; +ck_formline(o) +OP *o; { - return ck_fun(op); + return ck_fun(o); } OP * -ck_ftst(op) -OP *op; +ck_ftst(o) +OP *o; { - I32 type = op->op_type; + dTHR; + I32 type = o->op_type; - if (op->op_flags & OPf_REF) - return op; + if (o->op_flags & OPf_REF) + return o; - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; + if (o->op_flags & OPf_KIDS) { + SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(type, OPf_REF, gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO)); - op_free(op); + op_free(o); return newop; } } else { - op_free(op); + op_free(o); if (type == OP_FTTTY) return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, SVt_PVIO)); else return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); } - return op; + return o; } OP * -ck_fun(op) -OP *op; +ck_fun(o) +OP *o; { + dTHR; register OP *kid; OP **tokid; OP *sibl; I32 numargs = 0; - int type = op->op_type; + int type = o->op_type; register I32 oa = opargs[type] >> OASHIFT; - if (op->op_flags & OPf_STACKED) { + if (o->op_flags & OPf_STACKED) { if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL)) oa &= ~OA_OPTIONAL; else - return no_fh_allowed(op); + return no_fh_allowed(o); } - if (op->op_flags & OPf_KIDS) { - tokid = &cLISTOP->op_first; - kid = cLISTOP->op_first; + if (o->op_flags & OPf_KIDS) { + tokid = &cLISTOPo->op_first; + kid = cLISTOPo->op_first; if (kid->op_type == OP_PUSHMARK || kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK) { @@ -3448,7 +3552,7 @@ OP *op; *tokid = kid; } else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) - bad_type(numargs, "array", op_desc[op->op_type], kid); + bad_type(numargs, "array", op_desc[o->op_type], kid); mod(kid, type); break; case OA_HVREF: @@ -3466,7 +3570,7 @@ OP *op; *tokid = kid; } else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) - bad_type(numargs, "hash", op_desc[op->op_type], kid); + bad_type(numargs, "hash", op_desc[o->op_type], kid); mod(kid, type); break; case OA_CVREF: @@ -3507,13 +3611,13 @@ OP *op; tokid = &kid->op_sibling; kid = kid->op_sibling; } - op->op_private |= numargs; + o->op_private |= numargs; if (kid) - return too_many_arguments(op,op_desc[op->op_type]); - listkids(op); + return too_many_arguments(o,op_desc[o->op_type]); + listkids(o); } else if (opargs[type] & OA_DEFGV) { - op_free(op); + op_free(o); return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); } @@ -3521,68 +3625,68 @@ OP *op; while (oa & OA_OPTIONAL) oa >>= 4; if (oa && oa != OA_LIST) - return too_few_arguments(op,op_desc[op->op_type]); + return too_few_arguments(o,op_desc[o->op_type]); } - return op; + return o; } OP * -ck_glob(op) -OP *op; +ck_glob(o) +OP *o; { GV *gv = newGVgen("main"); gv_IOadd(gv); - append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv)); - scalarkids(op); - return ck_fun(op); + append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); + scalarkids(o); + return ck_fun(o); } OP * -ck_grep(op) -OP *op; +ck_grep(o) +OP *o; { LOGOP *gwop; OP *kid; - OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; + OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; - op->op_ppaddr = ppaddr[OP_GREPSTART]; + o->op_ppaddr = ppaddr[OP_GREPSTART]; Newz(1101, gwop, 1, LOGOP); - if (op->op_flags & OPf_STACKED) { + if (o->op_flags & OPf_STACKED) { OP* k; - op = ck_sort(op); - kid = cLISTOP->op_first->op_sibling; - for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) { + o = ck_sort(o); + kid = cLISTOPo->op_first->op_sibling; + for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) { kid = k; } kid->op_next = (OP*)gwop; - op->op_flags &= ~OPf_STACKED; + o->op_flags &= ~OPf_STACKED; } - kid = cLISTOP->op_first->op_sibling; + kid = cLISTOPo->op_first->op_sibling; if (type == OP_MAPWHILE) list(kid); else scalar(kid); - op = ck_fun(op); + o = ck_fun(o); if (error_count) - return op; - kid = cLISTOP->op_first->op_sibling; + return o; + kid = cLISTOPo->op_first->op_sibling; if (kid->op_type != OP_NULL) croak("panic: ck_grep"); kid = kUNOP->op_first; gwop->op_type = type; gwop->op_ppaddr = ppaddr[type]; - gwop->op_first = listkids(op); + gwop->op_first = listkids(o); gwop->op_flags |= OPf_KIDS; gwop->op_private = 1; gwop->op_other = LINKLIST(kid); gwop->op_targ = pad_alloc(type, SVs_PADTMP); kid->op_next = (OP*)gwop; - kid = cLISTOP->op_first->op_sibling; + kid = cLISTOPo->op_first->op_sibling; if (!kid || !kid->op_sibling) - return too_few_arguments(op,op_desc[op->op_type]); + return too_few_arguments(o,op_desc[o->op_type]); for (kid = kid->op_sibling; kid; kid = kid->op_sibling) mod(kid, OP_GREPSTART); @@ -3590,105 +3694,105 @@ OP *op; } OP * -ck_index(op) -OP *op; +ck_index(o) +OP *o; { - if (op->op_flags & OPf_KIDS) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + if (o->op_flags & OPf_KIDS) { + OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_type == OP_CONST) fbm_compile(((SVOP*)kid)->op_sv, 0); } - return ck_fun(op); + return ck_fun(o); } OP * -ck_lengthconst(op) -OP *op; +ck_lengthconst(o) +OP *o; { /* XXX length optimization goes here */ - return ck_fun(op); + return ck_fun(o); } OP * -ck_lfun(op) -OP *op; +ck_lfun(o) +OP *o; { - return modkids(ck_fun(op), op->op_type); + return modkids(ck_fun(o), o->op_type); } OP * -ck_rfun(op) -OP *op; +ck_rfun(o) +OP *o; { - return refkids(ck_fun(op), op->op_type); + return refkids(ck_fun(o), o->op_type); } OP * -ck_listiob(op) -OP *op; +ck_listiob(o) +OP *o; { register OP *kid; - kid = cLISTOP->op_first; + kid = cLISTOPo->op_first; if (!kid) { - op = force_list(op); - kid = cLISTOP->op_first; + o = force_list(o); + kid = cLISTOPo->op_first; } if (kid->op_type == OP_PUSHMARK) kid = kid->op_sibling; - if (kid && op->op_flags & OPf_STACKED) + if (kid && o->op_flags & OPf_STACKED) kid = kid->op_sibling; else if (kid && !kid->op_sibling) { /* print HANDLE; */ if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) { - op->op_flags |= OPf_STACKED; /* make it a filehandle */ + o->op_flags |= OPf_STACKED; /* make it a filehandle */ kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid)); - cLISTOP->op_first->op_sibling = kid; - cLISTOP->op_last = kid; + cLISTOPo->op_first->op_sibling = kid; + cLISTOPo->op_last = kid; kid = kid->op_sibling; } } if (!kid) - append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) ); + append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) ); - return listkids(op); + return listkids(o); } OP * -ck_match(op) -OP *op; +ck_match(o) +OP *o; { - cPMOP->op_pmflags |= PMf_RUNTIME; - cPMOP->op_pmpermflags |= PMf_RUNTIME; - return op; + cPMOPo->op_pmflags |= PMf_RUNTIME; + cPMOPo->op_pmpermflags |= PMf_RUNTIME; + return o; } OP * -ck_null(op) -OP *op; +ck_null(o) +OP *o; { - return op; + return o; } OP * -ck_repeat(op) -OP *op; +ck_repeat(o) +OP *o; { - if (cBINOP->op_first->op_flags & OPf_PARENS) { - op->op_private |= OPpREPEAT_DOLIST; - cBINOP->op_first = force_list(cBINOP->op_first); + if (cBINOPo->op_first->op_flags & OPf_PARENS) { + o->op_private |= OPpREPEAT_DOLIST; + cBINOPo->op_first = force_list(cBINOPo->op_first); } else - scalar(op); - return op; + scalar(o); + return o; } OP * -ck_require(op) -OP *op; +ck_require(o) +OP *o; { - if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ - SVOP *kid = (SVOP*)cUNOP->op_first; + if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ + SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { char *s; @@ -3702,61 +3806,61 @@ OP *op; sv_catpvn(kid->op_sv, ".pm", 3); } } - return ck_fun(op); + return ck_fun(o); } OP * -ck_retarget(op) -OP *op; +ck_retarget(o) +OP *o; { croak("NOT IMPL LINE %d",__LINE__); /* STUB */ - return op; + return o; } OP * -ck_select(op) -OP *op; +ck_select(o) +OP *o; { OP* kid; - if (op->op_flags & OPf_KIDS) { - kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + if (o->op_flags & OPf_KIDS) { + kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_sibling) { - op->op_type = OP_SSELECT; - op->op_ppaddr = ppaddr[OP_SSELECT]; - op = ck_fun(op); - return fold_constants(op); + o->op_type = OP_SSELECT; + o->op_ppaddr = ppaddr[OP_SSELECT]; + o = ck_fun(o); + return fold_constants(o); } } - op = ck_fun(op); - kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + o = ck_fun(o); + kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_type == OP_RV2GV) kid->op_private &= ~HINT_STRICT_REFS; - return op; + return o; } OP * -ck_shift(op) -OP *op; +ck_shift(o) +OP *o; { - I32 type = op->op_type; + I32 type = o->op_type; - if (!(op->op_flags & OPf_KIDS)) { - op_free(op); + if (!(o->op_flags & OPf_KIDS)) { + op_free(o); return newUNOP(type, 0, scalar(newUNOP(OP_RV2AV, 0, scalar(newGVOP(OP_GV, 0, gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) ))))); } - return scalar(modkids(ck_fun(op), type)); + return scalar(modkids(ck_fun(o), type)); } OP * -ck_sort(op) -OP *op; +ck_sort(o) +OP *o; { - if (op->op_flags & OPf_STACKED) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + if (o->op_flags & OPf_STACKED) { + OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; kid = kUNOP->op_first; /* get past rv2gv */ @@ -3767,7 +3871,7 @@ OP *op; kid->op_next = 0; } else if (kid->op_type == OP_LEAVE) { - if (op->op_type == OP_SORT) { + if (o->op_type == OP_SORT) { null(kid); /* wipe out leave */ kid->op_next = kid; @@ -3782,46 +3886,46 @@ OP *op; } peep(k); - kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ null(kid); /* wipe out rv2gv */ - if (op->op_type == OP_SORT) + if (o->op_type == OP_SORT) kid->op_next = kid; else kid->op_next = k; - op->op_flags |= OPf_SPECIAL; + o->op_flags |= OPf_SPECIAL; } } - return op; + return o; } OP * -ck_split(op) -OP *op; +ck_split(o) +OP *o; { register OP *kid; PMOP* pm; - if (op->op_flags & OPf_STACKED) - return no_fh_allowed(op); + if (o->op_flags & OPf_STACKED) + return no_fh_allowed(o); - kid = cLISTOP->op_first; + kid = cLISTOPo->op_first; if (kid->op_type != OP_NULL) croak("panic: ck_split"); kid = kid->op_sibling; - op_free(cLISTOP->op_first); - cLISTOP->op_first = kid; + op_free(cLISTOPo->op_first); + cLISTOPo->op_first = kid; if (!kid) { - cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1)); - cLISTOP->op_last = kid; /* There was only one element previously */ + cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1)); + cLISTOPo->op_last = kid; /* There was only one element previously */ } if (kid->op_type != OP_MATCH) { OP *sibl = kid->op_sibling; kid->op_sibling = 0; kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop); - if (cLISTOP->op_first == cLISTOP->op_last) - cLISTOP->op_last = kid; - cLISTOP->op_first = kid; + if (cLISTOPo->op_first == cLISTOPo->op_last) + cLISTOPo->op_last = kid; + cLISTOPo->op_first = kid; kid->op_sibling = sibl; } pm = (PMOP*)kid; @@ -3835,56 +3939,57 @@ OP *op; scalar(kid); if (!kid->op_sibling) - append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) ); + append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) ); kid = kid->op_sibling; scalar(kid); if (!kid->op_sibling) - append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0))); + append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0))); kid = kid->op_sibling; scalar(kid); if (kid->op_sibling) - return too_many_arguments(op,op_desc[op->op_type]); + return too_many_arguments(o,op_desc[o->op_type]); - return op; + return o; } OP * -ck_subr(op) -OP *op; +ck_subr(o) +OP *o; { - OP *prev = ((cUNOP->op_first->op_sibling) - ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first; - OP *o = prev->op_sibling; + dTHR; + OP *prev = ((cUNOPo->op_first->op_sibling) + ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first; + OP *o2 = prev->op_sibling; OP *cvop; char *proto = 0; CV *cv = 0; int optional = 0; I32 arg = 0; - for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ; + for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ; if (cvop->op_type == OP_RV2CV) { SVOP* tmpop; - op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER); + o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER); null(cvop); /* disable rv2cv */ tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV) { cv = GvCV(tmpop->op_sv); - if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) + if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) proto = SvPV((SV*)cv,na); } } - op->op_private |= (hints & HINT_STRICT_REFS); + o->op_private |= (hints & HINT_STRICT_REFS); if (perldb && curstash != debstash) - op->op_private |= OPpENTERSUB_DB; - while (o != cvop) { + o->op_private |= OPpENTERSUB_DB; + while (o2 != cvop) { if (proto) { switch (*proto) { case '\0': - return too_many_arguments(op, CvNAME(cv)); + return too_many_arguments(o, CvNAME(cv)); case ';': optional = 1; proto++; @@ -3892,28 +3997,28 @@ OP *op; case '$': proto++; arg++; - scalar(o); + scalar(o2); break; case '%': case '@': - list(o); + list(o2); arg++; break; case '&': proto++; arg++; - if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF) - bad_type(arg, "block", CvNAME(cv), o); + if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF) + bad_type(arg, "block", CvNAME(cv), o2); break; case '*': proto++; arg++; - if (o->op_type == OP_RV2GV) + if (o2->op_type == OP_RV2GV) goto wrapref; { - OP* kid = o; - o = newUNOP(OP_RV2GV, 0, kid); - o->op_sibling = kid->op_sibling; + OP* kid = o2; + o2 = newUNOP(OP_RV2GV, 0, kid); + o2->op_sibling = kid->op_sibling; kid->op_sibling = 0; prev->op_sibling = o; } @@ -3923,29 +4028,29 @@ OP *op; arg++; switch (*proto++) { case '*': - if (o->op_type != OP_RV2GV) - bad_type(arg, "symbol", CvNAME(cv), o); + if (o2->op_type != OP_RV2GV) + bad_type(arg, "symbol", CvNAME(cv), o2); goto wrapref; case '&': - if (o->op_type != OP_RV2CV) - bad_type(arg, "sub", CvNAME(cv), o); + if (o2->op_type != OP_RV2CV) + bad_type(arg, "sub", CvNAME(cv), o2); goto wrapref; case '$': - if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV) - bad_type(arg, "scalar", CvNAME(cv), o); + if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV) + bad_type(arg, "scalar", CvNAME(cv), o2); goto wrapref; case '@': - if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV) - bad_type(arg, "array", CvNAME(cv), o); + if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV) + bad_type(arg, "array", CvNAME(cv), o2); goto wrapref; case '%': - if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV) - bad_type(arg, "hash", CvNAME(cv), o); + if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV) + bad_type(arg, "hash", CvNAME(cv), o2); wrapref: { - OP* kid = o; - o = newUNOP(OP_REFGEN, 0, kid); - o->op_sibling = kid->op_sibling; + OP* kid = o2; + o2 = newUNOP(OP_REFGEN, 0, kid); + o2->op_sibling = kid->op_sibling; kid->op_sibling = 0; prev->op_sibling = o; } @@ -3960,38 +4065,38 @@ OP *op; } } else - list(o); - mod(o, OP_ENTERSUB); - prev = o; - o = o->op_sibling; + list(o2); + mod(o2, OP_ENTERSUB); + prev = o2; + o2 = o2->op_sibling; } if (proto && !optional && *proto == '$') - return too_few_arguments(op, CvNAME(cv)); - return op; + return too_few_arguments(o, CvNAME(cv)); + return o; } OP * -ck_svconst(op) -OP *op; +ck_svconst(o) +OP *o; { - SvREADONLY_on(cSVOP->op_sv); - return op; + SvREADONLY_on(cSVOPo->op_sv); + return o; } OP * -ck_trunc(op) -OP *op; +ck_trunc(o) +OP *o; { - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; + if (o->op_flags & OPf_KIDS) { + SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_NULL) kid = (SVOP*)kid->op_sibling; if (kid && kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) - op->op_flags |= OPf_SPECIAL; + o->op_flags |= OPf_SPECIAL; } - return ck_fun(op); + return ck_fun(o); } /* A peephole optimizer. We visit the ops in the order they're to execute. */ @@ -4000,6 +4105,7 @@ void peep(o) register OP* o; { + dTHR; register OP* oldop = 0; if (!o || o->op_seq) return; @@ -24,6 +24,7 @@ */ typedef U32 PADOFFSET; +#define NOT_IN_PAD ((PADOFFSET) -1) #ifdef DEBUGGING_OPS #define OPCODE opcode @@ -206,6 +207,19 @@ struct loop { #define cCOP ((COP*)op) #define cLOOP ((LOOP*)op) +#define cUNOPo ((UNOP*)o) +#define cBINOPo ((BINOP*)o) +#define cLISTOPo ((LISTOP*)o) +#define cLOGOPo ((LOGOP*)o) +#define cCONDOPo ((CONDOP*)o) +#define cPMOPo ((PMOP*)o) +#define cSVOPo ((SVOP*)o) +#define cGVOPo ((GVOP*)o) +#define cPVOPo ((PVOP*)o) +#define cCVOPo ((CVOP*)o) +#define cCOPo ((COP*)o) +#define cLOOPo ((LOOP*)o) + #define kUNOP ((UNOP*)kid) #define kBINOP ((BINOP*)kid) #define kLISTOP ((LISTOP*)kid) @@ -1052,378 +1052,378 @@ EXT char *op_desc[] = { }; #endif -OP * ck_concat _((OP* op)); -OP * ck_delete _((OP* op)); -OP * ck_eof _((OP* op)); -OP * ck_eval _((OP* op)); -OP * ck_exec _((OP* op)); -OP * ck_formline _((OP* op)); -OP * ck_ftst _((OP* op)); -OP * ck_fun _((OP* op)); -OP * ck_glob _((OP* op)); -OP * ck_grep _((OP* op)); -OP * ck_index _((OP* op)); -OP * ck_lengthconst _((OP* op)); -OP * ck_lfun _((OP* op)); -OP * ck_listiob _((OP* op)); -OP * ck_match _((OP* op)); -OP * ck_null _((OP* op)); -OP * ck_repeat _((OP* op)); -OP * ck_require _((OP* op)); -OP * ck_rfun _((OP* op)); -OP * ck_rvconst _((OP* op)); -OP * ck_select _((OP* op)); -OP * ck_shift _((OP* op)); -OP * ck_sort _((OP* op)); -OP * ck_spair _((OP* op)); -OP * ck_split _((OP* op)); -OP * ck_subr _((OP* op)); -OP * ck_svconst _((OP* op)); -OP * ck_trunc _((OP* op)); +OP * ck_concat _((OP* o)); +OP * ck_delete _((OP* o)); +OP * ck_eof _((OP* o)); +OP * ck_eval _((OP* o)); +OP * ck_exec _((OP* o)); +OP * ck_formline _((OP* o)); +OP * ck_ftst _((OP* o)); +OP * ck_fun _((OP* o)); +OP * ck_glob _((OP* o)); +OP * ck_grep _((OP* o)); +OP * ck_index _((OP* o)); +OP * ck_lengthconst _((OP* o)); +OP * ck_lfun _((OP* o)); +OP * ck_listiob _((OP* o)); +OP * ck_match _((OP* o)); +OP * ck_null _((OP* o)); +OP * ck_repeat _((OP* o)); +OP * ck_require _((OP* o)); +OP * ck_rfun _((OP* o)); +OP * ck_rvconst _((OP* o)); +OP * ck_select _((OP* o)); +OP * ck_shift _((OP* o)); +OP * ck_sort _((OP* o)); +OP * ck_spair _((OP* o)); +OP * ck_split _((OP* o)); +OP * ck_subr _((OP* o)); +OP * ck_svconst _((OP* o)); +OP * ck_trunc _((OP* o)); -OP * pp_null _((void)); -OP * pp_stub _((void)); -OP * pp_scalar _((void)); -OP * pp_pushmark _((void)); -OP * pp_wantarray _((void)); -OP * pp_const _((void)); -OP * pp_gvsv _((void)); -OP * pp_gv _((void)); -OP * pp_gelem _((void)); -OP * pp_padsv _((void)); -OP * pp_padav _((void)); -OP * pp_padhv _((void)); -OP * pp_padany _((void)); -OP * pp_pushre _((void)); -OP * pp_rv2gv _((void)); -OP * pp_rv2sv _((void)); -OP * pp_av2arylen _((void)); -OP * pp_rv2cv _((void)); -OP * pp_anoncode _((void)); -OP * pp_prototype _((void)); -OP * pp_refgen _((void)); -OP * pp_srefgen _((void)); -OP * pp_ref _((void)); -OP * pp_bless _((void)); -OP * pp_backtick _((void)); -OP * pp_glob _((void)); -OP * pp_readline _((void)); -OP * pp_rcatline _((void)); -OP * pp_regcmaybe _((void)); -OP * pp_regcomp _((void)); -OP * pp_match _((void)); -OP * pp_subst _((void)); -OP * pp_substcont _((void)); -OP * pp_trans _((void)); -OP * pp_sassign _((void)); -OP * pp_aassign _((void)); -OP * pp_chop _((void)); -OP * pp_schop _((void)); -OP * pp_chomp _((void)); -OP * pp_schomp _((void)); -OP * pp_defined _((void)); -OP * pp_undef _((void)); -OP * pp_study _((void)); -OP * pp_pos _((void)); -OP * pp_preinc _((void)); -OP * pp_i_preinc _((void)); -OP * pp_predec _((void)); -OP * pp_i_predec _((void)); -OP * pp_postinc _((void)); -OP * pp_i_postinc _((void)); -OP * pp_postdec _((void)); -OP * pp_i_postdec _((void)); -OP * pp_pow _((void)); -OP * pp_multiply _((void)); -OP * pp_i_multiply _((void)); -OP * pp_divide _((void)); -OP * pp_i_divide _((void)); -OP * pp_modulo _((void)); -OP * pp_i_modulo _((void)); -OP * pp_repeat _((void)); -OP * pp_add _((void)); -OP * pp_i_add _((void)); -OP * pp_subtract _((void)); -OP * pp_i_subtract _((void)); -OP * pp_concat _((void)); -OP * pp_stringify _((void)); -OP * pp_left_shift _((void)); -OP * pp_right_shift _((void)); -OP * pp_lt _((void)); -OP * pp_i_lt _((void)); -OP * pp_gt _((void)); -OP * pp_i_gt _((void)); -OP * pp_le _((void)); -OP * pp_i_le _((void)); -OP * pp_ge _((void)); -OP * pp_i_ge _((void)); -OP * pp_eq _((void)); -OP * pp_i_eq _((void)); -OP * pp_ne _((void)); -OP * pp_i_ne _((void)); -OP * pp_ncmp _((void)); -OP * pp_i_ncmp _((void)); -OP * pp_slt _((void)); -OP * pp_sgt _((void)); -OP * pp_sle _((void)); -OP * pp_sge _((void)); -OP * pp_seq _((void)); -OP * pp_sne _((void)); -OP * pp_scmp _((void)); -OP * pp_bit_and _((void)); -OP * pp_bit_xor _((void)); -OP * pp_bit_or _((void)); -OP * pp_negate _((void)); -OP * pp_i_negate _((void)); -OP * pp_not _((void)); -OP * pp_complement _((void)); -OP * pp_atan2 _((void)); -OP * pp_sin _((void)); -OP * pp_cos _((void)); -OP * pp_rand _((void)); -OP * pp_srand _((void)); -OP * pp_exp _((void)); -OP * pp_log _((void)); -OP * pp_sqrt _((void)); -OP * pp_int _((void)); -OP * pp_hex _((void)); -OP * pp_oct _((void)); -OP * pp_abs _((void)); -OP * pp_length _((void)); -OP * pp_substr _((void)); -OP * pp_vec _((void)); -OP * pp_index _((void)); -OP * pp_rindex _((void)); -OP * pp_sprintf _((void)); -OP * pp_formline _((void)); -OP * pp_ord _((void)); -OP * pp_chr _((void)); -OP * pp_crypt _((void)); -OP * pp_ucfirst _((void)); -OP * pp_lcfirst _((void)); -OP * pp_uc _((void)); -OP * pp_lc _((void)); -OP * pp_quotemeta _((void)); -OP * pp_rv2av _((void)); -OP * pp_aelemfast _((void)); -OP * pp_aelem _((void)); -OP * pp_aslice _((void)); -OP * pp_each _((void)); -OP * pp_values _((void)); -OP * pp_keys _((void)); -OP * pp_delete _((void)); -OP * pp_exists _((void)); -OP * pp_rv2hv _((void)); -OP * pp_helem _((void)); -OP * pp_hslice _((void)); -OP * pp_unpack _((void)); -OP * pp_pack _((void)); -OP * pp_split _((void)); -OP * pp_join _((void)); -OP * pp_list _((void)); -OP * pp_lslice _((void)); -OP * pp_anonlist _((void)); -OP * pp_anonhash _((void)); -OP * pp_splice _((void)); -OP * pp_push _((void)); -OP * pp_pop _((void)); -OP * pp_shift _((void)); -OP * pp_unshift _((void)); -OP * pp_sort _((void)); -OP * pp_reverse _((void)); -OP * pp_grepstart _((void)); -OP * pp_grepwhile _((void)); -OP * pp_mapstart _((void)); -OP * pp_mapwhile _((void)); -OP * pp_range _((void)); -OP * pp_flip _((void)); -OP * pp_flop _((void)); -OP * pp_and _((void)); -OP * pp_or _((void)); -OP * pp_xor _((void)); -OP * pp_cond_expr _((void)); -OP * pp_andassign _((void)); -OP * pp_orassign _((void)); -OP * pp_method _((void)); -OP * pp_entersub _((void)); -OP * pp_leavesub _((void)); -OP * pp_caller _((void)); -OP * pp_warn _((void)); -OP * pp_die _((void)); -OP * pp_reset _((void)); -OP * pp_lineseq _((void)); -OP * pp_nextstate _((void)); -OP * pp_dbstate _((void)); -OP * pp_unstack _((void)); -OP * pp_enter _((void)); -OP * pp_leave _((void)); -OP * pp_scope _((void)); -OP * pp_enteriter _((void)); -OP * pp_iter _((void)); -OP * pp_enterloop _((void)); -OP * pp_leaveloop _((void)); -OP * pp_return _((void)); -OP * pp_last _((void)); -OP * pp_next _((void)); -OP * pp_redo _((void)); -OP * pp_dump _((void)); -OP * pp_goto _((void)); -OP * pp_exit _((void)); -OP * pp_open _((void)); -OP * pp_close _((void)); -OP * pp_pipe_op _((void)); -OP * pp_fileno _((void)); -OP * pp_umask _((void)); -OP * pp_binmode _((void)); -OP * pp_tie _((void)); -OP * pp_untie _((void)); -OP * pp_tied _((void)); -OP * pp_dbmopen _((void)); -OP * pp_dbmclose _((void)); -OP * pp_sselect _((void)); -OP * pp_select _((void)); -OP * pp_getc _((void)); -OP * pp_read _((void)); -OP * pp_enterwrite _((void)); -OP * pp_leavewrite _((void)); -OP * pp_prtf _((void)); -OP * pp_print _((void)); -OP * pp_sysopen _((void)); -OP * pp_sysread _((void)); -OP * pp_syswrite _((void)); -OP * pp_send _((void)); -OP * pp_recv _((void)); -OP * pp_eof _((void)); -OP * pp_tell _((void)); -OP * pp_seek _((void)); -OP * pp_truncate _((void)); -OP * pp_fcntl _((void)); -OP * pp_ioctl _((void)); -OP * pp_flock _((void)); -OP * pp_socket _((void)); -OP * pp_sockpair _((void)); -OP * pp_bind _((void)); -OP * pp_connect _((void)); -OP * pp_listen _((void)); -OP * pp_accept _((void)); -OP * pp_shutdown _((void)); -OP * pp_gsockopt _((void)); -OP * pp_ssockopt _((void)); -OP * pp_getsockname _((void)); -OP * pp_getpeername _((void)); -OP * pp_lstat _((void)); -OP * pp_stat _((void)); -OP * pp_ftrread _((void)); -OP * pp_ftrwrite _((void)); -OP * pp_ftrexec _((void)); -OP * pp_fteread _((void)); -OP * pp_ftewrite _((void)); -OP * pp_fteexec _((void)); -OP * pp_ftis _((void)); -OP * pp_fteowned _((void)); -OP * pp_ftrowned _((void)); -OP * pp_ftzero _((void)); -OP * pp_ftsize _((void)); -OP * pp_ftmtime _((void)); -OP * pp_ftatime _((void)); -OP * pp_ftctime _((void)); -OP * pp_ftsock _((void)); -OP * pp_ftchr _((void)); -OP * pp_ftblk _((void)); -OP * pp_ftfile _((void)); -OP * pp_ftdir _((void)); -OP * pp_ftpipe _((void)); -OP * pp_ftlink _((void)); -OP * pp_ftsuid _((void)); -OP * pp_ftsgid _((void)); -OP * pp_ftsvtx _((void)); -OP * pp_fttty _((void)); -OP * pp_fttext _((void)); -OP * pp_ftbinary _((void)); -OP * pp_chdir _((void)); -OP * pp_chown _((void)); -OP * pp_chroot _((void)); -OP * pp_unlink _((void)); -OP * pp_chmod _((void)); -OP * pp_utime _((void)); -OP * pp_rename _((void)); -OP * pp_link _((void)); -OP * pp_symlink _((void)); -OP * pp_readlink _((void)); -OP * pp_mkdir _((void)); -OP * pp_rmdir _((void)); -OP * pp_open_dir _((void)); -OP * pp_readdir _((void)); -OP * pp_telldir _((void)); -OP * pp_seekdir _((void)); -OP * pp_rewinddir _((void)); -OP * pp_closedir _((void)); -OP * pp_fork _((void)); -OP * pp_wait _((void)); -OP * pp_waitpid _((void)); -OP * pp_system _((void)); -OP * pp_exec _((void)); -OP * pp_kill _((void)); -OP * pp_getppid _((void)); -OP * pp_getpgrp _((void)); -OP * pp_setpgrp _((void)); -OP * pp_getpriority _((void)); -OP * pp_setpriority _((void)); -OP * pp_time _((void)); -OP * pp_tms _((void)); -OP * pp_localtime _((void)); -OP * pp_gmtime _((void)); -OP * pp_alarm _((void)); -OP * pp_sleep _((void)); -OP * pp_shmget _((void)); -OP * pp_shmctl _((void)); -OP * pp_shmread _((void)); -OP * pp_shmwrite _((void)); -OP * pp_msgget _((void)); -OP * pp_msgctl _((void)); -OP * pp_msgsnd _((void)); -OP * pp_msgrcv _((void)); -OP * pp_semget _((void)); -OP * pp_semctl _((void)); -OP * pp_semop _((void)); -OP * pp_require _((void)); -OP * pp_dofile _((void)); -OP * pp_entereval _((void)); -OP * pp_leaveeval _((void)); -OP * pp_entertry _((void)); -OP * pp_leavetry _((void)); -OP * pp_ghbyname _((void)); -OP * pp_ghbyaddr _((void)); -OP * pp_ghostent _((void)); -OP * pp_gnbyname _((void)); -OP * pp_gnbyaddr _((void)); -OP * pp_gnetent _((void)); -OP * pp_gpbyname _((void)); -OP * pp_gpbynumber _((void)); -OP * pp_gprotoent _((void)); -OP * pp_gsbyname _((void)); -OP * pp_gsbyport _((void)); -OP * pp_gservent _((void)); -OP * pp_shostent _((void)); -OP * pp_snetent _((void)); -OP * pp_sprotoent _((void)); -OP * pp_sservent _((void)); -OP * pp_ehostent _((void)); -OP * pp_enetent _((void)); -OP * pp_eprotoent _((void)); -OP * pp_eservent _((void)); -OP * pp_gpwnam _((void)); -OP * pp_gpwuid _((void)); -OP * pp_gpwent _((void)); -OP * pp_spwent _((void)); -OP * pp_epwent _((void)); -OP * pp_ggrnam _((void)); -OP * pp_ggrgid _((void)); -OP * pp_ggrent _((void)); -OP * pp_sgrent _((void)); -OP * pp_egrent _((void)); -OP * pp_getlogin _((void)); -OP * pp_syscall _((void)); +OP * pp_null _((ARGSproto)); +OP * pp_stub _((ARGSproto)); +OP * pp_scalar _((ARGSproto)); +OP * pp_pushmark _((ARGSproto)); +OP * pp_wantarray _((ARGSproto)); +OP * pp_const _((ARGSproto)); +OP * pp_gvsv _((ARGSproto)); +OP * pp_gv _((ARGSproto)); +OP * pp_gelem _((ARGSproto)); +OP * pp_padsv _((ARGSproto)); +OP * pp_padav _((ARGSproto)); +OP * pp_padhv _((ARGSproto)); +OP * pp_padany _((ARGSproto)); +OP * pp_pushre _((ARGSproto)); +OP * pp_rv2gv _((ARGSproto)); +OP * pp_rv2sv _((ARGSproto)); +OP * pp_av2arylen _((ARGSproto)); +OP * pp_rv2cv _((ARGSproto)); +OP * pp_anoncode _((ARGSproto)); +OP * pp_prototype _((ARGSproto)); +OP * pp_refgen _((ARGSproto)); +OP * pp_srefgen _((ARGSproto)); +OP * pp_ref _((ARGSproto)); +OP * pp_bless _((ARGSproto)); +OP * pp_backtick _((ARGSproto)); +OP * pp_glob _((ARGSproto)); +OP * pp_readline _((ARGSproto)); +OP * pp_rcatline _((ARGSproto)); +OP * pp_regcmaybe _((ARGSproto)); +OP * pp_regcomp _((ARGSproto)); +OP * pp_match _((ARGSproto)); +OP * pp_subst _((ARGSproto)); +OP * pp_substcont _((ARGSproto)); +OP * pp_trans _((ARGSproto)); +OP * pp_sassign _((ARGSproto)); +OP * pp_aassign _((ARGSproto)); +OP * pp_chop _((ARGSproto)); +OP * pp_schop _((ARGSproto)); +OP * pp_chomp _((ARGSproto)); +OP * pp_schomp _((ARGSproto)); +OP * pp_defined _((ARGSproto)); +OP * pp_undef _((ARGSproto)); +OP * pp_study _((ARGSproto)); +OP * pp_pos _((ARGSproto)); +OP * pp_preinc _((ARGSproto)); +OP * pp_i_preinc _((ARGSproto)); +OP * pp_predec _((ARGSproto)); +OP * pp_i_predec _((ARGSproto)); +OP * pp_postinc _((ARGSproto)); +OP * pp_i_postinc _((ARGSproto)); +OP * pp_postdec _((ARGSproto)); +OP * pp_i_postdec _((ARGSproto)); +OP * pp_pow _((ARGSproto)); +OP * pp_multiply _((ARGSproto)); +OP * pp_i_multiply _((ARGSproto)); +OP * pp_divide _((ARGSproto)); +OP * pp_i_divide _((ARGSproto)); +OP * pp_modulo _((ARGSproto)); +OP * pp_i_modulo _((ARGSproto)); +OP * pp_repeat _((ARGSproto)); +OP * pp_add _((ARGSproto)); +OP * pp_i_add _((ARGSproto)); +OP * pp_subtract _((ARGSproto)); +OP * pp_i_subtract _((ARGSproto)); +OP * pp_concat _((ARGSproto)); +OP * pp_stringify _((ARGSproto)); +OP * pp_left_shift _((ARGSproto)); +OP * pp_right_shift _((ARGSproto)); +OP * pp_lt _((ARGSproto)); +OP * pp_i_lt _((ARGSproto)); +OP * pp_gt _((ARGSproto)); +OP * pp_i_gt _((ARGSproto)); +OP * pp_le _((ARGSproto)); +OP * pp_i_le _((ARGSproto)); +OP * pp_ge _((ARGSproto)); +OP * pp_i_ge _((ARGSproto)); +OP * pp_eq _((ARGSproto)); +OP * pp_i_eq _((ARGSproto)); +OP * pp_ne _((ARGSproto)); +OP * pp_i_ne _((ARGSproto)); +OP * pp_ncmp _((ARGSproto)); +OP * pp_i_ncmp _((ARGSproto)); +OP * pp_slt _((ARGSproto)); +OP * pp_sgt _((ARGSproto)); +OP * pp_sle _((ARGSproto)); +OP * pp_sge _((ARGSproto)); +OP * pp_seq _((ARGSproto)); +OP * pp_sne _((ARGSproto)); +OP * pp_scmp _((ARGSproto)); +OP * pp_bit_and _((ARGSproto)); +OP * pp_bit_xor _((ARGSproto)); +OP * pp_bit_or _((ARGSproto)); +OP * pp_negate _((ARGSproto)); +OP * pp_i_negate _((ARGSproto)); +OP * pp_not _((ARGSproto)); +OP * pp_complement _((ARGSproto)); +OP * pp_atan2 _((ARGSproto)); +OP * pp_sin _((ARGSproto)); +OP * pp_cos _((ARGSproto)); +OP * pp_rand _((ARGSproto)); +OP * pp_srand _((ARGSproto)); +OP * pp_exp _((ARGSproto)); +OP * pp_log _((ARGSproto)); +OP * pp_sqrt _((ARGSproto)); +OP * pp_int _((ARGSproto)); +OP * pp_hex _((ARGSproto)); +OP * pp_oct _((ARGSproto)); +OP * pp_abs _((ARGSproto)); +OP * pp_length _((ARGSproto)); +OP * pp_substr _((ARGSproto)); +OP * pp_vec _((ARGSproto)); +OP * pp_index _((ARGSproto)); +OP * pp_rindex _((ARGSproto)); +OP * pp_sprintf _((ARGSproto)); +OP * pp_formline _((ARGSproto)); +OP * pp_ord _((ARGSproto)); +OP * pp_chr _((ARGSproto)); +OP * pp_crypt _((ARGSproto)); +OP * pp_ucfirst _((ARGSproto)); +OP * pp_lcfirst _((ARGSproto)); +OP * pp_uc _((ARGSproto)); +OP * pp_lc _((ARGSproto)); +OP * pp_quotemeta _((ARGSproto)); +OP * pp_rv2av _((ARGSproto)); +OP * pp_aelemfast _((ARGSproto)); +OP * pp_aelem _((ARGSproto)); +OP * pp_aslice _((ARGSproto)); +OP * pp_each _((ARGSproto)); +OP * pp_values _((ARGSproto)); +OP * pp_keys _((ARGSproto)); +OP * pp_delete _((ARGSproto)); +OP * pp_exists _((ARGSproto)); +OP * pp_rv2hv _((ARGSproto)); +OP * pp_helem _((ARGSproto)); +OP * pp_hslice _((ARGSproto)); +OP * pp_unpack _((ARGSproto)); +OP * pp_pack _((ARGSproto)); +OP * pp_split _((ARGSproto)); +OP * pp_join _((ARGSproto)); +OP * pp_list _((ARGSproto)); +OP * pp_lslice _((ARGSproto)); +OP * pp_anonlist _((ARGSproto)); +OP * pp_anonhash _((ARGSproto)); +OP * pp_splice _((ARGSproto)); +OP * pp_push _((ARGSproto)); +OP * pp_pop _((ARGSproto)); +OP * pp_shift _((ARGSproto)); +OP * pp_unshift _((ARGSproto)); +OP * pp_sort _((ARGSproto)); +OP * pp_reverse _((ARGSproto)); +OP * pp_grepstart _((ARGSproto)); +OP * pp_grepwhile _((ARGSproto)); +OP * pp_mapstart _((ARGSproto)); +OP * pp_mapwhile _((ARGSproto)); +OP * pp_range _((ARGSproto)); +OP * pp_flip _((ARGSproto)); +OP * pp_flop _((ARGSproto)); +OP * pp_and _((ARGSproto)); +OP * pp_or _((ARGSproto)); +OP * pp_xor _((ARGSproto)); +OP * pp_cond_expr _((ARGSproto)); +OP * pp_andassign _((ARGSproto)); +OP * pp_orassign _((ARGSproto)); +OP * pp_method _((ARGSproto)); +OP * pp_entersub _((ARGSproto)); +OP * pp_leavesub _((ARGSproto)); +OP * pp_caller _((ARGSproto)); +OP * pp_warn _((ARGSproto)); +OP * pp_die _((ARGSproto)); +OP * pp_reset _((ARGSproto)); +OP * pp_lineseq _((ARGSproto)); +OP * pp_nextstate _((ARGSproto)); +OP * pp_dbstate _((ARGSproto)); +OP * pp_unstack _((ARGSproto)); +OP * pp_enter _((ARGSproto)); +OP * pp_leave _((ARGSproto)); +OP * pp_scope _((ARGSproto)); +OP * pp_enteriter _((ARGSproto)); +OP * pp_iter _((ARGSproto)); +OP * pp_enterloop _((ARGSproto)); +OP * pp_leaveloop _((ARGSproto)); +OP * pp_return _((ARGSproto)); +OP * pp_last _((ARGSproto)); +OP * pp_next _((ARGSproto)); +OP * pp_redo _((ARGSproto)); +OP * pp_dump _((ARGSproto)); +OP * pp_goto _((ARGSproto)); +OP * pp_exit _((ARGSproto)); +OP * pp_open _((ARGSproto)); +OP * pp_close _((ARGSproto)); +OP * pp_pipe_op _((ARGSproto)); +OP * pp_fileno _((ARGSproto)); +OP * pp_umask _((ARGSproto)); +OP * pp_binmode _((ARGSproto)); +OP * pp_tie _((ARGSproto)); +OP * pp_untie _((ARGSproto)); +OP * pp_tied _((ARGSproto)); +OP * pp_dbmopen _((ARGSproto)); +OP * pp_dbmclose _((ARGSproto)); +OP * pp_sselect _((ARGSproto)); +OP * pp_select _((ARGSproto)); +OP * pp_getc _((ARGSproto)); +OP * pp_read _((ARGSproto)); +OP * pp_enterwrite _((ARGSproto)); +OP * pp_leavewrite _((ARGSproto)); +OP * pp_prtf _((ARGSproto)); +OP * pp_print _((ARGSproto)); +OP * pp_sysopen _((ARGSproto)); +OP * pp_sysread _((ARGSproto)); +OP * pp_syswrite _((ARGSproto)); +OP * pp_send _((ARGSproto)); +OP * pp_recv _((ARGSproto)); +OP * pp_eof _((ARGSproto)); +OP * pp_tell _((ARGSproto)); +OP * pp_seek _((ARGSproto)); +OP * pp_truncate _((ARGSproto)); +OP * pp_fcntl _((ARGSproto)); +OP * pp_ioctl _((ARGSproto)); +OP * pp_flock _((ARGSproto)); +OP * pp_socket _((ARGSproto)); +OP * pp_sockpair _((ARGSproto)); +OP * pp_bind _((ARGSproto)); +OP * pp_connect _((ARGSproto)); +OP * pp_listen _((ARGSproto)); +OP * pp_accept _((ARGSproto)); +OP * pp_shutdown _((ARGSproto)); +OP * pp_gsockopt _((ARGSproto)); +OP * pp_ssockopt _((ARGSproto)); +OP * pp_getsockname _((ARGSproto)); +OP * pp_getpeername _((ARGSproto)); +OP * pp_lstat _((ARGSproto)); +OP * pp_stat _((ARGSproto)); +OP * pp_ftrread _((ARGSproto)); +OP * pp_ftrwrite _((ARGSproto)); +OP * pp_ftrexec _((ARGSproto)); +OP * pp_fteread _((ARGSproto)); +OP * pp_ftewrite _((ARGSproto)); +OP * pp_fteexec _((ARGSproto)); +OP * pp_ftis _((ARGSproto)); +OP * pp_fteowned _((ARGSproto)); +OP * pp_ftrowned _((ARGSproto)); +OP * pp_ftzero _((ARGSproto)); +OP * pp_ftsize _((ARGSproto)); +OP * pp_ftmtime _((ARGSproto)); +OP * pp_ftatime _((ARGSproto)); +OP * pp_ftctime _((ARGSproto)); +OP * pp_ftsock _((ARGSproto)); +OP * pp_ftchr _((ARGSproto)); +OP * pp_ftblk _((ARGSproto)); +OP * pp_ftfile _((ARGSproto)); +OP * pp_ftdir _((ARGSproto)); +OP * pp_ftpipe _((ARGSproto)); +OP * pp_ftlink _((ARGSproto)); +OP * pp_ftsuid _((ARGSproto)); +OP * pp_ftsgid _((ARGSproto)); +OP * pp_ftsvtx _((ARGSproto)); +OP * pp_fttty _((ARGSproto)); +OP * pp_fttext _((ARGSproto)); +OP * pp_ftbinary _((ARGSproto)); +OP * pp_chdir _((ARGSproto)); +OP * pp_chown _((ARGSproto)); +OP * pp_chroot _((ARGSproto)); +OP * pp_unlink _((ARGSproto)); +OP * pp_chmod _((ARGSproto)); +OP * pp_utime _((ARGSproto)); +OP * pp_rename _((ARGSproto)); +OP * pp_link _((ARGSproto)); +OP * pp_symlink _((ARGSproto)); +OP * pp_readlink _((ARGSproto)); +OP * pp_mkdir _((ARGSproto)); +OP * pp_rmdir _((ARGSproto)); +OP * pp_open_dir _((ARGSproto)); +OP * pp_readdir _((ARGSproto)); +OP * pp_telldir _((ARGSproto)); +OP * pp_seekdir _((ARGSproto)); +OP * pp_rewinddir _((ARGSproto)); +OP * pp_closedir _((ARGSproto)); +OP * pp_fork _((ARGSproto)); +OP * pp_wait _((ARGSproto)); +OP * pp_waitpid _((ARGSproto)); +OP * pp_system _((ARGSproto)); +OP * pp_exec _((ARGSproto)); +OP * pp_kill _((ARGSproto)); +OP * pp_getppid _((ARGSproto)); +OP * pp_getpgrp _((ARGSproto)); +OP * pp_setpgrp _((ARGSproto)); +OP * pp_getpriority _((ARGSproto)); +OP * pp_setpriority _((ARGSproto)); +OP * pp_time _((ARGSproto)); +OP * pp_tms _((ARGSproto)); +OP * pp_localtime _((ARGSproto)); +OP * pp_gmtime _((ARGSproto)); +OP * pp_alarm _((ARGSproto)); +OP * pp_sleep _((ARGSproto)); +OP * pp_shmget _((ARGSproto)); +OP * pp_shmctl _((ARGSproto)); +OP * pp_shmread _((ARGSproto)); +OP * pp_shmwrite _((ARGSproto)); +OP * pp_msgget _((ARGSproto)); +OP * pp_msgctl _((ARGSproto)); +OP * pp_msgsnd _((ARGSproto)); +OP * pp_msgrcv _((ARGSproto)); +OP * pp_semget _((ARGSproto)); +OP * pp_semctl _((ARGSproto)); +OP * pp_semop _((ARGSproto)); +OP * pp_require _((ARGSproto)); +OP * pp_dofile _((ARGSproto)); +OP * pp_entereval _((ARGSproto)); +OP * pp_leaveeval _((ARGSproto)); +OP * pp_entertry _((ARGSproto)); +OP * pp_leavetry _((ARGSproto)); +OP * pp_ghbyname _((ARGSproto)); +OP * pp_ghbyaddr _((ARGSproto)); +OP * pp_ghostent _((ARGSproto)); +OP * pp_gnbyname _((ARGSproto)); +OP * pp_gnbyaddr _((ARGSproto)); +OP * pp_gnetent _((ARGSproto)); +OP * pp_gpbyname _((ARGSproto)); +OP * pp_gpbynumber _((ARGSproto)); +OP * pp_gprotoent _((ARGSproto)); +OP * pp_gsbyname _((ARGSproto)); +OP * pp_gsbyport _((ARGSproto)); +OP * pp_gservent _((ARGSproto)); +OP * pp_shostent _((ARGSproto)); +OP * pp_snetent _((ARGSproto)); +OP * pp_sprotoent _((ARGSproto)); +OP * pp_sservent _((ARGSproto)); +OP * pp_ehostent _((ARGSproto)); +OP * pp_enetent _((ARGSproto)); +OP * pp_eprotoent _((ARGSproto)); +OP * pp_eservent _((ARGSproto)); +OP * pp_gpwnam _((ARGSproto)); +OP * pp_gpwuid _((ARGSproto)); +OP * pp_gpwent _((ARGSproto)); +OP * pp_spwent _((ARGSproto)); +OP * pp_epwent _((ARGSproto)); +OP * pp_ggrnam _((ARGSproto)); +OP * pp_ggrgid _((ARGSproto)); +OP * pp_ggrent _((ARGSproto)); +OP * pp_sgrent _((ARGSproto)); +OP * pp_egrent _((ARGSproto)); +OP * pp_getlogin _((ARGSproto)); +OP * pp_syscall _((ARGSproto)); #ifndef DOINIT EXT OP * (*ppaddr[])(); @@ -81,13 +81,13 @@ END # Emit function declarations. for (sort keys %ckname) { - print "OP *\t", &tab(3,$_),"_((OP* op));\n"; + print "OP *\t", &tab(3,$_),"_((OP* o));\n"; } print "\n"; for (@ops) { - print "OP *\t", &tab(3, "pp_\L$_"), "_((void));\n"; + print "OP *\t", &tab(3, "pp_\L$_"), "_((ARGSproto));\n"; } # Emit ppcode switch array. @@ -44,8 +44,10 @@ static void init_main_stash _((void)); static void init_perllib _((void)); static void init_postdump_symbols _((int, char **, char **)); static void init_predump_symbols _((void)); -static void init_stacks _((void)); static void open_script _((char *, bool, SV *)); +#ifdef USE_THREADS +static void thread_destruct _((void *)); +#endif /* USE_THREADS */ static void usage _((char *)); static void validate_suid _((char *, char*)); @@ -65,6 +67,10 @@ void perl_construct( sv_interp ) register PerlInterpreter *sv_interp; { +#ifdef USE_THREADS + struct thread *thr; +#endif /* USE_THREADS */ + if (!(curinterp = sv_interp)) return; @@ -72,6 +78,20 @@ register PerlInterpreter *sv_interp; Zero(sv_interp, 1, PerlInterpreter); #endif +#ifdef USE_THREADS +#ifdef NEED_PTHREAD_INIT + pthread_init(); +#endif /* NEED_PTHREAD_INIT */ + New(53, thr, 1, struct thread); + self = pthread_self(); + if (pthread_key_create(&thr_key, thread_destruct)) + croak("panic: pthread_key_create"); + if (pthread_setspecific(thr_key, (void *) thr)) + croak("panic: pthread_setspecific"); + nthreads = 1; + cvcache = newHV(); +#endif /* USE_THREADS */ + /* Init the real globals? */ if (!linestr) { linestr = NEWSV(65,80); @@ -90,6 +110,12 @@ register PerlInterpreter *sv_interp; nrs = newSVpv("\n", 1); rs = SvREFCNT_inc(nrs); + MUTEX_INIT(&malloc_mutex); + MUTEX_INIT(&sv_mutex); + MUTEX_INIT(&eval_mutex); + MUTEX_INIT(&nthreads_mutex); + COND_INIT(&nthreads_cond); + #ifdef MSDOS /* * There is no way we can refer to them from Perl so close them to save @@ -132,14 +158,42 @@ register PerlInterpreter *sv_interp; fdpid = newAV(); /* for remembering popen pids by fd */ pidstatus = newHV();/* for remembering status of dead pids */ - init_stacks(); + init_stacks(ARGS); + DEBUG( { + New(51,debname,128,char); + New(52,debdelim,128,char); + } ) + ENTER; } +#ifdef USE_THREADS +void +thread_destruct(arg) +void *arg; +{ + struct thread *thr = (struct thread *) arg; + /* + * Decrement the global thread count and signal anyone listening. + * The only official thread listening is the original thread while + * in perl_destruct. It waits until it's the only thread and then + * performs END blocks and other process clean-ups. + */ + DEBUG_L(fprintf(stderr, "thread_destruct: 0x%lx\n", (unsigned long) thr)); + + Safefree(thr); + MUTEX_LOCK(&nthreads_mutex); + nthreads--; + COND_BROADCAST(&nthreads_cond); + MUTEX_UNLOCK(&nthreads_mutex); +} +#endif /* USE_THREADS */ + void perl_destruct(sv_interp) register PerlInterpreter *sv_interp; { + dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ I32 last_sv_count; HV *hv; @@ -147,6 +201,22 @@ register PerlInterpreter *sv_interp; if (!(curinterp = sv_interp)) return; +#ifdef USE_THREADS + /* Wait until all user-created threads go away */ + MUTEX_LOCK(&nthreads_mutex); + while (nthreads > 1) + { + DEBUG_L(fprintf(stderr, "perl_destruct: waiting for %d threads\n", + nthreads - 1)); + COND_WAIT(&nthreads_cond, &nthreads_mutex); + } + /* At this point, we're the last thread */ + MUTEX_UNLOCK(&nthreads_mutex); + DEBUG_L(fprintf(stderr, "perl_destruct: armageddon has arrived\n")); + MUTEX_DESTROY(&nthreads_mutex); + COND_DESTROY(&nthreads_cond); +#endif /* USE_THREADS */ + destruct_level = perl_destruct_level; #ifdef DEBUGGING { @@ -214,6 +284,11 @@ register PerlInterpreter *sv_interp; sv_free_arenas(); DEBUG_P(debprofdump()); +#ifdef USE_THREADS + MUTEX_DESTROY(&sv_mutex); + MUTEX_DESTROY(&malloc_mutex); + MUTEX_DESTROY(&eval_mutex); +#endif /* USE_THREADS */ } void @@ -236,6 +311,7 @@ int argc; char **argv; char **env; { + dTHR; register SV *sv; register char *s; char *scriptname = NULL; @@ -436,6 +512,13 @@ setuid perl scripts securely.\n"); compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); +#ifdef USE_THREADS + CvOWNER(compcv) = 0; + New(666, CvMUTEXP(compcv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(compcv)); + New(666, CvCONDP(compcv), 1, pthread_cond_t); + COND_INIT(CvCONDP(compcv)); +#endif /* USE_THREADS */ pad = newAV(); comppad = pad; @@ -444,6 +527,9 @@ setuid perl scripts securely.\n"); padname = newAV(); comppad_name = padname; comppad_name_fill = 0; +#ifdef USE_THREADS + av_store(comppad_name, 0, newSVpv("@_", 2)); +#endif /* USE_THREADS */ min_intro_pending = 0; padix = 0; @@ -513,6 +599,7 @@ int perl_run(sv_interp) PerlInterpreter *sv_interp; { + dTHR; if (!(curinterp = sv_interp)) return 255; switch (Sigsetjmp(top_env,1)) { @@ -545,6 +632,9 @@ PerlInterpreter *sv_interp; if (!restartop) { DEBUG_x(dump_all()); DEBUG(fprintf(stderr,"\nEXECUTING...\n\n")); +#ifdef USE_THREADS + DEBUG_L(fprintf(stderr,"main thread is 0x%lx\n", (unsigned long) thr)); +#endif /* USE_THREADS */ if (minus_c) { fprintf(stderr,"%s syntax OK\n", origfilename); @@ -574,10 +664,15 @@ void my_exit(status) U32 status; { + dTHR; register CONTEXT *cx; I32 gimme; SV **newsp; +#ifdef USE_THREADS + DEBUG_L(fprintf(stderr, "my_exit: thread 0x%lx, status %lu\n", + (unsigned long) thr, (unsigned long) status)); +#endif /* USE_THREADS */ statusvalue = FIXSTATUS(status); if (cxstack_ix >= 0) { if (cxstack_ix > 0) @@ -649,6 +744,7 @@ char *subname; I32 flags; /* See G_* flags in cop.h */ register char **argv; /* null terminated arg list */ { + dTHR; dSP; PUSHMARK(sp); @@ -675,13 +771,14 @@ perl_call_method(methname, flags) char *methname; /* name of the subroutine */ I32 flags; /* See G_* flags in cop.h */ { + dTHR; dSP; OP myop; if (!op) op = &myop; XPUSHs(sv_2mortal(newSVpv(methname,0))); PUTBACK; - pp_method(); + pp_method(ARGS); return perl_call_sv(*stack_sp--, flags); } @@ -691,6 +788,7 @@ perl_call_sv(sv, flags) SV* sv; I32 flags; /* See G_* flags in cop.h */ { + dTHR; LOGOP myop; /* fake syntax tree node */ SV** sp = stack_sp; I32 oldmark = TOPMARK; @@ -781,7 +879,7 @@ I32 flags; /* See G_* flags in cop.h */ } if (op == (OP*)&myop) - op = pp_entersub(); + op = pp_entersub(ARGS); if (op) runops(); retval = stack_sp - (stack_base + oldmark); @@ -821,6 +919,7 @@ perl_eval_sv(sv, flags) SV* sv; I32 flags; /* See G_* flags in cop.h */ { + dTHR; UNOP myop; /* fake syntax tree node */ SV** sp = stack_sp; I32 oldmark = sp - stack_base; @@ -886,7 +985,7 @@ restart: } if (op == (OP*)&myop) - op = pp_entereval(); + op = pp_entereval(ARGS); if (op) runops(); retval = stack_sp - (stack_base + oldmark); @@ -1120,30 +1219,31 @@ char *s; taint_not("-m"); /* XXX ? */ if (*++s) { char *start; + SV *sv; char *use = "use "; /* -M-foo == 'no foo' */ if (*s == '-') { use = "no "; ++s; } - Sv = newSVpv(use,0); + sv = newSVpv(use,0); start = s; /* We allow -M'Module qw(Foo Bar)' */ while(isALNUM(*s) || *s==':') ++s; if (*s != '=') { - sv_catpv(Sv, start); + sv_catpv(sv, start); if (*(start-1) == 'm') { if (*s != '\0') croak("Can't use '%c' after -mname", *s); - sv_catpv( Sv, " ()"); + sv_catpv( sv, " ()"); } } else { - sv_catpvn(Sv, start, s-start); - sv_catpv(Sv, " split(/,/,q{"); - sv_catpv(Sv, ++s); - sv_catpv(Sv, "})"); + sv_catpvn(sv, start, s-start); + sv_catpv(sv, " split(/,/,q{"); + sv_catpv(sv, ++s); + sv_catpv(sv, "})"); } s += strlen(s); if (preambleav == NULL) preambleav = newAV(); - av_push(preambleav, Sv); + av_push(preambleav, sv); } else croak("No space allowed after -%c", *(s-1)); @@ -1286,6 +1386,7 @@ my_unexec() static void init_main_stash() { + dTHR; GV *gv; curstash = defstash = newHV(); curstname = newSVpv("main",4); @@ -1798,6 +1899,7 @@ init_ids() static void init_debugger() { + dTHR; curstash = debstash; dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV)))); AvREAL_off(dbargs); @@ -1813,8 +1915,9 @@ init_debugger() curstash = defstash; } -static void -init_stacks() +void +init_stacks(ARGS) +dARGS { stack = newAV(); mainstack = stack; /* remember in case we switch stacks */ @@ -1848,11 +1951,6 @@ init_stacks() New(50,tmps_stack,128,SV*); tmps_ix = -1; tmps_max = 128; - - DEBUG( { - New(51,debname,128,char); - New(52,debdelim,128,char); - } ) } static FILE *tmpfp; /* moved outside init_lexer() because of UNICOS bug */ @@ -1869,6 +1967,7 @@ init_lexer() static void init_predump_symbols() { + dTHR; GV *tmpgv; GV *othergv; @@ -2033,6 +2132,7 @@ void calllist(list) AV* list; { + dTHR; Sigjmp_buf oldtop; STRLEN len; line_t oldline = curcop->cop_line; @@ -33,6 +33,10 @@ # endif #endif +#ifdef USE_THREADS +#include <pthread.h> +#endif + #include "embed.h" #define VOIDUSED 1 @@ -607,6 +611,12 @@ union any { void (*any_dptr) _((void*)); }; +#ifdef USE_THREADS +#define ARGSproto struct thread * +#else +#define ARGSproto void +#endif /* USE_THREADS */ + #include "regexp.h" #include "sv.h" #include "util.h" @@ -867,6 +877,18 @@ I32 unlnk _((char*)); /* global state */ EXT PerlInterpreter * curinterp; /* currently running interpreter */ +#ifdef USE_THREADS +EXT pthread_key_t thr_key; /* For per-thread struct thread ptr */ +EXT pthread_mutex_t sv_mutex; /* Mutex for allocating SVs in sv.c */ +EXT pthread_mutex_t malloc_mutex; /* Mutex for malloc */ +EXT pthread_mutex_t eval_mutex; /* Mutex for doeval */ +EXT pthread_cond_t eval_cond; /* Condition variable for doeval */ +EXT struct thread * eval_owner; /* Owner thread for doeval */ +EXT int nthreads; /* Number of threads currently */ +EXT pthread_mutex_t nthreads_mutex; /* Mutex for nthreads */ +EXT pthread_cond_t nthreads_cond; /* Condition variable for nthreads */ +#endif /* USE_THREADS */ + #ifndef VMS /* VMS doesn't use environ array */ extern char ** environ; /* environment variables supplied via exec */ #endif @@ -1412,6 +1434,7 @@ struct interpreter { }; #endif +#include "thread.h" #include "pp.h" #ifdef __cplusplus @@ -7,10 +7,15 @@ * */ +#ifdef USE_THREADS +#define ARGS thr +#define dARGS struct thread *thr; +#define PP(s) OP* s(ARGS) dARGS +#else #define ARGS -#define ARGSproto void #define dARGS #define PP(s) OP* s(ARGS) dARGS +#endif /* USE_THREADS */ #define SP sp #define MARK mark @@ -24,7 +24,7 @@ #endif static OP *doeval _((int gimme)); -static OP *dofindlabel _((OP *op, char *label, OP **opstack)); +static OP *dofindlabel _((OP *o, char *label, OP **opstack)); static void doparseform _((SV *sv)); static I32 dopoptoeval _((I32 startingblock)); static I32 dopoptolabel _((char *label)); @@ -455,8 +455,8 @@ PP(pp_grepstart) RETURNOP(op->op_next->op_next); } stack_sp = stack_base + *markstack_ptr + 1; - pp_pushmark(); /* push dst */ - pp_pushmark(); /* push src */ + pp_pushmark(ARGS); /* push dst */ + pp_pushmark(ARGS); /* push src */ ENTER; /* enter outer scope */ SAVETMPS; @@ -471,7 +471,7 @@ PP(pp_grepstart) PUTBACK; if (op->op_type == OP_MAPSTART) - pp_pushmark(); /* push top */ + pp_pushmark(ARGS); /* push top */ return ((LOGOP*)op->op_next)->op_other; } @@ -756,6 +756,7 @@ static I32 dopoptolabel(label) char *label; { + dTHR; register I32 i; register CONTEXT *cx; @@ -791,6 +792,7 @@ char *label; I32 dowantarray() { + dTHR; I32 cxix; cxix = dopoptosub(cxstack_ix); @@ -807,6 +809,7 @@ static I32 dopoptosub(startingblock) I32 startingblock; { + dTHR; I32 i; register CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -827,6 +830,7 @@ static I32 dopoptoeval(startingblock) I32 startingblock; { + dTHR; I32 i; register CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -846,6 +850,7 @@ static I32 dopoptoloop(startingblock) I32 startingblock; { + dTHR; I32 i; register CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -875,6 +880,7 @@ void dounwind(cxix) I32 cxix; { + dTHR; register CONTEXT *cx; SV **newsp; I32 optype; @@ -911,6 +917,7 @@ die(pat, va_alist) va_dcl #endif { + dTHR; va_list args; char *message; int oldrunlevel = runlevel; @@ -945,6 +952,7 @@ OP * die_where(message) char *message; { + dTHR; if (in_eval) { I32 cxix; register CONTEXT *cx; @@ -1054,7 +1062,7 @@ PP(pp_entersubr) mark++; } *sp = cv; - return pp_entersub(); + return pp_entersub(ARGS); } #endif @@ -1155,6 +1163,7 @@ sortcv(a, b) const void *a; const void *b; { + dTHR; SV **str1 = (SV **) a; SV **str2 = (SV **) b; I32 oldsaveix = savestack_ix; @@ -1544,28 +1553,28 @@ PP(pp_redo) static OP* lastgotoprobe; static OP * -dofindlabel(op,label,opstack) -OP *op; +dofindlabel(o,label,opstack) +OP *o; char *label; OP **opstack; { OP *kid; OP **ops = opstack; - if (op->op_type == OP_LEAVE || - op->op_type == OP_SCOPE || - op->op_type == OP_LEAVELOOP || - op->op_type == OP_LEAVETRY) - *ops++ = cUNOP->op_first; + if (o->op_type == OP_LEAVE || + o->op_type == OP_SCOPE || + o->op_type == OP_LEAVELOOP || + o->op_type == OP_LEAVETRY) + *ops++ = cUNOPo->op_first; *ops = 0; - if (op->op_flags & OPf_KIDS) { + if (o->op_flags & OPf_KIDS) { /* First try all the kids at this level, since that's likeliest. */ - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && kCOP->cop_label && strEQ(kCOP->cop_label, label)) return kid; } - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if (kid == lastgotoprobe) continue; if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { @@ -1576,8 +1585,8 @@ OP **opstack; else *ops++ = kid; } - if (op = dofindlabel(kid,label,ops)) - return op; + if (o = dofindlabel(kid,label,ops)) + return o; } } *ops = 0; @@ -1824,7 +1833,7 @@ PP(pp_goto) OP *oldop = op; for (ix = 1; enterops[ix]; ix++) { op = enterops[ix]; - (*op->op_ppaddr)(); + (*op->op_ppaddr)(ARGS); } op = oldop; } @@ -1937,11 +1946,18 @@ static OP * doeval(gimme) int gimme; { + dTHR; dSP; OP *saveop = op; HV *newstash; AV* comppadlist; + MUTEX_LOCK(&eval_mutex); + if (eval_owner && eval_owner != thr) + while (eval_owner) + COND_WAIT(&eval_cond, &eval_mutex); + eval_owner = thr; + MUTEX_UNLOCK(&eval_mutex); in_eval = 1; /* set up a scratch pad */ @@ -1957,10 +1973,20 @@ int gimme; SAVESPTR(compcv); compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); +#ifdef USE_THREADS + CvOWNER(compcv) = 0; + New(666, CvMUTEXP(compcv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(compcv)); + New(666, CvCONDP(compcv), 1, pthread_cond_t); + COND_INIT(CvCONDP(compcv)); +#endif /* USE_THREADS */ comppad = newAV(); comppad_name = newAV(); comppad_name_fill = 0; +#ifdef USE_THREADS + av_store(comppad_name, 0, newSVpv("@_", 2)); +#endif /* USE_THREADS */ min_intro_pending = 0; av_push(comppad, Nullsv); curpad = AvARRAY(comppad); @@ -2028,6 +2054,10 @@ int gimme; /* compiled okay, so do it */ + MUTEX_LOCK(&eval_mutex); + eval_owner = 0; + COND_SIGNAL(&eval_cond); + MUTEX_UNLOCK(&eval_mutex); RETURNOP(eval_start); } @@ -20,6 +20,43 @@ /* Hot code. */ +#ifdef USE_THREADS +static void +unset_cvowner(cvarg) +void *cvarg; +{ + register CV* cv = (CV *) cvarg; +#ifdef DEBUGGING + dTHR; +#endif /* DEBUGGING */ + + DEBUG_L((fprintf(stderr, "0x%lx unsetting CvOWNER of 0x%lx:%s\n", + (unsigned long)thr, (unsigned long)cv, SvPEEK((SV*)cv)))); + MUTEX_LOCK(CvMUTEXP(cv)); + assert(CvDEPTH(cv) == 0); + assert(thr == CvOWNER(cv)); + CvOWNER(cv) = 0; + if (CvCONDP(cv)) + COND_SIGNAL(CvCONDP(cv)); /* next please */ + MUTEX_UNLOCK(CvMUTEXP(cv)); + SvREFCNT_dec(cv); +} + +#if 0 +void +mutex_unlock(m) +void *m; +{ +#ifdef DEBUGGING + dTHR; + DEBUG_L((fprintf(stderr, "0x%lx unlocking mutex 0x%lx\n", + (unsigned long) thr, (unsigned long) m))); +#endif /* DEBUGGING */ + MUTEX_UNLOCK((pthread_mutex_t *) m); +} +#endif +#endif /* USE_THREADS */ + PP(pp_const) { dSP; @@ -932,6 +969,7 @@ ret_no: OP * do_readline() { + dTHR; dSP; dTARGETSTACKED; register SV *sv; STRLEN tmplen = 0; @@ -1733,6 +1771,119 @@ PP(pp_entersub) DIE("No DBsub routine"); } +#ifdef USE_THREADS + MUTEX_LOCK(CvMUTEXP(cv)); + if (!CvCONDP(cv)) { +#ifdef DEBUGGING + DEBUG_L((fprintf(stderr, "0x%lx entering fast %s\n", + (unsigned long)thr, SvPEEK((SV*)cv)))); +#endif /* DEBUGGING */ + MUTEX_UNLOCK(CvMUTEXP(cv)); /* fast sub wants neither sync nor clone */ + } + else if (SvFLAGS(cv) & SVpcv_SYNC) { + /* + * It's a synchronised CV. Wait until it's free unless + * we own it already (in which case we're recursing). + */ + if (CvOWNER(cv) && CvOWNER(cv) != thr) { + do { + DEBUG_L((fprintf(stderr, "0x%lx wait for 0x%lx to leave %s\n", + (unsigned long)thr,(unsigned long)CvOWNER(cv), + SvPEEK((SV*)cv)))); + COND_WAIT(CvCONDP(cv), CvMUTEXP(cv)); /* yawn */ + } while (CvOWNER(cv)); + } + CvOWNER(cv) = thr; /* Assert ownership */ + SvREFCNT_inc(cv); + MUTEX_UNLOCK(CvMUTEXP(cv)); + if (CvDEPTH(cv) == 0) + SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + } + else { + /* + * It's an ordinary unsynchronised CV so we must distinguish + * three cases. (1) It's ours already (and we're recursing); + * (2) it's free (but we may already be using a cached clone); + * (3) another thread owns it. Case (1) is easy: we just use it. + * Case (2) means we look for a clone--if we have one, use it + * otherwise grab ownership of cv. Case (3) means look we for a + * clone and have to create one if we don't already have one. + * Why look for a clone in case (2) when we could just grab + * ownership of cv straight away? Well, we could be recursing, + * i.e. we originally tried to enter cv while another thread + * owned it (hence we used a clone) but it has been freed up + * and we're now recursing into it. It may or may not be "better" + * to use the clone but at least CvDEPTH can be trusted. + */ + if (CvOWNER(cv) == thr) + MUTEX_UNLOCK(CvMUTEXP(cv)); + else { + /* Case (2) or (3) */ + SV **svp; + + /* + * XXX Might it be better to release CvMUTEXP(cv) while we + * do the hv_fetch? We might find someone has pinched it + * when we look again, in which case we would be in case + * (3) instead of (2) so we'd have to clone. Would the fact + * that we released the mutex more quickly make up for this? + */ + svp = hv_fetch(cvcache, (char *)cv, sizeof(cv), FALSE); + if (svp) { + /* We already have a clone to use */ + MUTEX_UNLOCK(CvMUTEXP(cv)); + cv = *(CV**)svp; + DEBUG_L(fprintf(stderr, + "entersub: 0x%lx already has clone 0x%lx:%s\n", + (unsigned long) thr, (unsigned long) cv, + SvPEEK((SV*)cv))); + CvOWNER(cv) = thr; + SvREFCNT_inc(cv); + if (CvDEPTH(cv) == 0) + SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + } + else { + /* (2) => grab ownership of cv. (3) => make clone */ + if (!CvOWNER(cv)) { + CvOWNER(cv) = thr; + SvREFCNT_inc(cv); + MUTEX_UNLOCK(CvMUTEXP(cv)); + DEBUG_L(fprintf(stderr, + "entersub: 0x%lx grabbing 0x%lx:%s\n", + (unsigned long) thr, (unsigned long) cv, + SvPEEK((SV*)cv))); + } else { + /* Make a new clone. */ + CV *clonecv; + SvREFCNT_inc(cv); /* don't let it vanish from under us */ + MUTEX_UNLOCK(CvMUTEXP(cv)); + DEBUG_L((fprintf(stderr, + "entersub: 0x%lx cloning 0x%lx:%s\n", + (unsigned long) thr, (unsigned long) cv, + SvPEEK((SV*)cv)))); + /* + * We're creating a new clone so there's no race + * between the original MUTEX_UNLOCK and the + * SvREFCNT_inc since no one will be trying to undef + * it out from underneath us. At least, I don't think + * there's a race... + */ + clonecv = cv_clone(cv); + SvREFCNT_dec(cv); /* finished with this */ + hv_store(cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0); + CvOWNER(clonecv) = thr; + cv = clonecv; + SvREFCNT_inc(cv); + } + assert(CvDEPTH(cv) == 0); + SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + } + } + } +#endif /* USE_THREADS */ + + gimme = GIMME; + if (CvXSUB(cv)) { if (CvOLDSTYLE(cv)) { I32 (*fp3)_((int,int,int)); @@ -1886,8 +2037,8 @@ PP(pp_aelem) } void -provide_ref(op, sv) -OP* op; +provide_ref(o, sv) +OP* o; SV* sv; { if (SvGMAGICAL(sv)) @@ -1896,7 +2047,7 @@ SV* sv; if (SvREADONLY(sv)) croak(no_modify); (void)SvUPGRADE(sv, SVt_RV); - SvRV(sv) = (op->op_private & OPpDEREF_HV ? + SvRV(sv) = (o->op_private & OPpDEREF_HV ? (SV*)newHV() : (SV*)newAV()); SvROK_on(sv); SvSETMAGIC(sv); @@ -419,7 +419,7 @@ PP(pp_tie) XPUSHs(gv); PUTBACK; - if (op = pp_entersub()) + if (op = pp_entersub(ARGS)) runops(); SPAGAIN; @@ -504,7 +504,7 @@ PP(pp_dbmopen) SAVESPTR(op); op = (OP *) &myop; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); EXTEND(sp, 5); PUSHs(sv); @@ -517,7 +517,7 @@ PP(pp_dbmopen) PUSHs(gv); PUTBACK; - if (op = pp_entersub()) + if (op = pp_entersub(ARGS)) runops(); SPAGAIN; @@ -525,7 +525,7 @@ PP(pp_dbmopen) sp--; op = (OP *) &myop; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); PUSHs(sv); PUSHs(left); @@ -534,7 +534,7 @@ PP(pp_dbmopen) PUSHs(gv); PUTBACK; - if (op = pp_entersub()) + if (op = pp_entersub(ARGS)) runops(); SPAGAIN; } @@ -688,6 +688,7 @@ void setdefout(gv) GV *gv; { + dTHR; if (gv) (void)SvREFCNT_inc(gv); if (defoutgv) @@ -758,6 +759,7 @@ CV *cv; GV *gv; OP *retop; { + dTHR; register CONTEXT *cx; I32 gimme = GIMME; AV* padlist = CvPADLIST(cv); @@ -13,7 +13,7 @@ bool Gv_AMupdate _((HV* stash)); OP* append_elem _((I32 optype, OP* head, OP* tail)); OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); I32 apply _((I32 type, SV** mark, SV** sp)); -void assertref _((OP* op)); +void assertref _((OP* o)); void av_clear _((AV* ar)); void av_extend _((AV* ar, I32 key)); AV* av_fake _((I32 size, SV** svp)); @@ -39,8 +39,8 @@ U32 cast_ulong _((double f)); I32 chsize _((int fd, Off_t length)); #endif OP * ck_gvconst _((OP * o)); -OP * ck_retarget _((OP *op)); -OP* convert _((I32 optype, I32 flags, OP* op)); +OP * ck_retarget _((OP *o)); +OP* convert _((I32 optype, I32 flags, OP* o)); char* cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen)); void croak _((char* pat,...)) __attribute__((format(printf,1,2),noreturn)); CV* cv_clone _((CV* proto)); @@ -54,7 +54,7 @@ I32 filter_read _((int idx, SV *buffer, int maxlen)); I32 cxinc _((void)); void deb _((char* pat,...)) __attribute__((format(printf,1,2))); void deb_growlevel _((void)); -I32 debop _((OP* op)); +I32 debop _((OP* o)); I32 debstackptrs _((void)); #ifdef DEBUGGING void debprofdump _((void)); @@ -75,7 +75,7 @@ I32 do_ipcctl _((I32 optype, SV** mark, SV** sp)); I32 do_ipcget _((I32 optype, SV** mark, SV** sp)); #endif void do_join _((SV* sv, SV* del, SV** mark, SV** sp)); -OP* do_kv _((void)); +OP* do_kv _((ARGSproto)); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) I32 do_msgrcv _((SV** mark, SV** sp)); I32 do_msgsnd _((SV** mark, SV** sp)); @@ -116,7 +116,7 @@ char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); OP* force_list _((OP* arg)); OP* fold_constants _((OP * arg)); void free_tmps _((void)); -OP* gen_constant_list _((OP* op)); +OP* gen_constant_list _((OP* o)); void gp_free _((GV* gv)); GP* gp_ref _((GP* gp)); GV* gv_AVadd _((GV* gv)); @@ -149,6 +149,7 @@ SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash)); void hv_undef _((HV* tb)); I32 ibcmp _((U8* a, U8* b, I32 len)); I32 ingroup _((I32 testgid, I32 effective)); +void init_stacks _((ARGSproto)); char* instr _((char* big, char* little)); bool io_close _((IO* io)); OP* invert _((OP* cmd)); @@ -157,7 +158,7 @@ I32 keyword _((char* d, I32 len)); void leave_scope _((I32 base)); void lex_end _((void)); void lex_start _((SV *line)); -OP* linklist _((OP* op)); +OP* linklist _((OP* o)); OP* list _((OP* o)); OP* listkids _((OP* o)); OP* localize _((OP* arg, I32 lexical)); @@ -213,45 +214,48 @@ int mg_get _((SV* sv)); U32 mg_len _((SV* sv)); void mg_magical _((SV* sv)); int mg_set _((SV* sv)); -OP* mod _((OP* op, I32 type)); +OP* mod _((OP* o, I32 type)); char* moreswitches _((char* s)); +#ifdef USE_THREADS +void mutex_unlock _((void *m)); +#endif /* USE_THREADS */ OP * my _(( OP *)); char* my_bcopy _((char* from, char* to, I32 len)); #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) char* my_bzero _((char* loc, I32 len)); #endif void my_exit _((U32 status)) __attribute__((noreturn)); -I32 my_lstat _((void)); +I32 my_lstat _((ARGSproto)); #ifndef HAS_MEMCMP I32 my_memcmp _((unsigned char* s1, unsigned char* s2, I32 len)); #endif I32 my_pclose _((FILE* ptr)); FILE* my_popen _((char* cmd, char* mode)); void my_setenv _((char* nam, char* val)); -I32 my_stat _((void)); +I32 my_stat _((ARGSproto)); #ifdef MYSWAP short my_swap _((short s)); long my_htonl _((long l)); long my_ntohl _((long l)); #endif void my_unexec _((void)); -OP* newANONLIST _((OP* op)); -OP* newANONHASH _((OP* op)); +OP* newANONLIST _((OP* o)); +OP* newANONHASH _((OP* o)); OP* newANONSUB _((I32 floor, OP* proto, OP* block)); OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right)); OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop)); -void newFORM _((I32 floor, OP* op, OP* block)); +void newFORM _((I32 floor, OP* o, OP* block)); OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont)); OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right)); OP* newLOOPEX _((I32 type, OP* label)); OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block)); OP* newNULLLIST _((void)); OP* newOP _((I32 optype, I32 flags)); -void newPROG _((OP* op)); +void newPROG _((OP* o)); OP* newRANGE _((I32 flags, OP* left, OP* right)); OP* newSLICEOP _((I32 flags, OP* subscript, OP* list)); OP* newSTATEOP _((I32 flags, char* label, OP* o)); -CV* newSUB _((I32 floor, OP* op, OP* proto, OP* block)); +CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block)); CV* newXS _((char *name, void (*subaddr)(CV* cv), char *filename)); #ifdef DEPRECATED CV* newXSUB _((char *name, I32 ix, I32 (*subaddr)(int,int,int), char *filename)); @@ -288,7 +292,7 @@ FILE* nextargv _((GV* gv)); char* ninstr _((char* big, char* bigend, char* little, char* lend)); OP * oopsCV _((OP* o)); void op_free _((OP* arg)); -void package _((OP* op)); +void package _((OP* o)); PADOFFSET pad_alloc _((I32 optype, U32 tmptype)); PADOFFSET pad_allocmy _((char* name)); PADOFFSET pad_findmy _((char* name)); @@ -299,7 +303,7 @@ SV* pad_sv _((PADOFFSET po)); void pad_free _((PADOFFSET po)); void pad_reset _((void)); void pad_swipe _((PADOFFSET po)); -void peep _((OP* op)); +void peep _((OP* o)); PerlInterpreter* perl_alloc _((void)); I32 perl_call_argv _((char* subname, I32 flags, char** argv)); I32 perl_call_method _((char* methname, I32 flags)); @@ -321,21 +325,21 @@ int perl_run _((PerlInterpreter* sv_interp)); void pidgone _((int pid, int status)); void pmflag _((U16* pmfl, int ch)); OP* pmruntime _((OP* pm, OP* expr, OP* repl)); -OP* pmtrans _((OP* op, OP* expr, OP* repl)); +OP* pmtrans _((OP* o, OP* expr, OP* repl)); OP* pop_return _((void)); void pop_scope _((void)); OP* prepend_elem _((I32 optype, OP* head, OP* tail)); -void provide_ref _((OP* op, SV* sv)); -void push_return _((OP* op)); +void provide_ref _((OP* o, SV* sv)); +void push_return _((OP* o)); void push_scope _((void)); regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); -OP* ref _((OP* op, I32 type)); -OP* refkids _((OP* op, I32 type)); +OP* ref _((OP* o, I32 type)); +OP* refkids _((OP* o, I32 type)); void regdump _((regexp* r)); I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase)); void pregfree _((struct regexp* r)); char* regnext _((char* p)); -char* regprop _((char* op)); +char* regprop _((char* o)); void repeatcpy _((char* to, char* from, I32 len, I32 count)); char* rninstr _((char* big, char* bigend, char* little, char* lend)); int runops _((void)); @@ -367,7 +371,7 @@ void save_delete _((HV* hv, char* key, I32 klen)); void save_destructor _((void (*f)(void*), void* p)); #endif /* titan */ void save_freesv _((SV* sv)); -void save_freeop _((OP* op)); +void save_freeop _((OP* o)); void save_freepv _((char* pv)); HV* save_hash _((GV* gv)); void save_hptr _((HV** hptr)); @@ -383,9 +387,9 @@ void save_sptr _((SV** sptr)); SV* save_svref _((SV** sptr)); OP* sawparens _((OP* o)); OP* scalar _((OP* o)); -OP* scalarkids _((OP* op)); +OP* scalarkids _((OP* o)); OP* scalarseq _((OP* o)); -OP* scalarvoid _((OP* op)); +OP* scalarvoid _((OP* o)); unsigned long scan_hex _((char* start, I32 len, I32* retlen)); char* scan_num _((char* s)); unsigned long scan_oct _((char* start, I32 len, I32* retlen)); @@ -58,6 +58,10 @@ #include "INTERN.h" #include "regcomp.h" +#ifdef USE_THREADS +#undef op +#endif /* USE_THREADS */ + #ifdef MSDOS # if defined(BUGGY_MSC6) /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */ @@ -1498,14 +1502,14 @@ regexp *r; - regprop - printable representation of opcode */ char * -regprop(op) -char *op; +regprop(o) +char *o; { register char *p = 0; (void) strcpy(buf, ":"); - switch (OP(op)) { + switch (OP(o)) { case BOL: p = "BOL"; break; @@ -1573,23 +1577,23 @@ char *op; p = "NDIGIT"; break; case CURLY: - (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op)); + (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(o),ARG2(o)); p = NULL; break; case CURLYX: - (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op)); + (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(o),ARG2(o)); p = NULL; break; case REF: - (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op)); + (void)sprintf(buf+strlen(buf), "REF%d", ARG1(o)); p = NULL; break; case OPEN: - (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op)); + (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(o)); p = NULL; break; case CLOSE: - (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op)); + (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(o)); p = NULL; break; case STAR: @@ -89,6 +89,7 @@ CHECKPOINT regcppush(parenfloor) I32 parenfloor; { + dTHR; int retval = savestack_ix; int i = (regsize - parenfloor) * 3; int p; @@ -110,6 +111,7 @@ I32 parenfloor; char* regcppop() { + dTHR; I32 i = SSPOPINT; U32 paren = 0; char *input; @@ -771,6 +773,7 @@ char *prog; *reglastparen = n; break; case CURLYX: { + dTHR; CURCUR cc; CHECKPOINT cp = savestack_ix; cc.oldcc = regcc; @@ -23,19 +23,21 @@ dEXT char *watchok; int runops() { + dTHR; SAVEI32(runlevel); runlevel++; - while ( op = (*op->op_ppaddr)() ) ; + while ( op = (*op->op_ppaddr)(ARGS) ) ; return 0; } #else -static void debprof _((OP*op)); +static void debprof _((OP*o)); int runops() { + dTHR; if (!op) { warn("NULL OP IN RUN"); return 0; @@ -52,26 +54,29 @@ runops() { DEBUG_s(debstack()); DEBUG_t(debop(op)); DEBUG_P(debprof(op)); +#ifdef USE_THREADS + DEBUG_L(pthread_yield()); /* shake up scheduling a bit */ +#endif /* USE_THREADS */ } - } while ( op = (*op->op_ppaddr)() ); + } while ( op = (*op->op_ppaddr)(ARGS) ); return 0; } I32 -debop(op) -OP *op; +debop(o) +OP *o; { SV *sv; - deb("%s", op_name[op->op_type]); - switch (op->op_type) { + deb("%s", op_name[o->op_type]); + switch (o->op_type) { case OP_CONST: - fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv)); + fprintf(stderr, "(%s)", SvPEEK(cSVOPo->op_sv)); break; case OP_GVSV: case OP_GV: - if (cGVOP->op_gv) { + if (cGVOPo->op_gv) { sv = NEWSV(0,0); - gv_fullname(sv, cGVOP->op_gv); + gv_fullname(sv, cGVOPo->op_gv); fprintf(stderr, "(%s)", SvPV(sv, na)); SvREFCNT_dec(sv); } @@ -96,12 +101,12 @@ char **addr; } static void -debprof(op) -OP* op; +debprof(o) +OP* o; { if (!profiledata) New(000, profiledata, MAXO, U32); - ++profiledata[op->op_type]; + ++profiledata[o->op_type]; } void @@ -21,6 +21,7 @@ SV** sp; SV** p; int n; { + dTHR; stack_sp = sp; av_extend(stack, (p - stack_base) + (n) + 128); return stack_sp; @@ -29,6 +30,7 @@ int n; I32 cxinc() { + dTHR; cxstack_max = cxstack_max * 3 / 2; Renew(cxstack, cxstack_max + 1, CONTEXT); /* XXX should fix CXINC macro */ return cxstack_ix + 1; @@ -38,6 +40,7 @@ void push_return(retop) OP *retop; { + dTHR; if (retstack_ix == retstack_max) { retstack_max = retstack_max * 3 / 2; Renew(retstack, retstack_max, OP*); @@ -48,6 +51,7 @@ OP *retop; OP * pop_return() { + dTHR; if (retstack_ix > 0) return retstack[--retstack_ix]; else @@ -57,6 +61,7 @@ pop_return() void push_scope() { + dTHR; if (scopestack_ix == scopestack_max) { scopestack_max = scopestack_max * 3 / 2; Renew(scopestack, scopestack_max, I32); @@ -68,6 +73,7 @@ push_scope() void pop_scope() { + dTHR; I32 oldsave = scopestack[--scopestack_ix]; LEAVE_SCOPE(oldsave); } @@ -75,6 +81,7 @@ pop_scope() void markstack_grow() { + dTHR; I32 oldmax = markstack_max - markstack; I32 newmax = oldmax * 3 / 2; @@ -86,6 +93,7 @@ markstack_grow() void savestack_grow() { + dTHR; savestack_max = savestack_max * 3 / 2; Renew(savestack, savestack_max, ANY); } @@ -93,6 +101,7 @@ savestack_grow() void free_tmps() { + dTHR; /* XXX should tmps_floor live in cxstack? */ I32 myfloor = tmps_floor; while (tmps_ix > myfloor) { /* clean up after last statement */ @@ -111,6 +120,7 @@ SV * save_scalar(gv) GV *gv; { + dTHR; register SV *sv; SV *osv = GvSV(gv); @@ -148,6 +158,7 @@ void save_gp(gv) GV *gv; { + dTHR; register GP *gp; GP *ogp = GvGP(gv); @@ -169,6 +180,7 @@ SV* save_svref(sptr) SV **sptr; { + dTHR; register SV *sv; SV *osv = *sptr; @@ -205,6 +217,7 @@ AV * save_ary(gv) GV *gv; { + dTHR; SSCHECK(3); SSPUSHPTR(gv); SSPUSHPTR(GvAVn(gv)); @@ -218,6 +231,7 @@ HV * save_hash(gv) GV *gv; { + dTHR; SSCHECK(3); SSPUSHPTR(gv); SSPUSHPTR(GvHVn(gv)); @@ -231,6 +245,7 @@ void save_item(item) register SV *item; { + dTHR; register SV *sv; SSCHECK(3); @@ -245,6 +260,7 @@ void save_int(intp) int *intp; { + dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -255,6 +271,7 @@ void save_long(longp) long *longp; { + dTHR; SSCHECK(3); SSPUSHLONG(*longp); SSPUSHPTR(longp); @@ -265,6 +282,7 @@ void save_I32(intp) I32 *intp; { + dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -275,6 +293,7 @@ void save_iv(ivp) IV *ivp; { + dTHR; SSCHECK(3); SSPUSHIV(*ivp); SSPUSHPTR(ivp); @@ -288,6 +307,7 @@ void save_pptr(pptr) char **pptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*pptr); SSPUSHPTR(pptr); @@ -298,6 +318,7 @@ void save_sptr(sptr) SV **sptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*sptr); SSPUSHPTR(sptr); @@ -308,6 +329,7 @@ void save_nogv(gv) GV *gv; { + dTHR; SSCHECK(2); SSPUSHPTR(gv); SSPUSHINT(SAVEt_NSTAB); @@ -317,6 +339,7 @@ void save_hptr(hptr) HV **hptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*hptr); SSPUSHPTR(hptr); @@ -327,6 +350,7 @@ void save_aptr(aptr) AV **aptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*aptr); SSPUSHPTR(aptr); @@ -337,17 +361,19 @@ void save_freesv(sv) SV *sv; { + dTHR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_FREESV); } void -save_freeop(op) -OP *op; +save_freeop(o) +OP *o; { + dTHR; SSCHECK(2); - SSPUSHPTR(op); + SSPUSHPTR(o); SSPUSHINT(SAVEt_FREEOP); } @@ -355,6 +381,7 @@ void save_freepv(pv) char *pv; { + dTHR; SSCHECK(2); SSPUSHPTR(pv); SSPUSHINT(SAVEt_FREEPV); @@ -364,6 +391,7 @@ void save_clearsv(svp) SV** svp; { + dTHR; SSCHECK(2); SSPUSHLONG((long)(svp-curpad)); SSPUSHINT(SAVEt_CLEARSV); @@ -375,6 +403,7 @@ HV *hv; char *key; I32 klen; { + dTHR; SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); @@ -387,6 +416,7 @@ save_list(sarg,maxsarg) register SV **sarg; I32 maxsarg; { + dTHR; register SV *sv; register I32 i; @@ -405,6 +435,7 @@ save_destructor(f,p) void (*f) _((void*)); void* p; { + dTHR; SSCHECK(3); SSPUSHDPTR(f); SSPUSHPTR(p); @@ -415,6 +446,7 @@ void leave_scope(base) I32 base; { + dTHR; register SV *sv; register SV *value; register GV *gv; @@ -612,6 +644,7 @@ void cx_dump(cx) CONTEXT* cx; { + dTHR; fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]); if (cx->cx_type != CXt_SUBST) { fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); @@ -76,13 +76,17 @@ U32 flags; #else #define new_SV() \ - if (sv_root) { \ - sv = sv_root; \ - sv_root = (SV*)SvANY(sv); \ - ++sv_count; \ - } \ - else \ - sv = more_sv(); + do { \ + MUTEX_LOCK(&sv_mutex); \ + if (sv_root) { \ + sv = sv_root; \ + sv_root = (SV*)SvANY(sv); \ + ++sv_count; \ + } \ + else \ + sv = more_sv(); \ + MUTEX_UNLOCK(&sv_mutex); \ + } while (0) static SV* new_sv() @@ -1026,8 +1030,11 @@ IV i; case SVt_PVCV: case SVt_PVFM: case SVt_PVIO: - croak("Can't coerce %s to integer in %s", sv_reftype(sv,0), - op_name[op->op_type]); + { + dTHR; + croak("Can't coerce %s to integer in %s", sv_reftype(sv,0), + op_name[op->op_type]); + } } (void)SvIOK_only(sv); /* validate number */ SvIVX(sv) = i; @@ -1074,8 +1081,11 @@ double num; case SVt_PVCV: case SVt_PVFM: case SVt_PVIO: - croak("Can't coerce %s to number in %s", sv_reftype(sv,0), - op_name[op->op_type]); + { + dTHR; + croak("Can't coerce %s to number in %s", sv_reftype(sv,0), + op_name[op->op_type]); + } } SvNVX(sv) = num; (void)SvNOK_only(sv); /* validate number */ @@ -1086,6 +1096,7 @@ static void not_a_number(sv) SV *sv; { + dTHR; char tmpbuf[64]; char *d = tmpbuf; char *s; @@ -1195,6 +1206,7 @@ register SV *sv; SvIVX(sv) = (IV)atol(SvPVX(sv)); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1267,6 +1279,7 @@ register SV *sv; SvNVX(sv) = atof(SvPVX(sv)); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0.0; @@ -1398,6 +1411,7 @@ STRLEN *lp; while (*s) s++; } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0; @@ -1450,6 +1464,7 @@ register SV *sv; if (SvROK(sv)) { #ifdef OVERLOAD { + dTHR; SV* tmpsv; if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_))) return SvTRUE(tmpsv); @@ -1458,11 +1473,11 @@ register SV *sv; return SvRV(sv) != 0; } if (SvPOKp(sv)) { - register XPV* Xpv; - if ((Xpv = (XPV*)SvANY(sv)) && - (*Xpv->xpv_pv > '0' || - Xpv->xpv_cur > 1 || - (Xpv->xpv_cur && *Xpv->xpv_pv != '0'))) + register XPV* Xpvtmp; + if ((Xpvtmp = (XPV*)SvANY(sv)) && + (*Xpvtmp->xpv_pv > '0' || + Xpvtmp->xpv_cur > 1 || + (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0'))) return 1; else return 0; @@ -1489,6 +1504,7 @@ sv_setsv(dstr,sstr) SV *dstr; register SV *sstr; { + dTHR; register U32 sflags; register int dtype; register int stype; @@ -1622,6 +1638,7 @@ register SV *sstr; if (sflags & SVf_ROK) { if (dtype >= SVt_PV) { if (dtype == SVt_PVGV) { + dTHR; SV *sref = SvREFCNT_inc(SvRV(sstr)); SV *dref = 0; int intro = GvINTRO(dstr); @@ -2021,6 +2038,7 @@ I32 namlen; if (!obj || obj == sv || how == '#') mg->mg_obj = obj; else { + dTHR; mg->mg_obj = SvREFCNT_inc(obj); mg->mg_flags |= MGf_REFCOUNTED; } @@ -2272,6 +2290,7 @@ register SV *sv; assert(SvREFCNT(sv) == 0); if (SvOBJECT(sv)) { + dTHR; dSP; GV* destructor; @@ -2281,6 +2300,7 @@ register SV *sv; ENTER; SAVEFREESV(SvSTASH(sv)); if (destructor && GvCV(destructor)) { + dTHR; SV ref; Zero(&ref, 1, SV); @@ -2841,6 +2861,7 @@ register SV *sv; static void sv_mortalgrow() { + dTHR; tmps_max += 128; Renew(tmps_stack, tmps_max, SV*); } @@ -2849,6 +2870,7 @@ SV * sv_mortalcopy(oldstr) SV *oldstr; { + dTHR; register SV *sv; new_SV(); @@ -2866,6 +2888,7 @@ SV *oldstr; SV * sv_newmortal() { + dTHR; register SV *sv; new_SV(); @@ -2884,6 +2907,7 @@ SV * sv_2mortal(sv) register SV *sv; { + dTHR; if (!sv) return sv; if (SvREADONLY(sv) && curcop != &compiling) @@ -2944,6 +2968,7 @@ SV * newRV(ref) SV *ref; { + dTHR; register SV *sv; new_SV(); @@ -3205,9 +3230,11 @@ STRLEN *lp; s = SvPVX(sv); *lp = SvCUR(sv); } - else + else { + dTHR; croak("Can't coerce %s to string in %s", sv_reftype(sv,0), op_name[op->op_type]); + } } else s = sv_2pv(sv, lp); @@ -3296,6 +3323,7 @@ newSVrv(rv, classname) SV *rv; char *classname; { + dTHR; SV *sv; new_SV(); @@ -3362,6 +3390,7 @@ sv_bless(sv,stash) SV* sv; HV* stash; { + dTHR; SV *ref; if (!SvROK(sv)) croak("Can't bless non-reference value"); @@ -3591,6 +3620,11 @@ SV* sv; fprintf(stderr, " DEPTH = %ld\n", (long)CvDEPTH(sv)); fprintf(stderr, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv)); fprintf(stderr, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv)); +#ifdef USE_THREADS + fprintf(stderr, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv)); + fprintf(stderr, " CONDP = 0x%lx\n", (long)CvCONDP(sv)); + fprintf(stderr, " OWNER = 0x%lx\n", (long)CvOWNER(sv)); +#endif /* USE_THREADS */ if (type == SVt_PVFM) fprintf(stderr, " LINES = %ld\n", (long)FmLINES(sv)); break; @@ -129,6 +129,10 @@ struct io { #define SVpbm_CASEFOLD 0x40000000 #define SVpbm_TAIL 0x20000000 +#ifdef USE_THREADS +#define SVpcv_SYNC 0x10000000 /* Synchronised: 1 thread at a time */ +#endif /* USE_THREADS */ + #ifdef OVERLOAD #define SVpgv_AM 0x40000000 /* #define SVpgv_badAM 0x20000000 */ diff --git a/thread.h b/thread.h new file mode 100644 index 0000000000..4d6e4f0115 --- /dev/null +++ b/thread.h @@ -0,0 +1,206 @@ +#ifndef USE_THREADS +#define MUTEX_LOCK(m) +#define MUTEX_UNLOCK(m) +#define MUTEX_INIT(m) +#define MUTEX_DESTROY(m) +#define COND_INIT(c) +#define COND_SIGNAL(c) +#define COND_BROADCAST(c) +#define COND_WAIT(c, m) +#define COND_DESTROY(c) + +#define THR +/* Rats: if dTHR is just blank then the subsequent ";" throws an error */ +#define dTHR extern int errno +#else +#include <pthread.h> + +#ifdef OLD_PTHREADS_API +#define pthread_mutexattr_init(a) pthread_mutexattr_create(a) +#define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) +#define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d)) +#else +#define pthread_mutexattr_default NULL +#endif /* OLD_PTHREADS_API */ + +#define MUTEX_INIT(m) \ + if (pthread_mutex_init((m), pthread_mutexattr_default)) \ + croak("panic: MUTEX_INIT"); \ + else 1 +#define MUTEX_LOCK(m) \ + if (pthread_mutex_lock((m))) croak("panic: MUTEX_LOCK"); else 1 +#define MUTEX_UNLOCK(m) \ + if (pthread_mutex_unlock((m))) croak("panic: MUTEX_UNLOCK"); else 1 +#define MUTEX_DESTROY(m) \ + if (pthread_mutex_destroy((m))) croak("panic: MUTEX_DESTROY"); else 1 +#define COND_INIT(c) \ + if (pthread_cond_init((c), NULL)) croak("panic: COND_INIT"); else 1 +#define COND_SIGNAL(c) \ + if (pthread_cond_signal((c))) croak("panic: COND_SIGNAL"); else 1 +#define COND_BROADCAST(c) \ + if (pthread_cond_broadcast((c))) croak("panic: COND_BROADCAST"); else 1 +#define COND_WAIT(c, m) \ + if (pthread_cond_wait((c), (m))) croak("panic: COND_WAIT"); else 1 +#define COND_DESTROY(c) \ + if (pthread_cond_destroy((c))) croak("panic: COND_DESTROY"); else 1 +/* XXX Add "old" (?) POSIX draft interface too */ +#ifdef OLD_PTHREADS_API +struct thread *getTHR _((void)); +#define THR getTHR() +#else +#define THR ((struct thread *) pthread_getspecific(thr_key)) +#endif /* OLD_PTHREADS_API */ +#define dTHR struct thread *thr = THR + +struct thread { + pthread_t Tself; + + /* The fields that used to be global */ + SV ** Tstack_base; + SV ** Tstack_sp; + SV ** Tstack_max; + + OP * Top; + + I32 * Tscopestack; + I32 Tscopestack_ix; + I32 Tscopestack_max; + + ANY * Tsavestack; + I32 Tsavestack_ix; + I32 Tsavestack_max; + + OP ** Tretstack; + I32 Tretstack_ix; + I32 Tretstack_max; + + I32 * Tmarkstack; + I32 * Tmarkstack_ptr; + I32 * Tmarkstack_max; + + SV ** Tcurpad; + + SV * TSv; + XPV * TXpv; + char Tbuf[2048]; /* should be a global locked by a mutex */ + char Ttokenbuf[256]; /* should be a global locked by a mutex */ + struct stat Tstatbuf; + struct tms Ttimesbuf; + + /* XXX What about regexp stuff? */ + + /* Now the fields that used to be "per interpreter" (even when global) */ + + /* XXX What about magic variables such as $/, $? and so on? */ + HV * Tdefstash; + HV * Tcurstash; + AV * Tpad; + AV * Tpadname; + + SV ** Ttmps_stack; + I32 Ttmps_ix; + I32 Ttmps_floor; + I32 Ttmps_max; + + int Tin_eval; + OP * Trestartop; + int Tdelaymagic; + bool Tdirty; + U8 Tlocalizing; + + CONTEXT * Tcxstack; + I32 Tcxstack_ix; + I32 Tcxstack_max; + + AV * Tstack; + AV * Tmainstack; + Sigjmp_buf Ttop_env; + I32 Trunlevel; + + /* XXX Sort stuff, firstgv, secongv and so on? */ + + pthread_mutex_t * Tthreadstart_mutexp; + HV * Tcvcache; +}; + +typedef struct thread *Thread; + +#undef stack_base +#undef stack_sp +#undef stack_max +#undef stack +#undef mainstack +#undef markstack +#undef markstack_ptr +#undef markstack_max +#undef scopestack +#undef scopestack_ix +#undef scopestack_max +#undef savestack +#undef savestack_ix +#undef savestack_max +#undef retstack +#undef retstack_ix +#undef retstack_max +#undef cxstack +#undef cxstack_ix +#undef cxstack_max +#undef curpad +#undef Sv +#undef Xpv +#undef op +#undef top_env +#undef runlevel +#undef in_eval + +#define self (thr->Tself) +#define stack_base (thr->Tstack_base) +#define stack_sp (thr->Tstack_sp) +#define stack_max (thr->Tstack_max) +#define op (thr->Top) +#define stack (thr->Tstack) +#define mainstack (thr->Tmainstack) +#define markstack (thr->Tmarkstack) +#define markstack_ptr (thr->Tmarkstack_ptr) +#define markstack_max (thr->Tmarkstack_max) +#define scopestack (thr->Tscopestack) +#define scopestack_ix (thr->Tscopestack_ix) +#define scopestack_max (thr->Tscopestack_max) + +#define savestack (thr->Tsavestack) +#define savestack_ix (thr->Tsavestack_ix) +#define savestack_max (thr->Tsavestack_max) + +#define retstack (thr->Tretstack) +#define retstack_ix (thr->Tretstack_ix) +#define retstack_max (thr->Tretstack_max) + +#define cxstack (thr->Tcxstack) +#define cxstack_ix (thr->Tcxstack_ix) +#define cxstack_max (thr->Tcxstack_max) + +#define curpad (thr->Tcurpad) +#define Sv (thr->TSv) +#define Xpv (thr->TXpv) +#define defstash (thr->Tdefstash) +#define curstash (thr->Tcurstash) +#define pad (thr->Tpad) +#define padname (thr->Tpadname) + +#define tmps_stack (thr->Ttmps_stack) +#define tmps_ix (thr->Ttmps_ix) +#define tmps_floor (thr->Ttmps_floor) +#define tmps_max (thr->Ttmps_max) + +#define in_eval (thr->Tin_eval) +#define restartop (thr->Trestartop) +#define delaymagic (thr->Tdelaymagic) +#define dirty (thr->Tdirty) +#define localizing (thr->Tlocalizing) + +#define top_env (thr->Ttop_env) +#define runlevel (thr->Trunlevel) + +#define threadstart_mutexp (thr->Tthreadstart_mutexp) +#define cvcache (thr->Tcvcache) +#endif /* USE_THREADS */ @@ -326,6 +326,7 @@ static char * skipspace(s) register char *s; { + dTHR; if (lex_formbrack && lex_brackets <= lex_formbrack) { while (s < bufend && (*s == ' ' || *s == '\t')) s++; @@ -500,11 +501,11 @@ register char *s; int kind; { if (s && *s) { - OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); - nextval[nexttoke].opval = op; + OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); + nextval[nexttoke].opval = o; force_next(WORD); if (kind) { - op->op_private = OPpCONST_ENTERED; + o->op_private = OPpCONST_ENTERED; gv_fetchpv(s, TRUE, kind == '$' ? SVt_PV : kind == '@' ? SVt_PVAV : @@ -1145,6 +1146,7 @@ extern int yychar; /* last token */ int yylex() { + dTHR; register char *s; register char *d; register I32 tmp; @@ -1657,7 +1659,7 @@ yylex() TERM('%'); } if (!strchr(tokenbuf,':')) { - if (tmp = pad_findmy(tokenbuf)) { + if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) { nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; force_next(PRIVATEREF); @@ -1969,7 +1971,7 @@ yylex() PREREF(DOLSHARP); if (!strchr(tokenbuf+1,':')) { tokenbuf[0] = '@'; - if (tmp = pad_findmy(tokenbuf)) { + if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) { nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; expect = XOPERATOR; @@ -2060,7 +2062,7 @@ yylex() tokenbuf[0] = '%'; } } - if (tmp = pad_findmy(tokenbuf)) { + if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) { if (!tokenbuf[2] && *tokenbuf =='$' && tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a') { @@ -2113,7 +2115,7 @@ yylex() if (*s == '{') tokenbuf[0] = '%'; } - if (tmp = pad_findmy(tokenbuf)) { + if (tmp = pad_findmy(tokenbuf) != NOT_IN_PAD) { nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; force_next(PRIVATEREF); @@ -4334,6 +4336,7 @@ void hoistmust(pm) register PMOP *pm; { + dTHR; if (!pm->op_pmshort && pm->op_pmregexp->regstart && (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH) ) { @@ -4375,7 +4378,7 @@ scan_trans(start) char *start; { register char* s; - OP *op; + OP *o; short *tbl; I32 squash; I32 delete; @@ -4405,7 +4408,7 @@ char *start; } New(803,tbl,256,short); - op = newPVOP(OP_TRANS, 0, (char*)tbl); + o = newPVOP(OP_TRANS, 0, (char*)tbl); complement = delete = squash = 0; while (*s == 'c' || *s == 'd' || *s == 's') { @@ -4417,9 +4420,9 @@ char *start; squash = OPpTRANS_SQUASH; s++; } - op->op_private = delete|squash|complement; + o->op_private = delete|squash|complement; - lex_op = op; + lex_op = o; yylval.ival = OP_TRANS; return s; } @@ -4428,6 +4431,7 @@ static char * scan_heredoc(s) register char *s; { + dTHR; SV *herewas; I32 op_type = OP_SCALAR; I32 len; @@ -4575,10 +4579,10 @@ char *start; (void)strcpy(d,"ARGV"); if (*d == '$') { I32 tmp; - if (tmp = pad_findmy(d)) { - OP *op = newOP(OP_PADSV, 0); - op->op_targ = tmp; - lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op)); + if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { + OP *o = newOP(OP_PADSV, 0); + o->op_targ = tmp; + lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o)); } else { GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV); @@ -4602,6 +4606,7 @@ static char * scan_str(start) char *start; { + dTHR; SV *sv; char *tmps; register char *s = start; @@ -4812,6 +4817,7 @@ static char * scan_formline(s) register char *s; { + dTHR; register char *eol; register char *t; SV *stuff = newSVpv("",0); @@ -4890,6 +4896,7 @@ set_csh() int start_subparse() { + dTHR; int oldsavestack_ix = savestack_ix; CV* outsidecv = compcv; AV* comppadlist; @@ -4915,6 +4922,9 @@ start_subparse() comppad = newAV(); comppad_name = newAV(); comppad_name_fill = 0; +#ifdef USE_THREADS + av_store(comppad_name, 0, newSVpv("@_", 2)); +#endif /* USE_THREADS */ min_intro_pending = 0; av_push(comppad, Nullsv); curpad = AvARRAY(comppad); @@ -4928,6 +4938,13 @@ start_subparse() CvPADLIST(compcv) = comppadlist; CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv); +#ifdef USE_THREADS + CvOWNER(compcv) = 0; + New(666, CvMUTEXP(compcv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(compcv)); + New(666, CvCONDP(compcv), 1, pthread_cond_t); + COND_INIT(CvCONDP(compcv)); +#endif /* USE_THREADS */ return oldsavestack_ix; } @@ -4936,6 +4953,7 @@ int yywarn(s) char *s; { + dTHR; --error_count; in_eval |= 2; yyerror(s); @@ -4947,6 +4965,7 @@ int yyerror(s) char *s; { + dTHR; char tmpbuf[258]; char *tname = tmpbuf; @@ -885,6 +885,7 @@ mess(pat, args) va_list *args; #endif { + dTHR; char *s; char *s_start; SV *tmpstr; @@ -960,6 +961,7 @@ croak(pat, va_alist) va_dcl #endif { + dTHR; va_list args; char *message; HV *stash; @@ -973,6 +975,9 @@ croak(pat, va_alist) #endif message = mess(pat, &args); va_end(args); +#ifdef USE_THREADS + DEBUG_L(fprintf(stderr, "croak: 0x%lx %s", (unsigned long) thr, message)); +#endif /* USE_THREADS */ if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { dSP; @@ -1030,6 +1035,7 @@ warn(pat,va_alist) va_end(args); if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) { + dTHR; dSP; PUSHMARK(sp); @@ -1810,3 +1816,17 @@ I32 *retlen; *retlen = s - start; return retval; } + +#ifdef USE_THREADS +#ifdef OLD_PTHREADS_API +struct thread * +getTHR _((void)) +{ + pthread_addr_t t; + + if (pthread_getspecific(thr_key, &t)) + croak("panic: pthread_getspecific"); + return (struct thread *) t; +} +#endif /* OLD_PTHREADS_API */ +#endif /* USE_THREADS */ |