threads - stack size support

[perl5.git] / util.c

diff --git a/util.c b/util.c
index abd0db9..873d3cb 100644 (file)
--- a/util.c
+++ b/util.c
@@ -895,8 +895,8 @@ Perl_savepv(pTHX_ const char *pv)
 
 Perl's version of what C<strndup()> would be if it existed. Returns a
 pointer to a newly allocated string which is a duplicate of the first
-C<len> bytes from C<pv>. The memory allocated for the new string can be
-freed with the C<Safefree()> function.
+C<len> bytes from C<pv>, plus a trailing NUL byte. The memory allocated for
+the new string can be freed with the C<Safefree()> function.
 
 =cut
 */
@@ -1533,7 +1533,7 @@ Perl_ckwarn_d(pTHX_ U32 w)
 
 /* Set buffer=NULL to get a new one.  */
 STRLEN *
-Perl_new_warnings_bitfield(STRLEN *buffer, const char *const bits,
+Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
                           STRLEN size) {
     const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
 
@@ -1601,15 +1601,15 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
     }
     else
        safesysfree(environ[i]);
-    nlen = strlen(nam);
-    vlen = strlen(val);
+       nlen = strlen(nam);
+       vlen = strlen(val);
 
-    environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
-    /* all that work just for this */
-    my_setenv_format(environ[i], nam, nlen, val, vlen);
+       environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+       /* all that work just for this */
+       my_setenv_format(environ[i], nam, nlen, val, vlen);
     } else {
 # endif
-#   if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__)
+#   if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__) || defined(__riscos__)
 #       if defined(HAS_UNSETENV)
         if (val == NULL) {
             (void)unsetenv(nam);
@@ -1894,8 +1894,8 @@ Perl_my_ntohl(pTHX_ long l)
                type value;                                     \
                char c[sizeof(type)];                           \
            } u;                                                \
-           register I32 i;                                     \
-           register I32 s = 0;                                 \
+           register U32 i;                                     \
+           register U32 s = 0;                                 \
            for (i = 0; i < sizeof(u.c); i++, s += 8) {         \
                u.c[i] = (n >> s) & 0xFF;                       \
            }                                                   \
@@ -1910,8 +1910,8 @@ Perl_my_ntohl(pTHX_ long l)
                type value;                                     \
                char c[sizeof(type)];                           \
            } u;                                                \
-           register I32 i;                                     \
-           register I32 s = 0;                                 \
+           register U32 i;                                     \
+           register U32 s = 0;                                 \
            u.value = n;                                        \
            n = 0;                                              \
            for (i = 0; i < sizeof(u.c); i++, s += 8) {         \
@@ -1932,8 +1932,8 @@ Perl_my_ntohl(pTHX_ long l)
                type value;                                     \
                char c[sizeof(type)];                           \
            } u;                                                \
-           register I32 i;                                     \
-           register I32 s = 8*(sizeof(u.c)-1);                 \
+           register U32 i;                                     \
+           register U32 s = 8*(sizeof(u.c)-1);                 \
            for (i = 0; i < sizeof(u.c); i++, s -= 8) {         \
                u.c[i] = (n >> s) & 0xFF;                       \
            }                                                   \
@@ -1948,8 +1948,8 @@ Perl_my_ntohl(pTHX_ long l)
                type value;                                     \
                char c[sizeof(type)];                           \
            } u;                                                \
-           register I32 i;                                     \
-           register I32 s = 8*(sizeof(u.c)-1);                 \
+           register U32 i;                                     \
+           register U32 s = 8*(sizeof(u.c)-1);                 \
            u.value = n;                                        \
            n = 0;                                              \
            for (i = 0; i < sizeof(u.c); i++, s -= 8) {         \
@@ -2224,7 +2224,8 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
     /* If we managed to get status pipe check for exec fail */
     if (did_pipes && pid > 0) {
        int errkid;
-       int n = 0, n1;
+       unsigned n = 0;
+       SSize_t n1;
 
        while (n < sizeof(int)) {
            n1 = PerlLIO_read(pp[0],
@@ -2376,7 +2377,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
     PL_forkprocess = pid;
     if (did_pipes && pid > 0) {
        int errkid;
-       int n = 0, n1;
+       unsigned n = 0;
+       SSize_t n1;
 
        while (n < sizeof(int)) {
            n1 = PerlLIO_read(pp[0],
@@ -3113,9 +3115,13 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
            if (len == 2 && tmpbuf[0] == '.')
                seen_dot = 1;
 #endif
+#ifdef HAS_STRLCAT
+           (void)strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
+#else
            /* FIXME? Convert to memcpy by storing previous strlen(scriptname)
             */
            (void)strcpy(tmpbuf + len, scriptname);
+#endif /* #ifdef HAS_STRLCAT */
 #endif  /* !VMS */
 
 #ifdef SEARCH_EXTS
@@ -3427,15 +3433,6 @@ Perl_my_fflush_all(pTHX)
 void
 Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 {
-    const char * const func =
-       op == OP_READLINE   ? "readline"  :     /* "<HANDLE>" not nice */
-       op == OP_LEAVEWRITE ? "write" :         /* "write exit" not nice */
-       op < 0              ? "" :              /* handle phoney cases */
-       PL_op_desc[op];
-    const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
-    const char * const type = OP_IS_SOCKET(op)
-           || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
-               ?  "socket" : "filehandle";
     const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
 
     if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
@@ -3464,6 +3461,15 @@ Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
        }
 
        if (ckWARN(warn_type)) {
+           const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+           const char * const func =
+               op == OP_READLINE   ? "readline"  :     /* "<HANDLE>" not nice */
+               op == OP_LEAVEWRITE ? "write" :         /* "write exit" not nice */
+               op < 0              ? "" :              /* handle phoney cases */
+               PL_op_desc[op];
+           const char * const type = OP_IS_SOCKET(op)
+                   || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
+                       ?  "socket" : "filehandle";
            if (name && *name) {
                Perl_warner(aTHX_ packWARN(warn_type),
                            "%s%s on %s %s %s", func, pars, vile, type, name);
@@ -4288,7 +4294,11 @@ Perl_upg_version(pTHX_ SV *ver)
     if ( SvNOK(ver) ) /* may get too much accuracy */ 
     {
        char tbuf[64];
-       const STRLEN len = my_sprintf(tbuf,"%.9"NVgf, SvNVX(ver));
+#ifdef USE_SNPRINTF
+       const STRLEN len = snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+#else
+       const STRLEN len = my_sprintf(tbuf, "%.9"NVgf, SvNVX(ver));
+#endif /* #ifdef USE_SNPRINTF */
        version = savepvn(tbuf, len);
     }
 #ifdef SvVOK
@@ -4924,6 +4934,8 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
                      opt |= PERL_UNICODE_LOCALE_FLAG;  break;
                 case PERL_UNICODE_ARGV:
                      opt |= PERL_UNICODE_ARGV_FLAG;    break;
+                case PERL_UNICODE_UTF8CACHEASSERT:
+                     opt |= PERL_UNICODE_UTF8CACHEASSERT_FLAG; break;
                 default:
                      if (*p != '\n' && *p != '\r')
                          Perl_croak(aTHX_