Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/ppc parms.lisp,1.11,1.11.2.1 macros.lisp,1.6.4.1,1.6.4.2 call.lisp,1.3.6.1,1.3.6.2 array.lisp,1.4.6.1,1.4.6.2 alloc.lisp,1.2.6.1,1.2.6.2
|
From: Patrik N. <kin...@us...> - 2003-11-06 22:45:02
|
Update of /cvsroot/sbcl/sbcl/src/compiler/ppc
In directory sc8-pr-cvs1:/tmp/cvs-serv26778/src/compiler/ppc
Modified Files:
Tag: ppc_gencgc_branch
parms.lisp macros.lisp call.lisp array.lisp alloc.lisp
Log Message:
0.8.3.90.ppc_gencgc_branch.2:
More gencgc work
... Allocation has been redone for gencgc
... The gencgc bits of the runtime have been reconditionalised
so that things that are x86-specific use LISP_FEATURE_X86 and
those that are gencgc specific in general use
LISP_FEATURE_GENCGC
... Replaced lots of symbol twiddling in gencgc with macros
(because on non-x86 these aren't symbols)
... Moved interrupt scavenging from cheneygc to gc-common
because it's needed for non-x86 gencgc, and added interrupt
and control stack scavenging to gencgc for non-x86.
... Renamed i586_bzero to fast_bzero since we call it on
non-x86 too.
... Some changes to purify and core saving related to gencgc
on non-x86.
... Possibly some more changes I'm forgetting.
... Disabled some assertions when scavenging hash tables. I'm
not sure this is valid, Raymond Toy suggested on IRC that
perhaps this has to do with the hash-new code, which CMUCL has
but we don't. In any case, hash table scavenging seems rather
broken.
THIS CODE DOESN'T WORK. Even with assertions disabled it
crashes horribly on first GC, with what might be heap
corruption or might be something else entirely. This checkin
is mostly just a checkpoint where I've gotten the allocation
and gc:ing code to compile and run at least part of the way.
These changes are based on Raymond Toy's CMUCL/Sparc port of
gencgc, which actually works. He didn't run into the same hash
table issues I did, which may be due to CMUCL having hash-new.
Index: parms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/parms.lisp,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -u -d -r1.11 -r1.11.2.1
--- parms.lisp 16 Sep 2003 12:07:40 -0000 1.11
+++ parms.lisp 6 Nov 2003 22:44:58 -0000 1.11.2.1
@@ -133,6 +133,8 @@
list
instance)
+(defconstant allocation-trap 31)
+
(defenum (:prefix trace-table-)
normal
call-site
@@ -182,6 +184,13 @@
sb!unix::*interrupts-enabled*
sb!unix::*interrupt-pending*
+ ;; Gencgc
+ #+gencgc
+ *current-region-free-pointer*
+ #+gencgc
+ *current-region-end-addr*
+ #+gencgc
+ *scavenge-read-only-space*
))
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/macros.lisp,v
retrieving revision 1.6.4.1
retrieving revision 1.6.4.2
diff -u -d -r1.6.4.1 -r1.6.4.2
--- macros.lisp 24 Sep 2003 20:03:12 -0000 1.6.4.1
+++ macros.lisp 6 Nov 2003 22:44:58 -0000 1.6.4.2
@@ -158,18 +158,67 @@
;; then or in the lowtag.
;; Normal allocation to the heap.
`(let ((size ,size))
+ #-gencgc
(if (logbitp (1- n-lowtag-bits) ,lowtag)
- (progn
- (inst ori ,result-tn alloc-tn ,lowtag)
- (if (numberp size)
- (inst addi alloc-tn alloc-tn size)
- (inst add alloc-tn alloc-tn size)))
- (progn
- (inst clrrwi ,result-tn alloc-tn n-lowtag-bits)
- (inst ori ,result-tn ,result-tn ,lowtag)
- (if (numberp size)
- (inst addi alloc-tn alloc-tn size)
- (inst add alloc-tn alloc-tn size))))))
+ (progn
+ (inst ori ,result-tn alloc-tn ,lowtag)
+ (if (numberp size)
+ (inst addi alloc-tn alloc-tn size)
+ (inst add alloc-tn alloc-tn size)))
+ (progn
+ (inst clrrwi ,result-tn alloc-tn n-lowtag-bits)
+ (inst ori ,result-tn ,result-tn ,lowtag)
+ (if (numberp size)
+ (inst addi alloc-tn alloc-tn size)
+ (inst add alloc-tn alloc-tn size))))
+ #+gencgc
+ ;; The OR instruction MUST come just before the TRAP
+ ;; instruction, because the C code depends on this to figure
+ ;; out what to do.
+ (without-scheduling ()
+ (let ((done (gen-label))
+ (full-alloc (gen-label)))
+ ;; See if we can do an inline allocation. The updated
+ ;; free pointer should not point past the end of the
+ ;; current region. If it does, a full alloc needs to be
+ ;; done.
+ (load-symbol-value ,result-tn *current-region-free-pointer*)
+ (load-symbol-value ,temp-tn *current-region-end-addr*)
+ (if (numberp size)
+ (inst addi ,result-tn ,size)
+ (inst add ,result-tn ,size))
+ ;; Do we need to round up? I hope not because result-tn
+ ;; is descriptor!
+
+ ;;(inst add ,result-tn vm:lowtag-mask)
+ ;;(inst andn ,result-tn vm:lowtag-mask)
+
+ ;; result-tn points to the new end of region. Did we go
+ ;; past the actual end of the region? If so, we need a
+ ;; full alloc.
+ (inst cmpw ,result-tn ,temp-tn)
+ (inst b :gt full-alloc)
+
+ ;; Inline allocation worked, so update the free pointer
+ ;; and go. Should really do a swap instruction here to
+ ;; swap memory with a register.
+ (load-symbol-value ,temp-tn *current-region-free-pointer*)
+ (store-symbol-value ,result-tn *current-region-free-pointer*)
+ (move ,result-tn ,temp-tn)
+ (inst b done)
+
+ (emit-label full-alloc)
+ ;; Full alloc via trap to the C allocator. Tell the
+ ;; allocator what the result-tn and size are, using the
+ ;; OR instruction. Then trap to the allocator.
+ (if (numberp size)
+ (inst ori ,result-tn zero-tn ,size)
+ (inst ori ,result-tn ,size 0))
+ (inst t :t allocation-trap)
+
+ (emit-label done)
+ ;; Set lowtag appropriately
+ (inst ori ,result-tn ,lowtag)))))
(defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size)
&body body)
@@ -181,7 +230,8 @@
(once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn)
(type-code type-code) (size size))
`(pseudo-atomic (,flag-tn)
- (allocation ,result-tn (pad-data-block ,size) other-pointer-lowtag)
+ (allocation ,result-tn (pad-data-block ,size) other-pointer-lowtag
+ :temp-tn temp)
(when ,type-code
(inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
(storew ,temp-tn ,result-tn 0 other-pointer-lowtag))
Index: call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/call.lisp,v
retrieving revision 1.3.6.1
retrieving revision 1.3.6.2
diff -u -d -r1.3.6.1 -r1.3.6.2
--- call.lisp 24 Sep 2003 20:03:12 -0000 1.3.6.1
+++ call.lisp 6 Nov 2003 22:44:58 -0000 1.3.6.2
@@ -1123,7 +1123,7 @@
(assemble ()
;; Allocate a cons (2 words) for each item.
(inst slwi temp count 1)
- (allocation result temp list-pointer-lowtag)
+ (allocation result temp list-pointer-lowtag :temp-tn dst)
(move dst result)
(inst b enter)
Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/array.lisp,v
retrieving revision 1.4.6.1
retrieving revision 1.4.6.2
diff -u -d -r1.4.6.1 -r1.4.6.2
--- array.lisp 24 Sep 2003 20:03:12 -0000 1.4.6.1
+++ array.lisp 6 Nov 2003 22:44:58 -0000 1.4.6.2
@@ -22,13 +22,14 @@
(:arg-types tagged-num tagged-num)
(:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
(:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
+ (:temporary (:sc non-descriptor-reg) gc-temp)
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:results (result :scs (descriptor-reg)))
(:generator 0
(pseudo-atomic (pa-flag)
(inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
(inst clrrwi ndescr ndescr n-lowtag-bits)
- (allocation header ndescr other-pointer-lowtag)
+ (allocation header ndescr other-pointer-lowtag :temp-tn gc-temp)
(inst addi ndescr rank (fixnumize (1- array-dimensions-offset)))
(inst slwi ndescr ndescr n-widetag-bits)
(inst or ndescr ndescr type)
Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/alloc.lisp,v
retrieving revision 1.2.6.1
retrieving revision 1.2.6.2
diff -u -d -r1.2.6.1 -r1.2.6.2
--- alloc.lisp 24 Sep 2003 20:03:12 -0000 1.2.6.1
+++ alloc.lisp 6 Nov 2003 22:44:58 -0000 1.2.6.2
@@ -36,7 +36,7 @@
(let* ((cons-cells (if star (1- num) num))
(alloc (* (pad-data-block cons-size) cons-cells)))
(pseudo-atomic (pa-flag)
- (allocation res alloc list-pointer-lowtag)
+ (allocation res alloc list-pointer-lowtag :temp-tn temp)
(move ptr res)
(dotimes (i (1- cons-cells))
(storew (maybe-load (tn-ref-tn things)) ptr
@@ -83,7 +83,7 @@
;; pseudo-atomic, because oring in other-pointer-lowtag just adds
;; it right back.
(inst add size boxed unboxed)
- (allocation result size other-pointer-lowtag)
+ (allocation result size other-pointer-lowtag :temp-tn ndescr)
(inst slwi ndescr boxed (- n-widetag-bits word-shift))
(inst ori ndescr ndescr code-header-widetag)
(storew ndescr result 0 other-pointer-lowtag)
@@ -116,7 +116,7 @@
(let ((size (+ length closure-info-offset)))
(pseudo-atomic (pa-flag)
(allocation result (pad-data-block size)
- fun-pointer-lowtag)
+ fun-pointer-lowtag :temp-tn temp)
(inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag))
(storew temp result 0 fun-pointer-lowtag)))
;(inst lis temp (ash 18 10))
@@ -154,7 +154,7 @@
(:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
(:generator 4
(pseudo-atomic (pa-flag)
- (allocation result (pad-data-block words) lowtag)
+ (allocation result (pad-data-block words) lowtag :temp-tn temp)
(when type
(inst lr temp (logior (ash (1- words) n-widetag-bits) type))
(storew temp result 0 lowtag)))))
@@ -166,6 +166,7 @@
(:ignore name)
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (any-reg)) bytes header)
+ (:temporary (:sc non-descriptor-reg) temp)
(:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
(:generator 6
(inst addi bytes extra (* (1+ words) n-word-bytes))
@@ -173,5 +174,5 @@
(inst addi header header (+ (ash -2 n-widetag-bits) type))
(inst clrrwi bytes bytes n-lowtag-bits)
(pseudo-atomic (pa-flag)
- (allocation result bytes lowtag)
+ (allocation result bytes lowtag :temp-tn temp)
(storew header result 0 lowtag))))
|