Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

14 changed files:

Changes:

  • src/code/bsd-os.lisp
    ... ... @@ -56,13 +56,17 @@
    56 56 
     (defun os-init ()
    57 57 
       (setf *software-version* nil))
    58 58
    59 
    -;;; GET-PAGE-SIZE  --  Interface
    59 
    +;;; GET-SYSTEM-INFO  --  Interface
    60 60 
     ;;;
    61 
    -;;;    Return the system page size.
    61 
    +;;;    Return system time, user time and number of page faults.
    62 62 
     ;;;
    63 
    -(defun get-page-size ()
    64 
    -  (multiple-value-bind (val err)
    65 
    -      (unix:unix-getpagesize)
    66 
    -    (unless val
    67 
    -      (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err)))
    68 
    -    val))
    63 
    +(defun get-system-info ()
    64 
    +  (multiple-value-bind (err? utime stime maxrss ixrss idrss
    65 
    +			     isrss minflt majflt)
    66 
    +		       (unix:unix-getrusage unix:rusage_self)
    67 
    +    (declare (ignore maxrss ixrss idrss isrss minflt))
    68 
    +    (unless err?
    69 
    +      (error (intl:gettext "Unix system call getrusage failed: ~A.")
    70 
    +	     (unix:get-unix-error-msg utime)))
    71 
    +
    72 
    +    (values utime stime majflt)))

  • src/code/hpux-os.lisp
    ... ... @@ -46,13 +46,17 @@
    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-PAGE-SIZE  --  Interface
    50 
    -;;;
    51 
    -;;;    Return the system page size.
    52 
    -;;;
    53 
    -(defun get-page-size ()
    54 
    -  (multiple-value-bind (val err)
    55 
    -		       (unix:unix-getpagesize)
    56 
    -    (unless val
    57 
    -      (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
    58 
    -    val))
    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)))))

  • src/code/irix-os.lisp
    ... ... @@ -48,14 +48,17 @@
    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-PAGE-SIZE  --  Interface
    51 
    +;;; GET-SYSTEM-INFO  --  Interface
    52 52 
     ;;;
    53 
    -;;;    Return the system page size.
    53 
    +;;;    Return system time, user time and number of page faults.
    54 54 
     ;;;
    55 
    -(defun get-page-size ()
    56 
    -  (multiple-value-bind (val err)
    57 
    -		       (unix:unix-getpagesize)
    58 
    -    (unless val
    59 
    -      (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
    60 
    -    val))
    61 
    -
    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)))))

  • src/code/os.lisp
    1 
    +;;; -*- Package: SYSTEM -*-
    2 
    +;;;
    3 
    +;;; **********************************************************************
    4 
    +;;; This code was written as part of the CMU Common Lisp project and
    5 
    +;;; has been placed in the public domain.
    6 
    +;;;
    7 
    +(ext:file-comment
    8 
    +  "$Header: src/code/os.lisp $")
    9 
    +;;;
    10 
    +;;; **********************************************************************
    11 
    +;;;
    12 
    +;;; OS interface functions for CMUCL.
    13 
    +;;;
    14 
    +;;; The code here is for OS functions that don't depend on the OS.
    15 
    +
    16 
    +(in-package "SYSTEM")
    17 
    +(use-package "EXTENSIONS")
    18 
    +(intl:textdomain "cmucl-linux-os")
    19 
    +
    20 
    +(export '(get-page-size))
    21 
    +
    22 
    +;;; GET-PAGE-SIZE  --  Interface
    23 
    +;;;
    24 
    +;;;    Return the system page size.
    25 
    +;;;
    26 
    +(defun get-page-size ()
    27 
    +  _N"Return the system page size"
    28 
    +  (let ((maybe-page-size (alien:alien-funcall
    29 
    +			  (alien:extern-alien "os_get_page_size"
    30 
    +					      (function c-call:long)))))
    31 
    +    (when (minusp maybe-page-size)
    32 
    +      (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err)))
    33 
    +    maybe-page-size))
    34 
    +
    35 
    +

  • src/code/osf1-os.lisp
    ... ... @@ -47,14 +47,18 @@
    47 47 
     (defun os-init ()
    48 48 
       (setf *software-version* nil))
    49 49
    50 
    -;;; GET-PAGE-SIZE  --  Interface
    50 
    +;;; GET-SYSTEM-INFO  --  Interface
    51 51 
     ;;;
    52 
    -;;;    Return the system page size.
    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.
    53 55 
     ;;;
    54 
    -(defun get-page-size ()
    55 
    -  (multiple-value-bind (val err)
    56 
    -		       (unix:unix-getpagesize)
    57 
    -    (unless val
    58 
    -      (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
    59 
    -    val))
    60 
    -
    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)))

  • src/code/sunos-os.lisp
    ... ... @@ -41,13 +41,17 @@
    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-PAGE-SIZE  --  Interface
    45 
    -;;;
    46 
    -;;;    Return the system page size.
    47 
    -;;;
    48 
    -(defun get-page-size ()
    49 
    -  (multiple-value-bind (val err)
    50 
    -		       (unix:unix-getpagesize)
    51 
    -    (unless val
    52 
    -      (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err)))
    53 
    -    val))
    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)))))

  • src/code/unix.lisp
    ... ... @@ -1156,12 +1156,6 @@
    1156 1156 
       _N"Unix-getuid returns the real user-id associated with the
    1157 1157 
        current process.")
    1158 1158
    1159 
    -;;; Unix-getpagesize returns the number of bytes in the system page.
    1160 
    -
    1161 
    -(defun unix-getpagesize ()
    1162 
    -  _N"Unix-getpagesize returns the number of bytes in a system page."
    1163 
    -  (int-syscall ("getpagesize")))
    1164 
    -
    1165 1159 
     (defun unix-gethostname ()
    1166 1160 
       _N"Unix-gethostname returns the name of the host machine as a string."
    1167 1161 
       (with-alien ((buf (array char 256)))

  • src/contrib/unix/unix.lisp
    ... ... @@ -922,4 +922,11 @@
    922 922 
     		     (slot rlimit 'rlim-cur)
    923 923 
     		     (slot rlimit 'rlim-max))
    924 924 
     	     resource (addr rlimit))))
    925 
    +
    926 
    +;;; Unix-getpagesize returns the number of bytes in the system page.
    927 
    +
    928 
    +(defun unix-getpagesize ()
    929 
    +  _N"Unix-getpagesize returns the number of bytes in a system page."
    930 
    +  (int-syscall ("getpagesize")))
    931 
    +
    925 932 
     ;; EOF

  • src/i18n/locale/cmucl-linux-os.pot
    ... ... @@ -19,6 +19,14 @@ msgstr ""
    19 19 
     msgid "Getpagesize failed: ~A"
    20 20 
     msgstr ""
    21 21
    22 
    +#: src/code/os.lisp
    23 
    +msgid "Return the system page size"
    24 
    +msgstr ""
    25 
    +
    26 
    +#: src/code/os.lisp
    27 
    +msgid "get-page-size failed: ~A"
    28 
    +msgstr ""
    29 
    +
    22 30 
     #: src/code/signal.lisp
    23 31 
     msgid "Stack fault on coprocessor"
    24 32 
     msgstr ""

  • src/i18n/locale/cmucl-unix.pot
    ... ... @@ -470,10 +470,6 @@ msgid ""
    470 470 
     "   current process."
    471 471 
     msgstr ""
    472 472
    473 
    -#: src/code/unix.lisp
    474 
    -msgid "Unix-getpagesize returns the number of bytes in a system page."
    475 
    -msgstr ""
    476 
    -
    477 473 
     #: src/code/unix.lisp
    478 474 
     msgid "Unix-gethostname returns the name of the host machine as a string."
    479 475 
     msgstr ""

  • src/lisp/os-common.c
    ... ... @@ -806,6 +806,14 @@ os_get_locale_codeset(void)
    806 806 
         return nl_langinfo(CODESET);
    807 807 
     }
    808 808
    809 
    +long
    810 
    +os_get_page_size(void)
    811 
    +{
    812 
    +    errno = 0;
    813 
    +
    814 
    +    return sysconf(_SC_PAGESIZE);
    815 
    +}
    816 
    +
    809 817 
     /*
    810 818 
      * Get system info consisting of the utime (in usec), the stime (in
    811 819 
      * usec) and the number of major page faults.  The return value is the

  • src/pcl/simple-streams/internal.lisp
    ... ... @@ -99,7 +99,7 @@
    99 99 
     		    (tagbody
    100 100 
     		     again
    101 101 
     		       ;; Avoid CMUCL gengc write barrier
    102 
    -		       (do ((i start (+ i #.(unix:unix-getpagesize))))
    102 
    +		       (do ((i start (+ i #.(sys:get-page-size))))
    103 103 
     			   ((>= i end))
    104 104 
     			 (declare (type fixnum i))
    105 105 
     			 (setf (bref buffer i) 0))

  • src/tools/worldbuild.lisp
    ... ... @@ -147,6 +147,7 @@
    147 147 
     	'("target:code/bsd-os"))
    148 148 
         ,@(when (c:backend-featurep :Linux)
    149 149 
     	'("target:code/linux-os"))
    150 
    +    "target:code/os"
    150 151 
         "target:code/serve-event"
    151 152 
         "target:code/stream"
    152 153 
         "target:code/fd-stream"

  • src/tools/worldcom.lisp
    ... ... @@ -173,6 +173,7 @@
    173 173 
       (comf "target:code/bsd-os"))
    174 174 
     (when (c:backend-featurep :Linux)
    175 175 
       (comf "target:code/linux-os"))
    176 
    +(comf "target:code/os")
    176 177
    177 178 
     (when (c:backend-featurep :pmax)
    178 179 
       (comf "target:code/pmax-vm"))

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