X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3db8f154c4c6e098a5a0bdf7932e8f86fbd2c451..5ace197f9a644bde21b1b41430099295ed92365e:/ext/DynaLoader/dl_aix.xs

diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index 43e0c03..54a8e3d 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -8,10 +8,12 @@
  *
  *  I did change all malloc's, free's, strdup's, calloc's to use the perl
  *  equilvant.  I also removed some stuff we will not need.  Call fini()
- *  on statup...   It can probably be trimmed more.
+ *  on startup...   It can probably be trimmed more.
  */
 
 #define PERLIO_NOT_STDIO 0
+#define PERL_EXT
+#define PERL_IN_DL_AIX_XS
 
 /*
  * On AIX 4.3 and above the emulation layer is not needed any more, and
@@ -210,7 +212,7 @@ void *dlopen(char *path, int mode)
 {
 	dTHX;
 	dMY_CXT;
-	register ModulePtr mp;
+	ModulePtr mp;
 
 	/*
 	 * Upon the first call register a terminate handler that will
@@ -224,11 +226,11 @@ void *dlopen(char *path, int mode)
 	 * Scan the list of modules if have the module already loaded.
 	 */
 	for (mp = dl_modList; mp; mp = mp->next)
-		if (strcmp(mp->name, path) == 0) {
+		if (strEQ(mp->name, path)) {
 			mp->refCnt++;
 			return mp;
 		}
-	Newz(1000,mp,1,Module);
+	Newxz(mp,1,Module);
 	if (mp == NULL) {
 		dl_errvalid++;
 		strcpy(dl_errbuf, "Newz: ");
@@ -316,7 +318,7 @@ static void caterr(char *s)
 {
 	dTHX;
 	dMY_CXT;
-	register char *p = s;
+	char *p = s;
 
 	while (*p >= '0' && *p <= '9')
 		p++;
@@ -353,16 +355,16 @@ void *dlsym(void *handle, const char *symbol)
 {
 	dTHX;
 	dMY_CXT;
-	register ModulePtr mp = (ModulePtr)handle;
-	register ExportPtr ep;
-	register int i;
+	ModulePtr mp = (ModulePtr)handle;
+	ExportPtr ep;
+	int i;
 
 	/*
 	 * Could speed up search, but I assume that one assigns
 	 * the result to function pointers anyways.
 	 */
 	for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
-		if (strcmp(ep->name, symbol) == 0)
+		if (strEQ(ep->name, symbol))
 			return ep->addr;
 	dl_errvalid++;
 	strcpy(dl_errbuf, "dlsym: undefined symbol ");
@@ -385,9 +387,9 @@ int dlclose(void *handle)
 {
 	dTHX;
 	dMY_CXT;
-	register ModulePtr mp = (ModulePtr)handle;
+	ModulePtr mp = (ModulePtr)handle;
 	int result;
-	register ModulePtr mp1;
+	ModulePtr mp1;
 
 	if (--mp->refCnt > 0)
 		return 0;
@@ -397,8 +399,8 @@ int dlclose(void *handle)
 		strerrorcpy(dl_errbuf, errno);
 	}
 	if (mp->exports) {
-		register ExportPtr ep;
-		register int i;
+		ExportPtr ep;
+		int i;
 		for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 			if (ep->name)
 				safefree(ep->name);
@@ -568,7 +570,7 @@ static int readExports(ModulePtr mp)
 			continue;
 		mp->nExports++;
 	}
-	Newz(1001, mp->exports, mp->nExports, Export);
+	Newxz(mp->exports, mp->nExports, Export);
 	if (mp->exports == NULL) {
 		dl_errvalid++;
 		strcpy(dl_errbuf, "readExports: ");
@@ -688,21 +690,24 @@ BOOT:
     (void)dl_private_init(aTHX);
 
 
-void *
+void
 dl_load_file(filename, flags=0)
 	char *	filename
 	int	flags
-	CODE:
+        PREINIT:
+        void *retv;
+	PPCODE:
 	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
 	if (flags & 0x01)
 	    Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
-	RETVAL = dlopen(filename, RTLD_GLOBAL|RTLD_LAZY) ;
-	DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
+	retv = dlopen(filename, RTLD_GLOBAL|RTLD_LAZY) ;
+	DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", retv));
 	ST(0) = sv_newmortal() ;
-	if (RETVAL == NULL)
+	if (retv == NULL)
 	    SaveError(aTHX_ "%s",dlerror()) ;
 	else
-	    sv_setiv( ST(0), PTR2IV(RETVAL) );
+	    sv_setiv( ST(0), PTR2IV(retv) );
+        XSRETURN(1);
 
 int
 dl_unload_file(libref)
@@ -716,25 +721,29 @@ dl_unload_file(libref)
   OUTPUT:
     RETVAL
 
-void *
-dl_find_symbol(libhandle, symbolname)
+void
+dl_find_symbol(libhandle, symbolname, ign_err=0)
 	void *		libhandle
 	char *		symbolname
-	CODE:
+        int	        ign_err
+	PREINIT:
+        void *retv;
+        CODE:
 	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
 		libhandle, symbolname));
-	RETVAL = dlsym(libhandle, symbolname);
-	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
-	ST(0) = sv_newmortal() ;
-	if (RETVAL == NULL)
-	    SaveError(aTHX_ "%s",dlerror()) ;
-	else
-	    sv_setiv( ST(0), PTR2IV(RETVAL));
+	retv = dlsym(libhandle, symbolname);
+	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", retv));
+	ST(0) = sv_newmortal();
+	if (retv == NULL) {
+            if (!ign_err)
+	        SaveError(aTHX_ "%s", dlerror());
+	} else
+	    sv_setiv( ST(0), PTR2IV(retv));
 
 
 void
 dl_undef_symbols()
-	PPCODE:
+	CODE:
 
 
 
@@ -744,21 +753,39 @@ void
 dl_install_xsub(perl_name, symref, filename="$Package")
     char *	perl_name
     void *	symref 
-    char *	filename
+    const 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(*)(pTHX_ CV *))symref,
-					filename)));
+    ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
+					      (void(*)(pTHX_ CV *))symref,
+					      filename, NULL,
+					      XS_DYNAMIC_FILENAME)));
 
 
-char *
+SV *
 dl_error()
     CODE:
     dMY_CXT;
-    RETVAL = dl_last_error ;
+    RETVAL = newSVsv(MY_CXT.x_dl_last_error);
     OUTPUT:
     RETVAL
 
+#if defined(USE_ITHREADS)
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+
+    PERL_UNUSED_VAR(items);
+
+    /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
+     * using Perl variables that belong to another thread, we create our 
+     * own for this thread.
+     */
+    MY_CXT.x_dl_last_error = newSVpvs("");
+
+#endif
+
 # end.