clean up the users of PL_no_mem

This commit eliminates a couple strlen()s of a literal. "Out of memory!\n"
and PL_no_mem did not string pool on Visual C, so PL_no_mem was given a
length. This commit removes S_write_no_mem and replaces it with nonstatic.
Perl_croak_no_mem was made nocontext to save instructions in it's callers.
NORETURN_FUNCTION_END caused a syntax error on Visual C C++ mode and
therefore was removed.

diff --git a/embed.fnc b/embed.fnc
index cb5d827..3eb0084 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -249,6 +249,7 @@ Aprd        |void   |vcroak         |NULLOK const char* pat|NULLOK va_list* args
 Anprd  |void   |croak_no_modify
 Anprd  |void   |croak_xs_usage |NN const CV *const cv \
                                |NN const char *const params
+npr    |void   |croak_no_mem
 #if defined(WIN32)
 norx   |void   |win32_croak_not_implemented|NN const char * fname
 #endif
@@ -2198,7 +2199,6 @@ s |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o
 s      |SV*    |mess_alloc
 s      |SV *|with_queued_errors|NN SV *ex
 s      |bool   |invoke_exception_hook|NULLOK SV *ex|bool warn
-sr     |char * |write_no_mem
 #if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
 sn     |void   |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \
                                |NN const char *type_name|NULLOK const SV *sv \

diff --git a/embed.h b/embed.h
index 941e0b8..aaff3f7 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1050,6 +1050,7 @@
 #define core_prototype(a,b,c,d)        Perl_core_prototype(aTHX_ a,b,c,d)
 #define coresub_op(a,b,c)      Perl_coresub_op(aTHX_ a,b,c)
 #define create_eval_scope(a)   Perl_create_eval_scope(aTHX_ a)
+#define croak_no_mem           Perl_croak_no_mem
 #define cv_ckproto_len_flags(a,b,c,d,e)        Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e)
 #define cv_clone_into(a,b)     Perl_cv_clone_into(aTHX_ a,b)
 #define cv_forget_slab(a)      Perl_cv_forget_slab(aTHX_ a)
@@ -1633,7 +1634,6 @@
 #define invoke_exception_hook(a,b)     S_invoke_exception_hook(aTHX_ a,b)
 #define mess_alloc()           S_mess_alloc(aTHX)
 #define with_queued_errors(a)  S_with_queued_errors(aTHX_ a)
-#define write_no_mem()         S_write_no_mem(aTHX)
 #    if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
 #define mem_log_common         S_mem_log_common
 #    endif

diff --git a/perl.h b/perl.h
index 8b33633..f68a336 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4269,7 +4269,7 @@ EXTCONST char PL_no_helem_sv[]
   INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\"");
 EXTCONST char PL_no_modify[]
   INIT("Modification of a read-only value attempted");
-EXTCONST char PL_no_mem[]
+EXTCONST char PL_no_mem[sizeof("Out of memory!\n")]
   INIT("Out of memory!\n");
 EXTCONST char PL_no_security[]
   INIT("Insecure dependency in %s%s");

diff --git a/perlio.c b/perlio.c
index 54ca051..905e043 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2337,10 +2337,7 @@ S_more_refcounted_fds(pTHX_ const int new_fd) {
 #ifdef USE_ITHREADS
        MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
-       /* Can't use PerlIO to write as it allocates memory */
-       PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                     PL_no_mem, strlen(PL_no_mem));
-       my_exit(1);
+       croak_no_mem();
     }
 
     PL_perlio_fd_refcnt_size = new_max;

diff --git a/proto.h b/proto.h
index 83372f8..14d512b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -643,6 +643,9 @@ PERL_CALLCONV_NO_RET void   Perl_croak(pTHX_ const char* pat, ...)
 PERL_STATIC_NO_RET void        S_croak_memory_wrap(void)
                        __attribute__noreturn__;
 
+PERL_CALLCONV_NO_RET void      Perl_croak_no_mem(void)
+                       __attribute__noreturn__;
+
 PERL_CALLCONV_NO_RET void      Perl_croak_no_modify(void)
                        __attribute__noreturn__;
 
@@ -7300,9 +7303,6 @@ STATIC SV *       S_with_queued_errors(pTHX_ SV *ex)
 #define PERL_ARGS_ASSERT_WITH_QUEUED_ERRORS    \
        assert(ex)
 
-PERL_STATIC_NO_RET char *      S_write_no_mem(pTHX)
-                       __attribute__noreturn__;
-
 #  if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
 STATIC void    S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *type_name, const SV *sv, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
                        __attribute__nonnull__(4)

diff --git a/util.c b/util.c
index b7403e8..5132c24 100644 (file)
--- a/util.c
+++ b/util.c
@@ -59,17 +59,6 @@ int putenv(char *);
  * XXX This advice seems to be widely ignored :-(   --AD  August 1996.
  */
 
-static char *
-S_write_no_mem(pTHX)
-{
-    dVAR;
-    /* Can't use PerlIO to write as it allocates memory */
-    PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                 PL_no_mem, strlen(PL_no_mem));
-    my_exit(1);
-    NORETURN_FUNCTION_END;
-}
-
 #if defined (DEBUGGING) || defined(PERL_IMPLICIT_SYS) || defined (PERL_TRACK_MEMPOOL)
 #  define ALWAYS_NEED_THX
 #endif
@@ -131,7 +120,7 @@ Perl_safesysmalloc(MEM_SIZE size)
        if (PL_nomemok)
            return NULL;
        else {
-           return write_no_mem();
+           croak_no_mem();
        }
     }
     /*NOTREACHED*/
@@ -234,7 +223,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
        if (PL_nomemok)
            return NULL;
        else {
-           return write_no_mem();
+           croak_no_mem();
        }
     }
     /*NOTREACHED*/
@@ -368,7 +357,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 #endif
        if (PL_nomemok)
            return NULL;
-       return write_no_mem();
+       croak_no_mem();
     }
 }
 
@@ -1013,7 +1002,7 @@ Perl_savesharedpv(pTHX_ const char *pv)
     pvlen = strlen(pv)+1;
     newaddr = (char*)PerlMemShared_malloc(pvlen);
     if (!newaddr) {
-       return write_no_mem();
+       croak_no_mem();
     }
     return (char*)memcpy(newaddr, pv, pvlen);
 }
@@ -1035,7 +1024,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
     /* PERL_ARGS_ASSERT_SAVESHAREDPVN; */
 
     if (!newaddr) {
-       return write_no_mem();
+       croak_no_mem();
     }
     newaddr[len] = '\0';
     return (char*)memcpy(newaddr, pv, len);
@@ -1630,6 +1619,20 @@ Perl_croak_no_modify()
     Perl_croak_nocontext( "%s", PL_no_modify);
 }
 
+/* does not return, used in util.c perlio.c and win32.c
+   This is typically called when malloc returns NULL.
+*/
+void
+Perl_croak_no_mem()
+{
+    dTHX;
+    dVAR;
+    /* Can't use PerlIO to write as it allocates memory */
+    PerlLIO_write(PerlIO_fileno(Perl_error_log),
+                 PL_no_mem, sizeof(PL_no_mem)-1);
+    my_exit(1);
+}
+
 /*
 =for apidoc Am|void|warn_sv|SV *baseex
 

diff --git a/win32/win32.c b/win32/win32.c
index 818a107..5d6946a 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1662,13 +1662,8 @@ win32_longpath(char *path)
 static void
 out_of_memory(void)
 {
-    if (PL_curinterp) {
-        dTHX;
-        /* Can't use PerlIO to write as it allocates memory */
-        PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                      PL_no_mem, strlen(PL_no_mem));
-        my_exit(1);
-    }
+    if (PL_curinterp)
+       croak_no_mem();
     exit(1);
 }