# include <vfork.h>
#endif
+#ifdef I_LIMITS /* Needed for cast_xxx() functions below. */
+# include <limits.h>
+#endif
+
+/* Put this after #includes because fork and vfork prototypes may
+ conflict.
+*/
+#ifndef HAS_VFORK
+# define vfork fork
+#endif
+
#ifdef I_FCNTL
# include <fcntl.h>
#endif
I32 rarest = 0;
U32 frequency = 256;
+ if (len > 255)
+ return; /* can't have offsets that big */
Sv_Grow(sv,len+258);
table = (unsigned char*)(SvPVX(sv) + len + 1);
s = table - 2;
{
char *tmps;
char *message;
+ HV *stash;
+ GV *gv;
+ CV *cv;
message = mess(pat,a1,a2,a3,a4);
+ if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dSP;
+
+ PUSHMARK(sp);
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVpv(message,0)));
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
if (in_eval) {
restartop = die_where(message);
longjmp(top_env, 3);
(void)fflush(stderr);
if (e_fp)
(void)UNLINK(e_tmpname);
- statusvalue >>= 8;
- my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+ statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+ my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
+ my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
}
/*VARARGS1*/
long a1, a2, a3, a4;
{
char *message;
+ SV *sv;
+ HV *stash;
+ GV *gv;
+ CV *cv;
message = mess(pat,a1,a2,a3,a4);
- fputs(message,stderr);
+ if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dSP;
+
+ PUSHMARK(sp);
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVpv(message,0)));
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
+ else {
+ fputs(message,stderr);
#ifdef LEAKTEST
- DEBUG_L(xstat());
+ DEBUG_L(xstat());
#endif
- (void)fflush(stderr);
+ (void)fflush(stderr);
+ }
}
#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
{
va_list args;
char *message;
+ HV *stash;
+ GV *gv;
+ CV *cv;
#ifdef I_STDARG
va_start(args, pat);
#endif
message = mess(pat, &args);
va_end(args);
+ if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dSP;
+
+ PUSHMARK(sp);
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVpv(message,0)));
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
if (in_eval) {
restartop = die_where(message);
longjmp(top_env, 3);
(void)fflush(stderr);
if (e_fp)
(void)UNLINK(e_tmpname);
- statusvalue >>= 8;
- my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+ statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+ my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
+#else
+ my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
}
void
{
va_list args;
char *message;
+ HV *stash;
+ GV *gv;
+ CV *cv;
#ifdef I_STDARG
va_start(args, pat);
message = mess(pat, &args);
va_end(args);
- fputs(message,stderr);
+ if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+ dSP;
+
+ PUSHMARK(sp);
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVpv(message,0)));
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
+ else {
+ fputs(message,stderr);
#ifdef LEAKTEST
- DEBUG_L(xstat());
+ DEBUG_L(xstat());
#endif
- (void)fflush(stderr);
+ (void)fflush(stderr);
+ }
}
#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
}
#endif /* !VMS */
-#ifdef EUNICE
+#ifdef UNLINK_ALL_VERSIONS
I32
unlnk(f) /* unlink all versions of a file */
char *f;
}
#endif /* HAS_MEMCMP */
-#ifdef I_VARARGS
+#if defined(I_STDARG) || defined(I_VARARGS)
#ifndef HAS_VPRINTF
#ifdef USE_CHAR_VSPRINTF
return 0; /* wrong, but perl doesn't use the return value */
}
#endif /* HAS_VPRINTF */
-#endif /* I_VARARGS */
+#endif /* I_VARARGS || I_STDARGS */
-/*
- * I think my_swap(), htonl() and ntohl() have never been used.
- * perl.h contains last-chance references to my_swap(), my_htonl()
- * and my_ntohl(). I presume these are the intended functions;
- * but htonl() and ntohl() have the wrong names. There are no
- * functions my_htonl() and my_ntohl() defined anywhere.
- * -DWS
- */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
short
+#ifndef CAN_PROTOTYPE
my_swap(s)
short s;
+#else
+my_swap(short s)
+#endif
{
#if (BYTEORDER & 1) == 0
short result;
}
long
-htonl(l)
+#ifndef CAN_PROTOTYPE
+my_htonl(l)
register long l;
+#else
+my_htonl(long l)
+#endif
{
union {
long result;
}
long
-ntohl(l)
+#ifndef CAN_PROTOTYPE
+my_ntohl(l)
register long l;
+#else
+my_ntohl(long l)
+#endif
{
union {
long l;
return fdopen(p[this], mode);
}
#else
-#ifdef atarist
+#if defined(atarist) || defined(OS2)
FILE *popen();
FILE *
my_popen(cmd,mode)
#endif /* !DOSISH */
-#ifdef NOTDEF
+#ifdef DUMP_FDS
dump_fds(s)
char *s;
{
#endif
#ifndef HAS_DUP2
+int
dup2(oldfd,newfd)
int oldfd;
int newfd;
{
#if defined(HAS_FCNTL) && defined(F_DUPFD)
+ if (oldfd == newfd)
+ return oldfd;
close(newfd);
- fcntl(oldfd, F_DUPFD, newfd);
+ return fcntl(oldfd, F_DUPFD, newfd);
#else
int fdtmp[256];
I32 fdx = 0;
int fd;
if (oldfd == newfd)
- return 0;
+ return oldfd;
close(newfd);
- while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */
+ while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
fdtmp[fdx++] = fd;
while (fdx > 0)
close(fdtmp[--fdx]);
+ return fd;
#endif
}
#endif
-#ifndef DOSISH
-#ifndef VMS /* VMS' my_pclose() is in VMS.c */
+#if !defined(DOSISH) && !defined(VMS) /* VMS' my_popen() is in VMS.c */
I32
my_pclose(ptr)
FILE *ptr;
int pid;
svp = av_fetch(fdpid,fileno(ptr),TRUE);
- pid = SvIVX(*svp);
+ pid = (int)SvIVX(*svp);
SvREFCNT_dec(*svp);
*svp = &sv_undef;
fclose(ptr);
hstat = signal(SIGHUP, SIG_IGN);
istat = signal(SIGINT, SIG_IGN);
qstat = signal(SIGQUIT, SIG_IGN);
- pid = wait4pid(pid, &status, 0);
+ do {
+ pid = wait4pid(pid, &status, 0);
+ } while (pid == -1 && errno == EINTR);
signal(SIGHUP, hstat);
signal(SIGINT, istat);
signal(SIGQUIT, qstat);
return(pid < 0 ? pid : status);
}
-#endif /* !VMS */
+#endif /* !DOSISH */
+
+#if !defined(DOSISH) || defined(OS2)
I32
wait4pid(pid,statusp,flags)
int pid;
svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
if (svp && *svp != &sv_undef) {
*statusp = SvIVX(*svp);
- hv_delete(pidstatus,spid,strlen(spid));
+ (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
return pid;
}
}
sv = hv_iterval(pidstatus,entry);
*statusp = SvIVX(sv);
sprintf(spid, "%d", pid);
- hv_delete(pidstatus,spid,strlen(spid));
+ (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
return pid;
}
}
return;
}
-#ifdef atarist
+#if defined(atarist) || defined(OS2)
int pclose();
I32
my_pclose(ptr)
#endif
#ifndef CASTI32
+
+/* Look for MAX and MIN integral values. If we can't find them,
+ we'll use 32-bit two's complement defaults.
+*/
+#ifndef LONG_MAX
+# ifdef MAXLONG /* Often used in <values.h> */
+# define LONG_MAX MAXLONG
+# else
+# define LONG_MAX 2147483647L
+# endif
+#endif
+
+#ifndef LONG_MIN
+# define LONG_MIN (-LONG_MAX - 1)
+#endif
+
+#ifndef ULONG_MAX
+# ifdef MAXULONG
+# define LONG_MAX MAXULONG
+# else
+# define ULONG_MAX 4294967295L
+# endif
+#endif
+
+/* Unfortunately, on some systems the cast_uv() function doesn't
+ work with the system-supplied definition of ULONG_MAX. The
+ comparison (f >= ULONG_MAX) always comes out true. It must be a
+ problem with the compiler constant folding.
+
+ In any case, this workaround should be fine on any two's complement
+ system. If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
+ ccflags.
+ --Andy Dougherty <doughera@lafcol.lafayette.edu>
+*/
+#ifndef MY_ULONG_MAX
+# define MY_ULONG_MAX ((UV)LONG_MAX * (UV)2 + (UV)1)
+#endif
+
I32
cast_i32(f)
double f;
{
-# define BIGDOUBLE 2147483648.0 /* Assume 32 bit int's ! */
-# define BIGNEGDOUBLE (-2147483648.0)
- if (f >= BIGDOUBLE)
- return (I32)fmod(f, BIGDOUBLE);
- if (f <= BIGNEGDOUBLE)
- return (I32)fmod(f, BIGNEGDOUBLE);
+ if (f >= LONG_MAX)
+ return (I32) LONG_MAX;
+ if (f <= LONG_MIN)
+ return (I32) LONG_MIN;
return (I32) f;
}
-# undef BIGDOUBLE
-# undef BIGNEGDOUBLE
IV
cast_iv(f)
double f;
{
- /* XXX This should be fixed. It assumes 32 bit IV's. */
-# define BIGDOUBLE 2147483648.0 /* Assume 32 bit IV's ! */
-# define BIGNEGDOUBLE (-2147483648.0)
- if (f >= BIGDOUBLE)
- return (IV)fmod(f, BIGDOUBLE);
- if (f <= BIGNEGDOUBLE)
- return (IV)fmod(f, BIGNEGDOUBLE);
+ if (f >= LONG_MAX)
+ return (IV) LONG_MAX;
+ if (f <= LONG_MIN)
+ return (IV) LONG_MIN;
return (IV) f;
}
-# undef BIGDOUBLE
-# undef BIGNEGDOUBLE
+
+UV
+cast_uv(f)
+double f;
+{
+ if (f >= MY_ULONG_MAX)
+ return (UV) MY_ULONG_MAX;
+ return (UV) f;
+}
+
#endif
#ifndef HAS_RENAME
register char *s = start;
register unsigned long retval = 0;
- while (len-- && *s >= '0' && *s <= '7') {
+ while (len && *s >= '0' && *s <= '7') {
retval <<= 3;
retval |= *s++ - '0';
+ len--;
}
+ if (dowarn && len && (*s == '8' || *s == '9'))
+ warn("Illegal octal digit ignored");
*retlen = s - start;
return retval;
}
*retlen = s - start;
return retval;
}
-
-/* Amazingly enough, some systems (e.g. Dynix 3) don't have fmod.
- This is a slow, stupid, but working emulation. (AD)
-*/
-#ifdef USE_MY_FMOD
-double
-my_fmod(x, y)
-double x, y;
-{
- double i = 0.0; /* Can't use int because it can overflow */
- if ((x == 0) || (y == 0))
- return 0;
- /* The sign of fmod is the same as the sign of x. */
- if ( (x < 0 && y > 0) || (x > 0 && y < 0) )
- y = -y;
- if (x > 0) {
- while (x - i*y > y)
- i++;
- } else {
- while (x - i*y < y)
- i++;
- }
- return x - i * y;
-}
-#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff