diff --git a/C/absmi.c b/C/absmi.c index 2625ed5cd..c77c4d97c 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,12 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2006-10-10 20:21:42 $,$Author: vsc $ * +* Last rev: $Date: 2006-10-11 14:53:57 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.207 2006/10/10 20:21:42 vsc +* fix new indexing code to actually recover space +* fix predicate info to work for LUs +* * Revision 1.206 2006/10/10 14:08:15 vsc * small fixes on threaded implementation. * @@ -2070,13 +2074,16 @@ Yap_absmi(int inp) LOCK(cl->ClLock); DEC_CLREF_COUNT(cl); cl->ClFlags &= ~InUseMask; - erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); + erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount); UNLOCK(cl->ClLock); if (erase) { /* at this point, we are the only ones accessing the clause, hence we don't need to have a lock it */ saveregs(); - Yap_ErLogUpdIndex(cl); + if (cl->ClFlags & ErasedMask) + Yap_ErLogUpdIndex(cl); + else + Yap_CleanUpIndex(cl); setregs(); } } else { diff --git a/C/amasm.c b/C/amasm.c index 4ec112478..f40b1d4e0 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2006-10-10 14:08:16 $ * +* Last rev: $Date: 2006-10-11 14:53:57 $ * * $Log: not supported by cvs2svn $ +* Revision 1.89 2006/10/10 14:08:16 vsc +* small fixes on threaded implementation. +* * Revision 1.88 2006/09/20 20:03:51 vsc * improve indexing on floats * fix sending large lists to DB @@ -1687,6 +1690,10 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod save_machine_regs(); longjmp(cip->CompilerBotch,2); } +#ifdef DEBUG + Yap_NewCps++; + Yap_LiveCps++; +#endif if (opcode == try_op) { /* use the last n field to keep a chain with all diff --git a/C/cdmgr.c b/C/cdmgr.c index 50bd0dcad..5ce967331 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2006-10-10 14:08:16 $,$Author: vsc $ * +* Last rev: $Date: 2006-10-11 14:53:57 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.192 2006/10/10 14:08:16 vsc +* small fixes on threaded implementation. +* * Revision 1.191 2006/09/20 20:03:51 vsc * improve indexing on floats * fix sending large lists to DB @@ -873,7 +876,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code { OPCODE ecs = Yap_opcode(_expand_clauses); - while (ipc < end) { + while (ipc) { op_numbers op = Yap_op_from_opcode(ipc->opc); /* printf("op: %d %p->%p\n", op, ipc, end); */ switch(op) { @@ -929,18 +932,32 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code); ipc = ipc->u.lld.n; Yap_FreeCodeSpace((ADDR)oipc); +#ifdef DEBUG + Yap_DirtyCps--; + Yap_FreedCps++; +#endif } + end = ipc; break; case _trust_logical: case _count_trust_logical: case _profiled_trust_logical: +#ifdef DEBUG + Yap_DirtyCps--; + Yap_FreedCps++; +#endif decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code); Yap_FreeCodeSpace((ADDR)ipc); return; case _enter_lu_pred: if (ipc->u.Ill.I->ClFlags & InUseMask) return; +#ifdef DEBUG + Yap_DirtyCps+=ipc->u.Ill.s; + Yap_LiveCps-=ipc->u.Ill.s; +#endif ipc = ipc->u.Ill.l1; + end = ipc; break; case _try_in: case _jump: @@ -1029,7 +1046,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code) return; } op = Yap_op_from_opcode(beg->opc); - end = (yamop *)((CODEADDR)c+c->ClSize); + end = (yamop *)((CODEADDR)c+c->ClSize); ipc = beg; cleanup_dangling_indices(ipc, beg, end, suspend_code); } @@ -3707,7 +3724,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { pc = pc->u.lld.n; break; case _enter_lu_pred: - pc = pc->u.Ill.l2; + pc = pc->u.Ill.l1; break; /* instructions type p */ case _count_call: @@ -4985,6 +5002,82 @@ p_continue_log_update_clause0(void) return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_cp, FALSE); } +static void +adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt NStamps) +{ + UInt clstamp = cl->ClTimeStart; + while (arp[0]); + clstamp = cl->ClTimeEnd; +} + +void /* $hidden_predicate(P) */ +Yap_update_timestamps(PredEntry *ap, UInt arity) +{ + choiceptr bptr = B; + yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld); + yamop *cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld); + UInt ar = ap->ArityOfPE; + UInt *arp = ASP; + UInt nstamps; + LogUpdClause *cl; + +#if THREADS + YAP_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap); +#endif + if (ap->cs.p_code.NOfClauses < 2) + return; + restart: + while (bptr) { + op_numbers opnum = Yap_op_from_opcode(bptr->cp_ap->opc); + + switch (opnum) { + case _retry_logical: + case _count_retry_logical: + case _profiled_retry_logical: + case _trust_logical: + case _count_trust_logical: + case _profiled_trust_logical: + if (bptr->cp_ap->u.lld.d->ClPred == ap) { + UInt ts = IntegerOfTerm(bptr->cp_args[ar]); + if (ts != arp[0]) { + if (arp-H < 1024) { + goto overflow; + } + *--arp = ts; + } + } + break; + case _retry: + if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) && + ((PredEntry *)IntegerOfTerm((bptr+1)->cp_args[0]) == ap)) { + UInt ts = IntegerOfTerm(bptr->cp_args[5]); + if (ts != arp[0]) { + if (arp-H < 1024) { + goto overflow; + } + *--arp = ts; + } + } + break; + default: + continue; + } + } + NStamps = (ASP-arp); + cl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause); + while (cl) { + adjust_cl_timestamp(cl, arp, NStamps); + cl = cl->ClNext; + } + return; + overflow: + if (!Yap_gc(arity, ENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return; + } + goto restart; +} + static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) { @@ -5397,6 +5490,15 @@ p_predicate_erased_statistics(void) Yap_unify(ARG4,MkIntegerTerm(icls)) && Yap_unify(ARG5,MkIntegerTerm(isz)); } + +static Int +p_predicate_lu_cps(void) +{ + return Yap_unify(ARG1, MkIntegerTerm(Yap_LiveCps)) && + Yap_unify(ARG2, MkIntegerTerm(Yap_FreedCps)) && + Yap_unify(ARG3, MkIntegerTerm(Yap_DirtyCps)) && + Yap_unify(ARG4, MkIntegerTerm(Yap_NewCps)); +} #endif static Int @@ -5656,6 +5758,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag); #ifdef DEBUG Yap_InitCPred("predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag); + Yap_InitCPred("predicate_live_cps", 4, p_predicate_lu_cps, 0L); #endif } diff --git a/C/dbase.c b/C/dbase.c index 4e4af2ba3..38c6155da 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1417,6 +1417,12 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc return NULL; } ntp0 = ppt0->Contents; + if ((ADDR)TR >= Yap_TrailTop-1024) { + Yap_Error_Size = 0; + Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + Yap_ReleasePreAllocCodeSpace((ADDR)pp0); + return NULL; + } dbg->lr = dbg->LinkAr = (link_entry *)TR; #ifdef COROUTINING /* attachment */ @@ -3636,6 +3642,7 @@ index_sz(LogUpdIndex *x) if (op == _enter_lu_pred) { PredEntry *ap = x->ClPred; OPCODE endop, op1; + UInt count = 0, count0 = start->u.Ill.s, dead=0; if (ap->PredFlags & CountPredFlag) endop = Yap_opcode(_count_trust_logical); @@ -3647,8 +3654,17 @@ index_sz(LogUpdIndex *x) do { sz += (UInt)NEXTOP((yamop*)NULL,lld); op1 = start->opc; + count++; + if (start->u.lld.d->ClFlags & ErasedMask) + dead++; start = start->u.lld.n; } while (op1 != endop); + if (x->ClFlags & InUseMask) + fprintf(stderr,"Inuse -- %p(%p)\n",ap,x); + if (x->ClFlags & DirtyMask) + fprintf(stderr,"Dirty -- %p(%p)\n",ap,x); + if (count > 200) + fprintf(stderr,"%d/%d/%d -- %p(%p)\n",count,count0,dead,ap,x); } x = x->ChildIndex; while (x != NULL) { diff --git a/C/index.c b/C/index.c index 7bc57c096..f4f3c4b5d 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2006-10-10 14:08:16 $,$Author: vsc $ * +* Last rev: $Date: 2006-10-11 14:53:57 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.170 2006/10/10 14:08:16 vsc +* small fixes on threaded implementation. +* * Revision 1.169 2006/09/20 20:03:51 vsc * improve indexing on floats * fix sending large lists to DB @@ -6153,6 +6156,10 @@ remove_clause_from_index(yamop **prevp, yamop *curp, LogUpdClause *cl) ocurp->u.lld.n = curp->u.lld.n; ocurp->u.lld.t.block = curp->u.lld.t.block; } +#ifdef DEBUG + Yap_DirtyCps--; + Yap_FreedCps++; +#endif clean_ref_to_clause(cl); Yap_FreeCodeSpace((ADDR)curp); } @@ -6173,6 +6180,10 @@ remove_dirty_clauses_from_index(yamop **prevp, yamop *curp) while ((cl = curp->u.lld.d)->ClFlags & ErasedMask) { yamop *ocurp = curp; +#ifdef DEBUG + Yap_DirtyCps--; + Yap_FreedCps++; +#endif clean_ref_to_clause(cl); curp = curp->u.lld.n; Yap_FreeCodeSpace((ADDR)ocurp); @@ -6187,6 +6198,10 @@ remove_dirty_clauses_from_index(yamop **prevp, yamop *curp) if ((cl = curp->u.lld.d)->ClFlags & ErasedMask) { yamop *ocurp = curp; +#ifdef DEBUG + Yap_DirtyCps--; + Yap_FreedCps++; +#endif clean_ref_to_clause(cl); if (curp->opc == endop) { previouscurp->opc = endop; @@ -6510,6 +6525,10 @@ add_try(PredEntry *ap, ClauseDef *cls, yamop *next, struct intermediates *cint) save_machine_regs(); longjmp(cint->CompilerBotch,2); } +#ifdef DEBUG + Yap_NewCps++; + Yap_LiveCps++; +#endif newcp->opc = Yap_opcode(_try_logical); newcp->u.lld.t.s = ap->ArityOfPE; newcp->u.lld.n = next; @@ -6531,6 +6550,10 @@ add_trust(LogUpdIndex *icl, ClauseDef *cls, struct intermediates *cint) save_machine_regs(); longjmp(cint->CompilerBotch,2); } +#ifdef DEBUG + Yap_NewCps++; + Yap_LiveCps++; +#endif if (ap->PredFlags & CountPredFlag) newcp->opc = Yap_opcode(_count_trust_logical); else if (ap->PredFlags & ProfiledPredFlag) @@ -7172,6 +7195,10 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg break; case _enter_lu_pred: ipc->u.Ill.s--; +#ifdef DEBUG + Yap_DirtyCps++; + Yap_LiveCps--; +#endif sp = kill_clause(ipc, bg, lt, sp, ap); ipc = pop_path(&sp, cls, ap); break; diff --git a/C/init.c b/C/init.c index d7a7501d9..3a25421d9 100644 --- a/C/init.c +++ b/C/init.c @@ -1021,6 +1021,12 @@ InitCodes(void) pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); Yap_heap_regs->spy_code = pred; } +#if DEBUG + Yap_heap_regs->new_cps = 0; + Yap_heap_regs->live_cps = 0; + Yap_heap_regs->dirty_cps = 0; + Yap_heap_regs->freed_cps = 0; +#endif Yap_heap_regs->system_profiling = FALSE; Yap_heap_regs->system_call_counting = FALSE; Yap_heap_regs->system_pred_goal_expansion_all = FALSE; diff --git a/H/Heap.h b/H/Heap.h index ab88d9053..de15fde45 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.106 2006-10-10 14:08:17 vsc Exp $ * +* version: $Id: Heap.h,v 1.107 2006-10-11 14:53:57 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -288,6 +288,9 @@ typedef struct various_codes { struct pred_entry *creep_code; struct pred_entry *undef_code; struct pred_entry *spy_code; +#if DEBUG + UInt new_cps, live_cps, dirty_cps, freed_cps; +#endif int system_profiling; int system_call_counting; int system_pred_goal_expansion_all; @@ -926,6 +929,12 @@ struct various_codes *Yap_heap_regs; #define CreepCode Yap_heap_regs->creep_code #define UndefCode Yap_heap_regs->undef_code #define SpyCode Yap_heap_regs->spy_code +#ifdef DEBUG +#define Yap_NewCps Yap_heap_regs->new_cps +#define Yap_LiveCps Yap_heap_regs->live_cps +#define Yap_DirtyCps Yap_heap_regs->dirty_cps +#define Yap_FreedCps Yap_heap_regs->freed_cps +#endif #if defined(YAPOR) || defined(TABLING) #define GLOBAL Yap_heap_regs->global #define REMOTE Yap_heap_regs->remote