cs & io: small clean-ups to seconds->date
Streamline some things that probably needed to be different along the way.
This commit is contained in:
Matthew Flatt
parent
4b7b1872dc
commit
c7ca4414ca
|
|
@ -213,6 +213,13 @@
|
|||
(ftype-ref rktio_identity_t (b_bits) p)
|
||||
(ftype-ref rktio_identity_t (c_bits) p))))
|
||||
|
||||
(define (in-date-range? si)
|
||||
(if (> (fixnum-width) 32)
|
||||
(<= -9223372036854775808 si 9223372036854775807)
|
||||
(<= -2147483648 si 2147483647)))
|
||||
|
||||
(define unknown-zone-name (string->immutable-string "?"))
|
||||
|
||||
(define (rktio_seconds_to_date* rktio si nsecs get-gmt)
|
||||
(cond
|
||||
[(not (in-date-range? si))
|
||||
|
|
|
|||
|
|
@ -133,7 +133,6 @@
|
|||
|
||||
struct:date* date*? date* make-date*
|
||||
date*-nanosecond date*-time-zone-name
|
||||
in-date-range? unknown-zone-name ;; not exported to Racket
|
||||
|
||||
struct:arity-at-least arity-at-least arity-at-least?
|
||||
arity-at-least-value
|
||||
|
|
|
|||
|
|
@ -104,10 +104,3 @@
|
|||
(define (current-seconds)
|
||||
(let ((t (current-time 'time-utc)))
|
||||
(time-second t)))
|
||||
|
||||
(define (in-date-range? si)
|
||||
(if (> (fixnum-width) 32)
|
||||
(<= -9223372036854775808 si 9223372036854775807)
|
||||
(<= -2147483648 si 2147483647)))
|
||||
|
||||
(define unknown-zone-name (string->immutable-string "?"))
|
||||
|
|
|
|||
|
|
@ -38087,46 +38087,51 @@
|
|||
'current-load-extension))
|
||||
(define rktio_seconds_to_date-error-kind (vector-immutable 3 25))
|
||||
(define 1/seconds->date
|
||||
(|#%name|
|
||||
seconds->date
|
||||
(case-lambda
|
||||
((s_0) (begin (1/seconds->date s_0 #t)))
|
||||
((s_0 local?_0)
|
||||
(begin
|
||||
(if (real? s_0)
|
||||
(void)
|
||||
(raise-argument-error 'seconds->date "real?" s_0))
|
||||
(let ((s_1 (inexact->exact s_0)))
|
||||
(let ((si_0 (floor s_1)))
|
||||
(let ((get-gmt_0 (if local?_0 0 1)))
|
||||
(let ((nsecs_0 (floor (* (- s_1 si_0) 1000000000))))
|
||||
(let ((dt_0
|
||||
(|#%app|
|
||||
rktio_seconds_to_date*
|
||||
(unsafe-place-local-ref cell.1)
|
||||
si_0
|
||||
nsecs_0
|
||||
get-gmt_0)))
|
||||
(if (date*? dt_0)
|
||||
dt_0
|
||||
(if (equal? dt_0 rktio_seconds_to_date-error-kind)
|
||||
(raise-arguments-error
|
||||
'seconds->date
|
||||
"integer is out-of-range"
|
||||
"integer"
|
||||
si_0)
|
||||
(let ((base-msg_0 "conversion error"))
|
||||
(begin-unsafe
|
||||
(raise
|
||||
(let ((app_0
|
||||
(format-rktio-message
|
||||
'seconds->date
|
||||
dt_0
|
||||
base-msg_0)))
|
||||
(|#%app|
|
||||
exn:fail
|
||||
app_0
|
||||
(current-continuation-marks))))))))))))))))))
|
||||
(let ((seconds->date_0
|
||||
(|#%name|
|
||||
seconds->date
|
||||
(lambda (s2_0 local?1_0)
|
||||
(begin
|
||||
(begin
|
||||
(if (real? s2_0)
|
||||
(void)
|
||||
(raise-argument-error 'seconds->date "real?" s2_0))
|
||||
(let ((s_0 (inexact->exact s2_0)))
|
||||
(let ((si_0 (floor s_0)))
|
||||
(let ((get-gmt_0 (if local?1_0 0 1)))
|
||||
(let ((nsecs_0 (floor (* (- s_0 si_0) 1000000000))))
|
||||
(let ((dt_0
|
||||
(|#%app|
|
||||
rktio_seconds_to_date*
|
||||
(unsafe-place-local-ref cell.1)
|
||||
si_0
|
||||
nsecs_0
|
||||
get-gmt_0)))
|
||||
(if (date*? dt_0)
|
||||
dt_0
|
||||
(if (equal? dt_0 rktio_seconds_to_date-error-kind)
|
||||
(raise-arguments-error
|
||||
'seconds->date
|
||||
"integer is out-of-range"
|
||||
"integer"
|
||||
si_0)
|
||||
(let ((base-msg_0 "conversion error"))
|
||||
(begin-unsafe
|
||||
(raise
|
||||
(let ((app_0
|
||||
(format-rktio-message
|
||||
'seconds->date
|
||||
dt_0
|
||||
base-msg_0)))
|
||||
(|#%app|
|
||||
exn:fail
|
||||
app_0
|
||||
(current-continuation-marks)))))))))))))))))))
|
||||
(|#%name|
|
||||
seconds->date
|
||||
(case-lambda
|
||||
((s_0) (begin (seconds->date_0 s_0 #t)))
|
||||
((s_0 local?1_0) (seconds->date_0 s_0 local?1_0))))))
|
||||
(define 1/unsafe-poller
|
||||
(|#%name|
|
||||
unsafe-poller
|
||||
|
|
|
|||
|
|
@ -747,8 +747,8 @@
|
|||
(test l (sync l))
|
||||
(define-values (tai tao) (tcp-accept l))
|
||||
|
||||
(test #f (file-stream-port? i))
|
||||
(test #f (file-stream-port? o))
|
||||
(test #f (file-stream-port? ti))
|
||||
(test #f (file-stream-port? to))
|
||||
|
||||
(test 6 (write-string "hello\n" to))
|
||||
(flush-output to)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
(require racket/include
|
||||
racket/fixnum
|
||||
(only-in '#%linklet primitive-table)
|
||||
(only-in '#%kernel [date* kernel:date*])
|
||||
ffi/unsafe
|
||||
ffi/unsafe/atomic
|
||||
(for-syntax racket/base)
|
||||
|
|
@ -135,7 +134,7 @@
|
|||
(define dt (cast p _pointer _Rrktio_date_t-pointer))
|
||||
(define tzn (Rrktio_date_t-zone_name dt))
|
||||
(begin0
|
||||
(kernel:date*
|
||||
(date*
|
||||
(Rrktio_date_t-second dt)
|
||||
(Rrktio_date_t-minute dt)
|
||||
(Rrktio_date_t-hour dt)
|
||||
|
|
@ -226,54 +225,62 @@
|
|||
(define (rktio_make_sha2_ctx)
|
||||
(malloc _Rrktio_sha2_ctx_t))
|
||||
|
||||
(define (replace-ltps-open ht)
|
||||
;; Disable rktio_ltps_open in demo mode, since it is not
|
||||
;; connected to the host scheduler
|
||||
(hash-set ht 'rktio_ltps_open
|
||||
(lambda (x) (vector RKTIO_ERROR_KIND_RACKET
|
||||
RKTIO_ERROR_UNSUPPORTED))))
|
||||
|
||||
(primitive-table '#%rktio
|
||||
(let ()
|
||||
(define-syntax extract-functions
|
||||
(syntax-rules (define-constant
|
||||
define-type
|
||||
define-struct-type
|
||||
define-function
|
||||
define-function/errno
|
||||
define-function/errno+step)
|
||||
[(_ accum) (hasheq . accum)]
|
||||
[(_ accum (define-constant . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-type . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-struct-type . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-function _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]
|
||||
[(_ accum (define-function/errno _ _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]
|
||||
[(_ accum (define-function/errno+step _ _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]))
|
||||
(define-syntax-rule (begin form ...)
|
||||
(extract-functions [#;(begin)
|
||||
'rktio_NULL rktio_NULL
|
||||
'rktio_filesize_ref rktio_filesize_ref
|
||||
'rktio_timestamp_ref rktio_timestamp_ref
|
||||
'rktio_is_timestamp rktio_is_timestamp
|
||||
'rktio_recv_length_ref rktio_recv_length_ref
|
||||
'rktio_recv_address_ref rktio_recv_address_ref
|
||||
'rktio_identity_to_vector rktio_identity_to_vector
|
||||
'rktio_seconds_to_date* rktio_seconds_to_date*
|
||||
'rktio_convert_result_to_vector rktio_convert_result_to_vector
|
||||
'rktio_to_bytes rktio_to_bytes
|
||||
'rktio_to_bytes_list rktio_to_bytes_list
|
||||
'rktio_to_shorts rktio_to_shorts
|
||||
'rktio_from_bytes_list rktio_from_bytes_list
|
||||
'rktio_free_bytes_list rktio_free_bytes_list
|
||||
'rktio_make_sha1_ctx rktio_make_sha1_ctx
|
||||
'rktio_make_sha2_ctx rktio_make_sha2_ctx
|
||||
'rktio_process_result_stdin_fd rktio_process_result_stdin_fd
|
||||
'rktio_process_result_stdout_fd rktio_process_result_stdout_fd
|
||||
'rktio_process_result_stderr_fd rktio_process_result_stderr_fd
|
||||
'rktio_process_result_process rktio_process_result_process
|
||||
'rktio_status_running rktio_status_running
|
||||
'rktio_status_result rktio_status_result
|
||||
'rktio_pipe_results rktio_pipe_results
|
||||
'rktio_do_install_os_signal_handler rktio_do_install_os_signal_handler
|
||||
'rktio_get_ctl_c_handler rktio_get_ctl_c_handler]
|
||||
form ...))
|
||||
(include "../../rktio/rktio.rktl")))
|
||||
(replace-ltps-open
|
||||
(let ()
|
||||
(define-syntax extract-functions
|
||||
(syntax-rules (define-constant
|
||||
define-type
|
||||
define-struct-type
|
||||
define-function
|
||||
define-function/errno
|
||||
define-function/errno+step)
|
||||
[(_ accum) (hasheq . accum)]
|
||||
[(_ accum (define-constant . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-type . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-struct-type . _) . rest)
|
||||
(extract-functions accum . rest)]
|
||||
[(_ accum (define-function _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]
|
||||
[(_ accum (define-function/errno _ _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]
|
||||
[(_ accum (define-function/errno+step _ _ _ id . _) . rest)
|
||||
(extract-functions ('id id . accum) . rest)]))
|
||||
(define-syntax-rule (begin form ...)
|
||||
(extract-functions [#;(begin)
|
||||
'rktio_NULL rktio_NULL
|
||||
'rktio_filesize_ref rktio_filesize_ref
|
||||
'rktio_timestamp_ref rktio_timestamp_ref
|
||||
'rktio_is_timestamp rktio_is_timestamp
|
||||
'rktio_recv_length_ref rktio_recv_length_ref
|
||||
'rktio_recv_address_ref rktio_recv_address_ref
|
||||
'rktio_identity_to_vector rktio_identity_to_vector
|
||||
'rktio_seconds_to_date* rktio_seconds_to_date*
|
||||
'rktio_convert_result_to_vector rktio_convert_result_to_vector
|
||||
'rktio_to_bytes rktio_to_bytes
|
||||
'rktio_to_bytes_list rktio_to_bytes_list
|
||||
'rktio_to_shorts rktio_to_shorts
|
||||
'rktio_from_bytes_list rktio_from_bytes_list
|
||||
'rktio_free_bytes_list rktio_free_bytes_list
|
||||
'rktio_make_sha1_ctx rktio_make_sha1_ctx
|
||||
'rktio_make_sha2_ctx rktio_make_sha2_ctx
|
||||
'rktio_process_result_stdin_fd rktio_process_result_stdin_fd
|
||||
'rktio_process_result_stdout_fd rktio_process_result_stdout_fd
|
||||
'rktio_process_result_stderr_fd rktio_process_result_stderr_fd
|
||||
'rktio_process_result_process rktio_process_result_process
|
||||
'rktio_status_running rktio_status_running
|
||||
'rktio_status_result rktio_status_result
|
||||
'rktio_pipe_results rktio_pipe_results
|
||||
'rktio_do_install_os_signal_handler rktio_do_install_os_signal_handler
|
||||
'rktio_get_ctl_c_handler rktio_get_ctl_c_handler]
|
||||
form ...))
|
||||
(include "../../rktio/rktio.rktl"))))
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
(provide seconds->date)
|
||||
|
||||
(require racket/fixnum
|
||||
(only-in '#%kernel [date*? kernel:date*?])
|
||||
"../common/check.rkt"
|
||||
"../host/rktio.rkt"
|
||||
"../host/error.rkt"
|
||||
|
|
@ -12,26 +11,23 @@
|
|||
|
||||
(define rktio_seconds_to_date-error-kind
|
||||
(vector-immutable RKTIO_ERROR_KIND_RACKET
|
||||
RKTIO_ERROR_TIME_OUT_OF_RANGE ))
|
||||
RKTIO_ERROR_TIME_OUT_OF_RANGE))
|
||||
|
||||
(define/who seconds->date
|
||||
(case-lambda
|
||||
[(s) (seconds->date s #t)]
|
||||
[(s local?)
|
||||
(check who real? s)
|
||||
(let* ([s (inexact->exact s)]
|
||||
[si (floor s)]
|
||||
[get-gmt (if local? 0 1)]
|
||||
[nsecs (floor (* (- s si) 1000000000))]
|
||||
;; The allocation, deallocation and the conversion of the
|
||||
;; rktio_date_t* result is hidden in rktio_seconds_to_date*,
|
||||
;; therefore no atomicity is needed here.
|
||||
[dt (rktio_seconds_to_date* rktio si nsecs get-gmt)])
|
||||
(cond
|
||||
[(kernel:date*? dt)
|
||||
dt]
|
||||
[(equal? dt rktio_seconds_to_date-error-kind)
|
||||
(raise-arguments-error who "integer is out-of-range"
|
||||
"integer" si)]
|
||||
[else
|
||||
(raise-rktio-error who dt "conversion error")]))]))
|
||||
(define/who (seconds->date s [local? #t])
|
||||
(check who real? s)
|
||||
(let* ([s (inexact->exact s)]
|
||||
[si (floor s)]
|
||||
[get-gmt (if local? 0 1)]
|
||||
[nsecs (floor (* (- s si) 1000000000))]
|
||||
;; The allocation, deallocation and the conversion of the
|
||||
;; rktio_date_t* result is hidden in rktio_seconds_to_date*,
|
||||
;; therefore no atomicity is needed here.
|
||||
[dt (rktio_seconds_to_date* rktio si nsecs get-gmt)])
|
||||
(cond
|
||||
[(date*? dt)
|
||||
dt]
|
||||
[(equal? dt rktio_seconds_to_date-error-kind)
|
||||
(raise-arguments-error who "integer is out-of-range"
|
||||
"integer" si)]
|
||||
[else
|
||||
(raise-rktio-error who dt "conversion error")])))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user