#endif
#define dXSARGS \
- dSP; dMARK; \
+ dTHR; dSP; dMARK; \
I32 ax = mark - stack_base + 1; \
I32 items = sp - mark
while (key) {
sv = AvARRAY(av)[--key];
assert(sv);
- if (sv != &sv_undef)
+ if (sv != &sv_undef) {
+ dTHR;
(void)SvREFCNT_inc(sv);
+ }
}
AvREAL_on(av);
}
AV *av;
I32 key;
{
+ dTHR; /* only necessary if we have to extend stack */
if (key > AvMAX(av)) {
SV** ary;
I32 tmp;
if (SvRMAGICAL(av)) {
if (mg_find((SV*)av,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)av, sv, 0, key);
Sv = sv;
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
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;
};
#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 */
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);
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]);
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),
I32
debstack()
{
+ dTHR;
I32 top = stack_sp - stack_base;
register I32 i = top - 30;
I32 *markscan = markstack;
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 {
}
filemode = 0;
while (av_len(GvAV(gv)) >= 0) {
+ dTHR;
STRLEN len;
sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
do_eof(gv)
GV *gv;
{
+ dTHR;
register IO *io;
int ch;
char *tmps;
if (sp > mark) {
+ dTHR;
New(401,Argv, sp - mark + 1, char*);
a = Argv;
while (++mark <= sp) {
register SV **mark;
register SV **sp;
{
+ dTHR;
register I32 val;
register I32 val2;
register I32 tot = 0;
SV **mark;
SV **sp;
{
+ dTHR;
key_t key;
I32 n, flags;
SV **mark;
SV **sp;
{
+ dTHR;
SV *astr;
char *a;
I32 id, n, cmd, infosize, getinfo;
SV **sp;
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
I32 id, msize, flags;
SV **sp;
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
long mtype;
SV **sp;
{
#ifdef HAS_SEM
+ dTHR;
SV *opstr;
char *opbuf;
I32 id;
SV **sp;
{
#ifdef HAS_SHM
+ dTHR;
SV *mstr;
char *mbuf, *shm;
I32 id, mpos, msize;
SV *sv;
OP *arg;
{
+ dTHR;
register short *tbl;
register U8 *s;
register U8 *send;
void
dump_all()
{
+ dTHR;
#ifdef HAS_SETLINEBUF
setlinebuf(stderr);
#else
dump_packsubs(stash)
HV* stash;
{
+ dTHR;
I32 i;
HE *entry;
}
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';
}
}
- 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;
}
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;
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--;
hv_undef
ibcmp
ingroup
+init_stacks
instr
intuit_more
invert
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);
I32 add;
I32 sv_type;
{
+ dTHR;
register char *name = nambeg;
register GV *gv = 0;
GV**gvp;
IO *
newIO()
{
+ dTHR;
IO *io;
GV *iogv;
gv_check(stash)
HV* stash;
{
+ dTHR;
register HE *entry;
register I32 i;
register GV *gv;
Gv_AMupdate(stash)
HV* stash;
{
+ dTHR;
GV** gvp;
HV* hv;
GV* gv;
int method;
int flags;
{
+ dTHR;
MAGIC *mg;
CV *cv;
CV **cvp=NULL, **ocvp=NULL;
|| inc_dec_ass) RvDEEPCP(left);
}
{
+ dTHR;
dSP;
BINOP myop;
SV* res;
SAVESPTR(op);
op = (OP *) &myop;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
EXTEND(sp, notfound + 5);
PUSHs(lr>0? right: left);
PUSHs((SV*)cv);
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
LEAVE;
SPAGAIN;
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
Sv = sv;
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'));
#endif
#endif /* safemalloc */
+ MUTEX_LOCK(&malloc_mutex);
/*
* Convert amount of memory requested into
* closest block size stored in hash buckets
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);
p->ov_rmagic = RMAGIC;
*((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
#endif
+ MUTEX_UNLOCK(&malloc_mutex);
return ((Malloc_t)(p + 1));
}
return; /* sanity */
}
#endif
+ MUTEX_LOCK(&malloc_mutex);
#ifdef RCHECK
ASSERT(op->ov_rmagic == RMAGIC);
if (op->ov_index <= 13)
#ifdef DEBUGGING_MSTATS
nmalloc[size]--;
#endif
+ MUTEX_UNLOCK(&malloc_mutex);
}
/*
#endif
#endif /* safemalloc */
+ MUTEX_LOCK(&malloc_mutex);
op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
if (op->ov_magic == MAGIC) {
was_alloced++;
}
#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 */
SV* sv;
MAGIC* mg;
{
+ dTHR;
register char *s;
I32 i;
SV** svp;
MAGIC* mg;
char *meth;
{
+ dTHR;
dSP;
ENTER;
SV* sv;
MAGIC* mg;
{
+ dTHR;
dSP;
PUSHMARK(sp);
SV* sv;
MAGIC* mg;
{
+ dTHR;
dSP;
PUSHMARK(sp);
MAGIC* mg;
SV* key;
{
+ dTHR;
dSP;
char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
SV* sv;
MAGIC* mg;
{
+ dTHR;
OP *o;
I32 i;
GV* gv;
SV* sv;
MAGIC* mg;
{
+ dTHR;
if (localizing) {
if (localizing == 1)
mg->mg_len <<= 1;
SV* sv;
MAGIC* mg;
{
+ dTHR;
register char *s;
I32 i;
STRLEN len;
sighandler(sig)
int sig;
{
+ dTHR;
dSP;
GV *gv;
HV *st;
* 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));
}
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;
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);
pad_allocmy(name)
char *name;
{
+ dTHR;
PADOFFSET off;
SV *sv;
pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
#endif
{
+ dTHR;
CV *cv;
I32 off;
SV *sv;
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]) &&
/* 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
I32 optype;
U32 tmptype;
{
+ dTHR;
SV *sv;
I32 retval;
}
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;
}
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 */
}
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)
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]);
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)
/* 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 */
#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)
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 @_");
}
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
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:
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))
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
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);
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 */
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:
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:
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:
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:
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;
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 &&
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 *
OP *left;
OP *right;
{
- OP *op;
+ OP *o;
if (right->op_type == OP_MATCH ||
right->op_type == OP_SUBST ||
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,
}
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 *
int
block_start()
{
+ dTHR;
int retval = savestack_ix;
comppad_name_fill = AvFILL(comppad_name);
SAVEINT(min_intro_pending);
int floor;
OP* seq;
{
+ dTHR;
int needblockscope = hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
if (copline > (line_t)line)
}
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;
fold_constants(o)
register OP *o;
{
+ dTHR;
register OP *curop;
I32 type = o->op_type;
SV *sv;
gen_constant_list(o)
register OP *o;
{
+ dTHR;
register OP *curop;
I32 oldtmps_floor = tmps_floor;
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;
}
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 */
}
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 *
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 *
}
OP *
-pmtrans(op, expr, repl)
-OP *op;
+pmtrans(o, expr, repl)
+OP *o;
OP *expr;
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);
op_free(expr);
op_free(repl);
- return op;
+ return o;
}
OP *
I32 type;
I32 flags;
{
+ dTHR;
PMOP *pmop;
Newz(1101, pmop, 1, PMOP);
}
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;
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) {
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) {
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);
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);
I32 flags;
GV *gv;
{
+ dTHR;
GVOP *gvop;
Newz(1101, gvop, 1, GVOP);
gvop->op_type = type;
}
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>");
}
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;
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;
I32 optype;
OP *right;
{
- OP *op;
+ OP *o;
if (optype) {
if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
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;
}
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;
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;
}
}
}
- return op;
+ return o;
}
if (!right)
right = newOP(OP_UNDEF, 0);
}
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. */
}
}
- return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+ return prepend_elem(OP_LINESEQ, (OP*)cop, o);
}
OP *
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));
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) {
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 *
OP* true;
OP* false;
{
+ dTHR;
CONDOP *condop;
- OP *op;
+ OP *o;
if (!false)
return newLOGOP(OP_AND, 0, first, true);
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 *
CONDOP *condop;
OP *flip;
OP *flop;
- OP *op;
+ OP *o;
Newz(1101, condop, 1, CONDOP);
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;
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 *
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);
}
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 *
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)) {
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);
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 *
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)
: "" ));
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);
cv_clone(proto)
CV* proto;
{
+ dTHR;
AV* av;
I32 ix;
AV* protopadlist = CvPADLIST(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);
}
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))
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);
}
if (!block) {
CvROOT(cv) = 0;
- op_free(op);
+ op_free(o);
copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
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);
}
void (*subaddr) _((CV*));
char *filename;
{
+ dTHR;
register CV *cv;
GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
char *s;
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)
}
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);
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 *
/* 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 ||
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;
/* 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 *
}
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++) {
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)
{
*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:
*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:
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)));
}
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);
}
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;
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 */
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;
}
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;
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++;
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;
}
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;
}
}
}
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. */
peep(o)
register OP* o;
{
+ dTHR;
register OP* oldop = 0;
if (!o || o->op_seq)
return;
*/
typedef U32 PADOFFSET;
+#define NOT_IN_PAD ((PADOFFSET) -1)
#ifdef DEBUGGING_OPS
#define OPCODE opcode
#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)
};
#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[])();
# 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.
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*));
perl_construct( sv_interp )
register PerlInterpreter *sv_interp;
{
+#ifdef USE_THREADS
+ struct thread *thr;
+#endif /* USE_THREADS */
+
if (!(curinterp = sv_interp))
return;
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);
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
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;
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
{
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
char **argv;
char **env;
{
+ dTHR;
register SV *sv;
register char *s;
char *scriptname = NULL;
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;
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;
perl_run(sv_interp)
PerlInterpreter *sv_interp;
{
+ dTHR;
if (!(curinterp = sv_interp))
return 255;
switch (Sigsetjmp(top_env,1)) {
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);
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)
I32 flags; /* See G_* flags in cop.h */
register char **argv; /* null terminated arg list */
{
+ dTHR;
dSP;
PUSHMARK(sp);
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);
}
SV* sv;
I32 flags; /* See G_* flags in cop.h */
{
+ dTHR;
LOGOP myop; /* fake syntax tree node */
SV** sp = stack_sp;
I32 oldmark = TOPMARK;
}
if (op == (OP*)&myop)
- op = pp_entersub();
+ op = pp_entersub(ARGS);
if (op)
runops();
retval = stack_sp - (stack_base + oldmark);
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;
}
if (op == (OP*)&myop)
- op = pp_entereval();
+ op = pp_entereval(ARGS);
if (op)
runops();
retval = stack_sp - (stack_base + oldmark);
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));
static void
init_main_stash()
{
+ dTHR;
GV *gv;
curstash = defstash = newHV();
curstname = newSVpv("main",4);
static void
init_debugger()
{
+ dTHR;
curstash = debstash;
dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
AvREAL_off(dbargs);
curstash = defstash;
}
-static void
-init_stacks()
+void
+init_stacks(ARGS)
+dARGS
{
stack = newAV();
mainstack = stack; /* remember in case we switch 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 */
static void
init_predump_symbols()
{
+ dTHR;
GV *tmpgv;
GV *othergv;
calllist(list)
AV* list;
{
+ dTHR;
Sigjmp_buf oldtop;
STRLEN len;
line_t oldline = curcop->cop_line;
# endif
#endif
+#ifdef USE_THREADS
+#include <pthread.h>
+#endif
+
#include "embed.h"
#define VOIDUSED 1
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"
/* 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
};
#endif
+#include "thread.h"
#include "pp.h"
#ifdef __cplusplus
*
*/
+#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
#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));
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;
PUTBACK;
if (op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
+ pp_pushmark(ARGS); /* push top */
return ((LOGOP*)op->op_next)->op_other;
}
dopoptolabel(label)
char *label;
{
+ dTHR;
register I32 i;
register CONTEXT *cx;
I32
dowantarray()
{
+ dTHR;
I32 cxix;
cxix = dopoptosub(cxstack_ix);
dopoptosub(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dopoptoeval(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dopoptoloop(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dounwind(cxix)
I32 cxix;
{
+ dTHR;
register CONTEXT *cx;
SV **newsp;
I32 optype;
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
int oldrunlevel = runlevel;
die_where(message)
char *message;
{
+ dTHR;
if (in_eval) {
I32 cxix;
register CONTEXT *cx;
mark++;
}
*sp = cv;
- return pp_entersub();
+ return pp_entersub(ARGS);
}
#endif
const void *a;
const void *b;
{
+ dTHR;
SV **str1 = (SV **) a;
SV **str2 = (SV **) b;
I32 oldsaveix = savestack_ix;
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) {
else
*ops++ = kid;
}
- if (op = dofindlabel(kid,label,ops))
- return op;
+ if (o = dofindlabel(kid,label,ops))
+ return o;
}
}
*ops = 0;
OP *oldop = op;
for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
- (*op->op_ppaddr)();
+ (*op->op_ppaddr)(ARGS);
}
op = oldop;
}
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 */
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);
/* compiled okay, so do it */
+ MUTEX_LOCK(&eval_mutex);
+ eval_owner = 0;
+ COND_SIGNAL(&eval_cond);
+ MUTEX_UNLOCK(&eval_mutex);
RETURNOP(eval_start);
}
/* 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;
OP *
do_readline()
{
+ dTHR;
dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
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));
}
void
-provide_ref(op, sv)
-OP* op;
+provide_ref(o, sv)
+OP* o;
SV* sv;
{
if (SvGMAGICAL(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);
XPUSHs(gv);
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
SAVESPTR(op);
op = (OP *) &myop;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
EXTEND(sp, 5);
PUSHs(sv);
PUSHs(gv);
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
sp--;
op = (OP *) &myop;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
PUSHs(sv);
PUSHs(left);
PUSHs(gv);
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
}
setdefout(gv)
GV *gv;
{
+ dTHR;
if (gv)
(void)SvREFCNT_inc(gv);
if (defoutgv)
GV *gv;
OP *retop;
{
+ dTHR;
register CONTEXT *cx;
I32 gimme = GIMME;
AV* padlist = CvPADLIST(cv);
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));
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));
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));
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));
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));
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));
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));
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));
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));
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));
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));
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));
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));
#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 */
- 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;
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:
regcppush(parenfloor)
I32 parenfloor;
{
+ dTHR;
int retval = savestack_ix;
int i = (regsize - parenfloor) * 3;
int p;
char*
regcppop()
{
+ dTHR;
I32 i = SSPOPINT;
U32 paren = 0;
char *input;
*reglastparen = n;
break;
case CURLYX: {
+ dTHR;
CURCUR cc;
CHECKPOINT cp = savestack_ix;
cc.oldcc = regcc;
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;
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);
}
}
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
SV** p;
int n;
{
+ dTHR;
stack_sp = sp;
av_extend(stack, (p - stack_base) + (n) + 128);
return stack_sp;
I32
cxinc()
{
+ dTHR;
cxstack_max = cxstack_max * 3 / 2;
Renew(cxstack, cxstack_max + 1, CONTEXT); /* XXX should fix CXINC macro */
return cxstack_ix + 1;
push_return(retop)
OP *retop;
{
+ dTHR;
if (retstack_ix == retstack_max) {
retstack_max = retstack_max * 3 / 2;
Renew(retstack, retstack_max, OP*);
OP *
pop_return()
{
+ dTHR;
if (retstack_ix > 0)
return retstack[--retstack_ix];
else
void
push_scope()
{
+ dTHR;
if (scopestack_ix == scopestack_max) {
scopestack_max = scopestack_max * 3 / 2;
Renew(scopestack, scopestack_max, I32);
void
pop_scope()
{
+ dTHR;
I32 oldsave = scopestack[--scopestack_ix];
LEAVE_SCOPE(oldsave);
}
void
markstack_grow()
{
+ dTHR;
I32 oldmax = markstack_max - markstack;
I32 newmax = oldmax * 3 / 2;
void
savestack_grow()
{
+ dTHR;
savestack_max = savestack_max * 3 / 2;
Renew(savestack, savestack_max, ANY);
}
void
free_tmps()
{
+ dTHR;
/* XXX should tmps_floor live in cxstack? */
I32 myfloor = tmps_floor;
while (tmps_ix > myfloor) { /* clean up after last statement */
save_scalar(gv)
GV *gv;
{
+ dTHR;
register SV *sv;
SV *osv = GvSV(gv);
save_gp(gv)
GV *gv;
{
+ dTHR;
register GP *gp;
GP *ogp = GvGP(gv);
save_svref(sptr)
SV **sptr;
{
+ dTHR;
register SV *sv;
SV *osv = *sptr;
save_ary(gv)
GV *gv;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(gv);
SSPUSHPTR(GvAVn(gv));
save_hash(gv)
GV *gv;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(gv);
SSPUSHPTR(GvHVn(gv));
save_item(item)
register SV *item;
{
+ dTHR;
register SV *sv;
SSCHECK(3);
save_int(intp)
int *intp;
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
save_long(longp)
long *longp;
{
+ dTHR;
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
save_I32(intp)
I32 *intp;
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
save_iv(ivp)
IV *ivp;
{
+ dTHR;
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
save_pptr(pptr)
char **pptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*pptr);
SSPUSHPTR(pptr);
save_sptr(sptr)
SV **sptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*sptr);
SSPUSHPTR(sptr);
save_nogv(gv)
GV *gv;
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(gv);
SSPUSHINT(SAVEt_NSTAB);
save_hptr(hptr)
HV **hptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*hptr);
SSPUSHPTR(hptr);
save_aptr(aptr)
AV **aptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*aptr);
SSPUSHPTR(aptr);
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);
}
save_freepv(pv)
char *pv;
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(pv);
SSPUSHINT(SAVEt_FREEPV);
save_clearsv(svp)
SV** svp;
{
+ dTHR;
SSCHECK(2);
SSPUSHLONG((long)(svp-curpad));
SSPUSHINT(SAVEt_CLEARSV);
char *key;
I32 klen;
{
+ dTHR;
SSCHECK(4);
SSPUSHINT(klen);
SSPUSHPTR(key);
register SV **sarg;
I32 maxsarg;
{
+ dTHR;
register SV *sv;
register I32 i;
void (*f) _((void*));
void* p;
{
+ dTHR;
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
leave_scope(base)
I32 base;
{
+ dTHR;
register SV *sv;
register SV *value;
register GV *gv;
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);
#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()
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;
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 */
not_a_number(sv)
SV *sv;
{
+ dTHR;
char tmpbuf[64];
char *d = tmpbuf;
char *s;
SvIVX(sv) = (IV)atol(SvPVX(sv));
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
SvNVX(sv) = atof(SvPVX(sv));
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0.0;
while (*s) s++;
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
*lp = 0;
if (SvROK(sv)) {
#ifdef OVERLOAD
{
+ dTHR;
SV* tmpsv;
if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
return SvTRUE(tmpsv);
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;
SV *dstr;
register SV *sstr;
{
+ dTHR;
register U32 sflags;
register int dtype;
register int stype;
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);
if (!obj || obj == sv || how == '#')
mg->mg_obj = obj;
else {
+ dTHR;
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
assert(SvREFCNT(sv) == 0);
if (SvOBJECT(sv)) {
+ dTHR;
dSP;
GV* destructor;
ENTER;
SAVEFREESV(SvSTASH(sv));
if (destructor && GvCV(destructor)) {
+ dTHR;
SV ref;
Zero(&ref, 1, SV);
static void
sv_mortalgrow()
{
+ dTHR;
tmps_max += 128;
Renew(tmps_stack, tmps_max, SV*);
}
sv_mortalcopy(oldstr)
SV *oldstr;
{
+ dTHR;
register SV *sv;
new_SV();
SV *
sv_newmortal()
{
+ dTHR;
register SV *sv;
new_SV();
sv_2mortal(sv)
register SV *sv;
{
+ dTHR;
if (!sv)
return sv;
if (SvREADONLY(sv) && curcop != &compiling)
newRV(ref)
SV *ref;
{
+ dTHR;
register SV *sv;
new_SV();
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);
SV *rv;
char *classname;
{
+ dTHR;
SV *sv;
new_SV();
SV* sv;
HV* stash;
{
+ dTHR;
SV *ref;
if (!SvROK(sv))
croak("Can't bless non-reference value");
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;
#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 */
--- /dev/null
+#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 */
skipspace(s)
register char *s;
{
+ dTHR;
if (lex_formbrack && lex_brackets <= lex_formbrack) {
while (s < bufend && (*s == ' ' || *s == '\t'))
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 :
int
yylex()
{
+ dTHR;
register char *s;
register char *d;
register I32 tmp;
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);
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;
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')
{
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);
hoistmust(pm)
register PMOP *pm;
{
+ dTHR;
if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
(!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
) {
char *start;
{
register char* s;
- OP *op;
+ OP *o;
short *tbl;
I32 squash;
I32 delete;
}
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') {
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;
}
scan_heredoc(s)
register char *s;
{
+ dTHR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
(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);
scan_str(start)
char *start;
{
+ dTHR;
SV *sv;
char *tmps;
register char *s = start;
scan_formline(s)
register char *s;
{
+ dTHR;
register char *eol;
register char *t;
SV *stuff = newSVpv("",0);
int
start_subparse()
{
+ dTHR;
int oldsavestack_ix = savestack_ix;
CV* outsidecv = compcv;
AV* comppadlist;
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);
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;
}
yywarn(s)
char *s;
{
+ dTHR;
--error_count;
in_eval |= 2;
yyerror(s);
yyerror(s)
char *s;
{
+ dTHR;
char tmpbuf[258];
char *tname = tmpbuf;
va_list *args;
#endif
{
+ dTHR;
char *s;
char *s_start;
SV *tmpstr;
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
HV *stash;
#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;
va_end(args);
if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dTHR;
dSP;
PUSHMARK(sp);
*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 */
projects / p5sagit/p5-mst-13.2.git / commitdiff