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