aboutsummaryrefslogblamecommitdiffstats
path: root/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_codegen.erl
blob: 6b787e8c956edc9f743f82a13b8ce33486e3dee4 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364




                                                                        
  



                                                                         
  


                                                                         
  









                                                                      
  





                                                                      
                                                               

































































































































































































































































































                                                                                
 








































































































































































































                                                                                      
 













































































                                                                                 
 



















































                                                                            
 
















































                                                                              
                                                        





                                                                       
                       







































































































































































                                                                          
                              
                        

                                         












































































































































                                                                                  
                                     



                                            
                                 









































































































































































































































































































































                                                                                       
 





                                                              
 






















































































































































































































                                                                                 
 






































































































































































                                                                                 
%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved via the world wide web at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%%
%%     $Id: v3_codegen.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $
%%
%% Purpose : Code generator for Beam.

%% The following assumptions have been made:
%%
%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return
%% values; no variables are exported. If the match would have returned
%% extra variables then these have been transformed to multiple return
%% values.
%%
%% 2. All BIF's called in guards are gc-safe so there is no need to
%% put thing on the stack in the guard.  While this would in principle
%% work it would be difficult to keep track of the stack depth when
%% trimming.
%%
%% The code generation uses variable lifetime information added by
%% the v3_life module to save variables, allocate registers and
%% move registers to the stack when necessary.
%%
%% We try to use a consistent variable name scheme throughout.  The
%% StackReg record is always called Bef,Int<n>,Aft.

-module(v3_codegen).

%% The main interface.
-export([module/2]).

-import(lists, [member/2,keymember/3,keysort/2,keysearch/3,append/1,
		map/2,flatmap/2,foldl/3,foldr/3,mapfoldl/3,
		sort/1,reverse/1,reverse/2]).
-import(v3_life, [vdb_find/2]).

%%-compile([export_all]).

-include("v3_life.hrl").

%% Main codegen structure.
-record(cg, {lcount=1,				%Label counter
	     mod,				%Current module
	     func,				%Current function
	     finfo,				%Function info label
	     fcode,				%Function code label
	     btype,				%Type of bif used.
	     bfail,				%Fail label of bif
	     break,				%Break label
	     recv,				%Receive label
	     is_top_block,			%Boolean: top block or not
	     functable = [],			%Table of local functions:
						%[{{Name, Arity}, Label}...]
	     in_catch=false,			%Inside a catch or not.
	     need_frame,			%Need a stack frame.
	     new_funs=true}).			%Generate new fun instructions.

%% Stack/register state record.
-record(sr, {reg=[],				%Register table
	     stk=[],				%Stack table
	     res=[]}).				%Reserved regs: [{reserved,I,V}]

module({Mod,Exp,Attr,Forms}, Options) ->
    NewFunsFlag = not member(no_new_funs, Options),
    {Fs,St} = functions(Forms, #cg{mod=Mod,new_funs=NewFunsFlag}),
    {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.

functions(Forms, St0) ->
    mapfoldl(fun (F, St) -> function(F, St) end, St0#cg{lcount=1}, Forms).

function({function,Name,Arity,As0,Vb,Vdb}, St0) ->
    %%ok = io:fwrite("cg ~w:~p~n", [?LINE,{Name,Arity}]),
    St1 = St0#cg{func={Name,Arity}},
    {Fun,St2} = cg_fun(Vb, As0, Vdb, St1),
    Func0 = {function,Name,Arity,St2#cg.fcode,Fun},
    Func = bs_function(Func0),
    {Func,St2}.

%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State}

cg_fun(Les, Hvs, Vdb, St0) ->
    {Name,Arity} = St0#cg.func,
    {Fi,St1} = new_label(St0),			%FuncInfo label
    {Fl,St2} = local_func_label(Name, Arity, St1),
    %% Create initial stack/register state, clear unused arguments.
    Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) ->
					   put_reg(V, Reg)
				   end, [], Hvs),
			stk=[]}, 0, Vdb),
    {B2,_Aft,St3} = cg_list(Les, 0, Vdb, Bef, St2#cg{btype=exit,
						    bfail=Fi,
						    finfo=Fi,
						    fcode=Fl,
						    is_top_block=true}),
    A = [{label,Fi},{func_info,{atom,St3#cg.mod},{atom,Name},Arity},
	 {label,Fl}|B2],
    {A,St3}.

%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}.
%%  Generate code for a kexpr.
%%  Split function into two steps for clarity, not efficiency.

cg(Le, Vdb, Bef, St) ->
    cg(Le#l.ke, Le, Vdb, Bef, St).

cg({block,Es}, Le, Vdb, Bef, St) ->
    block_cg(Es, Le, Vdb, Bef, St);
cg({match,M,Rs}, Le, Vdb, Bef, St) ->
    match_cg(M, Rs, Le, Vdb, Bef, St);
cg({match_fail,F}, Le, Vdb, Bef, St) ->
    match_fail_cg(F, Le, Vdb, Bef, St);
cg({call,Func,As,Rs}, Le, Vdb, Bef, St) ->
    call_cg(Func, As, Rs, Le, Vdb, Bef, St);
cg({enter,Func,As}, Le, Vdb, Bef, St) ->
    enter_cg(Func, As, Le, Vdb, Bef, St);
cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
    bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) ->
    recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St);
cg(receive_next, Le, Vdb, Bef, St) ->
    recv_next_cg(Le, Vdb, Bef, St);
cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St};
cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) ->
    try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St);
cg({'catch',Cb,R}, Le, Vdb, Bef, St) ->
    catch_cg(Cb, R, Le, Vdb, Bef, St);
cg({set,Var,Con}, Le, Vdb, Bef, St) -> set_cg(Var, Con, Le, Vdb, Bef, St);
cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St);
cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St);
cg({need_heap,0}, _Le, _Vdb, Bef, St) ->
    {[],Bef,St};
cg({need_heap,H}, _Le, _Vdb, Bef, St) ->
    {[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}.

%% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.

cg_list(Kes, I, Vdb, Bef, St0) ->
    {Keis,{Aft,St1}} =
	flatmapfoldl(fun (Ke, {Inta,Sta}) ->
%			     ok = io:fwrite("    %% ~p\n", [Inta]),
%			     ok = io:fwrite("cgl:~p\n", [Ke]),
			     {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
%			     ok = io:fwrite("    ~p\n", [Keis]),
%			     ok = io:fwrite("    %% ~p\n", [Intb]),
			     {comment(Inta) ++ Keis,{Intb,Stb}}
		     end, {Bef,St0}, need_heap(Kes, I)),
    {Keis,Aft,St1}.

%% need_heap([Lkexpr], I, BifType) -> [Lkexpr].
%%  Insert need_heap instructions in Kexpr list.  Try to be smart and
%%  collect them together as much as possible.

need_heap(Kes0, I) ->
    {Kes1,{H,F}} = flatmapfoldr(fun (Ke, {H0,F0}) ->
					{Ns,H1,F1} = need_heap_1(Ke, H0, F0),
					{[Ke|Ns],{H1,F1}}
				end, {0,false}, Kes0),
    %% Prepend need_heap if necessary.
    Kes2 = need_heap_need(I, H, F) ++ Kes1,
%     ok = io:fwrite("need_heap: ~p~n",
% 		   [{{H,F},
% 		     map(fun (#l{ke={match,M,Rs}}) -> match;
% 			     (Lke) -> Lke#l.ke end, Kes2)}]),
    Kes2.

need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H, F) ->
    {need_heap_need(I, H, F),0,false};
need_heap_1(#l{ke={set,_,Val}}, H, F) ->
    %% Just pass through adding to needed heap.
    {[],H + case Val of
		{cons,_} -> 2;
		{tuple,Es} -> 1 + length(Es);
		{string,S} -> 2 * length(S);
		_Other -> 0
	    end,F};
need_heap_1(#l{ke={call,_Func,_As,_Rs},i=I}, H, F) ->
    %% Calls generate a need if necessary and also force one.
    {need_heap_need(I, H, F),0,true};
need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H, F) ->
    {need_heap_need(I, H, F),0,true};
need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H, F) ->
    {need_heap_need(I, H, F),0,true};
need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H, F) ->
    {[],H,F};
need_heap_1(#l{i=I}, H, F) ->
    %% Others kexprs generate a need if necessary but don't force.
    {need_heap_need(I, H, F),0,false}.

need_heap_need(_I, 0, false) -> [];
need_heap_need(I, H, _F) -> [#l{ke={need_heap,H},i=I}].


%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) ->
%%	{[Ainstr],StackReg,State}.
%%  Generate code for a match.  First save all variables on the stack
%%  that are to survive after the match.  We leave saved variables in
%%  their registers as they might actually be in the right place.
%%  Should test this.

match_cg(M, Rs, Le, Vdb, Bef, St0) ->
    I = Le#l.i,
    {Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb),
    {B,St1} = new_label(St0),
    {Mis,Int1,St2} = match_cg(M, none, Int0, St1#cg{break=B}),
    %% Put return values in registers.
    Reg = load_vars(Rs, Int1#sr.reg),
    {Sis ++ Mis ++ [{label,B}],
     clear_dead(Int1#sr{reg=Reg}, I, Vdb),
     St2#cg{break=St1#cg.break}}.

%% match_cg(Match, Fail, StackReg, State) -> {[Ainstr],StackReg,State}.
%%  Generate code for a match tree.  N.B. there is no need pass Vdb
%%  down as each level which uses this takes its own internal Vdb not
%%  the outer one.

match_cg(Le, Fail, Bef, St) ->
    match_cg(Le#l.ke, Le, Fail, Bef, St).

match_cg({alt,F,S}, _Le, Fail, Bef, St0) ->
    {Tf,St1} = new_label(St0),
    {Fis,Faft,St2} = match_cg(F, Tf, Bef, St1),
    {Sis,Saft,St3} = match_cg(S, Fail, Bef, St2),
    Aft = sr_merge(Faft, Saft),
    {Fis ++ [{label,Tf}] ++ Sis,Aft,St3};
match_cg({select,V,Scs}, _Va, Fail, Bef, St) ->
    match_fmf(fun (S, F, Sta) ->
		      select_cg(S, V, F, Fail, Bef, Sta) end,
	      Fail, St, Scs);
match_cg({guard,Gcs}, _Le, Fail, Bef, St) ->
    match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end,
	      Fail, St, Gcs);
match_cg({block,Es}, Le, _Fail, Bef, St) ->
    %% Must clear registers and stack of dead variables.
    Int = clear_dead(Bef, Le#l.i, Le#l.vdb),
    block_cg(Es, Le, Int, St).

%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) ->
%%	{[Ainstr],StackReg,State}.
%%  Generate code for the match_fail "call".  N.B. there is no generic
%%  case for when the fail value has been created elsewhere.

match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) ->
    %% Must have the args in {x,0}, {x,1},...
    {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
    {Sis ++ [{jump,{f,St#cg.finfo}}],
     Int#sr{reg=clear_regs(Int#sr.reg)},St};
match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) ->
    R = cg_reg_arg(Term, Bef),
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
    {Sis ++ [{badmatch,R}],
     Int#sr{reg=clear_regs(Int0#sr.reg)},St};
match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) ->
    R = cg_reg_arg(Reason, Bef),
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
    {Sis++[{case_end,R}],
     Int#sr{reg=clear_regs(Bef#sr.reg)},St};
match_fail_cg(if_clause, Le, Vdb, Bef, St) ->
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
    {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St};
match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) ->
    R = cg_reg_arg(Reason, Bef),
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
    {Sis ++ [{try_case_end,R}],
     Int#sr{reg=clear_regs(Int0#sr.reg)},St}.


%% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
%% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}.

block_cg(Es, Le, _Vdb, Bef, St) ->
    block_cg(Es, Le, Bef, St).

block_cg(Es, Le, Bef, St0) ->
    case St0#cg.is_top_block of
	false ->
	    cg_block(Es, Le#l.i, Le#l.vdb, Bef, St0);
	true ->
	    {Keis,Aft,St1} = cg_block(Es, Le#l.i, Le#l.vdb, Bef,
				      St0#cg{is_top_block=false,
					     need_frame=false}),
	    top_level_block(Keis, Aft, max_reg(Bef#sr.reg), St1)
    end.

cg_block([], _I, _Vdb, Bef, St0) ->
    {[],Bef,St0};
cg_block(Kes0, I, Vdb, Bef, St0) ->
    {Kes2,Int1,St1} =
	case basic_block(Kes0) of
	    {Kes1,LastI,Args,Rest} ->
		Ke = hd(Kes1),
		Fb = Ke#l.i,
		cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0);
	    {Kes1,Rest} ->
		cg_list(Kes1, I, Vdb, Bef, St0)
	end,
    {Kes3,Int2,St2} = cg_block(Rest, I, Vdb, Int1, St1),
    {Kes2 ++ Kes3,Int2,St2}.

basic_block(Kes) -> basic_block(Kes, []).

basic_block([], Acc) -> {reverse(Acc),[]};
basic_block([Le|Les], Acc) ->
    case collect_block(Le#l.ke) of
	include -> basic_block(Les, [Le|Acc]);
	{block_end,As} -> {reverse(Acc, [Le]),Le#l.i,As,Les};
	no_block -> {reverse(Acc, [Le]),Les}
    end.

collect_block({set,_,{binary,_}})    -> no_block;
collect_block({set,_,_})             -> include;
collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]};
collect_block({call,Func,As,_Rs})   -> {block_end,As++func_vars(Func)};
collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]};
collect_block({enter,Func,As})       -> {block_end,As++func_vars(Func)};
collect_block({return,Rs})           -> {block_end,Rs};
collect_block({break,Bs})            -> {block_end,Bs};
collect_block({bif,_Bif,_As,_Rs})    -> include;
collect_block(_)                     -> no_block.

func_vars({remote,M,F}) when element(1, M) == var;
			     element(1, F) == var ->
    [M,F];
func_vars(_) -> [].

%% cg_basic_block([Kexpr], FirstI, LastI, As, Vdb, StackReg, State) ->
%%      {[Ainstr],StackReg,State}.

cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) ->
    Res = make_reservation(As, 0),
    Regs0 = reserve(Res, Bef#sr.reg, Bef#sr.stk),
    Stk = extend_stack(Bef, Lf, Lf+1, Vdb),
    Int0 = Bef#sr{reg=Regs0,stk=Stk,res=Res},
    X0_v0 = x0_vars(As, Fb, Lf, Vdb),
    {Keis,{Aft,_,St1}} =
	flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end,
		     {Int0,X0_v0,St0}, need_heap(Kes, Fb)),
    {Keis,Aft,St1}.

cg_basic_block(Ke, {Inta,X0v,Sta}, _Lf, Vdb) when element(1, Ke#l.ke) =:= need_heap ->
    {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
    {comment(Inta) ++ Keis, {Intb,X0v,Stb}};
cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) ->
    {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb),
    {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb),
    Intd = reserve(Intc),
    {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta),
    {comment(Inta) ++ Sis ++ Keis, {Inte,X0_v2,Stb}}.

make_reservation([], _) -> [];
make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)];
make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)].

reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}.

reserve([{I,V}|Rs], [free|Regs], Stk) -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
reserve([{I,V}|Rs], [{I,V}|Regs], Stk) -> [{I,V}|reserve(Rs, Regs, Stk)];
reserve([{I,V}|Rs], [{I,Var}|Regs], Stk) ->
    case on_stack(Var, Stk) of
	true -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
	false -> [{I,Var}|reserve(Rs, Regs, Stk)]
    end;
reserve([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) ->
    [{reserved,I,V}|reserve(Rs, Regs, Stk)];
%reserve([{I,V}|Rs], [Other|Regs], Stk) -> [Other|reserve(Rs, Regs, Stk)];
reserve([{I,V}|Rs], [], Stk) -> [{reserved,I,V}|reserve(Rs, [], Stk)];
reserve([], Regs, _) -> Regs.

extend_stack(Bef, Fb, Lf, Vdb) ->
    Stk0 = clear_dead_stk(Bef#sr.stk, Fb, Vdb),
    Saves = [V || {V,F,L} <- Vdb,
		  F < Fb,
		  L >= Lf,
		  not on_stack(V, Stk0)],
    Stk1 = foldl(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
    Bef#sr.stk ++ lists:duplicate(length(Stk1) - length(Bef#sr.stk), free).

save_carefully(Bef, Fb, Lf, Vdb) ->
    Stk = Bef#sr.stk,
    %% New variables that are in use but not on stack.
    New = [ {V,F,L} || {V,F,L} <- Vdb,
		       F < Fb,
		   L >= Lf,
		       not on_stack(V, Stk) ],
    Saves = [ V || {V,_,_} <- keysort(2, New) ],
    save_carefully(Saves, Bef, []).

save_carefully([], Bef, Acc) -> {reverse(Acc),Bef};
save_carefully([V|Vs], Bef, Acc) ->
    case put_stack_carefully(V, Bef#sr.stk) of
	error -> {reverse(Acc),Bef};
	Stk1 ->
	    SrcReg = fetch_reg(V, Bef#sr.reg),
	    Move = {move,SrcReg,fetch_stack(V, Stk1)},
	    {x,_} = SrcReg,			%Assertion - must be X register.
	    save_carefully(Vs, Bef#sr{stk=Stk1}, [Move|Acc])
    end.

x0_vars([], _Fb, _Lf, _Vdb) -> [];
x0_vars([{var,V}|_], Fb, _Lf, Vdb) ->
    {V,F,_L} = VFL = vdb_find(V, Vdb),
    x0_vars1([VFL], Fb, F, Vdb);
x0_vars([X0|_], Fb, Lf, Vdb) ->
    x0_vars1([{X0,Lf,Lf}], Fb, Lf, Vdb).

x0_vars1(X0, Fb, Xf, Vdb) ->
    Vs0 = [VFL || {_V,F,L}=VFL <- Vdb,
		  F >= Fb,
		  L < Xf],
    Vs1 = keysort(3, Vs0),
    keysort(2, X0++Vs1).

allocate_x0([], _, Bef) -> {[],Bef#sr{res=[]}};
allocate_x0([{_,_,L}|Vs], I, Bef) when L =< I ->
    allocate_x0(Vs, I, Bef);
allocate_x0([{V,_F,_L}=VFL|Vs], _, Bef) ->
    {[VFL|Vs],Bef#sr{res=reserve_x0(V, Bef#sr.res)}}.

reserve_x0(V, [_|Res]) -> [{0,V}|Res];
reserve_x0(V, []) -> [{0,V}].

top_level_block(Keis, Bef, _MaxRegs, St0) when St0#cg.need_frame =:= false,
					      length(Bef#sr.stk) =:= 0 ->
    %% This block need no stack frame.  However, we still need to turn the
    %% stack frame upside down.
    MaxY = length(Bef#sr.stk)-1,
    Keis1 = flatmap(fun (Tuple) when tuple(Tuple) ->
			    [turn_yregs(size(Tuple), Tuple, MaxY)];
			(Other) ->
			    [Other]
		    end, Keis),
    {Keis1, Bef, St0#cg{is_top_block=true}};
top_level_block(Keis, Bef, MaxRegs, St0) ->
    %% This top block needs an allocate instruction before it, and a
    %% deallocate instruction before each return.
    FrameSz = length(Bef#sr.stk),
    MaxY = FrameSz-1,
    Keis1 = flatmap(fun ({call_only,Arity,Func}) ->
			    [{call_last,Arity,Func,FrameSz}];
			({call_ext_only,Arity,Func}) ->
			    [{call_ext_last,Arity,Func,FrameSz}];
			({apply_only,Arity}) ->
			    [{apply_last,Arity,FrameSz}];
			(return) ->
			    [{deallocate,FrameSz}, return];
			(Tuple) when tuple(Tuple) ->
			    [turn_yregs(size(Tuple), Tuple, MaxY)];
			(Other) ->
			    [Other]
		    end, Keis),
    {[{allocate_zero,FrameSz,MaxRegs}|Keis1], Bef, St0#cg{is_top_block=true}}.

%% turn_yregs(Size, Tuple, MaxY) -> Tuple'
%%   Renumber y register so that {y, 0} becomes {y, FrameSize-1},
%%   {y, FrameSize-1} becomes {y, 0} and so on.  This is to make nested
%%   catches work.  The code generation algorithm gives a lower register
%%   number to the outer catch, which is wrong.

turn_yregs(0, Tp, _) -> Tp;
turn_yregs(El, Tp, MaxY) when element(1, element(El, Tp)) == yy ->
    turn_yregs(El-1, setelement(El, Tp, {y,MaxY-element(2, element(El, Tp))}), MaxY);
turn_yregs(El, Tp, MaxY) when list(element(El, Tp)) ->
    New = map(fun ({yy,YY}) -> {y,MaxY-YY};
		  (Other) -> Other end, element(El, Tp)),
    turn_yregs(El-1, setelement(El, Tp, New), MaxY);
turn_yregs(El, Tp, MaxY) ->
    turn_yregs(El-1, Tp, MaxY).

%% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) ->
%%      {Is,StackReg,State}.
%%  Selecting type and value needs two failure labels, TypeFail is the
%%  label to jump to of the next type test when this type fails, and
%%  ValueFail is the label when this type is correct but the value is
%%  wrong.  These are different as in the second case there is no need
%%  to try the next type, it will always fail.

select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
    select_cons(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
    select_nil(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
    select_binary(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, Vf, Bef, St) ->
    select_bin_segs(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
    select_bin_end(S, V, Tf, Vf, Bef, St);
select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
    {Vis,{Aft,St1}} =
	mapfoldl(fun (S, {Int,Sta}) ->
			 {Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta),
			 {{Is,[Val]},{sr_merge(Int, Inta),Stb}}
		 end, {void,St0}, Scs),
    OptVls = combine(lists:sort(combine(Vis))),
    {Vls,Sis,St2} = select_labels(OptVls, St1, [], []),
    {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}.

select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
    [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
    [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
    [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
    [{test,select_type_test(Type),{f,Tf},[R]},
     {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis];
select_val_cg(Type, R, Vls0, Tf, Vf, Sis) ->
    Vls1 = map(fun ({f,Lbl}) -> {f,Lbl};
		   (Value) -> {Type,Value}
	       end, Vls0),
    [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis].

select_type_test(tuple) -> is_tuple;
select_type_test(integer) -> is_integer;
select_type_test(atom) -> is_atom;
select_type_test(float) -> is_float.

combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]);
combine([V|Vis]) -> [V|combine(Vis)];
combine([]) -> [].

select_labels([{Is,Vs}|Vis], St0, Vls, Sis) ->
    {Lbl,St1} = new_label(St0),
    select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]);
select_labels([], St, Vls, Sis) ->
    {Vls,append(Sis),St}.

add_vls([V|Vs], Lbl, Acc) ->
    add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]);
add_vls([], _, Acc) -> Acc.

select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) ->
    {Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0),
    {Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
    {[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}.

select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) ->
    {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
    {[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}.

select_binary(#l{ke={val_clause,{old_binary,Var},B}}=L,
	      V, Tf, Vf, Bef, St) ->
    %% Currently handled in the same way as new binaries.
    select_binary(L#l{ke={val_clause,{binary,Var},B}}, V, Tf, Vf, Bef, St);
select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb},
	      V, Tf, Vf, Bef, St0) ->
    Int0 = clear_dead(Bef, I, Vdb),
    {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0),
    {[{test,bs_start_match,{f,Tf},[fetch_var(V, Bef)]},{bs_save,Ivar}|Bis],
     Aft,St1}.

select_bin_segs(Scs, Ivar, Tf, _Vf, Bef, St) ->
    match_fmf(fun(S, Fail, Sta) ->
		      select_bin_seg(S, Ivar, Fail, Bef, Sta) end,
	      Tf, St, Scs).

select_bin_seg(#l{ke={val_clause,{bin_seg,Size,U,T,Fs,Es},B},i=I,vdb=Vdb},
		   Ivar, Fail, Bef, St0) ->
    {Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail,
				       I, Vdb, Bef, St0),
    {Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
    {[{bs_restore,Ivar}|Mis] ++ Bis,Aft,St2}.

select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf,
		   I, Vdb, Bef, St) ->
    SizeReg = get_bin_size_reg(Size0, Bef),
    {Es,Aft} =
	case vdb_find(Hd, Vdb) of
	    {_,_,Lhd} when Lhd =< I ->
		{[{test,bs_skip_bits,{f,Vf},[SizeReg,Unit,{field_flags,Flags}]},
		  {bs_save,Tl}],Bef};
	    {_,_,_} ->
		Reg0 = put_reg(Hd, Bef#sr.reg),
		Int1 = Bef#sr{reg=Reg0},
		Rhd = fetch_reg(Hd, Reg0),
		Name = get_bits_instr(Type),
		{[{test,Name,{f,Vf},[SizeReg,Unit,{field_flags,Flags},Rhd]},
		  {bs_save,Tl}],Int1}
	end,
    {Es,clear_dead(Aft, I, Vdb),St}.

get_bin_size_reg({var,V}, Bef) ->
    fetch_var(V, Bef);
get_bin_size_reg(Literal, _Bef) ->
    Literal.

select_bin_end(#l{ke={val_clause,bin_end,B}},
		   Ivar, Tf, Vf, Bef, St0) ->
    {Bis,Aft,St2} = match_cg(B, Vf, Bef, St0),
    {[{bs_restore,Ivar},{test,bs_test_tail,{f,Tf},[0]}|Bis],Aft,St2}.

get_bits_instr(integer) -> bs_get_integer;
get_bits_instr(float)   -> bs_get_float;
get_bits_instr(binary)  -> bs_get_binary.

select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) ->
    {Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0),
    {Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
    {length(Es),Eis ++ Bis,Aft,St2};
select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) ->
    {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
    {Val,Bis,Aft,St1}.

%% select_extract_tuple(Src, [V], I, Vdb, StackReg, State) ->
%%      {[E],StackReg,State}.
%%  Extract tuple elements, but only if they do not immediately die.

select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
    F = fun ({var,V}, {Int0,Elem}) ->
		case vdb_find(V, Vdb) of
		    {V,_,L} when L =< I -> {[], {Int0,Elem+1}};
		    _Other ->
			Reg1 = put_reg(V, Int0#sr.reg),
			Int1 = Int0#sr{reg=Reg1},
			Rsrc = fetch_var(Src, Int1),
			{[{get_tuple_element,Rsrc,Elem,fetch_reg(V, Reg1)}],
			 {Int1,Elem+1}}
		end
	end,
    {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs),
    {Es,Aft,St}.

select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) ->
    {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of
		   {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I ->
		       %% Both head and tail are dead.  No need to generate
		       %% any instruction.
		       {[], Bef};
		   _ ->
		       %% At least one of head and tail will be used,
		       %% but we must always fetch both.  We will call
		       %% clear_dead/2 to allow reuse of the register
		       %% in case only of them is used.

		       Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)),
		       Int0 = Bef#sr{reg=Reg0},
		       Rsrc = fetch_var(Src, Int0),
		       Rhd = fetch_reg(Hd, Reg0),
		       Rtl = fetch_reg(Tl, Reg0),
		       Int1 = clear_dead(Int0, I, Vdb),
		       {[{get_list,Rsrc,Rhd,Rtl}], Int1}
	       end,
    {Es,Aft,St}.


guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) ->
    {Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0),
    {Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
    {Gis ++ Bis,Aft,St2}.

%% guard_cg(Guard, Fail, Vdb, StackReg, State) ->
%%      {[Ainstr],StackReg,State}.
%%  A guard is a boolean expression of tests.  Tests return true or
%%  false.  A fault in a test causes the test to return false.  Tests
%%  never return the boolean, instead we generate jump code to go to
%%  the correct exit point.  Primops and tests all go to the next
%%  instruction on success or jump to a failure label.

guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) ->
    protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St);
guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) ->
    guard_cg_list(Ts, Fail, I, Bdb, Bef, St);
guard_cg(#l{ke={test,Test,As},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St) ->
    test_cg(Test, As, Fail, I, Vdb, Bef, St);
guard_cg(G, _Fail, Vdb, Bef, St) ->
    %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]),
    {Gis,Aft,St1} = cg(G, Vdb, Bef, St),
    %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]),
    {Gis,Aft,St1}.

%% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%%  Do a protected.  Protecteds without return values are just done
%%  for effect, the return value is not checked, success passes on to
%%  the next instruction and failure jumps to Fail.  If there are
%%  return values then these must be set to 'false' on failure,
%%  control always passes to the next instruction.

protected_cg(Ts, [], Fail, I, Vdb, Bef, St0) ->
    %% Protect these calls, revert when done.
    {Tis,Aft,St1} = guard_cg_list(Ts, Fail, I, Vdb, Bef,
				  St0#cg{btype=fail,bfail=Fail}),
    {Tis,Aft,St1#cg{btype=St0#cg.btype,bfail=St0#cg.bfail}};
protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) ->
    {Pfail,St1} = new_label(St0),
    {Psucc,St2} = new_label(St1),
    {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, I, Vdb, Bef,
				  St2#cg{btype=fail,bfail=Pfail}),
    %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]),
    %% Set return values to false.
    Mis = map(fun ({var,V}) -> {move,{atom,false},fetch_var(V, Aft)} end, Rs),
    Live = {'%live',max_reg(Aft#sr.reg)},
    {Tis ++ [Live,{jump,{f,Psucc}},
	     {label,Pfail}] ++ Mis ++ [Live,{label,Psucc}],
     Aft,St3#cg{btype=St0#cg.btype,bfail=St0#cg.bfail}}.

%% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%%  Generate test instruction.  Use explicit fail label here.

test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
    case test_type(Test, length(As)) of
	{cond_op,Op} ->
	    Ars = cg_reg_args(As, Bef),
	    Int = clear_dead(Bef, I, Vdb),
	    {[{test,Op,{f,Fail},Ars}],
	     clear_dead(Int, I, Vdb),
	     St};
	{rev_cond_op,Op} ->
	    [S1,S2] = cg_reg_args(As, Bef),
	    Int = clear_dead(Bef, I, Vdb),
	    {[{test,Op,{f,Fail},[S2,S1]}],
	     clear_dead(Int, I, Vdb),
	     St}
    end.

test_type(is_atom, 1)      -> {cond_op,is_atom};
test_type(is_boolean, 1)   -> {cond_op,is_boolean};
test_type(is_binary, 1)    -> {cond_op,is_binary};
test_type(is_constant, 1)  -> {cond_op,is_constant};
test_type(is_float, 1)     -> {cond_op,is_float};
test_type(is_function, 1)  -> {cond_op,is_function};
test_type(is_integer, 1)   -> {cond_op,is_integer};
test_type(is_list, 1)      -> {cond_op,is_list};
test_type(is_number, 1)    -> {cond_op,is_number};
test_type(is_pid, 1)       -> {cond_op,is_pid};
test_type(is_port, 1)      -> {cond_op,is_port};
test_type(is_reference, 1) -> {cond_op,is_reference};
test_type(is_tuple, 1)     -> {cond_op,is_tuple};
test_type('=<', 2)  -> {rev_cond_op,is_ge};
test_type('>', 2)   -> {rev_cond_op,is_lt};
test_type('<', 2)   -> {cond_op,is_lt};
test_type('>=', 2)  -> {cond_op,is_ge};
test_type('==', 2)  -> {cond_op,is_eq};
test_type('/=', 2)  -> {cond_op,is_ne};
test_type('=:=', 2) -> {cond_op,is_eq_exact};
test_type('=/=', 2) -> {cond_op,is_ne_exact};
test_type(internal_is_record, 3) -> {cond_op,internal_is_record}.

%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) ->
%%      {[Ainstr],StackReg,St}.

guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) ->
    {Keis,{Aft,St1}} =
	flatmapfoldl(fun (Ke, {Inta,Sta}) ->
			     {Keis,Intb,Stb} =
				 guard_cg(Ke, Fail, Vdb, Inta, Sta),
			     {comment(Inta) ++ Keis,{Intb,Stb}}
		     end, {Bef,St0}, need_heap(Kes, I)),
    {Keis,Aft,St1}.

%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}.
%%  This is a special flatmapfoldl for match code gen where we
%%  generate a "failure" label for each clause. The last clause uses
%%  an externally generated failure label, LastFail.  N.B. We do not
%%  know or care how the failure labels are used.

match_fmf(F, LastFail, St, [H]) ->
    F(H, LastFail, St);
match_fmf(F, LastFail, St0, [H|T]) ->
    {Fail,St1} = new_label(St0),
    {R,Aft1,St2} = F(H, Fail, St1),
    {Rs,Aft2,St3} = match_fmf(F, LastFail, St2, T),
    {R ++ [{label,Fail}] ++ Rs,sr_merge(Aft1, Aft2),St3};
match_fmf(_, _, St, []) -> {[],void,St}.

%% call_cg(Func, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%%      {[Ainstr],StackReg,State}.
%% enter_cg(Func, [Arg], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%%  Call and enter first put the arguments into registers and save any
%%  other registers, then clean up and compress the stack and set the
%%  frame size. Finally the actual call is made.  Call then needs the
%%  return values filled in.

call_cg({var,V}, As, Rs, Le, Vdb, Bef, St0) ->
    {Sis,Int} = cg_setup_call(As++[{var,V}], Bef, Le#l.i, Vdb),
    %% Put return values in registers.
    Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
    {comment({call_fun,{var,V},As}) ++ Sis ++ Frees ++ [{call_fun,Arity}],
     Aft,need_stack_frame(St0)};
call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0)
  when element(1, Mod) == var;
       element(1, Name) == var ->
    {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
    %% Put return values in registers.
    Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    Call = {apply,Arity},
    St = need_stack_frame(St0),
    %%{Call,St1} = build_call(Func, Arity, St0),
    {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
    {Sis ++ Frees ++ [Call],Aft,St};
call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
    {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
    %% Put return values in registers.
    Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    {Call,St1} = build_call(Func, Arity, St0),
    {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
    {comment({call,Func,As}) ++ Sis ++ Frees ++ Call,Aft,St1}.

build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
    {[send],need_stack_frame(St0)};
build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
    {[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)};
build_call(Name, Arity, St0) when atom(Name) ->
    {Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)),
    {[{call,Arity,{f,Lbl}}],St1}.

free_dead(#sr{stk=Stk0}=Aft) ->
    {Instr,Stk} = free_dead(Stk0, 0, [], []),
    {Instr,Aft#sr{stk=Stk}}.

free_dead([dead|Stk], Y, Instr, StkAcc) ->
    %% Note: kill/1 is equivalent to init/1 (translated by beam_asm).
    %% We use kill/1 to help further optimisation passes.
    free_dead(Stk, Y+1, [{kill,{yy,Y}}|Instr], [free|StkAcc]);
free_dead([Any|Stk], Y, Instr, StkAcc) ->
    free_dead(Stk, Y+1, Instr, [Any|StkAcc]);
free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}.

enter_cg({var,V}, As, Le, Vdb, Bef, St0) ->
    {Sis,Int} = cg_setup_call(As++[{var,V}], Bef, Le#l.i, Vdb),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    {comment({call_fun,{var,V},As}) ++ Sis ++ [{call_fun,Arity},return],
     clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
     need_stack_frame(St0)};
enter_cg({remote,Mod,Name}=Func, As, Le, Vdb, Bef, St0)
  when element(1, Mod) == var;
       element(1, Name) == var ->
    {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    Call = {apply_only,Arity},
    St = need_stack_frame(St0),
    {comment({enter,Func,As}) ++ Sis ++ [Call],
     clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
     St};
enter_cg(Func, As, Le, Vdb, Bef, St0) ->
    {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
    %% Build complete code and final stack/register state.
    Arity = length(As),
    {Call,St1} = build_enter(Func, Arity, St0),
    {comment({enter,Func,As}) ++ Sis ++ Call,
     clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
     St1}.

build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
    {[send,return],need_stack_frame(St0)};
build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
    St1 = case trap_bif(Mod, Name, Arity) of
	      true -> need_stack_frame(St0);
	      false -> St0
	  end,
    {[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1};
build_enter(Name, Arity, St0) when is_atom(Name) ->
    {Lbl,St1} = local_func_label(Name, Arity, St0),
    {[{call_only,Arity,{f,Lbl}}],St1}.

%% local_func_label(Name, Arity, State) -> {Label,State'}
%%  Get the function entry label for a local function.

local_func_label(Name, Arity, St0) ->
    Key = {Name,Arity},
    case keysearch(Key, 1, St0#cg.functable) of
	{value,{Key,Label}} ->
	    {Label,St0};
	false ->
	    {Label,St1} = new_label(St0),
	    {Label,St1#cg{functable=[{Key,Label}|St1#cg.functable]}}
    end.

%% need_stack_frame(State) -> State'
%%  Make a note in the state that this function will need a stack frame.

need_stack_frame(#cg{need_frame=true}=St) -> St;
need_stack_frame(St) -> St#cg{need_frame=true}.

%% trap_bif(Mod, Name, Arity) -> true|false
%%   Trap bifs that need a stack frame.

trap_bif(erlang, '!', 2) -> true;
trap_bif(erlang, link, 1) -> true;
trap_bif(erlang, unlink, 1) -> true;
trap_bif(erlang, monitor_node, 2) -> true;
trap_bif(erlang, group_leader, 2) -> true;
trap_bif(erlang, exit, 2) -> true;
trap_bif(_, _, _) -> false.

%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%%      {[Ainstr],StackReg,State}.

bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
    [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef),
    Index = Index1-1,
    {[{set_tuple_element,New,Tuple,Index}],
     clear_dead(Bef, Le#l.i, Vdb), St0};
bif_cg({make_fun,Func,Arity,Index,Uniq}, As, Rs, Le, Vdb, Bef, St0) ->
    %% This behaves more like a function call.
    {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
    Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
    {FuncLbl,St1} = local_func_label(Func, Arity, St0),
    MakeFun = case St0#cg.new_funs of
		  true -> {make_fun2,{f,FuncLbl},Index,Uniq,length(As)};
		  false -> {make_fun,{f,FuncLbl},Uniq,length(As)}
	      end,
    {comment({make_fun,{Func,Arity,Uniq},As}) ++ Sis ++
     [MakeFun],
     clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),
     St1};
bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
    Ars = cg_reg_args(As, Bef),

    %% If we are inside a catch, we must save everything that will
    %% be alive after the catch (because the BIF might fail and there
    %% will be a jump to the code after the catch).
    %%   Currently, we are somewhat pessimistic in
    %% that we save any variable that will be live after this BIF call.

    {Sis,Int0} =
	case St0#cg.in_catch of
	    true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);
	    false -> {[],Bef}
	end,

    Int1 = clear_dead(Int0, Le#l.i, Vdb),
    Reg = put_reg(V, Int1#sr.reg),
    Int = Int1#sr{reg=Reg},
    Dst = fetch_reg(V, Reg),
    {Sis ++ [{bif,Bif,bif_fail(St0#cg.btype, St0#cg.bfail, length(Ars)),Ars,Dst}],
     clear_dead(Int, Le#l.i, Vdb), St0}.

bif_fail(_, _, 0) -> nofail;
bif_fail(exit, _, _) -> {f,0};
bif_fail(fail, Fail, _) -> {f,Fail}.

%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs,
%%              [Ret], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.

recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) ->
    {Sis,Int0} = adjust_stack(Bef, Le#l.i, Le#l.i, Vdb),
    Int1 = Int0#sr{reg=clear_regs(Int0#sr.reg)},
    %% Get labels.
    {Rl,St1} = new_label(St0),
    {Tl,St2} = new_label(St1),
    {Bl,St3} = new_label(St2),
    St4 = St3#cg{break=Bl,recv=Rl},		%Set correct receive labels
    {Ris,Raft,St5} = cg_recv_mesg(Rvar, Rm, Tl, Int1, St4),
    {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5),
    Int2 = sr_merge(Raft, Taft),		%Merge stack/registers
    Reg = load_vars(Rs, Int2#sr.reg),
    {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}],
     clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb),
     St6#cg{break=St0#cg.break,recv=St0#cg.recv}}.

%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}.

cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) ->
    Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
    Ret = fetch_reg(R, Int0#sr.reg),
    %% Int1 = clear_dead(Int0, I, Rm#l.vdb),
    Int1 = Int0,
    {Mis,Int2,St1} = match_cg(Rm, none, Int1, St0),
    {[{'%live',0},{label,St1#cg.recv},{loop_rec,{f,Tl},Ret}|Mis],Int2,St1}.

%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}.

cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) ->
    %% We know that the 'after' body will never be executed.
    %% But to keep the stack and register information up to date,
    %% we will generate the code for the 'after' body, and then discard it.
    Int1 = clear_dead(Bef, I, Tes#l.vdb),
    {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
			      Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0),
    {[{wait,{f,St1#cg.recv}}],Int2,St1};
cg_recv_wait({integer,0}, Tes, _I, Bef, St0) ->
    {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0),
    {[timeout|Tis],Int,St1};
cg_recv_wait(Te, Tes, I, Bef, St0) ->
    Reg = cg_reg_arg(Te, Bef),
    %% Must have empty registers here!  Bug if anything in registers.
    Int0 = clear_dead(Bef, I, Tes#l.vdb),
    {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
			     Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0),
    {[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}.

%% recv_next_cg(Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
%%  Use adjust stack to clear stack, but only need it for Aft.

recv_next_cg(Le, Vdb, Bef, St) ->
    {Sis,Aft} = adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb),
    {[{loop_rec_end,{f,St#cg.recv}}] ++ Sis,Aft,St}.	%Joke

%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret],
%%        Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.

try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) ->
    {B,St1} = new_label(St0),			%Body label
    {H,St2} = new_label(St1),			%Handler label
    {E,St3} = new_label(St2),			%End label
    TryTag = Ta#l.i,
    Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)},
    TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk),
    {Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}),
    Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)},
    St5 = St4#cg{break=E,in_catch=St3#cg.in_catch},
    {Bis,Baft,St6} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St5),
    {His,Haft,St7} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St6),
    Int4 = sr_merge(Baft, Haft),		%Merge stack/registers
    Aft = Int4#sr{reg=load_vars(Rs, Int4#sr.reg)},
    {[{'try',TryReg,{f,H}}] ++ Ais ++
     [{label,B},{try_end,TryReg}] ++ Bis ++
     [{label,H},{try_case,TryReg}] ++ His ++
     [{label,E}],
     clear_dead(Aft, Le#l.i, Vdb),
     St7#cg{break=St0#cg.break}}.

%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.

catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
    {B,St1} = new_label(St0),
    CatchTag = Le#l.i,
    Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)},
    CatchReg = fetch_stack({catch_tag,CatchTag}, Int1#sr.stk),
    {Cis,Int2,St2} = cg_block(C, Le#l.i, Le#l.vdb, Int1,
			      St1#cg{break=B,in_catch=true}),
    Aft = Int2#sr{reg=load_reg(R, 0, Int2#sr.reg),
		  stk=drop_catch(CatchTag, Int2#sr.stk)},
    {[{'catch',CatchReg,{f,B}}] ++ Cis ++
     [{label,B},{catch_end,CatchReg}],
     clear_dead(Aft, Le#l.i, Vdb),
     St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}.

%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%%  We have to be careful how a 'set' works. First the structure is
%%  built, then it is filled and finally things can be cleared. The
%%  annotation must reflect this and make sure that the return
%%  variable is allocated first.
%%
%%  put_list for constructing a cons is an atomic instruction
%%  which can safely resuse one of the source registers as target.
%%  Also binaries can reuse a source register as target.

set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) ->
    [S1,S2] = map(fun ({var,V}) -> fetch_var(V, Bef);
		      (Other) -> Other
		  end, Es),
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
    Ret = fetch_reg(R, Int1#sr.reg),
    {[{put_list,S1,S2,Ret}], Int1, St};
set_cg([{var,R}], {old_binary,Segs}, Le, Vdb, Bef, St) ->
    Fail = bif_fail(St#cg.btype, St#cg.bfail, 42),
    PutCode = cg_bin_put(Segs, Fail, Bef),
    Code = cg_binary_old(PutCode),
    Int0 = clear_dead(Bef, Le#l.i, Vdb),
    Aft = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
    Ret = fetch_reg(R, Aft#sr.reg),
    {Code ++ [{bs_final,Fail,Ret}],Aft,St};
set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{in_catch=InCatch}=St) ->
    Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
    Target = fetch_reg(R, Int0#sr.reg),
    Fail = bif_fail(St#cg.btype, St#cg.bfail, 42),
    Temp = find_scratch_reg(Int0#sr.reg),
    PutCode = cg_bin_put(Segs, Fail, Bef),
    {Sis,Int1} =
	case InCatch of
	    true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb);
	    false -> {[],Int0}
	end,
    Aft = clear_dead(Int1, Le#l.i, Vdb),
    Code = cg_binary(PutCode, Target, Temp, Fail, Aft),
    {Sis++Code,Aft,St};
set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
    %% Find a place for the return register first.
    Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
    Ret = fetch_reg(R, Int#sr.reg),
    Ais = case Con of
	      {tuple,Es} ->
		  [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef);
	      {var,V} ->			% Normally removed by kernel optimizer.
		  [{move,fetch_var(V, Int),Ret}];
	      {string,Str} ->
		  [{put_string,length(Str),{string,Str},Ret}];
	      Other ->
		  [{move,Other,Ret}]
	  end,
    {Ais,clear_dead(Int, Le#l.i, Vdb),St};
set_cg([], {binary,Segs}, Le, Vdb, Bef, St) ->
    Fail = bif_fail(St#cg.btype, St#cg.bfail, 42),
    Target = find_scratch_reg(Bef#sr.reg),
    Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)),
    PutCode = cg_bin_put(Segs, Fail, Bef),
    Code = cg_binary(PutCode, Target, Temp, Fail, Bef),
    Aft = clear_dead(Bef, Le#l.i, Vdb),
    {Code,Aft,St};
set_cg([], {old_binary,Segs}, Le, Vdb, Bef, St) ->
    Fail = bif_fail(St#cg.btype, St#cg.bfail, 42),
    PutCode = cg_bin_put(Segs, Fail, Bef),
    Ais0 = cg_binary_old(PutCode),
    Ret = find_scratch_reg(Bef#sr.reg),
    Ais = Ais0 ++ [{bs_final,Fail,Ret}],
    {Ais,clear_dead(Bef, Le#l.i, Vdb),St};
set_cg([], _, Le, Vdb, Bef, St) ->
    %% This should have been stripped by compiler, just cleanup.
    {[],clear_dead(Bef, Le#l.i, Vdb), St}.


%%%
%%% Code generation for constructing binaries.
%%%

cg_binary(PutCode, Target, Temp, Fail, Bef) ->
    SzCode = cg_binary_size(PutCode, Target, Temp, Fail),
    MaxRegs = max_reg(Bef#sr.reg),
    Code = SzCode ++ [{bs_init2,Fail,Target,MaxRegs,{field_flags,[]},Target}|PutCode],
    cg_bin_opt(Code).

cg_binary_size(PutCode, Target, Temp, Fail) ->
    Szs = cg_binary_size_1(PutCode, 0, []),
    cg_binary_size_expr(Szs, Target, Temp, Fail).

cg_binary_size_1([{_Put,_Fail,S,U,_Flags,Src}|T], Bits, Acc) ->
    cg_binary_size_2(S, U, Src, T, Bits, Acc);
cg_binary_size_1([], Bits, Acc) ->
    Bytes = Bits div 8,
    RemBits = Bits rem 8,
    Res = sort([{1,{integer,RemBits}},{8,{integer,Bytes}}|Acc]),
    cg_binary_size_3(Res).

cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) ->
    cg_binary_size_1(Next, Bits+N*U, Acc);
cg_binary_size_2({atom,all}, 8, E, Next, Bits, Acc) ->
    cg_binary_size_1(Next, Bits, [{8,{size,E}}|Acc]);
cg_binary_size_2(Reg, 1, _, Next, Bits, Acc) ->
    cg_binary_size_1(Next, Bits, [{1,Reg}|Acc]);
cg_binary_size_2(Reg, 8, _, Next, Bits, Acc) ->
    cg_binary_size_1(Next, Bits, [{8,Reg}|Acc]);
cg_binary_size_2(Reg, U, _, Next, Bits, Acc) ->
    cg_binary_size_1(Next, Bits, [{1,{'*',Reg,U}}|Acc]).

cg_binary_size_3([{_,{integer,0}}|T]) ->
    cg_binary_size_3(T);
cg_binary_size_3([{U,S1},{U,S2}|T]) ->
    {L0,Rest} = cg_binary_size_4(T, U, []),
    L = [S1,S2|L0],
    [{U,L}|cg_binary_size_3(Rest)];
cg_binary_size_3([{U,S}|T]) ->
    [{U,[S]}|cg_binary_size_3(T)];
cg_binary_size_3([]) -> [].

cg_binary_size_4([{U,S}|T], U, Acc) ->
    cg_binary_size_4(T, U, [S|Acc]);
cg_binary_size_4(T, _, Acc) ->
    {Acc,T}.

%% cg_binary_size_expr/4
%%  Generate code for calculating the resulting size of a binary.
cg_binary_size_expr(Sizes, Target, Temp, Fail) ->
    cg_binary_size_expr_1(Sizes, Target, Temp, Fail,
			  [{move,{integer,0},Target}]).

cg_binary_size_expr_1([{1,E0}|T], Target, Temp, Fail, Acc) ->
    E1 = cg_gen_binsize(E0, Target, Temp, Fail, Acc),
    E = [{bs_bits_to_bytes,Fail,Target,Target}|E1],
    cg_binary_size_expr_1(T, Target, Temp, Fail, E);
cg_binary_size_expr_1([{8,E0}], Target, Temp, Fail, Acc) ->
    E = cg_gen_binsize(E0, Target, Temp, Fail, Acc),
    reverse(E);
cg_binary_size_expr_1([], _, _, _, Acc) -> reverse(Acc).

cg_gen_binsize([{'*',A,B}|T], Target, Temp, Fail, Acc) ->
    cg_gen_binsize(T, Target, Temp, Fail,
		   [{bs_add,Fail,[Target,A,B],Target}|Acc]);
cg_gen_binsize([{size,B}|T], Target, Temp, Fail, Acc) ->
    cg_gen_binsize([Temp|T], Target, Temp, Fail,
		   [{bif,size,Fail,[B],Temp}|Acc]);
cg_gen_binsize([E0|T], Target, Temp, Fail, Acc) ->
    cg_gen_binsize(T, Target, Temp, Fail,
		   [{bs_add,Fail,[Target,E0,1],Target}|Acc]);
cg_gen_binsize([], _, _, _, Acc) -> Acc.

%% cg_bin_opt(Code0) -> Code
%%  Optimize the size calculations for binary construction.

cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) ->
    cg_bin_opt([{move,S,Dst}|Is]);
cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) ->
    cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]);
cg_bin_opt([{move,{integer,Bytes},D},{bs_init2,Fail,D,Regs0,Flags,D}|Is]) ->
    Regs = cg_bo_newregs(Regs0, D),
    cg_bin_opt([{bs_init2,Fail,Bytes,Regs,Flags,D}|Is]);
cg_bin_opt([{move,Src,D},{bs_init2,Fail,D,Regs0,Flags,D}|Is]) ->
    Regs = cg_bo_newregs(Regs0, D),
    cg_bin_opt([{bs_init2,Fail,Src,Regs,Flags,D}|Is]);
cg_bin_opt([{move,Src,Dst},{bs_bits_to_bytes,Fail,Dst,Dst}|Is]) ->
    cg_bin_opt([{bs_bits_to_bytes,Fail,Src,Dst}|Is]);
cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) ->
    cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]);
cg_bin_opt([{bs_bits_to_bytes,Fail,{integer,N},_}|Is0]) when N rem 8 =/= 0 ->
    case Fail of
	{f,0} ->
	    Is = [{move,{atom,badarg},{x,0}},
		  {call_ext_only,1,{extfunc,erlang,error,1}}|Is0],
	    cg_bin_opt(Is);
	_ ->
	    cg_bin_opt([{jump,Fail}|Is0])
    end;
cg_bin_opt([I|Is]) ->
    [I|cg_bin_opt(Is)];
cg_bin_opt([]) -> [].

cg_bo_newregs(R, {x,X}) when R-1 =:= X -> R-1;
cg_bo_newregs(R, _) -> R.

%% Common for new and old binary code generation.

cg_bin_put({bin_seg,S0,U,T,Fs,[E0,Next]}, Fail, Bef) ->
    S1 = case S0 of
	     {var,Sv} -> fetch_var(Sv, Bef);
	     _ -> S0
	 end,
    E1 = case E0 of
	     {var,V} -> fetch_var(V, Bef);
	     Other ->   Other
	 end,
    Op = case T of
	     integer -> bs_put_integer;
	     binary  -> bs_put_binary;
	     float   -> bs_put_float
	 end,
    [{Op,Fail,S1,U,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)];
cg_bin_put(bin_end, _, _) -> [].

%% Old style.

cg_binary_old(PutCode) ->
    [cg_bs_init(PutCode)] ++ need_bin_buf(PutCode).

cg_bs_init(Code) ->
    {Size,Fs} = foldl(fun ({_,_,{integer,N},U,_,_}, {S,Fs}) ->
			      {S + N*U,Fs};
			  (_, {S,_}) ->
			      {S,[]}
		      end, {0,[exact]}, Code),
    {bs_init,(Size+7) div 8,{field_flags,Fs}}.

need_bin_buf(Code0) ->
    {Code1,F,H} = foldr(fun ({_,_,{integer,N},U,_,_}=Bs, {Code,F,H}) ->
				{[Bs|Code],F,H + N*U};
			    ({_,_,_,_,_,_}=Bs, {Code,F,H}) ->
				{[Bs|need_bin_buf_need(H, F, Code)],true,0}
			end, {[],false,0}, Code0),
    need_bin_buf_need(H, F, Code1).

need_bin_buf_need(0, false, Rest) -> Rest;
need_bin_buf_need(H, _, Rest) -> [{bs_need_buf,H}|Rest].

cg_build_args(As, Bef) ->
    map(fun ({var,V}) -> {put,fetch_var(V, Bef)};
	    (Other) -> {put,Other}
	end, As).

%% return_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%% break_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%%  These are very simple, just put return/break values in registers
%%  from 0, then return/break.  Use the call setup to clean up stack,
%%  but must clear registers to ensure sr_merge works correctly.

return_cg(Rs, Le, Vdb, Bef, St) ->
    {Ms,Int} = cg_setup_call(Rs, Bef, Le#l.i, Vdb),
    {comment({return,Rs}) ++ Ms ++ [return],
     Int#sr{reg=clear_regs(Int#sr.reg)},St}.

break_cg(Bs, Le, Vdb, Bef, St) ->
    {Ms,Int} = cg_setup_call(Bs, Bef, Le#l.i, Vdb),
    {comment({break,Bs}) ++ Ms ++ [{jump,{f,St#cg.break}}],
     Int#sr{reg=clear_regs(Int#sr.reg)},St}.

%% cg_reg_arg(Arg0, Info) -> Arg
%% cg_reg_args([Arg0], Info) -> [Arg]
%%  Convert argument[s] into registers. Literal values are returned unchanged.

cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As].

cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef);
cg_reg_arg(Literal, _) -> Literal.

%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}.
%%  Do the complete setup for a call/enter.

cg_setup_call(As, Bef, I, Vdb) ->
    {Ms,Int0} = cg_call_args(As, Bef, I, Vdb),
    %% Have set up arguments, can now clean up, compress and save to stack.
    Int1 = Int0#sr{stk=clear_dead_stk(Int0#sr.stk, I, Vdb),res=[]},
    {Sis,Int2} = adjust_stack(Int1, I, I+1, Vdb),
    {Ms ++ Sis ++ [{'%live',length(As)}],Int2}.

%% cg_call_args([Arg], SrState) -> {[Instr],SrState}.
%%  Setup the arguments to a call/enter/bif. Put the arguments into
%%  consecutive registers starting at {x,0} moving any data which
%%  needs to be saved. Return a modified SrState structure with the
%%  new register contents.  N.B. the resultant register info will
%%  contain non-variable values when there are non-variable values.
%%
%%  This routine is complicated by unsaved values in x registers.
%%  We'll move away any unsaved values that are in the registers
%%  to be overwritten by the arguments.

cg_call_args(As, Bef, I, Vdb) ->
    Regs0 = load_arg_regs(Bef#sr.reg, As),
    Unsaved = unsaved_registers(Regs0, Bef#sr.stk, I, I+1, Vdb),
    {UnsavedMoves,Regs} = move_unsaved(Unsaved, Bef#sr.reg, Regs0),
    Moves0 = gen_moves(As, Bef),
    Moves = order_moves(Moves0, find_scratch_reg(Regs)),
    {UnsavedMoves ++ Moves,Bef#sr{reg=Regs}}.

%% load_arg_regs([Reg], Arguments) -> [Reg]
%%  Update the register descriptor to include the arguments (from {x,0}
%%  and upwards). Values in argument register are overwritten.
%%  Values in x registers above the arguments are preserved.

load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0).

load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)];
load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)];
load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)];
load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)];
load_arg_regs(Rs, [], _) -> Rs.

%% Returns the variables must be saved and are currently in the
%% x registers that are about to be overwritten by the arguments.

unsaved_registers(Regs, Stk, Fb, Lf, Vdb) ->
    [V || {V,F,L} <- Vdb,
	  F < Fb,
	  L >= Lf,
	  not on_stack(V, Stk),
	  not in_reg(V, Regs)].

in_reg(V, Regs) -> keymember(V, 2, Regs).

%% Move away unsaved variables from the registers that are to be
%% overwritten by the arguments.
move_unsaved(Vs, OrigRegs, NewRegs) ->
    move_unsaved(Vs, OrigRegs, NewRegs, []).

move_unsaved([V|Vs], OrigRegs, NewRegs0, Acc) ->
    NewRegs = put_reg(V, NewRegs0),
    Src = fetch_reg(V, OrigRegs),
    Dst = fetch_reg(V, NewRegs),
    move_unsaved(Vs, OrigRegs, NewRegs, [{move,Src,Dst}|Acc]);
move_unsaved([], _, Regs, Acc) -> {Acc,Regs}.

%% gen_moves(As, Sr)
%%  Generate the basic move instruction to move the arguments
%%  to their proper registers. The list will be sorted on
%%  destinations. (I.e. the move to {x,0} will be first --
%%  see the comment to order_moves/2.)

gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []).

gen_moves([{var,V}|As], Sr, I, Acc) ->
    case fetch_var(V, Sr) of
	{x,I} -> gen_moves(As, Sr, I+1, Acc);
	Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc])
    end;
gen_moves([A|As], Sr, I, Acc) ->
    gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]);
gen_moves([], _, _, Acc) -> lists:keysort(3, Acc).

%% order_moves([Move], ScratchReg) -> [Move]
%%  Orders move instruction so that source registers are not
%%  destroyed before they are used. If there are cycles
%%  (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}),
%%  the scratch register is used to break up the cycle.
%%    If possible, the first move of the input list is placed
%%  last in the result list (to make the move to {x,0} occur
%%  just before the call to allow the Beam loader to coalesce
%%  the instructions).

order_moves(Ms, Scr) -> order_moves(Ms, Scr, []).

order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) ->
    {Chain,Ms} = collect_chain(Ms0, [M], ScrReg),
    Acc = reverse(Chain, Acc0),
    order_moves(Ms, ScrReg, Acc);
order_moves([], _, Acc) -> Acc.

collect_chain(Ms, Path, ScrReg) ->
    collect_chain(Ms, Path, [], ScrReg).

collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) ->
    case keysearch(Src, 3, Path) of
	{value,_} ->				%We have a cycle.
	    {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)};
	false ->
	    collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg)
    end;
collect_chain([M|Ms], Path, Others, ScrReg) ->
    collect_chain(Ms, Path, [M|Others], ScrReg);
collect_chain([], Path, Others, _) ->
    {Path,Others}.

break_up_cycle({move,Src,_}=M, Path, ScrReg) ->
    [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)].

break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) ->
    [{move,Src,ScrReg}|Path];
break_up_cycle1(Dst, [M|Path], LastMove) ->
    [M|break_up_cycle1(Dst, Path, LastMove)].

%% clear_dead(Sr, Until, Vdb) -> Aft.
%%  Remove all variables in Sr which have died AT ALL so far.

clear_dead(Sr, Until, Vdb) ->
    Sr#sr{reg=clear_dead_reg(Sr, Until, Vdb),
	  stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}.

clear_dead_reg(Sr, Until, Vdb) ->
    Reg = map(fun ({I,V}) ->
		      case vdb_find(V, Vdb) of
			  {V,_,L} when L > Until -> {I,V};
			  _ -> free		%Remove anything else
		      end;
		  ({reserved,I,V}) -> {reserved,I,V};
		  (free) -> free
	      end, Sr#sr.reg),
    reserve(Sr#sr.res, Reg, Sr#sr.stk).

clear_dead_stk(Stk, Until, Vdb) ->
    map(fun ({V}) ->
		case vdb_find(V, Vdb) of
		    {V,_,L} when L > Until -> {V};
		    _ -> dead			%Remove anything else
		end;
	    (free) -> free;
	    (dead) -> dead
	end, Stk).

%% sr_merge(Sr1, Sr2) -> Sr.
%%  Merge two stack/register states keeping the longest of both stack
%%  and register. Perform consistency check on both, elements must be
%%  the same.  Allow frame size 'void' to make easy creation of
%%  "empty" frame.

sr_merge(#sr{reg=R1,stk=S1,res=[]}, #sr{reg=R2,stk=S2,res=[]}) ->
    #sr{reg=longest(R1, R2),stk=longest(S1, S2),res=[]};
sr_merge(void, S2) -> S2#sr{res=[]};
sr_merge(S1, void) -> S1#sr{res=[]}.

longest([H|T1], [H|T2]) -> [H|longest(T1, T2)];
longest([dead|T1], [free|T2]) -> [dead|longest(T1, T2)];
longest([free|T1], [dead|T2]) -> [dead|longest(T1, T2)];
longest([dead|T1], []) -> [dead|T1];
longest([], [dead|T2]) -> [dead|T2];
longest([free|T1], []) -> [free|T1];
longest([], [free|T2]) -> [free|T2];
longest([], []) -> [].

%% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}.
%%  Do complete stack adjustment by compressing stack and adding
%%  variables to be saved.  Try to optimise ordering on stack by
%%  having reverse order to their lifetimes.
%%
%%  In Beam, there is a fixed stack frame and no need to do stack compression.

adjust_stack(Bef, Fb, Lf, Vdb) ->
    Stk0 = Bef#sr.stk,
    {Stk1,Saves} = save_stack(Stk0, Fb, Lf, Vdb),
    {saves(Saves, Bef#sr.reg, Stk1),
     Bef#sr{stk=Stk1}}.

%% save_stack(Stack, FirstBefore, LastFrom, Vdb) -> {[SaveVar],NewStack}.
%%  Save variables which are used past current point and which are not
%%  already on the stack.

save_stack(Stk0, Fb, Lf, Vdb) ->
    %% New variables that are in use but not on stack.
    New = [ {V,F,L} || {V,F,L} <- Vdb,
		   F < Fb,
		   L >= Lf,
		   not on_stack(V, Stk0) ],
    %% Add new variables that are not just dropped immediately.
    %% N.B. foldr works backwards from the end!!
    Saves = [ V || {V,_,_} <- keysort(3, New) ],
    Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
    {Stk1,Saves}.

%% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}].
%%  Generate move instructions to save variables onto stack.  The
%%  stack/reg info used is that after the new stack has been made.

saves(Ss, Reg, Stk) ->
    Res = map(fun (V) ->
		      {move,fetch_reg(V, Reg),fetch_stack(V, Stk)}
	      end, Ss),
    Res.

%% comment(C) -> ['%'{C}].

%comment(C) -> [{'%',C}].
comment(_) -> [].

%% fetch_var(VarName, StkReg) -> r{R} | sp{Sp}.
%% find_var(VarName, StkReg) -> ok{r{R} | sp{Sp}} | error.
%%  Fetch/find a variable in either the registers or on the
%%  stack. Fetch KNOWS it's there.

fetch_var(V, Sr) ->
    case find_reg(V, Sr#sr.reg) of
	{ok,R} -> R;
	error -> fetch_stack(V, Sr#sr.stk)
    end.

% find_var(V, Sr) ->
%     case find_reg(V, Sr#sr.reg) of
% 	{ok,R} -> {ok,R};
% 	error ->
% 	    case find_stack(V, Sr#sr.stk) of
% 		{ok,S} -> {ok,S};
% 		error -> error
% 	    end
%     end.

load_vars(Vs, Regs) ->
    foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).

%% put_reg(Val, Regs) -> Regs.
%% load_reg(Val, Reg, Regs) -> Regs.
%% free_reg(Val, Regs) -> Regs.
%% find_reg(Val, Regs) -> ok{r{R}} | error.
%% fetch_reg(Val, Regs) -> r{R}.
%%  Functions to interface the registers.
%%  put_reg puts a value into a free register,
%%  load_reg loads a value into a fixed register
%%  free_reg frees a register containing a specific value.

% put_regs(Vs, Rs) -> foldl(fun put_reg/2, Rs, Vs).

put_reg(V, Rs) -> put_reg_1(V, Rs, 0).

put_reg_1(V, [free|Rs], I) -> [{I,V}|Rs];
put_reg_1(V, [{reserved,I,V}|Rs], I) -> [{I,V}|Rs];
put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)];
put_reg_1(V, [], I) -> [{I,V}].

load_reg(V, R, Rs) -> load_reg_1(V, R, Rs, 0).

load_reg_1(V, I, [_|Rs], I) -> [{I,V}|Rs];
load_reg_1(V, I, [R|Rs], C) -> [R|load_reg_1(V, I, Rs, C+1)];
load_reg_1(V, I, [], I) -> [{I,V}];
load_reg_1(V, I, [], C) -> [free|load_reg_1(V, I, [], C+1)].

% free_reg(V, [{I,V}|Rs]) -> [free|Rs];
% free_reg(V, [R|Rs]) -> [R|free_reg(V, Rs)];
% free_reg(V, []) -> [].

fetch_reg(V, [{I,V}|_]) -> {x,I};
fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).

find_reg(V, [{I,V}|_]) -> {ok,{x,I}};
find_reg(V, [_|SRs]) -> find_reg(V, SRs);
find_reg(_, []) -> error.

%% For the bit syntax, we need a scratch register if we are constructing
%% a binary that will not be used.

find_scratch_reg(Rs) -> find_scratch_reg(Rs, 0).

find_scratch_reg([free|_], I) -> {x,I};
find_scratch_reg([_|Rs], I) -> find_scratch_reg(Rs, I+1);
find_scratch_reg([], I) -> {x,I}.

%%copy_reg(Val, R, Regs) -> load_reg(Val, R, Regs).
%%move_reg(Val, R, Regs) -> load_reg(Val, R, free_reg(Val, Regs)).

%%clear_regs(Regs) -> map(fun (R) -> free end, Regs).
clear_regs(_) -> [].

max_reg(Regs) ->
    foldl(fun ({I,_}, _) -> I;
	      (_, Max) -> Max end,
	  -1, Regs) + 1.

%% put_stack(Val, [{Val}]) -> [{Val}].
%% fetch_stack(Var, Stk) -> sp{S}.
%% find_stack(Var, Stk) -> ok{sp{S}} | error.
%%  Functions to interface the stack.

put_stack(Val, []) -> [{Val}];
put_stack(Val, [dead|Stk]) -> [{Val}|Stk];
put_stack(Val, [free|Stk]) -> [{Val}|Stk];
put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)].

put_stack_carefully(Val, Stk0) ->
    case catch put_stack_carefully1(Val, Stk0) of
	error -> error;
	Stk1 when list(Stk1) -> Stk1
    end.

put_stack_carefully1(_, []) -> throw(error);
put_stack_carefully1(Val, [dead|Stk]) -> [{Val}|Stk];
put_stack_carefully1(Val, [free|Stk]) -> [{Val}|Stk];
put_stack_carefully1(Val, [NotFree|Stk]) ->
    [NotFree|put_stack_carefully1(Val, Stk)].

fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0).

fetch_stack(V, [{V}|_], I) -> {yy,I};
fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1).

% find_stack(Var, Stk) -> find_stack(Var, Stk, 0).

% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}};
% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1);
% find_stack(V, [], I) -> error.

on_stack(V, Stk) -> keymember(V, 1, Stk).

%% put_catch(CatchTag, Stack) -> Stack'
%% drop_catch(CatchTag, Stack) -> Stack'
%%  Special interface for putting and removing catch tags, to ensure that
%%  catches nest properly. Also used for try tags.

put_catch(Tag, Stk0) -> put_catch(Tag, reverse(Stk0), []).

put_catch(Tag, [], Stk) ->
    put_stack({catch_tag,Tag}, Stk);
put_catch(Tag, [{{catch_tag,_}}|_]=RevStk, Stk) ->
    reverse(RevStk, put_stack({catch_tag,Tag}, Stk));
put_catch(Tag, [Other|Stk], Acc) ->
    put_catch(Tag, Stk, [Other|Acc]).

drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk];
drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)].

%%%
%%% Finish the code generation for the bit syntax matching.
%%%

bs_function({function,Name,Arity,CLabel,Asm0}=Func) ->
    case bs_needed(Asm0, 0, false, []) of
	{false,[]} -> Func;
	{true,Dict} ->
	    Asm = bs_replace(Asm0, Dict, []),
	    {function,Name,Arity,CLabel,Asm}
    end.

%%%
%%% Pass 1: Found out which bs_restore's that are needed. For now we assume
%%% that a bs_restore is needed unless it is directly preceeded by a bs_save.
%%%

bs_needed([{bs_save,Name},{bs_restore,Name}|T], N, _BsUsed, Dict) ->
    bs_needed(T, N, true, Dict);
bs_needed([{bs_save,_Name}|T], N, _BsUsed, Dict) ->
    bs_needed(T, N, true, Dict);
bs_needed([{bs_restore,Name}|T], N, _BsUsed, Dict) ->
    case keysearch(Name, 1, Dict) of
	{value,{Name,_}} -> bs_needed(T, N, true, Dict);
	false -> bs_needed(T, N+1, true, [{Name,N}|Dict])
    end;
bs_needed([{bs_init,_,_}|T], N, _, Dict) ->
    bs_needed(T, N, true, Dict);
bs_needed([{bs_init2,_,_,_,_,_}|T], N, _, Dict) ->
    bs_needed(T, N, true, Dict);
bs_needed([{bs_start_match,_,_}|T], N, _, Dict) ->
    bs_needed(T, N, true, Dict);
bs_needed([_|T], N, BsUsed, Dict) ->
    bs_needed(T, N, BsUsed, Dict);
bs_needed([], _, BsUsed, Dict) -> {BsUsed,Dict}.

%%%
%%% Pass 2: Only needed if there were some bs_* instructions found.
%%%
%%% Remove any bs_save with a name that never were found to be restored
%%% in the first pass.
%%%

bs_replace([{bs_save,Name}=Save,{bs_restore,Name}|T], Dict, Acc) ->
    bs_replace([Save|T], Dict, Acc);
bs_replace([{bs_save,Name}|T], Dict, Acc) ->
    case keysearch(Name, 1, Dict) of
	{value,{Name,N}} ->
	    bs_replace(T, Dict, [{bs_save,N}|Acc]);
	false ->
	    bs_replace(T, Dict, Acc)
    end;
bs_replace([{bs_restore,Name}|T], Dict, Acc) ->
    case keysearch(Name, 1, Dict) of
	{value,{Name,N}} ->
	    bs_replace(T, Dict, [{bs_restore,N}|Acc]);
	false ->
	    bs_replace(T, Dict, Acc)
    end;
bs_replace([{bs_init2,Fail,Bytes,Regs,Flags,Dst}|T0], Dict, Acc) ->
    case bs_find_test_heap(T0) of
	none ->
	    bs_replace(T0, Dict, [{bs_init2,Fail,Bytes,0,Regs,Flags,Dst}|Acc]);
	{T,Words} ->
	    bs_replace(T, Dict, [{bs_init2,Fail,Bytes,Words,Regs,Flags,Dst}|Acc])
    end;
bs_replace([H|T], Dict, Acc) ->
    bs_replace(T, Dict, [H|Acc]);
bs_replace([], _, Acc) -> reverse(Acc).

bs_find_test_heap(Is) ->
    bs_find_test_heap_1(Is, []).

bs_find_test_heap_1([{bs_put_integer,_,_,_,_,_}=I|Is], Acc) ->
    bs_find_test_heap_1(Is, [I|Acc]);
bs_find_test_heap_1([{bs_put_float,_,_,_,_,_}=I|Is], Acc) ->
    bs_find_test_heap_1(Is, [I|Acc]);
bs_find_test_heap_1([{bs_put_binary,_,_,_,_,_}=I|Is], Acc) ->
    bs_find_test_heap_1(Is, [I|Acc]);
bs_find_test_heap_1([{test_heap,Words,_}|Is], Acc) ->
    {reverse(Acc, Is),Words};
bs_find_test_heap_1(_, _) -> none.

%% new_label(St) -> {L,St}.

new_label(St) ->
    L = St#cg.lcount,
    {L,St#cg{lcount=L+1}}.

flatmapfoldl(F, Accu0, [Hd|Tail]) ->
    {R,Accu1} = F(Hd, Accu0),
    {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail),
    {R++Rs,Accu2};
flatmapfoldl(_, Accu, []) -> {[],Accu}.

flatmapfoldr(F, Accu0, [Hd|Tail]) ->
    {Rs,Accu1} = flatmapfoldr(F, Accu0, Tail),
    {R,Accu2} = F(Hd, Accu1),
    {R++Rs,Accu2};
flatmapfoldr(_, Accu, []) -> {[],Accu}.