From e0bacf086afba98465c33f63893d805e86c4f80f Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 20 Sep 2008 03:09:58 +0000 Subject: [PATCH] 1.0.20.16: make LOCK and FS prefixes part of the affected instruction * Disassembler still shows them as a separate instructions, but in assembler the prefixes become postfixes to the instructions they modify: (INST MOV X Y :FS), etc. * Not only does this reduce the amount of conditionalization, but making prefixes part of the instruction they modify seems necessary if we ever want to turn on the instruction scheduler on x86oids, and is probably needed for a peephole optimizer as well. * Also fix x86-64 build: missed one ALIGN to EMIT-ALIGNMENT renaming. --- src/assembly/x86-64/alloc.lisp | 3 +-- src/assembly/x86/alloc.lisp | 3 +-- src/compiler/codegen.lisp | 2 +- src/compiler/x86-64/cell.lisp | 16 ++++-------- src/compiler/x86-64/insts.lisp | 29 +++++++++++++-------- src/compiler/x86-64/macros.lisp | 4 +-- src/compiler/x86/c-call.lisp | 6 ++--- src/compiler/x86/call.lisp | 3 +-- src/compiler/x86/cell.lisp | 46 +++++++++++---------------------- src/compiler/x86/insts.lisp | 56 +++++++++++++++++++++++++++++------------ src/compiler/x86/macros.lisp | 41 +++++++++++------------------- src/compiler/x86/nlx.lisp | 12 +++------ src/compiler/x86/system.lisp | 3 +-- version.lisp-expr | 2 +- 14 files changed, 106 insertions(+), 120 deletions(-) diff --git a/src/assembly/x86-64/alloc.lisp b/src/assembly/x86-64/alloc.lisp index 68a8ce33c..63444e459 100644 --- a/src/assembly/x86-64/alloc.lisp +++ b/src/assembly/x86-64/alloc.lisp @@ -94,8 +94,7 @@ (emit-label get-tls-index-lock) (inst mov target 1) (zeroize rax-tn) - (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target) + (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target :lock) (inst jmp :ne get-tls-index-lock) ;; The symbol is now in OTHER. (inst pop other) diff --git a/src/assembly/x86/alloc.lisp b/src/assembly/x86/alloc.lisp index 030d00293..5bc6adeba 100644 --- a/src/assembly/x86/alloc.lisp +++ b/src/assembly/x86/alloc.lisp @@ -102,8 +102,7 @@ (emit-label get-tls-index-lock) (inst mov target 1) (inst xor eax-tn eax-tn) - (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target) + (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target :lock) (inst jmp :ne get-tls-index-lock) ;; The symbol is now in OTHER. (inst pop other) diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp index 1426716be..df6d06a6a 100644 --- a/src/compiler/codegen.lisp +++ b/src/compiler/codegen.lisp @@ -142,7 +142,7 @@ (when (and cloop (sb!c::loop-tail cloop) (not (sb!c::loop-info cloop))) - (sb!assem:align sb!vm:n-lowtag-bits #x90) + (sb!assem:emit-alignment sb!vm:n-lowtag-bits #x90) ;; Mark the loop as aligned by saving the IR1 block aligned. (setf (sb!c::loop-info cloop) 1block))) (sb!assem:emit-label (block-label 1block))) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 501bb4dbe..d90f81b8d 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -59,11 +59,9 @@ (:results (result :scs (descriptor-reg any-reg))) (:generator 5 (move rax old) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :qword :base object :disp (- (* offset n-word-bytes) lowtag)) - new) + new :lock) (move result rax))) ;;;; symbol hacking VOPs @@ -95,13 +93,12 @@ new) (inst cmp rax no-tls-value-marker-widetag) (inst jmp :ne check) - (move rax old) - (inst lock)) + (move rax old)) (inst cmpxchg (make-ea :qword :base symbol :disp (- (* symbol-value-slot n-word-bytes) other-pointer-lowtag) :scale 1) - new) + new :lock) (emit-label check) (move result rax) (inst cmp result unbound-marker-widetag) @@ -214,11 +211,10 @@ (:policy :fast-safe) (:generator 4 (move result value) - (inst lock) (inst add (make-ea :qword :base object :disp (- (* symbol-value-slot n-word-bytes) other-pointer-lowtag)) - value))) + value :lock))) #!+sb-thread (define-vop (boundp) @@ -640,9 +636,7 @@ (:generator 4 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - #!+sb-thread - (inst lock) - (inst xadd (make-ea-for-raw-slot object index tmp) diff) + (inst xadd (make-ea-for-raw-slot object index tmp) diff :lock) (move result diff))) (define-vop (raw-instance-ref/single) diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 75cf555dc..ec48990a2 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -1814,11 +1814,12 @@ (emit-byte segment #b10001101) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction cmpxchg (segment dst src) +(define-instruction cmpxchg (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment dst src) @@ -1827,11 +1828,6 @@ (emit-ea segment dst (reg-tn-encoding src))))) - -(define-instruction fs-segment-prefix (segment) - (:emitter - (emit-byte segment #x64))) - ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1960,9 +1956,11 @@ (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))) ) -(define-instruction add (segment dst src) +(define-instruction add (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b000)) - (:emitter (emit-random-arith-inst "ADD" segment dst src #b000))) + (:emitter + (emit-prefix segment prefix) + (emit-random-arith-inst "ADD" segment dst src #b000))) (define-instruction adc (segment dst src) (:printer-list (arith-inst-printer-list #b010)) @@ -2141,11 +2139,12 @@ (maybe-emit-rex-prefix segment :qword nil nil nil) (emit-byte segment #b10011001))) -(define-instruction xadd (segment dst src) +(define-instruction xadd (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment dst src) @@ -2771,10 +2770,20 @@ (:emitter (emit-byte segment #b10011011))) +(defun emit-prefix (segment name) + (declare (ignorable segment)) + (ecase name + ((nil)) + (:lock + #!+sb-thread + (emit-byte segment #xf0)))) + +;;; FIXME: It would be better to make the disassembler understand the prefix as part +;;; of the instructions... (define-instruction lock (segment) (:printer byte ((op #b11110000))) (:emitter - (emit-byte segment #b11110000))) + (bug "LOCK prefix used as a standalone instruction"))) ;;;; miscellaneous hackery diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 332351254..03da6d7df 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -356,11 +356,9 @@ (:result-types ,el-type) (:generator 5 (move rax old-value) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :qword :base object :index index :disp (- (* ,offset n-word-bytes) ,lowtag)) - new-value) + new-value :lock) (move value rax))))) (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index ae98e18dc..7f9277a21 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -300,8 +300,7 @@ (let ((delta (logandc2 (+ amount 3) 3))) (inst mov temp (make-ea-for-symbol-tls-index *alien-stack*)) - (inst fs-segment-prefix) - (inst sub (make-ea :dword :base temp) delta))) + (inst sub (make-ea :dword :base temp) delta :fs))) (load-tl-symbol-value result *alien-stack*)) #!-sb-thread (:generator 0 @@ -321,8 +320,7 @@ (let ((delta (logandc2 (+ amount 3) 3))) (inst mov temp (make-ea-for-symbol-tls-index *alien-stack*)) - (inst fs-segment-prefix) - (inst add (make-ea :dword :base temp) delta)))) + (inst add (make-ea :dword :base temp) delta :fs)))) #!-sb-thread (:generator 0 (unless (zerop amount) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 0ce198203..bdd1d5413 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -1461,10 +1461,9 @@ ;; register on -SB-THREAD. #!+sb-thread (progn - (inst fs-segment-prefix) (inst cmp (make-ea :dword :disp (* thread-stepping-slot n-word-bytes)) - nil-value)) + nil-value :fs)) #!-sb-thread (inst cmp (make-ea-for-symbol-value sb!impl::*stepping*) nil-value)) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 753838a66..a049fcdaf 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -42,11 +42,9 @@ (:results (result :scs (descriptor-reg any-reg))) (:generator 5 (move eax old) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :dword :base object :disp (- (* offset n-word-bytes) lowtag)) - new) + new :lock) (move result eax))) ;;;; symbol hacking VOPs @@ -73,16 +71,14 @@ (progn (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) ;; Thread-local area, no LOCK needed. - (inst fs-segment-prefix) - (inst cmpxchg (make-ea :dword :base tls) new) + (inst cmpxchg (make-ea :dword :base tls) new :fs) (inst cmp eax no-tls-value-marker-widetag) (inst jmp :ne check) - (move eax old) - (inst lock)) + (move eax old)) (inst cmpxchg (make-ea :dword :base symbol :disp (- (* symbol-value-slot n-word-bytes) other-pointer-lowtag)) - new) + new :lock) (emit-label check) (move result eax) (inst cmp result unbound-marker-widetag) @@ -103,11 +99,9 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) + (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag :fs) (inst jmp :z global-val) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls) value) + (inst mov (make-ea :dword :base tls) value :fs) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -133,8 +127,7 @@ (err-lab (generate-error-code vop 'unbound-symbol-error object)) (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -155,8 +148,7 @@ (:generator 8 (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 :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -195,10 +187,9 @@ (:policy :fast-safe) (:generator 4 (move result value) - (inst lock) (inst add (make-ea-for-object-slot object symbol-value-slot other-pointer-lowtag) - value))) + value :lock))) #!+sb-thread (define-vop (boundp) @@ -211,8 +202,7 @@ (:generator 9 (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 :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -331,12 +321,10 @@ (#.esi-offset 'alloc-tls-index-in-esi)) :assembly-routine)) (emit-label tls-index-valid) - (inst fs-segment-prefix) - (inst push (make-ea :dword :base tls-index)) + (inst push (make-ea :dword :base tls-index) :fs) (popw bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls-index) val)))) + (inst mov (make-ea :dword :base tls-index) val :fs)))) #!-sb-thread (define-vop (bind) @@ -362,8 +350,7 @@ (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag) ;; Load VALUE from stack, then restore it to the TLS area. (loadw temp bsp (- binding-value-slot binding-size)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls-index) temp) + (inst mov (make-ea :dword :base tls-index) temp :fs) ;; Zero out the stack. (storew 0 bsp (- binding-symbol-slot binding-size)) (storew 0 bsp (- binding-value-slot binding-size)) @@ -404,8 +391,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 :base tls-index) value) + #!+sb-thread (inst mov (make-ea :dword :base tls-index) value :fs) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP @@ -589,9 +575,7 @@ (when (sc-is index any-reg) (inst shl tmp 2) (inst sub tmp index)) - #!+sb-thread - (inst lock) - (inst xadd (make-ea-for-raw-slot object index tmp 1) diff) + (inst xadd (make-ea-for-raw-slot object index tmp 1) diff :lock) (move result diff))) (define-vop (raw-instance-ref/single) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index c51745c1d..e31279537 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -920,7 +920,7 @@ ;;;; general data transfer -(define-instruction mov (segment dst src) +(define-instruction mov (segment dst src &optional prefix) ;; immediate to register (:printer reg ((op #b1011) (imm nil :type 'imm-data)) '(:name :tab reg ", " imm)) @@ -933,6 +933,7 @@ (:printer reg/mem-imm ((op '(#b1100011 #b000)))) (:emitter + (emit-prefix segment prefix) (let ((size (matching-operand-size dst src))) (maybe-emit-operand-size-prefix segment size) (cond ((register-p dst) @@ -1004,7 +1005,7 @@ (:printer ext-reg-reg/mem ((op #b1011011) (reg nil :type 'word-reg))) (:emitter (emit-move-with-extension segment dst src #b10110110))) -(define-instruction push (segment src) +(define-instruction push (segment src &optional prefix) ;; register (:printer reg-no-width ((op #b01010))) ;; register/memory @@ -1017,6 +1018,7 @@ ;; ### segment registers? (:emitter + (emit-prefix segment prefix) (cond ((integerp src) (cond ((<= -128 src 127) (emit-byte segment #b01101010) @@ -1096,11 +1098,12 @@ (emit-byte segment #b10001101) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction cmpxchg (segment dst src) +(define-instruction cmpxchg (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (emit-byte segment #b00001111) @@ -1108,16 +1111,26 @@ (emit-ea segment dst (reg-tn-encoding src))))) +(defun emit-prefix (segment name) + (ecase name + ((nil)) + (:lock + #!+sb-thread + (emit-byte segment #xf0)) + (:fs + (emit-byte segment #x64)) + (:gs + (emit-byte segment #x65)))) (define-instruction fs-segment-prefix (segment) (:printer byte ((op #b01100100))) (:emitter - (emit-byte segment #x64))) + (bug "FS emitted as a separate instruction!"))) (define-instruction gs-segment-prefix (segment) (:printer byte ((op #b01100101))) (:emitter - (emit-byte segment #x65))) + (bug "GS emitted as a separate instruction!"))) ;;;; flag control instructions @@ -1190,7 +1203,7 @@ ;;;; arithmetic (defun emit-random-arith-inst (name segment dst src opcode - &optional allow-constants) + &optional allow-constants) (let ((size (matching-operand-size dst src))) (maybe-emit-operand-size-prefix segment size) (cond @@ -1235,25 +1248,31 @@ (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))) ) -(define-instruction add (segment dst src) +(define-instruction add (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b000)) - (:emitter (emit-random-arith-inst "ADD" segment dst src #b000))) + (:emitter + (emit-prefix segment prefix) + (emit-random-arith-inst "ADD" segment dst src #b000))) (define-instruction adc (segment dst src) (:printer-list (arith-inst-printer-list #b010)) (:emitter (emit-random-arith-inst "ADC" segment dst src #b010))) -(define-instruction sub (segment dst src) +(define-instruction sub (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b101)) - (:emitter (emit-random-arith-inst "SUB" segment dst src #b101))) + (:emitter + (emit-prefix segment prefix) + (emit-random-arith-inst "SUB" segment dst src #b101))) (define-instruction sbb (segment dst src) (:printer-list (arith-inst-printer-list #b011)) (:emitter (emit-random-arith-inst "SBB" segment dst src #b011))) -(define-instruction cmp (segment dst src) +(define-instruction cmp (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b111)) - (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t))) + (:emitter + (emit-prefix segment prefix) + (emit-random-arith-inst "CMP" segment dst src #b111 t))) (define-instruction inc (segment dst) ;; Register. @@ -1410,11 +1429,12 @@ (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011001))) -(define-instruction xadd (segment dst src) +(define-instruction xadd (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (emit-byte segment #b00001111) @@ -1584,16 +1604,18 @@ (t (inst test x y)))) -(define-instruction or (segment dst src) +(define-instruction or (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b001)) (:emitter + (emit-prefix segment prefix) (emit-random-arith-inst "OR" segment dst src #b001))) -(define-instruction xor (segment dst src) +(define-instruction xor (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b110)) (:emitter + (emit-prefix segment prefix) (emit-random-arith-inst "XOR" segment dst src #b110))) (define-instruction not (segment dst) @@ -2071,10 +2093,12 @@ (:emitter (emit-byte segment #b10011011))) +;;; FIXME: It would be better to make the disassembler understand the prefix as part +;;; of the instructions... (define-instruction lock (segment) (:printer byte ((op #b11110000))) (:emitter - (emit-byte segment #b11110000))) + (bug "LOCK prefix used as a standalone instruction"))) ;;;; miscellaneous hackery diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 4c1a916c6..9789ec21b 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -112,8 +112,7 @@ (defmacro load-tl-symbol-value (reg symbol) `(progn (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol)) - (inst fs-segment-prefix) - (inst mov ,reg (make-ea :dword :base ,reg)))) + (inst mov ,reg (make-ea :dword :base ,reg) :fs))) #!-sb-thread (defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol)) @@ -121,8 +120,7 @@ (defmacro store-tl-symbol-value (reg symbol temp) `(progn (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base ,temp) ,reg))) + (inst mov (make-ea :dword :base ,temp) ,reg :fs))) #!-sb-thread (defmacro store-tl-symbol-value (reg symbol temp) (declare (ignore temp)) @@ -131,19 +129,18 @@ (defmacro load-binding-stack-pointer (reg) #!+sb-thread `(progn - (inst fs-segment-prefix) (inst mov ,reg (make-ea :dword - :disp (* 4 thread-binding-stack-pointer-slot)))) + :disp (* 4 thread-binding-stack-pointer-slot)) + :fs)) #!-sb-thread `(load-symbol-value ,reg *binding-stack-pointer*)) (defmacro store-binding-stack-pointer (reg) #!+sb-thread `(progn - (inst fs-segment-prefix) (inst mov (make-ea :dword :disp (* 4 thread-binding-stack-pointer-slot)) - ,reg)) + ,reg :fs)) #!-sb-thread `(store-symbol-value ,reg *binding-stack-pointer*)) @@ -226,10 +223,8 @@ :scale 1))) ; thread->alloc_region.end_addr (unless (and (tn-p size) (location= alloc-tn size)) (inst mov alloc-tn size)) - #!+sb-thread (inst fs-segment-prefix) - (inst add alloc-tn free-pointer) - #!+sb-thread (inst fs-segment-prefix) - (inst cmp alloc-tn end-addr) + (inst add alloc-tn free-pointer #!+sb-thread :fs) + (inst cmp alloc-tn end-addr #!+sb-thread :fs) (inst jmp :be ok) (let ((dst (ecase (tn-offset alloc-tn) (#.eax-offset "alloc_overflow_eax") @@ -244,16 +239,12 @@ ;; Swap ALLOC-TN and FREE-POINTER (cond ((and (tn-p size) (location= alloc-tn size)) ;; XCHG is extremely slow, use the xor swap trick - #!+sb-thread (inst fs-segment-prefix) - (inst xor alloc-tn free-pointer) - #!+sb-thread (inst fs-segment-prefix) - (inst xor free-pointer alloc-tn) - #!+sb-thread (inst fs-segment-prefix) - (inst xor alloc-tn free-pointer)) + (inst xor alloc-tn free-pointer #!+sb-thread :fs) + (inst xor free-pointer alloc-tn #!+sb-thread :fs) + (inst xor alloc-tn free-pointer #!+sb-thread :fs)) (t ;; It's easier if SIZE is still available. - #!+sb-thread (inst fs-segment-prefix) - (inst mov free-pointer alloc-tn) + (inst mov free-pointer alloc-tn #!+sb-thread :fs) (inst sub alloc-tn size))) (emit-label done)) (values)) @@ -363,13 +354,11 @@ (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) - (inst fs-segment-prefix) (inst or (make-ea :byte :disp (* 4 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) + (fixnumize 1) :fs) ,@forms - (inst fs-segment-prefix) (inst xor (make-ea :byte :disp (* 4 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) + (fixnumize 1) :fs) (inst jmp :z ,label) ;; if PAI was set, interrupts were disabled at the same ;; time using the process signal mask. @@ -410,8 +399,6 @@ (:result-types ,el-type) (:generator 5 (move eax old-value) - #!+sb-thread - (inst lock) (let ((ea (sc-case index (immediate (make-ea :dword :base object @@ -426,7 +413,7 @@ (make-ea :dword :base object :index index :disp (- (* ,offset n-word-bytes) ,lowtag)))))) - (inst cmpxchg ea new-value)) + (inst cmpxchg ea new-value :lock)) (move value eax))))) (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 1447f4ceb..72b13665a 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -83,8 +83,7 @@ block catch-block-entry-pc-slot) #!+win32 (progn - (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :disp 0)) + (inst mov temp (make-ea :dword :disp 0) :fs) (storew temp block unwind-block-next-seh-frame-slot)))) ;;; like MAKE-UNWIND-BLOCK, except that we also store in the specified @@ -104,8 +103,7 @@ block catch-block-entry-pc-slot) #!+win32 (progn - (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :disp 0)) + (inst mov temp (make-ea :dword :disp 0) :fs) (storew temp block unwind-block-next-seh-frame-slot)) (storew tag block catch-block-tag-slot) (load-tl-symbol-value temp *current-catch-block*) @@ -126,8 +124,7 @@ (inst lea seh-frame (make-ea-for-object-slot new-uwp unwind-block-next-seh-frame-slot 0)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :disp 0) seh-frame)) + (inst mov (make-ea :dword :disp 0) seh-frame :fs)) (store-tl-symbol-value new-uwp *current-unwind-protect-block* tls))) (define-vop (unlink-catch-block) @@ -149,8 +146,7 @@ #!+win32 (progn (loadw seh-frame block unwind-block-next-seh-frame-slot) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :disp 0) seh-frame)) + (inst mov (make-ea :dword :disp 0) seh-frame :fs)) (loadw block block unwind-block-current-uwp-slot) (store-tl-symbol-value block *current-unwind-protect-block* tls))) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index d65cda32e..c00907e5d 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -267,8 +267,7 @@ (:arg-types unsigned-num) (:policy :fast-safe) (:generator 2 - (inst fs-segment-prefix) - (inst mov sap (make-ea :dword :disp 0 :index n :scale 4)))) + (inst mov sap (make-ea :dword :disp 0 :index n :scale 4) :fs))) (define-vop (halt) (:generator 1 diff --git a/version.lisp-expr b/version.lisp-expr index 8d6a56a7c..a321620bd 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.20.15" +"1.0.20.16" -- 2.11.4.GIT