line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#ifdef __cplusplus |
2
|
|
|
|
|
|
|
extern "C" { |
3
|
|
|
|
|
|
|
#endif |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#define MIN_PERL_DEFINE 1 |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
#include "EXTERN.h" |
8
|
|
|
|
|
|
|
#include "perl.h" |
9
|
|
|
|
|
|
|
#include "XSUB.h" |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
#ifdef __cplusplus |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
#endif |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
/* Is time() portable everywhere? Hope so! XXX */ |
16
|
|
|
|
|
|
|
|
17
|
12
|
|
|
|
|
|
static NV fallback_NVtime() |
18
|
12
|
|
|
|
|
|
{ return time(0); } |
19
|
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
|
static void fallback_U2time(U32 *ret) |
21
|
|
|
|
|
|
|
{ |
22
|
0
|
|
|
|
|
|
ret[0]=time(0); |
23
|
0
|
|
|
|
|
|
ret[1]=0; |
24
|
0
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
/*-----------------*/ |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
static int Installed=0; |
29
|
|
|
|
|
|
|
static NV (*realNVtime)(); |
30
|
|
|
|
|
|
|
static void (*realU2time)(U32 *); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
static double Lost; /** time relative to now */ |
33
|
|
|
|
|
|
|
static double Zero; /** apply Scale from when? */ |
34
|
|
|
|
|
|
|
static double Scale; /** speed of time (.5 == half speed) */ |
35
|
|
|
|
|
|
|
|
36
|
2
|
|
|
|
|
|
static void reset_warp() |
37
|
|
|
|
|
|
|
{ |
38
|
2
|
|
|
|
|
|
Lost=0; |
39
|
2
|
|
|
|
|
|
Zero=(*realNVtime)(); |
40
|
2
|
|
|
|
|
|
Scale=1; |
41
|
2
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
/*-----------------*/ |
44
|
|
|
|
|
|
|
|
45
|
10
|
|
|
|
|
|
static NV warped_NVtime() |
46
|
|
|
|
|
|
|
{ |
47
|
10
|
|
|
|
|
|
double now = (*realNVtime)() - Lost; |
48
|
10
|
|
|
|
|
|
double delta = now - Zero; |
49
|
10
|
|
|
|
|
|
delta *= Scale; |
50
|
10
|
|
|
|
|
|
return Zero + delta; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
|
static void warped_U2time(U32 *ret) |
54
|
|
|
|
|
|
|
{ |
55
|
|
|
|
|
|
|
/* performance doesn't matter enough for a native |
56
|
|
|
|
|
|
|
non-float implementation */ |
57
|
0
|
|
|
|
|
|
double now = warped_NVtime(); |
58
|
0
|
|
|
|
|
|
U32 unow = now; |
59
|
0
|
|
|
|
|
|
ret[0] = unow; |
60
|
0
|
|
|
|
|
|
ret[1] = (now - unow) * 1000000; |
61
|
0
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
MODULE = Time::Warp PACKAGE = Time::Warp |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
PROTOTYPES: ENABLE |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
void |
68
|
|
|
|
|
|
|
install_time_api() |
69
|
|
|
|
|
|
|
CODE: |
70
|
|
|
|
|
|
|
{ |
71
|
|
|
|
|
|
|
SV **svp; |
72
|
1
|
50
|
|
|
|
|
if (Installed) { |
73
|
0
|
|
|
|
|
|
warn("Time::Warp::install_time_api() called more than once"); |
74
|
0
|
|
|
|
|
|
return; |
75
|
|
|
|
|
|
|
} |
76
|
1
|
|
|
|
|
|
Installed=1; |
77
|
1
|
|
|
|
|
|
svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); |
78
|
1
|
50
|
|
|
|
|
if (!svp) { |
79
|
1
|
|
|
|
|
|
warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available"); |
80
|
1
|
|
|
|
|
|
hv_store(PL_modglobal, "Time::NVtime", 12, |
81
|
|
|
|
|
|
|
newSViv((IV) fallback_NVtime), 0); |
82
|
1
|
|
|
|
|
|
hv_store(PL_modglobal, "Time::U2time", 12, |
83
|
|
|
|
|
|
|
newSViv((IV) fallback_U2time), 0); |
84
|
|
|
|
|
|
|
} |
85
|
1
|
|
|
|
|
|
svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); |
86
|
1
|
50
|
|
|
|
|
if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); |
87
|
1
|
50
|
|
|
|
|
realNVtime = (NV(*)()) SvIV(*svp); |
88
|
1
|
|
|
|
|
|
svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0); |
89
|
1
|
50
|
|
|
|
|
if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer"); |
90
|
1
|
50
|
|
|
|
|
realU2time = (void(*)(U32*)) SvIV(*svp); |
91
|
1
|
|
|
|
|
|
hv_store(PL_modglobal, "Time::NVtime", 12, |
92
|
|
|
|
|
|
|
newSViv((IV) warped_NVtime), 0); |
93
|
1
|
|
|
|
|
|
hv_store(PL_modglobal, "Time::U2time", 12, |
94
|
|
|
|
|
|
|
newSViv((IV) warped_U2time), 0); |
95
|
|
|
|
|
|
|
|
96
|
1
|
|
|
|
|
|
reset_warp(); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
void |
100
|
|
|
|
|
|
|
reset() |
101
|
|
|
|
|
|
|
CODE: |
102
|
1
|
|
|
|
|
|
reset_warp(); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
void |
105
|
|
|
|
|
|
|
to(when) |
106
|
|
|
|
|
|
|
double when |
107
|
|
|
|
|
|
|
CODE: |
108
|
|
|
|
|
|
|
{ |
109
|
2
|
|
|
|
|
|
Lost += (warped_NVtime() - when) / Scale; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
void |
113
|
|
|
|
|
|
|
scale(...) |
114
|
|
|
|
|
|
|
PPCODE: |
115
|
|
|
|
|
|
|
{ |
116
|
5
|
100
|
|
|
|
|
if (items == 0) { |
117
|
3
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newSVnv(Scale))); |
118
|
|
|
|
|
|
|
} else { |
119
|
2
|
|
|
|
|
|
Zero = warped_NVtime(); |
120
|
2
|
|
|
|
|
|
Lost = 0; |
121
|
2
|
50
|
|
|
|
|
Scale = SvNV(ST(0)); |
122
|
2
|
50
|
|
|
|
|
if (Scale < 0) { |
123
|
0
|
|
|
|
|
|
warn("Sorry, Time::Warp cannot go backwards"); |
124
|
0
|
|
|
|
|
|
Scale = 1; |
125
|
|
|
|
|
|
|
} |
126
|
2
|
50
|
|
|
|
|
else if (Scale < .001) { |
127
|
0
|
|
|
|
|
|
warn("Sorry, Time::Warp cannot stop time"); |
128
|
0
|
|
|
|
|
|
Scale = .001; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
void |
134
|
|
|
|
|
|
|
time() |
135
|
|
|
|
|
|
|
PPCODE: |
136
|
|
|
|
|
|
|
{ |
137
|
6
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newSVnv(warped_NVtime()))); |
138
|
|
|
|
|
|
|
} |