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!!!
9 * 23rd Oct - Failing to find nlms with long names fixed - sdbm_file
14 NetWare related modifications done on dl_win32.xs file created by Wei-Yuen Tan to get this file.
27 //function pointer for UCSInitialize
28 typedef void (*PFUCSINITIALIZE) ();
32 #endif /* PERL_OBJECT */
34 #include "dlutils.c" /* SaveError() etc */
37 dl_private_init(pTHXo)
39 (void)dl_generic_private_init(aTHXo);
43 MODULE = DynaLoader PACKAGE = DynaLoader
46 (void)dl_private_init(aTHXo);
50 dl_load_file(filename,flags=0)
56 char* mod_name = filename;
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'};
64 unsigned int nlmHandle=0;
66 while (*mod_name) mod_name++;
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--;
71 DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
73 buffer = strdup(mod_name);
74 p = strtok (buffer, ".");
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, ".");
84 if ( (nlmHandle = FindNLMHandle(mod_name8)) == NULL )
86 //NLM/NLP not loaded, load it and get the handle
87 if(spawnlp(P_NOWAIT, filename, filename, NULL)!=0)
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.
94 case LOAD_CAN_NOT_LOAD_MULTIPLE_COPIES:
95 nlmHandle = FindNLMHandle(mod_name8);
97 case LOAD_ALREADY_IN_PROGRESS:
103 nlmHandle = FindNLMHandle(mod_name8);
111 nlmHandle = FindNLMHandle(mod_name8);
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)
120 unsigned int moduleHandle = 0;
121 moduleHandle = FindNLMHandle("UCSCORE.NLM");
124 PFUCSINITIALIZE ucsinit = (PFUCSINITIALIZE)ImportSymbol(moduleHandle,"UCSInitialize");
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);
137 sv_setiv( ST(0), (IV)nlmHandle);
146 dl_find_symbol(libhandle, symbolname)
150 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
151 libhandle, symbolname));
153 //import the symbol that the dynaloader is asking for.
154 RETVAL = (void *)ImportSymbol((int)libhandle, symbolname);
156 DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL));
157 ST(0) = sv_newmortal() ;
159 //SaveError(aTHXo_ "find_symbol:%s",
160 // OS_Error_String(aTHXo)) ;
161 ConsolePrintf("find_symbol error \n");
163 sv_setiv( ST(0), (IV)RETVAL);
170 # These functions should not need changing on any platform:
173 dl_install_xsub(perl_name, symref, filename="$Package")
178 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
180 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
181 (void(*)(pTHXo_ CV *))symref,