From ab7411fab2d02c380e980c30e9e154c1d830c4ec Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sat, 20 Apr 1991 16:51:33 +0000 Subject: [PATCH] Fixed primitive-type to handle the named-type ``structure'' in addition to structure types. Made the non-descriptor locations of the any-reg SC reserved, and moved them to the end of the list so that it will be more likely that they are available for non-descriptor usages. Added defconstants {single,double}-sc-reg-sc-number, each holding a list of all the coprocessor specific sc numbers. --- compiler/rt/vm.lisp | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/rt/vm.lisp b/compiler/rt/vm.lisp index e516bcaeb..f84084cca 100644 --- a/compiler/rt/vm.lisp +++ b/compiler/rt/vm.lisp @@ -42,7 +42,8 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(eval-when (compile load eval) + (defconstant ,constant-name ,index)) `(export ',constant-name) forms))) (index 0 (1+ index)) @@ -77,8 +78,9 @@ ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing ;; bad will happen if they are. (fixnums, characters, header values, etc). (any-reg registers - :locations (0 2 3 4 9 10 11 12 13 14) + :locations (9 10 11 12 13 14 0 2 3 4) :constant-scs (immediate) + :reserve-locations (0 2 3 4) :save-p t :alternate-scs (control-stack)) @@ -185,6 +187,15 @@ (catch-block control-stack :element-size vm:catch-block-size)) +(export '(single-reg-sc-number double-reg-sc-number)) +(defconstant single-reg-sc-number + (list mc68881-single-reg-sc-number + FPA-single-reg-sc-number + AFPA-single-reg-sc-number)) +(defconstant double-reg-sc-number + (list mc68881-double-reg-sc-number + FPA-double-reg-sc-number + AFPA-double-reg-sc-number)) ;;;; Primitive Type Definitions @@ -422,7 +433,8 @@ (return (values *any-primitive-type* nil)))))) (named-type (case (named-type-name type) - ((t bignum ratio complex function system-area-pointer weak-pointer) + ((t bignum ratio complex function system-area-pointer weak-pointer + structure) (values (primitive-type-or-lose (named-type-name type)) t)) ((character base-character string-char) (exactly base-character)) -- GitLab