;;870 IBM EBCDIC - Multilingual/ROECE (Latin-2)
(874 :CP874) ;; ANSI/OEM - Thai (same as 28605, ISO 8859-15)
;;875 IBM EBCDIC - Modern Greek
- ;;932 ANSI/OEM - Japanese, Shift-JIS
+ (932 :CP932) ;; ANSI/OEM - Japanese, Shift-JIS
;;936 ANSI/OEM - Simplified Chinese (PRC, Singapore)
;;949 ANSI/OEM - Korean (Unified Hangul Code)
;;950 ANSI/OEM - Traditional Chinese (Taiwan; Hong Kong SAR, PRC)
;;;; Process time information
+(defconstant 100ns-per-internal-time-unit
+ (/ 10000000 sb!xc:internal-time-units-per-second))
+
;; FILETIME
;; The FILETIME structure is a 64-bit value representing the number of
;; 100-nanosecond intervals since January 1, 1601 (UTC).
;; http://msdn.microsoft.com/library/en-us/sysinfo/base/filetime_str.asp?
(define-alien-type FILETIME (sb!alien:unsigned 64))
-(defun get-process-times ()
- (with-alien ((creation-time filetime)
- (exit-time filetime)
- (kernel-time filetime)
- (user-time filetime))
- (syscall* (("GetProcessTimes" 20) handle (* filetime) (* filetime)
- (* filetime) (* filetime))
- (values creation-time
- exit-time
- kernel-time
- user-time)
- (get-current-process)
- (addr creation-time)
- (addr exit-time)
- (addr kernel-time)
- (addr user-time))))
+(defmacro with-process-times ((creation-time exit-time kernel-time user-time)
+ &body forms)
+ `(with-alien ((,creation-time filetime)
+ (,exit-time filetime)
+ (,kernel-time filetime)
+ (,user-time filetime))
+ (syscall* (("GetProcessTimes" 20) handle (* filetime) (* filetime)
+ (* filetime) (* filetime))
+ (progn ,@forms)
+ (get-current-process)
+ (addr ,creation-time)
+ (addr ,exit-time)
+ (addr ,kernel-time)
+ (addr ,user-time))))
+
+(declaim (inline system-internal-real-time))
+
+(let ((epoch 0))
+ (declare (unsigned-byte epoch))
+ ;; FIXME: For optimization ideas see the unix implementation.
+ (defun reinit-internal-real-time ()
+ (setf epoch 0
+ epoch (get-internal-real-time)))
+ (defun get-internal-real-time ()
+ (- (with-alien ((system-time filetime))
+ (syscall (("GetSystemTimeAsFileTime" 4) void (* filetime))
+ (values (floor system-time 100ns-per-internal-time-unit))
+ (addr system-time)))
+ epoch)))
+
+(defun system-internal-run-time ()
+ (with-process-times (creation-time exit-time kernel-time user-time)
+ (values (floor (+ user-time kernel-time) 100ns-per-internal-time-unit))))
+
+(define-alien-type hword (unsigned 16))
+
+(define-alien-type systemtime
+ (struct systemtime
+ (year hword)
+ (month hword)
+ (weekday hword)
+ (day hword)
+ (hour hword)
+ (minute hword)
+ (second hword)
+ (millisecond hword)))
+
+;; Obtained with, but the XC can't deal with that -- but
+;; it's not like the value is ever going to change...
+;; (with-alien ((filetime filetime)
+;; (epoch systemtime))
+;; (setf (slot epoch 'year) 1970
+;; (slot epoch 'month) 1
+;; (slot epoch 'day) 1
+;; (slot epoch 'hour) 0
+;; (slot epoch 'minute) 0
+;; (slot epoch 'second) 0
+;; (slot epoch 'millisecond) 0)
+;; (syscall (("SystemTimeToFileTime" 8) void
+;; (* systemtime) (* filetime))
+;; filetime
+;; (addr epoch)
+;; (addr filetime)))
+(defconstant +unix-epoch-filetime+ 116444736000000000)
+
+#!-sb-fluid
+(declaim (inline get-time-of-day))
+(defun get-time-of-day ()
+ "Return the number of seconds and microseconds since the beginning of the
+UNIX epoch: January 1st 1970."
+ (with-alien ((system-time filetime))
+ (syscall (("GetSystemTimeAsFileTime" 4) void (* filetime))
+ (multiple-value-bind (sec 100ns)
+ (floor (- system-time +unix-epoch-filetime+)
+ (* 100ns-per-internal-time-unit
+ internal-time-units-per-second))
+ (values sec (floor 100ns 10)))
+ (addr system-time))))
;; SETENV
;; The SetEnvironmentVariable function sets the contents of the specified