From 13218d8705ddfd8d841a9dd68ba1adb72f93213d Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 13 Jan 1993 16:08:25 +0000
Subject: [PATCH] gengc mods.

---
 compiler/mips/macros.lisp    | 95 +++++++++++++++++++++---------------
 compiler/mips/memory.lisp    | 64 ++++++------------------
 compiler/mips/nlx.lisp       | 55 +++++++++++++++++++--
 compiler/mips/parms.lisp     | 32 +++++++++++-
 compiler/mips/static-fn.lisp | 12 ++---
 compiler/mips/system.lisp    | 44 ++++++++++++++++-
 compiler/mips/type-vops.lisp |  6 +--
 compiler/mips/vm.lisp        | 26 +++++++---
 8 files changed, 220 insertions(+), 114 deletions(-)

diff --git a/compiler/mips/macros.lisp b/compiler/mips/macros.lisp
index f74c1706f..57bb6e300 100644
--- a/compiler/mips/macros.lisp
+++ b/compiler/mips/macros.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/macros.lisp,v 1.47 1992/07/28 20:37:32 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/macros.lisp,v 1.48 1993/01/13 16:08:25 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -49,39 +49,28 @@
 ;;; 
 (def-mem-op loadw lw word-shift t)
 (def-mem-op storew sw word-shift nil)
-
+#+gengc
+(def-mem-op storew-and-remember-slot sw-and-remember-slot word-shift nil)
+#+gengc
+(def-mem-op storew-and-remember-object sw-and-remember-object word-shift nil)
 
 (defmacro load-symbol (reg symbol)
-  `(inst add ,reg null-tn (static-symbol-offset ,symbol)))
-
-(macrolet
-    ((frob (slot)
-       (let ((loader (intern (concatenate 'simple-string
-					  "LOAD-SYMBOL-"
-					  (string slot))))
-	     (storer (intern (concatenate 'simple-string
-					  "STORE-SYMBOL-"
-					  (string slot))))
-	     (offset (intern (concatenate 'simple-string
-					  "SYMBOL-"
-					  (string slot)
-					  "-SLOT")
-			     (find-package "VM"))))
-	 `(progn
-	    (defmacro ,loader (reg symbol)
-	      `(progn
-		 (inst lw ,reg null-tn
-		       (+ (static-symbol-offset ',symbol)
-			  (ash ,',offset word-shift)
-			  (- other-pointer-type)))
-		 (inst nop)))
-	    (defmacro ,storer (reg symbol)
-	      `(inst sw ,reg null-tn
-		     (+ (static-symbol-offset ',symbol)
-			(ash ,',offset word-shift)
-			(- other-pointer-type))))))))
-  (frob value)
-  (frob function))
+  `(inst addu ,reg null-tn (static-symbol-offset ,symbol)))
+
+#-gengc
+(defmacro load-symbol-value (reg symbol)
+  `(progn
+     (inst lw ,reg null-tn
+	   (+ (static-symbol-offset ',symbol)
+	      (ash symbol-value-slot word-shift)
+	      (- other-pointer-type)))
+     (inst nop)))
+#-gengc
+(defmacro store-symbol-value (reg symbol)
+  `(inst sw ,reg null-tn
+	 (+ (static-symbol-offset ',symbol)
+	    (ash symbol-value-slot word-shift)
+	    (- other-pointer-type))))
 
 (defmacro load-type (target source &optional (offset 0))
   "Loads the type bits of a pointer into target independent of
@@ -99,15 +88,17 @@
 ;;; Macros to handle the fact that we cannot use the machine native call and
 ;;; return instructions. 
 
+#-gengc
 (defmacro lisp-jump (function lip)
   "Jump to the lisp function FUNCTION.  LIP is an interior-reg temporary."
   `(progn
-     (inst addu ,lip ,function (- (ash function-header-code-offset
-					word-shift)
-				   function-pointer-type))
+     (inst addu ,lip ,function (- (ash vm:function-header-code-offset
+					vm:word-shift)
+				   vm:function-pointer-type))
      (inst j ,lip)
      (move code-tn ,function)))
 
+#-gengc
 (defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t))
   "Return to RETURN-PC.  LIP is an interior-reg temporary."
   `(progn
@@ -118,11 +109,14 @@
 	  `(move code-tn ,return-pc)
 	  '(inst nop))))
 
+
 (defmacro emit-return-pc (label)
   "Emit a return-pc header word.  LABEL is the label to use for this return-pc."
   `(progn
+     #-gengc
      (align lowtag-bits)
      (emit-label ,label)
+     #-gengc
      (inst lra-header-word)))
 
 
@@ -167,6 +161,7 @@
 
 ;;;; Storage allocation:
 
+#-gengc
 (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size)
 				 &body body)
   "Do stuff to allocate an other-pointer object of fixed Size with a single
@@ -180,6 +175,23 @@
      (storew ,temp-tn ,result-tn 0 other-pointer-type)
      ,@body))
 
+#+gengc
+(defun fixed-allocate (result temp type-code size)
+  (assemble ()
+    (without-scheduling ()
+      (inst li temp (logior (ash (1- size) type-bits) type-code))
+      (inst or result alloc-tn other-pointer-type)
+      (inst sw temp alloc-tn)
+      (inst addu alloc-tn alloc-tn (pad-data-block size)))))
+
+#+gengc
+(defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size)
+				 &body body)
+  (declare (ignore flag-tn))
+  `(progn
+     (fixed-allocate ,result-tn ,temp-tn ,type-code ,size)
+     ,@body))
+
 
 ;;;; Three Way Comparison
 
@@ -290,10 +302,13 @@
 ;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic.
 ;;;
 (defmacro pseudo-atomic ((flag-tn &key (extra 0)) &rest forms)
+  #+gengc
+  (unless (eql extra 0)
+    (error "Can't allocate any extra with pseudo-atomic in the gengc system."))
   `(progn
      (assert (= (tn-offset ,flag-tn) nl4-offset))
      (without-scheduling ()
-       (inst li ,flag-tn (1- ,extra))
+       (inst li ,flag-tn #-gengc (1- ,extra) #+gengc -1)
        (inst addu alloc-tn 1))
      ,@forms
      (without-scheduling ()
@@ -346,7 +361,7 @@
 	 (inst nop)))))
 
 (defmacro define-full-setter (name type offset lowtag scs el-type
-				   &optional translate)
+				   &optional translate #+gengc (remember t))
   `(progn
      (define-vop (,name)
        ,@(when translate
@@ -361,7 +376,8 @@
        (:result-types ,el-type)
        (:generator 2
 	 (inst add lip object index)
-	 (inst sw value lip (- (* ,offset word-bytes) ,lowtag))
+	 (inst #+gengc ,(if remember 'sw-and-remember-slot 'sw) #-gengc sw
+	       value lip (- (* ,offset word-bytes) ,lowtag))
 	 (move result value)))
      (define-vop (,(symbolicate name "-C"))
        ,@(when translate
@@ -377,7 +393,8 @@
        (:results (result :scs ,scs))
        (:result-types ,el-type)
        (:generator 1
-	 (inst sw value object (- (* (+ ,offset index) word-bytes) ,lowtag))
+	 (inst #+gengc ,(if remember 'sw-and-remember-slot 'sw) #-gengc sw
+	       value object (- (* (+ ,offset index) word-bytes) ,lowtag))
 	 (move result value)))))
 
 
diff --git a/compiler/mips/memory.lisp b/compiler/mips/memory.lisp
index 7980d5186..04b98b6cf 100644
--- a/compiler/mips/memory.lisp
+++ b/compiler/mips/memory.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/memory.lisp,v 1.13 1992/07/28 20:37:35 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.14 1993/01/13 16:06:43 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -23,10 +23,7 @@
 
 
 ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to
-;;; be read or written is a property of the VOP used.  Cell-Setf is similar to
-;;; Cell-Set, but delivers the new value as the result.  Cell-Setf-Function
-;;; takes its arguments as if it were a setf function (new value first, as
-;;; apposed to a setf macro, which takes the new value last).
+;;; be read or written is a property of the VOP used.
 ;;;
 (define-vop (cell-ref)
   (:args (object :scs (descriptor-reg)))
@@ -40,52 +37,15 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (descriptor-reg any-reg)))
   (:variant-vars offset lowtag)
+  #+gengc (:info remember)
   (:policy :fast-safe)
   (:generator 4
+    #+gengc
+    (if remember
+	(storew-and-remember-slot value object offset lowtag)
+	(storew value object offset lowtag))
+    #-gengc
     (storew value object offset lowtag)))
-;;;
-(define-vop (cell-setf)
-  (:args (object :scs (descriptor-reg))
-	 (value :scs (descriptor-reg any-reg)
-		:target result))
-  (:results (result :scs (descriptor-reg any-reg)))
-  (:variant-vars offset lowtag)
-  (:policy :fast-safe)
-  (:generator 4
-    (storew value object offset lowtag)
-    (move result value)))
-;;;
-(define-vop (cell-setf-function)
-  (:args (value :scs (descriptor-reg any-reg)
-		:target result)
-	 (object :scs (descriptor-reg)))
-  (:results (result :scs (descriptor-reg any-reg)))
-  (:variant-vars offset lowtag)
-  (:policy :fast-safe)
-  (:generator 4
-    (storew value object offset lowtag)
-    (move result value)))
-
-;;; Define-Cell-Accessors  --  Interface
-;;;
-;;;    Define accessor VOPs for some cells in an object.  If the operation name
-;;; is NIL, then that operation isn't defined.  If the translate function is
-;;; null, then we don't define a translation.
-;;;
-(defmacro define-cell-accessors (offset lowtag
-					ref-op ref-trans set-op set-trans)
-  `(progn
-     ,@(when ref-op
-	 `((define-vop (,ref-op cell-ref)
-	     (:variant ,offset ,lowtag)
-	     ,@(when ref-trans
-		 `((:translate ,ref-trans))))))
-     ,@(when set-op
-	 `((define-vop (,set-op cell-setf)
-	     (:variant ,offset ,lowtag)
-	     ,@(when set-trans
-		 `((:translate ,set-trans))))))))
-
 
 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
 ;;; offset is constant at compile time, but varies for different uses.  We add
@@ -103,7 +63,11 @@
   (:args (object :scs (descriptor-reg))
 	 (value :scs (descriptor-reg any-reg)))
   (:variant-vars base lowtag)
-  (:info offset)
+  (:info offset #+gengc remember)
   (:generator 4
+    #+gengc
+    (if remember
+	(storew-and-remember-slot value object (+ base offset) lowtag)
+	(storew value object (+ base offset) lowtag))
+    #-gengc
     (storew value object (+ base offset) lowtag)))
-
diff --git a/compiler/mips/nlx.lisp b/compiler/mips/nlx.lisp
index 38658b63e..09ad59456 100644
--- a/compiler/mips/nlx.lisp
+++ b/compiler/mips/nlx.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/nlx.lisp,v 1.18 1992/07/28 20:37:40 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.19 1993/01/13 16:05:00 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -54,12 +54,18 @@
 	    (eval :scs (descriptor-reg)))
   (:vop-var vop)
   (:generator 13
+    #-gengc
     (load-symbol-value catch lisp::*current-catch-block*)
+    #+gengc
+    (loadw catch mutator-tn mutator-current-catch-block-slot)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(move nfp cur-nfp)))
     (move nsp nsp-tn)
-    (load-symbol-value eval lisp::*eval-stack-top*)))
+    #-gengc
+    (load-symbol-value eval lisp::*eval-stack-top*)
+    #+gengc
+    (loadw eval mutator-tn mutator-eval-stack-top-slot)))
 
 (define-vop (restore-dynamic-state)
   (:args (catch :scs (descriptor-reg))
@@ -68,8 +74,14 @@
 	 (eval :scs (descriptor-reg)))
   (:vop-var vop)
   (:generator 10
+    #-gengc
     (store-symbol-value catch lisp::*current-catch-block*)
+    #+gengc
+    (storew catch mutator-tn mutator-current-catch-block-slot)
+    #-gengc
     (store-symbol-value eval lisp::*eval-stack-top*)
+    #+gengc
+    (storew eval mutator-tn mutator-eval-stack-top-slot)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(move cur-nfp nfp)))
@@ -100,11 +112,17 @@
   (:temporary (:scs (non-descriptor-reg)) ndescr)
   (:generator 22
     (inst addu block cfp-tn (* (tn-offset tn) vm:word-bytes))
+    #-gengc
     (load-symbol-value temp lisp::*current-unwind-protect-block*)
+    #+gengc
+    (loadw temp mutator-tn mutator-current-unwind-protect-slot)
     (storew temp block vm:unwind-block-current-uwp-slot)
     (storew cfp-tn block vm:unwind-block-current-cont-slot)
     (storew code-tn block vm:unwind-block-current-code-slot)
+    #-gengc
     (inst compute-lra-from-code temp code-tn entry-label ndescr)
+    #+gengc
+    (inst compute-ra-from-code temp code-tn entry-label ndescr)
     (storew temp block vm:catch-block-entry-pc-slot)))
 
 
@@ -121,17 +139,29 @@
   (:temporary (:scs (non-descriptor-reg)) ndescr)
   (:generator 44
     (inst addu result cfp-tn (* (tn-offset tn) vm:word-bytes))
+    #-gengc
     (load-symbol-value temp lisp::*current-unwind-protect-block*)
+    #+gengc
+    (loadw temp mutator-tn mutator-current-unwind-protect-slot)
     (storew temp result vm:catch-block-current-uwp-slot)
     (storew cfp-tn result vm:catch-block-current-cont-slot)
     (storew code-tn result vm:catch-block-current-code-slot)
+    #-gengc
     (inst compute-lra-from-code temp code-tn entry-label ndescr)
+    #+gengc
+    (inst compute-ra-from-code temp code-tn entry-label ndescr)
     (storew temp result vm:catch-block-entry-pc-slot)
 
     (storew tag result vm:catch-block-tag-slot)
+    #-gengc
     (load-symbol-value temp lisp::*current-catch-block*)
+    #+gengc
+    (loadw temp mutator-tn mutator-current-catch-block-slot)
     (storew temp result vm:catch-block-previous-catch-slot)
+    #-gengc
     (store-symbol-value result lisp::*current-catch-block*)
+    #+gengc
+    (storew result mutator-tn mutator-current-catch-block-slot)
 
     (move block result)))
 
@@ -144,7 +174,10 @@
   (:temporary (:scs (descriptor-reg)) new-uwp)
   (:generator 7
     (inst addu new-uwp cfp-tn (* (tn-offset tn) vm:word-bytes))
-    (store-symbol-value new-uwp lisp::*current-unwind-protect-block*)))
+    #-gengc
+    (store-symbol-value new-uwp lisp::*current-unwind-protect-block*)
+    #+gengc
+    (storew new-uwp mutator-tn mutator-current-unwind-protect-slot)))
 
 
 (define-vop (unlink-catch-block)
@@ -152,18 +185,30 @@
   (:policy :fast-safe)
   (:translate %catch-breakup)
   (:generator 17
+    #-gengc
     (load-symbol-value block lisp::*current-catch-block*)
+    #+gengc
+    (loadw block mutator-tn mutator-current-catch-block-slot)
     (loadw block block vm:catch-block-previous-catch-slot)
-    (store-symbol-value block lisp::*current-catch-block*)))
+    #-gengc
+    (store-symbol-value block lisp::*current-catch-block*)
+    #+gengc
+    (storew block mutator-tn mutator-current-catch-block-slot)))
 
 (define-vop (unlink-unwind-protect)
   (:temporary (:scs (any-reg)) block)
   (:policy :fast-safe)
   (:translate %unwind-protect-breakup)
   (:generator 17
+    #-gengc
     (load-symbol-value block lisp::*current-unwind-protect-block*)
+    #+gengc
+    (loadw block mutator-tn mutator-current-unwind-protect-slot)
     (loadw block block vm:unwind-block-current-uwp-slot)
-    (store-symbol-value block lisp::*current-unwind-protect-block*)))
+    #-gengc
+    (store-symbol-value block lisp::*current-unwind-protect-block*)
+    #+gengc
+    (storew block mutator-tn mutator-current-unwind-protect-slot)))
 
 
 ;;;; NLX entry VOPs:
diff --git a/compiler/mips/parms.lisp b/compiler/mips/parms.lisp
index f34cf6d19..b8265acd3 100644
--- a/compiler/mips/parms.lisp
+++ b/compiler/mips/parms.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/parms.lisp,v 1.105 1992/07/28 20:37:43 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.106 1993/01/13 16:04:32 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -29,7 +29,9 @@
 (eval-when (compile eval load)
 
 (setf (backend-name *target-backend*) "PMAX")
-(setf (backend-version *target-backend*) "DECstation 3100/Mach 1.0")
+(setf (backend-version *target-backend*)
+      #-gengc "DECstation 3100/Mach 1.0"
+      #+gengc "DECstation 3100/Mach 1.0 (gengc)")
 (setf (backend-fasl-file-type *target-backend*) "pmaxf")
 (setf (backend-fasl-file-implementation *target-backend*)
       pmax-fasl-file-implementation)
@@ -134,6 +136,13 @@
 (defparameter target-static-space-start    #x05000000)
 (defparameter target-dynamic-space-start   #x07000000)
 
+;;; LARGE-OBJECT-CUTOFF -- Size in words where we start allocating in the
+;;; large object space instead.  Must be less then a page.
+;;;
+#+gengc
+(export 'large-object-cutoff)
+#+gengc
+(defparameter large-object-cutoff 1024)
 
 
 
@@ -177,6 +186,7 @@
 ;;; space directly after the static symbols.  That way, the raw-addr
 ;;; can be loaded directly out of them by indirecting relative to NIL.
 ;;;
+#-gengc
 (defparameter static-symbols
   '(t
 
@@ -209,6 +219,24 @@
     unix::*interrupt-pending*
     ))
 
+#+gengc
+(defparameter static-symbols
+  '(t
+
+    ;; Random stuff needed for initialization.
+    lisp::lisp-environment-list
+    lisp::lisp-command-line-list
+    lisp::*initial-fdefn-objects*
+
+    ;; Functions that the C code needs to call
+    lisp::%initial-function
+    kernel::internal-error
+    di::handle-breakpoint
+    di::handle-function-end-breakpoint
+    lisp::fdefinition-object
+    apply
+    ))
+
 (defparameter static-functions
   '(two-arg-+ two-arg-- two-arg-* two-arg-/ two-arg-< two-arg-> two-arg-=
     two-arg-<= two-arg->= two-arg-/= eql %negate
diff --git a/compiler/mips/static-fn.lisp b/compiler/mips/static-fn.lisp
index 03da29f8e..f00057c8f 100644
--- a/compiler/mips/static-fn.lisp
+++ b/compiler/mips/static-fn.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/static-fn.lisp,v 1.18 1992/07/28 20:37:50 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.19 1993/01/13 16:03:23 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -27,8 +27,8 @@
   (:vop-var vop)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg)) move-temp)
-  (:temporary (:sc descriptor-reg :offset lra-offset) lra)
-  (:temporary (:scs (interior-reg)) lip)
+  #-gengc (:temporary (:sc descriptor-reg :offset lra-offset) lra)
+  (:temporary (:sc interior-reg :offset lip-offset) entry-point)
   (:temporary (:sc any-reg :offset nargs-offset) nargs)
   (:temporary (:sc any-reg :offset ocfp-offset) ocfp)
   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
@@ -89,13 +89,13 @@
 		 (cur-nfp (current-nfp-tn vop)))
 	     ,@(moves (temp-names) (arg-names))
 	     (inst li nargs (fixnum ,num-args))
-	     (inst lw lip null-tn (static-function-offset symbol))
+	     (inst lw entry-point null-tn (static-function-offset symbol))
 	     (when cur-nfp
 	       (store-stack-tn nfp-save cur-nfp))
 	     (inst move ocfp cfp-tn)
-	     (inst compute-lra-from-code lra code-tn lra-label temp)
+	     #-gengc (inst compute-lra-from-code lra code-tn lra-label temp)
 	     (note-this-location vop :call-site)
-	     (inst j lip)
+	     (inst #-gengc j #+gengc jal entry-point)
 	     (inst move cfp-tn csp-tn)
 	     (emit-return-pc lra-label)
 	     ,(collect ((bindings) (links))
diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp
index 6978f4b0d..d695f2f9c 100644
--- a/compiler/mips/system.lisp
+++ b/compiler/mips/system.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/system.lisp,v 1.46 1992/07/28 20:37:54 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.47 1993/01/13 16:02:06 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -249,6 +249,48 @@
     (inst addu ndescr (- function-pointer-type other-pointer-type))
     (inst addu func code ndescr)))
 
+#+gengc
+(progn
+
+(define-vop (%function-self)
+  (:policy :fast-safe)
+  (:translate (setf %function-self))
+  (:args (function :scs (descriptor-reg)))
+  (:temporary (:scs (any-reg)) temp)
+  (:results (result :scs (descriptor-reg)))
+  (:generator 3
+    (loadw temp function function-entry-point-slot function-pointer-type)
+    (inst addu result temp
+	  (- function-pointer-type (* function-code-offset word-bytes)))))
+
+(defknown %set-function-self (function function) (values) (unsafe))
+
+(define-vop (%set-function-self)
+  (:policy :fast-safe)
+  (:translate %set-function-self)
+  (:args (function :scs (descriptor-reg))
+	 (new-self :scs (descriptor-reg)))
+  (:temporary (:scs (any-reg)) temp)
+  (:generator 3
+    (inst addu temp new-self
+	  (- (* function-code-offset word-bytes) function-pointer-type))
+    (storew temp function function-entry-point-slot function-pointer-type)))
+
+(def-source-transform %closure-function (closure)
+  `(%function-self ,closure))
+
+(def-source-transform (setf %function-self) (new-self fun)
+  `(let ((new-self ,new-self) (fun ,fun))
+     (%set-function-self fun new-self)
+     new-self))
+
+(def-source-transform %set-funcallable-instance-function (fin fun)
+  `(let ((fin ,fin) (fun ,fun))
+     (%set-function-self fin fun)
+     fun))
+
+); #+gengc progn
+
 
 ;;;; Other random VOPs.
 
diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp
index ce5ec157b..77216fae6 100644
--- a/compiler/mips/type-vops.lisp
+++ b/compiler/mips/type-vops.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/type-vops.lisp,v 1.38 1992/12/05 21:54:24 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.39 1993/01/13 16:00:02 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -327,13 +327,13 @@
   object-not-weak-pointer-error weak-pointer-type)
 
 (def-type-vops scavenger-hook-p nil nil nil
-  0)
+  #-gengc 0 #+gengc scavenger-hook-type)
 
 (def-type-vops code-component-p nil nil nil
   code-header-type)
 
 (def-type-vops lra-p nil nil nil
-  return-pc-header-type)
+  #-gengc return-pc-header-type #+gengc 0)
 
 (def-type-vops fdefn-p nil nil nil
   fdefn-type)
diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp
index ca895258d..6803cd96f 100644
--- a/compiler/mips/vm.lisp
+++ b/compiler/mips/vm.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/vm.lisp,v 1.46 1992/07/28 20:38:03 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.47 1993/01/13 15:59:31 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -43,7 +43,8 @@
 ); eval-when
 
 (defreg zero 0)
-(defreg nl3 1)
+#-gengc (defreg nl3 1)
+#+gengc (defreg lip 1)
 (defreg cfunc 2)
 (defreg nl4 3)
 (defreg nl0 4) ; First C argument reg.
@@ -61,23 +62,28 @@
 ;; First saved reg
 (defreg nfp 16)
 (defreg ocfp 17)
-(defreg lra 18)
+#-gengc (defreg lra 18)
+#+gengc (defreg mutator 18)
 (defreg l0 19)
 (defreg null 20)
 (defreg bsp 21)
 (defreg cfp 22)
 (defreg csp 23)
-(defreg l1 24)
+#-gengc (defreg l1 24)
+#+gengc (defreg ssb 24)
 (defreg alloc 25)
 (defreg nsp 29)
 (defreg code 30)
+#-gengc
 (defreg lip 31)
+#+gengc
+(defreg ra 31)
 
 (defregset non-descriptor-regs
-  nl0 nl1 nl2 nl3 nl4 cfunc nargs)
+  nl0 nl1 nl2 ra nl4 cfunc nargs)
 
 (defregset descriptor-regs
-  a0 a1 a2 a3 a4 a5 fdefn lexenv nfp ocfp lra l0 l1)
+  a0 a1 a2 a3 a4 a5 fdefn lexenv nfp ocfp #-gengc lra l0 #-gengc l1)
 
 (defregset register-arg-offsets
   a0 a1 a2 a3 a4 a5)
@@ -248,6 +254,8 @@
 (defregtn code descriptor-reg)
 (defregtn alloc any-reg)
 (defregtn null descriptor-reg)
+#+gengc (defregtn mutator sap-reg)
+#+gengc (defregtn ssb sap-reg)
 
 (defregtn nargs any-reg)
 (defregtn fdefn descriptor-reg)
@@ -259,7 +267,7 @@
 (defregtn ocfp any-reg)
 (defregtn nsp any-reg)
 (defregtn nfp any-reg)
-
+#+gengc (defregtn ra any-reg)
 
 
 ;;;
@@ -298,8 +306,10 @@
 
 ;;; Offsets of special stack frame locations
 (defconstant ocfp-save-offset 0)
-(defconstant lra-save-offset 1)
+#-gengc (defconstant lra-save-offset 1)
+#+gengc (defconstant ra-save-offset 1)
 (defconstant nfp-save-offset 2)
+#+gengc (defconstant code-save-offset 3)
 
 
 ;;; The number of arguments/return values passed in registers.
-- 
GitLab