cmucl-cvs April 2023

cmucl-cvs@common-lisp.net

1 participants
32 discussions

[Git][cmucl/cmucl] Pushed new branch rtoy-master-patch-80206
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed new branch rtoy-master-patch-80206 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/rtoy-master-patch-80206 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update pot files
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 2556df76 by Raymond Toy at 2023-04-19T07:38:34-07:00 Update pot files Forgot to update these in the merges, so let's do them all now. - - - - - 2 changed files: - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -15,10 +15,6 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/code/linux-os.lisp -msgid "Unix system call getrusage failed: ~A." -msgstr "" - #: src/code/linux-os.lisp msgid "Getpagesize failed: ~A" msgstr "" ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1448,3 +1448,13 @@ msgstr "" msgid "Get the codeset from the locale" msgstr "" +#: src/code/unix.lisp +msgid "" +"Get system information consisting of the user time (in usec), the\n" +" system time (in usec) and the number of major page faults." +msgstr "" + +#: src/code/unix.lisp +msgid "Unix system call getrusage failed: ~A." +msgstr "" + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2556df76cb546b458f21fa2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2556df76cb546b458f21fa2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #120: software-version in C
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: fbb742ae by Raymond Toy at 2023-04-19T14:14:39+00:00 Fix #120: software-version in C - - - - - 501ca837 by Raymond Toy at 2023-04-19T14:14:40+00:00 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 - - - - - 8 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - src/code/sunos-os.lisp - src/general-info/release-21e.md - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl.pot - src/lisp/os-common.c Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -48,19 +48,6 @@ #+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 ===================================== src/code/linux-os.lisp ===================================== @@ -28,20 +28,10 @@ (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 ===================================== src/code/misc.lisp ===================================== @@ -17,7 +17,7 @@ (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)) @@ -81,12 +81,32 @@ (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.") ===================================== src/code/sunos-os.lisp ===================================== @@ -33,19 +33,6 @@ (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. ===================================== src/general-info/release-21e.md ===================================== @@ -49,10 +49,11 @@ public domain. * ~~#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. ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -15,10 +15,6 @@ msgstr "" "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 "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5646,6 +5646,14 @@ 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 "" ===================================== src/lisp/os-common.c ===================================== @@ -17,6 +17,7 @@ #include <string.h> #include <sys/resource.h> #include <sys/stat.h> +#include <sys/utsname.h> #include <unistd.h> #include <time.h> @@ -830,4 +831,27 @@ os_get_system_info(int64_t* utime, int64_t* stime, long* major_fault) 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; +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2aee0f70567e3e3657951… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2aee0f70567e3e3657951… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Address review comments
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: 550b8762 by Raymond Toy at 2023-04-19T06:54:41-07:00 Address review comments Remove the decache comment in `os-init` in bsd-os.lisp and linux-os.lisp. - - - - - 2 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -54,7 +54,6 @@ ;;; that set up the argument blocks for the server interfaces. (defun os-init () - ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) ;;; GET-PAGE-SIZE -- Interface ===================================== src/code/linux-os.lisp ===================================== @@ -31,7 +31,6 @@ ;;; OS-Init initializes our operating-system interface. ;;; (defun os-init () - ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/550b876213f2ab6aded82ab… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/550b876213f2ab6aded82ab… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] 6 commits: Fix warning about lack of prototype in os_get_locale_codeset.
by Raymond Toy (＠rtoy) 17 Apr '23

17 Apr '23

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: 72cdab53 by Raymond Toy at 2023-03-29T11:33:08-07:00 Fix warning about lack of prototype in os_get_locale_codeset. Clang produces a warning for `char * os_get_locale_codeset()` because we don't give a prototype for the arg of `os_get_locale_codeset`. So just make it `void`. - - - - - bbfff3c0 by Raymond Toy at 2023-04-10T15:11:59+00:00 Fix #170: Move get-system-info to C - - - - - 5196072a by Raymond Toy at 2023-04-10T15:12:01+00:00 Merge branch 'issue-179-get-system-info-in-c' into 'master' Fix #170: Move get-system-info to C Closes #170 See merge request cmucl/cmucl!137 - - - - - b2aee0f7 by Raymond Toy at 2023-04-17T08:14:29-07:00 Update cmucl.pot with latest source Some docstrings have changed, so update cmucl.pot - - - - - 3da41d71 by Raymond Toy at 2023-04-17T08:18:04-07:00 Merge branch 'master' into issue-120-software-type-in-c - - - - - 9360c95c by Raymond Toy at 2023-04-17T08:21:11-07:00 Add comment for os_software_version. - - - - - 8 changed files: - src/code/bsd-os.lisp - src/code/hpux-os.lisp - src/code/irix-os.lisp - src/code/linux-os.lisp - src/code/osf1-os.lisp - src/code/sunos-os.lisp - src/code/unix.lisp - src/lisp/os-common.c Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -57,22 +57,6 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. -;;; -(defun get-system-info () - (multiple-value-bind (err? utime stime maxrss ixrss idrss - isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (unless err? - (error (intl:gettext "Unix system call getrusage failed: ~A.") - (unix:get-unix-error-msg utime))) - - (values utime stime majflt))) - - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/hpux-os.lisp ===================================== @@ -46,22 +46,6 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. -;;; -(defun get-system-info () - (multiple-value-bind - (err? utime stime maxrss ixrss idrss isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (cond ((null err?) - (error "Unix system call getrusage failed: ~A." - (unix:get-unix-error-msg utime))) - (T - (values utime stime majflt))))) - - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/irix-os.lisp ===================================== @@ -48,22 +48,6 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. -;;; -(defun get-system-info () - (multiple-value-bind - (err? utime stime maxrss ixrss idrss isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (cond ((null err?) - (error "Unix system call getrusage failed: ~A." - (unix:get-unix-error-msg utime))) - (T - (values utime stime majflt))))) - - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/linux-os.lisp ===================================== @@ -35,22 +35,6 @@ (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. -;;; -(defun get-system-info () - (multiple-value-bind (err? utime stime maxrss ixrss idrss - isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (unless err? - (error (intl:gettext "Unix system call getrusage failed: ~A.") - (unix:get-unix-error-msg utime))) - - (values utime stime majflt))) - - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/osf1-os.lisp ===================================== @@ -47,23 +47,6 @@ (defun os-init () (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. For -;;; page-faults, we add pagein and pageout, since that is a somewhat more -;;; interesting number than the total faults. -;;; -(defun get-system-info () - (multiple-value-bind (err? utime stime maxrss ixrss idrss - isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (unless err? - (error "Unix system call getrusage failed: ~A." - (unix:get-unix-error-msg utime))) - (values utime stime majflt))) - - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/sunos-os.lisp ===================================== @@ -41,21 +41,6 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-SYSTEM-INFO -- Interface -;;; -;;; Return system time, user time and number of page faults. -;;; -(defun get-system-info () - (multiple-value-bind - (err? utime stime maxrss ixrss idrss isrss minflt majflt) - (unix:unix-getrusage unix:rusage_self) - (declare (ignore maxrss ixrss idrss isrss minflt)) - (cond ((null err?) - (error (intl:gettext "Unix system call getrusage failed: ~A.") - (unix:get-unix-error-msg utime))) - (T - (values utime stime majflt))))) - ;;; GET-PAGE-SIZE -- Interface ;;; ;;; Return the system page size. ===================================== src/code/unix.lisp ===================================== @@ -2927,3 +2927,28 @@ (extern-alien "os_get_locale_codeset" (function (* char)))) c-string)) + +;;; GET-SYSTEM-INFO -- Interface +;;; +;;; Return system time, user time (in usec) and number of page +;;; faults. +;;; +(defun get-system-info () + "Get system information consisting of the user time (in usec), the + system time (in usec) and the number of major page faults." + (with-alien ((utime int64-t 0) + (stime int64-t 0) + (major-fault c-call:long 0)) + (let ((rc (alien-funcall + (extern-alien "os_get_system_info" + (function c-call:int + (* int64-t) + (* int64-t) + (* c-call:long))) + (addr utime) + (addr stime) + (addr major-fault)))) + (when (minusp rc) + (error (intl:gettext "Unix system call getrusage failed: ~A.") + (unix:get-unix-error-msg utime))) + (values utime stime major-fault)))) ===================================== src/lisp/os-common.c ===================================== @@ -15,6 +15,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include <sys/resource.h> #include <sys/stat.h> #include <sys/utsname.h> #include <unistd.h> @@ -800,11 +801,41 @@ os_get_lc_messages(char *buf, int len) } char * -os_get_locale_codeset() +os_get_locale_codeset(void) { return nl_langinfo(CODESET); } +/* + * Get system info consisting of the utime (in usec), the stime (in + * usec) and the number of major page faults. The return value is the + * return code from getrusage. + */ +int +os_get_system_info(int64_t* utime, int64_t* stime, long* major_fault) +{ + struct rusage usage; + int rc; + + *utime = 0; + *stime = 0; + *major_fault = 0; + + rc = getrusage(RUSAGE_SELF, &usage); + if (rc == 0) { + *utime = usage.ru_utime.tv_sec * 1000000 + usage.ru_utime.tv_usec; + *stime = usage.ru_stime.tv_sec * 1000000 + usage.ru_stime.tv_usec; + *major_fault = usage.ru_majflt; + } + + 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) { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d629ff45cb7439b9434b9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d629ff45cb7439b9434b9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update cmucl.pot with latest source
by Raymond Toy (＠rtoy) 17 Apr '23

17 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b2aee0f7 by Raymond Toy at 2023-04-17T08:14:29-07:00 Update cmucl.pot with latest source Some docstrings have changed, so update cmucl.pot - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -4014,10 +4014,9 @@ msgstr "" #: src/code/string.lisp msgid "" -"Convert String to NFD (or NFKD). If :darwinp is non-NIL, then\n" -" characters in the ranges U2000-U2FFF, UF900-UFA6A, and\n" -" U2F800-U2FA1D are not decomposed, as specified for Darwin\n" -" pathnames." +"Convert STRING to NFD (or NFKD). If :darwinp is non-NIL, then\n" +" characters in the ranges U2000-U2FFF, UF900-UFA6A, and U2F800-U2FA1D\n" +" are not decomposed, as specified for Darwin pathnames." msgstr "" #: src/code/string.lisp @@ -5651,10 +5650,6 @@ msgstr "" msgid "The value of SHORT-SITE-NAME. Set in library:site-init.lisp." msgstr "" -#: src/code/misc.lisp -msgid "Unknown" -msgstr "" - #: src/code/misc.lisp msgid "Returns a string with the abbreviated site name." msgstr "" @@ -5663,10 +5658,6 @@ msgstr "" msgid "The value of LONG-SITE-NAME. Set in library:site-init.lisp." msgstr "" -#: src/code/misc.lisp -msgid "Site name not initialized" -msgstr "" - #: src/code/misc.lisp msgid "Returns a string with the long form of the site name." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b2aee0f70567e3e36579517… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b2aee0f70567e3e36579517… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-187-imul-disassembly
by Raymond Toy (＠rtoy) 14 Apr '23

14 Apr '23

Raymond Toy pushed new branch issue-187-imul-disassembly at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-187-imul-disassembly You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs April 2023