├── .gitignore ├── trivial-clock-test.lisp ├── trivial-clock.asd ├── LICENSE ├── .github └── workflows │ ├── CI.yml │ └── BSD.yml ├── trivial-clock.lisp └── README.org /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.fas 3 | -------------------------------------------------------------------------------- /trivial-clock-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; trivial-clock-test.lisp 2 | 3 | (defpackage #:trivial-clock-test 4 | (:use #:cl #:fiveam)) 5 | 6 | (in-package #:trivial-clock-test) 7 | 8 | (def-suite :trivial-clock) 9 | (in-suite :trivial-clock) 10 | 11 | (test now 12 | (let ((unix-time (- (get-universal-time) 13 | trivial-clock:+universal-time-epoch-offset+))) 14 | (multiple-value-bind (seconds nanos) 15 | (trivial-clock:now) 16 | (is (numberp seconds)) 17 | (is (plusp seconds)) 18 | (is (<= unix-time seconds)) 19 | (is (numberp nanos)) 20 | (is (not (minusp nanos))) 21 | (is (<= nanos 999999999))))) 22 | -------------------------------------------------------------------------------- /trivial-clock.asd: -------------------------------------------------------------------------------- 1 | ;;;; trivial-clock.asd 2 | 3 | (asdf:defsystem #:trivial-clock 4 | :description 5 | "Common Lisp library to get accurate wall-clock times on multiple platforms" 6 | :author "Ákos Kiss " 7 | :license "MIT License" 8 | :depends-on (#:cffi) 9 | :components ((:file "trivial-clock")) 10 | :in-order-to ((test-op (test-op "trivial-clock/test")))) 11 | 12 | (asdf:defsystem #:trivial-clock/test 13 | :depends-on (#:trivial-clock 14 | #:fiveam) 15 | :components ((:file "trivial-clock-test")) 16 | :perform (test-op (o c) (symbol-call :fiveam '#:run! :trivial-clock))) 17 | 18 | (asdf:defsystem #:trivial-clock/* 19 | :depends-on (#:trivial-clock 20 | #:trivial-clock/test)) 21 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Ákos Kiss 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.github/workflows/CI.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | paths-ignore: 7 | - 'README.org' 8 | pull_request: 9 | branches: [ "main" ] 10 | workflow_dispatch: 11 | schedule: 12 | - cron: '0 0 1 * *' 13 | 14 | jobs: 15 | test: 16 | name: ${{ matrix.lisp }} on ${{ matrix.os }} 17 | runs-on: ${{ matrix.os }} 18 | strategy: 19 | matrix: 20 | lisp: [sbcl-bin, ccl-bin/1.13, ecl/24.5.10] 21 | os: [ubuntu-latest, windows-latest, macos-latest] 22 | exclude: 23 | - os: windows-latest 24 | lisp: ecl/24.5.10 25 | - os: windows-latest 26 | lisp: ccl-bin/1.13 27 | - os: macos-latest 28 | lisp: ccl-bin/1.13 29 | env: 30 | LISP: ${{ matrix.lisp }} 31 | steps: 32 | - uses: actions/checkout@v4 33 | 34 | - name: Setup Lisp 35 | uses: 40ants/setup-lisp@v4 36 | with: 37 | qlfile-template: | 38 | dist ultralisp http://dist.ultralisp.org 39 | 40 | - name: Run tests (Non-Windows) 41 | if: runner.os != 'Windows' 42 | shell: bash 43 | run: | 44 | ros install neil-lindquist/ci-utils 45 | asdf-register-project 46 | run-fiveam -e t -l trivial-clock/test :trivial-clock 47 | 48 | - name: Run tests (Windows) 49 | if: runner.os == 'Windows' 50 | shell: msys2 {0} 51 | run: | 52 | ros install neil-lindquist/ci-utils 53 | asdf-register-project 54 | run-fiveam -e t -l trivial-clock/test :trivial-clock 55 | -------------------------------------------------------------------------------- /trivial-clock.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:trivial-clock 2 | (:use #:cl) 3 | (:export +universal-time-epoch-offset+ now)) 4 | 5 | (in-package #:trivial-clock) 6 | 7 | (defconstant +universal-time-epoch-offset+ 8 | (encode-universal-time 0 0 0 1 1 1970 0)) 9 | 10 | #+unix 11 | (progn 12 | (cffi:defcstruct timespec 13 | (tv-sec :uint64) 14 | (tv-nsec :uint64)) 15 | 16 | (cffi:defcfun clock-gettime :int 17 | (clock-id :int) 18 | (out-timespec (:pointer (:struct timespec))))) 19 | 20 | #+windows 21 | (progn 22 | (cffi:defcstruct filetime 23 | (low-dt :uint32) 24 | (hi-dt :uint32)) 25 | 26 | (if (cffi:foreign-symbol-pointer "GetSystemTimePreciseAsFileTime") 27 | (cffi:defcfun ("GetSystemTimePreciseAsFileTime" get-system-time) :void 28 | (out-filetime (:pointer (:struct filetime)))) 29 | (cffi:defcfun ("GetSystemTimeAsFileTime" get-system-time) :void 30 | (out-filetime (:pointer (:struct filetime)))))) 31 | 32 | (declaim (inline now) 33 | (ftype (function () (values (unsigned-byte 64) 34 | (integer 0 999999999))) 35 | now)) 36 | (defun now () 37 | "Query OS for current wall-clock time 38 | 39 | Returns number of seconds since the unix epoch and the number of 40 | additional nanoseconds as a second value." 41 | #+unix 42 | (cffi:with-foreign-object (p-timespec '(:struct timespec)) 43 | (clock-gettime 0 p-timespec) ;; Use CLOCK_REALTIME 44 | (cffi:with-foreign-slots ((tv-sec tv-nsec) 45 | p-timespec 46 | (:struct timespec)) 47 | (values tv-sec tv-nsec))) 48 | #+windows 49 | (cffi:with-foreign-object (p-filetime '(:struct filetime)) 50 | (get-system-time p-filetime) 51 | (cffi:with-foreign-slots ((low-dt hi-dt) 52 | p-filetime 53 | (:struct filetime)) 54 | (multiple-value-bind (seconds 100nanos) 55 | (floor (logior (ash hi-dt 32) low-dt) 56 | 10000000) 57 | (values (- seconds 11644473600) (* 100nanos 100))))) 58 | #+nil 59 | (values (- (get-universal-time) 60 | +universal-time-epoch-offset+) 61 | 0)) 62 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * cl-trivial-clock 2 | 3 | #+begin_html 4 |
5 | 6 | 7 | 8 |
9 |

10 | 11 | Build Status 12 | 13 |

14 | #+end_html 15 | 16 | Common Lisp library to get accurate wall-clock times on multiple platforms 17 | 18 | ** Overview 19 | 20 | CL:GET-UNIVERSAL-TIME is limited to returning whole seconds, but some 21 | platforms can provide more accurate clocks. This library aims to wrap 22 | platform-specific system calls for this purpose and fall back on 23 | CL:GET-UNIVERSAL-TIME on any unsupported platform. 24 | 25 | Currently the [[https://man.archlinux.org/man/clock_gettime.2.en][clock_gettime]] call is used (with CLOCK_REALTIME) on all 26 | Unix systems and [[https://learn.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-getsystemtimepreciseasfiletime][GetSystemTimePreciseAsFileTime]] on Windows, except for 27 | Windows versions below version 8 where [[https://learn.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-getsystemtimeasfiletime][GetSystemTimeAsFileTime]] is 28 | used. 29 | 30 | The following software combinations are tested via GitHub actions on 31 | x86-64: 32 | 33 | - [[https://sbcl.org/][SBCL]] (Linux, Windows, macOS, OpenBSD, FreeBSD, DragonflyBSD) 34 | - [[https://ccl.clozure.com/][CCL]] (Linux) 35 | - [[https://ecl.common-lisp.dev/][ECL]] (Linux, macOS, OpenBSD, FreeBSD) 36 | 37 | ** Installation 38 | 39 | cl-trivial-clock can be installed via [[https://www.quicklisp.org/][Quicklisp]]: 40 | 41 | #+begin_src lisp 42 | (ql:quickload :trivial-clock) 43 | #+end_src 44 | 45 | The latest version is available from the [[https://ultralisp.org/][Ultralisp]] distribution: 46 | 47 | #+begin_src lisp 48 | ;; Install the ultralisp distribution if you don't have it already 49 | (ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil) 50 | ;; Load cl-trivial-clock 51 | (ql:quickload :trivial-clock) 52 | #+end_src 53 | 54 | Alternatively you can also rely on [[https://github.com/ocicl/ocicl][ocicl]]. 55 | 56 | ** Usage 57 | 58 | The function NOW returns the number of seconds since the unix epoch 59 | and the number of additional nanoseconds as a second value: 60 | 61 | #+begin_src lisp 62 | ;; Get current wall-clock time: 63 | (trivial-clock:now) 64 | ;; => 1688533183 (31 bits, #x64A4F8BF) 65 | ;; 529460903 (29 bits, #x1F8EEEA7) 66 | #+end_src 67 | 68 | *** Running tests 69 | 70 | - Load the tests via Quicklisp: 71 | 72 | #+begin_src lisp 73 | (ql:quickload :trivial-clock/test) 74 | #+end_src 75 | 76 | - Use [[https://asdf.common-lisp.dev/][ASDF]] or [[https://fiveam.common-lisp.dev/][FiveAM]] to run the tests: 77 | 78 | #+begin_src lisp 79 | ;; Using ASDF: 80 | (asdf:test-system :trivial-clock) 81 | ;; Using FiveAM directly: 82 | (fiveam:run! :trivial-clock) 83 | #+end_src 84 | 85 | ** Legal 86 | 87 | - Released under the MIT License 88 | - [[https://developercertificate.org/][Developer Certificate of Origin]] 89 | - [[https://en.wikipedia.org/wiki/File:Al-jazari_elephant_clock.png][Source]] for README photo 90 | -------------------------------------------------------------------------------- /.github/workflows/BSD.yml: -------------------------------------------------------------------------------- 1 | name: BSD 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | paths-ignore: 7 | - 'README.org' 8 | pull_request: 9 | branches: [ "main" ] 10 | workflow_dispatch: 11 | schedule: 12 | - cron: '0 0 1 * *' 13 | 14 | jobs: 15 | test_freebsd: 16 | name: ${{ matrix.lisp }} on FreeBSD (${{ matrix.arch }}) 17 | runs-on: ubuntu-latest 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | lisp: [sbcl, ccl, ecl] 22 | arch: [x86_64, aarch64] 23 | exclude: 24 | - lisp: sbcl 25 | arch: aarch64 26 | - lisp: ccl 27 | arch: aarch64 28 | 29 | steps: 30 | - uses: actions/checkout@v4 31 | 32 | - name: Run tests on FreeBSD 33 | uses: vmactions/freebsd-vm@v1 34 | with: 35 | release: "15.0" 36 | usesh: true 37 | sync: rsync 38 | copyback: false 39 | prepare: | 40 | sed 's/quarterly/latest/' /etc/pkg/FreeBSD.conf > /tmp/FreeBSD.conf && mv /tmp/FreeBSD.conf /etc/pkg/ 41 | pkg install -y ${{ matrix.lisp }} wget 42 | wget https://beta.quicklisp.org/quicklisp.lisp 43 | ${{ matrix.lisp }} --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 44 | run: | 45 | mkdir -p ~/quicklisp/local-projects/cl-trivial-clock 46 | cp trivial-clock* ~/quicklisp/local-projects/cl-trivial-clock 47 | ${{ matrix.lisp }} --load ~/quicklisp/setup.lisp --eval "(ql:quickload :trivial-clock/test)" --eval "(progn (uiop:quit (if (uiop:symbol-call :fiveam '#:run! :trivial-clock) 0 1)))" 48 | 49 | test_otherbsds: 50 | name: ${{ matrix.lisp }} on other BSDs 51 | runs-on: ubuntu-latest 52 | strategy: 53 | fail-fast: false 54 | matrix: 55 | lisp: [sbcl] 56 | 57 | steps: 58 | - uses: actions/checkout@v4 59 | 60 | - name: Run tests on OpenBSD 61 | uses: vmactions/openbsd-vm@v1 62 | with: 63 | usesh: true 64 | sync: rsync 65 | copyback: false 66 | prepare: | 67 | /usr/sbin/pkg_add ${{ matrix.lisp }} 68 | /usr/sbin/pkg_add wget 69 | wget https://beta.quicklisp.org/quicklisp.lisp 70 | ${{ matrix.lisp }} --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 71 | run: | 72 | mkdir -p ~/quicklisp/local-projects/cl-trivial-clock 73 | cp trivial-clock* ~/quicklisp/local-projects/cl-trivial-clock 74 | ${{ matrix.lisp }} --load ~/quicklisp/setup.lisp --eval "(ql:quickload :trivial-clock/test)" --eval "(progn (uiop:quit (if (uiop:symbol-call :fiveam '#:run! :trivial-clock) 0 1)))" 75 | 76 | - name: Run tests on DragonflyBSD 77 | uses: vmactions/dragonflybsd-vm@v1 78 | continue-on-error: true 79 | with: 80 | usesh: true 81 | sync: rsync 82 | copyback: false 83 | prepare: | 84 | pkg install -y ${{ matrix.lisp }} wget 85 | wget https://beta.quicklisp.org/quicklisp.lisp 86 | ${{ matrix.lisp }} --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 87 | run: | 88 | mkdir -p ~/quicklisp/local-projects/cl-trivial-clock 89 | cp trivial-clock* ~/quicklisp/local-projects/cl-trivial-clock 90 | ${{ matrix.lisp }} --load ~/quicklisp/setup.lisp --eval "(ql:quickload :trivial-clock/test)" --eval "(progn (uiop:quit (if (uiop:symbol-call :fiveam '#:run! :trivial-clock) 0 1)))" 91 | --------------------------------------------------------------------------------