From 8146eeb8708fbc225169707a49b32e9e977d546e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 5 Mar 2008 01:48:06 +0000 Subject: [PATCH] 1.0.15.14: move bignum allocation out of line on x86-64 from MOVE-FROM-[UN]SIGNED * Essentially port of the work done for x86 earlier (1.0.13.10.) Shrinks the core by about 500k. * Change the high-bits test on x86 to be clearer about what happens (no magic numbers.) * Fixups cannot be called directly on x86-64, so make the CALL instruction barf on that instead of silently generating bogus code. --- src/assembly/x86-64/alloc.lisp | 99 +++++++++++++++++-------------- src/compiler/x86-64/insts.lisp | 4 +- src/compiler/x86-64/move.lisp | 128 ++++++++++++++++++++-------------------- src/compiler/x86/move.lisp | 2 +- version.lisp-expr | 2 +- 5 files changed, 123 insertions(+), 112 deletions(-) diff --git a/src/assembly/x86-64/alloc.lisp b/src/assembly/x86-64/alloc.lisp index 314e1b0..a27364f 100644 --- a/src/assembly/x86-64/alloc.lisp +++ b/src/assembly/x86-64/alloc.lisp @@ -11,49 +11,62 @@ (in-package "SB!VM") -;;;; from signed/unsigned +;;;; Signed and unsigned bignums from word-sized integers. Argument +;;;; and return in the same register. No VOPs, as these are only used +;;;; as out-of-line versions: MOVE-FROM-[UN]SIGNED VOPs handle the +;;;; fixnum cases inline. -;;; KLUDGE: Why don't we want vops for this one and the next -;;; one? -- WHN 19990916 -#+sb-assembling ; We don't want a vop for this one. -(define-assembly-routine - (move-from-signed) - ((:temp eax unsigned-reg eax-offset) - (:temp ebx unsigned-reg ebx-offset)) - (inst mov ebx eax) - (inst shl ebx 1) - (inst jmp :o BIGNUM) - (inst shl ebx 1) - (inst jmp :o BIGNUM) - (inst shl ebx 1) - (inst jmp :o BIGNUM) - (inst ret) - BIGNUM - - (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-lowtag)) - - (inst ret)) - -#+sb-assembling ; We don't want a vop for this one either. -(define-assembly-routine - (move-from-unsigned) - ((:temp eax unsigned-reg eax-offset) - (:temp ebx unsigned-reg ebx-offset)) - - (inst bsr ebx eax) - (inst cmp ebx 61) - (inst jmp :z DONE) - (inst jmp :ge BIGNUM) - ;; Fixnum - (inst mov ebx eax) - (inst shl ebx 3) - DONE - (inst ret) - - BIGNUM - (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 2)) - (storew eax ebx bignum-digits-offset other-pointer-lowtag)) - (inst ret)) +;;; #+SB-ASSEMBLING as we don't need VOPS, just the asm routines: +;;; these are out-of-line versions called by VOPs. +#+sb-assembling +(macrolet + ((def (reg) + `(define-assembly-routine (,(symbolicate "ALLOC-SIGNED-BIGNUM-IN-" reg)) + ((:temp number unsigned-reg ,(symbolicate reg "-OFFSET"))) + (inst push number) + (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 1)) + (popw number bignum-digits-offset other-pointer-lowtag)) + (inst ret)))) + (def rax) + (def rcx) + (def rdx) + (def rbx) + (def rsi) + (def rdi) + (def r8) + (def r9) + (def r10) + (def r12) + (def r13) + (def r14) + (def r15)) +#+sb-assembling +(macrolet + ((def (reg) + `(define-assembly-routine (,(symbolicate "ALLOC-UNSIGNED-BIGNUM-IN-" reg)) + ((:temp number unsigned-reg ,(symbolicate reg "-OFFSET"))) + (inst push number) + (inst jmp :ns one-word-bignum) + ;; Two word bignum + (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 2)) + (popw number bignum-digits-offset other-pointer-lowtag)) + (inst ret) + ONE-WORD-BIGNUM + (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 1)) + (popw number bignum-digits-offset other-pointer-lowtag)) + (inst ret)))) + (def rax) + (def rcx) + (def rdx) + (def rbx) + (def rsi) + (def rdi) + (def r8) + (def r9) + (def r10) + (def r12) + (def r13) + (def r14) + (def r15)) diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 5b61b5e..3f0c6f0 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -2503,8 +2503,8 @@ (- (label-position where) (+ posn 4)))))) (fixup - (emit-byte segment #b11101000) - (emit-relative-fixup segment where)) + ;; There is no CALL rel64... + (error "Cannot CALL a fixup: ~S" where)) (t (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set) (emit-byte segment #b11111111) diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp index 1a5279c..1921dfa 100644 --- a/src/compiler/x86-64/move.lisp +++ b/src/compiler/x86-64/move.lisp @@ -295,85 +295,83 @@ (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) -;;; Result may be a bignum, so we have to check. Use a worst-case cost -;;; to make sure people know they may be number consing. +;;; Convert an untagged signed word to a lispobj -- fixnum or bignum +;;; as the case may be. Fixnum case inline, bignum case in an assembly +;;; routine. (define-vop (move-from-signed) (:args (x :scs (signed-reg unsigned-reg) :to :result)) (:results (y :scs (any-reg descriptor-reg) :from :argument)) (:note "signed word to integer coercion") - (:node-var node) + ;; Worst case cost to make sure people know they may be number consing. (:generator 20 (aver (not (location= x y))) - (let ((bignum (gen-label)) - (done (gen-label))) - ;; We can't do the overflow check with SHL Y, 3, since the - ;; state of the overflow flag is only reliably set when - ;; shifting by 1. There used to be code here for doing "shift - ;; by one, check whether it overflowed" three times. But on all - ;; x86-64 processors IMUL is a reasonably fast instruction, so - ;; we can just do a straight multiply instead of trying to - ;; optimize it to a shift. This is both faster and smaller. - ;; -- JES, 2006-07-08 - (inst imul y x (ash 1 n-fixnum-tag-bits)) - (inst jmp :o bignum) - (emit-label done) - - (assemble (*elsewhere*) - (emit-label bignum) - (with-fixed-allocation - (y bignum-widetag (+ bignum-digits-offset 1) node) - (storew x y bignum-digits-offset other-pointer-lowtag)) - (inst jmp done))))) + (let ((done (gen-label))) + (inst imul y x #.(ash 1 n-fixnum-tag-bits)) + (inst jmp :no done) + (inst mov y x) + (inst lea temp-reg-tn + (make-ea :qword :disp + (make-fixup (ecase (tn-offset y) + (#.rax-offset 'alloc-signed-bignum-in-rax) + (#.rcx-offset 'alloc-signed-bignum-in-rcx) + (#.rdx-offset 'alloc-signed-bignum-in-rdx) + (#.rbx-offset 'alloc-signed-bignum-in-rbx) + (#.rsi-offset 'alloc-signed-bignum-in-rsi) + (#.rdi-offset 'alloc-signed-bignum-in-rdi) + (#.r8-offset 'alloc-signed-bignum-in-r8) + (#.r9-offset 'alloc-signed-bignum-in-r9) + (#.r10-offset 'alloc-signed-bignum-in-r10) + (#.r12-offset 'alloc-signed-bignum-in-r12) + (#.r13-offset 'alloc-signed-bignum-in-r13) + (#.r14-offset 'alloc-signed-bignum-in-r14) + (#.r15-offset 'alloc-signed-bignum-in-r15)) + :assembly-routine))) + (inst call temp-reg-tn) + (emit-label done)))) (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) -;;; Check for fixnum, and possibly allocate one or two word bignum -;;; result. Use a worst-case cost to make sure people know they may be -;;; number consing. - +;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum +;;; as the case may be. Fixnum case inline, bignum case in an assembly +;;; routine. (define-vop (move-from-unsigned) - (:args (x :scs (signed-reg unsigned-reg) :to :save)) - (:temporary (:sc unsigned-reg) alloc) - (:results (y :scs (any-reg descriptor-reg))) - (:node-var node) + (:args (x :scs (signed-reg unsigned-reg) :to :result)) + (:results (y :scs (any-reg descriptor-reg) :from :argument)) (:note "unsigned word to integer coercion") + ;; Worst case cost to make sure people know they may be number consing. (:generator 20 (aver (not (location= x y))) - (aver (not (location= x alloc))) - (aver (not (location= y alloc))) - (let ((bignum (gen-label)) - (done (gen-label)) - (one-word-bignum (gen-label)) - (L1 (gen-label))) - (inst bsr y x) ;find msb - (inst cmov :z y x) - (inst cmp y 60) - (inst jmp :ae bignum) + (let ((done (gen-label))) + (inst mov y #.(ash lowtag-mask (- n-word-bits n-fixnum-tag-bits 1))) + ;; The assembly routines test the sign flag from this one, so if + ;; you change stuff here, make sure the sign flag doesn't get + ;; overwritten before the CALL! + (inst test x y) + ;; Faster but bigger then SHL Y 4. The cost of doing this + ;; speculatively should be noise compared to bignum consing if + ;; that is needed and saves one branch. (inst lea y (make-ea :qword :index x :scale 8)) - (emit-label done) - (assemble (*elsewhere*) - (emit-label bignum) - ;; Note: As on the mips port, space for a two word bignum is - ;; always allocated and the header size is set to either one - ;; or two words as appropriate. - (inst cmp y 63) - (inst jmp :l one-word-bignum) - ;; two word bignum - (inst mov y (logior (ash (1- (+ bignum-digits-offset 2)) - n-widetag-bits) - bignum-widetag)) - (inst jmp L1) - (emit-label one-word-bignum) - (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) - n-widetag-bits) - bignum-widetag)) - (emit-label L1) - (pseudo-atomic - (allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node) - (storew y alloc) - (inst lea y (make-ea :byte :base alloc :disp other-pointer-lowtag)) - (storew x y bignum-digits-offset other-pointer-lowtag)) - (inst jmp done))))) + (inst jmp :z done) + (inst mov y x) + (inst lea temp-reg-tn + (make-ea :qword :disp + (make-fixup (ecase (tn-offset y) + (#.rax-offset 'alloc-unsigned-bignum-in-rax) + (#.rcx-offset 'alloc-unsigned-bignum-in-rcx) + (#.rdx-offset 'alloc-unsigned-bignum-in-rdx) + (#.rbx-offset 'alloc-unsigned-bignum-in-rbx) + (#.rsi-offset 'alloc-unsigned-bignum-in-rsi) + (#.rdi-offset 'alloc-unsigned-bignum-in-rdi) + (#.r8-offset 'alloc-unsigned-bignum-in-r8) + (#.r9-offset 'alloc-unsigned-bignum-in-r9) + (#.r10-offset 'alloc-unsigned-bignum-in-r10) + (#.r12-offset 'alloc-unsigned-bignum-in-r12) + (#.r13-offset 'alloc-unsigned-bignum-in-r13) + (#.r14-offset 'alloc-unsigned-bignum-in-r14) + (#.r15-offset 'alloc-unsigned-bignum-in-r15)) + :assembly-routine))) + (inst call temp-reg-tn) + (emit-label done)))) (define-move-vop move-from-unsigned :move (unsigned-reg) (descriptor-reg)) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index fa79459..24b4083 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -247,7 +247,7 @@ ;; The assembly routines test the sign flag from this one, so if ;; you change stuff here, make sure the sign flag doesn't get ;; overwritten before the CALL! - (inst test x #xe0000000) + (inst test x #.(ash lowtag-mask (- n-word-bits n-fixnum-tag-bits 1))) ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively ;; is noise compared to bignum consing if that is needed. (inst lea y (make-ea :dword :index x :scale 4)) diff --git a/version.lisp-expr b/version.lisp-expr index 4aa379c..fa11b4d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.15.13" +"1.0.15.14" -- 1.7.10.4