*/
#include "EXTERN.h"
+#define PERL_IN_PP_SYS_C
#include "perl.h"
#ifdef I_SHADOW
#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
# include <sys/socket.h>
+# if defined(USE_SOCKS) && defined(I_SOCKS)
+# include <socks.h>
+# endif
# ifdef I_NETDB
# include <netdb.h>
# endif
# ifdef I_PWD
# include <pwd.h>
# else
- struct passwd *getpwnam _((char *));
- struct passwd *getpwuid _((Uid_t));
+ struct passwd *getpwnam (char *);
+ struct passwd *getpwuid (Uid_t);
# endif
# ifdef HAS_GETPWENT
- struct passwd *getpwent _((void));
+ struct passwd *getpwent (void);
# endif
#endif
# ifdef I_GRP
# include <grp.h>
# else
- struct group *getgrnam _((char *));
- struct group *getgrgid _((Gid_t));
+ struct group *getgrnam (char *);
+ struct group *getgrgid (Gid_t);
# endif
# ifdef HAS_GETGRENT
- struct group *getgrent _((void));
+ struct group *getgrent (void);
# endif
#endif
# endif
#endif
-#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
-static int dooneliner _((char *cmd, char *filename));
-#endif
-
#ifdef HAS_CHSIZE
# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */
# undef my_chsize
# endif /* no flock() or fcntl(F_SETLK,...) */
# ifdef FLOCK
- static int FLOCK _((int, int));
+ static int FLOCK (int, int);
/*
* These are the flock() constants. Since this sytems doesn't have
|| defined(HAS_SETREGID) || defined(HAS_SETRESGID))
/* The Hard Way. */
STATIC int
-emulate_eaccess (const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, int mode)
{
Uid_t ruid = getuid();
Uid_t euid = geteuid();
MUTEX_LOCK(&PL_cred_mutex);
#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
- croak("switching effective uid is not implemented");
+ Perl_croak(aTHX_ "switching effective uid is not implemented");
#else
#ifdef HAS_SETREUID
if (setreuid(euid, ruid))
if (setresuid(euid, ruid, (Uid_t)-1))
#endif
#endif
- croak("entering effective uid failed");
+ Perl_croak(aTHX_ "entering effective uid failed");
#endif
#if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
- croak("switching effective gid is not implemented");
+ Perl_croak(aTHX_ "switching effective gid is not implemented");
#else
#ifdef HAS_SETREGID
if (setregid(egid, rgid))
if (setresgid(egid, rgid, (Gid_t)-1))
#endif
#endif
- croak("entering effective gid failed");
+ Perl_croak(aTHX_ "entering effective gid failed");
#endif
res = access(path, mode);
if (setresuid(ruid, euid, (Uid_t)-1))
#endif
#endif
- croak("leaving effective uid failed");
+ Perl_croak(aTHX_ "leaving effective uid failed");
#ifdef HAS_SETREGID
if (setregid(rgid, egid))
if (setresgid(rgid, egid, (Gid_t)-1))
#endif
#endif
- croak("leaving effective gid failed");
+ Perl_croak(aTHX_ "leaving effective gid failed");
MUTEX_UNLOCK(&PL_cred_mutex);
return res;
#if !defined(PERL_EFF_ACCESS_R_OK)
STATIC int
-emulate_eaccess (const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, int mode)
{
- croak("switching effective uid is not implemented");
+ Perl_croak(aTHX_ "switching effective uid is not implemented");
/*NOTREACHED*/
return -1;
}
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
- warn("%_", tmpsv);
+ Perl_warn(aTHX_ "%_", tmpsv);
RETSETYES;
}
PUSHs(file);
PUSHs(line);
PUTBACK;
- perl_call_sv((SV*)GvCV(gv),
- G_SCALAR|G_EVAL|G_KEEPERR);
+ call_sv((SV*)GvCV(gv),
+ G_SCALAR|G_EVAL|G_KEEPERR);
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE(Nullch);
+ DIE(aTHX_ Nullch);
}
else {
if (SvPOK(error) && SvCUR(error))
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvn("Died", 4));
- DIE("%_", tmpsv);
+ DIE(aTHX_ "%_", tmpsv);
}
/* I/O. */
if (MAXARG > 1)
sv = POPs;
if (!isGV(TOPs))
- DIE(PL_no_usym, "filehandle");
+ DIE(aTHX_ PL_no_usym, "filehandle");
if (MAXARG <= 1)
sv = GvSV(TOPs);
gv = (GV*)POPs;
if (!isGV(gv))
- DIE(PL_no_usym, "filehandle");
+ DIE(aTHX_ PL_no_usym, "filehandle");
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
XPUSHs(sv);
PUTBACK;
ENTER;
- perl_call_method("OPEN", G_SCALAR);
+ call_method("OPEN", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("CLOSE", G_SCALAR);
+ call_method("CLOSE", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
goto badexit;
if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
- DIE(PL_no_usym, "filehandle");
+ DIE(aTHX_ PL_no_usym, "filehandle");
rstio = GvIOn(rgv);
wstio = GvIOn(wgv);
badexit:
RETPUSHUNDEF;
#else
- DIE(PL_no_func, "pipe");
+ DIE(aTHX_ PL_no_func, "pipe");
#endif
}
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("FILENO", G_SCALAR);
+ call_method("FILENO", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
* Otherwise it's harmless and more useful to just return undef
* since 'group' and 'other' concepts probably don't exist here. */
if (MAXARG >= 1 && (POPi & 0700))
- DIE("umask not implemented");
+ DIE(aTHX_ "umask not implemented");
XPUSHs(&PL_sv_undef);
#endif
RETURN;
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("BINMODE", G_SCALAR);
+ call_method("BINMODE", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
while (items--)
PUSHs(*MARK++);
PUTBACK;
- perl_call_method(methname, G_SCALAR);
+ call_method(methname, G_SCALAR);
}
else {
- /* Not clear why we don't call perl_call_method here too.
+ /* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
stash = gv_stashsv(*MARK, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
- DIE("Can't locate object method \"%s\" via package \"%s\"",
+ DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
methname, SvPV(*MARK,n_a));
}
ENTER;
while (items--)
PUSHs(*MARK++);
PUTBACK;
- perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+ call_sv((SV*)GvCV(gv), G_SCALAR);
}
SPAGAIN;
MAGIC * mg ;
if (mg = SvTIED_mg(sv, how)) {
if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)
- warner(WARN_UNTIE,
+ Perl_warner(aTHX_ WARN_UNTIE,
"untie attempted while %lu inner references still exist",
(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
}
stash = gv_stashsv(sv, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
- perl_require_pv("AnyDBM_File.pm");
+ require_pv("AnyDBM_File.pm");
SPAGAIN;
if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
- DIE("No dbm on this machine");
+ DIE(aTHX_ "No dbm on this machine");
}
ENTER;
PUSHs(sv_2mortal(newSViv(O_RDWR)));
PUSHs(right);
PUTBACK;
- perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+ call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
if (!sv_isobject(TOPs)) {
PUSHs(sv_2mortal(newSViv(O_RDONLY)));
PUSHs(right);
PUTBACK;
- perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+ call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
}
PP(pp_dbmclose)
{
- return pp_untie(ARGS);
+ return pp_untie();
}
PP(pp_sselect)
register I32 j;
register char *s;
register SV *sv;
- double value;
+ NV value;
I32 maxlen = 0;
I32 nfound;
struct timeval timebuf;
if (value < 0.0)
value = 0.0;
timebuf.tv_sec = (long)value;
- value -= (double)timebuf.tv_sec;
+ value -= (NV)timebuf.tv_sec;
timebuf.tv_usec = (long)(value * 1000000.0);
}
else
PUSHi(nfound);
if (GIMME == G_ARRAY && tbuf) {
- value = (double)(timebuf.tv_sec) +
- (double)(timebuf.tv_usec) / 1000000.0;
+ value = (NV)(timebuf.tv_sec) +
+ (NV)(timebuf.tv_usec) / 1000000.0;
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setnv(sv, value);
}
RETURN;
#else
- DIE("select not implemented");
+ DIE(aTHX_ "select not implemented");
#endif
}
void
-setdefout(GV *gv)
+Perl_setdefout(pTHX_ GV *gv)
{
dTHR;
if (gv)
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("GETC", gimme);
+ call_method("GETC", gimme);
LEAVE;
SPAGAIN;
if (gimme == G_SCALAR)
PP(pp_read)
{
- return pp_sysread(ARGS);
+ return pp_sysread();
}
STATIC OP *
-doform(CV *cv, GV *gv, OP *retop)
+S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
dTHR;
register PERL_CONTEXT *cx;
if (fgv) {
SV *tmpsv = sv_newmortal();
gv_efullname3(tmpsv, fgv, Nullch);
- DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
+ DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv));
}
- DIE("Not a format reference");
+ DIE(aTHX_ "Not a format reference");
}
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
if (!IoTOP_NAME(io)) {
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
- topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io)));
+ topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
!gv_fetchpv("top",FALSE,SVt_PVFM))
IoFLAGS(io) |= IOf_DIDTOP;
fgv = IoTOP_GV(io);
if (!fgv)
- DIE("bad top format reference");
+ DIE(aTHX_ "bad top format reference");
cv = GvFORM(fgv);
if (!cv) {
SV *tmpsv = sv_newmortal();
gv_efullname3(tmpsv, fgv, Nullch);
- DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
+ DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv));
}
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
fp = IoOFP(io);
if (!fp) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
if (IoIFP(io))
- warner(WARN_IO, "Filehandle only opened for input");
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input",
+ SvPV_nolen(sv));
else if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "Write on closed filehandle");
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "Write on closed filehandle %s", SvPV_nolen(sv));
}
PUSHs(&PL_sv_no);
}
else {
if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
if (ckWARN(WARN_IO))
- warner(WARN_IO, "page overflow");
+ Perl_warner(aTHX_ WARN_IO, "page overflow");
}
if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
PerlIO_error(fp))
*MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
- perl_call_method("PRINTF", G_SCALAR);
+ call_method("PRINTF", G_SCALAR);
LEAVE;
SPAGAIN;
MARK = ORIGMARK + 1;
sv = NEWSV(0,0);
if (!(io = GvIO(gv))) {
if (ckWARN(WARN_UNOPENED)) {
- gv_fullname3(sv, gv, Nullch);
- warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_UNOPENED,
+ "Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- gv_fullname3(sv, gv, Nullch);
+ gv_efullname3(sv, gv, Nullch);
if (IoIFP(io))
- warner(WARN_IO, "Filehandle %s opened only for input",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input",
+ SvPV(sv,n_a));
else if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "printf on closed filehandle %s",
- SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "printf on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
-#ifdef USE_LOCALE_NUMERIC
- if (PL_op->op_private & OPpLOCALE)
- SET_NUMERIC_LOCAL();
- else
- SET_NUMERIC_STANDARD();
-#endif
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
PUSHMARK(MARK-1);
*MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
- perl_call_method("READ", G_SCALAR);
+ call_method("READ", G_SCALAR);
LEAVE;
SPAGAIN;
sv = POPs;
buffer = SvPV_force(bufsv, blen);
length = SvIVx(*++MARK);
if (length < 0)
- DIE("Negative length");
+ DIE(aTHX_ "Negative length");
SETERRNO(0,0);
if (MARK < SP)
offset = SvIVx(*++MARK);
#else
bufsize = sizeof namebuf;
#endif
+#ifdef OS2 /* At least Warp3+IAK: only the first byte of bufsize set */
+ if (bufsize >= 256)
+ bufsize = 255;
+#endif
buffer = SvGROW(bufsv, length+1);
/* 'offset' means 'flags' here */
length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
}
#else
if (PL_op->op_type == OP_RECV)
- DIE(PL_no_sock_func, "recv");
+ DIE(aTHX_ PL_no_sock_func, "recv");
#endif
if (offset < 0) {
if (-offset > blen)
- DIE("Offset outside string");
+ DIE(aTHX_ "Offset outside string");
offset += blen;
}
bufsize = SvCUR(bufsv);
if (length == 0 && PerlIO_error(IoIFP(io)))
length = -1;
}
- if (length < 0)
+ if (length < 0) {
+ if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ || IoIFP(io) == PerlIO_stderr())
+ {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
+ Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+ SvPV_nolen(sv));
+ }
goto say_undef;
+ }
SvCUR_set(bufsv, length+offset);
*SvEND(bufsv) = '\0';
(void)SvPOK_only(bufsv);
PUSHs(sv);
PUTBACK;
}
- return pp_send(ARGS);
+ return pp_send();
}
PP(pp_send)
PUSHMARK(MARK-1);
*MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
- perl_call_method("WRITE", G_SCALAR);
+ call_method("WRITE", G_SCALAR);
LEAVE;
SPAGAIN;
sv = POPs;
buffer = SvPV(bufsv, blen);
length = SvIVx(*++MARK);
if (length < 0)
- DIE("Negative length");
+ DIE(aTHX_ "Negative length");
SETERRNO(0,0);
io = GvIO(gv);
if (!io || !IoIFP(io)) {
length = -1;
if (ckWARN(WARN_CLOSED)) {
if (PL_op->op_type == OP_SYSWRITE)
- warner(WARN_CLOSED, "Syswrite on closed filehandle");
+ Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle");
else
- warner(WARN_CLOSED, "Send on closed socket");
+ Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
}
}
else if (PL_op->op_type == OP_SYSWRITE) {
offset = SvIVx(*++MARK);
if (offset < 0) {
if (-offset > blen)
- DIE("Offset outside string");
+ DIE(aTHX_ "Offset outside string");
offset += blen;
} else if (offset >= blen && blen > 0)
- DIE("Offset outside string");
+ DIE(aTHX_ "Offset outside string");
} else
offset = 0;
if (length > blen - offset)
#else
else
- DIE(PL_no_sock_func, "send");
+ DIE(aTHX_ PL_no_sock_func, "send");
#endif
if (length < 0)
goto say_undef;
PP(pp_recv)
{
- return pp_sysread(ARGS);
+ return pp_sysread();
}
PP(pp_eof)
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("EOF", G_SCALAR);
+ call_method("EOF", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
- perl_call_method("TELL", G_SCALAR);
+ call_method("TELL", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
PP(pp_seek)
{
- return pp_sysseek(ARGS);
+ return pp_sysseek();
}
PP(pp_sysseek)
XPUSHs(sv_2mortal(newSViv((IV) whence)));
PUTBACK;
ENTER;
- perl_call_method("SEEK", G_SCALAR);
+ call_method("SEEK", G_SCALAR);
LEAVE;
SPAGAIN;
RETURN;
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#else
- DIE("truncate not implemented");
+ DIE(aTHX_ "truncate not implemented");
#endif
}
PP(pp_fcntl)
{
- return pp_ioctl(ARGS);
+ return pp_ioctl();
}
PP(pp_ioctl)
#ifdef HAS_IOCTL
retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s);
#else
- DIE("ioctl is not implemented");
+ DIE(aTHX_ "ioctl is not implemented");
#endif
else
#ifdef HAS_FCNTL
retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
#endif
#else
- DIE("fcntl is not implemented");
+ DIE(aTHX_ "fcntl is not implemented");
#endif
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
- DIE("Possible memory corruption: %s overflowed 3rd argument",
+ DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
PL_op_name[optype]);
s[SvCUR(argsv)] = 0; /* put our null back */
SvSETMAGIC(argsv); /* Assume it has changed */
PUSHi(value);
RETURN;
#else
- DIE(PL_no_func, "flock()");
+ DIE(aTHX_ PL_no_func, "flock()");
#endif
}
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "socket");
+ DIE(aTHX_ PL_no_sock_func, "socket");
#endif
}
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "socketpair");
+ DIE(aTHX_ PL_no_sock_func, "socketpair");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "bind() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "bind");
+ DIE(aTHX_ PL_no_sock_func, "bind");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "connect() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "connect");
+ DIE(aTHX_ PL_no_sock_func, "connect");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "listen() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "listen");
+ DIE(aTHX_ PL_no_sock_func, "listen");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "accept() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
badexit:
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "accept");
+ DIE(aTHX_ PL_no_sock_func, "accept");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "shutdown() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "shutdown");
+ DIE(aTHX_ PL_no_sock_func, "shutdown");
#endif
}
PP(pp_gsockopt)
{
#ifdef HAS_SOCKET
- return pp_ssockopt(ARGS);
+ return pp_ssockopt();
#else
- DIE(PL_no_sock_func, "getsockopt");
+ DIE(aTHX_ PL_no_sock_func, "getsockopt");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "[gs]etsockopt() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "setsockopt");
+ DIE(aTHX_ PL_no_sock_func, "setsockopt");
#endif
}
PP(pp_getsockname)
{
#ifdef HAS_SOCKET
- return pp_getpeername(ARGS);
+ return pp_getpeername();
#else
- DIE(PL_no_sock_func, "getsockname");
+ DIE(aTHX_ PL_no_sock_func, "getsockname");
#endif
}
nuts:
if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "get{sock, peer}name() on closed fd");
+ Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
#else
- DIE(PL_no_sock_func, "getpeername");
+ DIE(aTHX_ PL_no_sock_func, "getpeername");
#endif
}
PP(pp_lstat)
{
- return pp_stat(ARGS);
+ return pp_stat();
}
PP(pp_stat)
PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
if (PL_laststatval < 0) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
- warner(WARN_NEWLINE, PL_warn_nl, "stat");
+ Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat");
max = 0;
}
}
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
RETPUSHNO;
}
else
- result = my_stat(ARGS);
+ result = my_stat();
#else
- result = my_stat(ARGS);
+ result = my_stat();
#endif
SPAGAIN;
if (result < 0)
PP(pp_ftis)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_fteowned)
{
- return pp_ftrowned(ARGS);
+ return pp_ftrowned();
}
PP(pp_ftrowned)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftzero)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftsize)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftmtime)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftatime)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftctime)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftsock)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftchr)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftblk)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftfile)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftdir)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftpipe)
{
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
djSP;
if (result < 0)
RETPUSHUNDEF;
PP(pp_ftlink)
{
- I32 result = my_lstat(ARGS);
+ I32 result = my_lstat();
djSP;
if (result < 0)
RETPUSHUNDEF;
{
djSP;
#ifdef S_ISUID
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
{
djSP;
#ifdef S_ISGID
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
{
djSP;
#ifdef S_ISVTX
- I32 result = my_stat(ARGS);
+ I32 result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
}
if (io && IoIFP(io)) {
if (! PerlIO_has_base(IoIFP(io)))
- DIE("-T and -B not implemented on filehandles");
+ DIE(aTHX_ "-T and -B not implemented on filehandles");
PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
if (PL_laststatval < 0)
RETPUSHUNDEF;
}
else {
if (ckWARN(WARN_UNOPENED))
- warner(WARN_UNOPENED, "Test on unopened file <%s>",
+ Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
GvENAME(cGVOP->op_gv));
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#endif
if (i < 0) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
- warner(WARN_NEWLINE, PL_warn_nl, "open");
+ Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
RETPUSHUNDEF;
}
PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
PP(pp_ftbinary)
{
- return pp_fttext(ARGS);
+ return pp_fttext();
}
/* File calls. */
PUSHi(value);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function chown");
+ DIE(aTHX_ PL_no_func, "Unsupported function chown");
#endif
}
PUSHi( chroot(tmps) >= 0 );
RETURN;
#else
- DIE(PL_no_func, "chroot");
+ DIE(aTHX_ PL_no_func, "chroot");
#endif
}
TAINT_PROPER("link");
SETi( link(tmps, tmps2) >= 0 );
#else
- DIE(PL_no_func, "Unsupported function link");
+ DIE(aTHX_ PL_no_func, "Unsupported function link");
#endif
RETURN;
}
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
#else
- DIE(PL_no_func, "symlink");
+ DIE(aTHX_ PL_no_func, "symlink");
#endif
}
#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
STATIC int
-dooneliner(char *cmd, char *filename)
+S_dooneliner(pTHX_ char *cmd, char *filename)
{
char *save_filename = filename;
char *cmdline;
SETERRNO(EBADF,RMS$_DIR);
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "opendir");
+ DIE(aTHX_ PL_no_dir_func, "opendir");
#endif
}
djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
#ifndef I_DIRENT
- Direntry_t *readdir _((DIR *));
+ Direntry_t *readdir (DIR *);
#endif
register Direntry_t *dp;
GV *gv = (GV*)POPs;
else
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "readdir");
+ DIE(aTHX_ PL_no_dir_func, "readdir");
#endif
}
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
--JHI 1999-Feb-02 */
# if !defined(HAS_TELLDIR_PROTO) || defined(NEED_TELLDIR_PROTO)
- long telldir _((DIR *));
+ long telldir (DIR *);
# endif
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "telldir");
+ DIE(aTHX_ PL_no_dir_func, "telldir");
#endif
}
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "seekdir");
+ DIE(aTHX_ PL_no_dir_func, "seekdir");
#endif
}
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "rewinddir");
+ DIE(aTHX_ PL_no_dir_func, "rewinddir");
#endif
}
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#else
- DIE(PL_no_dir_func, "closedir");
+ DIE(aTHX_ PL_no_dir_func, "closedir");
#endif
}
PUSHi(childpid);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function fork");
+ DIE(aTHX_ PL_no_func, "Unsupported function fork");
#endif
}
XPUSHi(childpid);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function wait");
+ DIE(aTHX_ PL_no_func, "Unsupported function wait");
#endif
}
SETi(childpid);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function waitpid");
+ DIE(aTHX_ PL_no_func, "Unsupported function waitpid");
#endif
}
#else /* ! FORK or VMS or OS/2 */
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
- value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
+ value = (I32)do_aspawn(aTHX_ really, (void **)MARK, (void **)SP);
}
else if (SP - MARK != 1)
- value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
+ value = (I32)do_aspawn(aTHX_ Nullsv, (void **)MARK, (void **)SP);
else {
- value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+ value = (I32)do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
}
STATUS_NATIVE_SET(value);
do_execfree();
#else
# ifdef __OPEN_VM
{
- (void ) do_aspawn(Nullsv, MARK, SP);
+ (void ) do_aspawn(aTHX_ Nullsv, MARK, SP);
value = 0;
}
# else
value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#else
# ifdef __OPEN_VM
- (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+ (void) do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
value = 0;
# else
value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
PUSHi(value);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function kill");
+ DIE(aTHX_ PL_no_func, "Unsupported function kill");
#endif
}
XPUSHi( getppid() );
RETURN;
#else
- DIE(PL_no_func, "getppid");
+ DIE(aTHX_ PL_no_func, "getppid");
#endif
}
value = (I32)BSD_GETPGRP(pid);
#else
if (pid != 0 && pid != getpid())
- DIE("POSIX getpgrp can't take an argument");
+ DIE(aTHX_ "POSIX getpgrp can't take an argument");
value = (I32)getpgrp();
#endif
XPUSHi(value);
RETURN;
#else
- DIE(PL_no_func, "getpgrp()");
+ DIE(aTHX_ PL_no_func, "getpgrp()");
#endif
}
SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
#else
if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
- DIE("POSIX setpgrp can't take an argument");
+ DIE(aTHX_ "POSIX setpgrp can't take an argument");
SETi( setpgrp() >= 0 );
#endif /* USE_BSDPGRP */
RETURN;
#else
- DIE(PL_no_func, "setpgrp()");
+ DIE(aTHX_ PL_no_func, "setpgrp()");
#endif
}
SETi( getpriority(which, who) );
RETURN;
#else
- DIE(PL_no_func, "getpriority()");
+ DIE(aTHX_ PL_no_func, "getpriority()");
#endif
}
SETi( setpriority(which, who, niceval) >= 0 );
RETURN;
#else
- DIE(PL_no_func, "setpriority()");
+ DIE(aTHX_ PL_no_func, "setpriority()");
#endif
}
djSP;
#ifndef HAS_TIMES
- DIE("times not implemented");
+ DIE(aTHX_ "times not implemented");
#else
EXTEND(SP, 4);
/* is returned. */
#endif
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_utime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/HZ)));
if (GIMME == G_ARRAY) {
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_stime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cutime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cstime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/HZ)));
}
RETURN;
#endif /* HAS_TIMES */
PP(pp_localtime)
{
- return pp_gmtime(ARGS);
+ return pp_gmtime();
}
PP(pp_gmtime)
SV *tsv;
if (!tmbuf)
RETPUSHUNDEF;
- tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d",
+ tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
dayname[tmbuf->tm_wday],
monname[tmbuf->tm_mon],
tmbuf->tm_mday,
PUSHi((I32)anum);
RETURN;
#else
- DIE(PL_no_func, "Unsupported function alarm");
+ DIE(aTHX_ PL_no_func, "Unsupported function alarm");
#endif
}
PP(pp_shmget)
{
- return pp_semget(ARGS);
+ return pp_semget();
}
PP(pp_shmctl)
{
- return pp_semctl(ARGS);
+ return pp_semctl();
}
PP(pp_shmread)
{
- return pp_shmwrite(ARGS);
+ return pp_shmwrite();
}
PP(pp_shmwrite)
PUSHi(value);
RETURN;
#else
- return pp_semget(ARGS);
+ return pp_semget();
#endif
}
PP(pp_msgget)
{
- return pp_semget(ARGS);
+ return pp_semget();
}
PP(pp_msgctl)
{
- return pp_semctl(ARGS);
+ return pp_semctl();
}
PP(pp_msgsnd)
PUSHi(value);
RETURN;
#else
- return pp_semget(ARGS);
+ return pp_semget();
#endif
}
PUSHi(value);
RETURN;
#else
- return pp_semget(ARGS);
+ return pp_semget();
#endif
}
PUSHi(anum);
RETURN;
#else
- DIE("System V IPC is not implemented on this machine");
+ DIE(aTHX_ "System V IPC is not implemented on this machine");
#endif
}
}
RETURN;
#else
- return pp_semget(ARGS);
+ return pp_semget();
#endif
}
PUSHi(value);
RETURN;
#else
- return pp_semget(ARGS);
+ return pp_semget();
#endif
}
PP(pp_ghbyname)
{
#ifdef HAS_GETHOSTBYNAME
- return pp_ghostent(ARGS);
+ return pp_ghostent();
#else
- DIE(PL_no_sock_func, "gethostbyname");
+ DIE(aTHX_ PL_no_sock_func, "gethostbyname");
#endif
}
PP(pp_ghbyaddr)
{
#ifdef HAS_GETHOSTBYADDR
- return pp_ghostent(ARGS);
+ return pp_ghostent();
#else
- DIE(PL_no_sock_func, "gethostbyaddr");
+ DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
#endif
}
#ifdef HAS_GETHOSTBYNAME
hent = PerlSock_gethostbyname(POPpx);
#else
- DIE(PL_no_sock_func, "gethostbyname");
+ DIE(aTHX_ PL_no_sock_func, "gethostbyname");
#endif
else if (which == OP_GHBYADDR) {
#ifdef HAS_GETHOSTBYADDR
hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
#else
- DIE(PL_no_sock_func, "gethostbyaddr");
+ DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
#endif
}
else
#ifdef HAS_GETHOSTENT
hent = PerlSock_gethostent();
#else
- DIE(PL_no_sock_func, "gethostent");
+ DIE(aTHX_ PL_no_sock_func, "gethostent");
#endif
#ifdef HOST_NOT_FOUND
}
RETURN;
#else
- DIE(PL_no_sock_func, "gethostent");
+ DIE(aTHX_ PL_no_sock_func, "gethostent");
#endif
}
PP(pp_gnbyname)
{
#ifdef HAS_GETNETBYNAME
- return pp_gnetent(ARGS);
+ return pp_gnetent();
#else
- DIE(PL_no_sock_func, "getnetbyname");
+ DIE(aTHX_ PL_no_sock_func, "getnetbyname");
#endif
}
PP(pp_gnbyaddr)
{
#ifdef HAS_GETNETBYADDR
- return pp_gnetent(ARGS);
+ return pp_gnetent();
#else
- DIE(PL_no_sock_func, "getnetbyaddr");
+ DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
#endif
}
#ifdef HAS_GETNETBYNAME
nent = PerlSock_getnetbyname(POPpx);
#else
- DIE(PL_no_sock_func, "getnetbyname");
+ DIE(aTHX_ PL_no_sock_func, "getnetbyname");
#endif
else if (which == OP_GNBYADDR) {
#ifdef HAS_GETNETBYADDR
Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
nent = PerlSock_getnetbyaddr(addr, addrtype);
#else
- DIE(PL_no_sock_func, "getnetbyaddr");
+ DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
#endif
}
else
#ifdef HAS_GETNETENT
nent = PerlSock_getnetent();
#else
- DIE(PL_no_sock_func, "getnetent");
+ DIE(aTHX_ PL_no_sock_func, "getnetent");
#endif
EXTEND(SP, 4);
RETURN;
#else
- DIE(PL_no_sock_func, "getnetent");
+ DIE(aTHX_ PL_no_sock_func, "getnetent");
#endif
}
PP(pp_gpbyname)
{
#ifdef HAS_GETPROTOBYNAME
- return pp_gprotoent(ARGS);
+ return pp_gprotoent();
#else
- DIE(PL_no_sock_func, "getprotobyname");
+ DIE(aTHX_ PL_no_sock_func, "getprotobyname");
#endif
}
PP(pp_gpbynumber)
{
#ifdef HAS_GETPROTOBYNUMBER
- return pp_gprotoent(ARGS);
+ return pp_gprotoent();
#else
- DIE(PL_no_sock_func, "getprotobynumber");
+ DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
#endif
}
#ifdef HAS_GETPROTOBYNAME
pent = PerlSock_getprotobyname(POPpx);
#else
- DIE(PL_no_sock_func, "getprotobyname");
+ DIE(aTHX_ PL_no_sock_func, "getprotobyname");
#endif
else if (which == OP_GPBYNUMBER)
#ifdef HAS_GETPROTOBYNUMBER
pent = PerlSock_getprotobynumber(POPi);
#else
- DIE(PL_no_sock_func, "getprotobynumber");
+ DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
#endif
else
#ifdef HAS_GETPROTOENT
pent = PerlSock_getprotoent();
#else
- DIE(PL_no_sock_func, "getprotoent");
+ DIE(aTHX_ PL_no_sock_func, "getprotoent");
#endif
EXTEND(SP, 3);
RETURN;
#else
- DIE(PL_no_sock_func, "getprotoent");
+ DIE(aTHX_ PL_no_sock_func, "getprotoent");
#endif
}
PP(pp_gsbyname)
{
#ifdef HAS_GETSERVBYNAME
- return pp_gservent(ARGS);
+ return pp_gservent();
#else
- DIE(PL_no_sock_func, "getservbyname");
+ DIE(aTHX_ PL_no_sock_func, "getservbyname");
#endif
}
PP(pp_gsbyport)
{
#ifdef HAS_GETSERVBYPORT
- return pp_gservent(ARGS);
+ return pp_gservent();
#else
- DIE(PL_no_sock_func, "getservbyport");
+ DIE(aTHX_ PL_no_sock_func, "getservbyport");
#endif
}
sent = PerlSock_getservbyname(name, proto);
#else
- DIE(PL_no_sock_func, "getservbyname");
+ DIE(aTHX_ PL_no_sock_func, "getservbyname");
#endif
}
else if (which == OP_GSBYPORT) {
#endif
sent = PerlSock_getservbyport(port, proto);
#else
- DIE(PL_no_sock_func, "getservbyport");
+ DIE(aTHX_ PL_no_sock_func, "getservbyport");
#endif
}
else
#ifdef HAS_GETSERVENT
sent = PerlSock_getservent();
#else
- DIE(PL_no_sock_func, "getservent");
+ DIE(aTHX_ PL_no_sock_func, "getservent");
#endif
EXTEND(SP, 4);
RETURN;
#else
- DIE(PL_no_sock_func, "getservent");
+ DIE(aTHX_ PL_no_sock_func, "getservent");
#endif
}
PerlSock_sethostent(TOPi);
RETSETYES;
#else
- DIE(PL_no_sock_func, "sethostent");
+ DIE(aTHX_ PL_no_sock_func, "sethostent");
#endif
}
PerlSock_setnetent(TOPi);
RETSETYES;
#else
- DIE(PL_no_sock_func, "setnetent");
+ DIE(aTHX_ PL_no_sock_func, "setnetent");
#endif
}
PerlSock_setprotoent(TOPi);
RETSETYES;
#else
- DIE(PL_no_sock_func, "setprotoent");
+ DIE(aTHX_ PL_no_sock_func, "setprotoent");
#endif
}
PerlSock_setservent(TOPi);
RETSETYES;
#else
- DIE(PL_no_sock_func, "setservent");
+ DIE(aTHX_ PL_no_sock_func, "setservent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "endhostent");
+ DIE(aTHX_ PL_no_sock_func, "endhostent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "endnetent");
+ DIE(aTHX_ PL_no_sock_func, "endnetent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "endprotoent");
+ DIE(aTHX_ PL_no_sock_func, "endprotoent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(PL_no_sock_func, "endservent");
+ DIE(aTHX_ PL_no_sock_func, "endservent");
#endif
}
PP(pp_gpwnam)
{
#ifdef HAS_PASSWD
- return pp_gpwent(ARGS);
+ return pp_gpwent();
#else
- DIE(PL_no_func, "getpwnam");
+ DIE(aTHX_ PL_no_func, "getpwnam");
#endif
}
PP(pp_gpwuid)
{
#ifdef HAS_PASSWD
- return pp_gpwent(ARGS);
+ return pp_gpwent();
#else
- DIE(PL_no_func, "getpwuid");
+ DIE(aTHX_ PL_no_func, "getpwuid");
#endif
}
struct passwd *pwent;
STRLEN n_a;
#ifdef HAS_GETSPENT
- struct spwd *spwent;
+ struct spwd *spwent = NULL;
#endif
if (which == OP_GPWNAM)
pwent = (struct passwd *)getpwent();
#ifdef HAS_GETSPNAM
- if (which == OP_GPWNAM)
- spwent = getspnam(pwent->pw_name);
+ if (which == OP_GPWNAM) {
+ if (pwent)
+ spwent = getspnam(pwent->pw_name);
+ }
# ifdef HAS_GETSPUID /* AFAIK there isn't any anywhere. --jhi */
- else if (which == OP_GPWUID)
- spwent = getspnam(pwent->pw_name);
+ else if (which == OP_GPWUID) {
+ if (pwent)
+ spwent = getspnam(pwent->pw_name);
+ }
# endif
- else
- spwent = (struct spwd *)getspent();
+ else
+ spwent = (struct spwd *)getspent();
#endif
EXTEND(SP, 10);
}
RETURN;
#else
- DIE(PL_no_func, "getpwent");
+ DIE(aTHX_ PL_no_func, "getpwent");
#endif
}
# endif
RETPUSHYES;
#else
- DIE(PL_no_func, "setpwent");
+ DIE(aTHX_ PL_no_func, "setpwent");
#endif
}
# endif
RETPUSHYES;
#else
- DIE(PL_no_func, "endpwent");
+ DIE(aTHX_ PL_no_func, "endpwent");
#endif
}
PP(pp_ggrnam)
{
#ifdef HAS_GROUP
- return pp_ggrent(ARGS);
+ return pp_ggrent();
#else
- DIE(PL_no_func, "getgrnam");
+ DIE(aTHX_ PL_no_func, "getgrnam");
#endif
}
PP(pp_ggrgid)
{
#ifdef HAS_GROUP
- return pp_ggrent(ARGS);
+ return pp_ggrent();
#else
- DIE(PL_no_func, "getgrgid");
+ DIE(aTHX_ PL_no_func, "getgrgid");
#endif
}
RETURN;
#else
- DIE(PL_no_func, "getgrent");
+ DIE(aTHX_ PL_no_func, "getgrent");
#endif
}
setgrent();
RETPUSHYES;
#else
- DIE(PL_no_func, "setgrent");
+ DIE(aTHX_ PL_no_func, "setgrent");
#endif
}
endgrent();
RETPUSHYES;
#else
- DIE(PL_no_func, "endgrent");
+ DIE(aTHX_ PL_no_func, "endgrent");
#endif
}
PUSHp(tmps, strlen(tmps));
RETURN;
#else
- DIE(PL_no_func, "getlogin");
+ DIE(aTHX_ PL_no_func, "getlogin");
#endif
}
}
switch (items) {
default:
- DIE("Too many args to syscall");
+ DIE(aTHX_ "Too many args to syscall");
case 0:
- DIE("Too few args to syscall");
+ DIE(aTHX_ "Too few args to syscall");
case 1:
retval = syscall(a[0]);
break;
PUSHi(retval);
RETURN;
#else
- DIE(PL_no_func, "syscall");
+ DIE(aTHX_ PL_no_func, "syscall");
#endif
}
# define F_TEST 3 /* Test a region for other processes locks */
# endif
-STATIC int
-lockf_emulate_flock (int fd, int operation)
+static int
+lockf_emulate_flock(int fd, int operation)
{
int i;
int save_errno;
projects / p5sagit/p5-mst-13.2.git / blobdiff