# include <sys/access.h>
#endif
-#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
-# define FD_CLOEXEC 1 /* NeXT needs this */
-#endif
-
#include "reentr.h"
#ifdef __Lynx__
PP(pp_backtick)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
PerlIO *fp;
const char * const tmps = POPpconstx;
const I32 gimme = GIMME_V;
PP(pp_glob)
{
- dVAR;
OP *result;
dSP;
GV * const gv = (PL_op->op_flags & OPf_SPECIAL) ? NULL : (GV *)POPs;
PP(pp_rcatline)
{
- dVAR;
PL_last_in_gv = cGVOP_gv;
return do_readline();
}
PP(pp_warn)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
SV *exsv;
STRLEN len;
if (SP - MARK > 1) {
PP(pp_die)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
SV *exsv;
STRLEN len;
#ifdef VMS
exsv = newSVpvs_flags("Died", SVs_TEMP);
}
}
- return die_sv(exsv);
+ die_sv(exsv);
+ NOT_REACHED; /* NOTREACHED */
+ return NULL; /* avoid missing return from non-void function warning */
}
/* I/O. */
PERL_ARGS_ASSERT_TIED_METHOD;
/* Ensure that our flag bits do not overlap. */
- assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
- assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
- assert((TIED_METHOD_SAY & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_SAY & G_WANT) == 0);
PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
PUSHSTACKi(PERLSI_MAGIC);
PP(pp_open)
{
- dVAR; dSP;
+ dSP;
dMARK; dORIGMARK;
dTARGET;
SV *sv;
PP(pp_close)
{
- dVAR; dSP;
+ dSP;
GV * const gv =
MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
PP(pp_pipe_op)
{
#ifdef HAS_PIPE
- dVAR;
dSP;
IO *rstio;
IO *wstio;
PP(pp_fileno)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg);
}
+ if (io && IoDIRP(io)) {
+#if defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)
+ PUSHi(my_dirfd(IoDIRP(io)));
+ RETURN;
+#elif defined(ENOTSUP)
+ errno = ENOTSUP; /* Operation not supported */
+ RETPUSHUNDEF;
+#elif defined(EOPNOTSUPP)
+ errno = EOPNOTSUPP; /* Operation not supported on socket */
+ RETPUSHUNDEF;
+#else
+ errno = EINVAL; /* Invalid argument */
+ RETPUSHUNDEF;
+#endif
+ }
+
if (!io || !(fp = IoIFP(io))) {
/* Can't do this because people seem to do things like
defined(fileno($foo)) to check whether $foo is a valid fh.
PP(pp_umask)
{
- dVAR;
dSP;
#ifdef HAS_UMASK
dTARGET;
PP(pp_binmode)
{
- dVAR; dSP;
+ dSP;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_tie)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
HV* stash;
GV *gv = NULL;
SV *sv;
RETURN;
}
+
+/* also used for: pp_dbmclose() */
+
PP(pp_untie)
{
- dVAR; dSP;
+ dSP;
MAGIC *mg;
SV *sv = POPs;
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
PP(pp_tied)
{
- dVAR;
dSP;
const MAGIC *mg;
dTOPss;
PP(pp_dbmopen)
{
- dVAR; dSP;
+ dSP;
dPOPPOPssrl;
HV* stash;
GV *gv = NULL;
PP(pp_sselect)
{
#ifdef HAS_SELECT
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 i;
I32 j;
char *s;
/* If SELECT_MIN_BITS is greater than one we most probably will want
* to align the sizes with SELECT_MIN_BITS/8 because for example
* in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
- * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
+ * UNIX, Solaris, Darwin) the smallest quantum select() operates
* on (sets/tests/clears bits) is 32 bits. */
growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
# endif
}
/*
+
+=head1 GV Functions
+
=for apidoc setdefout
Sets PL_defoutgv, the default file handle for output, to the passed in
void
Perl_setdefout(pTHX_ GV *gv)
{
- dVAR;
PERL_ARGS_ASSERT_SETDEFOUT;
SvREFCNT_inc_simple_void_NN(gv);
SvREFCNT_dec(PL_defoutgv);
PP(pp_select)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
HV *hv;
GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
GV * egv = GvEGVx(PL_defoutgv);
PP(pp_getc)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV * const gv =
MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
IO *const io = GvIO(gv);
STATIC OP *
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
- dVAR;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PP(pp_enterwrite)
{
- dVAR;
dSP;
GV *gv;
IO *io;
PP(pp_leavewrite)
{
- dVAR; dSP;
+ dSP;
GV * const gv = cxstack[cxstack_ix].blk_format.gv;
IO * const io = GvIOp(gv);
PerlIO *ofp;
PP(pp_prtf)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
PerlIO *fp;
GV * const gv
PP(pp_sysopen)
{
- dVAR;
dSP;
const int perm = (MAXARG > 3 && (TOPs || POPs)) ? POPi : 0666;
const int mode = POPi;
RETURN;
}
+
+/* also used for: pp_read() and pp_recv() (where supported) */
+
PP(pp_sysread)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SSize_t offset;
IO *io;
char *buffer;
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
unduly.
(should be 2 * length + offset + 1, or possibly something longer if
- PL_encoding is true) */
+ IN_ENCODING Is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
Zero(buffer+orig_size, offset-orig_size, char);
RETPUSHUNDEF;
}
+
+/* also used for: pp_send() where defined */
+
PP(pp_syswrite)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SV *bufsv;
const char *buffer;
SSize_t retval;
PP(pp_eof)
{
- dVAR; dSP;
+ dSP;
GV *gv;
IO *io;
const MAGIC *mg;
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
if (io && !IoIFP(io)) {
if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+ SV ** svp;
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
do_open6(gv, "-", 1, NULL, NULL, 0);
- if (GvSV(gv))
- sv_setpvs(GvSV(gv), "-");
+ svp = &GvSV(gv);
+ if (*svp) {
+ SV * sv = *svp;
+ sv_setpvs(sv, "-");
+ SvSETMAGIC(sv);
+ }
else
- GvSV(gv) = newSVpvs("-");
- SvSETMAGIC(GvSV(gv));
+ *svp = newSVpvs("-");
}
- else if (!nextargv(gv))
+ else if (!nextargv(gv, FALSE))
RETPUSHYES;
}
}
PP(pp_tell)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV *gv;
IO *io;
RETURN;
}
+
+/* also used for: pp_seek() */
+
PP(pp_sysseek)
{
- dVAR; dSP;
+ dSP;
const int whence = POPi;
#if LSEEKSIZE > IVSIZE
const Off_t offset = (Off_t)SvNVx(POPs);
PP(pp_truncate)
{
- dVAR;
dSP;
/* There seems to be no consensus on the length type of truncate()
* and ftruncate(), both off_t and size_t have supporters. In
}
}
+
+/* also used for: pp_fcntl() */
+
PP(pp_ioctl)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const argsv = POPs;
const unsigned int func = POPu;
int optype;
PP(pp_flock)
{
#ifdef FLOCK
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 value;
const int argtype = POPi;
GV * const gv = MUTABLE_GV(POPs);
PUSHi(value);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "flock()");
+ DIE(aTHX_ PL_no_func, "flock");
#endif
}
PP(pp_socket)
{
- dVAR; dSP;
+ dSP;
const int protocol = POPi;
const int type = POPi;
const int domain = POPi;
PP(pp_sockpair)
{
#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
- dVAR; dSP;
+ dSP;
int fd[2];
const int protocol = POPi;
const int type = POPi;
#ifdef HAS_SOCKET
+/* also used for: pp_connect() */
+
PP(pp_bind)
{
- dVAR; dSP;
+ dSP;
SV * const addrsv = POPs;
/* OK, so on what platform does bind modify addr? */
const char *addr;
PP(pp_listen)
{
- dVAR; dSP;
+ dSP;
const int backlog = POPi;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_accept)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
IO *nstio;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
PP(pp_shutdown)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int how = POPi;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
RETPUSHUNDEF;
}
+
+/* also used for: pp_gsockopt() */
+
PP(pp_ssockopt)
{
- dVAR; dSP;
+ dSP;
const int optype = PL_op->op_type;
SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
const unsigned int optname = (unsigned int) POPi;
len = SvCUR(sv);
if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
goto nuts2;
+#if defined(_AIX)
+ /* XXX Configure test: does getsockopt set the length properly? */
+ if (len == 256)
+ len = sizeof(int);
+#endif
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
PUSHs(sv);
}
+
+/* also used for: pp_getsockname() */
+
PP(pp_getpeername)
{
- dVAR; dSP;
+ dSP;
const int optype = PL_op->op_type;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
/* Stat calls. */
+/* also used for: pp_lstat() */
+
PP(pp_stat)
{
- dVAR;
dSP;
GV *gv = NULL;
IO *io = NULL;
STATIC OP *
S_try_amagic_ftest(pTHX_ char chr) {
- dVAR;
SV *const arg = *PL_stack_sp;
assert(chr != '?');
}
+/* also used for: pp_fteexec() pp_fteread() pp_ftewrite() pp_ftrexec()
+ * pp_ftrwrite() */
+
PP(pp_ftrread)
{
- dVAR;
I32 result;
/* Not const, because things tweak this below. Not bool, because there's
- no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */
+ no guarantee that OPpFT_ACCESS is <= CHAR_MAX */
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
I32 use_access = PL_op->op_private & OPpFT_ACCESS;
/* Giving some sort of initial value silences compilers. */
FT_RETURNNO;
}
+
+/* also used for: pp_ftatime() pp_ftctime() pp_ftmtime() pp_ftsize() */
+
PP(pp_ftis)
{
- dVAR;
I32 result;
const int op_type = PL_op->op_type;
char opchar = '?';
}
}
+
+/* also used for: pp_ftblk() pp_ftchr() pp_ftdir() pp_fteowned()
+ * pp_ftfile() pp_ftpipe() pp_ftsgid() pp_ftsock()
+ * pp_ftsuid() pp_ftsvtx() pp_ftzero() */
+
PP(pp_ftrowned)
{
- dVAR;
I32 result;
char opchar = '?';
PP(pp_ftlink)
{
- dVAR;
I32 result;
tryAMAGICftest_MG('l');
PP(pp_fttty)
{
- dVAR;
int fd;
GV *gv;
char *name = NULL;
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
else if (name && isDIGIT(*name))
- fd = atoi(name);
+ fd = grok_atou(name, NULL);
else
FT_RETURNUNDEF;
if (fd < 0) {
FT_RETURNNO;
}
+
+/* also used for: pp_ftbinary() */
+
PP(pp_fttext)
{
- dVAR;
I32 i;
SSize_t len;
I32 odd = 0;
}
/* now scan s to look for textiness */
- /* XXX ASCII dependent code */
#if defined(DOSISH) || defined(USEMYBINMODE)
/* ignore trailing ^Z on short files */
--len;
#endif
+ assert(len);
+ if (! is_invariant_string((U8 *) s, len)) {
+ const U8 *ep;
+
+ /* Here contains a variant under UTF-8 . See if the entire string is
+ * UTF-8. But the buffer may end in a partial character, so consider
+ * it UTF-8 if the first non-UTF8 char is an ending partial */
+ if (is_utf8_string_loc((U8 *) s, len, &ep)
+ || ep + UTF8SKIP(ep) > (U8 *) (s + len))
+ {
+ if (PL_op->op_type == OP_FTTEXT) {
+ FT_RETURNYES;
+ }
+ else {
+ FT_RETURNNO;
+ }
+ }
+ }
+
+ /* Here, is not UTF-8 or is entirely ASCII. Look through the buffer for
+ * things that wouldn't be in ASCII text or rich ASCII text. Count these
+ * in 'odd' */
for (i = 0; i < len; i++, s++) {
if (!*s) { /* null never allowed in text */
odd += len;
break;
}
-#ifdef EBCDIC
- else if (!(isPRINT(*s) || isSPACE(*s)))
- odd++;
-#else
- else if (*s & 128) {
-#ifdef USE_LOCALE
- if (IN_LOCALE_RUNTIME && isALPHA_LC(*s))
+#ifdef USE_LOCALE_CTYPE
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ if ( isPRINT_LC(*s) || isSPACE_LC(*s)) {
continue;
+ }
+ }
+ else
#endif
- /* utf8 characters don't count as odd */
- if (UTF8_IS_START(*s)) {
- int ulen = UTF8SKIP(s);
- if (ulen < len - i) {
- int j;
- for (j = 1; j < ulen; j++) {
- if (!UTF8_IS_CONTINUATION(s[j]))
- goto not_utf8;
- }
- --ulen; /* loop does extra increment */
- s += ulen;
- i += ulen;
- continue;
- }
- }
- not_utf8:
- odd++;
- }
- else if (*s < 32 &&
- *s != '\n' && *s != '\r' && *s != '\b' &&
- *s != '\t' && *s != '\f' && *s != 27)
- odd++;
-#endif
+ if (isPRINT_A(*s)
+ /* VT occurs so rarely in text, that we consider it odd */
+ || (isSPACE_A(*s) && *s != VT_NATIVE)
+
+ /* But there is a fair amount of backspaces and escapes in
+ * some text */
+ || *s == '\b'
+ || *s == ESC_NATIVE)
+ {
+ continue;
+ }
+ odd++;
}
if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
PP(pp_chdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const char *tmps = NULL;
GV *gv = NULL;
RETURN;
}
+
+/* also used for: pp_chmod() pp_kill() pp_unlink() pp_utime() */
+
PP(pp_chown)
{
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PP(pp_chroot)
{
#ifdef HAS_CHROOT
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
char * const tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
PP(pp_rename)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
int anum;
const char * const tmps2 = POPpconstx;
const char * const tmps = SvPV_nolen_const(TOPs);
RETURN;
}
+
+/* also used for: pp_symlink() */
+
#if defined(HAS_LINK) || defined(HAS_SYMLINK)
PP(pp_link)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int op_type = PL_op->op_type;
int result;
RETURN;
}
#else
+
+/* also used for: pp_symlink() */
+
PP(pp_link)
{
/* Have neither. */
PP(pp_readlink)
{
- dVAR;
dSP;
#ifdef HAS_SYMLINK
dTARGET;
const char *tmps;
char buf[MAXPATHLEN];
- int len;
+ SSize_t len;
TAINT;
tmps = POPpconstx;
+ /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
+ * it is impossible to know whether the result was truncated. */
len = readlink(tmps, buf, sizeof(buf) - 1);
if (len < 0)
RETPUSHUNDEF;
+ if (len != -1)
+ buf[len] = '\0';
PUSHp(buf, len);
RETURN;
#else
PP(pp_mkdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_rmdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_open_dir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dVAR; dSP;
+ dSP;
const char * const dirname = POPpconstx;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
- dVAR;
dSP;
SV *sv;
PP(pp_telldir)
{
#if defined(HAS_TELLDIR) || defined(telldir)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
/* XXX does _anyone_ need this? --AD 2/20/1998 */
/* XXX netbsd still seemed to.
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
PP(pp_seekdir)
{
#if defined(HAS_SEEKDIR) || defined(seekdir)
- dVAR; dSP;
+ dSP;
const long along = POPl;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_rewinddir)
{
#if defined(HAS_REWINDDIR) || defined(rewinddir)
- dVAR; dSP;
+ dSP;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_closedir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dVAR; dSP;
+ dSP;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_fork)
{
#ifdef HAS_FORK
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t childpid;
#ifdef HAS_SIGPROCMASK
sigset_t oldmask, newmask;
PP(pp_wait)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
Pid_t result;
PP(pp_system)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
#if defined(__LIBCATAMOUNT__)
PL_statusvalue = -1;
SP = ORIGMARK;
PP(pp_exec)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
if (TAINTING_get) {
PP(pp_getppid)
{
#ifdef HAS_GETPPID
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
XPUSHi( getppid() );
RETURN;
#else
PP(pp_getpgrp)
{
#ifdef HAS_GETPGRP
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t pgrp;
const Pid_t pid =
(MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0);
XPUSHi(pgrp);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "getpgrp()");
+ DIE(aTHX_ PL_no_func, "getpgrp");
#endif
}
PP(pp_setpgrp)
{
#ifdef HAS_SETPGRP
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t pgrp;
Pid_t pid;
pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
- if (MAXARG > 0) pid = TOPs && TOPi;
+ if (MAXARG > 0) pid = TOPs ? TOPi : 0;
else {
pid = 0;
- XPUSHi(-1);
+ EXTEND(SP,1);
+ SP++;
}
TAINT_PROPER("setpgrp");
#endif /* USE_BSDPGRP */
RETURN;
#else
- DIE(aTHX_ PL_no_func, "setpgrp()");
+ DIE(aTHX_ PL_no_func, "setpgrp");
#endif
}
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
SETi( getpriority(PRIORITY_WHICH_T(which), who) );
RETURN;
#else
- DIE(aTHX_ PL_no_func, "getpriority()");
+ DIE(aTHX_ PL_no_func, "getpriority");
#endif
}
PP(pp_setpriority)
{
#ifdef HAS_SETPRIORITY
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int niceval = POPi;
const int who = POPi;
const int which = TOPi;
SETi( setpriority(PRIORITY_WHICH_T(which), who, niceval) >= 0 );
RETURN;
#else
- DIE(aTHX_ PL_no_func, "setpriority()");
+ DIE(aTHX_ PL_no_func, "setpriority");
#endif
}
PP(pp_time)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
#ifdef BIG_TIME
XPUSHn( time(NULL) );
#else
PP(pp_tms)
{
#ifdef HAS_TIMES
- dVAR;
dSP;
struct tms timesbuf;
/* Sun Dec 29 12:00:00 2147483647 */
#define TIME_UPPER_BOUND 67767976233316800.0
+
+/* also used for: pp_localtime() */
+
PP(pp_gmtime)
{
- dVAR;
dSP;
Time64_T when;
struct TM tmbuf;
if (err == NULL)
RETPUSHUNDEF;
else {
- mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
+ mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %"IVdf,
dayname[tmbuf.tm_wday],
monname[tmbuf.tm_mon],
tmbuf.tm_mday,
tmbuf.tm_hour,
tmbuf.tm_min,
tmbuf.tm_sec,
- /* XXX newSVpvf()'s %lld type is broken,
- * so cheat with a double */
- (double)tmbuf.tm_year + 1900));
+ (IV)tmbuf.tm_year + 1900));
}
}
else { /* list context */
PP(pp_alarm)
{
#ifdef HAS_ALARM
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
int anum;
anum = POPi;
anum = alarm((unsigned int)anum);
PP(pp_sleep)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 duration;
Time_t lasttime;
Time_t when;
/* Shared memory. */
/* Merged with some message passing. */
+/* also used for: pp_msgrcv() pp_msgsnd() pp_semop() pp_shmread() */
+
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
const int op_type = PL_op->op_type;
I32 value;
/* Semaphores. */
+/* also used for: pp_msgget() pp_shmget() */
+
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
const int anum = do_ipcget(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
#endif
}
+/* also used for: pp_msgctl() pp_shmctl() */
+
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
- RETSETUNDEF;
+ RETPUSHUNDEF;
if (anum != 0) {
PUSHi(anum);
}
/* Get system info. */
+/* also used for: pp_ghbyaddr() pp_ghbyname() */
+
PP(pp_ghostent)
{
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
char **elem;
SV *sv;
#endif
}
+/* also used for: pp_gnbyaddr() pp_gnbyname() */
+
PP(pp_gnetent)
{
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
#endif
}
+
+/* also used for: pp_gpbyname() pp_gpbynumber() */
+
PP(pp_gprotoent)
{
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
#endif
}
+
+/* also used for: pp_gsbyname() pp_gsbyport() */
+
PP(pp_gservent)
{
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
#endif
}
+
+/* also used for: pp_snetent() pp_sprotoent() pp_sservent() */
+
PP(pp_shostent)
{
- dVAR; dSP;
+ dSP;
const int stayopen = TOPi;
switch(PL_op->op_type) {
case OP_SHOSTENT:
RETSETYES;
}
+
+/* also used for: pp_egrent() pp_enetent() pp_eprotoent() pp_epwent()
+ * pp_eservent() pp_sgrent() pp_spwent() */
+
PP(pp_ehostent)
{
- dVAR; dSP;
+ dSP;
switch(PL_op->op_type) {
case OP_EHOSTENT:
#ifdef HAS_ENDHOSTENT
RETPUSHYES;
}
+
+/* also used for: pp_gpwnam() pp_gpwuid() */
+
PP(pp_gpwent)
{
#ifdef HAS_PASSWD
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
struct passwd *pwent = NULL;
#endif
}
+
+/* also used for: pp_ggrgid() pp_ggrnam() */
+
PP(pp_ggrent)
{
#ifdef HAS_GROUP
- dVAR; dSP;
+ dSP;
const I32 which = PL_op->op_type;
const struct group *grent;
PP(pp_getlogin)
{
#ifdef HAS_GETLOGIN
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
char *tmps;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
PP(pp_syscall)
{
#ifdef HAS_SYSCALL
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
I32 items = SP - MARK;
unsigned long a[20];
I32 i = 0;
https://perl5.git.perl.org / perl5.git / blobdiff