moe changes to support atomic generation of atoms

support automatic generation of code walker (to find P's predicate and clause)
This commit is contained in:
Vitor Santos Costa 2008-12-24 09:04:44 +00:00
parent f679f21a71
commit b1cf60cafb
14 changed files with 1157 additions and 774 deletions

View File

@ -837,7 +837,7 @@ static Int
p_swi_all_atts(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
Functor attf = Yap_MkFunctor(AtomAtt1,3);
Functor attf = FunctorAtt1;
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
@ -962,7 +962,7 @@ p_is_attvar(void)
static Int
p_attvar_bound(void)
{
return FALSE;
b return FALSE;
}
#endif /* COROUTINING */

849
C/cdmgr.c
View File

@ -3736,6 +3736,129 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari
return -1;
}
/* intruction blocks we found ourselves at */
static PredEntry *
walk_got_lu_block(LogUpdIndex *cl, CODEADDR *startp, CODEADDR *endp)
{
PredEntry *pp = cl->ClPred;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return pp;
}
/* intruction blocks we found ourselves at */
static PredEntry *
walk_got_lu_clause(LogUpdClause *cl, CODEADDR *startp, CODEADDR *endp)
{
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return cl->ClPred;
}
/* we hit a meta-call, so we don't know what is happening */
static PredEntry *
found_meta_call(CODEADDR *startp, CODEADDR *endp)
{
PredEntry *pp = RepPredProp(Yap_GetPredPropByFunc(FunctorCall, CurrentModule));
*startp = (CODEADDR)&(pp->OpcodeOfPred);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e);
return pp;
}
/* we hit a mega-clause, no point in going on */
static PredEntry *
found_mega_clause(PredEntry *pp, CODEADDR *startp, CODEADDR *endp)
{
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
*startp = (CODEADDR)mcl;
*endp = (CODEADDR)mcl+mcl->ClSize;
return pp;
}
/* we hit a mega-clause, no point in going on */
static PredEntry *
found_idb_clause(yamop *pc, CODEADDR *startp, CODEADDR *endp)
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return cl->ClPred;
}
/* we hit a expand_index, no point in going on */
static PredEntry *
found_expand_index(yamop *pc, CODEADDR *startp, CODEADDR *endp, yamop *codeptr)
{
PredEntry *pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
if (pc == codeptr) {
*startp = (CODEADDR)&(pp->cs.p_code.ExpandCode);
*endp = (CODEADDR)&(pp->cs.p_code.ExpandCode);
}
return pp;
}
/* we hit a expand_index, no point in going on */
static PredEntry *
found_fail(yamop *pc, CODEADDR *startp, CODEADDR *endp)
{
PredEntry *pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule));
*startp = *endp = (CODEADDR)FAILCODE;
return pp;
}
/* we hit a expand_index, no point in going on */
static PredEntry *
found_owner_op(yamop *pc, CODEADDR *startp, CODEADDR *endp)
{
PredEntry *pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))));
*startp = (CODEADDR)&(pp->OpcodeOfPred);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e);
return pp;
}
static PredEntry *
found_ystop(yamop *pc, int clause_code, CODEADDR *startp, CODEADDR *endp, PredEntry *pp)
{
if (pc == YESCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,CurrentModule));
*startp = (CODEADDR)YESCODE;
*endp = (CODEADDR)YESCODE+(CELL)(NEXTOP((yamop *)NULL,e));
return pp;
}
if (!pp) {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->u.l.l;
pp = pep[-1];
}
if (pp->PredFlags & LogUpdatePredFlag) {
if (clause_code) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
}
} else if (pp->PredFlags & DynamicPredFlag) {
DynamicClause *cl = ClauseCodeToDynamicClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
if (clause_code) {
StaticClause *cl = ClauseCodeToStaticClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
StaticIndex *cl = ClauseCodeToStaticIndex(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
}
}
return pp;
}
static PredEntry *
ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
yamop *pc;
@ -3750,731 +3873,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
return pp;
}
pc = codeptr;
while (TRUE) {
op_numbers op;
op = Yap_op_from_opcode(pc->opc);
/* C-code, maybe indexing */
switch (op) {
case _Nstop:
return NULL;
case _Ystop:
if (pc == YESCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,CurrentModule));
*startp = (CODEADDR)YESCODE;
*endp = (CODEADDR)YESCODE+(CELL)(NEXTOP((yamop *)NULL,e));
return pp;
}
if (!pp) {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->u.l.l;
pp = pep[-1];
}
if (pp->PredFlags & LogUpdatePredFlag) {
if (clause_code) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
}
} else if (pp->PredFlags & DynamicPredFlag) {
DynamicClause *cl = ClauseCodeToDynamicClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
if (clause_code) {
StaticClause *cl = ClauseCodeToStaticClause(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
} else {
StaticIndex *cl = ClauseCodeToStaticIndex(pc->u.l.l);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
}
}
return pp;
/* instructions type ld */
case _try_me:
case _retry_me:
case _trust_me:
case _profiled_retry_me:
case _profiled_trust_me:
case _count_retry_me:
case _count_trust_me:
case _spy_or_trymark:
case _try_and_mark:
case _profiled_retry_and_mark:
case _count_retry_and_mark:
case _retry_and_mark:
case _try_clause:
case _retry:
case _trust:
#ifdef YAPOR
case _getwork:
case _getwork_seq:
case _sync:
#endif
#ifdef TABLING
case _table_load_answer:
case _table_try_answer:
case _table_try_single:
case _table_try_me:
case _table_retry_me:
case _table_trust_me:
case _table_try:
case _table_retry:
case _table_trust:
case _table_answer_resolution:
case _table_completion:
#endif /* TABLING */
pc = NEXTOP(pc, Otapl);
break;
case _try_logical:
case _retry_logical:
case _count_retry_logical:
case _profiled_retry_logical:
pc = pc->u.OtaLl.n;
break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
{
LogUpdIndex *cl = pc->u.OtILl.block;
pp = cl->ClPred;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return pp;
}
case _enter_lu_pred:
{
LogUpdIndex *cl = pc->u.Ills.I;
pp = cl->ClPred;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return pp;
}
/* instructions type p */
case _count_call:
case _count_retry:
case _enter_profiling:
case _retry_profiled:
pc = NEXTOP(pc,p);
break;
#if !defined(YAPOR)
case _or_last:
#endif
case _procceed:
case _lock_lu:
pp = pc->u.p.p;
if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
*startp = (CODEADDR)mcl;
*endp = (CODEADDR)mcl+mcl->ClSize;
return pp;
}
clause_code = TRUE;
pc = NEXTOP(pc,p);
break;
case _execute:
case _dexecute:
case _execute_cpred:
clause_code = TRUE;
pp = pc->u.pp.p0;
pc = NEXTOP(pc,pp);
break;
case _jump:
case _move_back:
case _skip:
case _jump_if_var:
case _try_in:
case _try_clause2:
case _try_clause3:
case _try_clause4:
case _retry2:
case _retry3:
case _retry4:
case _p_eq:
case _p_dif:
pc = NEXTOP(pc,l);
break;
/* instructions type EC */
case _jump_if_nonvar:
pc = NEXTOP(pc,xll);
break;
/* instructions type EC */
case _alloc_for_logical_pred:
{
LogUpdClause *cl = pc->u.L.ClBase;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return cl->ClPred;
}
/* instructions type e */
case _unify_idb_term:
case _copy_idb_term:
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc);
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return cl->ClPred;
}
case _deallocate:
pc = NEXTOP(pc,p);
break;
case _cut:
case _cut_t:
case _cut_e:
case _allocate:
case _write_void:
case _write_list:
case _write_l_list:
case _pop:
#ifdef BEAM
case _retry_eam:
#endif
#if THREADS
case _thread_local:
#endif
case _p_equal:
case _p_functor:
case _enter_a_profiling:
case _count_a_call:
case _index_dbref:
case _index_blob:
case _unlock_lu:
#ifdef YAPOR
case _getwork_first_time:
#endif
#ifdef TABLING
case _trie_do_null:
case _trie_trust_null:
case _trie_try_null:
case _trie_retry_null:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
case _trie_retry_var:
case _trie_do_val:
case _trie_trust_val:
case _trie_try_val:
case _trie_retry_val:
case _trie_do_atom:
case _trie_trust_atom:
case _trie_try_atom:
case _trie_retry_atom:
case _trie_do_list:
case _trie_trust_list:
case _trie_try_list:
case _trie_retry_list:
case _trie_do_struct:
case _trie_trust_struct:
case _trie_try_struct:
case _trie_retry_struct:
case _trie_do_extension:
case _trie_trust_extension:
case _trie_try_extension:
case _trie_retry_extension:
case _trie_do_float:
case _trie_trust_float:
case _trie_try_float:
case _trie_retry_float:
case _trie_do_long:
case _trie_trust_long:
case _trie_try_long:
case _trie_retry_long:
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
case _clause_with_cut:
#endif /* TABLING_INNER_CUTS */
pc = NEXTOP(pc,e);
break;
/* instructions type xp */
case _commit_b_x:
pc = NEXTOP(pc,xp);
break;
/* instructions type x */
case _save_b_x:
case _get_list:
case _put_list:
case _write_x_var:
case _write_x_val:
case _write_x_loc:
pc = NEXTOP(pc,x);
break;
/* instructions type xl */
case _p_atom_x:
case _p_atomic_x:
case _p_integer_x:
case _p_nonvar_x:
case _p_number_x:
case _p_var_x:
case _p_db_ref_x:
case _p_primitive_x:
case _p_compound_x:
case _p_float_x:
case _p_cut_by_x:
pc = NEXTOP(pc,xl);
break;
/* instructions type yp */
case _commit_b_y:
pc = NEXTOP(pc,yp);
break;
/* instructions type y */
case _save_b_y:
case _write_y_var:
case _write_y_val:
case _write_y_loc:
pc = NEXTOP(pc,y);
break;
/* instructions type yl */
case _p_atom_y:
case _p_atomic_y:
case _p_integer_y:
case _p_nonvar_y:
case _p_number_y:
case _p_var_y:
case _p_db_ref_y:
case _p_primitive_y:
case _p_compound_y:
case _p_float_y:
case _p_cut_by_y:
pc = NEXTOP(pc,yl);
break;
/* instructions type Osbpp or Osbmp */
case _p_execute_tail:
case _p_execute:
case _p_execute2:
clause_code = TRUE;
pp = RepPredProp(Yap_GetPredPropByFunc(FunctorCall, CurrentModule));
*startp = (CODEADDR)&(pp->OpcodeOfPred);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e);
return pp;
case _fcall:
case _call:
#ifdef YAPOR
case _or_last:
#endif
clause_code = TRUE;
pp = pc->u.Osbpp.p;
pc = NEXTOP(pc,Osbpp);
break;
/* instructions type Osbpp, but for disjunctions */
case _either:
case _or_else:
clause_code = TRUE;
pp = pc->u.Osblp.p0;
pc = NEXTOP(pc,Osblp);
break;
case _call_cpred:
case _call_usercpred:
clause_code = TRUE;
pp = pc->u.Osbpp.p0;
pc = NEXTOP(pc,Osbpp);
break;
/* instructions type xx */
case _get_x_var:
case _get_x_val:
case _glist_valx:
case _gl_void_varx:
case _gl_void_valx:
case _put_x_var:
case _put_x_val:
pc = NEXTOP(pc,xx);
break;
case _put_xx_val:
pc = NEXTOP(pc,xxxx);
break;
/* instructions type yx */
case _get_y_var:
case _get_y_val:
case _put_y_var:
case _put_y_val:
case _put_unsafe:
pc = NEXTOP(pc,yx);
break;
/* instructions type xd */
case _get_float:
case _put_float:
pc = NEXTOP(pc,xd);
break;
/* instructions type xi */
case _get_longint:
case _put_longint:
pc = NEXTOP(pc,xi);
break;
/* instructions type xc */
case _get_atom:
case _put_atom:
case _get_bigint:
case _get_dbterm:
pc = NEXTOP(pc,xc);
break;
/* instructions type cc */
case _get_2atoms:
pc = NEXTOP(pc,cc);
break;
/* instructions type ccc */
case _get_3atoms:
pc = NEXTOP(pc,ccc);
break;
/* instructions type cccc */
case _get_4atoms:
pc = NEXTOP(pc,cccc);
break;
/* instructions type ccccc */
case _get_5atoms:
pc = NEXTOP(pc,ccccc);
break;
/* instructions type cccccc */
case _get_6atoms:
pc = NEXTOP(pc,cccccc);
break;
/* instructions type xfa */
case _get_struct:
case _put_struct:
pc = NEXTOP(pc,xfa);
break;
/* instructions type xy */
case _glist_valy:
case _gl_void_vary:
case _gl_void_valy:
pc = NEXTOP(pc,xy);
break;
/* instructions type ox */
case _unify_x_var:
case _unify_x_var_write:
case _unify_l_x_var:
case _unify_l_x_var_write:
case _unify_x_val_write:
case _unify_x_val:
case _unify_l_x_val_write:
case _unify_l_x_val:
case _unify_x_loc_write:
case _unify_x_loc:
case _unify_l_x_loc_write:
case _unify_l_x_loc:
case _save_pair_x_write:
case _save_pair_x:
case _save_appl_x_write:
case _save_appl_x:
pc = NEXTOP(pc,ox);
break;
/* instructions type oxx */
case _unify_x_var2:
case _unify_x_var2_write:
case _unify_l_x_var2:
case _unify_l_x_var2_write:
pc = NEXTOP(pc,oxx);
break;
/* instructions type oy */
case _unify_y_var:
case _unify_y_var_write:
case _unify_l_y_var:
case _unify_l_y_var_write:
case _unify_y_val_write:
case _unify_y_val:
case _unify_l_y_val_write:
case _unify_l_y_val:
case _unify_y_loc_write:
case _unify_y_loc:
case _unify_l_y_loc_write:
case _unify_l_y_loc:
case _save_pair_y_write:
case _save_pair_y:
case _save_appl_y_write:
case _save_appl_y:
pc = NEXTOP(pc,oy);
break;
/* instructions type o */
case _unify_void_write:
case _unify_void:
case _unify_l_void_write:
case _unify_l_void:
case _unify_list_write:
case _unify_list:
case _unify_l_list_write:
case _unify_l_list:
pc = NEXTOP(pc,o);
break;
/* instructions type os */
case _unify_n_voids_write:
case _unify_n_voids:
case _unify_l_n_voids_write:
case _unify_l_n_voids:
pc = NEXTOP(pc,os);
break;
/* instructions type od */
case _unify_float:
case _unify_l_float:
case _unify_float_write:
case _unify_l_float_write:
pc = NEXTOP(pc,od);
break;
case _unify_longint:
case _unify_l_longint:
case _unify_longint_write:
case _unify_l_longint_write:
pc = NEXTOP(pc,oi);
break;
/* instructions type oc */
case _unify_atom_write:
case _unify_atom:
case _unify_l_atom_write:
case _unify_l_atom:
case _unify_bigint:
case _unify_l_bigint:
case _unify_dbterm:
case _unify_l_dbterm:
pc = NEXTOP(pc,oc);
break;
/* instructions type osc */
case _unify_n_atoms_write:
case _unify_n_atoms:
pc = NEXTOP(pc,osc);
break;
/* instructions type of */
case _unify_struct_write:
case _unify_struct:
case _unify_l_struc_write:
case _unify_l_struc:
pc = NEXTOP(pc,ofa);
break;
/* instructions type s */
case _write_n_voids:
case _pop_n:
#ifdef BEAM
case _run_eam:
#endif
#ifdef TABLING
case _table_new_answer:
#endif /* TABLING */
pc = NEXTOP(pc,s);
break;
/* instructions type c */
case _write_atom:
pc = NEXTOP(pc,c);
break;
/* instructions type d */
case _write_float:
pc = NEXTOP(pc,d);
break;
/* instructions type i */
case _write_longint:
pc = NEXTOP(pc,i);
break;
/* instructions type sc */
case _write_n_atoms:
pc = NEXTOP(pc,sc);
break;
/* instructions type f */
case _write_struct:
case _write_l_struc:
pc = NEXTOP(pc,fa);
break;
/* instructions type slp */
case _call_c_wfail:
clause_code = TRUE;
pp = pc->u.slp.p;
pc = NEXTOP(pc,slp);
break;
/* instructions type OtapFs */
case _try_c:
case _try_userc:
case _retry_c:
case _retry_userc:
clause_code = TRUE;
pp = pc->u.OtapFs.p;
pc = NEXTOP(pc,OtapFs);
break;
#ifdef CUT_C
case _cut_c:
case _cut_userc:
/* don't need to do nothing here, because this two instructions
are "phantom" instructions. (see: cut_c implementation paper
on PADL 2006) */
break;
#endif
/* instructions type llll */
case _switch_on_type:
pc = NEXTOP(pc,llll);
break;
/* instructions type ollll */
case _switch_list_nl:
pc = NEXTOP(pc,ollll);
break;
/* instructions type xllll */
case _switch_on_arg_type:
pc = NEXTOP(pc,xllll);
break;
/* instructions type sllll */
case _switch_on_sub_arg_type:
pc = NEXTOP(pc,sllll);
break;
/* instructions type clll */
case _if_not_then:
pc = NEXTOP(pc,clll);
break;
/* switch_on_func */
case _switch_on_func:
case _switch_on_cons:
case _go_on_func:
case _go_on_cons:
case _if_func:
case _if_cons:
pc = NEXTOP(pc,sssl);
break;
/* instructions type xxx */
case _p_plus_vv:
case _p_minus_vv:
case _p_times_vv:
case _p_div_vv:
case _p_and_vv:
case _p_or_vv:
case _p_sll_vv:
case _p_slr_vv:
case _p_arg_vv:
case _p_func2s_vv:
case _p_func2f_xx:
clause_code = TRUE;
pc = NEXTOP(pc,xxx);
break;
/* instructions type xxn */
case _p_plus_vc:
case _p_minus_cv:
case _p_times_vc:
case _p_div_cv:
case _p_and_vc:
case _p_or_vc:
case _p_sll_vc:
case _p_slr_vc:
case _p_func2s_vc:
clause_code = TRUE;
pc = NEXTOP(pc,xxn);
break;
case _p_div_vc:
case _p_sll_cv:
case _p_slr_cv:
case _p_arg_cv:
clause_code = TRUE;
pc = NEXTOP(pc,xxn);
break;
case _p_func2s_cv:
clause_code = TRUE;
pc = NEXTOP(pc,xxn);
break;
/* instructions type xxy */
case _p_func2f_xy:
clause_code = TRUE;
pc = NEXTOP(pc,xxy);
break;
/* instructions type yxx */
case _p_plus_y_vv:
case _p_minus_y_vv:
case _p_times_y_vv:
case _p_div_y_vv:
case _p_and_y_vv:
case _p_or_y_vv:
case _p_sll_y_vv:
case _p_slr_y_vv:
case _p_arg_y_vv:
case _p_func2s_y_vv:
case _p_func2f_yx:
clause_code = TRUE;
pc = NEXTOP(pc,yxx);
break;
/* instructions type yyx */
case _p_func2f_yy:
clause_code = TRUE;
pc = NEXTOP(pc,yyx);
break;
/* instructions type yxn */
case _p_plus_y_vc:
case _p_minus_y_cv:
case _p_times_y_vc:
case _p_div_y_vc:
case _p_div_y_cv:
case _p_and_y_vc:
case _p_or_y_vc:
case _p_sll_y_vc:
case _p_slr_y_vc:
case _p_func2s_y_vc:
clause_code = TRUE;
pc = NEXTOP(pc,yxn);
break;
/* instructions type yxn */
case _p_sll_y_cv:
case _p_slr_y_cv:
case _p_arg_y_cv:
clause_code = TRUE;
pc = NEXTOP(pc,yxn);
break;
/* instructions type yxn */
case _p_func2s_y_cv:
clause_code = TRUE;
pc = NEXTOP(pc,yxn);
break;
/* instructions type plxxs */
case _call_bfunc_xx:
clause_code = TRUE;
pc = NEXTOP(pc,plxxs);
break;
/* instructions type plxys */
case _call_bfunc_yx:
case _call_bfunc_xy:
clause_code = TRUE;
pc = NEXTOP(pc,plxys);
break;
/* instructions type plyys */
case _call_bfunc_yy:
clause_code = TRUE;
pc = NEXTOP(pc,plyys);
break;
case _expand_index:
pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
if (pc == codeptr) {
*startp = (CODEADDR)&(pp->cs.p_code.ExpandCode);
*endp = (CODEADDR)&(pp->cs.p_code.ExpandCode);
}
return pp;
case _undef_p:
case _spy_pred:
case _index_pred:
case _lock_pred:
pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))));
*startp = (CODEADDR)&(pp->OpcodeOfPred);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e);
return pp;
case _expand_clauses:
/* expansion points may not be found when following the indices tree */
pp = codeptr->u.sssllp.p;
if (pc == codeptr) {
*startp = (CODEADDR)codeptr;
*endp = (CODEADDR)NEXTOP(codeptr,sssllp);
}
return pp;
case _op_fail:
if (codeptr == FAILCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule));
*startp = *endp = (CODEADDR)FAILCODE;
return pp;
}
pc = NEXTOP(pc,e);
break;
case _trust_fail:
if (codeptr == TRUSTFAILCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule));
*startp = *endp = (CODEADDR)TRUSTFAILCODE;
return pp;
}
pc = NEXTOP(pc,e);
break;
}
}
#include "walkclause.h"
return NULL;
}

View File

@ -805,7 +805,7 @@ p_execute_0(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,2), mod);
pe = PredPropByFunc(FunctorDot2, mod);
ptr = RepPair(t);
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
@ -850,7 +850,7 @@ p_execute_1(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,3), mod);
pe = PredPropByFunc(FunctorDot3, mod);
ptr = RepPair(t);
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
@ -894,7 +894,7 @@ p_execute_2(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,4), mod);
pe = PredPropByFunc(FunctorDot4, mod);
ptr = RepPair(t);
XREGS[4] = ARG3;
XREGS[3] = ARG2;
@ -941,7 +941,7 @@ p_execute_3(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,5), mod);
pe = PredPropByFunc(FunctorDot5, mod);
ptr = RepPair(t);
XREGS[5] = ARG4;
XREGS[4] = ARG3;
@ -991,7 +991,7 @@ p_execute_4(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,6), mod);
pe = PredPropByFunc(FunctorDot6, mod);
ptr = RepPair(t);
XREGS[6] = ARG5;
XREGS[5] = ARG4;
@ -1044,7 +1044,7 @@ p_execute_5(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,7), mod);
pe = PredPropByFunc(FunctorDot7, mod);
ptr = RepPair(t);
XREGS[7] = ARG6;
XREGS[6] = ARG5;
@ -1100,7 +1100,7 @@ p_execute_6(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,8), mod);
pe = PredPropByFunc(FunctorDot8, mod);
ptr = RepPair(t);
XREGS[8] = ARG7;
XREGS[7] = ARG6;
@ -1159,7 +1159,7 @@ p_execute_7(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,9), mod);
pe = PredPropByFunc(FunctorDot9, mod);
ptr = RepPair(t);
XREGS[9] = ARG8;
XREGS[8] = ARG7;
@ -1221,7 +1221,7 @@ p_execute_8(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,10), mod);
pe = PredPropByFunc(FunctorDot10, mod);
ptr = RepPair(t);
XREGS[10] = ARG9;
XREGS[9] = ARG8;
@ -1286,7 +1286,7 @@ p_execute_9(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,11), mod);
pe = PredPropByFunc(FunctorDot11, mod);
ptr = RepPair(t);
XREGS[11] = ARG10;
XREGS[10] = ARG9;
@ -1354,7 +1354,7 @@ p_execute_10(void)
} else {
CELL *ptr;
pe = PredPropByFunc(Yap_MkFunctor(AtomDot,12), mod);
pe = PredPropByFunc(FunctorDot12, mod);
ptr = RepPair(t);
XREGS[12] = ARG11;
XREGS[11] = ARG10;

View File

@ -3722,7 +3722,7 @@ syntax_error (TokEntry * tokptr, int sno)
} else if (tokptr->Tok != Ord (Error_tok)) {
ts[1] = MkIntegerTerm(tokptr->TokPos);
*error =
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomMinus,2),2,ts),TermNil);
MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
@ -3741,7 +3741,7 @@ syntax_error (TokEntry * tokptr, int sno)
tf[4] = MkIntegerTerm(out);
tf[5] = MkIntegerTerm(err);
tf[6] = StreamName(sno);
return(Yap_MkApplTerm(Yap_MkFunctor(AtomSyntaxError,7),7,tf));
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
Int

View File

@ -405,7 +405,7 @@ p_ksort(void)
/* reserve the necessary space */
pt = H; /* because of possible garbage collection */
H += size*2;
if (!key_mergesort(pt, size, M_EVEN, Yap_MkFunctor(AtomMinus,2)))
if (!key_mergesort(pt, size, M_EVEN, FunctorMinus))
return(FALSE);
adjust_vector(pt, size);
out = AbsPair(pt);

View File

@ -1889,7 +1889,7 @@ gen_syntax_error(Atom InpAtom, char *s)
ts[2] = MkAtomTerm(AtomExpectedNumber);
ts[3] = TermNil;
ts[6] = MkAtomTerm(InpAtom);
return(Yap_MkApplTerm(Yap_MkFunctor(AtomSyntaxError,7),7,ts));
return(Yap_MkApplTerm(FunctorSyntaxError,7,ts));
}
static Int
@ -3585,9 +3585,9 @@ p_set_yap_flags(void)
if (value < 0 || value > 2)
return(FALSE);
if (value == 1) {
Yap_heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomMetaCall,4),0));
Yap_heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(FunctorMetaCall,0));
} else {
Yap_heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomMetaCall,4),0));
Yap_heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(FunctorMetaCall,0));
}
yap_flags[LANGUAGE_MODE_FLAG] = value;
break;

View File

@ -336,7 +336,7 @@
OPCODE(a_and ,sss),
OPCODE(xor_c ,ssn),
OPCODE(xor ,sss),
OPCODE(uminus ,ss),
OPCODE(uminus ,sss),
OPCODE(sl_c1 ,ssn),
OPCODE(sl_c2 ,ssn),
OPCODE(sl ,sss),
@ -349,12 +349,12 @@
OPCODE(put_i_val_y ,syll),
OPCODE(put_f_val_x ,sxll),
OPCODE(put_f_val_y ,syll),
OPCODE(put_fi_var_x ,sxll),
OPCODE(put_fi_var_y ,syll),
OPCODE(put_i_var_x ,sxll),
OPCODE(put_i_var_y ,syll),
OPCODE(put_f_var_x ,sxll),
OPCODE(put_f_var_y ,syll),
OPCODE(put_fi_var_x ,sxl),
OPCODE(put_fi_var_y ,syl),
OPCODE(put_i_var_x ,sxl),
OPCODE(put_i_var_y ,syl),
OPCODE(put_f_var_x ,sxl),
OPCODE(put_f_var_y ,syl),
OPCODE(p_equal ,e),
OPCODE(p_dif ,l),
OPCODE(p_eq ,l),

View File

@ -285,6 +285,7 @@
FunctorAssert = Yap_MkFunctor(AtomAssert,2);
FunctorAtFoundOne = Yap_MkFunctor(AtomFoundVar,2);
FunctorAtom = Yap_MkFunctor(AtomAtom,1);
FunctorAtt1 = Yap_MkFunctor(AtomAtt1,3);
FunctorAttGoal = Yap_MkFunctor(AtomAttDo,2);
FunctorBraces = Yap_MkFunctor(AtomBraces,1);
FunctorCall = Yap_MkFunctor(AtomCall,1);
@ -304,6 +305,17 @@
FunctorDoStaticClause = Yap_MkFunctor(AtomDoStaticClause,5);
FunctorDomainError = Yap_MkFunctor(AtomDomainError,2);
FunctorDot = Yap_MkFunctor(AtomDot,2);
FunctorDot10 = Yap_MkFunctor(AtomDot,10);
FunctorDot11 = Yap_MkFunctor(AtomDot,11);
FunctorDot12 = Yap_MkFunctor(AtomDot,12);
FunctorDot2 = Yap_MkFunctor(AtomDot,2);
FunctorDot3 = Yap_MkFunctor(AtomDot,3);
FunctorDot4 = Yap_MkFunctor(AtomDot,4);
FunctorDot5 = Yap_MkFunctor(AtomDot,5);
FunctorDot6 = Yap_MkFunctor(AtomDot,6);
FunctorDot7 = Yap_MkFunctor(AtomDot,7);
FunctorDot8 = Yap_MkFunctor(AtomDot,8);
FunctorDot9 = Yap_MkFunctor(AtomDot,9);
FunctorEq = Yap_MkFunctor(AtomEq,2);
FunctorError = Yap_MkFunctor(AtomError,2);
FunctorEvaluationError = Yap_MkFunctor(AtomEvaluationError,1);
@ -329,6 +341,7 @@
FunctorList = Yap_MkFunctor(AtomDot,2);
FunctorMegaClause = Yap_MkFunctor(AtomMegaClause,2);
FunctorMetaCall = Yap_MkFunctor(AtomMetaCall,4);
FunctorMinus = Yap_MkFunctor(AtomMinus,2);
FunctorModule = Yap_MkFunctor(AtomColomn,2);
FunctorMultiFileClause = Yap_MkFunctor(AtomMfClause,5);
FunctorMutable = Yap_MkFunctor(AtomMutableVariable,(sizeof(timed_var)/sizeof(CELL)));
@ -349,6 +362,7 @@
FunctorStream = Yap_MkFunctor(AtomStream,1);
FunctorStreamEOS = Yap_MkFunctor(AtomEndOfStream,1);
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,5);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7);
FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2);
FunctorThrow = Yap_MkFunctor(AtomThrow,1);
FunctorTypeError = Yap_MkFunctor(AtomTypeError,2);

View File

@ -288,6 +288,7 @@
FunctorAssert = FuncAdjust(FunctorAssert);
FunctorAtFoundOne = FuncAdjust(FunctorAtFoundOne);
FunctorAtom = FuncAdjust(FunctorAtom);
FunctorAtt1 = FuncAdjust(FunctorAtt1);
FunctorAttGoal = FuncAdjust(FunctorAttGoal);
FunctorBraces = FuncAdjust(FunctorBraces);
FunctorCall = FuncAdjust(FunctorCall);
@ -307,6 +308,17 @@
FunctorDoStaticClause = FuncAdjust(FunctorDoStaticClause);
FunctorDomainError = FuncAdjust(FunctorDomainError);
FunctorDot = FuncAdjust(FunctorDot);
FunctorDot10 = FuncAdjust(FunctorDot10);
FunctorDot11 = FuncAdjust(FunctorDot11);
FunctorDot12 = FuncAdjust(FunctorDot12);
FunctorDot2 = FuncAdjust(FunctorDot2);
FunctorDot3 = FuncAdjust(FunctorDot3);
FunctorDot4 = FuncAdjust(FunctorDot4);
FunctorDot5 = FuncAdjust(FunctorDot5);
FunctorDot6 = FuncAdjust(FunctorDot6);
FunctorDot7 = FuncAdjust(FunctorDot7);
FunctorDot8 = FuncAdjust(FunctorDot8);
FunctorDot9 = FuncAdjust(FunctorDot9);
FunctorEq = FuncAdjust(FunctorEq);
FunctorError = FuncAdjust(FunctorError);
FunctorEvaluationError = FuncAdjust(FunctorEvaluationError);
@ -332,6 +344,7 @@
FunctorList = FuncAdjust(FunctorList);
FunctorMegaClause = FuncAdjust(FunctorMegaClause);
FunctorMetaCall = FuncAdjust(FunctorMetaCall);
FunctorMinus = FuncAdjust(FunctorMinus);
FunctorModule = FuncAdjust(FunctorModule);
FunctorMultiFileClause = FuncAdjust(FunctorMultiFileClause);
FunctorMutable = FuncAdjust(FunctorMutable);
@ -352,6 +365,7 @@
FunctorStream = FuncAdjust(FunctorStream);
FunctorStreamEOS = FuncAdjust(FunctorStreamEOS);
FunctorStreamPos = FuncAdjust(FunctorStreamPos);
FunctorSyntaxError = FuncAdjust(FunctorSyntaxError);
FunctorThreadRun = FuncAdjust(FunctorThreadRun);
FunctorThrow = FuncAdjust(FunctorThrow);
FunctorTypeError = FuncAdjust(FunctorTypeError);

View File

@ -485,8 +485,6 @@ restore_opcodes(yamop *pc)
pc->u.snll.T = PtoOpAdjust(pc->u.snll.T);
pc = NEXTOP(pc,snll);
break;
/* instructions type ss */
case _uminus:
/* instructions type ssd */
case _add_float_c:
case _fdiv_c1:
@ -541,6 +539,7 @@ restore_opcodes(yamop *pc)
case _sl:
case _sr:
case _sub:
case _uminus:
case _xor:
pc->u.sss.s0 = ConstantAdjust(pc->u.sss.s0);
pc->u.sss.s1 = ConstantAdjust(pc->u.sss.s1);
@ -575,6 +574,9 @@ restore_opcodes(yamop *pc)
case _get_f_x:
case _get_fi_x:
case _get_i_x:
case _put_f_var_x:
case _put_fi_var_x:
case _put_i_var_x:
pc->u.sxl.s = ConstantAdjust(pc->u.sxl.s);
pc->u.sxl.x = XAdjust(pc->u.sxl.x);
pc->u.sxl.l = PtoOpAdjust(pc->u.sxl.l);
@ -582,11 +584,8 @@ restore_opcodes(yamop *pc)
break;
/* instructions type sxll */
case _put_f_val_x:
case _put_f_var_x:
case _put_fi_val_x:
case _put_fi_var_x:
case _put_i_val_x:
case _put_i_var_x:
pc->u.sxll.s = ConstantAdjust(pc->u.sxll.s);
pc->u.sxll.x = XAdjust(pc->u.sxll.x);
pc->u.sxll.F = PtoOpAdjust(pc->u.sxll.F);
@ -597,6 +596,9 @@ restore_opcodes(yamop *pc)
case _get_f_y:
case _get_fi_y:
case _get_i_y:
case _put_f_var_y:
case _put_fi_var_y:
case _put_i_var_y:
pc->u.syl.s = ConstantAdjust(pc->u.syl.s);
pc->u.syl.y = YAdjust(pc->u.syl.y);
pc->u.syl.l = PtoOpAdjust(pc->u.syl.l);
@ -604,11 +606,8 @@ restore_opcodes(yamop *pc)
break;
/* instructions type syll */
case _put_f_val_y:
case _put_f_var_y:
case _put_fi_val_y:
case _put_fi_var_y:
case _put_i_val_y:
case _put_i_var_y:
pc->u.syll.s = ConstantAdjust(pc->u.syll.s);
pc->u.syll.y = YAdjust(pc->u.syll.y);
pc->u.syll.F = PtoOpAdjust(pc->u.syll.F);

View File

@ -578,6 +578,8 @@
#define FunctorAtFoundOne Yap_heap_regs->FunctorAtFoundOne_
Functor FunctorAtom_;
#define FunctorAtom Yap_heap_regs->FunctorAtom_
Functor FunctorAtt1_;
#define FunctorAtt1 Yap_heap_regs->FunctorAtt1_
Functor FunctorAttGoal_;
#define FunctorAttGoal Yap_heap_regs->FunctorAttGoal_
Functor FunctorBraces_;
@ -616,6 +618,28 @@
#define FunctorDomainError Yap_heap_regs->FunctorDomainError_
Functor FunctorDot_;
#define FunctorDot Yap_heap_regs->FunctorDot_
Functor FunctorDot10_;
#define FunctorDot10 Yap_heap_regs->FunctorDot10_
Functor FunctorDot11_;
#define FunctorDot11 Yap_heap_regs->FunctorDot11_
Functor FunctorDot12_;
#define FunctorDot12 Yap_heap_regs->FunctorDot12_
Functor FunctorDot2_;
#define FunctorDot2 Yap_heap_regs->FunctorDot2_
Functor FunctorDot3_;
#define FunctorDot3 Yap_heap_regs->FunctorDot3_
Functor FunctorDot4_;
#define FunctorDot4 Yap_heap_regs->FunctorDot4_
Functor FunctorDot5_;
#define FunctorDot5 Yap_heap_regs->FunctorDot5_
Functor FunctorDot6_;
#define FunctorDot6 Yap_heap_regs->FunctorDot6_
Functor FunctorDot7_;
#define FunctorDot7 Yap_heap_regs->FunctorDot7_
Functor FunctorDot8_;
#define FunctorDot8 Yap_heap_regs->FunctorDot8_
Functor FunctorDot9_;
#define FunctorDot9 Yap_heap_regs->FunctorDot9_
Functor FunctorEq_;
#define FunctorEq Yap_heap_regs->FunctorEq_
Functor FunctorError_;
@ -666,6 +690,8 @@
#define FunctorMegaClause Yap_heap_regs->FunctorMegaClause_
Functor FunctorMetaCall_;
#define FunctorMetaCall Yap_heap_regs->FunctorMetaCall_
Functor FunctorMinus_;
#define FunctorMinus Yap_heap_regs->FunctorMinus_
Functor FunctorModule_;
#define FunctorModule Yap_heap_regs->FunctorModule_
Functor FunctorMultiFileClause_;
@ -706,6 +732,8 @@
#define FunctorStreamEOS Yap_heap_regs->FunctorStreamEOS_
Functor FunctorStreamPos_;
#define FunctorStreamPos Yap_heap_regs->FunctorStreamPos_
Functor FunctorSyntaxError_;
#define FunctorSyntaxError Yap_heap_regs->FunctorSyntaxError_
Functor FunctorThreadRun_;
#define FunctorThreadRun Yap_heap_regs->FunctorThreadRun_
Functor FunctorThrow_;

736
H/walkclause.h Normal file
View File

@ -0,0 +1,736 @@
/* This file was generated automatically by "yap -L misc/buildops"
please do not update */
while (TRUE) {
op_numbers op;
op = Yap_op_from_opcode(pc->opc);
/* C-code, maybe indexing */
switch (op) {
/* instructions type Ills */
case _enter_lu_pred:
return walk_got_lu_block(pc->u.Ills.I, startp, endp);
/* instructions type L */
case _alloc_for_logical_pred:
return walk_got_lu_clause(pc->u.L.ClBase, startp, endp);
/* instructions type Osblp */
case _either:
case _or_else:
clause_code = TRUE;
pp = pc->u.Osblp.p0;
pc = NEXTOP(pc,Osblp);
break;
/* instructions type Osbmp */
case _p_execute:
pc = NEXTOP(pc,Osbmp);
break;
/* instructions type Osbpp */
case _p_execute2:
case _p_execute_tail:
return found_meta_call(startp, endp);
case _call:
case _call_cpred:
case _call_usercpred:
case _fcall:
clause_code = TRUE;
pp = pc->u.Osbpp.p0;
pc = NEXTOP(pc,Osbpp);
break;
/* instructions type OtILl */
case _count_trust_logical:
case _profiled_trust_logical:
case _trust_logical:
return walk_got_lu_block(pc->u.OtILl.block, startp, endp);
/* instructions type OtaLl */
case _count_retry_logical:
case _profiled_retry_logical:
case _retry_logical:
case _try_logical:
pc = pc->u.OtaLl.n;
/* instructions type OtapFs */
#ifdef CUT_C
case _cut_c:
#endif
#ifdef CUT_C
case _cut_userc:
#endif
case _retry_c:
case _retry_userc:
case _try_c:
case _try_userc:
clause_code = TRUE;
pp = pc->u.OtapFs.p;
pc = NEXTOP(pc,OtapFs);
break;
/* instructions type Otapl */
case _count_retry_and_mark:
case _count_retry_me:
case _count_trust_me:
case _profiled_retry_and_mark:
case _profiled_retry_me:
case _profiled_trust_me:
case _retry:
case _retry_and_mark:
case _retry_me:
case _spy_or_trymark:
case _trust:
case _trust_me:
case _try_and_mark:
case _try_clause:
case _try_me:
pc = NEXTOP(pc,Otapl);
break;
/* instructions type c */
case _write_atom:
pc = NEXTOP(pc,c);
break;
/* instructions type cc */
case _get_2atoms:
pc = NEXTOP(pc,cc);
break;
/* instructions type ccc */
case _get_3atoms:
pc = NEXTOP(pc,ccc);
break;
/* instructions type cccc */
case _get_4atoms:
pc = NEXTOP(pc,cccc);
break;
/* instructions type ccccc */
case _get_5atoms:
pc = NEXTOP(pc,ccccc);
break;
/* instructions type cccccc */
case _get_6atoms:
pc = NEXTOP(pc,cccccc);
break;
/* instructions type clll */
case _if_not_then:
pc = NEXTOP(pc,clll);
break;
/* instructions type d */
case _write_float:
pc = NEXTOP(pc,d);
break;
/* instructions type e */
case _Nstop:
return NULL;
case _copy_idb_term:
return found_idb_clause(pc, startp, endp);
case _expand_index:
return found_expand_index(pc, startp, endp, codeptr);
case _index_pred:
return found_owner_op(pc, startp, endp);
case _lock_pred:
return found_owner_op(pc, startp, endp);
case _op_fail:
if (codeptr == FAILCODE)
return found_fail(pc, startp, endp);
pc = NEXTOP(pc,e);
break;
case _spy_pred:
return found_owner_op(pc, startp, endp);
case _trust_fail:
if (codeptr == TRUSTFAILCODE)
return found_fail(pc, startp, endp);
pc = NEXTOP(pc,e);
break;
case _undef_p:
return found_owner_op(pc, startp, endp);
case _unify_idb_term:
return found_idb_clause(pc, startp, endp);
case _allocate:
case _count_a_call:
case _cut:
case _cut_e:
case _cut_t:
case _enter_a_profiling:
case _index_blob:
case _index_dbref:
case _p_equal:
case _p_functor:
case _pop:
#ifdef BEAM
case _retry_eam:
#endif
#ifdef THREADS
case _thread_local:
#endif
case _unlock_lu:
case _write_l_list:
case _write_list:
case _write_void:
pc = NEXTOP(pc,e);
break;
/* instructions type fa */
case _write_l_struc:
case _write_struct:
pc = NEXTOP(pc,fa);
break;
/* instructions type i */
case _write_longint:
pc = NEXTOP(pc,i);
break;
/* instructions type l */
case _Ystop:
return found_ystop(pc, clause_code, startp, endp, pp);
case _jump:
case _jump_if_var:
case _move_back:
case _p_dif:
case _p_eq:
case _retry2:
case _retry3:
case _retry4:
case _skip:
case _try_clause2:
case _try_clause3:
case _try_clause4:
case _try_in:
pc = NEXTOP(pc,l);
break;
/* instructions type llll */
case _switch_on_type:
pc = NEXTOP(pc,llll);
break;
/* instructions type o */
case _unify_l_list:
case _unify_l_list_write:
case _unify_l_void:
case _unify_l_void_write:
case _unify_list:
case _unify_list_write:
case _unify_void:
case _unify_void_write:
pc = NEXTOP(pc,o);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_bigint:
case _unify_dbterm:
case _unify_l_atom:
case _unify_l_atom_write:
case _unify_l_bigint:
case _unify_l_dbterm:
pc = NEXTOP(pc,oc);
break;
/* instructions type od */
case _unify_float:
case _unify_float_write:
case _unify_l_float:
case _unify_l_float_write:
pc = NEXTOP(pc,od);
break;
/* instructions type ofa */
case _unify_l_struc:
case _unify_l_struc_write:
case _unify_struct:
case _unify_struct_write:
pc = NEXTOP(pc,ofa);
break;
/* instructions type oi */
case _unify_l_longint:
case _unify_l_longint_write:
case _unify_longint:
case _unify_longint_write:
pc = NEXTOP(pc,oi);
break;
/* instructions type ollll */
case _switch_list_nl:
pc = NEXTOP(pc,ollll);
break;
/* instructions type os */
#ifdef BEAM
case _run_eam:
#endif
case _unify_l_n_voids:
case _unify_l_n_voids_write:
case _unify_n_voids:
case _unify_n_voids_write:
pc = NEXTOP(pc,os);
break;
/* instructions type osc */
case _unify_n_atoms:
case _unify_n_atoms_write:
pc = NEXTOP(pc,osc);
break;
/* instructions type ox */
case _save_appl_x:
case _save_appl_x_write:
case _save_pair_x:
case _save_pair_x_write:
case _unify_l_x_loc:
case _unify_l_x_loc_write:
case _unify_l_x_val:
case _unify_l_x_val_write:
case _unify_l_x_var:
case _unify_l_x_var_write:
case _unify_x_loc:
case _unify_x_loc_write:
case _unify_x_val:
case _unify_x_val_write:
case _unify_x_var:
case _unify_x_var_write:
pc = NEXTOP(pc,ox);
break;
/* instructions type oxx */
case _unify_l_x_var2:
case _unify_l_x_var2_write:
case _unify_x_var2:
case _unify_x_var2_write:
pc = NEXTOP(pc,oxx);
break;
/* instructions type oy */
case _save_appl_y:
case _save_appl_y_write:
case _save_pair_y:
case _save_pair_y_write:
case _unify_l_y_loc:
case _unify_l_y_loc_write:
case _unify_l_y_val:
case _unify_l_y_val_write:
case _unify_l_y_var:
case _unify_l_y_var_write:
case _unify_y_loc:
case _unify_y_loc_write:
case _unify_y_val:
case _unify_y_val_write:
case _unify_y_var:
case _unify_y_var_write:
pc = NEXTOP(pc,oy);
break;
/* instructions type p */
case _lock_lu:
case _procceed:
pp = pc->u.p.p;
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,p);
break;
case _count_call:
case _count_retry:
case _deallocate:
case _enter_profiling:
case _retry_profiled:
pc = NEXTOP(pc,p);
break;
/* instructions type plxxs */
case _call_bfunc_xx:
pc = NEXTOP(pc,plxxs);
break;
/* instructions type plxys */
case _call_bfunc_xy:
case _call_bfunc_yx:
pc = NEXTOP(pc,plxys);
break;
/* instructions type plyys */
case _call_bfunc_yy:
pc = NEXTOP(pc,plyys);
break;
/* instructions type pp */
case _dexecute:
case _execute:
case _execute_cpred:
clause_code = TRUE;
pp = pc->u.pp.p0;
pc = NEXTOP(pc,pp);
break;
/* instructions type s */
case _pop_n:
case _write_n_voids:
pc = NEXTOP(pc,s);
break;
/* instructions type sc */
case _write_n_atoms:
pc = NEXTOP(pc,sc);
break;
/* instructions type sdll */
case _a_eqc_float:
case _gtc_float:
case _ltc_float:
pc = NEXTOP(pc,sdll);
break;
/* instructions type sllll */
case _switch_on_sub_arg_type:
pc = NEXTOP(pc,sllll);
break;
/* instructions type slp */
case _call_c_wfail:
pc = NEXTOP(pc,slp);
break;
/* instructions type snll */
case _a_eqc_int:
case _gtc_int:
case _ltc_int:
pc = NEXTOP(pc,snll);
break;
/* instructions type ssd */
case _add_float_c:
case _fdiv_c1:
case _fdiv_c2:
case _mul_float_c:
case _sub_float_c:
pc = NEXTOP(pc,ssd);
break;
/* instructions type ssll */
case _a_eq:
case _lt:
pc = NEXTOP(pc,ssll);
break;
/* instructions type ssn */
case _a_and_c:
case _a_or_c:
case _add_int_c:
case _idiv_c1:
case _idiv_c2:
case _mod_c1:
case _mod_c2:
case _mul_int_c:
case _rem_c1:
case _rem_c2:
case _sl_c1:
case _sl_c2:
case _sr_c1:
case _sr_c2:
case _sub_int_c:
case _xor_c:
pc = NEXTOP(pc,ssn);
break;
/* instructions type sss */
case _a_and:
case _a_or:
case _add:
case _fdiv:
case _idiv:
case _mod:
case _mul:
case _rem:
case _sl:
case _sr:
case _sub:
case _uminus:
case _xor:
pc = NEXTOP(pc,sss);
break;
/* instructions type sssl */
case _go_on_cons:
case _go_on_func:
case _if_cons:
case _if_func:
case _switch_on_cons:
case _switch_on_func:
pc = NEXTOP(pc,sssl);
break;
/* instructions type sssllp */
case _expand_clauses:
return found_expand_index(pc, startp, endp, codeptr);
pc = NEXTOP(pc,sssllp);
break;
/* instructions type sxl */
case _get_f_x:
case _get_fi_x:
case _get_i_x:
case _put_f_var_x:
case _put_fi_var_x:
case _put_i_var_x:
pc = NEXTOP(pc,sxl);
break;
/* instructions type sxll */
case _put_f_val_x:
case _put_fi_val_x:
case _put_i_val_x:
pc = NEXTOP(pc,sxll);
break;
/* instructions type syl */
case _get_f_y:
case _get_fi_y:
case _get_i_y:
case _put_f_var_y:
case _put_fi_var_y:
case _put_i_var_y:
pc = NEXTOP(pc,syl);
break;
/* instructions type syll */
case _put_f_val_y:
case _put_fi_val_y:
case _put_i_val_y:
pc = NEXTOP(pc,syll);
break;
/* instructions type x */
case _get_list:
case _put_list:
case _save_b_x:
case _write_x_loc:
case _write_x_val:
case _write_x_var:
pc = NEXTOP(pc,x);
break;
/* instructions type xc */
case _get_atom:
case _get_bigint:
case _get_dbterm:
case _put_atom:
pc = NEXTOP(pc,xc);
break;
/* instructions type xd */
case _get_float:
case _put_float:
pc = NEXTOP(pc,xd);
break;
/* instructions type xfa */
case _get_struct:
case _put_struct:
pc = NEXTOP(pc,xfa);
break;
/* instructions type xi */
case _get_longint:
case _put_longint:
pc = NEXTOP(pc,xi);
break;
/* instructions type xl */
case _p_atom_x:
case _p_atomic_x:
case _p_compound_x:
case _p_cut_by_x:
case _p_db_ref_x:
case _p_float_x:
case _p_integer_x:
case _p_nonvar_x:
case _p_number_x:
case _p_primitive_x:
case _p_var_x:
pc = NEXTOP(pc,xl);
break;
/* instructions type xll */
case _jump_if_nonvar:
pc = NEXTOP(pc,xll);
break;
/* instructions type xllll */
case _switch_on_arg_type:
pc = NEXTOP(pc,xllll);
break;
/* instructions type xp */
case _commit_b_x:
pc = NEXTOP(pc,xp);
break;
/* instructions type xx */
case _get_x_val:
case _get_x_var:
case _gl_void_valx:
case _gl_void_varx:
case _glist_valx:
case _put_x_val:
case _put_x_var:
pc = NEXTOP(pc,xx);
break;
/* instructions type xxn */
case _p_and_vc:
case _p_arg_cv:
case _p_div_cv:
case _p_div_vc:
case _p_func2s_cv:
case _p_func2s_vc:
case _p_minus_cv:
case _p_or_vc:
case _p_plus_vc:
case _p_sll_cv:
case _p_sll_vc:
case _p_slr_cv:
case _p_slr_vc:
case _p_times_vc:
pc = NEXTOP(pc,xxn);
break;
/* instructions type xxx */
case _p_and_vv:
case _p_arg_vv:
case _p_div_vv:
case _p_func2f_xx:
case _p_func2s_vv:
case _p_minus_vv:
case _p_or_vv:
case _p_plus_vv:
case _p_sll_vv:
case _p_slr_vv:
case _p_times_vv:
pc = NEXTOP(pc,xxx);
break;
/* instructions type xxxx */
case _put_xx_val:
pc = NEXTOP(pc,xxxx);
break;
/* instructions type xxy */
case _p_func2f_xy:
pc = NEXTOP(pc,xxy);
break;
/* instructions type xy */
case _gl_void_valy:
case _gl_void_vary:
case _glist_valy:
pc = NEXTOP(pc,xy);
break;
/* instructions type y */
case _save_b_y:
case _write_y_loc:
case _write_y_val:
case _write_y_var:
pc = NEXTOP(pc,y);
break;
/* instructions type yl */
case _p_atom_y:
case _p_atomic_y:
case _p_compound_y:
case _p_cut_by_y:
case _p_db_ref_y:
case _p_float_y:
case _p_integer_y:
case _p_nonvar_y:
case _p_number_y:
case _p_primitive_y:
case _p_var_y:
pc = NEXTOP(pc,yl);
break;
/* instructions type yp */
case _commit_b_y:
pc = NEXTOP(pc,yp);
break;
/* instructions type yx */
case _get_y_val:
case _get_y_var:
case _put_unsafe:
case _put_y_val:
case _put_y_var:
pc = NEXTOP(pc,yx);
break;
/* instructions type yxn */
case _p_and_y_vc:
case _p_arg_y_cv:
case _p_div_y_cv:
case _p_div_y_vc:
case _p_func2s_y_cv:
case _p_func2s_y_vc:
case _p_minus_y_cv:
case _p_or_y_vc:
case _p_plus_y_vc:
case _p_sll_y_cv:
case _p_sll_y_vc:
case _p_slr_y_cv:
case _p_slr_y_vc:
case _p_times_y_vc:
pc = NEXTOP(pc,yxn);
break;
/* instructions type yxx */
case _p_and_y_vv:
case _p_arg_y_vv:
case _p_div_y_vv:
case _p_func2f_yx:
case _p_func2s_y_vv:
case _p_minus_y_vv:
case _p_or_y_vv:
case _p_plus_y_vv:
case _p_sll_y_vv:
case _p_slr_y_vv:
case _p_times_y_vv:
pc = NEXTOP(pc,yxx);
break;
/* instructions type yyx */
case _p_func2f_yy:
pc = NEXTOP(pc,yyx);
break;
#ifdef YAPOR
/* instructions type Otapl */
case _getwork:
case _getwork_seq:
case _sync:
pc = NEXTOP(pc,Otapl);
break;
/* instructions type e */
case _getwork_first_time:
pc = NEXTOP(pc,e);
break;
#endif
#ifdef TABLING
/* instructions type Otapl */
case _table_answer_resolution:
case _table_completion:
case _table_load_answer:
case _table_retry:
case _table_retry_me:
case _table_trust:
case _table_trust_me:
case _table_try:
case _table_try_answer:
case _table_try_me:
case _table_try_single:
pc = NEXTOP(pc,Otapl);
break;
/* instructions type e */
#ifdef TABLING_INNER_CUTS
case _clause_with_cut:
#endif
pc = NEXTOP(pc,e);
break;
/* instructions type s */
case _table_new_answer:
pc = NEXTOP(pc,s);
break;
/* instructions type e */
case _trie_do_atom:
case _trie_do_extension:
case _trie_do_float:
case _trie_do_list:
case _trie_do_long:
case _trie_do_null:
case _trie_do_struct:
case _trie_do_val:
case _trie_do_var:
case _trie_retry_atom:
case _trie_retry_extension:
case _trie_retry_float:
case _trie_retry_list:
case _trie_retry_long:
case _trie_retry_null:
case _trie_retry_struct:
case _trie_retry_val:
case _trie_retry_var:
case _trie_trust_atom:
case _trie_trust_extension:
case _trie_trust_float:
case _trie_trust_list:
case _trie_trust_long:
case _trie_trust_null:
case _trie_trust_struct:
case _trie_trust_val:
case _trie_trust_var:
case _trie_try_atom:
case _trie_try_extension:
case _trie_try_float:
case _trie_try_list:
case _trie_try_long:
case _trie_try_null:
case _trie_try_struct:
case _trie_try_val:
case _trie_try_var:
pc = NEXTOP(pc,e);
break;
#endif
/* this instruction is hardwired */
case _or_last:
#ifdef YAPOR
pp = pc->u.Osblp.p;
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,Osblp);
#else
pp = pc->u.p.p;
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,p);
#endif
}
}

View File

@ -295,6 +295,7 @@ F Arrow Arrow 2
F Assert Assert 2
F AtFoundOne FoundVar 2
F Atom Atom 1
F Att1 Att1 3
F AttGoal AttDo 2
F Braces Braces 1
F Call Call 1
@ -314,6 +315,17 @@ F DoLogUpdClauseErase DoLogUpdClauseErase 6
F DoStaticClause DoStaticClause 5
F DomainError DomainError 2
F Dot Dot 2
F Dot10 Dot 10
F Dot11 Dot 11
F Dot12 Dot 12
F Dot2 Dot 2
F Dot3 Dot 3
F Dot4 Dot 4
F Dot5 Dot 5
F Dot6 Dot 6
F Dot7 Dot 7
F Dot8 Dot 8
F Dot9 Dot 9
F Eq Eq 2
F Error Error 2
F EvaluationError EvaluationError 1
@ -339,6 +351,7 @@ F LastExecuteWithin LastExecuteWithin 1
F List Dot 2
F MegaClause MegaClause 2
F MetaCall MetaCall 4
F Minus Minus 2
F Module Colomn 2
F MultiFileClause MfClause 5
F Mutable MutableVariable (sizeof(timed_var)/sizeof(CELL))
@ -359,6 +372,7 @@ F StaticClause StaticClause 1
F Stream Stream 1
F StreamEOS EndOfStream 1
F StreamPos StreamPos 5
F SyntaxError SyntaxError 7
F ThreadRun TopThreadGoal 2
F Throw Throw 1
F TypeError TypeError 2

View File

@ -25,30 +25,36 @@ 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),
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),
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),
end_ifdef(W,C),
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) :-
start_ifdef(D,W,C,L) :-
retractall(op(_,_)),
format(W, '#ifdef ~s~n',[D]),
format(C, '#ifdef ~s~n',[D]).
format(C, '#ifdef ~s~n',[D]),
format(L, '#ifdef ~s~n',[D]).
end_ifdef(W,C) :-
end_ifdef(W,C,L) :-
format(W, '#endif~n',[]),
format(C, '#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',[]).
@ -68,12 +74,23 @@ restore_opcodes(yamop *pc)
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;
file(I,W,C) :-
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_rclause(C),
output_walk_clause(L).
grep_opcode(W, Line) :-
split(Line," ,();",[OP,Name,Type]),
@ -187,7 +204,157 @@ dump_ops(C,[Op|Ops]) :-
end_special(Op,C),
dump_ops(C,Ops).
/* or_last requires special handling */
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',[]),
@ -210,6 +377,18 @@ footer_rclause(W) :-
}
',[]).
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),