From 0b657d459494477e49d62d5dd8cb7a701c0d6428 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 5 Oct 1987 20:45:00 +0000 Subject: [PATCH] - Make assignments use their own caches, distinct from those use by references. - Turn uuo links on by default. - Partly implement the CONSTANT declaration. - Add some more declaration language (ALL and NONE). - Make the variable set be computed at the right point during graph construction. --- v7/src/compiler/back/lapgn1.scm | 4 +- v7/src/compiler/back/lapgn3.scm | 13 +++- v7/src/compiler/fggen/declar.scm | 14 +++- v7/src/compiler/fgopt/folcon.scm | 6 +- v7/src/compiler/fgopt/outer.scm | 21 ++++-- v7/src/compiler/machines/bobcat/machin.scm | 3 +- .../compiler/machines/bobcat/make.scm-68040 | 6 +- v7/src/compiler/machines/bobcat/rules1.scm | 9 ++- v7/src/compiler/machines/bobcat/rules3.scm | 71 ++++++++++--------- 9 files changed, 98 insertions(+), 49 deletions(-) diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm index 773f3c416..51249f7d3 100644 --- a/v7/src/compiler/back/lapgn1.scm +++ b/v7/src/compiler/back/lapgn1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.41 1987/08/07 17:10:54 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.42 1987/10/05 20:39:46 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -48,6 +48,7 @@ MIT in each case. |# (fluid-let ((*next-constant* 0) (*interned-constants* '()) (*interned-variables* '()) + (*interned-assignments* '()) (*interned-uuo-links* '()) (*block-start-label* (generate-label))) (for-each cgen-rgraph rgraphs) @@ -55,6 +56,7 @@ MIT in each case. |# (generate/quotation-header *block-start-label* *interned-constants* *interned-variables* + *interned-assignments* *interned-uuo-links*)))))) (define (cgen-rgraph rgraph) diff --git a/v7/src/compiler/back/lapgn3.scm b/v7/src/compiler/back/lapgn3.scm index dfe52b741..aa9ed4740 100644 --- a/v7/src/compiler/back/lapgn3.scm +++ b/v7/src/compiler/back/lapgn3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 1.3 1987/08/07 17:11:10 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 1.4 1987/10/05 20:41:28 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -41,6 +41,7 @@ MIT in each case. |# (define *next-constant*) (define *interned-constants*) (define *interned-variables*) +(define *interned-assignments*) (define *interned-uuo-links*) (define (allocate-constant-label) @@ -70,6 +71,16 @@ MIT in each case. |# *interned-variables*)) label)))) +(define (free-assignment-label name) + (let ((entry (assq name *interned-assignments*))) + (if entry + (cdr entry) + (let ((label (allocate-constant-label))) + (set! *interned-assignments* + (cons (cons name label) + *interned-assignments*)) + label)))) + (define (free-uuo-link-label name) (let ((entry (assq name *interned-uuo-links*))) (if entry diff --git a/v7/src/compiler/fggen/declar.scm b/v7/src/compiler/fggen/declar.scm index 0b0d50a4e..0b5ad9c88 100644 --- a/v7/src/compiler/fggen/declar.scm +++ b/v7/src/compiler/fggen/declar.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.1 1987/07/03 18:54:07 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.2 1987/10/05 20:44:08 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -36,6 +36,14 @@ MIT in each case. |# (declare (usual-integrations)) +(define (process-top-level-declarations! block declarations) + (process-declarations! + block + ;; Kludge! + (if (assq 'UUO-LINK declarations) + declarations + (cons '(UUO-LINK ALL) declarations)))) + (define (process-declarations! block declarations) (for-each (lambda (declaration) (process-declaration! block declaration)) @@ -75,6 +83,10 @@ MIT in each case. |# (let loop ((specification specification)) (cond ((eq? specification 'BOUND) (block-bound-variables block)) ((eq? specification 'FREE) (block-free-variables block)) + ((eq? specification 'NONE) '()) + ((eq? specification 'ALL) + (append (block-bound-variables block) + (block-free-variables block))) ((and (pair? specification) (assq (car specification) binary-operators) (pair? (cdr specification)) diff --git a/v7/src/compiler/fgopt/folcon.scm b/v7/src/compiler/fgopt/folcon.scm index fafbed6f9..62c1a0122 100644 --- a/v7/src/compiler/fgopt/folcon.scm +++ b/v7/src/compiler/fgopt/folcon.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 1.1 1987/06/09 19:53:48 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 1.2 1987/10/05 20:45:00 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -59,7 +59,9 @@ MIT in each case. |# ;; should be a noop if there is only one ;; value. (and (variable? vnode) - (variable-assigned? vnode)))) + (variable-assigned? vnode) + (not (memq 'CONSTANT + (variable-declarations vnode)))))) (let ((procedures (vnode-procedures vnode)) (values (vnode-values vnode))) (if (null? values) diff --git a/v7/src/compiler/fgopt/outer.scm b/v7/src/compiler/fgopt/outer.scm index d4ea406b7..68c4e0223 100644 --- a/v7/src/compiler/fgopt/outer.scm +++ b/v7/src/compiler/fgopt/outer.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/outer.scm,v 1.1 1987/06/09 19:53:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/outer.scm,v 1.2 1987/10/05 20:44:28 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -72,9 +72,9 @@ MIT in each case. |# (define (analyze-block block) (if (ic-block? block) (begin (if (block-outer? block) - (for-each make-vnode-externally-visible! + (for-each make-vnode-externally-assignable! (block-free-variables block))) - (for-each make-vnode-externally-visible! + (for-each make-vnode-externally-accessible! (block-bound-variables block))))) (define (prepare-combination combination) @@ -105,12 +105,19 @@ MIT in each case. |# (set-combination-procedures! combination '()) (for-each make-procedure-externally-visible! procedures))) +(define (make-vnode-externally-assignable! vnode) + (make-vnode-unknowable! vnode) + (make-vnode-externally-visible! vnode)) + +(define (make-vnode-externally-accessible! vnode) + (cond ((not (memq 'CONSTANT (variable-declarations vnode))) + (make-vnode-externally-assignable! vnode)) + ((not (vnode-externally-visible? vnode)) + (make-vnode-externally-visible! vnode)))) + (define (make-vnode-externally-visible! vnode) (if (not (vnode-externally-visible? vnode)) - (begin (set! more-unknowable-vnodes? true) - (vnode-externally-visible! vnode) - (vnode-unknowable! vnode) - (make-vnode-forward-links-unknowable! vnode) + (begin (vnode-externally-visible! vnode) (for-each make-procedure-externally-visible! (vnode-procedures vnode))))) diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index 9468ab70f..079364c74 100644 --- a/v7/src/compiler/machines/bobcat/machin.scm +++ b/v7/src/compiler/machines/bobcat/machin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.50 1987/07/08 22:09:50 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.51 1987/10/05 20:35:26 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -83,6 +83,7 @@ MIT in each case. |# ((REGISTER) 4) ;move.l reg,reg ((UNASSIGNED) 12) ;move.l #data,reg ((VARIABLE-CACHE) 16) ;move.l d(pc),reg + ((ASSIGNMENT-CACHE) 16) ;move.l d(pc),reg (else (error "Unknown expression type" expression)))) (define (rtl:machine-register? rtl-register) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index af0bd0603..fc447e473 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.43 1987/09/03 05:13:32 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.44 1987/10/05 20:35:38 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -46,11 +46,11 @@ MIT in each case. |# (make-environment (define :name "Liar (Bobcat 68020)") (define :version 3) - (define :modification 1) + (define :modification 2) (define :files) ; (parse-rcs-header -; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.43 1987/09/03 05:13:32 jinx Exp $" +; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.44 1987/10/05 20:35:38 jinx Exp $" ; (lambda (filename version date time zone author state) ; (set! :version (car version)) ; (set! :modification (cadr version)))) diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 30fc9c551..bee3510b1 100644 --- a/v7/src/compiler/machines/bobcat/rules1.scm +++ b/v7/src/compiler/machines/bobcat/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 1.6 1987/07/08 22:08:21 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 1.7 1987/10/05 20:35:54 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -77,6 +77,13 @@ MIT in each case. |# (@PCR ,(free-reference-label name)) ,(reference-assignment-alias! target 'DATA)))) +(define-rule statement + (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name))) + (QUALIFIER (pseudo-register? target)) + (LAP (MOV L + (@PCR ,(free-assignment-label name)) + ,(reference-assignment-alias! target 'DATA)))) + (define-rule statement (ASSIGN (REGISTER (? target)) (REGISTER (? source))) (QUALIFIER (pseudo-register? target)) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index b68c3015a..5f78b9d7a 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.14 1987/09/03 05:14:52 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.15 1987/10/05 20:38:51 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -234,38 +234,45 @@ MIT in each case. |# ,@(inner (cdr constants)))))) (inner constants)) - (lambda (block-label constants references uuo-links) + (define (declare-references references entry:single entry:multiple) + (if (null? references) + (LAP) + (LAP (LEA (@PCR ,(cdar references)) (A 1)) + ,@(if (null? (cdr references)) + (LAP (JSR ,entry:single)) + (LAP ,(load-dnw (length references) 1) + (JSR ,entry:multiple))) + ,@(make-external-label (generate-label))))) + + (lambda (block-label constants references assignments uuo-links) (declare-constants references - (declare-constants uuo-links - (declare-constants constants - (LAP - ;; Place holder for the debugging info filename - ,@(let ((debugging-information-label (allocate-constant-label))) - (LAP (SCHEME-OBJECT ,debugging-information-label DEBUGGING-INFO))) - ,@(let ((environment-label (allocate-constant-label))) - (LAP (SCHEME-OBJECT ,environment-label ENVIRONMENT) - (LEA (@PCR ,environment-label) (A 0)))) - ,@(if (or (not (null? references)) - (not (null? uuo-links))) - (LAP (MOV L ,reg:environment (@A 0)) - (LEA (@PCR ,block-label) (A 0)) - ,@(if (null? references) - (LAP) - (LAP (LEA (@PCR ,(cdar references)) (A 1)) - ,@(if (null? (cdr references)) - (LAP (JSR ,entry:compiler-cache-variable)) - (LAP ,(load-dnw (length references) 1) - (JSR ,entry:compiler-cache-variable-multiple))) - ,@(make-external-label (generate-label)))) - ,@(if (null? uuo-links) - (LAP) - (LAP (LEA (@PCR ,(cdar uuo-links)) (A 1)) - ,@(if (null? (cdr uuo-links)) - (LAP (JSR ,entry:compiler-uuo-link)) - (LAP ,(load-dnw (length uuo-links) 1) - (JSR ,entry:compiler-uuo-link-multiple))) - ,@(make-external-label (generate-label))))) - (LAP ,(load-constant 0 '(@A 0))))))))))) + (declare-constants assignments + (declare-constants uuo-links + (declare-constants + constants + (let ((debugging-information-label (allocate-constant-label)) + (environment-label (allocate-constant-label))) + (LAP + ;; Place holder for the debugging info filename + (SCHEME-OBJECT ,debugging-information-label DEBUGGING-INFO) + (SCHEME-OBJECT ,environment-label ENVIRONMENT) + (LEA (@PCR ,environment-label) (A 0)) + ,@(if (and (null? references) (null? assignments) (null? uuo-links)) + (LAP ,(load-constant 0 '(@A 0))) + (LAP (MOV L ,reg:environment (@A 0)) + (LEA (@PCR ,block-label) (A 0)) + ,@(declare-references + references + entry:compiler-cache-variable + entry:compiler-cache-variable-multiple) + ,@(declare-references + assignments + entry:compiler-cache-assignment + entry:compiler-cache-assignment-multiple) + ,@(declare-references + uuo-links + entry:compiler-uuo-link + entry:compiler-uuo-link-multiple)))))))))))) ;;;; Procedure/Continuation Entries -- 2.25.1