Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use allocation-size info on more than just amd64. 

Moves the alloc_dbginfo type to Debuginfo, to avoid a circular
dependency on architectures that use Branch_relaxation.

This commit generates frame tables with allocation sizes on all
architectures, but does not yet update the allocation code for
non-amd64 backends.
master
Stephen Dolan 2019-09-18 16:15:18 +01:00
parent 47b03758f3
commit 768dcce48f
18 changed files with 127 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.depend
View File

@ -2152,10 +2152,12 @@ asmcomp/branch_relaxation.cmi : \
asmcomp/linear.cmi \
asmcomp/branch_relaxation_intf.cmo
asmcomp/branch_relaxation_intf.cmo : \
asmcomp/mach.cmi \
asmcomp/linear.cmi \
asmcomp/cmm.cmi \
asmcomp/arch.cmo
asmcomp/branch_relaxation_intf.cmx : \
asmcomp/mach.cmx \
asmcomp/linear.cmx \
asmcomp/cmm.cmx \
asmcomp/arch.cmx
@ -2351,7 +2353,6 @@ asmcomp/emit.cmo : \
lambda/lambda.cmi \
asmcomp/emitaux.cmi \
utils/domainstate.cmi \
lambda/debuginfo.cmi \
utils/config.cmi \
middle_end/compilenv.cmi \
asmcomp/cmm.cmi \
@ -2373,7 +2374,6 @@ asmcomp/emit.cmx : \
lambda/lambda.cmx \
asmcomp/emitaux.cmx \
utils/domainstate.cmx \
lambda/debuginfo.cmx \
utils/config.cmx \
middle_end/compilenv.cmx \
asmcomp/cmm.cmx \

13
asmcomp/amd64/emit.mlp
View File

@ -281,8 +281,7 @@ let spacetime_before_uninstrumented_call ~node_ptr ~index =
(* Record calls to the GC -- we've moved them out of the way *)
type gc_call =
{ gc_size: int; (* Allocation size, in bytes *)
gc_lbl: label; (* Entry label *)
{ gc_lbl: label; (* Entry label *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame: label; (* Label of frame descriptor *)
gc_spacetime : (X86_ast.arg * int) option;
@ -663,10 +662,6 @@ let emit_instr fallthrough i =
end
| Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; dbginfo }) ->
assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
let dbginfo =
if not !Clflags.debug && not Config.spacetime then
List.map (fun d -> { d with alloc_dbg = Debuginfo.none }) dbginfo
else dbginfo in
if !fastcode_flag then begin
I.sub (int n) r15;
I.cmp (domain_field Domainstate.Domain_young_limit) r15;
@ -683,8 +678,7 @@ let emit_instr fallthrough i =
else Some (arg i 0, spacetime_index)
in
call_gc_sites :=
{ gc_size = n;
gc_lbl = lbl_call_gc;
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
gc_frame = lbl_frame;
gc_spacetime; } :: !call_gc_sites
@ -1010,9 +1004,6 @@ let begin_assembly() =
all_functions := [];
if system = S_win64 then begin
D.extrn "caml_call_gc" NEAR;
D.extrn "caml_call_gc1" NEAR;
D.extrn "caml_call_gc2" NEAR;
D.extrn "caml_call_gc3" NEAR;
D.extrn "caml_c_call" NEAR;
D.extrn "caml_allocN" NEAR;
D.extrn "caml_alloc1" NEAR;

27
asmcomp/arm/emit.mlp
View File

@ -105,7 +105,7 @@ let emit_addressing addr r n =
(* Record live pointers at call points *)
let record_frame_label ?label live raise_ dbg =
let record_frame_label ?label live dbg =
let lbl =
match label with
| None -> new_label()
@ -123,11 +123,11 @@ let record_frame_label ?label live raise_ dbg =
| _ -> ())
live;
record_frame_descr ~label:lbl ~frame_size:(frame_size())
~live_offset:!live_offset ~raise_frame:raise_ dbg;
~live_offset:!live_offset dbg;
lbl
let record_frame ?label live raise_ dbg =
let lbl = record_frame_label ?label live raise_ dbg in `{emit_label lbl}:`
let record_frame ?label live dbg =
let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
(* Record calls to the GC -- we've moved them out of the way *)
@ -155,7 +155,7 @@ let bound_error_sites = ref ([] : bound_error_call list)
let bound_error_label ?label dbg =
if !Clflags.debug || !bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error;
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
@ -542,15 +542,15 @@ let emit_instr i =
| Lop(Icall_ind { label_after; }) ->
if !arch >= ARMv5 then begin
` blx {emit_reg i.arg.(0)}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`; 1
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
end else begin
` mov lr, pc\n`;
` bx {emit_reg i.arg.(0)}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`; 2
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 2
end
| Lop(Icall_imm { func; label_after; }) ->
` {emit_call func}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`; 1
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
| Lop(Itailcall_ind { label_after = _; }) ->
output_epilogue begin fun () ->
if !contains_calls then
@ -572,7 +572,7 @@ let emit_instr i =
| Lop(Iextcall { func; alloc = true; label_after; }) ->
let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) func in
` {emit_call "caml_c_call"}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`;
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`;
1 + ninstr
| Lop(Istackoffset n) ->
assert (n mod 8 = 0);
@ -642,9 +642,9 @@ let emit_instr i =
| Double_u -> "fstd"
| _ (* 32-bit quantities *) -> "str" in
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
let lbl_frame =
record_frame_label i.live false i.dbg ?label:label_after_call_gc
record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
in
if !fastcode_flag then begin
let lbl_redo = new_label() in
@ -912,10 +912,10 @@ let emit_instr i =
` mov r12, #0\n`;
` str r12, [domain_state_ptr, {emit_int offset}]\n`;
` {emit_call "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`; 3
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 3
| Lambda.Raise_reraise ->
` {emit_call "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`; 1
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 1
| Lambda.Raise_notrace ->
` mov sp, trap_ptr\n`;
` pop \{trap_ptr, pc}\n`; 2
@ -1072,6 +1072,7 @@ let end_assembly () =
efa_data_label = (fun lbl ->
` .type {emit_label lbl}, %object\n`;
` .word {emit_label lbl}\n`);
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
efa_16 = (fun n -> ` .short {emit_int n}\n`);
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
efa_word = (fun n -> ` .word {emit_int n}\n`);

3
asmcomp/arm64/arch.ml
View File

@ -38,7 +38,8 @@ type cmm_label = int
(* Do not introduce a dependency to Cmm *)
type specific_operation =
| Ifar_alloc of { bytes : int; label_after_call_gc : cmm_label option; }
| Ifar_alloc of { bytes : int; label_after_call_gc : cmm_label option;
dbginfo : Debuginfo.alloc_dbginfo }
| Ifar_intop_checkbound of { label_after_error : cmm_label option; }
| Ifar_intop_imm_checkbound of
{ bound : int; label_after_error : cmm_label option; }

37
asmcomp/arm64/emit.mlp
View File

@ -126,7 +126,7 @@ let emit_addressing addr r =
(* Record live pointers at call points *)
let record_frame_label ?label live raise_ dbg =
let record_frame_label ?label live dbg =
let lbl =
match label with
| None -> new_label()
@ -144,11 +144,11 @@ let record_frame_label ?label live raise_ dbg =
| _ -> ())
live;
record_frame_descr ~label:lbl ~frame_size:(frame_size())
~live_offset:!live_offset ~raise_frame:raise_ dbg;
~live_offset:!live_offset dbg;
lbl
let record_frame ?label live raise_ dbg =
let lbl = record_frame_label ?label live raise_ dbg in `{emit_label lbl}:`
let record_frame ?label live dbg =
let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
(* Record calls to the GC -- we've moved them out of the way *)
@ -176,7 +176,7 @@ let bound_error_sites = ref ([] : bound_error_call list)
let bound_error_label ?label dbg =
if !Clflags.debug || !bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error;
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
@ -512,8 +512,8 @@ module BR = Branch_relaxation.Make (struct
| Lambda.Raise_notrace -> 4
end
let relax_allocation ~num_bytes ~label_after_call_gc =
Lop (Ispecific (Ifar_alloc { bytes = num_bytes; label_after_call_gc; }))
let relax_allocation ~num_bytes ~label_after_call_gc ~dbginfo =
Lop (Ispecific (Ifar_alloc { bytes = num_bytes; label_after_call_gc; dbginfo }))
let relax_intop_checkbound ~label_after_error =
Lop (Ispecific (Ifar_intop_checkbound { label_after_error; }))
@ -529,9 +529,9 @@ end)
(* Output the assembly code for allocation. *)
let assembly_code_for_allocation ?label_after_call_gc i ~n ~far =
let assembly_code_for_allocation ~label_after_call_gc i ~n ~far ~dbginfo =
let lbl_frame =
record_frame_label ?label:label_after_call_gc i.live false i.dbg
record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
in
if !fastcode_flag then begin
let lbl_redo = new_label() in
@ -626,10 +626,10 @@ let emit_instr i =
emit_load_symbol_addr i.res.(0) s
| Lop(Icall_ind { label_after; }) ->
` blr {emit_reg i.arg.(0)}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
| Lop(Icall_imm { func; label_after; }) ->
` bl {emit_symbol func}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
| Lop(Itailcall_ind { label_after = _; }) ->
output_epilogue (fun () -> ` br {emit_reg i.arg.(0)}\n`)
| Lop(Itailcall_imm { func; label_after = _; }) ->
@ -642,7 +642,7 @@ let emit_instr i =
| Lop(Iextcall { func; alloc = true; label_after; }) ->
emit_load_symbol_addr reg_x15 func;
` bl {emit_symbol "caml_c_call"}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
emit_stack_adjustment (-n);
@ -697,10 +697,10 @@ let emit_instr i =
| Word_int | Word_val | Double | Double_u ->
` str {emit_reg src}, {emit_addressing addr base}\n`
end
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
assembly_code_for_allocation i ~n ~far:false ?label_after_call_gc
| Lop(Ispecific (Ifar_alloc { bytes = n; label_after_call_gc; })) ->
assembly_code_for_allocation i ~n ~far:true ?label_after_call_gc
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
assembly_code_for_allocation i ~n ~far:false ~label_after_call_gc ~dbginfo
| Lop(Ispecific (Ifar_alloc { bytes = n; label_after_call_gc; dbginfo })) ->
assembly_code_for_allocation i ~n ~far:true ~label_after_call_gc ~dbginfo
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
@ -906,10 +906,10 @@ let emit_instr i =
let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
` str xzr, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n`;
` bl {emit_symbol "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_reraise ->
` bl {emit_symbol "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_notrace ->
` mov sp, {emit_reg reg_trap_ptr}\n`;
` ldr {emit_reg reg_tmp1}, [sp, #8]\n`;
@ -1027,6 +1027,7 @@ let end_assembly () =
efa_data_label = (fun lbl ->
` .type {emit_label lbl}, %object\n`;
` .quad {emit_label lbl}\n`);
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
efa_16 = (fun n -> ` .short {emit_int n}\n`);
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
efa_word = (fun n -> ` .quad {emit_int n}\n`);

5
asmcomp/branch_relaxation.ml
View File

@ -86,8 +86,9 @@ module Make (T : Branch_relaxation_intf.S) = struct
fixup did_fix (pc + T.instr_size instr.desc) instr.next
else
match instr.desc with
| Lop (Ialloc { bytes = num_bytes; label_after_call_gc; }) ->
instr.desc <- T.relax_allocation ~num_bytes ~label_after_call_gc;
| Lop (Ialloc { bytes = num_bytes; label_after_call_gc; dbginfo }) ->
instr.desc <- T.relax_allocation ~num_bytes
~dbginfo ~label_after_call_gc;
fixup true (pc + T.instr_size instr.desc) instr.next
| Lop (Iintop (Icheckbound { label_after_error; })) ->
instr.desc <- T.relax_intop_checkbound ~label_after_error;

1
asmcomp/branch_relaxation_intf.ml
View File

@ -63,6 +63,7 @@ module type S = sig
val relax_allocation
: num_bytes:int
-> label_after_call_gc:Cmm.label option
-> dbginfo:Debuginfo.alloc_dbginfo
-> Linear.instruction_desc
val relax_intop_checkbound
: label_after_error:Cmm.label option

6
asmcomp/comballoc.ml
View File

@ -18,9 +18,9 @@
open Mach
type pending_alloc =
{ reg: Reg.t; (* register holding the result of the last allocation *)
dbginfos: alloc_dbginfo list; (* debug info for each pending allocation *)
totalsz: int } (* amount to be allocated in this block *)
{ reg: Reg.t; (* register holding the result of the last allocation *)
dbginfos: Debuginfo.alloc_dbginfo; (* debug info for each pending alloc *)
totalsz: int } (* amount to be allocated in this block *)
type allocation_state =
No_alloc

13
asmcomp/emitaux.ml
View File

@ -106,7 +106,7 @@ let emit_float32_directive directive x =
(* Record live pointers at call points *)
type frame_debuginfo =
| Dbg_alloc of Mach.alloc_dbginfo list
| Dbg_alloc of Debuginfo.alloc_dbginfo
| Dbg_raise of Debuginfo.t
| Dbg_other of Debuginfo.t
@ -175,9 +175,10 @@ let emit_frames a =
| Dbg_other d | Dbg_raise d ->
if Debuginfo.is_none d then 0 else 1
| Dbg_alloc dbgs ->
if List.for_all (fun d ->
Debuginfo.is_none d.Mach.alloc_dbg) dbgs
then 2 else 3
if !Clflags.debug && not Config.spacetime &&
List.exists (fun d ->
not (Debuginfo.is_none d.Debuginfo.alloc_dbg)) dbgs
then 3 else 2
in
a.efa_code_label fd.fd_lbl;
a.efa_16 (fd.fd_frame_size + flags);
@ -195,7 +196,7 @@ let emit_frames a =
| Dbg_alloc dbg ->
assert (List.length dbg < 256);
a.efa_8 (List.length dbg);
List.iter (fun Mach.{alloc_words;_} ->
List.iter (fun Debuginfo.{alloc_words;_} ->
(* Possible allocations range between 2 and 257 *)
assert (2 <= alloc_words &&
alloc_words - 1 <= Config.max_young_wosize &&
@ -203,7 +204,7 @@ let emit_frames a =
a.efa_8 (alloc_words - 2)) dbg;
if flags = 3 then begin
a.efa_align 4;
List.iter (fun Mach.{alloc_dbg; _} ->
List.iter (fun Debuginfo.{alloc_dbg; _} ->
if Debuginfo.is_none alloc_dbg then
a.efa_32 Int32.zero
else

2
asmcomp/emitaux.mli
View File

@ -39,7 +39,7 @@ val emit_debug_info_gen :
(file_num:int -> line:int -> col:int -> unit) -> unit
type frame_debuginfo =
| Dbg_alloc of Mach.alloc_dbginfo list
| Dbg_alloc of Debuginfo.alloc_dbginfo
| Dbg_raise of Debuginfo.t
| Dbg_other of Debuginfo.t

37
asmcomp/i386/emit.mlp
View File

@ -200,7 +200,7 @@ let addressing addr typ i n =
(* Record live pointers at call points *)
let record_frame_label ?label live raise_ dbg =
let record_frame_label ?label live dbg =
let lbl =
match label with
| None -> new_label()
@ -218,11 +218,11 @@ let record_frame_label ?label live raise_ dbg =
| _ -> ())
live;
record_frame_descr ~label:lbl ~frame_size:(frame_size())
~live_offset:!live_offset ~raise_frame:raise_ dbg;
~live_offset:!live_offset dbg;
lbl
let record_frame ?label live raise_ dbg =
let lbl = record_frame_label ?label live raise_ dbg in
let record_frame ?label live dbg =
let lbl = record_frame_label ?label live dbg in
def_label lbl
(* Record calls to the GC -- we've moved them out of the way *)
@ -254,7 +254,7 @@ let bound_error_call = ref 0
let bound_error_label ?label dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
lbl_bound_error
@ -540,11 +540,11 @@ let emit_instr fallthrough i =
I.mov (immsym s) (reg i.res.(0))
| Lop(Icall_ind { label_after; }) ->
I.call (reg i.arg.(0));
record_frame i.live false i.dbg ~label:label_after
record_frame i.live (Dbg_other i.dbg) ~label:label_after
| Lop(Icall_imm { func; label_after; }) ->
add_used_symbol func;
emit_call func;
record_frame i.live false i.dbg ~label:label_after
record_frame i.live (Dbg_other i.dbg) ~label:label_after
| Lop(Itailcall_ind { label_after = _; }) ->
output_epilogue begin fun () ->
I.jmp (reg i.arg.(0))
@ -563,7 +563,7 @@ let emit_instr fallthrough i =
if alloc then begin
I.mov (immsym func) eax;
emit_call "caml_c_call";
record_frame i.live false i.dbg ~label:label_after
record_frame i.live (Dbg_other i.dbg) ~label:label_after
end else begin
emit_call func
end
@ -614,22 +614,24 @@ let emit_instr fallthrough i =
I.fstp (addressing addr REAL8 i 1)
end
end
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
if !fastcode_flag then begin
let lbl_redo = new_label() in
def_label lbl_redo;
load_domain_state ebx;
I.mov (domain_field Domain_young_ptr RBX) eax;
I.sub (int n) eax;
I.cmp (domain_field Domain_young_limit RBX) eax;
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live false Debuginfo.none in
let lbl_frame =
record_frame_label ?label:label_after_call_gc
i.live (Dbg_alloc dbginfo) in
I.jb (label lbl_call_gc);
I.mov eax (domain_field Domain_young_ptr RBX);
let lbl_after_alloc = new_label() in
def_label lbl_after_alloc;
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
gc_return_lbl = lbl_after_alloc;
gc_frame = lbl_frame } :: !call_gc_sites
end else begin
begin match n with
@ -641,8 +643,8 @@ let emit_instr fallthrough i =
emit_call "caml_allocN"
end;
let label =
record_frame_label ?label:label_after_call_gc i.live false
Debuginfo.none
record_frame_label ?label:label_after_call_gc
i.live (Dbg_alloc dbginfo)
in
def_label label;
I.lea (mem32 NONE 4 RAX) (reg i.res.(0))
@ -895,10 +897,10 @@ let emit_instr fallthrough i =
load_domain_state ebx;
I.mov (int 0) (domain_field Domain_backtrace_pos RBX);
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
record_frame Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
record_frame Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_notrace ->
load_domain_state ebx;
I.mov (domain_field Domain_exception_pointer RBX) esp;
@ -1019,6 +1021,7 @@ let end_assembly() =
emit_frames
{ efa_code_label = (fun l -> D.long (ConstLabel (emit_label l)));
efa_data_label = (fun l -> D.long (ConstLabel (emit_label l)));
efa_8 = (fun n -> D.byte (const n));
efa_16 = (fun n -> D.word (const n));
efa_32 = (fun n -> D.long (const_32 n));
efa_word = (fun n -> D.long (const n));

6
asmcomp/mach.ml
View File

@ -39,10 +39,6 @@ type test =
| Ioddtest
| Ieventest
type alloc_dbginfo =
{ alloc_words : int;
alloc_dbg : Debuginfo.t }
type operation =
Imove
| Ispill
@ -59,7 +55,7 @@ type operation =
| Iload of Cmm.memory_chunk * Arch.addressing_mode
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
| Ialloc of { bytes : int; label_after_call_gc : label option;
dbginfo : alloc_dbginfo list; spacetime_index : int; }
dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
| Iintop of integer_operation
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf

11
asmcomp/mach.mli
View File

@ -46,15 +46,6 @@ type test =
| Ioddtest
| Ieventest
type alloc_dbginfo =
{ alloc_words : int;
alloc_dbg : Debuginfo.t }
(** Due to Comballoc, a single Ialloc instruction may combine several
unrelated allocations. Their Debuginfo.t (which may differ) are stored
as a list of alloc_dbginfo. This list is in order of increasing memory
address, which is the reverse of the original allocation order. Later
allocations are consed to the front of this list by Comballoc. *)
type operation =
Imove
| Ispill
@ -72,7 +63,7 @@ type operation =
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
(* false = initialization, true = assignment *)
| Ialloc of { bytes : int; label_after_call_gc : label option;
dbginfo : alloc_dbginfo list; spacetime_index : int; }
dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
(** For Spacetime only, Ialloc instructions take one argument, being the
pointer to the trie node for the current function. *)
| Iintop of integer_operation

3
asmcomp/power/arch.ml
View File

@ -47,7 +47,8 @@ type specific_operation =
Imultaddf (* multiply and add *)
| Imultsubf (* multiply and subtract *)
| Ialloc_far of (* allocation in large functions *)
{ bytes : int; label_after_call_gc : int (*Cmm.label*) option; }
{ bytes : int; label_after_call_gc : int (*Cmm.label*) option;
dbginfo : Debuginfo.alloc_dbginfo }
(* note: we avoid introducing a dependency to Cmm since this dep
is not detected when "make depend" is run under amd64 *)

39
asmcomp/power/emit.mlp
View File

@ -308,7 +308,7 @@ let adjust_stack_offset delta =
(* Record live pointers at call points *)
let record_frame ?label live raise_ dbg =
let record_frame ?label live dbg =
let lbl =
match label with
| None -> new_label()
@ -326,7 +326,7 @@ let record_frame ?label live raise_ dbg =
| _ -> ())
live;
record_frame_descr ~label:lbl ~frame_size:(frame_size())
~live_offset:!live_offset ~raise_frame:raise_ dbg;
~live_offset:!live_offset dbg;
`{emit_label lbl}:\n`
(* Record floating-point literals (for PPC32) *)
@ -546,8 +546,8 @@ module BR = Branch_relaxation.Make (struct
| Lpoptrap -> 2
| Lraise _ -> 6
let relax_allocation ~num_bytes:bytes ~label_after_call_gc =
Lop (Ispecific (Ialloc_far { bytes; label_after_call_gc; }))
let relax_allocation ~num_bytes:bytes ~label_after_call_gc ~dbginfo =
Lop (Ispecific (Ialloc_far { bytes; label_after_call_gc; dbginfo }))
(* [classify_addr], above, never identifies these instructions as needing
relaxing. As such, these functions should never be called. *)
@ -652,26 +652,26 @@ let emit_instr i =
| ELF32 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` bctrl\n`;
record_frame i.live false i.dbg ~label:label_after
record_frame i.live (Dbg_other i.dbg) ~label:label_after
| ELF64v1 ->
` ld 0, 0({emit_reg i.arg.(0)})\n`; (* code pointer *)
` mtctr 0\n`;
` ld 2, 8({emit_reg i.arg.(0)})\n`; (* TOC for callee *)
` bctrl\n`;
record_frame i.live false i.dbg ~label:label_after;
record_frame i.live (Dbg_other i.dbg) ~label:label_after;
emit_reload_toc()
| ELF64v2 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` mr 12, {emit_reg i.arg.(0)}\n`; (* addr of fn in r12 *)
` bctrl\n`;
record_frame i.live false i.dbg ~label:label_after;
record_frame i.live (Dbg_other i.dbg) ~label:label_after;
emit_reload_toc()
end
| Lop(Icall_imm { func; label_after; }) ->
begin match abi with
| ELF32 ->
emit_call func;
record_frame i.live false i.dbg ~label:label_after
record_frame i.live (Dbg_other i.dbg) ~label:label_after
| ELF64v1 | ELF64v2 ->
(* For PPC64, we cannot just emit a "bl s; nop" sequence, because
of the following scenario:
@ -691,7 +691,7 @@ let emit_instr i =
Cost: 3 instructions if same TOC, 7 if different TOC.
Let's try option 2. *)
emit_call func;
record_frame i.live false i.dbg ~label:label_after;
record_frame i.live (Dbg_other i.dbg) ~label:label_after;
` nop\n`;
emit_reload_toc()
end
@ -751,11 +751,11 @@ let emit_instr i =
` addis 25, 0, {emit_upper emit_symbol func}\n`;
` addi 25, 25, {emit_lower emit_symbol func}\n`;
emit_call "caml_c_call";
record_frame i.live false i.dbg
record_frame i.live (Dbg_other i.dbg)
| ELF64v1 | ELF64v2 ->
emit_tocload emit_gpr 25 (TocSym func);
emit_call "caml_c_call";
record_frame i.live false i.dbg;
record_frame i.live (Dbg_other i.dbg);
` nop\n`
end
| Lop(Istackoffset n) ->
@ -786,15 +786,15 @@ let emit_instr i =
| Single -> "stfs"
| Double | Double_u -> "stfd" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
` bltl {emit_label call_gc_lbl}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live false Debuginfo.none
| Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; })) ->
record_frame i.live (Dbg_alloc dbginfo)
| Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; dbginfo })) ->
let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in
let lbl = new_label() in
` addi 31, 31, {emit_int(-n)}\n`;
@ -802,7 +802,7 @@ let emit_instr i =
` bge {emit_label lbl}\n`;
` bl {emit_label call_gc_lbl}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live false Debuginfo.none;
record_frame i.live (Dbg_alloc dbginfo);
`{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
| Lop(Iintop Isub) -> (* subfc has swapped arguments *)
` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
@ -821,7 +821,7 @@ let emit_instr i =
end
| Lop(Iintop (Icheckbound { label_after_error; })) ->
if !Clflags.debug then
record_frame Reg.Set.empty false i.dbg ?label:label_after_error;
record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
` {emit_string tglle} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
| Lop(Iintop op) ->
let instr = name_for_intop op in
@ -839,7 +839,7 @@ let emit_instr i =
end
| Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
if !Clflags.debug then
record_frame Reg.Set.empty false i.dbg ?label:label_after_error;
record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
` {emit_string tglle}i {emit_reg i.arg.(0)}, {emit_int n}\n`
| Lop(Iintop_imm(op, n)) ->
let instr = name_for_intop_imm op in
@ -1023,11 +1023,11 @@ let emit_instr i =
| _ -> ` std 0, {emit_int (backtrace_pos * 8)}(28)\n`
end;
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg;
record_frame Reg.Set.empty (Dbg_raise i.dbg);
emit_call_nop()
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg;
record_frame Reg.Set.empty (Dbg_raise i.dbg);
emit_call_nop()
| Lambda.Raise_notrace ->
` {emit_string lg} 0, {emit_int trap_handler_offset}(29)\n`;
@ -1249,6 +1249,7 @@ let end_assembly() =
(fun l -> ` {emit_string datag} {emit_label l}\n`);
efa_data_label =
(fun l -> ` {emit_string datag} {emit_label l}\n`);
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
efa_16 = (fun n -> ` .short {emit_int n}\n`);
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
efa_word = (fun n -> ` {emit_string datag} {emit_int n}\n`);

25
asmcomp/s390x/emit.mlp
View File

@ -168,7 +168,7 @@ let emit_set_comp cmp res =
(* Record live pointers at call points *)
let record_frame_label ?label live raise_ dbg =
let record_frame_label ?label live dbg =
let lbl =
match label with
| None -> new_label()
@ -186,11 +186,11 @@ let record_frame_label ?label live raise_ dbg =
| _ -> ())
live;
record_frame_descr ~label:lbl ~frame_size:(frame_size())
~live_offset:!live_offset ~raise_frame:raise_ dbg;
~live_offset:!live_offset dbg;
lbl
let record_frame ?label live raise_ dbg =
let lbl = record_frame_label ?label live raise_ dbg in
let record_frame ?label live dbg =
let lbl = record_frame_label ?label live dbg in
`{emit_label lbl}:`
(* Record calls to caml_call_gc, emitted out of line. *)
@ -218,7 +218,7 @@ let bound_error_call = ref 0
let bound_error_label ?label dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
lbl_bound_error
@ -357,11 +357,11 @@ let emit_instr i =
emit_load_symbol_addr i.res.(0) s
| Lop(Icall_ind { label_after; }) ->
` basr %r14, {emit_reg i.arg.(0)}\n`;
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
| Lop(Icall_imm { func; label_after; }) ->
emit_call func;
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
| Lop(Itailcall_ind { label_after = _; }) ->
let n = frame_size() in
if !contains_calls then
@ -387,7 +387,7 @@ let emit_instr i =
else begin
emit_load_symbol_addr reg_r7 func;
emit_call "caml_c_call";
`{record_frame i.live false i.dbg ~label:label_after}\n`
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
end
| Lop(Istackoffset n) ->
@ -424,11 +424,11 @@ let emit_instr i =
| Double | Double_u -> "stdy" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
| Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
let lbl_redo = new_label() in
let lbl_call_gc = new_label() in
let lbl_frame =
record_frame_label i.live false i.dbg ?label:label_after_call_gc
record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
in
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
@ -641,10 +641,10 @@ let emit_instr i =
` lghi %r1, 0\n`;
` stg %r1, {emit_int offset}(%r10)\n`;
emit_call "caml_raise_exn";
`{record_frame Reg.Set.empty true i.dbg}\n`
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
`{record_frame Reg.Set.empty true i.dbg}\n`
`{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_notrace ->
` lg %r1, 0(%r13)\n`;
` lgr %r15, %r13\n`;
@ -782,6 +782,7 @@ let end_assembly() =
emit_frames
{ efa_code_label = (fun l -> ` .quad {emit_label l}\n`);
efa_data_label = (fun l -> ` .quad {emit_label l}\n`);
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
efa_16 = (fun n -> ` .short {emit_int n}\n`);
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
efa_word = (fun n -> ` .quad {emit_int n}\n`);

5
lambda/debuginfo.ml
View File

@ -29,6 +29,11 @@ type item = {
type t = item list
type alloc_dbginfo_item =
{ alloc_words : int;
alloc_dbg : t }
type alloc_dbginfo = alloc_dbginfo_item list
let none = []
let is_none = function

11
lambda/debuginfo.mli
View File

@ -25,6 +25,17 @@ type item = private {
type t = item list
type alloc_dbginfo_item =
{ alloc_words : int;
alloc_dbg : t }
(** Due to Comballoc, a single Ialloc instruction may combine several
unrelated allocations. Their Debuginfo.t (which may differ) are stored
as a list of alloc_dbginfo. This list is in order of increasing memory
address, which is the reverse of the original allocation order. Later
allocations are consed to the front of this list by Comballoc. *)
type alloc_dbginfo = alloc_dbginfo_item list
val none : t
val is_none : t -> bool