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 Move software-version to misc.lisp The version in misc.lisp can handle all OSes, so remove the different implementations in the foo-os.lisp files in favor of the one in misc.lisp. - - - - - 4 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - src/code/sunos-os.lisp Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -42,32 +42,13 @@ #+executable (register-lisp-runtime-feature :executable) -#+nil -(setq *software-type* #+OpenBSD "OpenBSD" - #+NetBSD "NetBSD" - #+freebsd "FreeBSD" - #+Darwin "Darwin" - #-(or freebsd NetBSD OpenBSD Darwin) "BSD") - -(defvar *software-version* nil "Version string for supporting software") - -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (string-trim '(#\newline) - (with-output-to-string (stream) - (run-program "/usr/bin/uname" - '("-r") - :output stream))))) - *software-version*) -  ;;; OS-Init initializes our operating-system interface. It sets the values ;;; of the global port variables to what they should be and calls the functions ;;; that set up the argument blocks for the server interfaces. (defun os-init () + ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) ;;; GET-SYSTEM-INFO -- Interface ===================================== src/code/linux-os.lisp ===================================== @@ -26,46 +26,11 @@ (register-lisp-feature :elf) (register-lisp-runtime-feature :executable) -;;(setq *software-type* "Linux") - -(defvar *software-version* nil - "Version string for supporting software") - -;;; Instead of reading /proc/version (which has some bugs with -;;; select() in Linux kernel 2.6.x) and instead of running uname -r, -;;; let's just get the info from uname(). -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (multiple-value-bind (sysname nodename release version) - (unix:unix-uname) - (declare (ignore sysname nodename)) - (concatenate 'string release " " version)))) - *software-version*) - -#+nil -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (let (version) - (unwind-protect - (progn - (setf version - (alien:alien-funcall - (alien:extern-alien "os_software_version" - (function (alien:* c-call:c-string))))) - (unless (zerop (sap-int (alien:alien-sap version))) - (alien:cast version c-call:c-string))) - (when version - (alien:free-alien version))))) - *software-version*)) - - ;;; OS-Init initializes our operating-system interface. ;;; -(defun os-init () nil) +(defun os-init () + ;; Decache version on save, because it might not be the same when we restart. + (setf *software-version* nil)) ;;; GET-SYSTEM-INFO -- Interface ===================================== src/code/misc.lisp ===================================== @@ -204,6 +204,26 @@ (alien:free-alien software-type)))))) *software-type*) +(defvar *software-version* nil + _N"Version string for supporting software") + +(defun software-version () + _N"Returns a string describing version of the supporting software." + (unless *software-version* + (setf *software-version* + (let (version) + (unwind-protect + (progn + (setf version + (alien:alien-funcall + (alien:extern-alien "os_software_version" + (function (alien:* c-call:c-string))))) + (unless (zerop (sap-int (alien:alien-sap version))) + (alien:cast version c-call:c-string))) + (when version + (alien:free-alien version))))) + *software-version*)) + (defvar *short-site-name* (intl:gettext "Unknown") "The value of SHORT-SITE-NAME. Set in library:site-init.lisp.") ===================================== src/code/sunos-os.lisp ===================================== @@ -31,21 +31,6 @@ #+executable (register-lisp-runtime-feature :executable) -;;(setq *software-type* "SunOS") - -(defvar *software-version* nil "Version string for supporting software") - -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (multiple-value-bind (sysname nodename release version) - (unix:unix-uname) - (declare (ignore sysname nodename)) - (concatenate 'string release " " version)))) - *software-version*) - - ;;; OS-INIT -- interface. ;;; ;;; Other OS dependent initializations. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b74... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b74... You're receiving this email because of your account on gitlab.common-lisp.net.