#| -*-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
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))
#| -*-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
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)))
#|
;; 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
#| -*-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
(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))
(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))
(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)))))))))
\f
(define (MC68020/cons-closure target procedure-label min max size)
(let* ((target (reference-target-alias! target 'ADDRESS))
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
### -*-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
###
\f
### 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)
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)
define_generic_binary(add,2b,fadd)
define_generic_unary_predicate(positive,2c,gt)
define_generic_unary_predicate(zero,2d,eq)
+\f
+### 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
/* -*-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
\f
/* 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
\f
/* 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 */
(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
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 */
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 ();
projects / mit-scheme.git / commitdiff