462 lines
12 KiB
Plaintext
462 lines
12 KiB
Plaintext
|
|
:- use_module(library(lineutils),
|
|
[process/2,
|
|
split/3]).
|
|
|
|
:- use_module(library(readutil),
|
|
[read_line_to_codes/2]).
|
|
|
|
:- use_module(library(lists),
|
|
[member/2]).
|
|
|
|
:- initialization(main).
|
|
|
|
:- yap_flag(write_strings,on).
|
|
|
|
:- yap_flag(unknown,error).
|
|
|
|
:- style_check(all).
|
|
|
|
:- dynamic qual/1.
|
|
|
|
qual("none").
|
|
|
|
main :-
|
|
get_field_names('H/amidefs.h'),
|
|
open('H/YapOpcodes.h',write,W),
|
|
open('H/rclause.h',write,C),
|
|
open('H/walkclause.h',write,L),
|
|
header(W),
|
|
header_rclause(C),
|
|
header_walk_clause(L),
|
|
file('C/absmi.c', W, C, L),
|
|
start_ifdef("YAPOR", W, C, L),
|
|
file('OPTYap/or.insts.i',W, C, L),
|
|
end_ifdef(W,C,L),
|
|
start_ifdef("TABLING",W,C,L),
|
|
file('OPTYap/tab.insts.i',W,C,L),
|
|
retractall(op(_,_)),
|
|
file('OPTYap/tab.tries.insts.i',W,C,L),
|
|
end_ifdef(W,C,L),
|
|
footer(W),
|
|
footer_rclause(C),
|
|
footer_walk_clause(L),
|
|
close(L),
|
|
close(W),
|
|
close(C).
|
|
|
|
start_ifdef(D,W,C,L) :-
|
|
retractall(op(_,_)),
|
|
format(W, '#ifdef ~s~n',[D]),
|
|
format(C, '#ifdef ~s~n',[D]),
|
|
format(L, '#ifdef ~s~n',[D]).
|
|
|
|
end_ifdef(W,C,L) :-
|
|
format(W, '#endif~n',[]),
|
|
format(C, '#endif~n',[]),
|
|
format(L, '#endif~n',[]).
|
|
|
|
header(W) :-
|
|
format(W,'~n /* This file was generated automatically by \"yap -L misc/buildops\"~n please do not update */~n~n',[]).
|
|
|
|
|
|
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) {
|
|
',[]).
|
|
|
|
header_walk_clause(W) :-
|
|
format(W,'~n /* This file was generated automatically by \"yap -L misc/buildops\"~n please do not update */~n~n
|
|
while (TRUE) {
|
|
op_numbers op;
|
|
|
|
op = Yap_op_from_opcode(pc->opc);
|
|
/* C-code, maybe indexing */
|
|
switch (op) {
|
|
',[]).
|
|
|
|
|
|
file(I,W,C,L) :-
|
|
open(I,read,R),
|
|
process(R,grep_opcode(W)),
|
|
close(R),
|
|
output_rclause(C),
|
|
output_walk_clause(L).
|
|
|
|
grep_opcode(W, Line) :-
|
|
split(Line," ,();",[OP,Name,Type]),
|
|
Name \= "or_last",
|
|
check_op(OP),
|
|
special(Name,W),
|
|
assert(op(Type,Name)),
|
|
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").
|
|
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").
|
|
|
|
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),
|
|
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(_,_).
|
|
|
|
dump_fields(_,[],"e",_).
|
|
dump_fields(_,[],[],_).
|
|
dump_fields(C,[I-_|Info],[O|Ops],T) :- !,
|
|
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]).
|
|
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).
|
|
|
|
|
|
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").
|
|
get_op(0'F,"ExternalFunction").
|
|
get_op(0'i,"IntegerInCode").
|
|
get_op(0'I,"PtoLUIndex").
|
|
get_op(0'l,"PtoOp").
|
|
get_op(0'L,"PtoLUClause").
|
|
get_op(0'm,"Module").
|
|
get_op(0'n,"Integer").
|
|
get_op(0'o,"Opcode").
|
|
get_op(0'O,"OrArg").
|
|
get_op(0'p,"PtoPred").
|
|
get_op(0's,"Constant").
|
|
get_op(0't,"TabEntry").
|
|
get_op(0'x,"X").
|
|
get_op(0'y,"Y").
|
|
% '
|
|
|
|
dump_ops(_,[]).
|
|
dump_ops(C,[Op|Ops]) :-
|
|
special(Op,C),
|
|
format(C,' case _~s:~n',[Op]),
|
|
end_special(Op,C),
|
|
dump_ops(C,Ops).
|
|
|
|
output_walk_clause(L) :-
|
|
setof(T,O^op(T,O),Types),
|
|
member(T, Types),
|
|
output_walk_type(T, L),
|
|
fail.
|
|
output_walk_clause(_).
|
|
|
|
%
|
|
% Walk the absmi code looking for the current predicate,
|
|
% the current beginning and the current end of the clause.
|
|
% This goes by skipping ops until we find a op which knows where the
|
|
% clause starts. Usually this is Ystop.
|
|
% We also take pains to stop and check if we find out the current predicate.
|
|
% Some instructions know it.
|
|
%
|
|
% Most instructions should not care less about what happens here!
|
|
%
|
|
|
|
output_walk_type(T, C) :-
|
|
format(C,' /* instructions type ~s */~n',[T]),
|
|
setof(Op,op(T,Op),Ops0),
|
|
split_ops(Ops0,Ops1,Ops2),
|
|
( split_ops1(T, Ops1, Ops) ; Ops2 = Ops ),
|
|
Ops = [_|_],
|
|
dump_ops(C,Ops),
|
|
output_walk(C,T,Ops).
|
|
|
|
% separate a special group for meta-calls
|
|
split_ops([],[],[]).
|
|
split_ops([Op|Ops0],[Op|Ops1],Ops2) :-
|
|
special_walk_op(Op), !,
|
|
split_ops(Ops0,Ops1,Ops2).
|
|
split_ops([Op|Ops0],Ops1,[Op|Ops2]) :-
|
|
split_ops(Ops0,Ops1,Ops2).
|
|
|
|
split_ops1("e", Ops, [M]) :- !,
|
|
member(M, Ops).
|
|
split_ops1(_, Ops, Ops).
|
|
|
|
% instructions which require special treatment, relative to
|
|
% other instructions with the same type
|
|
special_walk_op("p_execute").
|
|
special_walk_op("p_execute2").
|
|
special_walk_op("p_execute_tail").
|
|
special_walk_op("procceed").
|
|
special_walk_op("lock_lu").
|
|
special_walk_op("Nstop").
|
|
special_walk_op("Ystop").
|
|
special_walk_op("expand_index").
|
|
special_walk_op("undef_p").
|
|
special_walk_op("spy_pred").
|
|
special_walk_op("index_pred").
|
|
special_walk_op("lock_pred").
|
|
special_walk_op("op_fail").
|
|
special_walk_op("trust_fail").
|
|
special_walk_op("unify_idb_term").
|
|
special_walk_op("copy_idb_term").
|
|
|
|
|
|
output_walk(C,"Ills",_) :- !,
|
|
format(C,' return walk_got_lu_block(pc->u.Ills.I, startp, endp);~n',[]).
|
|
output_walk(C,"L",_) :- !,
|
|
format(C,' return walk_got_lu_clause(pc->u.L.ClBase, startp, endp);~n',[]).
|
|
output_walk(C,"OtILl",_) :- !,
|
|
format(C,' return walk_got_lu_block(pc->u.OtILl.block, startp, endp);~n',[]).
|
|
output_walk(C,"OtaLl",_) :- !, % do a jump here
|
|
format(C,' pc = pc->u.OtaLl.n;~n',[]).
|
|
output_walk(C,"Osblp",_) :- !,
|
|
label_in_clause(C,"Osblp","p0").
|
|
output_walk(C,"Osbpp",[Op|_]) :-
|
|
special_walk_op(Op), !,
|
|
walk_to_meta_call(C).
|
|
output_walk(C,"Osbpp",_) :- !,
|
|
label_in_clause(C,"Osbpp","p0").
|
|
output_walk(C,"pp",_) :- !,
|
|
label_in_clause(C,"pp","p0").
|
|
output_walk(C,"OtapFs",_) :- !,
|
|
label_in_clause(C,"OtapFs","p").
|
|
output_walk(C,"p",[Op|_]) :-
|
|
special_walk_op(Op), !,
|
|
add_pp(C,"p","p"),
|
|
format(C,' break;~n',[]).
|
|
output_walk(C,"e",[Op|Ops]) :-
|
|
special_walk_op(Op), !, % Nstop and friends
|
|
output_ewalks(C,[Op|Ops]).
|
|
output_walk(C,"sssllp",[Op|Ops]) :-
|
|
format(C,' return found_expand_index(pc, startp, endp, codeptr);~n',[]),
|
|
output_ewalks(C,[Op|Ops]).
|
|
output_walk(C,"l",[Op|_]) :-
|
|
special_walk_op(Op), !, % IDB
|
|
format(C,' return found_ystop(pc, clause_code, startp, endp, pp);~n',[]).
|
|
output_walk(C,T,_) :-
|
|
format(C,' pc = NEXTOP(pc,~s);
|
|
break;~n',[T]).
|
|
|
|
% There are so many weird empty instructions that we process
|
|
% each one separately.
|
|
output_ewalks(C,["Nstop"|Ops]) :-
|
|
format(C,' return NULL;~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["unify_idb_term"|Ops]) :-
|
|
format(C,' return found_idb_clause(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["copy_idb_term"|Ops]) :-
|
|
format(C,' return found_idb_clause(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["expand_index"|Ops]) :-
|
|
format(C,' return found_expand_index(pc, startp, endp, codeptr);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["undef_p"|Ops]) :-
|
|
format(C,' return found_owner_op(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["spy_pred"|Ops]) :-
|
|
format(C,' return found_owner_op(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["index_pred"|Ops]) :-
|
|
format(C,' return found_owner_op(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["lock_pred"|Ops]) :-
|
|
format(C,' return found_owner_op(pc, startp, endp);~n',[]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["op_fail"|Ops]) :-
|
|
format(C,' if (codeptr == FAILCODE)
|
|
return found_fail(pc, startp, endp);~n',[]),
|
|
format(C,' pc = NEXTOP(pc,~s);
|
|
break;~n',["e"]),
|
|
output_ewalks(C,Ops).
|
|
output_ewalks(C,["trust_fail"|Ops]) :-
|
|
format(C,' if (codeptr == TRUSTFAILCODE)
|
|
return found_fail(pc, startp, endp);~n',[]),
|
|
format(C,' pc = NEXTOP(pc,~s);
|
|
break;~n',["e"]),
|
|
output_ewalks(C,Ops).
|
|
|
|
label_in_clause(C,Type,Field) :-
|
|
format(C,' clause_code = TRUE;~n',[]),
|
|
format(C,' pp = pc->u.~s.~s;~n',[Type,Field]),
|
|
format(C,' pc = NEXTOP(pc,~s);
|
|
break;~n',[Type]).
|
|
|
|
add_pp(C,Type,Field) :-
|
|
format(C,' pp = pc->u.~s.~s;~n',[Type,Field]),
|
|
format(C,' if (pp->PredFlags & MegaClausePredFlag)~n',[]),
|
|
format(C,' return found_mega_clause(pp, startp, endp);~n',[]),
|
|
format(C,' clause_code = TRUE;~n',[]),
|
|
format(C,' pc = NEXTOP(pc,~s);~n',[Type]).
|
|
|
|
walk_to_meta_call(C) :-
|
|
format(C,' return found_meta_call(startp, endp);~n',[]).
|
|
|
|
/* 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',[]).
|
|
|
|
|
|
footer_rclause(W) :-
|
|
format(W,' /* this instruction is hardwired */~n',[]),
|
|
dump_ops(W,["or_last"]),
|
|
format(W,'#ifdef YAPOR~n',[]),
|
|
output_typeinfo(W,"Osblp"),
|
|
format(W,'#else~n',[]),
|
|
output_typeinfo(W,"p"),
|
|
format(W,'#endif~n',[]),
|
|
format(W,' }
|
|
} while (TRUE);
|
|
}
|
|
',[]).
|
|
|
|
footer_walk_clause(W) :-
|
|
format(W,' /* this instruction is hardwired */~n',[]),
|
|
dump_ops(W,["or_last"]),
|
|
format(W,'#ifdef YAPOR~n',[]),
|
|
add_pp(W,"Osblp","p"),
|
|
format(W,'#else~n',[]),
|
|
add_pp(W,"p","p"),
|
|
format(W,'#endif~n',[]),
|
|
format(W,' }
|
|
}
|
|
',[]).
|
|
|
|
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).
|