1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%% Purpose : Updates variable list with variables depending on
22%%%	      running Erlang system.
23
24-module(ts_erl_config).
25
26
27-export([variables/2]).
28
29%% Returns a list of key, value pairs.
30
31variables(Base0, OsType) ->
32    Base1 = erl_include(Base0),
33    Base2 = get_app_vars(fun erl_interface/2, Base1, OsType),
34    Base3 = get_app_vars(fun ic/2, Base2, OsType),
35    Base4 = get_app_vars(fun jinterface/2, Base3, OsType),
36    Base5 = dl_vars(Base4, Base3, OsType),
37    Base6 = emu_vars(Base5),
38    Base7 = get_app_vars(fun ssl/2, Base6, OsType),
39    Base8 = erts_lib(Base7, OsType),
40    Base = separators(Base8, OsType),
41    [{'EMULATOR', tl(code:objfile_extension())},
42     {emu_threads, atom_to_list(erlang:system_info(threads))},
43     {type_marker, case is_debug_build() of
44		       true ->
45			   ".debug";
46		       false ->
47			   ""
48		   end}
49     | Base].
50
51get_app_vars(AppFun, Vars, OsType) ->
52    case catch AppFun(Vars,OsType) of
53	Res when is_list(Res) ->
54	    Res;
55	{cannot_find_app, App} ->
56	    io:format("* WARNING: Cannot find ~p!~n", [App]),
57	    Vars;
58	{'EXIT', Reason} ->
59	    exit(Reason);
60	Garbage ->
61	    exit({unexpected_internal_error, Garbage})
62    end.
63
64dl_vars(Vars, Base3, OsType) ->
65    ShlibRules0 = ".SUFFIXES:\n" ++
66 	".SUFFIXES: @dll@ @obj@ .c\n\n" ++
67 	".c@dll@:\n" ++
68 	"\t@CC@ -c @SHLIB_CFLAGS@ $(SHLIB_EXTRA_CFLAGS) -I@erl_include@ @DEFS@ $<\n" ++
69	"\t@SHLIB_LD@ @CROSSLDFLAGS@ @SHLIB_LDFLAGS@ $(SHLIB_EXTRA_LDFLAGS) -o $@ $*@obj@ @SHLIB_LDLIBS@ $(SHLIB_EXTRA_LDLIBS)",
70
71    ShlibRules = ts_lib:subst(ShlibRules0, Vars),
72    case get_app_vars2(fun jinterface/2, Base3, OsType) of
73	{App, not_found} ->
74	    [{'SHLIB_RULES', ShlibRules}, {App, "not_found"}|Vars];
75	_ ->
76	    [{'SHLIB_RULES', ShlibRules}|Vars]
77    end.
78get_app_vars2(AppFun, Vars, OsType) ->
79    case catch AppFun(Vars,OsType) of
80	Res when is_list(Res) ->
81	    {jinterface, ok};
82	{cannot_find_app, App} ->
83	    {App, not_found};
84	{'EXIT', Reason} ->
85	    exit(Reason);
86	Garbage ->
87	    exit({unexpected_internal_error, Garbage})
88    end.
89
90erts_lib_name(multi_threaded, {win32, V}) ->
91    link_library("erts_MD" ++ case is_debug_build() of
92				  true -> "d";
93				  false -> ""
94			      end,
95		 {win32, V});
96erts_lib_name(single_threaded, {win32, V}) ->
97    link_library("erts_ML" ++ case is_debug_build() of
98				  true -> "d";
99				  false -> ""
100			      end,
101		 {win32, V});
102erts_lib_name(multi_threaded, OsType) ->
103    link_library("erts_r", OsType);
104erts_lib_name(single_threaded, OsType) ->
105    link_library("erts", OsType).
106
107erts_lib(Vars,OsType) ->
108    {ErtsLibInclude,
109     ErtsLibIncludeGenerated,
110     ErtsLibIncludeInternal,
111     ErtsLibIncludeInternalGenerated,
112     ErtsLibPath,
113     ErtsLibInternalPath,
114     ErtsLibEthreadMake,
115     ErtsLibInternalMake
116    }
117	= case erl_root(Vars) of
118	      {installed, _Root} ->
119		  Erts = lib_dir(Vars, erts),
120		  ErtsInclude = filename:join([Erts, "include"]),
121		  ErtsIncludeInternal = filename:join([ErtsInclude, "internal"]),
122		  ErtsLib = filename:join([Erts, "lib"]),
123		  ErtsLibInternal = filename:join([ErtsLib, "internal"]),
124		  ErtsEthreadMake = filename:join([ErtsIncludeInternal, "ethread.mk"]),
125		  ErtsInternalMake = filename:join([ErtsIncludeInternal, "erts_internal.mk"]),
126
127		  {ErtsInclude,
128		   ErtsInclude,
129		   ErtsIncludeInternal,
130		   ErtsIncludeInternal,
131		   ErtsLib,
132		   ErtsLibInternal,
133		   ErtsEthreadMake,
134		   ErtsInternalMake};
135	      {srctree, Root, Target} ->
136		  Erts = filename:join([Root, "erts"]),
137		  ErtsInclude = filename:join([Erts, "include"]),
138		  ErtsIncludeTarget = filename:join([ErtsInclude, Target]),
139		  ErtsIncludeInternal = filename:join([ErtsInclude,
140						       "internal"]),
141		  ErtsIncludeInternalTarget = filename:join([ErtsIncludeInternal,
142							     Target]),
143		  ErtsLib = filename:join([Erts, "lib", Target]),
144		  ErtsLibInternal = filename:join([Erts,
145						   "lib",
146						   "internal",
147						   Target]),
148		  ErtsEthreadMake = filename:join([ErtsIncludeInternalTarget, "ethread.mk"]),
149		  ErtsInternalMake = filename:join([ErtsIncludeInternalTarget, "erts_internal.mk"]),
150
151		  {ErtsInclude,
152		   ErtsIncludeTarget,
153		   ErtsIncludeInternal,
154		   ErtsIncludeInternalTarget,
155		   ErtsLib,
156		   ErtsLibInternal,
157		   ErtsEthreadMake,
158		   ErtsInternalMake}
159	  end,
160    [{erts_lib_include,
161      quote(filename:nativename(ErtsLibInclude))},
162     {erts_lib_include_generated,
163      quote(filename:nativename(ErtsLibIncludeGenerated))},
164     {erts_lib_include_internal,
165      quote(filename:nativename(ErtsLibIncludeInternal))},
166     {erts_lib_include_internal_generated,
167      quote(filename:nativename(ErtsLibIncludeInternalGenerated))},
168     {erts_lib_path, quote(filename:nativename(ErtsLibPath))},
169     {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))},
170     {erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)},
171     {erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)},
172     {erts_lib_make_ethread, quote(ErtsLibEthreadMake)},
173     {erts_lib_make_internal, quote(ErtsLibInternalMake)}
174     | Vars].
175
176erl_include(Vars) ->
177    Include =
178	case erl_root(Vars) of
179	    {installed, Root} ->
180		quote(filename:join([Root, "usr", "include"]));
181	    {srctree, Root, Target} ->
182		quote(filename:join([Root, "erts", "emulator", "beam"]))
183		    ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"]))
184		    ++ system_include(Root, Vars)
185		    ++ " -I" ++ quote(filename:join([Root, "erts", "include"]))
186		    ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target]))
187	end,
188    [{erl_include, filename:nativename(Include)}|Vars].
189
190
191system_include(Root, Vars) ->
192    SysDir =
193	case ts_lib:var(os, Vars) of
194	    "Windows" ++ _T -> "sys/win32";
195	    _ -> "sys/unix"
196	end,
197    " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))).
198
199erl_interface(Vars,OsType) ->
200    {Incl, {LibPath, MkIncl}} =
201	case lib_dir(Vars, erl_interface) of
202	    {error, bad_name} ->
203		throw({cannot_find_app, erl_interface});
204	    Dir ->
205		{filename:join(Dir, "include"),
206		 case erl_root(Vars) of
207		     {installed, _Root} ->
208			 {filename:join(Dir, "lib"),
209			  filename:join([Dir, "src", "eidefs.mk"])};
210		     {srctree, _Root, Target} ->
211                         Obj = case is_debug_build() of
212                                   true -> "obj.debug";
213                                   false -> "obj"
214                               end,
215			 {filename:join([Dir, Obj, Target]),
216			  filename:join([Dir, "src", Target, "eidefs.mk"])}
217		 end}
218	end,
219    Lib = link_library("erl_interface",OsType),
220    Lib1 = link_library("ei",OsType),
221    {LibDrv, Lib1Drv} =
222	case erlang:system_info(threads) of
223	    false ->
224		case OsType of
225		    {unix,_} ->
226			{link_library("erl_interface_st",OsType),
227			 link_library("ei_st",OsType)};
228		    _ ->
229			{Lib, Lib1}
230		end;
231	    true ->
232		case OsType of
233		    {win32, _} ->
234			{link_library("erl_interface_md",OsType),
235			 link_library("ei_md",OsType)};
236		    _ ->
237			{Lib, Lib1}
238		end
239	end,
240    ThreadLib = case OsType of
241		    % FIXME: FreeBSD uses gcc flag '-pthread' or linking with
242		    % "libc_r". So it has to be last of libs. This is an
243		    % temporary solution, should be configured elsewhere.
244
245		    % This temporary solution have now failed!
246		    % A new temporary solution is installed ...
247		    % {unix,freebsd} -> "-lc_r";
248		    {unix,freebsd} ->
249			"-lpthread";
250		    {unix,_} ->
251			"-lpthread";
252		    _ ->
253			""
254		end,
255    [{erl_interface_libpath, quote(filename:nativename(LibPath))},
256     {erl_interface_sock_libs, sock_libraries(OsType)},
257     {erl_interface_lib, quote(filename:join(LibPath, Lib))},
258     {erl_interface_eilib, quote(filename:join(LibPath, Lib1))},
259     {erl_interface_lib_drv, quote(filename:join(LibPath, LibDrv))},
260     {erl_interface_eilib_drv, quote(filename:join(LibPath, Lib1Drv))},
261     {erl_interface_threadlib, ThreadLib},
262     {erl_interface_include, quote(filename:nativename(Incl))},
263     {erl_interface_mk_include, quote(filename:nativename(MkIncl))}
264     | Vars].
265
266ic(Vars, OsType) ->
267    {ClassPath, LibPath, Incl} =
268	case lib_dir(Vars, ic) of
269	    {error, bad_name} ->
270		throw({cannot_find_app, ic});
271	    Dir ->
272		{filename:join([Dir, "priv", "ic.jar"]),
273		 case erl_root(Vars) of
274		     {installed, _Root} ->
275			 filename:join([Dir, "priv", "lib"]);
276		     {srctree, _Root, Target} ->
277			 filename:join([Dir, "priv", "lib", Target])
278		 end,
279		 filename:join(Dir, "include")}
280	end,
281    [{ic_classpath, quote(filename:nativename(ClassPath))},
282     {ic_libpath, quote(filename:nativename(LibPath))},
283     {ic_lib, quote(filename:join(filename:nativename(LibPath),link_library("ic", OsType)))},
284     {ic_include_path, quote(filename:nativename(Incl))}|Vars].
285
286jinterface(Vars, _OsType) ->
287    ClassPath =
288	case lib_dir(Vars, jinterface) of
289	    {error, bad_name} ->
290		throw({cannot_find_app, jinterface});
291	    Dir ->
292		filename:join([Dir, "priv", "OtpErlang.jar"])
293	end,
294    [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars].
295
296lib_dir(Vars, Lib) ->
297    LibLibDir = case Lib of
298		    erts ->
299			filename:join([code:root_dir(),
300				       "erts-" ++ erlang:system_info(version)]);
301		    _ ->
302			code:lib_dir(Lib)
303		end,
304    case {get_var(crossroot, Vars), LibLibDir} of
305	{{error, _}, _} ->			%no crossroot
306	    LibLibDir;
307	{CrossRoot, _} ->
308	    %% XXX: Ugly. So ugly I won't comment it
309	    %% /Patrik
310	    CLibDirList = case Lib of
311			      erts ->
312				  [CrossRoot, "erts"];
313			      _ ->
314				  [CrossRoot, "lib", atom_to_list(Lib)]
315			  end,
316	    CLibDir = filename:join(CLibDirList),
317	    Cmd = "ls -d " ++ CLibDir ++ "*",
318	    XLibDir = lists:last(string:lexemes(os:cmd(Cmd),"\n")),
319	    case file:list_dir(XLibDir) of
320		{error, enoent} ->
321		    [];
322		_ ->
323		    XLibDir
324	    end
325    end.
326
327erl_root(Vars) ->
328    Root = case get_var(crossroot,Vars) of
329	       {error, notfound} -> code:root_dir();
330	       CrossRoot -> CrossRoot
331	   end,
332    case ts_lib:erlang_type(Root) of
333	{srctree, _Version} ->
334	    Target = get_var(target, Vars),
335	    {srctree, Root, Target};
336	{_, _Version} ->
337	    {installed, Root}
338    end.
339
340
341get_var(Key, Vars) ->
342    case lists:keysearch(Key, 1, Vars) of
343	{value, {Key, Value}} ->
344	    Value;
345	_ ->
346	    {error, notfound}
347    end.
348
349
350sock_libraries({win32, _}) ->
351    "ws2_32.lib";
352sock_libraries({unix, _}) ->
353    "".	% Included in general libraries if needed.
354
355link_library(LibName,{win32, _}) ->
356    LibName ++ ".lib";
357link_library(LibName,{unix, _}) ->
358    "lib" ++ LibName ++ ".a";
359link_library(_LibName,_Other) ->
360    exit({link_library, not_supported}).
361
362%% Returns emulator specific variables.
363emu_vars(Vars) ->
364    [{is_source_build, is_source_build()},
365     {erl_name, get_progname()}|Vars].
366
367get_progname() ->
368    case init:get_argument(progname) of
369	{ok, [[Prog]]} ->
370	    Prog;
371	_Other ->
372	    "no_prog_name"
373    end.
374
375is_source_build() ->
376    string:find(erlang:system_info(system_version), "source") =/= nomatch.
377
378is_debug_build() ->
379    string:find(erlang:system_info(system_version), "debug") =/= nomatch.
380
381%%
382%% ssl_libdir
383%%
384ssl(Vars, _OsType) ->
385    case lib_dir(Vars, ssl) of
386	{error, bad_name} ->
387	    throw({cannot_find_app, ssl});
388	Dir ->
389	    [{ssl_libdir, quote(filename:nativename(Dir))}| Vars]
390    end.
391
392separators(Vars, {win32,_}) ->
393    [{'DS',"\\"},{'PS',";"}|Vars];
394separators(Vars, _) ->
395    [{'DS',"/"},{'PS',":"}|Vars].
396
397quote(List) ->
398    case lists:member($ , List) of
399	false -> List;
400	true -> make_quote(List)
401    end.
402
403make_quote(List) ->
404    case os:type() of
405	{win32, _} -> %% nmake"
406	    [$"] ++ List ++ [$"];
407	_ -> %% make
408	    BackQuote = fun($ , Acc) -> [$\\ , $  |Acc];
409			   (Char, Acc) -> [Char|Acc] end,
410	    lists:foldr(BackQuote, [], List)
411    end.
412