#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.12 1992/02/15 07:09:38 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.13 1992/02/15 14:17:23 jinx Exp $
$MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
(define-integrable (invoke-interface code)
(LAP (MOV B (R ,eax) (& ,code))
- (JMP ,entry:compiler-scheme-to-interface)))
+ (JMP F ,entry:compiler-scheme-to-interface)))
(define-integrable (invoke-interface/call code)
(LAP (MOV B (R ,eax) (& ,code))
- (CALL ,entry:compiler-scheme-to-interface/call)))
+ (CALL F ,entry:compiler-scheme-to-interface/call)))
\f
(let-syntax ((define-entries
(macro (start . names)
(car names))
(byte-offset-reference regnum:regs-pointer
,index))
- (loop (cdr names) (+ index 4)))))
+ (loop (cdr names) (+ index 8)))))
`(BEGIN ,@(loop names start)))))
(define-entries #x40 ; (* 16 4)
scheme-to-interface ; Main entry point (only one necessary)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.11 1992/02/13 19:03:46 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.12 1992/02/15 14:16:59 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
(LAP ,@(clear-map!)
#|
,@(case frame-size
- ((1) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-1)))
- ((2) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-2)))
- ((3) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-3)))
- ((4) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-4)))
- ((5) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-5)))
- ((6) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-6)))
- ((7) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-7)))
- ((8) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-8)))
+ ((1) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-1)))
+ ((2) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-2)))
+ ((3) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-3)))
+ ((4) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-4)))
+ ((5) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-5)))
+ ((6) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-6)))
+ ((7) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-7)))
+ ((8) (LAP (JMP F ,entry:compiler-shortcircuit-apply-size-8)))
(else
(LAP (MOV W (R ,ecx) (& ,frame-size))
- (JMP ,entry:compiler-shortcircuit-apply))))
+ (JMP F ,entry:compiler-shortcircuit-apply))))
|#
(MOV W (R ,ecx) (& ,frame-size))
,@(invoke-interface code:compiler-apply)))
(INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
continuation ; ignored
(define-integrable (invoke-entry entry)
- (LAP (JMP ,entry)))
+ (LAP (JMP F ,entry)))
(let-syntax ((invoke
(macro (code entry)
`(invoke-interface ,code))))
(define (optimized-primitive-invocation entry)
(LAP ,@(clear-map!)
- (JMP ,entry)))
+ (JMP F ,entry)))
;;; Invocation Prefixes
(define-integrable (simple-procedure-header code-word label entry)
(let ((gc-label (generate-label)))
(LAP (LABEL ,gc-label)
- (CALL ,entry)
+ (CALL F ,entry)
,@(make-external-label code-word label)
(CMP W (R ,regnum:free-pointer) ,reg:compiled-memtop)
(JGE (@PCR ,gc-label)))))
;; (CALL (@PCR <entry>))
(MOV B (@RO B ,regnum:free-pointer 8) (&U #xe8))
(SUB W ,temp ,target)
- (MOV L (@RO B ,regnum:free-pointer 9) ,temp) ; displacement
+ (MOV W (@RO B ,regnum:free-pointer 9) ,temp) ; displacement
(ADD W (R ,regnum:free-pointer) (& ,(* 4 (+ 5 size))))
(LEA ,temp (@RO UW
,target
,@(if (zero? entry)
(LAP)
(LAP (ADD W (@R ,esp) (& ,(* 10 entry)))))
- (JMP ,entry:compiler-interrupt-closure)
+ (JMP F ,entry:compiler-interrupt-closure)
,@(make-external-label internal-entry-code-word
external-label)
(ADD W (@R ,esp)
(LEA (R ,ebx) (@RO W ,eax (- ,free-ref-label ,pc-label)))
(MOV W ,reg:utility-arg-4 (& ,n-sections))
#|
- (CALL ,entry:compiler-link)
+ (CALL F ,entry:compiler-link)
|#
,@(invoke-interface/call code:compiler-link)
,@(make-external-label (continuation-code-word false)
(MOV W (@RO W ,edx ,environment-offset) (R ,ecx))
(MOV W ,reg:utility-arg-4 (& ,n-sections))
#|
- (CALL ,entry:compiler-link)
+ (CALL F ,entry:compiler-link)
|#
,@(invoke-interface/call code:compiler-link)
,@(make-external-label (continuation-code-word false)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.2 1992/02/05 17:20:37 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.3 1992/02/15 14:17:10 jinx Exp $
$mc68020-Header: rules4.scm,v 4.12 90/05/03 15:17:38 GMT jinx Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
(LAP ,@set-extension
,@(clear-map!)
#|
- (CALL ,(if safe?
- entry:compiler-safe-reference-trap
- entry:compiler-reference-trap))
+ (CALL F ,(if safe?
+ entry:compiler-safe-reference-trap
+ entry:compiler-reference-trap))
|#
,@(invoke-interface/call
(if safe?
,@set-value
,@(clear-map!)
#|
- (CALL ,entry:compiler-assignment-trap)
+ (CALL F ,entry:compiler-assignment-trap)
|#
,@(invoke-interface/call code:compiler-assignment-trap))))
### -*-Midas-*-
###
-### $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/i386.m4,v 1.5 1992/02/14 22:17:07 jinx Exp $
+### $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/i386.m4,v 1.6 1992/02/15 14:16:41 jinx Exp $
###
### Copyright (c) 1992 Massachusetts Institute of Technology
###
use_external(Registers)
use_external(Ext_Stack_Pointer)
- .file "cmpaux-i386.m4"
+ .file "cmpaux-i386.s"
.globl C_Stack_Pointer
.comm C_Stack_Pointer,4
.text
.align 2
define_c_label(interface_initialize)
-# This needs to set the floating point mode.
+ pushl %ebp
+ movl %esp,%ebp
+ subl IMMEDIATE(4),%esp
+ fstcw -2(%ebp)
+ # Set rounding mode to round-to-even, precision control to double,
+ # mask the inexact result exception, and unmask the other exceptions.
+ andl IMMEDIATE(0x0000f0e0),-4(%ebp)
+ orl IMMEDIATE(0x00000220),-4(%ebp)
+ fldcw -2(%ebp)
+ movw %cs,%ax # Obtain code segment
+ leave
ret
define_c_label(C_to_interface)
pushl %ebx
pushl %edx
pushl %ecx
- movl external_reference(utility_table)(,%eax,4),%eax
+ xorl %ecx,%ecx
+ movb %eax,%ecx
+ movl external_reference(utility_table)(,%ecx,4),%eax
call *%eax
define_debugging_label(scheme_to_interface_return)
jmp *%eax # Invoke handler
define_c_label(interface_to_scheme)
+ movl external_reference(Free),rfree # Free pointer = %edi
movl REGBLOCK_VAL()(regs),%eax # Value/dynamic link
movl IMMEDIATE(ADDRESS_MASK),rmask # = %ebp
- movl external_reference(Free),rfree # Free pointer = %edi
movl external_reference(Ext_Stack_Pointer),%esp
+# Apparently gas does not understand the following instruction
+# mov %ds,*rfree # Make a long pointer
+ .word 0x1f8e
+ movl %edx,2(rfree) # out of entry point
movl %eax,%ecx # Copy if used
- andl rmask,%ecx # Set up dynamic link
- movl %ecx,REGBLOCK_DLINK()(regs)
- jmp *%edx # invoke entry point
+ andl rmask,%ecx # Restore potential
+ movl %ecx,REGBLOCK_DLINK()(regs) # dynamic link
+# Apparently gas does not understand the following instruction
+# ljmp *rfree # invoke entry point
+ .word 0x2fff
define_c_label(interface_to_C)
movl %edx,%eax # Set up result
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/i386.h,v 1.7 1992/02/12 15:29:26 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/i386.h,v 1.8 1992/02/15 14:16:30 jinx Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
#define PC_ZERO_BITS 0
+/* For the relocation of PC-relative JMP and CALL instructions */
+
+extern long i386_pc_displacement_relocation;
+
+#define EXTRACT_ADDRESS_FROM_DISPLACEMENT(loc, instr_address) do \
+{ \
+ long displacement_address, new_displacement; \
+ \
+ displacement_address = (((long) (instr_address)) + 1); \
+ new_displacement = ((* ((long *) displacement_address)) \
+ + i386_pc_displacement_relocation); \
+ (* ((long *) displacement_address)) = new_displacement; \
+ (loc) = ((SCHEME_OBJECT) \
+ ((displacement_address + 4) + new_displacement)); \
+} while (0)
+
+#define STORE_DISPLACEMENT_FROM_ADDRESS(target, instr_address) do \
+{ \
+ long displacement_address = (((long) (instr_address)) + 1); \
+ (* ((long *) displacement_address)) = \
+ (((long) (target)) - (displacement_address + 4)); \
+} while (0)
+
/* See the encodings above. */
#define ENTRY_SKIPPED_CHECK_OFFSET 4
# define COMPILED_CLOSURE_ENTRY_SIZE \
((2 * (sizeof (format_word))) + 6)
-/* *** GC and other relocators have to be changed to set this up. *** */
-
-#define PC_RELATIVE_CLOSURES
-#define PC_RELATIVE_UUO_LINKS
-
-extern long pc_displacement_relocation;
-
-#define EXTRACT_ADDRESS_FROM_DISPLACEMENT(loc, instr_address) do \
+#define START_CLOSURE_RELOCATION(scan) do \
{ \
- long displacement_address, new_displacement; \
+ SCHEME_OBJECT \
+ * _new = ((SCHEME_OBJECT *) (scan)), \
+ * _old = (OBJECT_ADDRESS (_new[(OBJECT_DATUM (*_new))])); \
\
- displacement_address = (((long) (instr_address)) + 1); \
- new_displacement = ((* ((long *) displacement_address)) \
- + pc_displacement_relocation); \
- (* ((long *) displacement_address)) = new_displacement; \
- (loc) = ((SCHEME_OBJECT) \
- ((displacement_address + 4) + new_displacement)); \
+ i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
} while (0)
-#define STORE_DISPLACEMENT_FROM_ADDRESS(target, instr_address) do \
-{ \
- long displacement_address = (((long) (instr_address)) + 1); \
- (* ((long *) displacement_address)) = \
- (((long) (target)) - (displacement_address + 4)); \
-} while (0)
+#define END_CLOSURE_RELOCATION(scan) i386_pc_displacement_relocation = 0
#define EXTRACT_CLOSURE_ENTRY_ADDRESS EXTRACT_ADDRESS_FROM_DISPLACEMENT
#define STORE_CLOSURE_ENTRY_ADDRESS STORE_DISPLACEMENT_FROM_ADDRESS
-
+\f
#define EXECUTE_CACHE_ENTRY_SIZE 2
#define EXTRACT_EXECUTE_CACHE_ARITY(target, address) do \
(* (((unsigned char *) (address)) + 3)) = 0xe9; \
} while (0)
+#define START_OPERATOR_RELOCATION(scan) do \
+{ \
+ SCHEME_OBJECT \
+ * _new = (((SCHEME_OBJECT *) (scan)) + 1), \
+ * _old = ((SCHEME_OBJECT *) (* _new)); \
+ \
+ (* _new) = ((SCHEME_OBJECT) _new); \
+ i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
+} while (0)
+
+#define END_OPERATOR_RELOCATION(scan) i386_pc_displacement_relocation = 0
+
+#define FIRST_OPERATOR_LINKAGE_OFFSET 2
+
#define TRAMPOLINE_ENTRY_SIZE 3
#define TRAMPOLINE_BLOCK_TO_ENTRY 3 /* MNV to MOV instr. */
#define COMPILER_REGBLOCK_N_FIXED 16
#define COMPILER_REGBLOCK_N_HOOKS 80
- /* A hook is a 32-bit address for an indirect CALL/JMP instruction */
-#define COMPILER_HOOK_SIZE 1
+ /* A hook is a 48-bit address (segment + offset) for a far-indirect
+ CALL/JMP instruction. Pad to 64 bits.
+ */
+#define COMPILER_HOOK_SIZE 2
#define COMPILER_REGBLOCK_EXTRA_SIZE \
(COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE)
#ifdef IN_CMPINT_C
+long i386_pc_displacement_relocation = 0;
+
#define ASM_RESET_HOOK i386_reset_hook
#define SETUP_REGISTER(hook) do \
{ \
extern void hook (); \
+ unsigned short * far_pointer = \
+ ((unsigned short *) (esi_value + offset)); \
\
- (* ((unsigned long *) (esi_value + offset))) = \
- ((unsigned long) hook); \
+ *far_pointer++ = code_segment; \
+ (* ((unsigned long *) far_pointer)) = ((unsigned long) hook); \
offset += (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT))); \
} while (0)
void
DEFUN_VOID (i386_reset_hook)
{
- extern void interface_initialize ();
- unsigned char * esi_value = ((unsigned char *) (&Registers[0]));
+ extern unsigned short interface_initialize ();
int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)));
+ unsigned char * esi_value = ((unsigned char *) (&Registers[0]));
+ unsigned short code_segment = (interface_initialize ());
/* These must match machines/i386/lapgen.scm */
SETUP_REGISTER (asm_primitive_error); /* 38 */
#endif
- interface_initialize ();
return;
}
projects / mit-scheme.git / commitdiff