From 35e44760cf51dbebb1246e578c5e2081b3275723 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 29 Aug 1988 22:31:59 +0000 Subject: [PATCH] Many changes. Add documentation comments to most of the procedures in this file. Improve functionality of existing procedures in a variety of ways, and add new procedures to implement new functionality. --- v7/src/compiler/back/lapgn2.scm | 496 +++++++++++++++++++++----------- 1 file changed, 331 insertions(+), 165 deletions(-) diff --git a/v7/src/compiler/back/lapgn2.scm b/v7/src/compiler/back/lapgn2.scm index 3498d907c..0083ee403 100644 --- a/v7/src/compiler/back/lapgn2.scm +++ b/v7/src/compiler/back/lapgn2.scm @@ -1,8 +1,8 @@ #| -*-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 @@ -32,195 +32,208 @@ Technology nor of any adaptation thereof in any advertising, 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)) +;; `*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*)) - -(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))) + +;; 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))) - -(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))) + +(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)))))) - -;; 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))))))))) - -(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)) + +(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)) @@ -253,17 +266,170 @@ MIT in each case. |# (lambda (map instructions) (set! *register-map* map) (prefix-instructions! instructions))))) + +(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)))) + +(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))))) + +;; 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 -- 2.25.1