fix tabling

allow atom gc again for now.


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

C/agc.c

@@ -25,8 +25,9 @@ static char     SccsId[] = "@(#)agc.c	1.3 3/15/90";
 #include "attvar.h"
 
 #ifdef DEBUG
-#define DEBUG_RESTORE1 1
+/* #define DEBUG_RESTORE1 1 */
 /* #define DEBUG_RESTORE2 1 */
+#define DEBUG_RESTORE3 1
 #define errout Yap_stderr
 #endif
 
@@ -190,7 +191,7 @@ mark_atoms(void)
     return;
   }
   do {
-#ifdef DEBUG_RESTORE2		/* useful during debug */
+#ifdef DEBUG_RESTORE1		/* useful during debug */
     fprintf(errout, "Restoring %s\n", at->StrOfAE);
 #endif
     RestoreEntries(RepProp(at->PropsOfAE));
@@ -323,7 +324,7 @@ clean_atoms(void)
 	atm = at->NextOfAE;
 	NOfAtoms--;
       } else {
-#ifdef DEBUG_RESTORE2
+#ifdef DEBUG_RESTORE3
 	fprintf(stderr, "Purged %s\n", at->StrOfAE);
 #endif
 	*patm = at->NextOfAE;
@@ -343,7 +344,7 @@ clean_atoms(void)
       NOfAtoms--;
       atm = at->NextOfAE;
     } else {
-#ifdef DEBUG_RESTORE2
+#ifdef DEBUG_RESTORE1
       fprintf(stderr, "Purged %s\n", at->StrOfAE);
 #endif
       *patm = at->NextOfAE;
@@ -396,7 +397,6 @@ Yap_atom_gc(void)
 static Int
 p_atom_gc(void)
 {
-  return TRUE;
 #ifndef FIXED_STACKS
   atom_gc();
 #endif  /* FIXED_STACKS */

C/amasm.c

@@ -11,8 +11,12 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2005-05-25 21:43:32 $							 *
+* Last rev:     $Date: 2005-05-30 05:26:49 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.74  2005/05/25 21:43:32  vsc
+* fix compiler bug in 1 << X, found by Nuno Fonseca.
+* compiler internal errors get their own message.
+*
 * Revision 1.73  2005/04/10 04:01:09  vsc
 * bug fixes, I hope!
 *
@@ -2285,9 +2289,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 #endif	/* YAPOR */
   int log_update;
   int dynamic;
-#ifdef TABLING
   int tabled;
-#endif
   int ystop_found = FALSE;
   union clause_obj *cl_u;
   yamop *code_p;
@@ -2309,9 +2311,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
   /* Space while for the clause flags */
   log_update = cip->CurrentPred->PredFlags & LogUpdatePredFlag;
   dynamic = cip->CurrentPred->PredFlags & DynamicPredFlag;
-#ifdef TABLING
   tabled = cip->CurrentPred->PredFlags & TabledPredFlag;
-#endif
   if (assembling == ASSEMBLING_CLAUSE) {
     if (log_update) {
       if (pass_no) {
@@ -2359,11 +2359,17 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     }
     IPredArity = cip->cpc->rnd2;	/* number of args */
     *entry_codep = code_p;
+    if (tabled) {
+#if TABLING
+      printf("Here I go at %p\n", code_p);
+      code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p,ld), IPredArity, &clinfo, code_p, pass_no);
+#endif
+    }
     if (dynamic) {
 #ifdef YAPOR
-      a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, 1, 0, code_p, pass_no);
+      code_p = a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, 1, 0, code_p, pass_no);
 #else
-      a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, code_p, pass_no);
+      code_p = a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, code_p, pass_no);
 #endif	/* YAPOR */
     }
   } else {

C/index.c

@@ -11,8 +11,12 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-05-27 21:44:00 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-05-30 05:26:49 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.127  2005/05/27 21:44:00  vsc
+* Don't try to mess with sequences that don't end with a trust.
+* A fix for the atom garbage collector actually ignore floats ;-).
+*
 * Revision 1.126  2005/05/25 18:58:37  vsc
 * fix another bug in nth_instance, thanks to Pat Caldon
 *
@@ -2070,6 +2074,8 @@ add_info(ClauseDef *clause, UInt regno)
 #endif /* YAPOR */
 #ifdef TABLING
     case _table_try_single:
+      cl = NEXTOP(cl,ld);
+      break;      
     case _table_try_me:
     case _table_retry_me:
     case _table_trust_me:
@@ -3017,7 +3023,10 @@ static void
 emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses)
 {
   PredEntry *ap = cint->CurrentPred;
+  yamop *clcode = cl->Code;
 
+  if (ap->PredFlags & TabledPredFlag)
+    clcode = NEXTOP(clcode, ld);
   if (ap->PredFlags & ProfiledPredFlag) {
     Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
   }
@@ -3025,9 +3034,9 @@ emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses)
     Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
   }
   if (clauses == 0) {
-    Yap_emit(trust_op, (CELL)(cl->Code), has_cut(cl->CurrentCode) , cint);
+    Yap_emit(trust_op, (CELL)clcode, has_cut(cl->CurrentCode) , cint);
   } else {
-    Yap_emit(retry_op, (CELL)(cl->Code), (clauses << 1) | has_cut(cl->CurrentCode) , cint);
+    Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode) , cint);
     Yap_emit(jumpi_op, nxtlbl, Zero, cint);
   }
 }
@@ -3036,14 +3045,17 @@ static void
 emit_retry(ClauseDef *cl, struct intermediates *cint, int clauses)
 {
   PredEntry *ap = cint->CurrentPred;
+  yamop *clcode = cl->Code;
 
+  if (ap->PredFlags & TabledPredFlag)
+    clcode = NEXTOP(clcode, ld);
   if (ap->PredFlags & ProfiledPredFlag) {
     Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
   }
   if (ap->PredFlags & CountPredFlag) {
     Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
   }
-  Yap_emit(retry_op, (CELL)(cl->Code), (clauses << 1) | has_cut(cl->CurrentCode), cint);
+  Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode), cint);
 }
 
 static compiler_vm_op
@@ -3079,8 +3091,15 @@ emit_optry(int var_group, int first, int clauses, int clleft, PredEntry *ap)
 static void
 emit_try(ClauseDef *cl, struct intermediates *cint, int var_group, int first, int clauses, int clleft, UInt nxtlbl)
 {
+  PredEntry *ap = cint->CurrentPred;
+  yamop *clcode = cl->CurrentCode;
+
+  if (ap->PredFlags & TabledPredFlag) {
+    clcode = NEXTOP(cl->Code, ld);
+  }
+
   compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft, cint->CurrentPred);
-  Yap_emit(comp_op, (CELL)(cl->CurrentCode), ((clauses+clleft) << 1) | has_cut(cl->CurrentCode), cint);
+  Yap_emit(comp_op, (CELL)clcode, ((clauses+clleft) << 1) | has_cut(cl->CurrentCode), cint);
 }
 
 static TypeSwitch *
@@ -3377,19 +3396,14 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
 {
 #ifdef TABLING
   if (cint->CurrentPred->PredFlags & TabledPredFlag) {
-    /* we have two differences with tabling:
+    /* with tabling we don't clean trust at the very end of computation.
-       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) {
+    if (clleft == 0 && !first) {
       UInt lbl = new_label();
+
       Yap_emit(label_op, lbl, Zero, cint);
-      if (first) {
+      /* vsc: should check if this condition is sufficient */
-	Yap_emit(table_try_single_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode), cint);
-      } else {
       Yap_emit(trust_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode), cint);
-      }
       return lbl;
     }
   }

H/Yatom.h

@@ -1,10 +1,3 @@
-
-
-
-
-
-
-
 /*************************************************************************
 *									 *
 *	 YAP Prolog   %W% %G%

OPTYap/tab.insts.i

@@ -214,7 +214,8 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
       init_subgoal_frame(sg_fr);
       UNLOCK(SgFr_lock(sg_fr));
       store_generator_node(PREG->u.ld.s, COMPLETION, sg_fr);
-      PREG = PREG->u.ld.d;
+      /* PREG = PREG->u.ld.d; */
+	PREG = NEXTOP(PREG,ld);	
       PREFETCH_OP(PREG);
       allocate_environment(YENV);
       GONext();