Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl
Commits:
-
6f25328f
by Raymond Toy at 2022-08-31T08:20:55-07:00
4 changed files:
Changes:
| ... | ... | @@ -42,32 +42,13 @@ |
| 42 | 42 | #+executable
|
| 43 | 43 | (register-lisp-runtime-feature :executable)
|
| 44 | 44 | |
| 45 | -#+nil
|
|
| 46 | -(setq *software-type* #+OpenBSD "OpenBSD"
|
|
| 47 | - #+NetBSD "NetBSD"
|
|
| 48 | - #+freebsd "FreeBSD"
|
|
| 49 | - #+Darwin "Darwin"
|
|
| 50 | - #-(or freebsd NetBSD OpenBSD Darwin) "BSD")
|
|
| 51 | - |
|
| 52 | -(defvar *software-version* nil "Version string for supporting software")
|
|
| 53 | - |
|
| 54 | -(defun software-version ()
|
|
| 55 | - "Returns a string describing version of the supporting software."
|
|
| 56 | - (unless *software-version*
|
|
| 57 | - (setf *software-version*
|
|
| 58 | - (string-trim '(#\newline)
|
|
| 59 | - (with-output-to-string (stream)
|
|
| 60 | - (run-program "/usr/bin/uname"
|
|
| 61 | - '("-r")
|
|
| 62 | - :output stream)))))
|
|
| 63 | - *software-version*)
|
|
| 64 | - |
|
| 65 | 45 | |
| 66 | 46 | ;;; OS-Init initializes our operating-system interface. It sets the values
|
| 67 | 47 | ;;; of the global port variables to what they should be and calls the functions
|
| 68 | 48 | ;;; that set up the argument blocks for the server interfaces.
|
| 69 | 49 | |
| 70 | 50 | (defun os-init ()
|
| 51 | + ;; Decache version on save, because it might not be the same when we restart.
|
|
| 71 | 52 | (setf *software-version* nil))
|
| 72 | 53 | |
| 73 | 54 | ;;; GET-SYSTEM-INFO -- Interface
|
| ... | ... | @@ -26,46 +26,11 @@ |
| 26 | 26 | (register-lisp-feature :elf)
|
| 27 | 27 | (register-lisp-runtime-feature :executable)
|
| 28 | 28 | |
| 29 | -;;(setq *software-type* "Linux")
|
|
| 30 | - |
|
| 31 | -(defvar *software-version* nil
|
|
| 32 | - "Version string for supporting software")
|
|
| 33 | - |
|
| 34 | -;;; Instead of reading /proc/version (which has some bugs with
|
|
| 35 | -;;; select() in Linux kernel 2.6.x) and instead of running uname -r,
|
|
| 36 | -;;; let's just get the info from uname().
|
|
| 37 | -(defun software-version ()
|
|
| 38 | - "Returns a string describing version of the supporting software."
|
|
| 39 | - (unless *software-version*
|
|
| 40 | - (setf *software-version*
|
|
| 41 | - (multiple-value-bind (sysname nodename release version)
|
|
| 42 | - (unix:unix-uname)
|
|
| 43 | - (declare (ignore sysname nodename))
|
|
| 44 | - (concatenate 'string release " " version))))
|
|
| 45 | - *software-version*)
|
|
| 46 | - |
|
| 47 | -#+nil
|
|
| 48 | -(defun software-version ()
|
|
| 49 | - "Returns a string describing version of the supporting software."
|
|
| 50 | - (unless *software-version*
|
|
| 51 | - (setf *software-version*
|
|
| 52 | - (let (version)
|
|
| 53 | - (unwind-protect
|
|
| 54 | - (progn
|
|
| 55 | - (setf version
|
|
| 56 | - (alien:alien-funcall
|
|
| 57 | - (alien:extern-alien "os_software_version"
|
|
| 58 | - (function (alien:* c-call:c-string)))))
|
|
| 59 | - (unless (zerop (sap-int (alien:alien-sap version)))
|
|
| 60 | - (alien:cast version c-call:c-string)))
|
|
| 61 | - (when version
|
|
| 62 | - (alien:free-alien version)))))
|
|
| 63 | - *software-version*))
|
|
| 64 | - |
|
| 65 | - |
|
| 66 | 29 | ;;; OS-Init initializes our operating-system interface.
|
| 67 | 30 | ;;;
|
| 68 | -(defun os-init () nil)
|
|
| 31 | +(defun os-init ()
|
|
| 32 | + ;; Decache version on save, because it might not be the same when we restart.
|
|
| 33 | + (setf *software-version* nil))
|
|
| 69 | 34 | |
| 70 | 35 | |
| 71 | 36 | ;;; GET-SYSTEM-INFO -- Interface
|
| ... | ... | @@ -204,6 +204,26 @@ |
| 204 | 204 | (alien:free-alien software-type))))))
|
| 205 | 205 | *software-type*)
|
| 206 | 206 | |
| 207 | +(defvar *software-version* nil
|
|
| 208 | + _N"Version string for supporting software")
|
|
| 209 | + |
|
| 210 | +(defun software-version ()
|
|
| 211 | + _N"Returns a string describing version of the supporting software."
|
|
| 212 | + (unless *software-version*
|
|
| 213 | + (setf *software-version*
|
|
| 214 | + (let (version)
|
|
| 215 | + (unwind-protect
|
|
| 216 | + (progn
|
|
| 217 | + (setf version
|
|
| 218 | + (alien:alien-funcall
|
|
| 219 | + (alien:extern-alien "os_software_version"
|
|
| 220 | + (function (alien:* c-call:c-string)))))
|
|
| 221 | + (unless (zerop (sap-int (alien:alien-sap version)))
|
|
| 222 | + (alien:cast version c-call:c-string)))
|
|
| 223 | + (when version
|
|
| 224 | + (alien:free-alien version)))))
|
|
| 225 | + *software-version*))
|
|
| 226 | + |
|
| 207 | 227 | (defvar *short-site-name* (intl:gettext "Unknown")
|
| 208 | 228 | "The value of SHORT-SITE-NAME. Set in library:site-init.lisp.")
|
| 209 | 229 |
| ... | ... | @@ -31,21 +31,6 @@ |
| 31 | 31 | #+executable
|
| 32 | 32 | (register-lisp-runtime-feature :executable)
|
| 33 | 33 | |
| 34 | -;;(setq *software-type* "SunOS")
|
|
| 35 | - |
|
| 36 | -(defvar *software-version* nil "Version string for supporting software")
|
|
| 37 | - |
|
| 38 | -(defun software-version ()
|
|
| 39 | - "Returns a string describing version of the supporting software."
|
|
| 40 | - (unless *software-version*
|
|
| 41 | - (setf *software-version*
|
|
| 42 | - (multiple-value-bind (sysname nodename release version)
|
|
| 43 | - (unix:unix-uname)
|
|
| 44 | - (declare (ignore sysname nodename))
|
|
| 45 | - (concatenate 'string release " " version))))
|
|
| 46 | - *software-version*)
|
|
| 47 | - |
|
| 48 | - |
|
| 49 | 34 | ;;; OS-INIT -- interface.
|
| 50 | 35 | ;;;
|
| 51 | 36 | ;;; Other OS dependent initializations.
|