ext/DynaLoader/dl_beos.xs

   1 /*
   2  * dl_beos.xs, by Tom Spindler
   3  * based on dl_dlopen.xs, by Paul Marquess
   4  */
   5
   6 #include "EXTERN.h"
   7 #include "perl.h"
   8 #include "XSUB.h"
   9
  10 #include <be/kernel/image.h>
  11 #include <OS.h>
  12 #include <stdlib.h>
  13 #include <limits.h>
  14
  15 #define dlerror() strerror(errno)
  16
  17 #include "dlutils.c"    /* SaveError() etc      */
  18
  19 static void
  20 dl_private_init(pTHX)
  21 {
  22     (void)dl_generic_private_init(aTHX);
  23 }
  24
  25 MODULE = DynaLoader     PACKAGE = DynaLoader
  26
  27 BOOT:
  28     (void)dl_private_init(aTHX);
  29
  30
  31 void *
  32 dl_load_file(filename, flags=0)
  33     char *      filename
  34     int         flags
  35     CODE:
  36 {   image_id bogo;
  37     char *path;
  38     path = malloc(PATH_MAX);
  39     if (*filename != '/') {
  40       getcwd(path, PATH_MAX);
  41       strcat(path, "/");
  42       strcat(path, filename);
  43     } else {
  44       strcpy(path, filename);
  45     }
  46
  47     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
  48     bogo = load_add_on(path);
  49     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
  50     ST(0) = sv_newmortal() ;
  51     if (bogo < 0) {
  52         SaveError(aTHX_ "%s", strerror(bogo));
  53         PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
  54     } else {
  55         RETVAL = (void *) bogo;
  56         sv_setiv( ST(0), PTR2IV(RETVAL) );
  57     }
  58     free(path);
  59 }
  60
  61 void *
  62 dl_find_symbol(libhandle, symbolname)
  63     void *      libhandle
  64     char *      symbolname
  65     CODE:
  66     status_t retcode;
  67     void *adr = 0;
  68 #ifdef DLSYM_NEEDS_UNDERSCORE
  69     symbolname = Perl_form_nocontext("_%s", symbolname);
  70 #endif
  71     RETVAL = NULL;
  72     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  73                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
  74                              (unsigned long) libhandle, symbolname));
  75     retcode = get_image_symbol((image_id) libhandle, symbolname,
  76                                B_SYMBOL_TYPE_TEXT, (void **) &adr);
  77     RETVAL = adr;
  78     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  79                              "  symbolref = %lx\n", (unsigned long) RETVAL));
  80     ST(0) = sv_newmortal() ;
  81     if (RETVAL == NULL) {
  82         SaveError(aTHX_ "%s", strerror(retcode)) ;
  83         PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
  84     } else
  85         sv_setiv( ST(0), PTR2IV(RETVAL));
  86
  87
  88 void
  89 dl_undef_symbols()
  90     PPCODE:
  91
  92
  93
  94 # These functions should not need changing on any platform:
  95
  96 void
  97 dl_install_xsub(perl_name, symref, filename="$Package")
  98     char *              perl_name
  99     void *              symref
 100     const char *        filename
 101     CODE:
 102     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
 103                 perl_name, (unsigned long) symref));
 104     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
 105                                               (void(*)(pTHX_ CV *))symref,
 106                                               filename, NULL,
 107                                               XS_DYNAMIC_FILENAME)));
 108
 109
 110 char *
 111 dl_error()
 112     CODE:
 113     dMY_CXT;
 114     RETVAL = dl_last_error ;
 115     OUTPUT:
 116     RETVAL
 117
 118 #if defined(USE_ITHREADS)
 119
 120 void
 121 CLONE(...)
 122     CODE:
 123     MY_CXT_CLONE;
 124
 125     /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
 126      * using Perl variables that belong to another thread, we create our
 127      * own for this thread.
 128      */
 129     MY_CXT.x_dl_last_error = newSVpvn("", 0);
 130
 131 #endif
 132
 133 # end.