From 54f85917b50a0b0507047228fa8765ba1a524bc6 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Thu, 25 Jun 2026 21:34:10 +0300 Subject: [PATCH] Started work on posix-time --- srfi/170.scm | 32 ++++++++++++++++++ srfi/170.sld | 5 +-- srfi/170/README.md | 82 ++-------------------------------------------- 3 files changed, 37 insertions(+), 82 deletions(-) diff --git a/srfi/170.scm b/srfi/170.scm index ffaa50f..3310276 100644 --- a/srfi/170.scm +++ b/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 + ))) + )) diff --git a/srfi/170.sld b/srfi/170.sld index 898cead..cb27df2 100644 --- a/srfi/170.sld +++ b/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! diff --git a/srfi/170/README.md b/srfi/170/README.md index 9d09ba4..61412ee 100644 --- a/srfi/170/README.md +++ b/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