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