From e2c34f7b1fbbe335d7aae209cce3b1336294e54d Mon Sep 17 00:00:00 2001 From: "Brian A. LaMacchia" <edu/mit/csail/zurich/bal> Date: Tue, 5 Jan 1988 22:25:13 +0000 Subject: [PATCH] Initial check-in for version 4 compiler --- v7/src/compiler/machines/vax/rules4.scm | 69 +++++-------------------- 1 file changed, 12 insertions(+), 57 deletions(-) diff --git a/v7/src/compiler/machines/vax/rules4.scm b/v7/src/compiler/machines/vax/rules4.scm index 9de145f2f..25e033df2 100644 --- a/v7/src/compiler/machines/vax/rules4.scm +++ b/v7/src/compiler/machines/vax/rules4.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules4.scm,v 1.0 1988/01/05 22:24:49 bal Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules4.scm,v 4.1 1988/01/05 22:25:13 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: Interpreter Calls -;;; Matches MC68020 version 1.4 +;;; Matches MC68020 version 4.2 (declare (usual-integrations)) @@ -67,18 +67,16 @@ MIT in each case. |# (define-rule statement (INTERPRETER-CALL:ENCLOSE (? number-pushed)) - (decrement-frame-pointer-offset! - number-pushed - (LAP (MOV L (R 12) ,reg:enclose-result) - (MOV B ,(immediate-type (ucode-type vector)) ,reg:enclose-result-type) - ,(load-non-pointer (ucode-type manifest-vector) number-pushed - (INST-EA (@R+ 12))) - - ,@(generate-n-times - number-pushed 5 - (lambda () (INST (MOV L (@R+ 14) (@R+ 12)))) - (lambda (generator) - (generator (allocate-temporary-register! 'GENERAL))))))) + (LAP (MOV L (R 12) ,reg:enclose-result) + (MOV B ,(immediate-type (ucode-type vector)) ,reg:enclose-result-type) + ,(load-non-pointer (ucode-type manifest-vector) number-pushed + (INST-EA (@R+ 12))) + + ,@(generate-n-times + number-pushed 5 + (lambda () (INST (MOV L (@R+ 14) (@R+ 12)))) + (lambda (generator) + (generator (allocate-temporary-register! 'GENERAL)))))) (define-rule statement (INTERPRETER-CALL:DEFINE (? environment) (? name) (? value)) @@ -178,47 +176,4 @@ MIT in each case. |# ,@clear-map (JSB ,entry:compiler-unassigned?-trap) ,@(make-external-label (generate-label)))))) - -;;;; Poppers - -(define-rule statement - (MESSAGE-RECEIVER:CLOSURE (? frame-size)) - (record-push! - (LAP (PUSHL (& ,(* frame-size 4)))))) - -(define-rule statement - (MESSAGE-RECEIVER:STACK (? frame-size)) - (record-push! - (LAP (PUSHL (& ,(+ #x00180000 (* frame-size 4))))))) - -(define-rule statement - (MESSAGE-RECEIVER:SUBPROBLEM (? label)) - (record-continuation-frame-pointer-offset! label) - (increment-frame-pointer-offset! - 2 - (LAP (PUSHA B (@PCR ,label)) - (MOV B ,(immediate-type type-code:return-address) (@RO B 14 3)) - (PUSHL (& #x00300000))))) - -(define (apply-closure-sequence frame-size receiver-offset label) - (let ((offset (* (+ receiver-offset (frame-pointer-offset)) 4))) - (LAP ,(load-rnw frame-size 2) - (MOVA L (@RO ,(offset-type offset) 14 ,offset) (R 0)) - (MOVA B (@PCR ,label) (R 1)) - (JMP ,popper:apply-closure)))) - -(define (apply-stack-sequence frame-size receiver-offset n-levels label) - (let ((offset (* (+ receiver-offset (frame-pointer-offset)) 4))) - (LAP (MOV L (S ,n-levels) (R 3)) - ,(load-rnw frame-size 2) - (MOVA L (@RO ,(offset-type offset) 14 ,offset) - (R 0)) - (MOVA B (@PCR ,label) (R 1)) - (JMP ,popper:apply-stack)))) -(define-rule statement - (MESSAGE-SENDER:VALUE (? receiver-offset)) - (disable-frame-pointer-offset! - (LAP ,@(clear-map!) - ,@(increment-rnl 14 (+ receiver-offset (frame-pointer-offset))) - (JMP ,popper:value)))) \ No newline at end of file -- 2.25.1