cmucl-cvs April 2023

cmucl-cvs@common-lisp.net

1 participants
32 discussions

[Git][cmucl/cmucl][master] 2 commits: Fix #180: Move get-page-size to C
by Raymond Toy (＠rtoy) 21 Apr '23

21 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f52fcecb by Raymond Toy at 2023-04-21T13:35:02+00:00 Fix #180: Move get-page-size to C - - - - - 412d6523 by Raymond Toy at 2023-04-21T13:35:02+00:00 Merge branch 'issue-180-get-page-size-in-c' into 'master' Fix #180: Move get-page-size to C Closes #180 See merge request cmucl/cmucl!136 - - - - - 14 changed files: - src/code/bsd-os.lisp - src/code/hpux-os.lisp - src/code/irix-os.lisp - + src/code/os.lisp - src/code/osf1-os.lisp - src/code/sunos-os.lisp - src/code/unix.lisp - src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c - src/pcl/simple-streams/internal.lisp - src/tools/worldbuild.lisp - src/tools/worldcom.lisp Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -56,13 +56,17 @@ (defun os-init () (setf *software-version* nil)) -;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; Return system time, user time and number of page faults. ;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) - val)) +(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))) ===================================== src/code/hpux-os.lisp ===================================== @@ -46,13 +46,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-PAGE-SIZE -- Interface -;;; -;;; Return the system page size. -;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) +;;; 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))))) ===================================== src/code/irix-os.lisp ===================================== @@ -48,14 +48,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; Return system time, user time and number of page faults. ;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) - +(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))))) ===================================== src/code/os.lisp ===================================== @@ -0,0 +1,35 @@ +;;; -*- Package: SYSTEM -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project and +;;; has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/os.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMUCL. +;;; +;;; The code here is for OS functions that don't depend on the OS. + +(in-package "SYSTEM") +(use-package "EXTENSIONS") +(intl:textdomain "cmucl-linux-os") + +(export '(get-page-size)) + +;;; GET-PAGE-SIZE -- Interface +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + _N"Return the system page size" + (let ((maybe-page-size (alien:alien-funcall + (alien:extern-alien "os_get_page_size" + (function c-call:long))))) + (when (minusp maybe-page-size) + (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err))) + maybe-page-size)) + + ===================================== src/code/osf1-os.lisp ===================================== @@ -47,14 +47,18 @@ (defun os-init () (setf *software-version* nil)) -;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; 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-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) - +(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))) ===================================== src/code/sunos-os.lisp ===================================== @@ -41,13 +41,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) -;;; GET-PAGE-SIZE -- Interface -;;; -;;; Return the system page size. -;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) - val)) +;;; 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))))) ===================================== src/code/unix.lisp ===================================== @@ -1156,12 +1156,6 @@ _N"Unix-getuid returns the real user-id associated with the current process.") -;;; Unix-getpagesize returns the number of bytes in the system page. - -(defun unix-getpagesize () - _N"Unix-getpagesize returns the number of bytes in a system page." - (int-syscall ("getpagesize"))) - (defun unix-gethostname () _N"Unix-gethostname returns the name of the host machine as a string." (with-alien ((buf (array char 256))) ===================================== src/contrib/unix/unix.lisp ===================================== @@ -922,4 +922,11 @@ (slot rlimit 'rlim-cur) (slot rlimit 'rlim-max)) resource (addr rlimit)))) + +;;; Unix-getpagesize returns the number of bytes in the system page. + +(defun unix-getpagesize () + _N"Unix-getpagesize returns the number of bytes in a system page." + (int-syscall ("getpagesize"))) + ;; EOF ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -19,6 +19,14 @@ msgstr "" msgid "Getpagesize failed: ~A" msgstr "" +#: src/code/os.lisp +msgid "Return the system page size" +msgstr "" + +#: src/code/os.lisp +msgid "get-page-size failed: ~A" +msgstr "" + #: src/code/signal.lisp msgid "Stack fault on coprocessor" msgstr "" ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -470,10 +470,6 @@ msgid "" " current process." msgstr "" -#: src/code/unix.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." -msgstr "" - #: src/code/unix.lisp msgid "Unix-gethostname returns the name of the host machine as a string." msgstr "" ===================================== src/lisp/os-common.c ===================================== @@ -806,6 +806,14 @@ os_get_locale_codeset(void) return nl_langinfo(CODESET); } +long +os_get_page_size(void) +{ + errno = 0; + + return sysconf(_SC_PAGESIZE); +} + /* * 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 ===================================== src/pcl/simple-streams/internal.lisp ===================================== @@ -99,7 +99,7 @@ (tagbody again ;; Avoid CMUCL gengc write barrier - (do ((i start (+ i #.(unix:unix-getpagesize)))) + (do ((i start (+ i #.(sys:get-page-size)))) ((>= i end)) (declare (type fixnum i)) (setf (bref buffer i) 0)) ===================================== src/tools/worldbuild.lisp ===================================== @@ -147,6 +147,7 @@ '("target:code/bsd-os")) ,@(when (c:backend-featurep :Linux) '("target:code/linux-os")) + "target:code/os" "target:code/serve-event" "target:code/stream" "target:code/fd-stream" ===================================== src/tools/worldcom.lisp ===================================== @@ -173,6 +173,7 @@ (comf "target:code/bsd-os")) (when (c:backend-featurep :Linux) (comf "target:code/linux-os")) +(comf "target:code/os") (when (c:backend-featurep :pmax) (comf "target:code/pmax-vm")) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/de972bb39978a910da7fe1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/de972bb39978a910da7fe1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-180-get-page-size-in-c] Update pot files
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch issue-180-get-page-size-in-c at cmucl / cmucl Commits: 6fc4c2a1 by Raymond Toy at 2023-04-19T10:05:41-07:00 Update pot files - - - - - 3 changed files: - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -16,11 +16,15 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/linux-os.lisp -msgid "Returns a string describing version of the supporting software." +msgid "Getpagesize failed: ~A" msgstr "" -#: src/code/linux-os.lisp -msgid "Unix system call getrusage failed: ~A." +#: src/code/os.lisp +msgid "Return the system page size" +msgstr "" + +#: src/code/os.lisp +msgid "get-page-size failed: ~A" msgstr "" #: src/code/signal.lisp ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1445,6 +1445,12 @@ msgid "Get the codeset from the locale" msgstr "" #: src/code/unix.lisp -msgid "get-page-size failed: ~A" +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 "" ===================================== 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 "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6fc4c2a1c1645c04661b21c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6fc4c2a1c1645c04661b21c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-180-get-page-size-in-c] Fix typo in comment
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch issue-180-get-page-size-in-c at cmucl / cmucl Commits: 02884455 by Raymond Toy at 2023-04-19T09:57:08-07:00 Fix typo in comment - - - - - 1 changed file: - src/code/os.lisp Changes: ===================================== src/code/os.lisp ===================================== @@ -1,8 +1,8 @@ ;;; -*- Package: SYSTEM -*- ;;; ;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; and has been placed in the public domain. +;;; This code was written as part of the CMU Common Lisp project and +;;; has been placed in the public domain. ;;; (ext:file-comment "$Header: src/code/os.lisp $") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0288445524ea7ded798be22… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0288445524ea7ded798be22… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-180-get-page-size-in-c] 8 commits: Fix #170: Move get-system-info to C
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch issue-180-get-page-size-in-c at cmucl / cmucl Commits: 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 - - - - - 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 - - - - - 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. - - - - - dc1654d6 by Raymond Toy at 2023-04-19T08:32:04-07:00 Merge branch 'master' into issue-180-get-page-size-in-c - - - - - 0dc0b228 by Raymond Toy at 2023-04-19T09:51:28-07:00 Add new file os.lisp to hold common OS functions independent of OS Update the build files to compile this new file. - - - - - 10 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - + src/code/os.lisp - src/code/sunos-os.lisp - src/code/unix.lisp - src/general-info/release-21e.md - src/lisp/os-common.c - src/tools/worldbuild.lisp - src/tools/worldcom.lisp 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 @@ -83,5 +70,3 @@ (unix:get-unix-error-msg utime))) (values utime stime majflt))) - - ===================================== src/code/linux-os.lisp ===================================== @@ -28,33 +28,20 @@ (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 +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + (multiple-value-bind (val err) + (unix:unix-getpagesize) + (unless val + (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) + val)) -;;; 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))) ===================================== 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/os.lisp ===================================== @@ -0,0 +1,35 @@ +;;; -*- Package: SYSTEM -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; and has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/os.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMUCL. +;;; +;;; The code here is for OS functions that don't depend on the OS. + +(in-package "SYSTEM") +(use-package "EXTENSIONS") +(intl:textdomain "cmucl-linux-os") + +(export '(get-page-size)) + +;;; GET-PAGE-SIZE -- Interface +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + _N"Return the system page size" + (let ((maybe-page-size (alien:alien-funcall + (alien:extern-alien "os_get_page_size" + (function c-call:long))))) + (when (minusp maybe-page-size) + (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err))) + maybe-page-size)) + + ===================================== 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/code/unix.lisp ===================================== @@ -2922,14 +2922,27 @@ (function (* char)))) c-string)) -;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; Return system time, user time (in usec) and number of page +;;; faults. ;;; -(defun get-page-size () - (let ((maybe-page-size (alien-funcall - (extern-alien "os_get_page_size" - (function c-call:long))))) - (when (minusp maybe-page-size) - (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err))) - maybe-page-size)) +(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/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/lisp/os-common.c ===================================== @@ -15,7 +15,9 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include <sys/resource.h> #include <sys/stat.h> +#include <sys/utsname.h> #include <unistd.h> #include <time.h> @@ -811,3 +813,53 @@ os_get_page_size(void) return sysconf(_SC_PAGESIZE); } + +/* + * 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) +{ + 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; +} ===================================== src/tools/worldbuild.lisp ===================================== @@ -147,6 +147,7 @@ '("target:code/bsd-os")) ,@(when (c:backend-featurep :Linux) '("target:code/linux-os")) + "target:code/os" "target:code/serve-event" "target:code/stream" "target:code/fd-stream" ===================================== src/tools/worldcom.lisp ===================================== @@ -173,6 +173,7 @@ (comf "target:code/bsd-os")) (when (c:backend-featurep :Linux) (comf "target:code/linux-os")) +(comf "target:code/os") (when (c:backend-featurep :pmax) (comf "target:code/pmax-vm")) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/42a8fe564c94711f742837… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/42a8fe564c94711f742837… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Add missing colon after "Version"
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 38daa5e2 by Raymond Toy at 2023-04-19T15:13:28+00:00 Add missing colon after "Version" - - - - - de972bb3 by Raymond Toy at 2023-04-19T15:32:14+00:00 Merge branch 'rtoy-master-patch-80206' into 'master' Add missing colon after "Version" See merge request cmucl/cmucl!140 - - - - - 1 changed file: - .gitlab/issue_templates/Bug.md Changes: ===================================== .gitlab/issue_templates/Bug.md ===================================== @@ -16,7 +16,7 @@ If applicable, add screenshots to help explain your problem. ## Desktop (please complete the following information): - OS: [e.g. Linux] - - Version [e.g. 21c] + - Version: [e.g. 21c] ## Additional context Add any other context about the problem here. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2556df76cb546b458f21fa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2556df76cb546b458f21fa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs April 2023