Raymond Toy pushed to branch master at cmucl / cmucl
Commits: f52fcecb by Raymond Toy at 2023-04-21T13:35:02+00:00 Fix #180: Move get-page-size to C
- - - - - 412d6523 by Raymond Toy at 2023-04-21T13:35:02+00:00 Merge branch 'issue-180-get-page-size-in-c' into 'master'
Fix #180: Move get-page-size to C
Closes #180
See merge request cmucl/cmucl!136 - - - - -
14 changed files:
- src/code/bsd-os.lisp - src/code/hpux-os.lisp - src/code/irix-os.lisp - + src/code/os.lisp - src/code/osf1-os.lisp - src/code/sunos-os.lisp - src/code/unix.lisp - src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c - src/pcl/simple-streams/internal.lisp - src/tools/worldbuild.lisp - src/tools/worldcom.lisp
Changes:
===================================== src/code/bsd-os.lisp ===================================== @@ -56,13 +56,17 @@ (defun os-init () (setf *software-version* nil))
-;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; Return system time, user time and number of page faults. ;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) - val)) +(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)))
===================================== src/code/hpux-os.lisp ===================================== @@ -46,13 +46,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil))
-;;; GET-PAGE-SIZE -- Interface -;;; -;;; Return the system page size. -;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) +;;; 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)))))
===================================== src/code/irix-os.lisp ===================================== @@ -48,14 +48,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil))
-;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; Return system time, user time and number of page faults. ;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) - +(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)))))
===================================== src/code/os.lisp ===================================== @@ -0,0 +1,35 @@ +;;; -*- Package: SYSTEM -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project and +;;; has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/os.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMUCL. +;;; +;;; The code here is for OS functions that don't depend on the OS. + +(in-package "SYSTEM") +(use-package "EXTENSIONS") +(intl:textdomain "cmucl-linux-os") + +(export '(get-page-size)) + +;;; GET-PAGE-SIZE -- Interface +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + _N"Return the system page size" + (let ((maybe-page-size (alien:alien-funcall + (alien:extern-alien "os_get_page_size" + (function c-call:long))))) + (when (minusp maybe-page-size) + (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err))) + maybe-page-size)) + +
===================================== src/code/osf1-os.lisp ===================================== @@ -47,14 +47,18 @@ (defun os-init () (setf *software-version* nil))
-;;; GET-PAGE-SIZE -- Interface +;;; GET-SYSTEM-INFO -- Interface ;;; -;;; Return the system page size. +;;; 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-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err))) - val)) - +(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)))
===================================== src/code/sunos-os.lisp ===================================== @@ -41,13 +41,17 @@ ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil))
-;;; GET-PAGE-SIZE -- Interface -;;; -;;; Return the system page size. -;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) - val)) +;;; 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)))))
===================================== src/code/unix.lisp ===================================== @@ -1156,12 +1156,6 @@ _N"Unix-getuid returns the real user-id associated with the current process.")
-;;; Unix-getpagesize returns the number of bytes in the system page. - -(defun unix-getpagesize () - _N"Unix-getpagesize returns the number of bytes in a system page." - (int-syscall ("getpagesize"))) - (defun unix-gethostname () _N"Unix-gethostname returns the name of the host machine as a string." (with-alien ((buf (array char 256)))
===================================== src/contrib/unix/unix.lisp ===================================== @@ -922,4 +922,11 @@ (slot rlimit 'rlim-cur) (slot rlimit 'rlim-max)) resource (addr rlimit)))) + +;;; Unix-getpagesize returns the number of bytes in the system page. + +(defun unix-getpagesize () + _N"Unix-getpagesize returns the number of bytes in a system page." + (int-syscall ("getpagesize"))) + ;; EOF
===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -19,6 +19,14 @@ msgstr "" msgid "Getpagesize failed: ~A" msgstr ""
+#: src/code/os.lisp +msgid "Return the system page size" +msgstr "" + +#: src/code/os.lisp +msgid "get-page-size failed: ~A" +msgstr "" + #: src/code/signal.lisp msgid "Stack fault on coprocessor" msgstr ""
===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -470,10 +470,6 @@ msgid "" " current process." msgstr ""
-#: src/code/unix.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." -msgstr "" - #: src/code/unix.lisp msgid "Unix-gethostname returns the name of the host machine as a string." msgstr ""
===================================== src/lisp/os-common.c ===================================== @@ -806,6 +806,14 @@ os_get_locale_codeset(void) return nl_langinfo(CODESET); }
+long +os_get_page_size(void) +{ + errno = 0; + + return sysconf(_SC_PAGESIZE); +} + /* * 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
===================================== src/pcl/simple-streams/internal.lisp ===================================== @@ -99,7 +99,7 @@ (tagbody again ;; Avoid CMUCL gengc write barrier - (do ((i start (+ i #.(unix:unix-getpagesize)))) + (do ((i start (+ i #.(sys:get-page-size)))) ((>= i end)) (declare (type fixnum i)) (setf (bref buffer i) 0))
===================================== src/tools/worldbuild.lisp ===================================== @@ -147,6 +147,7 @@ '("target:code/bsd-os")) ,@(when (c:backend-featurep :Linux) '("target:code/linux-os")) + "target:code/os" "target:code/serve-event" "target:code/stream" "target:code/fd-stream"
===================================== src/tools/worldcom.lisp ===================================== @@ -173,6 +173,7 @@ (comf "target:code/bsd-os")) (when (c:backend-featurep :Linux) (comf "target:code/linux-os")) +(comf "target:code/os")
(when (c:backend-featurep :pmax) (comf "target:code/pmax-vm"))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/de972bb39978a910da7fe1b...