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 these before perl headers */
  35 #include <mach-o/rld.h>
  36 #include <streams/streams.h>
  37
  38 #include "EXTERN.h"
  39 #include "perl.h"
  40 #include "XSUB.h"
  41
  42 #define DL_LOADONCEONLY
  43
  44 #include "dlutils.c"    /* SaveError() etc      */
  45
  46
  47 static char * dl_last_error = (char *) 0;
  48 static AV *dl_resolve_using = Nullav;
  49
  50 NXStream *
  51 OpenError()
  52 {
  53     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
  54 }
  55
  56 void
  57 TransferError( s)
  58 NXStream *s;
  59 {
  60     char *buffer;
  61     int len, maxlen;
  62
  63     if ( dl_last_error ) {
  64         safefree(dl_last_error);
  65     }
  66     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
  67     dl_last_error = safemalloc(len);
  68     strcpy(dl_last_error, buffer);
  69 }
  70
  71 void
  72 CloseError( s)
  73 NXStream *s;
  74 {
  75     if ( s ) {
  76       NXCloseMemory( s, NX_FREEBUFFER);
  77     }
  78 }
  79
  80 char *dlerror()
  81 {
  82     return dl_last_error;
  83 }
  84
  85 char *
  86 dlopen(path, mode)
  87 char * path;
  88 int mode; /* mode is ignored */
  89 {
  90     int rld_success;
  91     NXStream *nxerr;
  92     I32 i, psize;
  93     char *result;
  94     char **p;
  95
  96     /* Do not load what is already loaded into this process */
  97     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
  98         return path;
  99
 100     nxerr = OpenError();
 101     psize = AvFILL(dl_resolve_using) + 3;
 102     p = (char **) safemalloc(psize * sizeof(char*));
 103     p[0] = path;
 104     for(i=1; i<psize-1; i++) {
 105         p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
 106     }
 107     p[psize-1] = 0;
 108     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
 109                             (const char *) 0);
 110     safefree((char*) p);
 111     if (rld_success) {
 112         result = path;
 113         /* prevent multiple loads of same file into same process */
 114         hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
 115     } else {
 116         TransferError(nxerr);
 117         result = (char*) 0;
 118     }
 119     CloseError(nxerr);
 120     return result;
 121 }
 122
 123 int
 124 dlclose(handle) /* stub only */
 125 void *handle;
 126 {
 127     return 0;
 128 }
 129
 130 void *
 131 dlsym(handle, symbol)
 132 void *handle;
 133 char *symbol;
 134 {
 135     NXStream    *nxerr = OpenError();
 136     char        symbuf[1024];
 137     unsigned long       symref = 0;
 138
 139     sprintf(symbuf, "_%s", symbol);
 140     if (!rld_lookup(nxerr, symbuf, &symref)) {
 141         TransferError(nxerr);
 142     }
 143     CloseError(nxerr);
 144     return (void*) symref;
 145 }
 146
 147
 148 /* ----- code from dl_dlopen.xs below here ----- */
 149
 150
 151 static void
 152 dl_private_init()
 153 {
 154     (void)dl_generic_private_init();
 155     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
 156 }
 157
 158 MODULE = DynaLoader     PACKAGE = DynaLoader
 159
 160 BOOT:
 161     (void)dl_private_init();
 162
 163
 164
 165 void *
 166 dl_load_file(filename)
 167     char *      filename
 168     CODE:
 169     int mode = 1;
 170     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
 171     RETVAL = dlopen(filename, mode) ;
 172     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
 173     ST(0) = sv_newmortal() ;
 174     if (RETVAL == NULL)
 175         SaveError("%s",dlerror()) ;
 176     else
 177         sv_setiv( ST(0), (IV)RETVAL);
 178
 179
 180 void *
 181 dl_find_symbol(libhandle, symbolname)
 182     void *              libhandle
 183     char *              symbolname
 184     CODE:
 185     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
 186             libhandle, symbolname));
 187     RETVAL = dlsym(libhandle, symbolname);
 188     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
 189     ST(0) = sv_newmortal() ;
 190     if (RETVAL == NULL)
 191         SaveError("%s",dlerror()) ;
 192     else
 193         sv_setiv( ST(0), (IV)RETVAL);
 194
 195
 196 void
 197 dl_undef_symbols()
 198     PPCODE:
 199
 200
 201
 202 # These functions should not need changing on any platform:
 203
 204 void
 205 dl_install_xsub(perl_name, symref, filename="$Package")
 206     char *      perl_name
 207     void *      symref
 208     char *      filename
 209     CODE:
 210     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 211             perl_name, symref));
 212     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 213
 214
 215 char *
 216 dl_error()
 217     CODE:
 218     RETVAL = LastError ;
 219     OUTPUT:
 220     RETVAL
 221
 222 # end.