mode = "rt";
fp = PerlProc_popen(tmps, mode);
if (fp) {
- const char *type = NULL;
- if (PL_curcop->cop_io) {
- type = SvPV_nolen_const(PL_curcop->cop_io);
- }
+ const char * const type = PL_curcop->cop_io ? SvPV_nolen_const(PL_curcop->cop_io) : NULL;
if (type && *type)
PerlIO_apply_layers(aTHX_ fp,mode,type);
SV *tmpsv;
const char *tmps;
STRLEN len;
- if (SP - MARK != 1) {
+ if (SP - MARK > 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
tmpsv = TARG;
SP = MARK + 1;
}
+ else if (SP == MARK) {
+ tmpsv = &PL_sv_no;
+ EXTEND(SP, 1);
+ }
else {
tmpsv = TOPs;
}
if (!multiarg)
SvSetSV(error,tmpsv);
else if (sv_isobject(error)) {
- HV *stash = SvSTASH(SvRV(error));
- GV *gv = gv_fetchmethod(stash, "PROPAGATE");
+ HV * const stash = SvSTASH(SvRV(error));
+ GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
- SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
- SV *line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
+ SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+ SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
EXTEND(SP, 3);
PUSHMARK(SP);
PUSHs(error);
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
- CV *cv = NULL;
+ CV *cv;
if (obj) {
GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
if (gv && isGV(gv) && (cv = GvCV(gv))) {
PP(pp_select)
{
dSP; dTARGET;
- GV *egv;
HV *hv;
-
GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
+ GV * egv = GvEGV(PL_defoutgv);
- egv = GvEGV(PL_defoutgv);
if (!egv)
egv = PL_defoutgv;
hv = GvSTASH(egv);
RETPUSHUNDEF;
}
-PP(pp_syswrite)
-{
- dVAR; dSP;
- const int items = (SP - PL_stack_base) - TOPMARK;
- if (items == 2) {
- SV *sv;
- EXTEND(SP, 1);
- sv = sv_2mortal(newSViv(sv_len(*SP)));
- PUSHs(sv);
- PUTBACK;
- }
- return pp_send();
-}
-
PP(pp_send)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- GV *gv;
IO *io;
SV *bufsv;
const char *buffer;
- Size_t length;
+ Size_t length = 0;
SSize_t retval;
STRLEN blen;
MAGIC *mg;
-
- gv = (GV*)*++MARK;
+ const int op_type = PL_op->op_type;
+
+ GV *const gv = (GV*)*++MARK;
if (PL_op->op_type == OP_SYSWRITE
&& gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
SV *sv;
+
+ if (MARK == SP - 1) {
+ EXTEND(SP, 1000);
+ sv = sv_2mortal(newSViv(sv_len(*SP)));
+ PUSHs(sv);
+ PUTBACK;
+ }
- PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)io, mg);
+ PUSHMARK(ORIGMARK);
+ *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
ENTER;
call_method("WRITE", G_SCALAR);
LEAVE;
}
if (!gv)
goto say_undef;
+
bufsv = *++MARK;
+
+ if (op_type == OP_SYSWRITE) {
+ if (MARK >= SP) {
+ length = (Size_t) sv_len(bufsv);
+ } else {
#if Size_t_size > IVSIZE
- length = (Size_t)SvNVx(*++MARK);
+ length = (Size_t)SvNVx(*++MARK);
#else
- length = (Size_t)SvIVx(*++MARK);
+ length = (Size_t)SvIVx(*++MARK);
#endif
- if ((SSize_t)length < 0)
- DIE(aTHX_ "Negative length");
+ if ((SSize_t)length < 0)
+ DIE(aTHX_ "Negative length");
+ }
+ }
SETERRNO(0,0);
io = GvIO(gv);
if (!io || !IoIFP(io)) {
buffer = SvPV_const(bufsv, blen);
}
- if (PL_op->op_type == OP_SYSWRITE) {
+ if (op_type == OP_SYSWRITE) {
IV offset;
if (DO_UTF8(bufsv)) {
/* length and offset are in chars */
}
}
#ifdef HAS_SOCKET
- else if (SP > MARK) {
- STRLEN mlen;
- char * const sockbuf = SvPVx(*++MARK, mlen);
- /* length is really flags */
- retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
- length, (struct sockaddr *)sockbuf, mlen);
+ else {
+ const int flags = SvIVx(*++MARK);
+ if (SP > MARK) {
+ STRLEN mlen;
+ char * const sockbuf = SvPVx(*++MARK, mlen);
+ retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+ flags, (struct sockaddr *)sockbuf, mlen);
+ }
+ else {
+ retval
+ = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+ }
}
- else
- /* length is really flags */
- retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
#else
else
DIE(aTHX_ PL_no_sock_func, "send");
PP(pp_sysseek)
{
dVAR; dSP;
- GV *gv;
IO *io;
const int whence = POPi;
#if LSEEKSIZE > IVSIZE
- Off_t offset = (Off_t)SvNVx(POPs);
+ const Off_t offset = (Off_t)SvNVx(POPs);
#else
- Off_t offset = (Off_t)SvIVx(POPs);
+ const Off_t offset = (Off_t)SvIVx(POPs);
#endif
MAGIC *mg;
- gv = PL_last_in_gv = (GV*)POPs;
+ GV * const gv = PL_last_in_gv = (GV*)POPs;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
if (sought < 0)
PUSHs(&PL_sv_undef);
else {
- SV* sv = sought ?
+ SV* const sv = sought ?
#if LSEEKSIZE > IVSIZE
newSVnv((NV)sought)
#else
* general one would think that when using large files, off_t is
* at least as wide as size_t, so using an off_t should be okay. */
/* XXX Configure probe for the length type of *truncate() needed XXX */
- Off_t len;
#if Off_t_size > IVSIZE
- len = (Off_t)POPn;
+ const Off_t len = (Off_t)POPn;
#else
- len = (Off_t)POPi;
+ const Off_t len = (Off_t)POPi;
#endif
/* Checking for length < 0 is problematic as the type might or
* might not be signed: if it is not, clever compilers will moan. */
}
}
else {
- SV *sv = POPs;
+ SV * const sv = POPs;
const char *name;
if (SvTYPE(sv) == SVt_PVGV) {
result = 0;
#else
{
- int tmpfd;
+ const int tmpfd = PerlLIO_open(name, O_RDWR);
- if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
+ if (tmpfd < 0)
result = 0;
else {
if (my_chsize(tmpfd, len) < 0)
PP(pp_ioctl)
{
dSP; dTARGET;
- SV *argsv = POPs;
+ SV * const argsv = POPs;
const unsigned int func = POPu;
const int optype = PL_op->op_type;
+ GV * const gv = (GV*)POPs;
+ IO * const io = gv ? GvIOn(gv) : Null(IO*);
char *s;
IV retval;
- GV *gv = (GV*)POPs;
- IO *io = gv ? GvIOn(gv) : 0;
if (!io || !argsv || !IoIFP(io)) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
#ifdef FLOCK
dSP; dTARGET;
I32 value;
- int argtype;
- GV *gv;
IO *io = NULL;
PerlIO *fp;
+ const int argtype = POPi;
+ GV * const gv = (MAXARG == 0) ? PL_last_in_gv : (GV*)POPs;
- argtype = POPi;
- if (MAXARG == 0)
- gv = PL_last_in_gv;
- else
- gv = (GV*)POPs;
if (gv && (io = GvIO(gv)))
fp = IoIFP(io);
else {
{
#ifdef HAS_SOCKET
dSP;
- GV *gv;
- register IO *io;
- int protocol = POPi;
- int type = POPi;
- int domain = POPi;
+ const int protocol = POPi;
+ const int type = POPi;
+ const int domain = POPi;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = gv ? GvIOn(gv) : NULL;
int fd;
- gv = (GV*)POPs;
- io = gv ? GvIOn(gv) : NULL;
-
if (!gv || !io) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
{
#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
dSP;
- GV *gv1;
- GV *gv2;
- register IO *io1;
- register IO *io2;
- int protocol = POPi;
- int type = POPi;
- int domain = POPi;
+ const int protocol = POPi;
+ const int type = POPi;
+ const int domain = POPi;
+ GV * const gv2 = (GV*)POPs;
+ GV * const gv1 = (GV*)POPs;
+ register IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
+ register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
int fd[2];
- gv2 = (GV*)POPs;
- gv1 = (GV*)POPs;
- io1 = gv1 ? GvIOn(gv1) : NULL;
- io2 = gv2 ? GvIOn(gv2) : NULL;
if (!gv1 || !gv2 || !io1 || !io2) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
if (!gv1 || !io1)
extern void GETPRIVMODE();
extern void GETUSERMODE();
#endif
- SV *addrsv = POPs;
+ SV * const addrsv = POPs;
/* OK, so on what platform does bind modify addr? */
const char *addr;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
STRLEN len;
int bind_ok = 0;
#ifdef MPE
{
#ifdef HAS_SOCKET
dSP;
- SV *addrsv = POPs;
+ SV * const addrsv = POPs;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
const char *addr;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
STRLEN len;
if (!io || !IoIFP(io))
{
#ifdef HAS_SOCKET
dSP;
- int backlog = POPi;
- GV *gv = (GV*)POPs;
- register IO *io = gv ? GvIOn(gv) : NULL;
+ const int backlog = POPi;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = gv ? GvIOn(gv) : NULL;
if (!gv || !io || !IoIFP(io))
goto nuts;
{
#ifdef HAS_SOCKET
dSP; dTARGET;
- GV *ngv;
- GV *ggv;
register IO *nstio;
register IO *gstio;
char namebuf[MAXPATHLEN];
#else
Sock_size_t len = sizeof namebuf;
#endif
+ GV * const ggv = (GV*)POPs;
+ GV * const ngv = (GV*)POPs;
int fd;
- ggv = (GV*)POPs;
- ngv = (GV*)POPs;
-
if (!ngv)
goto badexit;
if (!ggv)
{
#ifdef HAS_SOCKET
dSP; dTARGET;
- int how = POPi;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ const int how = POPi;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io || !IoIFP(io))
goto nuts;
{
#ifdef HAS_SOCKET
dSP;
- int optype = PL_op->op_type;
- SV *sv;
+ const int optype = PL_op->op_type;
+ SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs;
+ const unsigned int optname = (unsigned int) POPi;
+ const unsigned int lvl = (unsigned int) POPi;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
int fd;
- unsigned int optname;
- unsigned int lvl;
- GV *gv;
- register IO *io;
Sock_size_t len;
- if (optype == OP_GSOCKOPT)
- sv = sv_2mortal(NEWSV(22, 257));
- else
- sv = POPs;
- optname = (unsigned int) POPi;
- lvl = (unsigned int) POPi;
-
- gv = (GV*)POPs;
- io = GvIOn(gv);
if (!io || !IoIFP(io))
goto nuts;
{
#ifdef HAS_SOCKET
dSP;
- int optype = PL_op->op_type;
+ const int optype = PL_op->op_type;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
+ Sock_size_t len;
SV *sv;
int fd;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
- Sock_size_t len;
if (!io || !IoIFP(io))
goto nuts;
}
}
else {
- SV* sv = POPs;
+ SV* const sv = POPs;
if (SvTYPE(sv) == SVt_PVGV) {
gv = (GV*)sv;
goto do_fstat;
const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
- PUSHi(value);
+ XPUSHi(value);
RETURN;
}
{
#ifdef HAS_CHROOT
dSP; dTARGET;
- char *tmps = POPpx;
+ char * const tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
{
dSP; dTARGET;
int anum;
- const char *tmps2 = POPpconstx;
- const char *tmps = SvPV_nolen_const(TOPs);
+ const char * const tmps2 = POPpconstx;
+ const char * const tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
# endif
{
- const char *tmps2 = POPpconstx;
- const char *tmps = SvPV_nolen_const(TOPs);
+ const char * const tmps2 = POPpconstx;
+ const char * const tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER(PL_op_desc[op_type]);
result =
# if defined(HAS_LINK)
PP(pp_mkdir)
{
dSP; dTARGET;
- int mode;
#ifndef HAS_MKDIR
int oldumask;
#endif
STRLEN len;
const char *tmps;
bool copy = FALSE;
-
- if (MAXARG > 1)
- mode = POPi;
- else
- mode = 0777;
+ const int mode = (MAXARG > 1) ? POPi : 0777;
TRIMSLASHES(tmps,len,copy);
{
#if defined(Direntry_t) && defined(HAS_READDIR)
dSP;
- const char *dirname = POPpconstx;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ const char * const dirname = POPpconstx;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io)
goto nope;
SV *sv;
const I32 gimme = GIMME;
- GV *gv = (GV *)POPs;
- register Direntry_t *dp;
- register IO *io = GvIOn(gv);
+ GV * const gv = (GV *)POPs;
+ register const Direntry_t *dp;
+ register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
# if !defined(HAS_TELLDIR_PROTO) || defined(NEED_TELLDIR_PROTO)
long telldir (DIR *);
# endif
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
{
#if defined(HAS_SEEKDIR) || defined(seekdir)
dSP;
- long along = POPl;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ const long along = POPl;
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
{
#if defined(HAS_REWINDDIR) || defined(rewinddir)
dSP;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
{
#if defined(Direntry_t) && defined(HAS_READDIR)
dSP;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ GV * const gv = (GV*)POPs;
+ register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
#ifdef HAS_FORK
dSP; dTARGET;
Pid_t childpid;
- GV *tmpgv;
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
- if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
+ GV * const tmpgv = gv_fetchpv("$", TRUE, SVt_PV);
+ if (tmpgv) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
SvREADONLY_on(GvSV(tmpgv));
if (errno != EAGAIN) {
value = -1;
SP = ORIGMARK;
- PUSHi(value);
+ XPUSHi(value);
if (did_pipes) {
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
STATUS_NATIVE_CHILD_SET(-1);
}
}
- PUSHi(STATUS_CURRENT);
+ XPUSHi(STATUS_CURRENT);
RETURN;
}
if (did_pipes) {
STATUS_NATIVE_CHILD_SET(value);
do_execfree();
SP = ORIGMARK;
- PUSHi(result ? value : STATUS_CURRENT);
+ XPUSHi(result ? value : STATUS_CURRENT);
#endif /* !FORK or VMS */
RETURN;
}
}
SP = ORIGMARK;
- PUSHi(value);
+ XPUSHi(value);
RETURN;
}
case OP_MSGRCV:
value = (I32)(do_msgrcv(MARK, SP) >= 0);
break;
+ case OP_SEMOP:
+ value = (I32)(do_semop(MARK, SP) >= 0);
+ break;
default:
value = (I32)(do_shmio(op_type, MARK, SP) >= 0);
break;
#endif
}
-PP(pp_semop)
-{
-#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
- I32 value = (I32)(do_semop(MARK, SP) >= 0);
- SP = MARK;
- PUSHi(value);
- RETURN;
-#else
- return pp_semget();
-#endif
-}
-
/* Get system info. */
PP(pp_ghostent)
projects / p5sagit/p5-mst-13.2.git / blobdiff