Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* Copyright (C) 1995,1996 Free Software Foundation, Inc. |
2 | * | |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
15 | * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
16 | * | |
17 | * As a special exception, the Free Software Foundation gives permission | |
18 | * for additional uses of the text contained in its release of GUILE. | |
19 | * | |
20 | * The exception is that, if you link the GUILE library with other files | |
21 | * to produce an executable, this does not by itself cause the | |
22 | * resulting executable to be covered by the GNU General Public License. | |
23 | * Your use of that executable is in no way restricted on account of | |
24 | * linking the GUILE library code into it. | |
25 | * | |
26 | * This exception does not however invalidate any other reasons why | |
27 | * the executable file might be covered by the GNU General Public License. | |
28 | * | |
29 | * This exception applies only to the code released by the | |
30 | * Free Software Foundation under the name GUILE. If you copy | |
31 | * code from other Free Software Foundation releases into a copy of | |
32 | * GUILE, as the General Public License permits, the exception does | |
33 | * not apply to the code that you add in this way. To avoid misleading | |
34 | * anyone as to the status of such modified files, you must delete | |
35 | * this exception notice from them. | |
36 | * | |
37 | * If you write modifications of your own for GUILE, it is your choice | |
38 | * whether to permit this exception to apply to your modifications. | |
39 | * If you do not wish that, delete this exception notice. | |
40 | */ | |
41 | \f | |
42 | ||
43 | #include <stdio.h> | |
44 | #include "_scm.h" | |
20e6290e JB |
45 | |
46 | #include "stime.h" | |
47 | ||
0f2d19dd JB |
48 | #ifdef HAVE_UNISTD_H |
49 | #include <unistd.h> | |
50 | #endif | |
51 | ||
52 | \f | |
53 | # ifdef HAVE_SYS_TYPES_H | |
54 | # include <sys/types.h> | |
55 | # endif | |
56 | ||
57 | # ifdef TIME_WITH_SYS_TIME | |
58 | # include <sys/time.h> | |
59 | # include <time.h> | |
60 | # else | |
61 | # ifdef HAVE_SYS_TIME_H | |
62 | # include <sys/time.h> | |
63 | # else | |
64 | # ifdef HAVE_TIME_H | |
65 | # include <time.h> | |
66 | # endif | |
67 | # endif | |
68 | # endif | |
69 | ||
70 | # ifdef HAVE_SYS_TIMES_H | |
71 | # include <sys/times.h> | |
72 | # else | |
73 | # ifdef HAVE_SYS_TIMEB_H | |
74 | # include <sys/timeb.h> | |
75 | # endif | |
76 | # endif | |
77 | ||
cda55316 | 78 | /* This should be figured out by autoconf. */ |
0f2d19dd JB |
79 | #ifdef CLK_TCK |
80 | # define CLKTCK CLK_TCK | |
81 | # ifdef CLOCKS_PER_SEC | |
cda55316 | 82 | # if defined (unix) || defined (__unix) |
0f2d19dd JB |
83 | # ifndef ARM_ULIB |
84 | # include <sys/times.h> | |
85 | # endif | |
86 | # define LACK_CLOCK | |
87 | /* This is because clock() might be POSIX rather than ANSI. | |
88 | This occurs on HP-UX machines */ | |
89 | # endif | |
90 | # endif | |
91 | #else | |
92 | # ifdef CLOCKS_PER_SEC | |
93 | # define CLKTCK CLOCKS_PER_SEC | |
94 | # else | |
95 | # define LACK_CLOCK | |
96 | # define CLKTCK 60 | |
97 | # endif | |
98 | #endif | |
99 | ||
100 | ||
101 | # ifdef HAVE_FTIME | |
102 | # include <sys/timeb.h> | |
103 | # endif | |
104 | ||
105 | ||
106 | #ifdef __STDC__ | |
107 | # define timet time_t | |
108 | #else | |
109 | # define timet long | |
110 | #endif | |
111 | ||
112 | #ifdef HAVE_TIMES | |
0f2d19dd JB |
113 | static |
114 | long mytime() | |
0f2d19dd JB |
115 | { |
116 | struct tms time_buffer; | |
117 | times(&time_buffer); | |
118 | return time_buffer.tms_utime + time_buffer.tms_stime; | |
119 | } | |
120 | #else | |
121 | # ifdef LACK_CLOCK | |
122 | # define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK) | |
123 | # else | |
124 | # define mytime clock | |
125 | # endif | |
126 | #endif | |
127 | ||
128 | ||
129 | ||
130 | #ifdef HAVE_FTIME | |
131 | ||
23858ad1 MD |
132 | extern int ftime (struct timeb *); |
133 | ||
0f2d19dd JB |
134 | struct timeb scm_your_base = {0}; |
135 | SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time); | |
0f2d19dd JB |
136 | SCM |
137 | scm_get_internal_real_time() | |
0f2d19dd JB |
138 | { |
139 | struct timeb time_buffer; | |
140 | long tmp; | |
141 | ftime(&time_buffer); | |
142 | time_buffer.time -= scm_your_base.time; | |
143 | tmp = time_buffer.millitm - scm_your_base.millitm; | |
144 | tmp = time_buffer.time*1000L + tmp; | |
145 | tmp *= CLKTCK; | |
146 | tmp /= 1000; | |
147 | return SCM_MAKINUM(tmp); | |
148 | } | |
149 | ||
150 | #else | |
151 | ||
152 | timet scm_your_base = 0; | |
153 | SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time); | |
0f2d19dd JB |
154 | SCM |
155 | scm_get_internal_real_time() | |
0f2d19dd JB |
156 | { |
157 | return SCM_MAKINUM((time((timet*)0) - scm_your_base) * (int)CLKTCK); | |
158 | } | |
159 | #endif | |
160 | ||
161 | ||
162 | ||
163 | static long scm_my_base = 0; | |
164 | ||
165 | SCM_PROC(s_get_internal_run_time, "get-internal-run-time", 0, 0, 0, scm_get_internal_run_time); | |
0f2d19dd JB |
166 | SCM |
167 | scm_get_internal_run_time() | |
0f2d19dd JB |
168 | { |
169 | return SCM_MAKINUM(mytime()-scm_my_base); | |
170 | } | |
171 | ||
172 | SCM_PROC(s_current_time, "current-time", 0, 0, 0, scm_current_time); | |
0f2d19dd JB |
173 | SCM |
174 | scm_current_time() | |
0f2d19dd JB |
175 | { |
176 | timet timv = time((timet*)0); | |
177 | SCM ans; | |
178 | ans = scm_ulong2num(timv); | |
179 | return SCM_BOOL_F==ans ? SCM_MAKINUM(timv) : ans; | |
180 | } | |
181 | ||
0f2d19dd JB |
182 | long |
183 | scm_time_in_msec(x) | |
184 | long x; | |
0f2d19dd JB |
185 | { |
186 | if (CLKTCK==60) return (x*50)/3; | |
187 | else | |
188 | return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK); | |
189 | } | |
190 | ||
0f2d19dd JB |
191 | void |
192 | scm_init_stime() | |
0f2d19dd JB |
193 | { |
194 | scm_sysintern("internal-time-units-per-second", | |
195 | SCM_MAKINUM((long)CLKTCK)); | |
196 | ||
197 | #ifdef HAVE_FTIME | |
198 | if (!scm_your_base.time) ftime(&scm_your_base); | |
199 | #else | |
200 | if (!scm_your_base) time(&scm_your_base); | |
201 | #endif | |
202 | ||
203 | if (!scm_my_base) scm_my_base = mytime(); | |
204 | ||
205 | #include "stime.x" | |
206 | } | |
207 |