#| -*-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
(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!)))))
\f
-(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!
(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))))
#| -*-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
(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!
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)
-
+\f
(define (insert-memory-destination! expression element hash)
(let ((class (element->class element)))
(mention-registers! expression)
#| -*-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
(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)
*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!)
(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)
projects / mit-scheme.git / commitdiff