From 97a6cac1caed2028814bfce2cf99a3bb11b0dd3e Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 21 Mar 1990 23:32:43 +0000
Subject: [PATCH] Moved vector-word-length into array.lisp even though its not
 implimented yet.

Wrote get-type.
---
 compiler/mips/system.lisp | 47 +++++++++++++++++++++++++++++++--------
 1 file changed, 38 insertions(+), 9 deletions(-)

diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp
index 961774e05..ec3b72731 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.7 1990/03/19 17:36:57 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.8 1990/03/21 23:32:43 wlott Exp $
 ;;;
 ;;;    MIPS VM definitions of various system hacking operations.
 ;;;
@@ -17,14 +17,8 @@
 ;;;
 (in-package "C")
 
-#+nil
-(define-vop (vector-word-length)
-  (:args (vec :scs (descriptor-reg)))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:generator 6
-    (loadw res vec clc::g-vector-header-words)
-    (inst niuo res res clc::g-vector-words-mask-16)))
-
+
+;;;; Random pointer comparison VOPs
 
 (define-vop (pointer-compare)
   (:args (x :scs (any-reg descriptor-reg))
@@ -48,6 +42,10 @@
   (frob pointer< :lt)
   (frob pointer> :gt))
 
+
+
+;;;; Random assertions VOPS.
+
 (define-vop (check-op)
   (:args (x :scs (any-reg descriptor-reg))
 	 (y :scs (any-reg descriptor-reg)))
@@ -68,6 +66,35 @@
   (:translate check=))
 
 
+
+;;;; Type frobbing VOPs
+
+(define-vop (get-type)
+  (:args (object :scs (any-reg descriptor-reg)))
+  (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
+  (:results (result :scs (any-reg descriptor-reg)))
+  (:generator 10
+    (let ((other-ptr (gen-label))
+	  (shift (gen-label)))
+      (simple-test-simple-type object ndescr other-ptr
+			       nil vm:other-pointer-type)
+      (inst andi ndescr object (logand (logeqv vm:other-immediate-0-type
+					       vm:other-immediate-1-type)
+				       vm:lowtag-mask))
+      (inst xori ndescr ndescr (logand vm:other-immediate-0-type
+				       vm:other-immediate-1-type))
+      (inst bne ndescr zero-tn shift)
+      (inst andi ndescr object vm:lowtag-mask)
+
+      (b shift)
+      (inst andi ndescr object vm:type-mask)
+
+      (emit-label other-ptr)
+      (load-type ndescr object)
+
+      (emit-label shift)
+      (inst sll result ndescr 2))))
+
 
 (define-vop (make-fixnum)
   (:args (ptr :scs (any-reg descriptor-reg)))
@@ -92,6 +119,8 @@
        (inst or res res temp)))))
 
 
+
+;;;; Other random VOPs.
 
 
 (define-vop (halt)
-- 
GitLab