NetWare/dl_netware.xs

   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