From 09f361168cd56b9d446d93dfdd842b81b6d5097b Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Thu, 4 Mar 1999 11:54:48 +0000 Subject: [PATCH] New macro define-full-conditional-setter, used to add a new VOP data-vector-set-conditional for simple-arrays which is handy for writing thread and interrupt safe code. --- compiler/x86/array.lisp | 16 +++++++++++-- compiler/x86/macros.lisp | 50 ++++++++++++++++++++++++++++++++++++++-- 2 files changed, 62 insertions(+), 4 deletions(-) diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index 61df7876d..3d3758b47 100644 --- a/compiler/x86/array.lisp +++ b/compiler/x86/array.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/array.lisp,v 1.15 1998/07/24 17:22:39 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.16 1999/03/04 11:54:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,7 +16,7 @@ ;;; Written by William Lott ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1998. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1998,1999. ;;; (in-package :x86) @@ -1560,6 +1560,18 @@ (define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num %set-raw-bits) + +;;;; Conditional setters. + +(export 'kernel::data-vector-set-conditional "KERNEL") +(defknown data-vector-set-conditional (array index t t) t + (unsafe c::explicit-check)) + +(define-full-conditional-setter data-vector-set-condition/simple-vector + simple-vector vector-data-offset other-pointer-type + (descriptor-reg any-reg) * + data-vector-set-conditional) + ;;;; Misc. Array VOPs. diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index 3c5270fd5..f35a121b8 100644 --- a/compiler/x86/macros.lisp +++ b/compiler/x86/macros.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/macros.lisp,v 1.10 1998/01/29 07:15:43 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.11 1999/03/04 11:54:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,7 +16,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1998. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1998,1999. ;;; (in-package :x86) @@ -438,3 +438,49 @@ value) (move result value))))) +(defmacro define-full-conditional-setter (name type offset lowtag scs el-type + &optional translate) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to :result) + (index :scs (any-reg) :to :result) + (old-value :scs ,scs :target eax) + (new-value :scs ,scs :target temp)) + (:arg-types ,type tagged-num ,el-type ,el-type) + (:temporary (:sc ,(first scs) :offset eax-offset + :from (:argument 2) :to :result :target result) eax) + (:temporary (:sc ,(first scs) :from (:argument 3) :to :result) temp) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 5 + (move eax old-value) + (move temp new-value) + (inst cmpxchg (make-ea :dword :base object :index index :scale 1 + :disp (- (* ,offset word-bytes) ,lowtag)) + temp) + (move result eax))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to :result) + (old-value :scs ,scs :target eax) + (new-value :scs ,scs :target temp)) + (:info index) + (:arg-types ,type (:constant (signed-byte 30)) ,el-type ,el-type) + (:temporary (:sc ,(first scs) :offset eax-offset + :from (:argument 1) :to :result :target result) eax) + (:temporary (:sc ,(first scs) :from (:argument 2) :to :result) temp) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 4 + (move eax old-value) + (move temp new-value) + (inst cmpxchg (make-ea :dword :base object + :disp (- (* (+ ,offset index) word-bytes) + ,lowtag)) + temp) + (move result eax))))) -- GitLab