Merge branch 'yiannist/erllvm-fixes'

* yiannist/erllvm-fixes:
  Fix frame size adjustment of stack descriptors
  Fix counting of arguments of closures
  Check for required LLVM version or issue error

3 files changed, 47 insertions, 24 deletions

diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl
index e911fb89c9..0e50c9539b 100644
--- a/lib/hipe/llvm/hipe_llvm_main.erl
+++ b/lib/hipe/llvm/hipe_llvm_main.erl
@@ -342,8 +342,8 @@ create_sdesc_list([{ExnLbl, SPOff} | MoreExnAndSPOffs],
 %%      (thus, some of their arguments are passed to the stack). Because of the
 %%      Reserved Call Frame feature that the LLVM uses, the stack descriptors
 %%      are not correct since at the point of call the frame size is reduced
-%%      proportionally to the number of arguments that are passed on the stack.
-%%      Also the offsets of the roots need to be re-adjusted.
+%%      by the number of arguments that are passed on the stack. Also, the
+%%      offsets of the roots need to be re-adjusted.
 fix_stack_descriptors(_, _, [], _) ->
   [];
 fix_stack_descriptors(RelocsDict, Relocs, SDescs, ExposedClosures) ->
@@ -427,30 +427,22 @@ find_offsets([{Off,Arity}|Rest], Offsets, Acc) ->
   [I | RestOffsets] = lists:dropwhile(fun (Y) -> Y<Off end, Offsets),
   find_offsets(Rest, RestOffsets, [{I, Arity}|Acc]).
 
-%% The functions below correct the arity of calls, that are identified
-%% by offset, in the stack descriptors.
+%% The function below corrects the stack descriptors of calls with arguments
+%% that are passed on the stack (more than NR_ARG_REGS) by subtracting the
+%% number of stacked arguments from the frame size and from the offset of the
+%% roots.
 fix_sdescs([], SDescs) -> SDescs;
 fix_sdescs([{Offset, Arity} | Rest], SDescs) ->
   case lists:keyfind(Offset, 2, SDescs) of
     false ->
       fix_sdescs(Rest, SDescs);
-    {?SDESC, Offset, SDesc} ->
-      {ExnHandler, FrameSize, StkArity, Roots} = SDesc,
-      DecRoot = fun(X) -> X-Arity end,
-      NewRootsList = lists:map(DecRoot, tuple_to_list(Roots)),
-      NewSDesc =
-        case length(NewRootsList) > 0 andalso hd(NewRootsList) >= 0 of
-          true ->
-            {?SDESC, Offset, {ExnHandler, FrameSize-Arity, StkArity,
-			      list_to_tuple(NewRootsList)}};
-          false ->
-            {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}}
-        end,
-      RestSDescs = lists:keydelete(Offset, 2, SDescs),
-      fix_sdescs(Rest, [NewSDesc | RestSDescs])
+    {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}} ->
+      FixedRoots = list_to_tuple([Ri - Arity || Ri <- tuple_to_list(Roots)]),
+      FixedSDesc =
+        {?SDESC, Offset, {ExnHandler, FrameSize - Arity, StkArity, FixedRoots}},
+      fix_sdescs(Rest, [FixedSDesc | lists:keydelete(Offset, 2, SDescs)])
   end.
 
-
 %%------------------------------------------------------------------------------
 %% Miscellaneous functions
 %%------------------------------------------------------------------------------
diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
index ba76e1d815..d7d8d1b049 100644
--- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl
+++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
@@ -430,12 +430,13 @@ trans_call_name(RtlCallName, Relocs, CallArgs, FinalArgs) ->
   case RtlCallName of
     PrimOp when is_atom(PrimOp) ->
       LlvmName = trans_prim_op(PrimOp),
-      Relocs1 = relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}},
-                             Relocs),
+      Relocs1 =
+        relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}}, Relocs),
       {"@" ++ LlvmName, [], Relocs1};
     {M, F, A} when is_atom(M), is_atom(F), is_integer(A) ->
-      LlvmName = trans_mfa_name({M,F,A}),
-      Relocs1 = relocs_store(LlvmName, {call, {M,F,A}}, Relocs),
+      LlvmName = trans_mfa_name({M, F, A}),
+      Relocs1 =
+        relocs_store(LlvmName, {call, {M, F, length(CallArgs)}}, Relocs),
       {"@" ++ LlvmName, [], Relocs1};
     Reg ->
       case hipe_rtl:is_reg(Reg) of
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index d47eced6d8..539ce883c0 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -200,6 +200,7 @@
 	 compile_core/4,
  	 file/1,
  	 file/2,
+        llvm_support_available/0,
 	 load/1,
 	 help/0,
 	 help_hiper/0,
@@ -648,7 +649,18 @@ run_compiler_1(DisasmFun, IcodeFun, Options) ->
 			    %% The full option expansion is not done
 			    %% until the DisasmFun returns.
 			    {Code, CompOpts} = DisasmFun(Options),
-			    Opts = expand_options(Options ++ CompOpts),
+			    Opts0 = expand_options(Options ++ CompOpts),
+                           Opts =
+                             case proplists:get_bool(to_llvm, Opts0) andalso
+                                 not llvm_support_available() of
+                               true ->
+                                 ?error_msg("No LLVM version 3.4 or greater "
+                                            "found in $PATH; aborting "
+                                            "native code compilation.\n", []),
+                                 ?EXIT(cant_find_required_llvm_version);
+                               false ->
+                                 Opts0
+                             end,
 			    check_options(Opts),
 			    ?when_option(verbose, Options,
 					 ?debug_msg("Options: ~p.\n",[Opts])),
@@ -1537,4 +1549,22 @@ check_options(Opts) ->
       ok
   end.
 
+-spec llvm_support_available() -> boolean().
+
+llvm_support_available() ->
+  get_llvm_version() >= 3.4.
+
+get_llvm_version() ->
+  OptStr = os:cmd("opt -version"),
+  SubStr = "LLVM version ", N = length(SubStr),
+  case string:str(OptStr, SubStr) of
+     0 -> % No opt available
+       0.0;
+     S ->
+       case string:to_float(string:sub_string(OptStr, S + N)) of
+         {error, _} -> 0.0; %XXX: Assumes no revision numbers in versioning
+         {Float, _} -> Float
+       end
+  end.
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%