Skip to content
Snippets Groups Projects
Commit 0609b80b authored by ram's avatar ram
Browse files

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.
parent 42accb9a
No related branches found
No related tags found
No related merge requests found
...@@ -21,34 +21,6 @@ ...@@ -21,34 +21,6 @@
(define-storage-base constant :non-packed) (define-storage-base constant :non-packed)
(define-storage-base immediate-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. ;;; Non-immediate constants in the constant pool.
(define-storage-class constant 6 constant) (define-storage-class constant 6 constant)
...@@ -81,42 +53,49 @@ ...@@ -81,42 +53,49 @@
;;; ;;;
(define-storage-class random-immediate 11 immediate-constant) (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 ;;; Untagged string-chars stored on the stack.
:element-size system:%catch-block-size) (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. ;;; Pointer objects that must be seen by GC.
(define-move-costs (define-storage-class descriptor-reg 1 registers
((any-reg descriptor-reg non-descriptor-reg) :locations (1 3 4 5 7 8 9 10 11 15)
(1 any-reg descriptor-reg non-descriptor-reg) :constant-scs (constant short-immediate unsigned-immediate immediate
(2 string-char-reg) immediate-string-char random-immediate)
(5 stack)) :alternate-scs (stack))
((stack constant)
(5 any-reg descriptor-reg non-descriptor-reg) ;;;
(6 string-char-reg)) ;;; Objects that must not be seen by GC (unboxed numbers).
((immediate short-immediate unsigned-immediate random-immediate) (define-storage-class non-descriptor-reg 2 registers
(1 any-reg descriptor-reg non-descriptor-reg)) :locations (0 2))
((immediate-string-char)
(1 string-char-reg) ;;;
(2 any-reg descriptor-reg non-descriptor-reg)) ;;; String-chars represented without tag bits (looks like a fixnum).
((string-char-stack) (define-storage-class string-char-reg 3 registers
(5 string-char-reg)) :locations (0 1 2 3 4 5 7 8 9 10 11 15)
((string-char-reg) :constant-scs (immediate-string-char)
(1 string-char-reg) :alternate-scs (string-char-stack))
(2 any-reg descriptor-reg non-descriptor-reg)
(5 string-char-stack) ;;; A catch or unwind block.
(6 stack))) ;;;
(define-storage-class catch-block 12 stack
;;; :element-size system:%catch-block-size)
;;; 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))
;;;; Primitive type definition: ;;;; Primitive type definition:
...@@ -127,44 +106,23 @@ ...@@ -127,44 +106,23 @@
(def-primitive-type t (descriptor-reg stack)) (def-primitive-type t (descriptor-reg stack))
(defvar *any-primitive-type* (primitive-type-or-lose 't)) (defvar *any-primitive-type* (primitive-type-or-lose 't))
(def-primitive-type simple-string (descriptor-reg stack)) (def-primitive-type simple-string (descriptor-reg))
(def-primitive-type simple-vector (descriptor-reg stack)) (def-primitive-type simple-vector (descriptor-reg))
(def-primitive-type simple-bit-vector (descriptor-reg stack)) (def-primitive-type simple-bit-vector (descriptor-reg))
(def-primitive-type string-char (def-primitive-type string-char (string-char-reg any-reg))
(string-char-reg string-char-stack any-reg stack)) (def-primitive-type fixnum (any-reg))
(def-primitive-type fixnum (any-reg stack)) (def-primitive-type short-float (any-reg))
(def-primitive-type short-float (any-reg stack)) (def-primitive-type long-float (descriptor-reg))
(def-primitive-type long-float (descriptor-reg stack)) (def-primitive-type bignum (descriptor-reg))
(def-primitive-type bignum (descriptor-reg stack)) (def-primitive-type ratio (descriptor-reg))
(def-primitive-type ratio (descriptor-reg stack)) (def-primitive-type complex (descriptor-reg))
(def-primitive-type complex (descriptor-reg stack)) (def-primitive-type function (descriptor-reg))
(def-primitive-type function (descriptor-reg stack))
;;; We make List a primitive type, since it is useful for discrimination of ;;; 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 ;;; generic sequence function arguments. This means that Cons and Symbol can't
;;; be primitive types. ;;; be primitive types.
(def-primitive-type list (descriptor-reg stack)) (def-primitive-type list (descriptor-reg))
;;; 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*))))
;;; Primitive-Type -- Interface ;;; Primitive-Type -- Interface
...@@ -229,9 +187,10 @@ ...@@ -229,9 +187,10 @@
(setq res (primitive-type-union res ptype)))) (setq res (primitive-type-union res ptype))))
(values res exact))))) (values res exact)))))
(member-type (member-type
(values (reduce #'primitive-type-union (values (primitive-type
(mapcar #'primitive-type-of (reduce #'type-union
(member-type-members type))) (mapcar #'ctype-of
(member-type-members type))))
nil)) nil))
(named-type (named-type
(case (named-type-name type) (case (named-type-name type)
...@@ -250,7 +209,7 @@ ...@@ -250,7 +209,7 @@
;;;; Totally magical registers: ;;;; Totally magical registers:
;;; Pointer to the current frame: ;;; Pointer to the current frame:
(defparameter cont-tn (defparameter fp-tn
(make-random-tn :kind :normal (make-random-tn :kind :normal
:sc (sc-or-lose 'any-reg) :sc (sc-or-lose 'any-reg)
:offset 13)) :offset 13))
...@@ -327,16 +286,15 @@ ...@@ -327,16 +286,15 @@
(eval-when (compile load eval) (eval-when (compile load eval)
(defconstant return-pc-offset 15) (defconstant return-pc-offset 15)
(defconstant env-offset 14) (defconstant env-offset 14)
(defconstant argument-pointer-offset 11)
(defconstant argument-count-offset 0) (defconstant argument-count-offset 0)
(defconstant old-cont-offset 10) (defconstant old-fp-offset 10)
(defconstant sp-offset 6) (defconstant sp-offset 6)
(defconstant call-name-offset 9)) (defconstant call-name-offset 9))
;;; Offsets of special stack frame locations... ;;; Offsets of special stack frame locations...
;;; ;;;
(eval-when (compile load eval) (eval-when (compile load eval)
(defconstant old-cont-save-offset 0) (defconstant old-fp-save-offset 0)
(defconstant return-pc-save-offset 1) (defconstant return-pc-save-offset 1)
(defconstant env-save-offset 2)) (defconstant env-save-offset 2))
...@@ -346,11 +304,6 @@ ...@@ -346,11 +304,6 @@
:sc (sc-or-lose 'any-reg) :sc (sc-or-lose 'any-reg)
:offset argument-count-offset)) :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 (defparameter pc-tn
(make-random-tn :kind :normal (make-random-tn :kind :normal
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment