SvREFCNT_dec(sv);
break;
}
- XPUSHs(sv_2mortal(sv));
+ mXPUSHs(sv);
if (SvLEN(sv) - SvCUR(sv) > 20) {
SvPV_shrink_to_cur(sv);
}
PL_last_in_gv = (GV*)*PL_stack_sp--;
SAVESPTR(PL_rs); /* This is not permanent, either. */
- PL_rs = sv_2mortal(newSVpvs("\000"));
+ PL_rs = newSVpvs_flags("\000", SVs_TEMP);
#ifndef DOSISH
#ifndef CSH
*SvPVX(PL_rs) = '\n';
tmps = SvPV_const(tmpsv, len);
}
if (!tmps || !len)
- tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
+ tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
RETSETYES;
}
}
if (!tmps || !len)
- tmpsv = sv_2mortal(newSVpvs("Died"));
+ tmpsv = newSVpvs_flags("Died", SVs_TEMP);
DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
}
PUTBACK;
{
- const int mode = mode_from_discipline(discp);
- const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+ STRLEN len = 0;
+ const char *d = NULL;
+ int mode;
+ if (discp)
+ d = SvPV_const(discp, len);
+ mode = mode_from_discipline(d, len);
if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
break;
}
items = SP - MARK++;
- if (sv_isobject(*MARK)) {
+ if (sv_isobject(*MARK)) { /* Calls GET magic. */
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
/* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
- stash = gv_stashsv(*MARK, 0);
+ STRLEN len;
+ const char *name = SvPV_nomg_const(*MARK, len);
+ stash = gv_stashpvn(name, len, 0);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
- methname, SVfARG(*MARK));
+ methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
if (gv && isGV(gv) && (cv = GvCV(gv))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
- XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+ mXPUSHi(SvREFCNT(obj) - 1);
PUTBACK;
ENTER;
call_sv((SV *)cv, G_VOID);
GV *gv;
HV * const hv = (HV*)POPs;
- SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
+ SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
stash = gv_stashsv(sv, 0);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
SPAGAIN;
- if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+ if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
DIE(aTHX_ "No dbm on this machine");
}
PUSHs(sv);
PUSHs(left);
if (SvIV(right))
- PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT)));
+ mPUSHu(O_RDWR|O_CREAT);
else
- PUSHs(sv_2mortal(newSVuv(O_RDWR)));
+ mPUSHu(O_RDWR);
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
PUSHMARK(SP);
PUSHs(sv);
PUSHs(left);
- PUSHs(sv_2mortal(newSVuv(O_RDONLY)));
+ mPUSHu(O_RDONLY);
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
if (GIMME == G_ARRAY && tbuf) {
value = (NV)(timebuf.tv_sec) +
(NV)(timebuf.tv_usec) / 1000000.0;
- PUSHs(sv_2mortal(newSVnv(value)));
+ mPUSHn(value);
}
RETURN;
#else
XPUSHTARG;
}
else {
- XPUSHs(sv_2mortal(newRV((SV*)egv)));
+ mXPUSHs(newRV((SV*)egv));
}
}
register PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
+ PERL_ARGS_ASSERT_DOFORM;
+
ENTER;
SAVETMPS;
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
- PUSHFORMAT(cx);
- cx->blk_sub.retop = retop;
+ PUSHFORMAT(cx, retop);
SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
PP(pp_leavewrite)
{
dVAR; dSP;
- GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
+ GV * const gv = cxstack[cxstack_ix].blk_format.gv;
register IO * const io = GvIOp(gv);
PerlIO *ofp;
PerlIO *fp;
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
- sv_setpvn(GvSV(gv), "-", 1);
+ if ( GvSV(gv) ) {
+ sv_setpvn(GvSV(gv), "-", 1);
+ }
+ else {
+ GvSV(gv) = newSVpvn("-", 1);
+ }
SvSETMAGIC(GvSV(gv));
}
else if (!nextargv(gv))
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)io, mg));
#if LSEEKSIZE > IVSIZE
- XPUSHs(sv_2mortal(newSVnv((NV) offset)));
+ mXPUSHn((NV) offset);
#else
- XPUSHs(sv_2mortal(newSViv(offset)));
+ mXPUSHi(offset);
#endif
- XPUSHs(sv_2mortal(newSViv(whence)));
+ mXPUSHi(whence);
PUTBACK;
ENTER;
call_method("SEEK", G_SCALAR);
newSViv(sought)
#endif
: newSVpvn(zero_but_true, ZBTLEN);
- PUSHs(sv_2mortal(sv));
+ mPUSHs(sv);
}
}
RETURN;
if (max) {
EXTEND(SP, max);
EXTEND_MORTAL(max);
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode)));
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink)));
+ mPUSHi(PL_statcache.st_dev);
+ mPUSHi(PL_statcache.st_ino);
+ mPUSHu(PL_statcache.st_mode);
+ mPUSHu(PL_statcache.st_nlink);
#if Uid_t_size > IVSIZE
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
+ mPUSHn(PL_statcache.st_uid);
#else
# if Uid_t_sign <= 0
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+ mPUSHi(PL_statcache.st_uid);
# else
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
+ mPUSHu(PL_statcache.st_uid);
# endif
#endif
#if Gid_t_size > IVSIZE
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
+ mPUSHn(PL_statcache.st_gid);
#else
# if Gid_t_sign <= 0
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+ mPUSHi(PL_statcache.st_gid);
# else
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid)));
+ mPUSHu(PL_statcache.st_gid);
# endif
#endif
#ifdef USE_STAT_RDEV
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
+ mPUSHi(PL_statcache.st_rdev);
#else
- PUSHs(sv_2mortal(newSVpvs("")));
+ PUSHs(newSVpvs_flags("", SVs_TEMP));
#endif
#if Off_t_size > IVSIZE
- PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
+ mPUSHn(PL_statcache.st_size);
#else
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
+ mPUSHi(PL_statcache.st_size);
#endif
#ifdef BIG_TIME
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
+ mPUSHn(PL_statcache.st_atime);
+ mPUSHn(PL_statcache.st_mtime);
+ mPUSHn(PL_statcache.st_ctime);
#else
- PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_atime)));
- PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_mtime)));
- PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_ctime)));
+ mPUSHi(PL_statcache.st_atime);
+ mPUSHi(PL_statcache.st_mtime);
+ mPUSHi(PL_statcache.st_ctime);
#endif
#ifdef USE_STAT_BLOCKS
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
- PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
+ mPUSHu(PL_statcache.st_blksize);
+ mPUSHu(PL_statcache.st_blocks);
#else
- PUSHs(sv_2mortal(newSVpvs("")));
- PUSHs(sv_2mortal(newSVpvs("")));
+ PUSHs(newSVpvs_flags("", SVs_TEMP));
+ PUSHs(newSVpvs_flags("", SVs_TEMP));
#endif
}
RETURN;
effective = TRUE;
break;
-
case OP_FTEEXEC:
#ifdef PERL_EFF_ACCESS
- access_mode = W_OK;
+ access_mode = X_OK;
#else
use_access = 0;
#endif
int anum = 1;
Size_t size = strlen(cmd) + (strlen(filename) * 2) + 10;
+ PERL_ARGS_ASSERT_DOONELINER;
+
Newx(cmdline, size, char);
my_strlcpy(cmdline, cmd, size);
my_strlcat(cmdline, " ", size);
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
#endif
- XPUSHs(sv_2mortal(sv));
+ mXPUSHs(sv);
} while (gimme == G_ARRAY);
if (!dp && gimme != G_ARRAY)
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV * const really = *++MARK;
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
value = (I32)do_aspawn(NULL, MARK, SP);
# else
value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
/* is returned. */
#endif
- PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick)));
+ mPUSHn(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick);
if (GIMME == G_ARRAY) {
- PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick)));
- PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick)));
- PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick)));
+ mPUSHn(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick);
+ mPUSHn(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick);
+ mPUSHn(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick);
}
RETURN;
#else
# ifdef PERL_MICRO
dSP;
- PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ mPUSHn(0.0);
EXTEND(SP, 4);
if (GIMME == G_ARRAY) {
- PUSHs(sv_2mortal(newSVnv((NV)0.0)));
- PUSHs(sv_2mortal(newSVnv((NV)0.0)));
- PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+ mPUSHn(0.0);
+ mPUSHn(0.0);
+ mPUSHn(0.0);
}
RETURN;
# else
tmbuf->tm_min,
tmbuf->tm_sec,
tmbuf->tm_year + 1900);
- PUSHs(sv_2mortal(tsv));
+ mPUSHs(tsv);
}
else if (tmbuf) {
EXTEND(SP, 9);
EXTEND_MORTAL(9);
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_year)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday)));
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst)));
+ mPUSHi(tmbuf->tm_sec);
+ mPUSHi(tmbuf->tm_min);
+ mPUSHi(tmbuf->tm_hour);
+ mPUSHi(tmbuf->tm_mday);
+ mPUSHi(tmbuf->tm_mon);
+ mPUSHi(tmbuf->tm_year);
+ mPUSHi(tmbuf->tm_wday);
+ mPUSHi(tmbuf->tm_yday);
+ mPUSHi(tmbuf->tm_isdst);
}
RETURN;
}
{
SV *target;
+ PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
+
if (array && *array) {
- target = sv_2mortal(newSVpvs(""));
+ target = newSVpvs_flags("", SVs_TEMP);
while (1) {
sv_catpv(target, *array);
if (!*++array)
}
if (hent) {
- PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
+ mPUSHs(newSVpv((char*)hent->h_name, 0));
PUSHs(space_join_names_mortal(hent->h_aliases));
- PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
+ mPUSHi(hent->h_addrtype);
len = hent->h_length;
- PUSHs(sv_2mortal(newSViv((IV)len)));
+ mPUSHi(len);
#ifdef h_addr
for (elem = hent->h_addr_list; elem && *elem; elem++) {
- XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
+ mXPUSHp(*elem, len);
}
#else
if (hent->h_addr)
- PUSHs(newSVpvn(hent->h_addr, len));
+ mPUSHp(hent->h_addr, len);
else
PUSHs(sv_mortalcopy(&PL_sv_no));
#endif /* h_addr */
}
if (nent) {
- PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
+ mPUSHs(newSVpv(nent->n_name, 0));
PUSHs(space_join_names_mortal(nent->n_aliases));
- PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
- PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
+ mPUSHi(nent->n_addrtype);
+ mPUSHi(nent->n_net);
}
RETURN;
}
if (pent) {
- PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
+ mPUSHs(newSVpv(pent->p_name, 0));
PUSHs(space_join_names_mortal(pent->p_aliases));
- PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
+ mPUSHi(pent->p_proto);
}
RETURN;
}
if (sent) {
- PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
+ mPUSHs(newSVpv(sent->s_name, 0));
PUSHs(space_join_names_mortal(sent->s_aliases));
#ifdef HAS_NTOHS
- PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
+ mPUSHi(PerlSock_ntohs(sent->s_port));
#else
- PUSHs(sv_2mortal(newSViv((IV)(sent->s_port))));
+ mPUSHi(sent->s_port);
#endif
- PUSHs(sv_2mortal(newSVpv(sent->s_proto, 0)));
+ mPUSHs(newSVpv(sent->s_proto, 0));
}
RETURN;
{
#ifdef HAS_SETNETENT
dVAR; dSP;
- PerlSock_setnetent(TOPi);
+ (void)PerlSock_setnetent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setnetent");
{
#ifdef HAS_SETPROTOENT
dVAR; dSP;
- PerlSock_setprotoent(TOPi);
+ (void)PerlSock_setprotoent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setprotoent");
{
#ifdef HAS_SETSERVENT
dVAR; dSP;
- PerlSock_setservent(TOPi);
+ (void)PerlSock_setservent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setservent");
}
if (pwent) {
- PUSHs(sv_2mortal(newSVpv(pwent->pw_name, 0)));
+ mPUSHs(newSVpv(pwent->pw_name, 0));
- PUSHs(sv = sv_2mortal(newSViv(0)));
+ sv = newSViv(0);
+ mPUSHs(sv);
/* If we have getspnam(), we try to dig up the shadow
* password. If we are underprivileged, the shadow
* interface will set the errno to EACCES or similar,
# endif
# if Uid_t_sign <= 0
- PUSHs(sv_2mortal(newSViv((IV)pwent->pw_uid)));
+ mPUSHi(pwent->pw_uid);
# else
- PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_uid)));
+ mPUSHu(pwent->pw_uid);
# endif
# if Uid_t_sign <= 0
- PUSHs(sv_2mortal(newSViv((IV)pwent->pw_gid)));
+ mPUSHi(pwent->pw_gid);
# else
- PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_gid)));
+ mPUSHu(pwent->pw_gid);
# endif
/* pw_change, pw_quota, and pw_age are mutually exclusive--
* because of the poor interface of the Perl getpw*(),
* A better interface would have been to return a hash,
* but we are accursed by our history, alas. --jhi. */
# ifdef PWCHANGE
- PUSHs(sv_2mortal(newSViv((IV)pwent->pw_change)));
+ mPUSHi(pwent->pw_change);
# else
# ifdef PWQUOTA
- PUSHs(sv_2mortal(newSViv((IV)pwent->pw_quota)));
+ mPUSHi(pwent->pw_quota);
# else
# ifdef PWAGE
- PUSHs(sv_2mortal(newSVpv(pwent->pw_age, 0)));
+ mPUSHs(newSVpv(pwent->pw_age, 0));
# else
/* I think that you can never get this compiled, but just in case. */
PUSHs(sv_mortalcopy(&PL_sv_no));
/* pw_class and pw_comment are mutually exclusive--.
* see the above note for pw_change, pw_quota, and pw_age. */
# ifdef PWCLASS
- PUSHs(sv_2mortal(newSVpv(pwent->pw_class, 0)));
+ mPUSHs(newSVpv(pwent->pw_class, 0));
# else
# ifdef PWCOMMENT
- PUSHs(sv_2mortal(newSVpv(pwent->pw_comment, 0)));
+ mPUSHs(newSVpv(pwent->pw_comment, 0));
# else
/* I think that you can never get this compiled, but just in case. */
PUSHs(sv_mortalcopy(&PL_sv_no));
SvTAINTED_on(sv);
# endif
- PUSHs(sv_2mortal(newSVpv(pwent->pw_dir, 0)));
+ mPUSHs(newSVpv(pwent->pw_dir, 0));
PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
# ifndef INCOMPLETE_TAINTS
# endif
# ifdef PWEXPIRE
- PUSHs(sv_2mortal(newSViv((IV)pwent->pw_expire)));
+ mPUSHi(pwent->pw_expire);
# endif
}
RETURN;
}
if (grent) {
- PUSHs(sv_2mortal(newSVpv(grent->gr_name, 0)));
+ mPUSHs(newSVpv(grent->gr_name, 0));
#ifdef GRPASSWD
- PUSHs(sv_2mortal(newSVpv(grent->gr_passwd, 0)));
+ mPUSHs(newSVpv(grent->gr_passwd, 0));
#else
PUSHs(sv_mortalcopy(&PL_sv_no));
#endif
- PUSHs(sv_2mortal(newSViv((IV)grent->gr_gid)));
+ mPUSHi(grent->gr_gid);
#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
/* In UNICOS/mk (_CRAYMPP) the multithreading
https://perl5.git.perl.org / perl5.git / blobdiff