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(pTHX_ void *ptr)
  38 {
  39     dMY_CXT;
  40     int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID);
  41     HLock((Handle) dl_connections);
  42     while (size)
  43         CloseConnection(*dl_connections + --size);
  44     DisposeHandle((Handle) dl_connections);
  45     dl_connections = nil;
  46 }
  47
  48 static void
  49 dl_private_init(pTHX)
  50 {
  51     (void)dl_generic_private_init(aTHX);
  52 }
  53
  54 MODULE = DynaLoader     PACKAGE = DynaLoader
  55
  56 BOOT:
  57     (void)dl_private_init(aTHX);
  58
  59
  60 ConnectionID
  61 dl_load_file(filename, flags=0)
  62     char *              filename
  63     int                 flags
  64     PREINIT:
  65     OSErr               err;
  66     FSSpec              spec;
  67     ConnectionID        connID;
  68     Ptr                 mainAddr;
  69     Str255              errName;
  70     CODE:
  71     DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
  72     err = GUSIPath2FSp(filename, &spec);
  73     if (!err)
  74         err =
  75             GetDiskFragment(
  76                 &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName);
  77     if (!err) {
  78         dMY_CXT;
  79         if (!dl_connections) {
  80             dl_connections = (ConnectionID **)NewHandle(0);
  81             call_atexit(terminate, (void*)0);
  82         }
  83         PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID));
  84         RETVAL = connID;
  85     } else
  86         RETVAL = (ConnectionID) 0;
  87     DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
  88     ST(0) = sv_newmortal() ;
  89     if (err)
  90         SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
  91     else
  92         sv_setiv( ST(0), (IV)RETVAL);
  93
  94 void *
  95 dl_find_symbol(connID, symbol)
  96     ConnectionID        connID
  97     Str255              symbol
  98     CODE:
  99     {
 100         OSErr               err;
 101         Ptr                 symAddr;
 102         CFragSymbolClass    symClass;
 103         DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
 104             connID, symbol));
 105         err = FindSymbol(connID, symbol, &symAddr, &symClass);
 106         if (err)
 107             symAddr = (Ptr) 0;
 108         RETVAL = (void *) symAddr;
 109         DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
 110         ST(0) = sv_newmortal() ;
 111         if (err)
 112             SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
 113         else
 114             sv_setiv( ST(0), (IV)RETVAL);
 115     }
 116
 117 void
 118 dl_undef_symbols()
 119     PPCODE:
 120
 121
 122
 123 # These functions should not need changing on any platform:
 124
 125 void
 126 dl_install_xsub(perl_name, symref, filename="$Package")
 127     char *              perl_name
 128     void *              symref
 129     char *              filename
 130     CODE:
 131     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
 132                 perl_name, symref));
 133     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 134
 135
 136 char *
 137 dl_error()
 138     CODE:
 139     dMY_CXT;
 140     RETVAL = dl_last_error ;
 141     OUTPUT:
 142     RETVAL
 143
 144 # end.