From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 14 May 2018 03:06:41 +0000 (-0700)
Subject: Implement CURRENT-SECOND for R7RS.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~46
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5b1bfd0ea43e13b46a5a7be83eb97fa813fbd0d8;p=mit-scheme.git

Implement CURRENT-SECOND for R7RS.
---

diff --git a/src/runtime/datime.scm b/src/runtime/datime.scm
index 2cdeb9afc..f3e9d13e4 100644
--- a/src/runtime/datime.scm
+++ b/src/runtime/datime.scm
@@ -166,6 +166,9 @@ USA.
 
 (define epoch 2208988800)
 
+(define (current-second)
+  (exact->inexact ((ucode-primitive encoded-time 0))))
+
 (define (local-decoded-time)
   (universal-time->local-decoded-time (get-universal-time)))
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 327546925..c27f52229 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1650,6 +1650,7 @@ USA.
 	  ctime-string->decoded-time
 	  ctime-string->file-time
 	  ctime-string->universal-time
+	  current-second		;R7RS
 	  day-of-week/long-string
 	  day-of-week/short-string
 	  decoded-time->ctime-string