From 78d0a576fe34df1f4f50eaa8f2c284bedb633701 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 21 Mar 1990 23:22:04 +0000 Subject: [PATCH] Mucho hacking; almost a complete rewrite. --- compiler/mips/array.lisp | 177 +++++++++++++++++++++++---------------- 1 file changed, 103 insertions(+), 74 deletions(-) diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp index d4cdb5ecf..3d61cfc5b 100644 --- a/compiler/mips/array.lisp +++ b/compiler/mips/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.4 1990/03/20 00:19:03 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.5 1990/03/21 23:22:04 wlott Exp $ ;;; ;;; This file contains the MIPS definitions for array operations. ;;; @@ -15,50 +15,12 @@ ;;; (in-package "C") -#| -(define-miscop aref1 (a i) :translate aref) -(define-miscop caref2 (a i j) :translate aref) -(define-miscop caref3 (a i j k) :translate aref) -(define-miscop aset1 (a i val) :translate %aset) -(define-miscop caset2 (a i j val) :translate %aset) -(define-miscop caset3 (a i j k val) :translate %aset) -(define-miscop svref (v i) :translate aref - :arg-types (simple-vector t)) -(define-miscop svset (v i val) :translate %aset - :arg-types (simple-vector t t)) -(define-miscop schar (v i) :translate aref - :arg-types (simple-string t)) -(define-miscop scharset (v i val) :translate %aset - :arg-types (simple-string t t)) -(define-miscop sbit (v i) :translate aref - :arg-types (simple-bit-vector t)) -(define-miscop sbitset (v i val) :translate %aset - :arg-types (simple-bit-vector t t)) -|# - - -;;; These VOPS are automatically generated in cell.lisp -(defknown lisp::%array-fill-pointer (t) fixnum (flushable)) -(defknown lisp::%array-available-elements (t) fixnum (flushable)) -(defknown lisp::%array-data-vector (t) t (flushable)) -(defknown lisp::%array-displacement (t) (or fixnum null) (flushable)) -(defknown lisp::%array-displaced-p (t) (member t nil) (flushable)) + +;;;; Additional accessors and setters for the array header. -(defknown ((setf lisp::%array-fill-pointer)) - (t fixnum) fixnum ()) -(defknown ((setf lisp::%array-available-elements)) - (t fixnum) fixnum ()) -(defknown ((setf lisp::%array-data-vector)) - (t t) t ()) -(defknown ((setf lisp::%array-displacement)) - (t (or fixnum null)) (or fixnum null) ()) -(defknown ((setf lisp::%array-displaced-p)) - (t (member t nil)) (member t nil) ()) - -;;; Define an accessor and setter for to the dimensions. - -(defknown lisp::%array-dimension (t fixnum) fixnum (flushable)) +(defknown lisp::%array-dimension (t fixnum) fixnum + (flushable)) (defknown ((setf lisp::%array-dimension)) (t fixnum fixnum) fixnum ()) @@ -67,13 +29,30 @@ (:policy :fast-safe) (:variant vm:array-dimensions-offset vm:other-pointer-type)) -(define-vop (set-%array-dimension word-index-set) +(define-vop (%set-array-dimension word-index-set) (:translate (setf lisp::%array-dimension)) (:policy :fast-safe) (:variant vm:array-dimensions-offset vm:other-pointer-type)) -;;; Various length translations. + +(defknown lisp::%array-rank (t) fixnum (flushable)) + +(define-vop (array-rank-vop) + (:translate lisp::%array-rank) + (:policy :fast-safe) + (:args (x :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg) :type random) temp) + (:results (res :scs (any-reg descriptor-reg))) + (:generator 6 + (loadw temp x 0 vm:other-pointer-type) + (inst sra temp temp vm:type-bits) + (inst sll res temp 2) + (inst addiu res res (fixnum (- 1 vm:array-dimensions-offset))))) + + + +;;;; Various length translations. (macrolet ((frob (type) `(define-vop (,(intern (concatenate 'simple-string @@ -95,26 +74,88 @@ (frob simple-array-double-float)) + +;;;; Bounds checking routine. + + +(define-vop (check-bound) + (:translate %check-bound) + (:policy :fast-safe) + (:args (array :scs (descriptor-reg)) + (bound :scs (any-reg descriptor-reg)) + (index :scs (any-reg descriptor-reg) :target result)) + (:results (result :scs (any-reg descriptor-reg))) + (:node-var node) + (:temporary (:scs (non-descriptor-reg) :type random) temp) + (:generator 5 + (let ((error (generate-error-code node di:invalid-array-index-error + array bound index))) + (inst sltu temp index bound) + (inst beq temp zero-tn error) + (nop) + (move result index)))) + + + +;;;; Accessors/Setters + +(defmacro def-data-vector-frobs (type variant &optional (element-type t) sc) + `(progn + (define-vop (,(intern (concatenate 'simple-string + "DATA-VECTOR-REF/" + (string type))) + ,(intern (concatenate 'simple-string + (string variant) + "-REF"))) + (:variant vm:vector-data-offset vm:other-pointer-type) + (:translate data-vector-ref) + (:policy :fast-safe) + (:arg-types ,type *) + ,@(when sc + `((:results (value :scs (,sc))) + (:result-types ,element-type)))) + (define-vop (,(intern (concatenate 'simple-string + "DATA-VECTOR-SET/" + (string type))) + ,(intern (concatenate 'simple-string + (string variant) + "-SET"))) + (:variant vm:vector-data-offset vm:other-pointer-type) + (:translate data-vector-set) + (:policy :fast-safe) + (:arg-types ,type * ,element-type) + ,@(when sc + `((:args (object :scs (descriptor-reg)) + (index :scs (any-reg descriptor-reg + immediate unsigned-immediate)) + (value :scs (,sc))) + (:results (result :scs (,sc))) + (:result-types ,element-type)))))) + +(def-data-vector-frobs simple-string byte-index + base-character base-character-reg) +(def-data-vector-frobs simple-vector word-index) +#| +(def-data-vector-frobs simple-array-unsigned-byte-8 byte-index + unsigned-32-reg) +(def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index + unsigned-32-reg) +(def-data-vector-frobs simple-array-unsigned-byte-32 word-index + unsigned-32-reg) +|# + + +;;;; Misc. Array VOPs. -(define-vop (fast-schar byte-index-ref) - (:arg-types simple-string *) - (:results (value :scs (base-character-reg))) - (:result-types base-character) - (:variant vm:vector-data-offset vm:other-pointer-type) - (:translate aref) - (:policy :fast)) -(define-vop (fast-scharset byte-index-set) - (:args (object :scs (descriptor-reg)) - (index :scs (any-reg descriptor-reg immediate unsigned-immediate)) - (value :scs (base-character-reg))) - (:results (result :scs (base-character-reg))) - (:result-types base-character) - (:variant vm:vector-data-offset vm:other-pointer-type) - (:translate %aset) - (:policy :fast) - (:arg-types simple-string * base-character)) +#+nil +(define-vop (vector-word-length) + (:args (vec :scs (descriptor-reg))) + (:results (res :scs (any-reg descriptor-reg))) + (:generator 6 + (loadw res vec clc::g-vector-header-words) + (inst niuo res res clc::g-vector-words-mask-16))) (define-vop (get-vector-subtype) @@ -140,15 +181,3 @@ (storew t1 x 0 vm:other-pointer-type) (move res x))) - -(define-vop (fast-svref word-index-ref) - (:variant vm:vector-base-size vm:other-pointer-type) - (:translate aref) - (:arg-types simple-vector *) - (:policy :fast)) - -(define-vop (fast-svset word-index-set) - (:variant vm:vector-base-size vm:other-pointer-type) - (:translate %aset) - (:arg-types simple-vector * *) - (:policy :fast)) -- GitLab