December 2015 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] Update from logs.
by Raymond Toy 05 Dec '15

05 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1d64f63b by Raymond Toy at 2015-12-05T17:01:22Z Update from logs. - - - - - 1 changed file: - src/general-info/release-21b.txt Changes: ===================================== src/general-info/release-21b.txt ===================================== --- a/src/general-info/release-21b.txt +++ b/src/general-info/release-21b.txt @@ -42,10 +42,12 @@ New in this release: of BYTE and WORD. * Unix support on Linux has been unified with all other OSes. Thus, src/code/unix-glibc2.lisp is no longer used. + * Micro-optimize modular shifts on x86. * ANSI compliance fixes: * Bugfixes: + * Linux was missing unix-setitimer which prevented saving cores. * Trac Tickets: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1d64f63b45cfe030f76132521…

1 0

[Git][cmucl/cmucl][master] Regenerated.
by Raymond Toy 05 Dec '15

05 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: be500bc5 by Raymond Toy at 2015-12-05T16:10:46Z Regenerated. - - - - - 1 changed file: - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -1298,14 +1298,6 @@ msgstr "" #: src/code/unix.lisp msgid "" -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). On success,\n" -" unix-getitimer returns 5 values,\n" -" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." -msgstr "" - -#: src/code/unix.lisp -msgid "" "Return a USER-INFO structure for the user identified by UID, or NIL if not " "found." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/be500bc5ecbfb12a4053c9e24…

1 0

[Git][cmucl/cmucl][master] Linux needs unix-setitimer
by Raymond Toy 02 Dec '15

02 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 5406768c by Raymond Toy at 2015-12-02T20:07:43Z Linux needs unix-setitimer Cut and paste error from unix-glibc2.lisp copied unix-getitimer instead of unix-setitimer which is needed by SAVE-LISP. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -2661,12 +2661,18 @@ which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) #+linux -(defun unix-getitimer (which) - _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of - three system timers (:real :virtual or :profile). On success, - unix-getitimer returns 5 values, - T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." +(defun unix-setitimer (which int-secs int-usec val-secs val-usec) + _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). A SIGALRM signal + will be delivered VALUE <seconds+microseconds> from now. INTERVAL, + when non-zero, is <seconds+microseconds> to be loaded each time + the timer expires. Setting INTERVAL and VALUE to zero disables + the timer. See the Unix man page for more details. On success, + unix-setitimer returns the old contents of the INTERVAL and VALUE + slots as in unix-getitimer." (declare (type (member :real :virtual :profile) which) + (type (unsigned-byte 29) int-secs val-secs) + (type (integer 0 (1000000)) int-usec val-usec) (values t (unsigned-byte 29)(mod 1000000) (unsigned-byte 29)(mod 1000000))) @@ -2674,14 +2680,19 @@ (:real ITIMER-REAL) (:virtual ITIMER-VIRTUAL) (:profile ITIMER-PROF)))) - (with-alien ((itv (struct itimerval))) - (syscall* ("getitimer" int (* (struct itimerval))) + (with-alien ((itvn (struct itimerval)) + (itvo (struct itimerval))) + (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs + (slot (slot itvn 'it-interval) 'tv-usec) int-usec + (slot (slot itvn 'it-value ) 'tv-sec ) val-secs + (slot (slot itvn 'it-value ) 'tv-usec) val-usec) + (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval))) (values T - (slot (slot itv 'it-interval) 'tv-sec) - (slot (slot itv 'it-interval) 'tv-usec) - (slot (slot itv 'it-value) 'tv-sec) - (slot (slot itv 'it-value) 'tv-usec)) - which (alien-sap (addr itv)))))) + (slot (slot itvo 'it-interval) 'tv-sec) + (slot (slot itvo 'it-interval) 'tv-usec) + (slot (slot itvo 'it-value) 'tv-sec) + (slot (slot itvo 'it-value) 'tv-usec)) + which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) ;;;; User and group database access, POSIX Standard 9.2.2 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5406768cc69dd57ac8c719287…

1 0

[Git][cmucl/cmucl][master] Handle large (fixed) shift amounts for the digit shifters.
by Raymond Toy 01 Dec '15

01 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1b8b84be by Raymond Toy at 2015-12-01T21:41:49Z Handle large (fixed) shift amounts for the digit shifters. Make the vops handle the case when the known constant shift amount is so large that the result is a known value. Plus, the instructions have a fixed immediate argument size and the amount is taken mod 32 which would produce the wrong result if the actual shift amount were used. - - - - - 1 changed file: - src/compiler/x86/arith.lisp Changes: ===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1459,29 +1459,48 @@ (move ecx count) (inst sar result :cl)) (immediate - (inst sar result (tn-value count)))))) + (let ((amount (tn-value count))) + ;; If the amount is greater than 31, it's the same as + ;; shifting by 31, leaving just the sign bit. + (inst sar result (if (>= amount vm:word-bits) + (1- vm:word-bits) + amount))))))) (define-vop (digit-lshr digit-ashr) (:translate bignum::%digit-logical-shift-right) (:generator 2 - (move result digit) (sc-case count (unsigned-reg + (move result digit) (move ecx count) (inst shr result :cl)) (immediate - (inst shr result (tn-value count)))))) + (let ((amount (tn-value count))) + ;; If the amount is greater than 31, the result is 0 because + ;; all the bits get shifted right and out. + (cond ((>= amount vm:word-bits) + (inst mov result 0)) + (t + (move result digit) + (inst shr result count)))))))) (define-vop (digit-ashl digit-ashr) (:translate bignum::%ashl) (:generator 2 - (move result digit) (sc-case count (unsigned-reg + (move result digit) (move ecx count) (inst shl result :cl)) (immediate - (inst shl result (tn-value count)))))) + (let ((amount (tn-value count))) + ;; If the amount is greater than 31, the result is 0 because + ;; all the bits get shifted left and out. + (cond ((>= amount vm:word-bits) + (inst mov result 0)) + (t + (move result digit) + (inst shl result amount)))))))) ;;;; Static functions. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1b8b84be82ebb9fb86ddd5159…

1 0