/*-------------------------------------------------------------------------*/
/* Emission en mode c */
/* */
/* predicat d'appel: */
/* c_emission(LPaqW,Main). */
/* */
/* entree */
/* LPaqW : liste de paquets = [paq(Pred/N,[ [wam_inst,...],...]),...] */
/* Main : no_main ou declaration de main */
/*-------------------------------------------------------------------------*/
:- public c_emission/2.
c_emission(LPaqW,Main):-
c_emit_fic_c(LPaqW,Main,DicAt,DicPr,NbPrivate),
!,
c_emit_fic_h(DicAt,DicPr,NbPrivate),
g_read(fic_usr,FicUsr),
c_emit_fic_usr(FicUsr).
/* generation: C file (.c) */
c_emit_fic_c(LPaqW,Main,DicAt,DicPr,NbPrivate):-
g_read(fic_out,FicC),
g_read(module,Module),
tell(FicC),
formata('/*~*c~n',[75,0'*]),
display_version,
formata('File : ~a~n',[FicC]),
formata('Main : ~w~n',[Main]),
formata('~*c*/~n~n',[75,0'*]),
(g_read(fast_math,t) -> formata('#define FAST_MATH~n',[])
; true),
(g_read(no_stack_test,t) -> formata('#define NO_STACK_TEST~n',[])
; true),
g_read(debug,Debug),
formata('#define DEBUG_LEVEL ~d~n',[Debug]),
nl,
formata('#include "wam_engine.h"~n~n',[]),
formata('#include "~a.h"~n',[Module]),
formata('#include "~a.usr"',[Module]),
add_to_dic_atom(DicAt,[],_),
c_emit_lst_pred(LPaqW,DicAt,DicPr),
c_emit_fct_init_tables(DicAt,DicPr,NbPrivate),
c_emit_fct_exec_directives,
(Main\==no_main -> c_emit_fct_main(Main)
; true),
told.
c_emit_lst_pred([],_,[]).
c_emit_lst_pred([paq(Pred/N,W)|LPaqW],DicAt,DicPr1):-
add_to_dic_atom(DicAt,Pred,_),
DicPr1=[p(Pred/N,LSwtCst,LSwtStc)|DicPr],
c_emit_pred(Pred,N,LSwtCst,LSwtStc,W,DicAt),
!,
c_emit_lst_pred(LPaqW,DicAt,DicPr).
c_emit_pred(Pred,N,LSwtCst,LSwtStc,W,DicAt):-
!,
nl, nl, nl,
c_string(Pred,CPred),
write('#define ASCII_PRED '), write(CPred), nl,
write('#define PRED '), h_write(Pred), nl,
write('#define ARITY '), write(N), nl, nl,
(test_pred_info(pub,Pred,N) -> write('Begin_Public_Pred')
; write('Begin_Private_Pred')),
nl,
c_emit(W,DicAt,1,_,LSwtCst,LSwtStc),
nl, write('End_Pred'), nl, nl,
write('#undef ASCII_PRED'), nl,
write('#undef PRED'), nl,
write('#undef ARITY'), nl.
c_emit([],_,NoSub,NoSub,[],[]).
c_emit([InstW|W],DicAt,NoSub,NoSub2,LSwtCst,LSwtStc):-
% applatit le code
(special_form(InstW,InstW1) ; InstW1=InstW),
!,
c_emit(InstW1,DicAt,NoSub,NoSub1,LSwtCst1,LSwtStc1),
c_emit(W,DicAt,NoSub1,NoSub2,LSwtCst2,LSwtStc2),
!,
append(LSwtCst1,LSwtCst2,LSwtCst),
append(LSwtStc1,LSwtStc2,LSwtStc).
c_emit(InstW,_,NoSub,NoSub,[],[]):-
dummy_instruction(InstW). % cf wamcc5.pl
c_emit(get_constant(C,A),DicAt,NoSub,NoSub,[],[]):-
add_to_dic_atom(DicAt,C,CAtom),
tab(6), write('get_constant('), h_write(C),
formata(',~d,~a)~n',[A,CAtom]).
c_emit(put_constant(C,A),DicAt,NoSub,NoSub,[],[]):-
add_to_dic_atom(DicAt,C,CAtom),
tab(6), write('put_constant('), h_write(C),
formata(',~d,~a)~n',[A,CAtom]).
c_emit(get_structure(F/N,R),DicAt,NoSub,NoSub,[],[]):-
add_to_dic_atom(DicAt,F,CAtom),
tab(6), write('get_structure('), h_write(F),
formata(',~d,~d,~a)~n',[N,R,CAtom]).
c_emit(put_structure(F/N,R),DicAt,NoSub,NoSub,[],[]):-
add_to_dic_atom(DicAt,F,CAtom),
tab(6), write('put_structure('), h_write(F),
formata(',~d,~d,~a)~n',[N,R,CAtom]).
c_emit(unify_constant(C),DicAt,NoSub,NoSub,[],[]):-
add_to_dic_atom(DicAt,C,CAtom),
tab(6), write('unify_constant('), h_write(C),
formata(',~a)~n',[CAtom]).
c_emit(call(Pred/N),_,NoSub,NoSub1,[],[]):-
(test_pred_info(def,Pred,N) -> Local=1
; Local=0),
NoSub1 is NoSub+1,
c_string(Pred,CPred),
tab(6), write('call('), write_pred_name(Pred,N),
formata(',~d,~d,~a,~d)',[Local,NoSub,CPred,N]),
c_emit_header_sub_pred(NoSub).
c_emit(execute(Pred/N),_,NoSub,NoSub,[],[]):-
(test_pred_info(def,Pred,N) -> Local=1
; Local=0),
c_string(Pred,CPred),
tab(6), write('execute('), write_pred_name(Pred,N),
formata(',~d,~a,~d)~n',[Local,CPred,N]).
c_emit(switch_on_term(LabVar,LabCst,LabInt,LabLst,LabStc),_,NoSub,NoSub,[],[]):-
tab(6), write('switch_on_term('),
c_emit_goto_or_fail(LabVar), write(','),
c_emit_goto_or_fail(LabCst), write(','),
c_emit_goto_or_fail(LabInt), write(','),
c_emit_goto_or_fail(LabLst), write(','),
c_emit_goto_or_fail(LabStc), write(')'), nl.
c_emit_goto_or_fail(Lab):-
(Lab==fail -> write(fail)
;
write('G_label'(Lab))).
c_emit(switch_on_constant(Lab,Nb,Lst),_,NoSub,NoSub,[c(Lab,Nb,Lst)],[]):-
tab(6), write('switch_on_constant('),
formata('~d,"~w")~n',[Lab,Lst]).
% C switch for switch_on_integer
c_emit(switch_on_integer(_,_,Lst),_,NoSub,NoSub,[],[]):-
tab(6), write('switch_on_integer(lst('),
c_emit_swt_int(Lst),
formata('),"~w")~n',[Lst]).
c_emit_swt_int([]).
c_emit_swt_int([(Int,Label)|Lst]):-
write(i(Int,Label)), write(' '),
c_emit_swt_int(Lst).
c_emit(switch_on_structure(Lab,Nb,Lst),_,NoSub,NoSub,[],[s(Lab,Nb,Lst)]):-
tab(6), write('switch_on_structure('),
formata('~d,"~w")~n',[Lab,Lst]).
c_emit(try(Lab),_,NoSub,NoSub1,[],[]):-
NoSub1 is NoSub+1,
tab(6), write(try(Lab,NoSub)),
c_emit_header_sub_pred(NoSub).
c_emit(retry(Lab),_,NoSub,NoSub1,[],[]):-
NoSub1 is NoSub+1,
tab(6), write(retry(Lab,NoSub)),
c_emit_header_sub_pred(NoSub).
c_emit(label(Lab),_,NoSub,NoSub,[],[]):-
(Lab=0 -> true
;
nl, write(label(Lab)), nl).
c_emit(InstW,_,NoSub,NoSub,[],[]):-
tab(6), write(InstW), nl.
c_emit_header_sub_pred(NoSub):-
formata(' /* begin sub ~d */~n',[NoSub]).
c_emit_fct_init_tables(DicAt,DicPr,NbPrivate):-
g_read(module,Module),
nl, nl,
write('Begin_Init_Tables'(Module)), nl, nl,
c_emit_init_tables_atom(DicAt), nl,
c_emit_init_tables_pred(DicPr,NbPrivate), nl,
write(' Init_Usr_File'), nl, nl,
write('End_Init_Tables'), nl.
c_emit_init_tables_atom([]). % unifie var fin de liste
c_emit_init_tables_atom([Atom-CAtom|DicAt]):-
write(' Define_Atom('), h_write(Atom),
formata(',~a)~n',[CAtom]),
c_emit_init_tables_atom(DicAt).
c_emit_init_tables_pred([],0).
c_emit_init_tables_pred([p(Pred/N,LSwtCst,LSwtStc)|DicPr],NbPrivate):-
nl,
write(' Define_Pred('), h_write(Pred), formata(',~d,',[N]),
(test_pred_info(pub,Pred,N) -> write(1), Private=0
; write(0), Private=1),
write(')'), nl,
c_emit_init_tbl_swt_cst(LSwtCst,Pred,N),
c_emit_init_tbl_swt_stc(LSwtStc,Pred,N),
c_emit_init_tables_pred(DicPr,NbPrivate1),
NbPrivate is NbPrivate1+Private.
c_emit_init_tbl_swt_cst([],_,_).
c_emit_init_tbl_swt_cst([c(Lab,Nb,Lst)|LSwtCst],Pred,N):-
write(' Define_Switch_CST_Table('),
write_swt_table_name(Pred,N,Lab,cst),
formata(',~d)~n',[Nb]),
c_emit_init_swt_cst(Lst,Pred,N),
c_emit_init_tbl_swt_cst(LSwtCst,Pred,N).
c_emit_init_swt_cst([],_,_).
c_emit_init_swt_cst([(Atom,Label)|Lst],Pred,N):-
write(' Define_Switch_CST('), h_write(Atom),
write(','), write_label_pred_name(Pred,N,Label),
write(')'), nl,
c_emit_init_swt_cst(Lst,Pred,N).
c_emit_init_tbl_swt_stc([],_,_).
c_emit_init_tbl_swt_stc([s(Lab,Nb,Lst)|LSwtStc],Pred,N):-
write(' Define_Switch_STC_Table('),
write_swt_table_name(Pred,N,Lab,stc),
formata(',~d)~n',[Nb]),
c_emit_init_swt_stc(Lst,Pred,N),
c_emit_init_tbl_swt_stc(LSwtStc,Pred,N).
c_emit_init_swt_stc([],_,_).
c_emit_init_swt_stc([(Atom/N1,Label)|Lst],Pred,N):-
write(' Define_Switch_STC('), h_write(Atom),
formata(',~d,',[N1]), write_label_pred_name(Pred,N,Label),
write(')'), nl,
c_emit_init_swt_stc(Lst,Pred,N).
c_emit_fct_exec_directives:-
g_read(module,Module),
nl, nl,
write('Begin_Exec_Directives'(Module)), nl, nl,
g_read(nb_clause_dyn,NbClauseDyn),
c_emit_exec_directives(1,NbClauseDyn,'$dyn_'), nl,
g_read(nb_clause_exe,NbClauseExe),
c_emit_exec_directives(1,NbClauseExe,'$exe_'), nl,
write('End_Exec_Directives'), nl.
c_emit_exec_directives(I,N,Prefix):-
(I=<N -> make_special_clause_head(Prefix,I,Pred), % en wamcc0.pl
formata(' Exec_Directive(~d,',[I]),
write_pred_name(Pred,0), write(')'), nl,
I1 is I+1,
c_emit_exec_directives(I1,N,Prefix)
;
true).
/* generation: main() */
c_emit_fct_main(Main):-
g_read(module,Module),
(Main=main, LMod=[], LStack=[]
;
Main=main(LMod), LStack=[]
;
Main=main(LMod,LStack)),
!,
append(LMod,[Module],LMod1),
LMod2=['Builtin'|LMod1],
formata('~n~n/*** MAIN ***/~n~n',[]),
formata('int main(int argc,char *argv[])~n~n{~n',[]),
formata(' unix_argc=argc;~n',[]),
formata(' unix_argv=argv;~n~n',[]),
c_emit_fct_main_define_stacks(LStack), nl,
formata(' Init_Wam_Engine();~n~n',[]),
c_emit_fct_main_init_tables_modules(LMod2), nl,
c_emit_fct_main_exec_directives_modules(LMod2), nl,
formata(' Term_Wam_Engine();~n~n',[]),
formata(' return 0;~n}~n',[]).
c_emit_fct_main_define_stacks([]).
c_emit_fct_main_define_stacks([stack(Name,EnvVar,Size)|LStack]):-
formata(' Set_Stack_Defaults("~a","~a",~d);~n',[Name,EnvVar,Size]),
c_emit_fct_main_define_stacks(LStack).
c_emit_fct_main_init_tables_modules([]).
c_emit_fct_main_init_tables_modules([ImportModule|LMod]):-
write(' Init_Tables_Of_Module'(ImportModule)), nl,
c_emit_fct_main_init_tables_modules(LMod).
c_emit_fct_main_exec_directives_modules([]).
c_emit_fct_main_exec_directives_modules([ImportModule|LMod]):-
write(' Exec_Directives_Of_Module'(ImportModule)), nl,
c_emit_fct_main_exec_directives_modules(LMod).
/* Tools */
add_to_dic_atom(DicAt,Atom,CAtom):-
member(Atom-CAtom,DicAt),
(var(CAtom), c_string(Atom,CAtom)
; true),
!.
c_string(Atom,CAtom):-
atom_codes(Atom,SAtom),
prolog_to_c_string(SAtom,SCAtom),
atom_codes(CAtom,[0'"|SCAtom]).
prolog_to_c_string([],[0'"]).
prolog_to_c_string([X|SAtom],SCAtom1):-
((X=0'\; X=0'") -> SCAtom1=[0'\,X|SCAtom]
; SCAtom1=[X|SCAtom]),
prolog_to_c_string(SAtom,SCAtom).
/* generation: header file (.h) */
c_emit_fic_h(DicAt,DicPr,NbPrivate):-
g_read(module,Module),
g_read(fic_h,FicH),
tell(FicH),
formata('/*~*c~n',[75,0'*]),
display_version,
formata('file : ~a~n',[FicH]),
formata('~*c*/~n~n',[75,0'*]),
formata('#define NB_OF_PRIVATE_PREDS ~d~n~n',[NbPrivate]),
c_string(Module,CModule),
formata('static char *module_name=~a;~n',[CModule]),
formata('static int module_nb;~n~n',[]),
c_emit_decl_var_atom(DicAt), nl,
c_emit_decl_var_pred(DicPr), nl,
told.
c_emit_decl_var_atom([]). % unifie var fin de liste
c_emit_decl_var_atom([Atom-_|DicAt]):-
write('static AtomInf *'), h_write(Atom), write(';'), nl,
c_emit_decl_var_atom(DicAt).
c_emit_decl_var_pred([]). % unifie var fin de liste
c_emit_decl_var_pred([p(Pred/N,LSwtCst,LSwtStc)|DicPr]):-
c_emit_decl_tbl_swt(LSwtCst,cst,Pred,N),
c_emit_decl_tbl_swt(LSwtStc,stc,Pred,N),
c_emit_decl_var_pred(DicPr).
c_emit_decl_tbl_swt([],_,_,_).
c_emit_decl_tbl_swt([Swt|LSwt],Type,Pred,N):-
arg(1,Swt,Lab),
write('static SwtTbl '),
write_swt_table_name(Pred,N,Lab,Type), write(';'), nl,
c_emit_decl_tbl_swt(LSwt,Type,Pred,N).
/* generation: user file (.usr) */
c_emit_fic_usr(FicUsr):-
unix(access(FicUsr,0)). /* si existe deja, ne fait rien */
c_emit_fic_usr(FicUsr):-
tell(FicUsr),
formata('/*~*c~n',[75,0'*]),
display_version,
formata('file : ~a~n',[FicUsr]),
formata('~*c*/~n~n',[75,0'*]),
c_emit_modif_fail,
c_emit_en_tete_init_usr, nl, nl,
formata('{~n}~n',[]),
c_emit_restore_fail,
told.
c_emit_modif_fail:-
nl,
write('/* Above this line, put your first macros '),
write('(these included by pragma_c) */'), nl,
nl,
write('#undef fail'), nl,
write('#define fail Fail_Like_Bool'), nl,
nl,
write('/* Below this line, put your others macros '),
write('and your functions */'), nl,
nl, nl.
c_emit_restore_fail:-
nl,
write('/* end of user file */'), nl,
nl,
write('#undef fail'), nl,
write('#define fail Fail_Like_Wam'), nl.
c_emit_en_tete_init_usr:-
write('static void Initialize_Usr(void)').
write_pred_name(Pred,N):-
write('Pred_Name('), h_write(Pred),
formata(',~d)',[N]).
write_label_pred_name(Pred,N,Lab):-
write('Label_Pred_Name('), h_write(Pred),
formata(',~d,~d)',[N,Lab]).
write_swt_table_name(Pred,N,Lab,Type):-
write('Swt_Table_Name('), h_write(Pred),
formata(',~d,~d,~a)',[N,Lab,Type]).
h_write(X):-
atom_codes(X,Str),
write('X'),
h_write_hexa(Str).
h_write_hexa([]).
h_write_hexa([C|Str]):-
formata('~16R',[C]),
h_write_hexa(Str).
syntax highlighted by Code2HTML, v. 0.9.1