From 5972039ae0af31f53613e24a715d7c908d4aed82 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Thu, 4 Mar 1999 11:49:23 +0000 Subject: [PATCH] Fix for the TN life specs in the instance-set-conditional VOP. New conditional setters using cmpxchg: rplaca-conditional and rplacd-conditional. Handy for writing thread and interrupt safe code. --- compiler/x86/cell.lisp | 29 +++++++++++++++++++++++++---- compiler/x86/memory.lisp | 21 +++++++++++++++++++-- 2 files changed, 44 insertions(+), 6 deletions(-) diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index f7fa623bc..aed585702 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 9741c0898..afe582392 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) -- GitLab