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

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

06 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 06 Dec '15

06 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 03 Dec '15

03 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 02 Dec '15

02 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

[Git][cmucl/cmucl][master] Regenerated (due to docstring change for rename-package).
by Raymond Toy 29 Nov '15

29 Nov '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a613a908 by Raymond Toy at 2015-11-28T16:45:41Z Regenerated (due to docstring change for rename-package). - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -8120,7 +8120,10 @@ msgid "The package named ~S doesn't exist." msgstr "" #: src/code/package.lisp -msgid "Changes the name and nicknames for a package." +msgid "" +"Replaces the name and nicknames of Package. The old name and all of\n" +" the old nicknames of Package are eliminated and are replaced by\n" +" New-Name and New-Nicknames." msgstr "" #: src/code/package.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/a613a908988d4651740972f40…

1 0

[Git][cmucl/cmucl][master] Support constant shifts for bignum digits.
by Raymond Toy 29 Nov '15

29 Nov '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 5d3a63fa by Raymond Toy at 2015-11-28T16:43:54Z Support constant shifts for bignum digits. This gets rid of the load of the shift amount to ecx, saving one instruction and reducing pressure on the ecx register. - - - - - 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 @@ -1445,31 +1445,43 @@ (:translate bignum::%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target result) - (count :scs (unsigned-reg) :target ecx)) + (count :scs (unsigned-reg immediate))) (:arg-types unsigned-num positive-fixnum) (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx) (:results (result :scs (unsigned-reg) :from (:argument 0) :load-if (not (and (sc-is result unsigned-stack) (location= digit result))))) (:result-types unsigned-num) - (:generator 1 + (:generator 2 (move result digit) - (move ecx count) - (inst sar result :cl))) + (sc-case count + (unsigned-reg + (move ecx count) + (inst sar result :cl)) + (immediate + (inst sar result (tn-value count)))))) (define-vop (digit-lshr digit-ashr) (:translate bignum::%digit-logical-shift-right) - (:generator 1 + (:generator 2 (move result digit) - (move ecx count) - (inst shr result :cl))) + (sc-case count + (unsigned-reg + (move ecx count) + (inst shr result :cl)) + (immediate + (inst shr result (tn-value count)))))) (define-vop (digit-ashl digit-ashr) (:translate bignum::%ashl) - (:generator 1 + (:generator 2 (move result digit) - (move ecx count) - (inst shl result :cl))) + (sc-case count + (unsigned-reg + (move ecx count) + (inst shl result :cl)) + (immediate + (inst shl result (tn-value count)))))) ;;;; Static functions. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5d3a63fa223ea40f8625a47d3…

1 0

[Git][cmucl/cmucl][master] Rename arguments to RENAME-PACKAGE and update docstring
by Raymond Toy 11 Nov '15

11 Nov '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f7e92b73 by Raymond Toy at 2015-11-10T21:39:15Z Rename arguments to RENAME-PACKAGE and update docstring Can't ever remember the order of arguments for RENAME-PACKAGE so just rename the variables to make it clearer. And update the docstring to be a little more verbose. - - - - - 1 changed file: - src/code/package.lisp Changes: ===================================== src/code/package.lisp ===================================== --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -1204,23 +1204,25 @@ ;;; Change the name if we can, blast any old nicknames and then ;;; add in any new ones. ;;; -(defun rename-package (package name &optional (nicknames ())) - "Changes the name and nicknames for a package." +(defun rename-package (package new-name &optional (new-nicknames ())) + "Replaces the name and nicknames of Package. The old name and all of + the old nicknames of Package are eliminated and are replaced by + New-Name and New-Nicknames." (let* ((package (package-or-lose package)) - (name (string name)) - (found (find-package name))) + (new-name (string new-name)) + (found (find-package new-name))) (unless (or (not found) (eq found package)) (error 'simple-package-error - :package name + :package new-name :format-control (intl:gettext "A package named ~S already exists.") - :format-arguments (list name))) + :format-arguments (list new-name))) (remhash (package-%name package) *package-names*) (dolist (n (package-%nicknames package)) (remhash n *package-names*)) - (setf (package-%name package) name) - (setf (gethash name *package-names*) package) + (setf (package-%name package) new-name) + (setf (gethash new-name *package-names*) package) (setf (package-%nicknames package) ()) - (enter-new-nicknames package nicknames) + (enter-new-nicknames package new-nicknames) package)) ;;; Delete-Package -- Public View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f7e92b739fe1311d89924c9a5…

1 0

[Git][cmucl/cmucl][rtoy-mmap-anon-control-and-binding-stacks] Remove some unused code.
by Raymond Toy 05 Nov '15

05 Nov '15

Raymond Toy pushed to branch rtoy-mmap-anon-control-and-binding-stacks at cmucl / cmucl Commits: 70f15c09 by Raymond Toy at 2015-11-04T19:49:31Z Remove some unused code. - - - - - 1 changed file: - src/lisp/interrupt.c Changes: ===================================== src/lisp/interrupt.c ===================================== --- a/src/lisp/interrupt.c +++ b/src/lisp/interrupt.c @@ -408,10 +408,7 @@ interrupt_maybe_gc(HANDLER_ARGS) * Noise to install handlers. * \****************************************************************/ -//#if !(defined(i386) || defined(__x86_64)) -//#define SIGNAL_STACK_SIZE SIGSTKSZ char altstack[SIGNAL_STACK_SIZE]; -//#endif void interrupt_install_low_level_handler(int signal, void handler(HANDLER_ARGS)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/70f15c09eb7c4cb656ab38026…

1 0

[Git][cmucl/cmucl][rtoy-mmap-anon-control-and-binding-stacks] 2 commits: Fix merge mistake: Don't print break as int3.
by Raymond Toy 05 Nov '15

05 Nov '15

Raymond Toy pushed to branch rtoy-mmap-anon-control-and-binding-stacks at cmucl / cmucl Commits: 694331c1 by Raymond Toy at 2015-11-04T19:42:41Z Fix merge mistake: Don't print break as int3. - - - - - 0fb5c699 by Raymond Toy at 2015-11-04T19:44:58Z Define CONTROL_STACK_START and BINDING_STACK_START. ppc currently only supports allocating the control stack and binding stack at fixed addresses. (This used to work, but something broke it recently. Until the ppc machine comes back, we're going to disable that feature there.) - - - - - 2 changed files: - src/compiler/x86/insts.lisp - src/lisp/ppc-validate.h Changes: ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -2105,7 +2105,6 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :print-name 'int3 :control #'break-control) (:emitter (emit-byte segment #b11001100) ===================================== src/lisp/ppc-validate.h ===================================== --- a/src/lisp/ppc-validate.h +++ b/src/lisp/ppc-validate.h @@ -41,19 +41,13 @@ #define STATIC_SPACE_START (0x10000000) #define STATIC_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ -#if 0 #define CONTROL_STACK_START (0x30000000) -#endif #define CONTROL_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ -#if 0 #define CONTROL_STACK_END (CONTROL_STACK_START + control_stack_size) -#endif #define SIGNAL_STACK_SIZE SIGSTKSZ -#if 0 #define BINDING_STACK_START (0x38000000) -#endif #define BINDING_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ #if 0 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/138310f93edc558e3166c1a1…

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2015-11
by Raymond Toy 01 Nov '15

01 Nov '15

Raymond Toy pushed new tag snapshot-2015-11 at cmucl / cmucl

1 0