[Git][cmucl/cmucl][master] 2 commits: Fix #180: Move get-page-size to C
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Fri Apr 21 13:35:19 UTC 2023
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/de972bb39978a910da7fe1bef5c7d20070bab891...412d65234e9caf87ba2f9bb4347dce03188f7340
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/de972bb39978a910da7fe1bef5c7d20070bab891...412d65234e9caf87ba2f9bb4347dce03188f7340
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/20230421/326a0460/attachment-0001.html>
More information about the cmucl-cvs
mailing list