X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2Fdl_vms.xs;h=409d586ae79eb59ccf148376f56e584fac575e43;hb=f66f545a34e46cca76544b7cd178ab5d7e450e92;hp=a646e116ab960ffe5b5e332b70b6bc59cd01d57f;hpb=760ac839baf413929cd31cc32ffd6dba6b781a81;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
index a646e11..409d586 100644
--- a/ext/DynaLoader/dl_vms.xs
+++ b/ext/DynaLoader/dl_vms.xs
@@ -1,7 +1,7 @@
 /* dl_vms.xs
  * 
  * Platform:  OpenVMS, VAX or AXP
- * Author:    Charles Bailey  bailey@genetics.upenn.edu
+ * Author:    Charles Bailey  bailey@newman.upenn.edu
  * Revised:   12-Dec-1994
  *
  *                           Implementation Note
@@ -112,6 +112,7 @@ dl_set_error(sts,stv)
     vmssts  stv;
 {
     vmssts vec[3];
+    dTHX;
 
     vec[0] = stv ? 2 : 1;
     vec[1] = sts;  vec[2] = stv;
@@ -121,6 +122,7 @@ dl_set_error(sts,stv)
 static unsigned int
 findsym_handler(void *sig, void *mech)
 {
+    dTHX;
     unsigned long int myvec[8],args, *usig = (unsigned long int *) sig;
     /* Be paranoid and assume signal vector passed in might be readonly */
     myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1;
@@ -146,10 +148,10 @@ my_find_image_symbol(struct dsc$descriptor_s *imgname,
 
 
 static void
-dl_private_init()
+dl_private_init(pTHX)
 {
-    dl_generic_private_init();
-    dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
+    dl_generic_private_init(aTHX);
+    dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4);
     /* Set up the static control blocks for dl_expand_filespec() */
     dlfab = cc$rms_fab;
     dlnam = cc$rms_nam;
@@ -162,7 +164,7 @@ dl_private_init()
 MODULE = DynaLoader PACKAGE = DynaLoader
 
 BOOT:
-    (void)dl_private_init();
+    (void)dl_private_init(aTHX);
 
 void
 dl_expandspec(filespec)
@@ -184,7 +186,7 @@ dl_expandspec(filespec)
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
     if (!(sts & 1)) {
       dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
-      ST(0) = &sv_undef;
+      ST(0) = &PL_sv_undef;
     }
     else {
       /* Now set up a default spec - everything but the name */
@@ -205,7 +207,7 @@ dl_expandspec(filespec)
       DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
       if (!(sts & 1)) {
         dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
-        ST(0) = &sv_undef;
+        ST(0) = &PL_sv_undef;
       }
       else {
         /* Now find the actual file */
@@ -213,10 +215,10 @@ dl_expandspec(filespec)
         DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
         if (!(sts & 1)) {
           dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
-          ST(0) = &sv_undef;
+          ST(0) = &PL_sv_undef;
         }
         else {
-          ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
+          ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
           DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n",
                             dlnam.nam$b_rsl,dlnam.nam$l_rsa));
         }
@@ -224,9 +226,11 @@ dl_expandspec(filespec)
     }
 
 void
-dl_load_file(filespec)
+dl_load_file(filespec, flags)
     char *	filespec
-    CODE:
+    int		flags
+    PREINIT:
+    dTHX;
     char vmsspec[NAM$C_MAXRSS];
     SV *reqSV, **reqSVhndl;
     STRLEN deflen;
@@ -241,13 +245,14 @@ dl_load_file(filespec)
     struct libref *dlptr;
     vmssts sts, failed = 0;
     void (*entry)();
+    CODE:
 
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n",filespec));
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags));
     specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
     specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",
                       specdsc.dsc$a_pointer));
-    New(7901,dlptr,1,struct libref);
+    New(1399,dlptr,1,struct libref);
     dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
     dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
     sts = sys$filescan(&specdsc,namlst,0);
@@ -261,7 +266,7 @@ dl_load_file(filespec)
       dlptr->name.dsc$w_length = namlst[0].len;
       dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
       dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
-      dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
+      New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
       deflen = namlst[0].string - specdsc.dsc$a_pointer; 
       memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
       memcpy(dlptr->defspec.dsc$a_pointer + deflen,
@@ -293,10 +298,10 @@ dl_load_file(filespec)
       Safefree(dlptr->name.dsc$a_pointer);
       Safefree(dlptr->defspec.dsc$a_pointer);
       Safefree(dlptr);
-      ST(0) = &sv_undef;
+      ST(0) = &PL_sv_undef;
     }
     else {
-      ST(0) = sv_2mortal(newSViv((IV) dlptr));
+      ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
     }
 
 
@@ -321,9 +326,9 @@ dl_find_symbol(librefptr,symname)
                       (unsigned long int) entry));
     if (!(sts & 1)) {
       /* error message already saved by findsym_handler */
-      ST(0) = &sv_undef;
+      ST(0) = &PL_sv_undef;
     }
-    else ST(0) = sv_2mortal(newSViv((IV) entry));
+    else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
 
 
 void
@@ -341,7 +346,9 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     CODE:
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
         perl_name, symref));
-    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+				      (void(*)(pTHX_ CV *))symref,
+				      filename)));
 
 
 char *