summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2015-06-28 12:37:27 -0500
committerCraig A. Berry <craigberry@mac.com>2015-06-28 12:37:27 -0500
commit054a3baf7ca16fe022e9a5fd56c158300d5c44f5 (patch)
treef2ec729be1f37bf46bef16df5b0c7dc3e78f579a
parent2ad792cd4e9684519736fe03fd28a706b71ceda3 (diff)
downloadperl-054a3baf7ca16fe022e9a5fd56c158300d5c44f5.tar.gz
Require v7.3-2 or later for VMS builds.
OpenVMS v7.3-2 was released in 2003. Regular support ended in 2006 and even prior version support will be ending in 2015, so this seems like a pretty generous minimum for future Perl versions. A side of effect of this is that OpenVMS VAX will no longer be supported. The terminal software release for VAX was v7.3 in 2001 with support ending in 2012. VAX was a truly great architecture in the 1970s, 1980s, and 1990s, but it's just missing too many of the things expected in architectures, file systems and C run-times of the current century. De-supporting this older stuff allows quite a bit of code removal and simplification, hopefully easing the maintenance burden a bit.
-rw-r--r--configure.com374
-rw-r--r--vms/descrip_mms.template3
-rw-r--r--vms/gen_shrfls.pl73
-rw-r--r--vms/vms.c328
-rw-r--r--vms/vmsish.h6
5 files changed, 184 insertions, 600 deletions
diff --git a/configure.com b/configure.com
index a136a77c4e..efa3390f44 100644
--- a/configure.com
+++ b/configure.com
@@ -144,7 +144,7 @@ $ silent=""
$ extractsh=""
$ override=""
$ knowitall=""
-$ ccname="VAX"
+$ ccname="DECC"
$ Dec_C_Version = ""
$ cxxversion = ""
$ use_threads = "F"
@@ -978,7 +978,6 @@ $!
$!First time through, eh? I have some defaults handy for the following systems:
$!
$! EOD
-$! echo " ","VMS_VAX"
$! echo " ","VMS_AXP"
$! echo " ","VMS_IA64"
$! : Now look for a hint file osname_osvers, unless one has been
@@ -1161,25 +1160,24 @@ $! appendages later depending on configuration options. But we need the
$! base name early because not all questions are worth asking on all
$! platforms.
$!
-$! Please use F$ELEMENT(0,"-",archname) .EQS. "VMS_VAX" (or "VMS_AXP" or
+$! Please use F$ELEMENT(0,"-",archname) .EQS. "VMS_AXP" (or
$! "VMS_IA64") from here on to allow cross-platform configuration (e.g.
-$! configure a VAX build on an Alpha).
+$! configure a IA64 build on an Alpha).
$!
$ IF (F$GETSYI("HW_MODEL") .LT. 1024 .AND. F$GETSYI("HW_MODEL") .GT. 0)
$ THEN
-$ archname = "VMS_VAX"
-$ otherarch = "an Alpha or IA64"
-$ alignbytes="8"
-$ arch_type = "ARCH-TYPE=__VAX__"
+$ echo "Sorry, VAX is no longer supported by this Perl version."
+$ echo "Please try Perl 5.22 or earlier"
+$ exit 44
$ ELSE
$ IF (F$GETSYI("ARCH_TYPE") .EQ. 2)
$ THEN
$ archname = "VMS_AXP"
-$ otherarch = "a VAX or IA64"
+$ otherarch = "IA64"
$ arch_type = "ARCH-TYPE=__AXP__"
$ ELSE
$ archname = "VMS_IA64"
-$ otherarch = "a VAX or Alpha"
+$ otherarch = "Alpha"
$ arch_type = "ARCH-TYPE=__IA64__"
$ ENDIF
$ alignbytes="8"
@@ -1583,11 +1581,8 @@ $ CLOSE CONFIG
$ echo "You are using Dec C ''line'"
$ ccversion = line
$ Dec_C_Version = F$INTEGER(line)
-$ IF Dec_C_Version .GE. 60200000 .AND. F$ELEMENT(0, "-", archname) .NES. "VMS_VAX"
-$ THEN
-$ echo4 "adding /NOANSI_ALIAS qualifier to ccflags."
-$ ccflags = ccflags + "/NOANSI_ALIAS"
-$ ENDIF
+$ echo4 "adding /NOANSI_ALIAS qualifier to ccflags."
+$ ccflags = ccflags + "/NOANSI_ALIAS"
$ DELETE/NOLOG/NOCONFIRM deccvers.*;
$ ENDIF
$Gcc_check:
@@ -1780,17 +1775,11 @@ $!
$List_Parse:
$ OPEN/READ CONFIG ccvms.lis
$ READ CONFIG line
-$ IF F$ELEMENT(0, "-", archname) .EQS. "VMS_VAX"
+$ IF F$ELEMENT(0, "-", archname) .EQS. "VMS_AXP"
$ THEN
-$ read CONFIG line
-$ archsufx = "VAX"
+$ archsufx = "AXP"
$ ELSE
-$ IF F$ELEMENT(0, "-", archname) .EQS. "VMS_AXP"
-$ THEN
-$ archsufx = "AXP"
-$ ELSE
-$ archsufx = "IA64"
-$ ENDIF
+$ archsufx = "IA64"
$ ENDIF
$ CLOSE CONFIG
$ line = F$EDIT(line,"TRIM,COMPRESS")
@@ -2064,7 +2053,7 @@ $ THEN
$ thread_upcalls = "MTU=MTU=1"
$ usethreadupcalls = "define"
$ ! Are they on alpha or itanium?
-$ IF (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX") .AND. ("''f$extract(1,3, f$getsyi(""version""))'" .GES. "7.2")
+$ IF ("''f$extract(1,3, f$getsyi(""version""))'" .GES. "7.2")
$ THEN
$ echo ""
$ echo "Threaded Perl can be linked to use multiple kernel threads on your system."
@@ -2117,106 +2106,103 @@ $ ENDIF
$ ENDIF
$!
$! Ask if they want to build with 64-bit support
-$ IF (F$ELEMENT(0, "-", archname).NES."VMS_VAX").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1")
+$ bool_dflt = "n"
+$ IF F$TYPE(use64bitint) .NES. ""
$ THEN
-$ bool_dflt = "n"
-$ IF F$TYPE(use64bitint) .NES. ""
-$ THEN
-$ IF use64bitint .OR. use64bitint .eqs. "define" THEN bool_dflt = "y"
-$ ENDIF
-$ echo ""
-$ echo "You have natively 64-bit long integers."
-$ echo ""
-$ echo "Perl can be built to take advantage of 64-bit integer types"
-$ echo "on some systems, To do so, Configure can be run with -Duse64bitint."
-$ echo "Choosing this option will most probably introduce binary incompatibilities."
-$ echo ""
-$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
-$ rp = "Try to use 64-bit integers, if available? [''bool_dflt'] "
-$ GOSUB myread
-$ use64bitint = ans
+$ IF use64bitint .OR. use64bitint .eqs. "define" THEN bool_dflt = "y"
+$ ENDIF
+$ echo ""
+$ echo "You have natively 64-bit long integers."
+$ echo ""
+$ echo "Perl can be built to take advantage of 64-bit integer types"
+$ echo "on some systems, To do so, Configure can be run with -Duse64bitint."
+$ echo "Choosing this option will most probably introduce binary incompatibilities."
+$ echo ""
+$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
+$ rp = "Try to use 64-bit integers, if available? [''bool_dflt'] "
+$ GOSUB myread
+$ use64bitint = ans
$!
-$ bool_dflt = "n"
-$ IF F$TYPE(use64bitall) .NES. ""
-$ THEN
-$ IF use64bitall .OR. use64bitall .eqs. "define" THEN bool_dflt = "y"
-$ ENDIF
-$ echo ""
-$ echo "You may also choose to try maximal 64-bitness. It means using as much"
-$ echo "64-bitness as possible on the platform. This in turn means even more"
-$ echo "binary incompatibilities. On the other hand, your platform may not"
-$ echo "have any more 64-bitness available than what you already have chosen."
+$ bool_dflt = "n"
+$ IF F$TYPE(use64bitall) .NES. ""
+$ THEN
+$ IF use64bitall .OR. use64bitall .eqs. "define" THEN bool_dflt = "y"
+$ ENDIF
+$ echo ""
+$ echo "You may also choose to try maximal 64-bitness. It means using as much"
+$ echo "64-bitness as possible on the platform. This in turn means even more"
+$ echo "binary incompatibilities. On the other hand, your platform may not"
+$ echo "have any more 64-bitness available than what you already have chosen."
+$ echo ""
+$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
+$ rp = "Try to use maximal 64-bit support, if available? [''bool_dflt'] "
+$ GOSUB myread
+$ use64bitall=ans
+$ IF use64bitall .AND. .NOT. use64bitint
+$ THEN
$ echo ""
-$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
-$ rp = "Try to use maximal 64-bit support, if available? [''bool_dflt'] "
-$ GOSUB myread
-$ use64bitall=ans
-$ IF use64bitall .AND. .NOT. use64bitint
-$ THEN
-$ echo ""
-$ echo "Since you have chosen a maximally 64-bit build, I'm also turning on"
-$ echo "the use of 64-bit integers."
-$ use64bitint="Y"
-$ ENDIF
+$ echo "Since you have chosen a maximally 64-bit build, I'm also turning on"
+$ echo "the use of 64-bit integers."
+$ use64bitint="Y"
+$ ENDIF
$!
-$ bool_dflt = use64bitall
-$ IF F$TYPE(uselargefiles) .NES. ""
-$ THEN
-$ IF uselargefiles .OR. uselargefiles .eqs. "define" THEN bool_dflt = "y"
-$ ENDIF
-$ echo ""
-$ echo "Perl can be built to understand large files (files larger than 2 gigabytes)"
-$ echo "on some systems. To do so, Configure can be run with -Duselargefiles."
-$ echo ""
-$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
-$ rp = "Try to understand large files, if available? [''bool_dflt'] "
-$ GOSUB myread
-$ uselargefiles=ans
+$ bool_dflt = use64bitall
+$ IF F$TYPE(uselargefiles) .NES. ""
+$ THEN
+$ IF uselargefiles .OR. uselargefiles .eqs. "define" THEN bool_dflt = "y"
+$ ENDIF
+$ echo ""
+$ echo "Perl can be built to understand large files (files larger than 2 gigabytes)"
+$ echo "on some systems. To do so, Configure can be run with -Duselargefiles."
+$ echo ""
+$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
+$ rp = "Try to understand large files, if available? [''bool_dflt'] "
+$ GOSUB myread
+$ uselargefiles=ans
$!
-$ bool_dflt = "n"
-$ IF F$TYPE(uselongdouble) .NES. ""
-$ THEN
-$ IF uselongdouble .OR. uselongdouble .eqs. "define" THEN bool_dflt = "y"
-$ ENDIF
-$ echo ""
-$ echo "Perl can be built to take advantage of long doubles which"
-$ echo "(if available) may give more accuracy and range for floating point numbers."
-$ echo ""
-$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
-$ rp = "Try to use long doubles, if available? [''bool_dflt'] "
-$ GOSUB myread
-$ uselongdouble = ans
+$ bool_dflt = "n"
+$ IF F$TYPE(uselongdouble) .NES. ""
+$ THEN
+$ IF uselongdouble .OR. uselongdouble .eqs. "define" THEN bool_dflt = "y"
+$ ENDIF
+$ echo ""
+$ echo "Perl can be built to take advantage of long doubles which"
+$ echo "(if available) may give more accuracy and range for floating point numbers."
+$ echo ""
+$ echo "If this does not make any sense to you, just accept the default '" + bool_dflt + "'."
+$ rp = "Try to use long doubles, if available? [''bool_dflt'] "
+$ GOSUB myread
+$ uselongdouble = ans
$!
-$ ENDIF ! not VAX && >= 7.1
$!
$ IF usesitecustomize .OR. usesitecustomize .eqs. "define"
$ THEN
-$ usesitecustomize = "define"
+$ usesitecustomize = "define"
$ ELSE
-$ usesitecustomize = "undef"
+$ usesitecustomize = "undef"
$ ENDIF
$!
$! Case sensitive?
-$ echo ""
-$ echo "By default, perl (and pretty much everything else on VMS) uses"
-$ echo "case-insensitive linker symbols. Which is to say, when the"
-$ echo "underlying C code makes a call to a routine called Perl_foo in"
-$ echo "the source, the name in the object modules or shareable images"
-$ echo "is really PERL_FOO. There are some packages that use an"
-$ echo "embedded perl interpreter that instead require case-sensitive"
-$ echo "linker symbols."
-$ echo ""
-$ echo "If you have no idea what this means, and do not have"
-$ echo "any program requiring anything, choose the default."
-$ bool_dflt = be_case_sensitive
-$ if f$type(usecasesensitive) .nes. ""
-$ then
-$ if usecasesensitive .or. usecasesensitive .eqs. "define" then bool_dflt = "y"
-$ if f$extract(0,1,f$edit(usecasesensitive,"collapse,upcase")).eqs."N" .or. usecasesensitive .eqs. "undef" then bool_dflt = "n"
-$ endif
-$ rp = "Build with case-sensitive symbols? [''bool_dflt'] "
-$ GOSUB myread
-$ be_case_sensitive = ans
+$ echo ""
+$ echo "By default, perl (and pretty much everything else on VMS) uses"
+$ echo "case-insensitive linker symbols. Which is to say, when the"
+$ echo "underlying C code makes a call to a routine called Perl_foo in"
+$ echo "the source, the name in the object modules or shareable images"
+$ echo "is really PERL_FOO. There are some packages that use an"
+$ echo "embedded perl interpreter that instead require case-sensitive"
+$ echo "linker symbols."
+$ echo ""
+$ echo "If you have no idea what this means, and do not have"
+$ echo "any program requiring anything, choose the default."
+$ bool_dflt = be_case_sensitive
+$ if f$type(usecasesensitive) .nes. ""
+$ then
+$ if usecasesensitive .or. usecasesensitive .eqs. "define" then bool_dflt = "y"
+$ if f$extract(0,1,f$edit(usecasesensitive,"collapse,upcase")).eqs."N" .or. usecasesensitive .eqs. "undef" then bool_dflt = "n"
+$ endif
+$ rp = "Build with case-sensitive symbols? [''bool_dflt'] "
+$ GOSUB myread
+$ be_case_sensitive = ans
$!
$! Shortened symbols?
$ echo ""
@@ -2231,30 +2217,25 @@ $ endif
$ rp = "Build with long symbols shortened? [''bool_dflt'] "
$ GOSUB myread
$ shorten_long_symbols = ans
-$ IF F$ELEMENT(0, "-", archname) .NES. "VMS_VAX"
-$ THEN
$! IEEE math?
-$ echo ""
-$ echo "Perl normally uses IEEE format (T_FLOAT) floating point numbers on"
-$ echo "Alpha and Itanium, but if you need G_FLOAT for binary compatibility"
-$ echo "with an external library or existing data, you may wish to disable"
-$ echo "the IEEE math option."
-$ bool_dflt = use_ieee_math
-$ if f$type(useieee) .nes. ""
+$ echo ""
+$ echo "Perl normally uses IEEE format (T_FLOAT) floating point numbers on"
+$ echo "Alpha and Itanium, but if you need G_FLOAT for binary compatibility"
+$ echo "with an external library or existing data, you may wish to disable"
+$ echo "the IEEE math option."
+$ bool_dflt = use_ieee_math
+$ if f$type(useieee) .nes. ""
+$ then
+$ if useieee .or. useieee .eqs. "define"
$ then
-$ if useieee .or. useieee .eqs. "define"
-$ then
-$ bool_dflt="y"
-$ else
-$ bool_dflt="n"
-$ endif
+$ bool_dflt="y"
+$ else
+$ bool_dflt="n"
$ endif
-$ rp = "Use IEEE math? [''bool_dflt'] "
-$ GOSUB myread
-$ use_ieee_math = ans
-$ ELSE
-$ use_ieee_math = "n"
-$ ENDIF
+$ endif
+$ rp = "Use IEEE math? [''bool_dflt'] "
+$ GOSUB myread
+$ use_ieee_math = ans
$ useieee = "undef"
$ usecasesensitive = "undef"
$ useshortenedsymbols = "undef"
@@ -3325,52 +3306,27 @@ $!
$ perllibs=libs
$!
$!
-$ IF F$ELEMENT(0, "-", archname) .NES. "VMS_VAX"
-$ THEN
-$ d_PRId64 = "define"
-$ d_PRIi64 = "define"
-$ d_PRIu64 = "define"
-$ d_PRIo64 = "define"
-$ d_PRIx64 = "define"
-$ d_PRIXU64 = "define"
-$ sPRId64 = """Ld"""
-$ sPRIXU64 = """LX"""
-$ sPRIi64 = """Li"""
-$ sPRIo64 = """Lo"""
-$ sPRIu64 = """Lu"""
-$ sPRIx64 = """Lx"""
-$ d_quad = "define"
-$ quadtype = "long long"
-$ uquadtype = "unsigned long long"
-$ quadkind = "3"
-$!
-$ d_frexpl = "define"
-$ d_ldexpl = "define"
-$ d_modfl = "define"
-$ d_modflproto = "define"
-$ ELSE
-$ d_PRId64 = "undef"
-$ d_PRIi64 = "undef"
-$ d_PRIXU64 = "undef"
-$ d_PRIu64 = "undef"
-$ d_PRIo64 = "undef"
-$ d_PRIx64 = "undef"
-$ sPRId64 = ""
-$ sPRIXU64 = """lX"""
-$ sPRIi64 = ""
-$ sPRIo64 = ""
-$ sPRIu64 = ""
-$ sPRIx64 = ""
-$ d_quad = "undef"
-$ quadtype = "undef"
-$ uquadtype = "undef"
-$ quadkind = "undef"
-$!
-$ d_frexpl = "undef"
-$ d_ldexpl = "undef"
-$ d_modfl = "undef"
-$ d_modflproto = "undef"
-$ ENDIF
+$ d_PRId64 = "define"
+$ d_PRIi64 = "define"
+$ d_PRIu64 = "define"
+$ d_PRIo64 = "define"
+$ d_PRIx64 = "define"
+$ d_PRIXU64 = "define"
+$ sPRId64 = """Ld"""
+$ sPRIXU64 = """LX"""
+$ sPRIi64 = """Li"""
+$ sPRIo64 = """Lo"""
+$ sPRIu64 = """Lu"""
+$ sPRIx64 = """Lx"""
+$ d_quad = "define"
+$ quadtype = "long long"
+$ uquadtype = "unsigned long long"
+$ quadkind = "3"
+$!
+$ d_frexpl = "define"
+$ d_ldexpl = "define"
+$ d_modfl = "define"
+$ d_modflproto = "define"
$!
$ IF useieee .OR. useieee .EQS. "define"
$ THEN
@@ -5184,7 +5140,7 @@ $! easy to use DCL test to see if hardlinks are enabled on the build
$! disk. That would require more work to test, and I am only testing
$! this on 8.2, so that is why the 8.2 test.
$!
-$ IF (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ IF (vms_ver .GES. "8.2")
$ THEN
$ IF f$getdvi("SYS$DISK","HARDLINKS_SUPPORTED")
$ THEN
@@ -5202,7 +5158,7 @@ $ ENDIF
$!
$ IF uselargefiles .OR. uselargefiles .eqs. "define"
$ THEN
-$ IF (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ IF (vms_ver .GES. "8.2")
$ THEN
$ echo4 "Largefile support enabled, so enabling standard stat support too."
$ usestdstat = "y"
@@ -5243,7 +5199,7 @@ $ echo4 "Your system does not support symbolic links."
$ echo4 "I am disabling symbolic link support."
$ ENDIF
$ ELSE
-$ IF (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ IF (vms_ver .GES. "8.2")
$ THEN
$ echo4 "-Duselargefiles is required for symbolic link support."
$ echo4 "You did not specify that, so I am disabling symbolic link support."
@@ -5277,25 +5233,22 @@ $ d_ttyname_r = "undef"
$ ttyname_r_proto = "0"
$ d_snprintf = "undef"
$ d_vsnprintf = "undef"
-$ if (vms_ver .GES. "7.3-2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ echo "Asumming 64-bit OpenVMS ''vms_ver' -- will build with V7.3-2 routines"
+$ d_getgrgid_r = "define"
+$ getgrgid_r_proto = "1"
+$ d_getgrnam_r = "define"
+$ getgrnam_r_proto = "1"
+$ if d_symlink .or. d_symlink .EQS. "define"
$ then
-$ echo "Found 64 bit OpenVMS ''vms_ver' -- will build with V7.3-2 routines"
-$ d_getgrgid_r = "define"
-$ getgrgid_r_proto = "1"
-$ d_getgrnam_r = "define"
-$ getgrnam_r_proto = "1"
-$ if d_symlink .or. d_symlink .EQS. "define"
-$ then
$! FIXME: Need to find how to activate this.
$! d_getpgid = "define"
$! d_getpgrp = "define"
-$ endif
-$ d_setgrent = "define"
-$ d_ttyname_r = "define"
-$ ttyname_r_proto = "1"
-$ d_snprintf = "define"
-$ d_vsnprintf = "define"
$ endif
+$ d_setgrent = "define"
+$ d_ttyname_r = "define"
+$ ttyname_r_proto = "1"
+$ d_snprintf = "define"
+$ d_vsnprintf = "define"
$!
$! VMS V7.3-2 powered options
$! We know that it is only available for V7.3-2 and later on 64 bit platforms.
@@ -5311,7 +5264,7 @@ $ d_setregid = "undef"
$ d_setreuid = "undef"
$ d_setsid = "undef"
$ ! Disable this section for now.
-$!$ if (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$!$ if (vms_ver .GES. "8.2")
$ if .NOT. 1
$ then
$ echo "Found 64 bit OpenVMS ''vms_ver' -- will build with V7.3-2 UID setting routines"
@@ -5329,7 +5282,7 @@ $!
$ d_fstatvfs = "undef"
$ d_statvfs = "undef"
$ i_sysstatvfs = "undef"
-$ if (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ if (vms_ver .GES. "8.2")
$ then
$ echo "Found 64 bit OpenVMS ''vms_ver' -- will build with 8.2 routines"
$ d_fstatvfs = "define"
@@ -5398,10 +5351,7 @@ $ d_index="define"
$ pidtype="pid_t"
$ sig_name1="ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE"
$ sig_name2=" ALRM TERM USR1 USR2 NUM18 NUM19 CHLD CONT STOP TSTP TTIN TTOU DEBUG"
-$ IF (vms_ver .GES. "7.3")
-$ THEN
-$ sig_name2 = sig_name2 + " NUM27 WINCH"
-$ ENDIF
+$ sig_name2 = sig_name2 + " NUM27 WINCH"
$!* signal.h defines SIGRTMIN as 33 and SIGRTMAX as 64, but there is no
$!* sigqueue function or other apparent means to do realtime signalling,
$!* so let's not try to include the realtime range for now.
@@ -5493,7 +5443,7 @@ $ d_vms_do_sockets="define"
$ d_htonl="define"
$ d_socket="define"
$ d_sockpair = "undef"
-$ if (vms_ver .GES. "8.2") .AND. (F$ELEMENT(0, "-", archname) .NES. "VMS_VAX")
+$ if (vms_ver .GES. "8.2")
$ then
$ echo "Found 64 bit OpenVMS 8.2, will build with socketpair support"
$ d_sockpair = "define"
@@ -6061,7 +6011,7 @@ $ WC "d_fdim='" + d_fdim + "'"
$ WC "d_fds_bits='define'"
$ WC "d_fegetround='undef'"
$ WC "d_fgetpos='define'"
-$ IF F$ELEMENT(0, "-", archname) .NES. "VMS_VAX" .AND. use_ieee_math
+$ IF use_ieee_math
$ THEN
$ WC "d_finite='define'"
$ WC "d_finitel='define'"
@@ -6098,12 +6048,7 @@ $ WC "d_ftime='define'"
$ WC "d_futimes='undef'"
$ WC "d_gdbmndbm_h_uses_prototypes='undef'"
$ WC "d_gdbm_ndbm_h_uses_prototypes='undef'"
-$ IF vms_ver .GES. "7.3"
-$ THEN
-$ WC "d_getaddrinfo='define'"
-$ ELSE
-$ WC "d_getaddrinfo='undef'"
-$ ENDIF
+$ WC "d_getaddrinfo='define'"
$ WC "d_getcwd='define'"
$ WC "d_getespwnam='undef'"
$ WC "d_getfsstat='undef'"
@@ -6118,12 +6063,7 @@ $ WC "d_getitimer='" + d_getitimer + "'"
$ WC "d_getlogin='define'"
$ WC "d_getmnt='undef'"
$ WC "d_getmntent='undef'"
-$ IF vms_ver .GES. "7.3"
-$ THEN
-$ WC "d_getnameinfo='define'"
-$ ELSE
-$ WC "d_getnameinfo='undef'"
-$ ENDIF
+$ WC "d_getnameinfo='define'"
$ WC "d_getnbyaddr='" + d_getnbyaddr + "'"
$ WC "d_getnbyname='" + d_getnbyname + "'"
$ WC "d_getnent='" + d_getnent + "'"
@@ -6894,7 +6834,7 @@ $! ## The UNIXy POSIXy reentrantey thingys ##
$! See "Appendix B, Version-Dependency Tables" in the C RTL
$! manual for when assorted _r functions became available.
$!
-$ IF use_threads .AND. vms_ver .GES. "7.2"
+$ IF use_threads
$ THEN
$ WC "asctime_r_proto='REENTRANT_PROTO_B_SB'"
$ WC "d_asctime_r='define'"
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 0e3e9b6b9a..73ded25728 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -397,8 +397,7 @@ generate_uudmap$(O) : generate_uudmap.c mg_raw.h
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
# The following files are built in one go by gen_shrfls.pl:
-# perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP
-# perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
+# perlshr_attr.opt, $(DBG)perlshr_bld.opt - AXP and IA64
# The song and dance with gen_shrfls.opt accommodates DCL's line length limit.
$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
@ $(MINIPERL) makedef.pl "PLATFORM=vms" > makedef.lis
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index 039528f41b..570a946d40 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -18,11 +18,6 @@
# against PerlShr.Exe, since cc places global vars in SHR,WRT psects
# by default.
# PerlShr_Bld.Opt - declares universal symbols for PerlShr.Exe
-# Perlshr_Gbl*.Mar, Perlshr_Gbl*.Obj (VAX only) - declares global symbols
-# for global vars (done here because gcc can't globaldef) and creates
-# transfer vectors for routines on a VAX.
-# PerlShr_Gbl.Opt (VAX only) - list of PerlShr_Gbl*.Obj, used for input
-# to the linker when building PerlShr.Exe.
#
# To do:
# - figure out a good way to collect global vars in one psect, given that
@@ -56,11 +51,6 @@ if ($ARGV[0] eq '-f') {
my $cc_cmd = shift @ARGV; # no longer used to run the preprocessor
-# Someday, we'll have $GetSyI built into perl . . .
-my $isvax = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .LE. 1024 .AND. F\$GetSyI(\"HW_MODEL\") .GT. 0\)`;
-chomp $isvax;
-print "\$isvax: \\$isvax\\\n" if $debug;
-
print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
my $docc = ($cc_cmd !~ /^~~/);
print "\$docc = $docc\n" if $debug;
@@ -151,11 +141,6 @@ foreach (split /\s+/, $extnames) {
my $marord = 1;
open(OPTBLD,'>', "${dir}${dbgprefix}perlshr_bld.opt")
or die "$0: Can't write to ${dir}${dbgprefix}perlshr_bld.opt: $!\n";
-if ($isvax) {
- open(MAR, '>', "${dir}perlshr_gbl${marord}.mar")
- or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
- print MAR "\t.title perlshr_gbl$marord\n";
-}
unless ($isgcc) {
print OPTBLD "PSECT_ATTR=LIB\$INITIALIZE,GBL,NOEXE,NOWRT,NOSHR,LONG\n";
@@ -163,36 +148,11 @@ unless ($isgcc) {
print OPTBLD "case_sensitive=yes\n" if $care_about_case;
my $count = 0;
foreach my $var (sort (keys %vars)) {
- if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; }
- else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; }
- # This hack brought to you by the lack of a globaldef in gcc.
- if ($isgcc) {
- if ($count++ > 200) { # max 254 psects/file
- print MAR "\t.end\n";
- close MAR;
- $marord++;
- open(MAR, '>', "${dir}perlshr_gbl${marord}.mar")
- or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
- print MAR "\t.title perlshr_gbl$marord\n";
- $count = 0;
- }
- print MAR "\t.psect ${var},long,pic,ovr,rd,wrt,noexe,noshr\n";
- print MAR "\t${var}:: .blkl 1\n";
- }
+ print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n";
}
-print MAR "\t.psect \$transfer_vec,pic,rd,nowrt,exe,shr\n" if ($isvax);
foreach my $func (sort keys %fcns) {
- if ($isvax) {
- print MAR "\t.transfer $func\n";
- print MAR "\t.mask $func\n";
- print MAR "\tjmp G\^${func}+2\n";
- }
- else { print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n"; }
-}
-if ($isvax) {
- print MAR "\t.end\n";
- close MAR;
+ print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n";
}
open(OPTATTR, '>', "${dir}perlshr_attr.opt")
@@ -214,31 +174,6 @@ close OPTATTR;
my $incstr = 'PERL,GLOBALS';
my (@symfiles, $drvrname);
-if ($isvax) {
- $drvrname = "Compile_shrmars.tmp_".time;
- open (DRVR,'>', $drvrname) or die "$0: Can't write to $drvrname: $!\n";
- print DRVR "\$ Set NoOn\n";
- print DRVR "\$ Delete/NoLog/NoConfirm $drvrname;\n";
- print DRVR "\$ old_proc_vfy = F\$Environment(\"VERIFY_PROCEDURE\")\n";
- print DRVR "\$ old_img_vfy = F\$Environment(\"VERIFY_IMAGE\")\n";
- print DRVR "\$ MCR $^X -e \"\$ENV{'LIBPERL_RDT'} = (stat('$libperl'))[9]\"\n";
- print DRVR "\$ Set Verify\n";
- print DRVR "\$ If F\$Search(\"$libperl\").eqs.\"\" Then Library/Object/Create $libperl\n";
- do {
- push(@symfiles,"perlshr_gbl$marord");
- print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n";
- print DRVR "\$ Library/Object/Replace/Log $libperl PerlShr_Gbl${marord}$objsuffix\n";
- } while (--$marord);
- # We had to have a working miniperl to run this program; it's probably the
- # one we just built. It depended on LibPerl, which will be changed when
- # the PerlShr_Gbl* modules get inserted, so miniperl will be out of date,
- # and so, therefore, will all of its dependents . . .
- # We touch LibPerl here so it'll be back 'in date', and we won't rebuild
- # miniperl etc., and therefore LibPerl, the next time we invoke MM[KS].
- print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n";
- print DRVR "\$ MCR $^X -e \"utime 0, \$ENV{'LIBPERL_RDT'}, '$libperl'\"\n";
- close DRVR;
-}
# Initial hack to permit building of compatible shareable images for a
# given version of Perl.
@@ -264,8 +199,6 @@ if ($ENV{PERLSHR_USE_GSMATCH}) {
my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF; # range 0..255
print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
}
- print OPTBLD 'CLUSTER=$$TRANSFER_VECTOR,,',
- map(",$_$objsuffix",@symfiles), "\n" if $isvax;
}
elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
# Include object modules and RTLs in options file
@@ -277,8 +210,6 @@ while (<RTLOPT>) { print OPTBLD; }
close RTLOPT;
close OPTBLD;
-exec "\$ \@$drvrname" if $isvax;
-
# Symbol shortening Copyright (c) 2012 Craig A. Berry
#
diff --git a/vms/vms.c b/vms/vms.c
index 48486dc91a..7afe1afa9b 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -23,11 +23,6 @@
#include <acedef.h>
#include <acldef.h>
#include <armdef.h>
-#if __CRTL_VER < 70300000
-/* needed for home-rolled utime() */
-#include <atrdef.h>
-#include <fibdef.h>
-#endif
#include <chpdef.h>
#include <clidef.h>
#include <climsgdef.h>
@@ -45,9 +40,7 @@
#include <lib$routines.h>
#include <lnmdef.h>
#include <ossdef.h>
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
#include <ppropdef.h>
-#endif
#include <prvdef.h>
#include <psldef.h>
#include <rms.h>
@@ -63,14 +56,7 @@
#include <efndef.h>
#define NO_EFN EFN$C_ENF
-#if __CRTL_VER < 70301000 && __CRTL_VER >= 70300000
-int decc$feature_get_index(const char *name);
-char* decc$feature_get_name(int index);
-int decc$feature_get_value(int index, int mode);
-int decc$feature_set_value(int index, int mode, int value);
-#else
#include <unixlib.h>
-#endif
#pragma member_alignment save
#pragma nomember_alignment longword
@@ -108,7 +94,7 @@ struct item_list_3 {
#include <libfildef.h>
#endif
-#if !defined(__VAX) && __CRTL_VER >= 80200000
+#if __CRTL_VER >= 80200000
#ifdef lstat
#undef lstat
#endif
@@ -216,13 +202,8 @@ static char * int_tovmspath(const char *path, char *buf, int * utf8_fl);
#define PERL_LNM_MAX_ITER 10
/* New values with 7.3-2*/ /* why does max DCL have 4 byte subtracted from it? */
-#if __CRTL_VER >= 70302000 && !defined(__VAX)
#define MAX_DCL_SYMBOL (8192)
#define MAX_DCL_LINE_LENGTH (4096 - 4)
-#else
-#define MAX_DCL_SYMBOL (1024)
-#define MAX_DCL_LINE_LENGTH (1024 - 4)
-#endif
static char *__mystrtolower(char *str)
{
@@ -2255,11 +2236,7 @@ Perl_sig_to_vmscondition_int(int sig)
SS$_BREAK, /* 5 SIGTRAP */
SS$_OPCCUS, /* 6 SIGABRT */
SS$_COMPAT, /* 7 SIGEMT */
-#ifdef __VAX
- SS$_FLTOVF, /* 8 SIGFPE VAX */
-#else
SS$_HPARITH, /* 8 SIGFPE AXP */
-#endif
SS$_ABORT, /* 9 SIGKILL */
SS$_ACCVIO, /* 10 SIGBUS */
SS$_ACCVIO, /* 11 SIGSEGV */
@@ -2288,9 +2265,7 @@ Perl_sig_to_vmscondition_int(int sig)
sig_code[16] = C$_SIGUSR1;
sig_code[17] = C$_SIGUSR2;
sig_code[20] = C$_SIGCHLD;
-#if __CRTL_VER >= 70300000
sig_code[28] = C$_SIGWINCH;
-#endif
}
if (sig < _SIG_MIN) return 0;
@@ -2723,11 +2698,7 @@ Perl_unix_status_to_vms(int unix_status)
/* default piping mailbox size */
-#ifdef __VAX
-# define PERL_BUFSIZ 512
-#else
-# define PERL_BUFSIZ 8192
-#endif
+#define PERL_BUFSIZ 8192
static void
@@ -4586,7 +4557,6 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
} /* end of my_pclose() */
-#if defined(__CRTL_VER) && __CRTL_VER >= 70200000
/* Roll our own prototype because we want this regardless of whether
* _VMS_WAIT is defined.
*/
@@ -4599,7 +4569,6 @@ extern "C" {
}
#endif
-#endif
/* sort-of waitpid; special handling of pipe clean-up for subprocesses
created with popen(); otherwise partially emulate waitpid() unless
we have a suitable one from the CRTL that came with VMS 7.2 and later.
@@ -4643,8 +4612,6 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags)
/* fall through if this child is not one of our own pipe children */
-#if defined(__CRTL_VER) && __CRTL_VER >= 70200000
-
/* waitpid() became available in the CRTL as of VMS 7.0, but only
* in 7.2 did we get a version that fills in the VMS completion
* status as Perl has always tried to do.
@@ -4662,8 +4629,6 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags)
* of the current process.
*/
-#endif /* defined(__CRTL_VER) && __CRTL_VER >= 70200000 */
-
{
$DESCRIPTOR(intdsc,"0 00:00:01");
unsigned long int ownercode = JPI$_OWNER, ownerpid;
@@ -4752,7 +4717,7 @@ my_gconvert(double val, int ndig, int trail, char *buf)
}
/*}}}*/
-#if defined(__VAX) || !defined(NAML$C_MAXRSS)
+#if !defined(NAML$C_MAXRSS)
static int
rms_free_search_context(struct FAB * fab)
{
@@ -5269,7 +5234,7 @@ Perl_rename(pTHX_ const char *src, const char * dst)
new_file_dsc.dsc$b_class = DSC$K_CLASS_S;
flags = 0;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
flags |= 4; /* LIB$M_FIL_LONG_NAMES (bit 2) */
#endif
@@ -5412,7 +5377,7 @@ int_rmsexpand
* UNIX output, and that requires long names to be used
*/
if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
opts |= PERL_RMSEXPAND_M_LONG;
#else
NOOP;
@@ -5452,7 +5417,7 @@ int_rmsexpand
/* Now we need the expansion buffers */
esa = (char *)PerlMem_malloc(NAM$C_MAXRSS + 1);
if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
esal = (char *)PerlMem_malloc(VMS_MAXRSS);
if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -5461,7 +5426,7 @@ int_rmsexpand
/* If a NAML block is used RMS always writes to the long and short
* addresses unless you suppress the short name.
*/
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
outbufl = (char *)PerlMem_malloc(VMS_MAXRSS);
if (outbufl == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -5541,7 +5506,7 @@ int_expanded:
/* Is a long or a short name expected */
/*------------------------------------*/
spec_buf = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
if (rms_nam_rsll(mynam)) {
spec_buf = outbufl;
@@ -5562,7 +5527,7 @@ int_expanded:
spec_buf = esa; /* Not esal */
speclen = rms_nam_esl(mynam);
}
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
}
#endif
spec_buf[speclen] = '\0';
@@ -5587,7 +5552,7 @@ int_expanded:
defesa = (char *)PerlMem_malloc(VMS_MAXRSS + 1);
if (defesa != NULL) {
struct FAB deffab = cc$rms_fab;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
defesal = (char *)PerlMem_malloc(VMS_MAXRSS + 1);
if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -5667,7 +5632,7 @@ int_expanded:
/* If we just had a directory spec on input, $PARSE "helpfully"
* adds an empty name and type for us */
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
if (rms_nam_namel(mynam) == rms_nam_typel(mynam) &&
rms_nam_verl(mynam) == rms_nam_typel(mynam) + 1 &&
@@ -5700,7 +5665,7 @@ int_expanded:
{
int rsl;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
rsl = rms_nam_rsll(mynam);
} else
@@ -6143,7 +6108,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
esa = (char *)PerlMem_malloc(NAM$C_MAXRSS + 1);
if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
esal = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
esal = (char *)PerlMem_malloc(VMS_MAXRSS);
if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -6204,7 +6169,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
}
/* Make sure we are using the right buffer */
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
if (esal != NULL) {
my_esa = esal;
my_esa_len = rms_nam_esll(dirnam);
@@ -6212,7 +6177,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
#endif
my_esa = esa;
my_esa_len = rms_nam_esl(dirnam);
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
}
#endif
my_esa[my_esa_len] = '\0';
@@ -7320,8 +7285,6 @@ Perl_tounixspec_utf8_ts(pTHX_ const char *spec, char *buf, int * utf8_fl)
return do_tounixspec(spec,buf,1, utf8_fl);
}
-#if __CRTL_VER >= 70200000 && !defined(__VAX)
-
/*
This procedure is used to identify if a path is based in either
the old SYS$POSIX_ROOT: or the new 8.3 RMS based POSIX root, and
@@ -8280,7 +8243,6 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath,
*vmsptr = '\0';
return SS$_NORMAL;
}
-#endif
/* A convenience macro for copying dots in filenames and escaping
* them when they haven't already been escaped, with guards to
@@ -8347,7 +8309,7 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag)
/* Posix specifications are now a native VMS format */
/*--------------------------------------------------*/
-#if __CRTL_VER >= 80200000 && !defined(__VAX)
+#if __CRTL_VER >= 80200000
if (decc_posix_compliant_pathnames) {
if (strncmp(path,"\"^UP^",5) == 0) {
posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
@@ -9550,7 +9512,6 @@ vms_image_init(int *argcp, char ***argvp)
Perl_csighandler_init();
#endif
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
/* This was moved from the pre-image init handler because on threaded */
/* Perl it was always returning 0 for the default value. */
status = simple_trnlnm("SYS$POSIX_ROOT", eqv, LNM$C_NAMLENGTH);
@@ -9580,7 +9541,6 @@ vms_image_init(int *argcp, char ***argvp)
}
}
}
-#endif
_ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
_ckvmssts_noperl(iosb[0]);
@@ -11610,21 +11570,10 @@ Perl_my_localtime(pTHX_ const time_t *timep)
/* my_utime - update modification/access time of a file
*
- * VMS 7.3 and later implementation
* Only the UTC translation is home-grown. The rest is handled by the
* CRTL utime(), which will take into account the relevant feature
* logicals and ODS-5 volume characteristics for true access times.
*
- * pre VMS 7.3 implementation:
- * The calling sequence is identical to POSIX utime(), but under
- * VMS with ODS-2, only the modification time is changed; ODS-2 does
- * not maintain access times. Restrictions differ from the POSIX
- * definition in that the time can be changed as long as the
- * caller has permission to execute the necessary IO$_MODIFY $QIO;
- * no separate checks are made to insure that the caller is the
- * owner of the file or has special privs enabled.
- * Code here is based on Joe Meadows' FILE utility.
- *
*/
/* Adjustment from Unix epoch (01-JAN-1970 00:00:00.00)
@@ -11637,7 +11586,6 @@ static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
int
Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
{
-#if __CRTL_VER >= 70300000
struct utimbuf utc_utimes, *utc_utimesp;
if (utimes != NULL) {
@@ -11658,160 +11606,6 @@ Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
return utime(file, utc_utimesp);
-#else /* __CRTL_VER < 70300000 */
-
- int i;
- int sts;
- long int bintime[2], len = 2, lowbit, unixtime,
- secscale = 10000000; /* seconds --> 100 ns intervals */
- unsigned long int chan, iosb[2], retsts;
- char vmsspec[NAM$C_MAXRSS+1], rsa[NAM$C_MAXRSS], esa[NAM$C_MAXRSS];
- struct FAB myfab = cc$rms_fab;
- struct NAM mynam = cc$rms_nam;
-#if defined (__DECC) && defined (__VAX)
- /* VAX DEC C atrdef.h has unsigned type for pointer member atr$l_addr,
- * at least through VMS V6.1, which causes a type-conversion warning.
- */
-# pragma message save
-# pragma message disable cvtdiftypes
-#endif
- struct atrdef myatr[2] = {{sizeof bintime, ATR$C_REVDATE, bintime}, {0,0,0}};
- struct fibdef myfib;
-#if defined (__DECC) && defined (__VAX)
- /* This should be right after the declaration of myatr, but due
- * to a bug in VAX DEC C, this takes effect a statement early.
- */
-# pragma message restore
-#endif
- /* cast ok for read only parameter */
- struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z, DSC$K_CLASS_S,(char *) &myfib},
- devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0},
- fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0};
-
- if (file == NULL || *file == '\0') {
- SETERRNO(ENOENT, LIB$_INVARG);
- return -1;
- }
-
- /* Convert to VMS format ensuring that it will fit in 255 characters */
- if (int_rmsexpand_tovms(file, vmsspec, 0) == NULL) {
- SETERRNO(ENOENT, LIB$_INVARG);
- return -1;
- }
- if (utimes != NULL) {
- /* Convert Unix time (seconds since 01-JAN-1970 00:00:00.00)
- * to VMS quadword time (100 nsec intervals since 01-JAN-1858 00:00:00.00).
- * Since time_t is unsigned long int, and lib$emul takes a signed long int
- * as input, we force the sign bit to be clear by shifting unixtime right
- * one bit, then multiplying by an extra factor of 2 in lib$emul().
- */
- lowbit = (utimes->modtime & 1) ? secscale : 0;
- unixtime = (long int) utimes->modtime;
-# ifdef VMSISH_TIME
- /* If input was UTC; convert to local for sys svc */
- if (!VMSISH_TIME) unixtime = _toloc(unixtime);
-# endif
- unixtime >>= 1; secscale <<= 1;
- retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
- if (!(retsts & 1)) {
- SETERRNO(EVMSERR, retsts);
- return -1;
- }
- retsts = lib$addx(bintime,utime_baseadjust,bintime,&len);
- if (!(retsts & 1)) {
- SETERRNO(EVMSERR, retsts);
- return -1;
- }
- }
- else {
- /* Just get the current time in VMS format directly */
- retsts = sys$gettim(bintime);
- if (!(retsts & 1)) {
- SETERRNO(EVMSERR, retsts);
- return -1;
- }
- }
-
- myfab.fab$l_fna = vmsspec;
- myfab.fab$b_fns = (unsigned char) strlen(vmsspec);
- myfab.fab$l_nam = &mynam;
- mynam.nam$l_esa = esa;
- mynam.nam$b_ess = (unsigned char) sizeof esa;
- mynam.nam$l_rsa = rsa;
- mynam.nam$b_rss = (unsigned char) sizeof rsa;
- if (decc_efs_case_preserve)
- mynam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
-
- /* Look for the file to be affected, letting RMS parse the file
- * specification for us as well. I have set errno using only
- * values documented in the utime() man page for VMS POSIX.
- */
- retsts = sys$parse(&myfab,0,0);
- if (!(retsts & 1)) {
- set_vaxc_errno(retsts);
- if (retsts == RMS$_PRV) set_errno(EACCES);
- else if (retsts == RMS$_DIR) set_errno(ENOTDIR);
- else set_errno(EVMSERR);
- return -1;
- }
- retsts = sys$search(&myfab,0,0);
- if (!(retsts & 1)) {
- mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
- myfab.fab$b_dns = 0; sts = sys$parse(&myfab,0,0);
- set_vaxc_errno(retsts);
- if (retsts == RMS$_PRV) set_errno(EACCES);
- else if (retsts == RMS$_FNF) set_errno(ENOENT);
- else set_errno(EVMSERR);
- return -1;
- }
-
- devdsc.dsc$w_length = mynam.nam$b_dev;
- /* cast ok for read only parameter */
- devdsc.dsc$a_pointer = (char *) mynam.nam$l_dev;
-
- retsts = sys$assign(&devdsc,&chan,0,0);
- if (!(retsts & 1)) {
- mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
- myfab.fab$b_dns = 0; sts = sys$parse(&myfab,0,0);
- set_vaxc_errno(retsts);
- if (retsts == SS$_IVDEVNAM) set_errno(ENOTDIR);
- else if (retsts == SS$_NOPRIV) set_errno(EACCES);
- else if (retsts == SS$_NOSUCHDEV) set_errno(ENOTDIR);
- else set_errno(EVMSERR);
- return -1;
- }
-
- fnmdsc.dsc$a_pointer = mynam.nam$l_name;
- fnmdsc.dsc$w_length = mynam.nam$b_name + mynam.nam$b_type + mynam.nam$b_ver;
-
- memset((void *) &myfib, 0, sizeof myfib);
-#if defined(__DECC) || defined(__DECCXX)
- for (i=0;i<3;i++) myfib.fib$w_fid[i] = mynam.nam$w_fid[i];
- for (i=0;i<3;i++) myfib.fib$w_did[i] = mynam.nam$w_did[i];
- /* This prevents the revision time of the file being reset to the current
- * time as a result of our IO$_MODIFY $QIO. */
- myfib.fib$l_acctl = FIB$M_NORECORD;
-#else
- for (i=0;i<3;i++) myfib.fib$r_fid_overlay.fib$w_fid[i] = mynam.nam$w_fid[i];
- for (i=0;i<3;i++) myfib.fib$r_did_overlay.fib$w_did[i] = mynam.nam$w_did[i];
- myfib.fib$r_acctl_overlay.fib$l_acctl = FIB$M_NORECORD;
-#endif
- retsts = sys$qiow(0,chan,IO$_MODIFY,iosb,0,0,&fibdsc,&fnmdsc,0,0,myatr,0);
- mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
- myfab.fab$b_dns = 0; sts = sys$parse(&myfab,0,0);
- _ckvmssts(sys$dassgn(chan));
- if (retsts & 1) retsts = iosb[0];
- if (!(retsts & 1)) {
- set_vaxc_errno(retsts);
- if (retsts == SS$_NOPRIV) set_errno(EACCES);
- else set_errno(EVMSERR);
- return -1;
- }
-
- return 0;
-
-#endif /* #if __CRTL_VER >= 70300000 */
-
} /* end of my_utime() */
/*}}}*/
@@ -12202,7 +11996,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
SAVE_ERRNO;
-#if __CRTL_VER >= 80200000 && !defined(__VAX)
+#if __CRTL_VER >= 80200000
/*
* If we are in POSIX filespec mode, accept the filename as is.
*/
@@ -12269,24 +12063,20 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
* format unless * DECC$EFS_CHARSET is in effect, so temporarily
* enable it if it isn't already.
*/
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
if (!decc_efs_charset && (decc_efs_charset_index > 0))
decc$feature_set_value(decc_efs_charset_index, 1, 1);
-#endif
if (lstat_flag == 0)
retval = stat(fspec, &statbufp->crtl_stat);
else
retval = lstat(fspec, &statbufp->crtl_stat);
save_spec = fspec;
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
if (!decc_efs_charset && (decc_efs_charset_index > 0)) {
decc$feature_set_value(decc_efs_charset_index, 1, 0);
efs_hack = 1;
}
-#endif
}
-#if __CRTL_VER >= 80200000 && !defined(__VAX)
+#if __CRTL_VER >= 80200000
} else {
if (lstat_flag == 0)
retval = stat(temp_fspec, &statbufp->crtl_stat);
@@ -12296,11 +12086,9 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
}
#endif
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
/* As you were... */
if (!decc_efs_charset)
decc$feature_set_value(decc$feature_get_index("DECC$EFS_CHARSET"),1,0);
-#endif
if (!retval) {
char *cptr;
@@ -12310,13 +12098,11 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
if (lstat_flag)
rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
/* If we used the efs_hack above, we must also use it here for */
/* perl_cando to work */
if (efs_hack && (decc_efs_charset_index > 0)) {
decc$feature_set_value(decc_efs_charset_index, 1, 1);
}
-#endif
/* If we've got a directory, save a fileified, expanded version of it
* in st_devnam. If not a directory, just an expanded version.
@@ -12338,11 +12124,9 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
0,
0);
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
if (efs_hack && (decc_efs_charset_index > 0)) {
decc$feature_set_value(decc_efs_charset, 1, 0);
}
-#endif
/* Fix me: If this is NULL then stat found a file, and we could */
/* not convert the specification to VMS - Should never happen */
@@ -12455,7 +12239,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
esa = (char *)PerlMem_malloc(VMS_MAXRSS);
if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
esal = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
esal = (char *)PerlMem_malloc(VMS_MAXRSS);
if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -12470,7 +12254,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
rsa = (char *)PerlMem_malloc(VMS_MAXRSS);
if (rsa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
rsal = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
rsal = (char *)PerlMem_malloc(VMS_MAXRSS);
if (rsal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
#endif
@@ -12536,7 +12320,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
if (rsa_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
esal_out = NULL;
rsal_out = NULL;
-#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+#if defined(NAML$C_MAXRSS)
esal_out = (char *)PerlMem_malloc(VMS_MAXRSS);
if (esal_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
rsal_out = (char *)PerlMem_malloc(VMS_MAXRSS);
@@ -13542,7 +13326,7 @@ extern "C" {
/* Hack, use old stat() as fastest way of getting ino_t and device */
int decc$stat(const char *name, void * statbuf);
-#if !defined(__VAX) && __CRTL_VER >= 80200000
+#if __CRTL_VER >= 80200000
int decc$lstat(const char *name, void * statbuf);
#else
#define decc$lstat decc$stat
@@ -13628,20 +13412,16 @@ int vms_fid_to_name(char * outname, int outlen,
* format unless * DECC$EFS_CHARSET is in effect, so temporarily
* enable it if it isn't already.
*/
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
if (!decc_efs_charset && (decc_efs_charset_index > 0))
decc$feature_set_value(decc_efs_charset_index, 1, 1);
-#endif
ret_spec = int_tovmspath(name, temp_fspec, NULL);
if (lstat_flag == 0) {
sts = decc$stat(name, &statbuf);
} else {
sts = decc$lstat(name, &statbuf);
}
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
if (!decc_efs_charset && (decc_efs_charset_index > 0))
decc$feature_set_value(decc_efs_charset_index, 1, 0);
-#endif
}
@@ -13951,17 +13731,11 @@ do_vms_case_tolerant(void)
int
Perl_vms_case_tolerant(void)
{
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
return do_vms_case_tolerant();
-#else
- return vms_process_case_tolerant;
-#endif
}
/* Start of DECC RTL Feature handling */
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
-
static int
set_feature_default(const char *name, int value)
{
@@ -14000,7 +13774,6 @@ set_feature_default(const char *name, int value)
return 0;
}
-#endif
/* C RTL Feature settings */
@@ -14017,7 +13790,7 @@ vmsperl_set_features(void)
int status;
int s;
char val_str[10];
-#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
+#if defined(JPI$_CASE_LOOKUP_PERM)
const unsigned long int jpicode1 = JPI$_CASE_LOOKUP_PERM;
const unsigned long int jpicode2 = JPI$_CASE_LOOKUP_IMAGE;
unsigned long case_perm;
@@ -14089,7 +13862,6 @@ vmsperl_set_features(void)
vms_unlink_all_versions = 0;
}
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
/* Detect running under GNV Bash or other UNIX like shell */
gnv_unix_shell = 0;
status = simple_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
@@ -14109,7 +13881,6 @@ vmsperl_set_features(void)
set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
set_feature_default("DECC$ARGV_PARSE_STYLE", 1); /* Requires extended parse. */
set_feature_default("DECC$EFS_CHARSET", 1);
-#endif
/* hacks to see if known bugs are still present for testing */
@@ -14124,7 +13895,6 @@ vmsperl_set_features(void)
decc_bug_devnull = 0;
}
-#if __CRTL_VER >= 70300000 && !defined(__VAX)
s = decc$feature_get_index("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION");
if (s >= 0) {
decc_disable_to_vms_logname_translation = decc$feature_get_value(s, 1);
@@ -14194,58 +13964,8 @@ vmsperl_set_features(void)
}
#endif
-#else
- status = simple_trnlnm
- ("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_disable_to_vms_logname_translation = 1;
- }
- }
-
-#ifndef __VAX
- status = simple_trnlnm("DECC$EFS_CASE_PRESERVE", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_efs_case_preserve = 1;
- }
- }
-#endif
-
- status = simple_trnlnm("DECC$FILENAME_UNIX_REPORT", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_filename_unix_report = 1;
- }
- }
- status = simple_trnlnm("DECC$FILENAME_UNIX_ONLY", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_filename_unix_only = 1;
- decc_filename_unix_report = 1;
- }
- }
- status = simple_trnlnm("DECC$FILENAME_UNIX_NO_VERSION", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_filename_unix_no_version = 1;
- }
- }
- status = simple_trnlnm("DECC$READDIR_DROPDOTNOTYPE", val_str, sizeof(val_str));
- if (status) {
- val_str[0] = _toupper(val_str[0]);
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
- decc_readdir_dropdotnotype = 1;
- }
- }
-#endif
-#if defined(JPI$_CASE_LOOKUP_PERM) && defined(PPROP$K_CASE_BLIND) && !defined(__VAX)
+#if defined(JPI$_CASE_LOOKUP_PERM) && defined(PPROP$K_CASE_BLIND)
/* Report true case tolerance */
/*----------------------------*/
diff --git a/vms/vmsish.h b/vms/vmsish.h
index fcfd03fa20..52b7c5c2e3 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -64,7 +64,6 @@
/* Set the maximum filespec size here as it is larger for EFS file
* specifications.
*/
-#ifndef __VAX
#ifndef VMS_MAXRSS
#ifdef NAML$C_MAXRSS
#define VMS_MAXRSS (NAML$C_MAXRSS+1)
@@ -73,7 +72,6 @@
#endif /* VMS_LONGNAME_SUPPORT */
#endif /* NAML$C_MAXRSS */
#endif /* VMS_MAXRSS */
-#endif
#ifndef VMS_MAXRSS
#define VMS_MAXRSS (NAM$C_MAXRSS + 1)
@@ -365,11 +363,7 @@ struct interp_intern {
* getgrgid() routines are available to get group entries.
* The getgrent() has a separate definition, HAS_GETGRENT.
*/
-#if __CRTL_VER >= 70302000
#define HAS_GROUP /**/
-#else
-#undef HAS_GROUP /**/
-#endif
/* HAS_PASSWD
* This symbol, if defined, indicates that the getpwnam() and