diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index f7fa623bcff534ee8c7d61152669c3dd3d8665c7..aed58570242da32d29895296b361521a55097d93 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.6 1998/02/19 19:34:50 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.7 1999/03/04 11:49:23 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,1997. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1999. ;;; (in-package :x86) @@ -271,6 +271,7 @@ (define-vop (closure-init slot-set) (:variant closure-info-offset function-pointer-type)) + ;;;; Value Cell hackery. @@ -329,8 +330,8 @@ (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) + :from (:argument 2) :to :result :target result) eax) + (:temporary (:sc descriptor-reg :from (:argument 3) :to :result) temp) (:results (result :scs (descriptor-reg))) (:policy :fast-safe) (:generator 5 @@ -358,5 +359,25 @@ (define-full-setter code-header-set * 0 other-pointer-type (any-reg descriptor-reg) * code-header-set) + +;;;; Cons conditional setters. + +(export 'kernel::rplaca-conditional "KERNEL") +(defknown kernel::rplaca-conditional (cons t t) t + (unsafe)) + +(define-vop (rplaca-conditional cell-set-conditional) + (:policy :fast-safe) + (:translate kernel::rplaca-conditional) + (:variant cons-car-slot list-pointer-type) + (:arg-types list * *)) +(export 'kernel::rplacd-conditional "KERNEL") +(defknown kernel::rplacd-conditional (cons t t) t + (unsafe)) +(define-vop (rplacd-conditional cell-set-conditional) + (:policy :fast-safe) + (:translate kernel::rplacd-conditional) + (:variant cons-cdr-slot list-pointer-type) + (:arg-types list * *)) diff --git a/compiler/x86/memory.lisp b/compiler/x86/memory.lisp index 9741c0898137a640b8ed45d2f6fe80360acd77f3..afe582392a0b552d5d35e89627a3596f07f13aef 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.4 1997/11/04 09:11:10 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/memory.lisp,v 1.5 1999/03/04 11:49:22 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,1997. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1999. ;;; (in-package :x86) @@ -84,6 +84,23 @@ ,@(when set-trans `((:translate ,set-trans)))))))) +(define-vop (cell-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 offset lowtag) + (:results (result :scs (descriptor-reg))) + (:generator 4 + (move eax old-value) + (move temp new-value) + (inst cmpxchg (make-ea :dword :base object + :disp (- (* offset word-bytes) lowtag)) + temp) + (move result eax))) + ;;; X86 special (define-vop (cell-xadd) (:args (object :scs (descriptor-reg) :to :result)