fix memory leak

fix overflow handling
VS: ----------------------------------------------------------------------


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1702 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-10-11 14:53:57 +00:00
parent a6365ffdea
commit d3dab0f5a1
7 changed files with 185 additions and 10 deletions

View File

@ -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 {

View File

@ -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

111
C/cdmgr.c
View File

@ -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
}

View File

@ -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) {

View File

@ -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;

View File

@ -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;

View File

@ -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