diff options
| -rw-r--r-- | configure.com | 374 | ||||
| -rw-r--r-- | vms/descrip_mms.template | 3 | ||||
| -rw-r--r-- | vms/gen_shrfls.pl | 73 | ||||
| -rw-r--r-- | vms/vms.c | 328 | ||||
| -rw-r--r-- | vms/vmsish.h | 6 |
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 # @@ -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 |