From 744ca6f4e37f7108a98ff8043a7c85d478fc272e Mon Sep 17 00:00:00 2001 From: cshapiro <cshapiro> Date: Thu, 17 Apr 2008 09:05:02 +0000 Subject: [PATCH] Add a partial setter macro for the x86 and use it to implement the various stores to 8-bit and 16-bit specialized arrays. --- compiler/x86/array.lisp | 186 ++------------------------------------- compiler/x86/macros.lisp | 46 +++++++++- 2 files changed, 50 insertions(+), 182 deletions(-) diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index 6004a4f24..7b2068cad 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.21 2008/04/16 09:06:37 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.22 2008/04/17 09:05:02 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -133,7 +133,10 @@ `(progn (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type ,size ,signed vector-data-offset other-pointer-type ,scs - ,element-type data-vector-ref))) + ,element-type data-vector-ref) + (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type + ,size vector-data-offset other-pointer-type ,scs + ,element-type data-vector-set))) ); eval-when (compile eval) @@ -1081,97 +1084,6 @@ -;;; unsigned-byte-8 - -(define-vop (data-vector-set/simple-array-unsigned-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:arg-types simple-array-unsigned-byte-8 positive-fixnum positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 5 - (move eax value) - (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) - al-tn) - (move result eax))) - - -(define-vop (data-vector-set-c/simple-array-unsigned-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)) - positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 4 - (move eax value) - (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type)) - al-tn) - (move result eax))) - - -;;; unsigned-byte-16 - -(define-vop (data-vector-set/simple-array-unsigned-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:arg-types simple-array-unsigned-byte-16 positive-fixnum positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 5 - (move eax value) - (inst mov (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) - ax-tn) - (move result eax))) - - -(define-vop (data-vector-set-c/simple-array-unsigned-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)) - positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 4 - (move eax value) - (inst mov (make-ea :word :base object - :disp (- (+ (* vector-data-offset word-bytes) - (* 2 index)) - other-pointer-type)) - ax-tn) - (move result eax))) - - ;;; simple-string (define-vop (data-vector-ref/simple-string) @@ -1249,94 +1161,6 @@ (move result value))) -;;; signed-byte-8 - -(define-vop (data-vector-set/simple-array-signed-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (move eax value) - (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) - al-tn) - (move result eax))) - -(define-vop (data-vector-set-c/simple-array-signed-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30)) - tagged-num) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (move eax value) - (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type)) - al-tn) - (move result eax))) - -;;; signed-byte-16 - -(define-vop (data-vector-set/simple-array-signed-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (move eax value) - (inst mov (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) - ax-tn) - (move result eax))) - -(define-vop (data-vector-set-c/simple-array-signed-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)) tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (move eax value) - (inst mov - (make-ea :word :base object - :disp (- (+ (* vector-data-offset word-bytes) - (* 2 index)) - other-pointer-type)) - ax-tn) - (move result eax))) - - ;;; These VOPs are used for implementing float slots in structures (whose raw ;;; data is an unsigned-32 vector. diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index 31cf5038c..b8da8606d 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.23 2008/04/17 08:59:49 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.24 2008/04/17 09:05:02 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -485,6 +485,50 @@ :disp (- (+ (* ,offset word-bytes) (* ,scale index)) ,lowtag)))))))) +(defmacro define-partial-setter (name type size offset lowtag scs el-type + &optional translate) + (let ((scale (ecase size (:byte 1) (:word 2)))) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to (:eval 0)) + (index :scs (unsigned-reg) :to (:eval 0)) + (value :scs ,scs :target eax)) + (:arg-types ,type positive-fixnum ,el-type) + (:temporary (:sc unsigned-reg :offset eax-offset :target result + :from (:argument 2) :to (:result 0)) + eax) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 5 + (move eax value) + (inst mov (make-ea ,size :base object :index index :scale ,scale + :disp (- (* ,offset word-bytes) ,lowtag)) + ,(ecase size (:byte 'al-tn) (:word 'ax-tn))) + (move result eax))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to (:eval 0)) + (value :scs ,scs :target eax)) + (:info index) + (:arg-types ,type (:constant (signed-byte 30)) ,el-type) + (:temporary (:sc unsigned-reg :offset eax-offset :target result + :from (:argument 1) :to (:result 0)) + eax) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 4 + (move eax value) + (inst mov (make-ea ,size :base object + :disp (- (+ (* ,offset word-bytes) (* ,scale index)) + ,lowtag)) + ,(ecase size (:byte 'al-tn) (:word 'ax-tn))) + (move result eax)))))) + (defmacro define-full-conditional-setter (name type offset lowtag scs el-type &optional translate) `(progn -- GitLab