Re: Problem in ext/Time/HiRest/HiRes.t
[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
f9d00e57 279sleep(...)
89c2f7cb 280 PROTOTYPE: ;$
dcf686c9 281 CODE:
f9d00e57 282 if (items > 0)
283 usleep((int)(SvNV(ST(0)) * 1000000));
284 else
285 PerlProc_pause();
dcf686c9 286
287#endif
288
289#ifdef HAS_UALARM
290
291int
292ualarm(useconds,interval=0)
293 int useconds
294 int interval
295
296int
297alarm(fseconds,finterval=0)
3c72ec00 298 NV fseconds
299 NV finterval
dcf686c9 300 PREINIT:
301 int useconds, uinterval;
302 CODE:
303 useconds = fseconds * 1000000;
304 uinterval = finterval * 1000000;
305 RETVAL = ualarm (useconds, uinterval);
306
c6c619a9 307 OUTPUT:
308 RETVAL
309
dcf686c9 310#endif
311
312#ifdef HAS_GETTIMEOFDAY
313
314void
315gettimeofday()
316 PREINIT:
317 struct timeval Tp;
318 PPCODE:
319 int status;
320 status = gettimeofday (&Tp, NULL);
321 if (GIMME == G_ARRAY) {
322 EXTEND(sp, 2);
323 PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
324 PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
325 } else {
326 EXTEND(sp, 1);
327 PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
328 }
329
3c72ec00 330NV
dcf686c9 331time()
332 PREINIT:
333 struct timeval Tp;
334 CODE:
335 int status;
336 status = gettimeofday (&Tp, NULL);
337 RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
338 OUTPUT:
339 RETVAL
340
341#endif
342
3c72ec00 343#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
344
345#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
346
347void
348setitimer(which, seconds, interval = 0)
349 int which
350 NV seconds
351 NV interval
352 PREINIT:
353 struct itimerval newit;
354 struct itimerval oldit;
355 PPCODE:
356 newit.it_value.tv_sec = seconds;
357 newit.it_value.tv_usec =
358 (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;
359 newit.it_interval.tv_sec = interval;
360 newit.it_interval.tv_usec =
361 (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
362 if (setitimer(which, &newit, &oldit) == 0) {
363 EXTEND(sp, 1);
364 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
365 if (GIMME == G_ARRAY) {
366 EXTEND(sp, 1);
367 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
368 }
369 }
370
371void
372getitimer(which)
373 int which
374 PREINIT:
375 struct itimerval nowit;
376 PPCODE:
377 if (getitimer(which, &nowit) == 0) {
378 EXTEND(sp, 1);
379 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
380 if (GIMME == G_ARRAY) {
381 EXTEND(sp, 1);
382 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
383 }
384 }
385
386#endif
387
dcf686c9 388# $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $
389
390# $Log: HiRes.xs,v $
391# Revision 1.11 1999/03/16 02:27:38 wegscd
392# Add U2time, NVtime. Fix symbols for static link.
393#
394# Revision 1.10 1998/09/30 02:36:25 wegscd
395# Add VMS changes.
396#
397# Revision 1.9 1998/07/07 02:42:06 wegscd
398# Win32 usleep()
399#
400# Revision 1.8 1998/07/02 01:47:26 wegscd
401# Add Win32 code for gettimeofday.
402#
403# Revision 1.7 1997/11/13 02:08:12 wegscd
404# Add missing EXTEND in gettimeofday() scalar code.
405#
406# Revision 1.6 1997/11/11 02:32:35 wegscd
407# Do something useful when calling gettimeofday() in a scalar context.
408# The patch is courtesy of Gisle Aas.
409#
410# Revision 1.5 1997/11/06 03:10:47 wegscd
411# Fake ualarm() if we have setitimer.
412#
413# Revision 1.4 1997/11/05 05:41:23 wegscd
414# Turn prototypes ON (suggested by Gisle Aas)
415#
416# Revision 1.3 1997/10/13 20:56:15 wegscd
417# Add PROTOTYPES: DISABLE
418#
419# Revision 1.2 1997/05/23 01:01:38 wegscd
420# Conditional compilation, depending on what the OS gives us.
421#
422# Revision 1.1 1996/09/03 18:26:35 wegscd
423# Initial revision
424#
425#