Remove thread context from Perl_vmssetuserlnm.
authorCraig A. Berry <craigberry@mac.com>
Sat, 3 Nov 2012 13:11:44 +0000 (08:11 -0500)
committerCraig A. Berry <craigberry@mac.com>
Sat, 3 Nov 2012 13:11:44 +0000 (08:11 -0500)
This routine by its very nature applies to the whole process so
there is no way it can make use of a thread context, and it may need
to be called from places where there is no thread context, such
as very early in start-up.

It's not documented, was never intended to be part of the API, was
only made global so it could be called from doio.c, and no uses of
it turn up in a CPAN grep, so the change should be safe.

doio.c
vms/vms.c
vms/vmsish.h

diff --git a/doio.c b/doio.c
index 94f2003..e8eafdc 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -623,9 +623,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                 char newname[FILENAME_MAX+1];
                 if (PerlIO_getname(fp, newname)) {
                     if (fd == PerlIO_fileno(PerlIO_stdout()))
-                        Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+                        vmssetuserlnm("SYS$OUTPUT", newname);
                     if (fd == PerlIO_fileno(PerlIO_stderr()))
-                        Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
+                        vmssetuserlnm("SYS$ERROR", newname);
                 }
            }
 #endif
index c5967de..d731b6a 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1716,14 +1716,9 @@ Perl_my_setenv(pTHX_ const char *lnm, const char *eqv)
 /*  vmssetuserlnm
  *  sets a user-mode logical in the process logical name table
  *  used for redirection of sys$error
- *
- *  Fix-me: The pTHX is not needed for this routine, however doio.c
- *          is calling it with one instead of using a macro.
- *          A macro needs to be added to vmsish.h and doio.c updated to use it.
- *
  */
 void
-Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
+Perl_vmssetuserlnm(const char *name, const char *eqv)
 {
     $DESCRIPTOR(d_tab, "LNM$PROCESS");
     struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
@@ -4264,7 +4259,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
            info->fp  = PerlIO_open(mbx, mode);
         } else {
             info->fp = (PerlIO *) freopen(mbx, mode, stdin);
-            Perl_vmssetuserlnm(aTHX_ "SYS$INPUT",mbx);
+            vmssetuserlnm("SYS$INPUT", mbx);
         }
 
         if (!info->fp && info->out) {
@@ -4319,7 +4314,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
            info->fp  = PerlIO_open(mbx, mode);
         } else {
             info->fp = (PerlIO *) freopen(mbx, mode, stdout);
-            Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT",mbx);
+            vmssetuserlnm("SYS$OUTPUT", mbx);
         }
 
         if (info->in) {
@@ -9164,12 +9159,12 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        fprintf(stderr,"Can't open output file %s as stdout",out);
        exit(vaxc$errno);
        }
-       if (out != NULL) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT",out);
+       if (out != NULL) vmssetuserlnm("SYS$OUTPUT", out);
 
     if (err != NULL) {
         if (strcmp(err,"&1") == 0) {
             dup2(fileno(stdout), fileno(stderr));
-            Perl_vmssetuserlnm(aTHX_ "SYS$ERROR","SYS$OUTPUT");
+            vmssetuserlnm("SYS$ERROR", "SYS$OUTPUT");
         } else {
        FILE *tmperr;
        if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
@@ -9182,7 +9177,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
                {
                exit(vaxc$errno);
                }
-           Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",err);
+           vmssetuserlnm("SYS$ERROR", err);
        }
         }
 #ifdef ARGPROC_DEBUG
index 5524460..310016d 100644 (file)
 #define vms_realpath(a,b,c)            Perl_vms_realpath(aTHX_ a,b,c)
 #define vmssetenv(a,b,c)               Perl_vmssetenv(aTHX_ a,b,c)
 #define vmstrnenv(a,b,c,d,e)           Perl_vmstrnenv(a,b,c,d,e)
+#define vmssetuserlnm(a,b)             Perl_vmssetuserlnm(a,b)
 
 /* Delete if at all possible, changing protections if necessary. */
 #define unlink(a) kill_file(a)
@@ -735,7 +736,7 @@ bool        Perl_vms_do_aexec (pTHX_ SV *, SV **, SV **);
 int    Perl_vms_case_tolerant(void);
 char * Perl_my_getenv_len (pTHX_ const char *, unsigned long *, bool);
 int    Perl_vmssetenv (pTHX_ const char *, const char *, struct dsc$descriptor_s **);
-void   Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv);
+void   Perl_vmssetuserlnm(const char *name, const char *eqv);
 char * Perl_my_crypt (pTHX_ const char *, const char *);
 Pid_t  Perl_my_waitpid (pTHX_ Pid_t, int *, int);
 char * my_gconvert (double, int, int, char *);