From 3db8dc1dffe34d9cfadd295c80d62194b557b950 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 6 Jul 1993 00:56:32 +0000 Subject: [PATCH] - Update to match change in RTL introduced to improve array indexing. - Add floating-vector support. - Add top-level code compression support. --- v7/src/compiler/machines/bobcat/compiler.pkg | 5 +- v7/src/compiler/machines/bobcat/lapgen.scm | 168 +++++++-- v7/src/compiler/machines/bobcat/machin.scm | 14 +- .../compiler/machines/bobcat/make.scm-68040 | 6 +- v7/src/compiler/machines/bobcat/rules1.scm | 341 ++++++++++++------ v7/src/compiler/machines/bobcat/rules2.scm | 17 +- v7/src/compiler/machines/bobcat/rules3.scm | 87 ++++- v7/src/compiler/machines/bobcat/rules4.scm | 9 +- v7/src/compiler/machines/bobcat/rulrew.scm | 63 +++- 9 files changed, 530 insertions(+), 180 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg index 556119691..77ec5cf8f 100644 --- a/v7/src/compiler/machines/bobcat/compiler.pkg +++ b/v7/src/compiler/machines/bobcat/compiler.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: compiler.pkg,v 1.43 1993/02/25 02:16:04 gjr Exp $ +$Id: compiler.pkg,v 1.44 1993/07/06 00:56:22 gjr Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -511,7 +511,8 @@ MIT in each case. |# (files "rtlgen/rgcomb") (parent (compiler rtl-generator)) (export (compiler rtl-generator) - generate/combination) + generate/combination + rtl:bump-closure) (export (compiler rtl-generator combination/inline) generate/invocation-prefix)) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 5f3a99b9f..d3d5c2119 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: lapgen.scm,v 4.47 1993/01/13 00:18:46 cph Exp $ +$Id: lapgen.scm,v 4.48 1993/07/06 00:56:23 gjr Exp $ -Copyright (c) 1988-93 Massachusetts Institute of Technology +Copyright (c) 1988-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -350,9 +350,134 @@ MIT in each case. |# (register-alias register 'DATA) (load-alias-register! register 'ADDRESS))) -(define (offset->indirect-reference! offset) - (indirect-reference! (rtl:register-number (rtl:offset-base offset)) - (rtl:offset-number offset))) +(define (rtl:simple-byte-offset? expression) + (and (rtl:byte-offset? expression) + (let ((base (rtl:byte-offset-base expression)) + (offset (rtl:byte-offset-offset expression))) + (if (rtl:register? base) + (or (rtl:machine-constant? offset) + (rtl:register? offset)) + (and (rtl:byte-offset-address? base) + (rtl:machine-constant? offset) + (rtl:register? (rtl:byte-offset-address-base base)) + (rtl:register? (rtl:byte-offset-address-offset base))))) + expression)) + +(define (byte-offset->reference! offset) + ;; OFFSET must be a simple byte offset + (let ((base (rtl:byte-offset-base offset)) + (offset (rtl:byte-offset-offset offset))) + (cond ((not (rtl:register? base)) + (indexed-ea (rtl:register-number + (rtl:byte-offset-address-base base)) + (rtl:register-number + (rtl:byte-offset-address-offset base)) + 1 + (rtl:machine-constant-value offset))) + ((rtl:machine-constant? offset) + (indirect-byte-reference! (rtl:register-number base) + (rtl:machine-constant-value offset))) + (else + (indexed-ea (rtl:register-number base) + (rtl:register-number offset) + 1 + 0))))) + +(define (rtl:simple-offset? expression) + (and (rtl:offset? expression) + (let ((base (rtl:offset-base expression)) + (offset (rtl:offset-offset expression))) + (if (rtl:register? base) + (or (rtl:machine-constant? offset) + (rtl:register? offset)) + (and (rtl:offset-address? base) + (rtl:machine-constant? offset) + (rtl:register? (rtl:offset-address-base base)) + (rtl:register? (rtl:offset-address-offset base))))) + expression)) + +(define (offset->reference! offset) + ;; OFFSET must be a simple offset + (let ((base (rtl:offset-base offset)) + (offset (rtl:offset-offset offset))) + (cond ((not (rtl:register? base)) + (indexed-ea (rtl:register-number (rtl:offset-address-base base)) + (rtl:register-number (rtl:offset-address-offset base)) + 4 + (* 4 (rtl:machine-constant-value offset)))) + ((rtl:machine-constant? offset) + (indirect-reference! (rtl:register-number base) + (rtl:machine-constant-value offset))) + (else + (indexed-ea (rtl:register-number base) + (rtl:register-number offset) + 4 + 0))))) + +(define (offset->reference!/char offset) + ;; OFFSET must be a simple offset + (let ((base (rtl:offset-base offset)) + (offset (rtl:offset-offset offset))) + (cond ((not (rtl:register? base)) + (indexed-ea (rtl:register-number (rtl:offset-address-base base)) + (rtl:register-number (rtl:offset-address-offset base)) + 4 + (+ 3 (* 4 (rtl:machine-constant-value offset))))) + ((rtl:machine-constant? offset) + (indirect-byte-reference! + (rtl:register-number base) + (+ 3 (* 4 (rtl:machine-constant-value offset))))) + (else + (indexed-ea (rtl:register-number base) + (rtl:register-number offset) + 4 + 3))))) + +(define (rtl:simple-float-offset? expression) + (and (rtl:float-offset? expression) + (let ((base (rtl:float-offset-base expression)) + (offset (rtl:float-offset-offset expression))) + (and (or (rtl:machine-constant? offset) + (rtl:register? offset)) + (or (rtl:register? base) + (and (rtl:offset-address? base) + (rtl:register? (rtl:offset-address-base base)) + (rtl:machine-constant? + (rtl:offset-address-offset base)))))) + expression)) + +(define (float-offset->reference! offset) + ;; OFFSET must be a simple float offset + (let ((base (rtl:float-offset-base offset)) + (offset (rtl:float-offset-offset offset))) + (cond ((not (rtl:register? base)) + (let ((base* + (rtl:register-number (rtl:offset-address-base base))) + (w-offset + (rtl:machine-constant-value + (rtl:offset-address-offset base)))) + (if (rtl:machine-constant? offset) + (indirect-reference! + base* + (+ (* 2 (rtl:machine-constant-value offset)) + w-offset)) + (indexed-ea base* + (rtl:register-number offset) + 8 + (* 4 w-offset))))) + ((rtl:machine-constant? offset) + (indirect-reference! (rtl:register-number base) + (* 2 (rtl:machine-constant-value offset)))) + (else + (indexed-ea (rtl:register-number base) + (rtl:register-number offset) + 8 + 0))))) + +(define (indexed-ea base index scale offset) + (let ((base (allocate-indirection-register! base)) + (index (preferred-data-register-reference index))) + (INST-EA (@AOXS ,(->areg base) ,offset (,index L ,scale))))) (define (indirect-reference! register offset) (offset-reference (allocate-indirection-register! register) offset)) @@ -362,19 +487,7 @@ MIT in each case. |# (define-integrable (allocate-indirection-register! register) (load-alias-register! register 'ADDRESS)) - -#| - -;; *** This is believed to be a fossil. *** -;; Left here until the first compilation to make sure that it really is. -;; Can be removed the next time it is seen. - -(define (code-object-label-initialize code-object) - code-object - false) - -|# - + (define (generate-n-times n limit instruction-gen with-counter) (if (> n limit) (let ((loop (generate-label 'LOOP))) @@ -390,17 +503,21 @@ MIT in each case. |# (LAP ,@(instruction-gen) ,@(loop (-1+ n))))))) +#| + +;;; These seem to be fossils --- GJR 7/1/1993 + (define (standard-target-expression? target) - (or (and (rtl:offset? target) - (rtl:register? (rtl:offset-base target))) + (or (rtl:simple-offset? target) (rtl:free-push? target) (rtl:stack-push? target))) (define (standard-target-expression->ea target) - (cond ((rtl:offset? target) (offset->indirect-reference! target)) + (cond ((rtl:offset? target) (offset->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)))) +|# (define (rtl:free-push? expression) (and (rtl:post-increment? expression) @@ -451,7 +568,7 @@ MIT in each case. |# (operate-on-machine-target target) (use-temporary target)))))) ((OFFSET) - (use-temporary (offset->indirect-reference! target))) + (use-temporary (offset->reference! target))) (else (error "Illegal machine target" target))))) @@ -466,10 +583,9 @@ MIT in each case. |# (operate-on-target (reference-target-alias! target type))) operate-on-target)) -(define (machine-operation-target? target) - (or (rtl:register? target) - (and (rtl:offset? target) - (rtl:register? (rtl:offset-base target))))) +(define (machine-operation-target? expression) + (or (rtl:register? expression) + (rtl:simple-offset? expression))) (define (two-arg-register-operation operate commutative? diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index 64095888e..b2af96768 100644 --- a/v7/src/compiler/machines/bobcat/machin.scm +++ b/v7/src/compiler/machines/bobcat/machin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: machin.scm,v 4.30 1993/06/29 22:23:16 gjr Exp $ +$Id: machin.scm,v 4.31 1993/07/06 00:56:25 gjr Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -288,12 +288,15 @@ MIT in each case. |# (= (rtl:register-number expression) regnum:return-value))) (define (interpreter-environment-register) - (rtl:make-offset (interpreter-regs-pointer) 3)) + (rtl:make-offset (interpreter-regs-pointer) + (rtl:make-machine-constant 3))) (define (interpreter-environment-register? expression) (and (rtl:offset? expression) (interpreter-regs-pointer? (rtl:offset-base expression)) - (= 3 (rtl:offset-number expression)))) + (let ((offset (rtl:offset-offset expression))) + (and (rtl:machine-constant? offset) + (= 3 (rtl:machine-constant-value offset)))))) (define (interpreter-free-pointer) (rtl:make-machine-register regnum:free-pointer)) @@ -381,7 +384,8 @@ MIT in each case. |# ASSIGNMENT-CACHE VARIABLE-CACHE OFFSET-ADDRESS - BYTE-OFFSET-ADDRESS) + BYTE-OFFSET-ADDRESS + FLOAT-OFFSET-ADDRESS) 3) ((CONS-POINTER) (and (rtl:machine-constant? (rtl:cons-pointer-type expression)) @@ -398,4 +402,4 @@ MIT in each case. |# (define compiler:primitives-with-no-open-coding '(DIVIDE-FIXNUM GCD-FIXNUM &/ VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS - FLOATING-VECTOR-REF FLOATING-VECTOR-SET!)) \ No newline at end of file + FLONUM-CEILING FLONUM-FLOOR FLONUM-ATAN2)) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index f3c360b35..8dff8745c 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.88 1991/10/25 06:49:46 cph Exp $ +$Id: make.scm-68040,v 4.89 1993/07/06 00:56:26 gjr Exp $ -Copyright (c) 1991 Massachusetts Institute of Technology +Copyright (c) 1991-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -37,6 +37,8 @@ MIT in each case. |# (declare (usual-integrations)) ((load "base/make") "Motorola MC68040") +(set! (access compiler:compress-top-level? (->environment '(compiler))) + true) ((environment-lookup (->environment '(COMPILER LAP-SYNTAXER)) 'MC68K/TOGGLE-CLOSURE-FORMAT) 'MC68040) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 50d53de0f..8f139c620 100644 --- a/v7/src/compiler/machines/bobcat/rules1.scm +++ b/v7/src/compiler/machines/bobcat/rules1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.37 1992/07/05 14:20:36 jinx Exp $ +$Id: rules1.scm,v 4.38 1993/07/06 00:56:27 gjr Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -50,32 +50,94 @@ MIT in each case. |# (ASSIGN (REGISTER (? target)) (REGISTER (? source))) (assign-register->register target source)) +(define (assign-register->register target source) + (standard-move-to-target! source (register-type target) target) + (LAP)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (load-indexed-address target base index 4 0)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (BYTE-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (load-indexed-address target base index 1 0)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (load-indexed-address target base index 8 0)) + +(define-integrable (->areg reg) + (- reg 8)) + +(define (load-indexed-address target base index scale offset) + (let ((load-address + (lambda (get-target-reference) + (let ((ea (indexed-ea base index scale offset))) + (LAP (LEA ,ea ,(get-target-reference))))))) + (cond ((or (not (machine-register? target)) + (eq? (register-type target) 'ADDRESS)) + (load-address + (lambda () + (target-register-reference target 'ADDRESS)))) + ((eq? (register-type target) 'DATA) + (let ((temp + (register-reference + (allocate-temporary-register! 'ADDRESS)))) + (LAP ,@(load-address (lambda () temp)) + (MOV L ,temp ,(register-reference target))))) + (else + (error "load-indexed-address: Unknown register type" + target))))) + +(define (target-register-reference target type) + (delete-dead-registers!) + (register-reference + (or (register-alias target type) + (allocate-alias-register! target type)))) + (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n))) + (ASSIGN (REGISTER (? target)) + (OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n)))) (load-static-link target source (* 4 n) false)) +(define-rule statement + (ASSIGN (REGISTER (? target)) + (BYTE-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n)))) + (load-static-link target source n false)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n)))) + (load-static-link target source (* 8 n) false)) + (define-rule statement ;; This is an intermediate rule -- not intended to produce code. (ASSIGN (REGISTER (? target)) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n))))) (load-static-link target source (* 4 n) (lambda (target) (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target))))) -(define-rule statement - (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? n))) - (load-static-link target source n false)) - (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (BYTE-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n))))) (load-static-link target source n (lambda (target) (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target))))) - + (define (load-static-link target source n suffix) (cond ((and (not suffix) (zero? n)) (assign-register->register target source)) @@ -103,6 +165,7 @@ MIT in each case. |# (else (error "load-static-link: Unknown register type" (register-type target)))))) + (else (let ((non-reusable (cond ((not suffix) @@ -148,11 +211,7 @@ MIT in each case. |# (suffix (register-reference reusable-alias)) (LAP)))) non-reusable)))))) - -(define (assign-register->register target source) - (standard-move-to-target! source (register-type target) target) - (LAP)) - + (define-rule statement (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source)))) ;; See if we can reuse a source alias, because `object->type' can @@ -172,7 +231,7 @@ MIT in each case. |# (let ((source (register-reference source))) (object->type source source))) no-reuse)))) - + (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (REGISTER (? type)) (REGISTER (? datum)))) @@ -313,96 +372,101 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) - (OBJECT->TYPE (OFFSET (REGISTER (? address)) (? offset)))) - (let ((source (indirect-reference! address offset))) + (? expression rtl:simple-offset?)) + (let ((source (offset->reference! expression))) + (LAP (MOV L ,source ,(standard-target-reference target))))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1)) + (LAP (MOV L (@A+ 7) ,(standard-target-reference target)))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (OBJECT->TYPE (? expression rtl:simple-offset?))) + (let ((source (offset->reference! expression))) (delete-dead-registers!) (object->type source (reference-target-alias! target 'DATA)))) (define-rule statement (ASSIGN (REGISTER (? target)) - (OBJECT->DATUM (OFFSET (REGISTER (? address)) (? offset)))) - (convert-object/offset->register target address offset object->datum)) + (OBJECT->DATUM (? expression rtl:simple-offset?))) + (convert-object/offset->register target expression object->datum)) (define-rule statement (ASSIGN (REGISTER (? target)) - (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset)))) - (convert-object/offset->register target address offset object->address)) + (OBJECT->ADDRESS (? expression rtl:simple-offset?))) + (convert-object/offset->register target expression object->address)) (define-rule statement (ASSIGN (REGISTER (? target)) (ADDRESS->FIXNUM - (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset))))) - (convert-object/offset->register target address offset address->fixnum)) + (OBJECT->ADDRESS (? expression rtl:simple-offset?)))) + (convert-object/offset->register target expression address->fixnum)) (define-rule statement (ASSIGN (REGISTER (? target)) - (OBJECT->FIXNUM (OFFSET (REGISTER (? address)) (? offset)))) - (convert-object/offset->register target address offset object->fixnum)) + (OBJECT->FIXNUM (? expression rtl:simple-offset?))) + (convert-object/offset->register target expression object->fixnum)) -(define (convert-object/offset->register target address offset conversion) - (let ((source (indirect-reference! address offset))) +(define (convert-object/offset->register target expression conversion) + (let ((source (offset->reference! expression))) (delete-dead-registers!) (let ((target (reference-target-alias! target 'DATA))) (LAP (MOV L ,source ,target) ,@(conversion target))))) + +;;;; Transfers to Memory (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset))) - (let ((source (indirect-reference! address offset))) - (LAP (MOV L ,source ,(standard-target-reference target))))) + (ASSIGN (? expression rtl:simple-offset?) + (REGISTER (? r))) + (QUALIFIER (register-value-class=word? r)) + (LAP (MOV L + ,(standard-register-reference r false true) + ,(offset->reference! expression)))) (define-rule statement - (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1)) - (LAP (MOV L (@A+ 7) ,(standard-target-reference target)))) - -;;;; Transfers to Memory + (ASSIGN (? expression rtl:simple-offset?) + (POST-INCREMENT (REGISTER 15) 1)) + (LAP (MOV L (@A+ 7) ,(offset->reference! expression)))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? a)) (? n)) + (ASSIGN (? expression rtl:simple-offset?) (CONSTANT (? object))) - (load-constant object (indirect-reference! a n))) + (load-constant object (offset->reference! expression))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? a)) (? n)) + (ASSIGN (? expression rtl:simple-offset?) (CONS-POINTER (MACHINE-CONSTANT (? type)) (MACHINE-CONSTANT (? datum)))) - (load-non-pointer type datum (indirect-reference! a n))) - -(define-rule statement - (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (REGISTER (? r))) - (QUALIFIER (register-value-class=word? r)) - (LAP (MOV L - ,(standard-register-reference r false true) - ,(indirect-reference! a n)))) - -(define-rule statement - (ASSIGN (OFFSET (REGISTER (? a)) (? n)) - (POST-INCREMENT (REGISTER 15) 1)) - (LAP (MOV L (@A+ 7) ,(indirect-reference! a n)))) + (load-non-pointer type datum (offset->reference! expression))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) - (CONS-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? datum)))) - (let ((target (indirect-reference! address offset))) + (ASSIGN (? expression rtl:simple-offset?) + (CONS-POINTER (MACHINE-CONSTANT (? type)) + (REGISTER (? datum)))) + (let ((target (offset->reference! expression))) (LAP (MOV L ,(standard-register-reference datum 'DATA true) ,target) ,@(memory-set-type type target)))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (? expression rtl:simple-offset?) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n))))) (let ((temp (reference-temporary-register! 'ADDRESS)) - (target (indirect-reference! address offset))) + (target (offset->reference! expression))) (LAP (LEA ,(indirect-reference! source n) ,temp) (MOV L ,temp ,target) ,@(memory-set-type type target)))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (? expression rtl:simple-offset?) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (BYTE-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? n))))) (let ((temp (reference-temporary-register! 'ADDRESS)) - (target (indirect-reference! address offset))) + (target (offset->reference! expression))) (LAP (LEA ,(indirect-byte-reference! source n) ,temp) (MOV L ,temp ,target) ,@(memory-set-type type target)))) @@ -410,12 +474,13 @@ MIT in each case. |# ;; Common case that can be done cheaply: (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) - (BYTE-OFFSET-ADDRESS (OFFSET (REGISTER (? address)) (? offset)) - (? n))) + (ASSIGN (? expression0 rtl:simple-offset?) + (BYTE-OFFSET-ADDRESS (? expression rtl:simple-offset?) + (MACHINE-CONSTANT (? n)))) + (QUALIFIER (equal? expression0 expression)) (if (zero? n) (LAP) - (let ((target (indirect-reference! address offset))) + (let ((target (offset->reference! expression))) (cond ((<= 1 n 8) (LAP (ADDQ L (& ,n) ,target))) ((<= -8 n -1) @@ -428,31 +493,36 @@ MIT in each case. |# (LAP (ADD L (& ,n) ,target))))))) (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (? expression rtl:simple-offset?) (CONS-POINTER (MACHINE-CONSTANT (? type)) (ENTRY:PROCEDURE (? label)))) (let ((temp (reference-temporary-register! 'ADDRESS)) - (target (indirect-reference! address offset))) + (target (offset->reference! expression))) (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label))) ,temp) (MOV L ,temp ,target) ,@(memory-set-type type target)))) -(define-rule statement - (ASSIGN (OFFSET (REGISTER (? a0)) (? n0)) - (OFFSET (REGISTER (? a1)) (? n1))) - (if (and (= a0 a1) (= n0 n1)) - (LAP) - (let ((source (indirect-reference! a1 n1))) - (LAP (MOV L ,source ,(indirect-reference! a0 n0)))))) +#| +;; This is no better than assigning to a register and then assigning +;; from the register (define-rule statement - (ASSIGN (OFFSET (REGISTER (? a)) (? n)) + (ASSIGN (? expression rtl:simple-offset?) (FIXNUM->OBJECT (REGISTER (? source)))) - (let ((target (indirect-reference! a n))) + (let ((target (offset->reference! expression))) (let ((temporary (standard-move-to-temporary! source 'DATA))) (LAP ,@(fixnum->object temporary) (MOV L ,temporary ,target))))) +|# + +(define-rule statement + (ASSIGN (? expression0 rtl:simple-offset?) + (? expression1 rtl:simple-offset?)) + (if (equal? expression0 expression1) + (LAP) + (LAP (MOV L ,(offset->reference! expression1) + ,(offset->reference! expression0))))) ;;;; Consing @@ -472,8 +542,13 @@ MIT in each case. |# (LAP (MOV L ,(standard-register-reference r false true) (@A+ 5)))) (define-rule statement - (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (OFFSET (REGISTER (? r)) (? n))) - (LAP (MOV L ,(indirect-reference! r n) (@A+ 5)))) + (ASSIGN (POST-INCREMENT (REGISTER 13) 1) + (? expression rtl:simple-offset?)) + (LAP (MOV L ,(offset->reference! expression) (@A+ 5)))) + +#| +;; This is no better than assigning to a register and then assigning +;; from the register (define-rule statement (ASSIGN (POST-INCREMENT (REGISTER 13) 1) @@ -481,6 +556,7 @@ MIT in each case. |# (let ((temporary (standard-move-to-temporary! r 'DATA))) (LAP ,@(fixnum->object temporary) (MOV L ,temporary (@A+ 5))))) +|# (define-rule statement ;; This pops the top of stack into the heap @@ -527,20 +603,27 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (OFFSET-ADDRESS (REGISTER (? r)) (? n)))) + (OFFSET-ADDRESS (REGISTER (? r)) + (MACHINE-CONSTANT (? n))))) (LAP (PEA ,(indirect-reference! r n)) ,@(memory-set-type type (INST-EA (@A 7))))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (BYTE-OFFSET-ADDRESS (REGISTER (? r)) (? n)))) + (BYTE-OFFSET-ADDRESS (REGISTER (? r)) + (MACHINE-CONSTANT (? n))))) (LAP (PEA ,(indirect-byte-reference! r n)) ,@(memory-set-type type (INST-EA (@A 7))))) (define-rule statement - (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n))) - (LAP (MOV L ,(indirect-reference! r n) (@-A 7)))) + (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) + (? expression rtl:simple-offset?)) + (LAP (MOV L ,(offset->reference! expression) (@-A 7)))) + +#| +;; This is no better than assigning to a register and then assigning +;; from the register (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) @@ -548,6 +631,7 @@ MIT in each case. |# (let ((temporary (standard-move-to-temporary! r 'DATA))) (LAP ,@(fixnum->object temporary) (MOV L ,temporary (@-A 7))))) +|# ;;;; Fixnum Operations @@ -653,21 +737,21 @@ MIT in each case. |# (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM (OBJECT->FIXNUM (CONSTANT 4)) - (OBJECT->FIXNUM (OFFSET (REGISTER (? r)) (? n))) + (OBJECT->FIXNUM (? expression rtl:simple-offset?)) (? overflow?))) (QUALIFIER (machine-operation-target? target)) overflow? ; ignored - (convert-index->fixnum/offset target r n)) + (convert-index->fixnum/offset target expression)) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM - (OBJECT->FIXNUM (OFFSET (REGISTER (? r)) (? n))) + (OBJECT->FIXNUM (? expression rtl:simple-offset?)) (OBJECT->FIXNUM (CONSTANT 4)) (? overflow?))) (QUALIFIER (machine-operation-target? target)) overflow? ; ignored - (convert-index->fixnum/offset target r n)) + (convert-index->fixnum/offset target expression)) ;;; end (IF (<= SCHEME-TYPE-WIDTH 6) ...) )) @@ -680,8 +764,8 @@ MIT in each case. |# (lambda (target) (LAP (AS L L (& ,(+ scheme-type-width 2)) ,target))))) -(define (convert-index->fixnum/offset target address offset) - (let ((source (indirect-reference! address offset))) +(define (convert-index->fixnum/offset target expression) + (let ((source (offset->reference! expression))) (reuse-and-operate-on-machine-target! 'DATA target (lambda (target) (LAP (MOV L ,source ,target) @@ -698,7 +782,7 @@ MIT in each case. |# (LAP (MOV L (A 5) ,target) (OR L (& ,(make-non-pointer-literal (ucode-type flonum) 0)) ,target) ,@(load-non-pointer (ucode-type manifest-nm-vector) - flonum-size + 2 (INST-EA (@A+ 5))) (FMOVE D ,source (@A+ 5)))))) @@ -706,12 +790,11 @@ MIT in each case. |# (ASSIGN (REGISTER (? target)) (OBJECT->FLOAT (REGISTER (? source)))) (let ((source (standard-move-to-temporary! source 'DATA)) (temp (allocate-temporary-register! 'ADDRESS))) - (delete-dead-registers!) (LAP ,@(object->address source) (MOV L ,source ,(register-reference temp)) (FMOVE D ,(offset-reference temp 1) - ,(reference-target-alias! target 'FLOAT))))) + ,(target-float-reference target))))) (define-rule statement (ASSIGN (? target) @@ -757,56 +840,80 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) - (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset)))) + (CHAR->ASCII (REGISTER (? source)))) (load-char-into-register 0 - (indirect-char/ascii-reference! address offset) + (reference-alias-register! source 'DATA) target)) (define-rule statement (ASSIGN (REGISTER (? target)) - (CHAR->ASCII (REGISTER (? source)))) + (CHAR->ASCII (? expression rtl:simple-offset?))) (load-char-into-register 0 - (reference-alias-register! source 'DATA) + (offset->reference!/char expression) target)) (define-rule statement (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET (REGISTER (? address)) (? offset))) + (? expression rtl:simple-byte-offset?)) (load-char-into-register 0 - (indirect-byte-reference! address offset) + (byte-offset->reference! expression) target)) (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (MACHINE-CONSTANT (? type)) - (BYTE-OFFSET (REGISTER (? address)) (? offset)))) + (? expression rtl:simple-byte-offset?))) (load-char-into-register type - (indirect-byte-reference! address offset) + (byte-offset->reference! expression) target)) (define-rule statement - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) - (CHAR->ASCII (CONSTANT (? character)))) - (LAP (MOV B - (& ,(char->signed-8-bit-immediate character)) - ,(indirect-byte-reference! address offset)))) + (ASSIGN (? expression rtl:simple-byte-offset?) + (REGISTER (? source))) + (LAP (MOV B ,(coerce->any/byte-reference source) + ,(byte-offset->reference! expression)))) (define-rule statement - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) - (REGISTER (? source))) - (let ((source (coerce->any/byte-reference source))) - (let ((target (indirect-byte-reference! address offset))) - (LAP (MOV B ,source ,target))))) + (ASSIGN (? expression rtl:simple-byte-offset?) + (CHAR->ASCII (CONSTANT (? character)))) + (LAP (MOV B (& ,(char->signed-8-bit-immediate character)) + ,(byte-offset->reference! expression)))) (define-rule statement - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (? expression rtl:simple-byte-offset?) (CHAR->ASCII (REGISTER (? source)))) - (let ((source (coerce->any/byte-reference source))) - (let ((target (indirect-byte-reference! address offset))) - (LAP (MOV B ,source ,target))))) + (LAP (MOV B ,(coerce->any/byte-reference source) + ,(byte-offset->reference! expression)))) (define-rule statement - (ASSIGN (BYTE-OFFSET (REGISTER (? target)) (? target-offset)) - (CHAR->ASCII (OFFSET (REGISTER (? source)) (? source-offset)))) - (let ((source (indirect-char/ascii-reference! source source-offset))) - (LAP (MOV B ,source ,(indirect-byte-reference! target target-offset))))) \ No newline at end of file + (ASSIGN (? expression0 rtl:simple-byte-offset?) + (CHAR->ASCII (? expression1 rtl:simple-offset?))) + (LAP (MOV B ,(offset->reference!/char expression1) + ,(byte-offset->reference! expression0)))) + +(define-rule statement + (ASSIGN (? expression0 rtl:simple-byte-offset?) + (? expression1 rtl:simple-byte-offset?)) + (LAP (MOV B ,(byte-offset->reference! expression1) + ,(byte-offset->reference! expression0)))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (? expression rtl:simple-float-offset?)) + (let ((ea (float-offset->reference! expression))) + (LAP (FMOVE D ,ea ,(target-float-reference target))))) + +(define-rule statement + (ASSIGN (? expression rtl:simple-float-offset?) + (REGISTER (? source))) + (LAP (FMOVE D ,(source-float-reference source) + ,(float-offset->reference! expression)))) + +(define (target-float-reference target) + (delete-dead-registers!) + (reference-target-alias! target 'FLOAT)) + +(define (source-float-reference source) + (register-reference + (or (register-alias source 'FLOAT) + (allocate-alias-register! source 'FLOAT)))) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm index 1a88e9578..6de191290 100644 --- a/v7/src/compiler/machines/bobcat/rules2.scm +++ b/v7/src/compiler/machines/bobcat/rules2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.13 1992/07/05 14:20:58 jinx Exp $ +$Id: rules2.scm,v 4.14 1993/07/06 00:56:28 gjr Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -38,17 +38,18 @@ MIT in each case. |# (declare (usual-integrations)) (define (predicate/memory-operand? expression) - (or (and (rtl:offset? expression) - (rtl:register? (rtl:offset-base expression))) + (or (rtl:simple-offset? expression) (and (rtl:post-increment? expression) (interpreter-stack-pointer? (rtl:post-increment-register expression))))) (define (predicate/memory-operand-reference expression) (case (rtl:expression-type expression) - ((OFFSET) (offset->indirect-reference! expression)) + ((OFFSET) + (offset->reference! expression)) ((POST-INCREMENT) (INST-EA (@A+ 7))) - (else (error "Illegal memory operand" expression)))) + (else + (error "Illegal memory operand" expression)))) (define (compare/register*register register-1 register-2 cc) (let ((finish @@ -125,10 +126,10 @@ MIT in each case. |# type)))))) (define-rule predicate - (TYPE-TEST (OBJECT->TYPE (OFFSET (REGISTER (? address)) (? offset))) + (TYPE-TEST (OBJECT->TYPE (? expression rtl:simple-offset?)) (? type)) (set-standard-branches! 'EQ) - (let ((source (indirect-reference! address offset))) + (let ((source (offset->reference! expression))) (cond ((= scheme-type-width 8) (test-byte type source)) ((and (zero? type) use-68020-instructions?) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 0e205db94..155190c66 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rules3.scm,v 4.38 1993/02/19 17:48:51 cph Exp $ +$Id: rules3.scm,v 4.39 1993/07/06 00:56:29 gjr Exp $ -Copyright (c) 1988-93 Massachusetts Institute of Technology +Copyright (c) 1988-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -233,8 +233,10 @@ MIT in each case. |# ,@(generate/move-frame-up* frame-size temp)))) (define-rule statement - (INVOCATION-PREFIX:MOVE-FRAME-UP (? frame-size) - (OFFSET-ADDRESS (REGISTER 15) (? offset))) + (INVOCATION-PREFIX:MOVE-FRAME-UP + (? frame-size) + (OFFSET-ADDRESS (REGISTER 15) + (MACHINE-CONSTANT (? offset)))) (let ((how-far (- offset frame-size))) (cond ((zero? how-far) (LAP)) @@ -257,9 +259,10 @@ MIT in each case. |# (generate/move-frame-up frame-size (offset-reference a7 offset)))))) (define-rule statement - (INVOCATION-PREFIX:MOVE-FRAME-UP (? frame-size) - (OFFSET-ADDRESS (REGISTER (? base)) - (? offset))) + (INVOCATION-PREFIX:MOVE-FRAME-UP + (? frame-size) + (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? offset)))) (generate/move-frame-up frame-size (indirect-reference! base offset))) (define-rule statement @@ -267,10 +270,11 @@ MIT in each case. |# (LAP)) (define-rule statement - (INVOCATION-PREFIX:DYNAMIC-LINK (? frame-size) - (OFFSET-ADDRESS (REGISTER (? base)) - (? offset)) - (REGISTER 12)) + (INVOCATION-PREFIX:DYNAMIC-LINK + (? frame-size) + (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? offset))) + (REGISTER 12)) (let ((label (generate-label)) (temp (allocate-temporary-register! 'ADDRESS))) (let ((temp-ref (register-reference temp))) @@ -816,6 +820,67 @@ long-word aligned and there is no need for shuffling. ,@(make-external-label (continuation-code-word false) (generate-label))))) +(define (generate/remote-links n-code-blocks code-blocks-label n-sections) + (if (= n-code-blocks 0) + (LAP) + (let ((loop (generate-label)) + (bytes (generate-label))) + (LAP (CLR L (D 0)) + ;; Set up counter + (MOV L (D 0) (@-A 7)) + (BRA (@PCR ,loop)) + (LABEL ,bytes) + ,@(sections->bytes n-code-blocks n-sections) + (LABEL ,loop) + ;; Increment counter for next iteration + (ADDQ L (& 1) (@A 7)) + ;; Get subblock + (MOV L (@PCR ,code-blocks-label) (D 2)) + (AND L (D 7) (D 2)) + (MOV L (D 2) (A 0)) + (MOV L (@AOXS 0 4 ((D 0) L 4)) (D 2)) + ;; Get number of linkage sections + (CLR L (D 4)) + (MOV B (@PCRXS ,bytes ((D 0) L 1)) (D 4)) + ;; block -> address + (AND L (D 7) (D 2)) + (MOV L (D 2) (A 0)) + ;; Get length and non-marked length + (MOV L (@A 0) (D 3)) + (MOV L (@AO 0 4) (D 5)) + ;; Strip type tags + (AND L (D 7) (D 3)) + (AND L (D 7) (D 5)) + ;; Store environment + (MOV L ,reg:environment (@AOXS 0 0 ((D 3) L 4))) + ;; Address of first constant (linkage area) + (LEA (@AOXS 0 8 ((D 5) L 4)) (A 1)) + (MOV L (A 1) (D 3)) + (JSR ,entry:compiler-link) + ,@(make-external-label (continuation-code-word false) + (generate-label)) + ;; Counter value + (MOV L (@A 7) (D 0)) + ;; Exit loop if we've done all + (CMP L (& ,n-code-blocks) (D 0)) + (B NE (@PCR ,loop)) + ;; Pop counter off the stack + (ADDQ L (& 4) (A 7)))))) + +(define (sections->bytes n-code-blocks n-sections) + (let walk ((bytes + (append (vector->list n-sections) + (let ((left (remainder n-code-blocks 2))) + (if (zero? left) + '() + (make-list (- 2 left) 0)))))) + (if (null? bytes) + (LAP) + (let ((hi (car bytes)) + (lo (cadr bytes))) + (LAP (DC UW ,(+ lo (* 256 hi))) + ,@(walk (cddr bytes))))))) + (define (generate/constants-block constants references assignments uuo-links global-links static-vars) (let ((constant-info diff --git a/v7/src/compiler/machines/bobcat/rules4.scm b/v7/src/compiler/machines/bobcat/rules4.scm index 79f3d8514..78f2e3cf9 100644 --- a/v7/src/compiler/machines/bobcat/rules4.scm +++ b/v7/src/compiler/machines/bobcat/rules4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rules4.scm,v 4.13 1992/11/09 18:46:07 jinx Exp $ +$Id: rules4.scm,v 4.14 1993/07/06 00:56:31 gjr Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -89,8 +89,7 @@ MIT in each case. |# (and (rtl:cons-pointer? expression) (rtl:machine-constant? (rtl:cons-pointer-type expression)) (rtl:machine-constant? (rtl:cons-pointer-datum expression))) - (and (rtl:offset? expression) - (rtl:register? (rtl:offset-base expression))))) + (rtl:simple-offset? expression))) (define (interpreter-call-argument->machine-register! expression register) (let ((target (register-reference register))) @@ -108,7 +107,7 @@ MIT in each case. |# (rtl:cons-pointer-datum expression)) target))) ((OFFSET) - (let ((source-reference (offset->indirect-reference! expression))) + (let ((source-reference (offset->reference! expression))) (LAP ,@(clear-registers! register) (MOV L ,source-reference ,target)))) (else diff --git a/v7/src/compiler/machines/bobcat/rulrew.scm b/v7/src/compiler/machines/bobcat/rulrew.scm index 995917318..c42f88fa7 100644 --- a/v7/src/compiler/machines/bobcat/rulrew.scm +++ b/v7/src/compiler/machines/bobcat/rulrew.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rulrew.scm,v 1.5 1992/03/31 19:50:01 jinx Exp $ +$Id: rulrew.scm,v 1.6 1993/07/06 00:56:32 gjr Exp $ -Copyright (c) 1990-91 Massachusetts Institute of Technology +Copyright (c) 1990-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -193,7 +193,11 @@ MIT in each case. |# (? operand-1) (REGISTER (? operand-2 register-known-value)) (? overflow?)) - (QUALIFIER (rtl:constant-fixnum-test operand-2 (lambda (n) true))) + (QUALIFIER + (rtl:constant-fixnum-test operand-2 + (lambda (n) + n ; ignored + true))) (rtl:make-fixnum-2-args 'FIXNUM-LSH operand-1 operand-2 overflow?)) (define (rtl:constant-fixnum? expression) @@ -206,4 +210,55 @@ MIT in each case. |# (and (rtl:constant? expression) (let ((n (rtl:constant-value expression))) (and (fix:fixnum? n) - (predicate n))))))) \ No newline at end of file + (predicate n))))))) + +;;;; Indexed addressing modes + +(define-rule rewriting + (OFFSET (REGISTER (? base register-known-value)) + (MACHINE-CONSTANT (? value))) + (QUALIFIER (and (rtl:offset-address? base) + (rtl:simple-subexpressions? base))) + (rtl:make-offset base (rtl:make-machine-constant value))) + +(define-rule rewriting + (BYTE-OFFSET (REGISTER (? base register-known-value)) + (MACHINE-CONSTANT (? value))) + (QUALIFIER (and (rtl:byte-offset-address? base) + (rtl:simple-subexpressions? base))) + (rtl:make-byte-offset base (rtl:make-machine-constant value))) + +(define-rule rewriting + (FLOAT-OFFSET (REGISTER (? base register-known-value)) + (MACHINE-CONSTANT (? value))) + (QUALIFIER (and (rtl:float-offset-address? base) + (rtl:simple-subexpressions? base))) + (if (zero? value) + (rtl:make-float-offset + (rtl:float-offset-address-base base) + (rtl:float-offset-address-offset base)) + (rtl:make-float-offset base (rtl:make-machine-constant value)))) + +(define-rule rewriting + (FLOAT-OFFSET (REGISTER (? base register-known-value)) + (MACHINE-CONSTANT (? value))) + (QUALIFIER + (and (rtl:offset-address? base) + (rtl:simple-subexpressions? base) + (rtl:machine-constant? (rtl:offset-address-offset base)))) + (rtl:make-float-offset base (rtl:make-machine-constant value))) + +;; This is here to avoid generating things like +;; +;; (offset (offset-address (object->address (constant #(foo bar baz gack))) +;; (register 29)) +;; (machine-constant 1)) +;; +;; since the offset-address subexpression is constant, and therefore +;; known! + +(define (rtl:simple-subexpressions? expr) + (for-all? (cdr expr) + (lambda (sub) + (or (rtl:machine-constant? sub) + (rtl:register? sub))))) \ No newline at end of file -- 2.25.1