cmucl-cvs January 2016

cmucl-cvs@common-lisp.net

1 participants
28 discussions

[Git][cmucl/cmucl][master] Clean up make-double-float vop.
by Raymond Toy 25 Jan '16

25 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b059caca by Raymond Toy at 2016-01-24T20:21:39Z Clean up make-double-float vop. Remove the :load-if stuff. Don't think it's needed. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -1178,10 +1178,8 @@ (inst movd res bits))))))) (define-vop (make-double-float) - (:args (hi-bits :scs (signed-reg) - :load-if (not (sc-is hi-bits signed-stack))) - (lo-bits :scs (unsigned-reg) - :load-if (not (sc-is lo-bits signed-stack)))) + (:args (hi-bits :scs (signed-reg)) + (lo-bits :scs (unsigned-reg))) (:results (res :scs (double-reg))) (:arg-types signed-num unsigned-num) (:result-types double-float) @@ -1195,7 +1193,6 @@ (inst movd res lo-bits) (inst orpd res temp))) - (define-vop (single-float-bits) (:args (float :scs (single-reg descriptor-reg) :load-if (not (sc-is float single-stack)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/b059caca3cd4c094432493b17…

1 0

[Git][cmucl/cmucl][master] 2 commits: Add orps and orpd SSE2 instructions.
by Raymond Toy 24 Jan '16

24 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 23209c84 by Raymond Toy at 2016-01-23T14:28:45Z Add orps and orpd SSE2 instructions. - - - - - 187d987e by Raymond Toy at 2016-01-23T14:31:09Z Use SSE2 instructions for MAKE-DOUBLE-FLOAT Instead of storing the high and low words to memory and then loading it into the double-reg, use SSE2 instructions to directly create the double-float from the high and low words. - - - - - 2 changed files: - src/compiler/x86/float-sse2.lisp - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -1178,21 +1178,22 @@ (inst movd res bits))))))) (define-vop (make-double-float) - (:args (hi-bits :scs (signed-reg)) - (lo-bits :scs (unsigned-reg))) + (:args (hi-bits :scs (signed-reg) + :load-if (not (sc-is hi-bits signed-stack))) + (lo-bits :scs (unsigned-reg) + :load-if (not (sc-is lo-bits signed-stack)))) (:results (res :scs (double-reg))) - (:temporary (:sc double-stack) temp) (:arg-types signed-num unsigned-num) (:result-types double-float) (:translate make-double-float) + (:temporary (:sc double-reg) temp) (:policy :fast-safe) (:vop-var vop) - (:generator 2 - (let ((offset (1+ (tn-offset temp)))) - (storew hi-bits ebp-tn (- offset)) - (storew lo-bits ebp-tn (- (1+ offset))) - (inst movsd res (make-ea :dword :base ebp-tn - :disp (- (* (1+ offset) word-bytes))))))) + (:generator 4 + (inst movd temp hi-bits) + (inst psllq temp 32) + (inst movd res lo-bits) + (inst orpd res temp))) (define-vop (single-float-bits) ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -3146,6 +3146,8 @@ ;; logical (define-regular-sse-inst andpd #x66 #x54 t) (define-regular-sse-inst andps nil #x54) + (define-regular-sse-inst orpd #x66 #x56 t) + (define-regular-sse-inst orps nil #x56) (define-regular-sse-inst xorpd #x66 #x57 t) (define-regular-sse-inst xorps nil #x57) ;; comparison View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/351351dfc04be5578dc76650…

1 0

[Git][cmucl/cmucl][master] 2 commits: Add orps and orpd SSE2 instructions.
by Raymond Toy 23 Jan '16

23 Jan '16

1 0

[Git][cmucl/cmucl][master] Simplify bignum-shld and bignum-shrd vops.
by Raymond Toy 18 Jan '16

18 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 351351df by Raymond Toy at 2016-01-17T23:53:43Z Simplify bignum-shld and bignum-shrd vops. One temp variable for bignum-shld can be removed and the only temp variable for bignum-shld-c can be removed. Base this on the digit-ashr vops. This makes the vops simpler and faster. - - - - - 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 @@ -1583,80 +1583,48 @@ (define-vop (bignum-shld) (:policy :fast-safe) (:translate bignum::%shld) - (:args (x :scs (unsigned-reg) :target r) - (shift-in :scs (unsigned-reg)) + (:args (x :scs (unsigned-reg unsigned-stack) :target r) + (shift-in :scs (unsigned-reg) :to :result) (amount :scs (unsigned-reg) :target cl)) (:arg-types unsigned-num unsigned-num unsigned-num) - (:results (r :scs (unsigned-reg))) + (:results (r :scs (unsigned-reg) + :load-if (not (and (sc-is r unsigned-stack) + (location= x r))))) (:result-types unsigned-num) - (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) (:temporary (:sc unsigned-reg :offset ecx-offset - :from (:argument 2) :to (:result 0)) cl) - (:generator 4 + :from (:argument 2)) cl) + (:generator 3 (move cl amount) - (cond ((location= x r) - (inst shld x shift-in :cl)) - (t - (move temp x) - (inst shld temp shift-in :cl) - (move r temp))))) + (move r x) + (inst shld r shift-in :cl))) (define-vop (bignum-shld-c) (:policy :fast-safe) (:translate bignum::%shld) - (:args (x :scs (unsigned-reg) :target r) - (shift-in :scs (unsigned-reg))) + (:args (x :scs (unsigned-reg unsigned-stack) :target r) + (shift-in :scs (unsigned-reg) :to :save)) (:info shift) (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) - (:results (r :scs (unsigned-reg))) + (:results (r :scs (unsigned-reg) + :load-if (not (and (sc-is r unsigned-stack) + (location= x r))))) (:result-types unsigned-num) - (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) - (:generator 3 - (cond ((location= x r) - (inst shld x shift-in shift)) - (t - (move temp x) - (inst shld temp shift-in shift) - (move r temp))))) + (:generator 2 + (move r x) + (inst shld r shift-in shift))) -(define-vop (bignum-shrd) - (:policy :fast-safe) +(define-vop (bignum-shrd bignum-shld) (:translate bignum::%shrd) - (:args (x :scs (unsigned-reg) :target r) - (shift-in :scs (unsigned-reg)) - (amount :scs (unsigned-reg) :target cl)) - (:arg-types unsigned-num unsigned-num unsigned-num) - (:results (r :scs (unsigned-reg))) - (:result-types unsigned-num) - (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) - (:temporary (:sc unsigned-reg :offset ecx-offset - :from (:argument 2) :to (:result 0)) cl) - (:generator 4 + (:generator 3 (move cl amount) - (cond ((location= x r) - (inst shrd x shift-in :cl)) - (t - (move temp x) - (inst shrd temp shift-in :cl) - (move r temp))))) + (move r x) + (inst shrd r shift-in :cl))) -(define-vop (bignum-shrd-c) - (:policy :fast-safe) +(define-vop (bignum-shrd-c bignum-shld-c) (:translate bignum::%shrd) - (:args (x :scs (unsigned-reg)) - (shift-in :scs (unsigned-reg))) - (:info shift) - (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) - (:results (r :scs (unsigned-reg))) - (:result-types unsigned-num) - (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) - (:generator 3 - (cond ((location= x r) - (inst shrd x shift-in shift)) - (t - (move temp x) - (inst shrd temp shift-in shift) - (move r temp))))) + (:generator 2 + (move r x) + (inst shrd r shift-in shift))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/351351dfc04be5578dc76650c…

1 0

[Git][cmucl/cmucl][master] Indent nicely.
by Raymond Toy 18 Jan '16

18 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 909ad007 by Raymond Toy at 2016-01-17T20:57:41Z Indent nicely. - - - - - 1 changed file: - src/code/bignum.lisp Changes: ===================================== src/code/bignum.lisp ===================================== --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -3721,5 +3721,5 @@ friends is working. (%shrd x carry-in shift) #-x86 (ldb (byte vm:word-bits 0) - (logior (ash x (- shift)) - (ash carry-in (- vm:word-bits shift))))) + (logior (ash x (- shift)) + (ash carry-in (- vm:word-bits shift))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/909ad0074d079350b658f0f66…

1 0

[Git][cmucl/cmucl][master] Add bignum::%shld and bignum::%shrd
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ddc980d5 by Raymond Toy at 2016-01-16T14:34:19Z Add bignum::%shld and bignum::%shrd These are useful for multi-precision shifts. For x86, we can use the shld and shrd instructions. For others, we just use basic logical operations. - - - - - 3 changed files: - src/code/bignum.lisp - src/compiler/generic/vm-fndb.lisp - src/compiler/x86/arith.lisp Changes: ===================================== src/code/bignum.lisp ===================================== --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -3697,3 +3697,29 @@ friends is working. (unless (= newlen len) (%bignum-set-length result newlen)) result)) + +;; Shift X left by Shift bits, shifting in bits from Carry-in. +;; Basically treat x:carry-in as a 64-bit value and shift it left, +;; returning the top bignum-type bits. +(defun %shld (x carry-in shift) + (declare (type bignum-element-type x carry-in) + (type (unsigned-byte 5) shift)) + #+x86 + (%shld x carry-in shift) + #-x86 + (ldb (byte vm:word-bits 0) + (logior (ash x shift) + (ash carry-in (- shift vm:word-bits))))) + +;; Shift X right by Shift bits, shifting in bits from Carry-in. +;; Basically treat carry-in:x as a 64-bit value and shift it right, +;; returning the low bignum-type bits. +(defun %shrd (x carry-in shift) + (declare (type bignum-element-type x carry-in) + (type (unsigned-byte 5) shift)) + #+x86 + (%shrd x carry-in shift) + #-x86 + (ldb (byte vm:word-bits 0) + (logior (ash x (- shift)) + (ash carry-in (- vm:word-bits shift))))) ===================================== src/compiler/generic/vm-fndb.lisp ===================================== --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -288,6 +288,13 @@ (bignum-element-type (mod #+amd64 64 #-amd64 32)) bignum-element-type (foldable flushable movable)) + +#+x86 +(defknown (bignum::%shld bignum::%shrd) + (bignum-element-type bignum-element-type (unsigned-byte 5)) + bignum-element-type + (foldable flushable movable)) + ;;;; Bit-bashing routines. ===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1579,6 +1579,86 @@ (inst mov tmp y) (inst shr tmp 18) (inst xor y tmp))) + +(define-vop (bignum-shld) + (:policy :fast-safe) + (:translate bignum::%shld) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg)) + (amount :scs (unsigned-reg) :target cl)) + (:arg-types unsigned-num unsigned-num unsigned-num) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:temporary (:sc unsigned-reg :offset ecx-offset + :from (:argument 2) :to (:result 0)) cl) + (:generator 4 + (move cl amount) + (cond ((location= x r) + (inst shld x shift-in :cl)) + (t + (move temp x) + (inst shld temp shift-in :cl) + (move r temp))))) + +(define-vop (bignum-shld-c) + (:policy :fast-safe) + (:translate bignum::%shld) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg))) + (:info shift) + (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:generator 3 + (cond ((location= x r) + (inst shld x shift-in shift)) + (t + (move temp x) + (inst shld temp shift-in shift) + (move r temp))))) + +(define-vop (bignum-shrd) + (:policy :fast-safe) + (:translate bignum::%shrd) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg)) + (amount :scs (unsigned-reg) :target cl)) + (:arg-types unsigned-num unsigned-num unsigned-num) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:temporary (:sc unsigned-reg :offset ecx-offset + :from (:argument 2) :to (:result 0)) cl) + (:generator 4 + (move cl amount) + (cond ((location= x r) + (inst shrd x shift-in :cl)) + (t + (move temp x) + (inst shrd temp shift-in :cl) + (move r temp))))) + +(define-vop (bignum-shrd-c) + (:policy :fast-safe) + (:translate bignum::%shrd) + (:args (x :scs (unsigned-reg)) + (shift-in :scs (unsigned-reg))) + (:info shift) + (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:generator 3 + (cond ((location= x r) + (inst shrd x shift-in shift)) + (t + (move temp x) + (inst shrd temp shift-in shift) + (move r temp))))) + + ;;; Modular arithmetic ;;; logical operations View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a9…

1 0

[Git][cmucl/cmucl][master] Fix up shld/shrd instructions.
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 8058d410 by Raymond Toy at 2016-01-16T13:01:37Z Fix up shld/shrd instructions. o Need to define a new instruction format for these double shifts; they look like ext-reg-reg/mem but there's no width field. o Clean up emit-double-shift slightly. o Update double-shift-inst-printer-list to support both immediate shift or shifts in CL. - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -859,6 +859,18 @@ ;; optional fields (imm)) +;; Double shift instructions. Like ext-reg-reg/mem but there's no +;; width field. +(disassem:define-instruction-format (ext-reg-reg/mem-shift 24) + (prefix :field (byte 8 0) :value #b00001111) + (op :field (byte 8 8)) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) + :type 'reg/mem) + (reg :field (byte 3 19) :type 'reg) + ;; optional fields + (imm)) + + ;;; ---------------------------------------------------------------- ;;; this section added by jrd, for fp instructions. @@ -1535,24 +1547,22 @@ (defun emit-double-shift (segment opcode dst src amt) (let ((size (matching-operand-size dst src))) (when (eq size :byte) - (error "Double shifts can only be used with words.")) + (error "Double shifts cannot be used with byte registers.")) (maybe-emit-operand-size-prefix segment size) (emit-byte segment #b00001111) (emit-byte segment (dpb opcode (byte 1 3) (if (eq amt :cl) #b10100101 #b10100100))) - #+nil - (emit-ea segment dst src) - (emit-ea segment dst (reg-tn-encoding src)) ; pw tries this + (emit-ea segment dst (reg-tn-encoding src)) (unless (eq amt :cl) (emit-byte segment amt)))) (eval-when (compile eval) (defun double-shift-inst-printer-list (op) - `(#+nil - (ext-reg-reg/mem-imm ((op ,(logior op #b100)) - (imm nil :type signed-imm-byte))) - (ext-reg-reg/mem ((op ,(logior op #b101))) - (:name :tab reg/mem ", " 'cl))))) + `((ext-reg-reg/mem-shift ((op ,(logior op #b100)) + (imm nil :type signed-imm-byte)) + (:name :tab reg/mem ", " reg ", " imm)) + (ext-reg-reg/mem-shift ((op ,(logior op #b101))) + (:name :tab reg/mem ", " reg ", " 'cl))))) (define-instruction shld (segment dst src amt) (:declare (type (or (member :cl) (mod 32)) amt)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/8058d410e86a77a6839d4c422…

1 0

[Git][cmucl/cmucl][master] Regenerated.
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 06a68321 by Raymond Toy at 2016-01-16T12:58:43Z Regenerated. - - - - - 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 @@ -6654,7 +6654,9 @@ msgid "" msgstr "" #: src/code/save.lisp -msgid "An alist mapping environment variables (as keywords) to either values" +msgid "" +"An alist mapping each environment variable (as a keyword) to its\n" +" value." msgstr "" #: src/code/save.lisp @@ -13122,8 +13124,9 @@ msgid "" "\n" " The keyword arguments have the following meanings:\n" " :env -\n" -" An A-LIST mapping keyword environment variables to simple-string\n" -" values.\n" +" An A-LIST mapping keyword environment variables to\n" +" simple-string values. This is the shell environment for\n" +" Program. Defaults to *environment-list*.\n" " :wait -\n" " If non-NIL (default), wait until the created process finishes. If\n" " NIL, continue running Lisp until the program finishes.\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/06a683219621cc8e381b3d6ee…

1 0

[Git][cmucl/cmucl][master] Add comment on why RESTORE_FPU is needed.
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 6feaee2d by Raymond Toy at 2016-01-16T08:37:03Z Add comment on why RESTORE_FPU is needed. - - - - - 1 changed file: - src/lisp/x86-arch.c Changes: ===================================== src/lisp/x86-arch.c ===================================== --- a/src/lisp/x86-arch.c +++ b/src/lisp/x86-arch.c @@ -320,6 +320,12 @@ sigtrap_handler(HANDLER_ARGS) /* This is just for info in case monitor wants to print an approx */ current_control_stack_pointer = (unsigned long *) SC_SP(os_context); + + /* + * In many places in the switch below, we eventually throw instead + * of returning from the signal handler. So, just in case, set + * the current FPU modes from the saved context. + */ RESTORE_FPU(os_context); /* View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/6feaee2df686c62509f7c2292…

1 0

[Git][cmucl/cmucl][master] Actually remove RESTORE_FPU's that were #if'ed out.
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 17932a00 by Raymond Toy at 2016-01-16T08:33:55Z Actually remove RESTORE_FPU's that were #if'ed out. - - - - - 1 changed file: - src/lisp/interrupt.c Changes: ===================================== src/lisp/interrupt.c ===================================== --- a/src/lisp/interrupt.c +++ b/src/lisp/interrupt.c @@ -252,10 +252,6 @@ interrupt_handle_now(HANDLER_ARGS) handler = interrupt_handlers[signal]; -#if 0 - RESTORE_FPU(context); -#endif - if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN) return; @@ -335,9 +331,6 @@ maybe_now_maybe_later(HANDLER_ARGS) setup_pending_signal(signal, code, context); arch_set_pseudo_atomic_interrupted(context); } else { -#if 0 - RESTORE_FPU(context); -#endif interrupt_handle_now(signal, code, context); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/17932a00d691bb2dada5da81f…

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs January 2016