From e160d86304e23d5cf7449adedd3cab4d43d770d5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 5 Jul 2011 07:28:28 +0100 Subject: [PATCH] use assembler to tell whether a clause has cut, instead of stupidly searching the clause. --- C/amasm.c | 8 + C/index.c | 661 ++-------------------------------------------------- H/Yatom.h | 3 +- H/compile.h | 1 + 4 files changed, 31 insertions(+), 642 deletions(-) diff --git a/C/amasm.c b/C/amasm.c index c1debd1d3..9262a82db 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -2028,6 +2028,7 @@ a_ifnot(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip static yamop * a_cut(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip) { + cip->clause_has_cut = TRUE; code_p = check_alloc(clinfo, code_p, pass_no, cip); if (clinfo->dealloc_found) { return a_n(_cut_e, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2, code_p, pass_no); @@ -3032,6 +3033,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (pass_no) { cl_u->luc.Id = FunctorDBRef; cl_u->luc.ClFlags = LogUpdMask; + if (cip->clause_has_cut) + cl_u->luc.ClFlags |= HasCutMask; cl_u->luc.ClRefCount = 0; cl_u->luc.ClPred = cip->CurrentPred; cl_u->luc.ClSize = size; @@ -3082,6 +3085,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp /* static clause */ if (pass_no) { cl_u->sc.ClFlags = StaticMask; + if (cip->clause_has_cut) + cl_u->sc.ClFlags |= HasCutMask; cl_u->sc.ClNext = NULL; cl_u->sc.ClSize = size; cl_u->sc.usc.ClPred = cip->CurrentPred; @@ -3383,6 +3388,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp code_p = a_v(_save_b_x, _save_b_y, code_p, pass_no, cip->cpc); break; case commit_b_op: + cip->clause_has_cut = TRUE; code_p = a_vp(_commit_b_x, _commit_b_y, code_p, pass_no, cip->cpc, &clinfo); break; case save_pair_op: @@ -3402,6 +3408,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp code_p = a_cnp(_native_me, code_p, pass_no, cip); break; case cutexit_op: + cip->clause_has_cut = TRUE; if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found) @@ -3886,6 +3893,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates #else cip->label_offset = (Int *)cip->freep; #endif + cip->clause_has_cut = FALSE; cip->code_addr = NULL; code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size PASS_REGS); if (clause_has_dbterm) { diff --git a/C/index.c b/C/index.c index 2a8dace82..c0b00a8ae 100644 --- a/C/index.c +++ b/C/index.c @@ -940,643 +940,6 @@ link_regcopies(wamreg regs[MAX_REG_COPIES], int regs_count, Int c1, Int c2) return delete_regcopy(regs, regs_count, c2); } -/* Restores a prolog clause, in its compiled form */ -#if YAPOR -static int -has_cut(yamop *pc) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ -{ - do { - op_numbers op = Yap_op_from_opcode(pc->opc); - switch (op) { - case _unify_idb_term: - case _copy_idb_term: - case _Ystop: - case _Nstop: - return FALSE; - case _commit_b_y: - case _commit_b_x: - return TRUE; - /* instructions type ld */ -#if CUT_C - case _cut_c: - case _cut_userc: -#endif - return TRUE; - 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 /* YAPOR */ -#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; - /* instructions type Illss */ - case _enter_lu_pred: - pc = pc->u.Illss.l1; - break; - case _execute: - case _dexecute: - case _execute_cpred: - pc = NEXTOP(pc,pp); - break; - case _native_me: - pc = NEXTOP(pc,aFlp); - break; - /* instructions type Osbpi */ - case _ensure_space: - pc = NEXTOP(pc,Osbpi); - break; - /* instructions type l */ - case _enter_profiling: - case _count_call: - case _retry_profiled: - case _count_retry: - 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; - case _jump_if_nonvar: - pc = NEXTOP(pc,xll); - break; - /* instructions type EC */ - case _alloc_for_logical_pred: - pc = NEXTOP(pc,L); - break; - /* instructions type e */ - case _lock_lu: - case _unlock_lu: - case _trust_fail: - case _op_fail: - case _allocate: - case _write_void: - case _write_list: - case _write_l_list: -#if !defined(YAPOR) - case _or_last: -#endif /* !YAPOR */ - case _pop: - case _index_pred: - case _lock_pred: -#if THREADS - case _thread_local: -#endif - case _expand_index: - case _undef_p: - case _spy_pred: - case _p_equal: - case _p_functor: - case _p_execute_tail: - case _index_dbref: - case _index_blob: - case _index_long: -#ifdef YAPOR - case _getwork_first_time: -#endif /* YAPOR */ -#ifdef TABLING - case _trie_do_var: - case _trie_trust_var: - case _trie_try_var: - case _trie_retry_var: - case _trie_do_var_in_pair: - case _trie_trust_var_in_pair: - case _trie_try_var_in_pair: - case _trie_retry_var_in_pair: - case _trie_do_val: - case _trie_trust_val: - case _trie_try_val: - case _trie_retry_val: - case _trie_do_val_in_pair: - case _trie_trust_val_in_pair: - case _trie_try_val_in_pair: - case _trie_retry_val_in_pair: - case _trie_do_atom: - case _trie_trust_atom: - case _trie_try_atom: - case _trie_retry_atom: - case _trie_do_atom_in_pair: - case _trie_trust_atom_in_pair: - case _trie_try_atom_in_pair: - case _trie_retry_atom_in_pair: - case _trie_do_null: - case _trie_trust_null: - case _trie_try_null: - case _trie_retry_null: - case _trie_do_null_in_pair: - case _trie_trust_null_in_pair: - case _trie_try_null_in_pair: - case _trie_retry_null_in_pair: - case _trie_do_pair: - case _trie_trust_pair: - case _trie_try_pair: - case _trie_retry_pair: - case _trie_do_appl: - case _trie_trust_appl: - case _trie_try_appl: - case _trie_retry_appl: - case _trie_do_appl_in_pair: - case _trie_trust_appl_in_pair: - case _trie_try_appl_in_pair: - case _trie_retry_appl_in_pair: - case _trie_do_extension: - case _trie_trust_extension: - case _trie_try_extension: - case _trie_retry_extension: - case _trie_do_double: - case _trie_trust_double: - case _trie_try_double: - case _trie_retry_double: - case _trie_do_longint: - case _trie_trust_longint: - case _trie_try_longint: - case _trie_retry_longint: - case _trie_do_gterm: - case _trie_trust_gterm: - case _trie_try_gterm: - case _trie_retry_gterm: -#endif /* TABLING */ - pc = NEXTOP(pc,e); - break; - case _expand_clauses: - pc = NEXTOP(pc,sssllp); - 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 xD */ - case _put_dbterm: - pc = NEXTOP(pc,xD); - break; - /* instructions type D */ - case _write_dbterm: - pc = NEXTOP(pc,D); - break; - /* instructions type xN */ - case _put_bigint: - pc = NEXTOP(pc,xN); - break; - /* instructions type N */ - case _write_bigint: - pc = NEXTOP(pc,N); - 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: - pc = NEXTOP(pc,xl); - 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: - pc = NEXTOP(pc,yl); - break; - /* instructions type sbpp */ - case _p_execute: - pc = NEXTOP(pc,Osbmp); - break; - case _p_execute2: - case _fcall: - case _call: - case _call_cpred: - case _call_usercpred: - pc = NEXTOP(pc,Osbpp); - break; - /* instructions type sblp */ -#ifdef YAPOR - case _or_last: -#endif /* YAPOR */ - case _either: - case _or_else: - pc = NEXTOP(pc,Osblp); - 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: - case _glist_valy: - case _gl_void_vary: - case _gl_void_valy: - 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 yx */ - /* 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; - /* instructions type d */ - case _write_float: - pc = NEXTOP(pc,d); - break; - /* instructions type oi */ - case _unify_longint: - case _unify_l_longint: - case _unify_longint_write: - case _unify_l_longint_write: - pc = NEXTOP(pc,oi); - break; - /* instructions type i */ - case _write_longint: - pc = NEXTOP(pc,i); - 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 _cut: - case _cut_t: - case _cut_e: - case _write_n_voids: - case _pop_n: -#ifdef TABLING - case _table_new_answer: -#endif /* TABLING */ - pc = NEXTOP(pc,s); - break; - /* instructions type ps */ - case _write_atom: - pc = NEXTOP(pc,c); - break; - /* instructions type p */ - case _user_switch: - return FALSE; - case _deallocate: - case _procceed: - pc = NEXTOP(pc,p); - 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: - pc = NEXTOP(pc,slp); - break; - /* instructions type lds */ - case _try_c: - case _try_userc: - pc = NEXTOP(pc,OtapFs); - break; - /* instructions type OtaLl,OtILl */ - 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: - pc = pc->u.OtILl.n; - break; - case _retry_c: - case _retry_userc: - pc = NEXTOP(pc,OtapFs); - break; - /* instructions type llll */ - case _switch_on_type: - return FALSE; - break; - case _switch_list_nl: - return FALSE; - break; - case _switch_on_arg_type: - return FALSE; - break; - case _switch_on_sub_arg_type: - return FALSE; - /* instructions type lll */ - /* instructions type cll */ - case _if_not_then: - return FALSE; - /* instructions type sl */ - case _switch_on_func: - case _switch_on_cons: - case _go_on_func: - case _go_on_cons: - case _if_func: - case _if_cons: - return FALSE; - /* 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: - 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: - pc = NEXTOP(pc,xxn); - break; - case _p_div_vc: - case _p_sll_cv: - case _p_slr_cv: - case _p_arg_cv: - pc = NEXTOP(pc,xxn); - break; - case _p_func2s_cv: - pc = NEXTOP(pc,xxn); - break; - /* instructions type xxy */ - case _p_func2f_xy: - 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: - pc = NEXTOP(pc,yxx); - break; - /* instructions type yyx */ - case _get_yy_var: - case _put_y_vals: - pc = NEXTOP(pc,yyxx); - break; - /* instructions type yyx */ - case _p_func2f_yy: - 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: - pc = NEXTOP(pc,yxn); - break; - /* instructions type yxn */ - case _p_sll_y_cv: - case _p_slr_y_cv: - case _p_arg_y_cv: - pc = NEXTOP(pc,yxn); - break; - /* instructions type yxn */ - case _p_func2s_y_cv: - pc = NEXTOP(pc,yxn); - break; - /* instructions type plxxs */ - case _call_bfunc_xx: - pc = NEXTOP(pc,plxxs); - break; - /* instructions type plxys */ - case _call_bfunc_yx: - case _call_bfunc_xy: - pc = NEXTOP(pc,plxys); - break; - case _call_bfunc_yy: - pc = NEXTOP(pc,plyys); - break; - } - } while (TRUE); -} -#else -#define has_cut(pc) 0 -#endif /* YAPOR */ - static void add_info(ClauseDef *clause, UInt regno) { @@ -2086,6 +1449,22 @@ new_label(struct intermediates *cint) return lbl; } +static Int has_cut(yamop *pc, PredEntry *ap) +{ + if (ap->PredFlags & LogUpdatePredFlag) { + LogUpdClause *lcl = ClauseCodeToLogUpdClause(pc); + return lcl->ClFlags & HasCutMask; + } else if (ap->PredFlags & MegaClausePredFlag) { + /* must be a fact */ + return FALSE; + } else { + StaticClause *scl; + + scl = ClauseCodeToStaticClause(pc); + return scl->ClFlags & HasCutMask; + } +} + static void emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses) { @@ -2104,9 +1483,9 @@ emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses) } } if (clauses == 0) { - Yap_emit(trust_op, (CELL)clcode, has_cut(cl->CurrentCode) , cint); + Yap_emit(trust_op, (CELL)clcode, has_cut(cl->Code, ap) , cint); } else { - Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode) , cint); + Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap) , cint); Yap_emit(jumpi_op, nxtlbl, Zero, cint); } } @@ -2128,7 +1507,7 @@ emit_retry(ClauseDef *cl, struct intermediates *cint, int clauses) Yap_emit(count_retry_op, Unsigned(ap), Zero, cint); } } - Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode), cint); + Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap), cint); } static compiler_vm_op @@ -2177,7 +1556,7 @@ emit_try(ClauseDef *cl, struct intermediates *cint, int var_group, int first, in } comp_op = emit_optry(var_group, first, clauses, clleft, cint->CurrentPred); - Yap_emit(comp_op, (CELL)clcode, ((clauses+clleft) << 1) | has_cut(cl->CurrentCode), cint); + Yap_emit(comp_op, (CELL)clcode, ((clauses+clleft) << 1) | has_cut(cl->Code, ap), cint); } static TypeSwitch * diff --git a/H/Yatom.h b/H/Yatom.h index 03289ac25..4add68733 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -823,7 +823,8 @@ typedef enum LogUpdRuleMask = 0x0400, /* code is for a log upd rule with env */ LogUpdMask = 0x0200, /* logic update index. */ StaticMask = 0x0100, /* static predicates */ - DirtyMask = 0x0080 /* LUIndices */ + DirtyMask = 0x0080, /* LUIndices */ + HasCutMask = 0x0040 /* ! */ /* other flags belong to DB */ } dbentry_flags; diff --git a/H/compile.h b/H/compile.h index afbc18d02..a305bb17b 100755 --- a/H/compile.h +++ b/H/compile.h @@ -272,6 +272,7 @@ typedef struct intermediates { yamop **current_try_lab, **current_trust_lab; yamop *try_instructions; struct StructClauseDef *cls; + int clause_has_cut; /* for expanding code */ union { struct static_index *si;