This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In S_scan_heredoc(), the explicit test for '\n' duplicates the strNE().
[perl5.git] / ext / DynaLoader / dl_aix.xs
index c3f2c11..0e9141d 100644 (file)
@@ -8,7 +8,7 @@
  *
  *  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
@@ -26,6 +26,8 @@
 #include "XSUB.h"
 #include <dlfcn.h>
 
+#include "dlutils.c"   /* SaveError() etc      */
+
 #else
 
 /*
@@ -177,26 +179,13 @@ char *strerrorcat(char *str, int err) {
     int msgsiz;
     char *msg;
 
-#ifdef USE_5005THREADS
-    char *buf = malloc(BUFSIZ);
-
-    if (buf == 0)
-      return 0;
-    if (strerror_r(err, buf, BUFSIZ) == 0)
-      msg = buf;
-    else
-      msg = strerror_r_failed;
-    msgsiz = strlen(msg);
-    if (strsiz + msgsiz < BUFSIZ)
-      strcat(str, msg);
-    free(buf);
-#else
+    dTHX;
+
     if ((msg = strerror(err)) == 0)
       msg = strerror_failed;
     msgsiz = strlen(msg);              /* Note msg = buf and free() above. */
     if (strsiz + msgsiz < BUFSIZ)      /* Do not move this after #endif. */
       strcat(str, msg);
-#endif
 
     return str;
 }
@@ -205,26 +194,13 @@ char *strerrorcpy(char *str, int err) {
     int msgsiz;
     char *msg;
 
-#ifdef USE_5005THREADS
-    char *buf = malloc(BUFSIZ);
-
-    if (buf == 0)
-      return 0;
-    if (strerror_r(err, buf, BUFSIZ) == 0)
-      msg = buf;
-    else
-      msg = strerror_r_failed;
-    msgsiz = strlen(msg);
-    if (msgsiz < BUFSIZ)
-      strcpy(str, msg);
-    free(buf);
-#else
+    dTHX;
+
     if ((msg = strerror(err)) == 0)
       msg = strerror_failed;
     msgsiz = strlen(msg);      /* Note msg = buf and free() above. */
     if (msgsiz < BUFSIZ)       /* Do not move this after #endif. */
       strcpy(str, msg);
-#endif
 
     return str;
 }
@@ -234,7 +210,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
@@ -252,7 +228,7 @@ void *dlopen(char *path, int mode)
                        mp->refCnt++;
                        return mp;
                }
-       Newz(1000,mp,1,Module);
+       Newxz(mp,1,Module);
        if (mp == NULL) {
                dl_errvalid++;
                strcpy(dl_errbuf, "Newz: ");
@@ -340,7 +316,7 @@ static void caterr(char *s)
 {
        dTHX;
        dMY_CXT;
-       register char *p = s;
+       char *p = s;
 
        while (*p >= '0' && *p <= '9')
                p++;
@@ -377,9 +353,9 @@ 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
@@ -409,9 +385,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;
@@ -421,8 +397,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);
@@ -592,7 +568,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: ");
@@ -712,21 +688,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)
@@ -740,25 +719,27 @@ dl_unload_file(libref)
   OUTPUT:
     RETVAL
 
-void *
+void
 dl_find_symbol(libhandle, symbolname)
        void *          libhandle
        char *          symbolname
-       CODE:
+       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));
+       retv = dlsym(libhandle, symbolname);
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %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));
 
 
 void
 dl_undef_symbols()
-       PPCODE:
+       CODE:
 
 
 
@@ -768,13 +749,14 @@ 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 *
@@ -785,4 +767,19 @@ dl_error()
     OUTPUT:
     RETVAL
 
+#if defined(USE_ITHREADS)
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+
+    /* 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 = newSVpvn("", 0);
+
+#endif
+
 # end.