18static char SccsId[] =
"%W% %G%";
142#define DISCONNECT_OLD_ENTRIES 1
147#define Register register
153#define MkCode CodeDBBit
159#define FrstDBRef(V) ((V)->First)
160#define NextDBRef(V) ((V)->Next)
162#define DBLength(V) (sizeof(DBStruct) + (Int)(V) + CellSize)
163#define AllocDBSpace(V) ((DBRef)Yap_AllocCodeSpace(V))
164#define FreeDBSpace(V) Yap_FreeCodeSpace(V)
167#define ToSmall(V) ((link_entry)(Unsigned(V) >> 2))
169#define ToSmall(V) ((link_entry)(Unsigned(V) >> 3))
182#define HashFieldMask ((CELL)0xffL)
183#define DualHashFieldMask ((CELL)0xffffL)
184#define TripleHashFieldMask ((CELL)0xffffffL)
185#define FourHashFieldMask ((CELL)0xffffffffL)
187#define ONE_FIELD_SHIFT 8
188#define TWO_FIELDS_SHIFT 16
189#define THREE_FIELDS_SHIFT 24
191#define AtomHash(t) (Unsigned(t) >> 4)
192#define FunctorHash(t) (Unsigned(t) >> 4)
193#define NumberHash(t) (Unsigned(IntOfTerm(t)))
195#define LARGE_IDB_LINK_TABLE 1
198#if LARGE_IDB_LINK_TABLE
199typedef BITS32 link_entry;
200#define SIZEOF_LINK_ENTRY 4
202typedef BITS16 link_entry;
203#define SIZEOF_LINK_ENTRY 2
209 link_entry *lr, *LinkAr;
217 SFKeep *SFAr, *TopSF;
223#ifdef SUPPORT_HASH_TABLES
232 hash_db_entry *table;
237static CELL *cpcells(CELL *, CELL *, Int);
238static void linkblk(link_entry *, CELL *, CELL);
239static Int cmpclls(CELL *, CELL *, Int);
241static CELL CalcKey(Term);
243static CELL *MkDBTerm(CELL *, CELL *, CELL *, CELL *, CELL *, CELL *,
int *,
246static CELL *MkDBTerm(CELL *, CELL *, CELL *, CELL *, CELL *,
int *,
250static DBRef record(
int, Term, Term, Term CACHE_TYPE);
253static DBRef check_if_wvars(
DBRef,
unsigned int, CELL *);
254static int scheckcells(
int, CELL *, CELL *, link_entry *, CELL);
256static Int p_rcda(USES_REGS1);
257static Int p_rcdap(USES_REGS1);
258static Int p_rcdz(USES_REGS1);
259static Int p_rcdzp(USES_REGS1);
260static Int p_drcdap(USES_REGS1);
261static Int p_drcdzp(USES_REGS1);
262static Term GetDBTerm(
DBTerm *,
int src CACHE_TYPE);
263static DBProp FetchDBPropFromKey(Term,
int,
int,
char *);
264static Int i_recorded(
DBProp, Term CACHE_TYPE);
265static Int c_recorded(
int CACHE_TYPE);
266static Int co_rded(USES_REGS1);
267static Int in_rdedp(USES_REGS1);
268static Int co_rdedp(USES_REGS1);
269static Int p_first_instance(USES_REGS1);
270static void ErasePendingRefs(
DBTerm *CACHE_TYPE);
271static void RemoveDBEntry(
DBRef CACHE_TYPE);
275static void EraseEntry(
DBRef);
276static Int p_erase(USES_REGS1);
277static Int p_eraseall(USES_REGS1);
278static Int p_erased(USES_REGS1);
279static Int p_instance(USES_REGS1);
280static int NotActiveDB(
DBRef);
282static Int init_current_key(USES_REGS1);
283static Int cont_current_key(USES_REGS1);
284static Int cont_current_key_integer(USES_REGS1);
285static Int p_rcdstatp(USES_REGS1);
286static Int p_somercdedp(USES_REGS1);
287static yamop *find_next_clause(
DBRef USES_REGS);
288static Int p_jump_to_next_dynamic_clause(USES_REGS1);
290static void SFVarIn(Term);
291static void sf_include(SFKeep *);
293static Int p_init_queue(USES_REGS1);
294static Int p_enqueue(USES_REGS1);
295static void keepdbrefs(
DBTerm *CACHE_TYPE);
296static Int p_dequeue(USES_REGS1);
297static void ErDBE(
DBRef CACHE_TYPE);
298static void ReleaseTermFromDB(
DBTerm *CACHE_TYPE);
302static DBProp find_int_key(Int);
304#define db_check_trail(x) \
306 if (Unsigned(dbg->tofref) == Unsigned(x)) { \
307 goto error_tr_overflow; \
311static UInt new_trail_size(
void) {
313 UInt sz = (LOCAL_TrailTop - (ADDR)TR) / 2;
321static int recover_from_record_error(
int nargs) {
323 switch (LOCAL_Error_TYPE) {
324 case RESOURCE_ERROR_STACK:
326 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
330 case RESOURCE_ERROR_TRAIL:
331 if (!Yap_growtrail(new_trail_size(), FALSE)) {
332 Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
333 "YAP could not grow trail in recorda/3");
337 case RESOURCE_ERROR_HEAP:
338 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
339 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
343 case RESOURCE_ERROR_AUXILIARY_STACK:
344 if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
345 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
350 Yap_ThrowError(LOCAL_Error_TYPE, TermNil, LOCAL_ErrorMessage);
354 LOCAL_Error_Size = 0;
355 LOCAL_Error_TYPE = YAP_NO_ERROR;
359#ifdef SUPPORT_HASH_TABLES
361static void create_hash_table(
DBProp p, Int hint) {
362 int off =
sizeof(CELL) * 4, out;
365 if (hint < p->NOfEntries)
366 hint = p->NOfEntries;
368 Int limit = ((CELL)1) << (off);
375 if ((size = ((CELL)1) << out) < hint)
378 pt = tbl = (hash_db_entry *)AllocDBSpace(hint *
sizeof(hash_db_entry));
379 Yap_LUClauseSpace += hint *
sizeof(hash_db_entry);
380 for (i = 0; i < hint; i++) {
387static void insert_in_table() {}
389static void remove_from_table() {}
392inline static CELL *cpcells(CELL *to, CELL *from, Int n) {
394 memmove((
void *)to, (
void *)from, (
size_t)(n *
sizeof(CELL)));
404static void linkblk(link_entry *r, CELL *c, CELL offs) {
406 while ((p = (CELL)*r) != 0) {
409 c[p] = AdjustIDBPtr(t, offs);
413static Int cmpclls(CELL *a, CELL *b, Int n) {
422static Prop FindDBPropHavingLock(
AtomEntry *ae,
int CodeDB,
unsigned int arity,
427 p = RepDBProp(p0 = ae->PropsOfAE);
429 (((p->KindOfPE & ~0x1) != (CodeDB | DBProperty)) ||
430 (p->ArityOfDB != arity) ||
431 ((CodeDB & MkCode) && p->ModuleOfDB && p->ModuleOfDB != dbmod))) {
432 p = RepDBProp(p0 = p->NextOfPE);
438static Prop FindDBProp(
AtomEntry *ae,
int CodeDB,
unsigned int arity,
442 READ_LOCK(ae->ARWLock);
443 out = FindDBPropHavingLock(ae, CodeDB, arity, dbmod);
444 READ_UNLOCK(ae->ARWLock);
450inline static CELL CalcKey(Term tw) {
452 if (IsApplTerm(tw)) {
454 if (IsExtensionFunctor(f)) {
455 if (f == FunctorDBRef) {
456 return (FunctorHash(tw));
458 return (NumberHash(RepAppl(tw)[1]));
460 return (FunctorHash(f));
461 }
else if (IsAtomOrIntTerm(tw)) {
462 if (IsAtomTerm(tw)) {
463 return (AtomHash(tw));
465 return (NumberHash(tw));
467 return (FunctorHash(FunctorList));
471static CELL EvalMasks(
register Term tm, CELL *keyp) {
476 }
else if (IsApplTerm(tm)) {
477 Functor fun = FunctorOfTerm(tm);
479 if (IsExtensionFunctor(fun)) {
480 if (fun == FunctorDBRef) {
481 *keyp = FunctorHash(tm);
483 *keyp = NumberHash(RepAppl(tm)[1]);
485 return (FourHashFieldMask);
489 arity = ArityOfFunctor(fun);
491 if (arity == SFArity) {
493 return (FourHashFieldMask);
498 Term tw = ArgOfTerm(1, tm);
500 if (IsNonVarTerm(tw)) {
501 *keyp = (FunctorHash(fun) & DualHashFieldMask) |
502 (CalcKey(tw) << TWO_FIELDS_SHIFT);
503 return (FourHashFieldMask);
505 *keyp = (FunctorHash(fun) & DualHashFieldMask);
506 return (DualHashFieldMask);
513 key = FunctorHash(fun) & DualHashFieldMask;
514 mask = DualHashFieldMask;
516 tw1 = ArgOfTerm(1, tm);
517 if (IsNonVarTerm(tw1)) {
518 key |= ((CalcKey(tw1) & HashFieldMask) << TWO_FIELDS_SHIFT);
519 mask |= (HashFieldMask << TWO_FIELDS_SHIFT);
521 tw2 = ArgOfTerm(2, tm);
522 if (IsNonVarTerm(tw2)) {
523 *keyp = key | (CalcKey(tw2) << THREE_FIELDS_SHIFT);
524 return (mask | (HashFieldMask << THREE_FIELDS_SHIFT));
534 key = FunctorHash(fun) & HashFieldMask;
535 mask = HashFieldMask;
537 tw1 = ArgOfTerm(1, tm);
538 if (IsNonVarTerm(tw1)) {
539 key |= (CalcKey(tw1) & HashFieldMask) << ONE_FIELD_SHIFT;
540 mask |= HashFieldMask << ONE_FIELD_SHIFT;
542 tw2 = ArgOfTerm(2, tm);
543 if (IsNonVarTerm(tw2)) {
544 key |= (CalcKey(tw2) & HashFieldMask) << TWO_FIELDS_SHIFT;
545 mask |= HashFieldMask << TWO_FIELDS_SHIFT;
547 tw3 = ArgOfTerm(3, tm);
548 if (IsNonVarTerm(tw3)) {
549 *keyp = key | (CalcKey(tw3) << THREE_FIELDS_SHIFT);
550 return (mask | (HashFieldMask << THREE_FIELDS_SHIFT));
559 CELL key = (FunctorHash(FunctorList) & DualHashFieldMask);
560 CELL mask = DualHashFieldMask;
561 Term th = HeadOfTerm(tm), tt;
563 if (IsNonVarTerm(th)) {
564 mask |= (HashFieldMask << TWO_FIELDS_SHIFT);
565 key |= (CalcKey(th) << TWO_FIELDS_SHIFT);
568 if (IsNonVarTerm(tt)) {
569 *keyp = key | (CalcKey(tt) << THREE_FIELDS_SHIFT);
570 return (mask | (HashFieldMask << THREE_FIELDS_SHIFT));
577CELL Yap_EvalMasks(
register Term tm, CELL *keyp) {
return EvalMasks(tm, keyp); }
580#define MarkThisRef(Ref) ((Ref)->NOfRefsTo++)
586#define DB_UNWIND_CUNIF() \
587 while (visited < (visitel *)AuxSp) { \
588 RESET_VARIABLE(visited->addr); \
593#define CheckDBOverflow(X) \
594 if (CodeMax + X >= (CELL *)visited - 1024) { \
599#define CheckVisitOverflow() \
600 if ((CELL *)tovisit + 1024 >= ASP) { \
604static CELL *copy_long_int(CELL *st, CELL *pt) {
606 st[0] = (CELL)FunctorLongInt;
608 st[2] = CloseExtension(st);
613static CELL *copy_double(CELL *st, CELL *pt) {
615 st[0] = (CELL)FunctorDouble;
617#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
619 st[3] = CloseExtension(st);
621 st[2] = CloseExtension(st);
624 return st + (2 + SIZEOF_DOUBLE / SIZEOF_INT_P);
627static CELL *copy_string(CELL *st, CELL *pt) {
630 memcpy(st, pt,
sizeof(CELL) * sz);
636static CELL *copy_big_int(CELL *st, CELL *pt) {
638 sizeof(
MP_INT) + (((
MP_INT *)(pt + 2))->_mp_alloc *
sizeof(mp_limb_t));
641 st[0] = (CELL)FunctorBigInt;
644 memcpy((
void *)(st + 2), (
void *)(pt + 2), sz);
645 st = st + 2 + sz / CellSize;
647 st[0] = CloseExtension(st);
652#define DB_MARKED(d0) ((CELL *)(d0) < CodeMax && (CELL *)(d0) >= tbase)
655static CELL *MkDBTerm(
register CELL *pt0,
register CELL *pt0_end,
656 register CELL *StoPoint, CELL *CodeMax, CELL *tbase,
660 int *vars_foundp,
struct db_globs *dbg) {
665#define Yap_REGS (*regp)
669 register CELL **tovisit = (CELL **)HR;
670 CELL **tovisit_base = tovisit;
674 Term ConstraintsTerm = TermNil;
677 CELL *CodeMaxBase = CodeMax;
680 while (pt0 <= pt0_end) {
688 if (IsApplTerm(d0)) {
695 if (ap2 >= tbase && ap2 <= StoPoint) {
696 db_check_trail(dbg->lr + 1);
697 *dbg->lr++ = ToSmall((CELL)(StoPoint) - (CELL)(tbase));
703 db_check_trail(dbg->lr + 1);
704 *dbg->lr++ = ToSmall((CELL)(StoPoint) - (CELL)(tbase));
706 if (IsExtensionFunctor(f)) {
708 case (CELL)FunctorDBRef: {
714 if (
dbentry->Flags & LogUpdMask) {
718 if (GLOBAL_Option[
'i' -
'a' + 1]) {
720 Yap_DebugPlWriteln(d0);
721 fprintf(stderr,
"+%p@%p %s\n", cl, cl->ClPred,
722 (b=IndicatorOfPred(cl->ClPred)));
731 db_check_trail(dbg->lr);
736 case (CELL)FunctorLongInt:
738 *StoPoint++ = AbsAppl(CodeMax);
739 CodeMax = copy_long_int(CodeMax, ap2);
743 case (CELL)FunctorBigInt:
744 CheckDBOverflow(3 + Yap_SizeOfBigInt(d0));
746 *StoPoint++ = AbsAppl(CodeMax);
747 CodeMax = copy_big_int(CodeMax, ap2);
751 case (CELL)FunctorString: {
754 CheckDBOverflow(3 + ap2[1]);
756 *StoPoint++ = AbsAppl(st);
757 CodeMax = copy_string(CodeMax, ap2);
761 case (CELL)FunctorDouble: {
766 *StoPoint++ = AbsAppl(st);
767 CodeMax = copy_double(CodeMax, ap2);
774 *StoPoint++ = AbsAppl(CodeMax);
776 CheckVisitOverflow();
778 tovisit[0] = pt0 + 1;
779 tovisit[1] = pt0_end;
780 tovisit[2] = StoPoint;
781 tovisit[3] = (CELL *)*pt0;
786 tovisit[0] = pt0 + 1;
787 tovisit[1] = pt0_end;
788 tovisit[2] = StoPoint;
792 d0 = ArityOfFunctor(f);
795 CheckDBOverflow(d0 + 1);
798 *CodeMax++ = (CELL)f;
804 }
else if (IsPairTerm(d0)) {
806 CELL *ap2 = RepPair(d0);
807 if (ap2 >= tbase && ap2 <= StoPoint) {
808 db_check_trail(dbg->lr + 1);
809 *dbg->lr++ = ToSmall((CELL)(StoPoint) - (CELL)(tbase));
814 if (IsAtomOrIntTerm(Deref(ap2[0])) && IsPairTerm(Deref(ap2[1]))) {
816 Term tt = Deref(ap2[1]);
817 Term th = Deref(ap2[0]);
818 Int direction = RepPair(tt) - ap2;
826 db_check_trail(dbg->lr + 1);
827 *dbg->lr++ = ToSmall((CELL)(StoPoint) - (CELL)(tbase));
828 *StoPoint++ = AbsPair(CodeMax);
829 OldStoPoint = StoPoint;
833 if (lp >= tbase && lp <= StoPoint) {
838 db_check_trail(dbg->lr + 1);
839 *dbg->lr++ = ToSmall((CELL)(CodeMax + 1) - (CELL)(tbase));
840 CodeMax[1] = AbsPair(CodeMax + 2);
844 }
while (IsAtomOrIntTerm(th) && IsPairTerm(tt) &&
846 (RepPair(tt) - lp) * direction > 0);
847 if (lp >= tbase && lp <= StoPoint) {
851 if (IsAtomOrIntTerm(th) && IsAtomOrIntTerm(tt)) {
860 StoPoint = OldStoPoint;
862 db_check_trail(dbg->lr + 1);
863 *dbg->lr++ = ToSmall((CELL)(StoPoint) - (CELL)(tbase));
864 *StoPoint++ = AbsPair(CodeMax);
868 tovisit[0] = pt0 + 1;
869 tovisit[1] = pt0_end;
870 tovisit[2] = StoPoint;
871 tovisit[3] = (CELL *)*pt0;
876 tovisit[0] = pt0 + 1;
877 tovisit[1] = pt0_end;
878 tovisit[2] = StoPoint;
882 CheckVisitOverflow();
888 pt0_end = RepPair(d0) + 1;
893 }
else if (IsAtomOrIntTerm(d0)) {
901 if (!DB_MARKED(d0)) {
917 CELL displacement = (CELL)(StoPoint) - (CELL)(tbase);
921 if (!DB_MARKED(d0)) {
928 *ptd0 = (CELL)StoPoint;
934 *StoPoint = (CELL)StoPoint;
936 db_check_trail(dbg->lr + 1);
937 *dbg->lr++ = ToSmall(displacement);
942 if (SafeIsAttachedTerm((CELL)ptd0)) {
944 int sz = tovisit - tovisit_base;
946 HR = (CELL *)tovisit;
951 t[1] = GLOBAL_attas[ExtFromCell(ptd0)].to_term_op(ptd0);
952 t[2] = MkIntegerTerm(ExtFromCell(ptd0));
953 t[3] = ConstraintsTerm;
954 ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
955 if (HR + sz >= ASP) {
958 memcpy((
void *)HR, (
void *)(tovisit_base), sz *
sizeof(CELL *));
959 tovisit_base = (CELL **)HR;
960 tovisit = tovisit_base + sz;
966 db_check_trail(dbg->lr + 1);
967 *dbg->lr++ = ToSmall(displacement);
977 if (tovisit > tovisit_base) {
981 pt0_end = tovisit[1];
982 StoPoint = tovisit[2];
983 pt0[-1] = (CELL)tovisit[3];
987 pt0_end = tovisit[1];
989 StoPoint = tovisit[2];
996 if (ConstraintsTerm != TermNil &&
997 !IN_BETWEEN(tbase, RepAppl(ConstraintsTerm), CodeMax)) {
998 *attachmentsp = (CELL)(CodeMax + 1);
999 pt0 = RepAppl(ConstraintsTerm) + 1;
1000 pt0_end = RepAppl(ConstraintsTerm) + 4;
1002 *StoPoint++ = RepAppl(ConstraintsTerm)[0];
1003 ConstraintsTerm = AbsAppl(CodeMax);
1010 *vars_foundp = vars_found;
1018 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1019 LOCAL_Error_Size = 1024 + ((
char *)AuxSp - (
char *)CodeMaxBase);
1020 *vars_foundp = vars_found;
1021#ifdef RATIONAL_TREES
1022 while (tovisit > tovisit_base) {
1025 pt0_end = tovisit[1];
1026 StoPoint = tovisit[2];
1027 pt0[-1] = (CELL)tovisit[3];
1037 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
1038 *vars_foundp = vars_found;
1039#ifdef RATIONAL_TREES
1040 while (tovisit > tovisit_base) {
1043 pt0_end = tovisit[1];
1044 StoPoint = tovisit[2];
1045 pt0[-1] = (CELL)tovisit[3];
1055 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
1056 *vars_foundp = vars_found;
1057#ifdef RATIONAL_TREES
1058 while (tovisit > tovisit_base) {
1061 pt0_end = tovisit[1];
1062 StoPoint = tovisit[2];
1063 pt0[-1] = (CELL)tovisit[3];
1073#define Yap_REGS (*Yap_regp)
1083static void sf_include(SFKeep *sfp,
struct db_globs *dbg) SFKeep *sfp;
1085 Term Tm = sfp->SName;
1086 CELL *tp = ArgsOfSFTerm(Tm);
1087 Register Term *StoPoint = ntp;
1088 CELL *displacement = CodeAbs;
1093 if (sfp->SFather != NIL)
1094 *(sfp->SFather) = AbsAppl(displacement);
1095 *StoPoint++ = FunctorOfTerm(Tm);
1096 db_check_trail(dbg->lr + 1);
1097 *dbg->lr++ = ToSmall(displacement + 1);
1098 *StoPoint++ = (Term)(displacement + 1);
1101 tvalue = Derefa(tp++);
1102 if (IsVarTerm(tvalue)) {
1103 if (((VarKeep *)tvalue)->NOfVars != 0) {
1104 *StoPoint++ = arg_no;
1105 db_check_trail(dbg->lr + 1);
1106 *dbg->lr++ = ToSmall(displacement + j);
1107 if (((VarKeep *)tvalue)->New == 0)
1108 *StoPoint++ = ((VarKeep *)tvalue)->New = Unsigned(displacement + j);
1110 *StoPoint++ = ((VarKeep *)tvalue)->New;
1113 }
else if (IsAtomicTerm(tvalue)) {
1114 *StoPoint++ = arg_no;
1115 *StoPoint++ = tvalue;
1118 LOCAL_Error_TYPE = TYPE_ERROR_DBTERM;
1119 LOCAL_ErrorMessage =
"wrong term in SF";
1125 CodeAbs = displacement + j;
1133inline static DBRef check_if_cons(
DBRef p, Term to_compare) {
1135 (p->Flags & (DBCode | ErasedMask | DBVar | DBNoVars | DBComplex) ||
1136 p->DBT.Entry != Unsigned(to_compare)))
1147 p->Flags & (DBCode | ErasedMask | DBAtomic | DBNoVars | DBComplex))
1161static DBRef check_if_wvars(
DBRef p,
unsigned int NOfCells, CELL *BTptr) {
1166 p->Flags & (DBCode | ErasedMask | DBAtomic | DBNoVars | DBVar))
1170 memptr = CellPtr(&(p->DBT.Contents));
1171 if (NOfCells == p->DBT.NOfCells && cmpclls(memptr, BTptr, NOfCells))
1179static int scheckcells(
int NOfCells,
register CELL *m1,
register CELL *m2,
1180 link_entry *lp,
register CELL bp) {
1181 CELL base = Unsigned(m1);
1184 while (NOfCells-- > 0) {
1185 Register CELL r1, r2;
1191 else if (r2 + bp == r1) {
1196 r1 = m1 - (CELL *)base;
1197 while (*lp1 != r1 && *lp1)
1215static DBRef check_if_nvars(
DBRef p,
unsigned int NOfCells, CELL *BTptr,
1221 p->Flags & (DBCode | ErasedMask | DBAtomic | DBComplex | DBVar))
1225 memptr = CellPtr(p->DBT.Contents);
1226 if (scheckcells(NOfCells, memptr, BTptr, dbg->LinkAr,
1227 Unsigned(p->DBT.Contents - 1)))
1235static DBRef generate_dberror_msg(
int errnumb, UInt sz,
char *msg) {
1237 LOCAL_Error_Size = sz;
1238 LOCAL_Error_TYPE = errnumb;
1239 LOCAL_ErrorMessage = msg;
1244 DBRef pp, dbr = DBRefOfTerm(Tm);
1248 UInt sz =
sizeof(
DBTerm) + 2 *
sizeof(CELL);
1249 ppt = (
DBTerm *)AllocDBSpace(sz);
1251 return generate_dberror_msg(RESOURCE_ERROR_HEAP, TermNil,
1252 "could not allocate heap");
1255 Yap_LUClauseSpace += sz;
1258 UInt sz = DBLength(2 *
sizeof(
DBRef));
1259 pp = AllocDBSpace(sz);
1261 return generate_dberror_msg(RESOURCE_ERROR_HEAP, 0,
1262 "could not allocate space");
1264 Yap_LUClauseSpace += sz;
1266 pp->id = FunctorDBRef;
1267 pp->Flags = DBNoVars | DBComplex | DBWithRefs;
1268 INIT_LOCK(pp->lock);
1269 INIT_DBREF_COUNT(pp);
1272 if (dbr->Flags & LogUpdMask) {
1280 ppt->Contents[0] = (CELL)NULL;
1281 ppt->Contents[1] = (CELL)dbr;
1282 ppt->DBRefs = (
DBRef *)(ppt->Contents + 2);
1284 ppt->ag.attachments = 0L;
1289static DBTerm *CreateDBTermForAtom(Term Tm, UInt extra_size,
1293 UInt sz = extra_size +
sizeof(
DBTerm);
1295 ptr = (ADDR)AllocDBSpace(sz);
1297 return (
DBTerm *)generate_dberror_msg(RESOURCE_ERROR_HEAP, 0,
1298 "could not allocate space");
1300 Yap_LUClauseSpace += sz;
1302 ppt = (
DBTerm *)(ptr + extra_size);
1306 ppt->ag.attachments = 0;
1313static DBTerm *CreateDBTermForVar(UInt extra_size,
struct db_globs *dbg) {
1316 UInt sz = extra_size +
sizeof(
DBTerm);
1318 ptr = (ADDR)AllocDBSpace(sz);
1320 return (
DBTerm *)generate_dberror_msg(RESOURCE_ERROR_HEAP, 0,
1321 "could not allocate space");
1323 Yap_LUClauseSpace += sz;
1325 ppt = (
DBTerm *)(ptr + extra_size);
1329 ppt->ag.attachments = 0;
1332 ppt->Entry = (CELL)(&(ppt->Entry));
1336static DBRef CreateDBRefForAtom(Term Tm,
DBProp p,
int InFlag,
1340 UInt sz = DBLength(NIL);
1343 if (InFlag & MkIfNot && (dbg->found_one = check_if_cons(p->First, Tm)))
1344 return dbg->found_one;
1345 pp = AllocDBSpace(sz);
1347 return generate_dberror_msg(RESOURCE_ERROR_HEAP, 0,
1348 "could not allocate space");
1350 Yap_LUClauseSpace += sz;
1352 pp->id = FunctorDBRef;
1353 INIT_LOCK(pp->lock);
1354 INIT_DBREF_COUNT(pp);
1358 pp->DBT.DBRefs = NULL;
1359 pp->DBT.NOfCells = 0;
1361 pp->DBT.ag.attachments = 0;
1366static DBRef CreateDBRefForVar(Term Tm,
DBProp p,
int InFlag,
1369 UInt sz = DBLength(NULL);
1371 if (InFlag & MkIfNot && (dbg->found_one = check_if_var(p->First)))
1372 return dbg->found_one;
1373 pp = AllocDBSpace(sz);
1375 return generate_dberror_msg(RESOURCE_ERROR_HEAP, 0,
1376 "could not allocate space");
1378 Yap_LUClauseSpace += sz;
1380 pp->id = FunctorDBRef;
1382 pp->DBT.Entry = (CELL)Tm;
1384 pp->DBT.NOfCells = 0;
1385 pp->DBT.DBRefs = NULL;
1387 pp->DBT.ag.attachments = 0;
1389 INIT_LOCK(pp->lock);
1390 INIT_DBREF_COUNT(pp);
1394static DBRef CreateDBStruct(Term Tm,
DBProp p,
int InFlag,
int *pstat,
1395 UInt extra_size,
struct db_globs *dbg) {
1397 Register Term tt, *nar = NIL;
1403 int vars_found = FALSE;
1404 yap_error_number oerr = LOCAL_Error_TYPE;
1407 LOCAL_Error_TYPE = YAP_NO_ERROR;
1408 TmpRefBase = (
DBRef *)LOCAL_TrailTop;
1410 if (IsVarTerm(Tm)) {
1412 if (!SafeIsAttachedTerm(Tm)) {
1414 DBRef out = (
DBRef)CreateDBTermForVar(extra_size, dbg);
1416 LOCAL_Error_TYPE = oerr;
1421 }
else if (IsAtomOrIntTerm(Tm)) {
1422 DBRef out = (
DBRef)CreateDBTermForAtom(Tm, extra_size, dbg);
1424 LOCAL_Error_TYPE = oerr;
1430 && !SafeIsAttachedTerm(Tm)
1434 LOCAL_Error_TYPE = oerr;
1435 return CreateDBRefForVar(Tm, p, InFlag, dbg);
1436 }
else if (IsAtomOrIntTerm(Tm)) {
1437 LOCAL_Error_TYPE = oerr;
1438 return CreateDBRefForAtom(Tm, p, InFlag, dbg);
1446 unsigned int NOfCells = 0;
1448 CELL attachments = 0;
1451 dbg->tofref = TmpRefBase;
1454 ADDR ptr = Yap_PreAllocCodeSpace();
1455 ppt0 = (
DBTerm *)(ptr + extra_size);
1458 pp0 = (
DBRef)Yap_PreAllocCodeSpace();
1461 if ((ADDR)ppt0 >= (ADDR)AuxSp - 1024) {
1462 LOCAL_Error_Size = (UInt)(extra_size +
sizeof(ppt0));
1463 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1464 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1465 LOCAL_Error_TYPE = oerr;
1468 ntp0 = ppt0->Contents;
1469 if ((ADDR)TR >= LOCAL_TrailTop - 1024) {
1470 LOCAL_Error_Size = 0;
1471 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
1472 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1473 LOCAL_Error_TYPE = oerr;
1477 dbg->lr = dbg->LinkAr = (link_entry *)TR;
1480 if (IsVarTerm(Tm)) {
1481 tt = (CELL)(ppt0->Contents);
1482 ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0 + 1, ntp0 - 1,
1483 &attachments, &vars_found, dbg);
1485 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1486 LOCAL_Error_TYPE = oerr;
1491 if (IsPairTerm(Tm)) {
1493 tt = AbsPair(ppt0->Contents);
1494 ntp = MkDBTerm(RepPair(Tm), RepPair(Tm) + 1, ntp0, ntp0 + 2, ntp0 - 1,
1500 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1501 LOCAL_Error_TYPE = oerr;
1508 tt = AbsAppl(ppt0->Contents);
1510 fun = FunctorOfTerm(Tm);
1511 if (IsExtensionFunctor(fun)) {
1512 switch ((CELL)fun) {
1513 case (CELL)FunctorDouble:
1514 ntp = copy_double(ntp0, RepAppl(Tm));
1516 case (CELL)FunctorString:
1518 UInt sz = 1024+
sizeof(CELL)*(3 + RepAppl(Tm)[1]);
1520 (
char*)AuxSp-(
char*)ppt0) {
1521 LOCAL_Error_Size = sz;
1522 if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
1523 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
1529 ntp = copy_string(ntp0, RepAppl(Tm));
1531 case (CELL)FunctorDBRef:
1532 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1533 return CreateDBWithDBRef(Tm, p, dbg);
1535 case (CELL)FunctorBigInt:
1537 UInt sz = 1024+
sizeof(CELL)*Yap_SizeOfBigInt(Tm);
1539 (
char*)AuxSp-(
char*)ppt0) {
1540 LOCAL_Error_Size =
sizeof(CELL)*(3 + RepAppl(Tm)[1]);
1541 if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
1542 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
1548 ntp = copy_big_int(ntp0, RepAppl(Tm));
1552 ntp = copy_long_int(ntp0, RepAppl(Tm));
1557 arity = ArityOfFunctor(fun);
1558 ntp = MkDBTerm(RepAppl(Tm) + 1, RepAppl(Tm) + arity, ntp0 + 1,
1559 ntp0 + 1 + arity, ntp0 - 1,
1565 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1566 LOCAL_Error_TYPE = oerr;
1571 CodeAbs = (CELL *)((CELL)ntp - (CELL)ntp0);
1572 if (LOCAL_Error_TYPE) {
1573 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1574 LOCAL_Error_TYPE = oerr;
1577 NOfCells = ntp - ntp0;
1579 NOfLinks = (dbg->lr - dbg->LinkAr);
1580 if (vars_found || InFlag & InQueue) {
1587 CodeAbs += (NOfLinks + (
sizeof(CELL) /
sizeof(BITS32) - 1)) /
1588 (
sizeof(CELL) /
sizeof(BITS32));
1589 if ((CELL *)((
char *)ntp0 + (CELL)CodeAbs) > AuxSp) {
1590 LOCAL_Error_Size = (UInt)DBLength(CodeAbs);
1591 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1592 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1593 LOCAL_Error_TYPE = oerr;
1596 if ((InFlag & MkIfNot) &&
1597 (dbg->found_one = check_if_wvars(p->First, NOfCells, ntp0))) {
1598 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1599 LOCAL_Error_TYPE = oerr;
1600 return dbg->found_one;
1604 if ((InFlag & MkIfNot) &&
1605 (dbg->found_one = check_if_nvars(p->First, NOfCells, ntp0, dbg))) {
1606 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1607 LOCAL_Error_TYPE = oerr;
1608 return dbg->found_one;
1611 if (dbg->tofref != TmpRefBase) {
1612 CodeAbs += (TmpRefBase - dbg->tofref) + 1;
1613 if ((CELL *)((
char *)ntp0 + (CELL)CodeAbs) > AuxSp) {
1614 LOCAL_Error_Size = (UInt)DBLength(CodeAbs);
1615 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1616 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1617 LOCAL_Error_TYPE = oerr;
1622#if SIZEOF_LINK_ENTRY == 2
1623 if (Unsigned(CodeAbs) >= 0x40000) {
1624 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1625 LOCAL_Error_TYPE = oerr;
1626 return generate_dberror_msg(SYSTEM_ERROR_INTERNAL, 0,
1627 "trying to store term larger than 256KB");
1631 UInt sz = (CELL)CodeAbs + extra_size +
sizeof(
DBTerm);
1632 ADDR ptr = Yap_AllocCodeSpace(sz);
1633 ppt = (
DBTerm *)(ptr + extra_size);
1635 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1636 LOCAL_Error_TYPE = oerr;
1637 return generate_dberror_msg(RESOURCE_ERROR_HEAP, sz,
1638 "heap crashed against stacks");
1640 Yap_LUClauseSpace += sz;
1644 UInt sz = DBLength(CodeAbs);
1645 pp = AllocDBSpace(sz);
1647 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1648 LOCAL_Error_TYPE = oerr;
1649 return generate_dberror_msg(RESOURCE_ERROR_HEAP, sz,
1650 "heap crashed against stacks");
1652 Yap_LUClauseSpace += sz;
1654 pp->id = FunctorDBRef;
1656 INIT_LOCK(pp->lock);
1657 INIT_DBREF_COUNT(pp);
1660 if (flag & DBComplex) {
1663 ppt->NOfCells = NOfCells;
1665 ppt->ag.attachments = attachments;
1668 nar = ppt->Contents;
1669 nar = (Term *)cpcells(CellPtr(nar), ntp0, Unsigned(NOfCells));
1671 nar = ppt->Contents + Unsigned(NOfCells);
1673 woar = (link_entry *)nar;
1674 memcpy((
void *)woar, (
const void *)dbg->LinkAr,
1675 (
size_t)(NOfLinks *
sizeof(link_entry)));
1678#if SIZEOF_INT_P == 8
1679 while ((Unsigned(woar) & 7) != 0)
1682 if ((Unsigned(woar) & 3) != 0)
1686 nar = (Term *)(woar);
1688 }
else if (flag & DBNoVars) {
1690 nar = (Term *)cpcells(CellPtr(ppt->Contents), ntp0, Unsigned(NOfCells));
1692 nar = ppt->Contents + Unsigned(NOfCells);
1694 ppt->NOfCells = NOfCells;
1697 linkblk(dbg->LinkAr, CellPtr(ppt->Contents - 1), (CELL)ppt - (CELL)ppt0);
1698 ppt->Entry = AdjustIDBPtr(tt, (CELL)ppt - (CELL)ppt0);
1701 ppt->ag.attachments = AdjustIDBPtr(attachments, (CELL)ppt - (CELL)ppt0);
1703 ppt->ag.attachments = 0L;
1708 ppt->ag.attachments = attachments;
1711 if (flag & DBWithRefs) {
1712 DBRef *ptr = TmpRefBase, *rfnar = (
DBRef *)nar;
1715 while (ptr != dbg->tofref)
1717 ppt->DBRefs = rfnar;
1721 Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
1722 LOCAL_Error_TYPE = oerr;
1727static DBRef record(
int Flag, Term key, Term t_data, Term t_code USES_REGS) {
1728 Register Term twork = key;
1734 dbg.found_one = NULL;
1739 p = FetchDBPropFromKey(twork, Flag & MkCode, TRUE,
"record/3"))) {
1742 if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars, 0, &dbg)) == NULL) {
1745 if ((Flag & MkIfNot) && dbg.found_one)
1748 if (x->Flags & (DBNoVars | DBComplex))
1749 x->Mask = EvalMasks(t_data, &x->Key);
1751 x->Mask = x->Key = 0;
1755 x->Flags |= DBNoCode;
1758 x->Flags |= DBClMask;
1761 x->Flags |= (InUseMask | DBClMask);
1764 WRITE_LOCK(p->DBRWLock);
1765 if (p->F0 == NULL) {
1769 if (Flag & MkFirst) {
1781 if (p->First == NIL) {
1782 p->First = p->Last = x;
1783 x->Prev = x->Next = NIL;
1784 }
else if (Flag & MkFirst) {
1786 (p->First)->Prev = x;
1791 (p->Last)->Next = x;
1795 if (Flag & MkCode) {
1796 x->Code = (
yamop *)IntegerOfTerm(t_code);
1798 WRITE_UNLOCK(p->DBRWLock);
1803static DBRef record_at(
int Flag,
DBRef r0, Term t_data, Term t_code USES_REGS) {
1813 if ((x = CreateDBStruct(t_data, p, Flag, &needs_vars, 0, &dbg)) == NULL) {
1817 if (x->Flags & (DBNoVars | DBComplex))
1818 x->Mask = EvalMasks(t_data, &x->Key);
1820 x->Mask = x->Key = 0;
1824 x->Flags |= DBNoCode;
1827 x->Flags |= DBClMask;
1830 x->Flags |= (InUseMask | DBClMask);
1833 WRITE_LOCK(p->DBRWLock);
1834 if (Flag & MkFirst) {
1853 if (Flag & MkFirst) {
1856 if (p->First == r0) {
1865 if (p->Last == r0) {
1872 if (Flag & WithRef) {
1873 x->Code = (
yamop *)IntegerOfTerm(t_code);
1875 WRITE_UNLOCK(p->DBRWLock);
1884 int needs_vars = FALSE;
1890 if (!pe || !(pe->PredFlags & ThreadLocalPredFlag))
1894 if ((x = (
DBTerm *)CreateDBStruct(t, NULL, d_flag, &needs_vars, (UInt)ipc,
1900 cl->Id = FunctorDBRef;
1901 cl->ClFlags = LogUpdMask;
1902 cl->lusl.ClSource = x;
1906 cl->ClPrev = cl->ClNext = NULL;
1907 cl->ClSize = dbg.sz;
1909 if (pe && pe->LastCallOfPred != LUCALL_ASSERT) {
1910 if (pe->TimeStampOfPred >= TIMESTAMP_RESET)
1911 Yap_UpdateTimestamps(pe);
1912 ++pe->TimeStampOfPred;
1915 pe->LastCallOfPred = LUCALL_ASSERT;
1916 cl->ClTimeStart = pe->TimeStampOfPred;
1918 cl->ClTimeStart = 0L;
1920 cl->ClTimeEnd = TIMESTAMP_EOT;
1924 INIT_CLREF_COUNT(cl);
1925 ipc->opc = Yap_opcode(_copy_idb_term);
1928 ipc->opc = Yap_opcode(_copy_idb_term);
1930 ipc->opc = Yap_opcode(_unify_idb_term);
1940 LOCAL_Error_Size = 0;
1941 while ((x = new_lu_db_entry(t, pe)) == NULL) {
1942 if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
1945 XREGS[nargs + 1] = t;
1946 if (recover_from_record_error(nargs + 1)) {
1947 t = Deref(XREGS[nargs + 1]);
1959 if ((cl = new_lu_db_entry(t, pe)) == NULL) {
1963 Yap_inform_profiler_of_clause(cl, (
char *)cl + cl->ClSize, pe,
1964 GPROF_NEW_LU_CLAUSE);
1966 Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
1976 if ((cl = new_lu_db_entry(t, pe)) == NULL) {
1980 if (pe->cs.p_code.NOfClauses > 1)
1981 Yap_RemoveIndexation(pe);
1982 if (position == MkFirst) {
1985 if (ocl->ClCode == pe->cs.p_code.FirstClause) {
1987 pe->cs.p_code.FirstClause = cl->ClCode;
1989 cl->ClPrev = ocl->ClPrev;
1990 ocl->ClPrev->ClNext = cl;
1996 if (ocl->ClCode == pe->cs.p_code.LastClause) {
1998 pe->cs.p_code.LastClause = cl->ClCode;
2000 cl->ClNext = ocl->ClNext;
2001 ocl->ClNext->ClPrev = cl;
2005 pe->cs.p_code.NOfClauses++;
2006 if (pe->cs.p_code.NOfClauses > 1) {
2007 pe->OpcodeOfPred = INDEX_OPCODE;
2008 pe->CodeOfPred = (
yamop *)(&(pe->OpcodeOfPred));
2015static Int p_rcda(USES_REGS1) {
2017 Term TRef, t1 = Deref(ARG1);
2019 if (!IsVarTerm(Deref(ARG3)))
2021 pe = find_lu_entry(t1);
2022 LOCAL_Error_Size = 0;
2028 cl = record_lu(pe, Deref(ARG2), MkFirst);
2032 INC_CLREF_COUNT(cl);
2034 cl->ClFlags |= InUseMask;
2036 TRef = MkDBRefTerm((
DBRef)cl);
2042 TRef = MkDBRefTerm(record(MkFirst, t1, Deref(ARG2), Unsigned(0) PASS_REGS));
2044 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2045 if (recover_from_record_error(3)) {
2046 goto restart_record;
2053 return Yap_unify(ARG3, TRef);
2057static Int p_rcdap(USES_REGS1) {
2058 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
2060 if (!IsVarTerm(Deref(ARG3)))
2062 LOCAL_Error_Size = 0;
2064 TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0) PASS_REGS));
2066 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2067 if (recover_from_record_error(3)) {
2070 goto restart_record;
2075 return Yap_unify(ARG3, TRef);
2087static Int p_rcda_at(USES_REGS1) {
2089 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
2092 if (!IsVarTerm(Deref(ARG3)))
2094 if (IsVarTerm(t1)) {
2095 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"recorda_at/3");
2098 if (!IsDBRefTerm(t1)) {
2099 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"recorda_at/3");
2102 LOCAL_Error_Size = 0;
2104 dbr = DBRefOfTerm(t1);
2105 if (dbr->Flags & ErasedMask) {
2109 if (dbr->Flags & LogUpdMask) {
2113 record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0) PASS_REGS));
2115 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2116 if (recover_from_record_error(3)) {
2119 goto restart_record;
2124 return Yap_unify(ARG3, TRef);
2134static Int p_rcdz(USES_REGS1) { Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
2137 if (!IsVarTerm(Deref(ARG3)))
2139 pe = find_lu_entry(t1);
2140 LOCAL_Error_Size = 0;
2146 cl = record_lu(pe, t2, MkLast);
2150 INC_CLREF_COUNT(cl);
2152 cl->ClFlags |= InUseMask;
2154 TRef = MkDBRefTerm((
DBRef)cl);
2160 TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0) PASS_REGS));
2162 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2163 if (recover_from_record_error(3)) {
2166 goto restart_record;
2173 return Yap_unify(ARG3, TRef);
2177Int Yap_Recordz(
Atom at, Term t2) {
2181 pe = find_lu_entry(MkAtomTerm(at));
2182 LOCAL_Error_Size = 0;
2185 record_lu(pe, t2, MkLast);
2187 record(MkLast, MkAtomTerm(at), t2, Unsigned(0) PASS_REGS);
2189 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2191 if (recover_from_record_error(1)) {
2193 goto restart_record;
2202static Int p_rcdzp(USES_REGS1) {
2203 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
2205 if (!IsVarTerm(Deref(ARG3)))
2207 LOCAL_Error_Size = 0;
2209 TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0) PASS_REGS));
2210 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2211 if (recover_from_record_error(3)) {
2214 goto restart_record;
2219 return Yap_unify(ARG3, TRef);
2231static Int p_rcdz_at(USES_REGS1) {
2233 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
2236 if (!IsVarTerm(Deref(ARG3)))
2238 if (IsVarTerm(t1)) {
2239 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"recordz_at/3");
2242 if (!IsDBRefTerm(t1)) {
2243 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"recordz_at/3");
2246 LOCAL_Error_Size = 0;
2248 dbr = DBRefOfTerm(t1);
2249 if (dbr->Flags & ErasedMask) {
2253 if (dbr->Flags & LogUpdMask) {
2256 TRef = MkDBRefTerm(record_at(MkLast, dbr, t2, Unsigned(0) PASS_REGS));
2258 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2259 if (recover_from_record_error(3)) {
2262 goto restart_record;
2267 return Yap_unify(ARG3, TRef);
2271static Int p_rcdstatp(USES_REGS1) {
2272 Term t1 = Deref(ARG1), t2 = Deref(ARG2), t3 = Deref(ARG3);
2276 if (IsVarTerm(t3) || !IsIntTerm(t3))
2278 if (IsVarTerm(t3) || !IsIntTerm(t3))
2280 mk_first = ((IntOfTerm(t3) % 4) == 2);
2281 LOCAL_Error_Size = 0;
2285 MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0) PASS_REGS));
2287 TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0) PASS_REGS));
2288 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2289 if (recover_from_record_error(4)) {
2293 goto restart_record;
2298 return Yap_unify(ARG4, TRef);
2302static Int p_drcdap(USES_REGS1) {
2303 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2), t4 = Deref(ARG4);
2305 if (!IsVarTerm(Deref(ARG3)))
2307 if (IsVarTerm(t4) || !IsIntegerTerm(t4))
2309 LOCAL_Error_Size = 0;
2311 TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef, t1, t2, t4 PASS_REGS));
2312 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2313 if (recover_from_record_error(4)) {
2317 goto restart_record;
2322 return Yap_unify(ARG3, TRef);
2326static Int p_drcdzp(USES_REGS1) {
2327 Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2), t4 = Deref(ARG4);
2329 if (!IsVarTerm(Deref(ARG3)))
2331 if (IsVarTerm(t4) || !IsIntegerTerm(t4))
2334 LOCAL_Error_Size = 0;
2335 TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef, t1, t2, t4 PASS_REGS));
2336 if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
2337 if (recover_from_record_error(4)) {
2341 goto restart_record;
2346 return Yap_unify(ARG3, TRef);
2349static Int p_still_variant(USES_REGS1) {
2350 CELL *old_h = B->cp_h;
2351 tr_fr_ptr old_tr = B->cp_tr;
2352 Term t1 = Deref(ARG1), t2 = Deref(ARG2);
2356 if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
2359 if (dbr->id != FunctorDBRef) {
2363 dbr = DBRefOfTerm(t1);
2369 if (dbr->Flags & LogUpdMask) {
2372 if (old_tr == TR - 1) {
2373 if (TrailTerm(old_tr) != CLREF_TO_TRENTRY(cl))
2375 }
else if (old_tr != TR)
2377 if (Yap_op_from_opcode(cl->ClCode->opc) == _unify_idb_term) {
2380 dbt = cl->lusl.ClSource;
2383 if (old_tr == TR - 1) {
2384 if (TrailTerm(old_tr) != REF_TO_TRENTRY(dbr))
2386 }
else if (old_tr != TR)
2388 if (dbr->Flags & (DBNoVars | DBAtomic))
2390 if (dbr->Flags & DBVar)
2391 return IsVarTerm(t2);
2399 link_entry *lp = (link_entry *)(dbt->Contents + dbt->NOfCells);
2402 if (!dbt->NOfCells) {
2403 return IsVarTerm(t2);
2405 while ((link = *lp++)) {
2406 Term t2 = Deref(old_h[link - 1]);
2407 if (IsUnboundVar(dbt->Contents + (link - 1))) {
2408 if (IsVarTerm(t2)) {
2409 Yap_unify(t2, MkAtomTerm(AtomFoundVar));
2420static int copy_attachments(CELL *ts USES_REGS) {
2427 if (GLOBAL_attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0] PASS_REGS) ==
2434 if (ts[3] == TermNil)
2436 ts = RepAppl(ts[3]) + 1;
2443 if (ap->PredFlags & NumberDBPredFlag) {
2445 Int
id = ap->src.IndxId;
2447 return MkIntegerTerm(
id);
2448 }
else if (ap->PredFlags & AtomDBPredFlag ||
2449 (ap->ModuleOfPred != IDB_MODULE && ap->ArityOfPE == 0)) {
2452 return MkAtomTerm(at);
2454 Functor f = ap->FunctorOfPred;
2456 return Yap_MkNewApplTerm(f, ArityOfFunctor(f));
2460static int UnifyDBKey(
DBRef DBSP, PropFlags flags, Term t) {
2464 READ_LOCK(p->DBRWLock);
2466 if (p->ArityOfDB == 0) {
2467 t1 = MkAtomTerm((
Atom)(p->FunctorOfDB));
2469 t1 = Yap_MkNewApplTerm(p->FunctorOfDB, p->ArityOfDB);
2471 if ((p->KindOfPE & CodeDBBit) && (flags & CodeDBBit)) {
2474 t[0] = p->ModuleOfDB;
2478 tf = Yap_MkApplTerm(FunctorModule, 2, t);
2479 }
else if (!(flags & CodeDBBit)) {
2484 READ_UNLOCK(p->DBRWLock);
2485 return Yap_unify(tf, t);
2488static int UnifyDBNumber(
DBRef DBSP, Term t) {
2494 READ_LOCK(p->DBRWLock);
2496 while (ref != NIL) {
2505 READ_UNLOCK(p->DBRWLock);
2506 return Yap_unify(MkIntegerTerm(i), t);
2509Int Yap_unify_immediate_ref(
DBRef ref USES_REGS) {
2512 if (ref == NULL || DEAD_REF(ref) || !UnifyDBKey(ref, 0, ARG1) ||
2513 !UnifyDBNumber(ref, ARG2)) {
2522static Term GetDBTerm(
DBTerm *DBSP,
int src USES_REGS) {
2523 Term t = DBSP->Entry;
2527 && !DBSP->ag.attachments
2531 }
else if (IsAtomOrIntTerm(t)) {
2539 if (!(NOf = DBSP->NOfCells)) {
2542 pt = CellPtr(DBSP->Contents);
2543 CalculateStackGap(PASS_REGS1);
2544 if (HR + NOf > ASP - EventFlag /
sizeof(CELL)) {
2545 if (LOCAL_PrologMode & InErrorMode) {
2546 LOCAL_PrologMode &= ~InErrorMode;
2549 "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n");
2552 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
2553 LOCAL_Error_Size = NOf *
sizeof(CELL);
2557 HeapPtr = cpcells(HOld, pt, NOf);
2558 pt += HeapPtr - HOld;
2561 link_entry *lp = (link_entry *)pt;
2562 linkblk(lp, HOld - 1, (CELL)HOld - (CELL)(DBSP->Contents));
2565 if (DBSP->ag.attachments != 0L && !src) {
2566 if (!copy_attachments((CELL *)AdjustIDBPtr(
2567 DBSP->ag.attachments, (CELL)HOld - (CELL)(DBSP->Contents))
2570 LOCAL_Error_TYPE = RESOURCE_ERROR_ATTRIBUTED_VARIABLES;
2571 LOCAL_Error_Size = 0;
2576 return AdjustIDBPtr(t, Unsigned(HOld) - (CELL)(DBSP->Contents));
2580static Term GetDBTermFromDBEntry(
DBRef DBSP USES_REGS) {
2581 if (DBSP->Flags & (DBNoVars | DBAtomic))
2582 return DBSP->DBT.Entry;
2583 return GetDBTerm(&(DBSP->DBT), FALSE PASS_REGS);
2586static void init_int_keys(
void) {
2587 INT_KEYS = (
Prop *)Yap_AllocCodeSpace(
sizeof(
Prop) * INT_KEYS_SIZE);
2588 if (INT_KEYS != NULL) {
2591 for (i = 0; i < INT_KEYS_SIZE; i++) {
2595 Yap_LUClauseSpace +=
sizeof(
Prop) * INT_KEYS_SIZE;
2599static void init_int_lu_keys(
void) {
2600 INT_LU_KEYS = (
Prop *)Yap_AllocCodeSpace(
sizeof(
Prop) * INT_KEYS_SIZE);
2601 if (INT_LU_KEYS != NULL) {
2603 Prop *p = INT_LU_KEYS;
2604 for (i = 0; i < INT_KEYS_SIZE; i++) {
2608 Yap_LUClauseSpace +=
sizeof(
Prop) * INT_KEYS_SIZE;
2612static int resize_int_keys(UInt new_size) {
2616 UInt old_size = INT_KEYS_SIZE;
2618 YAPEnterCriticalSection();
2619 if (INT_KEYS == NULL) {
2620 INT_KEYS_SIZE = new_size;
2621 YAPLeaveCriticalSection();
2624 new = (
Prop *)Yap_AllocCodeSpace(
sizeof(
Prop) * new_size);
2626 YAPLeaveCriticalSection();
2627 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
2628 LOCAL_ErrorMessage =
"could not allocate space";
2631 Yap_LUClauseSpace +=
sizeof(
Prop) * new_size;
2632 for (i = 0; i < new_size; i++) {
2635 for (i = 0; i < INT_KEYS_SIZE; i++) {
2636 if (INT_KEYS[i] != NIL) {
2637 Prop p0 = INT_KEYS[i];
2639 DBProp p = RepDBProp(p0);
2640 CELL key = (CELL)(p->FunctorOfDB);
2641 UInt hash_key = (CELL)key % new_size;
2643 p->NextOfPE =
new[hash_key];
2644 new[hash_key] = AbsDBProp(p);
2648 Yap_LUClauseSpace -=
sizeof(
Prop) * old_size;
2649 Yap_FreeCodeSpace((
char *)INT_KEYS);
2651 INT_KEYS_SIZE = new_size;
2652 INT_KEYS_TIMESTAMP++;
2653 if (INT_KEYS_TIMESTAMP == MAX_ABS_INT)
2654 INT_KEYS_TIMESTAMP = 0;
2655 YAPLeaveCriticalSection();
2659static PredEntry *find_lu_int_key(Int key) {
2660 UInt hash_key = (CELL)key % INT_KEYS_SIZE;
2663 if (INT_LU_KEYS != NULL) {
2664 p0 = INT_LU_KEYS[hash_key];
2667 if (pe->src.IndxId == key) {
2673 if (UPDATE_MODE == UPDATE_MODE_LOGICAL && find_int_key(key) == NULL) {
2674 return new_lu_int_key(key);
2679PredEntry *Yap_FindLUIntKey(Int key) {
return find_lu_int_key(key); }
2681static DBProp find_int_key(Int key) {
2682 UInt hash_key = (CELL)key % INT_KEYS_SIZE;
2685 if (INT_KEYS == NULL) {
2688 p0 = INT_KEYS[hash_key];
2690 DBProp p = RepDBProp(p0);
2691 if (p->FunctorOfDB == (
Functor)key)
2698static PredEntry *new_lu_int_key(Int key) {
2699 UInt hash_key = (CELL)key % INT_KEYS_SIZE;
2704 if (INT_LU_KEYS == NULL) {
2706 if (INT_LU_KEYS == NULL) {
2708 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
2709 LOCAL_ErrorMessage =
"could not allocate space";
2714 WRITE_LOCK(ae->ARWLock);
2715 p0 = Yap_NewPredPropByAtom(ae, IDB_MODULE);
2716 p = RepPredProp(p0);
2717 p->NextOfPE = INT_LU_KEYS[hash_key];
2718 p->src.IndxId = key;
2719 p->PredFlags |= LogUpdatePredFlag | NumberDBPredFlag;
2721 p->OpcodeOfPred = Yap_opcode(_op_fail);
2722 p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = FAILCODE;
2723 if (p->PredFlags & ProfiledPredFlag) {
2724 if (!Yap_initProfiler(p)) {
2728 INT_LU_KEYS[hash_key] = p0;
2737 if (IsApplTerm(t)) {
2741 p0 = Yap_NewPredPropByFunctor(f, IDB_MODULE);
2742 }
else if (IsAtomTerm(t)) {
2743 Atom at = AtomOfTerm(t);
2745 WRITE_LOCK(RepAtom(at)->ARWLock);
2746 p0 = Yap_NewPredPropByAtom(at, IDB_MODULE);
2748 FUNC_WRITE_LOCK(FunctorList);
2749 p0 = Yap_NewPredPropByFunctor(FunctorList, IDB_MODULE);
2751 pe = RepPredProp(p0);
2752 pe->PredFlags |= LogUpdatePredFlag;
2753 if (IsAtomTerm(t)) {
2754 pe->PredFlags |= AtomDBPredFlag;
2755 pe->FunctorOfPred = (
Functor)AtomOfTerm(t);
2757 pe->FunctorOfPred = FunctorOfTerm(t);
2760 pe->OpcodeOfPred = Yap_opcode(_op_fail);
2761 if (CurrentModule == PROLOG_MODULE)
2762 pe->PredFlags |= StandardPredFlag;
2763 pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
2764 if (pe->PredFlags & ProfiledPredFlag) {
2765 if (!Yap_initProfiler(pe)) {
2772static DBProp find_entry(Term t) {
2777 return RepDBProp(NIL);
2778 }
else if (IsAtomTerm(t)) {
2782 }
else if (IsIntegerTerm(t)) {
2783 return find_int_key(IntegerOfTerm(t));
2784 }
else if (IsApplTerm(t)) {
2787 at = NameOfFunctor(f);
2788 arity = ArityOfFunctor(f);
2793 DBProp rc = RepDBProp(FindDBProp(RepAtom(at), 0, arity, 0));
2797static PredEntry *find_lu_entry(Term t) {
2801 Yap_ThrowError(INSTANTIATION_ERROR, t,
"while accessing database key");
2804 if (IsIntegerTerm(t)) {
2805 return find_lu_int_key(IntegerOfTerm(t));
2806 }
else if (IsApplTerm(t)) {
2809 if (IsExtensionFunctor(f)) {
2810 Yap_ThrowError(TYPE_ERROR_KEY, t,
"while accessing database key");
2813 p = Yap_GetPredPropByFuncInThisModule(FunctorOfTerm(t), IDB_MODULE);
2814 }
else if (IsAtomTerm(t)) {
2815 p = Yap_GetPredPropByAtomInThisModule(AtomOfTerm(t), IDB_MODULE);
2817 p = Yap_GetPredPropByFuncInThisModule(FunctorList, IDB_MODULE);
2820 if (UPDATE_MODE == UPDATE_MODE_LOGICAL && !find_entry(t)) {
2821 return new_lu_entry(t);
2826 return RepPredProp(p);
2829static DBProp FetchIntDBPropFromKey(Int key,
int flag,
int new,
2832 UInt hash_key = (CELL)key % INT_KEYS_SIZE;
2835 if (INT_KEYS == NULL) {
2837 if (INT_KEYS == NULL) {
2839 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
2840 LOCAL_ErrorMessage =
"could not allocate space";
2844 p0 = INT_KEYS[hash_key];
2846 DBProp p = RepDBProp(p0);
2847 if (p->FunctorOfDB == fun)
2855 p = (
DBProp)Yap_AllocAtomSpace(
sizeof(*p));
2856 p->KindOfPE = DBProperty | flag;
2857 p->F0 = p->L0 = NULL;
2859 p->First = p->Last = NULL;
2861 p->FunctorOfDB = fun;
2862 p->NextOfPE = INT_KEYS[hash_key];
2863 INIT_RWLOCK(p->DBRWLock);
2864 INT_KEYS[hash_key] = AbsDBProp(p);
2867 return RepDBProp(NULL);
2871static DBProp FetchDBPropFromKey(Term twork,
int flag,
int new,
2877 if (flag & MkCode) {
2878 if (IsVarTerm(twork)) {
2879 Yap_ThrowError(INSTANTIATION_ERROR, twork, error_mssg);
2880 return RepDBProp(NULL);
2882 if (!IsApplTerm(twork)) {
2883 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, twork,
"missing module");
2884 return RepDBProp(NULL);
2886 Functor f = FunctorOfTerm(twork);
2887 if (f != FunctorModule) {
2888 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, twork,
"missing module");
2889 return RepDBProp(NULL);
2891 dbmod = ArgOfTerm(1, twork);
2892 if (IsVarTerm(dbmod)) {
2893 Yap_ThrowError(INSTANTIATION_ERROR, twork,
"var in module");
2894 return RepDBProp(NIL);
2896 if (!IsAtomTerm(dbmod)) {
2897 Yap_ThrowError(TYPE_ERROR_ATOM, twork,
"not atom in module");
2898 return RepDBProp(NIL);
2900 twork = ArgOfTerm(2, twork);
2905 if (IsVarTerm(twork)) {
2906 Yap_ThrowError(INSTANTIATION_ERROR, twork, error_mssg);
2907 return RepDBProp(NIL);
2908 }
else if (IsAtomTerm(twork)) {
2909 arity = 0, At = AtomOfTerm(twork);
2910 }
else if (IsIntegerTerm(twork)) {
2911 return FetchIntDBPropFromKey(IntegerOfTerm(twork), flag,
new, error_mssg);
2912 }
else if (IsApplTerm(twork)) {
2913 Register
Functor f = FunctorOfTerm(twork);
2914 if (IsExtensionFunctor(f)) {
2915 Yap_ThrowError(TYPE_ERROR_KEY, twork, error_mssg);
2916 return RepDBProp(NIL);
2918 At = NameOfFunctor(f);
2919 arity = ArityOfFunctor(f);
2920 }
else if (IsPairTerm(twork)) {
2924 Yap_ThrowError(TYPE_ERROR_KEY, twork, error_mssg);
2925 return RepDBProp(NIL);
2931 WRITE_LOCK(ae->ARWLock);
2933 p = RepDBProp(FindDBPropHavingLock(ae, flag, arity, dbmod)))) {
2935 int OLD_UPDATE_MODE = UPDATE_MODE;
2936 if (flag & MkCode) {
2938 pp = RepPredProp(Yap_GetPredPropHavingLock(At, arity, dbmod));
2940 if (!EndOfPAEntr(pp)) {
2942 if (pp->PredFlags & LogUpdatePredFlag)
2943 UPDATE_MODE = UPDATE_MODE_LOGICAL;
2947 p = (
DBProp)Yap_AllocAtomSpace(
sizeof(*p));
2948 p->KindOfPE = DBProperty | flag;
2949 p->F0 = p->L0 = NULL;
2950 UPDATE_MODE = OLD_UPDATE_MODE;
2951 p->ArityOfDB = arity;
2952 p->First = p->Last = NIL;
2953 p->ModuleOfDB = dbmod;
2955 INIT_RWLOCK(p->DBRWLock);
2959 p->FunctorOfDB = Yap_UnlockedMkFunctor(ae, arity);
2962 WRITE_UNLOCK(ae->ARWLock);
2965 return RepDBProp(FindDBProp(RepAtom(At), flag, arity, dbmod));
2968static Int lu_nth_recorded(
PredEntry *pe, Int Count USES_REGS) {
2971 XREGS[2] = MkVarTerm();
2972 cl = Yap_NthClause(pe, Count);
2977 INC_CLREF_COUNT(cl);
2979 if (!(cl->ClFlags & InUseMask)) {
2980 cl->ClFlags |= InUseMask;
2985 return Yap_unify(MkDBRefTerm((
DBRef)cl), ARG4);
2989static Int nth_recorded(
DBProp AtProp, Int Count USES_REGS) {
2992 READ_LOCK(AtProp->DBRWLock);
2993 ref = AtProp->First;
2995 while (ref != NULL && DEAD_REF(ref))
2996 ref = NextDBRef(ref);
2998 READ_UNLOCK(AtProp->DBRWLock);
3003 ref = NextDBRef(ref);
3004 while (ref != NULL && DEAD_REF(ref))
3005 ref = NextDBRef(ref);
3007 READ_UNLOCK(AtProp->DBRWLock);
3013 READ_UNLOCK(AtProp->DBRWLock);
3015 INC_DBREF_COUNT(ref);
3018 if (!(ref->Flags & InUseMask)) {
3019 ref->Flags |= InUseMask;
3022 READ_UNLOCK(AtProp->DBRWLock);
3024 return Yap_unify(MkDBRefTerm(ref), ARG4);
3027Int Yap_db_nth_recorded(
PredEntry *pe, Int Count USES_REGS) {
3031 return lu_nth_recorded(pe, Count PASS_REGS);
3033 if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE,
3034 "nth_instance/3"))) {
3038 return nth_recorded(AtProp, Count PASS_REGS);
3041static Int p_db_key(USES_REGS1) {
3042 Register Term twork = Deref(ARG1);
3045 if (EndOfPAEntr(AtProp = FetchDBPropFromKey(twork, 0, TRUE,
"db_key/3"))) {
3049 return Yap_unify(ARG2, MkIntegerTerm((Int)AtProp));
3053static Int i_recorded(
DBProp AtProp, Term t3 USES_REGS) {
3058 READ_LOCK(AtProp->DBRWLock);
3059 ref = AtProp->First;
3060 while (ref != NULL && DEAD_REF(ref))
3061 ref = NextDBRef(ref);
3062 READ_UNLOCK(AtProp->DBRWLock);
3066 twork = Deref(ARG2);
3067 if (IsVarTerm(twork)) {
3068 EXTRA_CBACK_ARG(3, 2) = MkIntegerTerm(0);
3069 EXTRA_CBACK_ARG(3, 3) = MkIntegerTerm(0);
3071 while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
3073 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3075 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3076 LOCAL_Error_TYPE = YAP_NO_ERROR;
3077 if (!Yap_growglobal(NULL)) {
3078 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3079 LOCAL_ErrorMessage);
3083 LOCAL_Error_TYPE = YAP_NO_ERROR;
3085 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3089 LOCAL_Error_Size = 0;
3090 twork = Deref(ARG2);
3093 if (!Yap_unify(twork, TermDB)) {
3096 }
else if (IsAtomOrIntTerm(twork)) {
3097 EXTRA_CBACK_ARG(3, 2) = MkIntegerTerm(0);
3098 EXTRA_CBACK_ARG(3, 3) = MkIntegerTerm((Int)twork);
3100 READ_LOCK(AtProp->DBRWLock);
3102 if (((twork == ref->DBT.Entry) || IsVarTerm(ref->DBT.Entry)) &&
3105 ref = NextDBRef(ref);
3107 READ_UNLOCK(AtProp->DBRWLock);
3111 READ_UNLOCK(AtProp->DBRWLock);
3114 CELL mask = EvalMasks(twork, &key);
3117 READ_LOCK(AtProp->DBRWLock);
3119 while ((mask & ref->Key) != (key & ref->Mask) && !DEAD_REF(ref)) {
3120 ref = NextDBRef(ref);
3122 READ_UNLOCK(AtProp->DBRWLock);
3126 if ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) != (CELL)0) {
3127 if (Yap_unify(TermDB, ARG2)) {
3129 EXTRA_CBACK_ARG(3, 2) = MkIntegerTerm(((Int)mask));
3130 EXTRA_CBACK_ARG(3, 3) = MkIntegerTerm(((Int)key));
3134 while ((ref = NextDBRef(ref)) != NULL && DEAD_REF(ref))
3137 READ_UNLOCK(AtProp->DBRWLock);
3143 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3144 READ_UNLOCK(AtProp->DBRWLock);
3145 EXTRA_CBACK_ARG(3, 2) = MkIntegerTerm(((Int)mask));
3146 EXTRA_CBACK_ARG(3, 3) = MkIntegerTerm(((Int)key));
3148 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3149 LOCAL_Error_TYPE = YAP_NO_ERROR;
3150 if (!Yap_growglobal(NULL)) {
3151 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3152 LOCAL_ErrorMessage);
3156 LOCAL_Error_TYPE = YAP_NO_ERROR;
3158 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3162 READ_LOCK(AtProp->DBRWLock);
3165 READ_UNLOCK(AtProp->DBRWLock);
3167 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3170 TRef = MkDBRefTerm(ref);
3174 INC_DBREF_COUNT(ref);
3177 if (!(ref->Flags & InUseMask)) {
3178 ref->Flags |= InUseMask;
3182 return (Yap_unify(ARG3, TRef));
3185static Int c_recorded(
int flags USES_REGS) {
3187 Register
DBRef ref, ref0;
3188 CELL *PreviousHeap = HR;
3192 t1 = EXTRA_CBACK_ARG(3, 1);
3194 READ_LOCK(ref0->Parent->DBRWLock);
3195 ref = NextDBRef(ref0);
3197 if (ref0->Flags & ErasedMask) {
3199 while ((ref = ref->n) != NULL) {
3200 if (!(ref->Flags & ErasedMask))
3206 READ_UNLOCK(ref0->Parent->DBRWLock);
3210 READ_UNLOCK(ref0->Parent->DBRWLock);
3216 Term ttmp = EXTRA_CBACK_ARG(3, 2);
3217 if (IsLongIntTerm(ttmp))
3218 mask = (CELL)LongIntOfTerm(ttmp);
3220 mask = (CELL)IntOfTerm(ttmp);
3223 Term ttmp = EXTRA_CBACK_ARG(3, 3);
3224 if (IsLongIntTerm(ttmp))
3225 key = (CELL)LongIntOfTerm(ttmp);
3227 key = (CELL)IntOfTerm(ttmp);
3229 while (ref != NIL && DEAD_REF(ref))
3230 ref = NextDBRef(ref);
3232 READ_UNLOCK(ref0->Parent->DBRWLock);
3235 if (mask == 0 && key == 0) {
3236 while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
3238 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3240 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3241 LOCAL_Error_TYPE = YAP_NO_ERROR;
3242 if (!Yap_growglobal(NULL)) {
3243 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3244 LOCAL_ErrorMessage);
3248 LOCAL_Error_TYPE = YAP_NO_ERROR;
3250 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3254 LOCAL_Error_Size = 0;
3257 Yap_unify(ARG2, TermDB);
3258 }
else if (mask == 0) {
3260 if (((key == Unsigned(ref->DBT.Entry)) || (ref->Flags & DBVar)) &&
3263 ref = NextDBRef(ref);
3264 }
while (ref != NIL);
3266 READ_UNLOCK(ref0->Parent->DBRWLock);
3272 while ((mask & ref->Key) != (key & ref->Mask)) {
3273 while ((ref = NextDBRef(ref)) != NIL && DEAD_REF(ref))
3276 READ_UNLOCK(ref0->Parent->DBRWLock);
3280 while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
3282 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3284 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3285 LOCAL_Error_TYPE = YAP_NO_ERROR;
3286 if (!Yap_growglobal(NULL)) {
3287 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3288 LOCAL_ErrorMessage);
3292 LOCAL_Error_TYPE = YAP_NO_ERROR;
3294 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3298 LOCAL_Error_Size = 0;
3301 if (Yap_unify(ARG2, TermDB))
3303 while ((ref = NextDBRef(ref)) != NIL && DEAD_REF(ref))
3306 READ_UNLOCK(ref0->Parent->DBRWLock);
3310 READ_UNLOCK(ref0->Parent->DBRWLock);
3311 TRef = MkDBRefTerm(ref);
3312 EXTRA_CBACK_ARG(3, 1) = (CELL)ref;
3316 INC_DBREF_COUNT(ref);
3319 if (!(ref->Flags & InUseMask)) {
3320 ref->Flags |= InUseMask;
3324 return (Yap_unify(ARG3, TRef));
3332static Int lu_recorded(
PredEntry *pe USES_REGS) {
3333 op_numbers opc = Yap_op_from_opcode(P->opc);
3335#if defined(YAPOR) || defined(THREADS)
3339 if (opc == _procceed) {
3342 if (P->opc != Yap_opcode(_execute_cpred)) {
3346 YENV[E_CB] = (CELL)B;
3349#if defined(YAPOR) || defined(THREADS)
3351 if (P == FAILCODE) {
3357 if (pe->PredFlags & ProfiledPredFlag) {
3358 LOCK(pe->StatisticsForPred->lock);
3360 pe->StatisticsForPred->NOfEntries++;
3361 UNLOCK(pe->StatisticsForPred->lock);
3367static Int in_rded_with_key(USES_REGS1) {
3370 return (i_recorded(AtProp, Deref(ARG3) PASS_REGS));
3374static Int p_recorded(USES_REGS1) {
3376 Register Term twork = Deref(ARG1);
3378 Term t3 = Deref(ARG3);
3381 if (!IsVarTerm(t3)) {
3382 DBRef ref = DBRefOfTerm(t3);
3383 if (!IsDBRefTerm(t3)) {
3386 ref = DBRefOfTerm(t3);
3388 ref = DBRefOfTerm(t3);
3391 if (DEAD_REF(ref)) {
3394 if (ref->Flags & LogUpdMask) {
3397 op_numbers opc = Yap_op_from_opcode(P->opc);
3399 if (!Yap_unify(GetDBLUKey(ap), ARG1))
3402 if (opc == _procceed) {
3406#if defined(YAPOR) || defined(THREADS)
3412 YENV[E_CB] = (CELL)B;
3417 while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
3419 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3420 LOCAL_Error_TYPE = YAP_NO_ERROR;
3421 if (!Yap_growglobal(NULL)) {
3422 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3423 LOCAL_ErrorMessage);
3427 LOCAL_Error_TYPE = YAP_NO_ERROR;
3429 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3434 if (!Yap_unify(ARG2, TermDB) || !UnifyDBKey(ref, 0, ARG1)) {
3441 if ((pe = find_lu_entry(twork)) != NULL) {
3442 return lu_recorded(pe PASS_REGS);
3444 if (EndOfPAEntr(AtProp = FetchDBPropFromKey(twork, 0, FALSE,
"recorded/3"))) {
3447 ARG1 = MkIntegerTerm((Int)AtProp);
3448 P = PredRecordedWithKey->CodeOfPred;
3449 return (i_recorded(AtProp, t3 PASS_REGS));
3452static Int co_rded(USES_REGS1) {
return (c_recorded(0 PASS_REGS)); }
3455static Int in_rdedp(USES_REGS1) {
3458 Register Term twork = Deref(ARG1);
3461 Term t3 = Deref(ARG3);
3462 if (!IsVarTerm(t3)) {
3463 if (!IsDBRefTerm(t3)) {
3466 DBRef ref = DBRefOfTerm(t3);
3468 if (ref == NULL || DEAD_REF(ref) ||
3469 !Yap_unify(ARG2, GetDBTermFromDBEntry(ref PASS_REGS)) ||
3470 !UnifyDBKey(ref, CodeDBBit, ARG1)) {
3479 if (EndOfPAEntr(AtProp =
3480 FetchDBPropFromKey(twork, MkCode, FALSE,
"recorded/3"))) {
3486 return (i_recorded(AtProp, t3 PASS_REGS));
3489static Int co_rdedp(USES_REGS1) {
return (c_recorded(MkCode PASS_REGS)); }
3492static Int p_somercdedp(USES_REGS1) {
3495 Register Term twork = Deref(ARG1);
3497 if (EndOfPAEntr(AtProp = FetchDBPropFromKey(twork, MkCode, FALSE,
3498 "some_recorded/3"))) {
3501 READ_LOCK(AtProp->DBRWLock);
3502 ref = FrstDBRef(AtProp);
3503 while (ref != NIL && (ref->Flags & (DBNoCode | ErasedMask)))
3504 ref = NextDBRef(ref);
3505 READ_UNLOCK(AtProp->DBRWLock);
3513static Int p_first_instance(USES_REGS1) {
3517 Register Term twork = Deref(ARG1);
3522 if (!IsVarTerm(ARG3)) {
3526 AtProp = FetchDBPropFromKey(twork, 0, FALSE,
"first_instance/3"))) {
3529 READ_LOCK(AtProp->DBRWLock);
3530 ref = AtProp->First;
3531 while (ref != NIL && (ref->Flags & (DBCode | ErasedMask)))
3532 ref = NextDBRef(ref);
3533 READ_UNLOCK(AtProp->DBRWLock);
3537 TRef = MkDBRefTerm(ref);
3542 INC_DBREF_COUNT(ref);
3544 if (!(ref->Flags & InUseMask)) {
3545 ref->Flags |= InUseMask;
3550 while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) {
3552 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
3553 LOCAL_Error_TYPE = YAP_NO_ERROR;
3554 if (!Yap_growglobal(NULL)) {
3555 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
3556 LOCAL_ErrorMessage);
3560 LOCAL_Error_TYPE = YAP_NO_ERROR;
3562 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
3567 if (IsVarTerm(TermDB)) {
3568 Yap_unify(TermDB, ARG2);
3570 return Yap_unify(ARG2, TermDB);
3572 return Yap_unify(ARG3, TRef);
3576 UInt sz = x->ClSize;
3577 yamop *start = x->ClCode;
3578 op_numbers op = Yap_op_from_opcode(start->opc);
3581 while (op == _jump_if_nonvar) {
3582 start = NEXTOP(start, xll);
3583 op = Yap_op_from_opcode(start->opc);
3585 if (op == _enter_lu_pred) {
3588 UInt count = 0, dead = 0;
3590 if (ap->PredFlags & CountPredFlag)
3591 endop = Yap_opcode(_count_trust_logical);
3592 else if (ap->PredFlags & ProfiledPredFlag)
3593 endop = Yap_opcode(_profiled_trust_logical);
3595 endop = Yap_opcode(_trust_logical);
3596 start = start->y_u.Illss.l1;
3597 if (start->y_u.Illss.s)
3599 sz += (UInt)NEXTOP((
yamop *)NULL, OtaLl);
3602 if (start->y_u.OtaLl.d->ClFlags & ErasedMask)
3604 start = start->y_u.OtaLl.n;
3605 }
while (op1 != endop);
3610 x = x->SiblingIndex;
3615static Int lu_statistics(
PredEntry *pe USES_REGS) {
3616 UInt sz =
sizeof(
PredEntry), cls = 0, isz = 0;
3621 if (pe->cs.p_code.FirstClause == NULL) {
3625 x = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
3633 if (pe->PredFlags & IndexedPredFlag) {
3635 yamop *ep = ExpandClausesFirst;
3637 if (ep->y_u.sssllp.p == pe)
3638 isz += (UInt)NEXTOP((
yamop *)NULL, sssllp) +
3639 ep->y_u.sssllp.s1 *
sizeof(
yamop *);
3640 ep = ep->y_u.sssllp.snext;
3642 isz += index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
3644 return Yap_unify(ARG2, MkIntegerTerm(cls)) &&
3645 Yap_unify(ARG3, MkIntegerTerm(sz)) &&
3646 Yap_unify(ARG4, MkIntegerTerm(isz));
3659static Int p_key_statistics(USES_REGS1) {
3662 UInt sz = 0, cls = 0;
3663 Term twork = Deref(ARG1);
3666 if ((pe = find_lu_entry(twork)) != NULL) {
3667 return lu_statistics(pe PASS_REGS);
3669 if (EndOfPAEntr(p = FetchDBPropFromKey(twork, 0, TRUE,
"key_statistics/4"))) {
3677 sz +=
sizeof(
DBStruct) +
sizeof(CELL) * x->DBT.NOfCells;
3684 return Yap_unify(ARG2, MkIntegerTerm(cls)) &&
3685 Yap_unify(ARG3, MkIntegerTerm(sz)) && Yap_unify(ARG4, MkIntTerm(0));
3688static Int p_lu_statistics(USES_REGS1) {
3689 Term t = Deref(ARG1);
3690 Term mod = Deref(ARG5);
3694 }
else if (IsAtomTerm(t)) {
3695 Atom at = AtomOfTerm(t);
3696 pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
3697 }
else if (IsIntegerTerm(t) && mod == IDB_MODULE) {
3698 pe = find_lu_int_key(IntegerOfTerm(t));
3699 }
else if (IsApplTerm(t)) {
3700 Functor fun = FunctorOfTerm(t);
3701 pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
3706 if (!(pe->PredFlags & LogUpdatePredFlag)) {
3710 return lu_statistics(pe PASS_REGS);
3713static Int p_total_erased(USES_REGS1) {
3714 UInt sz = 0, cls = 0;
3715 UInt isz = 0, icls = 0;
3728 icl = icl->SiblingIndex;
3730 return Yap_unify(ARG1, MkIntegerTerm(cls)) &&
3731 Yap_unify(ARG2, MkIntegerTerm(sz)) &&
3732 Yap_unify(ARG3, MkIntegerTerm(icls)) &&
3733 Yap_unify(ARG4, MkIntegerTerm(isz));
3736static Int lu_erased_statistics(
PredEntry *pe USES_REGS) {
3737 UInt sz = 0, cls = 0;
3738 UInt isz = 0, icls = 0;
3743 if (cl->ClPred == pe) {
3750 if (pe == icl->ClPred) {
3754 icl = icl->SiblingIndex;
3756 return Yap_unify(ARG2, MkIntegerTerm(cls)) &&
3757 Yap_unify(ARG3, MkIntegerTerm(sz)) &&
3758 Yap_unify(ARG4, MkIntegerTerm(icls)) &&
3759 Yap_unify(ARG5, MkIntegerTerm(isz));
3762static Int p_key_erased_statistics(USES_REGS1) {
3763 Term twork = Deref(ARG1);
3767 if ((pe = find_lu_entry(twork)) == NULL)
3769 return lu_erased_statistics(pe PASS_REGS);
3772static Int p_heap_space_info(USES_REGS1) {
3773 return Yap_unify(ARG1, MkIntegerTerm(HeapUsed)) &&
3774 Yap_unify(ARG2, MkIntegerTerm(HeapMax - HeapUsed)) &&
3775 Yap_unify(ARG3, MkIntegerTerm(Yap_expand_clauses_sz));
3782static void ErasePendingRefs(
DBTerm *entryref USES_REGS) {
3786 cp = entryref->DBRefs;
3787 if (entryref->DBRefs == NULL)
3789 while ((ref = *--cp) != NULL) {
3790 if ((ref->Flags & DBClMask) && (--(ref->NOfRefsTo) == 0) &&
3791 (ref->Flags & ErasedMask))
3792 ErDBE(ref PASS_REGS);
3796inline static void RemoveDBEntry(
DBRef entryref USES_REGS) {
3798 ErasePendingRefs(&(entryref->DBT)PASS_REGS);
3801 if ((B->cp_ap == RETRY_C_RECORDED_K_CODE ||
3802 B->cp_ap == RETRY_C_RECORDEDP_CODE) &&
3803 EXTRA_CBACK_ARG(3, 1) == (CELL)entryref) {
3806 DEC_DBREF_COUNT(entryref);
3808 entryref->Flags &= ~InUseMask;
3810 DBErasedMarker->Next = NULL;
3811 DBErasedMarker->Parent = entryref->Parent;
3812 DBErasedMarker->n = entryref->n;
3813 EXTRA_CBACK_ARG(3, 1) = (CELL)DBErasedMarker;
3815 if (entryref->p != NULL)
3816 entryref->p->n = entryref->n;
3818 entryref->Parent->F0 = entryref->n;
3819 if (entryref->n != NULL)
3820 entryref->n->p = entryref->p;
3822 entryref->Parent->L0 = entryref->p;
3824 FreeDBSpace((
char *)entryref);
3827static yamop *find_next_clause(
DBRef ref0 USES_REGS) {
3833 if (!(ref0->Flags & ErasedMask)) {
3834 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil,
3835 "find_next_clause (dead clause %x)", ref0);
3841 while ((ref = ref->n) != NULL) {
3842 if (!(ref->Flags & ErasedMask))
3861 INC_CLREF_COUNT(cl);
3865 if (!(DynamicFlags(newp) & InUseMask)) {
3866 DynamicFlags(newp) |= InUseMask;
3867 TRAIL_CLREF(ClauseCodeToDynamicClause(newp));
3876static Int p_jump_to_next_dynamic_clause(USES_REGS1) {
3880 yamop *newp = find_next_clause(ref PASS_REGS);
3888 P = NEXTOP(newp, Otapl);
3896 if (clau->ClFlags & FactMask)
3899 cp = clau->lusl.ClSource->DBRefs;
3900 if (CL_IN_USE(clau)) {
3905 clau->ClNext->ClPrev = clau->ClPrev;
3907 clau->ClPrev->ClNext = clau->ClNext;
3909 DBErasedList = clau->ClNext;
3914 while ((ref = *--cp) != NIL) {
3915 if (ref->Flags & LogUpdMask) {
3918 if (cl->ClFlags & ErasedMask && !(cl->ClFlags & InUseMask) &&
3919 !(cl->ClRefCount)) {
3925 if (ref->Flags & ErasedMask && !(ref->Flags & InUseMask) &&
3929 ErDBE(ref PASS_REGS);
3936 Yap_InformOfRemoval(clau);
3937 Yap_LUClauseSpace -= clau->ClSize;
3938 Yap_FreeCodeSpace((
char *)clau);
3946 if (!(clau->ClFlags & ErasedMask)) {
3948 if (clau->ClNext != NULL) {
3949 clau->ClNext->ClPrev = clau->ClPrev;
3951 if (clau->ClPrev != NULL) {
3952 clau->ClPrev->ClNext = clau->ClNext;
3955 if (clau->ClCode == ap->cs.p_code.FirstClause) {
3956 if (clau->ClNext == NULL) {
3957 ap->cs.p_code.FirstClause = NULL;
3959 ap->cs.p_code.FirstClause = clau->ClNext->ClCode;
3962 if (clau->ClCode == ap->cs.p_code.LastClause) {
3963 if (clau->ClPrev == NULL) {
3964 ap->cs.p_code.LastClause = NULL;
3966 ap->cs.p_code.LastClause = clau->ClPrev->ClCode;
3969 ap->cs.p_code.NOfClauses--;
3971 clau->ClFlags |= ErasedMask;
3975 if (er_head == NULL) {
3976 clau->ClPrev = clau->ClNext = NULL;
3978 clau->ClNext = er_head;
3979 er_head->ClPrev = clau;
3980 clau->ClPrev = NULL;
3982 DBErasedList = clau;
3989 if (ap->LastCallOfPred != LUCALL_RETRACT) {
3990 if (ap->cs.p_code.NOfClauses > 1) {
3991 if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
3992 Yap_UpdateTimestamps(ap);
3993 ++ap->TimeStampOfPred;
3996 ap->LastCallOfPred = LUCALL_RETRACT;
4000 if (ap->cs.p_code.NOfClauses == 0) {
4002 ap->TimeStampOfPred = 0L;
4007 ap->LastCallOfPred = LUCALL_ASSERT;
4010 clau->ClTimeEnd = ap->TimeStampOfPred;
4011 Yap_RemoveClauseFromIndex(ap, clau->ClCode);
4016 complete_lu_erase(clau);
4022 if (CL_IN_USE(clau))
4028 ref = (
DBRef)NEXTOP(clau->ClCode, Otapl)->y_u.Osbpp.bmap;
4030 if (DBREF_IN_USE(ref))
4032 if (P == clau->ClCode) {
4033 yamop *np = RTRYCODE;
4036 find_next_clause((
DBRef)(NEXTOP(P, Otapl)->y_u.Osbpp.bmap)PASS_REGS);
4037 if (np->y_u.Otapl.d == NULL)
4038 P = (
yamop *)FAILCODE;
4041 np->y_u.Otapl.s = P->y_u.Otapl.s;
4042 np->y_u.Otapl.p = P->y_u.Otapl.p;
4047 Yap_InformOfRemoval(clau);
4048 Yap_LUClauseSpace -= clau->ClSize;
4049 Yap_FreeCodeSpace((
char *)clau);
4052 fprintf(stderr,
"Error: references to dynamic clause\n");
4054 RemoveDBEntry(ref PASS_REGS);
4062void Yap_ErLogUpdCl(
LogUpdClause *clau) { EraseLogUpdCl(clau); }
4070 MyEraseClause(clau PASS_REGS);
4074 yamop *code_p = clau->ClCode;
4078 if (clau->ClFlags & ErasedMask) {
4081 clau->ClFlags |= ErasedMask;
4082 if (p->cs.p_code.FirstClause != cl) {
4084 yamop *prev_code_p = (
yamop *)(dbr->Prev->Code);
4085 prev_code_p->y_u.Otapl.d = code_p->y_u.Otapl.d;
4087 if (p->cs.p_code.LastClause == cl)
4088 p->cs.p_code.LastClause = prev_code_p;
4091 if (p->cs.p_code.LastClause == p->cs.p_code.FirstClause) {
4092 p->cs.p_code.LastClause = p->cs.p_code.FirstClause = NULL;
4094 p->cs.p_code.FirstClause = code_p->y_u.Otapl.d;
4095 p->cs.p_code.FirstClause->opc = Yap_opcode(_try_me);
4099 if (p->PredFlags & IndexedPredFlag) {
4100 p->cs.p_code.NOfClauses--;
4101 Yap_RemoveIndexation(p);
4103 EraseLogUpdCl(clau);
4105 if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
4106 if (p->cs.p_code.FirstClause != NULL) {
4107 code_p = p->cs.p_code.FirstClause;
4108 code_p->y_u.Otapl.d = p->cs.p_code.FirstClause;
4109 p->cs.p_code.TrueCodeOfPred = NEXTOP(code_p, Otapl);
4110 if (p->PredFlags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag)) {
4111 p->OpcodeOfPred = Yap_opcode(_spy_pred);
4112 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4113#if defined(YAPOR) || defined(THREADS)
4114 }
else if (p->ModuleOfPred != IDB_MODULE &&
4115 !(p->PredFlags & ThreadLocalPredFlag)) {
4116 p->OpcodeOfPred = LOCKPRED_OPCODE;
4117 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4120 p->CodeOfPred = p->cs.p_code.TrueCodeOfPred;
4121 p->OpcodeOfPred = p->cs.p_code.TrueCodeOfPred->opc;
4123#if defined(YAPOR) || defined(THREADS)
4124 }
else if (p->ModuleOfPred != IDB_MODULE &&
4125 !(p->PredFlags & ThreadLocalPredFlag)) {
4126 p->OpcodeOfPred = LOCKPRED_OPCODE;
4127 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4130 p->OpcodeOfPred = FAIL_OPCODE;
4131 p->cs.p_code.TrueCodeOfPred = p->CodeOfPred =
4132 (
yamop *)(&(p->OpcodeOfPred));
4135 if (p->PredFlags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag)) {
4136 p->OpcodeOfPred = Yap_opcode(_spy_pred);
4137 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4138#if defined(YAPOR) || defined(THREADS)
4139 }
else if (p->ModuleOfPred != IDB_MODULE &&
4140 !(p->PredFlags & ThreadLocalPredFlag)) {
4141 p->OpcodeOfPred = LOCKPRED_OPCODE;
4142 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4145 p->OpcodeOfPred = INDEX_OPCODE;
4146 p->CodeOfPred = (
yamop *)(&(p->OpcodeOfPred));
4153static void ErDBE(
DBRef entryref USES_REGS) {
4155 if ((entryref->Flags & DBCode) && entryref->Code) {
4156 if (entryref->Flags & LogUpdMask) {
4157 LogUpdClause *clau = ClauseCodeToLogUpdClause(entryref->Code);
4158 if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
4159 PrepareToEraseLogUpdClause(clau, entryref);
4161 if (!(clau->ClFlags & ErasedMask))
4162 PrepareToEraseLogUpdClause(clau, entryref);
4164 EraseLogUpdCl(clau);
4167 DynamicClause *clau = ClauseCodeToDynamicClause(entryref->Code);
4168 if (CL_IN_USE(clau) || entryref->NOfRefsTo != 0) {
4169 PrepareToEraseClause(clau, entryref);
4171 if (!(clau->ClFlags & ErasedMask))
4172 PrepareToEraseClause(clau, entryref);
4174 MyEraseClause(clau PASS_REGS);
4177 }
else if (!(DBREF_IN_USE(entryref))) {
4178 if (entryref->NOfRefsTo == 0)
4179 RemoveDBEntry(entryref PASS_REGS);
4180 else if (!(entryref->Flags & ErasedMask)) {
4183 entryref->Flags |= ErasedMask;
4184 entryref->Next = entryref->Prev = NIL;
4189void Yap_ErDBE(
DBRef entryref) {
4191 ErDBE(entryref PASS_REGS);
4194static void EraseEntry(
DBRef entryref) {
4197 if (entryref->Flags & ErasedMask)
4199 if (entryref->Flags & LogUpdMask && !(entryref->Flags & DBClMask)) {
4201 PELOCK(67, luclause->ClPred);
4202 EraseLogUpdCl(luclause);
4203 UNLOCK(luclause->ClPred->PELock);
4206 entryref->Flags |= ErasedMask;
4208 p = entryref->Parent;
4210 if (entryref->Next != NIL) {
4211 entryref->Next->Prev = entryref->Prev;
4213 p->Last = entryref->Prev;
4215 if (entryref->Prev != NIL)
4216 entryref->Prev->Next = entryref->Next;
4218 p->First = entryref->Next;
4220 entryref->Next = NIL;
4221 if (!DBREF_IN_USE(entryref)) {
4223 ErDBE(entryref PASS_REGS);
4224 }
else if ((entryref->Flags & DBCode) && entryref->Code) {
4225 PrepareToEraseClause(ClauseCodeToDynamicClause(entryref->Code), entryref);
4230static Int p_erase(USES_REGS1) {
4231 Term t1 = Deref(ARG1);
4233 if (IsVarTerm(t1)) {
4234 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"erase");
4237 if (!IsDBRefTerm(t1)) {
4238 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"erase");
4241 EraseEntry(DBRefOfTerm(t1));
4246static Int p_increase_reference_counter(USES_REGS1) {
4247 Term t1 = Deref(ARG1);
4250 if (IsVarTerm(t1)) {
4251 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"increase_reference_counter/1");
4254 if (!IsDBRefTerm(t1)) {
4255 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"increase_reference_counter");
4259 PELOCK(67, cl->ClPred);
4261 UNLOCK(cl->ClPred->PELock);
4266static Int p_decrease_reference_counter(USES_REGS1) {
4267 Term t1 = Deref(ARG1);
4270 if (IsVarTerm(t1)) {
4271 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"increase_reference_counter/1");
4274 if (!IsDBRefTerm(t1)) {
4275 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"increase_reference_counter");
4279 PELOCK(67, cl->ClPred);
4280 if (cl->ClRefCount) {
4282 UNLOCK(cl->ClPred->PELock);
4285 UNLOCK(cl->ClPred->PELock);
4298static Int p_current_reference_counter(USES_REGS1) {
4299 Term t1 = Deref(ARG1);
4302 if (IsVarTerm(t1)) {
4303 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"increase_reference_counter/1");
4306 if (!IsDBRefTerm(t1)) {
4307 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"increase_reference_counter");
4311 return Yap_unify(ARG2, MkIntegerTerm(cl->ClRefCount));
4314static Int p_erase_clause(USES_REGS1) {
4315 Term t1 = Deref(ARG1), t2;;
4318 if (IsVarTerm(t1)) {
4319 Yap_ThrowError(INSTANTIATION_ERROR, t1,
"erase");
4322 if (!IsDBRefTerm(t1)) {
4323 if (IsApplTerm(t1)) {
4324 if (FunctorOfTerm(t1) == FunctorStaticClause &&
4325 IsIntegerTerm((t2=ArgOfTerm(2,t1)))) {
4326 Yap_EraseStaticClause(Yap_ClauseFromTerm(t1),
4327 (
PredEntry *)IntegerOfTerm(ArgOfTerm(2, t1)),
4331 if (FunctorOfTerm(t1) == FunctorMegaClause) {
4332 Yap_EraseMegaClause(Yap_MegaClauseFromTerm(t1),
4333 Yap_MegaClausePredicateFromTerm(t1));
4336 if (FunctorOfTerm(t1) == FunctorExoClause) {
4337 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"erase exo clause");
4341 Yap_ThrowError(TYPE_ERROR_DBREF, t1,
"erase");
4344 entryref = DBRefOfTerm(t1);
4346 EraseEntry(entryref);
4357static Int p_eraseall(USES_REGS1) {
4358 Register Term twork = Deref(ARG1);
4359 Register
DBRef entryref;
4363 if ((pe = find_lu_entry(twork)) != NULL) {
4366 if (!pe->cs.p_code.NOfClauses)
4368 if (pe->PredFlags & IndexedPredFlag)
4369 Yap_RemoveIndexation(pe);
4370 cl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
4375 }
while (cl != NULL);
4378 if (EndOfPAEntr(p = FetchDBPropFromKey(twork, 0, FALSE,
"eraseall/3"))) {
4381 WRITE_LOCK(p->DBRWLock);
4382 entryref = FrstDBRef(p);
4384 DBRef next_entryref;
4386 while (entryref != NIL && (entryref->Flags & (DBCode | ErasedMask)))
4387 entryref = NextDBRef(entryref);
4388 if (entryref == NIL)
4390 next_entryref = NextDBRef(entryref);
4392 if (entryref->Next != NIL) {
4393 entryref->Next->Prev = entryref->Prev;
4395 p->Last = entryref->Prev;
4397 if (entryref->Prev != NIL)
4398 entryref->Prev->Next = entryref->Next;
4400 p->First = entryref->Next;
4402 entryref->Next = entryref->Prev = NIL;
4403 if (!DBREF_IN_USE(entryref))
4404 ErDBE(entryref PASS_REGS);
4406 entryref->Flags |= ErasedMask;
4408 entryref = next_entryref;
4409 }
while (entryref != NIL);
4410 WRITE_UNLOCK(p->DBRWLock);
4423static Int p_erased(USES_REGS1) {
4424 Term t = Deref(ARG1);
4427 Yap_ThrowError(INSTANTIATION_ERROR, t,
"erased");
4430 if (!IsDBRefTerm(t)) {
4431 Yap_ThrowError(TYPE_ERROR_DBREF, t,
"erased");
4434 return (DBRefOfTerm(t)->Flags & ErasedMask);
4438 if (cl->ClFlags & ErasedMask) {
4441 if (cl->ClFlags & FactMask) {
4442 if (ap->ArityOfPE == 0) {
4443 return Yap_unify(ARG2, MkAtomTerm((
Atom)ap->FunctorOfPred));
4445 Functor f = ap->FunctorOfPred;
4446 UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
4447 Term t2 = Deref(ARG2);
4450 if (IsVarTerm(t2)) {
4451 Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f, arity)));
4452 }
else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
4455 ptr = RepAppl(t2) + 1;
4456 for (i = 0; i < arity; i++) {
4457 XREGS[i + 1] = ptr[i];
4461 YENV[E_CB] = (CELL)B;
4468 while ((TermDB = GetDBTerm(cl->usc.ClSource, TRUE PASS_REGS)) == 0L) {
4470 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
4471 LOCAL_Error_TYPE = YAP_NO_ERROR;
4472 if (!Yap_growglobal(NULL)) {
4473 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
4474 LOCAL_ErrorMessage);
4478 LOCAL_Error_TYPE = YAP_NO_ERROR;
4480 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
4485 return Yap_unify(ARG2, TermDB);
4489static Int exo_instance(Int i,
PredEntry *ap USES_REGS) {
4490 if (ap->ArityOfPE == 0) {
4491 return Yap_unify(ARG2, MkAtomTerm((
Atom)ap->FunctorOfPred));
4493 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
4494 Functor f = ap->FunctorOfPred;
4495 UInt arity = ArityOfFunctor(ap->FunctorOfPred);
4496 Term t2 = Deref(ARG2);
4497 CELL *ptr = (CELL *)((ADDR)mcl->ClCode + 2 *
sizeof(
struct index_t *) +
4498 i * (mcl->ClItemSize));
4499 if (IsVarTerm(t2)) {
4501 t2 = Yap_MkApplTerm(f, arity, ptr);
4502 Yap_unify(ARG2, t2);
4503 }
else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
4506 for (i = 0; i < arity; i++) {
4507 XREGS[i + 1] = ptr[i];
4512 YENV[E_CB] = (CELL)B;
4519 if (ap->ArityOfPE == 0) {
4520 return Yap_unify(ARG2, MkAtomTerm((
Atom)ap->FunctorOfPred));
4522 Functor f = ap->FunctorOfPred;
4523 UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
4524 Term t2 = Deref(ARG2);
4527 if (IsVarTerm(t2)) {
4528 t2 = Yap_MkNewApplTerm(f, arity);
4529 Yap_unify(ARG2, t2);
4530 }
else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
4533 ptr = RepAppl(t2) + 1;
4534 for (i = 0; i < arity; i++) {
4535 XREGS[i + 1] = ptr[i];
4539 YENV[E_CB] = (CELL)B;
4557static Int p_instance(USES_REGS1) {
4558 Term t1 = Deref(ARG1);
4561 if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
4562 if (IsApplTerm(t1)) {
4563 if (FunctorOfTerm(t1) == FunctorStaticClause) {
4564 return static_instance(Yap_ClauseFromTerm(t1),
4565 (
PredEntry *)IntegerOfTerm(ArgOfTerm(2, t1))
4568 if (FunctorOfTerm(t1) == FunctorMegaClause) {
4569 return mega_instance(Yap_MegaClauseFromTerm(t1),
4570 Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
4572 if (FunctorOfTerm(t1) == FunctorExoClause) {
4573 return exo_instance(Yap_ExoClauseFromTerm(t1),
4574 Yap_ExoClausePredicateFromTerm(t1) PASS_REGS);
4579 dbr = DBRefOfTerm(t1);
4581 if (dbr->Flags & LogUpdMask) {
4587 if (cl->ClFlags & ErasedMask) {
4591 if (cl->ClFlags & FactMask) {
4592 if (ap->ArityOfPE == 0) {
4594 return Yap_unify(ARG2, MkAtomTerm((
Atom)ap->FunctorOfPred));
4596 Functor f = ap->FunctorOfPred;
4597 UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
4598 Term t2 = Deref(ARG2);
4601 if (IsVarTerm(t2)) {
4602 Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f, arity)));
4603 }
else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
4607 ptr = RepAppl(t2) + 1;
4608 for (i = 0; i < arity; i++) {
4609 XREGS[i + 1] = ptr[i];
4613 YENV[E_CB] = (CELL)B;
4615#if defined(YAPOR) || defined(THREADS)
4616 if (ap->PredFlags & ThreadLocalPredFlag) {
4625 opc = Yap_op_from_opcode(cl->ClCode->opc);
4626 if (opc == _unify_idb_term) {
4628 return Yap_unify(ARG2, cl->lusl.ClSource->Entry);
4631 int in_cl = (opc != _copy_idb_term);
4633 while ((TermDB = GetDBTerm(cl->lusl.ClSource, in_cl PASS_REGS)) == 0L) {
4635 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
4636 LOCAL_Error_TYPE = YAP_NO_ERROR;
4637 if (!Yap_growglobal(NULL)) {
4638 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
4639 LOCAL_ErrorMessage);
4644 LOCAL_Error_TYPE = YAP_NO_ERROR;
4646 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
4653 return Yap_unify(ARG2, TermDB);
4657 while ((TermDB = GetDBTermFromDBEntry(dbr PASS_REGS)) == 0L) {
4659 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
4660 LOCAL_Error_TYPE = YAP_NO_ERROR;
4661 if (!Yap_growglobal(NULL)) {
4662 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
4663 LOCAL_ErrorMessage);
4667 LOCAL_Error_TYPE = YAP_NO_ERROR;
4669 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
4675 return Yap_unify(ARG2, TermDB);
4682 op_numbers opc = Yap_op_from_opcode(cl->ClCode->opc);
4684 if (opc == _unify_idb_term) {
4685 TermDB = cl->lusl.ClSource->Entry;
4690 in_src = (opc != _copy_idb_term);
4691 while ((TermDB = GetDBTerm(cl->lusl.ClSource, in_src PASS_REGS)) == 0L) {
4693 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
4694 LOCAL_Error_TYPE = YAP_NO_ERROR;
4695 if (!Yap_growglobal(NULL)) {
4696 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
4697 LOCAL_ErrorMessage);
4701 LOCAL_Error_TYPE = YAP_NO_ERROR;
4703 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
4713 if (!(cl->ClFlags & InUseMask)) {
4714 cl->ClFlags |= InUseMask;
4722static Int p_instance_module(USES_REGS1) {
4723 Term t1 = Deref(ARG1);
4726 if (IsVarTerm(t1)) {
4729 if (IsDBRefTerm(t1)) {
4730 dbr = DBRefOfTerm(t1);
4734 if (dbr->Flags & LogUpdMask) {
4737 if (cl->ClFlags & ErasedMask) {
4740 if (cl->ClPred->ModuleOfPred)
4741 return Yap_unify(ARG2, cl->ClPred->ModuleOfPred);
4743 return Yap_unify(ARG2, TermProlog);
4745 return Yap_unify(ARG2, dbr->Parent->ModuleOfDB);
4749inline static int NotActiveDB(
DBRef my_dbref) {
4750 while (my_dbref && (my_dbref->Flags & (DBCode | ErasedMask)))
4751 my_dbref = my_dbref->Next;
4752 return (my_dbref == NIL);
4756 while (!EndOfPAEntr(pp) && (((pp->KindOfPE & ~0x1) != DBProperty) ||
4757 NotActiveDB(((
DBProp)pp)->First)))
4758 pp = RepProp(pp->NextOfPE);
4762static Int init_current_key(USES_REGS1) {
4769 if (!IsVarTerm(t1)) {
4778 READ_LOCK(HashChain[i].AERWLock);
4779 a = HashChain[i].Entry;
4783 READ_UNLOCK(HashChain[i].AERWLock);
4786 READ_UNLOCK(HashChain[i].AERWLock);
4788 READ_LOCK(RepAtom(a)->ARWLock);
4789 pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE));
4790 READ_UNLOCK(RepAtom(a)->ARWLock);
4791 EXTRA_CBACK_ARG(2, 3) = MkAtomTerm(a);
4792 EXTRA_CBACK_ARG(2, 2) = MkIntTerm(i);
4793 EXTRA_CBACK_ARG(2, 1) = MkIntegerTerm((Int)pp);
4794 return cont_current_key(PASS_REGS1);
4797static Int cont_current_key(USES_REGS1) {
4802 Int i = IntegerOfTerm(EXTRA_CBACK_ARG(2, 2));
4803 Term first = Deref(ARG1);
4806 if (IsIntTerm(term = EXTRA_CBACK_ARG(2, 3)))
4807 return cont_current_key_integer(PASS_REGS1);
4808 a = AtomOfTerm(term);
4809 if (EndOfPAEntr(pp) && IsAtomTerm(first)) {
4812 while (EndOfPAEntr(pp)) {
4815 if ((a = RepAtom(a)->NextOfAE) == NIL) {
4817 while (i < AtomHashTableSize) {
4823 READ_LOCK(HashChain[i].AERWLock);
4824 a = HashChain[i].Entry;
4829 READ_UNLOCK(HashChain[i].AERWLock);
4832 if (i == AtomHashTableSize) {
4835 if (IsAtomTerm(first)) {
4839 if (INT_KEYS == NULL) {
4842 for (j = 0; j < INT_KEYS_SIZE; j++) {
4843 if (INT_KEYS[j] != NIL) {
4844 DBProp pptr = RepDBProp(INT_KEYS[j]);
4845 EXTRA_CBACK_ARG(2, 1) = MkIntegerTerm((Int)(pptr->NextOfPE));
4846 EXTRA_CBACK_ARG(2, 2) = MkIntegerTerm(j + 1);
4847 EXTRA_CBACK_ARG(2, 3) = MkIntTerm(INT_KEYS_TIMESTAMP);
4848 term = MkIntegerTerm((Int)(pptr->FunctorOfDB));
4849 return Yap_unify(term, ARG1) && Yap_unify(term, ARG2);
4852 if (j == INT_KEYS_SIZE) {
4855 return cont_current_key_integer(PASS_REGS1);
4858 READ_UNLOCK(HashChain[i].AERWLock);
4859 EXTRA_CBACK_ARG(2, 2) = MkIntTerm(i);
4862 READ_LOCK(RepAtom(a)->ARWLock);
4863 if (!EndOfPAEntr(pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE))))
4864 EXTRA_CBACK_ARG(2, 3) = (CELL)MkAtomTerm(a);
4865 READ_UNLOCK(RepAtom(a)->ARWLock);
4867 READ_LOCK(RepAtom(a)->ARWLock);
4868 EXTRA_CBACK_ARG(2, 1) = MkIntegerTerm((Int)NextDBProp(RepProp(pp->NextOfPE)));
4869 READ_UNLOCK(RepAtom(a)->ARWLock);
4870 arity = (
unsigned int)(pp->ArityOfDB);
4872 term = AtT = MkAtomTerm(a);
4877 for (j = 0; j < arity; j++) {
4880 functor = Yap_MkFunctor(a, arity);
4881 term = Yap_MkApplTerm(functor, arity, p);
4882 AtT = MkAtomTerm(a);
4884 return (Yap_unify_constant(ARG1, AtT) && Yap_unify(ARG2, term));
4887static Int cont_current_key_integer(USES_REGS1) {
4889 UInt i = IntOfTerm(EXTRA_CBACK_ARG(2, 2));
4890 Prop pp = (
Prop)IntegerOfTerm(EXTRA_CBACK_ARG(2, 1));
4891 UInt tstamp = (UInt)IntOfTerm(EXTRA_CBACK_ARG(2, 3));
4894 if (tstamp != INT_KEYS_TIMESTAMP) {
4898 for (; i < INT_KEYS_SIZE; i++) {
4899 if (INT_KEYS[i] != NIL) {
4900 EXTRA_CBACK_ARG(2, 2) = MkIntTerm(i + 1);
4905 if (i == INT_KEYS_SIZE) {
4909 pptr = RepDBProp(pp);
4910 EXTRA_CBACK_ARG(2, 1) = MkIntegerTerm((Int)(pptr->NextOfPE));
4911 term = MkIntegerTerm((Int)(pptr->FunctorOfDB));
4912 return Yap_unify(term, ARG1) && Yap_unify(term, ARG2);
4915Term Yap_FetchTermFromDB(
void *ref) {
4919 return GetDBTerm(ref, FALSE PASS_REGS);
4922Term Yap_FetchClauseTermFromDB(
void *ref) {
4926 return GetDBTerm(ref, TRUE PASS_REGS);
4929Term Yap_PopTermFromDB(
void *ref) {
4932 Term t = GetDBTerm(ref, FALSE PASS_REGS);
4934 ReleaseTermFromDB(ref PASS_REGS);
4938static DBTerm *StoreTermInDB(Term t,
int nargs USES_REGS) {
4943 LOCAL_Error_Size = 0;
4944 while ((x = (
DBTerm *)CreateDBStruct(t, (
DBProp)NULL, InQueue, &needs_vars, 0,
4946 if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
4948 }
else if (nargs == -1) {
4951 XREGS[nargs + 1] = t;
4952 if (recover_from_record_error(nargs + 1)) {
4953 t = Deref(XREGS[nargs + 1]);
4962DBTerm *Yap_StoreTermInDB(Term t,
int nargs) {
4964 return StoreTermInDB(t, nargs PASS_REGS);
4967DBTerm *Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size, UInt *sz) {
4973 o = (
DBTerm *)CreateDBStruct(t, (
DBProp)NULL, InQueue, &needs_vars,
4979void Yap_init_tqueue(
db_queue *dbq) {
4980 dbq->id = FunctorDBRef;
4981 dbq->Flags = DBClMask;
4982 dbq->FirstInQueue = dbq->LastInQueue = NULL;
4983 INIT_RWLOCK(dbq->QRWLock);
4986void Yap_destroy_tqueue(
db_queue *dbq USES_REGS) {
4987 QueueEntry *cur_instance = dbq->FirstInQueue;
4988 while (cur_instance) {
4990 keepdbrefs(cur_instance->DBT PASS_REGS);
4991 ErasePendingRefs(cur_instance->DBT PASS_REGS);
4992 FreeDBSpace((
char *)cur_instance->DBT);
4993 FreeDBSpace((
char *)cur_instance);
4995 dbq->FirstInQueue = dbq->LastInQueue = NULL;
4998bool Yap_enqueue_tqueue(
db_queue *father_key, Term t USES_REGS) {
5001 if (!Yap_growheap(FALSE,
sizeof(
QueueEntry), NULL)) {
5002 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"in findall");
5007 x->DBT = StoreTermInDB(Deref(t), 2 PASS_REGS);
5008 if (x->DBT == NULL) {
5012 if (father_key->LastInQueue != NULL)
5013 father_key->LastInQueue->next = x;
5014 father_key->LastInQueue = x;
5015 if (father_key->FirstInQueue == NULL) {
5016 father_key->FirstInQueue = x;
5021bool Yap_dequeue_tqueue(
db_queue *father_key, Term t,
bool first,
5022 bool release USES_REGS) {
5025 tr_fr_ptr oldTR = TR;
5026 QueueEntry *cur_instance = father_key->FirstInQueue, *prev = NULL;
5027 while (cur_instance) {
5030 while ((TDB = GetDBTerm(cur_instance->DBT,
false PASS_REGS)) == 0L) {
5031 if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
5032 LOCAL_Error_TYPE = YAP_NO_ERROR;
5033 if (!Yap_growglobal(NULL)) {
5034 Yap_ThrowError(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
5035 LOCAL_ErrorMessage);
5039 LOCAL_Error_TYPE = YAP_NO_ERROR;
5041 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
5048 if (Yap_unify(t, TDB)) {
5050 if (cur_instance == father_key->FirstInQueue) {
5051 father_key->FirstInQueue = cur_instance->next;
5053 if (cur_instance == father_key->LastInQueue) {
5054 father_key->LastInQueue = prev;
5057 prev->next = cur_instance->next;
5060 keepdbrefs(cur_instance->DBT PASS_REGS);
5061 ErasePendingRefs(cur_instance->DBT PASS_REGS);
5062 FreeDBSpace((
char *)cur_instance->DBT);
5063 FreeDBSpace((
char *)cur_instance);
5066 while (oldTR < TR) {
5067 CELL d1 = TrailTerm(TR - 1);
5079 prev = cur_instance;
5080 cur_instance = cur_instance->next;
5086static Int p_init_queue(USES_REGS1) {
5091 if (!Yap_growheap(FALSE,
sizeof(
db_queue), NULL)) {
5092 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"in findall");
5097 Yap_init_tqueue(dbq);
5098 t = MkIntegerTerm((Int)dbq);
5099 return Yap_unify(ARG1, t);
5102static Int p_enqueue(USES_REGS1) {
5103 Term Father = Deref(ARG1);
5107 if (IsVarTerm(Father)) {
5108 Yap_ThrowError(INSTANTIATION_ERROR, Father,
"enqueue");
5110 }
else if (!IsIntegerTerm(Father)) {
5111 Yap_ThrowError(TYPE_ERROR_INTEGER, Father,
"enqueue");
5114 father_key = (
db_queue *)IntegerOfTerm(Father);
5115 WRITE_LOCK(father_key->QRWLock);
5116 rc = Yap_enqueue_tqueue(father_key, Deref(ARG2) PASS_REGS);
5117 WRITE_UNLOCK(father_key->QRWLock);
5121static Int p_enqueue_unlocked(USES_REGS1) {
5122 Term Father = Deref(ARG1);
5125 if (IsVarTerm(Father)) {
5126 Yap_ThrowError(INSTANTIATION_ERROR, Father,
"enqueue");
5128 }
else if (!IsIntegerTerm(Father)) {
5129 Yap_ThrowError(TYPE_ERROR_INTEGER, Father,
"enqueue");
5132 father_key = (
db_queue *)IntegerOfTerm(Father);
5133 return Yap_enqueue_tqueue(father_key, Deref(ARG2) PASS_REGS);
5145static void keepdbrefs(
DBTerm *entryref USES_REGS) {
5149 cp = entryref->DBRefs;
5153 while ((ref = *--cp) != NIL) {
5154 if (!(ref->Flags & LogUpdMask)) {
5156 if (!(ref->Flags & InUseMask)) {
5157 ref->Flags |= InUseMask;
5165static Int p_dequeue(USES_REGS1) {
5168 Term Father = Deref(ARG1);
5171 if (IsVarTerm(Father)) {
5172 Yap_ThrowError(INSTANTIATION_ERROR, Father,
"dequeue");
5174 }
else if (!IsIntegerTerm(Father)) {
5175 Yap_ThrowError(TYPE_ERROR_INTEGER, Father,
"dequeue");
5178 father_key = (
db_queue *)IntegerOfTerm(Father);
5179 WRITE_LOCK(father_key->QRWLock);
5180 if ((cur_instance = father_key->FirstInQueue) == NULL) {
5182 WRITE_UNLOCK(father_key->QRWLock);
5183 FreeDBSpace((
char *)father_key);
5186 rc = Yap_dequeue_tqueue(father_key, ARG2,
true,
true PASS_REGS);
5187 WRITE_UNLOCK(father_key->QRWLock);
5192static Int p_dequeue_unlocked(USES_REGS1) {
5195 Term Father = Deref(ARG1);
5197 if (IsVarTerm(Father)) {
5198 Yap_ThrowError(INSTANTIATION_ERROR, Father,
"dequeue");
5200 }
else if (!IsIntegerTerm(Father)) {
5201 Yap_ThrowError(TYPE_ERROR_INTEGER, Father,
"dequeue");
5204 father_key = (
db_queue *)IntegerOfTerm(Father);
5205 if ((cur_instance = father_key->FirstInQueue) == NULL) {
5207 FreeDBSpace((
char *)father_key);
5210 return Yap_dequeue_tqueue(father_key, ARG2,
true,
true PASS_REGS);
5214static Int p_peek_queue(USES_REGS1) {
5217 Term Father = Deref(ARG1);
5219 if (IsVarTerm(Father)) {
5220 Yap_ThrowError(INSTANTIATION_ERROR, Father,
"dequeue");
5222 }
else if (!IsIntegerTerm(Father)) {
5223 Yap_ThrowError(TYPE_ERROR_INTEGER, Father,
"dequeue");
5226 father_key = (
db_queue *)IntegerOfTerm(Father);
5227 if ((cur_instance = father_key->FirstInQueue) == NULL) {
5229 FreeDBSpace((
char *)father_key);
5232 if (!Yap_dequeue_tqueue(father_key, ARG2,
true,
false PASS_REGS))
5234 if (cur_instance == father_key->LastInQueue)
5235 father_key->FirstInQueue = father_key->LastInQueue = NULL;
5237 father_key->FirstInQueue = cur_instance->next;
5242static Int p_clean_queues(USES_REGS1) {
return TRUE; }
5245static Int p_slu(USES_REGS1) {
5246 Term t = Deref(ARG1);
5248 Yap_ThrowError(INSTANTIATION_ERROR, t,
"switch_logical_updates/1");
5251 if (!IsIntTerm(t)) {
5252 Yap_ThrowError(TYPE_ERROR_INTEGER, t,
"switch_logical_updates/1");
5255 UPDATE_MODE = IntOfTerm(t);
5260static Int p_hold_index(USES_REGS1) {
5261 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil,
"hold_index in debugger");
5265static Int p_fetch_reference_from_index(USES_REGS1) {
5266 Term t1 = Deref(ARG1), t2 = Deref(ARG2);
5270 if (IsVarTerm(t1) || !IsDBRefTerm(t1))
5272 table = DBRefOfTerm(t1);
5274 if (IsVarTerm(t2) || !IsIntTerm(t2))
5276 pos = IntOfTerm(t2);
5277 el = (
DBRef)(table->DBT.Contents[pos]);
5281 INC_DBREF_COUNT(el);
5283 if (!(el->Flags & InUseMask)) {
5284 el->Flags |= InUseMask;
5289 return Yap_unify(ARG3, MkDBRefTerm(el));
5292static Int p_resize_int_keys(USES_REGS1) {
5293 Term t1 = Deref(ARG1);
5294 if (IsVarTerm(t1)) {
5295 return Yap_unify(ARG1, MkIntegerTerm((Int)INT_KEYS_SIZE));
5297 if (!IsIntegerTerm(t1)) {
5298 Yap_ThrowError(TYPE_ERROR_INTEGER, t1,
"yap_flag(resize_db_int_keys,T)");
5301 return resize_int_keys(IntegerOfTerm(t1));
5304static void ReleaseTermFromDB(
DBTerm *ref USES_REGS) {
5307 keepdbrefs(ref PASS_REGS);
5308 ErasePendingRefs(ref PASS_REGS);
5309 FreeDBSpace((
char *)ref);
5312void Yap_ReleaseTermFromDB(
void *ref) {
5314 ReleaseTermFromDB(ref PASS_REGS);
5317static Int p_install_thread_local(USES_REGS1) {
5319 Term t = Deref(ARG1);
5320 Term mod = Deref(ARG2);
5325 if (mod == IDB_MODULE) {
5326 pe = find_lu_entry(t);
5327 if (!pe->cs.p_code.NOfClauses) {
5328 if (IsIntegerTerm(t))
5329 pe->PredFlags |= LogUpdatePredFlag | NumberDBPredFlag;
5330 else if (IsAtomTerm(t))
5331 pe->PredFlags |= LogUpdatePredFlag | AtomDBPredFlag;
5333 pe->PredFlags |= LogUpdatePredFlag;
5335 }
else if (IsAtomTerm(t)) {
5336 Atom at = AtomOfTerm(t);
5337 pe = RepPredProp(PredPropByAtom(at, mod));
5338 }
else if (IsApplTerm(t)) {
5339 Functor fun = FunctorOfTerm(t);
5340 pe = RepPredProp(PredPropByFunc(fun, mod));
5345 if (pe->PredFlags & (ThreadLocalPredFlag | LogUpdatePredFlag)) {
5351 (UserCPredFlag | HiddenPredFlag | CArgsPredFlag | SyncPredFlag |
5352 TestPredFlag | AsmPredFlag | StandardPredFlag | CPredFlag |
5353 SafePredFlag | IndexedPredFlag | BinaryPredFlag) ||
5354 pe->cs.p_code.NOfClauses) {
5359 pe->PredFlags |= ThreadLocalPredFlag | LogUpdatePredFlag;
5360 pe->OpcodeOfPred = Yap_opcode(_thread_local);
5361 pe->CodeOfPred = (
yamop *)&pe->OpcodeOfPred;
5363 pe->PredFlags |= LogUpdatePredFlag;
5369void Yap_InitDBPreds(
void) {
5370 Yap_InitCPred(
"$set_pred_flags", 2, p_rcdz, SyncPredFlag);
5386 Yap_InitCPred(
"recorded", 3, p_recorded, SyncPredFlag);
5387 Yap_InitCPred(
"recorda", 3, p_rcda, SyncPredFlag);
5396 Yap_InitCPred(
"recordz", 3, p_rcdz, SyncPredFlag);
5397 Yap_InitCPred(
"$still_variant", 2, p_still_variant, SyncPredFlag);
5398 Yap_InitCPred(
"recorda_at", 3, p_rcda_at, SyncPredFlag);
5399 Yap_InitCPred(
"recordz_at", 3, p_rcdz_at, SyncPredFlag);
5400 Yap_InitCPred(
"$recordap", 3, p_rcdap, SyncPredFlag);
5401 Yap_InitCPred(
"$recordzp", 3, p_rcdzp, SyncPredFlag);
5402 Yap_InitCPred(
"$recordap", 4, p_drcdap, SyncPredFlag);
5403 Yap_InitCPred(
"$recordzp", 4, p_drcdzp, SyncPredFlag);
5404 Yap_InitCPred(
"erase", 1, p_erase, SafePredFlag | SyncPredFlag);
5405 Yap_InitCPred(
"$erase_clause", 2, p_erase_clause,
5407 Yap_InitCPred(
"increase_reference_count", 1, p_increase_reference_counter,
5408 SafePredFlag | SyncPredFlag);
5409 Yap_InitCPred(
"decrease_reference_count", 1, p_decrease_reference_counter,
5410 SafePredFlag | SyncPredFlag);
5411 Yap_InitCPred(
"current_reference_count", 2, p_current_reference_counter,
5412 SafePredFlag | SyncPredFlag);
5413 Yap_InitCPred(
"erased", 1, p_erased,
5414 TestPredFlag | SafePredFlag | SyncPredFlag);
5415 Yap_InitCPred(
"instance", 2, p_instance, SyncPredFlag);
5416 Yap_InitCPred(
"$instance_module", 2, p_instance_module, SyncPredFlag);
5417 Yap_InitCPred(
"eraseall", 1, p_eraseall, SafePredFlag | SyncPredFlag);
5418 Yap_InitCPred(
"$record_stat_source", 4, p_rcdstatp,
5419 SafePredFlag | SyncPredFlag);
5420 Yap_InitCPred(
"$some_recordedp", 1, p_somercdedp,
5421 SafePredFlag | SyncPredFlag);
5422 Yap_InitCPred(
"$first_instance", 3, p_first_instance,
5423 SafePredFlag | SyncPredFlag);
5424 Yap_InitCPred(
"$init_db_queue", 1, p_init_queue, SafePredFlag | SyncPredFlag);
5425 Yap_InitCPred(
"$db_key", 2, p_db_key, 0L);
5426 Yap_InitCPred(
"$db_enqueue", 2, p_enqueue, SyncPredFlag);
5427 Yap_InitCPred(
"$db_enqueue_unlocked", 2, p_enqueue_unlocked, SyncPredFlag);
5428 Yap_InitCPred(
"$db_dequeue", 2, p_dequeue, SyncPredFlag);
5429 Yap_InitCPred(
"$db_dequeue_unlocked", 2, p_dequeue_unlocked, SyncPredFlag);
5430 Yap_InitCPred(
"$db_peek_queue", 2, p_peek_queue, SyncPredFlag);
5431 Yap_InitCPred(
"$db_clean_queues", 1, p_clean_queues, SyncPredFlag);
5432 Yap_InitCPred(
"$switch_log_upd", 1, p_slu, SafePredFlag | SyncPredFlag);
5433 Yap_InitCPred(
"$hold_index", 3, p_hold_index, SafePredFlag | SyncPredFlag);
5434 Yap_InitCPred(
"$fetch_reference_from_index", 3, p_fetch_reference_from_index,
5435 SafePredFlag | SyncPredFlag);
5436 Yap_InitCPred(
"$resize_int_keys", 1, p_resize_int_keys,
5437 SafePredFlag | SyncPredFlag);
5438 Yap_InitCPred(
"key_statistics", 4, p_key_statistics, SyncPredFlag);
5439 Yap_InitCPred(
"$lu_statistics", 5, p_lu_statistics, SyncPredFlag);
5440 Yap_InitCPred(
"total_erased", 4, p_total_erased, SyncPredFlag);
5441 Yap_InitCPred(
"key_erased_statistics", 5, p_key_erased_statistics,
5443 Yap_InitCPred(
"heap_space_info", 3, p_heap_space_info, SyncPredFlag);
5444 Yap_InitCPred(
"$jump_to_next_dynamic_clause", 0,
5445 p_jump_to_next_dynamic_clause, SyncPredFlag);
5446 Yap_InitCPred(
"$install_thread_local", 2, p_install_thread_local,
5450void Yap_InitBackDB(
void) {
5451 Yap_InitCPredBack(
"$recorded_with_key", 3, 3, in_rded_with_key, co_rded,
5453 RETRY_C_RECORDED_K_CODE =
5454 NEXTOP(PredRecordedWithKey->cs.p_code.FirstClause, OtapFs);
5455 Yap_InitCPredBack(
"$recordedp", 3, 3, in_rdedp, co_rdedp, SyncPredFlag);
5456 RETRY_C_RECORDEDP_CODE =
5457 NEXTOP(RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomRecordedP, 3), 0))
5458 ->cs.p_code.FirstClause,
5460 Yap_InitCPredBack(
"$current_immediate_key", 2, 4, init_current_key,
5461 cont_current_key, SyncPredFlag);