Skip to content
Snippets Groups Projects
Commit 8657dd6c authored by wlott's avatar wlott
Browse files

Added a bunch of gengc stuff under #+gengc.

parent 98532de9
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -20,31 +20,53 @@
;;;; Allocator for the array header. ;;;; Allocator for the array header.
#-gengc
(define-vop (make-array-header) (define-vop (make-array-header)
(:policy :fast-safe) (:policy :fast-safe)
(:translate make-array-header) (:translate make-array-header)
(:args (type :scs (any-reg)) (:args (type :scs (any-reg))
(rank :scs (any-reg))) (rank :scs (any-reg)))
(:arg-types positive-fixnum positive-fixnum) (:arg-types positive-fixnum positive-fixnum)
(:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header) (:temporary (:scs (any-reg)) bytes)
(:temporary (:scs (any-reg)) temp1) (:temporary (:scs (non-descriptor-reg)) header)
(:temporary (:scs (non-descriptor-reg)) temp2)
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
(:results (result :scs (descriptor-reg))) (:results (result :scs (descriptor-reg)))
(:generator 13 (: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) (pseudo-atomic (pa-flag)
(inst or header alloc-tn other-pointer-type) (inst or result alloc-tn other-pointer-type)
(inst addu temp1 rank (+ (* array-dimensions-offset word-bytes) (storew header alloc-tn)
lowtag-mask)) (inst addu alloc-tn bytes))))
(inst li temp2 (lognot lowtag-mask))
(inst and temp1 temp2) #+gengc
(inst addu alloc-tn temp1) (define-vop (make-array-header)
(inst addu temp2 rank (fixnum (1- array-dimensions-offset))) (:args (type :scs (any-reg))
(inst sll temp2 type-bits) (rank :scs (any-reg)))
(inst or temp2 temp2 type) (:arg-types positive-fixnum positive-fixnum)
(inst srl temp2 2) (:temporary (:sc non-descriptor-reg :offset nl0-offset) nl0)
(storew temp2 header 0 other-pointer-type)) (:temporary (:sc non-descriptor-reg :offset nl1-offset) nl1)
(move result header))) (: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. ;;;; Additional accessors and setters for the array header.
...@@ -60,7 +82,7 @@ ...@@ -60,7 +82,7 @@
(define-full-setter %set-array-dimension * (define-full-setter %set-array-dimension *
array-dimensions-offset other-pointer-type 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)) (defknown lisp::%array-rank (t) index (flushable))
...@@ -117,7 +139,7 @@ ...@@ -117,7 +139,7 @@
data-vector-ref) data-vector-ref)
(define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type
vector-data-offset other-pointer-type ,scs ,element-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 (defmacro def-partial-data-vector-frobs
(type element-type size signed &rest scs) (type element-type size signed &rest scs)
...@@ -412,7 +434,7 @@ ...@@ -412,7 +434,7 @@
(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num (define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num
%raw-bits) %raw-bits)
(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) (define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
unsigned-num %set-raw-bits) unsigned-num %set-raw-bits #+gengc nil)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment