Started work on posix-time

srfi/170.scm

@@ -47,6 +47,7 @@
 (define-c-procedure c-link libc 'link 'int '(pointer pointer))
 (define-c-procedure c-slink libc 'link 'int '(pointer pointer))
 (define-c-procedure c-chown libc 'chown 'int '(pointer int int))
+(define-c-procedure c-clock-gettime libc 'clock_gettime 'int '(int pointer))
 
 (define slash (cond-expand (windows "\\") (else "/")))
 (define randomized? #f)
@@ -450,3 +451,34 @@
 
 (define (delete-environment-variable! name)
   (c-unsetenv (string->c-bytevector name)))
+
+(define CLOCK_REALTIME 0)
+(define CLOCK_MONOTONIC 1)
+(define tv_sec-type 'long)
+(define tv_nsec-type 'long)
+(define timespec (make-c-bytevector (c-type-size+ tv_sec-type tv_nsec-type)))
+(define (posix-time)
+  (let* ((result (c-clock-gettime CLOCK_REALTIME timespec)))
+    (cond
+      ((< result 0)
+       (let* ((error-message "posix-time error")
+              (error-pointer (string->c-bytevector error-message)))
+         (c-perror error-pointer)
+         (c-bytevector-free timespec)
+         (c-bytevector-free error-pointer)
+         (error error-message)))
+      (else
+        (let* ((tv-sec (c-bytevector-ref timespec tv_sec-type 0))
+               (tv-nsec (c-bytevector-ref timespec
+                                                 tv_nsec-type
+                                                 (c-type-size tv_sec-type)))
+               (time (make-time time-utc tv-sec tv-nsec)))
+          (display "HERE: tv-sec ")
+          (write tv-sec)
+          (newline)
+          (display "HERE: tv-nsec ")
+          (write tv-nsec)
+          (newline)
+          time
+          )))
+  ))

srfi/170.sld

@@ -5,7 +5,8 @@
           (scheme write)
           (scheme file)
           (scheme process-context)
-          (foreign c))
+          (foreign c)
+          (srfi 19))
   (export ;posix-error?
           ;posix-error-name
           ;posix-error-message
@@ -77,7 +78,7 @@
           group-info?
           group-info:name
           group-info:gid
-          ;posix-time
+          posix-time
           ;monotonic-time
           set-environment-variable!
           delete-environment-variable!

srfi/170/README.md

@@ -1,83 +1,5 @@
-Implementation of [SRFI 170](https://srfi.schemers.org/srfi-170/srfi-170.html)
-POSIX API using (foreign c)].
+Implementation of SRFI 170 - POSIX API using (foreign c)
 
 Currently only supports Linux.
 
-Uncommented things here are implemented.
-
-    ;;;;posix-error?
-    ;;;;posix-error-name
-    ;;;;posix-error-message
-    ;;;;open-file
-    ;;;;fd->port
-    create-directory
-    ;;;;create-fifo
-    create-hard-link
-    create-symlink
-    ;;;;read-symlink
-    ;;;;rename-file
-    delete-directory
-    ;;;;set-file-owner
-    ;;;;set-file-times
-    ;;;;truncate-file
-    file-info
-    file-info?
-    ;;;;file-info:device
-    ;;;;file-info:inode
-    ;;;;file-info:mode
-    ;;;;file-info:nlinks
-    ;;;;file-info:uid
-    ;;;;file-info:gid
-    ;;;;file-info:rdev
-    ;;;;file-info:size
-    ;;;;file-info:blksize
-    ;;;;file-info:blocks
-    ;;;;file-info:atime
-    ;;;;file-info:mtime
-    ;;;;file-info:ctime
-    file-info-directory?
-    ;;;;file-info-fifo?
-    ;;;;file-info-symlink?
-    ;;;;file-info-regular?
-    ;;;;file-info-socket?
-    ;;;;file-info-device?
-    set-file-mode
-    directory-files
-    ;;;;make-directory-files-generator
-    open-directory
-    read-directory
-    close-directory
-    real-path
-    ;;;;file-space
-    temp-file-prefix
-    create-temp-file
-    call-with-temporary-filename
-    ;;;;umask
-    ;;;;set-umask!
-    current-directory
-    set-current-directory!
-    pid
-    ;;;;nice
-    user-uid
-    user-gid
-    user-effective-uid
-    user-effective-gid
-    user-supplementary-gids
-    user-info
-    user-info?
-    user-info:name
-    user-info:uid
-    user-info:gid
-    user-info:home-dir
-    user-info:shell
-    user-info:full-name
-    ;;;;user-info:parsed-full-name
-    group-info
-    group-info?
-    group-info:name
-    group-info:gid
-    ;;;;posix-time
-    ;;;;monotonic-time
-    set-environment-variable!
-    delete-environment-variable!
-    ;;;;terminal?
+Not everything is implemented yet, see 170.sld for commented out parts