From a53e6a707e34fa26f42a110b8948ef9710c0d86e Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 3 May 2020 12:15:08 +0200 Subject: [PATCH 1/2] Deprecate current-milliseconds in favor of current-process-milliseconds For consistency, a similar deprecation is also made for the underlying C API. --- DEPRECATED | 6 ++++++ NEWS | 11 +++++++++-- batch-driver.scm | 2 +- chicken.h | 5 ++++- chicken.time.import.scm | 1 + library.scm | 6 +++++- manual/Module (chicken time) | 4 ++-- runtime.c | 6 ++++++ scheduler.scm | 6 +++--- tcp.scm | 10 +++++----- tests/loopy-test.scm | 6 +++--- tests/test.scm | 10 +++++----- types.db | 3 ++- 13 files changed, 52 insertions(+), 24 deletions(-) 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 -(current-milliseconds) +(current-process-milliseconds) 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)) -- 2.20.1