diff --git a/C/absmi.c b/C/absmi.c index c9462a405..99c98279e 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,11 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2006-10-25 02:31:07 $,$Author: vsc $ * +* Last rev: $Date: 2006-11-15 00:13:36 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.210 2006/10/25 02:31:07 vsc +* fix emulation of trust_logical +* * Revision 1.209 2006/10/18 13:47:31 vsc * index.c implementation of trust_logical was decrementing the wrong * cp_tr @@ -7975,6 +7978,8 @@ Yap_absmi(int inp) only increment time stamp if we are working on current time stamp */ + if (ap->TimeStampOfPred >= TIMESTAMP_RESET) + Yap_UpdateTimestamps(ap); ap->TimeStampOfPred++; ap->LastCallOfPred = LUCALL_EXEC; /* fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/ diff --git a/C/amasm.c b/C/amasm.c index 9062f2747..f202e8dd0 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2006-11-06 18:35:03 $ * +* Last rev: $Date: 2006-11-15 00:13:36 $ * * $Log: not supported by cvs2svn $ +* Revision 1.91 2006/11/06 18:35:03 vsc +* 1estranha +* * Revision 1.90 2006/10/11 14:53:57 vsc * fix memory leak * fix overflow handling @@ -2661,12 +2664,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp cl_u->luc.ClSize = size; /* Support for timestamps */ if (cip->CurrentPred->LastCallOfPred != LUCALL_ASSERT) { + if (cip->CurrentPred->TimeStampOfPred >= TIMESTAMP_RESET) + Yap_UpdateTimestamps(cip->CurrentPred); ++cip->CurrentPred->TimeStampOfPred; /* fprintf(stderr,"+ %x--%d--%ul\n",cip->CurrentPred,cip->CurrentPred->TimeStampOfPred,cip->CurrentPred->ArityOfPE);*/ cip->CurrentPred->LastCallOfPred = LUCALL_ASSERT; } cl_u->luc.ClTimeStart = cip->CurrentPred->TimeStampOfPred; - cl_u->luc.ClTimeEnd = ~0L; + cl_u->luc.ClTimeEnd = TIMESTAMP_EOT; if (*clause_has_blobsp) { cl_u->luc.ClFlags |= HasBlobsMask; } diff --git a/C/cdmgr.c b/C/cdmgr.c index 7ee0cf3b6..48f71f442 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2006-11-14 11:42:25 $,$Author: vsc $ * +* Last rev: $Date: 2006-11-15 00:13:36 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.198 2006/11/14 11:42:25 vsc +* fix bug in growstack +* * Revision 1.197 2006/11/06 18:35:03 vsc * 1estranha * @@ -5053,32 +5056,69 @@ p_continue_log_update_clause0(void) return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_cp, FALSE); } -#if TIMESTAMP_OVERFLOW static void -adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt NStamps) +adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt *base) { - UInt clstamp = cl->ClTimeStart; - while (arp[0]); + UInt clstamp = cl->ClTimeEnd; + if (cl->ClTimeEnd != TIMESTAMP_EOT) { + while (arp[0] > clstamp) + arp--; + if (arp[0] == clstamp) { + cl->ClTimeEnd = (arp-base); + } else { + cl->ClTimeEnd = (arp-base)+1; + } + } + clstamp = cl->ClTimeStart; + while (arp[0] > clstamp) + arp--; + if (arp[0] == clstamp) { + cl->ClTimeStart = (arp-base); + } else { + cl->ClTimeStart = (arp-base)+1; + } clstamp = cl->ClTimeEnd; } + +static Term +replace_integer(Term orig, UInt new) +{ + CELL *pt; + + if (IntInBnd((Int)new)) + return MkIntTerm(new); + /* should create an old integer */ + if (!IsApplTerm(orig)) { + Yap_Error(SYSTEM_ERROR,orig,"%uld-->%uld where it should increase",(unsigned long int)IntegerOfTerm(orig),(unsigned long int)new); + return MkIntegerTerm(new); + } + /* appl->appl */ + /* replace integer in situ */ + pt = RepAppl(orig)+1; + *pt = new; + return orig; +} + void /* $hidden_predicate(P) */ -Yap_update_timestamps(PredEntry *ap, UInt arity) +Yap_UpdateTimestamps(PredEntry *ap) { choiceptr bptr = B; yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld); yamop *cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld); UInt ar = ap->ArityOfPE; - UInt *arp = ASP; - UInt nstamps; - LogUpdClause *cl; + UInt *arp, *top, *base; + LogUpdClause *lcl; #if THREADS - YAP_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap); + Yap_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap); + return; #endif - if (ap->cs.p_code.NOfClauses < 2) + if (!ap->cs.p_code.NOfClauses) return; restart: + *--ASP = TIMESTAMP_EOT; + top = arp = (UInt *)ASP; while (bptr) { op_numbers opnum = Yap_op_from_opcode(bptr->cp_ap->opc); @@ -5095,43 +5135,96 @@ Yap_update_timestamps(PredEntry *ap, UInt arity) if (arp-H < 1024) { goto overflow; } + /* be thrifty, have this in case there is a hole */ + if (ts != arp[0]-1) { + UInt x = arp[0]; + *--arp = x; + } *--arp = ts; } } + bptr = bptr->cp_b; break; case _retry: if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) && - ((PredEntry *)IntegerOfTerm((bptr+1)->cp_args[0]) == ap)) { + ((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) { UInt ts = IntegerOfTerm(bptr->cp_args[5]); if (ts != arp[0]) { if (arp-H < 1024) { goto overflow; } + if (ts != arp[0]-1) { + UInt x = arp[0]; + *--arp = x; + } *--arp = ts; } } + bptr = bptr->cp_b; break; default: + bptr = bptr->cp_b; continue; } } - NStamps = (ASP-arp); - cl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause); - while (cl) { - adjust_cl_timestamp(cl, arp, NStamps); - cl = cl->ClNext; + if (*arp) + *--arp = 0L; + base = arp; + lcl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause); + while (lcl) { + adjust_cl_timestamp(lcl, top-1, base); + lcl = lcl->ClNext; + } + lcl = DBErasedList; + while (lcl) { + if (lcl->ClPred == ap) + adjust_cl_timestamp(lcl, top-1, base); + lcl = lcl->ClNext; + } + arp = top-1; + bptr = B; + while (bptr) { + op_numbers opnum = Yap_op_from_opcode(bptr->cp_ap->opc); + + switch (opnum) { + case _retry_logical: + case _count_retry_logical: + case _profiled_retry_logical: + case _trust_logical: + case _count_trust_logical: + case _profiled_trust_logical: + if (bptr->cp_ap->u.lld.d->ClPred == ap) { + UInt ts = IntegerOfTerm(bptr->cp_args[ar]); + while (ts != arp[0]) + arp--; + bptr->cp_args[ar] = replace_integer(bptr->cp_args[ar], arp-base); + } + bptr = bptr->cp_b; + break; + case _retry: + if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) && + ((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) { + UInt ts = IntegerOfTerm(bptr->cp_args[5]); + while (ts != arp[0]) + arp--; + bptr->cp_args[5] = replace_integer(bptr->cp_args[5], arp-base); + } + bptr = bptr->cp_b; + break; + default: + bptr = bptr->cp_b; + continue; + } } return; overflow: - if (!Yap_gc(arity, ENV, P)) { + if (!Yap_growstack(64*1024)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return; } goto restart; } -#endif - static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) { @@ -5500,7 +5593,6 @@ p_static_pred_statistics(void) return static_statistics(pe); } -#ifdef DEBUG static Int p_predicate_erased_statistics(void) { @@ -5545,6 +5637,7 @@ p_predicate_erased_statistics(void) Yap_unify(ARG5,MkIntegerTerm(isz)); } +#ifdef DEBUG static Int p_predicate_lu_cps(void) { @@ -5810,9 +5903,9 @@ Yap_InitCdMgr(void) Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$all_choicepoints", 1, p_all_choicepoints, HiddenPredFlag); Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag); + Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag); #ifdef DEBUG - Yap_InitCPred("predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag); - Yap_InitCPred("predicate_live_cps", 4, p_predicate_lu_cps, 0L); + Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L); #endif } diff --git a/C/dbase.c b/C/dbase.c index cb86e4a06..1351ec15d 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1826,6 +1826,8 @@ new_lu_db_entry(Term t, PredEntry *pe) cl->ClSize = dbg.sz; /* Support for timestamps */ if (pe && pe->LastCallOfPred != LUCALL_ASSERT) { + if (pe->TimeStampOfPred >= TIMESTAMP_RESET) + Yap_UpdateTimestamps(pe); ++pe->TimeStampOfPred; /* fprintf(stderr,"+ %x--%d--%ul\n",pe,pe->TimeStampOfPred,pe->ArityOfPE);*/ pe->LastCallOfPred = LUCALL_ASSERT; @@ -1833,7 +1835,7 @@ new_lu_db_entry(Term t, PredEntry *pe) } else { cl->ClTimeStart = 0L; } - cl->ClTimeEnd = ~0L; + cl->ClTimeEnd = TIMESTAMP_EOT; #if defined(YAPOR) || defined(THREADS) INIT_LOCK(cl->ClLock); INIT_CLREF_COUNT(cl); @@ -3788,7 +3790,6 @@ p_lu_statistics(void) } -#ifdef DEBUG static Int p_total_erased(void) { @@ -3865,7 +3866,6 @@ p_heap_space_info(void) Yap_unify(ARG3,MkIntegerTerm(Yap_expand_clauses_sz)); } -#endif /* @@ -4004,7 +4004,6 @@ complete_lu_erase(LogUpdClause *clau) clau->ClExt->u.EC.ClRefs > 0) { return; } -#ifdef DEBUG #ifndef THREADS if (clau->ClNext) clau->ClNext->ClPrev = clau->ClPrev; @@ -4013,7 +4012,6 @@ complete_lu_erase(LogUpdClause *clau) } else { DBErasedList = clau->ClNext; } -#endif #endif if (cp != NULL) { DBRef ref; @@ -4099,7 +4097,6 @@ EraseLogUpdCl(LogUpdClause *clau) ap->cs.p_code.NOfClauses--; } clau->ClFlags |= ErasedMask; -#ifdef DEBUG #ifndef THREADS { LogUpdClause *er_head = DBErasedList; @@ -4112,7 +4109,6 @@ EraseLogUpdCl(LogUpdClause *clau) } DBErasedList = clau; } -#endif #endif /* we are holding a reference to the clause */ clau->ClRefCount++; @@ -4120,6 +4116,8 @@ EraseLogUpdCl(LogUpdClause *clau) /* mark it as erased */ if (ap->LastCallOfPred != LUCALL_RETRACT) { if (ap->cs.p_code.NOfClauses > 1) { + if (ap->TimeStampOfPred >= TIMESTAMP_RESET) + Yap_UpdateTimestamps(ap); ++ap->TimeStampOfPred; /* fprintf(stderr,"- %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/ ap->LastCallOfPred = LUCALL_RETRACT; @@ -5299,11 +5297,9 @@ Yap_InitDBPreds(void) Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("key_statistics", 4, p_key_statistics, SyncPredFlag); Yap_InitCPred("$lu_statistics", 5, p_lu_statistics, SyncPredFlag); -#ifdef DEBUG Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag); Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag); Yap_InitCPred("heap_space_info", 3, p_heap_space_info, SyncPredFlag); -#endif Yap_InitCPred("$nth_instance", 3, p_nth_instance, SyncPredFlag); Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag|HiddenPredFlag); diff --git a/C/index.c b/C/index.c index 5b6dc186f..ce19d9c01 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2006-11-08 01:53:08 $,$Author: vsc $ * +* Last rev: $Date: 2006-11-15 00:13:36 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.176 2006/11/08 01:53:08 vsc +* avoid generating suspensions on static code. +* * Revision 1.175 2006/11/06 18:35:04 vsc * 1estranha * @@ -3669,11 +3672,6 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates else ncls = 0; Yap_emit_3ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, cint); - /* get some placeholders */ - Yap_emit(jump_op, labl_dyn0, Zero, cint); - Yap_emit(jump_op, labl_dyn0, Zero, cint); - Yap_emit(jump_op, labl_dyn0, Zero, cint); - Yap_emit(jump_op, labl_dyn0, Zero, cint); Yap_emit(label_op, labl_dyn0, Zero, cint); } if (c0 == cf) { @@ -3693,11 +3691,6 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates if (!clleft && cint->CurrentPred->PredFlags & LogUpdatePredFlag) { Yap_emit(label_op, labl_dynf, Zero, cint); - /* get some placeholders */ - Yap_emit(jump_op, labl_dynf, Zero, cint); - Yap_emit(jump_op, labl_dynf, Zero, cint); - Yap_emit(jump_op, labl_dynf, Zero, cint); - Yap_emit(jump_op, labl_dynf, Zero, cint); } } } @@ -7865,6 +7858,8 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y only increment time stamp if we are working on current time stamp */ + if (ap->TimeStampOfPred >= TIMESTAMP_RESET) + Yap_UpdateTimestamps(ap); ap->TimeStampOfPred++; /* fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/ ap->LastCallOfPred = LUCALL_EXEC; diff --git a/H/Yatom.h b/H/Yatom.h index 2da2dfc0d..05379b0a9 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -609,6 +609,9 @@ typedef enum { LUCALL_RETRACT } timestamp_type; +#define TIMESTAMP_EOT ((UInt)(~0L)) +#define TIMESTAMP_RESET (TIMESTAMP_EOT-1024) + typedef struct pred_entry { Prop NextOfPE; /* used to chain properties */ @@ -1193,6 +1196,7 @@ IsArrayProperty (int flags) /* cdmgr.c */ int STD_PROTO (Yap_RemoveIndexation, (PredEntry *)); +void STD_PROTO (Yap_UpdateTimestamps, (PredEntry *)); /* dbase.c */ void STD_PROTO (Yap_ErDBE, (DBRef)); diff --git a/changes-5.1.html b/changes-5.1.html index 8433b614a..6ec595a5c 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,7 @@

Yap-5.1.2: