ext/DynaLoader/dl_beos.xs

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