diff options
| author | Thomas Refis <thomas.refis@gmail.com> | 2018-01-17 15:19:09 +0000 |
|---|---|---|
| committer | Thomas Refis <refis.thomas@gmail.com> | 2018-02-19 11:02:32 +0000 |
| commit | 74c9dfaa59d00a70d730af85dc2c65891fb59abc (patch) | |
| tree | ac06e05ba06479b845005aa33a2e3198a4be516f | |
| parent | ca70c51cd7827df348dcea45e923c81dad2612c9 (diff) | |
| download | ocaml-74c9dfaa59d00a70d730af85dc2c65891fb59abc.tar.gz | |
emitcode: merge events after instructions reordering
| -rw-r--r-- | Changes | 4 | ||||
| -rw-r--r-- | bytecomp/bytegen.mli | 2 | ||||
| -rw-r--r-- | bytecomp/emitcode.ml | 13 |
3 files changed, 15 insertions, 4 deletions
@@ -197,6 +197,10 @@ Working version - GPR#1520: more robust implementation of Misc.no_overflow_mul (Max Mouratov, review by Xavier Leroy) +- GPR#1573: emitcode: merge events after instructions reordering + (Thomas Refis and Leo White, with help from David Allsopp, review by Frédéric + Bour) + - GPR#1586: testsuite: 'make promote' for ocamltest tests (The new "-promote" option for ocamltest is experimental and subject to change/removal). diff --git a/bytecomp/bytegen.mli b/bytecomp/bytegen.mli index b23a1dc6bf..24855ec696 100644 --- a/bytecomp/bytegen.mli +++ b/bytecomp/bytegen.mli @@ -21,3 +21,5 @@ open Instruct val compile_implementation: string -> lambda -> instruction list val compile_phrase: lambda -> instruction list * instruction list val reset: unit -> unit + +val merge_events : Instruct.debug_event -> Instruct.debug_event -> Instruct.debug_event diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 3c7f848a62..9cc4765791 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -304,6 +304,11 @@ let emit_instr = function (* Emission of a list of instructions. Include some peephole optimization. *) +let remerge_events ev1 = function + | Kevent ev2 :: c -> + Kevent (Bytegen.merge_events ev1 ev2) :: c + | c -> Kevent ev1 :: c + let rec emit = function [] -> () (* Peephole optimizations *) @@ -372,13 +377,13 @@ let rec emit = function out opPUSHGETGLOBAL; slot_for_literal sc end; emit c - | Kpush :: (Kevent {ev_kind = Event_before} as ev) :: + | Kpush :: (Kevent ({ev_kind = Event_before} as ev)) :: (Kgetglobal _ as instr1) :: (Kgetfield _ as instr2) :: c -> - emit (Kpush :: instr1 :: instr2 :: ev :: c) - | Kpush :: (Kevent {ev_kind = Event_before} as ev) :: + emit (Kpush :: instr1 :: instr2 :: remerge_events ev c) + | Kpush :: (Kevent ({ev_kind = Event_before} as ev)) :: (Kacc _ | Kenvacc _ | Koffsetclosure _ | Kgetglobal _ | Kconst _ as instr):: c -> - emit (Kpush :: instr :: ev :: c) + emit (Kpush :: instr :: remerge_events ev c) | Kgetglobal id :: Kgetfield n :: c -> out opGETGLOBALFIELD; slot_for_getglobal id; out_int n; emit c (* Default case *) |