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
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:
| ... | ... | @@ -42,6 +42,12 @@ |
| 42 | 42 | #+executable
|
| 43 | 43 | (register-lisp-runtime-feature :executable)
|
| 44 | 44 | |
| 45 | +(setq *software-type* #+OpenBSD "OpenBSD"
|
|
| 46 | + #+NetBSD "NetBSD"
|
|
| 47 | + #+freebsd "FreeBSD"
|
|
| 48 | + #+Darwin "Darwin"
|
|
| 49 | + #-(or freebsd NetBSD OpenBSD Darwin) "BSD")
|
|
| 50 | + |
|
| 45 | 51 | |
| 46 | 52 | ;;; OS-Init initializes our operating-system interface. It sets the values
|
| 47 | 53 | ;;; of the global port variables to what they should be and calls the functions
|
| ... | ... | @@ -26,6 +26,8 @@ |
| 26 | 26 | (register-lisp-feature :elf)
|
| 27 | 27 | (register-lisp-runtime-feature :executable)
|
| 28 | 28 | |
| 29 | +(setq *software-type* "Linux")
|
|
| 30 | + |
|
| 29 | 31 | ;;; OS-Init initializes our operating-system interface.
|
| 30 | 32 | ;;;
|
| 31 | 33 | (defun os-init ()
|
| ... | ... | @@ -80,23 +80,11 @@ |
| 80 | 80 | "Returns a string giving the name of the local machine."
|
| 81 | 81 | (unix:unix-gethostname))
|
| 82 | 82 | |
| 83 | -(defvar *software-type* nil
|
|
| 84 | - _N"The value of SOFTWARE-TYPE.")
|
|
| 83 | +(defvar *software-type* "Unix"
|
|
| 84 | + _N"The value of SOFTWARE-TYPE. Set in FOO-os.lisp.")
|
|
| 85 | 85 | |
| 86 | 86 | (defun software-type ()
|
| 87 | - _N"Returns a string describing the supporting software."
|
|
| 88 | - (unless *software-type*
|
|
| 89 | - (setf *software-type*
|
|
| 90 | - (let (software-type)
|
|
| 91 | - ;; Get the software-type from the C function os_software_type.
|
|
| 92 | - (unwind-protect
|
|
| 93 | - (progn
|
|
| 94 | - (setf software-type
|
|
| 95 | - (alien:alien-funcall
|
|
| 96 | - (alien:extern-alien "os_software_type"
|
|
| 97 | - (function (alien:* c-call:c-string)))))
|
|
| 98 | - (unless (zerop (sap-int (alien:alien-sap software-type)))
|
|
| 99 | - (alien:cast software-type c-call:c-string)))))))
|
|
| 87 | + "Returns a string describing the supporting software."
|
|
| 100 | 88 | *software-type*)
|
| 101 | 89 | |
| 102 | 90 | (defvar *software-version* nil
|
| ... | ... | @@ -31,6 +31,8 @@ |
| 31 | 31 | #+executable
|
| 32 | 32 | (register-lisp-runtime-feature :executable)
|
| 33 | 33 | |
| 34 | +(setq *software-type* "SunOS")
|
|
| 35 | + |
|
| 34 | 36 | ;;; OS-INIT -- interface.
|
| 35 | 37 | ;;;
|
| 36 | 38 | ;;; Other OS dependent initializations.
|
| ... | ... | @@ -5632,11 +5632,7 @@ msgid "Returns a string giving the name of the local machine." |
| 5632 | 5632 | msgstr ""
|
| 5633 | 5633 | |
| 5634 | 5634 | #: src/code/misc.lisp
|
| 5635 | -msgid "The value of SOFTWARE-TYPE."
|
|
| 5636 | -msgstr ""
|
|
| 5637 | - |
|
| 5638 | -#: src/code/misc.lisp
|
|
| 5639 | -msgid "Returns a string describing the supporting software."
|
|
| 5635 | +msgid "The value of SOFTWARE-TYPE. Set in FOO-os.lisp."
|
|
| 5640 | 5636 | msgstr ""
|
| 5641 | 5637 | |
| 5642 | 5638 | #: src/code/misc.lisp
|
| ... | ... | @@ -844,20 +844,3 @@ os_software_version(void) |
| 844 | 844 | return result;
|
| 845 | 845 | }
|
| 846 | 846 | #undef UNAME_RELEASE_AND_VERSION |
| 847 | - |
|
| 848 | -char*
|
|
| 849 | -os_software_type(void)
|
|
| 850 | -{
|
|
| 851 | - int status;
|
|
| 852 | - struct utsname uts;
|
|
| 853 | - static char os_name[sizeof(uts.sysname)];
|
|
| 854 | -
|
|
| 855 | - status = uname(&uts);
|
|
| 856 | - if (status != 0) {
|
|
| 857 | - return NULL;
|
|
| 858 | - }
|
|
| 859 | -
|
|
| 860 | - strcpy(os_name, uts.sysname);
|
|
| 861 | - |
|
| 862 | - return os_name;
|
|
| 863 | -} |