~ chicken-core (chicken-5) 27ff54345614fcf3945eab63a8aa14c5db684de0

commit 27ff54345614fcf3945eab63a8aa14c5db684de0
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Aug 5 08:57:01 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Aug 5 08:57:01 2010 -0400

    cpu-time can return flonums

diff --git a/chicken.h b/chicken.h
index 5179bfa1..a969d075 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1698,7 +1698,6 @@ C_fctexport void C_ccall C_register_finalizer(C_word c, C_word closure, C_word k
 C_fctexport void C_ccall C_set_dlopen_flags(C_word c, C_word closure, C_word k, C_word now, C_word global) C_noret;
 C_fctexport void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry, C_word reloadable) C_noret;
 C_fctexport void C_ccall C_become(C_word c, C_word closure, C_word k, C_word table) C_noret;
-C_fctexport void C_ccall C_cpu_time(C_word c, C_word closure, C_word k) C_noret;
 C_fctexport void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, C_word loc) C_noret;
 C_fctexport void C_ccall C_call_with_cthulhu(C_word c, C_word self, C_word k, C_word proc) C_noret;
 C_fctexport void C_ccall C_copy_closure(C_word c, C_word closure, C_word k, C_word proc) C_noret;
@@ -1821,6 +1820,7 @@ C_fctexport C_word C_fcall C_putprop(C_word **a, C_word sym, C_word prop, C_word
 C_fctexport C_word C_fcall C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm;
 C_fctexport double C_fcall C_milliseconds(void) C_regparm;
 C_fctexport double C_fcall C_cpu_milliseconds(void) C_regparm;
+C_fctexport C_word C_fcall C_a_i_cpu_time(C_word **a, int c, C_word buf) C_regparm;
 
 C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm;
 C_fctexport C_word C_fcall C_i_foreign_fixnum_argumentp(C_word x) C_regparm;
diff --git a/library.scm b/library.scm
index 80339aae..809e664f 100644
--- a/library.scm
+++ b/library.scm
@@ -196,7 +196,6 @@ EOF
 (define ##sys#memory-info (##core#primitive "C_get_memory_info"))
 (define (current-milliseconds) (##core#inline_allocate ("C_a_i_current_milliseconds" 4) #f))
 (define (current-gc-milliseconds) (##sys#fudge 31))
-(define cpu-time (##core#primitive "C_cpu_time"))
 (define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
 (define get-environment-variable (##core#primitive "C_get_environment_variable"))
 (define getenv get-environment-variable) ; DEPRECATED
@@ -232,6 +231,15 @@ EOF
 (define (current-seconds) 
   (##core#inline_allocate ("C_a_get_current_seconds" 4) #f))
 
+(define cpu-time
+  (let ((buf (vector #f #f)))
+    (lambda ()
+      ;; should be thread-safe as no context-switch will occur after
+      ;; function entry and `buf' contents will have been extracted
+      ;; before `values' gets called.
+      (##core#inline_allocate ("C_a_i_cpu_time" 8) buf)
+      (values (##sys#slot buf 0) (##sys#slot buf 1)))))
+
 (define (##sys#check-structure x y . loc) 
   (if (pair? loc)
       (##core#inline "C_i_check_structure_2" x y (car loc))
diff --git a/runtime.c b/runtime.c
index 779c3f21..31484444 100644
--- a/runtime.c
+++ b/runtime.c
@@ -742,7 +742,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
   C_pte(C_file_info);
   C_pte(C_get_symbol_table_info);
   C_pte(C_get_memory_info);
-  C_pte(C_cpu_time);
   C_pte(C_decode_seconds);
   C_pte(C_get_environment_variable);
   C_pte(C_stop_timer);
@@ -8206,24 +8205,28 @@ void become_2(void *dummy)
 }
 
 
-void C_ccall C_cpu_time(C_word c, C_word closure, C_word k)
+C_regparm C_word C_fcall
+C_a_i_cpu_time(C_word **a, int c, C_word buf)
 {
-  C_word u, s = 0;
+  C_word u, s = C_fix(0);
 
 #if defined(C_NONUNIX) || defined(__CYGWIN__)
   if(CLOCKS_PER_SEC == 1000) u = clock();
-  else u = ((double)clock() / (double)CLOCKS_PER_SEC) * 1000;
+  else u = C_number(a, ((double)clock() / (double)CLOCKS_PER_SEC) * 1000);
 #else
   struct rusage ru;
 
   if(C_getrusage(RUSAGE_SELF, &ru) == -1) u = 0;
   else {
-    u = ru.ru_utime.tv_sec * 1000 + ru.ru_utime.tv_usec / 1000;
-    s = ru.ru_stime.tv_sec * 1000 + ru.ru_stime.tv_usec / 1000;
+    u = C_number(a, (double)ru.ru_utime.tv_sec * 1000 + ru.ru_utime.tv_usec / 1000);
+    s = C_number(a, (double)ru.ru_stime.tv_sec * 1000 + ru.ru_stime.tv_usec / 1000);
   }
 #endif
-  
-  C_values(4, C_SCHEME_UNDEFINED, k, C_fix(u & C_MOST_POSITIVE_FIXNUM), C_fix(s & C_MOST_POSITIVE_FIXNUM));
+
+  /* buf must not be in nursery */
+  C_set_block_item(buf, 0, u);
+  C_set_block_item(buf, 1, s);
+  return buf;
 }