diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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 2004-09-30 19:51:54 +00:00
parent 6e0defe923
commit 8eb1d2f7b9
9 changed files with 212 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
C/absmi.c
View File

@ -10,8 +10,17 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * 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 $ * $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 * Revision 1.145 2004/09/17 20:47:35 vsc
* fix some overflows recorded. * fix some overflows recorded.
* *
@ -3561,7 +3570,7 @@ Yap_absmi(int inp)
deref_body(d0, pt0, gatom_6eunk, gatom_6enonvar); deref_body(d0, pt0, gatom_6eunk, gatom_6enonvar);
/* argument is a variable */ /* argument is a variable */
BIND(pt0, PREG->u.cccccc.c4, gatom_6f); BIND(pt0, PREG->u.cccccc.c5, gatom_6f);
#ifdef COROUTINING #ifdef COROUTINING
DO_TRAIL(pt0, d1); DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0); if (pt0 < H0) Yap_WakeUp(pt0);
@ -7068,7 +7077,7 @@ Yap_absmi(int inp)
ASP = (CELL *) B; ASP = (CELL *) B;
} }
saveregs(); saveregs();
Yap_IPred(ap); Yap_IPred(ap, 0);
/* IPred can generate errors, it thus must get rid of the lock itself */ /* IPred can generate errors, it thus must get rid of the lock itself */
setregs(); setregs();
CACHED_A1() = ARG1; CACHED_A1() = ARG1;
@ -7116,7 +7125,7 @@ Yap_absmi(int inp)
} }
#endif #endif
saveregs(); saveregs();
pt0 = Yap_ExpandIndex(pe); pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */ /* restart index */
setregs(); setregs();
UNLOCK(pe->PELock); UNLOCK(pe->PELock);
@ -7158,7 +7167,7 @@ Yap_absmi(int inp)
} }
#endif #endif
saveregs(); saveregs();
pt0 = Yap_ExpandIndex(pe); pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */ /* restart index */
setregs(); setregs();
UNLOCK(pe->PELock); UNLOCK(pe->PELock);
@ -12559,6 +12568,10 @@ Yap_absmi(int inp)
PREG = pen->CodeOfPred; PREG = pen->CodeOfPred;
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
E_YREG[E_CB] = (CELL)B; 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 #ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) { if (pen->ModuleOfPred) {

5
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * 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 #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -308,8 +308,6 @@ AddToFreeList(BlockHeader *b)
*q = b; *q = b;
} }
static int vsc_count_b;
static void static void
FreeBlock(BlockHeader *b) FreeBlock(BlockHeader *b)
{ {
@ -326,7 +324,6 @@ FreeBlock(BlockHeader *b)
/* sanity check */ /* sanity check */
sp = &(b->b_size) + (b->b_size & ~InUseFlag); sp = &(b->b_size) + (b->b_size & ~InUseFlag);
if (b == 0x8a04428) vsc_count_b++;
if (!(b->b_size & InUseFlag) || *sp != b->b_size) { if (!(b->b_size & InUseFlag) || *sp != b->b_size) {
#if !SHORT_INTS #if !SHORT_INTS
fprintf(stderr, "%% YAP INTERNAL ERROR: sanity check failed in FreeBlock %p %x %x\n", fprintf(stderr, "%% YAP INTERNAL ERROR: sanity check failed in FreeBlock %p %x %x\n",

67
C/cdmgr.c
View File

@ -12,8 +12,17 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * 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 $ * $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 * Revision 1.132 2004/09/17 19:34:51 vsc
* simplify frozen/2 * simplify frozen/2
* *
@ -420,7 +429,7 @@ split_megaclause(PredEntry *ap)
/* Index a prolog pred, given its predicate entry */ /* Index a prolog pred, given its predicate entry */
/* ap is already locked. */ /* ap is already locked. */
static void static void
IPred(PredEntry *ap) IPred(PredEntry *ap, UInt NSlots)
{ {
yamop *BaseAddr; yamop *BaseAddr;
@ -465,7 +474,7 @@ IPred(PredEntry *ap)
Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate"); Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate");
return; return;
} }
if ((BaseAddr = Yap_PredIsIndexable(ap)) != NULL) { if ((BaseAddr = Yap_PredIsIndexable(ap, NSlots)) != NULL) {
ap->cs.p_code.TrueCodeOfPred = BaseAddr; ap->cs.p_code.TrueCodeOfPred = BaseAddr;
ap->PredFlags |= IndexedPredFlag; ap->PredFlags |= IndexedPredFlag;
} }
@ -483,9 +492,9 @@ IPred(PredEntry *ap)
} }
void 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))) #define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->u.TYPE.next)))
@ -2085,7 +2094,7 @@ p_setspy(void)
return (FALSE); return (FALSE);
} }
if (pred->OpcodeOfPred == INDEX_OPCODE) { if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred(pred); IPred(pred, 0);
goto restart_spy; goto restart_spy;
} }
fg = pred->PredFlags; 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; LogUpdClause *cl;
Term rtn; Term rtn;
Term Terms[3]; 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[0] = th;
Terms[1] = tb; Terms[1] = tb;
Terms[2] = tr; Terms[2] = tr;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr); cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
th = Yap_GetFromSlot(slh); th = Terms[0];
tb = Yap_GetFromSlot(slb); tb = Terms[1];
tr = Yap_GetFromSlot(slr); tr = Terms[2];
/* don't do this!! I might have stored a choice-point and changed ASP /* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3); Yap_RecoverSlots(3);
*/ */
@ -3551,7 +3555,7 @@ p_log_update_clause(void)
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
PP = pe; PP = pe;
#endif #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; return ret;
} }
@ -3573,17 +3577,13 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
{ {
LogUpdClause *cl; LogUpdClause *cl;
Term Terms[3]; Term Terms[3];
long slh, slb;
Yap_StartSlots();
slh = Yap_InitSlot(th);
slb = Yap_InitSlot(tb);
Terms[0] = th; Terms[0] = th;
Terms[1] = tb; Terms[1] = tb;
Terms[2] = TermNil; Terms[2] = TermNil;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,l), cp_ptr); cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,l), cp_ptr);
th = Yap_GetFromSlot(slh); th = Terms[0];
tb = Yap_GetFromSlot(slb); tb = Terms[1];
/* don't do this!! I might have stored a choice-point and changed ASP /* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(2); Yap_RecoverSlots(2);
*/ */
@ -3661,7 +3661,7 @@ p_log_update_clause0(void)
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
PP = pe; PP = pe;
#endif #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; return ret;
} }
@ -3684,19 +3684,14 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
StaticClause *cl; StaticClause *cl;
Term rtn; Term rtn;
Term Terms[3]; 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[0] = th;
Terms[1] = tb; Terms[1] = tb;
Terms[2] = tr; Terms[2] = tr;
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr); cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
th = Yap_GetFromSlot(slh); th = Terms[0];
tb = Yap_GetFromSlot(slb); tb = Terms[1];
tr = Yap_GetFromSlot(slr); tr = Terms[2];
/* don't do this!! I might have stored a choice-point and changed ASP /* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3); Yap_RecoverSlots(3);
*/ */
@ -3791,15 +3786,7 @@ p_static_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
if(pe->OpcodeOfPred == INDEX_OPCODE) { return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, P, TRUE);
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);
} }
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
@ -3831,7 +3818,7 @@ p_nth_clause(void)
XREGS[2] = MkVarTerm(); XREGS[2] = MkVarTerm();
} }
if(pe->OpcodeOfPred == INDEX_OPCODE) { if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe); IPred(pe, 0);
} }
cl = Yap_NthClause(pe, ncls); cl = Yap_NthClause(pe, ncls);
if (cl == NULL) if (cl == NULL)

118
C/heapgc.c
View File

@ -1089,7 +1089,13 @@ mark_variable(CELL_PTR current)
inc_var(current, current); inc_var(current, current);
#endif #endif
*next = (CELL)current; *next = (CELL)current;
#if GC_NO_TAGS
UNMARK(next);
MARK(current);
*current = (CELL)current;
#else
*current = MARK_CELL((CELL)current); *current = MARK_CELL((CELL)current);
#endif
POP_CONTINUATION(); POP_CONTINUATION();
} else { } else {
/* can't help here */ /* can't help here */
@ -1101,6 +1107,9 @@ mark_variable(CELL_PTR current)
} else { } else {
/* binding to a determinate reference */ /* binding to a determinate reference */
if (next >= HB && current < LCL0 && cnext != TermFoundVar) { if (next >= HB && current < LCL0 && cnext != TermFoundVar) {
#if GC_NO_TAGS
UNMARK(current);
#endif
*current = cnext; *current = cnext;
total_marked--; total_marked--;
POP_POINTER(); POP_POINTER();
@ -1116,6 +1125,9 @@ mark_variable(CELL_PTR current)
current < LCL0) { current < LCL0) {
/* This step is possible because we clean up the trail */ /* This step is possible because we clean up the trail */
*current = UNMARK_CELL(cnext); *current = UNMARK_CELL(cnext);
#if GC_NO_TAGS
UNMARK(current);
#endif
total_marked--; total_marked--;
POP_POINTER(); POP_POINTER();
} else } else
@ -1187,6 +1199,9 @@ mark_variable(CELL_PTR current)
switch (cnext) { switch (cnext) {
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
MARK(next); MARK(next);
#if GC_NO_TAGS
MARK(next+2);
#endif
total_marked += 3; total_marked += 3;
PUSH_POINTER(next); PUSH_POINTER(next);
PUSH_POINTER(next+1); PUSH_POINTER(next+1);
@ -1200,6 +1215,11 @@ mark_variable(CELL_PTR current)
PUSH_POINTER(next+2); PUSH_POINTER(next+2);
#if SIZEOF_DOUBLE==2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE==2*SIZEOF_LONG_INT
PUSH_POINTER(next+3); PUSH_POINTER(next+3);
#if GC_NO_TAGS
MARK(next+3);
#endif
#elif GC_NO_TAGS
MARK(next+2);
#endif #endif
POP_CONTINUATION(); POP_CONTINUATION();
#ifdef USE_GMP #ifdef USE_GMP
@ -1214,8 +1234,12 @@ mark_variable(CELL_PTR current)
PUSH_POINTER(next); PUSH_POINTER(next);
for (i = 1; i <= (sizeof(MP_INT)+ for (i = 1; i <= (sizeof(MP_INT)+
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize; (((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
i++) i++) {
PUSH_POINTER(next+i); PUSH_POINTER(next+i);
}
#if GC_NO_TAGS
MARK(next+i);
#endif
PUSH_POINTER(next+i); PUSH_POINTER(next+i);
} }
POP_CONTINUATION(); POP_CONTINUATION();
@ -1645,12 +1669,14 @@ static void
mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) 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 #ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr; dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif #endif
#ifdef EASY_SHUNTING #ifdef EASY_SHUNTING
HB = H; HB = H;
#endif #endif
while (gc_B != NULL) { 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) { if (pe == NULL) {
fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, op_names[opnum]); fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, op_names[opnum]);
} else if (pe->ArityOfPE) { } 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 { } 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) (CELL *)(gc_B->cp_cp->u.ldl.bl)
#else #else
-gc_B->cp_cp->u.sla.s / ((OPREG)sizeof(CELL)), -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 #endif
); );
} else { } else {
@ -1731,9 +1757,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
#ifdef TABLING #ifdef TABLING
if (opnum != _table_completion) if (opnum != _table_completion)
#endif #endif
mark_environments((CELL_PTR) gc_B->cp_env, mark_environments((CELL_PTR) gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp))); EnvBMap((CELL_PTR) (gc_B->cp_cp)));
/* extended choice point */ /* extended choice point */
restart_cp: restart_cp:
switch (opnum) { switch (opnum) {
@ -1786,7 +1812,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
{ {
CELL *answ_fr; CELL *answ_fr;
CELL vars; CELL vars;
/* fetch the solution */ /* fetch the solution */
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->ccp_dep_fr); init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->ccp_dep_fr);
vars = *answ_fr++; vars = *answ_fr++;
@ -1961,19 +1987,32 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
register CELL ccur = *current, cnext = *next; register CELL ccur = *current, cnext = *next;
if (IsVarTerm(ccur)) { if (IsVarTerm(ccur)) {
#if GC_NO_TAGS
RMARK(next);
*current = UNMARKED(cnext);
#else
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) : *current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) ); UNMARKED(cnext) );
*next = (MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current; *next = (MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current;
#endif
} else if (IsPairTerm(ccur)) { } else if (IsPairTerm(ccur)) {
#if GC_NO_TAGS
*next = current;
#else
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) : *current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) ); UNMARKED(cnext) );
*next = AbsPair((CELL *) *next = AbsPair((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current)); ((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
#endif
} else if (IsApplTerm(ccur)) { } else if (IsApplTerm(ccur)) {
#if GC_NO_TAGS
*next = AbsPair((CELL *)current);
#else
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) : *current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) ); UNMARKED(cnext) );
*next = AbsAppl((CELL *) *next = AbsAppl((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current)); ((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
#endif
} else { } else {
fprintf(Yap_stderr," OH MY GOD !!!!!!!!!!!!\n"); fprintf(Yap_stderr," OH MY GOD !!!!!!!!!!!!\n");
} }
@ -1981,12 +2020,22 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
CELL current_tag; CELL current_tag;
current_tag = TAG(*current); 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); *current = (*current & MBIT) | (*next & ~MBIT);
#if INVERT_RBIT #if INVERT_RBIT
*next = ((*next & MBIT) | (CELL) current | current_tag) & ~RBIT; *next = ((*next & MBIT) | (CELL) current | current_tag) & ~RBIT;
#else #else
*next = (*next & MBIT) | RBIT | (CELL) current | current_tag; *next = (*next & MBIT) | RBIT | (CELL) current | current_tag;
#endif #endif
#endif /* GC_NO_TAGS */
#endif #endif
} }
@ -2677,7 +2726,7 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
CELL ccur = *current; CELL ccur = *current;
#ifdef TAGS_FAST_OPS #ifdef TAGS_FAST_OPS
while (RMARKED(ccur)) { while (RMARKED(current)) {
register CELL cnext; register CELL cnext;
next = GET_NEXT(ccur); next = GET_NEXT(ccur);
@ -2710,16 +2759,26 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
#endif #endif
} }
#else /* TAGS_FAST_OPS */ #else /* TAGS_FAST_OPS */
while (RMARKED(ccur)) { while (RMARKED(current)) {
CELL current_tag; CELL current_tag;
next = GET_NEXT(ccur); next = GET_NEXT(ccur);
current_tag = TAG(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); ccur = *current = (ccur & MBIT) | (*next & ~MBIT);
#if INVERT_RBIT #if INVERT_RBIT
*next = (*next & MBIT) | (CELL) dest | current_tag | RBIT; *next = (*next & MBIT) | (CELL) dest | current_tag | RBIT;
#else #else
*next = (*next & MBIT) | (CELL) dest | current_tag; *next = (*next & MBIT) | (CELL) dest | current_tag;
#endif #endif
#endif /* GC_NO_TAGS */
} }
#endif /* TAGS_FAST_OPS */ #endif /* TAGS_FAST_OPS */
} }
@ -2795,6 +2854,9 @@ compact_heap(void)
{ {
CELL tmp = current[0]; CELL tmp = current[0];
current[0] = ptr[1]; current[0] = ptr[1];
#if GC_NO_TAGS
MARK(ptr+1);
#endif
ptr[1] = tmp; ptr[1] = tmp;
} }
if (in_garbage > 0) { if (in_garbage > 0) {
@ -2826,9 +2888,15 @@ compact_heap(void)
if (next < current) /* push into reloc. if (next < current) /* push into reloc.
* chain */ * chain */
into_relocation_chain(current, next); into_relocation_chain(current, next);
else if (current == next) /* cell pointing to else if (current == next) { /* cell pointing to
* itself */ * itself */
#if GC_NO_TAGS
UNRMARK(current);
*current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) dest; /* no tag */ *current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
}
} }
dest--; dest--;
} else { } else {
@ -3010,6 +3078,9 @@ icompact_heap(void)
{ {
CELL tmp = current[0]; CELL tmp = current[0];
current[0] = ptr[1]; current[0] = ptr[1];
#if GC_NO_TAGS
MARK(ptr+1);
#endif
ptr[1] = tmp; ptr[1] = tmp;
} }
current = ptr; current = ptr;
@ -3024,9 +3095,14 @@ icompact_heap(void)
if (next < current) /* push into reloc. if (next < current) /* push into reloc.
* chain */ * chain */
into_relocation_chain(current, next); into_relocation_chain(current, next);
else if (current == next) /* cell pointing to else if (current == next) { /* cell pointing to
* itself */ * itself */
#if GC_NO_TAGS
*current = (CELL) (H0+(iptr-ibase)); /* no tag */
#else
*current = (*current & MBIT) | (CELL) (H0+(iptr-ibase)); /* no tag */ *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 */ #endif /* HYBRID_SCHEME */
{ {
#ifdef DEBUG #ifdef DEBUG
#ifdef HYBID_SCHEME /*
#ifdef HYBRID_SCHEME
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0); 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); fprintf(stderr,"%% not using pointers (%d) ASP: %p, ip %p (expected %p) \n", effectiveness, ASP, iptop, H+total_marked);
#endif #endif
*/
#endif #endif
compact_heap(); compact_heap();
} }
@ -3267,6 +3346,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#endif #endif
if (Yap_GetValue(AtomGcTrace) != TermNil) if (Yap_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1; gc_trace = 1;
#if !GC_NO_TAGS
/* sanity check: can we still do garbage_collection ? */ /* sanity check: can we still do garbage_collection ? */
if ((CELL)Yap_TrailTop & (MBIT|RBIT)) { if ((CELL)Yap_TrailTop & (MBIT|RBIT)) {
/* oops, we can't */ /* oops, we can't */
@ -3276,6 +3356,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
} }
return(0); return(0);
} }
#endif
if (gc_trace) { if (gc_trace) {
fprintf(Yap_stderr, "[gc]\n"); fprintf(Yap_stderr, "[gc]\n");
} else if (gc_verbose) { } else if (gc_verbose) {
@ -3311,7 +3392,10 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
bp = Yap_PreAllocCodeSpace(); bp = Yap_PreAllocCodeSpace();
if (bp+alloc_sz > (char *)AuxSp) { if (bp+alloc_sz > (char *)AuxSp) {
/* not enough space */ /* not enough space */
*--ASP = (CELL)current_env;
bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz); bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz);
current_env = (CELL *)*ASP;
ASP++;
} }
if (!bp) if (!bp)
return 0; return 0;

71
C/index.c
View File

@ -11,8 +11,17 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * 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 $ * $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 * Revision 1.98 2004/09/14 03:30:06 vsc
* make sure that condor version always grows trail! * make sure that condor version always grows trail!
* *
@ -3961,7 +3970,7 @@ compile_index(struct intermediates *cint)
yamop * yamop *
Yap_PredIsIndexable(PredEntry *ap) Yap_PredIsIndexable(PredEntry *ap, UInt NSlots)
{ {
yamop *indx_out; yamop *indx_out;
int setjres; int setjres;
@ -3973,7 +3982,7 @@ Yap_PredIsIndexable(PredEntry *ap)
if ((setjres = setjmp(cint.CompilerBotch)) == 3) { if ((setjres = setjmp(cint.CompilerBotch)) == 3) {
restore_machine_regs(); restore_machine_regs();
recover_from_failed_susp_on_cls(&cint, 0); 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) { } else if (setjres == 2) {
restore_machine_regs(); restore_machine_regs();
Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size); Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size);
@ -4909,7 +4918,7 @@ expand_index(struct intermediates *cint) {
static yamop * static yamop *
ExpandIndex(PredEntry *ap) { ExpandIndex(PredEntry *ap, int ExtraArgs) {
yamop *indx_out; yamop *indx_out;
yamop **labp; yamop **labp;
int cb; int cb;
@ -4919,7 +4928,7 @@ ExpandIndex(PredEntry *ap) {
restore_machine_regs(); restore_machine_regs();
/* grow stack */ /* grow stack */
recover_from_failed_susp_on_cls(&cint, 0); 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) { } else if (cb == 2) {
restore_machine_regs(); restore_machine_regs();
Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size); Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size);
@ -5054,8 +5063,8 @@ ExpandIndex(PredEntry *ap) {
} }
yamop * yamop *
Yap_ExpandIndex(PredEntry *ap) { Yap_ExpandIndex(PredEntry *ap, UInt nargs) {
return ExpandIndex(ap); return ExpandIndex(ap, nargs);
} }
static path_stack_entry * static path_stack_entry *
@ -7794,28 +7803,26 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
break; break;
case _expand_index: case _expand_index:
case _expand_clauses: case _expand_clauses:
*H++ = (CELL)s_reg; XREGS[ap->ArityOfPE+1] = (CELL)s_reg;
*H++ = t; XREGS[ap->ArityOfPE+2] = (CELL)t;
H[0] = Terms[0]; XREGS[ap->ArityOfPE+3] = Terms[0];
H[1] = Terms[1]; XREGS[ap->ArityOfPE+4] = Terms[1];
H[2] = Terms[2]; XREGS[ap->ArityOfPE+5] = Terms[2];
H += 3;
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock); LOCK(ap->PELock);
#if defined(YAPOR) || defined(THREADS)
if (!same_lu_block(jlbl, ipc)) { if (!same_lu_block(jlbl, ipc)) {
ipc = *jlbl; ipc = *jlbl;
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
break; break;
} }
#endif #endif
ipc = ExpandIndex(ap); ipc = ExpandIndex(ap, 5);
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
H -= 3; s_reg = (CELL *)XREGS[ap->ArityOfPE+1];
Terms[0] = H[0]; t = XREGS[ap->ArityOfPE+2];
Terms[1] = H[1]; Terms[0] = XREGS[ap->ArityOfPE+3];
Terms[2] = H[2]; Terms[1] = XREGS[ap->ArityOfPE+4];
t = *--H; Terms[2] = XREGS[ap->ArityOfPE+5];
s_reg = (CELL *)(*--H);
break; break;
case _op_fail: case _op_fail:
/* /*
@ -7836,10 +7843,24 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
ipc = ap->CodeOfPred; ipc = ap->CodeOfPred;
break; break;
#endif #endif
case _index_pred:
case _spy_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; 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; break;
default: default:
if (b0) { if (b0) {
@ -8071,7 +8092,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
break; break;
} }
#endif #endif
ipc = ExpandIndex(ap); ipc = ExpandIndex(ap, 0);
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
break; break;
case _op_fail: case _op_fail:
@ -8079,7 +8100,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
break; break;
case _index_pred: case _index_pred:
case _spy_pred: case _spy_pred:
Yap_IPred(ap); Yap_IPred(ap, 0);
ipc = ap->cs.p_code.TrueCodeOfPred; ipc = ap->cs.p_code.TrueCodeOfPred;
break; break;
case _undef_p: case _undef_p:

8
H/clause.h
View File

@ -184,7 +184,7 @@ wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
void STD_PROTO(Yap_InitComma,(void)); void STD_PROTO(Yap_InitComma,(void));
/* cdmgr.c */ /* 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_addclause,(Term,yamop *,int,Term));
void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int)); void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int));
void STD_PROTO(Yap_kill_iblock,(ClauseUnion *,ClauseUnion *,PredEntry *)); 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)); Term STD_PROTO(Yap_cp_as_integer,(choiceptr));
/* index.c */ /* index.c */
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *)); yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *, UInt));
yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *)); yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *, UInt));
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *)); yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int)); void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *)); void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
@ -282,7 +282,7 @@ Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc)
{ {
Term t[2]; Term t[2];
t[0] = MkIntegerTerm((Int)ap); t[0] = MkIntegerTerm((Int)ap);
t[0] = MkIntegerTerm((Int)ipc); t[1] = MkIntegerTerm((Int)ipc);
return Yap_MkApplTerm(FunctorMegaClause,2,t); return Yap_MkApplTerm(FunctorMegaClause,2,t);
} }

12
H/heapgc.h
View File

@ -16,6 +16,7 @@
*************************************************************************/ *************************************************************************/
/* macros used by garbage collection */ /* macros used by garbage collection */
#if TAG_64BITS #if TAG_64BITS
@ -126,7 +127,8 @@ UNRMARK(CELL* ptr)
static inline int static inline int
RMARKED(CELL* ptr) RMARKED(CELL* ptr)
{ {
return !GCIsPrimitiveTerm(*ptr) && (mcell(ptr) & RMARK_BIT); CELL val = *ptr;
return !GCIsPrimitiveTerm(val) && (mcell(ptr) & RMARK_BIT);
} }
#else #else
@ -158,8 +160,8 @@ RMARKED(CELL* ptr)
#ifdef TAGS_FAST_OPS #ifdef TAGS_FAST_OPS
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && (IsVarTerm(val) ?\ #define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && (IsVarTerm(*(ptr)) ?\
((val) & RBIT) : !((val) & RBIT))) ((*(ptr)) & RBIT) : !((*(ptr)) & RBIT)))
#define UNMARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\ #define UNMARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\
? \ ? \
@ -170,9 +172,9 @@ RMARKED(CELL* ptr)
#else #else
#if INVERT_RBIT #if INVERT_RBIT
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && !((val) & RBIT)) #define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && !((*(ptr)) & RBIT))
#else #else
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && ((val) & RBIT)) #define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && ((*(ptr)) & RBIT))
#endif #endif
#endif /* GC_NO_TAGS */ #endif /* GC_NO_TAGS */

4
m4/Yap.h.m4
View File

@ -10,9 +10,11 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * 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" #include "config.h"
/* /*

5
pl/consult.yap
View File

@ -166,11 +166,16 @@ reconsult(Fs) :-
'$include'(X, Status) :- '$include'(X, Status) :-
'$find_in_path'(X,Y,include(X)), '$find_in_path'(X,Y,include(X)),
'$values'('$included_file',OY,Y), '$values'('$included_file',OY,Y),
'$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_),
( '$open'(Y,'$csult',Stream,0), !, ( '$open'(Y,'$csult',Stream,0), !,
'$print_message'(informational, loading(including, Y)),
'$loop'(Stream,Status), '$close'(Stream) '$loop'(Stream,Status), '$close'(Stream)
; ;
'$do_error'(permission_error(input,stream,Y),include(X)) '$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). set_value('$included_file',OY).
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-