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

fix overflow from within clause/2

Browse Source 
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
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 *
* 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) {

5
C/alloc.c
View File

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

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

98
C/heapgc.c
View File

@@ -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,7 +1669,9 @@ 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;
#endif
@@ -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
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
View File

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

8
H/clause.h
View File

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

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

4
m4/Yap.h.m4
View File

@@ -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"
/*

5
pl/consult.yap
View File

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