Implement CURRENT-JIFFY and JIFFIES-PER-SECOND for R7RS.

Very rough implementation, may return process time instead of real time on
non-POSIX systems.

diff --git a/src/microcode/ntenv.c b/src/microcode/ntenv.c
index 4085eae00624afedbb02e393369475b67646f4bf..f7548dbad832be7e6f182505af28be816e935c6d 100644 (file)
--- a/src/microcode/ntenv.c
+++ b/src/microcode/ntenv.c
@@ -197,6 +197,18 @@ OS_real_time_clock (void)
 {
   return ((((double) (clock ())) * 1000.0) / ((double) CLOCKS_PER_SEC));
 }
+
+clock_t
+OS_current_jiffy (void)
+{
+  return (clock ());
+}
+
+clock_t
+OS_jiffies_per_second (void)
+{
+  return (CLOCKS_PER_SEC);
+}
 \f
 /* The timers are all the same.
    This just provides three distinct timers.

diff --git a/src/microcode/osenv.h b/src/microcode/osenv.h
index 3afce7e631640234bdeb1d3f3b6eb5e60d5f76c0..0c3915873adbcf64377da67d62fbf52f7d3c0ea0 100644 (file)
--- a/src/microcode/osenv.h
+++ b/src/microcode/osenv.h
@@ -73,5 +73,7 @@ extern void OS_real_timer_set (clock_t, clock_t);
 extern void OS_real_timer_clear (void);
 extern const char * OS_working_dir_pathname (void);
 extern void OS_set_working_dir_pathname (const char *);
+extern clock_t OS_current_jiffy (void);
+extern clock_t OS_jiffies_per_second (void);
 
 #endif /* SCM_OSENV_H */

diff --git a/src/microcode/prosenv.c b/src/microcode/prosenv.c
index baf186454e861da7ae00d5587f8c01261eca07b7..4344a8e728ff48d0b2c6f2ef398f93aab005a928 100644 (file)
--- a/src/microcode/prosenv.c
+++ b/src/microcode/prosenv.c
@@ -137,6 +137,19 @@ DEFINE_PRIMITIVE ("REAL-TIME-CLOCK", Prim_real_time_clock, 0, 0,
   PRIMITIVE_RETURN (double_to_integer (OS_real_time_clock ()));
 }
 
+DEFINE_PRIMITIVE ("CURRENT-JIFFY", Prim_current_jiffy, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  clock_t n = (OS_current_jiffy ());
+  PRIMITIVE_RETURN ((n < 0) ? SHARP_F : (intmax_to_integer (n)));
+}
+
+DEFINE_PRIMITIVE ("JIFFIES-PER-SECOND", Prim_jiffies_per_second, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (intmax_to_integer (OS_jiffies_per_second ()));
+}
+
 DEFINE_PRIMITIVE ("PROCESS-TIMER-CLEAR", Prim_process_timer_clear, 0, 0,
   "Turn off the process timer.")
 {

diff --git a/src/microcode/uxenv.c b/src/microcode/uxenv.c
index b91a15840098c711accf1f659a7183306c2aef90..70ccf5eaa57912be70d113e1c86614f3c0b7e445 100644 (file)
--- a/src/microcode/uxenv.c
+++ b/src/microcode/uxenv.c
@@ -498,6 +498,43 @@ OS_real_time_clock (void)
 
 #endif /* HAVE_TIMES */
 #endif /* HAVE_GETTIMEOFDAY */
+
+/* current-jiffy and jiffies-per-second */
+
+#ifdef HAVE_TIMES
+
+clock_t
+OS_current_jiffy (void)
+{
+  struct tms buffer;
+  return (UX_times (&buffer));
+}
+
+clock_t
+OS_jiffies_per_second (void)
+{
+#ifdef __APPLE__
+  return (CLK_TCK);
+#else
+  return (CLOCKS_PER_SEC);
+#endif
+}
+
+#else /* not HAVE_TIMES */
+
+clock_t
+OS_current_jiffy (void)
+{
+  return (clock ());
+}
+
+clock_t
+OS_jiffies_per_second (void)
+{
+  return (CLOCKS_PER_SEC);
+}
+
+#endif /* HAVE_TIMES */
 \f
 #ifdef HAVE_SETITIMER
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index c27f5222994746f01824135f524776dff947ad39..2371907101b9158efec92f592777f9d7d7db6bc1 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4820,8 +4820,10 @@ USA.
   (files "sysclk")
   (parent (runtime))
   (export ()
+         current-jiffy
          internal-time/seconds->ticks
          internal-time/ticks->seconds
+         jiffies-per-second
          measure-interval
          process-time-clock
          real-time-clock

diff --git a/src/runtime/sysclk.scm b/src/runtime/sysclk.scm
index 13d8b0bff6e4c12636e5ffa3fcf6692caf2d1317..4bc7b81a4b747339be52f4b5cc64b4032f1feffd 100644 (file)
--- a/src/runtime/sysclk.scm
+++ b/src/runtime/sysclk.scm
@@ -35,7 +35,11 @@ USA.
 
 (define (reset-system-clock!)
   (set! offset-time (process-time-clock))
-  (set! non-runtime 0))
+  (set! non-runtime 0)
+  unspecific)
+
+(define current-jiffy (ucode-primitive current-jiffy 0))
+(define jiffies-per-second (ucode-primitive jiffies-per-second 0))
 
 (define offset-time)
 (define non-runtime)
@@ -53,7 +57,8 @@ USA.
   (process->system-time (- (process-time-clock) non-runtime)))
 
 (define (increment-non-runtime! ticks)
-  (set! non-runtime (+ non-runtime ticks)))
+  (set! non-runtime (+ non-runtime ticks))
+  unspecific)
 
 (define (measure-interval runtime? thunk)
   (let ((start (process-time-clock)))