This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove x2p remnants
[perl5.git] / util.c
diff --git a/util.c b/util.c
index fca7132..4666233 100644 (file)
--- a/util.c
+++ b/util.c
@@ -51,8 +51,16 @@ int putenv(char *);
 # endif
 #endif
 
-/* <bfd.h> will have been included, if necessary, by "perl.h" */
 #ifdef USE_C_BACKTRACE
+#  ifdef I_BFD
+#    define USE_BFD
+#    ifdef PERL_DARWIN
+#      undef USE_BFD /* BFD is useless in OS X. */
+#    endif
+#    ifdef USE_BFD
+#      include <bfd.h>
+#    endif
+#  endif
 #  ifdef I_DLFCN
 #    include <dlfcn.h>
 #  endif
@@ -67,10 +75,6 @@ int putenv(char *);
 
 #define FLUSH
 
-#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
-#  define FD_CLOEXEC 1                 /* NeXT needs this */
-#endif
-
 /* NOTE:  Do not call the next three routines directly.  Use the macros
  * in handy.h, so that we can easily redefine everything to do tracking of
  * allocated hunks back to the original New to track down any memory leaks.
@@ -921,7 +925,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     /* This function must only ever be called on a scalar with study magic,
        but those do not happen any more. */
     Perl_croak(aTHX_ "panic: screaminstr");
-    return NULL;
+    NORETURN_FUNCTION_END;
 }
 
 /*
@@ -1090,6 +1094,9 @@ Perl_savesharedpv(pTHX_ const char *pv)
 {
     char *newaddr;
     STRLEN pvlen;
+
+    PERL_UNUSED_CONTEXT;
+
     if (!pv)
        return NULL;
 
@@ -1115,6 +1122,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
 {
     char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
 
+    PERL_UNUSED_CONTEXT;
     /* PERL_ARGS_ASSERT_SAVESHAREDPVN; */
 
     if (!newaddr) {
@@ -1365,12 +1373,12 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
     dVAR;
     SV *sv;
 
-#if defined(USE_C_BACKTRACE) && defined(USE_C_BACKTRACE_ON_WARN)
+#if defined(USE_C_BACKTRACE) && defined(USE_C_BACKTRACE_ON_ERROR)
     {
         char *ws;
         int wi;
         /* The PERL_C_BACKTRACE_ON_WARN must be an integer of one or more. */
-        if ((ws = PerlEnv_getenv("PERL_C_BACKTRACE_ON_WARN")) &&
+        if ((ws = PerlEnv_getenv("PERL_C_BACKTRACE_ON_ERROR")) &&
             (wi = atoi(ws)) > 0) {
             Perl_dump_c_backtrace(aTHX_ Perl_debug_log, wi, 1);
         }
@@ -1564,7 +1572,7 @@ Perl_die_sv(pTHX_ SV *baseex)
     PERL_ARGS_ASSERT_DIE_SV;
     croak_sv(baseex);
     assert(0); /* NOTREACHED */
-    return NULL;
+    NORETURN_FUNCTION_END;
 }
 
 /*
@@ -1587,7 +1595,7 @@ Perl_die_nocontext(const char* pat, ...)
     vcroak(pat, &args);
     assert(0); /* NOTREACHED */
     va_end(args);
-    return NULL;
+    NORETURN_FUNCTION_END;
 }
 #endif /* PERL_IMPLICIT_CONTEXT */
 
@@ -1599,7 +1607,7 @@ Perl_die(pTHX_ const char* pat, ...)
     vcroak(pat, &args);
     assert(0); /* NOTREACHED */
     va_end(args);
-    return NULL;
+    NORETURN_FUNCTION_END;
 }
 
 /*
@@ -3508,7 +3516,7 @@ Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have)
        if (name && HEK_LEN(name))
            Perl_warner(aTHX_ packWARN(WARN_IO),
                        "Filehandle %"HEKf" opened only for %sput",
-                       name, direction);
+                       HEKfARG(name), direction);
        else
            Perl_warner(aTHX_ packWARN(WARN_IO),
                        "Filehandle opened only for %sput", direction);
@@ -3591,12 +3599,14 @@ Perl_init_tm(pTHX_ struct tm *ptm)      /* see mktime, strftime and asctime */
 #ifdef HAS_TM_TM_ZONE
     Time_t now;
     const struct tm* my_tm;
+    PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_INIT_TM;
     (void)time(&now);
     my_tm = localtime(&now);
     if (my_tm)
         Copy(my_tm, ptm, 1, struct tm);
 #else
+    PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_INIT_TM;
     PERL_UNUSED_ARG(ptm);
 #endif
@@ -4763,7 +4773,7 @@ S_mem_log_common(enum mem_log_type mlt, const UV n,
            if (strchr(pmlenv, 't')) {
                len = my_snprintf(buf, sizeof(buf),
                                MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG);
-               PerlLIO_write(fd, buf, len);
+               PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len));
            }
            switch (mlt) {
            case MLT_ALLOC:
@@ -4798,7 +4808,7 @@ S_mem_log_common(enum mem_log_type mlt, const UV n,
            default:
                len = 0;
            }
-           PerlLIO_write(fd, buf, len);
+           PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len));
        }
     }
 }
@@ -5163,10 +5173,10 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
     else {
        /* XXX GV_ADDWARN */
        vn = "XS_VERSION";
-       sv = get_sv(Perl_form(aTHX_ "%"SVf"::%s", module, vn), 0);
+       sv = get_sv(Perl_form(aTHX_ "%"SVf"::%s", SVfARG(module), vn), 0);
        if (!sv || !SvOK(sv)) {
            vn = "VERSION";
-           sv = get_sv(Perl_form(aTHX_ "%"SVf"::%s", module, vn), 0);
+           sv = get_sv(Perl_form(aTHX_ "%"SVf"::%s", SVfARG(module), vn), 0);
        }
     }
     if (sv) {
@@ -5177,16 +5187,16 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
        if ( vcmp(pmsv,xssv) ) {
            SV *string = vstringify(xssv);
            SV *xpt = Perl_newSVpvf(aTHX_ "%"SVf" object version %"SVf
-                                   " does not match ", module, string);
+                                   " does not match ", SVfARG(module), SVfARG(string));
 
            SvREFCNT_dec(string);
            string = vstringify(pmsv);
 
            if (vn) {
-               Perl_sv_catpvf(aTHX_ xpt, "$%"SVf"::%s %"SVf, module, vn,
-                              string);
+               Perl_sv_catpvf(aTHX_ xpt, "$%"SVf"::%s %"SVf, SVfARG(module), vn,
+                              SVfARG(string));
            } else {
-               Perl_sv_catpvf(aTHX_ xpt, "bootstrap parameter %"SVf, string);
+               Perl_sv_catpvf(aTHX_ xpt, "bootstrap parameter %"SVf, SVfARG(string));
            }
            SvREFCNT_dec(string);
 
@@ -5215,7 +5225,8 @@ Perl_xs_apiversion_bootcheck(pTHX_ SV *module, const char *api_p,
        SV *runver_string = vstringify(runver);
        xpt = Perl_newSVpvf(aTHX_ "Perl API version %"SVf
                            " of %"SVf" does not match %"SVf,
-                           compver_string, module, runver_string);
+                           SVfARG(compver_string), SVfARG(module),
+                           SVfARG(runver_string));
        Perl_sv_2mortal(aTHX_ xpt);
 
        SvREFCNT_dec(compver_string);
@@ -5380,8 +5391,10 @@ Perl_my_dirfd(pTHX_ DIR * dir) {
     if(!dir)
         return -1;
 #ifdef HAS_DIRFD
+    PERL_UNUSED_CONTEXT;
     return dirfd(dir);
 #elif defined(HAS_DIR_DD_FD)
+    PERL_UNUSED_CONTEXT;
     return dir->dd_fd;
 #else
     Perl_die(aTHX_ PL_no_func, "dirfd");
@@ -5510,8 +5523,11 @@ Perl_drand48_r(perl_drand48_t *random_state)
 #ifdef USE_BFD
 
 typedef struct {
+    /* abfd is the BFD handle. */
     bfd* abfd;
+    /* bfd_syms is the BFD symbol table. */
     asymbol** bfd_syms;
+    /* bfd_text is handle to the the ".text" section of the object file. */
     asection* bfd_text;
     /* Since opening the executable and scanning its symbols is quite
      * heavy operation, we remember the filename we used the last time,
@@ -5615,10 +5631,20 @@ static void bfd_symbolize(bfd_context* ctx,
  * use high-level stuff.  Thanks, Apple. */
 
 typedef struct {
+    /* tool is set to the absolute pathname of the tool to use:
+     * xcrun or atos. */
     const char* tool;
+    /* format is set to a printf format string used for building
+     * the external command to run. */
     const char* format;
+    /* unavail is set if e.g. xcrun cannot be found, or something
+     * else happens that makes getting the backtrace dubious.  Note,
+     * however, that the context isn't persistent, the next call to
+     * get_c_backtrace() will start from scratch. */
     bool unavail;
+    /* fname is the current object file name. */
     const char* fname;
+    /* object_base_addr is the base address of the shared object. */
     void* object_base_addr;
 } atos_context;
 
@@ -5754,7 +5780,6 @@ static void atos_symbolize(atos_context* ctx,
          * We could play tricks with atos by batching the stack
          * addresses to be resolved: atos can either take multiple
          * addresses from the command line, or read addresses from
-         *
          * a file (though the mess of creating temporary files would
          * probably negate much of any possible speedup).
          *
@@ -5879,9 +5904,9 @@ Perl_get_c_backtrace(pTHX_ int depth, int skip)
     /* We use dladdr() instead of backtrace_symbols() because we want
      * the full details instead of opaque strings.  This is useful for
      * two reasons: () the details are needed for further symbolic
-     * digging (2) by having the details we fully control the output,
-     * which in turn is useful when more platforms are added:
-     * we can keep out output "portable". */
+     * digging, for example in OS X (2) by having the details we fully
+     * control the output, which in turn is useful when more platforms
+     * are added: we can keep out output "portable". */
 
     /* We want a single linear allocation, which can then be freed
      * with a single swoop.  We will do the usual trick of first