ext/DynaLoader/dlutils.c

   1 /* dlutils.c - handy functions and definitions for dl_*.xs files
   2  *
   3  * Currently this file is simply #included into dl_*.xs/.c files.
   4  * It should really be split into a dlutils.h and dlutils.c
   5  *
   6  * Modified:
   7  * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
   8  *                      files when the interpreter exits
   9  */
  10
  11 #ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
  12 #   include "EXTERN.h"
  13 #   include "perl.h"
  14 #   include "XSUB.h"
  15 #endif
  16
  17 #ifndef XS_VERSION
  18 #  define XS_VERSION "0"
  19 #endif
  20 #define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
  21
  22 typedef struct {
  23     SV*         x_dl_last_error;        /* pointer to allocated memory for
  24                                            last error message */
  25     int         x_dl_nonlazy;           /* flag for immediate rather than lazy
  26                                            linking (spots unresolved symbol) */
  27 #ifdef DL_LOADONCEONLY
  28     HV *        x_dl_loaded_files;      /* only needed on a few systems */
  29 #endif
  30 #ifdef DL_CXT_EXTRA
  31     my_cxtx_t   x_dl_cxtx;              /* extra platform-specific data */
  32 #endif
  33 #ifdef DEBUGGING
  34     int         x_dl_debug;     /* value copied from $DynaLoader::dl_debug */
  35 #endif
  36 } my_cxt_t;
  37
  38 START_MY_CXT
  39
  40 #define dl_last_error   (SvPVX(MY_CXT.x_dl_last_error))
  41 #define dl_nonlazy      (MY_CXT.x_dl_nonlazy)
  42 #ifdef DL_LOADONCEONLY
  43 #define dl_loaded_files (MY_CXT.x_dl_loaded_files)
  44 #endif
  45 #ifdef DL_CXT_EXTRA
  46 #define dl_cxtx         (MY_CXT.x_dl_cxtx)
  47 #endif
  48 #ifdef DEBUGGING
  49 #define dl_debug        (MY_CXT.x_dl_debug)
  50 #endif
  51
  52 #ifdef DEBUGGING
  53 #define DLDEBUG(level,code) \
  54     STMT_START {                                        \
  55         dMY_CXT;                                        \
  56         if (dl_debug>=level) { code; }                  \
  57     } STMT_END
  58 #else
  59 #define DLDEBUG(level,code)     NOOP
  60 #endif
  61
  62 #ifdef DL_UNLOAD_ALL_AT_EXIT
  63 /* Close all dlopen'd files */
  64 static void
  65 dl_unload_all_files(pTHX_ void *unused)
  66 {
  67     CV *sub;
  68     AV *dl_librefs;
  69     SV *dl_libref;
  70
  71     if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
  72         dl_librefs = get_av("DynaLoader::dl_librefs", 0);
  73         while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
  74            dSP;
  75            ENTER;
  76            SAVETMPS;
  77            PUSHMARK(SP);
  78            XPUSHs(sv_2mortal(dl_libref));
  79            PUTBACK;
  80            call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
  81            FREETMPS;
  82            LEAVE;
  83         }
  84     }
  85 }
  86 #endif
  87
  88 static void
  89 dl_generic_private_init(pTHX)   /* called by dl_*.xs dl_private_init() */
  90 {
  91     char *perl_dl_nonlazy;
  92     MY_CXT_INIT;
  93
  94     MY_CXT.x_dl_last_error = newSVpvn("", 0);
  95     dl_nonlazy = 0;
  96 #ifdef DL_LOADONCEONLY
  97     dl_loaded_files = NULL;
  98 #endif
  99 #ifdef DEBUGGING
 100     {
 101         SV *sv = get_sv("DynaLoader::dl_debug", 0);
 102         dl_debug = sv ? SvIV(sv) : 0;
 103     }
 104 #endif
 105     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
 106         dl_nonlazy = atoi(perl_dl_nonlazy);
 107     if (dl_nonlazy)
 108         DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
 109 #ifdef DL_LOADONCEONLY
 110     if (!dl_loaded_files)
 111         dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 112 #endif
 113 #ifdef DL_UNLOAD_ALL_AT_EXIT
 114     call_atexit(&dl_unload_all_files, (void*)0);
 115 #endif
 116 }
 117
 118
 119 #ifndef SYMBIAN
 120 /* SaveError() takes printf style args and saves the result in dl_last_error */
 121 static void
 122 SaveError(pTHX_ const char* pat, ...)
 123 {
 124     dMY_CXT;
 125     va_list args;
 126     SV *msv;
 127     const char *message;
 128     STRLEN len;
 129
 130     /* This code is based on croak/warn, see mess() in util.c */
 131
 132     va_start(args, pat);
 133     msv = vmess(pat, &args);
 134     va_end(args);
 135
 136     message = SvPV(msv,len);
 137     len++;              /* include terminating null char */
 138
 139     /* Copy message into dl_last_error (including terminating null char) */
 140     sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
 141     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
 142 }
 143 #endif
 144