diff --git a/compiler/rt/array.lisp b/compiler/rt/array.lisp index 27aeac7ba0b500cb8b0d6c513c3d71428a984fa7..6f96fd03f7838c06f7cece59cd1444463fb513c4 100644 --- a/compiler/rt/array.lisp +++ b/compiler/rt/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/array.lisp,v 1.2 1991/04/04 13:50:49 chiles Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/array.lisp,v 1.3 1991/04/15 15:40:00 ram Exp $ ;;; ;;; This file contains the IBM RT definitions for array operations. ;;; @@ -387,89 +387,83 @@ ;;;; Float vectors. -#| -(define-vop (data-vector-ref/simple-array-single-float) +(define-vop (data-vector-ref/simple-array-mc68881-single-float) (:note "inline array access") (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) (:arg-types simple-array-single-float positive-fixnum) - (:results (value :scs (single-reg))) - (:result-types single-float) + (:results (value :scs (mc68881-single-reg))) + (:result-types mc68881-single-float) + (:temporary (:sc sap-reg :from :eval) scratch) (:temporary (:scs (interior-reg)) lip) (:generator 20 - (inst add lip object index) - (inst lwc1 value lip - (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)) - (inst nop))) + (inst cas lip object index) + (inst inc lip (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)) + (inst mc68881-load value lip :single scratch))) -(define-vop (data-vector-set/simple-array-single-float) +(define-vop (data-vector-set/simple-array-mc68881-single-float) (:note "inline array store") (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) - (value :scs (single-reg) :target result)) - (:arg-types simple-array-single-float positive-fixnum single-float) - (:results (result :scs (single-reg))) - (:result-types single-float) + (value :scs (mc68881-single-reg) :target result)) + (:arg-types simple-array-single-float positive-fixnum mc68881-single-float) + (:results (result :scs (mc68881-single-reg))) + (:result-types mc68881-single-float) (:temporary (:scs (interior-reg)) lip) + (:temporary (:sc sap-reg :from :eval) scratch) (:generator 20 - (inst add lip object index) - (inst swc1 value lip - (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)) + (inst cas lip object index) + (inst inc lip (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)) + (inst mc68881-store value lip :single scratch) + (inst mc68881-wait) (unless (location= result value) - (inst move :single result value)))) + (inst mc68881-move result value scratch)))) -(define-vop (data-vector-ref/simple-array-double-float) +(define-vop (data-vector-ref/simple-array-mc68881-double-float) (:note "inline array access") (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) (:arg-types simple-array-double-float positive-fixnum) - (:results (value :scs (double-reg))) - (:result-types double-float) + (:results (value :scs (mc68881-double-reg))) + (:result-types mc68881-double-float) (:temporary (:scs (interior-reg)) lip) + (:temporary (:sc sap-reg :from :eval) scratch) (:generator 20 - (inst add lip object index) - (inst add lip index) - (inst lwc1 value lip - (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)) - (inst lwc1-odd value lip - (+ (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type) - vm:word-bytes)) - (inst nop))) - -(define-vop (data-vector-set/simple-array-double-float) + (inst cas lip object index) + (inst cas lip lip index) + (inst inc lip (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)) + (inst mc68881-load value lip :double scratch))) + +(define-vop (data-vector-set/simple-array-mc68881-double-float) (:note "inline array store") (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) - (value :scs (double-reg) :target result)) - (:arg-types simple-array-double-float positive-fixnum double-float) - (:results (result :scs (double-reg))) - (:result-types double-float) + (value :scs (mc68881-double-reg) :target result)) + (:arg-types simple-array-double-float positive-fixnum mc68881-double-float) + (:results (result :scs (mc68881-double-reg))) + (:result-types mc68881-double-float) (:temporary (:scs (interior-reg)) lip) + (:temporary (:sc sap-reg :from :eval) scratch) (:generator 20 - (inst add lip object index) - (inst add lip index) - (inst swc1 value lip - (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)) - (inst swc1-odd value lip - (+ (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type) - vm:word-bytes)) + (inst cas lip object index) + (inst cas lip lip index) + (inst inc lip (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)) + (inst mc68881-store value lip :double scratch) + (inst mc68881-wait) (unless (location= result value) - (inst move :double result value)))) -|# + (inst mc68881-move result value scratch)))) ;;;; Raw bits without regard to vector type.