[PATCH: perl@11006] s/div/lib\$ediv/ in Time::HiRes for VAX

Yesterday I submitted a patch to allow Time::HiRes to compile on the VAX:

 http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-06/msg01709.html

Thanks to Craig Berry's brilliant investigative work with the LIB$ RTL
Library Manual I've managed to get the VAX to pass all but one of the
hires.t tests using the lib$ediv() routine suggestion from Craig, and even
the failure is much closer and less non-sensical than the result using
just div() (and is fairly understandable).  Here is the new patch taken
w.r.t. the _patched_ version of perl@11006, that is assuming that the
previously mentioned patch is in the archive:

--- perl_11006_patched/ext/Time/HiRes/HiRes.xs.orig	Fri Jun 29 13:45:52 2001
+++ perl_11006_patched/ext/Time/HiRes/HiRes.xs	Fri Jun 29 13:45:34 2001
@@ -92,6 +92,9 @@
 #include <stdlib.h> /* qdiv */
 #include <starlet.h> /* sys$gettim */
 #include <descrip.h>
+#ifdef __VAX
+#include <lib$routines.h> /* lib$ediv() */
+#endif
 
 /*
         VMS binary time is expressed in 100 nano-seconds since
@@ -108,7 +111,7 @@
 static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
 
 #ifdef __VAX
-static long base_adjust=0L;
+static long base_adjust[2]={0L,0L};
 #else
 static __int64 base_adjust=0;
 #endif
@@ -118,8 +121,12 @@
 {
  long ret;
 #ifdef __VAX
- long quad;
- div_t ans1,ans2;
+ long quad[2];
+ long quad1[2];
+ long div_100ns_to_secs;
+ long div_100ns_to_usecs;
+ long quo,rem;
+ long quo1,rem1;
 #else
  __int64 quad;
  __qdiv_t ans1,ans2;
@@ -132,7 +139,11 @@
 
  tp->tv_usec = 0;
 
+#ifdef __VAX
+ if (base_adjust[0]==0 && base_adjust[1]==0) {
+#else
  if (base_adjust==0) { /* Need to determine epoch adjustment */
+#endif
         ret=sys$bintim(&dscepoch,&base_adjust);
         if (1 != (ret &&1)) {
                 tp->tv_sec = ret;
@@ -142,16 +153,24 @@
 
  ret=sys$gettim(&quad); /* Get VMS system time */
  if ((1 && ret) == 1) {
-        quad -= base_adjust; /* convert to epoch offset */
 #ifdef __VAX
-        ans1=div(quad,DIV_100NS_TO_SECS);
-        ans2=div(ans1.rem,DIV_100NS_TO_USECS);
+        quad[0] -= base_adjust[0]; /* convert to epoch offset */
+        quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
+        div_100ns_to_secs = DIV_100NS_TO_SECS;
+        div_100ns_to_usecs = DIV_100NS_TO_USECS;
+        lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
+        quad1[0] = rem;
+        quad1[1] = 0L;
+        lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
+        tp->tv_sec = quo; /* Whole seconds */
+        tp->tv_usec = quo1; /* Micro-seconds */
 #else
+        quad -= base_adjust; /* convert to epoch offset */
         ans1=qdiv(quad,DIV_100NS_TO_SECS);
         ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
-#endif
         tp->tv_sec = ans1.quot; /* Whole seconds */
         tp->tv_usec = ans2.quot; /* Micro-seconds */
+#endif
  } else {
         tp->tv_sec = ret;
         return -1;
End of Patch.

Here is a current run of 11006 with the above patch applied:

$ perl "-Ilib" ext/time/hires/hires.t;1
1..19
ok 1
ok 2
ok 3
ok 4
ok 5
ok 6
ok 7
ok 8
ok 9
ok 10
ok 11
ok 12 (skipped)
ok 13 (skipped)
not ok 14
# time 993847825 differs from Time::HiRes::time 993822625.15
ok 15 # skipped
ok 16 # skipped
ok 17 # skipped
ok 18 # Skip: no virtual interval timers
ok 19 # Skip: no virtual interval timers

The difference between those (integer) time() return values:

 $ perl -e "print +993847825 - 993822625"
 25200

Is just my GMT timezone offset (PDT):

 $ show logical sys$timezone_differential
   "SYS$TIMEZONE_DIFFERENTIAL" = "-25200" (LNM$SYSTEM_TABLE)

At this time I am not sure why the VAX has trouble with the TZ offset but
apparently the Alpha calling sys$bintim() does not (???).  Unfortunately I
am unlikely to be able to fix this little snag before finishing packing.
Aloha.

Peter Prymmer

• [PATCH: perl@11006] s/div/lib\$ediv/ in Time::HiRes for VAX by Peter Prymmer
• Re: [PATCH: perl@11006] s/div/lib\$ediv/ in Time::HiRes for VAX by Jarkko Hietaniemi