/*-------------------------------------------------------------------------*/
/* Passe 4: Generation du code.                                            */
/*                                                                         */
/* predicat d'appel: generation_code(T,C,NbChunk,Pred,W)                   */
/*                                                                         */
/* entree                                                                  */
/* T      : format interne de la tete                                      */
/* C      : format interne du corps                                        */
/* NbChunk: nombre de chunks du corps                                      */
/*                                                                         */
/* sortie                                                                  */
/* Pred   : nom du predicat de la tete (nom de la clause)                  */
/* W      : code wam associe a la clause, W = [inst_wam,...]               */
/*                                                                         */
/*                                                                         */
/* Principe:                                                               */
/* genere_tete  se charge de generer le code de la tete.                   */
/* genere_corps se charge de generer le code du corps. Remarquer que si le */
/* dernier but est un predicat inline il n'y a pas de execute mais un      */
/* un proceed.                                                             */
/*                                                                         */
/* Les termes structures:                                                  */
/* On entend par terme structure un format interne lst(_,_) ou stc(_,_),   */
/* on designera pas Strc de tels formats.                                  */
/* La gestion des termes structures de la tete et du corps est assuree par */
/* gen_lst_strc(LStrcReg,UL,LSuiv,W)                                       */
/*                                                                         */
/* entree                                                                  */
/* LStrcReg: une liste de Strc/Reg dont il faut generer le code            */
/* UL      : unif/load pour differencier les traitements                   */
/* LSuiv   : liste de codes wam a placer apres le resultat                 */
/*                                                                         */
/* sortie                                                                  */
/* W       : code wam associe a LStrcReg                                   */
/*                                                                         */
/* Un element de LStrcReg (un Strc/Reg) indique que Strc doit etre unifie  */
/* avec (resp. charge dans) le registre Reg si UL=unif (resp. UL=load).    */
/*                                                                         */
/* Pour chaque Strc/Reg on appelle:                                        */
/*                                                                         */
/* gen_strc(Strc,Reg,UL,LSuiv,StrcW,LStrcRegAux) qui calcule le code wam   */
/* associe a Strc/Reg (StrcW) et fournit une liste auxiliaire contenant    */
/* les sous termes structures de Strc (liste LStrcRegAux).                 */
/*                                                                         */
/* Il reste alors a rappeler gen_lst_strc() sur LStrcRegAux et aussi sur   */
/* LStrcReg' (LStrcReg = [Strc/Reg | LStrcReg']).                          */
/* Ce qui differe entre la tete et le corps est la facon dont doivent etre */
/* ajances les differents codes:                                           */
/*                                                                         */
/* en unif (tete) : LStrcRegW = StrcW        + LStrcRegAuxW + LStrcReg'W   */
/* en load (corps): LStrcRegW = LStrcRegAuxW + StrcW        + LStrcReg'W   */
/*                                                                         */
/* Exemples:                                                               */
/*                                                                         */
/* p(f(g(a,b),c)).                                                         */
/*                                                                         */
/* LStrcReg    = [f(g(a,b),c)/0]              (0 car a unifier contre A0)  */
/* StrcW       = [get_structure(f/2,0),                                    */
/*                unify_x_variable(_1),                                    */
/*                unify_constant(c)]                                       */
/*                                                                         */
/* LStrcRegAux = [g(a,b)/_1]                  (_1 temporaire cree)         */
/*                                                                         */
/* puis:                                                                   */
/* LStrcRegAuxW= [get_structure(g/2,_1),                                   */
/*                unify_constant(a),                                       */
/*                unify_constant(b)]                                       */
/*                                                                         */
/* d'ou:                                                                   */
/* LStrcRegW   = [get_structure(f/2,0),                                    */
/*                unify_x_variable(_1),                                    */
/*                unify_constant(c),                                       */
/*                get_structure(g/2,_1),                                   */
/*                unify_constant(a),                                       */
/*                unify_constant(b)]                                       */
/*                                                                         */
/*                                                                         */
/* p:- q(f(g(a,b),c)).                                                     */
/*                                                                         */
/* LStrcReg    = [f(g(a,b),c)/0]              (0 car a charger dans A0)    */
/* StrcW       = [put_structure(f/2,0),                                    */
/*                unify_x_value(_1),                                       */
/*                unify_constant(c)]                                       */
/*                                                                         */
/* LStrcRegAux = [g(a,b)/_1]                  (_1 temporaire cree)         */
/*                                                                         */
/* puis:                                                                   */
/* LStrcRegAuxW= [put_structure(g/2,_1),                                   */
/*                unify_constant(a),                                       */
/*                unify_constant(b)]                                       */
/*                                                                         */
/* d'ou:                                                                   */
/* LStrcRegW   = [put_structure(g/2,_1),                                   */
/*                unify_constant(a),                                       */
/*                unify_constant(b)]                                       */
/*                put_structure(f/2,0),                                    */
/*                unify_x_value(_1),                                       */
/*                unify_constant(c)]                                       */
/*-------------------------------------------------------------------------*/

:- public generation_code/5.

generation_code(T,C,NbChunk,Pred,TW1):-
	g_assign(nb_chunk,NbChunk),
	g_read(debug,Debug),
        (Debug>0 -> TW1=[dbg_clause|TW], CW1=[dbg_body|CW]
                 ;  TW1=TW, CW1=CW),
	genere_tete(T,NbChunk,CW1,TW,Pred),
	genere_corps(C,CW).




genere_tete(p(_,Pred,LstArg,NbY),NbChunk,LSuiv,TW,Pred):-
	gen_tete_lst_arg(LstArg,0,LSuiv,TW1),
	(NbChunk > 1 -> TW=[allocate(NbY)|TW1]
	             ;  TW=TW1).




gen_tete_lst_arg([],_,LSuiv,LSuiv).

gen_tete_lst_arg([Arg|LstArg],Reg,LSuiv,ArgW):-
	gen_unif_arg(Arg,Reg,LstArgW,ArgW),
	!,
	Reg1 is Reg+1,
	gen_tete_lst_arg(LstArg,Reg1,LSuiv,LstArgW).




genere_corps([],[proceed]).                                         % 0 buts

genere_corps([p(_,fail/0,[],_)|_],[fail]).

genere_corps([p(_,false/0,[],_)|_],[fail]).

genere_corps([p(NoPred,Pred/N,LstArg,_)|C],PredW):-
	inline_predicate(Pred,N),
	gen_inline_pred(Pred,N,NoPred,LstArg,CW,PredW),
	(C=[] -> (NoPred>1 -> CW=[deallocate,proceed]
	                   ;  CW=[proceed])
	      ;
	         genere_corps(C,CW)).

genere_corps([p(NoPred,Pred,LstArg,_)|C],PredW):-
	gen_corps_lst_arg(LstArg,0,NoPred,CallExecuteW,PredW),
	(C=[] -> (NoPred>1 -> CallExecuteW=[deallocate,execute(Pred)]
	                   ;  CallExecuteW=[execute(Pred)])
	      ;
	         CallExecuteW=[call(Pred)|CW],
	         genere_corps(C,CW)).




gen_corps_lst_arg([],_,_,LSuiv,LSuiv).

gen_corps_lst_arg([Arg|LstArg],Reg,NoPred,LSuiv,ArgW):-
	gen_load_arg(Arg,Reg,NoPred,LstArgW,ArgW),
	Reg1 is Reg+1,
	!,
	gen_corps_lst_arg(LstArg,Reg1,NoPred,LSuiv,LstArgW).




	/* gen_unif_arg(Arg,Reg,LSuiv,W) */

gen_unif_arg(var(igv(x(No),_,_,_,_),PremOcc,_),Reg,LSuiv,[ArgW|LSuiv]):-
	(PremOcc==t -> ArgW=get_x_variable(No,Reg)
	            ;  ArgW=get_x_value(No,Reg)).

gen_unif_arg(var(igv(y(No),_,_,_,_),PremOcc,_),Reg,LSuiv,[ArgW|LSuiv]):-
	(PremOcc==t -> ArgW=get_y_variable(No,Reg)
	            ;  ArgW=get_y_value(No,Reg)).

gen_unif_arg(cst(C),Reg,LSuiv,[get_constant(C,Reg)|LSuiv]).

gen_unif_arg(int(N),Reg,LSuiv,[get_integer(N,Reg)|LSuiv]).

gen_unif_arg(nil,Reg,LSuiv,[get_nil(Reg)|LSuiv]).

gen_unif_arg(Strc,Reg,LSuiv,StrcW):-
	gen_lst_strc([Strc/Reg],unif,LSuiv,StrcW).




	/* gen_load_arg(Arg,Reg,NoPred,LSuiv,W) */

gen_load_arg(var(igv(x(No),_,_,_,_),PremOcc,_),Reg,_,LSuiv,[ArgW|LSuiv]):-
	(PremOcc==t -> ArgW=put_x_variable(No,Reg)
	            ;  ArgW=put_x_value(No,Reg)).

gen_load_arg(var(igv(y(No),_,_,_,Unsafe),PremOcc,_),Reg,NoPred,LSuiv,[ArgW|LSuiv]):-
	(PremOcc==t -> ArgW=put_y_variable(No,Reg)
	            ;  (Unsafe==t, g_read(nb_chunk,NoPred)
	                          -> ArgW=put_y_unsafe_value(No,Reg)
	                          ;  ArgW=put_y_value(No,Reg))).

gen_load_arg(cst(C),Reg,_,LSuiv,[put_constant(C,Reg)|LSuiv]).

gen_load_arg(int(N),Reg,_,LSuiv,[put_integer(N,Reg)|LSuiv]).

gen_load_arg(nil,Reg,_,LSuiv,[put_nil(Reg)|LSuiv]).

gen_load_arg(Strc,Reg,_,LSuiv,StrcW):-
	gen_lst_strc([Strc/Reg],load,LSuiv,StrcW).




	/* gen_lst_strc(LStrcReg,UL,LSuiv,W) */

gen_lst_strc([],_,LSuiv,LSuiv).

gen_lst_strc([Strc/Reg|LStrcReg],UL,LSuiv,W):-
	gen_strc(Strc,Reg,UL,W1,W2,LStrcRegAux),
	gen_lst_strc(LStrcRegAux,UL,W3,W4),
	gen_lst_strc(LStrcReg,UL,LSuiv,W5),
	(UL==unif -> W=W2, W1=W4, W3=W5
	          ;  W=W4, W3=W2, W1=W5).




gen_strc(lst(Car,Cdr),Reg,UL,LSuiv,[W|LstW],LStrcRegAux):-
	(UL==unif -> W=get_list(Reg) 
	          ;  W=put_list(Reg)),
	gen_unify_lst_arg([Car,Cdr],UL,LSuiv,LstW,LStrcRegAux).

gen_strc(stc(F,LstArg),Reg,UL,LSuiv,[W|StcW],LStrcRegAux):-
	(UL==unif -> W=get_structure(F,Reg) 
	          ;  W=put_structure(F,Reg)),
	gen_unify_lst_arg(LstArg,UL,LSuiv,StcW,LStrcRegAux).




gen_unify_lst_arg([],_,LSuiv,LSuiv,[]).

gen_unify_lst_arg([Arg|LstArg],UL,LSuiv,ArgW,LStrcRegAux1):-
	gen_compte_void([Arg|LstArg],0,N,LstArg1),
	(N=0 
	  -> gen_unify_arg(Arg,UL,LstArgW,ArgW,LStrcRegAux,LStrcRegAux1),
	     gen_unify_lst_arg(LstArg,UL,LSuiv,LstArgW,LStrcRegAux)
	  ;
	     ArgW=[unify_void(N)|LstArg1W],
	     gen_unify_lst_arg(LstArg1,UL,LSuiv,LstArg1W,LStrcRegAux1)),
	!.




gen_compte_void([var(_,t,t)|LstArg],N,N2,LstArg1):-
	N1 is N+1,
	gen_compte_void(LstArg,N1,N2,LstArg1).

gen_compte_void(LstArg,N,N,LstArg).

	          


gen_unify_arg(var(igv(x(No),NoPPOcc,_,Stc,_),PremOcc,_),_,LSuiv,[ArgW|LSuiv],
	  LStrcRegAux,LStrcRegAux):-
	(PremOcc==t -> ArgW=unify_x_variable(No)
	            ; (NoPPOcc=0, Stc==f -> ArgW=unify_x_local_value(No)
	                                 ;  ArgW=unify_x_value(No))).

gen_unify_arg(var(igv(y(No),_,_,Stc,_),PremOcc,_),_,LSuiv,[ArgW|LSuiv],
	  LStrcRegAux,LStrcRegAux):-
	(PremOcc==t  -> ArgW=unify_y_variable(No)
	             ;  (Stc==f -> ArgW=unify_y_local_value(No)
	                        ;  ArgW=unify_y_value(No))).

gen_unify_arg(cst(C),_,LSuiv,[unify_constant(C)|LSuiv],LStrcRegAux,LStrcRegAux).

gen_unify_arg(int(N),_,LSuiv,[unify_integer(N)|LSuiv],LStrcRegAux,LStrcRegAux).

gen_unify_arg(nil,_,LSuiv,[unify_nil|LSuiv],LStrcRegAux,LStrcRegAux).

gen_unify_arg(Strc,UL,LSuiv,[ArgW|LSuiv],LStrcRegAux,[Strc/Reg|LStrcRegAux]):-
	(UL==unif -> ArgW=unify_x_variable(Reg)
	          ;  ArgW=unify_x_value(Reg)).



	% Code des predicats inline : 
	%      gen_inline_pred(Pred,Arite,NoPred,LstArg,LSuiv,Code)
	% Tous les predicats definis ici doivent aussi avoir une clause
	% dans le predicat inline_predicate/3 en passe 2 definissant tous
	% les predicats inline.




	/* Cut inline ('$get_bc_reg'/1,'$cut'/1) */

gen_inline_pred('$get_bc_reg',1,_,[var(igv(Nom,_,_,_,_),PremOcc,_)],
	    LSuiv,[InstW|LSuiv]):-
	(PremOcc==f -> error('$get_bc_reg used with bound variable...')
	            ;  true),
	(Nom=x(No), InstW=get_x_bc_reg(No)
	      ; 
	 Nom=y(No), InstW=get_y_bc_reg(No)).




gen_inline_pred('$cut',1,_,[var(igv(Nom,_,_,_,_),_,_)],LSuiv,[InstW|LSuiv]):-
	(Nom=x(No), InstW=cut_x(No) 
	      ; 
	 Nom=y(No), InstW=cut_y(No)).




	/* dbg_true */

gen_inline_pred('$dbg_true',0,_,_,LSuiv,LSuiv).




	/* Pragma C (pragma_c/1) */

gen_inline_pred(pragma_c,1,_,[cst(Code)],LSuiv,[pragma_c(Code)|LSuiv]).




          /* calling module nb inline */

gen_inline_pred(calling_module_nb,1,NoPred,[Arg1],LSuiv,CodeW):-
	gen_inline_pred((=),2,NoPred,[Arg1,int('CMN')],LSuiv,CodeW).




	/* Unification inline (=/2) */

gen_inline_pred((=),2,NoPred,[Arg1,Arg2],LSuiv,UnifW):-
	(Arg1=var(igv(x(Reg),_,_,_,_),PremOcc,_) 
	   -> inline_unif_reg_terme(PremOcc,Reg,Arg2,NoPred,LSuiv,UnifW)
	   ;
	      (Arg2=var(igv(x(Reg),_,_,_,_),PremOcc,_)
	         -> inline_unif_reg_terme(PremOcc,Reg,Arg1,NoPred,
	                                  LSuiv,UnifW)
	         ;
	            gen_load_arg(Arg1,Reg,NoPred,Unif1W,UnifW),
	            inline_unif_reg_terme(PremOcc,Reg,Arg2,NoPred,
	                                  LSuiv,Unif1W))).




inline_unif_reg_terme(f,Reg,Arg,_,LSuiv,UnifW):-
	gen_unif_arg(Arg,Reg,LSuiv,UnifW).

inline_unif_reg_terme(_,Reg,Arg,NoPred,LSuiv,UnifW):-
	gen_load_arg(Arg,Reg,NoPred,LSuiv,UnifW).




          /* Type test inline */

gen_inline_pred(F,1,_,[Arg],LSuiv,TestW):-
	type_test_functor(F),
	gen_load_arg(Arg,Reg,_,InstW,TestW),
	InstW=[builtin_1(F,Reg)|LSuiv].




type_test_functor(var).
type_test_functor(nonvar).
type_test_functor(atom).
type_test_functor(integer).
type_test_functor(number).
type_test_functor(atomic).
type_test_functor(compound).
type_test_functor(callable).




          /* Term decomposition + compare/3 inline */

gen_inline_pred(F,3,_,[Arg1,Arg2,Arg3],LSuiv,TermW):-
	term_ope_functor(F),
        gen_load_arg(Arg1,Reg1,_,Term1W,TermW),
        gen_load_arg(Arg2,Reg2,_,Term2W,Term1W),
        gen_load_arg(Arg3,Reg3,_,InstW,Term2W),
        InstW=[builtin_3(F,Reg1,Reg2,Reg3)|LSuiv].




term_ope_functor(arg).
term_ope_functor(functor).
term_ope_functor(compare).




          /* Term comparison inline */

gen_inline_pred(F,2,_,[Arg1,Arg2],LSuiv,CompW):-
	term_cmp_functor_name(F,Name),
	gen_load_arg(Arg1,Reg1,_,Comp1W,CompW),
	gen_load_arg(Arg2,Reg2,_,InstW,Comp1W),
	!,
	InstW=[builtin_2(Name,Reg1,Reg2)|LSuiv].



term_cmp_functor_name((=..),term_univ).        % not a cmp but its arity is 2

term_cmp_functor_name((==), term_eq).
term_cmp_functor_name((\==),term_neq).
term_cmp_functor_name((@<), term_lt).
term_cmp_functor_name((@=<),term_lte).
term_cmp_functor_name((@>), term_gt).
term_cmp_functor_name((@>=),term_gte).




	/* Mathematical inlines (is/2 =:=/2 ...) */

gen_inline_pred(is,2,_,[Arg1,Arg2],LSuiv,MathW):-
        inline_load_math_expr(Arg2,Reg,UnifW,MathW),
        !,
        gen_unif_arg(Arg1,Reg,LSuiv,UnifW).




gen_inline_pred(F,2,_,[Arg1,Arg2],LSuiv,Math1W):-
	math_cmp_functor_name(F,Name),
	inline_load_math_expr(Arg1,Reg1,Math2W,Math1W),
	inline_load_math_expr(Arg2,Reg2,InstW, Math2W),
	!,
	InstW=[builtin_2(Name,Reg1,Reg2)|LSuiv].




inline_load_math_expr(var(igv(Nom,_,_,_,_),PremOcc,_),Reg,LSuiv,MathW):-
	(PremOcc==t 
	    -> error('Illegal arithmetic expression - free variable')
	    ;  (Nom=x(No), MathW=[math_load_x_value(No,Reg)|LSuiv]
	           ;
	        Nom=y(No), MathW=[math_load_y_value(No,Reg)|LSuiv])).

inline_load_math_expr(int(N),Reg,LSuiv,MathW):-
	MathW=[put_integer(N,Reg)|LSuiv].

inline_load_math_expr(lst(Arg,nil),Reg,LSuiv,MathW):-
	inline_load_math_expr(Arg,Reg,LSuiv,MathW).

inline_load_math_expr(stc(F/_,[Arg]),Reg,LSuiv,MathW):-
	(F== (-) -> Name=neg
                 ;  math_exp_functor_name(F,Name)),
	inline_load_math_expr(Arg,Reg1,InstW,MathW),
        (Name==add -> Reg=Reg1,
                      InstW=LSuiv
                   ;
		      InstW=[function_1(Name,Reg,Reg1)|LSuiv]).

inline_load_math_expr(stc(F/_,[Arg1,Arg2]),Reg,LSuiv,MathW):-
	math_exp_functor_name(F,Name),
	inline_load_math_expr(Arg1,Reg1,Math1W,MathW),
	(Arg2=int(1), (Name==add, Name1=inc ; Name==sub, Name1=dec) 
	      -> Math1W=InstW,
	         InstW=[function_1(Name1,Reg,Reg1)|LSuiv]
	      ;
	         inline_load_math_expr(Arg2,Reg2,InstW,Math1W),
	         InstW=[function_2(Name,Reg,Reg1,Reg2)|LSuiv]).

inline_load_math_expr(X,_,_,_):-
	error('Illegal arithmetic expression - unknown operation'(X)).




math_exp_functor_name((+),  add).
math_exp_functor_name((-),  sub).
math_exp_functor_name((*),  mul).
math_exp_functor_name((//), div).
math_exp_functor_name(mod,  mod).
math_exp_functor_name((/\), and).
math_exp_functor_name((\/), or).
math_exp_functor_name((^),  xor).
math_exp_functor_name((\),  not).
math_exp_functor_name((<<), shl).
math_exp_functor_name((>>), shr).


math_cmp_functor_name((=:=),eq).
math_cmp_functor_name((=\=),neq).
math_cmp_functor_name((<),  lt).
math_cmp_functor_name((=<), lte).
math_cmp_functor_name((>),  gt).
math_cmp_functor_name((>=), gte).




          /* Global variables */

gen_inline_pred(F,2,_,[Arg1,Arg2],LSuiv,GVarW):-
	g_var_functor(F),
        gen_load_arg(Arg1,Reg1,_,GVar1W,GVarW),
        gen_load_arg(Arg2,Reg2,_,InstW,GVar1W),
        InstW=[builtin_2(F,Reg1,Reg2)|LSuiv].




g_var_functor(g_assign).
g_var_functor(g_assignb).
g_var_functor(g_link).
g_var_functor(g_read).
g_var_functor(g_array_size).
