From 37fae3553838c7a69b3db6c3c62c4df9629de5ef Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 9 Jun 1987 19:56:30 +0000 Subject: [PATCH] Split into pieces for compilation. --- v7/src/compiler/rtlopt/rcse1.scm | 239 +------------------------------ 1 file changed, 1 insertion(+), 238 deletions(-) diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm index 57168919c..b19daed07 100644 --- a/v7/src/compiler/rtlopt/rcse1.scm +++ b/v7/src/compiler/rtlopt/rcse1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.108 1987/06/01 20:31:53 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.109 1987/06/09 19:56:30 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -299,241 +299,4 @@ MIT in each case. |# rtl:interpreter-call:set!-environment rtl:set-interpreter-call:set!-environment! rtl:interpreter-call:set!-value - rtl:set-interpreter-call:set!-value!) - -;;;; Canonicalization - -(define (expression-replace! statement-expression set-statement-expression! - statement receiver) - ;; Replace the expression by its cheapest equivalent. Returns two - ;; values: (1) a flag which is true iff the expression is volatile; - ;; and (2) a thunk which, when called, will insert the expression in - ;; the hash table, returning the element. Do not call the thunk if - ;; the expression is volatile. - (let ((expression - (expression-canonicalize (statement-expression statement)))) - (full-expression-hash expression - (lambda (hash volatile? in-memory?) - (let ((element - (find-cheapest-valid-element expression hash volatile?))) - (define (finish expression hash volatile? in-memory?) - (set-statement-expression! statement expression) - (receiver - volatile? - (expression-inserter expression element hash in-memory?))) - (if element - (let ((expression (element-expression element))) - (full-expression-hash expression - (lambda (hash volatile? in-memory?) - (finish expression hash volatile? in-memory?)))) - (finish expression hash volatile? in-memory?))))))) - -(define ((expression-inserter expression element hash in-memory?)) - (or element - (begin (if (rtl:register? expression) - (set-register-expression! (rtl:register-number expression) - expression) - (mention-registers! expression)) - (let ((element* (hash-table-insert! hash expression false))) - (set-element-in-memory?! element* in-memory?) - (element-first-value element*))))) - -(define (expression-canonicalize expression) - (if (rtl:register? expression) - (or (register-expression - (quantity-first-register - (get-register-quantity (rtl:register-number expression)))) - expression) - (rtl:map-subexpressions expression expression-canonicalize))) - -;;;; Invalidation - -(define (non-object-invalidate!) - (hash-table-delete-class! - (lambda (element) - (memq (rtl:expression-type (element-expression element)) - '(OBJECT->ADDRESS OBJECT->DATUM OBJECT->TYPE))))) - -(define (element-address-varies? element) - (and (element-in-memory? element) - (expression-address-varies? (element-expression element)))) - -(define (expression-address-varies? expression) - (if (memq (rtl:expression-type expression) - '(OFFSET PRE-INCREMENT POST-INCREMENT)) - (let ((expression (rtl:address-register expression))) - (not (or (= regnum:regs-pointer (rtl:register-number expression)) - (= regnum:frame-pointer (rtl:register-number expression))))) - (rtl:any-subexpression? expression expression-address-varies?))) - -(define (expression-invalidate! expression) - ;; Delete any expression which refers to this expression from the - ;; table. - (if (rtl:register? expression) - (register-expression-invalidate! expression) - (hash-table-delete-class! - (lambda (element) - (expression-refers-to? (element-expression element) expression))))) - -(define-integrable (stack-pointer-invalidate!) - (register-expression-invalidate! (interpreter-stack-pointer))) - -(define (register-expression-invalidate! expression) - ;; Invalidate a register expression. These expressions are handled - ;; specially for efficiency -- the register is marked invalid but we - ;; delay searching the hash table for relevant expressions. - (let ((hash (expression-hash expression))) - (register-invalidate! (rtl:register-number expression)) - (hash-table-delete! hash (hash-table-lookup hash expression)))) - -(define (register-invalidate! register) - (let ((next (register-next-equivalent register)) - (previous (register-previous-equivalent register)) - (quantity (get-register-quantity register))) - (set-register-tick! register (1+ (register-tick register))) - (if next - (set-register-previous-equivalent! next previous) - (set-quantity-last-register! quantity previous)) - (if previous - (set-register-next-equivalent! previous next) - (set-quantity-first-register! quantity next)) - (set-register-quantity! register (new-quantity register)) - (set-register-next-equivalent! register false) - (set-register-previous-equivalent! register false))) - -;;;; Destination Insertion - -(define (insert-register-destination! expression element) - ;; Insert EXPRESSION, which should be a register expression, into - ;; the hash table as the destination of an assignment. ELEMENT is - ;; the hash table element for the value being assigned to - ;; EXPRESSION. - (let ((class (element->class element)) - (register (rtl:register-number expression))) - (define (register-equivalence! quantity) - (set-register-quantity! register quantity) - (let ((last (quantity-last-register quantity))) - (if last - (begin (set-register-next-equivalent! last register) - (set-register-previous-equivalent! register last)) - (begin (set-quantity-first-register! quantity register) - (set-quantity-last-register! quantity register)))) - (set-register-next-equivalent! register false) - (set-quantity-last-register! quantity register)) - - (set-register-expression! register expression) - (if class - (let ((expression (element-expression class))) - (cond ((rtl:register? expression) - (register-equivalence! - (get-register-quantity (rtl:register-number expression))))))) - (set-element-in-memory?! - (hash-table-insert! (expression-hash expression) expression class) - false))) - -(define (insert-memory-destination! expression element hash) - (let ((class (element->class element))) - (mention-registers! expression) - (set-element-in-memory?! (hash-table-insert! hash expression class) true))) - -(define (mention-registers! expression) - (if (rtl:register? expression) - (let ((register (rtl:register-number expression))) - (remove-invalid-references! register) - (set-register-in-table! register (register-tick register))) - (rtl:for-each-subexpression expression mention-registers!))) - -(define (remove-invalid-references! register) - ;; If REGISTER is invalid, delete all expressions which refer to it - ;; from the hash table. - (if (let ((in-table (register-in-table register))) - (and (not (negative? in-table)) - (not (= in-table (register-tick register))))) - (let ((expression (register-expression register))) - (hash-table-delete-class! - (lambda (element) - (let ((expression* (element-expression element))) - (and (not (rtl:register? expression*)) - (expression-refers-to? expression* expression)))))))) - -;;;; Table Search - -(define (find-cheapest-expression expression hash volatile?) - ;; Find the cheapest equivalent expression for EXPRESSION. - (let ((element (find-cheapest-valid-element expression hash volatile?))) - (if element - (element-expression element) - expression))) - -(define (find-cheapest-valid-element expression hash volatile?) - ;; Find the cheapest valid hash table element for EXPRESSION. - ;; Returns false if no such element exists or if EXPRESSION is - ;; VOLATILE?. - (and (not volatile?) - (let ((element (hash-table-lookup hash expression))) - (and element - (let ((element* (element-first-value element))) - (if (eq? element element*) - element - (let loop ((element element*)) - (and element - (let ((expression (element-expression element))) - (if (or (rtl:register? expression) - (expression-valid? expression)) - element - (loop (element-next-value element)))))))))))) - -(define (expression-valid? expression) - ;; True iff all registers mentioned in EXPRESSION have valid values - ;; in the hash table. - (if (rtl:register? expression) - (let ((register (rtl:register-number expression))) - (= (register-in-table register) (register-tick register))) - (rtl:all-subexpressions? expression expression-valid?))) - -(define (element->class element) - ;; Return the cheapest element in the hash table which has the same - ;; value as ELEMENT. This is necessary because ELEMENT may have - ;; been deleted due to register or memory invalidation. - (and element - ;; If ELEMENT has been deleted from the hash table, - ;; CLASS will be false. [ref crock-1] - (or (element-first-value element) - (element->class (element-next-value element))))) - -;;;; Expression Hash - -(define (expression-hash expression) - (full-expression-hash expression - (lambda (hash do-not-record? hash-arg-in-memory?) - hash))) - -(define (full-expression-hash expression receiver) - (let ((do-not-record? false) - (hash-arg-in-memory? false)) - (define (loop expression) - (let ((type (rtl:expression-type expression))) - (+ (symbol-hash type) - (case type - ((REGISTER) - (quantity-number - (get-register-quantity (rtl:register-number expression)))) - ((OFFSET) - (set! hash-arg-in-memory? true) - (continue expression)) - ((PRE-INCREMENT POST-INCREMENT) - (set! hash-arg-in-memory? true) - (set! do-not-record? true) - 0) - (else (continue expression)))))) - - (define (continue expression) - (rtl:reduce-subparts expression + 0 loop - (lambda (object) - (cond ((integer? object) object) - ((symbol? object) (symbol-hash object)) - ((string? object) (string-hash object)) - (else (hash object)))))) - - (let ((hash (loop expression))) rtl:set-interpreter-call:set!-value!) \ No newline at end of file -- 2.25.1