diff --git a/C/absmi.c b/C/absmi.c index 5460d2466..89ab20503 100644 --- a/C/absmi.c +++ b/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) { diff --git a/C/alloc.c b/C/alloc.c index 21f330334..3832c10d3 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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", diff --git a/C/cdmgr.c b/C/cdmgr.c index 5605d92a0..bda104f44 100644 --- a/C/cdmgr.c +++ b/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) diff --git a/C/heapgc.c b/C/heapgc.c index 72e767c15..3e940a003 100644 --- a/C/heapgc.c +++ b/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; diff --git a/C/index.c b/C/index.c index 1b0985436..cf071c9df 100644 --- a/C/index.c +++ b/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: diff --git a/H/clause.h b/H/clause.h index 9775d3e6f..dbe0cad53 100644 --- a/H/clause.h +++ b/H/clause.h @@ -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); } diff --git a/H/heapgc.h b/H/heapgc.h index 7f27f8b93..a98873ad2 100644 --- a/H/heapgc.h +++ b/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 */ diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4 index b4e3ccb76..a0e8b82fa 100644 --- a/m4/Yap.h.m4 +++ b/m4/Yap.h.m4 @@ -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" /* diff --git a/pl/consult.yap b/pl/consult.yap index ef566c4d1..b625cab54 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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) :-