;********************************************************************* ; ; Objective Caml ; ; Xavier Leroy, projet Gallium, INRIA Rocquencourt ; ; Copyright 2006 Institut National de Recherche en Informatique et ; en Automatique. All rights reserved. This file is distributed ; under the terms of the GNU Library General Public License, with ; the special exception on linking described in file ../LICENSE. ; ;********************************************************************* ; $Id: amd64nt.asm,v 1.5 2007/03/01 10:26:51 xleroy Exp $ ; Asm part of the runtime system, AMD64 processor, Intel syntax ; Notes on Win64 calling conventions: ; function arguments in RCX, RDX, R8, R9 / XMM0 - XMM3 ; caller must reserve 32 bytes of stack space ; callee must preserve RBX, RBP, RSI, RDI, R12-R15, XMM6-XMM15 EXTRN caml_garbage_collection: NEAR EXTRN caml_apply2: NEAR EXTRN caml_apply3: NEAR EXTRN caml_program: NEAR EXTRN caml_array_bound_error: NEAR EXTRN caml_young_limit: QWORD EXTRN caml_young_ptr: QWORD EXTRN caml_bottom_of_stack: QWORD EXTRN caml_last_return_address: QWORD EXTRN caml_gc_regs: QWORD EXTRN caml_exception_pointer: QWORD EXTRN caml_backtrace_active: DWORD EXTRN caml_stash_backtrace: NEAR .CODE ; Allocation PUBLIC caml_call_gc ALIGN 16 caml_call_gc: ; Record lowest stack address and return address mov rax, [rsp] mov caml_last_return_address, rax lea rax, [rsp+8] mov caml_bottom_of_stack, rax L105: ; Save caml_young_ptr, caml_exception_pointer mov caml_young_ptr, r15 mov caml_exception_pointer, r14 ; Build array of registers, save it into caml_gc_regs push r13 push r12 push rbp push r11 push r10 push r9 push r8 push rcx push rdx push rsi push rdi push rbx push rax mov caml_gc_regs, rsp ; Save floating-point registers sub rsp, 16*8 movlpd QWORD PTR [rsp + 0*8], xmm0 movlpd QWORD PTR [rsp + 1*8], xmm1 movlpd QWORD PTR [rsp + 2*8], xmm2 movlpd QWORD PTR [rsp + 3*8], xmm3 movlpd QWORD PTR [rsp + 4*8], xmm4 movlpd QWORD PTR [rsp + 5*8], xmm5 movlpd QWORD PTR [rsp + 6*8], xmm6 movlpd QWORD PTR [rsp + 7*8], xmm7 movlpd QWORD PTR [rsp + 8*8], xmm8 movlpd QWORD PTR [rsp + 9*8], xmm9 movlpd QWORD PTR [rsp + 10*8], xmm10 movlpd QWORD PTR [rsp + 11*8], xmm11 movlpd QWORD PTR [rsp + 12*8], xmm12 movlpd QWORD PTR [rsp + 13*8], xmm13 movlpd QWORD PTR [rsp + 14*8], xmm14 movlpd QWORD PTR [rsp + 15*8], xmm15 ; Call the garbage collector call caml_garbage_collection ; Restore all regs used by the code generator movlpd xmm0, QWORD PTR [rsp + 0*8] movlpd xmm1, QWORD PTR [rsp + 1*8] movlpd xmm2, QWORD PTR [rsp + 2*8] movlpd xmm3, QWORD PTR [rsp + 3*8] movlpd xmm4, QWORD PTR [rsp + 4*8] movlpd xmm5, QWORD PTR [rsp + 5*8] movlpd xmm6, QWORD PTR [rsp + 6*8] movlpd xmm7, QWORD PTR [rsp + 7*8] movlpd xmm8, QWORD PTR [rsp + 8*8] movlpd xmm9, QWORD PTR [rsp + 9*8] movlpd xmm10, QWORD PTR [rsp + 10*8] movlpd xmm11, QWORD PTR [rsp + 11*8] movlpd xmm12, QWORD PTR [rsp + 12*8] movlpd xmm13, QWORD PTR [rsp + 13*8] movlpd xmm14, QWORD PTR [rsp + 14*8] movlpd xmm15, QWORD PTR [rsp + 15*8] add rsp, 16*8 pop rax pop rbx pop rdi pop rsi pop rdx pop rcx pop r8 pop r9 pop r10 pop r11 pop rbp pop r12 pop r13 ; Restore caml_young_ptr, caml_exception_pointer mov r15, caml_young_ptr mov r14, caml_exception_pointer ; Return to caller ret PUBLIC caml_alloc1 ALIGN 16 caml_alloc1: sub r15, 16 cmp r15, caml_young_limit jb L100 ret L100: mov rax, [rsp + 0] mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax sub rsp, 8 call L105 add rsp, 8 jmp caml_alloc1 PUBLIC caml_alloc2 ALIGN 16 caml_alloc2: sub r15, 24 cmp r15, caml_young_limit jb L101 ret L101: mov rax, [rsp + 0] mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax sub rsp, 8 call L105 add rsp, 8 jmp caml_alloc2 PUBLIC caml_alloc3 ALIGN 16 caml_alloc3: sub r15, 32 cmp r15, caml_young_limit jb L102 ret L102: mov rax, [rsp + 0] mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax sub rsp, 8 call L105 add rsp, 8 jmp caml_alloc3 PUBLIC caml_allocN ALIGN 16 caml_allocN: sub r15, rax cmp r15, caml_young_limit jb L103 ret L103: push rax ; save desired size mov rax, [rsp + 8] mov caml_last_return_address, rax lea rax, [rsp + 16] mov caml_bottom_of_stack, rax call L105 pop rax ; recover desired size jmp caml_allocN ; Call a C function from Caml PUBLIC caml_c_call ALIGN 16 caml_c_call: ; Record lowest stack address and return address pop r12 mov caml_last_return_address, r12 mov caml_bottom_of_stack, rsp ; Make the exception handler and alloc ptr available to the C code mov caml_young_ptr, r15 mov caml_exception_pointer, r14 ; Call the function (address in rax) call rax ; Reload alloc ptr mov r15, caml_young_ptr ; Return to caller push r12 ret ; Start the Caml program PUBLIC caml_start_program ALIGN 16 caml_start_program: ; Save callee-save registers push rbx push rbp push rsi push rdi push r12 push r13 push r14 push r15 sub rsp, 8+10*16 ; stack 16-aligned + 10 saved xmm regs movapd OWORD PTR [rsp + 0*16], xmm6 movapd OWORD PTR [rsp + 1*16], xmm7 movapd OWORD PTR [rsp + 2*16], xmm8 movapd OWORD PTR [rsp + 3*16], xmm9 movapd OWORD PTR [rsp + 4*16], xmm10 movapd OWORD PTR [rsp + 5*16], xmm11 movapd OWORD PTR [rsp + 6*16], xmm12 movapd OWORD PTR [rsp + 7*16], xmm13 movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial entry point is caml_program lea r12, caml_program ; Common code for caml_start_program and caml_callback* L106: ; Build a callback link sub rsp, 8 ; stack 16-aligned push caml_gc_regs push caml_last_return_address push caml_bottom_of_stack ; Setup alloc ptr and exception ptr mov r15, caml_young_ptr mov r14, caml_exception_pointer ; Build an exception handler lea r13, L108 push r13 push r14 mov r14, rsp ; Call the Caml code call r12 L107: ; Pop the exception handler pop r14 pop r12 ; dummy register L109: ; Update alloc ptr and exception ptr mov caml_young_ptr, r15 mov caml_exception_pointer, r14 ; Pop the callback restoring, link the global variables pop caml_bottom_of_stack pop caml_last_return_address pop caml_gc_regs add rsp, 8 ; Restore callee-save registers. movapd xmm6, OWORD PTR [rsp + 0*16] movapd xmm7, OWORD PTR [rsp + 1*16] movapd xmm8, OWORD PTR [rsp + 2*16] movapd xmm9, OWORD PTR [rsp + 3*16] movapd xmm10, OWORD PTR [rsp + 4*16] movapd xmm11, OWORD PTR [rsp + 5*16] movapd xmm12, OWORD PTR [rsp + 6*16] movapd xmm13, OWORD PTR [rsp + 7*16] movapd xmm14, OWORD PTR [rsp + 8*16] movapd xmm15, OWORD PTR [rsp + 9*16] add rsp, 8+10*16 pop r15 pop r14 pop r13 pop r12 pop rdi pop rsi pop rbp pop rbx ; Return to caller ret L108: ; Exception handler ; Mark the bucket as an exception result and return it or rax, 2 jmp L109 ; Raise an exception from Caml PUBLIC caml_raise_exn ALIGN 16 caml_raise_exn: test caml_backtrace_active, 1 jne L110 mov rsp, r14 ; Cut stack pop r14 ; Recover previous exception handler ret ; Branch to handler L110: mov r12, rax ; Save exception bucket in r12 mov rcx, rax ; Arg 1: exception bucket mov rdx, [rsp] ; Arg 2: PC of raise lea r8, [rsp+8] ; Arg 3: SP of raise mov r9, r14 ; Arg 4: SP of handler sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace mov rax, r12 ; Recover exception bucket mov rsp, r14 ; Cut stack pop r14 ; Recover previous exception handler ret ; Branch to handler ; Raise an exception from C PUBLIC caml_raise_exception ALIGN 16 caml_raise_exception: test caml_backtrace_active, 1 jne L111 mov rax, rcx ; First argument is exn bucket mov rsp, caml_exception_pointer pop r14 ; Recover previous exception handler mov r15, caml_young_ptr ; Reload alloc ptr ret L111: mov r12, rcx ; Save exception bucket in r12 ; Arg 1: exception bucket mov rdx, caml_last_return_address ; Arg 2: PC of raise mov r8, caml_bottom_of_stack ; Arg 3: SP of raise mov r9, caml_exception_pointer ; Arg 4: SP of handler sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace mov rax, r12 ; Recover exception bucket mov rsp, caml_exception_pointer pop r14 ; Recover previous exception handler mov r15, caml_young_ptr ; Reload alloc ptr ret ; Callback from C to Caml PUBLIC caml_callback_exn ALIGN 16 caml_callback_exn: ; Save callee-save registers push rbx push rbp push rsi push rdi push r12 push r13 push r14 push r15 sub rsp, 8+10*16 ; stack 16-aligned + 10 saved xmm regs movapd OWORD PTR [rsp + 0*16], xmm6 movapd OWORD PTR [rsp + 1*16], xmm7 movapd OWORD PTR [rsp + 2*16], xmm8 movapd OWORD PTR [rsp + 3*16], xmm9 movapd OWORD PTR [rsp + 4*16], xmm10 movapd OWORD PTR [rsp + 5*16], xmm11 movapd OWORD PTR [rsp + 6*16], xmm12 movapd OWORD PTR [rsp + 7*16], xmm13 movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments mov rbx, rcx ; closure mov rax, rdx ; argument mov r12, [rbx] ; code pointer jmp L106 PUBLIC caml_callback2_exn ALIGN 16 caml_callback2_exn: ; Save callee-save registers push rbx push rbp push rsi push rdi push r12 push r13 push r14 push r15 sub rsp, 8+10*16 ; stack 16-aligned + 10 saved xmm regs movapd OWORD PTR [rsp + 0*16], xmm6 movapd OWORD PTR [rsp + 1*16], xmm7 movapd OWORD PTR [rsp + 2*16], xmm8 movapd OWORD PTR [rsp + 3*16], xmm9 movapd OWORD PTR [rsp + 4*16], xmm10 movapd OWORD PTR [rsp + 5*16], xmm11 movapd OWORD PTR [rsp + 6*16], xmm12 movapd OWORD PTR [rsp + 7*16], xmm13 movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments mov rdi, rcx ; closure mov rax, rdx ; first argument mov rbx, r8 ; second argument lea r12, caml_apply2 ; code pointer jmp L106 PUBLIC caml_callback3_exn ALIGN 16 caml_callback3_exn: ; Save callee-save registers push rbx push rbp push rsi push rdi push r12 push r13 push r14 push r15 sub rsp, 8+10*16 ; stack 16-aligned + 10 saved xmm regs movapd OWORD PTR [rsp + 0*16], xmm6 movapd OWORD PTR [rsp + 1*16], xmm7 movapd OWORD PTR [rsp + 2*16], xmm8 movapd OWORD PTR [rsp + 3*16], xmm9 movapd OWORD PTR [rsp + 4*16], xmm10 movapd OWORD PTR [rsp + 5*16], xmm11 movapd OWORD PTR [rsp + 6*16], xmm12 movapd OWORD PTR [rsp + 7*16], xmm13 movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments mov rsi, rcx ; closure mov rax, rdx ; first argument mov rbx, r8 ; second argument mov rdi, r9 ; third argument lea r12, caml_apply3 ; code pointer jmp L106 PUBLIC caml_ml_array_bound_error ALIGN 16 caml_ml_array_bound_error: lea rax, caml_array_bound_error jmp caml_c_call .DATA PUBLIC caml_system__frametable caml_system__frametable LABEL QWORD QWORD 1 ; one descriptor QWORD L107 ; return address into callback WORD -1 ; negative frame size => use callback link WORD 0 ; no roots here ALIGN 8 PUBLIC caml_negf_mask ALIGN 16 caml_negf_mask LABEL QWORD QWORD 8000000000000000H, 0 PUBLIC caml_absf_mask ALIGN 16 caml_absf_mask LABEL QWORD QWORD 7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH END