#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.4 1988/01/22 21:57:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.5 1988/03/14 21:04:25 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(lambda (expression)
(locative-dereference-for-statement locative
(lambda (address)
+ (if (and (rtl:pseudo-register-expression? address)
+ (rtl:address-valued-expression? expression))
+ ;; We don't know for sure that this register is assigned
+ ;; only once. However, if it is assigned multiple
+ ;; times, then all of those assignments should be
+ ;; address valued expressions. This constraint is not
+ ;; enforced.
+ (add-rgraph-address-register! *current-rgraph*
+ (rtl:register-number address)))
(%make-assign address expression))))))
(define (rtl:make-eq-test expression-1 expression-2)
(receiver (rtl:make-offset register offset*) offset))))
(define (guarantee-address expression scfg-append! receiver)
- (if (rtl:address-expression? expression)
+ (if (rtl:address-valued-expression? expression)
(receiver expression)
(guarantee-register expression scfg-append!
(lambda (register)
(assign-to-address-temporary register scfg-append! receiver)))))
-(define (rtl:address-expression? expression)
- (if (rtl:register? expression)
- (register-contains-address? (rtl:register-number expression))
- (rtl:object->address? expression)))
-
(define (guarantee-register expression scfg-append! receiver)
(if (rtl:register? expression)
(receiver expression)
(define (assign-to-temporary expression scfg-append! receiver)
(let ((pseudo (rtl:make-pseudo-register)))
- (if (rtl:object->address? expression)
+ (if (rtl:address-valued-expression? expression)
(add-rgraph-address-register! *current-rgraph*
(rtl:register-number pseudo)))
(scfg-append! (%make-assign pseudo expression) (receiver pseudo))))
(lambda (expression offset)
(if (zero? offset)
(receiver
- (if (rtl:address-expression? expression)
+ (if (rtl:address-valued-expression? expression)
(rtl:make-address->environment expression)
expression))
(generate-offset-address expression offset scfg-append!
(lambda (element)
(loop (cdr elements)
(cons element simplified-elements))))))))))))
+
+;; A NOP for simplification
+
+(define-expression-method 'TYPED-CONS:PROCEDURE
+ (lambda (receiver scfg-append! type entry min max size)
+ (receiver (rtl:make-typed-cons:procedure type entry min max size))))
\f
(define (object-selector make-object-selector)
(lambda (receiver scfg-append! expression)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlexp.scm,v 4.2 1987/12/31 08:50:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlexp.scm,v 4.3 1988/03/14 21:04:40 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
'(INVOCATION:APPLY
INVOCATION:JUMP
INVOCATION:LEXPR
- INVOCATION:LOOKUP
INVOCATION:PRIMITIVE
INVOCATION:SPECIAL-PRIMITIVE
- INVOCATION:UUO-LINK)))
+ INVOCATION:UUO-LINK
+ INVOCATION:CACHE-REFERENCE
+ INVOCATION:LOOKUP)))
(define (rtl:trivial-expression? expression)
(if (memq (rtl:expression-type expression)
ENTRY:CONTINUATION
ENTRY:PROCEDURE
UNASSIGNED
- VARIABLE-CACHE))
+ VARIABLE-CACHE
+ ASSIGNMENT-CACHE))
true
(and (rtl:offset? expression)
(interpreter-stack-pointer? (rtl:offset-register expression)))))
(and (rtl:register? expression)
(machine-register? (rtl:register-number expression))))
+(define (rtl:pseudo-register-expression? expression)
+ (and (rtl:register? expression)
+ (pseudo-register? (rtl:register-number expression))))
+
+(define (rtl:address-valued-expression? expression)
+ (if (rtl:register? expression)
+ (register-contains-address? (rtl:register-number expression))
+ (or (rtl:object->address? expression)
+ (rtl:variable-cache? expression)
+ (rtl:assignment-cache? expression))))
+\f
(define (rtl:map-subexpressions expression procedure)
(if (rtl:constant? expression)
(map identity-procedure expression)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.3 1988/02/17 19:13:26 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.4 1988/03/14 21:04:51 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(define-rtl-expression pre-increment rtl: register number)
(define-rtl-expression post-increment rtl: register number)
-(define-rtl-expression assignment-cache rtl: name)
(define-rtl-expression cons-pointer rtl: type datum)
(define-rtl-expression constant % value)
+(define-rtl-expression assignment-cache rtl: name)
(define-rtl-expression variable-cache rtl: name)
(define-rtl-expression entry:continuation rtl: continuation)
(define-rtl-expression entry:procedure rtl: procedure)
(define-rtl-predicate unassigned-test % expression)
(define-rtl-statement assign % address expression)
-(define-rtl-statement continuation-entry rtl: continuation)
-(define-rtl-statement continuation-heap-check rtl: continuation)
-(define-rtl-statement procedure-heap-check rtl: procedure)
-(define-rtl-statement setup-lexpr rtl: procedure)
+
(define-rtl-statement pop-return rtl:)
+(define-rtl-statement continuation-entry rtl: continuation)
+(define-rtl-statement continuation-header rtl: continuation)
+(define-rtl-statement ic-procedure-header rtl: procedure)
+(define-rtl-statement open-procedure-header rtl: procedure)
+(define-rtl-statement procedure-header rtl: procedure min max)
+(define-rtl-statement closure-header rtl: procedure)
+
+(define-rtl-statement cons-closure rtl: procedure min max size)
+
(define-rtl-statement interpreter-call:access % environment name)
(define-rtl-statement interpreter-call:define % environment name value)
(define-rtl-statement interpreter-call:lookup % environment name safe?)
(define-rtl-statement interpreter-call:cache-assignment % name value)
(define-rtl-statement interpreter-call:cache-reference % name safe?)
(define-rtl-statement interpreter-call:cache-unassigned? % name)
-(define-rtl-statement interpreter-call:enclose rtl: size)
(define-rtl-statement invocation:apply rtl: pushed continuation)
-(define-rtl-statement invocation:cache-reference rtl: pushed continuation name)
(define-rtl-statement invocation:jump rtl: pushed continuation procedure)
(define-rtl-statement invocation:lexpr rtl: pushed continuation procedure)
-(define-rtl-statement invocation:lookup rtl: pushed continuation environment
- name)
+(define-rtl-statement invocation:uuo-link rtl: pushed continuation name)
(define-rtl-statement invocation:primitive rtl: pushed continuation procedure)
(define-rtl-statement invocation:special-primitive rtl: pushed continuation
procedure)
-(define-rtl-statement invocation:uuo-link rtl: pushed continuation name)
+(define-rtl-statement invocation:cache-reference rtl: pushed continuation name)
+(define-rtl-statement invocation:lookup rtl: pushed continuation environment
+ name)
(define-rtl-statement invocation-prefix:move-frame-up rtl: frame-size locative)
(define-rtl-statement invocation-prefix:dynamic-link rtl: frame-size locative
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty2.scm,v 4.2 1987/12/31 08:50:53 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty2.scm,v 4.3 1988/03/14 21:05:05 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(define-integrable (rtl:make-typed-cons:vector type elements)
`(TYPED-CONS:VECTOR ,type ,@elements))
+(define-integrable (rtl:make-typed-cons:procedure label arg-info nvars)
+ `(TYPED-CONS:PROCEDURE ,label ,arg-info ,nvars))
+
;;; Linearizer Support
(define-integrable (rtl:make-jump-statement label)
projects / mit-scheme.git / commitdiff