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)
8 * Revision 1.3 1998/04/07 01:47:24 neeri
11 * Revision 1.2 1997/08/08 16:39:18 neeri
12 * MacPerl 5.1.4b1 + time() fix
14 * Revision 1.1 1997/04/07 20:48:23 neeri
15 * Synchronized with MacPerl 5.1.4a1
24 #include <CodeFragments.h>
27 #include "dlutils.c" /* SaveError() etc */
29 typedef CFragConnectionID ConnectionID;
31 static ConnectionID ** connections;
33 static void terminate(void)
35 int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID);
36 HLock((Handle) connections);
38 CloseConnection(*connections + --size);
39 DisposeHandle((Handle) connections);
46 (void)dl_generic_private_init(aTHX);
49 MODULE = DynaLoader PACKAGE = DynaLoader
52 (void)dl_private_init(aTHX);
56 dl_load_file(filename, flags=0)
66 DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
67 err = GUSIPath2FSp(filename, &spec);
71 &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName);
74 connections = (ConnectionID **)NewHandle(0);
77 PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID));
80 RETVAL = (ConnectionID) 0;
81 DLDEBUG(2,fprintf(stderr," libref=%d\n", RETVAL));
82 ST(0) = sv_newmortal() ;
84 SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
86 sv_setiv( ST(0), (IV)RETVAL);
89 dl_find_symbol(connID, symbol)
96 CFragSymbolClass symClass;
97 DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%#s)\n",
99 err = FindSymbol(connID, symbol, &symAddr, &symClass);
102 RETVAL = (void *) symAddr;
103 DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL));
104 ST(0) = sv_newmortal() ;
106 SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
108 sv_setiv( ST(0), (IV)RETVAL);
117 # These functions should not need changing on any platform:
120 dl_install_xsub(perl_name, symref, filename="$Package")
125 DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
127 ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));