### -*-Midas-*-
###
-### $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/mc68k.m4,v 1.7 1989/11/30 05:44:04 jinx Exp $
+### $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/mc68k.m4,v 1.8 1989/12/10 00:49:54 cph Exp $
###
### Copyright (c) 1989 Massachusetts Institute of Technology
###
addq.l &4,%d1 # Skip format info.
bra scheme_to_interface
+define(define_interface_indirection,
+`define_c_label(asm_$1)
+ movq &HEX($2),%d0
+ bra scheme_to_interface')
+
+define(define_interface_jsr_indirection,
+`define_c_label(asm_$1)
+ movq &HEX($2),%d0
+ bra scheme_to_interface_jsr')
+
+define_interface_indirection(primitive_lexpr_apply,13)
+define_interface_indirection(error,15)
+define_interface_jsr_indirection(link,17)
+define_interface_indirection(interrupt_closure,18)
+define_interface_jsr_indirection(interrupt_procedure,1a)
+define_interface_jsr_indirection(interrupt_continuation,1b)
+define_interface_jsr_indirection(assignment_trap,1d)
+define_interface_jsr_indirection(reference_trap,1f)
+define_interface_jsr_indirection(safe_reference_trap,20)
+define_interface_indirection(generic_decrement,22)
+define_interface_indirection(generic_divide,23)
+define_interface_indirection(generic_equal,24)
+define_interface_indirection(generic_greater,25)
+define_interface_indirection(generic_increment,26)
+define_interface_indirection(generic_less,27)
+define_interface_indirection(generic_subtract,28)
+define_interface_indirection(generic_multiply,29)
+define_interface_indirection(generic_negative,2a)
+define_interface_indirection(generic_add,2b)
+define_interface_indirection(generic_positive,2c)
+define_interface_indirection(generic_zero,2d)
+
+# Save an additional instruction here to load the dynamic link.
+define_c_label(asm_interrupt_dlink)
+ mov.l %a4,%d2 # Dynamic link -> d2
+ movq &HEX(19),%d0
+ bra scheme_to_interface_jsr
+
+# Bum this one for speed.
+define_c_label(asm_primitive_apply)
+ switch_to_C_registers()
+ mov.l %d1,-(%sp) # only one argument
+ mov.l extern_c_label(utility_table)+HEX(12)*4,%a0
+ jsr (%a0)
+ addq.l &4,%sp # pop the argument
+
+### On return, %d0 contains the address of interface_to_scheme or
+### interface_to_C. %d1 contains the appropriate data for them.
+
+ mov.l %d0,%a0
+ jmp (%a0)
+\f
set tc_compiled_entry,HEX(28)
set offset_apply,HEX(14)
# Fall through
define_debugging_label(shortcircuit_apply_2)
call_utility(apply)
+
+### Optimized versions of shortcircuit_apply for 0-7 arguments.
+
+define(define_apply_size_n,
+`define_c_label(asm_shortcircuit_apply_size_$1)
+define_debugging_label(shortcircuit_apply_size_$1)
+ EXTRACT_TYPE_CODE((%sp),%d0) # Get procedure type
+ mov.l (%sp)+,%d1 # Get procedure
+ COMPARE_TYPE_CODE(%d0,tc_compiled_entry)
+ bne.b shortcircuit_apply_size_$1_2
+ and.l rmask,%d1 # Extract entry point
+ mov.l %d1,%a0
+ cmp.b -3(%a0),&$1 # Is the frame size right?
+ bne.b shortcircuit_apply_size_$1_1
+ jmp (%a0) # Invoke
+
+define_debugging_label(shortcircuit_apply_size_$1_1)
+ mov.l -4(%sp),%d1 # Recover the type code
+ # Fall through
+define_debugging_label(shortcircuit_apply_size_$1_2)
+ movq &$1,%d2 # initialize frame size
+ call_utility(apply)')
+
+define_apply_size_n(1)
+define_apply_size_n(2)
+define_apply_size_n(3)
+define_apply_size_n(4)
+define_apply_size_n(5)
+define_apply_size_n(6)
+define_apply_size_n(7)
+define_apply_size_n(8)
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/mc68k.h,v 1.10 1989/11/30 05:45:25 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/mc68k.h,v 1.11 1989/12/10 00:49:58 cph Exp $
*
* Compiled code interface macros.
*
#define A6_TRAMPOLINE_TO_INTERFACE_OFFSET \
((COMPILER_REGBLOCK_N_FIXED + (2 * COMPILER_HOOK_SIZE)) * \
-((COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE))
-
-/* These must match machines/bobcat/lapgen.scm */
-
-#define A6_SCHEME_TO_INTERFACE_OFFSET \
-(COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)))
-
-#define A6_SCHEME_TO_INTERFACE_JSR_OFFSET \
-(A6_SCHEME_TO_INTERFACE_OFFSET + \
- (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT))))
+(COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE)
#define A6_CLOSURE_HOOK_OFFSET \
-(A6_SCHEME_TO_INTERFACE_JSR_OFFSET + \
- (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT))))
-
-#define A6_SHORTCIRCUIT_APPLY_OFFSET \
-(A6_TRAMPOLINE_TO_INTERFACE_OFFSET + \
- (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT))))
+((COMPILER_REGBLOCK_N_FIXED + (2 * COMPILER_HOOK_SIZE)) * \
+ (sizeof (SCHEME_OBJECT)))
#ifdef CAST_FUNCTION_TO_INT_BUG
-#define ASM_RESET_HOOK mc68k_reset_hook
+#define SETUP_REGISTER(hook) do \
{ \
-#define SETUP_REGISTER(hook, offset) \
+#define SETUP_REGISTER(hook) \
(((unsigned short *) (a6_value + offset)) + 1))) = \
extern void hook(); \
\
} while (0)
#endif
+\f
}
DEFUN_VOID (mc68k_reset_hook)
mc68k_reset_hook ()
int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)));
- unsigned char *a6_value;
- extern void interface_initialize();
-
- a6_value = ((unsigned char *) (&Registers[0]));
-
- SETUP_REGISTER(asm_scheme_to_interface,
- A6_SCHEME_TO_INTERFACE_OFFSET);
- SETUP_REGISTER(asm_scheme_to_interface_jsr,
- A6_SCHEME_TO_INTERFACE_JSR_OFFSET);
- SETUP_REGISTER(asm_trampoline_to_interface,
- A6_TRAMPOLINE_TO_INTERFACE_OFFSET);
- SETUP_REGISTER(asm_shortcircuit_apply,
- A6_SHORTCIRCUIT_APPLY_OFFSET);
- interface_initialize();
+ /* These must match machines/bobcat/lapgen.scm */
+
+ extern void interface_initialize ();
+ SETUP_REGISTER (asm_scheme_to_interface_jsr); /* 1 */
+ if (offset != A6_TRAMPOLINE_TO_INTERFACE_OFFSET)
+ {
+ SETUP_REGISTER (asm_shortcircuit_apply_size_2); /* 5 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_3); /* 6 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_4); /* 7 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_5); /* 8 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_6); /* 9 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_7); /* 10 */
+ SETUP_REGISTER (asm_shortcircuit_apply_size_8); /* 11 */
+ SETUP_REGISTER (asm_primitive_apply); /* 12 */
+ SETUP_REGISTER (asm_primitive_lexpr_apply); /* 13 */
+ SETUP_REGISTER (asm_error); /* 14 */
+ SETUP_REGISTER (asm_link); /* 15 */
+ SETUP_REGISTER (asm_interrupt_closure); /* 16 */
+ SETUP_REGISTER (asm_interrupt_dlink); /* 17 */
+ SETUP_REGISTER (asm_interrupt_procedure); /* 18 */
+ SETUP_REGISTER (asm_interrupt_continuation); /* 19 */
+ SETUP_REGISTER (asm_assignment_trap); /* 20 */
+ SETUP_REGISTER (asm_reference_trap); /* 21 */
+ SETUP_REGISTER (asm_safe_reference_trap); /* 22 */
+ SETUP_REGISTER (asm_generic_add); /* 23 */
+ SETUP_REGISTER (asm_generic_subtract); /* 24 */
+ SETUP_REGISTER (asm_generic_multiply); /* 25 */
+ SETUP_REGISTER (asm_generic_divide); /* 26 */
+ SETUP_REGISTER (asm_generic_equal); /* 27 */
+ SETUP_REGISTER (asm_generic_less); /* 28 */
+ SETUP_REGISTER (asm_generic_greater); /* 29 */
+ SETUP_REGISTER (asm_generic_increment); /* 30 */
+ SETUP_REGISTER (asm_generic_decrement); /* 31 */
+ SETUP_REGISTER (asm_generic_zero); /* 32 */
+ SETUP_REGISTER (asm_generic_positive); /* 33 */
+ SETUP_REGISTER (asm_generic_negative); /* 34 */
+ SETUP_REGISTER (asm_primitive_error); /* 35 */
+ SETUP_REGISTER (asm_allocate_closure); /* 36 */
+
+\f
#define CLOSURE_ENTRY_WORDS \
(COMPILED_CLOSURE_ENTRY_SIZE / (sizeof (SCHEME_OBJECT)))
/* On the 68K, here's a picture of a trampoline (offset in bytes from
projects / mit-scheme.git / commitdiff