From 8f3899760cfb5568d573ea99148be9fe809b10cf Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sun, 6 May 1990 05:32:32 +0000 Subject: [PATCH] Expanded fixnum primitive-type into fixnum and positive-fixnum. Added other primitive-types to cover signed-byte 32 and unsigned-byte 32. Put all signed-byte 32 and unsigned-byte 32 constants in random-immediates. --- compiler/mips/vm.lisp | 57 ++++++++++++++++++++++++++++++------------- 1 file changed, 40 insertions(+), 17 deletions(-) diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp index 0fec1c9ce..f79714c65 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.23 1990/04/24 07:00:20 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.24 1990/05/06 05:32:32 wlott Exp $ ;;; ;;; This file contains the VM definition for the MIPS R2000 and the new ;;; object format. @@ -189,16 +189,27 @@ (def-primitive-type t (descriptor-reg)) (defvar *any-primitive-type* (primitive-type-or-lose 't)) -;;; Primitive integer types. +;;; Primitive integer types that fit in registers. ;;; -(def-primitive-type fixnum (any-reg)) -#| ### Rob needs to think about this more. -(def-primitive-type positive-fixnum (any-reg signed-reg unsigned-reg)) -(def-primitive-type negative-fixnum (any-reg signed-reg)) -(def-primitive-type negative-signed-byte-32 (signed-reg)) -(def-primitive-type unsigned-byte-31 (signed-reg unsigned-reg)) -(def-primitive-type unsigned-byte-32 (unsigned-reg)) -|# +(def-primitive-type positive-fixnum (any-reg signed-reg unsigned-reg) + :type (unsigned-byte 29)) +(def-primitive-type unsigned-byte-31 (signed-reg unsigned-reg) + :type (unsigned-byte 31)) +(def-primitive-type unsigned-byte-32 (unsigned-reg) + :type (unsigned-byte 32)) +(def-primitive-type fixnum (any-reg signed-reg) + :type (signed-byte 30)) +(def-primitive-type signed-byte-32 (signed-reg) + :type (signed-byte 32)) + +(def-primitive-type-alias tagged-num (:or positive-fixnum fixnum)) +(def-primitive-type-alias unsigned-num (:or unsigned-byte-32 + unsigned-byte-31 + positive-fixnum)) +(def-primitive-type-alias signed-num (:or signed-byte-32 + fixnum + unsigned-byte-31 + positive-fixnum)) ;;; Other primitive immediate types. (def-primitive-type base-character (base-character-reg any-reg)) @@ -304,12 +315,24 @@ (:real (case (numeric-type-class type) (integer - (cond ((and hi lo - (>= lo most-negative-fixnum) - (<= hi most-positive-fixnum)) - (values (primitive-type-or-lose 'fixnum) - (and (= lo most-negative-fixnum) - (= hi most-positive-fixnum)))) + (cond ((and hi lo) + (dolist (spec + '((positive-fixnum 0 #.(1- (ash 1 29))) + (unsigned-byte-31 0 #.(1- (ash 1 31))) + (unsigned-byte-32 0 #.(1- (ash 1 32))) + (fixnum #.(ash -1 29) #.(1- (ash 1 29))) + (signed-byte-32 #.(ash -1 31) + #.(1- (ash 1 31)))) + (if (or (< hi (ash -1 29)) + (> lo (1- (ash 1 29)))) + (part-of bignum) + (any))) + (let ((type (car spec)) + (min (cadr spec)) + (max (caddr spec))) + (when (<= min lo hi max) + (return (values (primitive-type-or-lose type) + (and (= lo min) (= hi max)))))))) ((or (and hi (< hi most-negative-fixnum)) (and lo (> lo most-positive-fixnum))) (part-of bignum)) @@ -497,7 +520,7 @@ (if (vm:static-symbol-p value) (sc-number-or-lose 'random-immediate) nil)) - ((signed-byte 29) #+nil (or (signed-byte 32) (unsigned-byte 32)) + ((or (signed-byte 32) (unsigned-byte 32)) (sc-number-or-lose 'random-immediate)) #+new-compiler (system-area-pointer -- GitLab