#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.7 1988/03/25 21:21:27 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.8 1988/08/29 22:31:59 cph Exp $
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
promotional, or sales literature without prior written consent from
MIT in each case. |#
-;;;; LAP Generator
+;;;; LAP Generator: high level register assignment operations
(declare (usual-integrations))
\f
+;; `*register-map*' holds the current register map. The operations
+;; which follow use and update this map appropriately, so that the
+;; writer of LAP generator rules need not pass it around.
+
(define *register-map*)
-(define *prefix-instructions*)
-(define *needed-registers*)
-(define-integrable (prefix-instructions! instructions)
- (set! *prefix-instructions* (LAP ,@*prefix-instructions* ,@instructions)))
+;; `*needed-registers*' contains a set of machine registers which is
+;; in use during the LAP generation of a single RTL instruction. The
+;; value of this variable is automatically supplied to many low level
+;; register map operations. The set is initialized to the empty set
+;; at the beginning of each instruction. Typically, each alias
+;; register is added to this set as it is allocated. This informs the
+;; register map operations that it is unreasonable to reallocate that
+;; alias for some other purpose for this instruction.
+
+;; The operations that modify `*needed-registers*' assume that `eqv?'
+;; can be used to compare machine registers.
+
+(define *needed-registers*)
(define-integrable (need-register! register)
(set! *needed-registers* (cons register *needed-registers*)))
(define-integrable (need-registers! registers)
- ;; **** Assume EQ? works on registers here. ****
- (set! *needed-registers* (eq-set-union registers *needed-registers*)))
+ (set! *needed-registers* (eqv-set-union registers *needed-registers*)))
-(define (maybe-need-register! register)
- (if register (need-register! register))
- register)
+(define-integrable (dont-need-register! register)
+ (set! *needed-registers* (delv! register *needed-registers*)))
-(define (register-has-alias? register type)
- (if (machine-register? register)
- (register-type? register type)
- (pseudo-register-alias *register-map* type register)))
+(define-integrable (dont-need-registers! registers)
+ (set! *needed-registers* (eqv-set-difference *needed-registers* registers)))
-(define-integrable (is-alias-for-register? potential-alias register)
- (is-pseudo-register-alias? *register-map* potential-alias register))
+;; `*dead-registers*' is initialized at the beginning of each RTL
+;; instruction to the set of pseudo registers which become dead during
+;; that instruction. This information is used to make informed
+;; decisions about whether it is desirable to keep the contents of
+;; a particular pseudo register in a machine register, or not.
-(define-integrable (register-alias register type)
- (maybe-need-register! (pseudo-register-alias *register-map* type register)))
+;; All dead registers are deleted from the register map after the LAP
+;; generation for that instruction, by calling
+;; `delete-dead-registers!'. Thus, RTL instructions which alter the
+;; contents of any pseudo register must follow this pattern: (1)
+;; generate the source operands for the instruction, (2) delete the
+;; dead registers from the register map, and (3) generate the code for
+;; the assignment.
-(define-integrable (register-alias-alternate register type)
- (maybe-need-register! (machine-register-alias *register-map* type register)))
+(define *dead-registers*)
-(define-integrable (register-type? register type)
- (or (not type)
- (eq? (register-type register) type)))
+(define-integrable (dead-register? register)
+ (memv register *dead-registers*))
-(define ((register-type-predicate type) register)
- (register-type? register type))
+(define (delete-dead-registers!)
+ (delete-pseudo-registers *register-map* *dead-registers*
+ (lambda (map aliases)
+ (set! *register-map* map)))
+ (set! *dead-registers* '()))
-(define-integrable (same-register? reg1 reg2)
- (= reg1 reg2))
+;; `*prefix-instructions*' is used to accumulate LAP instructions to
+;; be inserted before the instructions which are the result of the
+;; rule for this RTL instruction. The register map operations
+;; generate these automatically whenever alias registers need to be
+;; loaded or stored, or when the aliases need to be shuffled in some
+;; way.
-(define-integrable (dead-register? register)
- (memv register *dead-registers*))
-\f
-(define (guarantee-machine-register! register type)
- (if (and (machine-register? register)
- (register-type? register type))
- register
- (load-alias-register! register type)))
+(define *prefix-instructions*)
-(define (load-alias-register! register type)
- (bind-allocator-values (load-alias-register *register-map* type
- *needed-registers* register)
- store-allocator-values!))
+(define-integrable (prefix-instructions! instructions)
+ (set! *prefix-instructions* (LAP ,@*prefix-instructions* ,@instructions)))
+\f
+;; Register map operations that return `allocator-values' eventually
+;; pass those values to `store-allocator-values!', perhaps after some
+;; tweaking.
-(define (allocate-alias-register! register type)
- (bind-allocator-values (allocate-alias-register *register-map* type
- *needed-registers* register)
+(define-integrable (store-allocator-values! allocator-values)
+ (bind-allocator-values allocator-values
(lambda (alias map instructions)
- (store-allocator-values! alias
- (delete-other-locations map alias)
- instructions))))
+ (need-register! alias)
+ (set! *register-map* map)
+ (prefix-instructions! instructions)
+ alias)))
-(define (allocate-assignment-alias! target type)
- (let ((target (allocate-alias-register! target type)))
- (delete-dead-registers!)
- target))
+;; Register map operations that return either an alias register or #F
+;; typically are wrapped with a call to `maybe-need-register!' to
+;; record the fact that the returned alias is in use.
-(define (allocate-temporary-register! type)
- (bind-allocator-values (allocate-temporary-register *register-map* type
- *needed-registers*)
- store-allocator-values!))
+(define (maybe-need-register! register)
+ (if register (need-register! register))
+ register)
-(define (store-allocator-values! alias map instructions)
- (need-register! alias)
- (set! *register-map* map)
- (prefix-instructions! instructions)
- alias)
+(define (register-has-alias? register type)
+ ;; True iff `register' has an alias of the given `type'.
+ ;; `register' may be any kind of register.
+ (if (machine-register? register)
+ (register-type? register type)
+ (pseudo-register-alias *register-map* type register)))
-(define-integrable (reference-existing-alias register type)
- (register-reference (register-alias register type)))
+(define-integrable (alias-is-unique? alias)
+ ;; `alias' must be a valid alias for some pseudo register. This
+ ;; predicate is true iff the pseudo register has no other aliases.
+ (machine-register-is-unique? *register-map* alias))
-(define-integrable (reference-alias-register! register type)
- (register-reference (load-alias-register! register type)))
+(define-integrable (alias-holds-unique-value? alias)
+ ;; `alias' must be a valid alias for some pseudo register. This
+ ;; predicate is true iff the contents of the pseudo register are not
+ ;; stored anywhere else that the register map knows of.
+ (machine-register-holds-unique-value? *register-map* alias))
-(define-integrable (reference-assignment-alias! register type)
- (register-reference (allocate-assignment-alias! register type)))
+(define-integrable (is-alias-for-register? potential-alias register)
+ ;; True iff `potential-alias' is a valid alias for `register'.
+ ;; `register' must be a pseudo register, and `potential-alias' must
+ ;; be a machine register.
+ (is-pseudo-register-alias? *register-map* potential-alias register))
-(define-integrable (reference-temporary-register! type)
- (register-reference (allocate-temporary-register! type)))
-\f
-(define (reuse-pseudo-register-alias! source type if-reusable if-not)
- (let ((reusable-alias
- (and (dead-register? source)
- (register-alias source type))))
- (if reusable-alias
- (begin (delete-dead-registers!)
- (if-reusable reusable-alias))
- (if-not))))
+(define-integrable (register-saved-into-home? register)
+ ;; True iff `register' is known to be saved in its spill temporary.
+ ;; `register' must be a pseudo register.
+ (pseudo-register-saved-into-home? *register-map* register))
-(define (move-to-alias-register! source type target)
- (reuse-and-load-pseudo-register-alias! source type
- (lambda (reusable-alias)
- (add-pseudo-register-alias! target reusable-alias false))
- (lambda ()
- (allocate-alias-register! target type))))
+(define-integrable (register-alias register type)
+ ;; Returns an alias for `register', of the given `type', if one
+ ;; exists. Otherwise returns #F. `register' must be a pseudo
+ ;; register.
+ (maybe-need-register! (pseudo-register-alias *register-map* type register)))
+\f
+(define (load-alias-register! register type)
+ ;; Returns an alias for `register', of the given `type'. If no such
+ ;; alias exists, a new alias is assigned and loaded with the correct
+ ;; value, and that alias is returned. `register' must be a pseudo
+ ;; register.
+ (store-allocator-values!
+ (load-alias-register *register-map* type *needed-registers* register)))
-(define (move-to-temporary-register! source type)
- (reuse-and-load-pseudo-register-alias! source type
- need-register!
- (lambda ()
- (allocate-temporary-register! type))))
+(define-integrable (reference-alias-register! register type)
+ (register-reference (load-alias-register! register type)))
-(define (reuse-and-load-pseudo-register-alias! source type if-reusable if-not)
- (reuse-pseudo-register-alias! source type
- (lambda (reusable-alias)
- (if-reusable reusable-alias)
- (register-reference reusable-alias))
- (lambda ()
- (let ((alias (if (machine-register? source)
- source
- (register-alias source false))))
- (delete-dead-registers!)
- (let ((target (if-not)))
- (prefix-instructions!
- (cond ((not alias) (home->register-transfer source target))
- ((= alias target) '())
- (else (register->register-transfer alias target))))
- (register-reference target))))))
-\f
-;; These procedures are used when the copy is going to be transformed,
-;; and the machine has 3 operand instructions, which allow an implicit
-;; motion in the transformation operation.
-;; For example, on the DEC VAX it is cheaper to do
-;; bicl3 op1,source,target
-;; than
-;; movl source,target
-;; bicl2 op1,target
-;; The extra arguments are
-;; REC1, invoked if we are resuing an alias of source.
-;; It already contains the data to operate on.
-;; REC2, invoked if a `brand-new' alias for target has been allocated.
-;; We must take care of moving the data ourselves.
+(define (allocate-alias-register! register type)
+ ;; This operation is used to allocate an alias for `register',
+ ;; assuming that it is about to be assigned. It first deletes any
+ ;; other aliases for register, then allocates and returns an alias
+ ;; for `register', of the given `type'. `register' must be a pseudo
+ ;; register.
+ (delete-pseudo-register! register)
+ (store-allocator-values!
+ (allocate-alias-register *register-map* type *needed-registers* register)))
+
+(define-integrable (reference-target-alias! register type)
+ (register-reference (allocate-alias-register! register type)))
-(define (with-register-copy-alias! source type target rec1 rec2)
- (provide-copy-reusing-alias! source type rec1 rec2
- (lambda (reusable-alias)
- (add-pseudo-register-alias! target reusable-alias false))
- (lambda ()
- (allocate-alias-register! target type))))
+(define (allocate-temporary-register! type)
+ ;; Allocates a machine register of the given `type' and returns it.
+ ;; This register is not associated with any pseudo register, and can
+ ;; be reallocated for other purposes as soon as it is no longer a
+ ;; member of `*needed-registers*'.
+ (store-allocator-values!
+ (allocate-temporary-register *register-map* type *needed-registers*)))
-(define (with-temporary-register-copy! register type rec1 rec2)
- (provide-copy-reusing-alias! register type rec1 rec2
- need-register!
- (lambda ()
- (allocate-temporary-register! type))))
+(define-integrable (reference-temporary-register! type)
+ (register-reference (allocate-temporary-register! type)))
-(define (provide-copy-reusing-alias! source type rec1 rec2 if-reusable if-not)
- (reuse-pseudo-register-alias! source type
- (lambda (reusable-alias)
- (if-reusable reusable-alias)
- (rec1 (register-reference reusable-alias)))
- (lambda ()
- (let ((alias (if (machine-register? source)
- source
- (register-alias source false))))
- (delete-dead-registers!)
- (let ((target (if-not)))
- (cond ((not alias)
- (rec2 (pseudo-register-home source)
- (register-reference target)))
- ((= alias target)
- (rec1 (register-reference target)))
- (else
- (rec2 (register-reference alias)
- (register-reference target)))))))))
-\f
-(define (add-pseudo-register-alias! register alias saved-into-home?)
+(define (add-pseudo-register-alias! register alias)
+ ;; This operation records `alias' as a valid alias for `register'.
+ ;; No instructions are generated. `register' must be a pseudo
+ ;; register, and `alias' must be a previously allocated register
+ ;; (typically for some other pseudo register). Additionally,
+ ;; `alias' must no longer be a valid alias, that is, it must have
+ ;; been deleted from the register map after it was allocated.
+
+ ;; This is extremely useful when performing assignments that move
+ ;; the value of one pseudo register into another, where the former
+ ;; register becomes dead. In this case, since no further reference
+ ;; is made to the source register, it no longer requires any
+ ;; aliases. Thus the target register can "inherit" the alias, which
+ ;; means that the assignment is accomplished without moving any
+ ;; data.
(set! *register-map*
- (add-pseudo-register-alias *register-map* register alias
- saved-into-home?))
+ (add-pseudo-register-alias *register-map* register alias false))
(need-register! alias))
+\f
+(define (delete-machine-register! register)
+ ;; Deletes `register' from the register map. No instructions are
+ ;; generated. `register' must be either an alias or a temporary.
+ (set! *register-map* (delete-machine-register *register-map* register))
+ (dont-need-register! register))
+
+(define (delete-pseudo-register! register)
+ ;; Deletes `register' from the register map. No instructions are
+ ;; generated. `register' must be a pseudo register.
+ (delete-pseudo-register *register-map* register
+ (lambda (map aliases)
+ (set! *register-map* map)
+ (dont-need-registers! aliases))))
(define (clear-map!)
+ ;; Deletes all registers from the register map. Generates and
+ ;; returns instructions to save pseudo registers into their homes,
+ ;; if necessary. This is typically used just before a control
+ ;; transfer to somewhere that can potentially flush the contents of
+ ;; the machine registers.
(delete-dead-registers!)
(let ((instructions (clear-map)))
(set! *register-map* (empty-register-map))
(lambda (map instructions)
(set! *register-map* map)
(prefix-instructions! instructions)))))
+\f
+(define (standard-register-reference register preferred-type)
+ ;; Generate a standard reference for `register'. This procedure
+ ;; uses a number of heuristics, aided by `preferred-type', to
+ ;; determine the optimum reference. This should be used only when
+ ;; the reference need not have any special properties, as the result
+ ;; is not even guaranteed to be a register reference.
+ (let ((no-preference
+ (lambda ()
+ ;; Next, attempt to find an alias of any type. If there
+ ;; are no aliases, and the register is not dead, allocate
+ ;; an alias of the preferred type. This is desirable
+ ;; because the register will be used again. Otherwise,
+ ;; this is the last use of this register, so we might as
+ ;; well just use the register's home.
+ (let ((alias (register-alias register false)))
+ (cond (alias
+ (register-reference alias))
+ ((dead-register? register)
+ (pseudo-register-home register))
+ (else
+ (reference-alias-register! register preferred-type)))))))
+ (cond ((machine-register? register)
+ (register-reference register))
+ ;; First, attempt to find an alias of the preferred type.
+ (preferred-type
+ (let ((alias (register-alias register preferred-type)))
+ (if alias
+ (register-reference alias)
+ (no-preference))))
+ (else
+ (no-preference)))))
+
+(define (machine-register-reference register type)
+ ;; Returns a reference to a machine register which contains the same
+ ;; contents as `register', and which has the given `type'.
+ (register-reference
+ (if (machine-register? register)
+ (if (register-type? register type)
+ register
+ (let ((temp (allocate-temporary-register! type)))
+ (prefix-instructions!
+ (register->register-transfer register temp))
+ temp))
+ (load-alias-register! register type))))
+(define (load-machine-register! source-register machine-register)
+ (if (machine-register? source-register)
+ (if (eqv? source-register machine-register)
+ (LAP)
+ (register->register-transfer source-register machine-register))
+ (if (is-alias-for-register? machine-register source-register)
+ (LAP)
+ (reference->register-transfer
+ (standard-register-reference source-register false)
+ machine-register))))
+\f
+(define (move-to-alias-register! source type target)
+ ;; Performs an assignment from the pseudo register `source' to the
+ ;; pseudo register `target', allocating an alias for `target' of the
+ ;; given `type'. Returns a reference to that alias. If `source'
+ ;; has a reusable alias of the appropriate type, that is used, in
+ ;; which case no instructions are generated.
+ (reuse-and-load-pseudo-register-alias! source type
+ (lambda (alias)
+ (add-pseudo-register-alias! target alias))
+ (lambda ()
+ (allocate-alias-register! target type))))
-(define (delete-machine-register! register)
- (set! *register-map* (delete-machine-register *register-map* register))
- (set! *needed-registers* (eqv-set-delete *needed-registers* register)))
-
-(package (delete-pseudo-register! delete-dead-registers!)
- (define-export (delete-pseudo-register! register)
- (delete-pseudo-register *register-map* register delete-registers!))
- (define-export (delete-dead-registers!)
- (delete-pseudo-registers *register-map* *dead-registers* delete-registers!)
- (set! *dead-registers* '()))
- (define (delete-registers! map aliases)
- (set! *register-map* map)
- (set! *needed-registers* (eqv-set-difference *needed-registers* aliases))))
\ No newline at end of file
+(define (move-to-temporary-register! source type)
+ ;; Allocates a temporary register, of the given `type', and loads
+ ;; the contents of the pseudo register `source' into it. Returns a
+ ;; reference to that temporary. If `source' has a reusable alias of
+ ;; the appropriate type, that is used, in which case no instructions
+ ;; are generated.
+ (reuse-and-load-pseudo-register-alias! source type
+ need-register!
+ (lambda ()
+ (allocate-temporary-register! type))))
+
+(define (reuse-and-load-pseudo-register-alias! source type if-reusable if-not)
+ ;; Attempts to find a reusable alias for `source', of the given
+ ;; `type'. If one is found, `if-reusable' is invoked on it (for
+ ;; effect only). Otherwise, `if-not' is invoked with no arguments
+ ;; to produce a machine register, and the contents of `source' are
+ ;; transferred into that register. The result of this procedure is
+ ;; a register reference, to the alias if it is found, otherwise to
+ ;; the result of `if-not'. Note: dead registers are always deleted
+ ;; by this procedure.
+ (reuse-alias-deleting-dead-registers! source type
+ (lambda (alias)
+ (if-reusable alias)
+ (register-reference alias))
+ (lambda (source)
+ (let ((target (if-not)))
+ (prefix-instructions! (reference->register-transfer source target))
+ (register-reference target)))))
+
+(define (reuse-alias-deleting-dead-registers! source type if-reusable if-not)
+ (reuse-pseudo-register-alias! source type
+ (lambda (alias)
+ (delete-dead-registers!)
+ (if-reusable alias))
+ (lambda ()
+ (let ((source (standard-register-reference source false))) (delete-dead-registers!)
+ (if-not source)))))
+
+(define (reuse-pseudo-register-alias! source type if-reusable if-not)
+ (reuse-pseudo-register-alias source type
+ (lambda (alias)
+ (delete-machine-register! alias)
+ (if-reusable alias))
+ if-not))
+
+(define (reuse-pseudo-register-alias source type if-reusable if-not)
+ ;; Attempts to find a reusable alias for `source', of the given
+ ;; `type'. If one is found, `if-reusable' is tail-recursively
+ ;; invoked on it. Otherwise, `if-not' is tail-recursively invoked
+ ;; with no arguments. The heuristics used to decide if an alias is
+ ;; reusable are as follows: (1) if `source' is dead, any of its
+ ;; aliases may be reused, and (2) if `source' is live with multiple
+ ;; aliases, then one of its aliases may be reused.
+ (let ((alias (register-alias source type)))
+ (cond ((not alias)
+ (if-not))
+ ((dead-register? source)
+ (if-reusable alias))
+ ((not (alias-is-unique? alias))
+ (if-reusable alias))
+ (else
+ (if-not)))))
+\f
+;; The following procedures are used when the copy is going to be
+;; transformed, and the machine has 3 operand instructions, which
+;; allow an implicit motion in the transformation operation.
+
+;; For example, on the DEC VAX it is cheaper to do
+;; bicl3 op1,source,target
+;; than
+;; movl source,target
+;; bicl2 op1,target
+
+;; The extra arguments are
+;; REC1, invoked if we are reusing an alias of source.
+;; It already contains the data to operate on.
+;; REC2, invoked if a `brand-new' alias for target has been allocated.
+;; We must take care of moving the data ourselves.
+
+(define (with-register-copy-alias! source type target rec1 rec2)
+ (provide-copy-reusing-alias! source type rec1 rec2
+ (lambda (reusable-alias)
+ (add-pseudo-register-alias! target reusable-alias))
+ (lambda ()
+ (allocate-alias-register! target type))))
+
+(define (with-temporary-register-copy! register type rec1 rec2)
+ (provide-copy-reusing-alias! register type rec1 rec2
+ need-register!
+ (lambda ()
+ (allocate-temporary-register! type))))
+
+(define (provide-copy-reusing-alias! source type rec1 rec2 if-reusable if-not)
+ (reuse-alias-deleting-dead-registers! source type
+ (lambda (alias)
+ (if-reusable alias)
+ (rec1 (register-reference alias)))
+ (lambda (source)
+ (rec2 source (register-reference (if-not))))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff