Utility predicates for packing: UNBOUNDED-SC-P and UNBOUNDED-TN-P

[sbcl.git] / src / code / win32-os.lisp

diff --git a/src/code/win32-os.lisp b/src/code/win32-os.lisp
index 1565897..b548905 100644 (file)
--- 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)