~ chicken-core (chicken-5) 9b9ed04eee5866019563587bb3a2c4963f3d3dc0
commit 9b9ed04eee5866019563587bb3a2c4963f3d3dc0
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun May 3 12:15:08 2020 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed May 6 11:19:10 2020 +0200
Deprecate current-milliseconds in favor of current-process-milliseconds
For consistency, a similar deprecation is also made for the underlying
C API.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/DEPRECATED b/DEPRECATED
index 40756ce2..8f25faa8 100644
--- a/DEPRECATED
+++ b/DEPRECATED
@@ -1,6 +1,12 @@
Deprecated functions and variables
==================================
+5.2.1
+- current-milliseconds and its C implementations C_milliseconds and
+ C_a_i_current_milliseconds have been deprecated in favor of
+ current-process_milliseconds, C_current_process_milliseconds and
+ C_a_i_current_process_milliseconds
+
5.1.1
- ##sys#check-exact and its C implementations C_i_check_exact and
diff --git a/NEWS b/NEWS
index 825fa8ab..67cc9f55 100644
--- a/NEWS
+++ b/NEWS
@@ -4,13 +4,20 @@
- Fixed a bug where optimisations for `irregex-match?` would cause
runtime errors due to the inlined specialisations not being
fully-expanded (see #1690).
+ - current-milliseconds has been deprecated in favor of the name
+ current-process-milliseconds, to avoid confusion due to naming
+ of current-milliseconds versus current-seconds, which do something
+ quite different.
- Runtime system
- Sleeping primordial thread doesn't forget mutations made to
parameters in interrupt handlers anymore. (See #1638. Fix
contributed by Sebastien Marie)
-- A feature corresponding to the word size is available
- regardless of the word size (#1693)
+ - A feature corresponding to the word size is available
+ regardless of the word size (#1693)
+ - Deprecated C_(a_i_current_)milliseconds in favor of
+ C_(a_i_)current_process_milliseconds to match the Scheme-level
+ deprecation of current-milliseconds.
- Build system
- Auto-configure at build time on most platforms. Cross-compilation
diff --git a/batch-driver.scm b/batch-driver.scm
index 29c6ac86..206d4089 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -254,7 +254,7 @@
(and-let* ((m (memq 'module options)))
(option-arg m))))
- (define (cputime) (current-milliseconds))
+ (define (cputime) (current-process-milliseconds))
(define (dribble fstr . args)
(debugging 'p (apply sprintf fstr args)))
diff --git a/chicken.h b/chicken.h
index 0e60b7cb..b3ba54f0 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1628,7 +1628,9 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
#define C_u_i_flonum_infinitep(x) C_mk_bool(C_isinf(C_flonum_magnitude(x)))
#define C_u_i_flonum_finitep(x) C_mk_bool(C_isfinite(C_flonum_magnitude(x)))
+/* DEPRECATED */
#define C_a_i_current_milliseconds(ptr, c, dummy) C_uint64_to_num(ptr, C_milliseconds())
+#define C_a_i_current_process_milliseconds(ptr, c, dummy) C_uint64_to_num(ptr, C_current_process_milliseconds())
#define C_i_noop1(dummy) ((dummy), C_SCHEME_UNDEFINED)
#define C_i_noop2(dummy1, dummy2) ((dummy1), (dummy2), C_SCHEME_UNDEFINED)
@@ -2079,7 +2081,8 @@ C_fctexport C_word C_fcall C_i_persist_symbol(C_word sym) C_regparm;
C_fctexport C_word C_fcall C_i_unpersist_symbol(C_word sym) C_regparm;
C_fctexport C_word C_fcall C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm;
C_fctexport C_word C_fcall C_i_process_sleep(C_word n) C_regparm;
-C_fctexport C_u64 C_fcall C_milliseconds(void) C_regparm;
+C_fctexport C_u64 C_fcall C_milliseconds(void) C_regparm; /* DEPRECATED */
+C_fctexport C_u64 C_fcall C_current_process_milliseconds(void) C_regparm;
C_fctexport C_u64 C_fcall C_cpu_milliseconds(void) C_regparm;
C_fctexport double C_fcall C_bignum_to_double(C_word bignum) C_regparm;
C_fctexport C_word C_fcall C_i_debug_modep(void) C_regparm;
diff --git a/chicken.time.import.scm b/chicken.time.import.scm
index d7cdbd5c..c77cd961 100644
--- a/chicken.time.import.scm
+++ b/chicken.time.import.scm
@@ -28,6 +28,7 @@
'library
'((cpu-time . chicken.time#cpu-time)
(current-milliseconds . chicken.time#current-milliseconds)
+ (current-process-milliseconds . chicken.time#current-process-milliseconds)
(current-seconds . chicken.time#current-seconds))
;; OBSOLETE: This can be removed after bootstrapping
(if (##sys#symbol-has-toplevel-binding? '##sys#chicken.time-macro-environment)
diff --git a/library.scm b/library.scm
index e645ae71..efcd3feb 100644
--- a/library.scm
+++ b/library.scm
@@ -1084,14 +1084,18 @@ EOF
;; to be a hardcoded primitive module.
;;
;; [syntax] time
- (cpu-time current-milliseconds current-seconds)
+ (cpu-time current-milliseconds current-process-milliseconds current-seconds)
(import scheme)
(import (only chicken.module reexport))
+;; Deprecated
(define (current-milliseconds)
(##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f))
+(define (current-process-milliseconds)
+ (##core#inline_allocate ("C_a_i_current_process_milliseconds" 7) #f))
+
(define (current-seconds)
(##core#inline_allocate ("C_a_get_current_seconds" 7) #f))
diff --git a/manual/Module (chicken time) b/manual/Module (chicken time)
index 88cf2838..2f302c4e 100644
--- a/manual/Module (chicken time)
+++ b/manual/Module (chicken time)
@@ -19,9 +19,9 @@ code. On platforms where user and system time can not be differentiated,
system time will be always be 0.
-==== current-milliseconds
+==== current-process-milliseconds
-<procedure>(current-milliseconds)</procedure>
+<procedure>(current-process-milliseconds)</procedure>
Returns the number of milliseconds since process- or machine startup.
diff --git a/runtime.c b/runtime.c
index e1ecd668..b01cdd06 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2025,7 +2025,13 @@ C_word C_dbg_hook(C_word dummy)
/* Timing routines: */
+/* DEPRECATED */
C_regparm C_u64 C_fcall C_milliseconds(void)
+{
+ return C_current_process_milliseconds();
+}
+
+C_regparm C_u64 C_fcall C_current_process_milliseconds(void)
{
#ifdef C_NONUNIX
if(CLOCKS_PER_SEC == 1000) return clock();
diff --git a/scheduler.scm b/scheduler.scm
index 4d5b11d0..28bb7ff9 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -185,7 +185,7 @@ EOF
(let loop1 ()
;; Unblock threads waiting for timeout:
(unless (null? ##sys#timeout-list)
- (let ((now (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f)))
+ (let ((now (##core#inline_allocate ("C_a_i_current_process_milliseconds" 7) #f)))
(let loop ((lst ##sys#timeout-list))
(if (null? lst)
(set! ##sys#timeout-list '())
@@ -460,7 +460,7 @@ EOF
(tmo (if (and to? (not rq?)) ; no thread was unblocked by timeout, so wait
(let* ((tmo1 (caar ##sys#timeout-list))
(tmo1 (inexact->exact (round tmo1)))
- (now (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f)))
+ (now (##core#inline_allocate ("C_a_i_current_process_milliseconds" 7) #f)))
(max 0 (- tmo1 now)) )
0))) ; otherwise immediate timeout.
(dbg "waiting for I/O with timeout " tmo)
@@ -603,7 +603,7 @@ EOF
(set! chicken.base#sleep-hook
(lambda (n)
(##sys#thread-sleep!
- (+ (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f)
+ (+ (##core#inline_allocate ("C_a_i_current_process_milliseconds" 7) #f)
(* 1000.0 n)))))
diff --git a/tcp.scm b/tcp.scm
index 250e6364..31bd0b5b 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -374,7 +374,7 @@ EOF
(read-input
(lambda ()
(let* ((tmr (tcp-read-timeout))
- (dlr (and tmr (+ (current-milliseconds) tmr))))
+ (dlr (and tmr (+ (current-process-milliseconds) tmr))))
(let loop ()
(let ((n (recv fd buf +input-buffer-size+ 0)))
(cond ((eq? _socket_error n)
@@ -484,7 +484,7 @@ EOF
(let ((tmw (tcp-write-timeout)))
(let loop ((len (##sys#size s))
(offset 0)
- (dlw (and tmw (+ (current-milliseconds) tmw))))
+ (dlw (and tmw (+ (current-process-milliseconds) tmw))))
(let* ((count (fxmin +output-chunk-size+ len))
(n (send fd s offset count 0)))
(cond ((eq? _socket_error n)
@@ -509,7 +509,7 @@ EOF
(if (fx= n 0)
tmw
;; If we wrote *something*, reset timeout
- (and tmw (+ (current-milliseconds) tmw)) )) ) ) ) )) ) )
+ (and tmw (+ (current-process-milliseconds) tmw)) )) ) ) ) )) ) )
(out
(make-output-port
(if outbuf
@@ -547,7 +547,7 @@ EOF
(##sys#check-structure tcpl 'tcp-listener)
(let* ((fd (##sys#slot tcpl 1))
(tma (tcp-accept-timeout))
- (dla (and tma (+ tma (current-milliseconds)))))
+ (dla (and tma (+ tma (current-process-milliseconds)))))
(let loop ()
(when dla
(##sys#thread-block-for-timeout! ##sys#current-thread dla) )
@@ -585,7 +585,7 @@ EOF
(define (tcp-connect host . more)
(let* ((port (optional more #f))
(tmc (tcp-connect-timeout))
- (dlc (and tmc (+ (current-milliseconds) tmc)))
+ (dlc (and tmc (+ (current-process-milliseconds) tmc)))
(addr (make-string _sockaddr_in_size)))
(##sys#check-string host)
(unless port
diff --git a/tests/loopy-test.scm b/tests/loopy-test.scm
index 46b94c1c..10c1a2bf 100644
--- a/tests/loopy-test.scm
+++ b/tests/loopy-test.scm
@@ -1,5 +1,5 @@
(import (only chicken.format printf)
- (only chicken.time current-milliseconds)
+ (only chicken.time current-process-milliseconds)
chicken.load)
(load-relative "loopy-loop.scm")
@@ -35,7 +35,7 @@
(define (test-begin . o)
(set! *pass* 0)
(set! *fail* 0)
- (set! *start* (current-milliseconds)))
+ (set! *start* (current-process-milliseconds)))
(define (format-float n prec)
(let* ((str (number->string n))
@@ -61,7 +61,7 @@
(format-float (* 100 x) 2)))
(define (test-end . o)
- (let ((end (current-milliseconds))
+ (let ((end (current-process-milliseconds))
(total (+ *pass* *fail*)))
(printf " ~A tests completed in ~A seconds\n"
total (format-float (exact->inexact (/ (- end *start*) 1000)) 3))
diff --git a/tests/test.scm b/tests/test.scm
index 7b47f5dc..5434e751 100644
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -3,7 +3,7 @@
; by Alex Shinn, lifted from match-test by felix
(import (only chicken.string ->string))
-(import (only chicken.time current-milliseconds))
+(import (only chicken.time current-process-milliseconds))
(define *current-group-name* "")
(define *pass* 0)
@@ -40,9 +40,9 @@
(set! *total-fail* (+ *total-fail* *fail*))
(set! *pass* 0)
(set! *fail* 0)
- (set! *start* (current-milliseconds))
+ (set! *start* (current-process-milliseconds))
(when (= 0 *total-start*)
- (set! *total-start* (current-milliseconds))))
+ (set! *total-start* (current-process-milliseconds))))
(define (format-float n prec)
(let* ((str (number->string n))
@@ -68,7 +68,7 @@
(format-float (* 100 x) 2)))
(define (test-end . o)
- (let ((end (current-milliseconds))
+ (let ((end (current-process-milliseconds))
(total (+ *pass* *fail*)))
(print " " total " tests completed in "
(format-float (exact->inexact (/ (- end *start*) 1000)) 3)
@@ -85,7 +85,7 @@
(print " TOTALS: ")
(set! *total-pass* (+ *total-pass* *pass*)) ; should be 0
(set! *total-fail* (+ *total-fail* *fail*)) ; should be 0
- (let ((end (current-milliseconds))
+ (let ((end (current-process-milliseconds))
(total (+ *total-pass* *total-fail*)))
(print " " total " tests completed in "
(format-float (exact->inexact (/ (- end *total-start*) 1000)) 3)
diff --git a/types.db b/types.db
index 43f0a741..ff88d1f3 100644
--- a/types.db
+++ b/types.db
@@ -1157,7 +1157,8 @@
(chicken.time#cpu-time (#(procedure #:clean) chicken.time#cpu-time () fixnum fixnum))
(chicken.time#current-seconds (#(procedure #:clean) chicken.time#current-seconds () integer))
-(chicken.time#current-milliseconds (#(procedure #:clean) chicken.time#current-milliseconds () integer))
+(chicken.time#current-milliseconds deprecated)
+(chicken.time#current-process-milliseconds (#(procedure #:clean) chicken.time#current-process-milliseconds () integer))
(##sys#error (procedure ##sys#error (* #!rest) noreturn))
(##sys#signal-hook (procedure ##sys#signal-hook (* #!rest) noreturn))
Trap