compile ground terms away.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1975 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2007-10-28 11:23:39 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:08 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.227  2007/10/28 11:23:39  vsc
+* fix overflow
+*
 * Revision 1.226  2007/10/28 00:54:09  vsc
 * new version of viterbi implementation
 * fix all:atvars reporting bad info
@@ -4311,6 +4314,42 @@ Yap_absmi(int inp)
       FAIL();
 #endif
       ENDOp();
+
+
+      Op(get_dbterm, xc);
+      BEGD(d0);
+      d0 = XREG(PREG->u.xc.x);
+      deref_head(d0, gdbterm_unk);
+
+    gdbterm_nonvar:
+      BEGD(d1);
+      /* we have met a preexisting dbterm */
+      d1 = XREG(PREG->u.xc.c);
+      PREG = NEXTOP(PREG, xc);      
+      UnifyBound(d0,d1);
+      ENDD(d1);
+
+      BEGP(pt0);
+      deref_body(d0, pt0, gdbterm_unk, gdbterm_nonvar);
+      /* Enter Write mode */
+      /* set d1 to be the new structure we are going to create */
+      START_PREFETCH(xc);
+      BEGD(d1);
+      d1 = PREG->u.xc.c;
+      PREG = NEXTOP(PREG, xc);
+      BIND(pt0, d1, bind_gdbterm);
+#ifdef COROUTINING
+      DO_TRAIL(pt0, d1);
+      if (pt0 < H0) Yap_WakeUp(pt0);
+    bind_gdbterm:
+#endif
+      GONext();
+      ENDD(d1);
+      END_PREFETCH();
+      ENDP(pt0);
+
+      ENDD(d0);
+      ENDOp();
 
 /************************************************************************\
 *    Optimised Get List Instructions					*
@@ -6340,7 +6379,7 @@ Yap_absmi(int inp)
 
       derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
       BEGD(d1);
-      d1 = AbsAppl(PREG->u.oi.i);
+      d1 = PREG->u.oc.c;
       PREG = NEXTOP(PREG, oi);
       BIND_GLOBAL(pt0, d1, bind_ubigint);
 #ifdef COROUTINING
@@ -6402,6 +6441,66 @@ Yap_absmi(int inp)
 #endif
       ENDOp();
 
+      Op(unify_dbterm, oc);
+      BEGD(d0);
+      BEGP(pt0);
+      pt0 = SREG++;
+      d0 = *pt0;
+      deref_head(d0, udbterm_unk);
+    udbterm_nonvar:
+      BEGD(d1);
+      /* we have met a preexisting dbterm */
+      d1 = XREG(PREG->u.oc.c);
+      PREG = NEXTOP(PREG, oc);
+      UnifyBound(d0,d1);
+      ENDD(d1);
+
+      derefa_body(d0, pt0, udbterm_unk, udbterm_nonvar);
+      BEGD(d1);
+      d1 = AbsAppl(PREG->u.oi.i);
+      PREG = NEXTOP(PREG, oi);
+      BIND_GLOBAL(pt0, d1, bind_udbterm);
+#ifdef COROUTINING
+      DO_TRAIL(pt0, d1);
+      if (pt0 < H0) Yap_WakeUp(pt0);
+  bind_udbterm:
+#endif
+      GONext();
+      ENDD(d1);
+      ENDP(pt0);
+      ENDD(d0);
+      ENDOp();
+
+      Op(unify_l_dbterm, oc);
+      BEGD(d0);
+      CACHE_S();
+      READ_IN_S();
+      d0 = *S_SREG;
+      deref_head(d0, uldbterm_unk);
+    uldbterm_nonvar:
+      BEGD(d1);
+      /* we have met a preexisting dbterm */
+      d1 = XREG(PREG->u.oc.c);
+      PREG = NEXTOP(PREG, oc);
+      UnifyBound(d0,d1);
+      ENDD(d1);
+
+      derefa_body(d0, S_SREG, uldbterm_unk, uldbterm_nonvar);
+      BEGD(d1);
+      d1 = PREG->u.oc.c;
+      PREG = NEXTOP(PREG, oc);
+      BIND_GLOBAL(S_SREG, d1, bind_uldbterm);
+#ifdef COROUTINING
+      DO_TRAIL(S_SREG, d1);
+      if (S_SREG < H0) Yap_WakeUp(S_SREG);
+  bind_uldbterm:
+#endif
+      GONext();
+      ENDD(d1);
+      ENDCACHE_S();
+      ENDD(d0);
+      ENDOp();
+
       OpW(unify_list_write, o);
       PREG = NEXTOP(PREG, o);
       BEGD(d0);

C/adtdefs.c

@@ -558,7 +558,7 @@ Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
   return (p0);
 }
 
-static void
+static int
 ExpandPredHash(void)
 {
   UInt new_size = PredHashTableSize+PredHashIncrement;
@@ -567,7 +567,7 @@ ExpandPredHash(void)
   UInt i;
 
   if (!np) {
-    Yap_Error(FATAL_ERROR,TermNil,"Could not allocate space for pred table");
+    return FALSE;
   }
   for (i = 0; i < new_size; i++) {
     np[i] = NULL;
@@ -586,6 +586,7 @@ ExpandPredHash(void)
   PredHashTableSize = new_size;
   PredHash = np;
   Yap_FreeAtomSpace((ADDR)oldp);
+  return TRUE;
 }
 
 /* fe is supposed to be locked */
@@ -594,6 +595,44 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
 {
   PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
 
+  if (p == NULL) {
+    WRITE_UNLOCK(fe->FRWLock);
+    return NULL;
+  }
+  if (fe->PropsOfFE) {
+    UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
+
+    WRITE_LOCK(PredHashRWLock);
+    if (10*(PredsInHashTable+1) > 6*PredHashTableSize) {
+      if (!ExpandPredHash()) {
+	Yap_FreeCodeSpace((ADDR)p);
+	WRITE_UNLOCK(PredHashRWLock);
+	WRITE_UNLOCK(fe->FRWLock);
+	return NULL;
+      }
+      /* retry hashing */
+      hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
+    }
+    PredsInHashTable++;
+    if (p->ModuleOfPred == 0L) {
+      PredEntry *pe = RepPredProp(fe->PropsOfFE);
+
+      hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize);
+      /* should be the first one */
+      pe->NextOfPE = AbsPredProp(PredHash[hsh]);
+      PredHash[hsh] = pe;
+      fe->PropsOfFE = AbsPredProp(p);
+    } else {
+      p->NextOfPE = AbsPredProp(PredHash[hsh]);
+      PredHash[hsh] = p;
+    }
+    WRITE_UNLOCK(PredHashRWLock);
+    /* make sure that we have something here */
+    RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE;
+  } else {
+    fe->PropsOfFE = AbsPredProp(p);
+    p->NextOfPE = NIL;
+  }
   INIT_RWLOCK(p->PRWLock);
   INIT_LOCK(p->PELock);
   p->KindOfPE = PEProp;
@@ -630,33 +669,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
     }
   }
   p->FunctorOfPred = fe;
-  if (fe->PropsOfFE) {
-    UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
-
-    WRITE_LOCK(PredHashRWLock);
-    if (p->ModuleOfPred == 0L) {
-      PredEntry *pe = RepPredProp(fe->PropsOfFE);
-
-      hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize);
-      /* should be the first one */
-      pe->NextOfPE = AbsPredProp(PredHash[hsh]);
-      PredHash[hsh] = pe;
-      fe->PropsOfFE = AbsPredProp(p);
-    } else {
-      p->NextOfPE = AbsPredProp(PredHash[hsh]);
-      PredHash[hsh] = p;
-    }
-    PredsInHashTable++;
-    if (10*PredsInHashTable > 6*PredHashTableSize) {
-      ExpandPredHash();
-    }
-    WRITE_UNLOCK(PredHashRWLock);
-    /* make sure that we have something here */
-    RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE;
-  } else {
-    fe->PropsOfFE = AbsPredProp(p);
-    p->NextOfPE = NIL;
-  }
   WRITE_UNLOCK(fe->FRWLock);
 #ifdef LOW_PROF
   if (ProfilerOn &&

C/agc.c

@@ -147,6 +147,7 @@ AtomAdjust(Atom a)
 #define PtoOpAdjust(P) (P)
 #define PtoLUClauseAdjust(P) (P)
 #define PtoLUIndexAdjust(P) (P)
+#define PtoDBTLAdjust(P) (P)
 #define PtoPredAdjust(P) (P)
 #define PropAdjust(P) (P)
 #define TrailAddrAdjust(P) (P)

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2007-06-23 17:31:50 $							 *
+* Last rev:     $Date: 2007-11-06 17:02:09 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.95  2007/06/23 17:31:50  vsc
+* pin cluses with floats.
+*
 * Revision 1.94  2006/12/27 01:32:37  vsc
 * diverse fixes
 *
@@ -237,7 +240,7 @@ STATIC_PROTO(yamop *a_xigl, (op_numbers, yamop *, int, struct PSEUDO *));
 STATIC_PROTO(yamop *a_ucons, (int *, compiler_vm_op, yamop *, int, struct intermediates *));
 STATIC_PROTO(yamop *a_uvar, (yamop *, int, struct intermediates *));
 STATIC_PROTO(yamop *a_wvar, (yamop *, int, struct intermediates *));
-STATIC_PROTO(yamop *do_pass, (int, yamop **, int, int *, struct intermediates *, UInt));
+STATIC_PROTO(yamop *do_pass, (int, yamop **, int, int *, int *,struct intermediates *, UInt));
 #ifdef DEBUG_OPCODES
 STATIC_PROTO(void DumpOpCodes, (void));
 #endif
@@ -439,6 +442,14 @@ add_clref(CELL clause_code, int pass_no)
   }
 }
 
+static void
+add_to_dbtermsl(struct intermediates *cip, Term t)
+{
+  DBTerm *dbt = TermToDBTerm(t);
+  dbt->ag.NextDBT = cip->dbterml->dbterms;
+  cip->dbterml->dbterms = dbt;
+}
+
 static yamop *
 a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip, clause_info *cla)
 {
@@ -809,6 +820,19 @@ a_blob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int
   return code_p;
 }
 
+inline static yamop *
+a_wdbt(CELL rnd1, op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
+{
+  if (pass_no) {
+    code_p->opc = emit_op(opcode);
+    code_p->u.c.c = rnd1;
+    add_to_dbtermsl(cip, cip->cpc->rnd1);
+  }
+  *clause_has_dbtermp = TRUE;
+  GONEXT(c);
+  return code_p;
+}
+
 inline static yamop *
 a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
 {
@@ -824,6 +848,20 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
   return code_p;
 }
 
+inline static yamop *
+a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
+{
+  if (pass_no) {
+    code_p->opc = emit_op(opcode);
+    code_p->u.oc.opcw = emit_op(opcode_w);
+    code_p->u.oc.c = cip->cpc->rnd1;
+    add_to_dbtermsl(cip, cip->cpc->rnd1);
+  }
+  *clause_has_dbtermp = TRUE;
+  GONEXT(oc);
+  return code_p;
+}
+
 inline static yamop *
 a_ud(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct PSEUDO *cpc)
 {
@@ -1050,6 +1088,20 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
   return code_p;
 }
 
+inline static yamop *
+a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
+{
+  if (pass_no) {
+    code_p->opc = emit_op(opcode);
+    code_p->u.xc.x = emit_x(cip->cpc->rnd2);
+    code_p->u.xc.c = cip->cpc->rnd1;
+    add_to_dbtermsl(cip, cip->cpc->rnd1);
+  }
+  *clause_has_dbtermp = TRUE;
+  GONEXT(xc);
+  return code_p;
+}
+
 inline static yamop *
 a_rli(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
 {
@@ -2631,7 +2683,7 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 #endif /* YAPOR */
 
 static yamop *
-do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp, struct intermediates *cip, UInt size)
+do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp, int *clause_has_dbtermp, struct intermediates *cip, UInt size)
 {
 #ifdef YAPOR
 #define EITHER_INST 50
@@ -2687,6 +2739,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	if (*clause_has_blobsp) {
 	  cl_u->luc.ClFlags |= HasBlobsMask;
 	}
+	if (*clause_has_dbtermp) {
+	  cl_u->luc.ClFlags |= HasDBTMask;
+	}
 	cl_u->luc.ClExt = NULL;
 	cl_u->luc.ClPrev = cl_u->luc.ClNext = NULL;
 #if defined(YAPOR) || defined(THREADS)
@@ -2701,6 +2756,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	if (*clause_has_blobsp) {
 	  cl_u->ic.ClFlags |= HasBlobsMask;
 	}
+	if (*clause_has_dbtermp) {
+	  cl_u->ic.ClFlags |= HasDBTMask;
+	}
 	cl_u->ic.ClSize = size;
 	cl_u->ic.ClRefCount = 0;
 #if defined(YAPOR) || defined(THREADS)
@@ -2719,6 +2777,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	if (*clause_has_blobsp) {
 	  cl_u->sc.ClFlags |= HasBlobsMask;
 	}
+	if (*clause_has_dbtermp) {
+	  cl_u->sc.ClFlags |= HasDBTMask;
+	}
       }
       code_p = cl_u->sc.ClCode;
     }
@@ -2869,6 +2930,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case get_bigint_op:
       code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case get_dbterm_op:
+      code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
+      break;
     case put_num_op:
     case put_atom_op:
       code_p = a_rc(_put_atom, code_p, pass_no, cip);
@@ -2884,6 +2948,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case put_bigint_op:
       code_p = a_rb(_put_atom, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case put_dbterm_op:
+      code_p = a_dbt(_put_atom, clause_has_dbtermp, code_p, pass_no, cip);
+      break;
     case get_list_op:
       code_p = a_glist(&do_not_optimise_uatom, code_p, pass_no, cip);
       break;
@@ -2941,6 +3008,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case unify_bigint_op:
       code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case unify_dbterm_op:
+      code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
+      break;
     case unify_last_num_op:
     case unify_last_atom_op:
       code_p = a_uc(cip->cpc->rnd1, _unify_l_atom, _unify_l_atom_write, code_p, pass_no);
@@ -2956,6 +3026,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case unify_last_bigint_op:
       code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case unify_last_dbterm_op:
+      code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
+      break;
     case write_num_op:
     case write_atom_op:
       code_p = a_ucons(&do_not_optimise_uatom, write_atom_op, code_p, pass_no, cip);
@@ -2971,6 +3044,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case write_bigint_op:
       code_p = a_blob(cip->cpc->rnd1, _write_atom, clause_has_blobsp, code_p, pass_no, cip);
       break;
+    case write_dbterm_op:
+      code_p = a_wdbt(cip->cpc->rnd1, _write_atom, clause_has_dbtermp, code_p, pass_no, cip);
+      break;
     case unify_list_op:
       code_p = a_ue(_unify_list, _unify_list_write, code_p, pass_no);
       break;
@@ -3026,7 +3102,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case cutexit_op:
       code_p = a_cut(&clinfo, code_p, pass_no, cip);
      if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
-	  *clause_has_blobsp &&
+	 (*clause_has_blobsp  || *clause_has_dbtermp) &&
 	  !clinfo.alloc_found)
 	code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
 #if THREADS
@@ -3129,7 +3205,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
       break;
     case procceed_op:
       if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
-	  *clause_has_blobsp &&
+	  (*clause_has_blobsp || *clause_has_dbtermp) &&
 	  !clinfo.alloc_found)
 	code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
 #if THREADS
@@ -3425,6 +3501,23 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep)
   return x;
 }
 
+static DBTermList *
+init_dbterms_list(yamop *code_p, PredEntry *ap)
+{
+  DBTermList *new;
+  if ((new = (DBTermList *)Yap_AllocCodeSpace(sizeof(DBTermList))) == NULL) {
+    return NULL;
+  }
+  new->dbterms = NULL;
+  new->clause_code = code_p;
+  new->p = ap;
+  LOCK(DBTermsListLock);
+  new->next_dbl = DBTermsList;
+  DBTermsList = new;
+  UNLOCK(DBTermsListLock);
+  return new;
+}
+
 
 yamop *
 Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates *cip)
@@ -3438,10 +3531,14 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
   yamop *entry_code;
   yamop *code_p;
   int clause_has_blobs = FALSE;
+  int clause_has_dbterm = FALSE;
 
   cip->label_offset = (int *)cip->freep;
   cip->code_addr = NULL;
-  code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, cip, size);
+  code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size);
+  if (clause_has_dbterm) {
+    cip->dbterml = init_dbterms_list(code_p, ap);
+  }
   if (ap->PredFlags & DynamicPredFlag) {
     size =
       (CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode),ld),sla),e);
@@ -3475,7 +3572,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
     }
     cl = (StaticClause *)((CODEADDR)x-(UInt)size);
     cip->code_addr = (yamop *)cl;
-    code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size);
+    code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size);
     /* make sure we copy after second pass */
     cl->usc.ClSource = x;
     cl->ClSize = osize;
@@ -3502,7 +3599,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
 	Yap_IndexSpace_Tree += size;
     }
   }
-  code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size);
+  code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size);
   ProfEnd=code_p;
 #ifdef LOW_PROF
   if (ProfilerOn &&

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2007-11-01 10:01:35 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:11 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.208  2007/11/01 10:01:35  vsc
+* fix uninitalised lock and reconsult test.
+*
 * Revision 1.207  2007/10/29 22:48:54  vsc
 * small fixes
 *
@@ -619,6 +622,11 @@ static Term BlobTermAdjust(Term t)
 #endif
 }
 
+static void
+RestoreDBTerm(DBTerm *dbr)
+{
+}
+
 #include "rclause.h"
 
 #ifdef DEBUG
@@ -4048,6 +4056,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
     case _get_atom:
     case _put_atom:
     case _get_bigint:
+    case _get_dbterm:
       pc = NEXTOP(pc,xc);
       break;
       /* instructions type cc */
@@ -4164,6 +4173,8 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
     case _unify_l_atom:
     case _unify_bigint:
     case _unify_l_bigint:
+    case _unify_dbterm:
+    case _unify_l_dbterm:
       pc = NEXTOP(pc,oc);
       break;
       /* instructions type osc */

C/compiler.c

@@ -11,8 +11,11 @@
 * File:		compiler.c						 *
 * comments:	Clause compiler						 *
 *									 *
-* Last rev:     $Date: 2007-03-27 13:48:51 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:11 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.84  2007/03/27 13:48:51  vsc
+* fix number of overflows (comments by Bart Demoen).
+*
 * Revision 1.83  2007/03/26 15:18:43  vsc
 * debugging and clause/3 over tabled predicates would kill YAP.
 *
@@ -481,8 +484,9 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
     return (p->VarOfCE);
   }
   /* first occurrence */
-  if (cglobs->onbranch || level > 1)
+  if (cglobs->onbranch || level > 1) {
     return t;
+  }
   ++(cglobs->n_common_exps);
   p = (CExpEntry *) Yap_AllocCMem(sizeof(CExpEntry), &cglobs->cint);
 
@@ -491,7 +495,7 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
   if (H >= (CELL *)cglobs->cint.freep0) {
     /* oops, too many new variables */
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch,4);
+    longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
   }
   p->NextCE = cglobs->common_exps;
   cglobs->common_exps = p;
@@ -526,7 +530,7 @@ compile_sf_term(Term t, int argno, int level)
 	Yap_Error_Term = TermNil;
 	Yap_ErrorMessage = "illegal argument of soft functor";
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch, 2);
+	longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
       }
       else
 	c_var(t, -argno, arity, level, cglobs);
@@ -553,7 +557,7 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs)
       Yap_Error_Term = TermNil;
       Yap_ErrorMessage = "exceed maximum arity of compiled goal";
       save_machine_regs();
-      longjmp(cglobs->cint.CompilerBotch, 2);
+      longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
     }
     if (Arity > cglobs->max_args)
       cglobs->max_args = Arity;
@@ -562,6 +566,52 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs)
     c_arg(i, ArgOfTerm(i, app), Arity, level, cglobs);
 }
 
+static int
+try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_struct *cglobs)
+{
+  DBTerm *dbt;
+  int g;
+  CELL *h0 = H;
+
+  while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) {
+    /* oops, too deep a term */
+    save_machine_regs();
+    Yap_Error_Size = 0;
+    longjmp(cglobs->cint.CompilerBotch, OUT_OF_AUX_BOTCH);
+  }
+  if (g < 16)
+    return FALSE;
+  /* store ground term away */
+  H = CellPtr(cglobs->cint.freep);
+  if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) {
+    H = h0;
+    switch(Yap_Error_TYPE) {
+    case OUT_OF_STACK_ERROR:
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      longjmp(cglobs->cint.CompilerBotch,OUT_OF_STACK_BOTCH);
+    case OUT_OF_TRAIL_ERROR:
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      longjmp(cglobs->cint.CompilerBotch,OUT_OF_TRAIL_BOTCH);
+    case OUT_OF_HEAP_ERROR:
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      longjmp(cglobs->cint.CompilerBotch,OUT_OF_HEAP_BOTCH);
+    case OUT_OF_AUXSPACE_ERROR:
+      Yap_Error_TYPE = YAP_NO_ERROR;
+      longjmp(cglobs->cint.CompilerBotch,OUT_OF_AUX_BOTCH);
+    default:
+      longjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH);
+    }
+  }
+  H = h0;
+  if (level == 0)
+    Yap_emit((cglobs->onhead ? get_dbterm_op : put_dbterm_op), dbt->Entry, argno, &cglobs->cint);
+  else
+    Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_dbterm_op
+				: unify_dbterm_op) :
+	      write_dbterm_op), dbt->Entry, Zero, &cglobs->cint);
+  return TRUE;
+}
+
 static void
 c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct *cglobs)
 {
@@ -641,6 +691,12 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 	    write_num_op), (CELL) t, Zero, &cglobs->cint);
   } else if (IsPairTerm(t)) {
     if (optimizer_on && level < 6) {
+      if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) {
+	if (try_store_as_dbterm(t, argno, arity, level, cglobs))
+	  return;
+      }      
+      if (try_store_as_dbterm(t, argno, arity, level, cglobs))
+	return;
       t = optimize_ce(t, arity, level, cglobs);
       if (IsVarTerm(t)) {
 	c_var(t, argno, arity, level, cglobs);
@@ -656,7 +712,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
     ++level;
     c_arg(1, HeadOfTerm(t), 2, level, cglobs);
     if (argno == (Int)arity) {
-      /* optimise for tail recursion */
+     /* optimise for tail recursion */
       t = TailOfTerm(t);
       goto restart;
     }
@@ -690,11 +746,14 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 #endif
 
     if (optimizer_on) {
+      if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) {
+	if (try_store_as_dbterm(t, argno, arity, level, cglobs))
+	  return;
+      }      
       t = optimize_ce(t, arity, level, cglobs);
       if (IsVarTerm(t)) {
 	c_var(t, argno, arity, level, cglobs);
 	return;
-
       }
     }
     if (level == 0)
@@ -803,7 +862,7 @@ c_test(Int Op, Term t1, compiler_struct *cglobs) {
     Yap_bip_name(Op, s);
     sprintf(Yap_ErrorMessage, "when compiling %s/1", s);
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch, 1);
+    longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
   }
   if (IsNewVar(t)) {
     /* in this case, var trivially succeeds and the others trivially fail */
@@ -858,7 +917,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
       Yap_bip_name(Op, s);
       sprintf(Yap_ErrorMessage, "when compiling %s/2",  s);
       save_machine_regs();
-      longjmp(cglobs->cint.CompilerBotch, 1);
+      longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
     } else if (IsVarTerm(t2)) {
       if (IsNewVar(t2)) {
 	char s[32];
@@ -869,7 +928,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
 	Yap_bip_name(Op, s);
 	sprintf(Yap_ErrorMessage, "when compiling %s/2",  s);
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch, 1);
+	longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
       } else {
 	/* first temp */
 	Int v1 = --cglobs->tmpreg;
@@ -987,7 +1046,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
 	    if (H+2 >= (CELL *)cglobs->cint.freep0) {
 	      /* oops, too many new variables */
 	      save_machine_regs();
-	      longjmp(cglobs->cint.CompilerBotch,4);
+	      longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	    }
 	    RESET_VARIABLE(H);
 	    RESET_VARIABLE(H+1);
@@ -999,7 +1058,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
 	      if (H >= (CELL *)cglobs->cint.freep0) {
 		/* oops, too many new variables */
 		save_machine_regs();
-		longjmp(cglobs->cint.CompilerBotch,4);
+		longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	      }
 	      RESET_VARIABLE(H);
 	      H++;	    
@@ -1128,7 +1187,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
 	    if (H+1+arity >= (CELL *)cglobs->cint.freep0) {
 	      /* oops, too many new variables */
 	      save_machine_regs();
-	      longjmp(cglobs->cint.CompilerBotch,4);
+	      longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	    }
 	    tnew = AbsAppl(H);
 	    *H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity);
@@ -1177,7 +1236,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
       if (H == (CELL *)cglobs->cint.freep0) {
 	/* oops, too many new variables */
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch,4);
+	longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
       }
       c_var(tmpvar,f_flag,(unsigned int)Op, 0, cglobs);
       c_eq(tmpvar,t3, cglobs);
@@ -1204,7 +1263,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *
     if (H == (CELL *)cglobs->cint.freep0) {
       /* oops, too many new variables */
       save_machine_regs();
-      longjmp(cglobs->cint.CompilerBotch,4);
+      longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
     }
     c_var(tmpvar,f_flag,(unsigned int)Op, 0, cglobs);
     /* I have to dit here, before I do the unification */
@@ -1298,7 +1357,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
       Yap_Error_Term = M;
       Yap_ErrorMessage = "in module name";
       save_machine_regs();
-      longjmp(cglobs->cint.CompilerBotch, 1);
+      longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
     }
     Goal = ArgOfTerm(2, Goal);
     mod = M;
@@ -1495,7 +1554,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	    if (H == (CELL *)cglobs->cint.freep0) {
 	      /* oops, too many new variables */
 	      save_machine_regs();
-	      longjmp(cglobs->cint.CompilerBotch,4);
+	      longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	    }
 	    savecpc = cglobs->cint.cpc;
 	    savencpc = FirstP->nextInst;
@@ -1574,7 +1633,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
       if (H == (CELL *)cglobs->cint.freep0) {
 	/* oops, too many new variables */
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch,4);
+	longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
       }
       push_branch(cglobs->onbranch, commitvar, cglobs);
       ++cglobs->curbranch;
@@ -1609,7 +1668,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
       if (H == (CELL *)cglobs->cint.freep0) {
 	/* oops, too many new variables */
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch,4);
+	longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
       }
       cglobs->onlast = FALSE;
       c_var(commitvar, save_b_flag, 1, 0, cglobs);
@@ -1723,7 +1782,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	  if (H == (CELL *)cglobs->cint.freep0) {
 	    /* oops, too many new variables */
 	    save_machine_regs();
-	    longjmp(cglobs->cint.CompilerBotch,4);
+	    longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	  }
 	  c_eq(t2, a2, cglobs);
 	  c_var(a1, bt1_flag, 2, 0, cglobs);
@@ -1736,7 +1795,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	if (H == (CELL *)cglobs->cint.freep0) {
 	  /* oops, too many new variables */
 	  save_machine_regs();
-	  longjmp(cglobs->cint.CompilerBotch,4);
+	  longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	}
 	c_eq(t1, a1, cglobs);
 
@@ -1750,7 +1809,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	  if (H == (CELL *)cglobs->cint.freep0) {
 	    /* oops, too many new variables */
 	    save_machine_regs();
-	    longjmp(cglobs->cint.CompilerBotch,4);
+	    longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	  }
 	  c_eq(t2, a2, cglobs);
 	  c_var(t1, bt1_flag, 2, 0, cglobs);
@@ -2110,7 +2169,7 @@ clear_bvarray(int var, CELL *bvarray
     Yap_Error_Term = TermNil;
     Yap_ErrorMessage = "compiler internal error: variable initialised twice";
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch, 2);
+    longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
   }
   cglobs->pbvars++;
 #endif
@@ -2151,7 +2210,7 @@ push_bvmap(int label, PInstr *pcpc, compiler_struct *cglobs)
     Yap_Error_Term = TermNil;
     Yap_ErrorMessage = "Too many embedded disjunctions";
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch, 2);
+    longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
   }
   /* the label instruction */
   bvstack[bvindex].lab = label;
@@ -2174,7 +2233,7 @@ reset_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs)
     Yap_Error_Term = TermNil;
     Yap_ErrorMessage = "No embedding in disjunctions";
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch, 2);
+    longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
   }
   env_size = (bvstack[bvindex-1].pc)->rnd1;
   size = env_size/(8*sizeof(CELL));
@@ -2194,7 +2253,7 @@ pop_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs)
     Yap_Error_Term = TermNil;
     Yap_ErrorMessage = "Too few embedded disjunctions";
     /*  save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch, 2); */
+	longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); */
   }
   reset_bvmap(bvarray, nperm, cglobs);
   bvindex--;
@@ -2462,7 +2521,7 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs)
     Yap_Error_Term = TermNil;
     Yap_ErrorMessage = "too many temporaries";
     save_machine_regs();
-    longjmp(cglobs->cint.CompilerBotch, 1);
+    longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
   }
   v->NoOfVE = cglobs->vadr = vadr = TempVar | target1;
   v->KindOfVE = TempVar;
@@ -2591,7 +2650,7 @@ c_layout(compiler_struct *cglobs)
 	Yap_Error_Term = TermNil;
 	Yap_ErrorMessage = "wrong number of variables found in bitmap";
 	save_machine_regs();
-	longjmp(cglobs->cint.CompilerBotch, 2);
+	longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
       } 
 #endif
     }
@@ -3034,56 +3093,91 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
   int botch_why;
   /* may botch while doing a different module */
   /* first, initialise cglobs->cint.CompilerBotch to handle all cases of interruptions */
- compiler_struct cglobs;
+  compiler_struct cglobs;
 
- /* make sure we know there was no error yet */
+  /* make sure we know there was no error yet */
- Yap_ErrorMessage = NULL;
+  Yap_ErrorMessage = NULL;
-  if ((botch_why = setjmp(cglobs.cint.CompilerBotch)) == 3) {
+  if ((botch_why = setjmp(cglobs.cint.CompilerBotch))) {
-    /* out of local stack, just duplicate the stack */
     restore_machine_regs();
     reset_vars(cglobs.vtable);
-    {
+    switch(botch_why) {
-      Int osize = 2*sizeof(CELL)*(ASP-H);
+    case OUT_OF_STACK_BOTCH:
-      ARG1 = inp_clause;
+      /* out of local stack, just duplicate the stack */
-      ARG3 = src;
+      {
+	Int osize = 2*sizeof(CELL)*(ASP-H);
+	ARG1 = inp_clause;
+	ARG3 = src;
 
-      YAPLeaveCriticalSection();
+	YAPLeaveCriticalSection();
-      if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, P)) {
+	if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, P)) {
-	Yap_Error_TYPE = OUT_OF_STACK_ERROR;
-	Yap_Error_Term = inp_clause;
-      }
-      if (osize > ASP-H) {
-	if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) {
 	  Yap_Error_TYPE = OUT_OF_STACK_ERROR;
 	  Yap_Error_Term = inp_clause;
 	}
+	if (osize > ASP-H) {
+	  if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) {
+	    Yap_Error_TYPE = OUT_OF_STACK_ERROR;
+	    Yap_Error_Term = inp_clause;
+	  }
+	}
+	YAPEnterCriticalSection();
+	src = ARG3;
+	inp_clause = ARG1;
+      }
+      break;
+    case OUT_OF_AUX_BOTCH:
+      /* out of local stack, just duplicate the stack */
+      YAPLeaveCriticalSection();
+      ARG1 = inp_clause;
+      ARG3 = src;
+      if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL)) {
+	Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
+	Yap_Error_Term = inp_clause;
       }
       YAPEnterCriticalSection();
       src = ARG3;
       inp_clause = ARG1;
+      break;
+    case OUT_OF_TEMPS_BOTCH:
+      /* out of temporary cells */
+      if (maxvnum < 16*1024) {
+	maxvnum *= 2;
+      } else {
+	maxvnum += 4096;
+      }
+      break;
+    case OUT_OF_HEAP_BOTCH:
+      /* not enough heap */
+      ARG1 = inp_clause;
+      ARG3 = src;
+      YAPLeaveCriticalSection();
+      if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
+	Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
+	Yap_Error_Term = inp_clause;
+	return NULL;
+      }
+      YAPEnterCriticalSection();
+      src = ARG3;
+      inp_clause = ARG1;
+      break;
+    case OUT_OF_TRAIL_BOTCH:
+      /* not enough trail */
+      ARG1 = inp_clause;
+      ARG3 = src;
+      YAPLeaveCriticalSection();
+      if (!Yap_growtrail(0L, FALSE)) {
+	Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
+	Yap_Error_Term = inp_clause;
+	return NULL;
+      }
+      YAPEnterCriticalSection();
+      src = ARG3;
+      inp_clause = ARG1;
+      break;
+    default:
+      return NULL;
     }
-  } else if (botch_why == 4) {
-    /* out of temporary cells */
-    restore_machine_regs();
-    reset_vars(cglobs.vtable);
-    if (maxvnum < 16*1024) {
-      maxvnum *= 2;
-    } else {
-      maxvnum += 4096;
-    }
-  } else if (botch_why == 2) {
-    /* not enough heap */
-    restore_machine_regs();
-    reset_vars(cglobs.vtable);
-    Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
-    Yap_Error_Term = TermNil;
-    return 0;
   }
   my_clause = inp_clause;
-  if (Yap_ErrorMessage) {
-    reset_vars(cglobs.vtable);
-    return (0);
-  }
   HB = H;
   Yap_ErrorMessage = NULL;
   Yap_Error_Size = 0;
@@ -3092,6 +3186,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
   
   cglobs.cint.CodeStart = cglobs.cint.cpc = NULL;
   cglobs.cint.BlobsStart = cglobs.cint.icpc = NULL;
+  cglobs.cint.dbterml = NULL;
   cglobs.cint.freep =
     cglobs.cint.freep0 =
     (char *) (H + maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps+MaxTemps);

C/computils.c

@@ -11,8 +11,12 @@
 * File:		computils.c						 *
 * comments:	some useful routines for YAP's compiler			 *
 *									 *
-* Last rev:     $Date: 2006-09-20 20:03:51 $							 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.30  2006/09/20 20:03:51  vsc
+* improve indexing on floats
+* fix sending large lists to DB
+*
 * Revision 1.29  2005/12/05 17:16:10  vsc
 * write_depth/3
 * overflow handlings and garbage collection
@@ -89,7 +93,7 @@ AllocCMem (int size, struct intermediates *cip)
   if (ASP <= CellPtr (cip->freep) + 256) {
     Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
     save_machine_regs();
-    longjmp(cip->CompilerBotch,3);
+    longjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH);
   }
   return (p);
 }
@@ -563,6 +567,8 @@ static char *opformat[] =
   "put_num\t\t%n,%r",
   "get_float\t\t%w,%r",
   "put_float\t\t%w,%r",
+  "get_dbterm\t%w,%r",
+  "put_dbterm\t%w,%r",
   "align_float",
   "get_longint\t\t%w,%r",
   "put_longint\t\t%w,%r",
@@ -583,6 +589,8 @@ static char *opformat[] =
   "write_num\t%n",
   "unify_float\t%w",
   "write_float\t%w",
+  "unify_dbterm\t%w",
+  "write_dbterm\t%w",
   "unify_longint\t%w",
   "write_longint\t%w",
   "unify_bigint\t%l",
@@ -649,7 +657,8 @@ static char *opformat[] =
   "unify_last_local\t%v",
   "unify_last_atom\t%a",
   "unify_last_num\t%n",
-  "unify_last_float\t%w",
+  "unify_last_float\t%w", 
+  "unify_last_dbterm\t%w",
   "unify_last_longint\t%w",
   "unify_last_bigint\t%l",
   "pvar_bitmap\t%l,%b",

C/dbase.c

@@ -1258,7 +1258,7 @@ CreateDBWithDBRef(Term Tm, DBProp p, struct db_globs *dbg)
   ppt->Contents[1] = (CELL)dbr;
   ppt->DBRefs = (DBRef *)(ppt->Contents+2);
 #ifdef COROUTINING
-  ppt->attachments = 0L;
+  ppt->ag.attachments = 0L;
 #endif
   return pp;
 }
@@ -1278,7 +1278,7 @@ CreateDBTermForAtom(Term Tm, UInt extra_size, struct db_globs *dbg) {
   ppt->NOfCells = 0;
   ppt->DBRefs = NULL;
 #ifdef COROUTINING
-  ppt->attachments = 0;
+  ppt->ag.attachments = 0;
 #endif
   ppt->DBRefs = NULL;
   ppt->Entry = Tm;
@@ -1301,7 +1301,7 @@ CreateDBTermForVar(UInt extra_size, struct db_globs *dbg)
   ppt->NOfCells = 0;
   ppt->DBRefs = NULL;
 #ifdef COROUTINING
-  ppt->attachments = 0;
+  ppt->ag.attachments = 0;
 #endif
   ppt->DBRefs = NULL;
   ppt->Entry = (CELL)(&(ppt->Entry));
@@ -1331,7 +1331,7 @@ CreateDBRefForAtom(Term Tm, DBProp p, int InFlag, struct db_globs *dbg) {
   pp->DBT.DBRefs = NULL;
   pp->DBT.NOfCells = 0;
 #ifdef COROUTINING
-  pp->DBT.attachments = 0;
+  pp->DBT.ag.attachments = 0;
 #endif
   return(pp);
 }
@@ -1355,7 +1355,7 @@ CreateDBRefForVar(Term Tm, DBProp p, int InFlag, struct db_globs *dbg) {
   pp->DBT.NOfCells = 0;
   pp->DBT.DBRefs = NULL;
 #ifdef COROUTINING
-  pp->DBT.attachments = 0;
+  pp->DBT.ag.attachments = 0;
 #endif
   INIT_LOCK(pp->lock);
   INIT_DBREF_COUNT(pp);
@@ -1582,7 +1582,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
 
       ppt->NOfCells = NOfCells;
 #ifdef COROUTINING
-      ppt->attachments = attachments;
+      ppt->ag.attachments = attachments;
 #endif
       if (pp0 != pp) {
 	nar = ppt->Contents;
@@ -1617,14 +1617,14 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
       ppt->Entry = AdjustIDBPtr(tt,(CELL)ppt-(CELL)ppt0);
 #ifdef COROUTINING
       if (attachments)
-	ppt->attachments = AdjustIDBPtr(attachments,(CELL)ppt-(CELL)ppt0);
+	ppt->ag.attachments = AdjustIDBPtr(attachments,(CELL)ppt-(CELL)ppt0);
       else
-	ppt->attachments = 0L;
+	ppt->ag.attachments = 0L;
 #endif
      } else {
       ppt->Entry = tt;
 #ifdef COROUTINING
-      ppt->attachments = attachments;
+      ppt->ag.attachments = attachments;
 #endif
     }
     if (flag & DBWithRefs) {
@@ -2440,7 +2440,7 @@ GetDBTerm(DBTerm *DBSP)
 
   if (IsVarTerm(t) 
 #if COROUTINING
-      && !DBSP->attachments
+      && !DBSP->ag.attachments
 #endif
       ) {
     return MkVarTerm();
@@ -2475,8 +2475,8 @@ GetDBTerm(DBTerm *DBSP)
       linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents));
     }
 #ifdef COROUTINING
-    if (DBSP->attachments != 0L)  {
+    if (DBSP->ag.attachments != 0L)  {
-      if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)HOld-(CELL)(DBSP->Contents)))) {
+      if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)))) {
 	H = HOld;
 	Yap_Error_TYPE = OUT_OF_ATTVARS_ERROR;
 	Yap_Error_Size = 0;
@@ -4949,16 +4949,18 @@ StoreTermInDB(Term t, int nargs)
 			  InQueue, &needs_vars, 0, &dbg)) == NULL) {
     if (Yap_Error_TYPE == YAP_NO_ERROR) {
       break;
+    } else if (nargs == -1) {
+      return NULL;
     } else {
       XREGS[nargs+1] = t;
       if (recover_from_record_error(nargs+1)) {	
 	t = Deref(XREGS[nargs+1]);
       } else {
-	return FALSE;
+	return NULL;
       }
     }
   }
-  return(x);
+  return x;
 }
 
 DBTerm *

C/grow.c

@@ -891,6 +891,8 @@ fix_compiler_instructions(PInstr *pcpc)
     case align_float_op:
     case get_bigint_op:
     case put_bigint_op:
+    case get_dbterm_op:
+    case put_dbterm_op:
     case get_list_op:
     case put_list_op:
     case get_struct_op:
@@ -906,7 +908,10 @@ fix_compiler_instructions(PInstr *pcpc)
     case write_longint_op:
     case unify_bigint_op:
     case unify_last_bigint_op:
+    case unify_dbterm_op:
+    case unify_last_dbterm_op:
     case write_bigint_op:
+    case write_dbterm_op:
     case unify_list_op:
     case write_list_op:
     case unify_struct_op:

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2007-10-28 11:23:40 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.188  2007/10/28 11:23:40  vsc
+* fix overflow
+*
 * Revision 1.187  2007/09/22 08:38:05  vsc
 * nb_ extra stuff plus an indexing overflow fix.
 *
@@ -1093,6 +1096,7 @@ has_cut(yamop *pc)
     case _get_atom:
     case _put_atom:
     case _get_bigint:
+    case _get_dbterm:
       pc = NEXTOP(pc,xc);
       break;
       /* instructions type cc */
@@ -1218,6 +1222,8 @@ has_cut(yamop *pc)
     case _unify_l_atom:
     case _unify_bigint:
     case _unify_l_bigint:
+    case _unify_dbterm:
+    case _unify_l_dbterm:
       pc = NEXTOP(pc,oc);
       break;
       /* instructions type osc */
@@ -1947,6 +1953,9 @@ add_info(ClauseDef *clause, UInt regno)
       }
       break;
      */
+    case _get_dbterm:
+      clause->Tag = (CELL)NULL;
+      return;
     case _copy_idb_term:
     case _unify_idb_term:
       if (regno == 2) {
@@ -2180,6 +2189,10 @@ add_info(ClauseDef *clause, UInt regno)
     case _unify_l_bigint:
       cl = NEXTOP(cl,oc);
       break;      
+    case _unify_dbterm:
+    case _unify_l_dbterm:
+      cl = NEXTOP(cl,oc);
+      break;      
     case _unify_n_atoms_write:
     case _unify_n_atoms:
       cl = NEXTOP(cl,osc);
@@ -2817,6 +2830,10 @@ add_head_info(ClauseDef *clause, UInt regno)
     case _unify_l_bigint:
       cl = NEXTOP(cl,oc);
       break;      
+    case _unify_dbterm:
+    case _unify_l_dbterm:
+      cl = NEXTOP(cl,oc);
+      break;      
     case _unify_n_atoms_write:
     case _unify_n_atoms:
       cl = NEXTOP(cl,osc);
@@ -2827,6 +2844,9 @@ add_head_info(ClauseDef *clause, UInt regno)
     case _unify_l_struc:
       cl = NEXTOP(cl,of);
       break;      
+    case _get_dbterm:
+      clause->Tag = (CELL)NULL;
+      return;
     case _unify_idb_term:
     case _copy_idb_term:
       if (regno != 2) {
@@ -3100,6 +3120,10 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
       }
       argno--;
       break;
+    case _unify_dbterm:
+    case _unify_l_dbterm:
+     clause->Tag = (CELL)NULL;
+     return;
     case _unify_n_atoms:
       if (argno <= cl->u.osc.s) {
 	clause->Tag = cl->u.osc.c;
@@ -3133,8 +3157,11 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
       cl = NEXTOP(cl,os);
       break;
 #endif   
+    case _get_dbterm:
     case _unify_idb_term:
     case _copy_idb_term:
+     clause->Tag = (CELL)NULL;
+     return;
       {
 	Term t = clause->u.c_sreg[argno];
 

C/stdpreds.c

@@ -11,8 +11,11 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2007-10-18 08:24:16 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.122  2007/10/18 08:24:16  vsc
+* fix global variables
+*
 * Revision 1.121  2007/10/10 09:44:24  vsc
 * some more fixes to make YAP swi compatible
 * fix absolute_file_name (again)
@@ -2884,10 +2887,24 @@ p_flags(void)
   if (IsVarTerm(t1))
     return (FALSE);
   if (IsAtomTerm(t1)) {
-    pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod));
+    while ((pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod)))== NULL) {
+      if (!Yap_growheap(FALSE, 0, NULL)) {
+	Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate");
+	return FALSE;
+      }
+      t1 = Deref(ARG1);
+      mod = Deref(ARG2);
+    }
   } else if (IsApplTerm(t1)) {
     Functor         funt = FunctorOfTerm(t1);
-    pe = RepPredProp(PredPropByFunc(funt, mod));
+    while ((pe = RepPredProp(PredPropByFunc(funt, mod)))== NULL) {
+      if (!Yap_growheap(FALSE, 0, NULL)) {
+	Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate");
+	return FALSE;
+      }
+      t1 = Deref(ARG1);
+      mod = Deref(ARG2);
+    }
   } else
     return (FALSE);
   if (EndOfPAEntr(pe))
@@ -3858,7 +3875,7 @@ Yap_InitCPreds(void)
   Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag|HiddenPredFlag);
 #endif
   /* Accessing and changing the flags for a predicate */
-  Yap_InitCPred("$flags", 4, p_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$flags", 4, p_flags, SyncPredFlag|HiddenPredFlag);
   /* hiding and unhiding some predicates */
   Yap_InitCPred("hide", 1, p_hide, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag);

C/utilpreds.c

@@ -1044,7 +1044,7 @@ p_ground(void)			/* ground(+T)		 */
       Functor fun = FunctorOfTerm(t);
       
       if (IsExtensionFunctor(fun))
-	return(TRUE);
+	return TRUE;
       else if ((out = ground_complex_term(RepAppl(t),
 					     RepAppl(t)+
 					     ArityOfFunctor(fun))) >= 0) {
@@ -1060,6 +1060,174 @@ p_ground(void)			/* ground(+T)		 */
   }
 }
 
+static int
+SizeOfExtension(Term t)
+{
+  Functor f = FunctorOfTerm(t);
+  if (f== FunctorDouble) {
+    return 2 + sizeof(Float)/sizeof(CELL);
+  }
+  if (f== FunctorLongInt) {
+    return 2 + sizeof(Float)/sizeof(CELL);
+  }
+  if (f== FunctorDBRef) {
+    return 0;
+  }
+  if (f== FunctorBigInt) {
+    CELL *pt = RepAppl(t)+1;
+    return 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
+  }
+  return 0;
+}
+
+
+static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, int ground)
+{
+
+  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  Int sz = 0;
+
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+
+    ++pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, vars_in_term_unk);
+  vars_in_term_nvar:
+    {
+      if (IsPairTerm(d0)) {
+	sz += 2;
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	pt0 = RepPair(d0) - 1;
+	pt0_end = RepPair(d0) + 1;
+      } else if (IsApplTerm(d0)) {
+	register Functor f;
+	register CELL *ap2;
+	/* store the terms to visit */
+	ap2 = RepAppl(d0);
+	f = (Functor)(*ap2);
+
+	if (IsExtensionFunctor(f)) {
+	  sz += SizeOfExtension(d0);
+	  continue;
+	}
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	/* store the terms to visit */
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	d0 = ArityOfFunctor(f);
+	sz += (1+d0);
+	pt0 = ap2;
+	pt0_end = ap2 + d0;
+      }
+      continue;
+    }
+    
+
+    derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
+    if (!ground)
+      continue;
+#ifdef RATIONAL_TREES
+    while (to_visit > to_visit0) {
+      to_visit -= 3;
+      pt0 = to_visit[0];
+      pt0_end = to_visit[1];
+      *pt0 = (CELL)to_visit[2];
+    }
+#endif
+    return 0;
+  }
+  /* Do we still have compound terms to visit */
+  if (to_visit > to_visit0) {
+#ifdef RATIONAL_TREES
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+    *pt0 = (CELL)to_visit[2];
+#else
+    to_visit -= 2;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+#endif
+    goto loop;
+  }
+  return sz;
+
+ aux_overflow:
+  /* unwind stack */
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  return -1;
+}
+
+int
+Yap_SizeGroundTerm(Term t, int ground)
+{
+  if (IsVarTerm(t)) {
+    if (!ground)
+      return 1;
+    return 0;
+  }  else if (IsPrimitiveTerm(t)) {
+    return 1;
+  } else if (IsPairTerm(t)) {
+    int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground);
+    if (sz <= 0)
+      return sz;
+    return sz+2;
+} else {
+  int sz = 0;
+  Functor fun = FunctorOfTerm(t);
+      
+  if (IsExtensionFunctor(fun))
+    return 1+ SizeOfExtension(t);
+  
+   sz = sz_ground_complex_term(RepAppl(t),
+			    RepAppl(t)+
+			    ArityOfFunctor(fun),
+			    ground);
+   if (sz <= 0)
+     return sz;
+   return 1+ArityOfFunctor(fun)+sz;
+  }  
+}
+
 static Int var_in_complex_term(register CELL *pt0,
 			       register CELL *pt0_end,
 			       Term v)

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.118 2007-10-10 09:44:24 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.119 2007-11-06 17:02:12 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -338,6 +338,7 @@ typedef struct various_codes {
   lockvar  dead_static_clauses_lock;        /* protect DeadStaticClauses */
   lockvar  dead_mega_clauses_lock;        /* protect DeadMegaClauses */
   lockvar  dead_static_indices_lock;        /* protect DeadStaticIndices */
+  lockvar  dbterms_list_lock;        /* protect DBTermList */
   int      heap_top_owner;
 #ifdef LOW_LEVEL_TRACER
   lockvar  low_level_trace_lock;
@@ -349,6 +350,7 @@ typedef struct various_codes {
   struct static_clause *dead_static_clauses;
   struct static_mega_clause *dead_mega_clauses;
   struct static_index *dead_static_indices;
+  struct dbterm_list *dbterms_list;
   Atom
     atom_abol,
     atom_alarm,
@@ -945,6 +947,7 @@ struct various_codes *Yap_heap_regs;
 #define  ParserErrorStyle         Yap_heap_regs->parser_error_style
 #define  DeadStaticClauses        Yap_heap_regs->dead_static_clauses
 #define  DeadMegaClauses          Yap_heap_regs->dead_mega_clauses
+#define  DBTermsList              Yap_heap_regs->dbterms_list
 #define  DeadStaticIndices        Yap_heap_regs->dead_static_indices
 #define  SizeOfOverflow           Yap_heap_regs->size_of_overflow
 #define  LastWtimePtr             Yap_heap_regs->last_wtime
@@ -959,6 +962,7 @@ struct various_codes *Yap_heap_regs;
 #define  ThreadsTotalTime         Yap_heap_regs->threads_total_time
 #define  DeadStaticClausesLock    Yap_heap_regs->dead_static_clauses_lock
 #define  DeadMegaClausesLock      Yap_heap_regs->dead_mega_clauses_lock
+#define  DBTermsListLock          Yap_heap_regs->dbterms_list_lock
 #define  DeadStaticIndicesLock    Yap_heap_regs->dead_static_indices_lock
 #define  ModulesLock		  Yap_heap_regs->modules_lock
 #endif

H/YapOpcodes.h

@@ -11,8 +11,11 @@
 * File:		YapOpcodes.h						 *
 * comments:	Central Table with all YAP opcodes                       *
 *									 *
-* Last rev:     $Date: 2006-10-10 14:08:17 $							 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.40  2006/10/10 14:08:17  vsc
+* small fixes on threaded implementation.
+*
 * Revision 1.39  2006/09/20 20:03:51  vsc
 * improve indexing on floats
 * fix sending large lists to DB
@@ -182,6 +185,7 @@
     OPCODE(get_float               ,xd),		
     OPCODE(get_longint             ,xi),		
     OPCODE(get_bigint              ,xc),		
+    OPCODE(get_dbterm              ,xc),		
     OPCODE(get_list                ,x),		
     OPCODE(get_struct              ,xf),		
     OPCODE(unify_x_var             ,ox),	
@@ -192,6 +196,7 @@
     OPCODE(unify_float             ,od),		
     OPCODE(unify_longint           ,oc),		
     OPCODE(unify_bigint            ,oc),		
+    OPCODE(unify_dbterm            ,oc),		
     OPCODE(unify_list              ,o),		
     OPCODE(unify_struct            ,of),	
     OPCODE(put_x_var               ,xx),		
@@ -318,6 +323,7 @@
     OPCODE(unify_l_float           ,od),	
     OPCODE(unify_l_longint         ,oi),	
     OPCODE(unify_l_bigint          ,oc),	
+    OPCODE(unify_l_dbterm          ,oc),	
     OPCODE(unify_l_void            ,o),	
     OPCODE(unify_l_n_voids         ,os),	
     OPCODE(unify_l_x_loc           ,ox),	

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.80 2007-10-18 08:24:16 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.81 2007-11-06 17:02:12 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -325,6 +325,7 @@ void	STD_PROTO(Yap_InitUserBacks,(void));
 
 /* utilpreds.c */
 Term	STD_PROTO(Yap_CopyTerm,(Term));
+int	STD_PROTO(Yap_SizeGroundTerm,(Term, int));
 void	STD_PROTO(Yap_InitUtilCPreds,(void));
 
 /* yap.c */

H/Yatom.h

@@ -798,6 +798,7 @@ IsPredProperty (int flags)
 /* There are several flags for code and data base entries */
 typedef enum
 {
+  HasDBTMask = 0x400000,	/* includes a pointer to a DBTerm */
   MegaMask = 0x200000,		/* mega clause */
   FactMask = 0x100000,		/* a fact */
   SwitchRootMask = 0x80000,	/* root for the index tree */
@@ -821,7 +822,10 @@ typedef enum
 typedef struct DB_TERM
 {
 #ifdef COROUTINING
-  CELL attachments;		/* attached terms */
+  union {
+    CELL attachments;		/* attached terms */
+    struct DB_TERM *NextDBT;
+  } ag;
 #endif
   struct DB_STRUCT **DBRefs;	/* pointer to other references     */
   CELL NOfCells;		/* Size of Term                         */
@@ -829,6 +833,18 @@ typedef struct DB_TERM
   Term Contents[MIN_ARRAY];	/* stored term                      */
 } DBTerm;
 
+inline EXTERN DBTerm *TermToDBTerm(Term);
+
+inline EXTERN DBTerm *TermToDBTerm(Term X)
+{
+  if (IsPairTerm(X)) {
+    return(DBTerm *)((char *)RepPair(X) - (CELL) &(((DBTerm *) NULL)->Contents));
+  } else {
+    return(DBTerm *)((char *)RepAppl(X) - (CELL) &(((DBTerm *) NULL)->Contents));
+  }
+}
+
+
 /* The ordering of the first 3 fields should be compatible with lu_clauses */
 typedef struct DB_STRUCT
 {

H/clause.h

@@ -158,6 +158,14 @@ typedef union clause_ptr {
   struct static_index *si;
 } ClausePointer;
 
+typedef struct dbterm_list {
+  /* a list of dbterms associated with a clause */
+  DBTerm *dbterms;
+  yamop *clause_code;
+  PredEntry *p;
+  struct dbterm_list *next_dbl;
+} DBTermList;
+
 #define ClauseCodeToDynamicClause(p)    ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode)))
 #define ClauseCodeToStaticClause(p)    ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode)))
 #define ClauseCodeToLogUpdClause(p)    ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode)))

H/compile.h

@@ -30,6 +30,8 @@ typedef enum compiler_op {
   put_num_op,
   get_float_op,
   put_float_op,
+  get_dbterm_op,
+  put_dbterm_op,
   align_float_op,
   get_longint_op,
   put_longint_op,
@@ -50,6 +52,8 @@ typedef enum compiler_op {
   write_num_op,
   unify_float_op,
   write_float_op,
+  unify_dbterm_op,
+  write_dbterm_op,
   unify_longint_op,
   write_longint_op,
   unify_bigint_op,
@@ -117,6 +121,7 @@ typedef enum compiler_op {
   unify_last_atom_op,
   unify_last_num_op,
   unify_last_float_op,
+  unify_last_dbterm_op,
   unify_last_longint_op,
   unify_last_bigint_op,
   mark_initialised_pvars_op,
@@ -231,6 +236,13 @@ typedef struct CEXPENTRY {
 	 struct CEXPENTRY *NextCE;
        } CExpEntry;
 
+#define COMPILER_ERR_BOTCH 1
+#define OUT_OF_HEAP_BOTCH  2
+#define OUT_OF_STACK_BOTCH 3
+#define OUT_OF_TEMPS_BOTCH 4
+#define OUT_OF_AUX_BOTCH   5
+#define OUT_OF_TRAIL_BOTCH 6  
+
 
 typedef struct intermediates {
   char *freep;
@@ -239,6 +251,7 @@ typedef struct intermediates {
   struct PSEUDO *CodeStart;
   struct PSEUDO *icpc;
   struct PSEUDO *BlobsStart;
+  struct dbterm_list *dbterml;
   int  *label_offset;
   Int  *uses;
   Term *contents;

H/rclause.h

@@ -12,8 +12,11 @@
 * File:		rclause.h						 *
 * comments:	walk through a clause					 *
 *									 *
-* Last rev:     $Date: 2006-11-27 17:42:03 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.18  2006/11/27 17:42:03  vsc
+* support for UNICODE, and other bug fixes.
+*
 * Revision 1.17  2006/10/10 14:08:17  vsc
 * small fixes on threaded implementation.
 *
@@ -464,6 +467,7 @@ restore_opcodes(yamop *pc)
     case _get_atom:
     case _put_atom:
     case _get_bigint:
+    case _get_dbterm:
       pc->u.xc.x = XAdjust(pc->u.xc.x);
       {
 	Term t = pc->u.xc.c;
@@ -474,7 +478,6 @@ restore_opcodes(yamop *pc)
       }
       pc = NEXTOP(pc,xc);
       break;
-      /* instructions type cc */
     case _get_2atoms:
       {
 	Term t = pc->u.cc.c1;
@@ -744,6 +747,8 @@ restore_opcodes(yamop *pc)
     case _unify_l_atom:
     case _unify_bigint:
     case _unify_l_bigint:
+    case _unify_dbterm:
+    case _unify_l_dbterm:
       pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw));
       {
 	Term t = pc->u.oc.c;

H/rheap.h

@@ -11,8 +11,13 @@
 * File:		rheap.h							 *
 * comments:	walk through heap code					 *
 *									 *
-* Last rev:     $Date: 2007-10-10 09:44:24 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-11-06 17:02:12 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.77  2007/10/10 09:44:24  vsc
+* some more fixes to make YAP swi compatible
+* fix absolute_file_name (again)
+* fix setarg
+*
 * Revision 1.76  2007/09/28 23:18:17  vsc
 * handle learning from interpretations.
 *
@@ -188,8 +193,6 @@ do_clean_susp_clauses(yamop *ipc) {
 
 #include "rclause.h"
 
-/* Restoring the heap */
-
 /* adjusts terms stored in the data base, when they have no variables */
 static Term 
 AdjustDBTerm(Term trm, Term *p_base)
@@ -232,12 +235,16 @@ AdjustDBTerm(Term trm, Term *p_base)
 }
 
 static void
-RestoreDBTerm(DBTerm *dbr)
+RestoreDBTerm(DBTerm *dbr, int attachments)
 {
+  if (attachments) {
 #ifdef COROUTINING
-  if (dbr->attachments)
+    if (dbr->ag.attachments)
-    dbr->attachments = AdjustDBTerm(dbr->attachments, dbr->Contents);
+      dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents);
 #endif
+  } else {
+    dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT);
+  }    
   if (dbr->DBRefs !=  NULL) {
     DBRef          *cp;
     DBRef            tm;
@@ -250,6 +257,8 @@ RestoreDBTerm(DBTerm *dbr)
   dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents);
 }
 
+/* Restoring the heap */
+
 /* Restores a prolog clause, in its compiled form */
 static void 
 RestoreStaticClause(StaticClause *cl)
@@ -313,7 +322,7 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp)
   }
   if (cl->ClSource) {
     cl->ClSource = DBTermAdjust(cl->ClSource);
-    RestoreDBTerm(cl->ClSource);
+    RestoreDBTerm(cl->ClSource, TRUE);
   }
   if (cl->ClPrev) {
     cl->ClPrev = PtoLUCAdjust(cl->ClPrev);
@@ -325,6 +334,20 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp)
   restore_opcodes(cl->ClCode);
 }
 
+static void
+RestoreDBTermEntry(struct dbterm_list *dbl) {
+  DBTerm *dbt;
+
+  dbl->dbterms = DBTermAdjust(dbl->dbterms);
+  dbl->clause_code = PtoOpAdjust(dbl->clause_code);
+  dbl->next_dbl = PtoDBTLAdjust(dbl->next_dbl);
+  dbl->p = PredEntryAdjust(dbl->p);
+  while (dbt) {
+    RestoreDBTerm(dbt, FALSE);
+    dbt = dbt->ag.NextDBT;
+  }
+}
+
 static void 
 CleanLUIndex(LogUpdIndex *idx)
 {
@@ -503,6 +526,14 @@ restore_codes(void)
       mc = mc->ClNext;
     }
   }
+  if (Yap_heap_regs->dbterms_list) {
+    struct dbterm_list *dbl = PtoDBTLAdjust(Yap_heap_regs->dbterms_list);
+    Yap_heap_regs->dbterms_list = dbl;
+    while (dbl) {
+      RestoreDBTermEntry(dbl);
+      dbl = dbl->next_dbl;
+    }
+  }
   if (Yap_heap_regs->dead_static_indices) {
     StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(Yap_heap_regs->dead_static_indices));
     Yap_heap_regs->dead_static_indices = si;
@@ -705,23 +736,23 @@ restore_codes(void)
   Yap_heap_regs->yap_lib_dir =
     (char *)AddrAdjust((ADDR)Yap_heap_regs->yap_lib_dir);
   Yap_heap_regs->pred_goal_expansion =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_goal_expansion);
+    PredEntryAdjust(Yap_heap_regs->pred_goal_expansion);
   Yap_heap_regs->pred_meta_call =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_meta_call);
+    PredEntryAdjust(Yap_heap_regs->pred_meta_call);
   Yap_heap_regs->pred_dollar_catch =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_dollar_catch);
+    PredEntryAdjust(Yap_heap_regs->pred_dollar_catch);
   Yap_heap_regs->pred_recorded_with_key =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_recorded_with_key);
+    PredEntryAdjust(Yap_heap_regs->pred_recorded_with_key);
   Yap_heap_regs->pred_log_upd_clause =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_log_upd_clause);
+    PredEntryAdjust(Yap_heap_regs->pred_log_upd_clause);
   Yap_heap_regs->pred_log_upd_clause0 =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_log_upd_clause0);
+    PredEntryAdjust(Yap_heap_regs->pred_log_upd_clause0);
   Yap_heap_regs->pred_static_clause =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_static_clause);
+    PredEntryAdjust(Yap_heap_regs->pred_static_clause);
   Yap_heap_regs->pred_throw =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_throw);
+    PredEntryAdjust(Yap_heap_regs->pred_throw);
   Yap_heap_regs->pred_handle_throw =
-    (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_handle_throw);
+    PredEntryAdjust(Yap_heap_regs->pred_handle_throw);
 #if DEBUG
   if (Yap_heap_regs->db_erased_list) {
     Yap_heap_regs->db_erased_list = 
@@ -816,7 +847,7 @@ RestoreDBEntry(DBRef dbr)
   else
     fprintf(stderr, " a var\n");
 #endif
-  RestoreDBTerm(&(dbr->DBT));
+  RestoreDBTerm(&(dbr->DBT), TRUE);
   if (dbr->Parent) {
     dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
   }
@@ -1029,7 +1060,7 @@ restore_static_array(StaticArrayEntry *ae)
 	  } else {
 	    DBTerm *db = (DBTerm *)RepAppl(reg);
 	    db = DBTermAdjust(db);
-	    RestoreDBTerm(db);
+	    RestoreDBTerm(db, TRUE);
 	    base->tstore = AbsAppl((CELL *)db);
 	  }
 	}
@@ -1048,7 +1079,7 @@ restore_static_array(StaticArrayEntry *ae)
 	    base++;
 	  } else {
 	    *base++ = reg = DBTermAdjust(reg);
-	    RestoreDBTerm(reg);
+	    RestoreDBTerm(reg, TRUE);
 	  }
 	}
       }

H/sshift.h

@@ -568,6 +568,15 @@ PtoStCAdjust (struct static_clause *ptr)
 }
 
 
+inline EXTERN struct dbterm_list *PtoDBTLAdjust (struct dbterm_list *);
+
+inline EXTERN struct dbterm_list *
+PtoDBTLAdjust (struct dbterm_list * addr)
+{
+  return (struct dbterm_list *) ((ADDR) (CharP (addr) + HDiff));
+}
+
+
 #if PRECOMPUTE_REGADDRESS
 
 inline EXTERN wamreg XAdjust (wamreg);

changes-5.1.html

@@ -17,6 +17,10 @@
 
 <h2>Yap-5.1.3:</h2>
 <ul>
+<li> FIXED: predicate table could not enough room while overflowing
+  (obs from Bernd Gutmann).</li>
+<li> FIXED: compile large ground terms outside clauses (obs from Bernd
+Gutmann).</li>
 <li> FIXED: YAP_LeaveGoal should always backtrack, if asked for, for
   deterministic computations (obs from Trevor Walker).</li>
 <li> FIXED: in_this_file_before should check predicate module, not

docs/yap.tex

@@ -1,4 +1,4 @@
-\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
+a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
 
 @c %**start of header
 @setfilename yap.info
@@ -1594,6 +1594,64 @@ will consult @code{file1} @code{file4} and reconsult @code{file2} and
 @noindent
 In YAP, the same as @code{reconsult/1}.
 
+@item load_files(@var{+Files}, @var{+Options})
+@findex load_files/2
+@syindex load_files/2
+@cnindex load_files/2
+@noindent
+General implementation of @code{consult}. Execution is controlled by the
+following flags:
+
+@table @code
+@item autoload(+@var{Autoload})
+SWI-compatible option where if @var{Autoload} is @code{true} predicates
+are loaded on first call. Currently
+not supported.
+@item derived_from(+@var{File})
+      SWI-compatible option to control make. Currently
+      not supported.
+@item encoding(+@var{Encoding})
+Character encoding used in consulting files. Please @pxref{Encoding} for
+supported encodings.
+
+@item expand(+@var{Bool})
+      Not yet implemented. In SWI-Prolog, if @code{true}, run the
+    filenames through @code{expand_file_name/2} and load the returned
+    files. Default is false, except for @code{consult/1} which is
+    intended for interactive use.
+
+@item if(+@var{Condition})
+    Load the file only if the specified @var{Condition} is
+    satisfied. The value @code{true} the file unconditionally,
+    @code{changed} loads the file if it was not loaded before, or has
+    been modified since it was loaded the last time, @code{not_loaded}
+    loads the file if it was not loaded before.
+
+@item imports(+@var{ListOrAll})
+    If @code{all} and the file is a module file, import all public
+    predicates. Otherwise import only the named predicates. Each
+    predicate is referred to as @code{<name>/<arity>}. This option has
+    no effect if the file is not a module file.
+
+@item must_be_module(+@var{Bool})
+    If true, raise an error if the file is not a module file. Used by
+    @code{use_module/[1,2]}.
+
+@c qcompile(Bool)
+@c     If this call appears in a directive of a file that is compiled into Quick Load Format using qcompile/1 and this flag is true, the contents of the argument files are included in the .qlf file instead of the loading directive.
+
+@item silent(+@var{Bool})
+    If true, load the file without printing a message. The specified value is the default for all files loaded as a result of loading the specified files.
+
+@item stream(+@var{Input})
+    This SWI-Prolog extension compiles the data from the stream
+    @var{Input}. If this option is used, @var{Files} must be a single
+    atom which is used to identify the source-location of the loaded
+    clauses as well as remove all clauses if the data is re-consulted.
+
+    This option is added to allow compiling from non-file locations such as databases, the web, the user (see consult/1) or other servers. 
+@end table
+
 @item ensure_loaded(@var{+F}) [ISO]
 @findex ensure_loaded/1
 @syindex compile/1

pl/consult.yap

@@ -19,14 +19,14 @@
 % SWI options
 % autoload(true,false)
 % derived_from(File) -> make
-% encoding(Encoding)
+% encoding(Encoding) => implemented
 % expand({true,false)
-% if(changed,true,not_loaded)
+% if(changed,true,not_loaded) => implemented
-% imports(all,List)
+% imports(all,List) => implemented
 % qcompile(true,false)
 % silent(true,false)  => implemented
 % stream(Stream)  => implemented
-% consult(consult,reconsult) 
+% consult(consult,reconsult) => implemented
 %
 load_files(Files,Opts) :-
 	'$load_files'(Files,Opts,load_files(Files,Opts)).