Commit a0d88a92 authored by rtoy's avatar rtoy
Browse files

Checkin the current code for gencgc. This is a basic port of sparc 

gencgc for ppc.  This is not yet functional.  Allocation seems to
work, but GC does not.  We're just making a checkpoint now.

compiler/ppc/macros.lisp:
o Update allocation macro to support gencgc.  Need a temp-tn as a
  scratch register for inline allocation.
o Update with-fixed-allocation to use allocation macro correctly for
  gencgc.

assembly/ppc/array.lisp:
o Update for new allocation macro for gencgc.

code/ppc-vm.lisp:
o Define *scavenge-read-only-space*

compiler/ppc/alloc.lisp:
compiler/ppc/array.lisp:
compiler/ppc/call.lisp:
o Update to use new allocation macro for gencgc.

compiler/ppc/parms.lisp:
o Add necessary static symbols to support gencgc.

lisp/Config.ppc_darwin:
o Update to build with gencgc as needed.

lisp/Darwin-os.c:
o Update C code for gencgc.  Mostly for checking if pointer is in the
  dynamic space.
o Many debugging printf's enabled.

lisp/gencgc.c:
o Adjust sparc version appropriately for ppc.
o Enable many gencgc self-checks.

lisp/gencgc.h:
o Update PAGE_SIZE for ppc, which is 4K.

lisp/ppc-arch.c:
o Add necessary code to handle the allocation traps for gencgc.
  Basically ported sparc version for ppc.

lisp/ppc-assem.S:
o The way pseudo-atomic is done has been changed, so make the assembly
  code match.  PA is now more like sparc where the LSB is the
  PA-interrupted bit.
o do_pending_interrupt may need work.

lisp/ppc-validate.h:
o Make the READ_ONLY_SPACE_SIZE right.
o Define CONTROL_STACK_END.

lisp/purify.c:
o Enable debugging printfs
o Adjust purify for gencgc, basically copying sparc version.
parent 4d1aa44a

assembly/ppc/array.lisp

+5 −3
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman (FAHLMAN@CMUC). 

;;; **********************************************************************

;;;

;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.4 2004/09/08 02:10:54 rtoy Exp $

;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.4.2.1 2005/04/05 03:41:08 rtoy Exp $

;;;

;;;    This file contains the support routines for arrays and vectors.

;;;
@@ -29,11 +29,13 @@ 


			  (:temp ndescr non-descriptor-reg nl0-offset)

			  (:temp pa-flag non-descriptor-reg nl3-offset)

			  (:temp vector descriptor-reg a3-offset))

			  (:temp vector descriptor-reg a3-offset)

			  (:temp temp non-descriptor-reg nl2-offset))

  (pseudo-atomic (pa-flag)

    (inst addi ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes))

    (inst clrrwi ndescr ndescr lowtag-bits)

    (allocation vector ndescr other-pointer-type)

    (allocation vector ndescr other-pointer-type

		:temp-tn temp :flag-tn pa-flag)

    (inst srwi ndescr type vm:word-shift)

    (storew ndescr vector 0 vm:other-pointer-type)

    (storew length vector vm:vector-length-slot vm:other-pointer-type))

code/ppc-vm.lisp

+3 −1
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.5 2005/02/06 19:43:13 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.5.2.1 2005/04/05 03:41:08 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -345,3 +345,5 @@ 
		      word-bytes)))

  nil)



;;; Enable/Disable scavenging of the read-only space.

(defvar *scavenge-read-only-space* nil)

compiler/ppc/alloc.lisp

+9 −6
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.9 2005/02/06 19:43:14 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.9.2.1 2005/04/05 03:41:09 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -66,7 +66,8 @@ 
	     (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-type :temp-tn alloc-temp)

		 (allocation res alloc list-pointer-type :temp-tn alloc-temp

			     :flag-tn pa-flag)

		 (move ptr res)

		 (dotimes (i (1- cons-cells))

		   (storew (maybe-load (tn-ref-tn things)) ptr
@@ -113,7 +114,7 @@ 
      ;; pseudo-atomic, because oring in other-pointer-type just adds

      ;; it right back.

      (inst add size boxed unboxed)

      (allocation result size other-pointer-type :temp-tn ndescr)

      (allocation result size other-pointer-type :temp-tn ndescr :flag-tn pa-flag)

      (inst slwi ndescr boxed (- type-bits word-shift))

      (inst ori ndescr ndescr code-header-type)

      (storew ndescr result 0 other-pointer-type)
@@ -155,7 +156,8 @@ 
    (let ((size (+ length closure-info-offset)))

      (pseudo-atomic (pa-flag)

     

	(allocation result (pad-data-block size) function-pointer-type :temp-tn temp)

	(allocation result (pad-data-block size) function-pointer-type

		    :temp-tn temp :flag-tn pa-flag)

	(inst lr temp (logior (ash (1- size) type-bits) closure-header-type))

	(storew temp result 0 function-pointer-type)))

    #+PPC-FUN-HACK
@@ -196,7 +198,7 @@ 
  (:generator 4

    ;; Could this be replaced with with-fixed-allocation?

    (pseudo-atomic (pa-flag)

      (allocation result (pad-data-block words) lowtag :temp-tn temp)

      (allocation result (pad-data-block words) lowtag :temp-tn temp :flag-tn pa-flag)

      (when type

	(inst lr temp (logior (ash (1- words) type-bits) type))

	(storew temp result 0 lowtag)))))
@@ -209,6 +211,7 @@ 
  (:results (result :scs (descriptor-reg)))

  (:temporary (:scs (any-reg)) bytes)

  (:temporary (:scs (non-descriptor-reg)) header)

  (:temporary (:scs (non-descriptor-reg)) temp)

  (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)

  (:generator 6

    (inst addi bytes extra (* (1+ words) word-bytes))
@@ -216,5 +219,5 @@ 
    (inst addi header header (+ (ash -2 type-bits) type))

    (inst clrrwi bytes bytes lowtag-bits)

    (pseudo-atomic (pa-flag)

      (allocation result bytes lowtag :temp-tn temp)

      (allocation result bytes lowtag :temp-tn temp :flag-tn pa-flag)

      (storew header result 0 lowtag))))

compiler/ppc/array.lisp

+2 −2
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.5 2004/08/08 11:15:12 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.5.2.1 2005/04/05 03:41:09 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -35,7 +35,7 @@ 
    (pseudo-atomic (pa-flag)

      (inst addi ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes))

      (inst clrrwi ndescr ndescr lowtag-bits)

      (allocation header ndescr other-pointer-type :temp-tn gc-temp)

      (allocation header ndescr other-pointer-type :temp-tn gc-temp :flag-tn pa-flag)

      (inst addi ndescr rank (fixnumize (1- vm:array-dimensions-offset)))

      (inst slwi ndescr ndescr vm:type-bits)

      (inst or ndescr ndescr type)

compiler/ppc/call.lisp

+2 −2
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.6 2004/08/09 01:36:47 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.6.2.1 2005/04/05 03:41:09 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -1199,7 +1199,7 @@ default-value-8 
      (assemble ()

	;; Allocate a cons (2 words) for each item.

	(inst slwi temp count 1)

        (allocation result temp list-pointer-type :temp-tn dst)

        (allocation result temp list-pointer-type :temp-tn dst :flag-tn pa-flag)

	(move dst result)

	(inst b enter)