#endif
#if !defined(PERL_EFF_ACCESS_R_OK)
+/* With it or without it: anyway you get a warning: either that
+ it is unused, or it is declared static and never defined.
+ */
STATIC int
S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
{
PP(pp_pipe_op)
{
- dSP;
#ifdef HAS_PIPE
+ dSP;
GV *rgv;
GV *wgv;
register IO *rstio;
PP(pp_umask)
{
dSP; dTARGET;
+#ifdef HAS_UMASK
Mode_t anum;
-#ifdef HAS_UMASK
if (MAXARG < 1) {
anum = PerlLIO_umask(0);
(void)PerlLIO_umask(anum);
PerlIO *fp;
MAGIC *mg;
SV *discp = Nullsv;
- STRLEN len = 0;
- char *names = NULL;
if (MAXARG < 1)
RETPUSHUNDEF;
RETPUSHUNDEF;
}
- if (discp) {
- names = SvPV(discp,len);
- }
-
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
(discp) ? SvPV_nolen(discp) : Nullch))
RETPUSHYES;
methname = "TIEARRAY";
break;
case SVt_PVGV:
-#ifdef GV_SHARED_CHECK
- if (GvSHARED((GV*)varsv)) {
- Perl_croak(aTHX_ "Attempt to tie shared GV");
+#ifdef GV_UNIQUE_CHECK
+ if (GvUNIQUE((GV*)varsv)) {
+ Perl_croak(aTHX_ "Attempt to tie unique GV");
}
#endif
methname = "TIEHANDLE";
PP(pp_sselect)
{
- dSP; dTARGET;
#ifdef HAS_SELECT
+ dSP; dTARGET;
register I32 i;
register I32 j;
register char *s;
PP(pp_flock)
{
+#ifdef FLOCK
dSP; dTARGET;
I32 value;
int argtype;
IO *io = NULL;
PerlIO *fp;
-#ifdef FLOCK
argtype = POPi;
if (MAXARG == 0)
gv = PL_last_in_gv;
PP(pp_socket)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
GV *gv;
register IO *io;
int protocol = POPi;
PP(pp_sockpair)
{
- dSP;
#ifdef HAS_SOCKETPAIR
+ dSP;
GV *gv1;
GV *gv2;
register IO *io1;
PP(pp_bind)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
- extern GETPRIVMODE();
- extern GETUSERMODE();
+ extern void GETPRIVMODE();
+ extern void GETUSERMODE();
#endif
SV *addrsv = POPs;
char *addr;
PP(pp_connect)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
SV *addrsv = POPs;
char *addr;
GV *gv = (GV*)POPs;
PP(pp_listen)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int backlog = POPi;
GV *gv = (GV*)POPs;
register IO *io = gv ? GvIOn(gv) : NULL;
PP(pp_accept)
{
- dSP; dTARGET;
#ifdef HAS_SOCKET
+ dSP; dTARGET;
GV *ngv;
GV *ggv;
register IO *nstio;
PP(pp_shutdown)
{
- dSP; dTARGET;
#ifdef HAS_SOCKET
+ dSP; dTARGET;
int how = POPi;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_ssockopt)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int optype = PL_op->op_type;
SV *sv;
int fd;
PP(pp_getpeername)
{
- dSP;
#ifdef HAS_SOCKET
+ dSP;
int optype = PL_op->op_type;
SV *sv;
int fd;
PP(pp_chown)
{
- dSP; dMARK; dTARGET;
- I32 value;
#ifdef HAS_CHOWN
- value = (I32)apply(PL_op->op_type, MARK, SP);
+ dSP; dMARK; dTARGET;
+ I32 value = (I32)apply(PL_op->op_type, MARK, SP);
+
SP = MARK;
PUSHi(value);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function chown");
+ DIE(aTHX_ PL_no_func, "chown");
#endif
}
PP(pp_chroot)
{
- dSP; dTARGET;
#ifdef HAS_CHROOT
+ dSP; dTARGET;
STRLEN n_a;
char *tmps = POPpx;
TAINT_PROPER("chroot");
PP(pp_link)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_LINK
+ dTARGET;
STRLEN n_a;
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
SETi( PerlLIO_link(tmps, tmps2) >= 0 );
+ RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function link");
+ DIE(aTHX_ PL_no_func, "link");
#endif
- RETURN;
}
PP(pp_symlink)
{
- dSP; dTARGET;
#ifdef HAS_SYMLINK
+ dSP; dTARGET;
STRLEN n_a;
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
PP(pp_readlink)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SYMLINK
+ dTARGET;
char *tmps;
char buf[MAXPATHLEN];
int len;
PP(pp_open_dir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
+ dSP;
STRLEN n_a;
char *dirname = POPpx;
GV *gv = (GV*)POPs;
PP(pp_readdir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
+ dSP;
#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
PP(pp_telldir)
{
- dSP; dTARGET;
#if defined(HAS_TELLDIR) || defined(telldir)
+ 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)
{
- dSP;
#if defined(HAS_SEEKDIR) || defined(seekdir)
+ dSP;
long along = POPl;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_rewinddir)
{
- dSP;
#if defined(HAS_REWINDDIR) || defined(rewinddir)
+ dSP;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_closedir)
{
- dSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
+ dSP;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PUSHi(childpid);
RETURN;
# else
- DIE(aTHX_ PL_no_func, "Unsupported function fork");
+ DIE(aTHX_ PL_no_func, "fork");
# endif
#endif
}
XPUSHi(childpid);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function wait");
+ DIE(aTHX_ PL_no_func, "wait");
#endif
}
SETi(childpid);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function waitpid");
+ DIE(aTHX_ PL_no_func, "waitpid");
#endif
}
{
dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
- Pid_t childpid;
- int result;
- int status;
- Sigsave_t ihand,qhand; /* place to save signals during system() */
STRLEN n_a;
- I32 did_pipes = 0;
+ int result;
int pp[2];
+ I32 did_pipes = 0;
if (SP - MARK == 1) {
if (PL_tainting) {
}
}
PERL_FLUSHALL_FOR_CHILD;
-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__) || defined(PERL_MICRO)
- if (PerlProc_pipe(pp) >= 0)
- did_pipes = 1;
- while ((childpid = vfork()) == -1) {
- if (errno != EAGAIN) {
- value = -1;
- SP = ORIGMARK;
- PUSHi(value);
- if (did_pipes) {
- PerlLIO_close(pp[0]);
- PerlLIO_close(pp[1]);
- }
- RETURN;
- }
- sleep(5);
- }
- if (childpid > 0) {
- if (did_pipes)
- PerlLIO_close(pp[1]);
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
+ {
+ Pid_t childpid;
+ int status;
+ Sigsave_t ihand,qhand; /* place to save signals during system() */
+
+ if (PerlProc_pipe(pp) >= 0)
+ did_pipes = 1;
+ while ((childpid = vfork()) == -1) {
+ if (errno != EAGAIN) {
+ value = -1;
+ SP = ORIGMARK;
+ PUSHi(value);
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
+ PerlLIO_close(pp[1]);
+ }
+ RETURN;
+ }
+ sleep(5);
+ }
+ if (childpid > 0) {
+ if (did_pipes)
+ PerlLIO_close(pp[1]);
#ifndef PERL_MICRO
- rsignal_save(SIGINT, SIG_IGN, &ihand);
- rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+ rsignal_save(SIGINT, SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, SIG_IGN, &qhand);
#endif
- do {
- result = wait4pid(childpid, &status, 0);
- } while (result == -1 && errno == EINTR);
+ do {
+ result = wait4pid(childpid, &status, 0);
+ } while (result == -1 && errno == EINTR);
#ifndef PERL_MICRO
- (void)rsignal_restore(SIGINT, &ihand);
- (void)rsignal_restore(SIGQUIT, &qhand);
-#endif
- STATUS_NATIVE_SET(result == -1 ? -1 : status);
- do_execfree(); /* free any memory child malloced on vfork */
- SP = ORIGMARK;
- if (did_pipes) {
- int errkid;
- int n = 0, n1;
-
- while (n < sizeof(int)) {
- n1 = PerlLIO_read(pp[0],
- (void*)(((char*)&errkid)+n),
- (sizeof(int)) - n);
- if (n1 <= 0)
- break;
- n += n1;
- }
- PerlLIO_close(pp[0]);
- if (n) { /* Error */
- if (n != sizeof(int))
- DIE(aTHX_ "panic: kid popen errno read");
- errno = errkid; /* Propagate errno from kid */
- STATUS_CURRENT = -1;
- }
- }
- PUSHi(STATUS_CURRENT);
- RETURN;
- }
- if (did_pipes) {
- PerlLIO_close(pp[0]);
+ (void)rsignal_restore(SIGINT, &ihand);
+ (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
+ STATUS_NATIVE_SET(result == -1 ? -1 : status);
+ do_execfree(); /* free any memory child malloced on vfork */
+ SP = ORIGMARK;
+ if (did_pipes) {
+ int errkid;
+ int n = 0, n1;
+
+ while (n < sizeof(int)) {
+ n1 = PerlLIO_read(pp[0],
+ (void*)(((char*)&errkid)+n),
+ (sizeof(int)) - n);
+ if (n1 <= 0)
+ break;
+ n += n1;
+ }
+ PerlLIO_close(pp[0]);
+ if (n) { /* Error */
+ if (n != sizeof(int))
+ DIE(aTHX_ "panic: kid popen errno read");
+ errno = errkid; /* Propagate errno from kid */
+ STATUS_CURRENT = -1;
+ }
+ }
+ PUSHi(STATUS_CURRENT);
+ RETURN;
+ }
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+ fcntl(pp[1], F_SETFD, FD_CLOEXEC);
#endif
+ }
}
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
#endif
}
-#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
- if (value >= 0)
- my_exit(value);
-#endif
-
SP = ORIGMARK;
PUSHi(value);
RETURN;
PP(pp_kill)
{
+#ifdef HAS_KILL
dSP; dMARK; dTARGET;
I32 value;
-#ifdef HAS_KILL
value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function kill");
+ DIE(aTHX_ PL_no_func, "kill");
#endif
}
PP(pp_getpriority)
{
- dSP; dTARGET;
#ifdef HAS_GETPRIORITY
+ dSP; dTARGET;
int who = POPi;
int which = TOPi;
SETi( getpriority(which, who) );
PP(pp_setpriority)
{
- dSP; dTARGET;
#ifdef HAS_SETPRIORITY
+ dSP; dTARGET;
int niceval = POPi;
int who = POPi;
int which = TOPi;
PP(pp_tms)
{
+#ifdef HAS_TIMES
dSP;
-
-#ifndef HAS_TIMES
- DIE(aTHX_ "times not implemented");
-#else
EXTEND(SP, 4);
-
#ifndef VMS
(void)PerlProc_times(&PL_timesbuf);
#else
PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/HZ)));
}
RETURN;
+#else
+ DIE(aTHX_ "times not implemented");
#endif /* HAS_TIMES */
}
else
tmbuf = gmtime(&when);
- EXTEND(SP, 9);
- EXTEND_MORTAL(9);
if (GIMME != G_ARRAY) {
SV *tsv;
+ EXTEND(SP, 1);
+ EXTEND_MORTAL(1);
if (!tmbuf)
RETPUSHUNDEF;
tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
PUSHs(sv_2mortal(tsv));
}
else if (tmbuf) {
- PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
+ EXTEND(SP, 9);
+ EXTEND_MORTAL(9);
+ PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
PP(pp_alarm)
{
+#ifdef HAS_ALARM
dSP; dTARGET;
int anum;
-#ifdef HAS_ALARM
anum = POPi;
anum = alarm((unsigned int)anum);
EXTEND(SP, 1);
PUSHi(anum);
RETURN;
#else
- DIE(aTHX_ PL_no_func, "Unsupported function alarm");
+ DIE(aTHX_ PL_no_func, "alarm");
#endif
}
PP(pp_ghostent)
{
- dSP;
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gnetent)
{
- dSP;
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gprotoent)
{
- dSP;
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gservent)
{
- dSP;
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_shostent)
{
- dSP;
#ifdef HAS_SETHOSTENT
+ dSP;
PerlSock_sethostent(TOPi);
RETSETYES;
#else
PP(pp_snetent)
{
- dSP;
#ifdef HAS_SETNETENT
+ dSP;
PerlSock_setnetent(TOPi);
RETSETYES;
#else
PP(pp_sprotoent)
{
- dSP;
#ifdef HAS_SETPROTOENT
+ dSP;
PerlSock_setprotoent(TOPi);
RETSETYES;
#else
PP(pp_sservent)
{
- dSP;
#ifdef HAS_SETSERVENT
+ dSP;
PerlSock_setservent(TOPi);
RETSETYES;
#else
PP(pp_ehostent)
{
- dSP;
#ifdef HAS_ENDHOSTENT
+ dSP;
PerlSock_endhostent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_enetent)
{
- dSP;
#ifdef HAS_ENDNETENT
+ dSP;
PerlSock_endnetent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eprotoent)
{
- dSP;
#ifdef HAS_ENDPROTOENT
+ dSP;
PerlSock_endprotoent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eservent)
{
- dSP;
#ifdef HAS_ENDSERVENT
+ dSP;
PerlSock_endservent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_gpwent)
{
- dSP;
#ifdef HAS_PASSWD
+ dSP;
I32 which = PL_op->op_type;
register SV *sv;
STRLEN n_a;
PP(pp_spwent)
{
- dSP;
#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
+ dSP;
setpwent();
RETPUSHYES;
#else
PP(pp_epwent)
{
- dSP;
#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
+ dSP;
endpwent();
RETPUSHYES;
#else
PP(pp_ggrent)
{
- dSP;
#ifdef HAS_GROUP
+ dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_sgrent)
{
- dSP;
#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
+ dSP;
setgrent();
RETPUSHYES;
#else
PP(pp_egrent)
{
- dSP;
#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
+ dSP;
endgrent();
RETPUSHYES;
#else
PP(pp_getlogin)
{
- dSP; dTARGET;
#ifdef HAS_GETLOGIN
+ dSP; dTARGET;
char *tmps;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
projects / p5sagit/p5-mst-13.2.git / blobdiff