#ifdef HAS_PIPE
dVAR;
dSP;
- register IO *rstio;
- register IO *wstio;
+ IO *rstio;
+ IO *wstio;
int fd[2];
GV * const wgv = MUTABLE_GV(POPs);
{
#ifdef HAS_SELECT
dVAR; dSP; dTARGET;
- register I32 i;
- register I32 j;
- register char *s;
- register SV *sv;
+ I32 i;
+ I32 j;
+ char *s;
+ SV *sv;
NV value;
I32 maxlen = 0;
I32 nfound;
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
dVAR;
- register PERL_CONTEXT *cx;
+ PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PERL_ARGS_ASSERT_DOFORM;
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx, retop);
+ if (CvDEPTH(cv) >= 2) {
+ PERL_STACK_OVERFLOW_CHECK();
+ pad_push(CvPADLIST(cv), CvDEPTH(cv));
+ }
SAVECOMPPAD();
- PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+ PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
setdefout(gv); /* locally select filehandle so $% et al work */
return CvSTART(cv);
{
dVAR;
dSP;
- register GV *gv;
- register IO *io;
+ GV *gv;
+ IO *io;
GV *fgv;
CV *cv = NULL;
SV *tmpsv = NULL;
{
dVAR; dSP;
GV * const gv = cxstack[cxstack_ix].blk_format.gv;
- register IO * const io = GvIOp(gv);
+ IO * const io = GvIOp(gv);
PerlIO *ofp;
PerlIO *fp;
SV **newsp;
I32 gimme;
- register PERL_CONTEXT *cx;
+ PERL_CONTEXT *cx;
OP *retop;
if (!io || !(ofp = IoOFP(io)))
SP = newsp; /* ignore retval of formline */
LEAVE;
- fp = IoOFP(io);
- if (!fp) {
- if (IoIFP(io))
+ if (!io || !(fp = IoOFP(io))) {
+ if (io && IoIFP(io))
report_wrongway_fh(gv, '<');
else
report_evil_fh(gv);
PUSHs(&PL_sv_yes);
}
}
- /* bad_ofp: */
PL_formtarget = PL_bodytarget;
PERL_UNUSED_VAR(gimme);
RETURNOP(retop);
const int type = POPi;
const int domain = POPi;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = gv ? GvIOn(gv) : NULL;
int fd;
if (!io) {
const int domain = POPi;
GV * const gv2 = MUTABLE_GV(POPs);
GV * const gv1 = MUTABLE_GV(POPs);
- register IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
- register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
+ IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
+ IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
int fd[2];
if (!io1)
/* OK, so on what platform does bind modify addr? */
const char *addr;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
STRLEN len;
const int op_type = PL_op->op_type;
dVAR; dSP;
const int backlog = POPi;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = gv ? GvIOn(gv) : NULL;
if (!io || !IoIFP(io))
goto nuts;
PP(pp_accept)
{
dVAR; dSP; dTARGET;
- register IO *nstio;
- register IO *gstio;
+ IO *nstio;
+ IO *gstio;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
Sock_size_t len = sizeof (struct sockaddr_in);
dVAR; dSP; dTARGET;
const int how = POPi;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io || !IoIFP(io))
goto nuts;
const unsigned int optname = (unsigned int) POPi;
const unsigned int lvl = (unsigned int) POPi;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
int fd;
Sock_size_t len;
dVAR; dSP;
const int optype = PL_op->op_type;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
Sock_size_t len;
SV *sv;
int fd;
RETURN;
}
+/* All filetest ops avoid manipulating the perl stack pointer in their main
+ bodies (since commit d2c4d2d1e22d3125), and return using either
+ S_ft_return_false() or S_ft_return_true(). These two helper functions are
+ the only two which manipulate the perl stack. To ensure that no stack
+ manipulation macros are used, the filetest ops avoid defining a local copy
+ of the stack pointer with dSP. */
+
/* If the next filetest is stacked up with this one
(PL_op->op_private & OPpFT_STACKING), we leave
the original argument on the stack for success,
*/
static OP *
-S_ft_stacking_return_false(pTHX_ SV *ret) {
- dSP;
+S_ft_return_false(pTHX_ SV *ret) {
OP *next = NORMAL;
- while (OP_IS_FILETEST(next->op_type)
- && next->op_private & OPpFT_STACKED)
- next = next->op_next;
+ dSP;
+
if (PL_op->op_flags & OPf_REF) XPUSHs(ret);
else SETs(ret);
PUTBACK;
+
+ if (PL_op->op_private & OPpFT_STACKING) {
+ while (OP_IS_FILETEST(next->op_type)
+ && next->op_private & OPpFT_STACKED)
+ next = next->op_next;
+ }
return next;
}
-#define FT_RETURN_FALSE(X) \
- STMT_START { \
- if (PL_op->op_private & OPpFT_STACKING) \
- return S_ft_stacking_return_false(aTHX_ X); \
- PL_op->op_flags & OPf_REF ? XPUSHs(X) : SETs(X); \
- PUTBACK; \
- return NORMAL; \
- } STMT_END
-#define FT_RETURN_TRUE(X) \
- STMT_START { \
- (void)( \
- PL_op->op_flags & OPf_REF \
- ? (bool)XPUSHs( \
- PL_op->op_private & OPpFT_STACKING ? (SV *)cGVOP_gv : (X) \
- ) \
- : (PL_op->op_private & OPpFT_STACKING || SETs(X)) \
- ); \
- PUTBACK; \
- return NORMAL; \
- } STMT_END
+PERL_STATIC_INLINE OP *
+S_ft_return_true(pTHX_ SV *ret) {
+ dSP;
+ if (PL_op->op_flags & OPf_REF)
+ XPUSHs(PL_op->op_private & OPpFT_STACKING ? (SV *)cGVOP_gv : (ret));
+ else if (!(PL_op->op_private & OPpFT_STACKING))
+ SETs(ret);
+ PUTBACK;
+ return NORMAL;
+}
-#define FT_RETURNNO FT_RETURN_FALSE(&PL_sv_no)
-#define FT_RETURNUNDEF FT_RETURN_FALSE(&PL_sv_undef)
-#define FT_RETURNYES FT_RETURN_TRUE(&PL_sv_yes)
+#define FT_RETURNNO return S_ft_return_false(aTHX_ &PL_sv_no)
+#define FT_RETURNUNDEF return S_ft_return_false(aTHX_ &PL_sv_undef)
+#define FT_RETURNYES return S_ft_return_true(aTHX_ &PL_sv_yes)
#define tryAMAGICftest_MG(chr) STMT_START { \
- if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
+ if ( (SvFLAGS(*PL_stack_sp) & (SVf_ROK|SVs_GMG)) \
&& PL_op->op_flags & OPf_KIDS) { \
OP *next = S_try_amagic_ftest(aTHX_ chr); \
if (next) return next; \
STATIC OP *
S_try_amagic_ftest(pTHX_ char chr) {
dVAR;
- dSP;
- SV* const arg = TOPs;
+ SV *const arg = *PL_stack_sp;
assert(chr != '?');
if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
- if (SvAMAGIC(TOPs))
+ if (SvAMAGIC(arg))
{
const char tmpchr = chr;
SV * const tmpsv = amagic_call(arg,
if (!tmpsv)
return NULL;
- if (SvTRUE(tmpsv)) FT_RETURN_TRUE(tmpsv);
- FT_RETURN_FALSE(tmpsv);
+ return SvTRUE(tmpsv)
+ ? S_ft_return_true(aTHX_ tmpsv) : S_ft_return_false(aTHX_ tmpsv);
}
return NULL;
}
bool effective = FALSE;
char opchar = '?';
- dSP;
switch (PL_op->op_type) {
case OP_FTRREAD: opchar = 'R'; break;
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
- const char *name = TOPpx;
+ const char *name = SvPV_nolen(*PL_stack_sp);
if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);
I32 result;
const int op_type = PL_op->op_type;
char opchar = '?';
- dSP;
switch (op_type) {
case OP_FTIS: opchar = 'e'; break;
break;
}
SvSETMAGIC(TARG);
- if (SvTRUE_nomg(TARG)) FT_RETURN_TRUE(TARG);
- else FT_RETURN_FALSE(TARG);
+ return SvTRUE_nomg(TARG)
+ ? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG);
}
}
dVAR;
I32 result;
char opchar = '?';
- dSP;
switch (PL_op->op_type) {
case OP_FTROWNED: opchar = 'O'; break;
PP(pp_ftlink)
{
dVAR;
- dSP;
I32 result;
tryAMAGICftest_MG('l');
PP(pp_fttty)
{
dVAR;
- dSP;
int fd;
GV *gv;
char *name = NULL;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else {
- SV *tmpsv = TOPs;
+ SV *tmpsv = *PL_stack_sp;
if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {
name = SvPV_nomg(tmpsv, namelen);
gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
FT_RETURNNO;
}
-#if defined(atarist) /* this will work with atariST. Configure will
- make guesses for other systems. */
-# define FILE_base(f) ((f)->_base)
-# define FILE_ptr(f) ((f)->_ptr)
-# define FILE_cnt(f) ((f)->_cnt)
-# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
-#endif
-
PP(pp_fttext)
{
dVAR;
- dSP;
I32 i;
I32 len;
I32 odd = 0;
STDCHAR tbuf[512];
- register STDCHAR *s;
- register IO *io;
- register SV *sv = NULL;
+ STDCHAR *s;
+ IO *io;
+ SV *sv = NULL;
GV *gv;
PerlIO *fp;
== OPpFT_STACKED)
gv = PL_defgv;
else {
- sv = TOPs;
+ sv = *PL_stack_sp;
gv = MAYBE_DEREF_GV_nomg(sv);
}
dVAR; dSP;
const char * const dirname = POPpconstx;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io)
goto nope;
SV *sv;
const I32 gimme = GIMME;
GV * const gv = MUTABLE_GV(POPs);
- register const Direntry_t *dp;
- register IO * const io = GvIOn(gv);
+ const Direntry_t *dp;
+ IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
long telldir (DIR *);
# endif
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
dVAR; dSP;
const long along = POPl;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
#if defined(HAS_REWINDDIR) || defined(rewinddir)
dVAR; dSP;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
#if defined(Direntry_t) && defined(HAS_READDIR)
dVAR; dSP;
GV * const gv = MUTABLE_GV(POPs);
- register IO * const io = GvIOn(gv);
+ IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
#ifdef VMS
value = (I32)vms_do_aexec(NULL, MARK, SP);
#else
-# ifdef __OPEN_VM
- {
- (void ) do_aspawn(NULL, MARK, SP);
- value = 0;
- }
-# else
value = (I32)do_aexec(NULL, MARK, SP);
-# endif
#endif
else {
#ifdef VMS
value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
#else
-# ifdef __OPEN_VM
- (void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
- value = 0;
-# else
value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
-# endif
#endif
}
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register char **elem;
- register SV *sv;
+ char **elem;
+ SV *sv;
#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
struct hostent *gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
struct hostent *gethostbyname(Netdb_name_t);
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register SV *sv;
+ SV *sv;
#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
struct netent *getnetbyaddr(Netdb_net_t, int);
struct netent *getnetbyname(Netdb_name_t);
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register SV *sv;
+ SV *sv;
#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
struct protoent *getprotobyname(Netdb_name_t);
struct protoent *getprotobynumber(int);
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register SV *sv;
+ SV *sv;
#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
struct servent *getservbyport(int, Netdb_name_t);
#ifdef HAS_PASSWD
dVAR; dSP;
I32 which = PL_op->op_type;
- register SV *sv;
+ SV *sv;
struct passwd *pwent = NULL;
/*
* We currently support only the SysV getsp* shadow password interface.
{
#ifdef HAS_SYSCALL
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- register I32 items = SP - MARK;
+ I32 items = SP - MARK;
unsigned long a[20];
- register I32 i = 0;
+ I32 i = 0;
IV retval = -1;
if (PL_tainting) {
case 8:
retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
break;
-#ifdef atarist
- case 9:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
- break;
- case 10:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
- break;
- case 11:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
- a[10]);
- break;
- case 12:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
- a[10],a[11]);
- break;
- case 13:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
- a[10],a[11],a[12]);
- break;
- case 14:
- retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
- a[10],a[11],a[12],a[13]);
- break;
-#endif /* atarist */
}
SP = ORIGMARK;
PUSHi(retval);
https://perl5.git.perl.org / perl5.git / blobdiff