More VERSION tuning: to avoid unnecessary Perl upgrades
[p5sagit/p5-mst-13.2.git] / ext / Time / HiRes / HiRes.xs
CommitLineData
dcf686c9 1#ifdef __cplusplus
2extern "C" {
3#endif
4#include "EXTERN.h"
5#include "perl.h"
6#include "XSUB.h"
7#ifdef WIN32
8#include <time.h>
9#else
10#include <sys/time.h>
11#endif
12#ifdef __cplusplus
13}
14#endif
15
3c72ec00 16static IV
17constant(char *name, int arg)
18{
19 errno = 0;
20 switch (*name) {
21 case 'I':
22 if (strEQ(name, "ITIMER_REAL"))
23#ifdef ITIMER_REAL
24 return ITIMER_REAL;
25#else
26 goto not_there;
27#endif
28 if (strEQ(name, "ITIMER_REALPROF"))
29#ifdef ITIMER_REALPROF
30 return ITIMER_REALPROF;
31#else
32 goto not_there;
33#endif
34 if (strEQ(name, "ITIMER_VIRTUAL"))
35#ifdef ITIMER_VIRTUAL
36 return ITIMER_VIRTUAL;
37#else
38 goto not_there;
39#endif
40 if (strEQ(name, "ITIMER_PROF"))
41#ifdef ITIMER_PROF
42 return ITIMER_PROF;
43#else
44 goto not_there;
45#endif
46 break;
47 }
48 errno = EINVAL;
49 return 0;
50
51not_there:
52 errno = ENOENT;
53 return 0;
54}
55
dcf686c9 56#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
57#define HAS_GETTIMEOFDAY
58
59/* shows up in winsock.h?
60struct timeval {
61 long tv_sec;
62 long tv_usec;
63}
64*/
65
66int
67gettimeofday (struct timeval *tp, int nothing)
68{
69 SYSTEMTIME st;
70 time_t tt;
71 struct tm tmtm;
72 /* mktime converts local to UTC */
73 GetLocalTime (&st);
74 tmtm.tm_sec = st.wSecond;
75 tmtm.tm_min = st.wMinute;
76 tmtm.tm_hour = st.wHour;
77 tmtm.tm_mday = st.wDay;
78 tmtm.tm_mon = st.wMonth - 1;
79 tmtm.tm_year = st.wYear - 1900;
80 tmtm.tm_isdst = -1;
81 tt = mktime (&tmtm);
82 tp->tv_sec = tt;
83 tp->tv_usec = st.wMilliseconds * 1000;
84 return 0;
85}
86#endif
87
88#if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
89#define HAS_GETTIMEOFDAY
90
91#include <time.h> /* gettimeofday */
92#include <stdlib.h> /* qdiv */
93#include <starlet.h> /* sys$gettim */
94#include <descrip.h>
3785778e 95#ifdef __VAX
96#include <lib$routines.h> /* lib$ediv() */
97#endif
dcf686c9 98
99/*
100 VMS binary time is expressed in 100 nano-seconds since
101 system base time which is 17-NOV-1858 00:00:00.00
102*/
103
104#define DIV_100NS_TO_SECS 10000000L
105#define DIV_100NS_TO_USECS 10L
106
107/*
108 gettimeofday is supposed to return times since the epoch
109 so need to determine this in terms of VMS base time
110*/
111static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
112
5cdb7193 113#ifdef __VAX
3785778e 114static long base_adjust[2]={0L,0L};
5cdb7193 115#else
dcf686c9 116static __int64 base_adjust=0;
5cdb7193 117#endif
dcf686c9 118
119int
120gettimeofday (struct timeval *tp, void *tpz)
121{
122 long ret;
5cdb7193 123#ifdef __VAX
3785778e 124 long quad[2];
125 long quad1[2];
126 long div_100ns_to_secs;
127 long div_100ns_to_usecs;
128 long quo,rem;
129 long quo1,rem1;
5cdb7193 130#else
dcf686c9 131 __int64 quad;
132 __qdiv_t ans1,ans2;
5cdb7193 133#endif
dcf686c9 134/*
135 In case of error, tv_usec = 0 and tv_sec = VMS condition code.
136 The return from function is also set to -1.
137 This is not exactly as per the manual page.
138*/
139
140 tp->tv_usec = 0;
141
3785778e 142#ifdef __VAX
143 if (base_adjust[0]==0 && base_adjust[1]==0) {
144#else
dcf686c9 145 if (base_adjust==0) { /* Need to determine epoch adjustment */
3785778e 146#endif
dcf686c9 147 ret=sys$bintim(&dscepoch,&base_adjust);
148 if (1 != (ret &&1)) {
149 tp->tv_sec = ret;
150 return -1;
151 }
152 }
153
154 ret=sys$gettim(&quad); /* Get VMS system time */
155 if ((1 && ret) == 1) {
5cdb7193 156#ifdef __VAX
3785778e 157 quad[0] -= base_adjust[0]; /* convert to epoch offset */
158 quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
159 div_100ns_to_secs = DIV_100NS_TO_SECS;
160 div_100ns_to_usecs = DIV_100NS_TO_USECS;
161 lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
162 quad1[0] = rem;
163 quad1[1] = 0L;
164 lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
165 tp->tv_sec = quo; /* Whole seconds */
166 tp->tv_usec = quo1; /* Micro-seconds */
5cdb7193 167#else
3785778e 168 quad -= base_adjust; /* convert to epoch offset */
dcf686c9 169 ans1=qdiv(quad,DIV_100NS_TO_SECS);
170 ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
171 tp->tv_sec = ans1.quot; /* Whole seconds */
172 tp->tv_usec = ans2.quot; /* Micro-seconds */
3785778e 173#endif
dcf686c9 174 } else {
175 tp->tv_sec = ret;
176 return -1;
177 }
178 return 0;
179}
180#endif
181
182#if !defined(HAS_USLEEP) && defined(HAS_SELECT)
183#ifndef SELECT_IS_BROKEN
184#define HAS_USLEEP
185#define usleep hrt_usleep /* could conflict with ncurses for static build */
186
187void
188hrt_usleep(unsigned long usec)
189{
190 struct timeval tv;
191 tv.tv_sec = 0;
192 tv.tv_usec = usec;
193 select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
194 (Select_fd_set_t)NULL, &tv);
195}
196#endif
197#endif
198
199#if !defined(HAS_USLEEP) && defined(WIN32)
200#define HAS_USLEEP
201#define usleep hrt_usleep /* could conflict with ncurses for static build */
202
203void
204hrt_usleep(unsigned long usec)
205{
206 long msec;
207 msec = usec / 1000;
208 Sleep (msec);
209}
210#endif
211
212
213#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
214#define HAS_UALARM
215#define ualarm hrt_ualarm /* could conflict with ncurses for static build */
216
217int
218hrt_ualarm(int usec, int interval)
219{
220 struct itimerval itv;
221 itv.it_value.tv_sec = usec / 1000000;
222 itv.it_value.tv_usec = usec % 1000000;
223 itv.it_interval.tv_sec = interval / 1000000;
224 itv.it_interval.tv_usec = interval % 1000000;
225 return setitimer(ITIMER_REAL, &itv, 0);
226}
227#endif
228
229#ifdef HAS_GETTIMEOFDAY
230
a2e20b18 231static int
dcf686c9 232myU2time(UV *ret)
233{
234 struct timeval Tp;
235 int status;
236 status = gettimeofday (&Tp, NULL);
237 ret[0] = Tp.tv_sec;
238 ret[1] = Tp.tv_usec;
a2e20b18 239 return status;
dcf686c9 240}
241
3c72ec00 242static NV
dcf686c9 243myNVtime()
244{
245 struct timeval Tp;
246 int status;
247 status = gettimeofday (&Tp, NULL);
a2e20b18 248 return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
dcf686c9 249}
250
251#endif
252
253MODULE = Time::HiRes PACKAGE = Time::HiRes
254
255PROTOTYPES: ENABLE
256
257BOOT:
dcf686c9 258#ifdef HAS_GETTIMEOFDAY
a2e20b18 259{
260 UV auv[2];
261 hv_store(PL_modglobal, "Time::NVtime", 12, newSViv((IV) myNVtime()), 0);
262 if (myU2time(auv) == 0)
263 hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
264}
dcf686c9 265#endif
dcf686c9 266
3c72ec00 267IV
268constant(name, arg)
269 char * name
270 int arg
271
dcf686c9 272#ifdef HAS_USLEEP
273
274void
275usleep(useconds)
276 int useconds
277
278void
279sleep(fseconds)
3c72ec00 280 NV fseconds
dcf686c9 281 CODE:
282 int useconds = fseconds * 1000000;
283 usleep (useconds);
284
285#endif
286
287#ifdef HAS_UALARM
288
289int
290ualarm(useconds,interval=0)
291 int useconds
292 int interval
293
294int
295alarm(fseconds,finterval=0)
3c72ec00 296 NV fseconds
297 NV finterval
dcf686c9 298 PREINIT:
299 int useconds, uinterval;
300 CODE:
301 useconds = fseconds * 1000000;
302 uinterval = finterval * 1000000;
303 RETVAL = ualarm (useconds, uinterval);
304
c6c619a9 305 OUTPUT:
306 RETVAL
307
dcf686c9 308#endif
309
310#ifdef HAS_GETTIMEOFDAY
311
312void
313gettimeofday()
314 PREINIT:
315 struct timeval Tp;
316 PPCODE:
317 int status;
318 status = gettimeofday (&Tp, NULL);
319 if (GIMME == G_ARRAY) {
320 EXTEND(sp, 2);
321 PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
322 PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
323 } else {
324 EXTEND(sp, 1);
325 PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
326 }
327
3c72ec00 328NV
dcf686c9 329time()
330 PREINIT:
331 struct timeval Tp;
332 CODE:
333 int status;
334 status = gettimeofday (&Tp, NULL);
335 RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
336 OUTPUT:
337 RETVAL
338
339#endif
340
3c72ec00 341#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
342
343#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
344
345void
346setitimer(which, seconds, interval = 0)
347 int which
348 NV seconds
349 NV interval
350 PREINIT:
351 struct itimerval newit;
352 struct itimerval oldit;
353 PPCODE:
354 newit.it_value.tv_sec = seconds;
355 newit.it_value.tv_usec =
356 (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;
357 newit.it_interval.tv_sec = interval;
358 newit.it_interval.tv_usec =
359 (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
360 if (setitimer(which, &newit, &oldit) == 0) {
361 EXTEND(sp, 1);
362 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
363 if (GIMME == G_ARRAY) {
364 EXTEND(sp, 1);
365 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
366 }
367 }
368
369void
370getitimer(which)
371 int which
372 PREINIT:
373 struct itimerval nowit;
374 PPCODE:
375 if (getitimer(which, &nowit) == 0) {
376 EXTEND(sp, 1);
377 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
378 if (GIMME == G_ARRAY) {
379 EXTEND(sp, 1);
380 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
381 }
382 }
383
384#endif
385
dcf686c9 386# $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $
387
388# $Log: HiRes.xs,v $
389# Revision 1.11 1999/03/16 02:27:38 wegscd
390# Add U2time, NVtime. Fix symbols for static link.
391#
392# Revision 1.10 1998/09/30 02:36:25 wegscd
393# Add VMS changes.
394#
395# Revision 1.9 1998/07/07 02:42:06 wegscd
396# Win32 usleep()
397#
398# Revision 1.8 1998/07/02 01:47:26 wegscd
399# Add Win32 code for gettimeofday.
400#
401# Revision 1.7 1997/11/13 02:08:12 wegscd
402# Add missing EXTEND in gettimeofday() scalar code.
403#
404# Revision 1.6 1997/11/11 02:32:35 wegscd
405# Do something useful when calling gettimeofday() in a scalar context.
406# The patch is courtesy of Gisle Aas.
407#
408# Revision 1.5 1997/11/06 03:10:47 wegscd
409# Fake ualarm() if we have setitimer.
410#
411# Revision 1.4 1997/11/05 05:41:23 wegscd
412# Turn prototypes ON (suggested by Gisle Aas)
413#
414# Revision 1.3 1997/10/13 20:56:15 wegscd
415# Add PROTOTYPES: DISABLE
416#
417# Revision 1.2 1997/05/23 01:01:38 wegscd
418# Conditional compilation, depending on what the OS gives us.
419#
420# Revision 1.1 1996/09/03 18:26:35 wegscd
421# Initial revision
422#
423#