From b6ea4ff696c73a692f6991eeb4ebefde1ce659db Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 16 Dec 1992 18:13:55 +0000
Subject: [PATCH] Lots of gengc stuff under #+gengcs.  Fixed var-alloc, was
 real broken.

---
 compiler/mips/alloc.lisp | 86 ++++++++++++++++++++++++++++------------
 1 file changed, 61 insertions(+), 25 deletions(-)

diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
index 8fd40ebe3..e8f9e6d92 100644
--- a/compiler/mips/alloc.lisp
+++ b/compiler/mips/alloc.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/alloc.lisp,v 1.19 1992/12/13 15:21:29 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.20 1992/12/16 18:13:55 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,6 +21,7 @@
 
 ;;;; LIST and LIST*
 
+#-gengc
 (define-vop (list-or-list*)
   (:args (things :more t))
   (:temporary (:scs (descriptor-reg) :type list) ptr)
@@ -72,9 +73,11 @@
 		 (assert (null (tn-ref-across things)))
 		 (move result res))))))))
 
+#-gengc
 (define-vop (list list-or-list*)
   (:variant nil))
 
+#-gengc
 (define-vop (list* list-or-list*)
   (:variant t))
 
@@ -91,28 +94,33 @@
   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:generator 100
     (inst li ndescr (lognot lowtag-mask))
-    (inst addu boxed boxed-arg (fixnum (1+ code-trace-table-offset-slot)))
+    (inst addu boxed boxed-arg
+	  (fixnum (1+ #-gengc code-trace-table-offset-slot
+		      #+gengc code-debug-info-slot)))
     (inst and boxed ndescr)
     (inst srl unboxed unboxed-arg word-shift)
     (inst addu unboxed unboxed lowtag-mask)
     (inst and unboxed ndescr)
-    (pseudo-atomic (pa-flag)
+    (inst sll ndescr boxed (- type-bits word-shift))
+    (inst or ndescr code-header-type)
+    
+    (#-gengc pseudo-atomic #-gengc (pa-flag)
+     #+gengc without-scheduling #+gengc ()
       (inst or result alloc-tn other-pointer-type)
+      (storew ndescr alloc-tn 0)
+      (storew unboxed alloc-tn code-code-size-slot)
+      (storew null-tn alloc-tn code-entry-points-slot)
       (inst addu alloc-tn boxed)
-      (inst addu alloc-tn unboxed)
-      (inst sll ndescr boxed (- type-bits word-shift))
-      (inst or ndescr code-header-type)
-      (storew ndescr result 0 other-pointer-type)
-      (storew unboxed result code-code-size-slot other-pointer-type)
-      (storew null-tn result code-entry-points-slot other-pointer-type)
-      (storew null-tn result code-debug-info-slot other-pointer-type))))
+      (inst addu alloc-tn unboxed))
+
+    (storew null-tn result code-debug-info-slot other-pointer-type)))
 
 (define-vop (make-fdefn)
   (:policy :fast-safe)
   (:translate make-fdefn)
   (:args (name :scs (descriptor-reg) :to :eval))
   (:temporary (:scs (non-descriptor-reg)) temp)
-  (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
+  #-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:results (result :scs (descriptor-reg) :from :argument))
   (:generator 37
     (with-fixed-allocation (result pa-flag temp fdefn-type fdefn-size)
@@ -128,19 +136,30 @@
   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:results (result :scs (descriptor-reg)))
   (:generator 10
+    #-gengc
     (let ((size (+ length closure-info-offset)))
+      (inst li temp (logior (ash (1- size) type-bits) closure-header-type))
       (pseudo-atomic (pa-flag :extra (pad-data-block size))
 	(inst or result alloc-tn function-pointer-type)
-	(inst li temp (logior (ash (1- size) type-bits) closure-header-type))
-	(storew temp result 0 function-pointer-type)))
-    (storew function result closure-function-slot function-pointer-type)))
+	(storew temp alloc-tn))
+      (storew function result closure-function-slot function-pointer-type))
+    #+gengc
+    (let ((size (+ length closure-info-offset)))
+      (inst li temp (logior (ash (1- size) type-bits) closure-header-type))
+      (without-scheduling ()
+	(inst or result alloc-tn function-pointer-type)
+	(storew temp alloc-tn)
+	(inst addu alloc-tn (pad-data-block size)))
+      (inst addu temp function
+	    (- (* function-code-offset word-bytes) function-pointer-type))
+      (storew temp result closure-entry-point-slot function-pointer-type))))
 
 ;;; The compiler likes to be able to directly make value cells.
 ;;; 
 (define-vop (make-value-cell)
   (:args (value :to :save :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
-  (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
+  #-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:results (result :scs (descriptor-reg)))
   (:generator 10
     (with-fixed-allocation
@@ -164,11 +183,21 @@
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:generator 4
+    #-gengc
     (pseudo-atomic (pa-flag :extra (pad-data-block words))
       (inst or result alloc-tn lowtag)
       (when type
 	(inst li temp (logior (ash (1- words) type-bits) type))
-	(storew temp result 0 lowtag)))))
+	(storew temp result 0 lowtag)))
+    #+gengc
+    (progn
+      (when type
+	(inst li temp (logior (ash (1- words) type-bits) type)))
+      (without-scheduling ()
+	(inst or result alloc-tn lowtag)
+	(when type
+	  (storew temp alloc-tn))
+	(inst addu alloc-tn (pad-data-block words))))))
 
 (define-vop (var-alloc)
   (:args (extra :scs (any-reg)))
@@ -176,15 +205,22 @@
   (:info name words type lowtag)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
-  (:temporary (:scs (any-reg)) temp1 temp2)
-  (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
+  (:temporary (:scs (any-reg)) header)
+  (:temporary (:scs (non-descriptor-reg)) bytes)
+  #-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:generator 6
+    (inst addu bytes extra (* (1+ words) word-bytes))
+    (inst sll header bytes (- type-bits 2))
+    (inst addu header header (+ (ash -2 type-bits) type))
+    (inst srl bytes bytes lowtag-bits)
+    (inst sll bytes bytes lowtag-bits)
+    #-gengc
     (pseudo-atomic (pa-flag)
       (inst or result alloc-tn lowtag)
-      (inst addu temp1 extra (fixnum (1- words)))
-      (inst sll temp2 temp2 (- type-bits 2))
-      (inst or temp2 temp2 type)
-      (storew temp2 result 0 lowtag)
-      (inst li temp2 (lognot lowtag-mask))
-      (inst and temp1 temp1 temp2)
-      (inst addu alloc-tn alloc-tn temp1))))
+      (storew header result 0 lowtag)
+      (inst addu alloc-tn alloc-tn bytes))
+    #+gengc
+    (without-scheduling ()
+      (inst or result alloc-tn lowtag)
+      (storew header result 0 lowtag)
+      (inst addu alloc-tn alloc-tn bytes))))
-- 
GitLab