Skip to content

Commit

Permalink
[MERGE] make RC-stack-aware: pp_readline() etc
Browse files Browse the repository at this point in the history 
Remove the temporary wrappers from:

    pp_readline()
    pp_rcatline()
    pp_glob()
    pp_rv2gv()
    pp_index()

and dependent functions.

This branch started out as an attempt to unwrap a few simple functions
like pp_index() and pp_rv2gv(). But pp_readline() calls pp_rv2gv(),
so that had to be unwrapped too. Then the bulk of pp_readline()'s
implementation is done by do_readline(), so that had to be updated too.
But pp_rcatline() and pp_glob() also call out to do_readline(), so they
had to be fixed too. And pp_glob() outsources most of its work to the
XS module File::Glob, so calling that had to be wrapped to handle a
non-refcounted stack in the XS code. Then it turns out that code in
IO.xs calls pp_readline() directly and needed tweaking.

So now its a larger branch that touches a lot of stuff.
  • Loading branch information
@iabyn
iabyn committed Dec 6, 2023
2 parents 450676c + 99e4f4b commit 49e6c78
Show file tree
Hide file tree
Showing 6 changed files with 466 additions and 129 deletions.
23 changes: 15 additions & 8 deletions dist/IO/IO.xs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -553,25 +553,32 @@ PPCODE:
if (!ix && GIMME_V != G_LIST)
Perl_croak(aTHX_ "Can't call $io->getlines in a scalar context, use $io->getline");
Zero(&myop, 1, UNOP);
#if PERL_VERSION_GE(5,39,6)
myop.op_flags = (ix ? (OPf_WANT_SCALAR | OPf_STACKED) : OPf_WANT_LIST);
#else
myop.op_flags = (ix ? OPf_WANT_SCALAR : OPf_WANT_LIST ) | OPf_STACKED;
#endif
myop.op_ppaddr = PL_ppaddr[OP_READLINE];
myop.op_type = OP_READLINE;
/* I don't know if we need this, but it's correct as far as the control flow
goes. However, if we *do* need it, do we need to set anything else up? */
myop.op_next = PL_op->op_next;
myop.op_next = NULL; /* return from the runops loop below after 1 op */
/* Sigh, because pp_readline calls pp_rv2gv, and *it* has this wonderful
state check for PL_op->op_type == OP_READLINE */
PL_op = (OP *) &myop;
io = ST(0);
/* Our target (which we need to provide, as we don't have a pad entry.
I think that this is only needed for G_SCALAR - maybe we can get away
with NULL for list context? */
PUSHs(sv_newmortal());
/* For scalar functions (getline/gets), provide a target on the stack,
* as we don't have a pad entry. */
#if PERL_VERSION_GE(5,39,6)
if (ix)
#endif
PUSHs(sv_newmortal());
XPUSHs(io);
PUTBACK;
/* call a new runops loop for just the one op rather than just calling
* pp_readline directly, as the former will handle the call coming
* from a ref-counted stack */
/* And effectively we get away with tail calling pp_readline, as it stacks
exactly the return value(s) we need to return. */
PL_ppaddr[OP_READLINE](aTHX);
CALLRUNOPS(aTHX);
PL_op = was;
/* And we don't want to reach the line
PL_stack_sp = sp;
Expand Down
7 changes: 7 additions & 0 deletions gv.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4195,6 +4195,13 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
res = newSV_type_mortal(SVt_PVAV);
av_extend((AV *)res, nret);
while (nret--)
/* Naughtily, we don't increment the ref counts
* of the items we push onto the temporary array.
* So we rely on the caller knowing not to decrement them,
* and to empty the array before there's any chance of
* it being freed. (Probably should either turn off
* AvREAL or actually increment.)
*/
av_store((AV *)res, nret, POPs);
break;
}
Expand Down
56 changes: 36 additions & 20 deletions pp.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -186,9 +186,10 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
return sv;
}

PP_wrapped(pp_rv2gv, 1, 0)

PP(pp_rv2gv)
{
dSP; dTOPss;
SV *sv = *PL_stack_sp;

sv = S_rv2gv(aTHX_
sv, PL_op->op_private & OPpDEREF,
Expand All @@ -198,10 +199,11 @@ PP_wrapped(pp_rv2gv, 1, 0)
);
if (PL_op->op_private & OPpLVAL_INTRO)
save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
SETs(sv);
RETURN;
rpp_replace_1_1(sv);
return NORMAL;
}


/* Helper function for pp_rv2sv and pp_rv2av/hv.
*
* Return a GV based on the value of sv, using symbolic references etc.
Expand Down Expand Up @@ -3789,9 +3791,11 @@ PP_wrapped(pp_vec, 3, 0)

/* also used for: pp_rindex() */

PP_wrapped(pp_index, MAXARG, 0)
PP(pp_index)
{
dSP; dTARGET;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *big;
SV *little;
SV *temp = NULL;
Expand All @@ -3804,12 +3808,24 @@ PP_wrapped(pp_index, MAXARG, 0)
bool big_utf8;
bool little_utf8;
const bool is_index = PL_op->op_type == OP_INDEX;
const bool threeargs = MAXARG >= 3 && (TOPs || ((void)POPs,0));

if (threeargs)
offset = POPi;
little = POPs;
big = POPs;
assert(MAXARG == 2 || MAXARG == 3);

bool threeargs = (MAXARG == 3);
if (MAXARG == 3 && !PL_stack_sp[0]) {
/* pp_coreargs pushes a NULL in order to flag that &CORE::index()
* was called with two args */
PL_stack_sp--;
threeargs = FALSE;
}

if (threeargs) {
offset = SvIV(*PL_stack_sp);
rpp_popfree_1();
}

little = PL_stack_sp[0];
big = PL_stack_sp[-1];
big_p = SvPV_const(big, biglen);
little_p = SvPV_const(little, llen);

Expand Down Expand Up @@ -3896,20 +3912,20 @@ PP_wrapped(pp_index, MAXARG, 0)
if (PL_op->op_private & OPpTRUEBOOL) {
SV *result = ((retval != -1) ^ cBOOL(PL_op->op_private & OPpINDEX_BOOLNEG))
? &PL_sv_yes : &PL_sv_no;
if (PL_op->op_private & OPpTARGET_MY) {
if (PL_op->op_private & OPpTARGET_MY)
/* $lex = (index() == -1) */
sv_setsv_mg(TARG, result);
PUSHs(TARG);
}
else {
PUSHs(result);
}
sv_setsv_mg(targ, result);
else
targ = result;
}
else
PUSHi(retval);
RETURN;
TARGi(retval, 1);

rpp_replace_2_1(targ);
return NORMAL;
}


PP_wrapped(pp_sprintf, 0, 1)
{
dSP; dMARK; dORIGMARK; dTARGET;
Expand Down
45 changes: 0 additions & 45 deletions pp.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -681,51 +681,6 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>.
/* No longer used in core. Use AMG_CALLunary instead */
#define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg))

#define tryAMAGICunTARGETlist(meth, jump) \
STMT_START { \
dSP; \
SV *tmpsv; \
SV *arg= *sp; \
U8 gimme = GIMME_V; \
if (UNLIKELY(SvAMAGIC(arg) && \
(tmpsv = amagic_call(arg, &PL_sv_undef, meth, \
AMGf_want_list | AMGf_noright \
|AMGf_unary)))) \
{ \
SPAGAIN; \
if (gimme == G_VOID) { \
NOOP; \
} \
else if (gimme == G_LIST) { \
SSize_t i; \
SSize_t len; \
assert(SvTYPE(tmpsv) == SVt_PVAV); \
len = av_count((AV *)tmpsv); \
(void)POPs; /* get rid of the arg */ \
EXTEND(sp, len); \
for (i = 0; i < len; ++i) \
PUSHs(av_shift((AV *)tmpsv)); \
} \
else { /* AMGf_want_scalar */ \
dATARGET; /* just use the arg's location */ \
sv_setsv(TARG, tmpsv); \
if (PL_op->op_flags & OPf_STACKED) \
sp--; \
SETTARG; \
} \
PUTBACK; \
if (jump) { \
OP *jump_o = NORMAL->op_next; \
while (jump_o->op_type == OP_NULL) \
jump_o = jump_o->op_next; \
assert(jump_o->op_type == OP_ENTERSUB); \
(void)POPMARK; \
return jump_o->op_next; \
} \
return NORMAL; \
} \
} STMT_END

/* This is no longer used anywhere in the core. You might wish to consider
calling amagic_deref_call() directly, as it has a cleaner interface. */
#define tryAMAGICunDEREF(meth) \
Expand Down
Loading

0 comments on commit 49e6c78

Please sign in to comment.