ext/DynaLoader/dl_next.xs

   1 /* dl_next.xs
   2  *
   3  * Platform:    NeXT NS 3.2
   4  * Author:      Anno Siegel (siegel@zrz.TU-Berlin.DE)
   5  * Based on:    dl_dlopen.xs by Paul Marquess
   6  * Created:     Aug 15th, 1994
   7  *
   8  */
   9
  10 /*
  11     And Gandalf said: 'Many folk like to know beforehand what is to
  12     be set on the table; but those who have laboured to prepare the
  13     feast like to keep their secret; for wonder makes the words of
  14     praise louder.'
  15 */
  16
  17 /* Porting notes:
  18
  19 dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
  20 should not be used as a base for further ports though it may be used
  21 as an example for how dl_dlopen.xs can be ported to other platforms.
  22
  23 The method used here is just to supply the sun style dlopen etc.
  24 functions in terms of NeXTs rld_*.  The xs code proper is unchanged
  25 from Paul's original.
  26
  27 The port could use some streamlining.  For one, error handling could
  28 be simplified.
  29
  30 Anno Siegel
  31
  32 */
  33
  34 #include "EXTERN.h"
  35 #include "perl.h"
  36 #include "XSUB.h"
  37
  38 #include "dlutils.c"    /* SaveError() etc      */
  39
  40
  41 #include <mach-o/rld.h>
  42 #include <streams/streams.h>
  43
  44 static char * dl_last_error = (char *) 0;
  45
  46 NXStream *
  47 OpenError()
  48 {
  49     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
  50 }
  51
  52 void
  53 TransferError( s)
  54 NXStream *s;
  55 {
  56     char *buffer;
  57     int len, maxlen;
  58
  59     if ( dl_last_error ) {
  60         safefree(dl_last_error);
  61     }
  62     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
  63     dl_last_error = safemalloc(len);
  64     strcpy(dl_last_error, buffer);
  65 }
  66
  67 void
  68 CloseError( s)
  69 NXStream *s;
  70 {
  71     if ( s ) {
  72       NXCloseMemory( s, NX_FREEBUFFER);
  73     }
  74 }
  75
  76 char *dlerror()
  77 {
  78     return dl_last_error;
  79 }
  80
  81 char *
  82 dlopen(path, mode)
  83 char * path;
  84 int mode; /* mode is ignored */
  85 {
  86     int rld_success;
  87     NXStream *nxerr = OpenError();
  88     AV * av_resolve;
  89     I32 i, psize;
  90     char *result;
  91     char **p;
  92
  93     av_resolve = GvAVn(gv_fetchpv(
  94         "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV));
  95     psize = AvFILL(av_resolve) + 3;
  96     p = (char **) safemalloc(psize * sizeof(char*));
  97     p[0] = path;
  98     for(i=1; i<psize-1; i++) {
  99         p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na);
 100     }
 101     p[psize-1] = 0;
 102     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
 103                             (const char *) 0);
 104     safefree((char*) p);
 105     if (rld_success) {
 106         result = path;
 107     } else {
 108         TransferError(nxerr);
 109         result = (char*) 0;
 110     }
 111     CloseError(nxerr);
 112     return result;
 113 }
 114
 115 int
 116 dlclose(handle) /* stub only */
 117 void *handle;
 118 {
 119     return 0;
 120 }
 121
 122 void *
 123 dlsym(handle, symbol)
 124 void *handle;
 125 char *symbol;
 126 {
 127     NXStream    *nxerr = OpenError();
 128     char        symbuf[1024];
 129     unsigned long       symref = 0;
 130
 131     sprintf(symbuf, "_%s", symbol);
 132     if (!rld_lookup(nxerr, symbuf, &symref)) {
 133         TransferError(nxerr);
 134     }
 135     CloseError(nxerr);
 136     return (void*) symref;
 137 }
 138
 139
 140 /* ----- code from dl_dlopen.xs below here ----- */
 141
 142
 143 static void
 144 dl_private_init()
 145 {
 146     (void)dl_generic_private_init();
 147 }
 148
 149 MODULE = DynaLoader     PACKAGE = DynaLoader
 150
 151 BOOT:
 152     (void)dl_private_init();
 153
 154
 155
 156 void *
 157 dl_load_file(filename)
 158     char *      filename
 159     CODE:
 160     int mode = 1;
 161     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
 162     RETVAL = dlopen(filename, mode) ;
 163     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
 164     ST(0) = sv_newmortal() ;
 165     if (RETVAL == NULL)
 166         SaveError("%s",dlerror()) ;
 167     else
 168         sv_setiv( ST(0), (IV)RETVAL);
 169
 170
 171 void *
 172 dl_find_symbol(libhandle, symbolname)
 173     void *              libhandle
 174     char *              symbolname
 175     CODE:
 176     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
 177             libhandle, symbolname));
 178     RETVAL = dlsym(libhandle, symbolname);
 179     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
 180     ST(0) = sv_newmortal() ;
 181     if (RETVAL == NULL)
 182         SaveError("%s",dlerror()) ;
 183     else
 184         sv_setiv( ST(0), (IV)RETVAL);
 185
 186
 187 void
 188 dl_undef_symbols()
 189     PPCODE:
 190
 191
 192
 193 # These functions should not need changing on any platform:
 194
 195 void
 196 dl_install_xsub(perl_name, symref, filename="$Package")
 197     char *      perl_name
 198     void *      symref
 199     char *      filename
 200     CODE:
 201     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 202             perl_name, symref));
 203     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 204
 205
 206 char *
 207 dl_error()
 208     CODE:
 209     RETVAL = LastError ;
 210     OUTPUT:
 211     RETVAL
 212
 213 # end.