summaryrefslogtreecommitdiff
path: root/vms
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 /vms
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.
Diffstat (limited to 'vms')
-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
4 files changed, 27 insertions, 383 deletions
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