From 534443d04a795ee4b64e38da61bb80d74bfd4f0c Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sat, 15 Feb 1992 14:17:23 +0000 Subject: [PATCH] Jumps into compiled scheme code and out must use far jmp/call instructions, because the code segment is not necessarily the same as the data segment. We still assume that the stack segment and the data segment are the same. --- v7/src/compiler/machines/i386/lapgen.scm | 8 +-- v7/src/compiler/machines/i386/rules3.scm | 34 ++++----- v7/src/compiler/machines/i386/rules4.scm | 10 +-- v7/src/microcode/cmpauxmd/i386.m4 | 34 ++++++--- v7/src/microcode/cmpintmd/i386.h | 88 ++++++++++++++++-------- 5 files changed, 110 insertions(+), 64 deletions(-) diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm index 81b5a5ff6..5c0703d9b 100644 --- a/v7/src/compiler/machines/i386/lapgen.scm +++ b/v7/src/compiler/machines/i386/lapgen.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -414,11 +414,11 @@ MIT in each case. |# (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))) (let-syntax ((define-entries (macro (start . names) @@ -430,7 +430,7 @@ MIT in each case. |# (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) diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 04674379e..21a8f5aa6 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.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 @@ -55,17 +55,17 @@ MIT in each case. |# (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))) @@ -152,7 +152,7 @@ MIT in each case. |# (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)))) @@ -229,7 +229,7 @@ MIT in each case. |# (define (optimized-primitive-invocation entry) (LAP ,@(clear-map!) - (JMP ,entry))) + (JMP F ,entry))) ;;; Invocation Prefixes @@ -365,7 +365,7 @@ MIT in each case. |# (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))))) @@ -436,7 +436,7 @@ MIT in each case. |# ;; (CALL (@PCR )) (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 @@ -502,7 +502,7 @@ MIT in each case. |# ,@(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) @@ -566,7 +566,7 @@ MIT in each case. |# (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) @@ -586,7 +586,7 @@ MIT in each case. |# (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) diff --git a/v7/src/compiler/machines/i386/rules4.scm b/v7/src/compiler/machines/i386/rules4.scm index 57c528ee2..252b9fd40 100644 --- a/v7/src/compiler/machines/i386/rules4.scm +++ b/v7/src/compiler/machines/i386/rules4.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -100,9 +100,9 @@ MIT in each case. |# (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? @@ -120,7 +120,7 @@ MIT in each case. |# ,@set-value ,@(clear-map!) #| - (CALL ,entry:compiler-assignment-trap) + (CALL F ,entry:compiler-assignment-trap) |# ,@(invoke-interface/call code:compiler-assignment-trap)))) diff --git a/v7/src/microcode/cmpauxmd/i386.m4 b/v7/src/microcode/cmpauxmd/i386.m4 index f19d7c62b..81b49f67e 100644 --- a/v7/src/microcode/cmpauxmd/i386.m4 +++ b/v7/src/microcode/cmpauxmd/i386.m4 @@ -1,6 +1,6 @@ ### -*-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 ### @@ -132,7 +132,7 @@ use_external(Free) 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 @@ -143,7 +143,17 @@ use_external(Ext_Stack_Pointer) .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) @@ -180,7 +190,9 @@ define_debugging_label(scheme_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) @@ -188,14 +200,20 @@ 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 diff --git a/v7/src/microcode/cmpintmd/i386.h b/v7/src/microcode/cmpintmd/i386.h index 504f7ccb6..7a83a7760 100644 --- a/v7/src/microcode/cmpintmd/i386.h +++ b/v7/src/microcode/cmpintmd/i386.h @@ -1,6 +1,6 @@ /* -*-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 @@ -216,6 +216,29 @@ typedef unsigned short format_word; #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 @@ -236,35 +259,20 @@ do { \ # 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 - + #define EXECUTE_CACHE_ENTRY_SIZE 2 #define EXTRACT_EXECUTE_CACHE_ARITY(target, address) do \ @@ -295,6 +303,20 @@ extern long pc_displacement_relocation; (* (((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. */ @@ -319,8 +341,10 @@ extern long pc_displacement_relocation; #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) @@ -331,23 +355,28 @@ extern long pc_displacement_relocation; #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 */ @@ -407,7 +436,6 @@ DEFUN_VOID (i386_reset_hook) SETUP_REGISTER (asm_primitive_error); /* 38 */ #endif - interface_initialize (); return; } -- 2.25.1