Front page | perl.vmsperl |
Postings from June 2002
[PATCH perl@17206] assorted help for older VMS systems
Thread Next
From:
Craig A. Berry
Date:
June 13, 2002 17:57
Subject:
[PATCH perl@17206] assorted help for older VMS systems
Message ID:
a05111b05b92ec91d165b@[172.16.52.1]
There are various fix-ups here that help with VAX builds, non-IEEE
float format Alpha builds, older versions of DEC C, and downright
ancient versions of VMS. Thanks to Brian Tillman and Henry Frystak
for testing and reporting problems. Everything here is VMS-specific.
There are some remaining test failures, particularly related to VAX
D_FLOAT doubles, but this should at least get us a clean build on any
VMS version released in the last 10-12 years.
The pp_pack.c bit essentially steals Paul's VOS code for packing
floats and doubles but we don't have the same constants he does
(_float_constants, _double_constants) so I couldn't simply share the
same code.
--- configure.com;-0 Tue Jun 11 23:02:33 2002
+++ configure.com Thu Jun 13 14:58:01 2002
@@ -4730,7 +4730,12 @@
$ i_locale="define"
$ i_langinfo="define"
$ d_locconv="define"
-$ d_nl_langinfo="define"
+$ IF vms_ver .GES. "6.2"
+$ THEN
+$ d_nl_langinfo="define"
+$ ELSE
+$ d_nl_langinfo="undef"
+$ ENDIF
$ d_setlocale="define"
$ vms_cc_type="decc"
$ ELSE
--- pp_pack.c;-0 Sat Jun 1 12:03:44 2002
+++ pp_pack.c Thu Jun 13 13:08:27 2002
@@ -2101,7 +2101,18 @@
afloat = _float_constants[0]; /* single prec. inf. */
else afloat = (float)SvNV(fromstr);
#else
+# if defined(VMS) && !defined(__IEEE_FP)
+/* IEEE fp overflow shenanigans are unavailable on VAX and optional
+ * on Alpha; fake it if we don't have them.
+ */
+ if (SvNV(fromstr) > FLT_MAX)
+ afloat = FLT_MAX;
+ else if (SvNV(fromstr) < -FLT_MAX)
+ afloat = -FLT_MAX;
+ else afloat = (float)SvNV(fromstr);
+# else
afloat = (float)SvNV(fromstr);
+# endif
#endif
sv_catpvn(cat, (char *)&afloat, sizeof (float));
}
@@ -2122,7 +2133,18 @@
adouble = _double_constants[0]; /* double prec. inf. */
else adouble = (double)SvNV(fromstr);
#else
+# if defined(VMS) && !defined(__IEEE_FP)
+/* IEEE fp overflow shenanigans are unavailable on VAX and optional
+ * on Alpha; fake it if we don't have them.
+ */
+ if (SvNV(fromstr) > DBL_MAX)
+ adouble = DBL_MAX;
+ else if (SvNV(fromstr) < -DBL_MAX)
+ adouble = -DBL_MAX;
+ else adouble = (double)SvNV(fromstr);
+# else
adouble = (double)SvNV(fromstr);
+# endif
#endif
sv_catpvn(cat, (char *)&adouble, sizeof (double));
}
--- pod/perldelta.pod;-0 Tue Jun 11 08:57:10 2002
+++ pod/perldelta.pod Thu Jun 13 15:20:19 2002
@@ -2580,7 +2580,8 @@
File access tests now use current process privileges rather than the
user's default privileges, which could sometimes result in a mismatch
-between reported access and actual access.
+between reported access and actual access. This improvement is only
+available on VMS v6.0 and later.
There is a new C<kill> implementation based on C<sys$sigprc> that allows
older VMS systems (pre-7.0) to use C<kill> to send signals rather than
--- vms/vms.c;-0 Sat Jun 1 12:03:53 2002
+++ vms/vms.c Thu Jun 13 13:09:31 2002
@@ -3341,6 +3341,7 @@
unsigned long int retlen;
char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1];
unsigned short int trnlnm_iter_count;
+ STRLEN trnlen;
if (!dir || !*dir) {
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
@@ -3354,7 +3355,7 @@
&& my_trnlnm(trndir,trndir,0)) {
trnlnm_iter_count++;
if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
- STRLEN trnlen = strlen(trndir);
+ trnlen = strlen(trndir);
/* Trap simple rooted lnms, and return lnm:[000000] */
if (!strcmp(trndir+trnlen-2,".]")) {
@@ -6636,13 +6637,17 @@
/* Before we call $check_access, create a user profile with the current
* process privs since otherwise it just uses the default privs from the
- * UAF and might give false positives or negatives.
+ * UAF and might give false positives or negatives. This only works on
+ * VMS versions v6.0 and later since that's when sys$create_user_profile
+ * became available.
*/
/* get current process privs and username */
_ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
_ckvmssts(iosb[0]);
+#if defined(__VMS_VER) && __VMS_VER >= 60000000
+
/* find out the space required for the profile */
_ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
&usrprodsc.dsc$w_length,0));
@@ -6656,6 +6661,13 @@
retsts = sys$check_access(&objtyp,&namdsc,0,armlst,0,0,0,&usrprodsc);
Safefree(usrprodsc.dsc$a_pointer);
if (retsts == SS$_NOCALLPRIV) retsts = SS$_NOPRIV; /* not really 3rd party */
+
+#else
+
+ retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
+
+#endif
+
if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT ||
retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN ||
retsts == RMS$_DIR || retsts == RMS$_DEV || retsts == RMS$_DNF) {
[end of patch]
--
________________________________________
Craig A. Berry
mailto:craigberry@mac.com
"... getting out of a sonnet is much more
difficult than getting in."
Brad Leithauser
Thread Next
-
[PATCH perl@17206] assorted help for older VMS systems
by Craig A. Berry