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 #include "dlutils.c"    /* SaveError() etc      */
  31
  32 static void
  33 dl_private_init(pTHX)
  34 {
  35     (void)dl_generic_private_init(aTHX);
  36 }
  37
  38
  39 MODULE = DynaLoader     PACKAGE = DynaLoader
  40
  41 BOOT:
  42     (void)dl_private_init(aTHX);
  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 Perl2UCS or 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.nlm")==0) || (strcmp(mod_name,"UCSExt.nlm")==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)
 129                         //SaveError(aTHX_ "load_file:%s",
 130                         //        OS_Error_String(aTHX)) ;
 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)
 155         //SaveError(aTHX_ "find_symbol:%s",
 156         //        OS_Error_String(aTHX)) ;
 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,
 177                                         (void(*)(pTHX_ CV *))symref,
 178                                         filename)));
 179
 180
 181 char *
 182 dl_error()
 183     CODE:
 184     dMY_CXT;
 185     RETVAL = dl_last_error ;
 186     OUTPUT:
 187     RETVAL
 188
 189 # end.
 190
 191