Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl

Commits: 3c1f5538 by Raymond Toy at 2022-08-30T06:27:12-07:00 Implement software-type in C

Add function software-type to misc.lisp, and initialize to *software-type* to NIL so that (software-type) will set it appropriately.

Add function os_software_type to os-common.c that returns the sysname slot of struct utsname. On Linux and macos, this value matches the value that we previously returned.

In linux-os.lisp and bsd-os.lisp, comment out the code that sets *software-type*. (We need to do this for other OSes, still)

- - - - -

4 changed files:

- src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - src/lisp/os-common.c

Changes:

===================================== src/code/bsd-os.lisp ===================================== @@ -42,6 +42,7 @@ #+executable (register-lisp-runtime-feature :executable)

+#+nil (setq *software-type* #+OpenBSD "OpenBSD" #+NetBSD "NetBSD" #+freebsd "FreeBSD"

===================================== src/code/linux-os.lisp ===================================== @@ -26,7 +26,7 @@ (register-lisp-feature :elf) (register-lisp-runtime-feature :executable)

-(setq *software-type* "Linux") +;;(setq *software-type* "Linux")

(defvar *software-version* nil "Version string for supporting software")

===================================== src/code/misc.lisp ===================================== @@ -183,11 +183,25 @@ "Returns a string giving the name of the local machine." (unix:unix-gethostname))

-(defvar *software-type* "Unix" - "The value of SOFTWARE-TYPE. Set in FOO-os.lisp.") +(defvar *software-type* nil + _N"The value of SOFTWARE-TYPE.")

(defun software-type () - "Returns a string describing the supporting software." + _N"Returns a string describing the supporting software." + (unless *software-type* + (setf *software-type* + (let (software-type) + ;; Get the software-type from the C function os_software_type. + (unwind-protect + (progn + (setf software-type + (alien:alien-funcall + (alien:extern-alien "os_software_type" + (function (alien:* c-call:c-string))))) + (unless (zerop (sap-int (alien:alien-sap software-type))) + (alien:cast software-type c-call:c-string))) + (when software-type + (alien:free-alien software-type)))))) *software-type*)

(defvar *short-site-name* (intl:gettext "Unknown")

===================================== src/lisp/os-common.c ===================================== @@ -757,3 +757,23 @@ os_software_version()

return version; } +#undef UNAME_RELEASE_AND_VERSION + +char* +os_software_type() +{ + int status; + struct utsname uts; + char *os_name = NULL; + + status = uname(&uts); + if (status == 0) { + os_name = malloc(strlen(uts.sysname) + 1); + if (os_name) { + strcpy(os_name, uts.sysname); + } + } + + return os_name; +} +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3c1f5538b09c6256480aac2c...