diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp index a46511e5fc2e3573a73fcf444cc7f4070aa115f7..c83f202f7faaffb8aa8ba887dd4215cbdc6033e9 100644 --- a/code/x86-vm.lisp +++ b/code/x86-vm.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; ;(ext:file-comment -; "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.3 1997/09/24 15:49:54 dtc Exp $") +; "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.4 1997/09/29 04:40:35 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -390,3 +390,11 @@ ;;; The current alien stack pointer; saved/restored for non-local ;;; exits. (defvar *alien-stack*) + +;;; +(defun kernel::%instance-set-conditional (object slot test-value new-value) + (declare (type instance object) + (type index slot)) + "Atomically compare object's slot value to test-value and if EQ store + new-value in the slot. The original value of the slot is returned." + (kernel::%instance-set-conditional object slot test-value new-value)) diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index 84ba3922ee1ba17c26410e6881a8945d70b059fd..d7ef4219d4eb821a4204abfdf07bf61feea8621a 100644 --- a/compiler/x86/cell.lisp +++ b/compiler/x86/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.2 1997/02/13 01:20:32 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.3 1997/09/29 04:40:34 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,6 +17,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -291,6 +292,37 @@ (define-full-setter instance-index-set * instance-slots-offset instance-pointer-type (any-reg descriptor-reg) * %instance-set) +(export 'kernel::%instance-set-conditional "KERNEL") +(defknown kernel::%instance-set-conditional (instance index t t) t + (unsafe)) + +(define-vop (instance-set-conditional-c slot-set-conditional) + (:policy :fast-safe) + (:translate kernel::%instance-set-conditional) + (:variant instance-slots-offset instance-pointer-type) + (:arg-types instance (:constant index) * *)) + +(define-vop (instance-set-conditional) + (:translate kernel::%instance-set-conditional) + (:args (object :scs (descriptor-reg) :to :eval) + (slot :scs (any-reg) :to :result) + (old-value :scs (descriptor-reg any-reg) :target eax) + (new-value :scs (descriptor-reg any-reg) :target temp)) + (:arg-types instance positive-fixnum * *) + (:temporary (:sc descriptor-reg :offset eax-offset + :from (:argument 1) :to :result :target result) eax) + (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp) + (:results (result :scs (descriptor-reg))) + (:policy :fast-safe) + (:generator 5 + (move eax old-value) + (move temp new-value) + (inst cmpxchg (make-ea :dword :base object :index slot :scale 4 + :disp (- (* instance-slots-offset word-bytes) + instance-pointer-type)) + temp) + (move result eax))) + ;;;; Code object frobbing. diff --git a/compiler/x86/memory.lisp b/compiler/x86/memory.lisp index 5c9eae74a35ef1651ec748d20453e6632e80cf35..c2ea36368bd5992f37c692c78433a0ceebe6a607 100644 --- a/compiler/x86/memory.lisp +++ b/compiler/x86/memory.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/memory.lisp,v 1.2 1997/02/08 21:30:11 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/memory.lisp,v 1.3 1997/09/29 04:40:33 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,7 +17,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Enhancements/debugging by Douglas T. Crosher 1996. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -98,9 +98,46 @@ ;;; (define-vop (slot-set) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg immediate))) (:variant-vars base lowtag) (:info offset) (:generator 4 - (storew value object (+ base offset) lowtag))) + (if (sc-is value immediate) + (let ((val (tn-value value))) + (etypecase val + (integer + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) word-bytes) lowtag)) + (fixnum val))) + (symbol + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) word-bytes) lowtag)) + (+ nil-value (static-symbol-offset val)))) + (character + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) word-bytes) lowtag)) + (logior (ash (char-code val) type-bits) + base-char-type))))) + ;; Else, value not immediate. + (storew value object (+ base offset) lowtag)))) +(define-vop (slot-set-conditional) + (:args (object :scs (descriptor-reg) :to :eval) + (old-value :scs (descriptor-reg any-reg) :target eax) + (new-value :scs (descriptor-reg any-reg) :target temp)) + (:temporary (:sc descriptor-reg :offset eax-offset + :from (:argument 1) :to :result :target result) eax) + (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp) + (:variant-vars base lowtag) + (:results (result :scs (descriptor-reg))) + (:info offset) + (:generator 4 + (move eax old-value) + (move temp new-value) + (inst cmpxchg (make-ea :dword :base object + :disp (- (* (+ base offset) word-bytes) lowtag)) + temp) + (move result eax)))