diff --git a/C/attvar.c b/C/attvar.c index dfadc8023..9b63eda7a 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -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 */ diff --git a/C/cdmgr.c b/C/cdmgr.c index fab09520a..7315d69da 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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; } diff --git a/C/exec.c b/C/exec.c index f0d5a32fb..091ffec8a 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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; diff --git a/C/iopreds.c b/C/iopreds.c index ae3ea024c..7ad3fb15f 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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 diff --git a/C/sort.c b/C/sort.c index a8ff9e8fb..57e0a3e42 100644 --- a/C/sort.c +++ b/C/sort.c @@ -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); diff --git a/C/stdpreds.c b/C/stdpreds.c index ef2debfcb..8604b97fd 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index e950adf42..57387b6f5 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/iatoms.h b/H/iatoms.h index 9103a86b9..fa1c3fb27 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -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); diff --git a/H/ratoms.h b/H/ratoms.h index 23806731b..b1f798bb2 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -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); diff --git a/H/rclause.h b/H/rclause.h index 5cb9d6b2a..042b28007 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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); diff --git a/H/tatoms.h b/H/tatoms.h index 5678073ff..fcc277cd3 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -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_; diff --git a/H/walkclause.h b/H/walkclause.h new file mode 100644 index 000000000..9b99238b9 --- /dev/null +++ b/H/walkclause.h @@ -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 + } + } diff --git a/misc/ATOMS b/misc/ATOMS index 3c368c974..f788830de 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -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 diff --git a/misc/buildops b/misc/buildops index ab8a4f583..8561dd04c 100644 --- a/misc/buildops +++ b/misc/buildops @@ -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),