From 152d146681f419ed1d3cfa9c1711bc1bd3ed2c63 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 15 Oct 1992 16:31:54 +0000 Subject: [PATCH] Update interrupt-check to avoid generating stack checks when entering continuations and leaf procedures. --- v7/src/compiler/machines/i386/rules3.scm | 16 ++++++++++------ v7/src/compiler/machines/vax/rules3.scm | 16 ++++++++++------ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 0e181448d..6202dcd3c 100644 --- a/v7/src/compiler/machines/i386/rules3.scm +++ b/v7/src/compiler/machines/i386/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.23 1992/08/05 21:32:27 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.24 1992/10/15 16:28:14 jinx Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -385,10 +385,14 @@ MIT in each case. |# ;;; interrupt handler that saves and restores the dynamic link ;;; register. -(define (interrupt-check interrupt-label) +(define (interrupt-check procedure-label interrupt-label) + ;; This always does interrupt checks in line. (LAP (CMP W (R ,regnum:free-pointer) ,reg:compiled-memtop) (JGE (@PCR ,interrupt-label)) - ,@(if compiler:generate-stack-checks? + ,@(if (let ((object (label->object procedure-label))) + (and (rtl-procedure? object) + (not (rtl-procedure/stack-leaf? object)) + compiler:generate-stack-checks?)) (LAP (CMP W (R ,regnum:stack-pointer) ,reg:stack-guard) (JL (@PCR ,interrupt-label))) (LAP)))) @@ -398,7 +402,7 @@ MIT in each case. |# (LAP (LABEL ,gc-label) ,@(invoke-hook/call entry) ,@(make-external-label code-word label) - ,@(interrupt-check gc-label)))) + ,@(interrupt-check label gc-label)))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -421,7 +425,7 @@ MIT in each case. |# (LABEL ,gc-label) ,@(invoke-interface/call code:compiler-interrupt-ic-procedure) ,@(make-external-label expression-code-word internal-label) - ,@(interrupt-check gc-label))))) + ,@(interrupt-check internal-label gc-label))))) (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) @@ -539,7 +543,7 @@ MIT in each case. |# (ADD W (@R ,esp) (&U ,(generate/make-magic-closure-constant entry))) (LABEL ,internal-label) - ,@(interrupt-check gc-label)))))) + ,@(interrupt-check internal-label gc-label)))))) (define (generate/make-magic-closure-constant entry) (- (make-non-pointer-literal (ucode-type compiled-entry) 0) diff --git a/v7/src/compiler/machines/vax/rules3.scm b/v7/src/compiler/machines/vax/rules3.scm index 1471281bc..f1cf40d91 100644 --- a/v7/src/compiler/machines/vax/rules3.scm +++ b/v7/src/compiler/machines/vax/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules3.scm,v 4.10 1992/08/05 21:40:15 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules3.scm,v 4.11 1992/10/15 16:31:54 jinx Exp $ Copyright (c) 1987-1992 Massachusetts Institute of Technology @@ -392,10 +392,14 @@ MIT in each case. |# ;;; interrupt handler that saves and restores the dynamic link ;;; register. -(define (interrupt-check interrupt-label) +(define (interrupt-check procedure-label interrupt-label) + ;; This always does interrupt/stack checks in line. (LAP (CMP L (R ,regnum:free-pointer) ,reg:compiled-memtop) (B B GEQ (@PCR ,interrupt-label)) - ,@(if compiler:generate-stack-checks? + ,@(if (let ((object (label->object procedure-label))) + (and (rtl-procedure? object) + (not (rtl-procedure/stack-leaf? object)) + compiler:generate-stack-checks?)) (LAP (CMP L (R ,regnum:stack-pointer) ,reg:stack-guard) (B B LSS (@PCR ,interrupt-label))) (LAP)))) @@ -410,7 +414,7 @@ MIT in each case. |# |# ,@(invoke-interface-jsb code:compiler-interrupt) ,@(make-external-label code-word label) - ,@(interrupt-check gc-label)))) + ,@(interrupt-check label gc-label)))) (define (dlink-procedure-header code-word label) (let ((gc-label (generate-label))) @@ -422,7 +426,7 @@ MIT in each case. |# ,@(invoke-interface-jsb code:compiler-interrupt-dlink) ;; 'Til here ,@(make-external-label code-word label) - ,@(interrupt-check gc-label)))) + ,@(interrupt-check label gc-label)))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -503,7 +507,7 @@ MIT in each case. |# external-label) (ADD L (&U ,(make-magic-closure-constant entry)) (@R 14)) (LABEL ,internal-label) - ,@(interrupt-check gc-label)))))) + ,@(interrupt-check internal-label gc-label)))))) (define-rule statement (ASSIGN (REGISTER (? target)) -- 2.25.1