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