From 94bd324ff7653639559f70ab7f6c343f57a98c4f Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Thu, 31 May 1990 00:22:55 +0000
Subject: [PATCH] Changed get-type to indirect function pointers in addition to
 otherpointers. Fixed code-instructions to use vm:other-pointer-type when
 accounting for the lowtag on the code object, not vm:code-header-type.

---
 compiler/mips/system.lisp | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp
index d4b11a910..ceb9272df 100644
--- a/compiler/mips/system.lisp
+++ b/compiler/mips/system.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.18 1990/05/27 16:50:48 ch Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.19 1990/05/31 00:22:55 wlott Exp $
 ;;;
 ;;;    MIPS VM definitions of various system hacking operations.
 ;;;
@@ -74,9 +74,12 @@
   (:results (result :scs (any-reg descriptor-reg)))
   (:generator 10
     (let ((other-ptr (gen-label))
-	  (shift (gen-label)))
+	  (shift (gen-label))
+	  (function-ptr (gen-label)))
       (simple-test-simple-type object ndescr other-ptr
 			       nil vm:other-pointer-type)
+      (simple-test-simple-type object ndescr function-ptr
+			       nil vm:function-pointer-type)
       (inst and ndescr object (logand (logeqv vm:other-immediate-0-type
 					      vm:other-immediate-1-type)
 				      vm:lowtag-mask))
@@ -88,6 +91,11 @@
       (inst b shift)
       (inst and ndescr object vm:type-mask)
       
+      (emit-label function-ptr)
+      (load-type ndescr object (- vm:function-pointer-type))
+      (inst b shift)
+      (inst nop)
+
       (emit-label other-ptr)
       (load-type ndescr object (- vm:other-pointer-type))
       (inst nop)
@@ -168,7 +176,7 @@
     (loadw ndescr code 0 vm:other-pointer-type)
     (inst srl ndescr vm:type-bits)
     (inst sll ndescr vm:word-shift)
-    (inst subu ndescr vm:code-header-type)
+    (inst subu ndescr vm:other-pointer-type)
     (inst addu sap code ndescr)))
 
 (define-vop (compute-function)
-- 
GitLab