### 2) The C compiler divides registers into three groups:
### - Linkage registers, used for procedure calls and global
### references. On AMD64 Unix ABI: %rbp, %rsp.
-### - super temporaries, not preserved accross procedure calls and
+### - super temporaries, not preserved across procedure calls and
### always usable. On AMD64 Unix ABI: everything but what is
### listed below.
### - preserved registers saved by the callee if they are written.
ifdef(`SUPPRESS_LEADING_UNDERSCORE',
`define(EVR,`$1')',
`define(EVR,`_$1')')
+ifdef(`ENABLE_SMP',
+ `define(TLVR,`%fs:$1\@tpoff')',
+ `define(TLVR,`ABS(EVR($1))')')
# When using the Watcom C compiler with register-based calling
# conventions, source-code function names normally expand to `FOO_',
define(REGBLOCK_VAL,16)
define(REGBLOCK_COMPILER_TEMP,32)
define(REGBLOCK_DLINK,REGBLOCK_COMPILER_TEMP)
+define(COMPILER_REGBLOCK_N_FIXED,16)
+define(COMPILER_REGBLOCK_N_HOOKS,80)
+define(COMPILER_REGBLOCK_N_TEMPS,256)
+define(COMPILER_HOOK_SIZE,1)
+define(COMPILER_TEMP_SIZE,1)
+define(REGBLOCK_LENGTH,
+ eval(COMPILER_REGBLOCK_N_FIXED
+ +(COMPILER_REGBLOCK_N_HOOKS*COMPILER_HOOK_SIZE)
+ +(COMPILER_REGBLOCK_N_TEMPS*COMPILER_TEMP_SIZE)))
# Define the floating-point processor control word. Always set
# round-to-even and double precision. Under Win32, mask all
IFDASM(`.586p
.model flat')
+use_external_data(EVR(utility_table))
+
+ifdef(`ENABLE_SMP',`
+ .section .tbss,"awT",\@nobits
+ .align 8
+define(`define_tllong',`
+ .globl $1
+ .type $1 STT_TLS
+ .size $1, 8
+$1:
+ .zero 8
+')
+ define_tllong(Free)
+ define_tllong(heap_alloc_limit)
+ define_tllong(heap_end)
+ define_tllong(stack_guard)
+ define_tllong(stack_pointer)
+ define_tllong(stack_start)
+ define_tllong(C_Stack_Pointer)
+ define_tllong(C_Frame_Pointer)
+
+ .globl Registers
+ .type Registers STT_TLS
+ .size Registers, eval(REGBLOCK_LENGTH*8)
+Registers:
+ .zero eval(REGBLOCK_LENGTH*8)
+
DECLARE_DATA_SEGMENT()
declare_alignment(2)
+',`
-use_external_data(EVR(Free))
-use_external_data(EVR(stack_pointer))
-use_external_data(EVR(utility_table))
+DECLARE_DATA_SEGMENT()
+declare_alignment(2)
ifdef(`WIN32',`
use_external_data(EVR(RegistersPtr))
',`
-use_external_data(EVR(Registers))
+define_data(Registers)
+allocate_space(`Registers',`eval(REGBLOCK_LENGTH*8)')
')
define_data(C_Stack_Pointer)
define_data(C_Frame_Pointer)
allocate_quadword(C_Frame_Pointer)
+')
declare_alignment(8)
define_double(flonum_zero,0.0)
# set esp to something they consider funny.
define_c_label(within_c_stack)
- OP(mov,q) TW(ABS(EVR(C_Stack_Pointer)),REG(rax))
+ OP(mov,q) TW(TLVR(C_Stack_Pointer),REG(rax))
# Are we currently in C, signalled by having no saved C stack pointer?
OP(cmp,q) TW(IMM(0),REG(rax))
# Yes: just call the function without messing with rsp.
OP(push,q) REG(rbp) # Save frame pointer
OP(mov,q) TW(REG(rsp),REG(rbp))
OP(mov,q) TW(REG(rax),REG(rsp)) # Switch to C stack
- OP(mov,q) TW(IMM(0),ABS(EVR(C_Stack_Pointer)))
+ OP(mov,q) TW(IMM(0),TLVR(C_Stack_Pointer))
OP(push,q) IMM(0) # Align sp to 16 bytes
OP(push,q) REG(rbp) # Save stack pointer
OP(mov,q) TW(REG(rdi),REG(rax)) # arg1 (fn) -> rax
define_debugging_label(within_c_stack_restore)
OP(mov,q) TW(REG(rsp),REG(rax)) # Restore C stack ptr
OP(add,q) TW(IMM(16),REG(rax))
- OP(mov,q) TW(REG(rax),ABS(EVR(C_Stack_Pointer)))
+ OP(mov,q) TW(REG(rax),TLVR(C_Stack_Pointer))
OP(pop,q) REG(rsp) # Restore stack pointer
# and switch back to
# Scheme stack
OP(push,q) IMM(0) # Align stack
OP(mov,q) TW(REG(rdi),REG(rdx)) # Entry point
# Preserve frame ptr
- OP(mov,q) TW(REG(rbp),ABS(EVR(C_Frame_Pointer)))
+ OP(mov,q) TW(REG(rbp),TLVR(C_Frame_Pointer))
# Preserve stack ptr
- OP(mov,q) TW(REG(rsp),ABS(EVR(C_Stack_Pointer)))
+ OP(mov,q) TW(REG(rsp),TLVR(C_Stack_Pointer))
jmp EPFR(interface_to_scheme)
define_hook_label(trampoline_to_interface)
define_hook_label(scheme_to_interface)
define_debugging_label(scheme_to_interface)
- OP(mov,q) TW(REG(rsp),ABS(EVR(stack_pointer)))
- OP(mov,q) TW(rfree,ABS(EVR(Free)))
- OP(mov,q) TW(ABS(EVR(C_Stack_Pointer)),REG(rsp))
- OP(mov,q) TW(ABS(EVR(C_Frame_Pointer)),REG(rbp))
+ OP(mov,q) TW(REG(rsp),TLVR(stack_pointer))
+ OP(mov,q) TW(rfree,TLVR(Free))
+ OP(mov,q) TW(TLVR(C_Stack_Pointer),REG(rsp))
+ OP(mov,q) TW(TLVR(C_Frame_Pointer),REG(rbp))
# Signal to within_c_stack that we are now in C land.
- OP(mov,q) TW(IMM(0),ABS(EVR(C_Stack_Pointer)))
+ OP(mov,q) TW(IMM(0),TLVR(C_Stack_Pointer))
OP(sub,q) TW(IMM(16),REG(rsp)) # alloc struct return
OP(mov,q) TW(REG(rsp),REG(rdi)) # Structure is first argument.
define_c_label(interface_to_scheme)
ifdef(`WIN32', # Register block = %rsi
-` OP(mov,q) TW(ABS(EVR(RegistersPtr)),regs)',
-` OP(lea,q) TW(ABS(EVR(Registers)),regs)')
- OP(mov,q) TW(ABS(EVR(Free)),rfree) # Free pointer = %rdi
+` OP(mov,q) TW(TLVR(RegistersPtr),regs)',
+`ifdef(`ENABLE_SMP',
+` OP(mov,q) TW(%fs:0,regs)
+ OP(add,q) TW($Registers\@tpoff,regs)',
+` OP(lea,q) TW(ABS(EVR(Registers)),regs)')')
+ OP(mov,q) TW(TLVR(Free),rfree) # Free pointer = %rdi
OP(mov,q) TW(QOF(REGBLOCK_VAL(),regs),REG(rax)) # Value/dynamic link
OP(mov,q) TW(IMM(ADDRESS_MASK),rmask) # = %rbp
# Restore the C stack pointer, which we zeroed back in
# scheme_to_interface, for within_c_stack.
- OP(mov,q) TW(REG(rsp),ABS(EVR(C_Stack_Pointer)))
- OP(mov,q) TW(ABS(EVR(stack_pointer)),REG(rsp))
+ OP(mov,q) TW(REG(rsp),TLVR(C_Stack_Pointer))
+ OP(mov,q) TW(TLVR(stack_pointer),REG(rsp))
OP(mov,q) TW(REG(rax),REG(rcx)) # Preserve if used
OP(and,q) TW(rmask,REG(rcx)) # Restore potential dynamic link
OP(mov,q) TW(REG(rcx),QOF(REGBLOCK_DLINK(),regs))
# define VM_PROT_SCHEME (VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE)
#endif
+void
+x86_64_init_hook (void)
+{
+ x86_64_interface_initialize ();
+
+ declare_builtin ((unsigned long)asm_scheme_to_interface, "asm_scheme_to_interface");
+ declare_builtin ((unsigned long)asm_scheme_to_interface_call, "asm_scheme_to_interface_call");
+ declare_builtin ((unsigned long)asm_trampoline_to_interface, "asm_trampoline_to_interface");
+ declare_builtin ((unsigned long)asm_interrupt_procedure, "asm_interrupt_procedure");
+ declare_builtin ((unsigned long)asm_interrupt_continuation, "asm_interrupt_continuation");
+ declare_builtin ((unsigned long)asm_interrupt_closure, "asm_interrupt_closure");
+ declare_builtin ((unsigned long)asm_interrupt_dlink, "asm_interrupt_dlink");
+ declare_builtin ((unsigned long)asm_primitive_apply, "asm_primitive_apply");
+ declare_builtin ((unsigned long)asm_primitive_lexpr_apply, "asm_primitive_lexpr_apply");
+ declare_builtin ((unsigned long)asm_assignment_trap, "asm_assignment_trap");
+ declare_builtin ((unsigned long)asm_reference_trap, "asm_reference_trap");
+ declare_builtin ((unsigned long)asm_safe_reference_trap, "asm_safe_reference_trap");
+ declare_builtin ((unsigned long)asm_link, "asm_link");
+ declare_builtin ((unsigned long)asm_error, "asm_error");
+ declare_builtin ((unsigned long)asm_primitive_error, "asm_primitive_error");
+ declare_builtin ((unsigned long)asm_generic_add, "asm_generic_add");
+ declare_builtin ((unsigned long)asm_generic_subtract, "asm_generic_subtract");
+ declare_builtin ((unsigned long)asm_generic_multiply, "asm_generic_multiply");
+ declare_builtin ((unsigned long)asm_generic_divide, "asm_generic_divide");
+ declare_builtin ((unsigned long)asm_generic_equal, "asm_generic_equal");
+ declare_builtin ((unsigned long)asm_generic_less, "asm_generic_less");
+ declare_builtin ((unsigned long)asm_generic_greater, "asm_generic_greater");
+ declare_builtin ((unsigned long)asm_generic_increment, "asm_generic_increment");
+ declare_builtin ((unsigned long)asm_generic_decrement, "asm_generic_decrement");
+ declare_builtin ((unsigned long)asm_generic_zero, "asm_generic_zero");
+ declare_builtin ((unsigned long)asm_generic_positive, "asm_generic_positive");
+ declare_builtin ((unsigned long)asm_generic_negative, "asm_generic_negative");
+ declare_builtin ((unsigned long)asm_generic_quotient, "asm_generic_quotient");
+ declare_builtin ((unsigned long)asm_generic_remainder, "asm_generic_remainder");
+ declare_builtin ((unsigned long)asm_generic_modulo, "asm_generic_modulo");
+ declare_builtin ((unsigned long)asm_sc_apply, "asm_sc_apply");
+ declare_builtin ((unsigned long)asm_sc_apply_size_1, "asm_sc_apply_size_1");
+ declare_builtin ((unsigned long)asm_sc_apply_size_2, "asm_sc_apply_size_2");
+ declare_builtin ((unsigned long)asm_sc_apply_size_3, "asm_sc_apply_size_3");
+ declare_builtin ((unsigned long)asm_sc_apply_size_4, "asm_sc_apply_size_4");
+ declare_builtin ((unsigned long)asm_sc_apply_size_5, "asm_sc_apply_size_5");
+ declare_builtin ((unsigned long)asm_sc_apply_size_6, "asm_sc_apply_size_6");
+ declare_builtin ((unsigned long)asm_sc_apply_size_7, "asm_sc_apply_size_7");
+ declare_builtin ((unsigned long)asm_sc_apply_size_8, "asm_sc_apply_size_8");
+ declare_builtin ((unsigned long)asm_interrupt_continuation_2, "asm_interrupt_continuation_2");
+ declare_builtin ((unsigned long)asm_fixnum_shift, "asm_fixnum_shift");
+
+#ifdef _MACH_UNIX
+ {
+ vm_address_t addr;
+ vm_size_t size;
+ vm_prot_t prot;
+ vm_prot_t max_prot;
+ vm_inherit_t inheritance;
+ boolean_t shared;
+ port_t object;
+ vm_offset_t offset;
+
+ addr = ((vm_address_t) Heap);
+ if ((vm_region ((task_self ()), &addr, &size, &prot, &max_prot,
+ &inheritance, &shared, &object, &offset))
+ != KERN_SUCCESS)
+ {
+ outf_fatal ( "compiler_reset: vm_region() failed.\n");
+ Microcode_Termination (TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ if ((prot & VM_PROT_SCHEME) != VM_PROT_SCHEME)
+ {
+ if ((max_prot & VM_PROT_SCHEME) != VM_PROT_SCHEME)
+ {
+ outf_fatal (
+ "compiler_reset: inadequate protection for Heap.\n");
+ outf_fatal ( "maximum = 0x%lx; desired = 0x%lx\n",
+ ((unsigned long) (max_prot & VM_PROT_SCHEME)),
+ ((unsigned long) VM_PROT_SCHEME));
+ Microcode_Termination (TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ if ((vm_protect ((task_self ()), ((vm_address_t) Heap),
+ (((char *) constant_end) - ((char *) Heap)),
+ 0, VM_PROT_SCHEME))
+ != KERN_SUCCESS)
+ {
+ outf_fatal ("Unable to change protection for Heap.\n");
+ outf_fatal ("actual = 0x%lx; desired = 0x%lx\n",
+ ((unsigned long) (prot & VM_PROT_SCHEME)),
+ ((unsigned long) VM_PROT_SCHEME));
+ Microcode_Termination (TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ }
+ }
+#endif /* _MACH_UNIX */
+}
+
#define SETUP_REGISTER(hook) do \
{ \
(* ((unsigned long *) (rsi_value + offset))) \
= ((unsigned long) (hook)); \
offset += (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT))); \
- declare_builtin (((unsigned long) hook), #hook); \
} while (0)
void
int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)));
unsigned char * rsi_value = ((unsigned char *) Registers);
- x86_64_interface_initialize ();
-
/* These must match machines/x86-64/lapgen.scm */
SETUP_REGISTER (asm_scheme_to_interface); /* 0 */
SETUP_REGISTER (asm_interrupt_continuation_2); /* 39 */
SETUP_REGISTER (asm_fixnum_shift); /* 40 */
-
-#ifdef _MACH_UNIX
- {
- vm_address_t addr;
- vm_size_t size;
- vm_prot_t prot;
- vm_prot_t max_prot;
- vm_inherit_t inheritance;
- boolean_t shared;
- port_t object;
- vm_offset_t offset;
-
- addr = ((vm_address_t) Heap);
- if ((vm_region ((task_self ()), &addr, &size, &prot, &max_prot,
- &inheritance, &shared, &object, &offset))
- != KERN_SUCCESS)
- {
- outf_fatal ( "compiler_reset: vm_region() failed.\n");
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
- if ((prot & VM_PROT_SCHEME) != VM_PROT_SCHEME)
- {
- if ((max_prot & VM_PROT_SCHEME) != VM_PROT_SCHEME)
- {
- outf_fatal (
- "compiler_reset: inadequate protection for Heap.\n");
- outf_fatal ( "maximum = 0x%lx; desired = 0x%lx\n",
- ((unsigned long) (max_prot & VM_PROT_SCHEME)),
- ((unsigned long) VM_PROT_SCHEME));
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
- if ((vm_protect ((task_self ()), ((vm_address_t) Heap),
- (((char *) constant_end) - ((char *) Heap)),
- 0, VM_PROT_SCHEME))
- != KERN_SUCCESS)
- {
- outf_fatal ("Unable to change protection for Heap.\n");
- outf_fatal ("actual = 0x%lx; desired = 0x%lx\n",
- ((unsigned long) (prot & VM_PROT_SCHEME)),
- ((unsigned long) VM_PROT_SCHEME));
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
- }
- }
-#endif /* _MACH_UNIX */
}
#ifndef HAVE_FENV_H
projects / mit-scheme.git / commitdiff