diff --git a/C/absmi.c b/C/absmi.c index 379cf1006..f26b91f37 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,14 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ * +* Last rev: $Date: 2004-03-31 01:03:09 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.126 2004/03/19 11:35:42 vsc +* trim_trail for default machine +* be more aggressive about try-retry-trust chains. +* - handle cases where block starts with a wait +* - don't use _killed instructions, just let the thing rot by itself. +* * Revision 1.125 2004/03/10 14:59:54 vsc * optimise -> for type tests * @@ -6458,6 +6464,48 @@ Yap_absmi(int inp) } ENDBOp(); + BOp(expand_clauses, sp); + { + PredEntry *pe = PREG->u.sp.p; + yamop *pt0; + + /* update ASP before calling IPred */ + ASP = YREG+E_CB; + if (ASP > (CELL *) B) { + ASP = (CELL *) B; + } +#if defined(YAPOR) || defined(THREADS) + if (PP == NULL) { + READ_LOCK(pe->PRWLock); + PP = pe; + } + LOCK(pe->PELock); + if (*PREG_ADDR != PREG) { + PREG = *PREG_ADDR; + if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) { + READ_UNLOCK(pe->PRWLock); + PP = NULL; + } + UNLOCK(pe->PELock); + JMPNext(); + } +#endif + saveregs(); + pt0 = Yap_ExpandIndex(pe); + /* restart index */ + setregs(); + UNLOCK(pe->PELock); + PREG = pt0; +#if defined(YAPOR) || defined(THREADS) + if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) { + READ_UNLOCK(pe->PRWLock); + PP = NULL; + } +#endif + JMPNext(); + } + ENDBOp(); + BOp(undef_p, e); /* save S for module name */ { @@ -6923,7 +6971,7 @@ Yap_absmi(int inp) #define HASH_SHIFT 6 - BOp(switch_on_func, ssl); + BOp(switch_on_func, sssl); BEGD(d1); d1 = *SREG++; /* we use a very simple hash function to find elements in a @@ -6931,10 +6979,10 @@ Yap_absmi(int inp) { register CELL /* first, calculate the mask */ - Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */ + Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */ hash = d1 >> (HASH_SHIFT - 1) & Mask; - PREG = (yamop *)(PREG->u.sl.l); + PREG = (yamop *)(PREG->u.sssl.l); /* PREG now points at the beginning of the hash table */ BEGP(pt0); /* pt0 will always point at the item */ @@ -6977,10 +7025,10 @@ Yap_absmi(int inp) { register CELL /* first, calculate the mask */ - Mask = (PREG->u.sl.s - 1) << 1, /* next, calculate the hash function */ + Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */ hash = d1 >> (HASH_SHIFT - 1) & Mask; - PREG = (yamop *)(PREG->u.sl.l); + PREG = (yamop *)(PREG->u.sssl.l); /* PREG now points at the beginning of the hash table */ BEGP(pt0); /* pt0 will always point at the item */ @@ -7015,10 +7063,10 @@ Yap_absmi(int inp) ENDD(d1); ENDBOp(); - BOp(go_on_func, sl); + BOp(go_on_func, sssl); BEGD(d0); { - CELL *pt = (CELL *)(PREG->u.sl.l); + CELL *pt = (CELL *)(PREG->u.sssl.l); d0 = *SREG++; if (d0 == pt[0]) { @@ -7034,10 +7082,10 @@ Yap_absmi(int inp) ENDD(d0); ENDBOp(); - BOp(go_on_cons, sl); + BOp(go_on_cons, sssl); BEGD(d0); { - CELL *pt = (CELL *)(PREG->u.sl.l); + CELL *pt = (CELL *)(PREG->u.sssl.l); d0 = I_R; if (d0 == pt[0]) { @@ -7053,10 +7101,10 @@ Yap_absmi(int inp) ENDD(d0); ENDBOp(); - BOp(if_func, sl); + BOp(if_func, sssl); BEGD(d1); BEGP(pt0); - pt0 = (CELL *) PREG->u.sl.l; + pt0 = (CELL *) PREG->u.sssl.l; d1 = *SREG++; while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) { pt0 += 2; @@ -7068,10 +7116,10 @@ Yap_absmi(int inp) ENDD(d1); ENDBOp(); - BOp(if_cons, sl); + BOp(if_cons, sssl); BEGD(d1); BEGP(pt0); - pt0 = (CELL *) PREG->u.sl.l; + pt0 = (CELL *) PREG->u.sssl.l; d1 = I_R; while (pt0[0] != d1 && pt0[0] != 0L ) { pt0 += 2; diff --git a/C/amasm.c b/C/amasm.c index bda7daaf2..395d99300 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2004-03-10 14:59:55 $ * -* $Log: not supported by cvs2svn $ * +* Last rev: $Date: 2004-03-31 01:03:09 $ * +* $Log: not supported by cvs2svn $ +* Revision 1.58 2004/03/10 14:59:55 vsc +* optimise -> for type tests +* * * * *************************************************************************/ #ifdef SCCS @@ -734,18 +737,6 @@ a_r(CELL arnd2, op_numbers opcode, yamop *code_p, int pass_no) return code_p; } -inline static yamop * -a_sp(op_numbers opcode, COUNT sv, yamop *code_p, int pass_no, struct intermediates *cip) -{ - if (pass_no) { - code_p->opc = emit_op(opcode); - code_p->u.sp.s = sv-1; - code_p->u.sp.p = cip->CurrentPred; - } - GONEXT(dp); - return code_p; -} - static yamop * check_alloc(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip) { @@ -1191,25 +1182,32 @@ a_hx(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i { register CELL i, imax; register CELL *seq_ptr = (CELL *)cip->cpc->rnd2; + int j = 0; imax = cip->cpc->rnd1; if (pass_no) { code_p->opc = emit_op(opcode); - code_p->u.sl.s = emit_c(imax); - code_p->u.sl.l = emit_a(cip->cpc->rnd2); + code_p->u.sssl.s = emit_c(imax); + code_p->u.sssl.l = emit_a(cip->cpc->rnd2); if (log_update) { init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u); } else { init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u); } } - GONEXT(sl); if (pass_no) { for (i = 0; i < imax; i++) { + yamop *ipc = (yamop *)seq_ptr[1]; a_pair(seq_ptr, pass_no, cip); + if (ipc != FAILCODE) { + j++; + } seq_ptr += 2; } + code_p->u.sssl.e = j; + code_p->u.sssl.w = 0; } + GONEXT(sssl); return code_p; } @@ -1222,15 +1220,16 @@ a_if(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i imax = cip->cpc->rnd1; if (pass_no) { code_p->opc = emit_op(opcode); - code_p->u.sl.s = emit_count(imax); - code_p->u.sl.l = emit_a(cip->cpc->rnd2); + code_p->u.sssl.s = code_p->u.sssl.e = emit_count(imax); + code_p->u.sssl.w = 0; + code_p->u.sssl.l = emit_a(cip->cpc->rnd2); if (log_update) { init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u); } else { init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u); } } - GONEXT(sl); + GONEXT(sssl); if (pass_no) { CELL lab, lab0; for (i = 0; i < imax; i++) { diff --git a/C/cdmgr.c b/C/cdmgr.c index 3dadfcf36..156616a54 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,14 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ * +* Last rev: $Date: 2004-03-31 01:03:09 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.115 2004/03/19 11:35:42 vsc +* trim_trail for default machine +* be more aggressive about try-retry-trust chains. +* - handle cases where block starts with a wait +* - don't use _killed instructions, just let the thing rot by itself. +* * * *************************************************************************/ #ifdef SCCS @@ -353,7 +359,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code case _switch_on_cons: case _if_cons: case _go_on_cons: - ipc = NEXTOP(ipc,sl); + ipc = NEXTOP(ipc,sssl); break; default: Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code: opcode %d", op); @@ -377,6 +383,18 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code) yamop *beg = c->ClCode, *end, *ipc; op_numbers op; if (c->ClFlags & SwitchTableMask) { + CELL *end = (CELL *)((char *)c+c->ClSize); + CELL *beg = (CELL *)(c->ClCode); + OPCODE ecs = Yap_opcode(_expand_clauses); + + while (beg < end) { + yamop *cop; + cop = (yamop *)beg[1]; + beg += 2; + if (cop->opc == ecs) { + Yap_FreeCodeSpace((char *)cop); + } + } return; } op = Yap_op_from_opcode(beg->opc); @@ -403,9 +421,12 @@ kill_static_child_indxs(StaticIndex *indx) Yap_FreeCodeSpace((CODEADDR)indx); } +int kills; + static void kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) { + kills++; if (parent != NULL) { /* sat bye bye */ /* decrease refs */ @@ -3114,8 +3135,15 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya { LogUpdClause *cl; Term rtn; + Term Terms[3]; - cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr); + Terms[0] = th; + Terms[1] = tb; + Terms[2] = tr; + cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr); + th = Terms[0]; + tb = Terms[1]; + tr = Terms[2]; if (cl == NULL) { return FALSE; } @@ -3223,8 +3251,14 @@ static Int fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) { LogUpdClause *cl; + Term Terms[3]; - cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr); + Terms[0] = th; + Terms[1] = tb; + Terms[2] = TermNil; + cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr); + th = Terms[0]; + tb = Terms[1]; #if defined(YAPOR) || defined(THREADS) if (PP == pe) { READ_UNLOCK(pe->PRWLock); @@ -3314,8 +3348,15 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr { StaticClause *cl; Term rtn; + Term Terms[3]; - cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr); + Terms[0] = th; + Terms[1] = tb; + Terms[2] = tr; + cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr); + th = Terms[0]; + tb = Terms[1]; + tr = Terms[2]; if (cl == NULL) return FALSE; rtn = MkDBRefTerm((DBRef)cl); diff --git a/C/tracer.c b/C/tracer.c index 7b8e23c43..09193e2cc 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -127,10 +127,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) } #endif vsc_count++; - if (vsc_count < 5319900) - return; - if (vsc_count == 5319949) - vsc_xstop = 1; #ifdef COMMENTED // if (vsc_count == 218280) // vsc_xstop = 1; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 0c0710b52..e5734081e 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -11,8 +11,14 @@ * File: YapOpcodes.h * * comments: Central Table with all YAP opcodes * * * -* Last rev: $Date: 2004-03-19 11:35:42 $ * +* Last rev: $Date: 2004-03-31 01:03:10 $ * * $Log: not supported by cvs2svn $ +* Revision 1.22 2004/03/19 11:35:42 vsc +* trim_trail for default machine +* be more aggressive about try-retry-trust chains. +* - handle cases where block starts with a wait +* - don't use _killed instructions, just let the thing rot by itself. +* * Revision 1.21 2004/03/10 14:59:55 vsc * optimise -> for type tests * * @@ -155,22 +161,23 @@ OPCODE(try_in ,l), OPCODE(jump_if_var ,l), OPCODE(jump_if_nonvar ,xl), - OPCODE(switch_on_cons ,ssl), + OPCODE(switch_on_cons ,sssl), OPCODE(switch_on_type ,llll), OPCODE(switch_list_nl ,ollll), OPCODE(switch_on_arg_type ,xllll), OPCODE(switch_on_sub_arg_type ,sllll), - OPCODE(go_on_cons ,sl), - OPCODE(if_cons ,sl), - OPCODE(switch_on_func ,sl), - OPCODE(go_on_func ,sl), - OPCODE(if_func ,sl), + OPCODE(go_on_cons ,sssl), + OPCODE(if_cons ,sssl), + OPCODE(switch_on_func ,sssl), + OPCODE(go_on_func ,sssl), + OPCODE(if_func ,sssl), OPCODE(if_not_then ,cll), OPCODE(index_dbref ,e), OPCODE(index_blob ,e), OPCODE(trust_fail ,e), OPCODE(index_pred ,e), OPCODE(expand_index ,e), + OPCODE(expand_clauses ,sp), OPCODE(save_b_x ,x), OPCODE(save_b_y ,y), OPCODE(commit_b_x ,x), diff --git a/H/amidefs.h b/H/amidefs.h index 3dec8fb32..cba2a270c 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -11,8 +11,11 @@ * File: amidefs.h * * comments: Abstract machine peculiarities * * * -* Last rev: $Date: 2004-03-10 14:59:55 $ * -* $Log: not supported by cvs2svn $ * +* Last rev: $Date: 2004-03-31 01:03:10 $ * +* $Log: not supported by cvs2svn $ +* Revision 1.22 2004/03/10 14:59:55 vsc +* optimise -> for type tests +* * * * *************************************************************************/ @@ -357,7 +360,8 @@ typedef struct yami { CELL next; } s; struct { - COUNT s; + COUNT s1; + COUNT s2; struct pred_entry *p; CELL next; } sp; @@ -374,11 +378,6 @@ typedef struct yami { CELL next; } sdl; struct { - COUNT s; - struct yami *l; - CELL next; - } sl; - struct { #ifdef YAPOR unsigned int or_arg; #endif /* YAPOR */ @@ -392,6 +391,13 @@ typedef struct yami { struct pred_entry *p0; CELL next; } sla; /* also check env for yes and trustfail code before making any changes */ + struct { + COUNT s; /* size of table */ + COUNT e; /* live entries */ + COUNT w; /* pending suspended blocks */ + struct yami *l; + CELL next; + } sssl; struct { wamreg x; CELL next; diff --git a/H/clause.h b/H/clause.h index 0a427ad33..97d7a8a99 100644 --- a/H/clause.h +++ b/H/clause.h @@ -196,7 +196,7 @@ yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *)); void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int)); void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *)); LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int)); -LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *)); +LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *)); #if USE_THREADED_CODE diff --git a/H/rheap.h b/H/rheap.h index 8725670f2..a44deca86 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,14 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ * -* $Log: not supported by cvs2svn $ * +* Last rev: $Date: 2004-03-31 01:03:10 $,$Author: vsc $ * +* $Log: not supported by cvs2svn $ +* Revision 1.39 2004/03/19 11:35:42 vsc +* trim_trail for default machine +* be more aggressive about try-retry-trust chains. +* - handle cases where block starts with a wait +* - don't use _killed instructions, just let the thing rot by itself. +* * * * *************************************************************************/ #ifdef SCCS @@ -713,6 +719,18 @@ restore_opcodes(yamop *pc) pc->u.xF.F = PtoOpAdjust(pc->u.xF.F); pc = NEXTOP(pc,xF); break; + case _expand_clauses: + pc->u.sp.p = PtoPredAdjust(pc->u.sp.p); + { + COUNT i; + yamop **st = (yamop **)NEXTOP(pc,sp); + + for (i = 0; i < pc->u.sp.s1; i++, st++) { + if (*st) { + *st = PtoOpAdjust(*st); + } + } + } /* instructions type y */ case _save_b_y: case _commit_b_y: @@ -1051,8 +1069,8 @@ restore_opcodes(yamop *pc) int i, j; CELL *oldcode, *startcode; - i = pc->u.sl.s; - startcode = oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + i = pc->u.sssl.s; + startcode = oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); for (j = 0; j < i; j++) { Functor oldfunc = (Functor)(oldcode[0]); CODEADDR oldjmp = (CODEADDR)(oldcode[1]); @@ -1063,7 +1081,7 @@ restore_opcodes(yamop *pc) oldcode += 2; } rehash(startcode, i, Funcs); - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); } break; /* switch_on_cons */ @@ -1075,11 +1093,11 @@ restore_opcodes(yamop *pc) CELL *startcode; #endif - i = pc->u.sl.s; + i = pc->u.sssl.s; #if !USE_OFFSETS startcode = #endif - oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); for (j = 0; j < i; j++) { Term oldcons = oldcode[0]; CODEADDR oldjmp = (CODEADDR)(oldcode[1]); @@ -1092,23 +1110,23 @@ restore_opcodes(yamop *pc) #if !USE_OFFSETS rehash(startcode, i, Atomics); #endif - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); } break; case _go_on_func: { - CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); Functor oldfunc = (Functor)(oldcode[0]); oldcode[0] = (CELL)FuncAdjust(oldfunc); oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]); } - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); break; case _go_on_cons: { - CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); Term oldcons = oldcode[0]; if (IsAtomTerm(oldcons)) { @@ -1117,14 +1135,14 @@ restore_opcodes(yamop *pc) oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]); } - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); break; case _if_func: { - CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); Int j; - for (j = 0; j < pc->u.sl.s; j++) { + for (j = 0; j < pc->u.sssl.s; j++) { Functor oldfunc = (Functor)(oldcode[0]); CODEADDR oldjmp = (CODEADDR)(oldcode[1]); oldcode[0] = (CELL)FuncAdjust(oldfunc); @@ -1134,14 +1152,14 @@ restore_opcodes(yamop *pc) /* adjust fail code */ oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); } - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); break; case _if_cons: { - CELL *oldcode = (CELL *)(pc->u.sl.l = PtoOpAdjust(pc->u.sl.l)); + CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); Int j; - for (j = 0; j < pc->u.sl.s; j++) { + for (j = 0; j < pc->u.sssl.s; j++) { Term oldcons = oldcode[0]; CODEADDR oldjmp = (CODEADDR)(oldcode[1]); if (IsAtomTerm(oldcons)) { @@ -1153,7 +1171,7 @@ restore_opcodes(yamop *pc) /* adjust fail code */ oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); } - pc = NEXTOP(pc,sl); + pc = NEXTOP(pc,sssl); break; /* instructions type xxx */ case _p_plus_vv: