From 5889c12137feb07f4a0bef471ccef897c049d2ef Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sun, 6 May 1990 05:29:53 +0000 Subject: [PATCH] Added bignum types bignum-type, bignum-element-type, and bignum-index. Added containing-integer-type function. Change hairy-check-template to check for interesting numeric types 'cause fixnum no longer maps one-to-one to a primitive-type. --- compiler/generic/vm-type.lisp | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp index 90e9a9229..744856876 100644 --- a/compiler/generic/vm-type.lisp +++ b/compiler/generic/vm-type.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.12 1990/04/29 02:00:05 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.13 1990/05/06 05:29:53 wlott Exp $ ;;; ;;; This file contains implementation-dependent parts of the type support ;;; code. This is stuff which deals with the mapping from types defined in @@ -86,6 +86,9 @@ ;;; Internal time format. Not a fixnum (blag...) (deftype internal-time () 'unsigned-byte) +(deftype bignum-element-type () `(unsigned-byte ,vm:word-bits)) +(deftype bignum-type () 'bignum) +(deftype bignum-index () 'index) ;;;; Hooks into type system: @@ -136,6 +139,21 @@ type)) +;;; Contaning-Integer-Type -- Interface +;;; +;;; Return the most specific integer type that can be quickly checked that +;;; includes the given type. +;;; +(defun containing-integer-type (subtype) + (dolist (type '(fixnum + (signed-byte 32) + (unsigned-byte 32) + integer) + (error "~S isn't an integer type?" subtype)) + (when (csubtypep subtype (specifier-type type)) + (return type)))) + + ;;; Hairy-Type-Check-Template -- Interface ;;; ;;; If Type has a CHECK-xxx template, but doesn't have a corresponding @@ -149,6 +167,14 @@ (cons 'c::check-cons) (symbol 'c::check-symbol) (t nil))) + (numeric-type + (cond ((type= type (specifier-type 'fixnum)) + 'c::check-fixnum) + ((type= type (specifier-type '(signed-byte 32))) + 'c::check-signed-byte-32) + ((type= type (specifier-type '(unsigned-byte 32))) + 'c::check-unsigned-byte-32) + (t nil))) (union-type (if (type= type (specifier-type '(or function symbol))) 'c::check-function-or-symbol -- GitLab