X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32-os.lisp;h=b5489051497f6240fb8fbec2cdb3a09c5da17956;hb=6e60dc9f79037ab84f5bfd8568979c24291c9922;hp=15658978bf001040a0cbff4a950b753a452001cf;hpb=7fb597b585fc715537ea644f7d84440eca217ca1;p=sbcl.git diff --git a/src/code/win32-os.lisp b/src/code/win32-os.lisp index 1565897..b548905 100644 --- a/src/code/win32-os.lisp +++ b/src/code/win32-os.lisp @@ -20,42 +20,25 @@ "Return a string describing the supporting software." (values "Win32")) -(defvar *software-version* nil) - (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL if not available." - nil ;; FIXME: Implement. - #+nil(or *software-version* + (or *software-version* (setf *software-version* - (string-trim '(#\newline) - (with-output-to-string (stream) - (sb!ext:run-program "/bin/uname" `("-r") - :output stream)))))) - -(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here - (/show0 "entering win32-os.lisp OS-COLD-INIT-OR-REINIT") - (setf *software-version* nil) - (/show0 "setting *DEFAULT-PATHNAME-DEFAULTS*") - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when - ;; we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/))) - (/show0 "leaving linux-os.lisp OS-COLD-INIT-OR-REINIT")) - -;;; Return system time, user time and number of page faults. + (multiple-value-bind + (major-version minor-version build-number platform-id csd-version) + (sb!win32:get-version-ex) + (declare (ignore platform-id)) + (format nil (if (zerop (length csd-version)) + "~A.~A.~A" + "~A.~A.~A (~A)") + major-version minor-version build-number csd-version))))) + +;;; Return user time, system time, and number of page faults. (defun get-system-info () -#+nil (multiple-value-bind - (err? utime stime maxrss ixrss idrss isrss minflt majflt) - (sb!unix:unix-getrusage sb!unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (unless err? ; FIXME: nonmnemonic (reversed) name for ERR? - (error "Unix system call getrusage failed: ~A." (strerror utime))) - (values utime stime majflt))) + (sb!win32:with-process-times (creation-time exit-time kernel-time user-time) + (values (floor user-time 10) (floor kernel-time 10) 0))) ;;; Return the system page size. (defun get-page-size () @@ -63,3 +46,7 @@ ;; FIXME: Or we could just get rid of this, since the uses of it look ;; disposable. 4096) + +;;; support for CL:MACHINE-VERSION defined OAOO elsewhere +(defun get-machine-version () + nil)