source: project/release/5/srfi-19/trunk/srfi-19-tmctm.scm @ 38668

;;;; srfi-19-tmctm.scm  -*- Scheme -*-
;;;; Chicken port, Kon Lovett, Dec '05

;; SRFI-19: Time Data Types and Procedures.
;;
;; Copyright (C) I/NET, Inc. (2000, 2002, 2003). All Rights Reserved.
;; Copyright (C) Neodesic Corporation (2000). All Rights Reserved.
;;
;; This document and translations of it may be copied and furnished to others,
;; and derivative works that comment on or otherwise explain it or assist in its
;; implementation may be prepared, copied, published and distributed, in whole or
;; in part, without restriction of any kind, provided that the above copyright
;; notice and this paragraph are included on all such copies and derivative works.
;; However, this document itself may not be modified in any way, such as by
;; removing the copyright notice or references to the Scheme Request For
;; Implementation process or editors, except as needed for the purpose of
;; developing SRFIs in which case the procedures for copyrights defined in the SRFI
;; process must be followed, or as required to translate it into languages other
;; than English.
;;
;; The limited permissions granted above are perpetual and will not be revoked
;; by the authors or their successors or assigns.
;;
;; This document and the information contained herein is provided on an "AS IS"
;; basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.

;; Issues
;;
;; - current-milliseconds is since process start but current-seconds is since
;; epoch start.

;; Bugs
;;
;; - assumes process start on a second boundary which is !?

;; Notes
;;
;; - w/o define-inline .o = 6920, w/ = 6428 !?

(declare (disable-interrupts))

(module srfi-19-tmctm

(;export
  tm:current-time-values)

(import scheme)
(import (chicken base))
(import (chicken type))
;(import (only (chicken time) current-seconds current-milliseconds))

;from library.scm

#>
#define C_a_get_current_seconds(ptr, c, dummy)  C_int64_to_num(ptr, time(NULL))
<#

(: current-milliseconds (-> integer))
(: current-seconds (-> integer))

(define-inline (current-milliseconds)
  (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f))

(define-inline (current-seconds)
  (##core#inline_allocate ("C_a_get_current_seconds" 7) #f))

;;;

(include "srfi-19-common")

;; Current time

(: subsecond-ms (integer --> fixnum))
(: ms->ns (fixnum --> fixnum))

(define-inline (subsecond-ms ms) (remainder ms MS/S))
(define-inline (ms->ns ms) (* ms NS/MS))

(: tm:current-time-values (-> fixnum integer))

(define (tm:current-time-values)
  ;per #chicken irc example (still not n'sync)
  (let* (
    (a-s (current-seconds))
    (a-ms (current-milliseconds))
    (b-s (current-seconds))
    (b-ms (current-milliseconds)) )
    (if (= a-s b-s)
      (values (ms->ns (subsecond-ms a-ms)) a-s)
      (values (ms->ns (subsecond-ms b-ms)) b-s) ) ) )

) ;module srfi-19-tmctm