This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_mac.xs
CommitLineData
bf4acbe4
GS
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
cdc73a10 26typedef CFragConnectionID ConnectionID;
bf4acbe4 27
cdc73a10
JH
28typedef struct {
29 ConnectionID ** x_connections;
30} my_cxtx_t; /* this *must* be named my_cxtx_t */
bf4acbe4 31
cdc73a10
JH
32#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
33#include "dlutils.c" /* SaveError() etc */
bf4acbe4 34
cdc73a10 35#define dl_connections (dl_cxtx.x_connections)
bf4acbe4 36
e45b21ab 37static void terminate(pTHX_ void *ptr)
bf4acbe4 38{
cdc73a10
JH
39 dMY_CXT;
40 int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID);
41 HLock((Handle) dl_connections);
bf4acbe4 42 while (size)
cdc73a10
JH
43 CloseConnection(*dl_connections + --size);
44 DisposeHandle((Handle) dl_connections);
45 dl_connections = nil;
bf4acbe4
GS
46}
47
48static void
49dl_private_init(pTHX)
50{
51 (void)dl_generic_private_init(aTHX);
52}
53
54MODULE = DynaLoader PACKAGE = DynaLoader
55
56BOOT:
57 (void)dl_private_init(aTHX);
58
59
60ConnectionID
61dl_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:
db5fd395 71 DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
bf4acbe4
GS
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) {
cdc73a10
JH
78 dMY_CXT;
79 if (!dl_connections) {
80 dl_connections = (ConnectionID **)NewHandle(0);
e45b21ab 81 call_atexit(terminate, (void*)0);
bf4acbe4 82 }
cdc73a10 83 PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID));
bf4acbe4
GS
84 RETVAL = connID;
85 } else
86 RETVAL = (ConnectionID) 0;
db5fd395 87 DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
bf4acbe4
GS
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
94void *
95dl_find_symbol(connID, symbol)
96 ConnectionID connID
97 Str255 symbol
98 CODE:
99 {
100 OSErr err;
101 Ptr symAddr;
102 CFragSymbolClass symClass;
db5fd395 103 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
bf4acbe4
GS
104 connID, symbol));
105 err = FindSymbol(connID, symbol, &symAddr, &symClass);
106 if (err)
107 symAddr = (Ptr) 0;
108 RETVAL = (void *) symAddr;
db5fd395 109 DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL));
bf4acbe4
GS
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
117void
118dl_undef_symbols()
119 PPCODE:
120
121
122
123# These functions should not need changing on any platform:
124
125void
126dl_install_xsub(perl_name, symref, filename="$Package")
127 char * perl_name
128 void * symref
129 char * filename
130 CODE:
db5fd395 131 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
bf4acbe4 132 perl_name, symref));
77004dee
NC
133 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
134 (void(*)(pTHX_ CV *))symref,
135 filename, NULL,
136 XS_DYNAMIC_FILENAME)));
bf4acbe4
GS
137
138
139char *
140dl_error()
141 CODE:
cdc73a10
JH
142 dMY_CXT;
143 RETVAL = dl_last_error ;
bf4acbe4
GS
144 OUTPUT:
145 RETVAL
146
147# end.