/* pp_sys.c
*
* Copyright (C) 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
* a rumour and a trouble as of great engines throbbing and labouring.
*/
+/* This file contains system pp ("push/pop") functions that
+ * execute the opcodes that make up a perl program. A typical pp function
+ * expects to find its arguments on the stack, and usually pushes its
+ * results onto the stack, hence the 'pp' terminology. Each OP structure
+ * contains a pointer to the relevant pp_foo() function.
+ *
+ * By 'system', we mean ops which interact with the OS, such as pp_open().
+ */
+
#include "EXTERN.h"
#define PERL_IN_PP_SYS_C
#include "perl.h"
if (PerlProc_pipe(fd) < 0)
goto badexit;
- IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
- IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+ IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
+ IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
IoOFP(rstio) = IoIFP(rstio);
IoIFP(wstio) = IoOFP(wstio);
IoTYPE(rstio) = IoTYPE_RDONLY;
ENTER;
SAVETMPS;
- push_return(retop);
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx);
+ cx->blk_sub.retop = retop;
PAD_SET_CUR(CvPADLIST(cv), 1);
setdefout(gv); /* locally select filehandle so $% et al work */
if (!IoTOP_NAME(io)) {
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
- topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
+ topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
!gv_fetchpv("top",FALSE,SVt_PVFM))
/* bad_ofp: */
PL_formtarget = PL_bodytarget;
PUTBACK;
- return pop_return();
+ return cx->blk_sub.retop;
}
PP(pp_prtf)
}
if (DO_UTF8(bufsv)) {
/* convert offset-as-chars to offset-as-bytes */
- offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
+ if (offset >= (int)blen)
+ offset += SvCUR(bufsv) - blen;
+ else
+ offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
}
more_bytes:
bufsize = SvCUR(bufsv);
}
if (PerlIO_isutf8(IoIFP(io))) {
- buffer = SvPVutf8(bufsv, blen);
+ if (!SvUTF8(bufsv)) {
+ bufsv = sv_2mortal(newSVsv(bufsv));
+ buffer = sv_2pvutf8(bufsv, &blen);
+ } else
+ buffer = SvPV(bufsv, blen);
}
else {
if (DO_UTF8(bufsv)) {
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
- IoIFP(io) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE); /* stdio gets confused about sockets */
- IoOFP(io) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+ IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
+ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
IoTYPE(io) = IoTYPE_SOCKET;
if (!IoIFP(io) || !IoOFP(io)) {
if (IoIFP(io)) PerlIO_close(IoIFP(io));
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
- IoIFP(io1) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
- IoOFP(io1) = PerlIO_fdopen(fd[0], "w"PIPESOCK_MODE);
+ IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
+ IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
IoTYPE(io1) = IoTYPE_SOCKET;
- IoIFP(io2) = PerlIO_fdopen(fd[1], "r"PIPESOCK_MODE);
- IoOFP(io2) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+ IoIFP(io2) = PerlIO_fdopen(fd[1], "r"SOCKET_OPEN_MODE);
+ IoOFP(io2) = PerlIO_fdopen(fd[1], "w"SOCKET_OPEN_MODE);
IoTYPE(io2) = IoTYPE_SOCKET;
if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
goto badexit;
if (IoIFP(nstio))
do_close(ngv, FALSE);
- IoIFP(nstio) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE);
- IoOFP(nstio) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+ IoIFP(nstio) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);
+ IoOFP(nstio) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
RETURN;
}
+/* This macro is used by the stacked filetest operators :
+ * if the previous filetest failed, short-circuit and pass its value.
+ * Else, discard it from the stack and continue. --rgs
+ */
+#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
+ if (TOPs == &PL_sv_no || TOPs == &PL_sv_undef) { RETURN; } \
+ else { (void)POPs; PUTBACK; } \
+ }
+
PP(pp_ftrread)
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(R_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, R_OK);
if (result == 0)
RETPUSHYES;
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(W_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, W_OK);
if (result == 0)
RETPUSHYES;
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(X_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, X_OK);
if (result == 0)
RETPUSHYES;
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_R_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_R_OK(POPpx);
if (result == 0)
RETPUSHYES;
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_W_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_W_OK(POPpx);
if (result == 0)
RETPUSHYES;
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_X_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_X_OK(POPpx);
if (result == 0)
RETPUSHYES;
PP(pp_ftis)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
RETPUSHYES;
PP(pp_ftrowned)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
PP(pp_ftzero)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (PL_statcache.st_size == 0)
PP(pp_ftsize)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
#if Off_t_size > IVSIZE
PP(pp_ftmtime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
PP(pp_ftatime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
PP(pp_ftctime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
PP(pp_ftsock)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISSOCK(PL_statcache.st_mode))
PP(pp_ftchr)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISCHR(PL_statcache.st_mode))
PP(pp_ftblk)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISBLK(PL_statcache.st_mode))
PP(pp_ftfile)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISREG(PL_statcache.st_mode))
PP(pp_ftdir)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISDIR(PL_statcache.st_mode))
PP(pp_ftpipe)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISFIFO(PL_statcache.st_mode))
{
dSP;
#ifdef S_ISUID
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
{
dSP;
#ifdef S_ISGID
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
{
dSP;
#ifdef S_ISVTX
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
char *tmps = Nullch;
STRLEN n_a;
+ STACKED_FTEST_CHECK;
+
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else if (isGV(TOPs))
STRLEN n_a;
PerlIO *fp;
+ STACKED_FTEST_CHECK;
+
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else if (isGV(TOPs))
projects / p5sagit/p5-mst-13.2.git / blobdiff