From ef18c58c01f116868e4bc1d7bc2660466f90d429 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 25 Sep 1992 01:19:13 +0000 Subject: [PATCH] Implement close-coded stack and interrupt check. --- v7/src/compiler/machines/bobcat/dassm2.scm | 9 ++- v7/src/compiler/machines/bobcat/lapgen.scm | 15 +++-- v7/src/compiler/machines/bobcat/rules3.scm | 69 ++++++++++++--------- v7/src/microcode/cmpauxmd/mc68k.m4 | 70 +++++++++++++++++++++- v7/src/microcode/cmpintmd/mc68k.h | 28 +++++---- 5 files changed, 141 insertions(+), 50 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/dassm2.scm b/v7/src/compiler/machines/bobcat/dassm2.scm index 2efb0dfa6..fd31a7546 100644 --- a/v7/src/compiler/machines/bobcat/dassm2.scm +++ b/v7/src/compiler/machines/bobcat/dassm2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.19 1992/08/11 02:25:29 jinx Exp $ +$Id: dassm2.scm,v 4.20 1992/09/25 01:17:58 cph Exp $ Copyright (c) 1988-1992 Massachusetts Institute of Technology @@ -338,7 +338,12 @@ MIT in each case. |# closure-hook quotient remainder - ;; modulo ; No hook space. + modulo + stack-and-interrupt-check-12 + stack-and-interrupt-check-14 + stack-and-interrupt-check-18 + stack-and-interrupt-check-22 + stack-and-interrupt-check-24 )) ;; Compiled code temporaries ,@(let loop ((i 0) (index first-temp)) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index ff15d54f5..e2a7bab47 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.45 1992/07/29 22:04:20 cph Exp $ +$Id: lapgen.scm,v 4.46 1992/09/25 01:18:08 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -1138,11 +1138,16 @@ MIT in each case. |# closure-hook ; This doesn't have a code: counterpart. quotient remainder - ;; modulo ; We are out of hook space! + modulo + stack-and-interrupt-check-12 ; This doesn't have a code: counterpart. + stack-and-interrupt-check-14 ; This doesn't have a code: counterpart. + stack-and-interrupt-check-18 ; This doesn't have a code: counterpart. + stack-and-interrupt-check-22 ; This doesn't have a code: counterpart. + stack-and-interrupt-check-24 ; This doesn't have a code: counterpart. )) (define-integrable (invoke-interface code) - (LAP ,@(load-dnw code 0) + (LAP (MOVEQ (& ,code) (D 0)) (JMP ,entry:compiler-scheme-to-interface))) #| @@ -1151,12 +1156,12 @@ MIT in each case. |# ;; The others can be handled similarly. (define-integrable (invoke-interface-jsr code) - (LAP ,@(load-dnw code 0) + (LAP (MOVEQ (& ,code) (D 0)) (LEA (@PCO 12) (A 0)) (MOV L (A 0) (D 1)) (JMP ,entry:compiler-scheme-to-interface))) |# (define-integrable (invoke-interface-jsr code) - (LAP ,@(load-dnw code 0) + (LAP (MOVEQ (& ,code) (D 0)) (JSR ,entry:compiler-scheme-to-interface-jsr))) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index e244d4222..4d76f24e8 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.33 1992/07/29 22:04:02 cph Exp $ +$Id: rules3.scm,v 4.34 1992/09/25 01:18:33 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -400,15 +400,21 @@ MIT in each case. |# (LAP (LABEL ,gc-label) (JSR ,entry) ,@(make-external-label code-word label) - ,@(interrupt-check gc-label)))) - -(define (interrupt-check gc-label) - (LAP (CMP L ,reg:compiled-memtop (A 5)) - (B GE B (@PCR ,gc-label)) - ,@(if compiler:generate-stack-checks? - (LAP (CMP L ,reg:stack-guard (A 7)) - (B LE B (@PCR ,gc-label))) - (LAP)))) + ,@(interrupt-check gc-label -12)))) + +(define (interrupt-check gc-label gc-label-offset) + (if (not compiler:generate-stack-checks?) + (LAP (CMP L ,reg:compiled-memtop (A 5)) + (B GE B (@PCR ,gc-label))) + (LAP (JSR + ,(case gc-label-offset + ((-12) entry:compiler-stack-and-interrupt-check-12) + ((-14) entry:compiler-stack-and-interrupt-check-14) + ((-18) entry:compiler-stack-and-interrupt-check-18) + ((-22) entry:compiler-stack-and-interrupt-check-22) + ((-24) entry:compiler-stack-and-interrupt-check-24) + (else (error "Illegal GC label offset:" + gc-label-offset))))))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -431,7 +437,7 @@ MIT in each case. |# (LABEL ,gc-label) ,@(invoke-interface-jsr code:compiler-interrupt-ic-procedure) ,@(make-external-label expression-code-word internal-label) - ,@(interrupt-check gc-label))))) + ,@(interrupt-check gc-label -14))))) (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) @@ -498,21 +504,30 @@ long-word aligned and there is no need for shuffling. (internal-procedure-code-word rtl-proc) internal-label entry:compiler-interrupt-procedure)) - (LAP (LABEL ,gc-label) - ,@(let ((distance (* 10 entry))) - (cond ((zero? distance) - (LAP)) - ((< distance 128) - (LAP (MOVEQ (& ,distance) (D 0)) - (ADD L (D 0) (@A 7)))) - (else - (LAP (ADD L (& ,distance) (@A 7)))))) - (JMP ,entry:compiler-interrupt-closure) - ,@(make-external-label internal-entry-code-word - external-label) - (ADD UL (& ,(MC68020/make-magic-closure-constant entry)) (@A 7)) - (LABEL ,internal-label) - ,@(interrupt-check gc-label)))))) + (with-values + (lambda () + (let ((distance (* 10 entry))) + (cond ((zero? distance) + (values (LAP) + 0)) + ((< distance 128) + (values (LAP (MOVEQ (& ,distance) (D 0)) + (ADD L (D 0) (@A 7))) + 4)) + (else + (values (LAP (ADD L (& ,distance) (@A 7))) + 6))))) + (lambda (adjustment adjustment-size) + (LAP (LABEL ,gc-label) + ,@adjustment + (JMP ,entry:compiler-interrupt-closure) + ,@(make-external-label internal-entry-code-word + external-label) + (ADD UL (& ,(MC68020/make-magic-closure-constant entry)) + (@A 7)) + (LABEL ,internal-label) + ,@(interrupt-check gc-label + (- -18 adjustment-size))))))))) (define (MC68020/cons-closure target procedure-label min max size) (let* ((target (reference-target-alias! target 'ADDRESS)) @@ -593,7 +608,7 @@ long-word aligned and there is no need for shuffling. external-label) (ADD UL (& ,(MC68040/make-magic-closure-constant entry)) (@A 7)) (LABEL ,internal-label) - ,@(interrupt-check gc-label)))))) + ,@(interrupt-check gc-label -18)))))) (define (MC68040/cons-closure target procedure-label min max size) (MC68040/with-allocated-closure target 1 size diff --git a/v7/src/microcode/cmpauxmd/mc68k.m4 b/v7/src/microcode/cmpauxmd/mc68k.m4 index 83d101e5d..001b164be 100644 --- a/v7/src/microcode/cmpauxmd/mc68k.m4 +++ b/v7/src/microcode/cmpauxmd/mc68k.m4 @@ -1,6 +1,6 @@ ### -*-Midas-*- ### -### $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/mc68k.m4,v 1.22 1992/02/11 22:19:55 cph Exp $ +### $Id: mc68k.m4,v 1.23 1992/09/25 01:19:13 cph Exp $ ### ### Copyright (c) 1989-92 Massachusetts Institute of Technology ### @@ -163,7 +163,11 @@ define(COMPARE_TYPE_CODE, ### External conventions - set regblock_val,8 # from const.h (* 4) + set regblock_memtop,0 # from const.h (* 4) + set regblock_int_mask,4 + set regblock_val,8 + set regblock_stack_guard,44 + set regblock_int_code,48 set address_mask,HEX(ADDRESS_MASK) # This must match the compiler (machin.scm) @@ -173,7 +177,7 @@ define(dlink, %a4) # Dynamic link register (contains a define(rfree, %a5) # Free pointer define(regs, %a6) # Pointer to Registers[0] define(rmask, %d7) # Mask to clear type code -define(rval,%d6) +define(rval,%d6) # Procedure value reference_external(Ext_Stack_Pointer) reference_external(Free) @@ -633,3 +637,63 @@ define_generic_unary_predicate(negative,2a,lt) define_generic_binary(add,2b,fadd) define_generic_unary_predicate(positive,2c,gt) define_generic_unary_predicate(zero,2d,eq) + +### Close-coded stack and interrupt check for use when stack checking +### is enabled. + +define_c_label(asm_stack_and_interrupt_check_12) + mov.l &-12,-(%sp) + bra.b stack_and_interrupt_check + +define_c_label(asm_stack_and_interrupt_check_14) + mov.l &-14,-(%sp) + bra.b stack_and_interrupt_check + +define_c_label(asm_stack_and_interrupt_check_18) + mov.l &-18,-(%sp) + bra.b stack_and_interrupt_check + +define_c_label(asm_stack_and_interrupt_check_22) + mov.l &-22,-(%sp) + bra.b stack_and_interrupt_check + +define_c_label(asm_stack_and_interrupt_check_24) + mov.l &-24,-(%sp) +# bra.b stack_and_interrupt_check + +### On entry, 4(%sp) contains the resumption address, and 0(%sp) is +### the offset between the resumption address and the GC label +### address. +define_debugging_label(stack_and_interrupt_check) + +### If the Scheme stack pointer is <= Stack_Guard, then the stack has +### overflowed -- in which case we must signal a stack-overflow interrupt. + cmp.l %sp,regblock_stack_guard(regs) + bgt.b stack_and_interrupt_check_1 + +### Set the stack-overflow interrupt bit. If the stack-overflow +### interrupt is disabled, skip forward to gc test. Otherwise, set +### MemTop to -1 and signal the interrupt. + bset &0,regblock_int_code+3(regs) + btst &0,regblock_int_mask+3(regs) + beq.b stack_and_interrupt_check_1 + mov.l &-1,regblock_memtop(regs) + bra.b stack_and_interrupt_check_2 + +### If (Free >= MemTop), signal an interrupt. +stack_and_interrupt_check_1: + cmp.l rfree,regblock_memtop(regs) + bge.b stack_and_interrupt_check_2 + +### No action necessary -- return to resumption address. + addq.l &4,%sp + rts + +### Must signal the interrupt -- return to GC label instead. +stack_and_interrupt_check_2: + mov.l %d0,-(%sp) + mov.l 4(%sp),%d0 + add.l %d0,8(%sp) + mov.l (%sp),%d0 + addq.l &8,%sp + rts diff --git a/v7/src/microcode/cmpintmd/mc68k.h b/v7/src/microcode/cmpintmd/mc68k.h index 00340477a..44ae5a8e5 100644 --- a/v7/src/microcode/cmpintmd/mc68k.h +++ b/v7/src/microcode/cmpintmd/mc68k.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/mc68k.h,v 1.30 1992/02/12 15:47:58 jinx Exp $ +$Id: mc68k.h,v 1.31 1992/09/25 01:19:03 cph Exp $ Copyright (c) 1989-1992 Massachusetts Institute of Technology @@ -58,10 +58,11 @@ MIT in each case. */ /* Machine parameters to be set by the user. */ -/* Processor type. Choose a number from the above list, or allocate your own. */ +/* Processor type. + Choose a number from the above list, or allocate your own. */ #ifndef COMPILER_PROCESSOR_TYPE -# define COMPILER_PROCESSOR_TYPE COMPILER_MC68020_TYPE +#define COMPILER_PROCESSOR_TYPE COMPILER_MC68040_TYPE #endif /* Size (in long words) of the contents of a floating point register if @@ -471,11 +472,11 @@ do { \ /* This overrides the definition in cmpint.c because the code below depends on knowing it, and is inserted before the definition in - cmpint.c - */ + "cmpint.c". */ #define COMPILER_REGBLOCK_N_FIXED 16 +#define COMPILER_REGBLOCK_START_HOOKS COMPILER_REGBLOCK_N_FIXED #define COMPILER_REGBLOCK_N_HOOKS 80 #define COMPILER_HOOK_SIZE 2 /* absolute jsr instruction */ @@ -483,11 +484,11 @@ do { \ (COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE) #define A6_TRAMPOLINE_TO_INTERFACE_OFFSET \ - ((COMPILER_REGBLOCK_N_FIXED + (2 * COMPILER_HOOK_SIZE)) * \ + ((COMPILER_REGBLOCK_START_HOOKS + (2 * COMPILER_HOOK_SIZE)) * \ (sizeof (SCHEME_OBJECT))) #define A6_CLOSURE_HOOK_OFFSET \ - ((COMPILER_REGBLOCK_N_FIXED + (37 * COMPILER_HOOK_SIZE)) * \ + ((COMPILER_REGBLOCK_START_HOOKS + (37 * COMPILER_HOOK_SIZE)) * \ (sizeof (SCHEME_OBJECT))) #ifdef IN_CMPINT_C @@ -526,7 +527,7 @@ DEFUN_VOID (mc68k_reset_hook) extern void EXFUN (interface_initialize, (void)); unsigned char * a6_value = ((unsigned char *) (&Registers[0])); - int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT))); + int offset = (COMPILER_REGBLOCK_START_HOOKS * (sizeof (SCHEME_OBJECT))); /* These must match machines/bobcat/lapgen.scm */ @@ -596,14 +597,15 @@ DEFUN_VOID (mc68k_reset_hook) SETUP_REGISTER (asm_generic_quotient); /* 38 */ SETUP_REGISTER (asm_generic_remainder); /* 39 */ -#if 0 - /* We are out of hook space! */ - SETUP_REGISTER (asm_generic_modulo); /* 40 */ -#endif + SETUP_REGISTER (asm_stack_and_interrupt_check_12); /* 41 */ + SETUP_REGISTER (asm_stack_and_interrupt_check_14); /* 42 */ + SETUP_REGISTER (asm_stack_and_interrupt_check_18); /* 43 */ + SETUP_REGISTER (asm_stack_and_interrupt_check_22); /* 44 */ + SETUP_REGISTER (asm_stack_and_interrupt_check_24); /* 45 */ FLUSH_CACHE_INITIALIZE (); - FLUSH_I_CACHE_REGION (&Registers[COMPILER_REGBLOCK_N_FIXED], + FLUSH_I_CACHE_REGION (&Registers[COMPILER_REGBLOCK_START_HOOKS], (COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE)); interface_initialize (); -- 2.25.1