GitLab

at 2023-04-19T14:14:39+00:00

Fix #120: software-version in C

Merge branch 'issue-120-software-type-in-c' into 'master'

Fix #120: software-version in C

Closes #120, #130, #146, #136, #142, #134, and #132

See merge request cmucl/cmucl!93
 		      #+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

 (setq *software-type* "Linux")

-;;; 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."

-  (multiple-value-bind (sysname nodename release version)

-      (unix:unix-uname)

-    (declare (ignore sysname nodename))

-    (concatenate 'string release " " version)))

-

-

 ;;; OS-Init initializes our operating-system interface.

 ;;;

-(defun os-init () nil)

+(defun os-init ()

+  (setf *software-version* nil))

 ;;; GET-PAGE-SIZE  --  Interface

 (in-package "LISP")

 (intl:textdomain "cmucl")

-(export '(documentation *features* variable room

+(export '(*features* variable room

 	  lisp-implementation-type lisp-implementation-version machine-type

 	  machine-version machine-instance software-type software-version

 	  short-site-name long-site-name dribble compiler-macro))

   (unix:unix-gethostname))

 (defvar *software-type* "Unix"

-  "The value of SOFTWARE-TYPE.  Set in FOO-os.lisp.")

+  _N"The value of SOFTWARE-TYPE.  Set in FOO-os.lisp.")

 (defun software-type ()

   "Returns a string describing the supporting software."

   *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 result)

+	    (unwind-protect

+		 (progn

+		   (setf version

+			 (alien:alien-funcall

+			  (alien:extern-alien "os_software_version"

+					      (function (alien:* c-call:c-string)))))

+		   (setf result (alien:cast version c-call:c-string))))

+	    (if (zerop (length result))

+		"Unknown"

+		result)))

+    *software-version*))

+

 (defvar *short-site-name* nil

   "The value of SHORT-SITE-NAME.  Set in library:site-init.lisp.")

 (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.

     * ~~#108~~ Update ASDF.

     * ~~#112~~ CLX can't connect to X server via inet sockets.

     * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF.

-    * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM.

-    * ~~#122~~ gcc 11 can't build cmucl.

-    * ~~#124~~ directory with `:wild-inferiors` doesn't descend subdirectories.

-    * ~~#125~~ Linux `unix-stat` returning incorrect values.

+    * ~~#120~~ `SOFTWARE-VERSION` is implemented in C.

+    * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM

+    * ~~#122~~ gcc 11 can't build cmucl

+    * ~~#124~~ directory with `:wild-inferiors` doesn't descend subdirectories 

+    * ~~#125~~ Linux `unix-stat` returning incorrect values

     * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid.

     * ~~#128~~ `QUIT` accepts an exit code.

     * ~~#130~~ Move file-author to C.

 "Content-Type: text/plain; charset=UTF-8\n"

 "Content-Transfer-Encoding: 8bit\n"

-#: src/code/linux-os.lisp

-msgid "Returns a string describing version of the supporting software."

-msgstr ""

-

 #: src/code/linux-os.lisp

 msgid "Unix system call getrusage failed: ~A."

 msgstr ""

 msgid "Returns a string describing the supporting software."

 msgstr ""

+#: src/code/misc.lisp

+msgid "Version string for supporting software"

+msgstr ""

+

+#: src/code/misc.lisp

+msgid "Returns a string describing version of the supporting software."

+msgstr ""

+

 #: src/code/misc.lisp

 msgid "The value of SHORT-SITE-NAME.  Set in library:site-init.lisp."

 msgstr ""

 #include <string.h>

 #include <sys/resource.h>

 #include <sys/stat.h>

+#include <sys/utsname.h>

 #include <unistd.h>

 #include <time.h>

     return rc;

 }

+/*

+ * Get the software version.  This is the same as "uname -r", the release.

+ * A pointer to a static string is returned. If uname fails, an empty

+ * string is returned.

+ */

+char*

+os_software_version(void)

+{

+    struct utsname uts;

+    int status;

+

+    /*

+     * Buffer large enough to hold the release.

+     */

+    static char result[sizeof(uts.release)];

+    result[0] = '\0';

+

+    status = uname(&uts);

+    if (status == 0) {

+      strcpy(result, uts.release);

+    }

+    return result;

+}

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

8 changed files:

Changes: