[Git][cmucl/cmucl][issue-120-software-type-in-c] 6 commits: Fix warning about lack of prototype in os_get_locale_codeset. - cmucl-cvs - mailman3.common-lisp.net

17 Apr 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&#39;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 &#39;issue-179-get-system-info-in-c&#39; into &#39;master&#39;
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 &#39;master&#39; 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.





    