From: Brian A. LaMacchia Date: Tue, 5 Jan 1988 15:59:31 +0000 (+0000) Subject: Initial check-in for compiler version 4 X-Git-Tag: 20090517-FFI~12941 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c6fb6f6ffca394293849c174afe936b55e5796e3;p=mit-scheme.git Initial check-in for compiler version 4 --- diff --git a/v7/src/compiler/machines/vax/rules1.scm b/v7/src/compiler/machines/vax/rules1.scm index f6c9fed57..652b2408b 100644 --- a/v7/src/compiler/machines/vax/rules1.scm +++ b/v7/src/compiler/machines/vax/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules1.scm,v 1.0 1988/01/05 15:58:25 bal Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules1.scm,v 4.1 1988/01/05 15:59:05 bal Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; VAX LAP Generation Rules: Data Transfers -;;; Matches MC68020 version 1.6 +;;; Matches MC68020 version 4.2 (declare (usual-integrations)) @@ -45,14 +45,9 @@ MIT in each case. |# ;;; dead registers, and thus would be flushed if the deletions ;;; happened after the assignment. -(define-rule statement - (ASSIGN (REGISTER 10) (REGISTER 14)) - (enable-frame-pointer-offset! 0) - (LAP)) - (define-rule statement (ASSIGN (REGISTER 14) (OFFSET-ADDRESS (REGISTER 14) (? n))) - (decrement-frame-pointer-offset! n (increment-rnl 14 n))) + (increment-rnl 14 n)) (define-rule statement (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER 14) (? n))) @@ -65,8 +60,7 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER 14) (REGISTER (? source))) - (disable-frame-pointer-offset! - (LAP (MOV L ,(coerce->any source) (R 14))))) + (LAP (MOV L ,(coerce->any source) (R 14)))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONSTANT (? source))) @@ -117,7 +111,6 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 14) 1)) (QUALIFIER (pseudo-register? target)) - (record-pop!) (delete-dead-registers!) (LAP (MOV L (@R+ 14) @@ -162,7 +155,6 @@ MIT in each case. |# (define-rule statement (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (POST-INCREMENT (REGISTER 14) 1)) - (record-pop!) (LAP (MOV L (@R+ 14) ,(indirect-reference! a n)))) @@ -188,6 +180,11 @@ MIT in each case. |# (ASSIGN (POST-INCREMENT (REGISTER 12) 1) (CONSTANT (? object))) (LAP ,(load-constant object (INST-EA (@R+ 12))))) +(define-rule statement + (ASSIGN (POST-INCREMENT (REGISTER 12) 1) + (CONS-POINTER (CONSTANT (? type)) (CONSTANT (? datum)))) + (LAP ,(load-non-pointer type datum (INST-EA (@R+ 12))))) + (define-rule statement (ASSIGN (POST-INCREMENT (REGISTER 12) 1) (UNASSIGNED)) (LAP ,(load-non-pointer (ucode-type unassigned) 0 (INST-EA (@R+ 12))))) @@ -202,7 +199,7 @@ MIT in each case. |# (define-rule statement (ASSIGN (POST-INCREMENT (REGISTER 12) 1) (ENTRY:PROCEDURE (? label))) - (LAP (MOVA B (@PCR ,(procedure-external-label (label->procedure label))) + (LAP (MOVA B (@PCR ,(rtl-procedure/external-label (label->object label))) (@R+ 12)) (MOV B ,(immediate-type (ucode-type compiled-expression)) (@RO B 12 -1)))) @@ -211,49 +208,28 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (CONSTANT (? object))) - (record-push! - (LAP ,(push-constant object)))) + (LAP ,(push-constant object))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (UNASSIGNED)) - (record-push! - (LAP ,(push-non-pointer (ucode-type unassigned) 0)))) + (LAP ,(push-non-pointer (ucode-type unassigned) 0))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (REGISTER (? r))) - (record-push! - (if (= r regnum:frame-pointer) - (LAP (PUSHA L ,(offset-reference regnum:stack-pointer - (frame-pointer-offset))) - (MOV B ,(immediate-type (ucode-type stack-environment)) - (@RO B 14 3))) - (LAP (PUSHL ,(coerce->any r)))))) + (LAP (PUSHL ,(coerce->any r)))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r)))) - (record-push! - (LAP (PUSHL ,(coerce->any r)) - (MOV B ,(immediate-type type) (@RO B 14 3))))) + (LAP (PUSHL ,(coerce->any r)) + (MOV B ,(immediate-type type) (@RO B 14 3)))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (OFFSET (REGISTER (? r)) (? n))) - (record-push! - (LAP (PUSHL ,(indirect-reference! r n))))) - -(define-rule statement - (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) - (OFFSET-ADDRESS (REGISTER 10) (? n))) - (record-push! - (LAP (PUSHA L ,(offset-reference regnum:stack-pointer - (+ n (frame-pointer-offset)))) - (MOV B ,(immediate-type (ucode-type stack-environment)) - (@RO B 14 3))))) + (LAP (PUSHL ,(indirect-reference! r n)))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 14) -1) (ENTRY:CONTINUATION (? label))) - (record-continuation-frame-pointer-offset! label) - (record-push! - (LAP (PUSHA B (@PCR ,label)) - (MOV B ,(immediate-type (ucode-type compiler-return-address)) - (@RO B 14 3))))) + (LAP (PUSHA B (@PCR ,label)) + (MOV B ,(immediate-type (ucode-type compiler-return-address)) + (@RO B 14 3)))) diff --git a/v7/src/compiler/machines/vax/rules2.scm b/v7/src/compiler/machines/vax/rules2.scm index 0b87e7bbe..1a2cdb551 100644 --- a/v7/src/compiler/machines/vax/rules2.scm +++ b/v7/src/compiler/machines/vax/rules2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules2.scm,v 1.0 1988/01/05 15:58:40 bal Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules2.scm,v 4.1 1988/01/05 15:59:31 bal Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; VAX LAP Generation Rules: Predicates -;;; Matches MC68020 version 1.3 +;;; Matches MC68020 version 4.2 (declare (usual-integrations)) @@ -70,6 +70,13 @@ MIT in each case. |# (LAP (ROTL (S 8) ,source ,reference) ,(test-byte type reference))))) +(define-rule predicate + (TYPE-TEST (OBJECT->TYPE (OFFSET (REGISTER (? register)) (? offset))) + (? type)) + (set-standard-branches! 'EQLU) + (LAP ,(test-non-pointer (ucode-type unassigned) 0 + (coerce->any register)))) + (define-rule predicate (UNASSIGNED-TEST (REGISTER (? register))) (set-standard-branches! 'EQLU) @@ -172,15 +179,13 @@ MIT in each case. |# (define-rule predicate (EQ-TEST (POST-INCREMENT (REGISTER 14) 1) (REGISTER (? register))) - (record-pop!) (eq-test/register*memory register (INST-EA (@R+ 14)))) (define-rule predicate (EQ-TEST (REGISTER (? register)) (POST-INCREMENT (REGISTER 14) 1)) - (record-pop!) (eq-test/register*memory register (INST-EA (@R+ 14)))) (define-rule predicate (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1)) (OFFSET (REGISTER (? register-2)) (? offset-2))) - (eq-test/memory*memory register-1 offset-1 register-2 offset-2)) \ No newline at end of file + (eq-test/memory*memory register-1 offset-1 register-2 offset-2))