[Git][cmucl/cmucl][issue-120-software-type-in-c] Revert changes to software-type

Raymond Toy (@rtoy) gitlab at common-lisp.net
Sat Mar 25 14:46:38 UTC 2023



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


Commits:
531ea53c by Raymond Toy at 2023-03-25T07:45:14-07:00
Revert changes to software-type

We restore the old code for determining `(software-type)`.  This means
removing the function from os-common.lisp as well.

- - - - -


6 changed files:

- src/code/bsd-os.lisp
- src/code/linux-os.lisp
- src/code/misc.lisp
- src/code/sunos-os.lisp
- src/i18n/locale/cmucl.pot
- src/lisp/os-common.c


Changes:

=====================================
src/code/bsd-os.lisp
=====================================
@@ -42,6 +42,12 @@
 #+executable
 (register-lisp-runtime-feature :executable)
 
+(setq *software-type* #+OpenBSD "OpenBSD"
+                      #+NetBSD "NetBSD"
+                      #+freebsd "FreeBSD"
+		      #+Darwin "Darwin"
+		      #-(or freebsd NetBSD OpenBSD Darwin) "BSD")
+
 
 ;;; 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


=====================================
src/code/linux-os.lisp
=====================================
@@ -26,6 +26,8 @@
 (register-lisp-feature :elf)
 (register-lisp-runtime-feature :executable)
 
+(setq *software-type* "Linux")
+
 ;;; OS-Init initializes our operating-system interface.
 ;;;
 (defun os-init ()


=====================================
src/code/misc.lisp
=====================================
@@ -80,23 +80,11 @@
   "Returns a string giving the name of the local machine."
   (unix:unix-gethostname))
 
-(defvar *software-type* nil
-  _N"The value of SOFTWARE-TYPE.")
+(defvar *software-type* "Unix"
+  _N"The value of SOFTWARE-TYPE.  Set in FOO-os.lisp.")
 
 (defun software-type ()
-  _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)))))))
+  "Returns a string describing the supporting software."
   *software-type*)
 
 (defvar *software-version* nil


=====================================
src/code/sunos-os.lisp
=====================================
@@ -31,6 +31,8 @@
 #+executable
 (register-lisp-runtime-feature :executable)
 
+(setq *software-type* "SunOS")
+
 ;;; OS-INIT -- interface.
 ;;;
 ;;; Other OS dependent initializations.


=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -5632,11 +5632,7 @@ msgid "Returns a string giving the name of the local machine."
 msgstr ""
 
 #: src/code/misc.lisp
-msgid "The value of SOFTWARE-TYPE."
-msgstr ""
-
-#: src/code/misc.lisp
-msgid "Returns a string describing the supporting software."
+msgid "The value of SOFTWARE-TYPE.  Set in FOO-os.lisp."
 msgstr ""
 
 #: src/code/misc.lisp


=====================================
src/lisp/os-common.c
=====================================
@@ -844,20 +844,3 @@ os_software_version(void)
     return result;
 }
 #undef UNAME_RELEASE_AND_VERSION
-
-char*
-os_software_type(void)
-{
-    int status;
-    struct utsname uts;
-    static char os_name[sizeof(uts.sysname)];
-    
-    status = uname(&uts);
-    if (status != 0) {
-        return NULL;
-    }
-    
-    strcpy(os_name, uts.sysname);
-
-    return os_name;
-}



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/531ea53c4501269b59aa81e3bdc70778fd0325ac

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/531ea53c4501269b59aa81e3bdc70778fd0325ac
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/20230325/fbbef9b5/attachment-0001.html>


More information about the cmucl-cvs mailing list