Changeset 15793 in project


Ignore:
Timestamp:
09/08/09 07:04:35 (10 years ago)
Author:
Kon Lovett
Message:

Use of prims. Fix for time-abs/negate not handling nanos.

Location:
release/4/srfi-19
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-19/tags/3.0.0/srfi-19-support.scm

    r15790 r15793  
    331331;; Number of seconds after epoch of first leap year
    332332
    333 (define LEAP-START (fx* (fx- FIRST-LEAP-YEAR TAI-EPOCH-YEAR) (fx* DY/YR SEC/DY)))
     333(define LEAP-START (%fx* (%fx- FIRST-LEAP-YEAR TAI-EPOCH-YEAR) (%fx* DY/YR SEC/DY)))
    334334
    335335;; A table of leap seconds
     
    424424          (_if (r 'if))
    425425          (_null? (r 'null?))
    426           (_car (r 'car))
    427           (_cdr (r 'cdr))
     426          (_%car (r '%car))
     427          (_%cdr (r '%cdr))
    428428          (_leap-second-item (r 'leap-second-item)) )
    429429      (let ((?secs (cadr form))
     
    432432        `(,_let loop ((lsvar ,?ls))
    433433           (,_if (,_null? lsvar) 0
    434                (,_let ((leap-second-item (,_car lsvar)))
    435                  (,_if ,?tst (,_cdr leap-second-item)
    436                      (loop (,_cdr lsvar)) ) ) ) ) ) ) ) )
     434               (,_let ((leap-second-item (,_%car lsvar)))
     435                 (,_if ,?tst (,_%cdr leap-second-item)
     436                     (loop (,_%cdr lsvar)) ) ) ) ) ) ) ) )
    437437
    438438(define-syntax leap-second-delta*
     
    453453(define-inline (leap-second-delta utc-seconds)
    454454  (leap-second-delta* utc-seconds
    455                       (<= (car leap-second-item) utc-seconds)) )
     455                      (<= (%car leap-second-item) utc-seconds)) )
    456456
    457457;; Going from tai seconds to utc seconds ...
     
    459459(define-inline (leap-second-neg-delta tai-seconds)
    460460  (leap-second-delta* tai-seconds
    461                       (<= (cdr leap-second-item) (- tai-seconds (car leap-second-item)))) )
     461                      (<= (%cdr leap-second-item) (- tai-seconds (%car leap-second-item)))) )
    462462
    463463;;; Time Object (Public Mutable)
     
    469469
    470470(define-record-type/primitive time
    471   (*make-time tt ns sec)
     471  (%make-time tt ns sec)
    472472  time?
    473   (tt   *time-type        *time-type-set!)
    474   (ns   *time-nanosecond  *time-nanosecond-set!)
    475   (sec  *time-second      *time-second-set!) )
     473  (tt   %time-type        %time-type-set!)
     474  (ns   %time-nanosecond  %time-nanosecond-set!)
     475  (sec  %time-second      %time-second-set!) )
    476476
    477477;;
    478478
    479479(define-record-printer (time tim out)
    480   (format out "#,(time ~A ~A ~A)" (*time-type tim) (*time-nanosecond tim) (*time-second tim)) )
    481 
    482 (define-reader-ctor 'time *make-time)
    483 
    484 ;;
    485 
    486 (define (time-type? obj) (memq obj '(monotonic utc tai gc duration process thread)))
     480  (format out "#,(time ~A ~A ~A)" (%time-type tim) (%time-nanosecond tim) (%time-second tim)) )
     481
     482(define-reader-ctor 'time %make-time)
     483
     484;;
     485
     486(define (time-type? obj) (%memq obj '(monotonic utc tai gc duration process thread)))
    487487(define (time-seconds? obj) (integer? obj))
    488 (define (time-nanoseconds? obj) (and (fixnum? obj) (fx< -NS/S obj) (fx< obj NS/S)))
     488(define (time-nanoseconds? obj) (and (%fixnum? obj) (%fx< -NS/S obj) (%fx< obj NS/S)))
    489489
    490490;;
     
    499499;Used to create an output time record where all fields will be set later
    500500;
    501 (define (tm:any-time) (*make-time #f #f #f))
     501(define (tm:any-time) (%make-time #f #f #f))
    502502
    503503;Used to create a time record where ns & sec fields will be set later
    504504;
    505 (define (tm:some-time tt) (*make-time tt #f #f))
     505(define (tm:some-time tt) (%make-time tt #f #f))
    506506
    507507;Used to create a time record where ns & sec fields will be set later
    508508;
    509 (define (tm:as-some-time tim) (*make-time (*time-type tim) #f #f))
    510 
    511 ;;
    512 
    513 (define tm:time-type *time-type)
    514 (define tm:time-second *time-second)
    515 (define tm:time-nanosecond *time-nanosecond)
    516 
    517 (define tm:time-type-set! *time-type-set!)
    518 (define (tm:time-nanosecond-set! tim ns) (*time-nanosecond-set! tim (gennum->?fixnum ns)))
    519 (define (tm:time-second-set! tim sec) (*time-second-set! tim (?genint->?fixnum sec)))
    520 
    521 (define (tm:make-time tt ns sec) (*make-time tt (gennum->?fixnum ns) (?genint->?fixnum sec)))
    522 
    523 (define (tm:copy-time tim) (*make-time (*time-type tim) (*time-second tim) (*time-nanosecond tim)))
    524 
    525 (define (tm:time-has-type? tim tt) (eq? tt (*time-type tim)))
     509(define (tm:as-some-time tim) (%make-time (%time-type tim) #f #f))
     510
     511;;
     512
     513(define tm:time-type %time-type)
     514(define tm:time-second %time-second)
     515(define tm:time-nanosecond %time-nanosecond)
     516
     517(define tm:time-type-set! %time-type-set!)
     518(define (tm:time-nanosecond-set! tim ns) (%time-nanosecond-set! tim (gennum->?fixnum ns)))
     519(define (tm:time-second-set! tim sec) (%time-second-set! tim (?genint->?fixnum sec)))
     520
     521(define (tm:make-time tt ns sec) (%make-time tt (gennum->?fixnum ns) (?genint->?fixnum sec)))
     522
     523(define (tm:copy-time tim) (%make-time (%time-type tim) (%time-second tim) (%time-nanosecond tim)))
     524
     525(define (tm:time-has-type? tim tt) (%eq? tt (%time-type tim)))
    526526
    527527;; Rem & Quo of nanoseconds per second
     
    541541;;
    542542
    543 (define (tm:time->nanoseconds tim) (+ (*time-nanosecond tim) (* (*time-second tim) NS/S)))
    544 (define (tm:time->milliseconds tim) (+ (/ (*time-nanosecond tim) NS/MS) (* (*time-second tim) MS/S)))
     543(define (tm:time->nanoseconds tim) (+ (%time-nanosecond tim) (* (%time-second tim) NS/S)))
     544(define (tm:time->milliseconds tim) (+ (/ (%time-nanosecond tim) NS/MS) (* (%time-second tim) MS/S)))
    545545(define (tm:nanoseconds->seconds ns) (/ ns NS/S))
    546546(define (tm:milliseconds->seconds ms) (/ (exact->inexact ms) MS/S))
     
    555555(define (tm:seconds->time-values sec)
    556556  (let* ((tsec (?genint->?fixnum (truncate sec)))
    557          (ns (gennum->?fixnum (round (abs (* (- (exact->inexact sec) tsec) NS/S))))) )
     557         (ns (gennum->?fixnum (exact->inexact (round (* (- sec tsec) NS/S))))) )
    558558      (values ns tsec) ) )
    559559
    560560(define (tm:milliseconds->time-values ms)
    561   (let ((ns (fx* (gennum->?fixnum (remainder ms MS/S)) NS/MS))
     561  (let ((ns (%fx* (gennum->?fixnum (remainder ms MS/S)) NS/MS))
    562562        (sec (quotient ms MS/S)) )
    563563    (values ns sec) ) )
    564564
    565565(define (tm:milliseconds->time ms tt)
    566   (receive (ns sec)
    567       (tm:milliseconds->time-values ms)
     566  (receive (ns sec) (tm:milliseconds->time-values ms)
    568567    (tm:make-time tt ns sec) ) )
    569568
    570569(define (tm:seconds->time sec tt)
    571   (receive (ns sec)
    572       (tm:seconds->time-values sec)
     570  (receive (ns sec) (tm:seconds->time-values sec)
    573571    (tm:make-time tt ns sec) ) )
    574572
     
    578576; Chicken 'current-milliseconds' within positive fixnum range
    579577;
    580 (define (tm:current-sub-milliseconds) (fxmod (current-milliseconds) MS/S))
     578(define (tm:current-sub-milliseconds) (%fxmod (current-milliseconds) MS/S))
    581579(define (tm:current-nanoseconds) (* (tm:current-sub-milliseconds) NS/MS))
    582580
     
    596594  (let ((tim (tm:current-time-tai)))
    597595    ;time-monotonic is time-tai
    598     (*time-type-set! tim 'monotonic)
     596    (%time-type-set! tim 'monotonic)
    599597    tim ) )
    600598
     
    622620(define (check-time-has-type loc tim tt)
    623621  (unless (tm:time-has-type? tim tt)
    624     (error-incompatible-time-types loc (*time-type tim) tt) ) )
     622    (error-incompatible-time-types loc (%time-type tim) tt) ) )
    625623
    626624(define (check-time-and-type loc tim tt)
     
    644642(define (check-time-compare loc obj1 obj2)
    645643  (check-time-binop loc obj1 obj2)
    646   (check-time-has-type loc obj1 (*time-type obj2)) )
     644  (check-time-has-type loc obj1 (%time-type obj2)) )
    647645
    648646(define (check-time-aritmetic loc tim dur)
     
    653651
    654652(define (tm:time-compare tim1 tim2)
    655   (let ((dif (- (*time-second tim1) (*time-second tim2))))
     653  (let ((dif (- (%time-second tim1) (%time-second tim2))))
    656654    (if (not (zero? dif)) dif
    657         (fx- (*time-nanosecond tim1) (*time-nanosecond tim2)) ) ) )
     655        (%fx- (%time-nanosecond tim1) (%time-nanosecond tim2)) ) ) )
    658656
    659657(define (tm:time=? tim1 tim2)
    660   (and (= (*time-second tim1) (*time-second tim2))
    661        (fx= (*time-nanosecond tim1) (*time-nanosecond tim2))) )
     658  (and (= (%time-second tim1) (%time-second tim2))
     659       (%fx= (%time-nanosecond tim1) (%time-nanosecond tim2))) )
    662660
    663661(define (tm:time<? tim1 tim2)
    664   (or (< (*time-second tim1) (*time-second tim2))
    665       (and (= (*time-second tim1) (*time-second tim2))
    666            (fx< (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     662  (or (< (%time-second tim1) (%time-second tim2))
     663      (and (= (%time-second tim1) (%time-second tim2))
     664           (%fx< (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    667665
    668666(define (tm:time<=? tim1 tim2)
    669   (or (< (*time-second tim1) (*time-second tim2))
    670       (and (= (*time-second tim1) (*time-second tim2))
    671            (fx<= (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     667  (or (< (%time-second tim1) (%time-second tim2))
     668      (and (= (%time-second tim1) (%time-second tim2))
     669           (%fx<= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    672670
    673671(define (tm:time>? tim1 tim2)
    674   (or (> (*time-second tim1) (*time-second tim2))
    675       (and (= (*time-second tim1) (*time-second tim2))
    676            (fx> (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     672  (or (> (%time-second tim1) (%time-second tim2))
     673      (and (= (%time-second tim1) (%time-second tim2))
     674           (%fx> (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    677675
    678676(define (tm:time>=? tim1 tim2)
    679   (or (> (*time-second tim1) (*time-second tim2))
    680       (and (= (*time-second tim1) (*time-second tim2))
    681            (fx>= (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     677  (or (> (%time-second tim1) (%time-second tim2))
     678      (and (= (%time-second tim1) (%time-second tim2))
     679           (%fx>= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    682680
    683681(define (tm:time-max tim1 tim2)
     
    702700
    703701(define (tm:add-duration tim1 dur timout)
    704   (let ((sec-plus (+ (*time-second tim1) (*time-second dur)))
    705         (nsec-plus (+ (*time-nanosecond tim1) (*time-nanosecond dur))) )
     702  (let ((sec-plus (+ (%time-second tim1) (%time-second dur)))
     703        (nsec-plus (+ (%time-nanosecond tim1) (%time-nanosecond dur))) )
    706704    (let ((rem (remainder nsec-plus NS/S))
    707705          (secs (+ sec-plus (quotient nsec-plus NS/S))) )
     
    715713
    716714(define (tm:subtract-duration tim1 dur timout)
    717   (let ((sec-minus (- (*time-second tim1) (*time-second dur)))
    718         (nsec-minus (- (*time-nanosecond tim1) (*time-nanosecond dur))) )
     715  (let ((sec-minus (- (%time-second tim1) (%time-second dur)))
     716        (nsec-minus (- (%time-nanosecond tim1) (%time-nanosecond dur))) )
    719717    (let ((rem (remainder nsec-minus NS/S))
    720718          (secs (- sec-minus (quotient nsec-minus NS/S))) )
     
    742740
    743741(define (tm:time-abs tim1 timout)
    744   (tm:time-second-set! timout (abs (*time-second tim1)))
     742  (tm:time-nanosecond-set! timout (abs (%time-nanosecond tim1)))
     743  (tm:time-second-set! timout (abs (%time-second tim1)))
    745744  timout )
    746745
    747746(define (tm:time-negate tim1 timout)
    748   (tm:time-second-set! timout (- (*time-second tim1)))
     747  (tm:time-nanosecond-set! timout (- (%time-nanosecond tim1)))
     748  (tm:time-second-set! timout (- (%time-second tim1)))
    749749  timout )
    750750
     
    752752
    753753(define (tm:time-tai->time-utc timin timout)
    754   (*time-type-set! timout 'utc)
    755   (tm:time-nanosecond-set! timout (*time-nanosecond timin))
     754  (%time-type-set! timout 'utc)
     755  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    756756  (tm:time-second-set! timout
    757                        (- (*time-second timin)
    758                           (leap-second-neg-delta (*time-second timin))))
     757                       (- (%time-second timin)
     758                          (leap-second-neg-delta (%time-second timin))))
    759759  timout )
    760760
    761761(define (tm:time-tai->time-monotonic timin timout)
    762   (*time-type-set! timout 'monotonic)
    763   (unless (eq? timin timout)
    764     (tm:time-nanosecond-set! timout (*time-nanosecond timin))
    765     (tm:time-second-set! timout (*time-second timin)))
     762  (%time-type-set! timout 'monotonic)
     763  (unless (%eq? timin timout)
     764    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     765    (tm:time-second-set! timout (%time-second timin)))
    766766  timout )
    767767
    768768(define (tm:time-utc->time-tai timin timout)
    769   (*time-type-set! timout 'tai)
    770   (tm:time-nanosecond-set! timout (*time-nanosecond timin))
     769  (%time-type-set! timout 'tai)
     770  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    771771  (tm:time-second-set! timout
    772                        (+ (*time-second timin)
    773                           (leap-second-delta (*time-second timin))))
     772                       (+ (%time-second timin)
     773                          (leap-second-delta (%time-second timin))))
    774774  timout )
    775775
    776776(define (tm:time-utc->time-monotonic timin timout)
    777777  (let ((ntim (tm:time-utc->time-tai timin timout)))
    778     (*time-type-set! ntim 'monotonic)
     778    (%time-type-set! ntim 'monotonic)
    779779    ntim ) )
    780780
    781781(define (tm:time-monotonic->time-tai timin timout)
    782   (*time-type-set! timout 'tai)
    783   (unless (eq? timin timout)
    784     (tm:time-nanosecond-set! timout (*time-nanosecond timin))
    785     (tm:time-second-set! timout (*time-second timin)))
     782  (%time-type-set! timout 'tai)
     783  (unless (%eq? timin timout)
     784    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     785    (tm:time-second-set! timout (%time-second timin)))
    786786  timout )
    787787
    788788(define (tm:time-monotonic->time-utc timin timout)
    789   #;(*time-type-set! timin 'tai) ; fool converter (unnecessary)
     789  #;(%time-type-set! timin 'tai) ; fool converter (unnecessary)
    790790  (tm:time-tai->time-utc timin timout) )
    791791
     
    801801
    802802(define (tm:leap-year? year)
    803   (and (not (fx= (fxmod year 4000) 0)) ;Not officially adopted!
    804        (or (fx= (fxmod year 400) 0)
    805                 (and (fx= (fxmod year 4) 0)
    806                      (not (fx= (fxmod year 100) 0))))) )
     803  (and (not (%fx= (%fxmod year 4000) 0)) ;Not officially adopted!
     804       (or (%fx= (%fxmod year 400) 0)
     805                (and (%fx= (%fxmod year 4) 0)
     806                     (not (%fx= (%fxmod year 100) 0))))) )
    807807
    808808;; Days per Month
     
    812812
    813813(define (tm:days-in-month yr mn)
    814   (vector-ref (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) mn) )
     814  (%vector-ref (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) mn) )
    815815
    816816;;
    817817
    818818(define-record-type/primitive date
    819   (*make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
     819  (%make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
    820820  date?
    821   (ns     *date-nanosecond  *date-nanosecond-set!)
    822   (sec    *date-second      *date-second-set!)
    823   (min    *date-minute      *date-minute-set!)
    824   (hr     *date-hour        *date-hour-set!)
    825   (dy     *date-day         *date-day-set!)
    826   (mn     *date-month       *date-month-set!)
    827   (yr     *date-year        *date-year-set!)
    828   (tzo    *date-zone-offset *date-zone-offset-set!)
     821  (ns     %date-nanosecond  %date-nanosecond-set!)
     822  (sec    %date-second      %date-second-set!)
     823  (min    %date-minute      %date-minute-set!)
     824  (hr     %date-hour        %date-hour-set!)
     825  (dy     %date-day         %date-day-set!)
     826  (mn     %date-month       %date-month-set!)
     827  (yr     %date-year        %date-year-set!)
     828  (tzo    %date-zone-offset %date-zone-offset-set!)
    829829  ;; non-srfi extn
    830   (tzn    *date-zone-name   *date-zone-name-set!)
    831   (dstf   *date-dst?        *date-dst-set!)
    832   (wdy    *date-wday        *date-wday-set!)
    833   (ydy    *date-yday        *date-yday-set!)
    834   (jdy    *date-jday        *date-jday-set!) )
     830  (tzn    %date-zone-name   %date-zone-name-set!)
     831  (dstf   %date-dst?        %date-dst-set!)
     832  (wdy    %date-wday        %date-wday-set!)
     833  (ydy    %date-yday        %date-yday-set!)
     834  (jdy    %date-jday        %date-jday-set!) )
    835835
    836836;;
     
    839839  (format out
    840840   "#,(date ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A)"
    841    (*date-nanosecond dat)
    842    (*date-second dat) (*date-minute dat) (*date-hour dat)
    843    (*date-day dat) (*date-month dat) (*date-year dat)
    844    (*date-zone-offset dat)
    845    (*date-zone-name dat) (*date-dst? dat)
    846    (*date-wday dat) (*date-yday dat) (*date-jday dat)) )
    847 
    848 (define-reader-ctor 'date *make-date)
     841   (%date-nanosecond dat)
     842   (%date-second dat) (%date-minute dat) (%date-hour dat)
     843   (%date-day dat) (%date-month dat) (%date-year dat)
     844   (%date-zone-offset dat)
     845   (%date-zone-name dat) (%date-dst? dat)
     846   (%date-wday dat) (%date-yday dat) (%date-jday dat)) )
     847
     848(define-reader-ctor 'date %make-date)
    849849
    850850; Nanoseconds in [0 NS/S-1]
    851 (define (date-nanoseconds? obj) (and (fixnum? obj) (fx<= 0 obj) (fx< obj NS/S)))
     851(define (date-nanoseconds? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx< obj NS/S)))
    852852
    853853; Seconds in [0 SEC/MIN] ; SEC/MIN legal due to leap second
    854 (define (date-seconds? obj) (and (fixnum? obj) (fx<= 0 obj) (fx<= obj SEC/MIN)))
     854(define (date-seconds? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx<= obj SEC/MIN)))
    855855
    856856; Minutes in [0 SEC/MIN-1]
    857 (define (date-minutes? obj) (and (fixnum? obj) (and (fx<= 0 obj) (fx< obj SEC/MIN))))
     857(define (date-minutes? obj) (and (%fixnum? obj) (and (%fx<= 0 obj) (%fx< obj SEC/MIN))))
    858858
    859859; Hours in [0 HR/DY-1]
    860 (define (date-hours? obj) (and (fixnum? obj) (and (fx<= 0 obj) (fx< obj HR/DY))))
     860(define (date-hours? obj) (and (%fixnum? obj) (and (%fx<= 0 obj) (%fx< obj HR/DY))))
    861861
    862862; Days in [1 28/29/30/31] - depending on month & year
    863 (define (date-day? obj mn yr) (and (fixnum? obj) (fx<= 1 obj) (fx<= obj (tm:days-in-month yr mn))))
     863(define (date-day? obj mn yr) (and (%fixnum? obj) (%fx<= 1 obj) (%fx<= obj (tm:days-in-month yr mn))))
    864864
    865865; Months in [1 MN/YR]
    866 (define (date-month? obj) (and (fixnum? obj) (fx<= 1 obj) (fx<= obj MN/YR)))
     866(define (date-month? obj) (and (%fixnum? obj) (%fx<= 1 obj) (%fx<= obj MN/YR)))
    867867
    868868; No year 0!
    869 (define (date-year? obj) (and (fixnum? obj) (not (fx= 0 obj))))
     869(define (date-year? obj) (and (%fixnum? obj) (not (%fx= 0 obj))))
    870870
    871871;;
     
    897897
    898898(define (check-date-compatible-timezone-offsets loc dat1 dat2)
    899   (unless (fx= (*date-zone-offset dat1) (*date-zone-offset dat2))
     899  (unless (%fx= (%date-zone-offset dat1) (%date-zone-offset dat2))
    900900    (error-date-compatible-timezone loc dat1 dat2) ) )
    901901
    902902;;
    903903
    904 (define (clock-type? obj) (memq obj '(monotonic tai utc)))
     904(define (clock-type? obj) (%memq obj '(monotonic tai utc)))
    905905
    906906(define-check+error-type clock-type)
     
    913913;;
    914914
    915 (define tm:date-nanosecond *date-nanosecond)
    916 (define tm:date-second *date-second)
    917 (define tm:date-minute *date-minute)
    918 (define tm:date-hour *date-hour)
    919 (define tm:date-day *date-day)
    920 (define tm:date-month *date-month)
    921 (define tm:date-year *date-year)
    922 (define tm:date-zone-offset *date-zone-offset)
    923 (define tm:date-zone-name *date-zone-name)
    924 (define tm:date-dst? *date-dst?)
    925 (define tm:date-wday *date-wday)
    926 (define tm:date-yday *date-yday)
    927 (define tm:date-jday *date-jday)
    928 
    929 (define (tm:date-nanosecond-set! dat x) (*date-nanosecond-set! dat (gennum->?fixnum x)))
    930 (define (tm:date-second-set! dat x) (*date-second-set! dat (gennum->?fixnum x)))
    931 (define (tm:date-minute-set! dat x) (*date-minute-set! dat (gennum->?fixnum x)))
    932 (define (tm:date-hour-set! dat x) (*date-hour-set! dat (gennum->?fixnum x)))
    933 (define (tm:date-day-set! dat x) (*date-day-set! dat (gennum->?fixnum x)))
    934 (define (tm:date-month-set! dat x) (*date-month-set! dat (gennum->?fixnum x)))
    935 (define (tm:date-year-set! dat x) (*date-year-set! dat (gennum->?fixnum x)))
    936 (define (tm:date-zone-offset-set! dat x) (*date-zone-offset-set! dat (gennum->?fixnum x)))
     915(define tm:date-nanosecond %date-nanosecond)
     916(define tm:date-second %date-second)
     917(define tm:date-minute %date-minute)
     918(define tm:date-hour %date-hour)
     919(define tm:date-day %date-day)
     920(define tm:date-month %date-month)
     921(define tm:date-year %date-year)
     922(define tm:date-zone-offset %date-zone-offset)
     923(define tm:date-zone-name %date-zone-name)
     924(define tm:date-dst? %date-dst?)
     925(define tm:date-wday %date-wday)
     926(define tm:date-yday %date-yday)
     927(define tm:date-jday %date-jday)
     928
     929(define (tm:date-nanosecond-set! dat x) (%date-nanosecond-set! dat (gennum->?fixnum x)))
     930(define (tm:date-second-set! dat x) (%date-second-set! dat (gennum->?fixnum x)))
     931(define (tm:date-minute-set! dat x) (%date-minute-set! dat (gennum->?fixnum x)))
     932(define (tm:date-hour-set! dat x) (%date-hour-set! dat (gennum->?fixnum x)))
     933(define (tm:date-day-set! dat x) (%date-day-set! dat (gennum->?fixnum x)))
     934(define (tm:date-month-set! dat x) (%date-month-set! dat (gennum->?fixnum x)))
     935(define (tm:date-year-set! dat x) (%date-year-set! dat (gennum->?fixnum x)))
     936(define (tm:date-zone-offset-set! dat x) (%date-zone-offset-set! dat (gennum->?fixnum x)))
    937937
    938938(define (tm:date-timezone-info dat)
    939   (list (*date-zone-name dat) (*date-zone-offset dat) (*date-dst? dat)) )
     939  (list (%date-zone-name dat) (%date-zone-offset dat) (%date-dst? dat)) )
    940940
    941941(define (tm:date-timezone-info-set! dat tzi)
    942   (*date-zone-name-set! dat (car tzi))
    943   (*date-zone-offset-set! dat (cadr tzi))
    944   (*date-dst-set! dat (caddr tzi)) )
     942  (%date-zone-name-set! dat (%car tzi))
     943  (%date-zone-offset-set! dat (%cadr tzi))
     944  (%date-dst-set! dat (%caddr tzi)) )
    945945
    946946;; Returns an invalid date record (for use by 'scan-date')
    947947
    948948(define (tm:make-incomplete-date)
    949   (*make-date
     949  (%make-date
    950950   0
    951951   0 0 0
     
    957957
    958958(define (tm:make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
    959   (*make-date
     959  (%make-date
    960960   (gennum->?fixnum ns)
    961961   (gennum->?fixnum sec) (gennum->?fixnum min) (gennum->?fixnum hr)
     
    965965
    966966(define (tm:copy-date dat)
    967   (*make-date
    968    (*date-nanosecond dat)
    969    (*date-second dat) (*date-minute dat) (*date-hour dat)
    970    (*date-day dat) (*date-month dat) (*date-year dat)
    971    (*date-zone-offset dat)
    972    (*date-zone-name dat) (*date-dst? dat)
    973    (*date-wday dat) (*date-yday dat) (*date-jday dat)) )
     967  (%make-date
     968   (%date-nanosecond dat)
     969   (%date-second dat) (%date-minute dat) (%date-hour dat)
     970   (%date-day dat) (%date-month dat) (%date-year dat)
     971   (%date-zone-offset dat)
     972   (%date-zone-name dat) (%date-dst? dat)
     973   (%date-wday dat) (%date-yday dat) (%date-jday dat)) )
    974974
    975975(define (tm:seconds->date/type sec tzc)
     
    980980    (tm:make-date
    981981     (round (* (- fsec isec) NS/S))
    982      (vector-ref tv 0) (vector-ref tv 1) (vector-ref tv 2)
    983      (vector-ref tv 3) (fx+ 1 (vector-ref tv 4)) (fx+ 1900 (vector-ref tv 5))
     982     (%vector-ref tv 0) (%vector-ref tv 1) (%vector-ref tv 2)
     983     (%vector-ref tv 3) (%fx+ 1 (%vector-ref tv 4)) (%fx+ 1900 (%vector-ref tv 5))
    984984     tzo (timezone-locale-name tzc) (timezone-locale-dst? tzc)
    985      (vector-ref tv 6) (fx+ 1 (vector-ref tv 7)) #f) ) )
     985     (%vector-ref tv 6) (%fx+ 1 (%vector-ref tv 7)) #f) ) )
    986986
    987987(define (tm:current-date tzi) (tm:time-utc->date (tm:current-time-utc) tzi))
     
    990990
    991991(define (tm:date-compare dat1 dat2)
    992   (let ((dif (fx- (*date-year dat1) (*date-year dat2))))
    993     (if (not (fx= 0 dif)) dif
    994         (let ((dif (fx- (*date-month dat1) (*date-month dat2))))
    995           (if (not (fx= 0 dif)) dif
    996               (let ((dif (fx- (*date-day dat1) (*date-day dat2))))
    997                 (if (not (fx= 0 dif)) dif
    998                     (let ((dif (fx- (*date-hour dat1) (*date-hour dat2))))
    999                       (if (not (fx= 0 dif)) dif
    1000                           (let ((dif (fx- (*date-minute dat1) (*date-minute dat2))))
    1001                             (if (not (fx= 0 dif)) dif
    1002                                 (let ((dif (fx- (*date-second dat1) (*date-second dat2))))
    1003                                   (if (not (fx= 0 dif)) dif
    1004                                       (fx- (*date-nanosecond dat1) (*date-nanosecond dat2)) ) ) ) ) ) ) ) ) ) ) ) ) )
     992  (let ((dif (%fx- (%date-year dat1) (%date-year dat2))))
     993    (if (not (%fx= 0 dif)) dif
     994        (let ((dif (%fx- (%date-month dat1) (%date-month dat2))))
     995          (if (not (%fx= 0 dif)) dif
     996              (let ((dif (%fx- (%date-day dat1) (%date-day dat2))))
     997                (if (not (%fx= 0 dif)) dif
     998                    (let ((dif (%fx- (%date-hour dat1) (%date-hour dat2))))
     999                      (if (not (%fx= 0 dif)) dif
     1000                          (let ((dif (%fx- (%date-minute dat1) (%date-minute dat2))))
     1001                            (if (not (%fx= 0 dif)) dif
     1002                                (let ((dif (%fx- (%date-second dat1) (%date-second dat2))))
     1003                                  (if (not (%fx= 0 dif)) dif
     1004                                      (%fx- (%date-nanosecond dat1) (%date-nanosecond dat2)) ) ) ) ) ) ) ) ) ) ) ) ) )
    10051005
    10061006;; Time to Date
    10071007
    1008 (define ONE-SECOND-DURATION (*make-time 'duration 0 1))
     1008(define ONE-SECOND-DURATION (%make-time 'duration 0 1))
    10091009
    10101010;; Gives the seconds/day/month/year
     
    10281028(define (tm:decode-julian-day-number jdn)
    10291029  (let* ((dys (gennum->?fixnum (truncate jdn)))
    1030          (a (fx+ dys 32044))
    1031          (b (fx/ (fx+ (fx* 4 a) 3) 146097))
    1032          (c (fx- a (fx/ (fx* 146097 b) 4)))
    1033          (d (fx/ (fx+ (fx* 4 c) 3) 1461))
    1034          (e (fx- c (fx/ (fx* 1461 d) 4)))
    1035          (m (fx/ (fx+ (fx* 5 e) 2) 153))
    1036          (y (fx+ (fx* 100 b) (fx+ d (fx- (fx/ m 10) JDYR)))))
     1030         (a (%fx+ dys 32044))
     1031         (b (%fx/ (%fx+ (%fx* 4 a) 3) 146097))
     1032         (c (%fx- a (%fx/ (%fx* 146097 b) 4)))
     1033         (d (%fx/ (%fx+ (%fx* 4 c) 3) 1461))
     1034         (e (%fx- c (%fx/ (%fx* 1461 d) 4)))
     1035         (m (%fx/ (%fx+ (%fx* 5 e) 2) 153))
     1036         (y (%fx+ (%fx* 100 b) (%fx+ d (%fx- (%fx/ m 10) JDYR)))))
    10371037    (values ; seconds date month year
    10381038      (gennum->?fixnum (floor (* (- jdn dys) SEC/DY)))
    1039       (fx+ (fx- e (fx/ (fx+ (fx* 153 m) 2) 5)) 1)
    1040       (fx- (fx+ m 3) (fx* (fx/ m 10) MN/YR))
    1041       (if (fx<= y 0) (fx- y 1) y)) ) )
     1039      (%fx+ (%fx- e (%fx/ (%fx+ (%fx* 153 m) 2) 5)) 1)
     1040      (%fx- (%fx+ m 3) (%fx* (%fx/ m 10) MN/YR))
     1041      (if (%fx<= y 0) (%fx- y 1) y)) ) )
    10421042
    10431043;; Gives the Julian day number - rounds up to the nearest day
     
    10491049
    10501050(define (tm:tai-before-leap-second? tim)
    1051   (let ((sec (*time-second tim)))
     1051  (let ((sec (%time-second tim)))
    10521052    (let loop ((ls tm:second-before-leap-second-table))
    1053       (and (not (null? ls))
    1054            (or (= sec (car ls))
    1055                (loop (cdr ls)) ) ) ) ) )
     1053      (and (not (%null? ls))
     1054           (or (= sec (%car ls))
     1055               (loop (%cdr ls)) ) ) ) ) )
    10561056
    10571057#; ;Original
     
    10651065        (set! tzo (timezone-locale-offset tzo)) )
    10661066      (receive (secs dy mn yr)
    1067           (tm:decode-julian-day-number (tm:seconds->julian-day-number (*time-second tim) tzo))
     1067          (tm:decode-julian-day-number (tm:seconds->julian-day-number (%time-second tim) tzo))
    10681068        (let ((hr (quotient secs (* 60 60)))
    10691069              (rem (remainder secs (* 60 60))))
    10701070          (let ((min (quotient rem 60))
    10711071                (sec (remainder rem 60)))
    1072             (tm:make-date (*time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
     1072            (tm:make-date (%time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
    10731073
    10741074(define (tm:time-utc->date tim tzi)
     
    10811081        (set! tzo (timezone-locale-offset tzo)) )
    10821082      (receive (secs dy mn yr)
    1083           (tm:decode-julian-day-number (tm:seconds->julian-day-number (*time-second tim) tzo))
    1084         (let ((hr (fx/ secs SEC/HR))
    1085               (rem (fxmod secs SEC/HR)))
    1086           (let ((min (fx/ rem SEC/MIN))
    1087                 (sec (fxmod rem SEC/MIN)))
    1088             (tm:make-date (*time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
     1083          (tm:decode-julian-day-number (tm:seconds->julian-day-number (%time-second tim) tzo))
     1084        (let ((hr (%fx/ secs SEC/HR))
     1085              (rem (%fxmod secs SEC/HR)))
     1086          (let ((min (%fx/ rem SEC/MIN))
     1087                (sec (%fxmod rem SEC/MIN)))
     1088            (tm:make-date (%time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
    10891089
    10901090(define (tm:time-tai->date tim tzi)
     
    10931093        ; else time is *right* before the leap, we need to pretend to subtract a second ...
    10941094        (let ((dat (tm:time-utc->date (tm:subtract-duration tm-utc ONE-SECOND-DURATION tm-utc) tzi)))
    1095           (*date-second-set! dat SEC/MIN) ; Note full minute!
     1095          (%date-second-set! dat SEC/MIN) ; Note full minute!
    10961096          dat ) ) ) )
    10971097
    10981098(define (tm:time->date tim tzi)
    1099   (case (*time-type tim)
     1099  (case (%time-type tim)
    11001100    ((monotonic) (tm:time-utc->date tim tzi))
    11011101    ((utc)       (tm:time-utc->date tim tzi))
     
    11211121
    11221122(define (tm:encode-julian-day-number dy mn yr)
    1123   (let* ((a (fx/ (fx- 14 mn) MN/YR))
    1124          (b (fx- (fx+ yr JDYR) a))
    1125          (y (if (fx< yr 0) (fx+ b 1) b)) ; BCE?
    1126          (m (fx- (fx+ mn (fx* a MN/YR)) 3)))
     1123  (let* ((a (%fx/ (%fx- 14 mn) MN/YR))
     1124         (b (%fx- (%fx+ yr JDYR) a))
     1125         (y (if (%fx< yr 0) (%fx+ b 1) b)) ; BCE?
     1126         (m (%fx- (%fx+ mn (%fx* a MN/YR)) 3)))
    11271127    (+ dy
    1128        (fx/ (fx+ (fx* 153 m) 2) 5)
    1129        (fx* y DY/YR)
    1130        (fx/ y 4)
    1131        (fx/ y -100)
    1132        (fx/ y 400)
     1128       (%fx/ (%fx+ (%fx* 153 m) 2) 5)
     1129       (%fx* y DY/YR)
     1130       (%fx/ y 4)
     1131       (%fx/ y -100)
     1132       (%fx/ y 400)
    11331133       -32045) ) )
    11341134
    11351135#; ;Original
    11361136(define (tm:date->time-utc dat)
    1137   (let ((ns (*date-nanosecond dat))
    1138         (sec (*date-second dat))
    1139         (min (*date-minute dat))
    1140         (hr (*date-hour dat))
    1141         (dy (*date-day dat))
    1142         (mn (*date-month dat))
    1143         (yr (*date-year dat))
    1144         (tzo (*date-zone-offset dat)) )
     1137  (let ((ns (%date-nanosecond dat))
     1138        (sec (%date-second dat))
     1139        (min (%date-minute dat))
     1140        (hr (%date-hour dat))
     1141        (dy (%date-day dat))
     1142        (mn (%date-month dat))
     1143        (yr (%date-year dat))
     1144        (tzo (%date-zone-offset dat)) )
    11451145    (let ((jdays (- (tm:encode-julian-day-number dy mn yr) TAI-EPOCH-IN-JD))
    11461146          (secs (+ (* hr 60 60) (* min 60) sec (- tzo))) )
     
    11481148
    11491149(define (tm:date->time-utc dat)
    1150   (let ((ns (*date-nanosecond dat))
    1151         (sec (*date-second dat))
    1152         (min (*date-minute dat))
    1153         (hr (*date-hour dat))
    1154         (dy (*date-day dat))
    1155         (mn (*date-month dat))
    1156         (yr (*date-year dat))
    1157         (tzo (*date-zone-offset dat)) )
     1150  (let ((ns (%date-nanosecond dat))
     1151        (sec (%date-second dat))
     1152        (min (%date-minute dat))
     1153        (hr (%date-hour dat))
     1154        (dy (%date-day dat))
     1155        (mn (%date-month dat))
     1156        (yr (%date-year dat))
     1157        (tzo (%date-zone-offset dat)) )
    11581158    (let ((jdys (- (tm:encode-julian-day-number dy mn yr) TAI-EPOCH-IN-JD))
    1159           (secs (fx+ (fx+ (fx* hr SEC/HR) (fx+ (fx* min SEC/MIN) sec)) (fxneg tzo))) )
     1159          (secs (%fx+ (%fx+ (%fx* hr SEC/HR) (%fx+ (%fx* min SEC/MIN) sec)) (%fxneg tzo))) )
    11601160      (tm:make-time 'utc ns (+ (* (- jdys ONE-HALF) SEC/DY) secs)) ) ) )
    11611161
     
    11631163  (let* ((tm-utc (tm:date->time-utc dat))
    11641164         (tm-tai (tm:time-utc->time-tai tm-utc tm-utc)))
    1165     (if (not (fx= SEC/MIN (*date-second dat))) tm-tai
     1165    (if (not (%fx= SEC/MIN (%date-second dat))) tm-tai
    11661166        (tm:subtract-duration tm-tai ONE-SECOND-DURATION tm-tai) ) ) )
    11671167
     
    11801180
    11811181(define (tm:natural-year n tzi)
    1182   (if (or (fx< n 0) (fx>= n 100)) n
    1183       (let* ((current-year (*date-year (tm:current-date tzi)))
    1184              (current-century (fx* (fx/ current-year 100) 100)))
    1185         (if (fx<= (fx- (fx+ current-century n) current-year) 50) (fx+ current-century n)
    1186             (fx+ (fx- current-century 100) n) ) ) ) )
     1182  (if (or (%fx< n 0) (%fx>= n 100)) n
     1183      (let* ((current-year (%date-year (tm:current-date tzi)))
     1184             (current-century (%fx* (%fx/ current-year 100) 100)))
     1185        (if (%fx<= (%fx- (%fx+ current-century n) current-year) 50) (%fx+ current-century n)
     1186            (%fx+ (%fx- current-century 100) n) ) ) ) )
    11871187
    11881188;; Day of Year
     
    11911191
    11921192(define (tm:year-day dy mn yr)
    1193   (let ((yrdy (fx+ dy (vector-ref +cumulative-month-days+ mn))))
    1194     (if (and (tm:leap-year? yr) (fx< 2 mn)) (fx+ yrdy 1)
     1193  (let ((yrdy (%fx+ dy (%vector-ref +cumulative-month-days+ mn))))
     1194    (if (and (tm:leap-year? yr) (%fx< 2 mn)) (%fx+ yrdy 1)
    11951195        yrdy ) ) )
    11961196
    11971197(define (tm:cache-date-year-day dat)
    1198   (let ((yrdy (tm:year-day (*date-day dat) (*date-month dat) (*date-year dat))))
    1199     (*date-yday-set! dat yrdy)
     1198  (let ((yrdy (tm:year-day (%date-day dat) (%date-month dat) (%date-year dat))))
     1199    (%date-yday-set! dat yrdy)
    12001200    yrdy ) )
    12011201
    12021202(define (tm:date-year-day dat)
    1203   (or (*date-yday dat)
     1203  (or (%date-yday dat)
    12041204      (tm:cache-date-year-day dat) ) )
    12051205
    12061206;; Week Day
    12071207
    1208 (define (week-day? obj) (and (fixnum? obj) (fx<= 0 obj) (fx<= obj 6)))
     1208(define (week-day? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx<= obj 6)))
    12091209
    12101210(define-check+error-type week-day)
     
    12131213
    12141214(define (tm:week-day dy mn yr)
    1215   (let* ((a (fx/ (fx- 14 mn) MN/YR))
    1216          (y (fx- yr a))
    1217          (m (fx- (fx+ mn (fx* a MN/YR)) 2)))
    1218     (fxmod (fx+ (fx+ dy y)
    1219                 (fx+ (fx- (fx/ y 4) (fx/ y 100))
    1220                      (fx+ (fx/ y 400)
    1221                           (fx/ (fx* m DY/MN) MN/YR))))
     1215  (let* ((a (%fx/ (%fx- 14 mn) MN/YR))
     1216         (y (%fx- yr a))
     1217         (m (%fx- (%fx+ mn (%fx* a MN/YR)) 2)))
     1218    (%fxmod (%fx+ (%fx+ dy y)
     1219                (%fx+ (%fx- (%fx/ y 4) (%fx/ y 100))
     1220                     (%fx+ (%fx/ y 400)
     1221                          (%fx/ (%fx* m DY/MN) MN/YR))))
    12221222           DY/WK) ) )
    12231223
    12241224(define (tm:cache-date-week-day dat)
    1225   (let ((wdy (tm:week-day (*date-day dat) (*date-month dat) (*date-year dat))))
    1226     (*date-wday-set! dat wdy)
     1225  (let ((wdy (tm:week-day (%date-day dat) (%date-month dat) (%date-year dat))))
     1226    (%date-wday-set! dat wdy)
    12271227    wdy ) )
    12281228
    12291229(define (tm:date-week-day dat)
    1230   (or (*date-wday dat)
     1230  (or (%date-wday dat)
    12311231      (tm:cache-date-week-day dat) ) )
    12321232
    12331233(define (tm:days-before-first-week dat 1st-weekday)
    1234   (fxmod (fx- 1st-weekday (tm:week-day 1 1 (*date-year dat))) DY/WK) )
     1234  (%fxmod (%fx- 1st-weekday (tm:week-day 1 1 (%date-year dat))) DY/WK) )
    12351235
    12361236(define (tm:date-week-number dat 1st-weekday)
    1237   (fx/ (fx- (tm:date-year-day dat) (tm:days-before-first-week dat 1st-weekday))
     1237  (%fx/ (%fx- (tm:date-year-day dat) (tm:days-before-first-week dat 1st-weekday))
    12381238        DY/WK) )
    12391239
     
    12531253(define (tm:julian-day ns sec min hr dy mn yr tzo)
    12541254  (+ (- (tm:encode-julian-day-number dy mn yr) ONE-HALF)
    1255      (/ (+ (fx+ (fx+ (fx* hr SEC/HR)
    1256                      (fx+ (fx* min SEC/MIN) sec))
    1257                 (fxneg tzo))
     1255     (/ (+ (%fx+ (%fx+ (%fx* hr SEC/HR)
     1256                       (%fx+ (%fx* min SEC/MIN) sec))
     1257                (%fxneg tzo))
    12581258           (/ ns NS/S))
    12591259        SEC/DY)) )
     
    12611261#; ; inexact version
    12621262(define (tm:julian-day ns sec min hr dy mn yr tzo)
    1263   (fp+ (fp- (exact->inexact (tm:encode-julian-day-number dy mn yr)) iONE-HALF)
    1264        (fp/ (fp+ (exact->inexact (fx+ (fx+ (fx* hr SEC/HR)
    1265                                            (fx+ (fx* min SEC/MIN) sec))
    1266                                       (fxneg tzo)))
    1267                  (fp/ (exact->inexact ns) iNS/S))
    1268             iSEC/DY)) )
     1263  (%fp+ (%fp- (exact->inexact (tm:encode-julian-day-number dy mn yr)) iONE-HALF)
     1264        (%fp/ (%fp+ (exact->inexact (%fx+ (%fx+ (%fx* hr SEC/HR)
     1265                                                (%fx+ (%fx* min SEC/MIN) sec))
     1266                                          (%fxneg tzo)))
     1267                    (%fp/ (exact->inexact ns) iNS/S))
     1268              iSEC/DY)) )
    12691269
    12701270(define (tm:date->julian-day dat)
    1271   (or (*date-jday dat)
     1271  (or (%date-jday dat)
    12721272      (let ((jdn
    12731273             (tm:julian-day
    1274               (*date-nanosecond dat)
    1275               (*date-second dat) (*date-minute dat) (*date-hour dat)
    1276               (*date-day dat) (*date-month dat) (*date-year dat)
    1277               (*date-zone-offset dat))))
    1278         (*date-jday-set! dat jdn)
     1274              (%date-nanosecond dat)
     1275              (%date-second dat) (%date-minute dat) (%date-hour dat)
     1276              (%date-day dat) (%date-month dat) (%date-year dat)
     1277              (%date-zone-offset dat))))
     1278        (%date-jday-set! dat jdn)
    12791279        jdn ) ) )
    12801280
     
    12831283(define (tm:seconds->julian-day ns sec) (+ TAI-EPOCH-IN-JD (/ (+ sec (/ ns NS/S)) SEC/DY)))
    12841284
    1285 (define-inline (*time-tai->julian-day tim)
    1286   (let ((sec (*time-second tim)))
    1287     (tm:seconds->julian-day (*time-nanosecond tim) (- sec (leap-second-delta sec))) ) )
    1288 
    12891285(define (tm:time-utc->julian-day tim)
    1290   (tm:seconds->julian-day (*time-nanosecond tim) (*time-second tim)) )
    1291 
    1292 (define (tm:time-tai->julian-day tim) (*time-tai->julian-day tim))
    1293 
    1294 (define (tm:time-monotonic->julian-day tim) (*time-tai->julian-day tim))
     1286  (tm:seconds->julian-day (%time-nanosecond tim) (%time-second tim)) )
     1287
     1288(define (tm:time-tai->julian-day tim)
     1289  (let ((sec (%time-second tim)))
     1290    (tm:seconds->julian-day (%time-nanosecond tim) (- sec (leap-second-delta sec))) ) )
     1291
     1292(define (tm:time-monotonic->julian-day tim) tm:time-tai->julian-day)
    12951293
    12961294(define (tm:time->julian-day tim)
    1297   (case (*time-type tim)
     1295  (case (%time-type tim)
    12981296    ((monotonic) (tm:time-monotonic->julian-day tim))
    12991297    ((utc)       (tm:time-utc->julian-day tim))
     
    13111309
    13121310(define (tm:time->modified-julian-day tim)
    1313   (case (*time-type tim)
     1311  (case (%time-type tim)
    13141312    ((monotonic) (tm:time-monotonic->modified-julian-day tim))
    13151313    ((utc)       (tm:time-utc->modified-julian-day tim))
  • release/4/srfi-19/trunk/srfi-19-support.scm

    r15788 r15793  
    331331;; Number of seconds after epoch of first leap year
    332332
    333 (define LEAP-START (fx* (fx- FIRST-LEAP-YEAR TAI-EPOCH-YEAR) (fx* DY/YR SEC/DY)))
     333(define LEAP-START (%fx* (%fx- FIRST-LEAP-YEAR TAI-EPOCH-YEAR) (%fx* DY/YR SEC/DY)))
    334334
    335335;; A table of leap seconds
     
    424424          (_if (r 'if))
    425425          (_null? (r 'null?))
    426           (_car (r 'car))
    427           (_cdr (r 'cdr))
     426          (_%car (r '%car))
     427          (_%cdr (r '%cdr))
    428428          (_leap-second-item (r 'leap-second-item)) )
    429429      (let ((?secs (cadr form))
     
    432432        `(,_let loop ((lsvar ,?ls))
    433433           (,_if (,_null? lsvar) 0
    434                (,_let ((leap-second-item (,_car lsvar)))
    435                  (,_if ,?tst (,_cdr leap-second-item)
    436                      (loop (,_cdr lsvar)) ) ) ) ) ) ) ) )
     434               (,_let ((leap-second-item (,_%car lsvar)))
     435                 (,_if ,?tst (,_%cdr leap-second-item)
     436                     (loop (,_%cdr lsvar)) ) ) ) ) ) ) ) )
    437437
    438438(define-syntax leap-second-delta*
     
    453453(define-inline (leap-second-delta utc-seconds)
    454454  (leap-second-delta* utc-seconds
    455                       (<= (car leap-second-item) utc-seconds)) )
     455                      (<= (%car leap-second-item) utc-seconds)) )
    456456
    457457;; Going from tai seconds to utc seconds ...
     
    459459(define-inline (leap-second-neg-delta tai-seconds)
    460460  (leap-second-delta* tai-seconds
    461                       (<= (cdr leap-second-item) (- tai-seconds (car leap-second-item)))) )
     461                      (<= (%cdr leap-second-item) (- tai-seconds (%car leap-second-item)))) )
    462462
    463463;;; Time Object (Public Mutable)
     
    469469
    470470(define-record-type/primitive time
    471   (*make-time tt ns sec)
     471  (%make-time tt ns sec)
    472472  time?
    473   (tt   *time-type        *time-type-set!)
    474   (ns   *time-nanosecond  *time-nanosecond-set!)
    475   (sec  *time-second      *time-second-set!) )
     473  (tt   %time-type        %time-type-set!)
     474  (ns   %time-nanosecond  %time-nanosecond-set!)
     475  (sec  %time-second      %time-second-set!) )
    476476
    477477;;
    478478
    479479(define-record-printer (time tim out)
    480   (format out "#,(time ~A ~A ~A)" (*time-type tim) (*time-nanosecond tim) (*time-second tim)) )
    481 
    482 (define-reader-ctor 'time *make-time)
    483 
    484 ;;
    485 
    486 (define (time-type? obj) (memq obj '(monotonic utc tai gc duration process thread)))
     480  (format out "#,(time ~A ~A ~A)" (%time-type tim) (%time-nanosecond tim) (%time-second tim)) )
     481
     482(define-reader-ctor 'time %make-time)
     483
     484;;
     485
     486(define (time-type? obj) (%memq obj '(monotonic utc tai gc duration process thread)))
    487487(define (time-seconds? obj) (integer? obj))
    488 (define (time-nanoseconds? obj) (and (fixnum? obj) (fx< -NS/S obj) (fx< obj NS/S)))
     488(define (time-nanoseconds? obj) (and (%fixnum? obj) (%fx< -NS/S obj) (%fx< obj NS/S)))
    489489
    490490;;
     
    499499;Used to create an output time record where all fields will be set later
    500500;
    501 (define (tm:any-time) (*make-time #f #f #f))
     501(define (tm:any-time) (%make-time #f #f #f))
    502502
    503503;Used to create a time record where ns & sec fields will be set later
    504504;
    505 (define (tm:some-time tt) (*make-time tt #f #f))
     505(define (tm:some-time tt) (%make-time tt #f #f))
    506506
    507507;Used to create a time record where ns & sec fields will be set later
    508508;
    509 (define (tm:as-some-time tim) (*make-time (*time-type tim) #f #f))
    510 
    511 ;;
    512 
    513 (define tm:time-type *time-type)
    514 (define tm:time-second *time-second)
    515 (define tm:time-nanosecond *time-nanosecond)
    516 
    517 (define tm:time-type-set! *time-type-set!)
    518 (define (tm:time-nanosecond-set! tim ns) (*time-nanosecond-set! tim (gennum->?fixnum ns)))
    519 (define (tm:time-second-set! tim sec) (*time-second-set! tim (?genint->?fixnum sec)))
    520 
    521 (define (tm:make-time tt ns sec) (*make-time tt (gennum->?fixnum ns) (?genint->?fixnum sec)))
    522 
    523 (define (tm:copy-time tim) (*make-time (*time-type tim) (*time-second tim) (*time-nanosecond tim)))
    524 
    525 (define (tm:time-has-type? tim tt) (eq? tt (*time-type tim)))
     509(define (tm:as-some-time tim) (%make-time (%time-type tim) #f #f))
     510
     511;;
     512
     513(define tm:time-type %time-type)
     514(define tm:time-second %time-second)
     515(define tm:time-nanosecond %time-nanosecond)
     516
     517(define tm:time-type-set! %time-type-set!)
     518(define (tm:time-nanosecond-set! tim ns) (%time-nanosecond-set! tim (gennum->?fixnum ns)))
     519(define (tm:time-second-set! tim sec) (%time-second-set! tim (?genint->?fixnum sec)))
     520
     521(define (tm:make-time tt ns sec) (%make-time tt (gennum->?fixnum ns) (?genint->?fixnum sec)))
     522
     523(define (tm:copy-time tim) (%make-time (%time-type tim) (%time-second tim) (%time-nanosecond tim)))
     524
     525(define (tm:time-has-type? tim tt) (%eq? tt (%time-type tim)))
    526526
    527527;; Rem & Quo of nanoseconds per second
     
    541541;;
    542542
    543 (define (tm:time->nanoseconds tim) (+ (*time-nanosecond tim) (* (*time-second tim) NS/S)))
    544 (define (tm:time->milliseconds tim) (+ (/ (*time-nanosecond tim) NS/MS) (* (*time-second tim) MS/S)))
     543(define (tm:time->nanoseconds tim) (+ (%time-nanosecond tim) (* (%time-second tim) NS/S)))
     544(define (tm:time->milliseconds tim) (+ (/ (%time-nanosecond tim) NS/MS) (* (%time-second tim) MS/S)))
    545545(define (tm:nanoseconds->seconds ns) (/ ns NS/S))
    546546(define (tm:milliseconds->seconds ms) (/ (exact->inexact ms) MS/S))
     
    555555(define (tm:seconds->time-values sec)
    556556  (let* ((tsec (?genint->?fixnum (truncate sec)))
    557          (ns (gennum->?fixnum (round (abs (* (- (exact->inexact sec) tsec) NS/S))))) )
     557         (ns (gennum->?fixnum (exact->inexact (round (* (- sec tsec) NS/S))))) )
    558558      (values ns tsec) ) )
    559559
    560560(define (tm:milliseconds->time-values ms)
    561   (let ((ns (fx* (gennum->?fixnum (remainder ms MS/S)) NS/MS))
     561  (let ((ns (%fx* (gennum->?fixnum (remainder ms MS/S)) NS/MS))
    562562        (sec (quotient ms MS/S)) )
    563563    (values ns sec) ) )
    564564
    565565(define (tm:milliseconds->time ms tt)
    566   (receive (ns sec)
    567       (tm:milliseconds->time-values ms)
     566  (receive (ns sec) (tm:milliseconds->time-values ms)
    568567    (tm:make-time tt ns sec) ) )
    569568
    570569(define (tm:seconds->time sec tt)
    571   (receive (ns sec)
    572       (tm:seconds->time-values sec)
     570  (receive (ns sec) (tm:seconds->time-values sec)
    573571    (tm:make-time tt ns sec) ) )
    574572
     
    578576; Chicken 'current-milliseconds' within positive fixnum range
    579577;
    580 (define (tm:current-sub-milliseconds) (fxmod (current-milliseconds) MS/S))
     578(define (tm:current-sub-milliseconds) (%fxmod (current-milliseconds) MS/S))
    581579(define (tm:current-nanoseconds) (* (tm:current-sub-milliseconds) NS/MS))
    582580
     
    596594  (let ((tim (tm:current-time-tai)))
    597595    ;time-monotonic is time-tai
    598     (*time-type-set! tim 'monotonic)
     596    (%time-type-set! tim 'monotonic)
    599597    tim ) )
    600598
     
    622620(define (check-time-has-type loc tim tt)
    623621  (unless (tm:time-has-type? tim tt)
    624     (error-incompatible-time-types loc (*time-type tim) tt) ) )
     622    (error-incompatible-time-types loc (%time-type tim) tt) ) )
    625623
    626624(define (check-time-and-type loc tim tt)
     
    644642(define (check-time-compare loc obj1 obj2)
    645643  (check-time-binop loc obj1 obj2)
    646   (check-time-has-type loc obj1 (*time-type obj2)) )
     644  (check-time-has-type loc obj1 (%time-type obj2)) )
    647645
    648646(define (check-time-aritmetic loc tim dur)
     
    653651
    654652(define (tm:time-compare tim1 tim2)
    655   (let ((dif (- (*time-second tim1) (*time-second tim2))))
     653  (let ((dif (- (%time-second tim1) (%time-second tim2))))
    656654    (if (not (zero? dif)) dif
    657         (fx- (*time-nanosecond tim1) (*time-nanosecond tim2)) ) ) )
     655        (%fx- (%time-nanosecond tim1) (%time-nanosecond tim2)) ) ) )
    658656
    659657(define (tm:time=? tim1 tim2)
    660   (and (= (*time-second tim1) (*time-second tim2))
    661        (fx= (*time-nanosecond tim1) (*time-nanosecond tim2))) )
     658  (and (= (%time-second tim1) (%time-second tim2))
     659       (%fx= (%time-nanosecond tim1) (%time-nanosecond tim2))) )
    662660
    663661(define (tm:time<? tim1 tim2)
    664   (or (< (*time-second tim1) (*time-second tim2))
    665       (and (= (*time-second tim1) (*time-second tim2))
    666            (fx< (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     662  (or (< (%time-second tim1) (%time-second tim2))
     663      (and (= (%time-second tim1) (%time-second tim2))
     664           (%fx< (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    667665
    668666(define (tm:time<=? tim1 tim2)
    669   (or (< (*time-second tim1) (*time-second tim2))
    670       (and (= (*time-second tim1) (*time-second tim2))
    671            (fx<= (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     667  (or (< (%time-second tim1) (%time-second tim2))
     668      (and (= (%time-second tim1) (%time-second tim2))
     669           (%fx<= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    672670
    673671(define (tm:time>? tim1 tim2)
    674   (or (> (*time-second tim1) (*time-second tim2))
    675       (and (= (*time-second tim1) (*time-second tim2))
    676            (fx> (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     672  (or (> (%time-second tim1) (%time-second tim2))
     673      (and (= (%time-second tim1) (%time-second tim2))
     674           (%fx> (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    677675
    678676(define (tm:time>=? tim1 tim2)
    679   (or (> (*time-second tim1) (*time-second tim2))
    680       (and (= (*time-second tim1) (*time-second tim2))
    681            (fx>= (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
     677  (or (> (%time-second tim1) (%time-second tim2))
     678      (and (= (%time-second tim1) (%time-second tim2))
     679           (%fx>= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )
    682680
    683681(define (tm:time-max tim1 tim2)
     
    702700
    703701(define (tm:add-duration tim1 dur timout)
    704   (let ((sec-plus (+ (*time-second tim1) (*time-second dur)))
    705         (nsec-plus (+ (*time-nanosecond tim1) (*time-nanosecond dur))) )
     702  (let ((sec-plus (+ (%time-second tim1) (%time-second dur)))
     703        (nsec-plus (+ (%time-nanosecond tim1) (%time-nanosecond dur))) )
    706704    (let ((rem (remainder nsec-plus NS/S))
    707705          (secs (+ sec-plus (quotient nsec-plus NS/S))) )
     
    715713
    716714(define (tm:subtract-duration tim1 dur timout)
    717   (let ((sec-minus (- (*time-second tim1) (*time-second dur)))
    718         (nsec-minus (- (*time-nanosecond tim1) (*time-nanosecond dur))) )
     715  (let ((sec-minus (- (%time-second tim1) (%time-second dur)))
     716        (nsec-minus (- (%time-nanosecond tim1) (%time-nanosecond dur))) )
    719717    (let ((rem (remainder nsec-minus NS/S))
    720718          (secs (- sec-minus (quotient nsec-minus NS/S))) )
     
    742740
    743741(define (tm:time-abs tim1 timout)
    744   (tm:time-second-set! timout (abs (*time-second tim1)))
     742  (tm:time-nanosecond-set! timout (abs (%time-nanosecond tim1)))
     743  (tm:time-second-set! timout (abs (%time-second tim1)))
    745744  timout )
    746745
    747746(define (tm:time-negate tim1 timout)
    748   (tm:time-second-set! timout (- (*time-second tim1)))
     747  (tm:time-nanosecond-set! timout (- (%time-nanosecond tim1)))
     748  (tm:time-second-set! timout (- (%time-second tim1)))
    749749  timout )
    750750
     
    752752
    753753(define (tm:time-tai->time-utc timin timout)
    754   (*time-type-set! timout 'utc)
    755   (tm:time-nanosecond-set! timout (*time-nanosecond timin))
     754  (%time-type-set! timout 'utc)
     755  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    756756  (tm:time-second-set! timout
    757                        (- (*time-second timin)
    758                           (leap-second-neg-delta (*time-second timin))))
     757                       (- (%time-second timin)
     758                          (leap-second-neg-delta (%time-second timin))))
    759759  timout )
    760760
    761761(define (tm:time-tai->time-monotonic timin timout)
    762   (*time-type-set! timout 'monotonic)
    763   (unless (eq? timin timout)
    764     (tm:time-nanosecond-set! timout (*time-nanosecond timin))
    765     (tm:time-second-set! timout (*time-second timin)))
     762  (%time-type-set! timout 'monotonic)
     763  (unless (%eq? timin timout)
     764    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     765    (tm:time-second-set! timout (%time-second timin)))
    766766  timout )
    767767
    768768(define (tm:time-utc->time-tai timin timout)
    769   (*time-type-set! timout 'tai)
    770   (tm:time-nanosecond-set! timout (*time-nanosecond timin))
     769  (%time-type-set! timout 'tai)
     770  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    771771  (tm:time-second-set! timout
    772                        (+ (*time-second timin)
    773                           (leap-second-delta (*time-second timin))))
     772                       (+ (%time-second timin)
     773                          (leap-second-delta (%time-second timin))))
    774774  timout )
    775775
    776776(define (tm:time-utc->time-monotonic timin timout)
    777777  (let ((ntim (tm:time-utc->time-tai timin timout)))
    778     (*time-type-set! ntim 'monotonic)
     778    (%time-type-set! ntim 'monotonic)
    779779    ntim ) )
    780780
    781781(define (tm:time-monotonic->time-tai timin timout)
    782   (*time-type-set! timout 'tai)
    783   (unless (eq? timin timout)
    784     (tm:time-nanosecond-set! timout (*time-nanosecond timin))
    785     (tm:time-second-set! timout (*time-second timin)))
     782  (%time-type-set! timout 'tai)
     783  (unless (%eq? timin timout)
     784    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     785    (tm:time-second-set! timout (%time-second timin)))
    786786  timout )
    787787
    788788(define (tm:time-monotonic->time-utc timin timout)
    789   #;(*time-type-set! timin 'tai) ; fool converter (unnecessary)
     789  #;(%time-type-set! timin 'tai) ; fool converter (unnecessary)
    790790  (tm:time-tai->time-utc timin timout) )
    791791
     
    801801
    802802(define (tm:leap-year? year)
    803   (and (not (fx= (fxmod year 4000) 0)) ;Not officially adopted!
    804        (or (fx= (fxmod year 400) 0)
    805                 (and (fx= (fxmod year 4) 0)
    806                      (not (fx= (fxmod year 100) 0))))) )
     803  (and (not (%fx= (%fxmod year 4000) 0)) ;Not officially adopted!
     804       (or (%fx= (%fxmod year 400) 0)
     805                (and (%fx= (%fxmod year 4) 0)
     806                     (not (%fx= (%fxmod year 100) 0))))) )
    807807
    808808;; Days per Month
     
    812812
    813813(define (tm:days-in-month yr mn)
    814   (vector-ref (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) mn) )
     814  (%vector-ref (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) mn) )
    815815
    816816;;
    817817
    818818(define-record-type/primitive date
    819   (*make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
     819  (%make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
    820820  date?
    821   (ns     *date-nanosecond  *date-nanosecond-set!)
    822   (sec    *date-second      *date-second-set!)
    823   (min    *date-minute      *date-minute-set!)
    824   (hr     *date-hour        *date-hour-set!)
    825   (dy     *date-day         *date-day-set!)
    826   (mn     *date-month       *date-month-set!)
    827   (yr     *date-year        *date-year-set!)
    828   (tzo    *date-zone-offset *date-zone-offset-set!)
     821  (ns     %date-nanosecond  %date-nanosecond-set!)
     822  (sec    %date-second      %date-second-set!)
     823  (min    %date-minute      %date-minute-set!)
     824  (hr     %date-hour        %date-hour-set!)
     825  (dy     %date-day         %date-day-set!)
     826  (mn     %date-month       %date-month-set!)
     827  (yr     %date-year        %date-year-set!)
     828  (tzo    %date-zone-offset %date-zone-offset-set!)
    829829  ;; non-srfi extn
    830   (tzn    *date-zone-name   *date-zone-name-set!)
    831   (dstf   *date-dst?        *date-dst-set!)
    832   (wdy    *date-wday        *date-wday-set!)
    833   (ydy    *date-yday        *date-yday-set!)
    834   (jdy    *date-jday        *date-jday-set!) )
     830  (tzn    %date-zone-name   %date-zone-name-set!)
     831  (dstf   %date-dst?        %date-dst-set!)
     832  (wdy    %date-wday        %date-wday-set!)
     833  (ydy    %date-yday        %date-yday-set!)
     834  (jdy    %date-jday        %date-jday-set!) )
    835835
    836836;;
     
    839839  (format out
    840840   "#,(date ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A ~A)"
    841    (*date-nanosecond dat)
    842    (*date-second dat) (*date-minute dat) (*date-hour dat)
    843    (*date-day dat) (*date-month dat) (*date-year dat)
    844    (*date-zone-offset dat)
    845    (*date-zone-name dat) (*date-dst? dat)
    846    (*date-wday dat) (*date-yday dat) (*date-jday dat)) )
    847 
    848 (define-reader-ctor 'date *make-date)
     841   (%date-nanosecond dat)
     842   (%date-second dat) (%date-minute dat) (%date-hour dat)
     843   (%date-day dat) (%date-month dat) (%date-year dat)
     844   (%date-zone-offset dat)
     845   (%date-zone-name dat) (%date-dst? dat)
     846   (%date-wday dat) (%date-yday dat) (%date-jday dat)) )
     847
     848(define-reader-ctor 'date %make-date)
    849849
    850850; Nanoseconds in [0 NS/S-1]
    851 (define (date-nanoseconds? obj) (and (fixnum? obj) (fx<= 0 obj) (fx< obj NS/S)))
     851(define (date-nanoseconds? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx< obj NS/S)))
    852852
    853853; Seconds in [0 SEC/MIN] ; SEC/MIN legal due to leap second
    854 (define (date-seconds? obj) (and (fixnum? obj) (fx<= 0 obj) (fx<= obj SEC/MIN)))
     854(define (date-seconds? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx<= obj SEC/MIN)))
    855855
    856856; Minutes in [0 SEC/MIN-1]
    857 (define (date-minutes? obj) (and (fixnum? obj) (and (fx<= 0 obj) (fx< obj SEC/MIN))))
     857(define (date-minutes? obj) (and (%fixnum? obj) (and (%fx<= 0 obj) (%fx< obj SEC/MIN))))
    858858
    859859; Hours in [0 HR/DY-1]
    860 (define (date-hours? obj) (and (fixnum? obj) (and (fx<= 0 obj) (fx< obj HR/DY))))
     860(define (date-hours? obj) (and (%fixnum? obj) (and (%fx<= 0 obj) (%fx< obj HR/DY))))
    861861
    862862; Days in [1 28/29/30/31] - depending on month & year
    863 (define (date-day? obj mn yr) (and (fixnum? obj) (fx<= 1 obj) (fx<= obj (tm:days-in-month yr mn))))
     863(define (date-day? obj mn yr) (and (%fixnum? obj) (%fx<= 1 obj) (%fx<= obj (tm:days-in-month yr mn))))
    864864
    865865; Months in [1 MN/YR]
    866 (define (date-month? obj) (and (fixnum? obj) (fx<= 1 obj) (fx<= obj MN/YR)))
     866(define (date-month? obj) (and (%fixnum? obj) (%fx<= 1 obj) (%fx<= obj MN/YR)))
    867867
    868868; No year 0!
    869 (define (date-year? obj) (and (fixnum? obj) (not (fx= 0 obj))))
     869(define (date-year? obj) (and (%fixnum? obj) (not (%fx= 0 obj))))
    870870
    871871;;
     
    897897
    898898(define (check-date-compatible-timezone-offsets loc dat1 dat2)
    899   (unless (fx= (*date-zone-offset dat1) (*date-zone-offset dat2))
     899  (unless (%fx= (%date-zone-offset dat1) (%date-zone-offset dat2))
    900900    (error-date-compatible-timezone loc dat1 dat2) ) )
    901901
    902902;;
    903903
    904 (define (clock-type? obj) (memq obj '(monotonic tai utc)))
     904(define (clock-type? obj) (%memq obj '(monotonic tai utc)))
    905905
    906906(define-check+error-type clock-type)
     
    913913;;
    914914
    915 (define tm:date-nanosecond *date-nanosecond)
    916 (define tm:date-second *date-second)
    917 (define tm:date-minute *date-minute)
    918 (define tm:date-hour *date-hour)
    919 (define tm:date-day *date-day)
    920 (define tm:date-month *date-month)
    921 (define tm:date-year *date-year)
    922 (define tm:date-zone-offset *date-zone-offset)
    923 (define tm:date-zone-name *date-zone-name)
    924 (define tm:date-dst? *date-dst?)
    925 (define tm:date-wday *date-wday)
    926 (define tm:date-yday *date-yday)
    927 (define tm:date-jday *date-jday)
    928 
    929 (define (tm:date-nanosecond-set! dat x) (*date-nanosecond-set! dat (gennum->?fixnum x)))
    930 (define (tm:date-second-set! dat x) (*date-second-set! dat (gennum->?fixnum x)))
    931 (define (tm:date-minute-set! dat x) (*date-minute-set! dat (gennum->?fixnum x)))
    932 (define (tm:date-hour-set! dat x) (*date-hour-set! dat (gennum->?fixnum x)))
    933 (define (tm:date-day-set! dat x) (*date-day-set! dat (gennum->?fixnum x)))
    934 (define (tm:date-month-set! dat x) (*date-month-set! dat (gennum->?fixnum x)))
    935 (define (tm:date-year-set! dat x) (*date-year-set! dat (gennum->?fixnum x)))
    936 (define (tm:date-zone-offset-set! dat x) (*date-zone-offset-set! dat (gennum->?fixnum x)))
     915(define tm:date-nanosecond %date-nanosecond)
     916(define tm:date-second %date-second)
     917(define tm:date-minute %date-minute)
     918(define tm:date-hour %date-hour)
     919(define tm:date-day %date-day)
     920(define tm:date-month %date-month)
     921(define tm:date-year %date-year)
     922(define tm:date-zone-offset %date-zone-offset)
     923(define tm:date-zone-name %date-zone-name)
     924(define tm:date-dst? %date-dst?)
     925(define tm:date-wday %date-wday)
     926(define tm:date-yday %date-yday)
     927(define tm:date-jday %date-jday)
     928
     929(define (tm:date-nanosecond-set! dat x) (%date-nanosecond-set! dat (gennum->?fixnum x)))
     930(define (tm:date-second-set! dat x) (%date-second-set! dat (gennum->?fixnum x)))
     931(define (tm:date-minute-set! dat x) (%date-minute-set! dat (gennum->?fixnum x)))
     932(define (tm:date-hour-set! dat x) (%date-hour-set! dat (gennum->?fixnum x)))
     933(define (tm:date-day-set! dat x) (%date-day-set! dat (gennum->?fixnum x)))
     934(define (tm:date-month-set! dat x) (%date-month-set! dat (gennum->?fixnum x)))
     935(define (tm:date-year-set! dat x) (%date-year-set! dat (gennum->?fixnum x)))
     936(define (tm:date-zone-offset-set! dat x) (%date-zone-offset-set! dat (gennum->?fixnum x)))
    937937
    938938(define (tm:date-timezone-info dat)
    939   (list (*date-zone-name dat) (*date-zone-offset dat) (*date-dst? dat)) )
     939  (list (%date-zone-name dat) (%date-zone-offset dat) (%date-dst? dat)) )
    940940
    941941(define (tm:date-timezone-info-set! dat tzi)
    942   (*date-zone-name-set! dat (car tzi))
    943   (*date-zone-offset-set! dat (cadr tzi))
    944   (*date-dst-set! dat (caddr tzi)) )
     942  (%date-zone-name-set! dat (%car tzi))
     943  (%date-zone-offset-set! dat (%cadr tzi))
     944  (%date-dst-set! dat (%caddr tzi)) )
    945945
    946946;; Returns an invalid date record (for use by 'scan-date')
    947947
    948948(define (tm:make-incomplete-date)
    949   (*make-date
     949  (%make-date
    950950   0
    951951   0 0 0
     
    957957
    958958(define (tm:make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
    959   (*make-date
     959  (%make-date
    960960   (gennum->?fixnum ns)
    961961   (gennum->?fixnum sec) (gennum->?fixnum min) (gennum->?fixnum hr)
     
    965965
    966966(define (tm:copy-date dat)
    967   (*make-date
    968    (*date-nanosecond dat)
    969    (*date-second dat) (*date-minute dat) (*date-hour dat)
    970    (*date-day dat) (*date-month dat) (*date-year dat)
    971    (*date-zone-offset dat)
    972    (*date-zone-name dat) (*date-dst? dat)
    973    (*date-wday dat) (*date-yday dat) (*date-jday dat)) )
     967  (%make-date
     968   (%date-nanosecond dat)
     969   (%date-second dat) (%date-minute dat) (%date-hour dat)
     970   (%date-day dat) (%date-month dat) (%date-year dat)
     971   (%date-zone-offset dat)
     972   (%date-zone-name dat) (%date-dst? dat)
     973   (%date-wday dat) (%date-yday dat) (%date-jday dat)) )
    974974
    975975(define (tm:seconds->date/type sec tzc)
     
    980980    (tm:make-date
    981981     (round (* (- fsec isec) NS/S))
    982      (vector-ref tv 0) (vector-ref tv 1) (vector-ref tv 2)
    983      (vector-ref tv 3) (fx+ 1 (vector-ref tv 4)) (fx+ 1900 (vector-ref tv 5))
     982     (%vector-ref tv 0) (%vector-ref tv 1) (%vector-ref tv 2)
     983     (%vector-ref tv 3) (%fx+ 1 (%vector-ref tv 4)) (%fx+ 1900 (%vector-ref tv 5))
    984984     tzo (timezone-locale-name tzc) (timezone-locale-dst? tzc)
    985      (vector-ref tv 6) (fx+ 1 (vector-ref tv 7)) #f) ) )
     985     (%vector-ref tv 6) (%fx+ 1 (%vector-ref tv 7)) #f) ) )
    986986
    987987(define (tm:current-date tzi) (tm:time-utc->date (tm:current-time-utc) tzi))
     
    990990
    991991(define (tm:date-compare dat1 dat2)
    992   (let ((dif (fx- (*date-year dat1) (*date-year dat2))))
    993     (if (not (fx= 0 dif)) dif
    994         (let ((dif (fx- (*date-month dat1) (*date-month dat2))))
    995           (if (not (fx= 0 dif)) dif
    996               (let ((dif (fx- (*date-day dat1) (*date-day dat2))))
    997                 (if (not (fx= 0 dif)) dif
    998                     (let ((dif (fx- (*date-hour dat1) (*date-hour dat2))))
    999                       (if (not (fx= 0 dif)) dif
    1000                           (let ((dif (fx- (*date-minute dat1) (*date-minute dat2))))
    1001                             (if (not (fx= 0 dif)) dif
    1002                                 (let ((dif (fx- (*date-second dat1) (*date-second dat2))))
    1003                                   (if (not (fx= 0 dif)) dif
    1004                                       (fx- (*date-nanosecond dat1) (*date-nanosecond dat2)) ) ) ) ) ) ) ) ) ) ) ) ) )
     992  (let ((dif (%fx- (%date-year dat1) (%date-year dat2))))
     993    (if (not (%fx= 0 dif)) dif
     994        (let ((dif (%fx- (%date-month dat1) (%date-month dat2))))
     995          (if (not (%fx= 0 dif)) dif
     996              (let ((dif (%fx- (%date-day dat1) (%date-day dat2))))
     997                (if (not (%fx= 0 dif)) dif
     998                    (let ((dif (%fx- (%date-hour dat1) (%date-hour dat2))))
     999                      (if (not (%fx= 0 dif)) dif
     1000                          (let ((dif (%fx- (%date-minute dat1) (%date-minute dat2))))
     1001                            (if (not (%fx= 0 dif)) dif
     1002                                (let ((dif (%fx- (%date-second dat1) (%date-second dat2))))
     1003                                  (if (not (%fx= 0 dif)) dif
     1004                                      (%fx- (%date-nanosecond dat1) (%date-nanosecond dat2)) ) ) ) ) ) ) ) ) ) ) ) ) )
    10051005
    10061006;; Time to Date
    10071007
    1008 (define ONE-SECOND-DURATION (*make-time 'duration 0 1))
     1008(define ONE-SECOND-DURATION (%make-time 'duration 0 1))
    10091009
    10101010;; Gives the seconds/day/month/year
     
    10281028(define (tm:decode-julian-day-number jdn)
    10291029  (let* ((dys (gennum->?fixnum (truncate jdn)))
    1030          (a (fx+ dys 32044))
    1031          (b (fx/ (fx+ (fx* 4 a) 3) 146097))
    1032          (c (fx- a (fx/ (fx* 146097 b) 4)))
    1033          (d (fx/ (fx+ (fx* 4 c) 3) 1461))
    1034          (e (fx- c (fx/ (fx* 1461 d) 4)))
    1035          (m (fx/ (fx+ (fx* 5 e) 2) 153))
    1036          (y (fx+ (fx* 100 b) (fx+ d (fx- (fx/ m 10) JDYR)))))
     1030         (a (%fx+ dys 32044))
     1031         (b (%fx/ (%fx+ (%fx* 4 a) 3) 146097))
     1032         (c (%fx- a (%fx/ (%fx* 146097 b) 4)))
     1033         (d (%fx/ (%fx+ (%fx* 4 c) 3) 1461))
     1034         (e (%fx- c (%fx/ (%fx* 1461 d) 4)))
     1035         (m (%fx/ (%fx+ (%fx* 5 e) 2) 153))
     1036         (y (%fx+ (%fx* 100 b) (%fx+ d (%fx- (%fx/ m 10) JDYR)))))
    10371037    (values ; seconds date month year
    10381038      (gennum->?fixnum (floor (* (- jdn dys) SEC/DY)))
    1039       (fx+ (fx- e (fx/ (fx+ (fx* 153 m) 2) 5)) 1)
    1040       (fx- (fx+ m 3) (fx* (fx/ m 10) MN/YR))
    1041       (if (fx<= y 0) (fx- y 1) y)) ) )
     1039      (%fx+ (%fx- e (%fx/ (%fx+ (%fx* 153 m) 2) 5)) 1)
     1040      (%fx- (%fx+ m 3) (%fx* (%fx/ m 10) MN/YR))
     1041      (if (%fx<= y 0) (%fx- y 1) y)) ) )
    10421042
    10431043;; Gives the Julian day number - rounds up to the nearest day
     
    10491049
    10501050(define (tm:tai-before-leap-second? tim)
    1051   (let ((sec (*time-second tim)))
     1051  (let ((sec (%time-second tim)))
    10521052    (let loop ((ls tm:second-before-leap-second-table))
    1053       (and (not (null? ls))
    1054            (or (= sec (car ls))
    1055                (loop (cdr ls)) ) ) ) ) )
     1053      (and (not (%null? ls))
     1054           (or (= sec (%car ls))
     1055               (loop (%cdr ls)) ) ) ) ) )
    10561056
    10571057#; ;Original
     
    10651065        (set! tzo (timezone-locale-offset tzo)) )
    10661066      (receive (secs dy mn yr)
    1067           (tm:decode-julian-day-number (tm:seconds->julian-day-number (*time-second tim) tzo))
     1067          (tm:decode-julian-day-number (tm:seconds->julian-day-number (%time-second tim) tzo))
    10681068        (let ((hr (quotient secs (* 60 60)))
    10691069              (rem (remainder secs (* 60 60))))
    10701070          (let ((min (quotient rem 60))
    10711071                (sec (remainder rem 60)))
    1072             (tm:make-date (*time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
     1072            (tm:make-date (%time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
    10731073
    10741074(define (tm:time-utc->date tim tzi)
     
    10811081        (set! tzo (timezone-locale-offset tzo)) )
    10821082      (receive (secs dy mn yr)
    1083           (tm:decode-julian-day-number (tm:seconds->julian-day-number (*time-second tim) tzo))
    1084         (let ((hr (fx/ secs SEC/HR))
    1085               (rem (fxmod secs SEC/HR)))
    1086           (let ((min (fx/ rem SEC/MIN))
    1087                 (sec (fxmod rem SEC/MIN)))
    1088             (tm:make-date (*time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
     1083          (tm:decode-julian-day-number (tm:seconds->julian-day-number (%time-second tim) tzo))
     1084        (let ((hr (%fx/ secs SEC/HR))
     1085              (rem (%fxmod secs SEC/HR)))
     1086          (let ((min (%fx/ rem SEC/MIN))
     1087                (sec (%fxmod rem SEC/MIN)))
     1088            (tm:make-date (%time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
    10891089
    10901090(define (tm:time-tai->date tim tzi)
     
    10931093        ; else time is *right* before the leap, we need to pretend to subtract a second ...
    10941094        (let ((dat (tm:time-utc->date (tm:subtract-duration tm-utc ONE-SECOND-DURATION tm-utc) tzi)))
    1095           (*date-second-set! dat SEC/MIN) ; Note full minute!
     1095          (%date-second-set! dat SEC/MIN) ; Note full minute!
    10961096          dat ) ) ) )
    10971097
    10981098(define (tm:time->date tim tzi)
    1099   (case (*time-type tim)
     1099  (case (%time-type tim)
    11001100    ((monotonic) (tm:time-utc->date tim tzi))
    11011101    ((utc)       (tm:time-utc->date tim tzi))
     
    11211121
    11221122(define (tm:encode-julian-day-number dy mn yr)
    1123   (let* ((a (fx/ (fx- 14 mn) MN/YR))
    1124          (b (fx- (fx+ yr JDYR) a))
    1125          (y (if (fx< yr 0) (fx+ b 1) b)) ; BCE?
    1126          (m (fx- (fx+ mn (fx* a MN/YR)) 3)))
     1123  (let* ((a (%fx/ (%fx- 14 mn) MN/YR))
     1124         (b (%fx- (%fx+ yr JDYR) a))
     1125         (y (if (%fx< yr 0) (%fx+ b 1) b)) ; BCE?
     1126         (m (%fx- (%fx+ mn (%fx* a MN/YR)) 3)))
    11271127    (+ dy
    1128        (fx/ (fx+ (fx* 153 m) 2) 5)
    1129        (fx* y DY/YR)
    1130        (fx/ y 4)
    1131        (fx/ y -100)
    1132        (fx/ y 400)
     1128       (%fx/ (%fx+ (%fx* 153 m) 2) 5)
     1129       (%fx* y DY/YR)
     1130       (%fx/ y 4)
     1131       (%fx/ y -100)
     1132       (%fx/ y 400)
    11331133       -32045) ) )
    11341134
    11351135#; ;Original
    11361136(define (tm:date->time-utc dat)
    1137   (let ((ns (*date-nanosecond dat))
    1138         (sec (*date-second dat))
    1139         (min (*date-minute dat))
    1140         (hr (*date-hour dat))
    1141         (dy (*date-day dat))
    1142         (mn (*date-month dat))
    1143         (yr (*date-year dat))
    1144         (tzo (*date-zone-offset dat)) )
     1137  (let ((ns (%date-nanosecond dat))
     1138        (sec (%date-second dat))
     1139        (min (%date-minute dat))
     1140        (hr (%date-hour dat))
     1141        (dy (%date-day dat))
     1142        (mn (%date-month dat))
     1143        (yr (%date-year dat))
     1144        (tzo (%date-zone-offset dat)) )
    11451145    (let ((jdays (- (tm:encode-julian-day-number dy mn yr) TAI-EPOCH-IN-JD))
    11461146          (secs (+ (* hr 60 60) (* min 60) sec (- tzo))) )
     
    11481148
    11491149(define (tm:date->time-utc dat)
    1150   (let ((ns (*date-nanosecond dat))
    1151         (sec (*date-second dat))
    1152         (min (*date-minute dat))
    1153         (hr (*date-hour dat))
    1154         (dy (*date-day dat))
    1155         (mn (*date-month dat))
    1156         (yr (*date-year dat))
    1157         (tzo (*date-zone-offset dat)) )
     1150  (let ((ns (%date-nanosecond dat))
     1151        (sec (%date-second dat))
     1152        (min (%date-minute dat))
     1153        (hr (%date-hour dat))
     1154        (dy (%date-day dat))
     1155        (mn (%date-month dat))
     1156        (yr (%date-year dat))
     1157        (tzo (%date-zone-offset dat)) )
    11581158    (let ((jdys (- (tm:encode-julian-day-number dy mn yr) TAI-EPOCH-IN-JD))
    1159           (secs (fx+ (fx+ (fx* hr SEC/HR) (fx+ (fx* min SEC/MIN) sec)) (fxneg tzo))) )
     1159          (secs (%fx+ (%fx+ (%fx* hr SEC/HR) (%fx+ (%fx* min SEC/MIN) sec)) (%fxneg tzo))) )
    11601160      (tm:make-time 'utc ns (+ (* (- jdys ONE-HALF) SEC/DY) secs)) ) ) )
    11611161
     
    11631163  (let* ((tm-utc (tm:date->time-utc dat))
    11641164         (tm-tai (tm:time-utc->time-tai tm-utc tm-utc)))
    1165     (if (not (fx= SEC/MIN (*date-second dat))) tm-tai
     1165    (if (not (%fx= SEC/MIN (%date-second dat))) tm-tai
    11661166        (tm:subtract-duration tm-tai ONE-SECOND-DURATION tm-tai) ) ) )
    11671167
     
    11801180
    11811181(define (tm:natural-year n tzi)
    1182   (if (or (fx< n 0) (fx>= n 100)) n
    1183       (let* ((current-year (*date-year (tm:current-date tzi)))
    1184              (current-century (fx* (fx/ current-year 100) 100)))
    1185         (if (fx<= (fx- (fx+ current-century n) current-year) 50) (fx+ current-century n)
    1186             (fx+ (fx- current-century 100) n) ) ) ) )
     1182  (if (or (%fx< n 0) (%fx>= n 100)) n
     1183      (let* ((current-year (%date-year (tm:current-date tzi)))
     1184             (current-century (%fx* (%fx/ current-year 100) 100)))
     1185        (if (%fx<= (%fx- (%fx+ current-century n) current-year) 50) (%fx+ current-century n)
     1186            (%fx+ (%fx- current-century 100) n) ) ) ) )
    11871187
    11881188;; Day of Year
     
    11911191
    11921192(define (tm:year-day dy mn yr)
    1193   (let ((yrdy (fx+ dy (vector-ref +cumulative-month-days+ mn))))
    1194     (if (and (tm:leap-year? yr) (fx< 2 mn)) (fx+ yrdy 1)
     1193  (let ((yrdy (%fx+ dy (%vector-ref +cumulative-month-days+ mn))))
     1194    (if (and (tm:leap-year? yr) (%fx< 2 mn)) (%fx+ yrdy 1)
    11951195        yrdy ) ) )
    11961196
    11971197(define (tm:cache-date-year-day dat)
    1198   (let ((yrdy (tm:year-day (*date-day dat) (*date-month dat) (*date-year dat))))
    1199     (*date-yday-set! dat yrdy)
     1198  (let ((yrdy (tm:year-day (%date-day dat) (%date-month dat) (%date-year dat))))
     1199    (%date-yday-set! dat yrdy)
    12001200    yrdy ) )
    12011201
    12021202(define (tm:date-year-day dat)
    1203   (or (*date-yday dat)
     1203  (or (%date-yday dat)
    12041204      (tm:cache-date-year-day dat) ) )
    12051205
    12061206;; Week Day
    12071207
    1208 (define (week-day? obj) (and (fixnum? obj) (fx<= 0 obj) (fx<= obj 6)))
     1208(define (week-day? obj) (and (%fixnum? obj) (%fx<= 0 obj) (%fx<= obj 6)))
    12091209
    12101210(define-check+error-type week-day)
     
    12131213
    12141214(define (tm:week-day dy mn yr)
    1215   (let* ((a (fx/ (fx- 14 mn) MN/YR))
    1216          (y (fx- yr a))
    1217          (m (fx- (fx+ mn (fx* a MN/YR)) 2)))
    1218     (fxmod (fx+ (fx+ dy y)
    1219                 (fx+ (fx- (fx/ y 4) (fx/ y 100))
    1220                      (fx+ (fx/ y 400)
    1221                           (fx/ (fx* m DY/MN) MN/YR))))
     1215  (let* ((a (%fx/ (%fx- 14 mn) MN/YR))
     1216         (y (%fx- yr a))
     1217         (m (%fx- (%fx+ mn (%fx* a MN/YR)) 2)))
     1218    (%fxmod (%fx+ (%fx+ dy y)
     1219                (%fx+ (%fx- (%fx/ y 4) (%fx/ y 100))
     1220                     (%fx+ (%fx/ y 400)
     1221                          (%fx/ (%fx* m DY/MN) MN/YR))))
    12221222           DY/WK) ) )
    12231223
    12241224(define (tm:cache-date-week-day dat)
    1225   (let ((wdy (tm:week-day (*date-day dat) (*date-month dat) (*date-year dat))))
    1226     (*date-wday-set! dat wdy)
     1225  (let ((wdy (tm:week-day (%date-day dat) (%date-month dat) (%date-year dat))))
     1226    (%date-wday-set! dat wdy)
    12271227    wdy ) )
    12281228
    12291229(define (tm:date-week-day dat)
    1230   (or (*date-wday dat)
     1230  (or (%date-wday dat)
    12311231      (tm:cache-date-week-day dat) ) )
    12321232
    12331233(define (tm:days-before-first-week dat 1st-weekday)
    1234   (fxmod (fx- 1st-weekday (tm:week-day 1 1 (*date-year dat))) DY/WK) )
     1234  (%fxmod (%fx- 1st-weekday (tm:week-day 1 1 (%date-year dat))) DY/WK) )
    12351235
    12361236(define (tm:date-week-number dat 1st-weekday)
    1237   (fx/ (fx- (tm:date-year-day dat) (tm:days-before-first-week dat 1st-weekday))
     1237  (%fx/ (%fx- (tm:date-year-day dat) (tm:days-before-first-week dat 1st-weekday))
    12381238        DY/WK) )
    12391239
     
    12531253(define (tm:julian-day ns sec min hr dy mn yr tzo)
    12541254  (+ (- (tm:encode-julian-day-number dy mn yr) ONE-HALF)
    1255      (/ (+ (fx+ (fx+ (fx* hr SEC/HR)
    1256                      (fx+ (fx* min SEC/MIN) sec))
    1257                 (fxneg tzo))
     1255     (/ (+ (%fx+ (%fx+ (%fx* hr SEC/HR)
     1256                       (%fx+ (%fx* min SEC/MIN) sec))
     1257                (%fxneg tzo))
    12581258           (/ ns NS/S))
    12591259        SEC/DY)) )
     
    12611261#; ; inexact version
    12621262(define (tm:julian-day ns sec min hr dy mn yr tzo)
    1263   (fp+ (fp- (exact->inexact (tm:encode-julian-day-number dy mn yr)) iONE-HALF)
    1264        (fp/ (fp+ (exact->inexact (fx+ (fx+ (fx* hr SEC/HR)
    1265                                            (fx+ (fx* min SEC/MIN) sec))
    1266                                       (fxneg tzo)))
    1267                  (fp/ (exact->inexact ns) iNS/S))
    1268             iSEC/DY)) )
     1263  (%fp+ (%fp- (exact->inexact (tm:encode-julian-day-number dy mn yr)) iONE-HALF)
     1264        (%fp/ (%fp+ (exact->inexact (%fx+ (%fx+ (%fx* hr SEC/HR)
     1265                                                (%fx+ (%fx* min SEC/MIN) sec))
     1266                                          (%fxneg tzo)))
     1267                    (%fp/ (exact->inexact ns) iNS/S))
     1268              iSEC/DY)) )
    12691269
    12701270(define (tm:date->julian-day dat)
    1271   (or (*date-jday dat)
     1271  (or (%date-jday dat)
    12721272      (let ((jdn
    12731273             (tm:julian-day
    1274               (*date-nanosecond dat)
    1275               (*date-second dat) (*date-minute dat) (*date-hour dat)
    1276               (*date-day dat) (*date-month dat) (*date-year dat)
    1277               (*date-zone-offset dat))))
    1278         (*date-jday-set! dat jdn)
     1274              (%date-nanosecond dat)
     1275              (%date-second dat) (%date-minute dat) (%date-hour dat)
     1276              (%date-day dat) (%date-month dat) (%date-year dat)
     1277              (%date-zone-offset dat))))
     1278        (%date-jday-set! dat jdn)
    12791279        jdn ) ) )
    12801280
     
    12831283(define (tm:seconds->julian-day ns sec) (+ TAI-EPOCH-IN-JD (/ (+ sec (/ ns NS/S)) SEC/DY)))
    12841284
    1285 (define-inline (*time-tai->julian-day tim)
    1286   (let ((sec (*time-second tim)))
    1287     (tm:seconds->julian-day (*time-nanosecond tim) (- sec (leap-second-delta sec))) ) )
    1288 
    12891285(define (tm:time-utc->julian-day tim)
    1290   (tm:seconds->julian-day (*time-nanosecond tim) (*time-second tim)) )
    1291 
    1292 (define (tm:time-tai->julian-day tim) (*time-tai->julian-day tim))
    1293 
    1294 (define (tm:time-monotonic->julian-day tim) (*time-tai->julian-day tim))
     1286  (tm:seconds->julian-day (%time-nanosecond tim) (%time-second tim)) )
     1287
     1288(define (tm:time-tai->julian-day tim)
     1289  (let ((sec (%time-second tim)))
     1290    (tm:seconds->julian-day (%time-nanosecond tim) (- sec (leap-second-delta sec))) ) )
     1291
     1292(define (tm:time-monotonic->julian-day tim) tm:time-tai->julian-day)
    12951293
    12961294(define (tm:time->julian-day tim)
    1297   (case (*time-type tim)
     1295  (case (%time-type tim)
    12981296    ((monotonic) (tm:time-monotonic->julian-day tim))
    12991297    ((utc)       (tm:time-utc->julian-day tim))
     
    13111309
    13121310(define (tm:time->modified-julian-day tim)
    1313   (case (*time-type tim)
     1311  (case (%time-type tim)
    13141312    ((monotonic) (tm:time-monotonic->modified-julian-day tim))
    13151313    ((utc)       (tm:time-utc->modified-julian-day tim))
Note: See TracChangeset for help on using the changeset viewer.