This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/misc/buildops

283 lines
6.1 KiB
Plaintext
Raw Normal View History

2008-08-21 13:39:56 +01:00
:- use_module(library(lineutils),
[process/2,
split/3]).
2008-08-29 05:25:36 +01:00
:- use_module(library(readutil),
[read_line_to_codes/2]).
:- use_module(library(lists),
[member/2]).
2008-08-21 13:39:56 +01:00
:- initialization(main).
2008-08-29 05:25:36 +01:00
:- yap_flag(write_strings,on).
:- yap_flag(unknown,error).
:- style_check(all).
:- dynamic qual/1.
qual("none").
2008-08-21 13:39:56 +01:00
main :-
2008-08-29 05:25:36 +01:00
get_field_names('H/amidefs.h'),
2008-08-21 13:39:56 +01:00
open('H/YapOpcodes.h',write,W),
2008-08-29 05:25:36 +01:00
open('H/rclause.h',write,C),
2008-08-21 13:39:56 +01:00
header(W),
2008-08-29 05:25:36 +01:00
header_rclause(C),
file('C/absmi.c',W,C),
start_ifdef("YAPOR",W,C),
file('OPTYap/or.insts.i',W,C),
end_ifdef(W,C),
start_ifdef("TABLING",W,C),
file('OPTYap/tab.insts.i',W,C),
retractall(op(_,_)),
2008-08-29 05:25:36 +01:00
file('OPTYap/tab.tries.insts.i',W,C),
end_ifdef(W,C),
2008-08-21 13:39:56 +01:00
footer(W),
2008-08-29 05:25:36 +01:00
footer_rclause(C),
close(W),
close(C).
start_ifdef(D,W,C) :-
retractall(op(_,_)),
format(W, '#ifdef ~s~n',[D]),
format(C, '#ifdef ~s~n',[D]).
end_ifdef(W,C) :-
format(W, '#endif~n',[]),
format(C, '#endif~n',[]).
2008-08-21 13:39:56 +01:00
header(W) :-
format(W,'~n /* This file was generated automatically by \"yap -L misc/buildops\"~n please do not update */~n~n',[]).
2008-08-29 05:25:36 +01:00
header_rclause(W) :-
format(W,'~n /* This file was generated automatically by \"yap -L misc/buildops\"~n please do not update */~n~n
static void
restore_opcodes(yamop *pc)
{
do {
op_numbers op = Yap_op_from_opcode(pc->opc);
pc->opc = Yap_opcode(op);
#ifdef DEBUG_RESTORE2
fprintf(stderr, "%s ", Yap_op_names[op]);
#endif
switch (op) {
',[]).
file(I,W,C) :-
2008-08-21 13:39:56 +01:00
open(I,read,R),
process(R,grep_opcode(W)),
2008-08-29 05:25:36 +01:00
close(R),
output_rclause(C).
2008-08-21 13:39:56 +01:00
grep_opcode(W, Line) :-
split(Line," ,();",[OP,Name,Type]),
Name \= "or_last",
check_op(OP),
special(Name,W),
2008-08-29 05:25:36 +01:00
assert(op(Type,Name)),
2008-08-21 13:39:56 +01:00
format(W,' OPCODE(~s~36+,~s),~n',[Name,Type]),
end_special(Name,W).
check_op("Op").
check_op("BOp").
check_op("PBOp").
check_op("OpRW").
check_op("OpW").
special(Name, W) :-
special_op(Name, Decl), !,
format(W,"#ifdef ~s~n",[Decl]).
special(_, _).
end_special(Name, W) :-
special_op(Name, _), !,
format(W,"#endif~n",[]).
end_special(_, _).
special_op("clause_with_cut","TABLING_INNER_CUTS").
2008-08-21 13:39:56 +01:00
special_op("cut_c","CUT_C").
special_op("cut_userc","CUT_C").
special_op("run_eam","BEAM").
special_op("retry_eam","BEAM").
special_op("thread_local","THREADS").
2008-08-29 05:25:36 +01:00
output_rclause(C) :-
setof(T,O^op(T,O),Types),
member(T, Types),
output_type(T, C),
fail.
output_rclause(_).
output_type(T, C) :-
format(C,' /* instructions type ~s */~n',[T]),
setof(Op,op(T,Op),Ops),
dump_ops(C,Ops),
output_typeinfo(C,T).
output_typeinfo(C,T) :-
tinfo(T, Info),
dump_fields(C,Info,T,T),
special_formats(C,T),
2008-08-29 05:25:36 +01:00
format(C,' pc = NEXTOP(pc,~s);
break;~n',[T]).
% tables require access to the table info.
special_formats(C,"e") :- !,
format(C,' if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return;~n',[]).
special_formats(C,"l") :- !,
format(C,' if (op == _Ystop) return;~n',[]).
special_formats(C,"sssl") :- !,
format(C,' AdjustSwitchTable(op, pc->u.sssl.l, pc->u.sssl.s);~n',[]).
special_formats(_,_).
2008-08-29 05:25:36 +01:00
dump_fields(_,[],"e",_).
dump_fields(_,[],[],_).
dump_fields(C,[I-_|Info],[O|Ops],T) :- !,
2008-08-29 05:25:36 +01:00
dump_field(C,I,O,T),
dump_fields(C,Info,Ops,T).
dump_fields(C,[_|Info],Ops,T) :-
dump_fields(C,Info,Ops,T).
dump_field(C,I,O,T) :-
rewritable_field(O), !,
get_op(O,A),
format(C,' ~sAdjust(pc->u.~s.~s);~n',[A,T,I]).
2008-08-29 05:25:36 +01:00
dump_field(C,I,O,T) :-
get_op(O,A),
format(C,' pc->u.~s.~s = ~sAdjust(pc->u.~s.~s);~n',[T,I,A,T,I]).
rewritable_field(0'd).
rewritable_field(0'i).
rewritable_field(0'O).
rewritable_field(0't).
2008-08-29 05:25:36 +01:00
get_op(0'a,"Arity").
get_op(0'b,"CellPtoHeap").
get_op(0'c,"ConstantTerm").
get_op(0'd,"DoubleInCode").
get_op(0'f,"Func").
2008-08-29 05:25:36 +01:00
get_op(0'F,"ExternalFunction").
get_op(0'i,"IntegerInCode").
get_op(0'I,"PtoLUIndex").
2008-08-29 05:25:36 +01:00
get_op(0'l,"PtoOp").
get_op(0'L,"PtoLUClause").
2008-08-29 05:25:36 +01:00
get_op(0'm,"Module").
get_op(0'n,"Integer").
2008-08-29 05:25:36 +01:00
get_op(0'o,"Opcode").
get_op(0'O,"OrArg").
2008-08-29 05:25:36 +01:00
get_op(0'p,"PtoPred").
get_op(0's,"Constant").
get_op(0't,"TabEntry").
2008-08-29 05:25:36 +01:00
get_op(0'x,"X").
get_op(0'y,"Y").
% '
2008-08-29 05:25:36 +01:00
dump_ops(_,[]).
dump_ops(C,[Op|Ops]) :-
special(Op,C),
format(C,' case _~s:~n',[Op]),
end_special(Op,C),
dump_ops(C,Ops).
2008-08-21 13:39:56 +01:00
/* or_last requires special handling */
footer(W) :-
format(W,' /* this instruction is hardwired */~n',[]),
format(W,'#ifdef YAPOR~n',[]),
format(W,' OPCODE(~s~36+,~s)~n',["or_last","sblp"]),
format(W,'#else~n',[]),
format(W,' OPCODE(~s~36+,~s)~n',["or_last","p"]),
format(W,'#endif~n',[]).
2008-08-29 05:25:36 +01:00
footer_rclause(W) :-
format(W,' /* this instruction is hardwired */~n',[]),
dump_ops(W,["or_last"]),
format(W,'#ifdef YAPOR~n',[]),
output_typeinfo(W,"Osblp"),
2008-08-29 05:25:36 +01:00
format(W,'#else~n',[]),
output_typeinfo(W,"p"),
format(W,'#endif~n',[]),
format(W,' }
} while (TRUE);
}
',[]).
get_field_names(F) :-
open(F, read, A),
loop_for_fields(A),
close(A).
loop_for_fields(A) :-
read_line_to_codes(A,"typedef struct yami {"), !,
loop_for_fields_go(A).
loop_for_fields(A) :-
loop_for_fields(A).
loop_for_fields_go(A) :-
read_line_to_codes(A,_),
read_line_to_codes(A,_),
read_field_by_field(A).
read_field_by_field(A) :-
read_line_to_codes(A,L),
split(L," ",Statement),
read_field_by_field(A,Statement).
read_field_by_field(_,["}","u;"]) :- !.
read_field_by_field(A,["struct","{"]) :- !,
read_fields(A,Fields,Type),
assert(tinfo(Type,Fields)),
read_field_by_field(A).
read_field_by_field(A,_) :-
read_field_by_field(A).
read_fields(A,Fields,Type) :-
read_line_to_codes(A,L),
split(L," ;*[",Statements0),
clean_statements(Statements0, Statements),
( Statements = ["}",Type]
->
Fields = []
;
Statements = ["CELL","next"]
->
read_fields(A,Fields,Type)
;
Statements = ["/"|_]
->
read_fields(A,Fields,Type)
;
Statements = ["#ifdef",If]
->
retract(qual(_)),
assert(qual(If)),
read_fields(A,Fields,Type)
;
Statements = ["#endif"|_]
->
retract(qual(_)),
assert(qual("none")),
read_fields(A,Fields,Type)
;
Statements = [_,F|_],
qual(Qual),
Fields = [F-Qual|More],
read_fields(A,More,Type)
).
clean_statements(["struct"|Statements0], StatementsF) :- !,
clean_statements(Statements0, StatementsF).
clean_statements(["unsigned"|Statements0], StatementsF) :- !,
clean_statements(Statements0, StatementsF).
clean_statements(Statements, Statements).