summaryrefslogtreecommitdiff
path: root/perl.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2022-12-31 22:02:31 +0000
committerYves Orton <demerphq@gmail.com>2023-02-28 20:53:51 +0800
commit214a9432e04871da2b88eba02ea3f1148a99f9c8 (patch)
tree9f1c36e6171d4e7df22d4c29f4bf480fd67c9747 /perl.c
parente9ba788868247fdfb2a2fbf69079290fb5d11962 (diff)
downloadperl-214a9432e04871da2b88eba02ea3f1148a99f9c8.tar.gz
call_sv, amagic_call: call pp_entersub via runops
These two functions do a slightly odd thing (which has been present since 5.000) when calling out to a CV: they half fake up an OP_ENTERSUB, then call pp_entersub() directly, and only then if it returns a non-null PL_op value, execute the rest of the ops of the sub within a CALLRUNOPS() loop. I can't find any particular reason for this. I guess it might make calling XS subs infinitesimally faster by not have to invoke the runops loop when only a single op is executed (the entersub), but hardly seems worth the effort. Conversely, eliminating this special-case makes the code cleaner, and it will allow the workarounds planned to be added shortly (to the runops loops for reference-counted stacks) to work uniformly. Without this commit, pp_entersub() would get called before runops() has had a chance to fix up the stack if necessary. So this commit *fully* populates the fake OP_ENTERSUB (including type and pp address) then causes pp_entersub to be invoked implicitly from the runops loop rather than explicitly.
Diffstat (limited to 'perl.c')
-rw-r--r--perl.c14
1 files changed, 4 insertions, 10 deletions
diff --git a/perl.c b/perl.c
index c520d2c53d..dc40aa04ad 100644
--- a/perl.c
+++ b/perl.c
@@ -67,12 +67,6 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
# define validate_suid(rsfp) S_validate_suid(aTHX_ rsfp)
#endif
-#define CALL_BODY_SUB(myop) \
- if (PL_op == (myop)) \
- PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); \
- if (PL_op) \
- CALLRUNOPS(aTHX);
-
#define CALL_LIST_BODY(cv) \
PUSHMARK(PL_stack_sp); \
call_sv(MUTABLE_SV((cv)), G_EVAL|G_DISCARD|G_VOID);
@@ -3087,6 +3081,8 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
if (!(flags & G_NOARGS))
myop.op_flags |= OPf_STACKED;
myop.op_flags |= OP_GIMME_REVERSE(flags);
+ myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+ myop.op_type = OP_ENTERSUB;
SAVEOP();
PL_op = (OP*)&myop;
@@ -3119,13 +3115,11 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
method_op.op_type = OP_METHOD;
}
- myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
- myop.op_type = OP_ENTERSUB;
}
if (!(flags & G_EVAL)) {
CATCH_SET(TRUE);
- CALL_BODY_SUB((OP*)&myop);
+ CALLRUNOPS(aTHX);
retval = PL_stack_sp - (PL_stack_base + oldmark);
CATCH_SET(oldcatch);
}
@@ -3142,7 +3136,7 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
switch (ret) {
case 0:
redo_body:
- CALL_BODY_SUB((OP*)&myop);
+ CALLRUNOPS(aTHX);
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR)) {
CLEAR_ERRSV();