ext/DynaLoader/dl_mac.xs

   1 /* dl_mac.xs
   2  *
   3  * Platform:    Macintosh CFM
   4  * Author:      Matthias Neeracher <neeri@iis.ee.ethz.ch>
   5  *              Adapted from dl_dlopen.xs reference implementation by
   6  *              Paul Marquess (pmarquess@bfsec.bt.co.uk)
   7  * $Log: dl_mac.xs,v $
   8  * Revision 1.3  1998/04/07 01:47:24  neeri
   9  * MacPerl 5.2.0r4b1
  10  *
  11  * Revision 1.2  1997/08/08 16:39:18  neeri
  12  * MacPerl 5.1.4b1 + time() fix
  13  *
  14  * Revision 1.1  1997/04/07 20:48:23  neeri
  15  * Synchronized with MacPerl 5.1.4a1
  16  *
  17  */
  18
  19 #define MAC_CONTEXT
  20 #include "EXTERN.h"
  21 #include "perl.h"
  22 #include "XSUB.h"
  23
  24 #include <CodeFragments.h>
  25
  26 typedef CFragConnectionID ConnectionID;
  27
  28 typedef struct {
  29     ConnectionID **     x_connections;
  30 } my_cxtx_t;            /* this *must* be named my_cxtx_t */
  31
  32 #define DL_CXT_EXTRA    /* ask for dl_cxtx to be defined in dlutils.c */
  33 #include "dlutils.c"    /* SaveError() etc      */
  34
  35 #define dl_connections  (dl_cxtx.x_connections)
  36
  37 static void terminate(void)
  38 {
  39     dTHX;
  40     dMY_CXT;
  41     int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID);
  42     HLock((Handle) dl_connections);
  43     while (size)
  44         CloseConnection(*dl_connections + --size);
  45     DisposeHandle((Handle) dl_connections);
  46     dl_connections = nil;
  47 }
  48
  49 static void
  50 dl_private_init(pTHX)
  51 {
  52     (void)dl_generic_private_init(aTHX);
  53 }
  54
  55 MODULE = DynaLoader     PACKAGE = DynaLoader
  56
  57 BOOT:
  58     (void)dl_private_init(aTHX);
  59
  60
  61 ConnectionID
  62 dl_load_file(filename, flags=0)
  63     char *              filename
  64     int                 flags
  65     PREINIT:
  66     OSErr               err;
  67     FSSpec              spec;
  68     ConnectionID        connID;
  69     Ptr                 mainAddr;
  70     Str255              errName;
  71     CODE:
  72     DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
  73     err = GUSIPath2FSp(filename, &spec);
  74     if (!err)
  75         err =
  76             GetDiskFragment(
  77                 &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName);
  78     if (!err) {
  79         dMY_CXT;
  80         if (!dl_connections) {
  81             dl_connections = (ConnectionID **)NewHandle(0);
  82             atexit(terminate);
  83         }
  84         PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID));
  85         RETVAL = connID;
  86     } else
  87         RETVAL = (ConnectionID) 0;
  88     DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
  89     ST(0) = sv_newmortal() ;
  90     if (err)
  91         SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
  92     else
  93         sv_setiv( ST(0), (IV)RETVAL);
  94
  95 void *
  96 dl_find_symbol(connID, symbol)
  97     ConnectionID        connID
  98     Str255              symbol
  99     CODE:
 100     {
 101         OSErr               err;
 102         Ptr                 symAddr;
 103         CFragSymbolClass    symClass;
 104         DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
 105             connID, symbol));
 106         err = FindSymbol(connID, symbol, &symAddr, &symClass);
 107         if (err)
 108             symAddr = (Ptr) 0;
 109         RETVAL = (void *) symAddr;
 110         DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
 111         ST(0) = sv_newmortal() ;
 112         if (err)
 113             SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
 114         else
 115             sv_setiv( ST(0), (IV)RETVAL);
 116     }
 117
 118 void
 119 dl_undef_symbols()
 120     PPCODE:
 121
 122
 123
 124 # These functions should not need changing on any platform:
 125
 126 void
 127 dl_install_xsub(perl_name, symref, filename="$Package")
 128     char *              perl_name
 129     void *              symref
 130     char *              filename
 131     CODE:
 132     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
 133                 perl_name, symref));
 134     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 135
 136
 137 char *
 138 dl_error()
 139     CODE:
 140     dMY_CXT;
 141     RETVAL = dl_last_error ;
 142     OUTPUT:
 143     RETVAL
 144
 145 # end.