From 6184c8c6f279f35300a8c57eea88ddd7f5057255 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 31 May 1987 23:00:30 +0000 Subject: [PATCH] Add new RTL types for cached variable lookup mechanism. --- v7/src/compiler/machines/bobcat/lapgen.scm | 5 +++-- v7/src/compiler/machines/bobcat/machin.scm | 15 ++++++++++----- v7/src/compiler/rtlbase/rtlcon.scm | 10 +++++++++- v7/src/compiler/rtlopt/rcse1.scm | 15 ++++++++++++++- 4 files changed, 36 insertions(+), 9 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index e81b7adc7..826a2d4ad 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.170 1987/05/29 21:21:02 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.171 1987/05/31 23:00:30 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -238,7 +238,8 @@ MIT in each case. |# unassigned? unbound? set! define primitive-apply enclose setup-lexpr return-to-interpreter safe-lookup cache-variable reference-trap assignment-trap) - (define-entries #x0228 uuo-link uuo-link-trap)) + (define-entries #x0228 uuo-link uuo-link-trap cache-reference-apply + safe-reference-trap unassigned?-trap)) (define reg:temp '(@AO 6 #x0010)) (define reg:enclose-result '(@AO 6 #x0014)) diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index 2bc9c8595..c5ad414c6 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.47 1987/05/31 14:14:21 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.48 1987/05/31 23:00:05 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -91,6 +91,8 @@ MIT in each case. |# ((INTERPRETER-CALL-RESULT:ACCESS) (interpreter-register:access)) ((INTERPRETER-CALL-RESULT:CACHE-REFERENCE) (interpreter-register:cache-reference)) + ((INTERPRETER-CALL-RESULT:CACHE-UNASSIGNED?) + (interpreter-register:cache-unassigned?)) ((INTERPRETER-CALL-RESULT:LOOKUP) (interpreter-register:lookup)) ((INTERPRETER-CALL-RESULT:UNASSIGNED?) (interpreter-register:unassigned?)) ((INTERPRETER-CALL-RESULT:UNBOUND?) (interpreter-register:unbound?)) @@ -144,7 +146,7 @@ MIT in each case. |# (define (pseudo-register=? x y) (= (register-renumber x) (register-renumber y))) - + (define register-type (let ((types (make-vector 16))) (let loop ((i 0) (j 8)) @@ -163,15 +165,18 @@ MIT in each case. |# (vector-set! references j `(A ,i)) (loop (1+ i) (1+ j))))) (lambda (register) (vector-ref references register)))) - -(define mask-reference '(D 7)) +(define mask-reference '(D 7)) + (define-integrable (interpreter-register:access) (rtl:make-machine-register d0)) (define-integrable (interpreter-register:cache-reference) (rtl:make-machine-register d0)) +(define-integrable (interpreter-register:cache-unassigned?) + (rtl:make-machine-register d0)) + (define-integrable (interpreter-register:enclose) (rtl:make-offset (interpreter-regs-pointer) 5)) @@ -207,7 +212,7 @@ MIT in each case. |# (define-integrable (interpreter-stack-pointer? register) (= (rtl:register-number register) regnum:stack-pointer)) - + (define (lap:make-label-statement label) `(LABEL ,label)) diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm index 49f06cb13..3670b7d59 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 1.6 1987/05/29 17:49:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 1.7 1987/05/31 22:56:27 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -136,6 +136,14 @@ MIT in each case. |# (and continuation (continuation-label continuation)))) +(define (rtl:make-invocation:cache-reference frame-size prefix continuation + name) + (%make-invocation:cache-reference frame-size + prefix + (and continuation + (continuation-label continuation)) + name)) + (define (rtl:make-invocation:jump frame-size prefix continuation procedure) (%make-invocation:jump frame-size prefix diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm index 9bb67049f..c6cd3dffb 100644 --- a/v7/src/compiler/rtlopt/rcse1.scm +++ b/v7/src/compiler/rtlopt/rcse1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.105 1987/05/28 17:59:24 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.106 1987/05/31 22:56:55 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -180,8 +180,11 @@ MIT in each case. |# (define-cse-method 'CONTINUATION-HEAP-CHECK method/noop) (define-cse-method 'INVOCATION:APPLY method/noop) (define-cse-method 'INVOCATION:JUMP method/noop) +(define-cse-method 'INVOCATION:CACHE-REFERENCE method/noop) (define-cse-method 'INVOCATION:LEXPR method/noop) (define-cse-method 'INVOCATION:PRIMITIVE method/noop) +(define-cse-method 'INTERPRETER-CALL:CACHE-REFERENCE method/noop) +(define-cse-method 'INTERPRETER-CALL:CACHE-UNASSIGNED? method/noop) (define (method/invalidate-stack statement) (stack-pointer-invalidate!)) @@ -203,6 +206,16 @@ MIT in each case. |# rtl:set-invocation:lookup-environment! statement trivial-action))) + +(define-cse-method 'INTERPRETER-CALL:CACHE-ASSIGNMENT + (lambda (statement) + (expression-replace! rtl:interpreter-call:cache-assignment-value + rtl:set-interpreter-call:cache-assignment-value! + statement + (lambda (volatile? insert-source!) + (hash-table-delete-class! element-address-varies?) + (non-object-invalidate!) + (if (not volatile?) (insert-source!)))))) (define (define-lookup-method type get-environment set-environment! register) (define-cse-method type -- 2.25.1