diff --git a/C/absmi.c b/C/absmi.c index 0adfd16f1..1ce82f28a 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -904,11 +904,11 @@ absmi(int inp) #if defined(YAPOR) || defined(THREADS) /* just store a reference */ INC_CLREF_COUNT(cl); - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl); #else if (!(cl->ClFlags & InUseMask)) { cl->ClFlags |= InUseMask; - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl); cl->u2.ClUse = TR-(tr_fr_ptr)(TrailBase); } #endif @@ -967,7 +967,7 @@ absmi(int inp) LOCK(cl->ClLock); /* always add an extra reference */ INC_CLREF_COUNT(cl); - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl); UNLOCK(cl->ClLock); } #else @@ -978,7 +978,7 @@ absmi(int inp) PREG->u.EC.ClTrail = TR-(tr_fr_ptr)TrailBase; PREG->u.EC.ClENV = LCL0-YENV; cl->ClFlags |= InUseMask; - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl); } #endif PREG = NEXTOP(PREG, EC); @@ -1104,14 +1104,12 @@ absmi(int inp) #if defined(YAPOR) || defined(THREADS) INC_CLREF_COUNT(ClauseCodeToClause(PREG)); UNLOCK(DynamicLock(PREG)); - TRAIL_REF((CELL *)&DynamicFlags(PREG)); + TRAIL_CLREF(ClauseCodeToClause(PREG)); #else if (FlagOff(InUseMask, DynamicFlags(PREG))) { - CELL *pt0 = (CELL *)&DynamicFlags(PREG); SetFlag(InUseMask, DynamicFlags(PREG)); - - TRAIL_REF(pt0); + TRAIL_CLREF(ClauseCodeToClause(PREG)); } #endif PREG = NEXTOP(PREG,ld); @@ -1149,14 +1147,13 @@ absmi(int inp) ENDCACHE_Y(); #if defined(YAPOR) || defined(THREADS) INC_CLREF_COUNT(ClauseCodeToClause(PREG)); - TRAIL_REF((CELL *)&DynamicFlags(PREG)); + TRAIL_CLREF(ClauseCodeToClause(PREG)); UNLOCK(DynamicLock(PREG)); #else if (FlagOff(InUseMask, DynamicFlags(PREG))) { - CELL *pt0 = (CELL *)&DynamicFlags(PREG); SetFlag(InUseMask, DynamicFlags(PREG)); - TRAIL_REF(pt0); + TRAIL_CLREF(ClauseCodeToClause(PREG)); } #endif PREG = NEXTOP(PREG,ld); @@ -1212,7 +1209,7 @@ absmi(int inp) #endif /* SBA */ { TR = TR_FZ; - TRAIL_REF(pt0); + TRAIL_LINK(pt0); } #endif /* FROZEN_REGS */ SP = SP0; diff --git a/C/arrays.c b/C/arrays.c index bbd75f0b7..0d3fef92c 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -234,12 +234,12 @@ AccessNamedArray(Atom a, Int indx) #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); INC_DBREF_COUNT(ref); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif } else { diff --git a/C/cdmgr.c b/C/cdmgr.c index f7a45c940..d70d9a016 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1413,14 +1413,14 @@ p_find_dynamic(void) { Clause *cl = ClauseCodeToClause(q); LOCK(cl->ClLock); - TRAIL_REF((CELL *)(cl->ClFlags)); + TRAIL_CLREF(cl->ClFlags); INC_CLREF_COUNT(cl); UNLOCK(cl->ClLock); } #else if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) { OPREG *opp = &(ClauseCodeToClause(q)->ClFlags); - TRAIL_REF(opp); + TRAIL_CLREF(ClauseCodeToClause(q)); *opp |= InUseMask; } #endif diff --git a/C/dbase.c b/C/dbase.c index 7fff7fdcd..5480461aa 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1475,7 +1475,7 @@ record(int Flag, Term key, Term t_data, Term t_code) } if ((Flag & MkIfNot) && found_one) return (NULL); - TRAIL_REF(&(x->Flags)); + TRAIL_REF(x); if (x->Flags & (DBNoVars|DBComplex)) x->Mask = EvalMasks(t_data, &x->Key); else @@ -2266,13 +2266,13 @@ i_log_upd_recorded(LogUpdDBProp AtProp) if (unify(ARG3, TRef)) { #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif cut_succeed(); @@ -2285,25 +2285,25 @@ i_log_upd_recorded(LogUpdDBProp AtProp) EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep); #if defined(YAPOR) || defined(THREADS) LOCK(table->lock); - TRAIL_REF(&(table->Flags)); /* So that fail will erase it */ + TRAIL_REF(table); /* So that fail will erase it */ INC_DBREF_COUNT(table); UNLOCK(table->lock); LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(table->Flags & InUseMask)) { table->Flags |= InUseMask; if (B->cp_tr == TR) { - TRAIL_REF(&(table->Flags)); /* So that fail will erase it */ + TRAIL_REF(table); /* So that fail will erase it */ B->cp_tr = TR; /* protect this entry so that it will not be undone by backtracking */ } else { Term new; - TRAIL_REF(&(table->Flags)); /* So that fail will erase it */ + TRAIL_REF(table); /* So that fail will erase it */ /* swap this with what was pointed by the choicepoint */ new = TrailTerm(TR-1); TrailTerm(TR-1) = TrailTerm(B->cp_tr); @@ -2321,7 +2321,7 @@ i_log_upd_recorded(LogUpdDBProp AtProp) } if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif return (unify(ARG3, TRef)); @@ -2469,13 +2469,13 @@ i_recorded(DBProp AtProp) TRef = MkDBRefTerm(ref); #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif return (unify(ARG3, TRef)); @@ -2562,13 +2562,13 @@ c_log_upd_recorded(DBRef *ep, int flags) EXTRA_CBACK_ARG(3,1) = AbsAppl((CELL *)ep); #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif if (!unify(ARG3, TRef)) @@ -2705,13 +2705,13 @@ c_recorded(int flags) EXTRA_CBACK_ARG(3,1) = (CELL)ref; #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif return (unify(ARG3, TRef)); @@ -2843,13 +2843,13 @@ p_first_instance(void) /* we have a pointer to the term available */ #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); UNLOCK(ref->lock); #else if (!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } #endif while ((TermDB = GetDBTerm(ref)) == (CELL)0) { @@ -3031,14 +3031,14 @@ find_next_clause(DBRef ref0) Clause *cl = ClauseCodeToClause(newp); LOCK(cl->ClLock); - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl)); INC_DBREF_COUNT(cl); UNLOCK(cl->ClLock); } #else if (!DynamicFlags(newp) & InUseMask) { DynamicFlags(newp) |= InUseMask; - TRAIL_REF(&DynamicFlags(newp)); + TRAIL_CLREF(ClauseCodeToClause(newp)); } #endif return(newp); @@ -3451,6 +3451,24 @@ p_erase(void) return (TRUE); } +/* erase(+Ref) */ +static Int +p_smash(void) +{ + Term t1 = Deref(ARG1); + + if (IsVarTerm(t1)) { + Error(INSTANTIATION_ERROR, t1, "erase"); + return (FALSE); + } + if (!IsDBRefTerm(t1)) { + Error(TYPE_ERROR_DBREF, t1, "erase"); + return (FALSE); + } + EraseEntry(DBRefOfTerm(t1)); + return (TRUE); +} + /* eraseall(+Key) */ static Int p_eraseall(void) @@ -3844,7 +3862,7 @@ keepdbrefs(DBRef entryref) LOCK(ref->lock); if(!(ref->Flags & InUseMask)) { ref->Flags |= InUseMask; - TRAIL_REF(&(ref->Flags)); /* So that fail will erase it */ + TRAIL_REF(ref); /* So that fail will erase it */ } UNLOCK(ref->lock); } @@ -3890,7 +3908,6 @@ p_dequeue(void) } /* - This is a hack, to steal the first element of a key. It first fetches the first element in the chain, and then erases it @@ -4028,13 +4045,13 @@ p_db_nb_to_ref(void) tref = MkDBRefTerm(myref); #if defined(YAPOR) || defined(THREADS) LOCK(myref->lock); - TRAIL_REF(&(myref->Flags)); /* So that fail will erase it */ + TRAIL_REF(myref); /* So that fail will erase it */ INC_DBREF_COUNT(myref); UNLOCK(myref->lock); #else if (!(myref->Flags & InUseMask)) { myref->Flags |= InUseMask; - TRAIL_REF(&(myref->Flags)); /* So that fail will erase it */ + TRAIL_REF(myref); /* So that fail will erase it */ } #endif return(unify(ARG3,tref)); @@ -4103,13 +4120,13 @@ p_hold_index(void) /* now, stash the index */ #if defined(YAPOR) || defined(THREADS) LOCK(index->lock); - TRAIL_REF(&(index->Flags)); /* So that fail will erase it */ + TRAIL_REF(index); /* So that fail will erase it */ INC_DBREF_COUNT(index); UNLOCK(index->lock); #else if (!(index->Flags & InUseMask)) { index->Flags |= InUseMask; - TRAIL_REF(&(index->Flags)); + TRAIL_REF(index); } #endif return(unify(ARG2, MkDBRefTerm(index)) && @@ -4133,13 +4150,13 @@ p_fetch_reference_from_index(void) el = (DBRef)(table->Contents[pos]); #if defined(YAPOR) || defined(THREADS) LOCK(el->lock); - TRAIL_REF(&(el->Flags)); /* So that fail will erase it */ + TRAIL_REF(el); /* So that fail will erase it */ INC_DBREF_COUNT(el); UNLOCK(el->lock); #else if (!(el->Flags & InUseMask)) { el->Flags |= InUseMask; - TRAIL_REF(&(el->Flags)); + TRAIL_REF(el); } #endif return(unify(ARG3, MkDBRefTerm(el))); @@ -4170,6 +4187,7 @@ InitDBPreds(void) InitCPred("$recordzp", 4, p_drcdzp, SafePredFlag|SyncPredFlag); InitCPred("$recordaifnot", 3, p_rcdaifnot, SafePredFlag|SyncPredFlag); InitCPred("$recordzifnot", 3, p_rcdzifnot, SafePredFlag|SyncPredFlag); + InitCPred("$db_smash", 1, p_smash, SafePredFlag|SyncPredFlag); InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag); InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag); InitCPred("instance", 2, p_instance, SyncPredFlag); diff --git a/C/exec.c b/C/exec.c index a99d5de24..ea796b988 100644 --- a/C/exec.c +++ b/C/exec.c @@ -113,14 +113,14 @@ CallProlog(PredEntry *pen, unsigned int arity, Int position) Clause *cl = ClauseCodeToClause(q); LOCK(cl->ClLock); - TRAIL_REF(&(cl->ClFlags)); + TRAIL_CLREF(cl); INC_DBREF_COUNT(cl); UNLOCK(cl->ClLock); } #else if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) { OPREG *opp = &(ClauseCodeToClause(q)->ClFlags); - TRAIL_REF(opp); + TRAIL_CLREF(ClauseCodeToClause(q)); *opp |= InUseMask; } #endif diff --git a/C/heapgc.c b/C/heapgc.c index 15f55e2a0..c6bd15417 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -663,7 +663,7 @@ init_dbtable(tr_fr_ptr trail_ptr) { #ifdef DEBUG #define INSTRUMENT_GC 1 -#define CHECK_CHOICEPOINTS 1 +/* #define CHECK_CHOICEPOINTS 1 */ #ifdef INSTRUMENT_GC typedef enum { diff --git a/C/save.c b/C/save.c index 5e5cd2345..94ab9a929 100644 --- a/C/save.c +++ b/C/save.c @@ -1092,7 +1092,7 @@ restore_codes(void) #endif heap_regs->term_refound_var = AtomTermAdjust(heap_regs->term_refound_var); heap_regs->file_aliases = - (void *)AddrAdjust((ADDR)heap_regs->file_aliases); + (struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases); heap_regs->yap_lib_dir = (char *)AddrAdjust((ADDR)heap_regs->yap_lib_dir); heap_regs->pred_goal_expansion = diff --git a/H/amiops.h b/H/amiops.h index a8ba29b89..ee2c0e256 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -299,7 +299,12 @@ Binding Macros for Multiple Assignment Variables. #endif /* TABLING */ -#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF))) +#define REF_TO_TRENTRY(REF) AbsPair(((CELL *)&((REF)->Flags))) +#define CLREF_TO_TRENTRY(REF) AbsPair(((CELL *)&((REF)->ClFlags))) + +#define TRAIL_REF(REF) TrailTerm(TR++) = REF_TO_TRENTRY(REF) +#define TRAIL_CLREF(REF) TrailTerm(TR++) = CLREF_TO_TRENTRY(REF) +#define TRAIL_LINK(REF) TrailTerm(TR++) = AbsPair((CELL *)(REF)) #define Bind(A,D) TRAIL(A,D); *(A) = (D) diff --git a/changes4.3.html b/changes4.3.html index d05e3490d..6209acc16 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -16,6 +16,10 @@

Yap-4.3.19: