ENTER_with_name("glob");
#ifndef VMS
- if (PL_tainting) {
+ if (TAINTING_get) {
/*
* The external globbing program may use things we can't control,
* so for security reasons we must assume the worst.
#ifdef HAS_PIPE
dVAR;
dSP;
- register IO *rstio;
- register IO *wstio;
+ IO *rstio;
+ IO *wstio;
int fd[2];
GV * const wgv = MUTABLE_GV(POPs);
switch(SvTYPE(varsv)) {
case SVt_PVHV:
+ {
+ HE *entry;
methname = "TIEHASH";
+ if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) {
+ HvLAZYDEL_off(varsv);
+ hv_free_ent((HV *)varsv, entry);
+ }
HvEITER_set(MUTABLE_HV(varsv), 0);
break;
+ }
case SVt_PVAV:
methname = "TIEARRAY";
if (!AvREAL(varsv)) {
{
#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;
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (!SvPOK(sv)) {
if (!SvPOKp(sv))
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)))
}
}
if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
- do_print(PL_formfeed, ofp);
+ do_print(GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV)), ofp);
IoLINES_LEFT(io) = IoPAGE_LEN(io);
IoPAGE(io)++;
PL_formtarget = PL_toptarget;
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);
{
dVAR; dSP; dMARK; dORIGMARK;
PerlIO *fp;
- SV *sv;
GV * const gv
= (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
IO *const io = GvIO(gv);
+ /* Treat empty list as "" */
+ if (MARK == SP) XPUSHs(&PL_sv_no);
+
if (io) {
const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
}
}
- sv = newSV(0);
if (!io) {
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
goto just_say_no;
}
else {
+ SV *sv = sv_newmortal();
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
if (PerlIO_flush(fp) == EOF)
goto just_say_no;
}
- SvREFCNT_dec(sv);
SP = ORIGMARK;
PUSHs(&PL_sv_yes);
RETURN;
just_say_no:
- SvREFCNT_dec(sv);
SP = ORIGMARK;
PUSHs(&PL_sv_undef);
RETURN;
buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
}
if (DO_UTF8(bufsv)) {
- /* offset adjust in characters not bytes */
- /* SV's length cache is only safe for non-magical values */
- if (SvGMAGICAL(bufsv))
- blen = utf8_length((const U8 *)buffer, (const U8 *)buffer + blen);
- else
- blen = sv_len_utf8(bufsv);
+ blen = sv_len_utf8_nomg(bufsv);
}
charstart = TRUE;
if (PL_op->op_type == OP_RECV) {
Sock_size_t bufsize;
char namebuf[MAXPATHLEN];
-#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
bufsize = sizeof (struct sockaddr_in);
#else
bufsize = sizeof namebuf;
blen_chars = orig_blen_bytes;
} else {
/* The SV really is UTF-8. */
- if (SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
- /* Don't call sv_len_utf8 again because it will call magic
- or overloading a second time, and we might get back a
- different result. */
- blen_chars = utf8_length((U8*)buffer, (U8*)buffer + blen);
- } else {
- /* It's safe, and it may well be cached. */
- blen_chars = sv_len_utf8(bufsv);
- }
+ /* Don't call sv_len_utf8 on a magical or overloaded
+ scalar, as we might get back a different result. */
+ blen_chars = sv_or_pv_len_utf8(bufsv, buffer, blen);
}
} else {
blen_chars = blen;
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__)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
Sock_size_t len = sizeof (struct sockaddr_in);
#else
Sock_size_t len = sizeof namebuf;
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;
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),
}
#endif
if (childpid < 0)
- RETSETUNDEF;
+ RETPUSHUNDEF;
if (!childpid) {
#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
PERL_FLUSHALL_FOR_CHILD;
childpid = PerlProc_fork();
if (childpid == -1)
- RETSETUNDEF;
+ RETPUSHUNDEF;
PUSHi(childpid);
RETURN;
# else
I32 value;
int result;
- if (PL_tainting) {
+ if (TAINTING_get) {
TAINT_ENV();
while (++MARK <= SP) {
(void)SvPV_nolen_const(*MARK); /* stringify for taint check */
- if (PL_tainted)
+ if (TAINT_get)
break;
}
MARK = ORIGMARK;
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
- if (PL_tainting) {
+ if (TAINTING_get) {
TAINT_ENV();
while (++MARK <= SP) {
(void)SvPV_nolen_const(*MARK); /* stringify for taint check */
- if (PL_tainted)
+ if (TAINT_get)
break;
}
MARK = ORIGMARK;
#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) {
+ if (TAINTING_get) {
while (++MARK <= SP) {
if (SvTAINTED(*MARK)) {
TAINT;