fix overflow from within clause/2
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1149 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
6e0defe923
commit
8eb1d2f7b9
23
C/absmi.c
23
C/absmi.c
|
|
@ -10,8 +10,17 @@
|
|||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2004-09-27 20:45:02 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-09-30 19:51:53 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.146 2004/09/27 20:45:02 vsc
|
||||
* Mega clauses
|
||||
* Fixes to sizeof(expand_clauses) which was being overestimated
|
||||
* Fixes to profiling+indexing
|
||||
* Fixes to reallocation of memory after restoring
|
||||
* Make sure all clauses, even for C, end in _Ystop
|
||||
* Don't reuse space for Streams
|
||||
* Fix Stream_F on StreaNo+1
|
||||
*
|
||||
* Revision 1.145 2004/09/17 20:47:35 vsc
|
||||
* fix some overflows recorded.
|
||||
*
|
||||
|
|
@ -3561,7 +3570,7 @@ Yap_absmi(int inp)
|
|||
|
||||
deref_body(d0, pt0, gatom_6eunk, gatom_6enonvar);
|
||||
/* argument is a variable */
|
||||
BIND(pt0, PREG->u.cccccc.c4, gatom_6f);
|
||||
BIND(pt0, PREG->u.cccccc.c5, gatom_6f);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
if (pt0 < H0) Yap_WakeUp(pt0);
|
||||
|
|
@ -7068,7 +7077,7 @@ Yap_absmi(int inp)
|
|||
ASP = (CELL *) B;
|
||||
}
|
||||
saveregs();
|
||||
Yap_IPred(ap);
|
||||
Yap_IPred(ap, 0);
|
||||
/* IPred can generate errors, it thus must get rid of the lock itself */
|
||||
setregs();
|
||||
CACHED_A1() = ARG1;
|
||||
|
|
@ -7116,7 +7125,7 @@ Yap_absmi(int inp)
|
|||
}
|
||||
#endif
|
||||
saveregs();
|
||||
pt0 = Yap_ExpandIndex(pe);
|
||||
pt0 = Yap_ExpandIndex(pe, 0);
|
||||
/* restart index */
|
||||
setregs();
|
||||
UNLOCK(pe->PELock);
|
||||
|
|
@ -7158,7 +7167,7 @@ Yap_absmi(int inp)
|
|||
}
|
||||
#endif
|
||||
saveregs();
|
||||
pt0 = Yap_ExpandIndex(pe);
|
||||
pt0 = Yap_ExpandIndex(pe, 0);
|
||||
/* restart index */
|
||||
setregs();
|
||||
UNLOCK(pe->PELock);
|
||||
|
|
@ -12559,6 +12568,10 @@ Yap_absmi(int inp)
|
|||
PREG = pen->CodeOfPred;
|
||||
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
||||
E_YREG[E_CB] = (CELL)B;
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (Yap_do_low_level_trace)
|
||||
low_level_trace(enter_pred,pen,XREGS+1);
|
||||
#endif /* LOW_LEVEL_TRACER */
|
||||
#ifdef DEPTH_LIMIT
|
||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
||||
if (pen->ModuleOfPred) {
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: allocating space *
|
||||
* version:$Id: alloc.c,v 1.59 2004-09-28 18:37:05 vsc Exp $ *
|
||||
* version:$Id: alloc.c,v 1.60 2004-09-30 19:51:53 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
|
|
@ -308,8 +308,6 @@ AddToFreeList(BlockHeader *b)
|
|||
*q = b;
|
||||
}
|
||||
|
||||
static int vsc_count_b;
|
||||
|
||||
static void
|
||||
FreeBlock(BlockHeader *b)
|
||||
{
|
||||
|
|
@ -326,7 +324,6 @@ FreeBlock(BlockHeader *b)
|
|||
|
||||
/* sanity check */
|
||||
sp = &(b->b_size) + (b->b_size & ~InUseFlag);
|
||||
if (b == 0x8a04428) vsc_count_b++;
|
||||
if (!(b->b_size & InUseFlag) || *sp != b->b_size) {
|
||||
#if !SHORT_INTS
|
||||
fprintf(stderr, "%% YAP INTERNAL ERROR: sanity check failed in FreeBlock %p %x %x\n",
|
||||
|
|
|
|||
67
C/cdmgr.c
67
C/cdmgr.c
|
|
@ -12,8 +12,17 @@
|
|||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2004-09-27 20:45:02 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-09-30 19:51:53 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.133 2004/09/27 20:45:02 vsc
|
||||
* Mega clauses
|
||||
* Fixes to sizeof(expand_clauses) which was being overestimated
|
||||
* Fixes to profiling+indexing
|
||||
* Fixes to reallocation of memory after restoring
|
||||
* Make sure all clauses, even for C, end in _Ystop
|
||||
* Don't reuse space for Streams
|
||||
* Fix Stream_F on StreaNo+1
|
||||
*
|
||||
* Revision 1.132 2004/09/17 19:34:51 vsc
|
||||
* simplify frozen/2
|
||||
*
|
||||
|
|
@ -420,7 +429,7 @@ split_megaclause(PredEntry *ap)
|
|||
/* Index a prolog pred, given its predicate entry */
|
||||
/* ap is already locked. */
|
||||
static void
|
||||
IPred(PredEntry *ap)
|
||||
IPred(PredEntry *ap, UInt NSlots)
|
||||
{
|
||||
yamop *BaseAddr;
|
||||
|
||||
|
|
@ -465,7 +474,7 @@ IPred(PredEntry *ap)
|
|||
Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate");
|
||||
return;
|
||||
}
|
||||
if ((BaseAddr = Yap_PredIsIndexable(ap)) != NULL) {
|
||||
if ((BaseAddr = Yap_PredIsIndexable(ap, NSlots)) != NULL) {
|
||||
ap->cs.p_code.TrueCodeOfPred = BaseAddr;
|
||||
ap->PredFlags |= IndexedPredFlag;
|
||||
}
|
||||
|
|
@ -483,9 +492,9 @@ IPred(PredEntry *ap)
|
|||
}
|
||||
|
||||
void
|
||||
Yap_IPred(PredEntry *p)
|
||||
Yap_IPred(PredEntry *p, UInt NSlots)
|
||||
{
|
||||
IPred(p);
|
||||
IPred(p, NSlots);
|
||||
}
|
||||
|
||||
#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
|
||||
|
|
@ -2085,7 +2094,7 @@ p_setspy(void)
|
|||
return (FALSE);
|
||||
}
|
||||
if (pred->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pred);
|
||||
IPred(pred, 0);
|
||||
goto restart_spy;
|
||||
}
|
||||
fg = pred->PredFlags;
|
||||
|
|
@ -3432,19 +3441,14 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
|||
LogUpdClause *cl;
|
||||
Term rtn;
|
||||
Term Terms[3];
|
||||
long slh, slb, slr;
|
||||
|
||||
Yap_StartSlots();
|
||||
slh = Yap_InitSlot(th);
|
||||
slb = Yap_InitSlot(tb);
|
||||
slr = Yap_InitSlot(tr);
|
||||
Terms[0] = th;
|
||||
Terms[1] = tb;
|
||||
Terms[2] = tr;
|
||||
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
|
||||
th = Yap_GetFromSlot(slh);
|
||||
tb = Yap_GetFromSlot(slb);
|
||||
tr = Yap_GetFromSlot(slr);
|
||||
th = Terms[0];
|
||||
tb = Terms[1];
|
||||
tr = Terms[2];
|
||||
/* don't do this!! I might have stored a choice-point and changed ASP
|
||||
Yap_RecoverSlots(3);
|
||||
*/
|
||||
|
|
@ -3551,7 +3555,7 @@ p_log_update_clause(void)
|
|||
READ_LOCK(pe->PRWLock);
|
||||
PP = pe;
|
||||
#endif
|
||||
ret = fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
||||
ret = fetch_next_lu_clause(pe, pe->CodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
|
@ -3573,17 +3577,13 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
|
|||
{
|
||||
LogUpdClause *cl;
|
||||
Term Terms[3];
|
||||
long slh, slb;
|
||||
|
||||
Yap_StartSlots();
|
||||
slh = Yap_InitSlot(th);
|
||||
slb = Yap_InitSlot(tb);
|
||||
Terms[0] = th;
|
||||
Terms[1] = tb;
|
||||
Terms[2] = TermNil;
|
||||
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,l), cp_ptr);
|
||||
th = Yap_GetFromSlot(slh);
|
||||
tb = Yap_GetFromSlot(slb);
|
||||
th = Terms[0];
|
||||
tb = Terms[1];
|
||||
/* don't do this!! I might have stored a choice-point and changed ASP
|
||||
Yap_RecoverSlots(2);
|
||||
*/
|
||||
|
|
@ -3661,7 +3661,7 @@ p_log_update_clause0(void)
|
|||
READ_LOCK(pe->PRWLock);
|
||||
PP = pe;
|
||||
#endif
|
||||
ret = fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
|
||||
ret = fetch_next_lu_clause0(pe, pe->CodeOfPred, t1, ARG3, P, TRUE);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
|
@ -3684,19 +3684,14 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
|
|||
StaticClause *cl;
|
||||
Term rtn;
|
||||
Term Terms[3];
|
||||
long slh, slb, slr;
|
||||
|
||||
Yap_StartSlots();
|
||||
slh = Yap_InitSlot(th);
|
||||
slb = Yap_InitSlot(tb);
|
||||
slr = Yap_InitSlot(tr);
|
||||
Terms[0] = th;
|
||||
Terms[1] = tb;
|
||||
Terms[2] = tr;
|
||||
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
|
||||
th = Yap_GetFromSlot(slh);
|
||||
tb = Yap_GetFromSlot(slb);
|
||||
tr = Yap_GetFromSlot(slr);
|
||||
th = Terms[0];
|
||||
tb = Terms[1];
|
||||
tr = Terms[2];
|
||||
/* don't do this!! I might have stored a choice-point and changed ASP
|
||||
Yap_RecoverSlots(3);
|
||||
*/
|
||||
|
|
@ -3791,15 +3786,7 @@ p_static_clause(void)
|
|||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
WRITE_LOCK(pe->PRWLock);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (pe->OpcodeOfPred == INDEX_OPCODE)
|
||||
#endif
|
||||
IPred(pe);
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
}
|
||||
return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, ARG1, ARG3, ARG4, P, TRUE);
|
||||
return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, P, TRUE);
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
|
|
@ -3831,7 +3818,7 @@ p_nth_clause(void)
|
|||
XREGS[2] = MkVarTerm();
|
||||
}
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pe);
|
||||
IPred(pe, 0);
|
||||
}
|
||||
cl = Yap_NthClause(pe, ncls);
|
||||
if (cl == NULL)
|
||||
|
|
|
|||
118
C/heapgc.c
118
C/heapgc.c
|
|
@ -1089,7 +1089,13 @@ mark_variable(CELL_PTR current)
|
|||
inc_var(current, current);
|
||||
#endif
|
||||
*next = (CELL)current;
|
||||
#if GC_NO_TAGS
|
||||
UNMARK(next);
|
||||
MARK(current);
|
||||
*current = (CELL)current;
|
||||
#else
|
||||
*current = MARK_CELL((CELL)current);
|
||||
#endif
|
||||
POP_CONTINUATION();
|
||||
} else {
|
||||
/* can't help here */
|
||||
|
|
@ -1101,6 +1107,9 @@ mark_variable(CELL_PTR current)
|
|||
} else {
|
||||
/* binding to a determinate reference */
|
||||
if (next >= HB && current < LCL0 && cnext != TermFoundVar) {
|
||||
#if GC_NO_TAGS
|
||||
UNMARK(current);
|
||||
#endif
|
||||
*current = cnext;
|
||||
total_marked--;
|
||||
POP_POINTER();
|
||||
|
|
@ -1116,6 +1125,9 @@ mark_variable(CELL_PTR current)
|
|||
current < LCL0) {
|
||||
/* This step is possible because we clean up the trail */
|
||||
*current = UNMARK_CELL(cnext);
|
||||
#if GC_NO_TAGS
|
||||
UNMARK(current);
|
||||
#endif
|
||||
total_marked--;
|
||||
POP_POINTER();
|
||||
} else
|
||||
|
|
@ -1187,6 +1199,9 @@ mark_variable(CELL_PTR current)
|
|||
switch (cnext) {
|
||||
case (CELL)FunctorLongInt:
|
||||
MARK(next);
|
||||
#if GC_NO_TAGS
|
||||
MARK(next+2);
|
||||
#endif
|
||||
total_marked += 3;
|
||||
PUSH_POINTER(next);
|
||||
PUSH_POINTER(next+1);
|
||||
|
|
@ -1200,6 +1215,11 @@ mark_variable(CELL_PTR current)
|
|||
PUSH_POINTER(next+2);
|
||||
#if SIZEOF_DOUBLE==2*SIZEOF_LONG_INT
|
||||
PUSH_POINTER(next+3);
|
||||
#if GC_NO_TAGS
|
||||
MARK(next+3);
|
||||
#endif
|
||||
#elif GC_NO_TAGS
|
||||
MARK(next+2);
|
||||
#endif
|
||||
POP_CONTINUATION();
|
||||
#ifdef USE_GMP
|
||||
|
|
@ -1214,8 +1234,12 @@ mark_variable(CELL_PTR current)
|
|||
PUSH_POINTER(next);
|
||||
for (i = 1; i <= (sizeof(MP_INT)+
|
||||
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
|
||||
i++)
|
||||
i++) {
|
||||
PUSH_POINTER(next+i);
|
||||
}
|
||||
#if GC_NO_TAGS
|
||||
MARK(next+i);
|
||||
#endif
|
||||
PUSH_POINTER(next+i);
|
||||
}
|
||||
POP_CONTINUATION();
|
||||
|
|
@ -1645,12 +1669,14 @@ static void
|
|||
mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
{
|
||||
|
||||
yamop *lu_cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld), *lu_cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld), *su_cl = NEXTOP(PredStaticClause->CodeOfPred,ld);
|
||||
yamop *lu_cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld),
|
||||
*lu_cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld),
|
||||
*su_cl = NEXTOP(PredStaticClause->CodeOfPred,ld);
|
||||
#ifdef TABLING
|
||||
dep_fr_ptr depfr = LOCAL_top_dep_fr;
|
||||
dep_fr_ptr depfr = LOCAL_top_dep_fr;
|
||||
#endif
|
||||
#ifdef EASY_SHUNTING
|
||||
HB = H;
|
||||
HB = H;
|
||||
#endif
|
||||
|
||||
while (gc_B != NULL) {
|
||||
|
|
@ -1689,9 +1715,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
|||
if (pe == NULL) {
|
||||
fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, op_names[opnum]);
|
||||
} else if (pe->ArityOfPE) {
|
||||
fprintf(Yap_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
|
||||
fprintf(Yap_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
|
||||
} else {
|
||||
fprintf(Yap_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]);
|
||||
fprintf(Yap_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]);
|
||||
}
|
||||
}
|
||||
{
|
||||
|
|
@ -1715,7 +1741,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
|||
(CELL *)(gc_B->cp_cp->u.ldl.bl)
|
||||
#else
|
||||
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)),
|
||||
gc_B->cp_cp->u.sla.bmap
|
||||
gc_B->cp_cp->u.sla.bmap
|
||||
#endif
|
||||
);
|
||||
} else {
|
||||
|
|
@ -1731,9 +1757,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
|||
#ifdef TABLING
|
||||
if (opnum != _table_completion)
|
||||
#endif
|
||||
mark_environments((CELL_PTR) gc_B->cp_env,
|
||||
EnvSize((CELL_PTR) (gc_B->cp_cp)),
|
||||
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
|
||||
mark_environments((CELL_PTR) gc_B->cp_env,
|
||||
EnvSize((CELL_PTR) (gc_B->cp_cp)),
|
||||
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
|
||||
/* extended choice point */
|
||||
restart_cp:
|
||||
switch (opnum) {
|
||||
|
|
@ -1786,7 +1812,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
|||
{
|
||||
CELL *answ_fr;
|
||||
CELL vars;
|
||||
|
||||
|
||||
/* fetch the solution */
|
||||
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->ccp_dep_fr);
|
||||
vars = *answ_fr++;
|
||||
|
|
@ -1961,19 +1987,32 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
|
|||
register CELL ccur = *current, cnext = *next;
|
||||
|
||||
if (IsVarTerm(ccur)) {
|
||||
#if GC_NO_TAGS
|
||||
RMARK(next);
|
||||
*current = UNMARKED(cnext);
|
||||
#else
|
||||
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
|
||||
UNMARKED(cnext) );
|
||||
*next = (MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current;
|
||||
#endif
|
||||
} else if (IsPairTerm(ccur)) {
|
||||
#if GC_NO_TAGS
|
||||
*next = current;
|
||||
#else
|
||||
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
|
||||
UNMARKED(cnext) );
|
||||
*next = AbsPair((CELL *)
|
||||
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
|
||||
#endif
|
||||
} else if (IsApplTerm(ccur)) {
|
||||
#if GC_NO_TAGS
|
||||
*next = AbsPair((CELL *)current);
|
||||
#else
|
||||
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
|
||||
UNMARKED(cnext) );
|
||||
*next = AbsAppl((CELL *)
|
||||
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
|
||||
#endif
|
||||
} else {
|
||||
fprintf(Yap_stderr," OH MY GOD !!!!!!!!!!!!\n");
|
||||
}
|
||||
|
|
@ -1981,12 +2020,22 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
|
|||
CELL current_tag;
|
||||
|
||||
current_tag = TAG(*current);
|
||||
#if GC_NO_TAGS
|
||||
if (RMARKED(next))
|
||||
RMARK(current);
|
||||
else
|
||||
UNRMARK(current);
|
||||
*current = *next;
|
||||
*next = (CELL) current | current_tag;
|
||||
RMARK(next);
|
||||
#else
|
||||
*current = (*current & MBIT) | (*next & ~MBIT);
|
||||
#if INVERT_RBIT
|
||||
*next = ((*next & MBIT) | (CELL) current | current_tag) & ~RBIT;
|
||||
#else
|
||||
*next = (*next & MBIT) | RBIT | (CELL) current | current_tag;
|
||||
#endif
|
||||
#endif /* GC_NO_TAGS */
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
@ -2677,7 +2726,7 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
|
|||
CELL ccur = *current;
|
||||
|
||||
#ifdef TAGS_FAST_OPS
|
||||
while (RMARKED(ccur)) {
|
||||
while (RMARKED(current)) {
|
||||
register CELL cnext;
|
||||
|
||||
next = GET_NEXT(ccur);
|
||||
|
|
@ -2710,16 +2759,26 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
|
|||
#endif
|
||||
}
|
||||
#else /* TAGS_FAST_OPS */
|
||||
while (RMARKED(ccur)) {
|
||||
while (RMARKED(current)) {
|
||||
CELL current_tag;
|
||||
next = GET_NEXT(ccur);
|
||||
current_tag = TAG(ccur);
|
||||
#if GC_NO_TAGS
|
||||
ccur = *current = *next;
|
||||
if (RMARKED(next))
|
||||
RMARK(current);
|
||||
else
|
||||
UNRMARK(current);
|
||||
*next = (CELL) dest | current_tag;
|
||||
UNRMARK(next);
|
||||
#else
|
||||
ccur = *current = (ccur & MBIT) | (*next & ~MBIT);
|
||||
#if INVERT_RBIT
|
||||
*next = (*next & MBIT) | (CELL) dest | current_tag | RBIT;
|
||||
#else
|
||||
*next = (*next & MBIT) | (CELL) dest | current_tag;
|
||||
#endif
|
||||
#endif /* GC_NO_TAGS */
|
||||
}
|
||||
#endif /* TAGS_FAST_OPS */
|
||||
}
|
||||
|
|
@ -2795,6 +2854,9 @@ compact_heap(void)
|
|||
{
|
||||
CELL tmp = current[0];
|
||||
current[0] = ptr[1];
|
||||
#if GC_NO_TAGS
|
||||
MARK(ptr+1);
|
||||
#endif
|
||||
ptr[1] = tmp;
|
||||
}
|
||||
if (in_garbage > 0) {
|
||||
|
|
@ -2826,9 +2888,15 @@ compact_heap(void)
|
|||
if (next < current) /* push into reloc.
|
||||
* chain */
|
||||
into_relocation_chain(current, next);
|
||||
else if (current == next) /* cell pointing to
|
||||
else if (current == next) { /* cell pointing to
|
||||
* itself */
|
||||
#if GC_NO_TAGS
|
||||
UNRMARK(current);
|
||||
*current = (CELL) dest; /* no tag */
|
||||
#else
|
||||
*current = (*current & MBIT) | (CELL) dest; /* no tag */
|
||||
#endif
|
||||
}
|
||||
}
|
||||
dest--;
|
||||
} else {
|
||||
|
|
@ -3010,6 +3078,9 @@ icompact_heap(void)
|
|||
{
|
||||
CELL tmp = current[0];
|
||||
current[0] = ptr[1];
|
||||
#if GC_NO_TAGS
|
||||
MARK(ptr+1);
|
||||
#endif
|
||||
ptr[1] = tmp;
|
||||
}
|
||||
current = ptr;
|
||||
|
|
@ -3024,9 +3095,14 @@ icompact_heap(void)
|
|||
if (next < current) /* push into reloc.
|
||||
* chain */
|
||||
into_relocation_chain(current, next);
|
||||
else if (current == next) /* cell pointing to
|
||||
* itself */
|
||||
else if (current == next) { /* cell pointing to
|
||||
* itself */
|
||||
#if GC_NO_TAGS
|
||||
*current = (CELL) (H0+(iptr-ibase)); /* no tag */
|
||||
#else
|
||||
*current = (*current & MBIT) | (CELL) (H0+(iptr-ibase)); /* no tag */
|
||||
#endif
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -3206,10 +3282,13 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
|
|||
#endif /* HYBRID_SCHEME */
|
||||
{
|
||||
#ifdef DEBUG
|
||||
#ifdef HYBID_SCHEME
|
||||
/*
|
||||
#ifdef HYBRID_SCHEME
|
||||
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
|
||||
fprintf(stderr,"%% not using pointers (%d) ASP: %p, ip %p (expected %p) \n", effectiveness, ASP, iptop, H+total_marked);
|
||||
|
||||
#endif
|
||||
*/
|
||||
#endif
|
||||
compact_heap();
|
||||
}
|
||||
|
|
@ -3267,6 +3346,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
|||
#endif
|
||||
if (Yap_GetValue(AtomGcTrace) != TermNil)
|
||||
gc_trace = 1;
|
||||
#if !GC_NO_TAGS
|
||||
/* sanity check: can we still do garbage_collection ? */
|
||||
if ((CELL)Yap_TrailTop & (MBIT|RBIT)) {
|
||||
/* oops, we can't */
|
||||
|
|
@ -3276,6 +3356,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
|||
}
|
||||
return(0);
|
||||
}
|
||||
#endif
|
||||
if (gc_trace) {
|
||||
fprintf(Yap_stderr, "[gc]\n");
|
||||
} else if (gc_verbose) {
|
||||
|
|
@ -3311,7 +3392,10 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
|||
bp = Yap_PreAllocCodeSpace();
|
||||
if (bp+alloc_sz > (char *)AuxSp) {
|
||||
/* not enough space */
|
||||
*--ASP = (CELL)current_env;
|
||||
bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz);
|
||||
current_env = (CELL *)*ASP;
|
||||
ASP++;
|
||||
}
|
||||
if (!bp)
|
||||
return 0;
|
||||
|
|
|
|||
71
C/index.c
71
C/index.c
|
|
@ -11,8 +11,17 @@
|
|||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2004-09-27 20:45:03 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-09-30 19:51:54 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.99 2004/09/27 20:45:03 vsc
|
||||
* Mega clauses
|
||||
* Fixes to sizeof(expand_clauses) which was being overestimated
|
||||
* Fixes to profiling+indexing
|
||||
* Fixes to reallocation of memory after restoring
|
||||
* Make sure all clauses, even for C, end in _Ystop
|
||||
* Don't reuse space for Streams
|
||||
* Fix Stream_F on StreaNo+1
|
||||
*
|
||||
* Revision 1.98 2004/09/14 03:30:06 vsc
|
||||
* make sure that condor version always grows trail!
|
||||
*
|
||||
|
|
@ -3961,7 +3970,7 @@ compile_index(struct intermediates *cint)
|
|||
|
||||
|
||||
yamop *
|
||||
Yap_PredIsIndexable(PredEntry *ap)
|
||||
Yap_PredIsIndexable(PredEntry *ap, UInt NSlots)
|
||||
{
|
||||
yamop *indx_out;
|
||||
int setjres;
|
||||
|
|
@ -3973,7 +3982,7 @@ Yap_PredIsIndexable(PredEntry *ap)
|
|||
if ((setjres = setjmp(cint.CompilerBotch)) == 3) {
|
||||
restore_machine_regs();
|
||||
recover_from_failed_susp_on_cls(&cint, 0);
|
||||
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
|
||||
Yap_gcl(Yap_Error_Size, ap->ArityOfPE+NSlots, ENV, CP);
|
||||
} else if (setjres == 2) {
|
||||
restore_machine_regs();
|
||||
Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size);
|
||||
|
|
@ -4909,7 +4918,7 @@ expand_index(struct intermediates *cint) {
|
|||
|
||||
|
||||
static yamop *
|
||||
ExpandIndex(PredEntry *ap) {
|
||||
ExpandIndex(PredEntry *ap, int ExtraArgs) {
|
||||
yamop *indx_out;
|
||||
yamop **labp;
|
||||
int cb;
|
||||
|
|
@ -4919,7 +4928,7 @@ ExpandIndex(PredEntry *ap) {
|
|||
restore_machine_regs();
|
||||
/* grow stack */
|
||||
recover_from_failed_susp_on_cls(&cint, 0);
|
||||
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
|
||||
Yap_gcl(Yap_Error_Size, ap->ArityOfPE+ExtraArgs, ENV, CP);
|
||||
} else if (cb == 2) {
|
||||
restore_machine_regs();
|
||||
Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size);
|
||||
|
|
@ -5054,8 +5063,8 @@ ExpandIndex(PredEntry *ap) {
|
|||
}
|
||||
|
||||
yamop *
|
||||
Yap_ExpandIndex(PredEntry *ap) {
|
||||
return ExpandIndex(ap);
|
||||
Yap_ExpandIndex(PredEntry *ap, UInt nargs) {
|
||||
return ExpandIndex(ap, nargs);
|
||||
}
|
||||
|
||||
static path_stack_entry *
|
||||
|
|
@ -7794,28 +7803,26 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
|||
break;
|
||||
case _expand_index:
|
||||
case _expand_clauses:
|
||||
*H++ = (CELL)s_reg;
|
||||
*H++ = t;
|
||||
H[0] = Terms[0];
|
||||
H[1] = Terms[1];
|
||||
H[2] = Terms[2];
|
||||
H += 3;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
XREGS[ap->ArityOfPE+1] = (CELL)s_reg;
|
||||
XREGS[ap->ArityOfPE+2] = (CELL)t;
|
||||
XREGS[ap->ArityOfPE+3] = Terms[0];
|
||||
XREGS[ap->ArityOfPE+4] = Terms[1];
|
||||
XREGS[ap->ArityOfPE+5] = Terms[2];
|
||||
LOCK(ap->PELock);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (!same_lu_block(jlbl, ipc)) {
|
||||
ipc = *jlbl;
|
||||
UNLOCK(ap->PELock);
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
ipc = ExpandIndex(ap);
|
||||
ipc = ExpandIndex(ap, 5);
|
||||
UNLOCK(ap->PELock);
|
||||
H -= 3;
|
||||
Terms[0] = H[0];
|
||||
Terms[1] = H[1];
|
||||
Terms[2] = H[2];
|
||||
t = *--H;
|
||||
s_reg = (CELL *)(*--H);
|
||||
s_reg = (CELL *)XREGS[ap->ArityOfPE+1];
|
||||
t = XREGS[ap->ArityOfPE+2];
|
||||
Terms[0] = XREGS[ap->ArityOfPE+3];
|
||||
Terms[1] = XREGS[ap->ArityOfPE+4];
|
||||
Terms[2] = XREGS[ap->ArityOfPE+5];
|
||||
break;
|
||||
case _op_fail:
|
||||
/*
|
||||
|
|
@ -7836,10 +7843,24 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
|||
ipc = ap->CodeOfPred;
|
||||
break;
|
||||
#endif
|
||||
case _index_pred:
|
||||
case _spy_pred:
|
||||
Yap_IPred(ap);
|
||||
if (!(ap->PredFlags & MetaPredFlag)) {
|
||||
ipc = ap->cs.p_code.TrueCodeOfPred;
|
||||
break;
|
||||
}
|
||||
case _index_pred:
|
||||
XREGS[ap->ArityOfPE+1] = (CELL)s_reg;
|
||||
XREGS[ap->ArityOfPE+2] = (CELL)t;
|
||||
XREGS[ap->ArityOfPE+3] = Terms[0];
|
||||
XREGS[ap->ArityOfPE+4] = Terms[1];
|
||||
XREGS[ap->ArityOfPE+5] = Terms[2];
|
||||
Yap_IPred(ap, 5);
|
||||
start_pc = ipc = ap->cs.p_code.TrueCodeOfPred;
|
||||
s_reg = (CELL *)XREGS[ap->ArityOfPE+1];
|
||||
t = XREGS[ap->ArityOfPE+2];
|
||||
Terms[0] = XREGS[ap->ArityOfPE+3];
|
||||
Terms[1] = XREGS[ap->ArityOfPE+4];
|
||||
Terms[2] = XREGS[ap->ArityOfPE+5];
|
||||
break;
|
||||
default:
|
||||
if (b0) {
|
||||
|
|
@ -8071,7 +8092,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
|
|||
break;
|
||||
}
|
||||
#endif
|
||||
ipc = ExpandIndex(ap);
|
||||
ipc = ExpandIndex(ap, 0);
|
||||
UNLOCK(ap->PELock);
|
||||
break;
|
||||
case _op_fail:
|
||||
|
|
@ -8079,7 +8100,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
|
|||
break;
|
||||
case _index_pred:
|
||||
case _spy_pred:
|
||||
Yap_IPred(ap);
|
||||
Yap_IPred(ap, 0);
|
||||
ipc = ap->cs.p_code.TrueCodeOfPred;
|
||||
break;
|
||||
case _undef_p:
|
||||
|
|
|
|||
|
|
@ -184,7 +184,7 @@ wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
|
|||
void STD_PROTO(Yap_InitComma,(void));
|
||||
|
||||
/* cdmgr.c */
|
||||
void STD_PROTO(Yap_IPred,(PredEntry *));
|
||||
void STD_PROTO(Yap_IPred,(PredEntry *, UInt));
|
||||
void STD_PROTO(Yap_addclause,(Term,yamop *,int,Term));
|
||||
void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int));
|
||||
void STD_PROTO(Yap_kill_iblock,(ClauseUnion *,ClauseUnion *,PredEntry *));
|
||||
|
|
@ -201,8 +201,8 @@ void STD_PROTO(Yap_ErLogUpdIndex,(LogUpdIndex *));
|
|||
Term STD_PROTO(Yap_cp_as_integer,(choiceptr));
|
||||
|
||||
/* index.c */
|
||||
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *));
|
||||
yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *));
|
||||
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *, UInt));
|
||||
yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *, UInt));
|
||||
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
|
||||
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
|
||||
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
|
||||
|
|
@ -282,7 +282,7 @@ Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc)
|
|||
{
|
||||
Term t[2];
|
||||
t[0] = MkIntegerTerm((Int)ap);
|
||||
t[0] = MkIntegerTerm((Int)ipc);
|
||||
t[1] = MkIntegerTerm((Int)ipc);
|
||||
return Yap_MkApplTerm(FunctorMegaClause,2,t);
|
||||
}
|
||||
|
||||
|
|
|
|||
12
H/heapgc.h
12
H/heapgc.h
|
|
@ -16,6 +16,7 @@
|
|||
*************************************************************************/
|
||||
|
||||
|
||||
|
||||
/* macros used by garbage collection */
|
||||
|
||||
#if TAG_64BITS
|
||||
|
|
@ -126,7 +127,8 @@ UNRMARK(CELL* ptr)
|
|||
static inline int
|
||||
RMARKED(CELL* ptr)
|
||||
{
|
||||
return !GCIsPrimitiveTerm(*ptr) && (mcell(ptr) & RMARK_BIT);
|
||||
CELL val = *ptr;
|
||||
return !GCIsPrimitiveTerm(val) && (mcell(ptr) & RMARK_BIT);
|
||||
}
|
||||
|
||||
#else
|
||||
|
|
@ -158,8 +160,8 @@ RMARKED(CELL* ptr)
|
|||
|
||||
#ifdef TAGS_FAST_OPS
|
||||
|
||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && (IsVarTerm(val) ?\
|
||||
((val) & RBIT) : !((val) & RBIT)))
|
||||
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && (IsVarTerm(*(ptr)) ?\
|
||||
((*(ptr)) & RBIT) : !((*(ptr)) & RBIT)))
|
||||
|
||||
#define UNMARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\
|
||||
? \
|
||||
|
|
@ -170,9 +172,9 @@ RMARKED(CELL* ptr)
|
|||
#else
|
||||
|
||||
#if INVERT_RBIT
|
||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && !((val) & RBIT))
|
||||
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && !((*(ptr)) & RBIT))
|
||||
#else
|
||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && ((val) & RBIT))
|
||||
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && ((*(ptr)) & RBIT))
|
||||
#endif
|
||||
|
||||
#endif /* GC_NO_TAGS */
|
||||
|
|
|
|||
|
|
@ -10,9 +10,11 @@
|
|||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h.m4,v 1.66 2004-09-18 14:03:42 vsc Exp $ *
|
||||
* version: $Id: Yap.h.m4,v 1.67 2004-09-30 19:51:54 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#define GC_NO_TAGS 1
|
||||
|
||||
#include "config.h"
|
||||
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -166,11 +166,16 @@ reconsult(Fs) :-
|
|||
'$include'(X, Status) :-
|
||||
'$find_in_path'(X,Y,include(X)),
|
||||
'$values'('$included_file',OY,Y),
|
||||
'$current_module'(Mod),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
( '$open'(Y,'$csult',Stream,0), !,
|
||||
'$print_message'(informational, loading(including, Y)),
|
||||
'$loop'(Stream,Status), '$close'(Stream)
|
||||
;
|
||||
'$do_error'(permission_error(input,stream,Y),include(X))
|
||||
),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(informational, loaded(included, Y, Mod, T, H)),
|
||||
set_value('$included_file',OY).
|
||||
|
||||
'$do_startup_reconsult'(X) :-
|
||||
|
|
|
|||
Reference in New Issue