diff options
author | Karl Williamson <khw@cpan.org> | 2020-03-08 11:53:55 -0600 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2020-07-30 16:37:34 -0600 |
commit | 4d208ad05a4ee7139f59af0252ade468a97d3a88 (patch) | |
tree | 3bbd5e3202e5ddfd0785e0c081bde12b6cc8758d /dist/Time-HiRes | |
parent | 81169c06a76f62ff987ed990ac910c2ae08b3f91 (diff) | |
download | perl-4d208ad05a4ee7139f59af0252ade468a97d3a88.tar.gz |
Time-HiRes: Remove obsolete vms code
This code became irrelevant in 1996.
See https://github.com/Perl/perl5/pull/17658#pullrequestreview-377796612
Diffstat (limited to 'dist/Time-HiRes')
-rw-r--r-- | dist/Time-HiRes/HiRes.xs | 195 |
1 files changed, 8 insertions, 187 deletions
diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index 0eeca95521..fbabd94ca3 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -18,6 +18,7 @@ extern "C" { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include "reentr.h" #ifdef USE_PPPORT_H # include "ppport.h" #endif @@ -85,6 +86,13 @@ extern "C" { # undef ITIMER_REALPROF #endif +#ifndef ENV_LOCALE_LOCK +# define ENV_LOCALE_LOCK +#endif +#ifndef ENV_LOCALE_UNLOCK +# define ENV_LOCALE_UNLOCK +#endif + #ifndef TIME_HIRES_CLOCKID_T typedef int clockid_t; #endif @@ -317,193 +325,6 @@ _clock_getres(clockid_t clock_id, struct timespec *tp) #endif /* #if defined(WIN32) || defined(CYGWIN_WITH_W32API) */ -#if !defined(HAS_GETTIMEOFDAY) && defined(VMS) -# define HAS_GETTIMEOFDAY - -# include <lnmdef.h> -# include <time.h> /* gettimeofday */ -# 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 - system base time which is 17-NOV-1858 00:00:00.00 -*/ - -# define DIV_100NS_TO_SECS 10000000L -# define DIV_100NS_TO_USECS 10L - -/* - gettimeofday is supposed to return times since the epoch - so need to determine this in terms of VMS base time -*/ -static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00"); - -# ifdef __VAX -static long base_adjust[2]={0L,0L}; -# else -static __int64 base_adjust=0; -# endif - -/* - - If we don't have gettimeofday, then likely we are on a VMS machine that - operates on local time rather than UTC...so we have to zone-adjust. - This code gleefully swiped from VMS.C - -*/ -/* method used to handle UTC conversions: - * 1 == CRTL gmtime(); 2 == SYS$TIMEZONE_DIFFERENTIAL; 3 == no correction - */ -static int gmtime_emulation_type; -/* number of secs to add to UTC POSIX-style time to get local time */ -static long int utc_offset_secs; -static struct dsc$descriptor_s fildevdsc = - { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" }; -static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL }; - -static time_t toutc_dst(time_t loc) { - struct tm *rsltmp; - - if ((rsltmp = localtime(&loc)) == NULL) return -1; - loc -= utc_offset_secs; - if (rsltmp->tm_isdst) loc -= 3600; - return loc; -} - -static time_t toloc_dst(time_t utc) { - struct tm *rsltmp; - - utc += utc_offset_secs; - if ((rsltmp = localtime(&utc)) == NULL) return -1; - if (rsltmp->tm_isdst) utc += 3600; - return utc; -} - -# define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ - ((gmtime_emulation_type || timezone_setup()), \ - (gmtime_emulation_type == 1 ? toutc_dst(secs) : \ - ((secs) - utc_offset_secs)))) - -# define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ - ((gmtime_emulation_type || timezone_setup()), \ - (gmtime_emulation_type == 1 ? toloc_dst(secs) : \ - ((secs) + utc_offset_secs)))) - -static int -timezone_setup(void) -{ - struct tm *tm_p; - - if (gmtime_emulation_type == 0) { - int dstnow; - time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */ - /* results of calls to gmtime() and localtime() */ - /* for same &base */ - - gmtime_emulation_type++; - if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */ - char off[LNM$C_NAMLENGTH+1];; - - gmtime_emulation_type++; - if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) { - gmtime_emulation_type++; - utc_offset_secs = 0; - Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC"); - } - else { utc_offset_secs = atol(off); } - } - else { /* We've got a working gmtime() */ - struct tm gmt, local; - - gmt = *tm_p; - tm_p = localtime(&base); - local = *tm_p; - utc_offset_secs = (local.tm_mday - gmt.tm_mday) * 86400; - utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600; - utc_offset_secs += (local.tm_min - gmt.tm_min) * 60; - utc_offset_secs += (local.tm_sec - gmt.tm_sec); - } - } - return 1; -} - - -int -gettimeofday (struct timeval *tp, void *tpz) -{ - long ret; -# ifdef __VAX - 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; -# endif - /* - In case of error, tv_usec = 0 and tv_sec = VMS condition code. - The return from function is also set to -1. - This is not exactly as per the manual page. - */ - - 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; - return -1; - } - } - - ret=sys$gettim(&quad); /* Get VMS system time */ - if ((1 && ret) == 1) { -# ifdef __VAX - 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); - tp->tv_sec = ans1.quot; /* Whole seconds */ - tp->tv_usec = ans2.quot; /* Micro-seconds */ -# endif - } else { - tp->tv_sec = ret; - return -1; - } -# ifdef VMSISH_TIME -# ifdef RTL_USES_UTC - if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec); -# else - if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec); -# endif -# endif - return 0; -} -#endif /* #if !defined(HAS_GETTIMEOFDAY) && defined(VMS) */ - - /* Do not use H A S _ N A N O S L E E P * so that Perl Configure doesn't scan for it (and pull in -lrt and * the like which are not usually good ideas for the default Perl). |