diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 2b5fe59c58cc..a9616f8cdb2e 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -867,6 +867,11 @@ let emit_instr fallthrough i = D.text () | Lentertrap -> () + | 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 | Lpushtrap { lbl_handler; } -> let load_label_addr s arg = if !Clflags.pic_code then diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 43d7a750f13e..c4b1a05aced2 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -877,6 +877,11 @@ let emit_instr i = end | Lentertrap -> 0 + | Ladjust_trap_depth { delta_traps } -> + (* each trap occupies 8 bytes on the stack *) + let delta = 8 * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta; 0 | Lpushtrap { lbl_handler; } -> let s = emit_load_handler_address lbl_handler in stack_offset := !stack_offset + 8; diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 0210477c2b55..635ecdc23801 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -495,6 +495,7 @@ module BR = Branch_relaxation.Make (struct + begin match lbl2 with None -> 0 | Some _ -> 1 end | Lswitch jumptbl -> 3 + Array.length jumptbl | Lentertrap -> 0 + | Ladjust_trap_depth _ -> 0 | Lpushtrap _ -> 4 | Lpoptrap -> 1 | Lraise k -> @@ -875,6 +876,11 @@ let emit_instr i = *) | Lentertrap -> () + | 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 | Lpushtrap { lbl_handler; } -> ` adr {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`; stack_offset := !stack_offset + 16; diff --git a/asmcomp/debug/compute_ranges.ml b/asmcomp/debug/compute_ranges.ml new file mode 100644 index 000000000000..3ace8c24370e --- /dev/null +++ b/asmcomp/debug/compute_ranges.ml @@ -0,0 +1,515 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 2014--2019 Jane Street Group LLC *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-4-30-40-41-42"] + +open! Int_replace_polymorphic_compare + +module L = Linearize + +module Make (S : Compute_ranges_intf.S_functor) = struct + module Subrange_state = S.Subrange_state + module Subrange_info = S.Subrange_info + module Range_info = S.Range_info + + let rewrite_label env label = + match Numbers.Int.Map.find label env with + | exception Not_found -> label + | label -> label + + module Subrange = struct + (* CR-soon mshinwell: Check that function epilogues, including returns + in the middle of functions, work ok in the debugger. *) + type t = { + start_pos : L.label; + start_pos_offset : int; + end_pos : L.label; + end_pos_offset : int; + subrange_info : Subrange_info.t; + } + + let create ~(start_insn : Linearize.instruction) + ~start_pos ~start_pos_offset + ~end_pos ~end_pos_offset + ~subrange_info = + match start_insn.desc with + | Llabel _ -> + { start_pos; + start_pos_offset; + end_pos; + end_pos_offset; + subrange_info; + } + | _ -> + Misc.fatal_errorf "Subrange.create: bad [start_insn]: %a" + Printlinear.instr start_insn + + let start_pos t = t.start_pos + let start_pos_offset t = t.start_pos_offset + let end_pos t = t.end_pos + let end_pos_offset t = t.end_pos_offset + let info t = t.subrange_info + + let rewrite_labels t ~env = + let start_pos = rewrite_label env t.start_pos in + let end_pos = rewrite_label env t.end_pos in + if start_pos = end_pos + && t.start_pos_offset = 0 + && t.end_pos_offset = 0 + then None + else + Some { + t with + start_pos; + end_pos; + } + end + + module Range = struct + type t = { + mutable subranges : Subrange.t list; + mutable min_pos_and_offset : (L.label * int) option; + range_info : Range_info.t; + } + + let create range_info = + { subranges = []; + min_pos_and_offset = None; + range_info; + } + + let info t = t.range_info + + let add_subrange t ~subrange = + let start_pos = Subrange.start_pos subrange in + let start_pos_offset = Subrange.start_pos_offset subrange in + begin match t.min_pos_and_offset with + | None -> t.min_pos_and_offset <- Some (start_pos, start_pos_offset) + | Some (min_pos, min_pos_offset) -> + (* This may seem dubious, but is correct by virtue of the way label + counters are allocated sequentially and the fact that, below, + we go through the code from lowest (code) address to highest. As + such the label with the highest integer value should be the one with + the highest address, and vice-versa. (Note that we also exploit the + ordering when constructing DWARF-4 location lists, to ensure that + they are sorted in increasing program counter order by start + address.) *) + let c = compare start_pos min_pos in + if c < 0 + || (c = 0 && start_pos_offset < min_pos_offset) + then begin + t.min_pos_and_offset <- Some (start_pos, start_pos_offset) + end + end; + t.subranges <- subrange::t.subranges + + let estimate_lowest_address t = + (* See assumption described in compute_ranges_intf.ml. *) + t.min_pos_and_offset + + let fold t ~init ~f = + List.fold_left f init t.subranges + + let no_subranges t = + match t.subranges with + | [] -> true + | _ -> false + + let rewrite_labels_and_remove_empty_subranges t ~env = + let subranges = + List.filter_map (fun subrange -> + Subrange.rewrite_labels subrange ~env) + t.subranges + in + match subranges with + | [] -> + { t with + subranges; + min_pos_and_offset = None; + } + | subranges -> + let min_pos_and_offset = + Option.map + (fun (label, offset) -> rewrite_label env label, offset) + t.min_pos_and_offset + in + { t with + subranges; + min_pos_and_offset; + } + end + + type t = { + ranges : Range.t S.Index.Tbl.t; + } + + module KM = S.Key.Map + module KS = S.Key.Set + + (* Whilst this pass is not DWARF-specific, the output of this pass uses + the conventions of the DWARF specification (e.g. DWARF-4 spec. + section 2.6.2, page 30) in the sense that starting addresses of ranges + are treated as inclusive and ending addresses as exclusive. + + Imagine that, for a given [key], the program counter (PC) is exactly at the + start of [insn]; that instruction has not yet been executed. Assume + a immediately-previous instruction exists called [prev_insn]. Intuitively, + this function calculates which available subranges are to start and stop at + that point, but these notions are subtle. + + There are eight cases, referenced in the code below. + + 1. First four cases: [key] is currently unavailable, i.e. it is not a + member of (roughly speaking) [S.available_across prev_insn]. + + (a) [key] is not in [S.available_before insn] and neither is it in + [S.available_across insn]. There is nothing to do. + + (b) [key] is not in [S.available_before insn] but it is in + [S.available_across insn]. A new range is created with the starting + position being one byte after the first machine instruction of [insn] + and left open. + + It might seem like this case 1 (b) is impossible, likewise for 2 (b) + below, since "available across" should always be a subset of + "available before". However this does not hold in general: see the + comment in available_ranges_vars.ml. + + (c) [key] is in [S.available_before insn] but it is not in + [S.available_across insn]. A new range is created with the starting + position being the first machine instruction of [insn] and the ending + position being the next machine address after that. + + (d) [key] is in [S.available_before insn] and it is also in + [S.available_across insn]. A new range is created with the starting + position being the first machine instruction of [insn] and left open. + + 2. Second four cases: [key] is already available, i.e. a member of + [S.available_across prev_insn]. + + (a) [key] is not in [S.available_before insn] and neither is it in + [S.available_across insn]. The range endpoint is given as the address + of the first machine instruction of [insn]. Since endpoint bounds are + exclusive (see above) then [key] will not be shown as available when + the debugger is standing on [insn]. + + (b) [key] is not in [S.available_before insn] but it is in + [S.available_across insn]. The range endpoint is given as the address + of the first machine instruction of [insn]; and a new range is opened + in the same way as for case 1 (b), above. + + (c) [key] is in [S.available_before insn] but it is not in + [S.available_across insn]. This will only happen when calculating + variables' available ranges for operation (i.e. [Lop]) instructions + (for example calls or allocations). To give a good user experience it + is necessary to show availability when the debugger is standing on the + very first instruction of the operation but not thereafter. As such we + terminate the range one byte beyond the first machine instruction of + [insn]. + + (d) [key] is in [S.available_before insn] and it is also in + it is in [S.available_across insn]. The existing range remains open. + *) + + type action = + | Open_one_byte_subrange + | Open_subrange + | Open_subrange_one_byte_after + | Close_subrange + | Close_subrange_one_byte_after + + (* CR mshinwell: Move to [Clflags] *) + let check_invariants = ref true + + let actions_at_instruction ~(insn : L.instruction) + ~(prev_insn : L.instruction option) = + let available_before = S.available_before insn in + let available_across = S.available_across insn in + let opt_available_across_prev_insn = + match prev_insn with + | None -> KS.empty + | Some prev_insn -> S.available_across prev_insn + in + let case_1b = + KS.diff available_across + (KS.union opt_available_across_prev_insn available_before) + in + let case_1c = + KS.diff available_before + (KS.union opt_available_across_prev_insn available_across) + in + let case_1d = + KS.diff (KS.inter available_before available_across) + opt_available_across_prev_insn + in + let case_2a = + KS.diff opt_available_across_prev_insn + (KS.union available_before available_across) + in + let case_2b = + KS.inter opt_available_across_prev_insn + (KS.diff available_across available_before) + in + let case_2c = + KS.diff + (KS.inter opt_available_across_prev_insn available_before) + available_across + in + let handle case action result = + (* We use [K.all_parents] here to circumvent a potential performance + problem. In the case of lexical blocks, there may be long chains + of blocks and their parents, yet the innermost block determines the + rest of the chain. As such [S] (which comes from + lexical_block_ranges.ml) only needs to use the innermost blocks in + the "available before" sets, keeping things fast---but we still + populate ranges for all parent blocks, thus avoiding any + post-processing, by using [K.all_parents] here. *) + KS.fold (fun key result -> + List.fold_left (fun result key -> + (key, action) :: result) + result + (key :: (S.Key.all_parents key))) + case + result + in + let actions = + (* Ranges must be closed before they are opened---otherwise, when a + variable moves between registers at a range boundary, we might end up + with no open range for that variable. Note that the pipeline below + constructs the [actions] list in reverse order---later functions in + the pipeline produce actions nearer the head of the list. *) + [] + |> handle case_1b Open_subrange_one_byte_after + |> handle case_1c Open_one_byte_subrange + |> handle case_1d Open_subrange + |> handle case_2a Close_subrange + |> handle case_2b Open_subrange_one_byte_after + |> handle case_2b Close_subrange + |> handle case_2c Close_subrange_one_byte_after + in + let must_restart = + if S.must_restart_ranges_upon_any_change () + && match actions with + | [] -> false + | _::_ -> true + then + KS.inter opt_available_across_prev_insn available_before + else + KS.empty + in + actions, must_restart + + let rec process_instruction t (fundecl : L.fundecl) + ~(first_insn : L.instruction) ~(insn : L.instruction) + ~(prev_insn : L.instruction option) + ~currently_open_subranges ~subrange_state = + let used_label = ref None in + let get_label () = + match !used_label with + | Some label_and_insn -> label_and_insn + | None -> + (* Note that we can't reuse an existing label in the code since we rely + on the ordering of range-related labels. *) + let label = Cmm.new_label () in + let label_insn : L.instruction = + { desc = Llabel label; + next = insn; + arg = [| |]; + res = [| |]; + dbg = insn.dbg; + live = insn.live; + } + in + used_label := Some (label, label_insn); + label, label_insn + in + let open_subrange key ~start_pos_offset ~currently_open_subranges = + (* If the range is later discarded, the inserted label may actually be + useless, but this doesn't matter. It does not generate any code. *) + let label, label_insn = get_label () in + KM.add key (label, start_pos_offset, label_insn) currently_open_subranges + in + let close_subrange key ~end_pos_offset ~currently_open_subranges = + match KM.find key currently_open_subranges with + | exception Not_found -> + Misc.fatal_errorf "No subrange is open for key %a" + S.Key.print key + | start_pos, start_pos_offset, start_insn -> + let currently_open_subranges = KM.remove key currently_open_subranges in + match Range_info.create fundecl key ~start_insn with + | None -> currently_open_subranges + | Some (index, range_info) -> + let range = + match S.Index.Tbl.find t.ranges index with + | range -> range + | exception Not_found -> + let range = Range.create range_info in + S.Index.Tbl.add t.ranges index range; + range + in + let label, _label_insn = get_label () in + let subrange_info = Subrange_info.create key subrange_state in + let subrange = + Subrange.create ~start_insn + ~start_pos ~start_pos_offset + ~end_pos:label ~end_pos_offset + ~subrange_info + in + Range.add_subrange range ~subrange; + currently_open_subranges + in + let actions, must_restart = actions_at_instruction ~insn ~prev_insn in + (* Restart ranges if needed *) + let currently_open_subranges = + KS.fold (fun key currently_open_subranges -> + let currently_open_subranges = + close_subrange key ~end_pos_offset:0 ~currently_open_subranges + in + open_subrange key ~start_pos_offset:0 ~currently_open_subranges) + must_restart + currently_open_subranges + in + (* Apply actions *) + let currently_open_subranges = + List.fold_left (fun currently_open_subranges (key, (action : action)) -> + match action with + | Open_one_byte_subrange -> + let currently_open_subranges = + open_subrange key ~start_pos_offset:0 ~currently_open_subranges + in + close_subrange key ~end_pos_offset:1 ~currently_open_subranges + | Open_subrange -> + open_subrange key ~start_pos_offset:0 ~currently_open_subranges + | Open_subrange_one_byte_after -> + open_subrange key ~start_pos_offset:1 ~currently_open_subranges + | Close_subrange -> + close_subrange key ~end_pos_offset:0 ~currently_open_subranges + | Close_subrange_one_byte_after -> + close_subrange key ~end_pos_offset:1 ~currently_open_subranges) + currently_open_subranges + actions + in + (* Close all subranges if at last instruction *) + let currently_open_subranges = + match insn.desc with + | Lend -> + let currently_open_subranges = + KM.fold (fun key _ currently_open_subranges -> + close_subrange key ~end_pos_offset:0 ~currently_open_subranges) + currently_open_subranges + currently_open_subranges + in + assert (KM.is_empty currently_open_subranges); + currently_open_subranges + | _ -> currently_open_subranges + in + let first_insn = + match !used_label with + | None -> first_insn + | Some (_label, label_insn) -> + assert (label_insn.L.next == insn); + (* (Note that by virtue of [Lprologue], we can insert labels prior to + the first assembly instruction of the function.) *) + begin match prev_insn with + | None -> + (* The label becomes the new first instruction. *) + label_insn + | Some prev_insn -> + assert (prev_insn.L.next == insn); + prev_insn.next <- label_insn; + first_insn + end + in + if !check_invariants then begin + let currently_open_subranges = + KS.of_list ( + List.map (fun (key, _datum) -> key) + (KM.bindings currently_open_subranges)) + in + let should_be_open = S.available_across insn in + let not_open_but_should_be = + KS.diff should_be_open currently_open_subranges + in + if not (KS.is_empty not_open_but_should_be) then begin + Misc.fatal_errorf "%s: ranges for %a are not open across the following \ + instruction:\n%a\navailable_across:@ %a\n\ + currently_open_subranges: %a" + fundecl.fun_name + KS.print not_open_but_should_be + Printlinear.instr { insn with L.next = L.end_instr; } + KS.print should_be_open + KS.print currently_open_subranges + end + end; + match insn.desc with + | Lend -> first_insn + | Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _ + | Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _ + | Lentertrap | Lpushtrap _ | Lpoptrap | Ladjust_trap_depth _ + | Lraise _ -> + let subrange_state = + Subrange_state.advance_over_instruction subrange_state insn + in + process_instruction t fundecl ~first_insn ~insn:insn.next + ~prev_insn:(Some insn) ~currently_open_subranges ~subrange_state + + let process_instructions t fundecl ~first_insn = + let subrange_state = Subrange_state.create () in + process_instruction t fundecl ~first_insn ~insn:first_insn + ~prev_insn:None ~currently_open_subranges:KM.empty ~subrange_state + + let all_indexes t = + S.Index.Set.of_list (List.map fst (S.Index.Tbl.to_list t.ranges)) + + let empty = + { ranges = S.Index.Tbl.create 1; + } + + let create (fundecl : L.fundecl) = + let t = + { ranges = S.Index.Tbl.create 42; + } + in + let first_insn = + process_instructions t fundecl ~first_insn:fundecl.fun_body + in + let fundecl : L.fundecl = + { fundecl with fun_body = first_insn; } + in + t, fundecl + + let iter t ~f = + S.Index.Tbl.iter (fun index range -> f index range) + t.ranges + + let fold t ~init ~f = + S.Index.Tbl.fold (fun index range acc -> f acc index range) + t.ranges + init + + let find t index = S.Index.Tbl.find t.ranges index + + let rewrite_labels_and_remove_empty_subranges_and_ranges t ~env = + let ranges = S.Index.Tbl.create 42 in + S.Index.Tbl.iter (fun index range -> + let range = + Range.rewrite_labels_and_remove_empty_subranges range ~env + in + if not (Range.no_subranges range) then begin + S.Index.Tbl.add ranges index range + end) + t.ranges; + { ranges; + } +end diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index d38dbaa0ecd6..4afabf8207e0 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -882,6 +882,10 @@ let emit_instr fallthrough i = D.text () | Lentertrap -> () + | Ladjust_trap_depth { delta_traps } -> + let delta = trap_frame_size * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> I.push (label lbl_handler); if trap_frame_size > 8 then diff --git a/asmcomp/linearize.ml b/asmcomp/linearize.ml index 96ba094faf8b..c2a81b3761f8 100644 --- a/asmcomp/linearize.ml +++ b/asmcomp/linearize.ml @@ -40,6 +40,7 @@ and instruction_desc = | Lcondbranch3 of label option * label option * label option | Lswitch of label array | Lentertrap + | Ladjust_trap_depth of { delta_traps : int; } | Lpushtrap of { lbl_handler : label; } | Lpoptrap | Lraise of Cmm.raise_kind @@ -120,18 +121,48 @@ let check_label n = match n.desc with | Llabel lbl -> lbl | _ -> -1 + +(* Add pseudo-instruction Ladjust_trap_depth in front of a continuation + to notify assembler generation about updates to the stack as a result + of differences in exception trap depths. + The argument delta is the number of trap frames (not bytes). *) + +let rec adjust_trap_depth delta_traps next = + (* Simplify by merging and eliminating Ladjust_trap_depth instructions + whenever possible. *) + match next.desc with + | Ladjust_trap_depth { delta_traps = k } -> + adjust_trap_depth (delta_traps + k) next.next + | _ -> + if delta_traps = 0 then next + else cons_instr (Ladjust_trap_depth { delta_traps }) next + (* Discard all instructions up to the next label. This function is to be called before adding a non-terminating instruction. *) let rec discard_dead_code n = + let adjust trap_depth = + adjust_trap_depth trap_depth (discard_dead_code n.next) + in match n.desc with Lend -> n | Llabel _ -> n -(* Do not discard Lpoptrap/Lpushtrap or Istackoffset instructions, - as this may cause a stack imbalance later during assembler generation. *) - | Lpoptrap | Lpushtrap _ -> n - | Lop(Istackoffset _) -> n + (* Do not discard Lpoptrap/Lpushtrap/Ladjust_trap_depth + or Istackoffset instructions, as this may cause a stack imbalance + later during assembler generation. Replace them + with pseudo-instruction Ladjust_trap_depth with the corresponding + stack offset and eliminate dead instructions after them. *) + | Lpoptrap -> adjust (-1) + | Lpushtrap _ -> adjust (+1) + | Ladjust_trap_depth { delta_traps } -> adjust delta_traps + | Lop(Istackoffset _) -> + (* This dead instruction cannot be replaced by Ladjust_trap_depth, + because the units don't match: the argument of Istackoffset is in bytes, + whereas the argument of Ladjust_trap_depth is in trap frames, + and the size of trap frames is machine-dependant and therefore not + available here. *) + { n with next = discard_dead_code n.next; } | _ -> discard_dead_code n.next (* @@ -275,19 +306,9 @@ let rec linear i n = n3 | Iexit nfail -> let lbl, t = find_exit_label_try_depth nfail in - (* We need to re-insert dummy pushtrap (which won't be executed), - so as to preserve stack offset during assembler generation. - It would make sense to have a special pseudo-instruction - only to inform the later pass about this stack offset - (corresponding to N traps). - *) - let lbl_dummy = lbl in - let rec loop i tt = - if t = tt then i - else - loop (cons_instr (Lpushtrap { lbl_handler = lbl_dummy; }) i) (tt - 1) - in - let n1 = loop (linear i.Mach.next n) !try_depth in + assert (i.Mach.next.desc = Iend); + let delta_traps = !try_depth - t in + let n1 = adjust_trap_depth delta_traps n in let rec loop i tt = if t = tt then i else loop (cons_instr Lpoptrap i) (tt - 1) diff --git a/asmcomp/linearize.mli b/asmcomp/linearize.mli index 257716bc6e86..66f1e6feeb80 100644 --- a/asmcomp/linearize.mli +++ b/asmcomp/linearize.mli @@ -37,6 +37,7 @@ and instruction_desc = | Lcondbranch3 of label option * label option * label option | Lswitch of label array | Lentertrap + | Ladjust_trap_depth of { delta_traps : int; } | Lpushtrap of { lbl_handler : label; } | Lpoptrap | Lraise of Cmm.raise_kind diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 4039238b6b73..bfcd0a24850e 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -503,6 +503,7 @@ module BR = Branch_relaxation.Make (struct + (if lbl2 = None then 0 else 1) | Lswitch _ -> size 7 (5 + tocload_size()) (5 + tocload_size()) | Lentertrap -> size 0 (tocload_size()) (tocload_size()) + | Ladjust_trap_depth _ -> 0 | Lpushtrap _ -> size 5 (4 + tocload_size()) (4 + tocload_size()) | Lpoptrap -> 2 | Lraise _ -> 6 @@ -980,6 +981,8 @@ let emit_instr i = | ELF32 -> () | ELF64v1 | ELF64v2 -> emit_reload_toc() end + | Ladjust_trap_depth { delta_traps } -> + adjust_stack_offset (trap_size * delta_traps) | Lpushtrap { lbl_handler; } -> begin match abi with | ELF32 -> diff --git a/asmcomp/printlinear.ml b/asmcomp/printlinear.ml index 4e62fc6f61ad..066193e5423e 100644 --- a/asmcomp/printlinear.ml +++ b/asmcomp/printlinear.ml @@ -61,6 +61,8 @@ let instr ppf i = fprintf ppf "@,endswitch" | Lentertrap -> fprintf ppf "enter trap" + | Ladjust_trap_depth { delta_traps } -> + fprintf ppf "adjust trap depth by %d traps" delta_traps | Lpushtrap { lbl_handler; } -> fprintf ppf "push trap %a" label lbl_handler | Lpoptrap -> diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 52d724f757e2..b7a0fdc993e3 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -610,6 +610,11 @@ let emit_instr i = emit_string code_space | Lentertrap -> () + | Ladjust_trap_depth { delta_traps } -> + (* each trap occupies 16 bytes on the stack *) + let delta = 16 * delta_traps in + emit_stack_adjust delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> stack_offset := !stack_offset + 16; emit_stack_adjust 16;