[Git][cmucl/cmucl][issue-120-software-type-in-c] 6 commits: Fix warning about lack of prototype in os_get_locale_codeset.
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Mon Apr 17 15:21:37 UTC 2023
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/9d629ff45cb7439b9434b9b0eee079de1cf40790...9360c95c6423a8a51293343b6377f0408f341941
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d629ff45cb7439b9434b9b0eee079de1cf40790...9360c95c6423a8a51293343b6377f0408f341941
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/20230417/4fca15e2/attachment-0001.html>
More information about the cmucl-cvs
mailing list