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…
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…
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…
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…