Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
ocaml/runtime/amd64nt.asm

537 lines
18 KiB
NASM
Raw Blame History

;**************************************************************************
;* *
;* OCaml *
;* *
;* 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 Lesser General Public License version 2.1, with the *
;* special exception on linking described in the file LICENSE. *
;* *
;**************************************************************************
; 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_pos: DWORD
EXTRN caml_backtrace_active: DWORD
EXTRN caml_stash_backtrace: NEAR
IFDEF WITH_SPACETIME
EXTRN caml_spacetime_trie_node_ptr: QWORD
EXTRN caml_spacetime_c_to_ocaml: NEAR
ENDIF
.CODE
PUBLIC caml_system__code_begin
caml_system__code_begin:
ret ; just one instruction, so that debuggers don't display
; caml_system__code_begin instead of caml_call_gc
; 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:
; Touch the stack to trigger a recoverable segfault
; if insufficient space remains
sub rsp, 01000h
mov [rsp], rax
add rsp, 01000h
; Save caml_young_ptr, caml_exception_pointer
mov caml_young_ptr, r15
mov caml_exception_pointer, r14
IFDEF WITH_SPACETIME
mov caml_spacetime_trie_node_ptr, r13
ENDIF
; Build array of registers, save it into caml_gc_regs
push rbp
push r11
push r10
push r13
push r12
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
movsd QWORD PTR [rsp + 0*8], xmm0
movsd QWORD PTR [rsp + 1*8], xmm1
movsd QWORD PTR [rsp + 2*8], xmm2
movsd QWORD PTR [rsp + 3*8], xmm3
movsd QWORD PTR [rsp + 4*8], xmm4
movsd QWORD PTR [rsp + 5*8], xmm5
movsd QWORD PTR [rsp + 6*8], xmm6
movsd QWORD PTR [rsp + 7*8], xmm7
movsd QWORD PTR [rsp + 8*8], xmm8
movsd QWORD PTR [rsp + 9*8], xmm9
movsd QWORD PTR [rsp + 10*8], xmm10
movsd QWORD PTR [rsp + 11*8], xmm11
movsd QWORD PTR [rsp + 12*8], xmm12
movsd QWORD PTR [rsp + 13*8], xmm13
movsd QWORD PTR [rsp + 14*8], xmm14
movsd QWORD PTR [rsp + 15*8], xmm15
; Call the garbage collector
sub rsp, 32 ; PR#5008: bottom 32 bytes are reserved for callee
call caml_garbage_collection
add rsp, 32 ; PR#5008
; Restore all regs used by the code generator
movsd xmm0, QWORD PTR [rsp + 0*8]
movsd xmm1, QWORD PTR [rsp + 1*8]
movsd xmm2, QWORD PTR [rsp + 2*8]
movsd xmm3, QWORD PTR [rsp + 3*8]
movsd xmm4, QWORD PTR [rsp + 4*8]
movsd xmm5, QWORD PTR [rsp + 5*8]
movsd xmm6, QWORD PTR [rsp + 6*8]
movsd xmm7, QWORD PTR [rsp + 7*8]
movsd xmm8, QWORD PTR [rsp + 8*8]
movsd xmm9, QWORD PTR [rsp + 9*8]
movsd xmm10, QWORD PTR [rsp + 10*8]
movsd xmm11, QWORD PTR [rsp + 11*8]
movsd xmm12, QWORD PTR [rsp + 12*8]
movsd xmm13, QWORD PTR [rsp + 13*8]
movsd xmm14, QWORD PTR [rsp + 14*8]
movsd 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 r12
pop r13
pop r10
pop r11
pop rbp
; 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 OCaml
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
IFDEF WITH_SPACETIME
; Record the trie node hole pointer that corresponds to
; [caml_last_return_address]
mov caml_spacetime_trie_node_ptr, r13
ENDIF
; Touch the stack to trigger a recoverable segfault
; if insufficient space remains
sub rsp, 01000h
mov [rsp], rax
add rsp, 01000h
; 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 OCaml 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
IFDEF WITH_SPACETIME
push caml_spacetime_trie_node_ptr
ELSE
sub rsp, 8 ; stack 16-aligned
ENDIF
push caml_gc_regs
push caml_last_return_address
push caml_bottom_of_stack
IFDEF WITH_SPACETIME
; Save arguments to caml_callback
push rax
push rbx
push rdi
push rsi
; No need to push r12: it is callee-save.
mov rcx, r12
lea rdx, caml_start_program
call caml_spacetime_c_to_ocaml
pop rsi
pop rdi
pop rbx
pop rax
ENDIF
; 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
IFDEF WITH_SPACETIME
mov r13, caml_spacetime_trie_node_ptr
ENDIF
; Call the OCaml 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
IFDEF WITH_SPACETIME
pop caml_spacetime_trie_node_ptr
ELSE
add rsp, 8
ENDIF
; 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 OCaml
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 L112
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
L112:
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 OCaml
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
PUBLIC caml_system__code_end
caml_system__code_end:
.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
IFDEF WITH_SPACETIME
.DATA
PUBLIC caml_system__spacetime_shapes
ALIGN 8
caml_system__spacetime_shapes LABEL QWORD
QWORD caml_start_program
QWORD 2 ; indirect call point to OCaml code
QWORD L107 ; in caml_start_program / caml_callback*
QWORD 0 ; end of shapes in caml_start_program
QWORD 0 ; end of shape table
ALIGN 8
ENDIF
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
Reference in New Issue View Git Blame Copy Permalink