Add os390.c and z/OS startup code

MANIFEST

@@ -5665,6 +5665,7 @@ os2/os2thread.h				pthread-like typedefs
 os2/perl2cmd.pl				Corrects installed binaries under OS/2
 os2/perlrexx.c				Support perl interpreter embedded in REXX
 os2/perlrexx.cmd			Test perl interpreter embedded in REXX
+os390/os390.c				z/OS specific code
 plan9/9front.patch			Plan9 port: patch for 9front-specific flavor of Plan 9
 plan9/aperl				Plan9 port: shell to make Perl error messages Acme-friendly
 plan9/arpa/inet.h			Plan9 port: replacement C header file

doio.c

@@ -222,57 +222,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
 #endif
 }
 
-#if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-#   include <stdio.h>
-#   include <stdlib.h>
-
-    static int setccsid(int fd, int ccsid) 
-    {
-      attrib_t attr;
-      int rc;
-
-      memset(&attr, 0, sizeof(attr));
-      attr.att_filetagchg = 1;
-      attr.att_filetag.ft_ccsid = ccsid;
-      attr.att_filetag.ft_txtflag = 1;
-
-      rc = __fchattr(fd, &attr, sizeof(attr));
-      return rc;
-    }
-
-    static void updateccsid(int fd, const char* path, int oflag, int perm) 
-    { 
-      int rc;
-      if (oflag & O_CREAT) {
-        rc = setccsid(fd, 819);
-      }
-    }
-
-    int asciiopen(const char* path, int oflag) 
-    {
-      int rc;
-      int fd = open(path, oflag);
-      if (fd == -1) { 
-        return fd;
-      }
-      updateccsid(fd, path, oflag, -1);
-      return fd; 
-    }
-
-    int asciiopen3(const char* path, int oflag, int perm) 
-    {
-      int rc;
-      int fd = open(path, oflag, perm);
-      if (fd == -1) { 
-        return fd;
-      }
-      updateccsid(fd, path, oflag, perm);
-      return fd;
-    } 
-  #endif
-#endif
-
 int
 Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
 {
@@ -302,9 +251,6 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
 }
 
 #if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-    #define TEMP_CCSID 819
-  #endif
 static int Internal_Perl_my_mkstemp_cloexec(char *templte)
 {     
     PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC;
@@ -321,9 +267,6 @@ int
 Perl_my_mkstemp_cloexec(char *templte) 
 {
     int tempfd = Internal_Perl_my_mkstemp_cloexec(templte);
-#  if defined(TEMP_CCSID)
-    setccsid(tempfd, TEMP_CCSID);
-#  endif
     return tempfd;
 }
 
@@ -1471,6 +1414,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 #endif
                 PL_filemode = statbuf.st_mode;
                 fileuid = statbuf.st_uid;
+#ifdef __MVS__
+                int txtflag = statbuf.st_tag.ft_txtflag;
+                int ccsid = statbuf.st_tag.ft_ccsid;
+#endif
                 filegid = statbuf.st_gid;
                 if (!S_ISREG(PL_filemode)) {
                     ck_warner_d(packWARN(WARN_INPLACE),
@@ -1548,6 +1495,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
                 PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
                 if (PL_lastfd >= 0) {
                     (void)PerlLIO_fstat(PL_lastfd,&statbuf);
+#ifdef __MVS__
+                    __setfdccsid(PL_lastfd, (txtflag << 16) | ccsid);
+#endif
 #ifdef HAS_FCHMOD
                     (void)fchmod(PL_lastfd,PL_filemode);
 #else
@@ -2558,6 +2508,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
             }
           doshell:
             PERL_FPU_PRE_EXEC
+#if defined(OEMVS)
+  #if (__CHARSET_LIB == 1)
+            unsetenv("_TAG_REDIR_ERR");
+  #endif
+#endif
             PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
             PERL_FPU_POST_EXEC
             S_exec_failed(aTHX_ PL_sh_path, fd, do_report);

installperl

@@ -284,7 +284,6 @@ else {
     strip("$installbin/$perl_verbase$ver$exe_ext");
     fix_dep_names("$installbin/$perl_verbase$ver$exe_ext");
     chmod(0755, "$installbin/$perl_verbase$ver$exe_ext");
-    `chtag -r "$installbin/$perl_verbase$ver$exe_ext"` if ($^O eq 'os390');
 }
 
 # Install library files.
@@ -355,7 +354,6 @@ foreach my $file (@corefiles) {
 	} else {
 	    chmod($NON_SO_MODE, "$installarchlib/CORE/$file");
 	}
-        `chtag -r "$installarchlib/CORE/$file"` if ($^O eq 'os390');
     }
 }
 
@@ -424,7 +422,6 @@ if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
 	  eval { CORE::link $instperl, $usrbinperl } )	||
 	eval { symlink $expinstperl, $usrbinperl }	||
 	copy($instperl, $usrbinperl);
-        `chtag -r "$usrbinperl"` if ($^O eq 'os390');
 
 	$mainperl_is_instperl = 1;
     }
@@ -719,7 +716,6 @@ sub copy_if_diff {
 	    my ($atime, $mtime) = (stat $from)[8,9];
 	    utime $atime, $mtime, $to;
 	}
-        `chtag -r "$to"` if ($^O eq "os390");
 	1;
     }
 }

iperlsys.h

@@ -770,21 +770,8 @@ struct IPerlLIOInfo
 #    define PerlLIO_lstat(name, buf)    PerlLIO_stat((name), (buf))
 #  endif
 #  define PerlLIO_mktemp(file)          mktemp((file))
-#  if defined(OEMVS)
-#    if (__CHARSET_LIB == 1)
-    int asciiopen(const char* path, int oflag);
-    int asciiopen3(const char* path, int oflag, int perm);
-
-#      define PerlLIO_open(file, flag)          asciiopen((file), (flag))
-#      define PerlLIO_open3(file, flag, perm)   asciiopen3((file), (flag), (perm))
-#    else
-#      define PerlLIO_open(file, flag)          open((file), (flag))
-#      define PerlLIO_open3(file, flag, perm)   open((file), (flag), (perm))
-#    endif
-#  else
-#    define PerlLIO_open(file, flag)            open((file), (flag))
-#    define PerlLIO_open3(file, flag, perm)     open((file), (flag), (perm))
-#  endif
+#  define PerlLIO_open(file, flag)            open((file), (flag))
+#  define PerlLIO_open3(file, flag, perm)     open((file), (flag), (perm))
 #  define PerlLIO_read(fd, buf, count)  read((fd), (buf), (count))
 #  define PerlLIO_rename(old, new)      rename((old), (new))
 #  define PerlLIO_setmode(fd, mode)     setmode((fd), (mode))

lib/File/Copy.pm

@@ -5,7 +5,7 @@
 # Additions copyright 1996 by Charles Bailey.  Permission is granted
 # to distribute the revised code under the same terms as Perl itself.
 
-package File::Copy 2.42;
+package File::Copy 2.43;
 
 use v5.40;
 no warnings 'newline';
@@ -165,6 +165,11 @@ sub copy {
 	$closeto = 1;
     }
 
+    # Copy file tags on os390
+    if ($^O eq 'os390') {
+      ZOS::Filespec::copytags_fd(fileno($from_h), fileno($to_h));
+    }
+
     $! = 0;
     for (;;) {
 	my ($r, $w, $t);

os390/os390.c

@@ -0,0 +1,56 @@
+#include <string.h>
+#include <sys/stat.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/ps.h>
+#include <unistd.h>
+#include <stdarg.h>
+#include <varargs.h>
+#include <limits.h>
+#include <_Nascii.h>
+#include <fcntl.h>
+#include <libgen.h>
+#include <termios.h>
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+void
+zos_copytags_fd(pTHX_ CV *cv)
+{
+  dXSARGS;
+  int ret = 0;
+
+  if (items != 2)
+    Perl_croak(aTHX_ "Usage: ZOS::Filespec::copytags_fd(f1, f2])");
+
+  int from_fd = (int)SvIV(ST(0));
+  int to_fd = (int)SvIV(ST(1));
+
+  char path[_XOPEN_PATH_MAX] = {0};
+  int rc = w_ioctl(from_fd, _IOCC_GPN, _XOPEN_PATH_MAX, path);
+  if (rc == 0) {
+    __e2a_l(path, _XOPEN_PATH_MAX);
+  }
+
+  struct stat src_statsbuf;
+  if (stat(path, &src_statsbuf)) {
+    ret = -1;
+  }
+  if (ret != -1) {
+    ret = __setfdccsid(to_fd,  (src_statsbuf.st_tag.ft_txtflag << 16) | src_statsbuf.st_tag.ft_ccsid);
+  }
+
+  XSRETURN_IV(ret);
+}
+
+void
+init_os_extras(void)
+{
+  dTHX;
+  char* file = __FILE__;
+
+  newXSproto("ZOS::Filespec::copytags_fd",zos_copytags_fd,file,"$;$");
+
+  return;
+}

perl.c

@@ -2597,7 +2597,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     if (xsinit)
         (*xsinit)(aTHX);	/* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32) || defined(__CYGWIN__)
+#if defined(VMS) || defined(WIN32) || defined(__CYGWIN__) || defined(__MVS__)
     init_os_extras();
 #endif
 

perl.h

@@ -4469,8 +4469,17 @@ intrinsic function, see its documents for more details.
             cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1)
 #endif
 
-#ifdef __CYGWIN__
+#if defined(__CYGWIN__) || defined(__MVS__)
+
 void init_os_extras(void);
+
+#endif
+#if defined(__MVS__)
+#  ifdef EBCDIC
+#    define __setfdccsid(to_fd,  bits)  0
+#  else
+#    include <zos.h>
+#  endif
 #endif
 
 union any {

util.c

@@ -2534,12 +2534,6 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
         /* Close parent's end of error status pipe (if any) */
         if (did_pipes)
             PerlLIO_close(pp[0]);
-#if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-        chgfdccsid(p[THIS], 819);
-        chgfdccsid(p[THAT], 819);
-  #endif
-#endif
         /* Now dup our end of _the_ pipe to right position */
         if (p[THIS] != (*mode == 'r')) {
             PerlLIO_dup2(p[THIS], *mode == 'r');
@@ -2615,20 +2609,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
     }
     if (did_pipes)
          PerlLIO_close(pp[0]);
-#if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-    PerlIO* io = PerlIO_fdopen(p[This], mode);
-    if (io) {
-      chgfdccsid(p[This], 819);
-    }
-    return io;
-  #else
-    return PerlIO_fdopen(p[This], mode);
-  #endif
-#else
     return PerlIO_fdopen(p[This], mode);
-#endif
-
 #else
 #  if defined(OS2)	/* Same, without fork()ing and all extra overhead... */
     return my_syspopen4(aTHX_ NULL, mode, n, args);
@@ -2706,12 +2687,6 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 #define THAT This
         if (did_pipes)
             PerlLIO_close(pp[0]);
-#if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-        chgfdccsid(p[THIS], 819);
-        chgfdccsid(p[THAT], 819);
-  #endif
-#endif
         if (p[THIS] != (*mode == 'r')) {
             PerlLIO_dup2(p[THIS], *mode == 'r');
             PerlLIO_close(p[THIS]);
@@ -2798,19 +2773,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
     }
     if (did_pipes)
          PerlLIO_close(pp[0]);
-#if defined(OEMVS)
-  #if (__CHARSET_LIB == 1)
-    PerlIO* io = PerlIO_fdopen(p[This],	mode);
-    if (io) {
-      chgfdccsid(p[This], 819);
-    }
-    return io;
-  #else
     return PerlIO_fdopen(p[This], mode);
-  #endif
-#else
-    return PerlIO_fdopen(p[This], mode);
-#endif
 }
 #elif defined(__LIBCATAMOUNT__)
 PerlIO *