Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl

Commits:

8 changed files:

Changes:

  • src/code/bsd-os.lisp
    ... ... @@ -57,22 +57,6 @@
    57 57 
       ;; Decache version on save, because it might not be the same when we restart.
    58 58 
       (setf *software-version* nil))
    59 59
    60 
    -;;; GET-SYSTEM-INFO  --  Interface
    61 
    -;;;
    62 
    -;;;    Return system time, user time and number of page faults.
    63 
    -;;;
    64 
    -(defun get-system-info ()
    65 
    -  (multiple-value-bind (err? utime stime maxrss ixrss idrss
    66 
    -			     isrss minflt majflt)
    67 
    -		       (unix:unix-getrusage unix:rusage_self)
    68 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    69 
    -    (unless err?
    70 
    -      (error (intl:gettext "Unix system call getrusage failed: ~A.")
    71 
    -	     (unix:get-unix-error-msg utime)))
    72 
    -
    73 
    -    (values utime stime majflt)))
    74 
    -
    75 
    -
    76 60 
     ;;; GET-PAGE-SIZE  --  Interface
    77 61 
     ;;;
    78 62 
     ;;;    Return the system page size.

  • src/code/hpux-os.lisp
    ... ... @@ -46,22 +46,6 @@
    46 46 
       ;; Decache version on save, because it might not be the same when we restart.
    47 47 
       (setf *software-version* nil))
    48 48
    49 
    -;;; GET-SYSTEM-INFO  --  Interface
    50 
    -;;;
    51 
    -;;;    Return system time, user time and number of page faults.
    52 
    -;;;
    53 
    -(defun get-system-info ()
    54 
    -  (multiple-value-bind
    55 
    -      (err? utime stime maxrss ixrss idrss isrss minflt majflt)
    56 
    -      (unix:unix-getrusage unix:rusage_self)
    57 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    58 
    -    (cond ((null err?)
    59 
    -	   (error "Unix system call getrusage failed: ~A."
    60 
    -		  (unix:get-unix-error-msg utime)))
    61 
    -	  (T
    62 
    -	   (values utime stime majflt)))))
    63 
    -
    64 
    -
    65 49 
     ;;; GET-PAGE-SIZE  --  Interface
    66 50 
     ;;;
    67 51 
     ;;;    Return the system page size.

  • src/code/irix-os.lisp
    ... ... @@ -48,22 +48,6 @@
    48 48 
       ;; Decache version on save, because it might not be the same when we restart.
    49 49 
       (setf *software-version* nil))
    50 50
    51 
    -;;; GET-SYSTEM-INFO  --  Interface
    52 
    -;;;
    53 
    -;;;    Return system time, user time and number of page faults.
    54 
    -;;;
    55 
    -(defun get-system-info ()
    56 
    -  (multiple-value-bind
    57 
    -      (err? utime stime maxrss ixrss idrss isrss minflt majflt)
    58 
    -      (unix:unix-getrusage unix:rusage_self)
    59 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    60 
    -    (cond ((null err?)
    61 
    -	   (error "Unix system call getrusage failed: ~A."
    62 
    -		  (unix:get-unix-error-msg utime)))
    63 
    -	  (T
    64 
    -	   (values utime stime majflt)))))
    65 
    -
    66 
    -
    67 51 
     ;;; GET-PAGE-SIZE  --  Interface
    68 52 
     ;;;
    69 53 
     ;;;    Return the system page size.

  • src/code/linux-os.lisp
    ... ... @@ -35,22 +35,6 @@
    35 35 
       (setf *software-version* nil))
    36 36
    37 37
    38 
    -;;; GET-SYSTEM-INFO  --  Interface
    39 
    -;;;
    40 
    -;;;    Return system time, user time and number of page faults.
    41 
    -;;;
    42 
    -(defun get-system-info ()
    43 
    -  (multiple-value-bind (err? utime stime maxrss ixrss idrss
    44 
    -			     isrss minflt majflt)
    45 
    -		       (unix:unix-getrusage unix:rusage_self)
    46 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    47 
    -    (unless err?
    48 
    -      (error (intl:gettext "Unix system call getrusage failed: ~A.")
    49 
    -	     (unix:get-unix-error-msg utime)))
    50 
    -
    51 
    -    (values utime stime majflt)))
    52 
    -
    53 
    -
    54 38 
     ;;; GET-PAGE-SIZE  --  Interface
    55 39 
     ;;;
    56 40 
     ;;;    Return the system page size.

  • src/code/osf1-os.lisp
    ... ... @@ -47,23 +47,6 @@
    47 47 
     (defun os-init ()
    48 48 
       (setf *software-version* nil))
    49 49
    50 
    -;;; GET-SYSTEM-INFO  --  Interface
    51 
    -;;;
    52 
    -;;;    Return system time, user time and number of page faults.  For
    53 
    -;;; page-faults, we add pagein and pageout, since that is a somewhat more
    54 
    -;;; interesting number than the total faults.
    55 
    -;;;
    56 
    -(defun get-system-info ()
    57 
    -  (multiple-value-bind (err? utime stime maxrss ixrss idrss
    58 
    -			     isrss minflt majflt)
    59 
    -		       (unix:unix-getrusage unix:rusage_self)
    60 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    61 
    -    (unless err?
    62 
    -      (error "Unix system call getrusage failed: ~A."
    63 
    -	     (unix:get-unix-error-msg utime)))
    64 
    -    (values utime stime majflt)))
    65 
    -
    66 
    -
    67 50 
     ;;; GET-PAGE-SIZE  --  Interface
    68 51 
     ;;;
    69 52 
     ;;;    Return the system page size.

  • src/code/sunos-os.lisp
    ... ... @@ -41,21 +41,6 @@
    41 41 
       ;; Decache version on save, because it might not be the same when we restart.
    42 42 
       (setf *software-version* nil))
    43 43
    44 
    -;;; GET-SYSTEM-INFO  --  Interface
    45 
    -;;;
    46 
    -;;;    Return system time, user time and number of page faults.
    47 
    -;;;
    48 
    -(defun get-system-info ()
    49 
    -  (multiple-value-bind
    50 
    -      (err? utime stime maxrss ixrss idrss isrss minflt majflt)
    51 
    -      (unix:unix-getrusage unix:rusage_self)
    52 
    -    (declare (ignore maxrss ixrss idrss isrss minflt))
    53 
    -    (cond ((null err?)
    54 
    -	   (error (intl:gettext "Unix system call getrusage failed: ~A.")
    55 
    -		  (unix:get-unix-error-msg utime)))
    56 
    -	  (T
    57 
    -	   (values utime stime majflt)))))
    58 
    -
    59 44 
     ;;; GET-PAGE-SIZE  --  Interface
    60 45 
     ;;;
    61 46 
     ;;;    Return the system page size.

  • src/code/unix.lisp
    ... ... @@ -2927,3 +2927,28 @@
    2927 2927 
     	    (extern-alien "os_get_locale_codeset"
    2928 2928 
     			  (function (* char))))
    2929 2929 
     	c-string))
    2930 
    +
    2931 
    +;;; GET-SYSTEM-INFO  --  Interface
    2932 
    +;;;
    2933 
    +;;;    Return system time, user time (in usec) and number of page
    2934 
    +;;;    faults.
    2935 
    +;;;
    2936 
    +(defun get-system-info ()
    2937 
    +  "Get system information consisting of the user time (in usec), the
    2938 
    +  system time (in usec) and the number of major page faults."
    2939 
    +  (with-alien ((utime int64-t 0)
    2940 
    +	       (stime int64-t 0)
    2941 
    +	       (major-fault c-call:long 0))
    2942 
    +    (let ((rc (alien-funcall
    2943 
    +	       (extern-alien "os_get_system_info"
    2944 
    +			     (function c-call:int
    2945 
    +				       (* int64-t)
    2946 
    +				       (* int64-t)
    2947 
    +				       (* c-call:long)))
    2948 
    +	       (addr utime)
    2949 
    +	       (addr stime)
    2950 
    +	       (addr major-fault))))
    2951 
    +      (when (minusp rc)
    2952 
    +	(error (intl:gettext "Unix system call getrusage failed: ~A.")
    2953 
    +	       (unix:get-unix-error-msg utime)))
    2954 
    +      (values utime stime major-fault))))

  • src/lisp/os-common.c
    ... ... @@ -15,6 +15,7 @@
    15 15 
     #include <stdio.h>
    16 16 
     #include <stdlib.h>
    17 17 
     #include <string.h>
    18 
    +#include <sys/resource.h>
    18 19 
     #include <sys/stat.h>
    19 20 
     #include <sys/utsname.h>
    20 21 
     #include <unistd.h>
    ... ... @@ -800,11 +801,41 @@ os_get_lc_messages(char *buf, int len)
    800 801 
     }
    801 802
    802 803 
     char *
    803 
    -os_get_locale_codeset()
    804 
    +os_get_locale_codeset(void)
    804 805 
     {
    805 806 
         return nl_langinfo(CODESET);
    806 807 
     }
    807 808
    809 
    +/*
    810 
    + * Get system info consisting of the utime (in usec), the stime (in
    811 
    + * usec) and the number of major page faults.  The return value is the
    812 
    + * return code from getrusage.
    813 
    + */
    814 
    +int
    815 
    +os_get_system_info(int64_t* utime, int64_t* stime, long* major_fault)
    816 
    +{
    817 
    +    struct rusage usage;
    818 
    +    int rc;
    819 
    +
    820 
    +    *utime = 0;
    821 
    +    *stime = 0;
    822 
    +    *major_fault = 0;
    823 
    +
    824 
    +    rc = getrusage(RUSAGE_SELF, &usage);
    825 
    +    if (rc == 0) {
    826 
    +        *utime = usage.ru_utime.tv_sec * 1000000 + usage.ru_utime.tv_usec;
    827 
    +        *stime = usage.ru_stime.tv_sec * 1000000 + usage.ru_stime.tv_usec;
    828 
    +        *major_fault = usage.ru_majflt;
    829 
    +    }
    830 
    +
    831 
    +    return rc;
    832 
    +}
    833 
    +
    834 
    +/*
    835 
    + * Get the software version.  This is the same as "uname -r", the release.
    836 
    + * A pointer to a static string is returned. If uname fails, an empty
    837 
    + * string is returned.
    838 
    + */
    808 839 
     char*
    809 840 
     os_software_version(void)
    810 841 
     {

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help