#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,
return next;
}
-#define FT_RETURN_FALSE(X) \
- return S_ft_return_false(aTHX_ X)
-#define FT_RETURN_TRUE(X) \
- return S_ft_return_true(aTHX_ X)
-
PERL_STATIC_INLINE OP *
S_ft_return_true(pTHX_ SV *ret) {
dSP;
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(*PL_stack_sp) & (SVf_ROK|SVs_GMG)) \
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;
}
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);
}
}
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;
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;
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