2014-08-18 02:32:20 -07:00
|
|
|
# 2 "asmcomp/amd64/emit.mlp"
|
2016-02-18 07:11:59 -08:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 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. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2014-08-18 02:32:20 -07:00
|
|
|
(* Emission of Intel x86_64 assembly code *)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
open Cmm
|
|
|
|
open Arch
|
|
|
|
open Proc
|
|
|
|
open Reg
|
|
|
|
open Mach
|
2019-08-13 04:11:13 -07:00
|
|
|
open Linear
|
2003-06-30 01:28:48 -07:00
|
|
|
open Emitaux
|
|
|
|
|
2014-11-27 09:12:21 -08:00
|
|
|
open X86_ast
|
|
|
|
open X86_proc
|
|
|
|
open X86_dsl
|
2018-07-23 05:19:41 -07:00
|
|
|
module String = Misc.Stdlib.String
|
2019-11-26 04:06:19 -08:00
|
|
|
module Int = Numbers.Int
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2015-07-17 07:31:05 -07:00
|
|
|
(* [Branch_relaxation] is not used in this file, but is required by
|
|
|
|
emit.mlp files for certain other targets; the reference here ensures
|
|
|
|
that when releases are being prepared the .depend files are correct
|
|
|
|
for all targets. *)
|
2019-04-01 09:18:47 -07:00
|
|
|
[@@@ocaml.warning "-66"]
|
2015-07-17 07:31:05 -07:00
|
|
|
open! Branch_relaxation
|
|
|
|
|
2014-09-30 07:59:56 -07:00
|
|
|
let _label s = D.label ~typ:QWORD s
|
2014-09-30 07:40:09 -07:00
|
|
|
|
2014-08-18 02:32:20 -07:00
|
|
|
(* Override proc.ml *)
|
|
|
|
|
|
|
|
let int_reg_name =
|
|
|
|
[| RAX; RBX; RDI; RSI; RDX; RCX; R8; R9;
|
|
|
|
R12; R13; R10; R11; RBP; |]
|
|
|
|
|
|
|
|
let float_reg_name = Array.init 16 (fun i -> XMM i)
|
|
|
|
|
|
|
|
let register_name r =
|
2014-09-10 02:40:49 -07:00
|
|
|
if r < 100 then Reg64 (int_reg_name.(r))
|
2014-08-18 02:32:20 -07:00
|
|
|
else Regf (float_reg_name.(r - 100))
|
|
|
|
|
|
|
|
(* CFI directives *)
|
|
|
|
|
|
|
|
let cfi_startproc () =
|
2014-09-30 07:54:15 -07:00
|
|
|
if Config.asm_cfi_supported then D.cfi_startproc ()
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
let cfi_endproc () =
|
2014-09-30 07:54:15 -07:00
|
|
|
if Config.asm_cfi_supported then D.cfi_endproc ()
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
let cfi_adjust_cfa_offset n =
|
2014-09-30 07:54:15 -07:00
|
|
|
if Config.asm_cfi_supported then D.cfi_adjust_cfa_offset n
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
let emit_debug_info dbg =
|
2014-09-30 07:54:15 -07:00
|
|
|
emit_debug_info_gen dbg D.file D.loc
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2013-06-03 11:03:59 -07:00
|
|
|
let fp = Config.with_frame_pointers
|
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Tradeoff between code size and code speed *)
|
|
|
|
|
|
|
|
let fastcode_flag = ref true
|
|
|
|
|
2019-08-14 04:52:05 -07:00
|
|
|
(* Layout of the stack frame *)
|
2003-06-30 01:28:48 -07:00
|
|
|
let stack_offset = ref 0
|
|
|
|
|
2019-08-14 04:52:05 -07:00
|
|
|
let num_stack_slots = Array.make Proc.num_register_classes 0
|
|
|
|
|
|
|
|
let prologue_required = ref false
|
|
|
|
|
|
|
|
let frame_required = ref false
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let frame_size () = (* includes return address *)
|
2019-08-14 04:52:05 -07:00
|
|
|
if !frame_required then begin
|
2008-01-11 08:13:18 -08:00
|
|
|
let sz =
|
2013-06-03 11:03:59 -07:00
|
|
|
(!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8
|
2014-09-10 02:07:50 -07:00
|
|
|
+ (if fp then 8 else 0))
|
2005-08-13 13:59:37 -07:00
|
|
|
in Misc.align sz 16
|
2008-01-11 08:13:18 -08:00
|
|
|
end else
|
2005-08-13 13:59:37 -07:00
|
|
|
!stack_offset + 8
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let slot_offset loc cl =
|
|
|
|
match loc with
|
2014-09-23 05:59:54 -07:00
|
|
|
| Incoming n -> frame_size() + n
|
2003-06-30 01:28:48 -07:00
|
|
|
| Local n ->
|
|
|
|
if cl = 0
|
|
|
|
then !stack_offset + n * 8
|
|
|
|
else !stack_offset + (num_stack_slots.(0) + n) * 8
|
|
|
|
| Outgoing n -> n
|
|
|
|
|
|
|
|
(* Symbols *)
|
|
|
|
|
2014-08-18 02:32:20 -07:00
|
|
|
let symbol_prefix = if system = S_macosx then "_" else ""
|
|
|
|
|
2014-09-23 05:54:41 -07:00
|
|
|
let emit_symbol s = string_of_symbol symbol_prefix s
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
(* Record symbols used and defined - at the end generate extern for those
|
|
|
|
used but not defined *)
|
|
|
|
|
2018-07-23 05:19:41 -07:00
|
|
|
let symbols_defined = ref String.Set.empty
|
|
|
|
let symbols_used = ref String.Set.empty
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2018-07-23 05:19:41 -07:00
|
|
|
let add_def_symbol s = symbols_defined := String.Set.add s !symbols_defined
|
|
|
|
let add_used_symbol s = symbols_used := String.Set.add s !symbols_used
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2015-03-11 09:02:20 -07:00
|
|
|
let imp_table = Hashtbl.create 16
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2015-03-11 09:02:20 -07:00
|
|
|
let reset_imp_table () = Hashtbl.clear imp_table
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2015-03-11 09:02:20 -07:00
|
|
|
let get_imp_symbol s =
|
|
|
|
match Hashtbl.find imp_table s with
|
|
|
|
| exception Not_found ->
|
|
|
|
let imps = "__caml_imp_" ^ s in
|
|
|
|
Hashtbl.add imp_table s imps;
|
|
|
|
imps
|
|
|
|
| imps -> imps
|
|
|
|
|
|
|
|
let emit_imp_table () =
|
|
|
|
let f s imps =
|
|
|
|
_label (emit_symbol imps);
|
|
|
|
D.qword (ConstLabel (emit_symbol s))
|
2015-01-22 08:31:51 -08:00
|
|
|
in
|
2015-03-11 09:02:20 -07:00
|
|
|
D.data();
|
|
|
|
D.comment "relocation table start";
|
|
|
|
D.align 8;
|
|
|
|
Hashtbl.iter f imp_table;
|
|
|
|
D.comment "relocation table end"
|
|
|
|
|
|
|
|
let mem__imp s =
|
|
|
|
let imp_s = get_imp_symbol s in
|
|
|
|
mem64_rip QWORD (emit_symbol imp_s)
|
|
|
|
|
|
|
|
let rel_plt s =
|
|
|
|
if windows && !Clflags.dlcode then mem__imp s
|
|
|
|
else
|
|
|
|
sym (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s)
|
2014-09-11 08:46:18 -07:00
|
|
|
|
2014-09-23 05:54:41 -07:00
|
|
|
let emit_call s = I.call (rel_plt s)
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2014-09-23 05:54:41 -07:00
|
|
|
let emit_jump s = I.jmp (rel_plt s)
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
let load_symbol_addr s arg =
|
2015-03-11 09:02:20 -07:00
|
|
|
if !Clflags.dlcode then
|
|
|
|
if windows then begin
|
|
|
|
(* I.mov (mem__imp s) arg (\* mov __caml_imp_foo(%rip), ... *\) *)
|
|
|
|
I.mov (sym (emit_symbol s)) arg (* movabsq $foo, ... *)
|
|
|
|
end else I.mov (mem64_rip QWORD (emit_symbol s ^ "@GOTPCREL")) arg
|
2015-01-24 08:35:26 -08:00
|
|
|
else if !Clflags.pic_code then
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (mem64_rip NONE (emit_symbol s)) arg
|
2014-08-18 02:32:20 -07:00
|
|
|
else
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (sym (emit_symbol s)) arg
|
2008-12-03 10:09:09 -08:00
|
|
|
|
2019-06-03 04:56:45 -07:00
|
|
|
let domain_field f =
|
|
|
|
mem64 QWORD (Domainstate.idx_of_field f * 8) R14
|
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Output a label *)
|
|
|
|
|
|
|
|
let emit_label lbl =
|
2014-09-23 05:54:41 -07:00
|
|
|
match system with
|
2018-08-30 10:15:32 -07:00
|
|
|
| S_macosx | S_win64 -> "L" ^ Int.to_string lbl
|
|
|
|
| _ -> ".L" ^ Int.to_string lbl
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2014-09-22 04:51:53 -07:00
|
|
|
let label s = sym (emit_label s)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2019-11-26 04:06:19 -08:00
|
|
|
let def_label ?typ s =
|
|
|
|
D.label ?typ (emit_label s)
|
2006-04-16 16:28:22 -07:00
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
let emit_Llabel fallthrough lbl =
|
2014-09-30 07:54:15 -07:00
|
|
|
if not fallthrough && !fastcode_flag then D.align 4;
|
2014-09-24 03:28:28 -07:00
|
|
|
def_label lbl
|
2006-04-16 16:28:22 -07:00
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Output a pseudo-register *)
|
|
|
|
|
2014-09-10 02:19:22 -07:00
|
|
|
let reg = function
|
2014-09-10 03:57:29 -07:00
|
|
|
| { loc = Reg.Reg r } -> register_name r
|
2014-08-18 02:32:20 -07:00
|
|
|
| { loc = Stack s; typ = Float } as r ->
|
2014-08-29 05:36:35 -07:00
|
|
|
let ofs = slot_offset s (register_class r) in
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 REAL8 ofs RSP
|
2003-06-30 01:28:48 -07:00
|
|
|
| { loc = Stack s } as r ->
|
|
|
|
let ofs = slot_offset s (register_class r) in
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 QWORD ofs RSP
|
2003-06-30 01:28:48 -07:00
|
|
|
| { loc = Unknown } ->
|
|
|
|
assert false
|
|
|
|
|
2014-09-10 03:57:29 -07:00
|
|
|
let reg64 = function
|
|
|
|
| { loc = Reg.Reg r } -> int_reg_name.(r)
|
|
|
|
| _ -> assert false
|
|
|
|
|
|
|
|
|
2014-09-23 05:54:41 -07:00
|
|
|
let res i n = reg i.res.(n)
|
2014-09-10 03:57:29 -07:00
|
|
|
|
2014-09-23 05:54:41 -07:00
|
|
|
let arg i n = reg i.arg.(n)
|
2014-09-10 03:57:29 -07:00
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Output a reference to the lower 8, 16 or 32 bits of a register *)
|
|
|
|
|
2014-09-29 06:39:01 -07:00
|
|
|
let reg_low_8_name = Array.map (fun r -> Reg8L r) int_reg_name
|
|
|
|
let reg_low_16_name = Array.map (fun r -> Reg16 r) int_reg_name
|
|
|
|
let reg_low_32_name = Array.map (fun r -> Reg32 r) int_reg_name
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2014-09-16 07:33:13 -07:00
|
|
|
let emit_subreg tbl typ r =
|
2003-06-30 01:28:48 -07:00
|
|
|
match r.loc with
|
2014-09-23 05:54:41 -07:00
|
|
|
| Reg.Reg r when r < 13 -> tbl.(r)
|
2014-09-30 07:41:41 -07:00
|
|
|
| Stack s -> mem64 typ (slot_offset s (register_class r)) RSP
|
2014-09-23 05:54:41 -07:00
|
|
|
| _ -> assert false
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2014-09-10 03:57:29 -07:00
|
|
|
let arg8 i n = emit_subreg reg_low_8_name BYTE i.arg.(n)
|
|
|
|
let arg16 i n = emit_subreg reg_low_16_name WORD i.arg.(n)
|
|
|
|
let arg32 i n = emit_subreg reg_low_32_name DWORD i.arg.(n)
|
|
|
|
let arg64 i n = reg64 i.arg.(n)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2014-09-10 03:57:29 -07:00
|
|
|
let res16 i n = emit_subreg reg_low_16_name WORD i.res.(n)
|
|
|
|
let res32 i n = emit_subreg reg_low_32_name DWORD i.res.(n)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
(* Output an addressing mode *)
|
|
|
|
|
2014-09-16 07:33:13 -07:00
|
|
|
let addressing addr typ i n =
|
2003-06-30 01:28:48 -07:00
|
|
|
match addr with
|
2014-09-10 03:57:29 -07:00
|
|
|
| Ibased(s, ofs) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
add_used_symbol s;
|
2014-09-30 07:45:35 -07:00
|
|
|
mem64_rip typ (emit_symbol s) ~ofs
|
2003-06-30 01:28:48 -07:00
|
|
|
| Iindexed d ->
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 typ d (arg64 i n)
|
2003-06-30 01:28:48 -07:00
|
|
|
| Iindexed2 d ->
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 typ ~base:(arg64 i n) d (arg64 i (n+1))
|
2003-06-30 01:28:48 -07:00
|
|
|
| Iscaled(2, d) ->
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 typ ~base:(arg64 i n) d (arg64 i n)
|
2003-06-30 01:28:48 -07:00
|
|
|
| Iscaled(scale, d) ->
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 typ ~scale d (arg64 i n)
|
2003-06-30 01:28:48 -07:00
|
|
|
| Iindexed2scaled(scale, d) ->
|
2014-09-30 07:41:41 -07:00
|
|
|
mem64 typ ~scale ~base:(arg64 i n) d (arg64 i (n+1))
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2007-01-29 04:11:18 -08:00
|
|
|
(* Record live pointers at call points -- see Emitaux *)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2019-04-23 06:11:11 -07:00
|
|
|
let record_frame_label ?label live dbg =
|
2016-07-06 03:44:00 -07:00
|
|
|
let lbl =
|
|
|
|
match label with
|
|
|
|
| None -> new_label()
|
|
|
|
| Some label -> label
|
|
|
|
in
|
2003-06-30 01:28:48 -07:00
|
|
|
let live_offset = ref [] in
|
|
|
|
Reg.Set.iter
|
|
|
|
(function
|
2014-11-06 00:54:14 -08:00
|
|
|
| {typ = Val; loc = Reg r} ->
|
2003-06-30 01:28:48 -07:00
|
|
|
live_offset := ((r lsl 1) + 1) :: !live_offset
|
2014-11-06 00:54:14 -08:00
|
|
|
| {typ = Val; loc = Stack s} as reg ->
|
2003-06-30 01:28:48 -07:00
|
|
|
live_offset := slot_offset s (register_class reg) :: !live_offset
|
2014-11-06 00:54:14 -08:00
|
|
|
| {typ = Addr} as r ->
|
|
|
|
Misc.fatal_error ("bad GC root " ^ Reg.name r)
|
2014-09-23 05:54:41 -07:00
|
|
|
| _ -> ()
|
|
|
|
)
|
2003-06-30 01:28:48 -07:00
|
|
|
live;
|
2016-12-09 07:41:22 -08:00
|
|
|
record_frame_descr ~label:lbl ~frame_size:(frame_size())
|
2019-04-23 06:11:11 -07:00
|
|
|
~live_offset:!live_offset dbg;
|
2003-06-30 01:28:48 -07:00
|
|
|
lbl
|
|
|
|
|
2019-04-23 06:11:11 -07:00
|
|
|
let record_frame ?label live dbg =
|
|
|
|
let lbl = record_frame_label ?label live dbg in
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label lbl
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
(* Record calls to the GC -- we've moved them out of the way *)
|
|
|
|
|
|
|
|
type gc_call =
|
2019-09-18 08:15:18 -07:00
|
|
|
{ gc_lbl: label; (* Entry label *)
|
2003-06-30 01:28:48 -07:00
|
|
|
gc_return_lbl: label; (* Where to branch after GC *)
|
2016-07-29 07:07:10 -07:00
|
|
|
gc_frame: label; (* Label of frame descriptor *)
|
|
|
|
}
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let call_gc_sites = ref ([] : gc_call list)
|
|
|
|
|
|
|
|
let emit_call_gc gc =
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label gc.gc_lbl;
|
2019-07-16 08:24:01 -07:00
|
|
|
emit_call "caml_call_gc";
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label gc.gc_frame;
|
|
|
|
I.jmp (label gc.gc_return_lbl)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2007-01-29 04:11:18 -08:00
|
|
|
(* Record calls to caml_ml_array_bound_error.
|
2020-10-08 06:19:31 -07:00
|
|
|
In -g mode we maintain one call to
|
2016-07-29 07:07:10 -07:00
|
|
|
caml_ml_array_bound_error per bound check site. Without -g, we can share
|
|
|
|
a single call. *)
|
2007-01-29 04:11:18 -08:00
|
|
|
|
|
|
|
type bound_error_call =
|
|
|
|
{ bd_lbl: label; (* Entry label *)
|
2016-07-29 07:07:10 -07:00
|
|
|
bd_frame: label; (* Label of frame descriptor *)
|
|
|
|
(* As for [gc_call]. *)
|
|
|
|
}
|
2007-01-29 04:11:18 -08:00
|
|
|
|
|
|
|
let bound_error_sites = ref ([] : bound_error_call list)
|
|
|
|
let bound_error_call = ref 0
|
|
|
|
|
2020-10-08 06:19:31 -07:00
|
|
|
let bound_error_label ?label dbg =
|
|
|
|
if !Clflags.debug then begin
|
2007-01-29 04:11:18 -08:00
|
|
|
let lbl_bound_error = new_label() in
|
2019-04-23 06:11:11 -07:00
|
|
|
let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
|
2007-01-29 04:11:18 -08:00
|
|
|
bound_error_sites :=
|
2020-10-08 06:19:31 -07:00
|
|
|
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame; } :: !bound_error_sites;
|
2014-08-29 05:36:35 -07:00
|
|
|
lbl_bound_error
|
|
|
|
end else begin
|
|
|
|
if !bound_error_call = 0 then bound_error_call := new_label();
|
|
|
|
!bound_error_call
|
|
|
|
end
|
2007-01-29 04:11:18 -08:00
|
|
|
|
|
|
|
let emit_call_bound_error bd =
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label bd.bd_lbl;
|
2014-08-18 02:32:20 -07:00
|
|
|
emit_call "caml_ml_array_bound_error";
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label bd.bd_frame
|
2007-01-29 04:11:18 -08:00
|
|
|
|
|
|
|
let emit_call_bound_errors () =
|
|
|
|
List.iter emit_call_bound_error !bound_error_sites;
|
2014-08-18 02:32:20 -07:00
|
|
|
if !bound_error_call > 0 then begin
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label !bound_error_call;
|
2014-08-18 02:32:20 -07:00
|
|
|
emit_call "caml_ml_array_bound_error"
|
|
|
|
end
|
2007-01-29 04:11:18 -08:00
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Names for instructions *)
|
|
|
|
|
|
|
|
let instr_for_intop = function
|
2014-09-30 07:18:25 -07:00
|
|
|
| Iadd -> I.add
|
|
|
|
| Isub -> I.sub
|
2014-11-27 09:20:22 -08:00
|
|
|
| Imul -> (fun arg1 arg2 -> I.imul arg1 (Some arg2))
|
2014-09-30 07:18:25 -07:00
|
|
|
| Iand -> I.and_
|
|
|
|
| Ior -> I.or_
|
|
|
|
| Ixor -> I.xor
|
|
|
|
| Ilsl -> I.sal
|
|
|
|
| Ilsr -> I.shr
|
|
|
|
| Iasr -> I.sar
|
2003-06-30 01:28:48 -07:00
|
|
|
| _ -> assert false
|
|
|
|
|
|
|
|
let instr_for_floatop = function
|
2014-09-17 05:44:16 -07:00
|
|
|
| Iaddf -> I.addsd
|
2014-08-18 02:32:20 -07:00
|
|
|
| Isubf -> I.subsd
|
|
|
|
| Imulf -> I.mulsd
|
|
|
|
| Idivf -> I.divsd
|
2003-06-30 01:28:48 -07:00
|
|
|
| _ -> assert false
|
|
|
|
|
|
|
|
let instr_for_floatarithmem = function
|
2014-09-17 05:44:16 -07:00
|
|
|
| Ifloatadd -> I.addsd
|
2014-08-18 02:32:20 -07:00
|
|
|
| Ifloatsub -> I.subsd
|
|
|
|
| Ifloatmul -> I.mulsd
|
|
|
|
| Ifloatdiv -> I.divsd
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2014-09-24 08:53:26 -07:00
|
|
|
let cond = function
|
2014-09-17 05:44:16 -07:00
|
|
|
| Isigned Ceq -> E | Isigned Cne -> NE
|
|
|
|
| Isigned Cle -> LE | Isigned Cgt -> G
|
|
|
|
| Isigned Clt -> L | Isigned Cge -> GE
|
2014-08-18 02:32:20 -07:00
|
|
|
| Iunsigned Ceq -> E | Iunsigned Cne -> NE
|
|
|
|
| Iunsigned Cle -> BE | Iunsigned Cgt -> A
|
2014-09-17 05:44:16 -07:00
|
|
|
| Iunsigned Clt -> B | Iunsigned Cge -> AE
|
2006-04-16 16:28:22 -07:00
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Output an = 0 or <> 0 test. *)
|
|
|
|
|
|
|
|
let output_test_zero arg =
|
|
|
|
match arg.loc with
|
2014-11-27 09:20:22 -08:00
|
|
|
| Reg.Reg _ -> I.test (reg arg) (reg arg)
|
|
|
|
| _ -> I.cmp (int 0) (reg arg)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
(* Output a floating-point compare and branch *)
|
|
|
|
|
2018-02-28 05:19:46 -08:00
|
|
|
let emit_float_test cmp i lbl =
|
2010-05-24 08:26:23 -07:00
|
|
|
(* Effect of comisd on flags and conditional branches:
|
|
|
|
ZF PF CF cond. branches taken
|
|
|
|
unordered 1 1 1 je, jb, jbe, jp
|
|
|
|
> 0 0 0 jne, jae, ja
|
|
|
|
< 0 0 1 jne, jbe, jb
|
|
|
|
= 1 0 0 je, jae, jbe.
|
|
|
|
If FP traps are on (they are off by default),
|
|
|
|
comisd traps on QNaN and SNaN but ucomisd traps on SNaN only.
|
|
|
|
*)
|
2018-02-28 05:19:46 -08:00
|
|
|
match cmp with
|
|
|
|
| CFeq ->
|
2003-06-30 01:28:48 -07:00
|
|
|
let next = new_label() in
|
2014-11-27 09:20:22 -08:00
|
|
|
I.ucomisd (arg i 1) (arg i 0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.jp (label next); (* skip if unordered *)
|
|
|
|
I.je lbl; (* branch taken if x=y *)
|
2014-09-10 02:19:22 -07:00
|
|
|
def_label next
|
2018-02-28 05:19:46 -08:00
|
|
|
| CFneq ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.ucomisd (arg i 1) (arg i 0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.jp lbl; (* branch taken if unordered *)
|
|
|
|
I.jne lbl (* branch taken if x<y or x>y *)
|
2018-02-28 05:19:46 -08:00
|
|
|
| CFlt ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.comisd (arg i 0) (arg i 1);
|
2018-02-28 05:19:46 -08:00
|
|
|
I.ja lbl (* branch taken if y>x i.e. x<y *)
|
|
|
|
| CFnlt ->
|
|
|
|
I.comisd (arg i 0) (arg i 1);
|
|
|
|
I.jbe lbl (* taken if unordered or y<=x i.e. !(x<y) *)
|
|
|
|
| CFle ->
|
|
|
|
I.comisd (arg i 0) (arg i 1);(* swap compare *)
|
|
|
|
I.jae lbl (* branch taken if y>=x i.e. x<=y *)
|
|
|
|
| CFnle ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.comisd (arg i 0) (arg i 1);(* swap compare *)
|
2018-02-28 05:19:46 -08:00
|
|
|
I.jb lbl (* taken if unordered or y<x i.e. !(x<=y) *)
|
|
|
|
| CFgt ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.comisd (arg i 1) (arg i 0);
|
2018-02-28 05:19:46 -08:00
|
|
|
I.ja lbl (* branch taken if x>y *)
|
|
|
|
| CFngt ->
|
|
|
|
I.comisd (arg i 1) (arg i 0);
|
|
|
|
I.jbe lbl (* taken if unordered or x<=y i.e. !(x>y) *)
|
|
|
|
| CFge ->
|
|
|
|
I.comisd (arg i 1) (arg i 0);(* swap compare *)
|
|
|
|
I.jae lbl (* branch taken if x>=y *)
|
|
|
|
| CFnge ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.comisd (arg i 1) (arg i 0);(* swap compare *)
|
2018-02-28 05:19:46 -08:00
|
|
|
I.jb lbl (* taken if unordered or x<y i.e. !(x>=y) *)
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
(* Deallocate the stack frame before a return or tail call *)
|
|
|
|
|
2012-02-21 09:41:02 -08:00
|
|
|
let output_epilogue f =
|
2019-08-14 04:52:05 -07:00
|
|
|
if !frame_required then begin
|
2013-06-03 11:03:59 -07:00
|
|
|
let n = frame_size() - 8 - (if fp then 8 else 0) in
|
2015-06-17 02:21:36 -07:00
|
|
|
if n <> 0
|
|
|
|
then begin
|
|
|
|
I.add (int n) rsp;
|
|
|
|
cfi_adjust_cfa_offset (-n);
|
2013-06-03 11:03:59 -07:00
|
|
|
end;
|
2014-09-30 07:18:25 -07:00
|
|
|
if fp then I.pop rbp;
|
2012-02-21 09:41:02 -08:00
|
|
|
f ();
|
|
|
|
(* reset CFA back cause function body may continue *)
|
2015-06-17 02:21:36 -07:00
|
|
|
if n <> 0
|
|
|
|
then cfi_adjust_cfa_offset n
|
2003-06-30 01:28:48 -07:00
|
|
|
end
|
2012-02-21 09:41:02 -08:00
|
|
|
else
|
|
|
|
f ()
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2012-12-21 10:33:32 -08:00
|
|
|
(* Floating-point constants *)
|
|
|
|
|
2014-04-25 01:41:13 -07:00
|
|
|
let float_constants = ref ([] : (int64 * int) list)
|
2012-12-21 10:33:32 -08:00
|
|
|
|
|
|
|
let add_float_constant cst =
|
|
|
|
try
|
2015-11-19 00:25:02 -08:00
|
|
|
List.assoc cst !float_constants
|
2014-09-23 05:54:41 -07:00
|
|
|
with Not_found ->
|
|
|
|
let lbl = new_label() in
|
2015-11-19 00:25:02 -08:00
|
|
|
float_constants := (cst, lbl) :: !float_constants;
|
2014-09-23 05:54:41 -07:00
|
|
|
lbl
|
2012-12-21 10:33:32 -08:00
|
|
|
|
2014-08-18 02:32:20 -07:00
|
|
|
let emit_float_constant f lbl =
|
|
|
|
_label (emit_label lbl);
|
2014-09-30 07:54:15 -07:00
|
|
|
D.qword (Const f)
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2014-09-10 04:33:03 -07:00
|
|
|
let emit_global_label s =
|
|
|
|
let lbl = Compilenv.make_symbol (Some s) in
|
|
|
|
add_def_symbol lbl;
|
2014-08-18 02:32:20 -07:00
|
|
|
let lbl = emit_symbol lbl in
|
2014-09-30 07:54:15 -07:00
|
|
|
D.global lbl;
|
2014-08-18 02:32:20 -07:00
|
|
|
_label lbl
|
2012-12-21 10:33:32 -08:00
|
|
|
|
2019-07-08 07:41:06 -07:00
|
|
|
(* Output .text section directive, or named .text.caml.<name> if enabled and
|
2019-02-20 10:46:43 -08:00
|
|
|
supported on the target system. *)
|
|
|
|
|
|
|
|
let emit_named_text_section func_name =
|
2019-06-27 09:07:25 -07:00
|
|
|
if !Clflags.function_sections then
|
2019-02-20 10:46:43 -08:00
|
|
|
begin match system with
|
|
|
|
| S_macosx
|
|
|
|
(* Names of section segments in macosx are restricted to 16 characters,
|
|
|
|
but function names are often longer, especially anonymous functions. *)
|
|
|
|
| S_win64 | S_mingw64 | S_cygwin
|
|
|
|
(* Win systems provide named text sections, but configure on these
|
|
|
|
systems does not support function sections. *)
|
|
|
|
-> assert false
|
|
|
|
| _ -> D.section
|
2019-07-08 07:41:06 -07:00
|
|
|
[ ".text.caml."^(emit_symbol func_name) ]
|
2019-02-20 10:46:43 -08:00
|
|
|
(Some "ax")
|
|
|
|
["@progbits"]
|
|
|
|
end
|
|
|
|
else D.text ()
|
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Output the assembly code for an instruction *)
|
|
|
|
|
|
|
|
(* Name of current function *)
|
|
|
|
let function_name = ref ""
|
|
|
|
(* Entry point for tail recursive calls *)
|
|
|
|
let tailrec_entry_point = ref 0
|
|
|
|
|
2012-02-21 09:41:02 -08:00
|
|
|
(* Emit an instruction *)
|
2003-06-30 01:28:48 -07:00
|
|
|
let emit_instr fallthrough i =
|
2014-08-18 02:32:20 -07:00
|
|
|
emit_debug_info i.dbg;
|
|
|
|
match i.desc with
|
2014-09-23 05:54:41 -07:00
|
|
|
| Lend -> ()
|
2018-09-24 02:03:26 -07:00
|
|
|
| Lprologue ->
|
2019-08-14 04:52:05 -07:00
|
|
|
assert (!prologue_required);
|
2018-09-24 02:03:26 -07:00
|
|
|
if fp then begin
|
|
|
|
I.push rbp;
|
|
|
|
cfi_adjust_cfa_offset 8;
|
|
|
|
I.mov rsp rbp;
|
|
|
|
end;
|
2019-08-14 04:52:05 -07:00
|
|
|
if !frame_required then begin
|
2018-09-24 02:03:26 -07:00
|
|
|
let n = frame_size() - 8 - (if fp then 8 else 0) in
|
|
|
|
if n <> 0
|
|
|
|
then begin
|
|
|
|
I.sub (int n) rsp;
|
|
|
|
cfi_adjust_cfa_offset n;
|
|
|
|
end;
|
2019-03-29 04:47:53 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Imove | Ispill | Ireload) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
let src = i.arg.(0) and dst = i.res.(0) in
|
|
|
|
if src.loc <> dst.loc then
|
|
|
|
begin match src.typ, src.loc, dst.loc with
|
2014-11-27 09:20:22 -08:00
|
|
|
| Float, Reg.Reg _, Reg.Reg _ -> I.movapd (reg src) (reg dst)
|
|
|
|
| Float, _, _ -> I.movsd (reg src) (reg dst)
|
|
|
|
| _ -> I.mov (reg src) (reg dst)
|
2003-06-30 01:28:48 -07:00
|
|
|
end
|
2016-07-29 07:07:10 -07:00
|
|
|
| Lop(Iconst_int n) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
if n = 0n then begin
|
|
|
|
match i.res.(0).loc with
|
2019-09-26 07:39:25 -07:00
|
|
|
| Reg _ ->
|
|
|
|
(* Clearing the bottom half also clears the top half (except for
|
|
|
|
64-bit-only registers where the behaviour is as if the operands
|
|
|
|
were 64 bit). *)
|
|
|
|
I.xor (res32 i 0) (res32 i 0)
|
|
|
|
| _ ->
|
|
|
|
I.mov (int 0) (res i 0)
|
|
|
|
end else if n > 0n && n <= 0xFFFF_FFFFn then begin
|
|
|
|
match i.res.(0).loc with
|
|
|
|
| Reg _ ->
|
|
|
|
(* Similarly, setting only the bottom half clears the top half. *)
|
|
|
|
I.mov (nat n) (res32 i 0)
|
|
|
|
| _ ->
|
|
|
|
I.mov (nat n) (res i 0)
|
|
|
|
end else
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (nat n) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iconst_float f) ->
|
2015-11-19 00:25:02 -08:00
|
|
|
begin match f with
|
2014-08-18 02:32:20 -07:00
|
|
|
| 0x0000_0000_0000_0000L -> (* +0.0 *)
|
2014-11-27 09:20:22 -08:00
|
|
|
I.xorpd (res i 0) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| _ ->
|
2014-04-25 01:41:13 -07:00
|
|
|
let lbl = add_float_constant f in
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsd (mem64_rip NONE (emit_label lbl)) (res i 0)
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iconst_symbol s) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
add_used_symbol s;
|
2014-09-10 03:57:29 -07:00
|
|
|
load_symbol_addr s (res i 0)
|
2016-07-06 03:44:00 -07:00
|
|
|
| Lop(Icall_ind { label_after; }) ->
|
2014-09-10 03:57:29 -07:00
|
|
|
I.call (arg i 0);
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame i.live (Dbg_other i.dbg) ~label:label_after
|
2016-07-06 03:44:00 -07:00
|
|
|
| Lop(Icall_imm { func; label_after; }) ->
|
|
|
|
add_used_symbol func;
|
|
|
|
emit_call func;
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame i.live (Dbg_other i.dbg) ~label:label_after
|
2020-10-08 06:19:31 -07:00
|
|
|
| Lop(Itailcall_ind { label_after = _; }) ->
|
2014-08-18 02:32:20 -07:00
|
|
|
output_epilogue begin fun () ->
|
2020-10-08 06:19:31 -07:00
|
|
|
I.jmp (arg i 0)
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2020-10-08 06:19:31 -07:00
|
|
|
| Lop(Itailcall_imm { func; label_after = _; }) ->
|
2016-07-29 07:07:10 -07:00
|
|
|
begin
|
|
|
|
if func = !function_name then
|
|
|
|
I.jmp (label !tailrec_entry_point)
|
|
|
|
else begin
|
|
|
|
output_epilogue begin fun () ->
|
|
|
|
add_used_symbol func;
|
|
|
|
emit_jump func
|
|
|
|
end
|
2003-06-30 01:28:48 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
end
|
2016-07-06 03:44:00 -07:00
|
|
|
| Lop(Iextcall { func; alloc; label_after; }) ->
|
|
|
|
add_used_symbol func;
|
2014-08-29 05:36:35 -07:00
|
|
|
if alloc then begin
|
2016-07-06 03:44:00 -07:00
|
|
|
load_symbol_addr func rax;
|
2014-08-29 05:36:35 -07:00
|
|
|
emit_call "caml_c_call";
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame i.live (Dbg_other i.dbg) ~label:label_after;
|
2014-09-02 05:34:31 -07:00
|
|
|
if system <> S_win64 then begin
|
|
|
|
(* TODO: investigate why such a diff.
|
|
|
|
This comes from:
|
2015-09-11 04:58:31 -07:00
|
|
|
http://caml.inria.fr/cgi-bin/viewvc.cgi?view=revision&revision=12664
|
2014-09-02 05:34:31 -07:00
|
|
|
|
|
|
|
If we do the same for Win64, we probably need to change
|
|
|
|
amd64nt.asm accordingly.
|
|
|
|
*)
|
2019-06-03 07:13:15 -07:00
|
|
|
I.mov (domain_field Domainstate.Domain_young_ptr) r15
|
2016-07-29 07:07:10 -07:00
|
|
|
end
|
|
|
|
end else begin
|
2020-10-08 06:19:31 -07:00
|
|
|
emit_call func
|
2016-07-29 07:07:10 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Istackoffset n) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
if n < 0
|
2014-11-27 09:20:22 -08:00
|
|
|
then I.add (int (-n)) rsp
|
2015-06-17 02:21:36 -07:00
|
|
|
else if n > 0
|
|
|
|
then I.sub (int n) rsp;
|
|
|
|
if n <> 0
|
|
|
|
then cfi_adjust_cfa_offset n;
|
2014-08-29 05:36:35 -07:00
|
|
|
stack_offset := !stack_offset + n
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iload(chunk, addr)) ->
|
2014-09-10 03:57:29 -07:00
|
|
|
let dest = res i 0 in
|
2014-08-29 05:36:35 -07:00
|
|
|
begin match chunk with
|
2015-07-27 01:18:53 -07:00
|
|
|
| Word_int | Word_val ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (addressing addr QWORD i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Byte_unsigned ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movzx (addressing addr BYTE i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Byte_signed ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsx (addressing addr BYTE i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Sixteen_unsigned ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movzx (addressing addr WORD i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Sixteen_signed ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsx (addressing addr WORD i 0) dest;
|
2014-08-18 02:32:20 -07:00
|
|
|
| Thirtytwo_unsigned ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (addressing addr DWORD i 0) (res32 i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Thirtytwo_signed ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsxd (addressing addr DWORD i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Single ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cvtss2sd (addressing addr REAL4 i 0) dest
|
2014-08-18 02:32:20 -07:00
|
|
|
| Double | Double_u ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsd (addressing addr REAL8 i 0) dest
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Istore(chunk, addr, _)) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
begin match chunk with
|
2015-07-27 01:18:53 -07:00
|
|
|
| Word_int | Word_val ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (arg i 0) (addressing addr QWORD i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Byte_unsigned | Byte_signed ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (arg8 i 0) (addressing addr BYTE i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Sixteen_unsigned | Sixteen_signed ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (arg16 i 0) (addressing addr WORD i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Thirtytwo_signed | Thirtytwo_unsigned ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (arg32 i 0) (addressing addr DWORD i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Single ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cvtsd2ss (arg i 0) xmm15;
|
|
|
|
I.movss xmm15 (addressing addr REAL4 i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Double | Double_u ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsd (arg i 0) (addressing addr REAL8 i 1)
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2020-10-08 06:19:31 -07:00
|
|
|
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
|
2019-07-31 06:49:44 -07:00
|
|
|
assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
|
2019-07-16 08:24:01 -07:00
|
|
|
if !fastcode_flag then begin
|
2014-11-27 09:20:22 -08:00
|
|
|
I.sub (int n) r15;
|
2019-06-03 07:13:15 -07:00
|
|
|
I.cmp (domain_field Domainstate.Domain_young_limit) r15;
|
2014-08-29 05:36:35 -07:00
|
|
|
let lbl_call_gc = new_label() in
|
2016-07-29 07:07:10 -07:00
|
|
|
let lbl_frame =
|
2019-07-16 08:24:01 -07:00
|
|
|
record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
|
2016-07-29 07:07:10 -07:00
|
|
|
in
|
2014-09-10 02:19:22 -07:00
|
|
|
I.jb (label lbl_call_gc);
|
2019-07-16 08:24:01 -07:00
|
|
|
let lbl_after_alloc = new_label() in
|
|
|
|
def_label lbl_after_alloc;
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (mem64 NONE 8 R15) (res i 0);
|
2014-08-29 05:36:35 -07:00
|
|
|
call_gc_sites :=
|
2019-09-18 08:15:18 -07:00
|
|
|
{ gc_lbl = lbl_call_gc;
|
2019-07-16 08:24:01 -07:00
|
|
|
gc_return_lbl = lbl_after_alloc;
|
2020-10-08 06:19:31 -07:00
|
|
|
gc_frame = lbl_frame; } :: !call_gc_sites
|
2014-08-29 05:36:35 -07:00
|
|
|
end else begin
|
|
|
|
begin match n with
|
2014-09-11 08:51:47 -07:00
|
|
|
| 16 -> emit_call "caml_alloc1"
|
2014-08-18 02:32:20 -07:00
|
|
|
| 24 -> emit_call "caml_alloc2"
|
|
|
|
| 32 -> emit_call "caml_alloc3"
|
2014-09-11 08:51:47 -07:00
|
|
|
| _ ->
|
2020-03-09 11:52:36 -07:00
|
|
|
I.sub (int n) r15;
|
2014-08-29 05:36:35 -07:00
|
|
|
emit_call "caml_allocN"
|
|
|
|
end;
|
2016-07-06 03:44:00 -07:00
|
|
|
let label =
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame_label ?label:label_after_call_gc i.live
|
2019-07-16 08:24:01 -07:00
|
|
|
(Dbg_alloc dbginfo)
|
2016-07-06 03:44:00 -07:00
|
|
|
in
|
|
|
|
def_label label;
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (mem64 NONE 8 R15) (res i 0)
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop(Icomp cmp)) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (arg i 1) (arg i 0);
|
2014-09-24 08:53:26 -07:00
|
|
|
I.set (cond cmp) al;
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movzx al (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop_imm(Icomp cmp, n)) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (int n) (arg i 0);
|
2014-09-24 08:53:26 -07:00
|
|
|
I.set (cond cmp) al;
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movzx al (res i 0)
|
2020-10-08 06:19:31 -07:00
|
|
|
| Lop(Iintop (Icheckbound { label_after_error; } )) ->
|
|
|
|
let lbl = bound_error_label ?label:label_after_error i.dbg in
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (arg i 1) (arg i 0);
|
2014-09-10 02:19:22 -07:00
|
|
|
I.jbe (label lbl)
|
2020-10-08 06:19:31 -07:00
|
|
|
| Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
|
|
|
|
let lbl = bound_error_label ?label:label_after_error i.dbg in
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (int n) (arg i 0);
|
2014-09-10 02:19:22 -07:00
|
|
|
I.jbe (label lbl)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop(Idiv | Imod)) ->
|
2014-09-30 07:18:25 -07:00
|
|
|
I.cqo ();
|
|
|
|
I.idiv (arg i 1)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
(* We have i.arg.(0) = i.res.(0) and i.arg.(1) = %rcx *)
|
2014-11-27 09:20:22 -08:00
|
|
|
instr_for_intop op cl (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop Imulh) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.imul (arg i 1) None
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop op) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
(* We have i.arg.(0) = i.res.(0) *)
|
2014-11-27 09:20:22 -08:00
|
|
|
instr_for_intop op (arg i 1) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop_imm(Iadd, n)) when i.arg.(0).loc <> i.res.(0).loc ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (mem64 NONE n (arg64 i 0)) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop_imm(Iadd, 1) | Iintop_imm(Isub, -1)) ->
|
2014-09-30 07:18:25 -07:00
|
|
|
I.inc (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop_imm(Iadd, -1) | Iintop_imm(Isub, 1)) ->
|
2014-09-30 07:18:25 -07:00
|
|
|
I.dec (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintop_imm(op, n)) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
(* We have i.arg.(0) = i.res.(0) *)
|
2014-11-27 09:20:22 -08:00
|
|
|
instr_for_intop op (int n) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Inegf) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.xorpd (mem64_rip OWORD (emit_symbol "caml_negf_mask")) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iabsf) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.andpd (mem64_rip OWORD (emit_symbol "caml_absf_mask")) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iaddf | Isubf | Imulf | Idivf as floatop) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
instr_for_floatop floatop (arg i 1) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ifloatofint) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cvtsi2sd (arg i 0) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Iintoffloat) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cvttsd2si (arg i 0) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific(Ilea addr)) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (addressing addr NONE i 0) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific(Istore_int(n, addr, _))) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.mov (nat n) (addressing addr QWORD i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific(Ioffset_loc(n, addr))) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.add (int n) (addressing addr QWORD i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific(Ifloatarithmem(op, addr))) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
instr_for_floatarithmem op (addressing addr REAL8 i 1) (res i 0)
|
2014-09-11 08:51:47 -07:00
|
|
|
| Lop(Ispecific(Ibswap 16)) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.xchg ah al;
|
|
|
|
I.movzx (res16 i 0) (res i 0)
|
2014-09-11 08:51:47 -07:00
|
|
|
| Lop(Ispecific(Ibswap 32)) ->
|
|
|
|
I.bswap (res32 i 0);
|
2014-11-27 09:20:22 -08:00
|
|
|
I.movsxd (res32 i 0) (res i 0)
|
2014-09-11 08:51:47 -07:00
|
|
|
| Lop(Ispecific(Ibswap 64)) ->
|
|
|
|
I.bswap (res i 0)
|
|
|
|
| Lop(Ispecific(Ibswap _)) ->
|
|
|
|
assert false
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific Isqrtf) ->
|
2019-10-15 10:04:20 -07:00
|
|
|
if arg i 0 <> res i 0 then
|
|
|
|
I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
|
2014-11-27 09:20:22 -08:00
|
|
|
I.sqrtsd (arg i 0) (res i 0)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lop(Ispecific(Ifloatsqrtf addr)) ->
|
2019-10-15 10:04:20 -07:00
|
|
|
I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
|
2014-11-27 09:20:22 -08:00
|
|
|
I.sqrtsd (addressing addr REAL8 i 0) (res i 0)
|
2018-05-28 06:38:57 -07:00
|
|
|
| Lop(Ispecific(Isextend32)) ->
|
|
|
|
I.movsxd (arg32 i 0) (res i 0)
|
2019-10-01 10:31:48 -07:00
|
|
|
| Lop(Ispecific(Izextend32)) ->
|
|
|
|
I.mov (arg32 i 0) (res32 i 0)
|
2017-09-15 03:08:14 -07:00
|
|
|
| Lop (Iname_for_debugger _) -> ()
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lreloadretaddr ->
|
2014-08-29 05:36:35 -07:00
|
|
|
()
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lreturn ->
|
2014-08-29 05:36:35 -07:00
|
|
|
output_epilogue begin fun () ->
|
2014-09-10 02:07:50 -07:00
|
|
|
I.ret ()
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Llabel lbl ->
|
2014-09-24 03:28:28 -07:00
|
|
|
emit_Llabel fallthrough lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lbranch lbl ->
|
2014-09-10 02:19:22 -07:00
|
|
|
I.jmp (label lbl)
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lcondbranch(tst, lbl) ->
|
2014-09-10 04:33:03 -07:00
|
|
|
let lbl = label lbl in
|
2014-08-29 05:36:35 -07:00
|
|
|
begin match tst with
|
2014-09-23 05:54:41 -07:00
|
|
|
| Itruetest ->
|
2014-08-29 05:36:35 -07:00
|
|
|
output_test_zero i.arg.(0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.jne lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Ifalsetest ->
|
2014-08-29 05:36:35 -07:00
|
|
|
output_test_zero i.arg.(0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.je lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Iinttest cmp ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (arg i 1) (arg i 0);
|
2014-09-24 08:53:26 -07:00
|
|
|
I.j (cond cmp) lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Iinttest_imm((Isigned Ceq | Isigned Cne |
|
|
|
|
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
|
2014-08-29 05:36:35 -07:00
|
|
|
output_test_zero i.arg.(0);
|
2014-09-24 08:53:26 -07:00
|
|
|
I.j (cond cmp) lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Iinttest_imm(cmp, n) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (int n) (arg i 0);
|
2014-09-24 08:53:26 -07:00
|
|
|
I.j (cond cmp) lbl
|
2018-02-28 05:19:46 -08:00
|
|
|
| Ifloattest cmp ->
|
|
|
|
emit_float_test cmp i lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Ioddtest ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.test (int 1) (arg8 i 0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.jne lbl
|
2014-08-18 02:32:20 -07:00
|
|
|
| Ieventest ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.test (int 1) (arg8 i 0);
|
2014-09-10 04:33:03 -07:00
|
|
|
I.je lbl
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lcondbranch3(lbl0, lbl1, lbl2) ->
|
2014-11-27 09:20:22 -08:00
|
|
|
I.cmp (int 1) (arg i 0);
|
2014-08-29 05:36:35 -07:00
|
|
|
begin match lbl0 with
|
2014-09-23 05:54:41 -07:00
|
|
|
| None -> ()
|
2014-09-10 02:19:22 -07:00
|
|
|
| Some lbl -> I.jb (label lbl)
|
2014-08-29 05:36:35 -07:00
|
|
|
end;
|
|
|
|
begin match lbl1 with
|
2014-09-23 05:54:41 -07:00
|
|
|
| None -> ()
|
2014-09-10 02:19:22 -07:00
|
|
|
| Some lbl -> I.je (label lbl)
|
2014-08-29 05:36:35 -07:00
|
|
|
end;
|
|
|
|
begin match lbl2 with
|
2014-09-23 05:54:41 -07:00
|
|
|
| None -> ()
|
2019-06-03 07:30:34 -07:00
|
|
|
| Some lbl -> I.ja (label lbl)
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lswitch jumptbl ->
|
2014-09-23 05:54:41 -07:00
|
|
|
let lbl = emit_label (new_label()) in
|
2014-08-29 05:36:35 -07:00
|
|
|
(* rax and rdx are clobbered by the Lswitch,
|
|
|
|
meaning that no variable that is live across the Lswitch
|
|
|
|
is assigned to rax or rdx. However, the argument to Lswitch
|
|
|
|
can still be assigned to one of these two registers, so
|
|
|
|
we must be careful not to clobber it before use. *)
|
|
|
|
let (tmp1, tmp2) =
|
|
|
|
if i.arg.(0).loc = Reg 0 (* rax *)
|
|
|
|
then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*))
|
|
|
|
else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in
|
|
|
|
|
2014-11-27 09:20:22 -08:00
|
|
|
I.lea (mem64_rip NONE lbl) (reg tmp1);
|
2015-09-11 04:58:31 -07:00
|
|
|
I.movsxd (mem64 DWORD 0 (arg64 i 0) ~scale:4 ~base:(reg64 tmp1))
|
|
|
|
(reg tmp2);
|
2014-11-27 09:20:22 -08:00
|
|
|
I.add (reg tmp2) (reg tmp1);
|
2014-09-10 02:19:22 -07:00
|
|
|
I.jmp (reg tmp1);
|
2014-08-29 05:36:35 -07:00
|
|
|
|
|
|
|
begin match system with
|
2014-09-30 07:54:15 -07:00
|
|
|
| S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
|
2016-01-29 16:46:26 -08:00
|
|
|
| S_macosx | S_win64 -> () (* with LLVM/OS X and MASM, use the text segment *)
|
2014-09-30 07:54:15 -07:00
|
|
|
| _ -> D.section [".rodata"] None []
|
2014-08-29 05:36:35 -07:00
|
|
|
end;
|
2014-09-30 07:54:15 -07:00
|
|
|
D.align 4;
|
2014-09-23 05:54:41 -07:00
|
|
|
_label lbl;
|
2014-08-29 05:36:35 -07:00
|
|
|
for i = 0 to Array.length jumptbl - 1 do
|
2014-09-30 07:54:15 -07:00
|
|
|
D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)),
|
2014-09-23 05:54:41 -07:00
|
|
|
ConstLabel lbl))
|
2014-08-29 05:36:35 -07:00
|
|
|
done;
|
2019-02-20 10:46:43 -08:00
|
|
|
emit_named_text_section !function_name
|
2019-03-07 02:37:22 -08:00
|
|
|
| Lentertrap ->
|
|
|
|
()
|
2019-06-24 06:18:37 -07:00
|
|
|
| Ladjust_trap_depth { delta_traps; } ->
|
|
|
|
(* each trap occupies 16 bytes on the stack *)
|
|
|
|
let delta = 16 * delta_traps in
|
|
|
|
cfi_adjust_cfa_offset delta;
|
|
|
|
stack_offset := !stack_offset + delta
|
2019-03-07 02:37:22 -08:00
|
|
|
| Lpushtrap { lbl_handler; } ->
|
|
|
|
let load_label_addr s arg =
|
|
|
|
if !Clflags.pic_code then
|
|
|
|
I.lea (mem64_rip NONE (emit_label s)) arg
|
|
|
|
else
|
|
|
|
I.mov (sym (emit_label s)) arg
|
|
|
|
in
|
2019-06-03 04:56:45 -07:00
|
|
|
load_label_addr lbl_handler r11;
|
|
|
|
I.push r11;
|
|
|
|
cfi_adjust_cfa_offset 8;
|
2019-06-10 03:24:37 -07:00
|
|
|
I.push (domain_field Domainstate.Domain_exception_pointer);
|
2019-06-20 23:03:32 -07:00
|
|
|
cfi_adjust_cfa_offset 8;
|
2019-06-10 03:24:37 -07:00
|
|
|
I.mov rsp (domain_field Domainstate.Domain_exception_pointer);
|
2019-03-07 02:37:22 -08:00
|
|
|
stack_offset := !stack_offset + 16;
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lpoptrap ->
|
2019-06-10 03:24:37 -07:00
|
|
|
I.pop (domain_field Domainstate.Domain_exception_pointer);
|
2014-08-29 05:36:35 -07:00
|
|
|
cfi_adjust_cfa_offset (-8);
|
2014-11-27 09:20:22 -08:00
|
|
|
I.add (int 8) rsp;
|
2014-08-29 05:36:35 -07:00
|
|
|
cfi_adjust_cfa_offset (-8);
|
|
|
|
stack_offset := !stack_offset - 16
|
2014-08-18 02:32:20 -07:00
|
|
|
| Lraise k ->
|
2016-07-28 04:46:23 -07:00
|
|
|
begin match k with
|
2019-06-07 02:02:14 -07:00
|
|
|
| Lambda.Raise_regular ->
|
|
|
|
I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos);
|
2014-08-29 05:36:35 -07:00
|
|
|
emit_call "caml_raise_exn";
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame Reg.Set.empty (Dbg_raise i.dbg)
|
2019-06-07 02:02:14 -07:00
|
|
|
| Lambda.Raise_reraise ->
|
|
|
|
emit_call "caml_raise_exn";
|
2019-04-23 06:11:11 -07:00
|
|
|
record_frame Reg.Set.empty (Dbg_raise i.dbg)
|
2019-06-07 02:02:14 -07:00
|
|
|
| Lambda.Raise_notrace ->
|
2019-06-10 03:24:37 -07:00
|
|
|
I.mov (domain_field Domainstate.Domain_exception_pointer) rsp;
|
|
|
|
I.pop (domain_field Domainstate.Domain_exception_pointer);
|
2019-03-07 02:37:22 -08:00
|
|
|
I.pop r11;
|
|
|
|
I.jmp r11
|
2014-08-29 05:36:35 -07:00
|
|
|
end
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let rec emit_all fallthrough i =
|
|
|
|
match i.desc with
|
2014-09-10 04:33:03 -07:00
|
|
|
| Lend -> ()
|
2003-06-30 01:28:48 -07:00
|
|
|
| _ ->
|
|
|
|
emit_instr fallthrough i;
|
2019-08-13 04:11:13 -07:00
|
|
|
emit_all (Linear.has_fallthrough i.desc) i.next
|
2003-06-30 01:28:48 -07:00
|
|
|
|
2016-07-29 07:07:10 -07:00
|
|
|
let all_functions = ref []
|
|
|
|
|
2003-06-30 01:28:48 -07:00
|
|
|
(* Emission of a function declaration *)
|
|
|
|
|
|
|
|
let fundecl fundecl =
|
|
|
|
function_name := fundecl.fun_name;
|
|
|
|
fastcode_flag := fundecl.fun_fast;
|
2019-03-29 04:47:53 -07:00
|
|
|
tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
|
2003-06-30 01:28:48 -07:00
|
|
|
stack_offset := 0;
|
|
|
|
call_gc_sites := [];
|
2007-01-29 04:11:18 -08:00
|
|
|
bound_error_sites := [];
|
|
|
|
bound_error_call := 0;
|
2019-08-14 04:52:05 -07:00
|
|
|
for i = 0 to Proc.num_register_classes - 1 do
|
|
|
|
num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
|
|
|
|
done;
|
|
|
|
prologue_required := fundecl.fun_prologue_required;
|
|
|
|
frame_required := fundecl.fun_frame_required;
|
2016-07-29 07:07:10 -07:00
|
|
|
all_functions := fundecl :: !all_functions;
|
2019-02-20 10:46:43 -08:00
|
|
|
emit_named_text_section !function_name;
|
2014-09-30 07:54:15 -07:00
|
|
|
D.align 16;
|
2014-08-18 02:32:20 -07:00
|
|
|
add_def_symbol fundecl.fun_name;
|
|
|
|
if system = S_macosx
|
2010-01-20 08:26:46 -08:00
|
|
|
&& not !Clflags.output_c_object
|
|
|
|
&& is_generic_function fundecl.fun_name
|
2009-05-20 04:52:42 -07:00
|
|
|
then (* PR#4690 *)
|
2014-09-30 07:54:15 -07:00
|
|
|
D.private_extern (emit_symbol fundecl.fun_name)
|
2009-05-20 04:52:42 -07:00
|
|
|
else
|
2014-09-30 07:54:15 -07:00
|
|
|
D.global (emit_symbol fundecl.fun_name);
|
2014-09-30 07:59:56 -07:00
|
|
|
D.label (emit_symbol fundecl.fun_name);
|
2012-02-21 09:41:02 -08:00
|
|
|
emit_debug_info fundecl.fun_dbg;
|
|
|
|
cfi_startproc ();
|
2003-06-30 01:28:48 -07:00
|
|
|
emit_all true fundecl.fun_body;
|
|
|
|
List.iter emit_call_gc !call_gc_sites;
|
2007-01-29 04:11:18 -08:00
|
|
|
emit_call_bound_errors ();
|
2019-08-14 04:52:05 -07:00
|
|
|
if !frame_required then begin
|
2016-01-08 23:58:12 -08:00
|
|
|
let n = frame_size() - 8 - (if fp then 8 else 0) in
|
|
|
|
if n <> 0
|
|
|
|
then begin
|
|
|
|
cfi_adjust_cfa_offset (-n);
|
|
|
|
end;
|
|
|
|
end;
|
2012-02-21 09:41:02 -08:00
|
|
|
cfi_endproc ();
|
2014-09-24 03:28:28 -07:00
|
|
|
begin match system with
|
|
|
|
| S_gnu | S_linux ->
|
2014-09-30 07:54:15 -07:00
|
|
|
D.type_ (emit_symbol fundecl.fun_name) "@function";
|
|
|
|
D.size (emit_symbol fundecl.fun_name)
|
2014-09-24 03:28:28 -07:00
|
|
|
(ConstSub (
|
|
|
|
ConstThis,
|
|
|
|
ConstLabel (emit_symbol fundecl.fun_name)))
|
|
|
|
| _ -> ()
|
2011-03-13 06:36:00 -07:00
|
|
|
end
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
(* Emission of data *)
|
|
|
|
|
|
|
|
let emit_item = function
|
2014-09-30 07:54:15 -07:00
|
|
|
| Cglobal_symbol s -> D.global (emit_symbol s)
|
2014-09-24 03:28:28 -07:00
|
|
|
| Cdefine_symbol s -> add_def_symbol s; _label (emit_symbol s)
|
2014-09-30 07:54:15 -07:00
|
|
|
| Cint8 n -> D.byte (const n)
|
|
|
|
| Cint16 n -> D.word (const n)
|
|
|
|
| Cint32 n -> D.long (const_nat n)
|
|
|
|
| Cint n -> D.qword (const_nat n)
|
|
|
|
| Csingle f -> D.long (Const (Int64.of_int32 (Int32.bits_of_float f)))
|
|
|
|
| Cdouble f -> D.qword (Const (Int64.bits_of_float f))
|
|
|
|
| Csymbol_address s -> add_used_symbol s; D.qword (ConstLabel (emit_symbol s))
|
2014-09-30 08:00:52 -07:00
|
|
|
| Cstring s -> D.bytes s
|
2014-09-30 07:54:15 -07:00
|
|
|
| Cskip n -> if n > 0 then D.space n
|
|
|
|
| Calign n -> D.align n
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let data l =
|
2014-09-30 07:54:15 -07:00
|
|
|
D.data ();
|
2019-06-19 07:03:43 -07:00
|
|
|
D.align 8;
|
2003-06-30 01:28:48 -07:00
|
|
|
List.iter emit_item l
|
|
|
|
|
|
|
|
(* Beginning / end of an assembly file *)
|
|
|
|
|
|
|
|
let begin_assembly() =
|
2014-11-27 09:12:21 -08:00
|
|
|
X86_proc.reset_asm_code ();
|
2012-05-12 02:51:45 -07:00
|
|
|
reset_debug_info(); (* PR#5603 *)
|
2015-03-11 09:02:20 -07:00
|
|
|
reset_imp_table();
|
2012-12-21 10:33:32 -08:00
|
|
|
float_constants := [];
|
2016-07-29 07:07:10 -07:00
|
|
|
all_functions := [];
|
2014-08-18 02:32:20 -07:00
|
|
|
if system = S_win64 then begin
|
2014-09-30 07:54:15 -07:00
|
|
|
D.extrn "caml_call_gc" NEAR;
|
|
|
|
D.extrn "caml_c_call" NEAR;
|
|
|
|
D.extrn "caml_allocN" NEAR;
|
|
|
|
D.extrn "caml_alloc1" NEAR;
|
|
|
|
D.extrn "caml_alloc2" NEAR;
|
|
|
|
D.extrn "caml_alloc3" NEAR;
|
|
|
|
D.extrn "caml_ml_array_bound_error" NEAR;
|
|
|
|
D.extrn "caml_raise_exn" NEAR;
|
2014-08-18 02:32:20 -07:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
2016-12-27 04:30:12 -08:00
|
|
|
if !Clflags.dlcode || Arch.win64 then begin
|
2007-11-06 07:16:56 -08:00
|
|
|
(* from amd64.S; could emit these constants on demand *)
|
2014-08-18 02:32:20 -07:00
|
|
|
begin match system with
|
2014-10-06 08:35:01 -07:00
|
|
|
| S_macosx -> D.section ["__TEXT";"__literal16"] None ["16byte_literals"]
|
2014-09-30 07:54:15 -07:00
|
|
|
| S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
|
2015-03-11 09:02:20 -07:00
|
|
|
| S_win64 -> D.data ()
|
2014-09-30 07:54:15 -07:00
|
|
|
| _ -> D.section [".rodata.cst8"] (Some "a") ["@progbits"]
|
2014-08-18 02:32:20 -07:00
|
|
|
end;
|
2014-09-30 07:54:15 -07:00
|
|
|
D.align 16;
|
2014-08-18 02:32:20 -07:00
|
|
|
_label (emit_symbol "caml_negf_mask");
|
2014-09-30 07:54:15 -07:00
|
|
|
D.qword (Const 0x8000000000000000L);
|
|
|
|
D.qword (Const 0L);
|
|
|
|
D.align 16;
|
2014-08-18 02:32:20 -07:00
|
|
|
_label (emit_symbol "caml_absf_mask");
|
2014-09-30 07:54:15 -07:00
|
|
|
D.qword (Const 0x7FFFFFFFFFFFFFFFL);
|
|
|
|
D.qword (Const 0xFFFFFFFFFFFFFFFFL);
|
2007-11-06 07:16:56 -08:00
|
|
|
end;
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2014-09-30 07:54:15 -07:00
|
|
|
D.data ();
|
2014-09-10 04:33:03 -07:00
|
|
|
emit_global_label "data_begin";
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2019-02-20 10:46:43 -08:00
|
|
|
emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
|
2014-09-10 04:33:03 -07:00
|
|
|
emit_global_label "code_begin";
|
2014-08-18 02:32:20 -07:00
|
|
|
if system = S_macosx then I.nop (); (* PR#4690 *)
|
|
|
|
()
|
2003-06-30 01:28:48 -07:00
|
|
|
|
|
|
|
let end_assembly() =
|
2012-12-21 10:33:32 -08:00
|
|
|
if !float_constants <> [] then begin
|
2014-08-18 02:32:20 -07:00
|
|
|
begin match system with
|
2014-10-06 08:35:01 -07:00
|
|
|
| S_macosx -> D.section ["__TEXT";"__literal8"] None ["8byte_literals"]
|
2014-09-30 07:54:15 -07:00
|
|
|
| S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
|
|
|
|
| S_win64 -> D.data ()
|
|
|
|
| _ -> D.section [".rodata.cst8"] (Some "a") ["@progbits"]
|
2014-08-18 02:32:20 -07:00
|
|
|
end;
|
|
|
|
List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
|
2012-12-21 10:33:32 -08:00
|
|
|
end;
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2019-02-20 10:46:43 -08:00
|
|
|
emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
|
2014-09-24 03:28:28 -07:00
|
|
|
if system = S_macosx then I.nop ();
|
|
|
|
(* suppress "ld warning: atom sorting error" *)
|
|
|
|
|
2014-09-10 04:33:03 -07:00
|
|
|
emit_global_label "code_end";
|
|
|
|
|
2015-03-11 09:02:20 -07:00
|
|
|
emit_imp_table();
|
|
|
|
|
2014-09-30 07:54:15 -07:00
|
|
|
D.data ();
|
2017-10-24 08:57:20 -07:00
|
|
|
D.qword (const 0); (* PR#6329 *)
|
2014-09-10 04:33:03 -07:00
|
|
|
emit_global_label "data_end";
|
2017-07-22 13:32:23 -07:00
|
|
|
D.qword (const 0);
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2017-07-22 13:32:23 -07:00
|
|
|
D.align 8; (* PR#7591 *)
|
2014-09-10 04:33:03 -07:00
|
|
|
emit_global_label "frametable";
|
2014-08-18 02:32:20 -07:00
|
|
|
|
2014-10-06 09:18:35 -07:00
|
|
|
let setcnt = ref 0 in
|
2007-01-29 04:11:18 -08:00
|
|
|
emit_frames
|
2016-06-27 00:14:54 -07:00
|
|
|
{ efa_code_label = (fun l -> D.qword (ConstLabel (emit_label l)));
|
|
|
|
efa_data_label = (fun l -> D.qword (ConstLabel (emit_label l)));
|
2019-04-23 06:11:11 -07:00
|
|
|
efa_8 = (fun n -> D.byte (const n));
|
2014-09-30 07:54:15 -07:00
|
|
|
efa_16 = (fun n -> D.word (const n));
|
|
|
|
efa_32 = (fun n -> D.long (const_32 n));
|
|
|
|
efa_word = (fun n -> D.qword (const n));
|
|
|
|
efa_align = D.align;
|
2008-12-03 10:09:09 -08:00
|
|
|
efa_label_rel =
|
2014-10-06 09:18:35 -07:00
|
|
|
(fun lbl ofs ->
|
|
|
|
let c =
|
|
|
|
ConstAdd (
|
|
|
|
ConstSub(ConstLabel(emit_label lbl), ConstThis),
|
|
|
|
const_32 ofs
|
|
|
|
) in
|
|
|
|
if system = S_macosx then begin
|
|
|
|
incr setcnt;
|
|
|
|
let s = Printf.sprintf "L$set$%d" !setcnt in
|
|
|
|
D.setvar (s, c);
|
|
|
|
D.long (ConstLabel s)
|
|
|
|
end else
|
|
|
|
D.long c
|
|
|
|
);
|
2014-08-18 02:32:20 -07:00
|
|
|
efa_def_label = (fun l -> _label (emit_label l));
|
2014-09-30 08:00:52 -07:00
|
|
|
efa_string = (fun s -> D.bytes (s ^ "\000"))
|
2014-08-18 02:32:20 -07:00
|
|
|
};
|
|
|
|
|
Per-architecture support for allocation size info in frame tables.
amd64: remove caml_call_gc{1,2,3} and simplify caml_alloc{1,2,3,N}
by tail-calling caml_call_gc.
i386: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
these functions do not need to preserve ebx.
arm: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
partial revert of #8619.
arm64: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
partial revert of #8619.
power: partial revert of #8619.
avoid restarting allocation sequence after failure.
s390: partial revert of #8619.
avoid restarting allocation seqeunce after failure.
2019-10-22 01:39:02 -07:00
|
|
|
if system = S_linux then begin
|
2020-04-19 02:17:00 -07:00
|
|
|
let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in
|
Per-architecture support for allocation size info in frame tables.
amd64: remove caml_call_gc{1,2,3} and simplify caml_alloc{1,2,3,N}
by tail-calling caml_call_gc.
i386: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
these functions do not need to preserve ebx.
arm: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
partial revert of #8619.
arm64: simplify caml_alloc{1,2,3,N} by tail-calling caml_call_gc.
partial revert of #8619.
power: partial revert of #8619.
avoid restarting allocation sequence after failure.
s390: partial revert of #8619.
avoid restarting allocation seqeunce after failure.
2019-10-22 01:39:02 -07:00
|
|
|
D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
|
|
|
|
end;
|
2019-04-23 06:11:11 -07:00
|
|
|
|
2014-08-18 02:32:20 -07:00
|
|
|
if system = S_linux then
|
2008-08-01 01:04:57 -07:00
|
|
|
(* Mark stack as non-executable, PR#4564 *)
|
2014-09-30 07:54:15 -07:00
|
|
|
D.section [".note.GNU-stack"] (Some "") [ "%progbits" ];
|
2014-08-18 02:32:20 -07:00
|
|
|
|
|
|
|
if system = S_win64 then begin
|
2014-09-30 07:54:15 -07:00
|
|
|
D.comment "External functions";
|
2018-07-23 05:19:41 -07:00
|
|
|
String.Set.iter
|
2014-08-18 02:32:20 -07:00
|
|
|
(fun s ->
|
2018-07-23 05:19:41 -07:00
|
|
|
if not (String.Set.mem s !symbols_defined) then
|
2014-09-30 07:54:15 -07:00
|
|
|
D.extrn (emit_symbol s) NEAR)
|
2014-08-18 02:32:20 -07:00
|
|
|
!symbols_used;
|
2018-07-23 05:19:41 -07:00
|
|
|
symbols_used := String.Set.empty;
|
|
|
|
symbols_defined := String.Set.empty;
|
2014-08-18 02:32:20 -07:00
|
|
|
end;
|
|
|
|
|
2014-09-03 07:46:53 -07:00
|
|
|
let asm =
|
|
|
|
if !Emitaux.create_asm_file then
|
|
|
|
Some
|
2014-09-23 01:36:45 -07:00
|
|
|
(
|
2014-11-27 09:12:21 -08:00
|
|
|
(if X86_proc.masm then X86_masm.generate_asm
|
|
|
|
else X86_gas.generate_asm) !Emitaux.output_channel
|
2014-09-03 07:46:53 -07:00
|
|
|
)
|
|
|
|
else
|
|
|
|
None
|
2014-08-29 05:36:35 -07:00
|
|
|
in
|
2014-11-27 09:12:21 -08:00
|
|
|
X86_proc.generate_code asm
|