# 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.
*/
return Nullch;
}
+/* Initialize locale (and the fold[] array).*/
+int
+perl_init_i18nl14n(printwarn)
+ int printwarn;
+{
+ int ok = 1;
+ /* returns
+ * 1 = set ok or not applicable,
+ * 0 = fallback to C locale,
+ * -1 = fallback to C locale failed
+ */
+#if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
+ char * lang = getenv("LANG");
+ char * lc_all = getenv("LC_ALL");
+ char * lc_ctype = getenv("LC_CTYPE");
+ int i;
+
+ if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
+ if (printwarn) {
+ fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
+ fprintf(stderr,
+ "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
+ lc_all ? lc_all : "(null)",
+ lc_ctype ? lc_ctype : "(null)",
+ lang ? lang : "(null)"
+ );
+ fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
+ }
+ ok = 0;
+ if (setlocale(LC_CTYPE, "C") == NULL)
+ ok = -1;
+ }
+
+ for (i = 0; i < 256; i++) {
+ if (isUPPER(i)) fold[i] = toLOWER(i);
+ else if (isLOWER(i)) fold[i] = toUPPER(i);
+ else fold[i] = i;
+ }
+#endif
+ return ok;
+}
+
void
fbm_compile(sv, iflag)
SV *sv;
long a1, a2, a3, a4;
{
char *s;
+ char *s_start;
I32 usermess = strEQ(pat,"%s");
SV *tmpstr;
- s = buf;
+ s = s_start = buf;
if (usermess) {
tmpstr = sv_newmortal();
sv_setpv(tmpstr, (char*)a1);
s += strlen(s);
}
(void)strcpy(s,".\n");
+ s += 2;
}
if (usermess)
sv_catpv(tmpstr,buf+1);
}
+
+ if (s - s_start >= sizeof(buf)) { /* Ooops! */
+ if (usermess)
+ fputs(SvPVX(tmpstr), stderr);
+ else
+ fputs(buf, stderr);
+ fputs("panic: message overflow - memory corrupted!\n",stderr);
+ my_exit(1);
+ }
if (usermess)
return SvPVX(tmpstr);
else
}
if (in_eval) {
restartop = die_where(message);
- longjmp(top_env, 3);
+ Siglongjmp(top_env, 3);
}
fputs(message,stderr);
- (void)fflush(stderr);
- if (e_fp)
+ (void)Fflush(stderr);
+ if (e_fp) {
+ fclose(e_fp);
+ e_fp = Nullfp;
(void)UNLINK(e_tmpname);
+ }
statusvalue = SHIFTSTATUS(statusvalue);
#ifdef VMS
my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
#ifdef LEAKTEST
DEBUG_L(xstat());
#endif
- (void)fflush(stderr);
+ (void)Fflush(stderr);
}
}
#endif
{
char *s;
+ char *s_start;
SV *tmpstr;
I32 usermess;
#ifndef HAS_VPRINTF
#endif
#endif
- s = buf;
+ s = s_start = buf;
usermess = strEQ(pat, "%s");
if (usermess) {
tmpstr = sv_newmortal();
SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
s += strlen(s);
}
- if (GvIO(last_in_gv) &&
- IoLINES(GvIOp(last_in_gv)) ) {
+ if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
+ bool line_mode = (RsSIMPLE(rs) &&
+ SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
(void)sprintf(s,", <%s> %s %ld",
last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
- strEQ(rs,"\n") ? "line" : "chunk",
+ line_mode ? "line" : "chunk",
(long)IoLINES(GvIOp(last_in_gv)));
s += strlen(s);
}
(void)strcpy(s,".\n");
+ s += 2;
}
if (usermess)
sv_catpv(tmpstr,buf+1);
}
+ if (s - s_start >= sizeof(buf)) { /* Ooops! */
+ if (usermess)
+ fputs(SvPVX(tmpstr), stderr);
+ else
+ fputs(buf, stderr);
+ fputs("panic: message overflow - memory corrupted!\n",stderr);
+ my_exit(1);
+ }
if (usermess)
return SvPVX(tmpstr);
else
}
if (in_eval) {
restartop = die_where(message);
- longjmp(top_env, 3);
+ Siglongjmp(top_env, 3);
}
fputs(message,stderr);
- (void)fflush(stderr);
- if (e_fp)
+ (void)Fflush(stderr);
+ if (e_fp) {
+ fclose(e_fp);
+ e_fp = Nullfp;
(void)UNLINK(e_tmpname);
+ }
statusvalue = SHIFTSTATUS(statusvalue);
#ifdef VMS
my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
#ifdef LEAKTEST
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 */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
VTOH(vtohl,long)
#endif
-#if !defined(DOSISH) && !defined(VMS) /* VMS' my_popen() is in VMS.c */
+#if !defined(DOSISH) && !defined(VMS) /* VMS' my_popen() is in
+ VMS.c, same with OS/2. */
FILE *
my_popen(cmd,mode)
char *cmd;
return fdopen(p[this], mode);
}
#else
-#ifdef atarist
+#if defined(atarist)
FILE *popen();
FILE *
my_popen(cmd,mode)
}
#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;
signal(SIGQUIT, qstat);
return(pid < 0 ? pid : status);
}
-#endif /* !VMS */
+#endif /* !DOSISH */
+
+#if !defined(DOSISH) || defined(OS2)
I32
wait4pid(pid,statusp,flags)
int 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
*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