cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl] Pushed new branch issue-192-disassemble-prints-radix-marker
by Raymond Toy (＠rtoy) 28 Apr '23

28 Apr '23

Raymond Toy pushed new branch issue-192-disassemble-prints-radix-marker at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-192-disassemble-pri… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-185-x86-shorter-insts] Simplify test using `sign-extend`.
by Raymond Toy (＠rtoy) 27 Apr '23

27 Apr '23

Raymond Toy pushed to branch issue-185-x86-shorter-insts at cmucl / cmucl Commits: db1e9b11 by Carl S. Shapiro at 2023-04-26T22:59:49+00:00 Simplify test using `sign-extend`. - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -1274,12 +1274,7 @@ #b00000100 #b00000101))) (emit-sized-immediate segment size src)) - ((and (not (eq size :byte)) - (or (<= -128 src 127) - ;; Check that the top 25 bits are all ones so - ;; that sign-extending an 8-bit value produces - ;; the desired 32-bit value. - (= (ldb (byte 25 7) src) #x1ffffff))) + ((and (not (eq size :byte)) (<= -128 (sign-extend src 32) 127)) (emit-byte segment #b10000011) (emit-ea segment dst opcode allow-constants) (emit-byte segment (ldb (byte 8 0) src))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db1e9b11dc19a5c3cedea51… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db1e9b11dc19a5c3cedea51… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #131: Move unix-uname to contrib/unix
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: c2a99381 by Raymond Toy at 2023-04-26T21:38:42+00:00 Fix #131: Move unix-uname to contrib/unix - - - - - acb29d8f by Raymond Toy at 2023-04-26T21:38:42+00:00 Merge branch 'issue-131-move-unix-uname' into 'master' Fix #131: Move unix-uname to contrib/unix Closes #131 See merge request cmucl/cmucl!142 - - - - - 5 changed files: - src/code/exports.lisp - src/code/unix.lisp - src/contrib/unix/unix-glibc2.lisp - src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/code/exports.lisp ===================================== @@ -249,9 +249,6 @@ "OPEN-DIR" "READ-DIR" - ;; linux-os, sunos-os. - "UNIX-UNAME" - ;; filesys.lisp "UNIX-GETPWUID" @@ -411,7 +408,7 @@ "TIOCSETP" "TTY-IUCLC" "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" - "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" + "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UTSNAME" ) #+solaris ===================================== src/code/unix.lisp ===================================== @@ -2724,27 +2724,6 @@ (machine (array char 65)) (domainname (array char 65)))) -(defun unix-uname () - _N"Unix-uname returns information from the uname(2) system call. - The return values are - - Name of the operating system - Name of this node within some implementation-defined network, if any - Release level of this operating system - Version level of this operating system release - Name of the hardware type on which the system is running" - (with-alien ((names (struct utsname))) - (syscall* (#-(or freebsd (and x86 solaris)) "uname" - #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h - #+freebsd "__xuname" #+freebsd int - (* (struct utsname))) - (values (cast (slot names 'sysname) c-string) - (cast (slot names 'nodename) c-string) - (cast (slot names 'release) c-string) - (cast (slot names 'version) c-string) - (cast (slot names 'machine) c-string)) - #+freebsd 256 - (addr names)))) ;;; For asdf. Well, only getenv, but might as well make it symmetric. ===================================== src/contrib/unix/unix-glibc2.lisp ===================================== @@ -1908,5 +1908,26 @@ in at a time in poll.") :until (zerop (sap-int (alien-sap member))) :collect (string (cast member c-call:c-string)))))))) +(defun unix-uname () + _N"Unix-uname returns information from the uname(2) system call. + The return values are + + Name of the operating system + Name of this node within some implementation-defined network, if any + Release level of this operating system + Version level of this operating system release + Name of the hardware type on which the system is running" + (with-alien ((names (struct utsname))) + (syscall* (#-(or freebsd (and x86 solaris)) "uname" + #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h + #+freebsd "__xuname" #+freebsd int + (* (struct utsname))) + (values (cast (slot names 'sysname) c-string) + (cast (slot names 'nodename) c-string) + (cast (slot names 'release) c-string) + (cast (slot names 'version) c-string) + (cast (slot names 'machine) c-string)) + #+freebsd 256 + (addr names)))) ;; EOF ===================================== src/contrib/unix/unix.lisp ===================================== @@ -929,4 +929,25 @@ _N"Unix-getpagesize returns the number of bytes in a system page." (int-syscall ("getpagesize"))) +(defun unix-uname () + _N"Unix-uname returns information from the uname(2) system call. + The return values are + + Name of the operating system + Name of this node within some implementation-defined network, if any + Release level of this operating system + Version level of this operating system release + Name of the hardware type on which the system is running" + (with-alien ((names (struct utsname))) + (syscall* (#-(or freebsd (and x86 solaris)) "uname" + #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h + #+freebsd "__xuname" #+freebsd int + (* (struct utsname))) + (values (cast (slot names 'sysname) c-string) + (cast (slot names 'nodename) c-string) + (cast (slot names 'release) c-string) + (cast (slot names 'version) c-string) + (cast (slot names 'machine) c-string)) + #+freebsd 256 + (addr names)))) ;; EOF ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1370,18 +1370,6 @@ msgid "" " and its children." msgstr "" -#: src/code/unix.lisp -msgid "" -"Unix-uname returns information from the uname(2) system call.\n" -" The return values are\n" -"\n" -" Name of the operating system\n" -" Name of this node within some implementation-defined network, if any\n" -" Release level of this operating system\n" -" Version level of this operating system release\n" -" Name of the hardware type on which the system is running" -msgstr "" - #: src/code/unix.lisp msgid "" "Get the value of the environment variable named Name. If no such\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90a5e5690f8baa91a3484f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90a5e5690f8baa91a3484f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-131-move-unix-uname
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed new branch issue-131-move-unix-uname at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-131-move-unix-uname You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-185-x86-shorter-insts] Simplify testing for signed-imm-byte data using sign-extend function.,
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed to branch issue-185-x86-shorter-insts at cmucl / cmucl Commits: 54ba7245 by Carl S. Shapiro at 2023-04-25T23:53:54+00:00 Simplify testing for signed-imm-byte data using sign-extend function., - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -1304,19 +1304,12 @@ (defun arith-logical-constant-control (chunk inst stream dstate) (declare (ignore inst stream)) - (let ((opcode (ldb (byte 8 0) chunk)) - (signed-imm-data (ldb (byte 8 16) chunk))) - ;; See emit-random-arith-inst for the case where we use an 8-bit - ;; signed immediate value in the instruction. We print a note - ;; only if we have a 8-bit immediate and the 8-bit value is - ;; negative (MSB is 1). - (when (and (= opcode #b10000011) - (logbitp 7 signed-imm-data)) - (disassem:note #'(lambda (stream) - (princ (ldb (byte 32 0) - (sign-extend signed-imm-data 8)) - stream)) - dstate)))) + (when (= (ldb (byte 8 0) chunk) #b10000011) + (let ((imm (sign-extend (ldb (byte 8 16) chunk) 8))) + (when (minusp imm) + (disassem:note #'(lambda (stream) + (princ (ldb (byte 32 0) imm) stream)) + dstate))))) (eval-when (compile eval) (defun arith-inst-printer-list (subop &key control) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/54ba7245abe655147e6dfe0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/54ba7245abe655147e6dfe0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #189: Move get-system-info from unix.lisp to os.lisp
by Raymond Toy (＠rtoy) 25 Apr '23

25 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 31825793 by Raymond Toy at 2023-04-25T20:49:36+00:00 Fix #189: Move get-system-info from unix.lisp to os.lisp - - - - - 90a5e569 by Raymond Toy at 2023-04-25T20:49:36+00:00 Merge branch 'issue-189-move-get-system-info' into 'master' Fix #189: Move get-system-info from unix.lisp to os.lisp Closes #189 See merge request cmucl/cmucl!141 - - - - - 5 changed files: - src/code/os.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-linux-os.pot - + src/i18n/locale/cmucl-os.pot - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/code/os.lisp ===================================== @@ -15,7 +15,7 @@ (in-package "SYSTEM") (use-package "EXTENSIONS") -(intl:textdomain "cmucl-linux-os") +(intl:textdomain "cmucl-os") (export '(get-page-size)) @@ -33,3 +33,27 @@ maybe-page-size)) +;;; GET-SYSTEM-INFO -- Interface +;;; +;;; Return system time, user time (in usec) and number of page +;;; faults. +;;; +(defun get-system-info () + _N"Get system information consisting of the user time (in usec), the + system time (in usec) and the number of major page faults." + (alien:with-alien ((utime unix:int64-t 0) + (stime unix:int64-t 0) + (major-fault c-call:long 0)) + (let ((rc (alien:alien-funcall + (alien:extern-alien "os_get_system_info" + (function c-call:int + (* unix:int64-t) + (* unix:int64-t) + (* c-call:long))) + (alien:addr utime) + (alien:addr stime) + (alien: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/code/unix.lisp ===================================== @@ -2921,28 +2921,3 @@ (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/i18n/locale/cmucl-linux-os.pot ===================================== @@ -19,14 +19,6 @@ 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-os.pot ===================================== @@ -0,0 +1,35 @@ +#@ cmucl-os + +# SOME DESCRIPTIVE TITLE +# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\n" +"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" +"Language-Team: LANGUAGE <LL(a)li.org>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: src/code/os.lisp +msgid "Return the system page size" +msgstr "" + +#: src/code/os.lisp +msgid "get-page-size failed: ~A" +msgstr "" + +#: src/code/os.lisp +msgid "" +"Get system information consisting of the user time (in usec), the\n" +" system time (in usec) and the number of major page faults." +msgstr "" + +#: src/code/os.lisp +msgid "Unix system call getrusage failed: ~A." +msgstr "" + ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1444,13 +1444,3 @@ msgstr "" msgid "Get the codeset from the locale" msgstr "" -#: src/code/unix.lisp -msgid "" -"Get system information consisting of the user time (in usec), the\n" -" system time (in usec) and the number of major page faults." -msgstr "" - -#: src/code/unix.lisp -msgid "Unix system call getrusage failed: ~A." -msgstr "" - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/412d65234e9caf87ba2f9b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/412d65234e9caf87ba2f9b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-189-move-get-system-info] Update pot files
by Raymond Toy (＠rtoy) 21 Apr '23

21 Apr '23

Raymond Toy pushed to branch issue-189-move-get-system-info at cmucl / cmucl Commits: 527160e8 by Raymond Toy at 2023-04-21T07:17:03-07:00 Update pot files cmucl-linux-os.pot has changed because we moved some functions. Likewise cmucl-unix.pot has changed too. Add cmucl-os.pot to hold the new OS strings from os.lisp. - - - - - 3 changed files: - src/i18n/locale/cmucl-linux-os.pot - + src/i18n/locale/cmucl-os.pot - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -19,14 +19,6 @@ 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-os.pot ===================================== @@ -0,0 +1,35 @@ +#@ cmucl-os + +# SOME DESCRIPTIVE TITLE +# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\n" +"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" +"Language-Team: LANGUAGE <LL(a)li.org>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: src/code/os.lisp +msgid "Return the system page size" +msgstr "" + +#: src/code/os.lisp +msgid "get-page-size failed: ~A" +msgstr "" + +#: src/code/os.lisp +msgid "" +"Get system information consisting of the user time (in usec), the\n" +" system time (in usec) and the number of major page faults." +msgstr "" + +#: src/code/os.lisp +msgid "Unix system call getrusage failed: ~A." +msgstr "" + ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1444,13 +1444,3 @@ msgstr "" msgid "Get the codeset from the locale" msgstr "" -#: src/code/unix.lisp -msgid "" -"Get system information consisting of the user time (in usec), the\n" -" system time (in usec) and the number of major page faults." -msgstr "" - -#: src/code/unix.lisp -msgid "Unix system call getrusage failed: ~A." -msgstr "" - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/527160e8cc697f24a5c980c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/527160e8cc697f24a5c980c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-189-move-get-system-info
by Raymond Toy (＠rtoy) 21 Apr '23

21 Apr '23

Raymond Toy pushed new branch issue-189-move-get-system-info at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-189-move-get-system… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #180: Move get-page-size to C
by Raymond Toy (＠rtoy) 21 Apr '23

21 Apr '23

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/de972bb39978a910da7fe1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/de972bb39978a910da7fe1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-180-get-page-size-in-c] Update pot files
by Raymond Toy (＠rtoy) 19 Apr '23

19 Apr '23

Raymond Toy pushed to branch issue-180-get-page-size-in-c at cmucl / cmucl Commits: 6fc4c2a1 by Raymond Toy at 2023-04-19T10:05:41-07:00 Update pot files - - - - - 3 changed files: - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -16,11 +16,15 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/linux-os.lisp -msgid "Returns a string describing version of the supporting software." +msgid "Getpagesize failed: ~A" msgstr "" -#: src/code/linux-os.lisp -msgid "Unix system call getrusage failed: ~A." +#: 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 ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1445,6 +1445,12 @@ msgid "Get the codeset from the locale" msgstr "" #: src/code/unix.lisp -msgid "get-page-size failed: ~A" +msgid "" +"Get system information consisting of the user time (in usec), the\n" +" system time (in usec) and the number of major page faults." +msgstr "" + +#: src/code/unix.lisp +msgid "Unix system call getrusage failed: ~A." msgstr "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5646,6 +5646,14 @@ msgstr "" msgid "Returns a string describing the supporting software." msgstr "" +#: src/code/misc.lisp +msgid "Version string for supporting software" +msgstr "" + +#: src/code/misc.lisp +msgid "Returns a string describing version of the supporting software." +msgstr "" + #: src/code/misc.lisp msgid "The value of SHORT-SITE-NAME. Set in library:site-init.lisp." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6fc4c2a1c1645c04661b21c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6fc4c2a1c1645c04661b21c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs