support for tabling

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

C/absmi.c

@@ -1139,7 +1139,7 @@ Yap_absmi(int inp)
 	  UNLOCK(cl->ClLock);
 	}
 #else
-	if (B->cp_tr[-1] == CLREF_TO_TRENTRY(cl) &&
+	if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
 	    B->cp_tr > B->cp_b->cp_tr) {
 	  cl->ClFlags &= ~InUseMask;
 	  TR = --B->cp_tr;
@@ -1419,7 +1419,14 @@ Yap_absmi(int inp)
 
       /* trust_fail                       */
       BOp(trust_fail, e);
+#ifdef YAPOR
+      CUT_prune_to((choiceptr) d0);
+#else
       B = B->cp_b;
+#endif	/* YAPOR */
+#ifdef TABLING
+      abolish_incomplete_subgoals(B);
+#endif /* TABLING */
       goto fail;
       ENDBOp();
 
@@ -1601,7 +1608,6 @@ Yap_absmi(int inp)
 	    if ((ADDR) pt1 >= Yap_TrailBase)
 #endif /* SBA */
 	      {
-		pt1 = (tr_fr_ptr) pt1;
 		goto failloop;
 	      }
 #endif /* FROZEN_STACKS */

C/amasm.c

@@ -1245,6 +1245,9 @@ a_try(op_numbers opcode, CELL lab, CELL opr)
     code_p->u.ld.d = emit_a(lab);
     code_p->u.ld.s = emit_count(opr);
     code_p->u.ld.p = CurrentPred;
+#ifdef TABLING
+    code_p->u.ld.te = CurrentPred->TableOfPred;
+#endif
 #ifdef YAPOR
     INIT_YAMOP_LTT(code_p, nofalts);
     if (hascut)
@@ -2016,9 +2019,11 @@ a_f2(int var)
 
 #define TRYOP(G,P)   (IPredArity<5 ? (op_numbers)((int)(P)+(IPredArity*3)) : (G))
 #ifdef YAPOR
-#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1);
+#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1)
+#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cpc->rnd1), IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1)
 #else
-#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity);
+#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity)
+#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cpc->rnd1), IPredArity)
 #endif /* YAPOR */
 
 static yamop *
@@ -2032,6 +2037,9 @@ do_pass(void)
 #endif	/* YAPOR */
   int log_update;
   int dynamic;
+#ifdef TABLING
+  int tabled;
+#endif
   int ystop_found = FALSE;
   union clause_obj *cl_u;
 
@@ -2043,6 +2051,9 @@ do_pass(void)
   /* Space while for the clause flags */
   log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
   dynamic = CurrentPred->PredFlags & DynamicPredFlag;
+#ifdef TABLING
+  tabled = CurrentPred->PredFlags & TabledPredFlag;
+#endif
   if (assembling != ASSEMBLING_INDEX) {
     if (log_update) {
       if (pass_no) {
@@ -2128,6 +2139,9 @@ do_pass(void)
     case table_new_answer_op:
       a_n(_table_new_answer, (int) cpc->rnd2);
       break;
+    case table_try_single_op:
+      a_gl(_table_try_single);
+      break;
 #endif /* TABLING */
 #ifdef TABLING_INNER_CUTS
     case clause_with_cut_op:
@@ -2359,27 +2373,52 @@ do_pass(void)
       a_deallocate();
       break;
     case tryme_op:
+#ifdef TABLING
+      if (tabled)
+	TABLE_TRYCODE(_table_try_me);
+      else
+#endif
 	TRYCODE(_try_me, _try_me0);
       break;
     case retryme_op:
+#ifdef TABLING
+      if (tabled)
+	TABLE_TRYCODE(_table_retry_me);
+      else
+#endif
 	TRYCODE(_retry_me, _retry_me0);
       break;
     case trustme_op:
       if (log_update && assembling == ASSEMBLING_INDEX) {
-	a_cl(_trust_logical_pred);
+	a_gl(_trust_logical_pred);
       }
+#ifdef TABLING
+      if (tabled)
+	TABLE_TRYCODE(_table_trust_me);
+      else
+#endif
 	TRYCODE(_trust_me, _trust_me0);
       break;
     case enter_lu_op:
       a_lucl(_enter_lu_pred);
       break;
     case try_op:
+#ifdef TABLING
+      if (tabled)
+	a_gl(_table_try);
+      else
+#endif
 	a_gl(_try_clause);
       break;
     case retry_op:
       if (log_update) {
 	add_clref(cpc->rnd1);
       }
+#ifdef TABLING
+      if (tabled)
+	a_gl(_table_retry);
+      else
+#endif
 	a_gl(_retry);
       break;
     case trust_op:
@@ -2387,6 +2426,11 @@ do_pass(void)
 	add_clref(cpc->rnd1);
 	a_cl(_trust_logical_pred);
       }
+#ifdef TABLING
+      if (tabled)
+	a_gl(_table_trust);
+      else
+#endif
 	a_gl(_trust);
       break;
     case try_in_op:

C/cdmgr.c

@@ -151,13 +151,6 @@ IPred(PredEntry *ap)
 {
   yamop          *BaseAddr;
 
-#ifdef TABLING
-  if (is_tabled(ap)) {
-    ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
-    ap->OpcodeOfPred = ap->CodeOfPred->opc;
-    return;
-  }
-#endif /* TABLING */
 #ifdef DEBUG
   if (Yap_Option['i' - 'a' + 1]) {
     Term tmod = ModuleName[ap->ModuleOfPred];
@@ -235,7 +228,11 @@ RemoveMainIndex(PredEntry *ap)
   if (First != NULL && spied) {
     ap->OpcodeOfPred = Yap_opcode(_spy_pred);
     ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); 
-  } else if (ap->cs.p_code.NOfClauses > 1) {
+  } else if (ap->cs.p_code.NOfClauses > 1
+#ifdef TABLING
+	     ||ap->PredFlags & TabledPredFlag
+#endif
+	     ) {
     ap->OpcodeOfPred = INDEX_OPCODE;
     ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); 
   } else {
@@ -657,10 +654,9 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
 #endif /* YAPOR */
 #ifdef TABLING
     if (is_tabled(p)) {
-      pt->u.ld.te = p->TableOfPred; XXXXX
+      p->OpcodeOfPred = INDEX_OPCODE;
-      pt->opc = Yap_opcode(_table_try_me_single);
+      p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); 
     }
-    else	
 #endif /* TABLING */
   }
   p->cs.p_code.TrueCodeOfPred = pt;
@@ -800,11 +796,6 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
 #ifdef YAPOR
   PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->cs.p_code.FirstClause)) + 1);
 #endif /* YAPOR */
-#ifdef TABLING
-  if (is_tabled(p)) XXX
-    q->opc = Yap_opcode(_table_try_me);    
-  else
-#endif /* TABLING */
   p->cs.p_code.FirstClause = q;
   p->cs.p_code.TrueCodeOfPred = q;
   if (p->PredFlags & SpiedPredFlag) {

C/computils.c

@@ -624,6 +624,7 @@ static char *opformat[] =
 #endif /* YAPOR */
 #ifdef TABLING
   "table_new_answer",
+  "table_try_single\t%g\t%x",
 #endif /* TABLING */
 #ifdef TABLING_INNER_CUTS
   "clause_with_cut",

C/dbase.c

@@ -1789,10 +1789,8 @@ record_lu(PredEntry *pe, Term t, int position)
   LogUpdClause *cl;
   int needs_vars = FALSE;
 
-  WRITE_LOCK(pe->PRWLock);
   ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
   if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) {
-    WRITE_UNLOCK(pe->PRWLock);
     return NULL; /* crash */
   }
   cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
@@ -1812,6 +1810,7 @@ record_lu(PredEntry *pe, Term t, int position)
     ipc->opc = Yap_opcode(_copy_idb_term);
   else
     ipc->opc = Yap_opcode(_unify_idb_term);
+  WRITE_LOCK(pe->PRWLock);
   Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
   WRITE_UNLOCK(pe->PRWLock);
   return cl;
@@ -1829,7 +1828,6 @@ p_rcda(void)
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
   pe = find_lu_entry(t1);
-  WRITE_LOCK(pe->PRWLock);
  restart_record:
   Yap_Error_Size = 0;
   if (pe) {
@@ -4366,7 +4364,12 @@ p_instance_module(void)
   Term t1 = Deref(ARG1);
   DBRef dbr;
 
-  if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
+  if (IsVarTerm(t1)) {
+    return FALSE;
+  }
+  if (IsDBRefTerm(t1)) {
+    dbr = DBRefOfTerm(t1);
+  } else {
     if (IsIntegerTerm(t1)) 
       dbr = (DBRef)IntegerOfTerm(t1);
     else
@@ -4375,8 +4378,6 @@ p_instance_module(void)
     if (dbr > (DBRef)Yap_HeapBase && dbr < (DBRef)HeapTop && dbr->id != FunctorDBRef) {
       return FALSE;
     }
-  } else {
-    dbr = DBRefOfTerm(t1);
   }
   if (dbr->Flags & LogUpdMask) {
     LogUpdClause *cl = (LogUpdClause *)dbr;

C/heapgc.c

@@ -1490,9 +1490,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
 	  op_numbers caller_op = Yap_op_from_opcode(ENV_ToOp(gc_B->cp_cp));
 	  /* first condition  checks if this was a meta-call */
 	  if ((caller_op != _call  && caller_op != _fcall) || pe == NULL) {
-	    fprintf(Yap_stderr,"[GC]       marked %d (%s)\n", total_marked, op_names[opnum]);
+	    fprintf(Yap_stderr,"[GC]       marked %ld (%s)\n", total_marked, op_names[opnum]);
 	  } else
-	    fprintf(Yap_stderr,"[GC]       %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
+	    fprintf(Yap_stderr,"[GC]       %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
 	}
 	break;
       case _trie_retry_var:
@@ -1505,7 +1505,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
       case _trie_trust_list:
       case _trie_retry_struct:
       case _trie_trust_struct:
-	fprintf(Yap_stderr,"[GC]       marked %d (%s)\n", total_marked, op_names[opnum]);
+	fprintf(Yap_stderr,"[GC]       marked %ld (%s)\n", total_marked, op_names[opnum]);
 	break;
 #endif
       default:
@@ -1640,6 +1640,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
 	break;
       case _table_retry_me:
       case _table_trust_me:
+      case _table_retry:
+      case _table_trust:
 	{
 	  register gen_cp_ptr gcp = GEN_CP(gc_B);	  
 	  int nargs = rtp->u.ld.s;
@@ -2312,6 +2314,8 @@ sweep_choicepoints(choiceptr gc_B)
 	break;
     case _table_retry_me:
     case _table_trust_me:
+    case _table_retry:
+    case _table_trust:
       {
 	register gen_cp_ptr gcp = GEN_CP(gc_B);
 	int nargs;

C/index.c

@@ -1550,10 +1550,13 @@ add_info(ClauseDef *clause, UInt regno)
     case _sync:
 #endif
 #ifdef TABLING
-    case _table_try_me_single:
+    case _table_try_single:
     case _table_try_me:
     case _table_retry_me:
     case _table_trust_me:
+    case _table_try:
+    case _table_retry:
+    case _table_trust:
     case _table_answer_resolution:
     case _table_completion:
 #endif
@@ -1597,6 +1600,7 @@ add_info(ClauseDef *clause, UInt regno)
     case _getwork_first_time:
 #endif
 #ifdef TABLING
+    case _table_new_answer:
     case _trie_do_var:
     case _trie_trust_var:
     case _trie_try_var:
@@ -2335,7 +2339,7 @@ emit_retry(ClauseDef *cl, PredEntry *ap, int clauses)
 }
 
 static compiler_vm_op
-emit_optry(int var_group, int first, int clauses, int clleft)
+emit_optry(int var_group, int first, int clauses, int clleft, PredEntry *ap)
 {
   /* var group */
   if (var_group || clauses == 0) {
@@ -2347,8 +2351,13 @@ emit_optry(int var_group, int first, int clauses, int clleft)
       return trust_op;
     }
   } else if (clleft == 0) {
+    if (ap->PredFlags & TabledPredFlag && !first) {
+      /* we never actually get to remove the last choice-point in this case */
+      return retry_op;
+    } else {
       /* last group */
       return try_op;
+    }
   } else {
     /* nonvar group */
     return try_in_op;
@@ -2359,7 +2368,7 @@ emit_optry(int var_group, int first, int clauses, int clleft)
 static void
 emit_try(ClauseDef *cl, PredEntry *ap, int var_group, int first, int clauses, int clleft, UInt nxtlbl)
 {
-  compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft);
+  compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft, ap);
   Yap_emit(comp_op, (CELL)(cl->CurrentCode), ((clauses+clleft) << 1) | has_cut(cl->CurrentCode) );
 }
 
@@ -2635,6 +2644,25 @@ count_funcs(GroupDef *grp)
 static UInt
 emit_single_switch_case(ClauseDef *min, PredEntry *ap, int first, int clleft, UInt nxtlbl)
 {
+#ifdef TABLING
+  if (ap->PredFlags & TabledPredFlag) {
+    /* we have two differences with tabling:
+       1. we cannot allow straight jumps to clauses, otherwise thetabled
+         would never get to be created.
+       2. we don't clean trust at the very end of computation.
+    */
+    if (clleft == 0) {
+      UInt lbl = new_label();
+      Yap_emit(label_op, lbl, Zero);
+      if (first) {
+	Yap_emit(table_try_single_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode));
+      } else {
+	Yap_emit(trust_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode));
+      }
+      return lbl;
+    }
+  }
+#endif
   return (UInt)(min->CurrentCode);
 }
 
@@ -2834,6 +2862,13 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, PredEntry *ap)
     /* !first */
     if (clleft) {
       Yap_emit(retryme_op, nxtlbl, (clleft << 1));
+    } else if ((ap->PredFlags & TabledPredFlag)) {
+      /*
+	we cannot get rid of the choice-point for tabled predicates, all
+	kinds of hell would follow, so we just keep it around: not nice,
+	but should work.
+      */
+      Yap_emit(retryme_op, (CELL)TRUSTFAILCODE, 0);
     } else {
       Yap_emit(trustme_op, 0, 0);
     }
@@ -6178,7 +6213,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
 	  UNLOCK(cl->ClLock);
 	}
 #else
-	if (B->cp_tr[-1] == CLREF_TO_TRENTRY(cl) &&
+	if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
 	    B->cp_tr > B->cp_b->cp_tr) {
 	  cl->ClFlags &= ~InUseMask;
 	  /* clear the entry from the trail */

C/init.c

@@ -1140,9 +1140,12 @@ Yap_InitStacks(int Heap,
 	    aux_delayed_release_load);
 #else /* Yap */
   Yap_InitMemory (Trail, Heap, Stack);
+#endif /* YAPOR || TABLING */
   AtomHashTableSize = MaxHash;
   HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
-#endif /* YAPOR || TABLING */
+  if (HashChain == NULL) {
+    Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial atom table");
+  }
   for (i = 0; i < MaxHash; ++i) {
     INIT_RWLOCK(HashChain[i].AERWLock);
     HashChain[i].Entry = NIL;

C/tracer.c

@@ -115,10 +115,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /*  extern int gc_calls; */
 
   vsc_count++;
-  if (vsc_count == 716559119LL)
-    vsc_xstop=1;
-  if (vsc_count < 716558000LL)
-    return;
 #ifdef COMMENTED
   if (port != enter_pred ||
       !pred ||

H/YapOpcodes.h

@@ -29,10 +29,13 @@
     OPCODE(sync                    ,ld),
 #endif /* YAPOR */
 #ifdef TABLING
-    OPCODE(table_try_me_single     ,ld),
     OPCODE(table_try_me            ,ld),
     OPCODE(table_retry_me          ,ld),
     OPCODE(table_trust_me          ,ld),
+    OPCODE(table_try_single        ,ld),
+    OPCODE(table_try	           ,ld),
+    OPCODE(table_retry	           ,ld),
+    OPCODE(table_trust             ,ld),
     OPCODE(table_new_answer        ,s),
     OPCODE(table_answer_resolution ,ld),
     OPCODE(table_completion        ,ld),

H/compile.h

@@ -138,6 +138,7 @@ typedef enum compiler_op {
 #endif /* YAPOR */
 #ifdef TABLING
   table_new_answer_op,
+  table_try_single_op,
 #endif /* TABLING */
 #ifdef TABLING_INNER_CUTS
   clause_with_cut_op,

H/rheap.h

@@ -648,10 +648,13 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
     case _sync:
 #endif
 #ifdef TABLING
-    case _table_try_me_single:
+    case _table_try_single:
     case _table_try_me:
     case _table_retry_me:
     case _table_trust_me:
+    case _table_try:
+    case _table_retry:
+    case _table_trust:
     case _table_answer_resolution:
     case _table_completion:
 #endif /* TABLING */

OPTYap/tab.insts.i

@@ -189,7 +189,7 @@
 
 
 
-  PBOp(table_try_me_single, ld)
+  PBOp(table_try_single, ld)
     tab_ent_ptr tab_ent;
     sg_node_ptr sg_node;
     sg_fr_ptr sg_fr;
@@ -221,7 +221,7 @@
 #endif /* TABLE_LOCK_LEVEL */
       LOCAL_top_sg_fr = sg_fr;
       store_generator_node(YENV, PREG->u.ld.s, COMPLETION, sg_fr);
-      PREG = NEXTOP(PREG, ld);
+      PREG = PREG->u.ld.d;
       PREFETCH_OP(PREG);
       allocate_environment(YENV);
       GONext();
@@ -386,6 +386,115 @@
   ENDPBOp();
 
 
+  PBOp(table_try, ld)
+    tab_ent_ptr tab_ent;
+    sg_node_ptr sg_node;
+    sg_fr_ptr sg_fr;
+    CELL *Yaddr;
+
+    Yaddr = YENV;
+    check_trail();
+    tab_ent = PREG->u.ld.te;
+#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
+    LOCK(TabEnt_lock(tab_ent));
+#endif /* TABLE_LOCK_LEVEL */
+    sg_node = subgoal_search(tab_ent, PREG->u.ld.s, &Yaddr);
+    YENV = Yaddr;
+#if defined(TABLE_LOCK_AT_NODE_LEVEL)
+    LOCK(TrNode_lock(sg_node));
+#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
+    LOCK_TABLE(sg_node);
+#endif /* TABLE_LOCK_LEVEL */
+    if (TrNode_sg_fr(sg_node) == NULL) {
+      /* new tabled subgoal */
+      new_subgoal_frame(sg_fr, sg_node, PREG->u.ld.s, LOCAL_top_sg_fr);
+      TrNode_sg_fr(sg_node) = (sg_node_ptr) sg_fr;
+#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
+      UNLOCK(TabEnt_lock(tab_ent));
+#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
+      UNLOCK(TrNode_lock(sg_node));
+#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
+      UNLOCK_TABLE(sg_node);
+#endif /* TABLE_LOCK_LEVEL */
+      LOCAL_top_sg_fr = sg_fr;
+      store_generator_node(YENV, PREG->u.ld.s, NEXTOP(PREG,ld), sg_fr);
+      PREG = PREG->u.ld.d;
+      PREFETCH_OP(PREG);
+      allocate_environment(YENV);
+      GONext();
+    } else {
+      /* tabled subgoal not new */
+#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
+      UNLOCK(TabEnt_lock(tab_ent));
+#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
+      UNLOCK(TrNode_lock(sg_node));
+#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
+      UNLOCK_TABLE(sg_node);
+#endif /* TABLE_LOCK_LEVEL */
+      sg_fr = (sg_fr_ptr) TrNode_sg_fr(sg_node);
+      LOCK(SgFr_lock(sg_fr));
+      if (SgFr_state(sg_fr)) {
+        /* subgoal completed */
+        if (SgFr_state(sg_fr) == complete)
+          update_answer_trie(sg_fr);
+        UNLOCK(SgFr_lock(sg_fr));
+        if (SgFr_first_answer(sg_fr) == NULL) {
+          /* no answers --> fail */
+          goto fail;
+        } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
+          /* yes answer --> procceed */
+          PREG = (yamop *) CPREG;
+          PREFETCH_OP(PREG);
+          YENV = ENV;
+          GONext();
+        } else {
+          /* answers -> load first answer */
+          PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
+          PREFETCH_OP(PREG);
+          *--YENV = 0;  /* vars_arity */
+          *--YENV = 0;  /* heap_arity */
+          GONext();
+        }
+      } else {
+        /* subgoal not completed */
+        choiceptr leader_cp;
+        int leader_dep_on_stack;
+        find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
+        UNLOCK(SgFr_lock(sg_fr));
+        find_leader_node(leader_cp, leader_dep_on_stack);
+        store_consumer_node(YENV, sg_fr, leader_cp, leader_dep_on_stack);
+#ifdef OPTYAP_ERRORS
+        if (PARALLEL_EXECUTION_MODE) {
+          choiceptr aux_cp;
+          aux_cp = B;
+          while (YOUNGER_CP(aux_cp, LOCAL_top_cp_on_stack))
+            aux_cp = aux_cp->cp_b;
+          if (aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr))
+            OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (table_try_me)");
+          aux_cp = B;
+          while (YOUNGER_CP(aux_cp, DepFr_leader_cp(LOCAL_top_dep_fr)))
+            aux_cp = aux_cp->cp_b;
+          if (aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr))
+            OPTYAP_ERROR_MESSAGE("Error on DepFr_leader_cp (table_try_me)");
+        }
+#endif /* OPTYAP_ERRORS */
+        goto answer_resolution;
+      }
+    }
+  ENDPBOp();
+
+
+
+  Op(table_retry, ld)
+    restore_generator_node(B, PREG->u.ld.s, NEXTOP(PREG,ld));
+    YENV = (CELL *) PROTECT_FROZEN_B(B);
+    set_cut(YENV, B->cp_b);
+    SET_BB(NORM_CP(YENV));
+    allocate_environment(YENV);
+    PREG = PREG->u.ld.d;
+    GONext();
+  ENDOp();
+
 
   Op(table_retry_me, ld)
     restore_generator_node(B, PREG->u.ld.s, PREG->u.ld.d);
@@ -409,6 +518,15 @@
     GONext();
   ENDOp();
 
+  Op(table_trust, ld)
+    restore_generator_node(B, PREG->u.ld.s, COMPLETION);
+    YENV = (CELL *) PROTECT_FROZEN_B(B);
+    set_cut(YENV, B->cp_b);
+    SET_BB(NORM_CP(YENV));
+    allocate_environment(YENV);
+    PREG = PREG->u.ld.d;
+    GONext();
+  ENDOp();
 
 
   PBOp(table_new_answer, s)

docs/yap.tex

@@ -4863,6 +4863,9 @@ true if the predicate is exported in the current module.
 @item public
 true if the predicate is public; note that all dynamic predicates are
 public.
+@item tabled
+true if the predicate is tabled; note that only static predicates can
+be tabled in YAP.
 @item source
 true if source for the predicate is available.
 @item number_of_clauses(@var{ClauseCount})

pl/init.yap

@@ -131,6 +131,8 @@ system_mode(verbose,off) :- set_value('$verbose',off).
 
 :- module(user).
 
+:- current_module(X), write(X).
+
 :- multifile goal_expansion/3.
 
 :- dynamic_predicate(goal_expansion/3, logical).
@@ -157,5 +159,3 @@ library_directory(D) :-
 
 :- get_value(system_library_directory,D), assert(library_directory(D)).
 
-
-

pl/modules.yap

@@ -180,10 +180,7 @@ module(N) :-
 	'$current_module'(_,N),
 	get_value('$consulting_file',F),
 	( recordzifnot('$module','$module'(N),_) -> true; true),
-	( recorded('$module','$module'(F,N,[]),_) ->
+	( recordaifnot('$module','$module'(F,N,[]),_) -> true, true).
-	  true ;
-	  recorda('$module','$module'(F,N,[]),_)
-	).
 module(N) :-
 	'$do_error'(type_error(atom,N),module(N)).
 

pl/preds.yap

@@ -809,7 +809,10 @@ predicate_property(Pred,Prop) :-
 	'$system_predicate'(P,M), !.
 '$predicate_property'(P,M,_,source) :- 
 	'$flags'(G,M,F,F),
-	( F /\ 0x00400000 =\= 0 -> true ; false).
+	F /\ 0x00400000 =\= 0.
+'$predicate_property'(P,M,_,tabled) :- 
+	'$flags'(G,M,F,F),
+	F /\ 0x00000040 =\= 0.
 '$predicate_property'(P,M,_,dynamic) :-
 	'$is_dynamic'(P,M).
 '$predicate_property'(P,M,_,static) :-

pl/tabling.yap

@@ -20,7 +20,7 @@
 table(M:X) :- !,
 	'$table'(X, M).
 table(X) :-
-	current_module(M),
+	'$current_module'(M),
 	'$table'(X, M).
 
 '$table'(X, _) :- var(X), !,
@@ -30,18 +30,25 @@ table(X) :-
 '$table'(M:A, _) :- !, '$table'(A, M).
 '$table'((A,B), M) :- !, '$table'(A, M), '$table'(B, M).
 '$table'(A/N, M) :- integer(N), atom(A), !,
-              functor(T,A,N), '$flags'(T,M,F,F),
+	functor(P, A, N),
-              (
+	'$declare_tabled'(P, M).
-                X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T, M)
-              ;
-		'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N))
-              ).
 '$table'(X, _) :- write(user_error, '[ Error: '),
         write(user_error, X),
         write(user_error, ' is an invalid argument to table/1 ]'),
         nl(user_error),
         fail.
 
+'$declare_tabled'(P, M) :-
+	'$undefined'(P, M), !,
+	'$do_table'(P, M).
+'$declare_tabled'(P, M) :-
+	'$flags'(P,M,F,F),
+	X is F /\ 0x1991F880, X =:= 0, !,
+	'$do_table'(P, M).
+'$declare_tabled'(P, M) :-
+	functor(P, A, N),
+	'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N)).
+
 abolish_trie(M:X)   :- !,
 	'$abolish_trie'(X, M).
 abolish_trie(X)   :-