RETURN;
}
+/* These are private to this function, which is private to this file.
+ Use 0x04 rather than the next available bit, to help the compiler if the
+ architecture can generate more efficient instructions. */
+#define MORTALIZE_NOT_NEEDED 0x04
+#define TIED_HANDLE_ARGC_SHIFT 3
+
static OP *
S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
- IO *const io, MAGIC *const mg, const U32 gimme,
- unsigned int argc, ...)
+ IO *const io, MAGIC *const mg, const U32 flags, ...)
{
+ U32 argc = flags >> TIED_HANDLE_ARGC_SHIFT;
+
PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
+ /* Ensure that our flag bits do not overlap. */
+ assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ assert((G_WANT >> TIED_HANDLE_ARGC_SHIFT) == 0);
+
PUSHMARK(sp);
PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
if (argc) {
+ const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
va_list args;
- va_start(args, argc);
+ va_start(args, flags);
do {
SV *const arg = va_arg(args, SV *);
- PUSHs(arg);
+ if(mortalize_not_needed)
+ PUSHs(arg);
+ else
+ mPUSHs(arg);
} while (--argc);
va_end(args);
}
PUTBACK;
ENTER_with_name("call_tied_handle_method");
- call_method(methname, gimme);
+ call_method(methname, flags & G_WANT);
LEAVE_with_name("call_tied_handle_method");
return NORMAL;
}
#define tied_handle_method(a,b,c,d) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,0)
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR)
#define tied_handle_method1(a,b,c,d,e) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,1,e)
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (1 << TIED_HANDLE_ARGC_SHIFT),e)
#define tied_handle_method2(a,b,c,d,e,f) \
- S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f)
+ S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f)
PP(pp_close)
{
function, which I don't think that the optimiser will be able to
figure out. Although, as it's a static function, in theory it
could. */
- return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg, G_SCALAR,
- discp ? 1 : 0, discp);
+ return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
+ G_SCALAR|MORTALIZE_NOT_NEEDED
+ | (discp
+ ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
+ discp);
}
}
call_method(methname, G_SCALAR);
}
else {
- /* Not clear why we don't call call_method here too.
- * perhaps to get different error message ?
+ /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO"
+ * will attempt to invoke IO::File::TIEARRAY, with (best case) the
+ * wrong error message, and worse case, supreme action at a distance.
+ * (Sorry obfuscation writers. You're not going to be given this one.)
*/
STRLEN len;
const char *name = SvPV_nomg_const(*MARK, len);
MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
const U32 gimme = GIMME_V;
- S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme, 0);
+ S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme);
if (gimme == G_SCALAR) {
SPAGAIN;
SvSetMagicSV_nosteal(TARG, TOPs);
RETPUSHNO;
if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
- return tied_handle_method1("EOF", SP, io, mg,
- sv_2mortal(newSVuv(which)));
+ return tied_handle_method1("EOF", SP, io, mg, newSVuv(which));
}
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
#if LSEEKSIZE > IVSIZE
- SV *const offset_sv = sv_2mortal(newSVnv((NV) offset));
+ SV *const offset_sv = newSVnv((NV) offset);
#else
- SV *const offset_sv = sv_2mortal(newSViv(offset));
+ SV *const offset_sv = newSViv(offset);
#endif
return tied_handle_method2("SEEK", SP, io, mg, offset_sv,
- sv_2mortal(newSViv(whence)));
+ newSViv(whence));
}
}