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
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_flags(perl_name,
134                                               (void(*)(pTHX_ CV *))symref,
135                                               filename, NULL,
136                                               XS_DYNAMIC_FILENAME)));
137
138
139 char *
140 dl_error()
141     CODE:
142     dMY_CXT;
143     RETVAL = dl_last_error ;
144     OUTPUT:
145     RETVAL
146
147 # end.