From fe0392ac72c573e66ab5164d17c8cf29cac41663 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 8 Nov 1988 12:36:58 +0000 Subject: [PATCH] Generalize rule for `cons-closure' so that it handles more types of target expressions. --- v7/src/compiler/machines/bobcat/lapgen.scm | 61 +++++++++++++++------- v7/src/compiler/machines/bobcat/rules3.scm | 23 ++++++-- 2 files changed, 60 insertions(+), 24 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index c7e3b004e..6e2494002 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 4.17 1988/11/04 10:58:30 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.18 1988/11/08 12:36:18 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -211,24 +211,6 @@ MIT in each case. |# (define-integrable (cc-commutative? cc) (memq cc '(T F NE EQ))) -(define (expression->machine-register! expression register) - (let ((target (register-reference register))) - (let ((result - (case (car expression) - ((REGISTER) - (load-machine-register! (rtl:register-number expression) - register)) - ((OFFSET) - (LAP (MOV L ,(offset->indirect-reference! expression) ,target))) - ((CONSTANT) - (LAP ,(load-constant (rtl:constant-value expression) target))) - ((UNASSIGNED) - (LAP ,(load-non-pointer type-code:unassigned 0 target))) - (else - (error "Unknown expression type" (car expression)))))) - (delete-machine-register! register) - result))) - (define-integrable (effective-address/data&alterable? ea) (memq (lap:ea-keyword ea) '(D @D @A @A+ @-A @AO @DO @AOX W L))) @@ -300,6 +282,26 @@ MIT in each case. |# (LAP) (LAP ,(instruction-gen) ,@(loop (-1+ n))))))) + +;;;; Expression-Generic Operations + +(define (expression->machine-register! expression register) + (let ((target (register-reference register))) + (let ((result + (case (car expression) + ((REGISTER) + (load-machine-register! (rtl:register-number expression) + register)) + ((OFFSET) + (LAP (MOV L ,(offset->indirect-reference! expression) ,target))) + ((CONSTANT) + (LAP ,(load-constant (rtl:constant-value expression) target))) + ((UNASSIGNED) + (LAP ,(load-non-pointer type-code:unassigned 0 target))) + (else + (error "Unknown expression type" (car expression)))))) + (delete-machine-register! register) + result))) (define (put-type-in-ea type-code ea) (cond ((effective-address/data-register? ea) @@ -309,6 +311,27 @@ MIT in each case. |# (LAP (MOV B (& ,type-code) ,ea))) (else (error "PUT-TYPE-IN-EA: Illegal effective-address" ea)))) + +(define (standard-target-expression? target) + (or (rtl:offset? target) + (rtl:free-push? target) + (rtl:stack-push? target))) + +(define (rtl:free-push? expression) + (and (rtl:post-increment? expression) + (interpreter-free-pointer? (rtl:post-increment-register expression)) + (= 1 (rtl:post-increment-number expression)))) + +(define (rtl:stack-push? expression) + (and (rtl:pre-increment? expression) + (interpreter-stack-pointer? (rtl:pre-increment-register expression)) + (= -1 (rtl:pre-increment-number expression)))) + +(define (standard-target-expression->ea target) + (cond ((rtl:offset? target) (offset->indirect-reference! target)) + ((rtl:free-push? target) (INST-EA (@A+ 5))) + ((rtl:stack-push? target) (INST-EA (@-A 7))) + (else (error "STANDARD-TARGET->EA: Not a standard target" target)))) ;;;; Fixnum Operators diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 4fb64e1ed..3ac298dc9 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 4.13 1988/11/08 11:11:27 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.14 1988/11/08 12:36:58 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -396,13 +396,26 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (CONSTANT (? type)) - (CONS-CLOSURE (ENTRY:PROCEDURE (? internal-label)) + (CONS-CLOSURE (ENTRY:PROCEDURE (? procedure-label)) (? min) (? max) (? size)))) (QUALIFIER (pseudo-register? target)) - (let ((temporary (reference-temporary-register! 'ADDRESS)) - (target (reference-target-alias! target 'DATA))) + (generate/cons-closure (reference-target-alias! target 'DATA) + type procedure-label min max size)) + +(define-rule statement + (ASSIGN (? target) + (CONS-POINTER (CONSTANT (? type)) + (CONS-CLOSURE (ENTRY:PROCEDURE (? procedure-label)) + (? min) (? max) (? size)))) + (QUALIFIER (standard-target-expression? target)) + (let ((temporary (reference-temporary-register! 'DATA))) + (LAP ,@(generate/cons-closure temporary type procedure-label min max size) + (MOV L ,temporary ,(standard-target-expression->ea target))))) + +(define (generate/cons-closure target type procedure-label min max size) + (let ((temporary (reference-temporary-register! 'ADDRESS))) (LAP (LEA (@PCR ,(rtl-procedure/external-label - (label->object internal-label))) + (label->object procedure-label))) ,temporary) ,(load-non-pointer (ucode-type manifest-closure) (+ 3 size) -- 2.25.1