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