1 files changed, 89 insertions, 0 deletions
diff --git a/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
new file mode 100644
index 0000000000..01d7e89ccd
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
@@ -0,0 +1,89 @@
+%% -*- mode: erlang; erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+-module(hipe_rtl_verify_gcsafe).
+
+-export([check/1]).
+
+-include("../flow/cfg.hrl").              %% needed for the specs
+-include("hipe_rtl.hrl").
+
+check(CFG) ->
+  Liveness = hipe_rtl_liveness:analyze(CFG),
+  put({?MODULE, 'fun'}, CFG#cfg.info#cfg_info.'fun'),
+  lists:foreach(
+    fun(Lb) ->
+        put({?MODULE, label}, Lb),
+        Liveout = hipe_rtl_liveness:liveout(Liveness, Lb),
+        BB = hipe_rtl_cfg:bb(CFG, Lb),
+        check_instrs(lists:reverse(hipe_bb:code(BB)), Liveout)
+    end, hipe_rtl_cfg:labels(CFG)),
+  erase({?MODULE, 'fun'}),
+  erase({?MODULE, label}),
+  erase({?MODULE, instr}),
+  ok.
+
+check_instrs([], _Livein) -> ok;
+check_instrs([I|Is], LiveOut) ->
+  Def = ordsets:from_list(hipe_rtl:defines(I)),
+  Use = ordsets:from_list(hipe_rtl:uses(I)),
+  LiveOver = ordsets:subtract(LiveOut, Def),
+  LiveIn = ordsets:union(LiveOver, Use),
+  case (hipe_rtl:is_call(I)
+        andalso not safe_primop(hipe_rtl:call_fun(I)))
+    orelse is_record(I, gctest)
+  of
+    false -> ok;
+    true ->
+      put({?MODULE, instr}, I),
+      lists:foreach(fun verify_live/1, LiveOver)
+  end,
+  check_instrs(Is, LiveIn).
+
+verify_live(T) ->
+  case hipe_rtl:is_reg(T) of
+    false -> ok;
+    true ->
+      case hipe_rtl:reg_is_gcsafe(T) of
+        true -> ok;
+        false ->
+          error({gcunsafe_live_over_call,
+                 get({?MODULE, 'fun'}),
+                 {label, get({?MODULE, label})},
+                 get({?MODULE, instr}),
+                 T})
+      end
+  end.
+
+%% Primops that can't gc
+%% Note: This information is essentially duplicated from hipe_bif_list.m4
+safe_primop(is_divisible) -> true;
+safe_primop(is_unicode) -> true;
+safe_primop(cmp_2) -> true;
+safe_primop(eq_2) -> true;
+safe_primop(bs_allocate) -> true;
+safe_primop(bs_reallocate) -> true;
+safe_primop(bs_utf8_size) -> true;
+safe_primop(bs_get_utf8) -> true;
+safe_primop(bs_put_utf8) -> true;
+safe_primop(bs_utf16_size) -> true;
+safe_primop(bs_get_utf16) -> true;
+safe_primop(bs_validate_unicode_retract) -> true;
+safe_primop(bs_put_small_float) -> true;
+safe_primop(bs_put_bits) -> true;
+safe_primop(emasculate_binary) -> true;
+safe_primop(atomic_inc) -> true;
+%% Not noproc but manually verified
+safe_primop(bs_put_big_integer) -> true;
+safe_primop(_) -> false.