From 0609b80bfcca94f285b44384e51d06ec827490da Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sun, 8 Apr 1990 23:51:58 +0000 Subject: [PATCH] Changed stuff to use the new non-descriptor stuff for move/coerce. Changed PRIMITIVE-TYPE not to use PRIMITIVE-TYPE-OF. Deleted PRIMITIVE-TYPE-OF, since it used PRIMITIVE-TYPE-UNION, which no longer exists. cont -> fp flushed argument pointer. --- compiler/old-rt/vm.lisp | 161 ++++++++++++++-------------------------- 1 file changed, 57 insertions(+), 104 deletions(-) diff --git a/compiler/old-rt/vm.lisp b/compiler/old-rt/vm.lisp index f109d03ca..7623e34db 100644 --- a/compiler/old-rt/vm.lisp +++ b/compiler/old-rt/vm.lisp @@ -21,34 +21,6 @@ (define-storage-base constant :non-packed) (define-storage-base immediate-constant :non-packed) -;;; -;;; Objects that can be stored in any register (immediate objects). -(define-storage-class any-reg 0 registers - :locations (0 1 2 3 4 5 7 8 9 10 11 15)) - -;;; -;;; Pointer objects that must be seen by GC. -(define-storage-class descriptor-reg 1 registers - :locations (1 3 4 5 7 8 9 10 11 15)) - -;;; -;;; Objects that must not be seen by GC (unboxed numbers). -(define-storage-class non-descriptor-reg 2 registers - :locations (0 2)) - -;;; -;;; String-chars represented without tag bits (looks like a fixnum). -(define-storage-class string-char-reg 3 registers - :locations (0 1 2 3 4 5 7 8 9 10 11 15)) - -;;; -;;; Descriptor objects stored on the stack. -(define-storage-class stack 4 stack) - -;;; -;;; Untagged string-chars stored on the stack. -(define-storage-class string-char-stack 5 stack) - ;;; ;;; Non-immediate constants in the constant pool. (define-storage-class constant 6 constant) @@ -81,42 +53,49 @@ ;;; (define-storage-class random-immediate 11 immediate-constant) +;;; +;;; Descriptor objects stored on the stack. +(define-storage-class stack 4 stack + :constant-scs (constant short-immediate unsigned-immediate immediate + immediate-string-char random-immediate)) -;;; A catch or unwind block. ;;; -(define-storage-class catch-block 12 stack - :element-size system:%catch-block-size) +;;; Untagged string-chars stored on the stack. +(define-storage-class string-char-stack 5 stack + :constant-scs (immediate-string-char)) +;;; +;;; Objects that can be stored in any register (immediate objects). +(define-storage-class any-reg 0 registers + :locations (0 1 2 3 4 5 7 8 9 10 11 15) + :constant-scs (constant short-immediate unsigned-immediate immediate + immediate-string-char random-immediate) + :alternate-scs (stack)) ;;; -;;; Set up the cost information for operand loading. -(define-move-costs - ((any-reg descriptor-reg non-descriptor-reg) - (1 any-reg descriptor-reg non-descriptor-reg) - (2 string-char-reg) - (5 stack)) - ((stack constant) - (5 any-reg descriptor-reg non-descriptor-reg) - (6 string-char-reg)) - ((immediate short-immediate unsigned-immediate random-immediate) - (1 any-reg descriptor-reg non-descriptor-reg)) - ((immediate-string-char) - (1 string-char-reg) - (2 any-reg descriptor-reg non-descriptor-reg)) - ((string-char-stack) - (5 string-char-reg)) - ((string-char-reg) - (1 string-char-reg) - (2 any-reg descriptor-reg non-descriptor-reg) - (5 string-char-stack) - (6 stack))) - -;;; -;;; Non-descriptor registers can't be saved, since we don't have an unboxed -;;; stack. There had better not be any need to do such saving... -(define-save-scs - (stack any-reg descriptor-reg) - (string-char-stack string-char-reg)) +;;; Pointer objects that must be seen by GC. +(define-storage-class descriptor-reg 1 registers + :locations (1 3 4 5 7 8 9 10 11 15) + :constant-scs (constant short-immediate unsigned-immediate immediate + immediate-string-char random-immediate) + :alternate-scs (stack)) + +;;; +;;; Objects that must not be seen by GC (unboxed numbers). +(define-storage-class non-descriptor-reg 2 registers + :locations (0 2)) + +;;; +;;; String-chars represented without tag bits (looks like a fixnum). +(define-storage-class string-char-reg 3 registers + :locations (0 1 2 3 4 5 7 8 9 10 11 15) + :constant-scs (immediate-string-char) + :alternate-scs (string-char-stack)) + +;;; A catch or unwind block. +;;; +(define-storage-class catch-block 12 stack + :element-size system:%catch-block-size) ;;;; Primitive type definition: @@ -127,44 +106,23 @@ (def-primitive-type t (descriptor-reg stack)) (defvar *any-primitive-type* (primitive-type-or-lose 't)) -(def-primitive-type simple-string (descriptor-reg stack)) -(def-primitive-type simple-vector (descriptor-reg stack)) -(def-primitive-type simple-bit-vector (descriptor-reg stack)) +(def-primitive-type simple-string (descriptor-reg)) +(def-primitive-type simple-vector (descriptor-reg)) +(def-primitive-type simple-bit-vector (descriptor-reg)) -(def-primitive-type string-char - (string-char-reg string-char-stack any-reg stack)) -(def-primitive-type fixnum (any-reg stack)) -(def-primitive-type short-float (any-reg stack)) -(def-primitive-type long-float (descriptor-reg stack)) -(def-primitive-type bignum (descriptor-reg stack)) -(def-primitive-type ratio (descriptor-reg stack)) -(def-primitive-type complex (descriptor-reg stack)) -(def-primitive-type function (descriptor-reg stack)) +(def-primitive-type string-char (string-char-reg any-reg)) +(def-primitive-type fixnum (any-reg)) +(def-primitive-type short-float (any-reg)) +(def-primitive-type long-float (descriptor-reg)) +(def-primitive-type bignum (descriptor-reg)) +(def-primitive-type ratio (descriptor-reg)) +(def-primitive-type complex (descriptor-reg)) +(def-primitive-type function (descriptor-reg)) ;;; We make List a primitive type, since it is useful for discrimination of ;;; generic sequence function arguments. This means that Cons and Symbol can't ;;; be primitive types. -(def-primitive-type list (descriptor-reg stack)) - -;;; This primitive type is used for random unboxed temporary registers. -;;; -(def-primitive-type random (non-descriptor-reg) :type nil) - -;;; This primitive type is used for making unwind blocks. -;;; -(def-primitive-type catch-block (catch-block) :type nil) - - -;;; Primitive-Type-Of -- Interface -;;; -;;; Return the most restrictive primitive type that contains Object. -;;; -(defun primitive-type-of (object) - (let ((type (ctype-of object))) - (cond ((not (member-type-p type)) (primitive-type type)) - ((equal (member-type-members type) '(nil)) - (primitive-type-or-lose 'list)) - (t *any-primitive-type*)))) +(def-primitive-type list (descriptor-reg)) ;;; Primitive-Type -- Interface @@ -229,9 +187,10 @@ (setq res (primitive-type-union res ptype)))) (values res exact))))) (member-type - (values (reduce #'primitive-type-union - (mapcar #'primitive-type-of - (member-type-members type))) + (values (primitive-type + (reduce #'type-union + (mapcar #'ctype-of + (member-type-members type)))) nil)) (named-type (case (named-type-name type) @@ -250,7 +209,7 @@ ;;;; Totally magical registers: ;;; Pointer to the current frame: -(defparameter cont-tn +(defparameter fp-tn (make-random-tn :kind :normal :sc (sc-or-lose 'any-reg) :offset 13)) @@ -327,16 +286,15 @@ (eval-when (compile load eval) (defconstant return-pc-offset 15) (defconstant env-offset 14) - (defconstant argument-pointer-offset 11) (defconstant argument-count-offset 0) - (defconstant old-cont-offset 10) + (defconstant old-fp-offset 10) (defconstant sp-offset 6) (defconstant call-name-offset 9)) ;;; Offsets of special stack frame locations... ;;; (eval-when (compile load eval) - (defconstant old-cont-save-offset 0) + (defconstant old-fp-save-offset 0) (defconstant return-pc-save-offset 1) (defconstant env-save-offset 2)) @@ -346,11 +304,6 @@ :sc (sc-or-lose 'any-reg) :offset argument-count-offset)) -(defparameter args-tn - (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg) - :offset argument-pointer-offset)) - (defparameter pc-tn (make-random-tn :kind :normal -- GitLab