more fixes for expand_clauses

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

C/cdmgr.c

@@ -11,8 +11,12 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2004-04-14 19:10:23 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-04-27 15:03:43 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.118  2004/04/14 19:10:23  vsc
+* expand_clauses: keep a list of clauses to expand
+* fix new trail scheme for multi-assignment variables
+*
 * Revision 1.117  2004/04/07 22:04:03  vsc
 * fix memory leaks
 *
@@ -278,9 +282,23 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc)
   }
 }
 
+static void
+release_wcls(yamop *cop, OPCODE ecs)
+{
+  if (cop->opc == ecs) {
+    cop->u.sp.s3--;
+    if (!cop->u.sp.s3) {
+      Yap_FreeCodeSpace((char *)cop);
+    }
+  }
+}
+
+
 static void
 cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code)
 {
+  OPCODE ecs = Yap_opcode(_expand_clauses);
+
   while (ipc < end) {
     op_numbers op = Yap_op_from_opcode(ipc->opc);
     /* printf("op: %d %p->%p\n", op, ipc, end); */
@@ -339,23 +357,41 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
     case _trust_logical_pred:
     case _jump:
     case _jump_if_var:
+      release_wcls(ipc->u.l.l, ecs);
       ipc = NEXTOP(ipc,l);
       break;
       /* instructions type xl */
     case _jump_if_nonvar:
+      release_wcls(ipc->u.xl.l, ecs);
       ipc = NEXTOP(ipc,xl);
       break;
       /* instructions type e */
     case _switch_on_type:
       ipc = NEXTOP(ipc,llll);
+      release_wcls(ipc->u.llll.l1, ecs);
+      release_wcls(ipc->u.llll.l2, ecs);
+      release_wcls(ipc->u.llll.l3, ecs);
+      release_wcls(ipc->u.llll.l4, ecs);
       break;
     case _switch_list_nl:
+      release_wcls(ipc->u.ollll.l1, ecs);
+      release_wcls(ipc->u.ollll.l2, ecs);
+      release_wcls(ipc->u.ollll.l3, ecs);
+      release_wcls(ipc->u.ollll.l4, ecs);
       ipc = NEXTOP(ipc,ollll);
       break;
     case _switch_on_arg_type:
+      release_wcls(ipc->u.xllll.l1, ecs);
+      release_wcls(ipc->u.xllll.l2, ecs);
+      release_wcls(ipc->u.xllll.l3, ecs);
+      release_wcls(ipc->u.xllll.l4, ecs);
       ipc = NEXTOP(ipc,xllll);
       break;
     case _switch_on_sub_arg_type:
+      release_wcls(ipc->u.sllll.l1, ecs);
+      release_wcls(ipc->u.sllll.l2, ecs);
+      release_wcls(ipc->u.sllll.l3, ecs);
+      release_wcls(ipc->u.sllll.l4, ecs);
       ipc = NEXTOP(ipc,sllll);
       break;
     case _if_not_then:
@@ -399,12 +435,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
       yamop *cop;
       cop = (yamop *)beg[1];
       beg += 2;
-      if (cop->opc == ecs) {
+      release_wcls(cop, ecs);
-	cop->u.sp.s3--;
-	if (!cop->u.sp.s3) {
-	  Yap_FreeCodeSpace((char *)cop);
-	}
-      }
     }
     return;
   }

C/index.c

@@ -11,8 +11,12 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2004-04-22 03:24:17 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-04-27 15:03:43 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.88  2004/04/22 03:24:17  vsc
+* trust_logical should protect the last clause, otherwise it cannot
+* jump there.
+*
 * Revision 1.87  2004/04/21 04:01:53  vsc
 * fix bad ordering when inserting second clause
 *
@@ -2874,7 +2878,7 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
     cint->expand_block->u.sp.s3++;
     return (UInt)(cint->expand_block);
   }
-  if (cls < tcls/8) {
+  if (cls < tcls/8 && FALSE) {
     yamop *ncode;
     yamop **st;
     UInt sz = (UInt)(NEXTOP((yamop *)NULL,sp)+cls*sizeof(yamop *));
@@ -3299,6 +3303,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
       }
       if (argno == ap->ArityOfPE) {
 	do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0);
+	cint->expand_block = eblk;
 	return lablx;
       }
       argno++;
@@ -4391,7 +4396,7 @@ expand_index(struct intermediates *cint) {
 #endif
     if (cls+2*nclauses > (ClauseDef *)(ASP-4096)) {
       /* tell how much space we need (worst case) */
-      Yap_Error_Size += NClauses*sizeof(ClauseDef);
+      Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
       /* grow stack */
       recover_from_failed_susp_on_cls(cint, 0);
       longjmp(cint->CompilerBotch,3);
@@ -4405,7 +4410,7 @@ expand_index(struct intermediates *cint) {
     cint->expand_block = NULL;
     if (cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
       /* tell how much space we need (worst case) */
-      Yap_Error_Size += NClauses*sizeof(ClauseDef);
+      Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
       /* grow stack */
       recover_from_failed_susp_on_cls(cint, 0);
       longjmp(cint->CompilerBotch,3);
@@ -5611,10 +5616,9 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
   path_stack_entry *sp = *spp;
   yamop **clar = (yamop **)NEXTOP(ipc,sp);
 
-  while ((--sp)->flag != block_entry);
   if (first) {
     if (*clar == NULL) {
-      while (*clar++ == NULL);
+      while (*clar == NULL) clar++;
       if (clar[0] != cls->Code) {
 	clar[-1] = cls->Code;
 	ipc->u.sp.s2++;
@@ -5623,21 +5627,21 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
     }
   } else {
     clar += ipc->u.sp.s1;
-    while (*--clar == NULL);
+    if (clar[-1] == NULL) {
-    if (clar[0] == NULL) {
+      while (*--clar == NULL);
-      if (clar[-1] != cls->Code) {
+      if (clar[0] != cls->Code) {
-	clar[0] = cls->Code;
+	clar[1] = cls->Code;
 	ipc->u.sp.s2++;
       }
       return pop_path(spp, cls, ap);
     }
   }
+  while ((--sp)->flag != block_entry);
   if (sp->u.cle.entry_code) {
     *sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
   }
-  *spp = sp;
   recover_ecls_block(ipc);
-  return (yamop *)&(ap->cs.p_code.ExpandCode);
+  return pop_path(spp, cls, ap);
 }
 
 /* this code should be called when we jumped to clauses */

pl/preds.yap

@@ -306,12 +306,12 @@ clause(V,Q,R) :-
 	M0 = M,
 	instance(R,T),
 	( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
-'$clause'(V,M,Q,_) :- var(V), !, 
+'$clause'(V,M,Q,R) :- var(V), !, 
-	'$do_error'(instantiation_error,M:clause(V,Q)).
+	'$do_error'(instantiation_error,clause(M:V,Q,R)).
-'$clause'(C,M,Q,_) :- number(C), !,
+'$clause'(C,M,Q,R) :- number(C), !,
-	'$do_error'(type_error(callable,C),M:clause(C,Q)).
+	'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
-'$clause'(R,M,Q,_) :- db_reference(R), !,
+'$clause'(R,M,Q,R) :- db_reference(R), !,
-	'$do_error'(type_error(callable,R),M:clause(R,Q)).
+	'$do_error'(type_error(callable,R),clause(M:R,Q,R)).
 '$clause'(M:P,_,Q,R) :- !,
 	'$clause'(P,M,Q,R).
 '$clause'(P,M,Q,R) :-
@@ -323,13 +323,13 @@ clause(V,Q,R) :-
 '$clause'(P,M,Q,R) :-
 	'$some_recordedp'(M:P), !,
 	'$recordedp'(M:P,(P:-Q),R).
-'$clause'(P,M,Q,_) :-
+'$clause'(P,M,Q,R) :-
 	\+ '$undefined'(P,M),
 	( '$system_predicate'(P,M) -> true ;
 	    '$number_of_clauses'(P,M,N), N > 0 ),
 	functor(P,Name,Arity),
 	'$do_error'(permission_error(access,private_procedure,Name/Arity),
-	      clause(M:P,Q)).
+	      clause(M:P,Q,R)).
 
 % just create a choice-point
 '$do_log_upd_clause'(_,_,_,_,_).