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