Commit | Line | Data |
2986a63f |
1 | /* dl_netware.xs |
2 | * |
3 | * Platform: NetWare |
4 | * Author: SGP |
5 | * Created: 21st July 2000 |
6 | * Last Modified: 23rd Oct 2000 |
7 | * Note: !!!Any modification to the xs file to be done to the one which is under netware directory!!! |
8 | * Modification History |
9 | * 23rd Oct - Failing to find nlms with long names fixed - sdbm_file |
10 | */ |
11 | |
12 | /* |
13 | |
14 | NetWare related modifications done on dl_win32.xs file created by Wei-Yuen Tan to get this file. |
15 | |
16 | */ |
17 | |
18 | |
19 | #include <nwthread.h> |
20 | #include <nwerrno.h> |
21 | |
22 | #include "EXTERN.h" |
23 | #include "perl.h" |
24 | #include "XSUB.h" |
25 | |
26 | |
27 | //function pointer for UCSInitialize |
28 | typedef void (*PFUCSINITIALIZE) (); |
29 | |
30 | #ifdef PERL_OBJECT |
31 | |
32 | #endif /* PERL_OBJECT */ |
33 | |
34 | #include "dlutils.c" /* SaveError() etc */ |
35 | |
36 | static void |
37 | dl_private_init(pTHXo) |
38 | { |
39 | (void)dl_generic_private_init(aTHXo); |
40 | } |
41 | |
42 | |
43 | MODULE = DynaLoader PACKAGE = DynaLoader |
44 | |
45 | BOOT: |
46 | (void)dl_private_init(aTHXo); |
47 | |
48 | |
49 | void * |
50 | dl_load_file(filename,flags=0) |
51 | char * filename |
52 | int flags |
53 | PREINIT: |
54 | CODE: |
55 | { |
56 | char* mod_name = filename; |
57 | |
58 | //Names with more than 8 chars can't be found with FindNLMHandle |
59 | //8 - Name, 1 - Period, 3 - Extension, 1 - String terminator |
60 | char mod_name8[13]={'\0'}; |
61 | char *p=NULL; |
62 | char *buffer=NULL; |
63 | int nNameLength=0; |
64 | unsigned int nlmHandle=0; |
65 | |
66 | while (*mod_name) mod_name++; |
67 | |
68 | //Get the module name with extension to see if it is already loaded |
69 | while (mod_name > filename && mod_name[-1] != '/' && mod_name[-1] != '\\') mod_name--; |
70 | |
71 | DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename)); |
72 | |
73 | buffer = strdup(mod_name); |
74 | p = strtok (buffer, "."); |
75 | if (p) { |
76 | nNameLength = (strlen(p)>8)?8:strlen(p); |
77 | memcpy(mod_name8,p,nNameLength); |
78 | *(mod_name8 + nNameLength) = '.'; |
79 | *(mod_name8 + nNameLength+1) ='\0'; |
80 | p = strtok (NULL, "."); |
81 | if (p){ |
82 | strcat(mod_name8,p); |
83 | |
84 | if ( (nlmHandle = FindNLMHandle(mod_name8)) == NULL ) |
85 | { |
86 | //NLM/NLP not loaded, load it and get the handle |
87 | if(spawnlp(P_NOWAIT, filename, filename, NULL)!=0) |
88 | { |
89 | //failed to load the NLM/NLP, this unlikely |
90 | //If multiple scripts are executed for the first time before running any other |
91 | //ucs script, sometimes there used to be an abend. |
92 | switch(NetWareErrno) |
93 | { |
94 | case LOAD_CAN_NOT_LOAD_MULTIPLE_COPIES: |
95 | nlmHandle = FindNLMHandle(mod_name8); |
96 | break; |
97 | case LOAD_ALREADY_IN_PROGRESS: |
98 | #ifdef MPK_ON |
99 | kYieldThread(); |
100 | #else |
101 | ThreadSwitch(); |
102 | #endif //MPK_ON |
103 | nlmHandle = FindNLMHandle(mod_name8); |
104 | break; |
105 | default: |
106 | nlmHandle = 0; |
107 | } |
108 | } |
109 | else |
110 | { |
111 | nlmHandle = FindNLMHandle(mod_name8); |
112 | } |
113 | } |
114 | //use UCSExt encountered- |
115 | //initialize UCS, this has to be terminated when the script finishes execution |
116 | //Is the script intending to use UCS Extensions? |
117 | //This should be done once per script execution |
118 | if (strcmp(mod_name,"Perl2UCS.nlp")==0) |
119 | { |
120 | unsigned int moduleHandle = 0; |
121 | moduleHandle = FindNLMHandle("UCSCORE.NLM"); |
122 | if (moduleHandle) |
123 | { |
124 | PFUCSINITIALIZE ucsinit = (PFUCSINITIALIZE)ImportSymbol(moduleHandle,"UCSInitialize"); |
125 | if (ucsinit!=NULL) |
126 | (*ucsinit)(); |
127 | } |
128 | } |
129 | |
130 | DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", nlmHandle)); |
131 | ST(0) = sv_newmortal() ; |
132 | if (nlmHandle == NULL) |
133 | //SaveError(aTHXo_ "load_file:%s", |
134 | // OS_Error_String(aTHXo)) ; |
135 | ConsolePrintf("load_file error : %s\n", mod_name8); |
136 | else |
137 | sv_setiv( ST(0), (IV)nlmHandle); |
138 | } |
139 | } |
140 | free(buffer); |
141 | |
142 | |
143 | } |
144 | |
145 | void * |
146 | dl_find_symbol(libhandle, symbolname) |
147 | void * libhandle |
148 | char * symbolname |
149 | CODE: |
150 | DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", |
151 | libhandle, symbolname)); |
152 | |
153 | //import the symbol that the dynaloader is asking for. |
154 | RETVAL = (void *)ImportSymbol((int)libhandle, symbolname); |
155 | |
156 | DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL)); |
157 | ST(0) = sv_newmortal() ; |
158 | if (RETVAL == NULL) |
159 | //SaveError(aTHXo_ "find_symbol:%s", |
160 | // OS_Error_String(aTHXo)) ; |
161 | ConsolePrintf("find_symbol error \n"); |
162 | else |
163 | sv_setiv( ST(0), (IV)RETVAL); |
164 | |
165 | void |
166 | dl_undef_symbols() |
167 | PPCODE: |
168 | |
169 | |
170 | # These functions should not need changing on any platform: |
171 | |
172 | void |
173 | dl_install_xsub(perl_name, symref, filename="$Package") |
174 | char * perl_name |
175 | void * symref |
176 | char * filename |
177 | CODE: |
178 | DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", |
179 | perl_name, symref)); |
180 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
181 | (void(*)(pTHXo_ CV *))symref, |
182 | filename))); |
183 | |
184 | |
185 | char * |
186 | dl_error() |
187 | CODE: |
188 | RETVAL = LastError ; |
189 | OUTPUT: |
190 | RETVAL |
191 | |
192 | # end. |
193 | |
194 | |