PP(pp_wantarray)
{
- dSP;
+ djSP;
I32 cxix;
EXTEND(SP, 1);
}
PP(pp_regcomp) {
- dSP;
+ djSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
register char *t;
SV *tmpstr;
PP(pp_substcont)
{
- dSP;
+ djSP;
register PMOP *pm = (PMOP*) cLOGOP->op_other;
register CONTEXT *cx = &cxstack[cxstack_ix];
register SV *dstr = cx->sb_dstr;
}
void
-rxres_save(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_save(void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
}
void
-rxres_restore(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_restore(void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
}
void
-rxres_free(rsp)
-void **rsp;
+rxres_free(void **rsp)
{
UV *p = (UV*)*rsp;
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV *form = *++MARK;
register U16 *fpc;
register char *t;
PP(pp_grepstart)
{
- dSP;
+ djSP;
SV *src;
if (stack_base + *markstack_ptr == sp) {
PP(pp_mapwhile)
{
- dSP;
+ djSP;
I32 diff = (sp - stack_base) - *markstack_ptr;
I32 count;
I32 shift;
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV **up;
SV **myorigmark = ORIGMARK;
register I32 max;
bool oldcatch = CATCH_GET;
SAVETMPS;
- SAVESPTR(op);
+ SAVEOP();
oldstack = curstack;
if (!sortstack) {
cx->blk_gimme = G_SCALAR;
PUSHSUB(cx);
if (!CvDEPTH(cv))
- SvREFCNT_inc(cv); /* in preparation for POPSUB */
+ (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
sortcxix = cxstack_ix;
PP(pp_flip)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
if (op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
+ SETs(targ);
RETURN;
}
else {
PP(pp_flop)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
/* Control. */
static I32
-dopoptolabel(label)
-char *label;
+dopoptolabel(char *label)
{
dTHR;
register I32 i;
}
I32
-dowantarray()
+dowantarray(void)
{
I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
I32
-block_gimme()
+block_gimme(void)
{
dTHR;
I32 cxix;
return G_VOID;
switch (cxstack[cxix].blk_gimme) {
- case G_VOID:
- return G_VOID;
case G_SCALAR:
return G_SCALAR;
case G_ARRAY:
return G_ARRAY;
default:
croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
+ case G_VOID:
+ return G_VOID;
}
}
static I32
-dopoptosub(startingblock)
-I32 startingblock;
+dopoptosub(I32 startingblock)
{
dTHR;
I32 i;
}
static I32
-dopoptoeval(startingblock)
-I32 startingblock;
+dopoptoeval(I32 startingblock)
{
dTHR;
I32 i;
}
static I32
-dopoptoloop(startingblock)
-I32 startingblock;
+dopoptoloop(I32 startingblock)
{
dTHR;
I32 i;
}
void
-dounwind(cxix)
-I32 cxix;
+dounwind(I32 cxix)
{
dTHR;
register CONTEXT *cx;
}
OP *
-die_where(message)
-char *message;
+die_where(char *message)
{
dTHR;
if (in_eval) {
SV **svp;
STRLEN klen = strlen(message);
- svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+ svp = hv_fetch(errhv, message, klen, TRUE);
if (svp) {
if (!SvIOK(*svp)) {
static char prefix[] = "\t(in cleanup) ";
sv_upgrade(*svp, SVt_IV);
(void)SvIOK_only(*svp);
- SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
- sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
- sv_catpvn(GvSV(errgv), message, klen);
+ SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
+ sv_catpvn(errsv, prefix, sizeof(prefix)-1);
+ sv_catpvn(errsv, message, klen);
}
sv_inc(*svp);
}
}
else
- sv_setpv(GvSV(errgv), message);
+ sv_setpv(errsv, message);
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(GvSV(errgv), na);
+ char* msg = SvPV(errsv, na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_andassign)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else
PP(pp_orassign)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else
RETURNOP(cLOGOP->op_other);
}
-#ifdef DEPRECATED
-PP(pp_entersubr)
-{
- dSP;
- SV** mark = (stack_base + *markstack_ptr + 1);
- SV* cv = *mark;
- while (mark < sp) { /* emulate old interface */
- *mark = mark[1];
- mark++;
- }
- *sp = cv;
- return pp_entersub(ARGS);
-}
-#endif
-
PP(pp_caller)
{
- dSP;
+ djSP;
register I32 cxix = dopoptosub(cxstack_ix);
register CONTEXT *cx;
I32 dbcxix;
}
static int
-sortcv(a, b)
-const void *a;
-const void *b;
+sortcv(const void *a, const void *b)
{
dTHR;
SV * const *str1 = (SV * const *)a;
}
static int
-sortcmp(a, b)
-const void *a;
-const void *b;
+sortcmp(const void *a, const void *b)
{
return sv_cmp(*(SV * const *)a, *(SV * const *)b);
}
static int
-sortcmp_locale(a, b)
-const void *a;
-const void *b;
+sortcmp_locale(const void *a, const void *b)
{
return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
}
-#ifdef USE_THREADS
-static void
-unlock_condpair(svv)
-void *svv;
-{
- dTHR;
- MAGIC *mg = mg_find((SV*)svv, 'm');
-
- if (!mg)
- croak("panic: unlock_condpair unlocking non-mutex");
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) != thr)
- croak("panic: unlock_condpair unlocking mutex that we don't own");
- MgOWNER(mg) = 0;
- COND_SIGNAL(MgOWNERCONDP(mg));
- MUTEX_UNLOCK(MgMUTEXP(mg));
-}
-#endif /* USE_THREADS */
-
PP(pp_reset)
{
- dSP;
-#ifdef USE_THREADS
- dTOPss;
- MAGIC *mg;
-
- if (MAXARG < 1)
- croak("reset requires mutex argument with USE_THREADS");
- if (SvROK(sv)) {
- /*
- * Kludge to allow lock of real objects without requiring
- * to pass in every type of argument by explicit reference.
- */
- sv = SvRV(sv);
- }
- mg = condpair_magic(sv);
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) == thr)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- MUTEX_UNLOCK(MgMUTEXP(mg));
- save_destructor(unlock_condpair, sv);
- }
- RETURN;
-#else
+ djSP;
char *tmps;
if (MAXARG < 1)
sv_reset(tmps, curcop->cop_stash);
PUSHs(&sv_yes);
RETURN;
-#endif /* USE_THREADS */
}
PP(pp_lineseq)
PP(pp_enteriter)
{
- dSP; dMARK;
+ djSP; dMARK;
register CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
PP(pp_enterloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leaveloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
struct block_loop cxloop;
I32 gimme;
PP(pp_return)
{
- dSP; dMARK;
+ djSP; dMARK;
I32 cxix;
register CONTEXT *cx;
struct block_sub cxsub;
PP(pp_last)
{
- dSP;
+ djSP;
I32 cxix;
register CONTEXT *cx;
struct block_loop cxloop;
static OP* lastgotoprobe;
static OP *
-dofindlabel(o,label,opstack,oplimit)
-OP *o;
-char *label;
-OP **opstack;
-OP **oplimit;
+dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
{
OP *kid;
OP **ops = opstack;
PP(pp_goto)
{
- dSP;
+ djSP;
OP *retop = 0;
I32 ix;
register CONTEXT *cx;
EXTEND(stack_sp, items); /* @_ could have been extended. */
Copy(AvARRAY(av), stack_sp, items, SV*);
stack_sp += items;
+#ifndef USE_THREADS
SvREFCNT_dec(GvAV(defgv));
GvAV(defgv) = cx->blk_sub.savearray;
+#endif /* USE_THREADS */
AvREAL_off(av);
av_clear(av);
}
svp = AvARRAY(padlist);
}
}
+#ifdef USE_THREADS
+ if (!cx->blk_sub.hasargs) {
+ AV* av = (AV*)curpad[0];
+
+ items = AvFILL(av) + 1;
+ if (items) {
+ /* Mark is at the end of the stack. */
+ EXTEND(sp, items);
+ Copy(AvARRAY(av), sp + 1, items, SV*);
+ sp += items;
+ PUTBACK ;
+ }
+ }
+#endif /* USE_THREADS */
SAVESPTR(curpad);
curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
- if (cx->blk_sub.hasargs) {
+#ifndef USE_THREADS
+ if (cx->blk_sub.hasargs)
+#endif /* USE_THREADS */
+ {
AV* av = (AV*)curpad[0];
SV** ary;
+#ifndef USE_THREADS
cx->blk_sub.savearray = GvAV(defgv);
- cx->blk_sub.argarray = av;
GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+ cx->blk_sub.argarray = av;
++mark;
if (items >= AvMAX(av) + 1) {
mark++;
}
}
- if (perldb && curstash != debstash) {
+ if (PERLDB_SUB && curstash != debstash) {
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
OP *oldop = op;
for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
+ /* Eventually we may want to stack the needed arguments
+ * for each op. For now, we punt on the hard ones. */
+ if (op->op_type == OP_ENTERITER)
+ DIE("Can't \"goto\" into the middle of a foreach loop",
+ label);
(*op->op_ppaddr)(ARGS);
}
op = oldop;
PP(pp_exit)
{
- dSP;
+ djSP;
I32 anum;
if (MAXARG < 1)
#ifdef NOTYET
PP(pp_nswitch)
{
- dSP;
+ djSP;
double value = SvNVx(GvSV(cCOP->cop_gv));
register I32 match = I_32(value);
PP(pp_cswitch)
{
- dSP;
+ djSP;
register I32 match;
if (multiline)
/* Eval. */
static void
-save_lines(array, sv)
-AV *array;
-SV *sv;
+save_lines(AV *array, SV *sv)
{
register char *s = SvPVX(sv);
register char *send = SvPVX(sv) + SvCUR(sv);
}
static OP *
-docatch(o)
-OP *o;
+docatch(OP *o)
{
dTHR;
int ret;
return Nullop;
}
+/* With USE_THREADS, eval_owner must be held on entry to doeval */
static OP *
-doeval(gimme)
-int gimme;
+doeval(int gimme)
{
- dTHR;
dSP;
OP *saveop = op;
HV *newstash;
CV *caller;
AV* comppadlist;
-#ifdef USE_THREADS
- 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);
-#endif /* USE_THREADS */
in_eval = 1;
PUSHMARK(SP);
CvUNIQUE_on(compcv);
#ifdef USE_THREADS
CvOWNER(compcv) = 0;
- New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+ New(666, CvMUTEXP(compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(compcv));
- New(666, CvCONDP(compcv), 1, pthread_cond_t);
- COND_INIT(CvCONDP(compcv));
#endif /* USE_THREADS */
comppad = newAV();
+ av_push(comppad, Nullsv);
+ curpad = AvARRAY(comppad);
comppad_name = newAV();
comppad_name_fill = 0;
+ min_intro_pending = 0;
+ padix = 0;
#ifdef USE_THREADS
av_store(comppad_name, 0, newSVpv("@_", 2));
+ curpad[0] = (SV*)newAV();
+ SvPADMY_on(curpad[0]); /* XXX Needed? */
#endif /* USE_THREADS */
- min_intro_pending = 0;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
- padix = 0;
comppadlist = newAV();
AvREAL_off(comppadlist);
if (saveop->op_flags & OPf_SPECIAL)
in_eval |= 4;
else
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(GvSV(errgv), na);
+ char* msg = SvPV(errsv, na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ eval_owner = 0;
+ COND_SIGNAL(&eval_cond);
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
RETPUSHUNDEF;
}
SvREFCNT_dec(rs);
DEBUG_x(dump_eval());
/* Register with debugger: */
- if (perldb && saveop->op_type == OP_REQUIRE) {
+ if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
CV *cv = perl_get_cv("DB::postponed", FALSE);
if (cv) {
dSP;
CvDEPTH(compcv) = 1;
SP = stack_base + POPMARK; /* pop original mark */
+ op = saveop; /* The caller may need it. */
#ifdef USE_THREADS
MUTEX_LOCK(&eval_mutex);
eval_owner = 0;
PP(pp_require)
{
- dSP;
+ djSP;
register CONTEXT *cx;
SV *sv;
char *name;
#ifdef DOSISH
|| (name[0] && name[1] == ':')
#endif
+#ifdef WIN32
+ || (name[0] == '\\' && name[1] == '\\') /* UNC path */
+#endif
#ifdef VMS
|| (strchr(name,':') || ((*name == '[' || *name == '<') &&
(isALNUM(name[1]) || strchr("$-_]>",name[1]))))
if (!tryrsfp) {
if (op->op_type == OP_REQUIRE) {
SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
+ SV *dirmsgsv = NEWSV(0, 0);
+ AV *ar = GvAVn(incgv);
+ I32 i;
if (instr(SvPVX(msg), ".h "))
sv_catpv(msg, " (change .h to .ph maybe?)");
if (instr(SvPVX(msg), ".ph "))
sv_catpv(msg, " (did you run h2ph?)");
+ sv_catpv(msg, " (@INC contains:");
+ for (i = 0; i <= AvFILL(ar); i++) {
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+ sv_setpvf(dirmsgsv, " %s", dir);
+ sv_catsv(msg, dirmsgsv);
+ }
+ sv_catpvn(msg, ")", 1);
+ SvREFCNT_dec(dirmsgsv);
DIE("%_", msg);
}
compiling.cop_line = 0;
PUTBACK;
+#ifdef USE_THREADS
+ 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);
+#endif /* USE_THREADS */
return DOCATCH(doeval(G_SCALAR));
}
PP(pp_entereval)
{
- dSP;
+ djSP;
register CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = sub_generation;
/* prepare to compile string */
- if (perldb && curstash != debstash)
+ if (PERLDB_LINE && curstash != debstash)
save_lines(GvAV(compiling.cop_filegv), linestr);
PUTBACK;
+#ifdef USE_THREADS
+ 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);
+#endif /* USE_THREADS */
ret = doeval(gimme);
- if (perldb && was != sub_generation) { /* Some subs defined here. */
+ if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */
+ && ret != op->op_next) { /* Successive compilation. */
strcpy(safestr, "_<(eval )"); /* Anything fake and short. */
}
return DOCATCH(ret);
PP(pp_leaveeval)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
}
curpm = newpm; /* Don't pop $1 et al till now */
+ /*
+ * Closures mentioned at top level of eval cannot be referenced
+ * again, and their presence indirectly causes a memory leak.
+ * (Note that the fact that compcv and friends are still set here
+ * is, AFAIK, an accident.) --Chip
+ */
+ if (AvFILL(comppad_name) >= 0) {
+ SV **svp = AvARRAY(comppad_name);
+ I32 ix;
+ for (ix = AvFILL(comppad_name); ix >= 0; ix--) {
+ SV *sv = svp[ix];
+ if (sv && sv != &sv_undef && *SvPVX(sv) == '&') {
+ SvREFCNT_dec(sv);
+ svp[ix] = &sv_undef;
+
+ sv = curpad[ix];
+ if (CvCLONE(sv)) {
+ SvREFCNT_dec(CvOUTSIDE(sv));
+ CvOUTSIDE(sv) = Nullcv;
+ }
+ else {
+ SvREFCNT_dec(sv);
+ sv = NEWSV(0,0);
+ SvPADTMP_on(sv);
+ curpad[ix] = sv;
+ }
+ }
+ }
+ }
+
#ifdef DEBUGGING
assert(CvDEPTH(compcv) == 1);
#endif
LEAVE;
if (!(save_flags & OPf_SPECIAL))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
RETURNOP(retop);
}
PP(pp_entertry)
{
- dSP;
+ djSP;
register CONTEXT *cx;
I32 gimme = GIMME_V;
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
PUTBACK;
return DOCATCH(op->op_next);
}
PP(pp_leavetry)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
RETURN;
}
static void
-doparseform(sv)
-SV *sv;
+doparseform(SV *sv)
{
STRLEN len;
register char *s = SvPV_force(sv, len);
sv_magic(sv, Nullsv, 'f', Nullch, 0);
SvCOMPILED_on(sv);
}
+
https://perl5.git.perl.org / perl5.git / blobdiff