From cf0cb637e62b756bd7bb75230756607dd760451d Mon Sep 17 00:00:00 2001 From: cshapiro <cshapiro> Date: Wed, 16 Apr 2008 09:06:41 +0000 Subject: [PATCH] Add a partial reffer macro for the x86 and use it to implement the various loads from 8-bit and 16-bit specialized arrays. --- compiler/x86/array.lisp | 140 ++++++--------------------------------- compiler/x86/macros.lisp | 34 +++++++++- 2 files changed, 55 insertions(+), 119 deletions(-) diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index 8ca738ffb..6004a4f24 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.20 2008/04/15 03:24:21 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.21 2008/04/16 09:06:37 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -128,11 +128,32 @@ vector-data-offset other-pointer-type ,scs ,element-type data-vector-set))) +(defmacro def-partial-data-vector-frobs + (type element-type size signed &rest scs) + `(progn + (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type + ,size ,signed vector-data-offset other-pointer-type ,scs + ,element-type data-vector-ref))) + ); eval-when (compile eval) (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) + +(def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum + :byte nil unsigned-reg signed-reg) + +(def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum + :word nil unsigned-reg signed-reg) + (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num unsigned-reg) + +(def-partial-data-vector-frobs simple-array-signed-byte-8 tagged-num + :byte t signed-reg) + +(def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num + :word t signed-reg) + (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg) (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg) @@ -1062,36 +1083,6 @@ ;;; unsigned-byte-8 -(define-vop (data-vector-ref/simple-array-unsigned-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-unsigned-byte-8 positive-fixnum) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 5 - (inst movzx value - (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) - - -(define-vop (data-vector-ref-c/simple-array-unsigned-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 4 - (inst movzx value - (make-ea :byte :base object - :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type))))) - - (define-vop (data-vector-set/simple-array-unsigned-byte-8) (:translate data-vector-set) (:policy :fast-safe) @@ -1137,36 +1128,6 @@ ;;; unsigned-byte-16 -(define-vop (data-vector-ref/simple-array-unsigned-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-unsigned-byte-16 positive-fixnum) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 5 - (inst movzx value - (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) - - -(define-vop (data-vector-ref-c/simple-array-unsigned-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) - (:generator 4 - (inst movzx value - (make-ea :word :base object - :disp (- (+ (* vector-data-offset word-bytes) (* 2 index)) - other-pointer-type))))) - - (define-vop (data-vector-set/simple-array-unsigned-byte-16) (:translate data-vector-set) (:policy :fast-safe) @@ -1290,34 +1251,6 @@ ;;; signed-byte-8 -(define-vop (data-vector-ref/simple-array-signed-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-signed-byte-8 positive-fixnum) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (inst movsx value - (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) - -(define-vop (data-vector-ref-c/simple-array-signed-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30))) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (inst movsx value - (make-ea :byte :base object - :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type))))) - (define-vop (data-vector-set/simple-array-signed-byte-8) (:translate data-vector-set) (:policy :fast-safe) @@ -1361,35 +1294,6 @@ ;;; signed-byte-16 -(define-vop (data-vector-ref/simple-array-signed-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-signed-byte-16 positive-fixnum) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (inst movsx value - (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) - -(define-vop (data-vector-ref-c/simple-array-signed-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30))) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (inst movsx value - (make-ea :word :base object - :disp (- (+ (* vector-data-offset word-bytes) - (* 2 index)) - other-pointer-type))))) - (define-vop (data-vector-set/simple-array-signed-byte-16) (:translate data-vector-set) (:policy :fast-safe) diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index a66cf61e8..8bc3571fb 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.21 2003/08/25 20:50:58 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.22 2008/04/16 09:06:41 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -453,6 +453,38 @@ value) (move result value))))) +(defmacro define-partial-reffer (name type size signed 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)) + (index :scs (unsigned-reg))) + (:arg-types ,type positive-fixnum) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 5 + (inst ,(if signed 'movsx 'movzx) value + (make-ea ,size :base object :index index :scale ,scale + :disp (- (* ,offset word-bytes) ,lowtag))))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:info index) + (:arg-types ,type (:constant (signed-byte 30))) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 5 + (inst ,(if signed 'movsx 'movzx) value + (make-ea ,size :base object + :disp (- (+ (* ,offset word-bytes) (* ,scale index)) + ,lowtag)))))))) + (defmacro define-full-conditional-setter (name type offset lowtag scs el-type &optional translate) `(progn -- GitLab