From: Nathan F. <nf...@us...> - 2006-03-20 02:49:22
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31147/src/compiler/x86 Modified Files: macros.lisp c-call.lisp cell.lisp Log Message: 0.9.10.44: Apply Alastair Bridgewater's "Small inefficiency in tl-symbol-value access" patch, sbcl-devel 11-02-2006. ... take care of cases in {c-call,cell}.lisp too. Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v retrieving revision 1.34 retrieving revision 1.35 diff -u -d -r1.34 -r1.35 --- macros.lisp 15 Mar 2006 03:01:53 -0000 1.34 +++ macros.lisp 20 Mar 2006 02:49:16 -0000 1.35 @@ -93,7 +93,7 @@ `(progn (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol)) (inst fs-segment-prefix) - (inst mov ,reg (make-ea :dword :scale 1 :index ,reg)))) + (inst mov ,reg (make-ea :dword :base ,reg)))) #!-sb-thread (defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol)) @@ -102,7 +102,7 @@ `(progn (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol)) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg))) + (inst mov (make-ea :dword :base ,temp) ,reg))) #!-sb-thread (defmacro store-tl-symbol-value (reg symbol temp) (declare (ignore temp)) Index: c-call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- c-call.lisp 6 Mar 2006 10:01:48 -0000 1.31 +++ c-call.lisp 20 Mar 2006 02:49:16 -0000 1.32 @@ -306,7 +306,7 @@ (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) (inst fs-segment-prefix) - (inst sub (make-ea :dword :scale 1 :index temp) delta))) + (inst sub (make-ea :dword :base temp) delta))) (load-tl-symbol-value result *alien-stack*)) #!-sb-thread (:generator 0 @@ -330,12 +330,12 @@ (let ((delta (logandc2 (+ amount 3) 3))) (inst mov temp (make-ea :dword - :disp (+ nil-value - (static-symbol-offset '*alien-stack*) + :disp (+ nil-value + (static-symbol-offset '*alien-stack*) (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) (inst fs-segment-prefix) - (inst add (make-ea :dword :scale 1 :index temp) delta)))) + (inst add (make-ea :dword :base temp) delta)))) #!-sb-thread (:generator 0 (unless (zerop amount) Index: cell.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/cell.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- cell.lisp 7 Mar 2006 19:06:42 -0000 1.23 +++ cell.lisp 20 Mar 2006 02:49:16 -0000 1.24 @@ -72,11 +72,10 @@ (inst or tls tls) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst cmp (make-ea :dword :scale 1 :index tls) - no-tls-value-marker-widetag) + (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls) value) + (inst mov (make-ea :dword :base tls) value) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -113,7 +112,7 @@ (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -135,7 +134,7 @@ (let ((ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -192,7 +191,7 @@ (let ((check-unbound-label (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -323,11 +322,11 @@ (emit-label tls-index-valid) (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :scale 1 :index tls-index)) + (inst mov temp (make-ea :dword :base tls-index)) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) val)))) + (inst mov (make-ea :dword :base tls-index) val)))) #!-sb-thread (define-vop (bind) @@ -355,7 +354,7 @@ (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (inst mov (make-ea :dword :base tls-index) value) (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) @@ -394,7 +393,7 @@ #!+sb-thread (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) #!+sb-thread (inst fs-segment-prefix) - #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) + #!+sb-thread (inst mov (make-ea :dword :base tls-index) value) (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) |