From 8eb0a0b542cf026764fa23199812b30f7402f351 Mon Sep 17 00:00:00 2001
From: ch <ch>
Date: Sun, 3 Jun 1990 19:01:00 +0000
Subject: [PATCH] Added weak pointer cruft.

---
 compiler/generic/vm-fndb.lisp     | 8 +++++---
 compiler/generic/vm-typetran.lisp | 3 ++-
 compiler/mips/type-vops.lisp      | 7 +++++--
 compiler/mips/vm.lisp             | 5 +++--
 4 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp
index e44c96482..edff8676b 100644
--- a/compiler/generic/vm-fndb.lisp
+++ b/compiler/generic/vm-fndb.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.9 1990/05/27 16:51:48 ch Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.10 1990/06/03 18:57:12 ch Exp $
 ;;;
 ;;; This file defines the machine specific function signatures.
 ;;;
@@ -30,7 +30,8 @@
 	   simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p
 	   simple-array-unsigned-byte-16-p simple-array-unsigned-byte-32-p
 	   simple-array-single-float-p simple-array-double-float-p
-	   system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p)
+	   system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p
+	   weak-pointer-p)
   (t) boolean (movable foldable flushable))
 
 ;;; Introduce these predicates into the old compiler.  This is necessary
@@ -50,7 +51,8 @@
   (frob system-area-pointer-p system-area-pointer)
   (frob realp real)
   (frob unsigned-byte-32-p (unsigned-byte 32))
-  (frob signed-byte-32-p (signed-byte 32))) 
+  (frob signed-byte-32-p (signed-byte 32))
+  (frob weak-pointer-p weak-pointer))
 
 
 ;;;; Miscellaneous "sub-primitives":
diff --git a/compiler/generic/vm-typetran.lisp b/compiler/generic/vm-typetran.lisp
index c88d12c09..d15522325 100644
--- a/compiler/generic/vm-typetran.lisp
+++ b/compiler/generic/vm-typetran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.5 1990/05/14 01:59:07 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.6 1990/06/03 18:58:03 ch Exp $
 ;;;
 ;;; This file contains the implimentation specific type transformation magic.
 ;;; Basically, the various non-standard predicates that can be used in typep
@@ -50,6 +50,7 @@
 (define-type-predicate system-area-pointer-p system-area-pointer)
 (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
 (define-type-predicate signed-byte-32-p (signed-byte 32))
+(define-type-predicate weak-pointer-p weak-pointer)
 
 ;;; Unlike the un-%'ed versions, these are true type predicates, accepting any
 ;;; type object.
diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp
index 886cfcdd4..6f6cbd3ff 100644
--- a/compiler/mips/type-vops.lisp
+++ b/compiler/mips/type-vops.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.13 1990/05/16 18:48:53 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.14 1990/06/03 19:01:00 ch Exp $
 ;;; 
 ;;; This file contains the VM definition of type testing and checking VOPs
 ;;; for the RT.
@@ -126,7 +126,10 @@
     vm:base-character-type di:object-not-base-character-error)
 
   (frob system-area-pointer-p check-system-area-pointer system-area-pointer
-    vm:sap-type di:object-not-sap-error))
+    vm:sap-type di:object-not-sap-error)
+
+  (frob weak-pointer-p check-weak-pointer weak-pointer
+    vm:weak-pointer-type di:object-not-weak-pointer-error))
 
 
 ;;; Slightly tenser versions for FIXNUM's
diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp
index 10f57d018..7f5bb39a2 100644
--- a/compiler/mips/vm.lisp
+++ b/compiler/mips/vm.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.28 1990/05/23 06:10:04 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.29 1990/06/03 18:56:47 ch Exp $
 ;;;
 ;;; This file contains the VM definition for the MIPS R2000 and the new
 ;;; object format.
@@ -254,6 +254,7 @@
 ;;; Other primitive other-pointer types.
 ;;; 
 (def-primitive-type system-area-pointer (sap-reg descriptor-reg))
+(def-primitive-type weak-pointer (descriptor-reg))
 
 ;;; Random primitive types that don't exist at the LISP level.
 ;;; 
@@ -384,7 +385,7 @@
 	     (return (values *any-primitive-type* nil))))))
       (named-type
        (case (named-type-name type)
-	 ((t bignum ratio complex function system-area-pointer)
+	 ((t bignum ratio complex function system-area-pointer weak-pointer)
 	  (values (primitive-type-or-lose (named-type-name type)) t))
 	 ((character base-character string-char)
 	  (exactly base-character))
-- 
GitLab