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