[Git][cmucl/cmucl][issue-120-software-type-in-c] Move software-version to misc.lisp

[Raymond Toy (@rtoy)]

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/6f25328fd2f67d8119ff3b74b1bc7389fb1a09be

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b74b1bc7389fb1a09be
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20220831/5998da80/attachment-0001.html>