From: Guillermo J. Rozas Date: Mon, 14 Mar 1988 21:05:05 +0000 (+0000) Subject: Change the representation of compiled procedures and other entries: X-Git-Tag: 20090517-FFI~12865 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=23c998182a98725f1e815a3f9f22d84f373aa335;p=mit-scheme.git Change the representation of compiled procedures and other entries: They are now just the address of an instruction with a gc offset preceding the instruction and an arity/type word preceding that. Compiled closures are done by creating a tiny fake compiled code block which jumps to the right place and sets up the free variables for reference. Uuo style links are now just jump instructions to the correct address. All relocators have been updated to reflect this change. Variable caches have no type code. The relocators know about this. New types: TC_COMPILED_ENTRY TC_MANIFEST_CLOSURE TC_LINKAGE_SECTION --- diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm index 6c686f18c..8f6cfa70e 100644 --- a/v7/src/compiler/rtlbase/rtlcon.scm +++ b/v7/src/compiler/rtlbase/rtlcon.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -43,6 +43,15 @@ MIT in each case. |# (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) @@ -226,17 +235,12 @@ MIT in each case. |# (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) @@ -273,7 +277,7 @@ MIT in each case. |# (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)))) @@ -332,7 +336,7 @@ MIT in each case. |# (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! @@ -392,6 +396,12 @@ MIT in each case. |# (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)))) (define (object-selector make-object-selector) (lambda (receiver scfg-append! expression) diff --git a/v7/src/compiler/rtlbase/rtlexp.scm b/v7/src/compiler/rtlbase/rtlexp.scm index 375138423..84209ed56 100644 --- a/v7/src/compiler/rtlbase/rtlexp.scm +++ b/v7/src/compiler/rtlbase/rtlexp.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -41,10 +41,11 @@ MIT in each case. |# '(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) @@ -53,7 +54,8 @@ MIT in each case. |# ENTRY:CONTINUATION ENTRY:PROCEDURE UNASSIGNED - VARIABLE-CACHE)) + VARIABLE-CACHE + ASSIGNMENT-CACHE)) true (and (rtl:offset? expression) (interpreter-stack-pointer? (rtl:offset-register expression))))) @@ -62,6 +64,17 @@ MIT in each case. |# (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)))) + (define (rtl:map-subexpressions expression procedure) (if (rtl:constant? expression) (map identity-procedure expression) diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm index 4f962d21c..0f6fa5c8e 100644 --- a/v7/src/compiler/rtlbase/rtlty1.scm +++ b/v7/src/compiler/rtlbase/rtlty1.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -44,9 +44,9 @@ MIT in each case. |# (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) @@ -59,12 +59,18 @@ MIT in each case. |# (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?) @@ -75,18 +81,17 @@ MIT in each case. |# (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 diff --git a/v7/src/compiler/rtlbase/rtlty2.scm b/v7/src/compiler/rtlbase/rtlty2.scm index 7dc77596c..9770703f6 100644 --- a/v7/src/compiler/rtlbase/rtlty2.scm +++ b/v7/src/compiler/rtlbase/rtlty2.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -115,6 +115,9 @@ MIT in each case. |# (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)