diff --git a/.gitignore b/.gitignore index 5d7bec3d..0cd96deb 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +*.*fas* *.fasl *.dfsl *.ppcf @@ -18,4 +19,4 @@ doc/*.fn doc/*.fns doc/*.cp doc/*.cps -doc/*.aux \ No newline at end of file +doc/*.aux diff --git a/src/local-time.lisp b/src/local-time.lisp index 826131d6..d41c549c 100644 --- a/src/local-time.lisp +++ b/src/local-time.lisp @@ -999,6 +999,8 @@ elements." ((filetime (* filetime))) :returning :void)) +#+(or (and allegro os-windows) + (and ccl windows)) (defun filetime-to-current-time (low high) "Convert a Windows time into (values sec nano-sec)." (let* ((unix-epoch-filetime 116444736000000000) @@ -1008,6 +1010,36 @@ elements." (floor filetime #.(round 1e7)) (values secs (* 100ns-periods 100))))) +#+(and lispworks (or linux darwin)) +(progn + (fli:define-c-typedef time-t :long) + (fli:define-c-typedef suseconds-t #+linux :long + #+darwin :int) + + (fli:define-c-struct timeval + (tv-sec time-t) + (tv-usec suseconds-t)) + + (fli:define-foreign-function (gettimeofday/ffi "gettimeofday") + ((tv (:pointer (:struct timeval))) + (tz :pointer)) + :result-type :int) + + (defun lispworks-gettimeofday () + (declare (optimize speed (safety 1))) + (fli:with-dynamic-foreign-objects ((tv (:struct timeval))) + (let ((ret (gettimeofday/ffi tv fli:*null-pointer*))) + (assert (zerop ret) nil "gettimeofday failed") + (let ((secs + (fli:foreign-slot-value tv 'tv-sec + :type 'time-t + :object-type '(:struct timeval))) + (usecs + (fli:foreign-slot-value tv 'tv-usec + :type 'suseconds-t + :object-type '(:struct timeval)))) + (values secs (* 1000 usecs))))))) + (defun %get-current-time () "Cross-implementation abstraction to get the current time measured from the unix epoch (1/1/1970). Should return (values sec nano-sec)." #+(and allegro (not os-windows)) @@ -1054,7 +1086,9 @@ elements." (multiple-value-bind (sec millis) (truncate (java:jstatic "currentTimeMillis" "java.lang.System") 1000) (values sec (* millis 1000000))) - #-(or allegro cmu sbcl abcl ccl) + #+(and lispworks (or linux darwin)) + (lispworks-gettimeofday) + #-(or allegro cmu sbcl abcl ccl (and lispworks (or linux darwin))) (values (- (get-universal-time) ;; CL's get-universal-time uses an epoch of 1/1/1900, so adjust the result to the Unix epoch #.(encode-universal-time 0 0 0 1 1 1970 0))