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... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3c1f5538b09c6256480aac2c... You're receiving this email because of your account on gitlab.common-lisp.net.