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