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