home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dl_beos.xs < prev    next >
Text File  |  2000-01-02  |  3KB  |  118 lines
  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(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
  49.     bogo = load_add_on(path);
  50.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
  51.     ST(0) = sv_newmortal() ;
  52.     if (bogo < 0) {
  53.     SaveError(aTHX_ "%s", strerror(bogo));
  54.     PerlIO_printf(Perl_debug_log, "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 = Perl_form_nocontext("_%s", symbolname);
  71. #endif
  72.     RETVAL = NULL;
  73.     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  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(Perl_debug_log,
  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(Perl_debug_log, "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(Perl_debug_log, "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.
  118.