From 8657dd6c019a48d463c18fa93404d94f916dec3e Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 13 Jan 1993 15:55:23 +0000 Subject: [PATCH] Added a bunch of gengc stuff under #+gengc. --- compiler/mips/array.lisp | 60 +++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 19 deletions(-) diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp index 4550f9e00..d74af077a 100644 --- a/compiler/mips/array.lisp +++ b/compiler/mips/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/mips/array.lisp,v 1.36 1992/08/18 04:48:00 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.37 1993/01/13 15:55:23 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -20,31 +20,53 @@ ;;;; Allocator for the array header. +#-gengc (define-vop (make-array-header) (:policy :fast-safe) (:translate make-array-header) (:args (type :scs (any-reg)) (rank :scs (any-reg))) (:arg-types positive-fixnum positive-fixnum) - (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header) - (:temporary (:scs (any-reg)) temp1) - (:temporary (:scs (non-descriptor-reg)) temp2) + (:temporary (:scs (any-reg)) bytes) + (:temporary (:scs (non-descriptor-reg)) header) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:results (result :scs (descriptor-reg))) (:generator 13 + (inst addu bytes rank (+ (* array-dimensions-offset word-bytes) + lowtag-mask)) + (inst li header (lognot lowtag-mask)) + (inst and bytes header) + (inst addu header rank (fixnum (1- array-dimensions-offset))) + (inst sll header type-bits) + (inst or header header type) + (inst srl header 2) (pseudo-atomic (pa-flag) - (inst or header alloc-tn other-pointer-type) - (inst addu temp1 rank (+ (* array-dimensions-offset word-bytes) - lowtag-mask)) - (inst li temp2 (lognot lowtag-mask)) - (inst and temp1 temp2) - (inst addu alloc-tn temp1) - (inst addu temp2 rank (fixnum (1- array-dimensions-offset))) - (inst sll temp2 type-bits) - (inst or temp2 temp2 type) - (inst srl temp2 2) - (storew temp2 header 0 other-pointer-type)) - (move result header))) + (inst or result alloc-tn other-pointer-type) + (storew header alloc-tn) + (inst addu alloc-tn bytes)))) + +#+gengc +(define-vop (make-array-header) + (:args (type :scs (any-reg)) + (rank :scs (any-reg))) + (:arg-types positive-fixnum positive-fixnum) + (:temporary (:sc non-descriptor-reg :offset nl0-offset) nl0) + (:temporary (:sc non-descriptor-reg :offset nl1-offset) nl1) + (:temporary (:sc non-descriptor-reg :offset nl2-offset) nl2) + (:temporary (:sc descriptor-reg :offset a0-offset :target result + :from (:argument 0) :to (:result 0)) + a0) + (:results (result :scs (descriptor-reg))) + (:ignore nl2) + (:generator 13 + (inst addu a0 rank (fixnum (1+ array-dimensions-offset))) + (inst addu nl1 rank (fixnum (1- array-dimensions-offset))) + (inst sll nl1 (- type-bits 2)) + (inst or nl1 type) + (inst jal (make-fixup 'var-alloc :assembly-routine)) + (inst li nl0 other-pointer-type) + (move result a0))) + ;;;; Additional accessors and setters for the array header. @@ -60,7 +82,7 @@ (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-type - (any-reg) positive-fixnum lisp::%set-array-dimension) + (any-reg) positive-fixnum lisp::%set-array-dimension nil) (defknown lisp::%array-rank (t) index (flushable)) @@ -117,7 +139,7 @@ data-vector-ref) (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type vector-data-offset other-pointer-type ,scs ,element-type - data-vector-set))) + data-vector-set #+gengc ,(if (member 'descriptor-reg scs) t nil)))) (defmacro def-partial-data-vector-frobs (type element-type size signed &rest scs) @@ -412,7 +434,7 @@ (define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num %raw-bits) (define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) - unsigned-num %set-raw-bits) + unsigned-num %set-raw-bits #+gengc nil) -- GitLab