From 748ca013c2c3255f036cdb90988c87f892b31920 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 21 Jan 1989 09:06:39 +0000 Subject: [PATCH] Change CSE to record expressions as their values are pushed on the stack; previously these expressions weren't recorded until their first reference. Fix `insert-stack-destination!' which was not setting up the quantity associated with a stack slot correctly. Fix stack model which was not invalidating things correctly when pops occurred. Change method for `invocation:special-primitive' to forget the contents of all pseudo registers. --- v7/src/compiler/rtlopt/rcse1.scm | 178 ++++++++++++++++++------------ v7/src/compiler/rtlopt/rcse2.scm | 39 ++++--- v7/src/compiler/rtlopt/rcsesr.scm | 52 ++++++--- 3 files changed, 166 insertions(+), 103 deletions(-) diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm index 83101df4e..bbb314e0e 100644 --- a/v7/src/compiler/rtlopt/rcse1.scm +++ b/v7/src/compiler/rtlopt/rcse1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 4.15 1988/11/08 11:15:07 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 4.16 1989/01/21 09:05:49 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -149,78 +149,104 @@ MIT in each case. |# (expression-replace! rtl:assign-expression rtl:set-assign-expression! statement (lambda (volatile? insert-source!) - (let ((address (rtl:assign-address statement))) - (cond ((rtl:register? address) - (if (interpreter-stack-pointer? address) - (let ((expression (rtl:assign-expression statement))) - (if (and (rtl:offset? expression) - (interpreter-stack-pointer? - (rtl:offset-register expression))) - (stack-pointer-adjust! (rtl:offset-number expression)) - (begin - (stack-invalidate!) - (stack-pointer-invalidate!)))) - (register-expression-invalidate! address)) - (if (and (not volatile?) - (not (rtl:machine-register-expression? - (rtl:assign-expression statement)))) - (insert-register-destination! address (insert-source!)))) - ((stack-reference? address) - (stack-reference-invalidate! address) - (if (not volatile?) - (insert-stack-destination! address (insert-source!)))) - ((interpreter-register-reference? address) - (let ((hash (expression-hash address))) - (let ((memory-invalidate! - (lambda () - (hash-table-delete! hash - (hash-table-lookup hash - address))))) - (if volatile? - (memory-invalidate!) - (assignment-memory-insertion address - hash - insert-source! - memory-invalidate!))))) - (else - (let ((address (expression-canonicalize address))) - (rtl:set-assign-address! statement address) - (full-expression-hash address - (lambda (hash volatile?* in-memory?) - in-memory? - (let ((memory-invalidate! - (cond ((stack-push/pop? address) - (lambda () 'DONE)) - ((and (memq (rtl:expression-type address) - '(PRE-INCREMENT POST-INCREMENT)) - (interpreter-free-pointer? - (rtl:address-register address))) - (lambda () - (register-expression-invalidate! - (rtl:address-register address)))) - ((expression-address-varies? address) - (lambda () - (hash-table-delete-class! - element-in-memory?))) - (else - (lambda () - (hash-table-delete! - hash - (hash-table-lookup hash address)) - (varying-address-invalidate!)))))) - (if (or volatile? volatile?*) - (memory-invalidate!) - (assignment-memory-insertion address - hash - insert-source! - memory-invalidate!))))) - (notice-push/pop! address))))) - (notice-push/pop! (rtl:assign-expression statement))))) + ((let ((address (rtl:assign-address statement))) + (if volatile? (notice-pop! (rtl:assign-expression statement))) + (cond ((rtl:register? address) cse/assign/register) + ((stack-reference? address) cse/assign/stack-reference) + ((and (rtl:pre-increment? address) + (interpreter-stack-pointer? + (rtl:address-register address))) + cse/assign/stack-push) + ((interpreter-register-reference? address) + cse/assign/interpreter-register) + (else + (let ((address (expression-canonicalize address))) + (rtl:set-assign-address! statement address) + cse/assign/general)))) + (rtl:assign-address statement) + (rtl:assign-expression statement) + volatile? + insert-source!)))) + +(define (cse/assign/register address expression volatile? insert-source!) + (if (interpreter-stack-pointer? address) + (if (and (rtl:offset? expression) + (interpreter-stack-pointer? + (rtl:offset-register expression))) + (stack-pointer-adjust! (rtl:offset-number expression)) + (begin + (stack-invalidate!) + (stack-pointer-invalidate!))) + (register-expression-invalidate! address)) + (if (and (not volatile?) + (pseudo-register? (rtl:register-number address))) + (insert-register-destination! address (insert-source!)))) + +(define (cse/assign/stack-reference address expression volatile? + insert-source!) + (stack-reference-invalidate! address) + (if (not volatile?) + (insert-stack-destination! address (insert-source!)))) + +(define (cse/assign/stack-push address expression volatile? insert-source!) + (let ((adjust! + (lambda () + (stack-pointer-adjust! (rtl:address-number address))))) + (if (not volatile?) + (let ((element (insert-source!))) + (adjust!) + (insert-stack-destination! + (rtl:make-offset (interpreter-stack-pointer) 0) + element)) + (adjust!)))) + +(define (cse/assign/interpreter-register address expression volatile? + insert-source!) + (let ((hash (expression-hash address))) + (let ((memory-invalidate! + (lambda () + (hash-table-delete! hash (hash-table-lookup hash address))))) + (if volatile? + (memory-invalidate!) + (assignment-memory-insertion address + hash + insert-source! + memory-invalidate!))))) -(define (notice-push/pop! expression) +(define (cse/assign/general address expression volatile? insert-source!) + (full-expression-hash address + (lambda (hash volatile?* in-memory?) + in-memory? + (let ((memory-invalidate! + (cond ((stack-pop? address) + (lambda () unspecific)) + ((and (memq (rtl:expression-type address) + '(PRE-INCREMENT POST-INCREMENT)) + (interpreter-free-pointer? + (rtl:address-register address))) + (lambda () + (register-expression-invalidate! + (rtl:address-register address)))) + ((expression-address-varies? address) + (lambda () + (hash-table-delete-class! element-in-memory?))) + (else + (lambda () + (hash-table-delete! hash + (hash-table-lookup hash address)) + (varying-address-invalidate!)))))) + (if (or volatile? volatile?*) + (memory-invalidate!) + (assignment-memory-insertion address + hash + insert-source! + memory-invalidate!))))) + (notice-pop! address)) + +(define (notice-pop! expression) ;; **** Kludge. Works only because stack-pointer ;; gets used in very fixed way by code generator. - (if (stack-push/pop? expression) + (if (stack-pop? expression) (stack-pointer-adjust! (rtl:address-number expression)))) (define (assignment-memory-insertion address hash insert-source! @@ -301,8 +327,14 @@ MIT in each case. |# (define-cse-method 'INVOCATION:SPECIAL-PRIMITIVE (lambda (statement) - statement - (stack-pointer-adjust! (rtl:invocation:special-primitive-pushed statement)) + (for-each-pseudo-register + (lambda (register) + (let ((expression (register-expression register))) + (if expression + (register-expression-invalidate! expression))))) + (stack-pointer-adjust! + (stack->memory-offset + (rtl:invocation:special-primitive-pushed statement))) (expression-invalidate! (interpreter-value-register)) (expression-invalidate! (interpreter-free-pointer)))) diff --git a/v7/src/compiler/rtlopt/rcse2.scm b/v7/src/compiler/rtlopt/rcse2.scm index 0b3a71e75..9bfa6fbfa 100644 --- a/v7/src/compiler/rtlopt/rcse2.scm +++ b/v7/src/compiler/rtlopt/rcse2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse2.scm,v 4.10 1988/08/29 23:17:22 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse2.scm,v 4.11 1989/01/21 09:06:11 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -202,14 +202,12 @@ MIT in each case. |# (lambda (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) + (cond ((not last) + (set-quantity-first-register! quantity register) + (set-register-next-equivalent! register false)) + (else + (set-register-next-equivalent! last register) + (set-register-previous-equivalent! register last)))) (set-quantity-last-register! quantity register)))) (cond ((rtl:register? expression) (register-equivalence! @@ -223,12 +221,23 @@ MIT in each case. |# unspecific) (define (insert-stack-destination! expression element) - (set-element-in-memory?! (hash-table-insert! (expression-hash expression) - expression - (element->class element)) - false) + (let ((class (element->class element))) + (if class + (let ((expression (element-expression class)) + (stash-quantity! + (lambda (quantity) + (set-stack-reference-quantity! expression quantity)))) + (cond ((rtl:register? expression) + (stash-quantity! + (get-register-quantity (rtl:register-number expression)))) + ((stack-reference? expression) + (stash-quantity! + (stack-reference-quantity expression)))))) + (set-element-in-memory?! + (hash-table-insert! (expression-hash expression) expression class) + false)) unspecific) - + (define (insert-memory-destination! expression element hash) (let ((class (element->class element))) (mention-registers! expression) diff --git a/v7/src/compiler/rtlopt/rcsesr.scm b/v7/src/compiler/rtlopt/rcsesr.scm index 3e934c93a..bb4cadfc3 100644 --- a/v7/src/compiler/rtlopt/rcsesr.scm +++ b/v7/src/compiler/rtlopt/rcsesr.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcsesr.scm,v 4.1 1987/12/08 13:56:09 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcsesr.scm,v 4.2 1989/01/21 09:06:39 cph Rel $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -39,12 +39,22 @@ MIT in each case. |# (define *stack-offset*) (define *stack-reference-quantities*) -(define (stack-push/pop? expression) - (and (memq (rtl:expression-type expression) '(PRE-INCREMENT POST-INCREMENT)) - (interpreter-stack-pointer? (rtl:address-register expression)))) +(define-integrable (memory->stack-offset offset) + ;; Assume this operation is a self-inverse. + (stack->memory-offset offset)) + +(define (stack-push? expression) + (and (rtl:pre-increment? expression) + (interpreter-stack-pointer? (rtl:address-register expression)) + (= -1 (memory->stack-offset (rtl:address-number expression))))) + +(define (stack-pop? expression) + (and (rtl:post-increment? expression) + (interpreter-stack-pointer? (rtl:address-register expression)) + (= 1 (memory->stack-offset (rtl:address-number expression))))) (define (stack-reference? expression) - (and (eq? (rtl:expression-type expression) 'OFFSET) + (and (rtl:offset? expression) (interpreter-stack-pointer? (rtl:address-register expression)))) (define (stack-reference-quantity expression) @@ -58,8 +68,21 @@ MIT in each case. |# *stack-reference-quantities*)) quantity))))) -(define-integrable (stack-pointer-adjust! offset) - (set! *stack-offset* (+ (stack->memory-offset offset) *stack-offset*)) +(define (set-stack-reference-quantity! expression quantity) + (let ((n (+ *stack-offset* (rtl:offset-number expression)))) + (let ((entry (ass= n *stack-reference-quantities*))) + (if entry + (set-cdr! entry quantity) + (set! *stack-reference-quantities* + (cons (cons n quantity) + *stack-reference-quantities*))))) + unspecific) + +(define (stack-pointer-adjust! offset) + (let ((offset (memory->stack-offset offset))) + (if (positive? offset) ;i.e. if a pop + (stack-region-invalidate! 0 offset))) + (set! *stack-offset* (+ *stack-offset* offset)) (stack-pointer-invalidate!)) (define-integrable (stack-pointer-invalidate!) @@ -69,13 +92,12 @@ MIT in each case. |# (set! *stack-reference-quantities* '())) (define (stack-region-invalidate! start end) - (let ((end (+ *stack-offset* end))) - (define (loop i quantities) - (if (< i end) - (loop (1+ i) - (del-ass=! i quantities)) - (set! *stack-reference-quantities* quantities))) - (loop (+ *stack-offset* start) *stack-reference-quantities*))) + (let loop ((i start) (quantities *stack-reference-quantities*)) + (if (< i end) + (loop (1+ i) + (del-ass=! (+ *stack-offset* (stack->memory-offset i)) + quantities)) + (set! *stack-reference-quantities* quantities)))) (define (stack-reference-invalidate! expression) (expression-invalidate! expression) -- 2.25.1