NetWare port from Guruprasad S <SGURUPRASAD@novell.com>.

p4raw-id: //depot/perl@10643

1 files changed, 194 insertions, 0 deletions

diff --git a/NetWare/dl_netware.xs b/NetWare/dl_netware.xs
new file mode 100644
index 0000000000..2f466ca499
--- /dev/null
+++ b/NetWare/dl_netware.xs
@@ -0,0 +1,194 @@
+/* dl_netware.xs
+ * 
+ * Platform:	NetWare 
+ * Author:	SGP
+ * Created:	21st July 2000
+ * Last Modified: 23rd Oct 2000
+ * Note: !!!Any modification to the xs file to be done to the one which is under netware directory!!!
+ * Modification History
+ * 23rd Oct - Failing to find nlms with long names fixed - sdbm_file
+ */
+
+/* 
+
+NetWare related modifications done on dl_win32.xs file created by Wei-Yuen Tan to get this file.
+
+*/
+
+
+#include <nwthread.h> 
+#include <nwerrno.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+
+//function pointer for UCSInitialize
+typedef void (*PFUCSINITIALIZE) ();
+
+#ifdef PERL_OBJECT
+
+#endif  /* PERL_OBJECT */
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+static void
+dl_private_init(pTHXo)
+{
+    (void)dl_generic_private_init(aTHXo);
+}
+
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init(aTHXo);
+
+
+void *
+dl_load_file(filename,flags=0)
+    char *		filename
+    int			flags
+    PREINIT:
+    CODE:
+  {
+	char* mod_name = filename;
+
+	//Names with more than 8 chars can't be found with FindNLMHandle
+	//8 - Name, 1 - Period, 3 - Extension, 1 - String terminator
+	char mod_name8[13]={'\0'};
+	char *p=NULL;
+	char *buffer=NULL;
+	int nNameLength=0;
+	unsigned int nlmHandle=0;
+
+	while (*mod_name) mod_name++;
+	
+	//Get the module name with extension to see if it is already loaded
+	while (mod_name > filename && mod_name[-1] != '/' && mod_name[-1] != '\\') mod_name--;
+
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
+
+	buffer = strdup(mod_name);
+	p = strtok (buffer, "."); 
+	if (p) {
+		nNameLength = (strlen(p)>8)?8:strlen(p);
+		memcpy(mod_name8,p,nNameLength);
+		*(mod_name8 + nNameLength) = '.';
+		*(mod_name8 + nNameLength+1) ='\0';
+		p = strtok (NULL, ".");
+		if (p){
+			strcat(mod_name8,p);
+
+			if ( (nlmHandle = FindNLMHandle(mod_name8)) == NULL )
+			{
+				//NLM/NLP not loaded, load it and get the handle
+				if(spawnlp(P_NOWAIT, filename, filename, NULL)!=0)
+				{
+					//failed to load the NLM/NLP, this unlikely
+					//If multiple scripts are executed for the first time before running any other
+					//ucs script, sometimes there used to be an abend.
+					switch(NetWareErrno)
+					{
+					case LOAD_CAN_NOT_LOAD_MULTIPLE_COPIES:
+						nlmHandle = FindNLMHandle(mod_name8);
+						break;
+					case LOAD_ALREADY_IN_PROGRESS:
+#ifdef MPK_ON
+							kYieldThread();
+#else
+							ThreadSwitch();
+#endif	//MPK_ON
+						nlmHandle = FindNLMHandle(mod_name8);
+						break;
+					default:
+						nlmHandle = 0;
+					}
+				}
+				else
+				{
+					nlmHandle = FindNLMHandle(mod_name8);
+				}
+			}
+			//use UCSExt encountered-
+			//initialize UCS, this has to be terminated when the script finishes execution
+			//Is the script intending to use UCS Extensions?
+			//This should be done once per script execution
+			if (strcmp(mod_name,"Perl2UCS.nlp")==0)
+			{
+				unsigned int moduleHandle = 0;
+				moduleHandle = FindNLMHandle("UCSCORE.NLM");
+				if (moduleHandle)
+				{
+					PFUCSINITIALIZE ucsinit = (PFUCSINITIALIZE)ImportSymbol(moduleHandle,"UCSInitialize");
+					if (ucsinit!=NULL)
+						(*ucsinit)();
+				}
+			}
+
+			DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", nlmHandle));
+			ST(0) = sv_newmortal() ;
+			if (nlmHandle == NULL)
+			//SaveError(aTHXo_ "load_file:%s",
+			//	  OS_Error_String(aTHXo)) ;
+			ConsolePrintf("load_file error :  %s\n", mod_name8);
+			else
+			sv_setiv( ST(0), (IV)nlmHandle);
+		}
+	}
+	free(buffer);
+
+	
+  }
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
+		      libhandle, symbolname));
+
+	//import the symbol that the dynaloader is asking for.
+	RETVAL = (void *)ImportSymbol((int)libhandle, symbolname);
+
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	//SaveError(aTHXo_ "find_symbol:%s",
+	//	  OS_Error_String(aTHXo)) ;
+	ConsolePrintf("find_symbol error \n");
+    else
+	sv_setiv( ST(0), (IV)RETVAL);
+
+void
+dl_undef_symbols()
+    PPCODE:
+
+
+# These functions should not need changing on any platform:
+
+void
+dl_install_xsub(perl_name, symref, filename="$Package")
+    char *		perl_name
+    void *		symref 
+    char *		filename
+    CODE:
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
+		      perl_name, symref));
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+					(void(*)(pTHXo_ CV *))symref,
+					filename)));
+
+
+char *
+dl_error()
+    CODE:
+    RETVAL = LastError ;
+    OUTPUT:
+    RETVAL
+
+# end.
+
+