hand-apply whitespace mutiliated patch

	Message-Id: <3.0.6.32.19990607144642.03079100@ous.edu>
	Subject: [PATCH 5.005_57]Updated VMS patch

p4raw-id: //depot/perl@3594

5 files changed, 165 insertions, 20 deletions

diff --git a/thread.h b/thread.h
index f6c468c675..f09143d1eb 100644
--- a/thread.h
+++ b/thread.h
@@ -35,10 +35,8 @@ struct perl_thread *getTHR (void);
 #      define YIELD pthread_yield(NULL)
 #    endif
 #  endif
-#  ifndef VMS
 #    define pthread_mutexattr_default NULL
 #    define pthread_condattr_default  NULL
-#  endif
 #endif
 
 #ifndef PTHREAD_CREATE
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 206740890e..0bd08de57b 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -240,7 +240,7 @@ INSTPERL = perl
 
 # Space-separated list of "dynamic" extensions which should be built for
 # run-time dynamic loading.
-dynamic_ext = Fcntl Errno IO Opcode Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File POSIX
+dynamic_ext = $extensions
 
 # Space-separated list of "static" extensions to build into perlshr (case counts).
 MYEXT = DynaLoader
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index d96c845a80..6b6483a9a1 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -449,6 +449,8 @@ $ if ("''Use_Threads'".eqs."T")
 $ THEN
 $ perl_arch = "''perl_arch'-thread"
 $ perl_archname = "''perl_archname'-thread"
+$ perl_d_old_pthread_create_joinable = "undef"
+$ perl_old_pthread_create_joinable = " "
 $ ELSE
 $ perl_d_old_pthread_create_joinable = "undef"
 $ perl_old_pthread_create_joinable = " "
@@ -1097,11 +1099,11 @@ $ DEASSIGN SYS$ERROR
 $ if (teststatus.nes."1")
 $ THEN
 $!  Okay, off64_t failed. Must not exist
-$   perl_d_off64t = "undef"
+$   perl_d_off64_t = "undef"
 $ ELSE
-$   perl_d_off64t="define"
+$   perl_d_off64_t="define"
 $ ENDIF
-$ WRITE_RESULT "d_off64t is ''perl_d_off64t'"
+$ WRITE_RESULT "d_off64_t is ''perl_d_off64_t'"
 $!
 $! Check to see if gethostname exists
 $!
@@ -1487,6 +1489,52 @@ $     ENDIF
 $   ENDIF
 $ WRITE_RESULT "d_fcntl is ''perl_d_fcntl'"
 $!
+$! Check for memchr
+$!
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <string.h>
+$ WS "int main()
+$ WS "{"
+$ WS "char * place;
+$ WS "place = memchr(""foo"", 47, 3)
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$   DEFINE SYS$ERROR _NLA0:
+$   DEFINE SYS$OUTPUT _NLA0:
+$   on error then continue
+$   on warning then continue
+$   'Checkcc' temp.c
+$   savedstatus = $status
+$   teststatus = f$extract(9,1,savedstatus)
+$   if (teststatus.nes."1")
+$   THEN
+$     perl_d_memchr="undef"
+$     DEASSIGN SYS$OUTPUT
+$     DEASSIGN SYS$ERROR
+$   ELSE
+$     If (Needs_Opt.eqs."Yes")
+$     THEN
+$       link temp.obj,temp.opt/opt
+$     else
+$       link temp.obj
+$     endif
+$     savedstatus = $status
+$     teststatus = f$extract(9,1,savedstatus)
+$     DEASSIGN SYS$OUTPUT
+$     DEASSIGN SYS$ERROR
+$     if (teststatus.nes."1")
+$     THEN
+$       perl_d_memchr="undef"
+$     ELSE
+$       perl_d_memchr="define"
+$     ENDIF
+$   ENDIF
+$ WRITE_RESULT "d_memchr is ''perl_d_memchr'"
+$!
 $! Check for access
 $!
 $ OS
@@ -1782,6 +1830,52 @@ $   perl_i_niin="undef"
 $ ENDIF
 $ WRITE_RESULT "i_niin is ''perl_i_niin'"
 $!
+$! Check for <netinet/tcp.h>
+$!
+$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
+$ THEN
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <stdio.h>
+$ if ("''Has_Socketshr'".eqs."T")
+$ THEN
+$  WS "#include <socketshr.h>"
+$ else
+$  WS "#include <netdb.h>
+$ endif
+$ WS "#include <netinet/tcp.h>"
+$ WS "int main()
+$ WS "{"
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$   DEFINE SYS$ERROR _NLA0:
+$   DEFINE SYS$OUTPUT _NLA0:
+$   on error then continue
+$   on warning then continue
+$   'Checkcc' temp.c
+$   If (Needs_Opt.eqs."Yes")
+$   THEN
+$     link temp.obj,temp.opt/opt
+$   else
+$     link temp.obj
+$   endif
+$   teststatus = f$extract(9,1,$status)
+$   DEASSIGN SYS$OUTPUT
+$   DEASSIGN SYS$ERROR
+$   if (teststatus.nes."1")
+$   THEN
+$     perl_i_netinettcp="undef"
+$   ELSE
+$     perl_i_netinettcp="define"
+$   ENDIF
+$ ELSE
+$   perl_i_netinettcp="undef"
+$ ENDIF
+$ WRITE_RESULT "i_netinettcp is ''perl_i_netinettcp'"
+$!
 $! Check for endhostent
 $!
 $ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
@@ -2396,13 +2490,17 @@ $   DEASSIGN SYS$ERROR
 $   if (teststatus.nes."1")
 $   THEN
 $     perl_d_sched_yield="undef"
+$     perl_sched_yield = " "
 $   ELSE
 $     perl_d_sched_yield="define"
+$     perl_sched_yield = "sched_yield"
 $   ENDIF
 $ ELSE
 $   perl_d_sched_yield="undef"
+$   perl_sched_yield = " "
 $ ENDIF
 $ WRITE_RESULT "d_sched_yield is ''perl_d_sched_yield'"
+$ WRITE_RESULT "sched_yield is ''perl_sched_yield'"
 $!
 $! Check for generic pointer size
 $!
@@ -2736,6 +2834,7 @@ $!
 $ WC "# This file generated by Configure.COM on a VMS system."
 $ WC "# Time: " + perl_cf_time
 $ WC ""
+$ WC "CONFIGDOTSH=true"
 $ WC "package='" + perl_package + "'"
 $ WC "CONFIG='" + perl_config + "'"
 $ WC "cf_time='" + perl_cf_time + "'"
@@ -2788,6 +2887,7 @@ $ WC "d_gethent='" + perl_d_gethent + "'"
 $ WC "d_getsent='" + perl_d_getsent + "'"
 $ WC "d_select='" + perl_d_select + "'"
 $ WC "i_niin='" + perl_i_niin + "'"
+$ WC "i_netinettcp='" + perl_i_netinettcp + "'"
 $ WC "i_neterrno='" + perl_i_neterrno + "'"
 $ WC "d_stdstdio='" + perl_d_stdstdio + "'"
 $ WC "d_stdio_ptr_lval='" + perl_d_stdio_ptr_lval + "'"
@@ -3160,7 +3260,7 @@ $ WC "d_nextkey64='" + perl_d_nextkey64 + "'"
 $ WC "i_poll='" + perl_i_poll + "'"
 $ WC "i_inttypes='" + perl_i_inttypes + "'"
 $ WC "d_int64t='" + perl_d_int64t + "'"
-$ WC "d_off64t='" + perl_d_off64t + "'"
+$ WC "d_off64_t='" + perl_d_off64_t + "'"
 $ WC "d_fstat64='" + perl_d_fstat64 + "'"
 $ WC "d_ftruncate64='" + perl_d_ftruncate64 + "'"
 $ WC "d_lseek64='" + perl_d_lseek64 + "'"
@@ -3192,7 +3292,11 @@ $ WC "seedfunc='" + perl_seedfunc + "'"
 $ WC "sig_num_init='" + perl_sig_num_with_commas + "'"
 $ WC "i_sysmount='" + perl_i_sysmount + "'"
 $ WC "d_fstatfs='" + perl_d_fstatfs + "'"
+$ WC "d_memchr='" + perl_d_memchr + "'"
 $ WC "d_statfsflags='" + perl_d_statfsflags + "'"
+$ WC "fflushNULL='define'"
+$ WC "fflushall='undef'"
+$ WC "d_stdio_stream_array='undef'"
 $ WC "i_sysstatvfs='" + perl_i_sysstatvfs + "'"
 $ WC "i_machcthreads='" + perl_i_machcthreads + "'"
 $ WC "i_pthread='" + perl_i_pthread + "'"
@@ -3210,6 +3314,7 @@ $ WC "i_sysmman='" + perl_i_sysmman + "'"
 $ WC "installusrbinperl='" + perl_installusrbinperl + "'"
 $ WC "crosscompile='" + perl_crosscompile + "'"
 $ WC "multiarch='" + perl_multiarch + "'"
+$ WC "sched_yield='" + perl_sched_yield + "'"
 $!
 $! ##WRITE NEW CONSTANTS HERE##
 $!
diff --git a/vms/vms.c b/vms/vms.c
index ebb05a142a..af35fbd62f 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -106,6 +106,18 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
                                  {LNM$C_NAMLENGTH, LNM$_STRING, eqv, &eqvlen},
                                  {0, 0, 0, 0}};
     $DESCRIPTOR(crtlenv,"CRTL_ENV");  $DESCRIPTOR(clisym,"CLISYM");
+#if defined(USE_THREADS)
+    /* We jump through these hoops because we can be called at */
+    /* platform-specific initialization time, which is before anything is */
+    /* set up--we can't even do a plain dTHR since that relies on the */
+    /* interpreter structure to be initialized */
+    struct perl_thread *thr;
+    if (PL_curinterp) {
+      thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
+    } else {
+      thr = NULL;
+    }
+#endif
 
     if (!lnm || !eqv || idx > LNM$_MAX_INDEX) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return 0;
@@ -159,8 +171,22 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
             if (eqvlen > 1024) {
               set_errno(EVMSERR); set_vaxc_errno(LIB$_STRTRU);
               eqvlen = 1024;
-              if (ckWARN(WARN_MISC))
-                warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+	      /* Special hack--we might be called before the interpreter's */
+	      /* fully initialized, in which case either thr or PL_curcop */
+	      /* might be bogus. We have to check, since ckWARN needs them */
+	      /* both to be valid if running threaded */
+#if defined(USE_THREADS)
+	      if (thr && PL_curcop) {
+#endif
+		if (ckWARN(WARN_MISC)) {
+		  warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+		}
+#if defined(USE_THREADS)
+	      } else {
+		  warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+	      }
+#endif
+	      
             }
             strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
           }
@@ -188,7 +214,6 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 }  /* end of vmstrnenv */
 /*}}}*/
 
-
 /*{{{ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)*/
 /* Define as a function so we can access statics. */
 int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
@@ -260,9 +285,19 @@ my_getenv(const char *lnm, bool sys)
 char *
 my_getenv_len(const char *lnm, unsigned long *len, bool sys)
 {
-    char buf[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+    char *buf, *cp1, *cp2;
     unsigned long idx = 0;
-
+    static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
+    SV *tmpsv;
+    
+    if (PL_curinterp) {  /* Perl interpreter running -- may be threaded */
+      /* Set up a temporary buffer for the return value; Perl will
+       * clean it up at the next statement transition */
+      tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+      if (!tmpsv) return NULL;
+      buf = SvPVX(tmpsv);
+    }
+    else buf = __my_getenv_len_eqv;  /* Assume no interpreter ==> single thread */
     for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
     if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
       getcwd(buf,LNM$C_NAMLENGTH);
@@ -285,7 +320,8 @@ my_getenv_len(const char *lnm, unsigned long *len, bool sys)
 #endif
                                                          )))
 	  return buf;
-      else return Nullch;
+      else
+	  return Nullch;
     }
 
 }  /* end of my_getenv_len() */
@@ -1083,6 +1119,7 @@ Pid_t
 my_waitpid(Pid_t pid, int *statusp, int flags)
 {
     struct pipe_details *info;
+    dTHR;
     
     for (info = open_pipes; info != NULL; info = info->next)
         if (info->pid == pid) break;
@@ -3381,6 +3418,7 @@ bool
 vms_do_exec(char *cmd)
 {
 
+  dTHR;
   if (vfork_called) {             /* this follows a vfork - act Unixish */
     vfork_called--;
     if (vfork_called < 0) {
@@ -3445,6 +3483,7 @@ unsigned long int
 do_spawn(char *cmd)
 {
   unsigned long int sts, substs, hadcmd = 1;
+  dTHR;
 
   TAINT_ENV();
   TAINT_PROPER("spawn");
@@ -4499,17 +4538,19 @@ flex_fstat(int fd, Stat_t *statbufp)
 }  /* end of flex_fstat() */
 /*}}}*/
 
-/*{{{ int flex_stat(char *fspec, Stat_t *statbufp)*/
+/*{{{ int flex_stat(const char *fspec, Stat_t *statbufp)*/
 int
-flex_stat(char *fspec, Stat_t *statbufp)
+flex_stat(const char *fspec, Stat_t *statbufp)
 {
     dTHR;
     char fileified[NAM$C_MAXRSS+1];
+    char temp_fspec[NAM$C_MAXRSS+300];
     int retval = -1;
 
+    strcpy(temp_fspec, fspec);
     if (statbufp == (Stat_t *) &PL_statcache)
-      do_tovmsspec(fspec,namecache,0);
-    if (is_null_device(fspec)) { /* Fake a stat() for the null device */
+      do_tovmsspec(temp_fspec,namecache,0);
+    if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
       memset(statbufp,0,sizeof *statbufp);
       statbufp->st_dev = encode_dev("_NLA0:");
       statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
@@ -4528,12 +4569,12 @@ flex_stat(char *fspec, Stat_t *statbufp)
      * the file with null type, specify this by calling flex_stat() with
      * a '.' at the end of fspec.
      */
-    if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
+    if (do_fileify_dirspec(temp_fspec,fileified,0) != NULL) {
       retval = stat(fileified,(stat_t *) statbufp);
       if (!retval && statbufp == (Stat_t *) &PL_statcache)
         strcpy(namecache,fileified);
     }
-    if (retval) retval = stat(fspec,(stat_t *) statbufp);
+    if (retval) retval = stat(temp_fspec,(stat_t *) statbufp);
     if (!retval) {
       statbufp->st_dev = encode_dev(statbufp->st_devnam);
 #     ifdef RTL_USES_UTC
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 06ad647169..8f630189b7 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -66,6 +66,7 @@
 
 /* Note that we do, in fact, have this */
 #define HAS_GETENV_SV
+#define HAS_GETENV_LEN
 
 #ifndef DONT_MASK_RTL_CALLS
 #  ifdef getenv
@@ -624,7 +625,7 @@ int     my_sigprocmask (int, sigset_t *, sigset_t *);
 #endif
 I32	cando_by_name (I32, I32, char *);
 int	flex_fstat (int, Stat_t *);
-int	flex_stat (char *, Stat_t *);
+int	flex_stat (const char *, Stat_t *);
 int	trim_unixpath (char *, char*, int);
 int	my_vfork ();
 bool	vms_do_aexec (SV *, SV **, SV **);