bug fixes, I hope!

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

C/absmi.c

@@ -10,8 +10,14 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2005-04-07 17:48:53 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-04-10 04:01:07 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.162  2005/04/07 17:48:53  ricroc
+* Adding tabling support for mixed strategy evaluation (batched and local scheduling)
+*   UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure.
+*   NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default).
+*   NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local).
+*
 * Revision 1.161  2005/03/13 06:26:09  vsc
 * fix excessive pruning in meta-calls
 * fix Term->int breakage in compiler
@@ -7828,20 +7834,20 @@ Yap_absmi(int inp)
       ENDD(d0);
       ENDBOp();
 
-      BOp(jump_if_nonvar, xl);
+      BOp(jump_if_nonvar, xll);
       BEGD(d0);
-      d0 = XREG(PREG->u.xl.x);
+      d0 = XREG(PREG->u.xll.x);
       deref_head(d0, jump2_if_unk);
       /* non var */
     jump2_if_nonvar:
-      copy_jmp_address(PREG->u.xl.l);
+      copy_jmp_address(PREG->u.xll.l1);
-      PREG = PREG->u.xl.l;
+      PREG = PREG->u.xll.l1;
       JMPNext();
 
       BEGP(pt0);
       deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
       /* variable */
-      PREG = NEXTOP(PREG, xl);
+      PREG = NEXTOP(PREG, xll);
       ENDP(pt0);
       JMPNext();
       ENDD(d0);
@@ -11396,8 +11402,8 @@ Yap_absmi(int inp)
 	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
 	GONext();
       }	else if (d1  == 0) {
-	XREG(PREG->u.xxx.x) = d0;
+	XREG(PREG->u.xcx.x) = d0;
-	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
 	GONext();
       }	else {
 	saveregs();

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2005-03-04 20:30:10 $							 *
+* Last rev:     $Date: 2005-04-10 04:01:09 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.72  2005/03/04 20:30:10  ricroc
+* bug fixes for YapTab support
+*
 * Revision 1.71  2005/01/28 23:14:34  vsc
 * move to Yap-4.5.7
 * Fix clause size
@@ -1197,10 +1200,11 @@ a_xigl(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
 {
   if (pass_no) {
     code_p->opc = emit_op(opcode);
-    code_p->u.xl.x = emit_x(cpc->rnd2);
+    code_p->u.xll.x = emit_x(cpc->rnd2);
-    code_p->u.xl.l = emit_a(cpc->rnd1);
+    code_p->u.xll.l1 = emit_a(cpc->rnd1);
+    code_p->u.xll.l2 = NEXTOP(code_p,xll);
   }
-  GONEXT(xl);
+  GONEXT(xll);
   return code_p;
 }
 
@@ -1793,7 +1797,7 @@ a_fetch_vc(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
     Ventry *ve;
 
     cmp_info->c_type = TYPE_XC;
-    cmp_info->c_arg = (Int)(cip->cpc->rnd1);
+    cmp_info->c_arg = cip->cpc->rnd1;
     ve = (Ventry *) p->rnd1;
     if (ve->KindOfVE == PermVar) {
       /* don't get rid of get_val_op */
@@ -1820,7 +1824,7 @@ a_fetch_cv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
     Ventry *ve;
 
     cmp_info->c_type = TYPE_CX;
-    cmp_info->c_arg = (Int)(cip->cpc->rnd1);
+    cmp_info->c_arg = cip->cpc->rnd1;
     ve = (Ventry *) p->rnd1;
     if (ve->KindOfVE == PermVar) {
       /* don't get rid of get_val_op */

C/arrays.c

@@ -2011,6 +2011,35 @@ p_static_array_to_term(void)
   return(FALSE);
 }
 
+static Int
+p_static_array_location(void)
+{
+  Term t = Deref(ARG1);
+  Int *ptr;
+
+  if (IsVarTerm(t)) {
+    return FALSE;
+  } else if (IsAtomTerm(t)) {
+    /* Create a named array */
+    AtomEntry *ae = RepAtom(AtomOfTerm(t));
+    StaticArrayEntry *pp;
+
+    READ_LOCK(ae->ARWLock);
+    pp = RepStaticArrayProp(ae->PropsOfAE);
+    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
+      pp = RepStaticArrayProp(pp->NextOfPE);
+    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
+      READ_UNLOCK(ae->ARWLock);
+      return FALSE;
+    } else {
+      ptr =  pp->ValueOfVE.ints;
+      READ_UNLOCK(ae->ARWLock);
+    }
+    return Yap_unify(ARG2,MkIntegerTerm((Int)ptr));
+  }
+  return FALSE;
+}
+
 void 
 Yap_InitArrayPreds(void)
 {
@@ -2029,5 +2058,6 @@ Yap_InitArrayPreds(void)
   Yap_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$static_array_properties", 3, p_static_array_properties, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("static_array_to_term", 2, p_static_array_to_term, 0L);
+  Yap_InitCPred("static_array_location", 2, p_static_array_location, 0L);
 }
 

C/c_interface.c

@@ -10,8 +10,12 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2005-03-15 18:29:23 $,$Author: vsc $						 *
+* Last rev:	$Date: 2005-04-10 04:01:10 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.65  2005/03/15 18:29:23  vsc
+* fix GPL
+* fix idb: stuff in coroutines.
+*
 * Revision 1.64  2005/03/13 06:26:10  vsc
 * fix excessive pruning in meta-calls
 * fix Term->int breakage in compiler
@@ -1009,8 +1013,9 @@ YAP_Read(int (*mygetc)(void))
   Stream[sno].status = Free_Stream_f;
   if (Yap_ErrorMessage)
     {
-      save_machine_regs();
+      Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
-      return(0);
+      RECOVER_MACHINE_REGS();
+      return 0;
     }
   t = Yap_Parse();
   Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2005-03-04 20:30:11 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-04-10 04:01:10 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.154  2005/03/04 20:30:11  ricroc
+* bug fixes for YapTab support
+*
 * Revision 1.153  2005/02/25 03:39:44  vsc
 * fix fixes to undefp
 * fix bug where clause mistook cp for ap
@@ -752,8 +755,8 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
       break;
       /* instructions type xl */
     case _jump_if_nonvar:
-      release_wcls(ipc->u.xl.l, ecs);
+      release_wcls(ipc->u.xll.l1, ecs);
-      ipc = NEXTOP(ipc,xl);
+      ipc = NEXTOP(ipc,xll);
       break;
       /* instructions type e */
     case _switch_on_type:
@@ -2300,6 +2303,10 @@ p_setspy(void)
     return (FALSE);
   }
   if (pred->OpcodeOfPred == INDEX_OPCODE) {
+    int i = 0;
+    for (i = 0; i < pred->ArityOfPE; i++) {
+      XREGS[i+1] = MkVarTerm();
+    }
     IPred(pred, 0);
     goto restart_spy;
   }
@@ -4415,7 +4422,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$start_consult", 3, p_startconsult, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$show_consult_level", 1, p_showconslultlev, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$end_consult", 0, p_endconsult, SafePredFlag|SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred("$set_spy", 2, p_setspy, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$set_spy", 2, p_setspy, SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$rm_spy", 2, p_rmspy, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   /* gc() may happen during compilation, hence these predicates are
 	now unsafe */

C/compiler.c

@@ -11,8 +11,13 @@
 * File:		compiler.c						 *
 * comments:	Clause compiler						 *
 *									 *
-* Last rev:     $Date: 2005-03-13 06:26:10 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-04-10 04:01:10 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.64  2005/03/13 06:26:10  vsc
+* fix excessive pruning in meta-calls
+* fix Term->int breakage in compiler
+* improve JPL (at least it does something now for amd64).
+*
 * Revision 1.63  2005/03/04 20:30:11  ricroc
 * bug fixes for YapTab support
 *
@@ -813,19 +818,11 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
 	c_var(t1, v1, 0, 0, cglobs);
 	c_var(tn, v2, 0, 0, cglobs);
       /* it has to be either an integer or a floating point */
-      } else if (IsIntTerm(t2)) {
+      } else if (IsIntegerTerm(t2)) {
 	/* first temp */
 	Int v1 = --cglobs->tmpreg;
 
-	Yap_emit(fetch_args_vc_op, (CELL)IntOfTerm(t2), Zero, &cglobs->cint);
+	Yap_emit(fetch_args_vc_op, IntegerOfTerm(t2), Zero, &cglobs->cint);
-	/* these should be the arguments */
-	c_var(t1, v1, 0, 0, cglobs);
-	/* now we know where the arguments are */
-      } else if (IsLongIntTerm(t2)) {
-	/* first temp */
-	Int v1 = --cglobs->tmpreg;
-
-	Yap_emit(fetch_args_vc_op, (CELL)LongIntOfTerm(t2), Zero, &cglobs->cint);
 	/* these should be the arguments */
 	c_var(t1, v1, 0, 0, cglobs);
 	/* now we know where the arguments are */
@@ -1058,17 +1055,10 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
 	  /* now we know where the arguments are */
 	}
       }
-    } else if (IsIntTerm(t1)) {
+    } else if (IsIntegerTerm(t1)) {
       /* first temp */
       Int v1 = --cglobs->tmpreg;
-      Yap_emit(fetch_args_cv_op, (CELL)IntOfTerm(t1), Zero, &cglobs->cint);
+      Yap_emit(fetch_args_cv_op, IntegerOfTerm(t1), Zero, &cglobs->cint);
-      /* these should be the arguments */
-      c_var(t2, v1, 0, 0, cglobs);
-      /* now we know where the arguments are */
-    } else if (IsLongIntTerm(t1)) {
-      /* first temp */
-      Int v1 = --cglobs->tmpreg;
-      Yap_emit(fetch_args_cv_op, (CELL)LongIntOfTerm(t1), Zero, &cglobs->cint);
       /* these should be the arguments */
       c_var(t2, v1, 0, 0, cglobs);
       /* now we know where the arguments are */

C/dbase.c

@@ -1864,11 +1864,11 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code)
 
 
 static LogUpdClause *
-record_lu(PredEntry *pe, Term t, int position)
+new_lu_db_entry(Term t, PredEntry *pe)
 {
-  yamop *ipc;
   DBTerm *x;
   LogUpdClause *cl;
+  yamop *ipc;
   int needs_vars = FALSE;
   struct db_globs dbg;
 
@@ -1895,6 +1895,19 @@ record_lu(PredEntry *pe, Term t, int position)
     ipc->opc = Yap_opcode(_copy_idb_term);
   else
     ipc->opc = Yap_opcode(_unify_idb_term);
+
+  return cl;
+}
+
+
+static LogUpdClause *
+record_lu(PredEntry *pe, Term t, int position)
+{
+  LogUpdClause *cl;
+  
+  if ((cl = new_lu_db_entry(t, pe)) == NULL) {
+    return NULL;
+  }
   WRITE_LOCK(pe->PRWLock);
 #if defined(YAPOR) || defined(THREADS)
   WPP = pe;
@@ -1907,6 +1920,48 @@ record_lu(PredEntry *pe, Term t, int position)
   return cl;
 }
 
+static LogUpdClause *
+record_lu_at(int position, LogUpdClause *ocl, Term t)
+{
+  LogUpdClause *cl;
+  PredEntry *pe;
+
+  LOCK(ocl->ClLock);
+  pe = ocl->ClPred;
+  if ((cl = new_lu_db_entry(t,pe)) == NULL) {
+    return NULL;
+  }
+  WRITE_LOCK(pe->PRWLock);
+  Yap_RemoveIndexation(pe);
+  if (position == MkFirst) {
+    /* add before current clause */
+    cl->ClNext = ocl;
+    if (ocl->ClCode == pe->cs.p_code.FirstClause) {
+      cl->ClPrev = NULL;
+      pe->cs.p_code.FirstClause = cl->ClCode;
+    } else {
+      cl->ClPrev = ocl->ClPrev;
+      ocl->ClPrev->ClNext = cl;
+    }
+    ocl->ClPrev = cl;
+  } else {
+    /* add after current clause */
+    cl->ClPrev = ocl;
+    if (ocl->ClCode == pe->cs.p_code.LastClause) {
+      cl->ClNext = NULL;
+      pe->cs.p_code.LastClause = cl->ClCode;
+    } else {
+      cl->ClNext = ocl->ClNext;
+      ocl->ClNext->ClPrev = cl;
+    }
+    ocl->ClNext = cl;
+  }
+  pe->cs.p_code.NOfClauses++;
+  WRITE_UNLOCK(pe->PRWLock);
+  UNLOCK(ocl->ClLock);
+  return cl;
+}
+
 
 /* recorda(+Functor,+Term,-Ref) */
 static Int 
@@ -1973,12 +2028,13 @@ p_rcdap(void)
   return Yap_unify(ARG3, TRef);
 }
 
-/* recorda_at(+Functor,+Term,-Ref) */
+/* recorda_at(+DBRef,+Term,-Ref) */
 static Int 
 p_rcda_at(void)
 {
   /* Idiotic xlc's cpp does not work with ARG1 within MkDBRefTerm */
   Term            TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
+  DBRef           dbr;
 
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
@@ -1992,7 +2048,16 @@ p_rcda_at(void)
   }
   Yap_Error_Size = 0;
  restart_record:
-  TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
+  dbr = DBRefOfTerm(t1);
+  if (dbr->Flags & ErasedMask) {
+    /* doesn't make sense */ 
+    return FALSE;
+  }
+  if (dbr->Flags & LogUpdMask) {
+    TRef = MkDBRefTerm((DBRef)record_lu_at(MkFirst, (LogUpdClause *)dbr, t2));
+  } else { 
+    TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
+  }
   if (Yap_Error_TYPE != YAP_NO_ERROR) {
     if (recover_from_record_error(3)) {
       t1 = Deref(ARG1);
@@ -2100,6 +2165,7 @@ p_rcdz_at(void)
 {
   /* Idiotic xlc's cpp does not work with ARG1 within MkDBRefTerm */
   Term            TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
+  DBRef           dbr;
 
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
@@ -2113,7 +2179,16 @@ p_rcdz_at(void)
   }
   Yap_Error_Size = 0;
  restart_record:
-  TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0)));
+  dbr = DBRefOfTerm(t1);
+  if (dbr->Flags & ErasedMask) {
+    /* doesn't make sense */ 
+    return FALSE;
+  }
+  if (dbr->Flags & LogUpdMask) {
+    TRef = MkDBRefTerm((DBRef)record_lu_at(MkLast, (LogUpdClause *)dbr, t2));
+  } else {
+    TRef = MkDBRefTerm(record_at(MkLast, dbr, t2, Unsigned(0)));
+  }
   if (Yap_Error_TYPE != YAP_NO_ERROR) {
     if (recover_from_record_error(3)) {
       t1 = Deref(ARG1);

C/exec.c

@@ -1296,7 +1296,7 @@ Yap_RunTopGoal(Term t)
   if (Yap_TrailTop - HeapTop < 2048) {
     Yap_PrologMode = BootMode;
     Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,
-	  "unable to boot because of too little heap space");
+	  "unable to boot because of too little Trail space");
   }
 #endif
   goal_out = do_goal(t, CodeAdr, arity, pt, TRUE);

C/index.c

@@ -11,8 +11,14 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-04-07 17:48:54 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-04-10 04:01:12 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.121  2005/04/07 17:48:54  ricroc
+* Adding tabling support for mixed strategy evaluation (batched and local scheduling)
+*   UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure.
+*   NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default).
+*   NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local).
+*
 * Revision 1.120  2005/03/15 18:29:23  vsc
 * fix GPL
 * fix idb: stuff in coroutines.
@@ -526,8 +532,7 @@ sort_group(GroupDef *grp, CELL *top, struct intermediates *cint)
     longjmp(cint->CompilerBotch,4);
 #else
     if (!Yap_growtrail(2*max*CellSize, TRUE)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld in growtrail",
+      longjmp(cint->CompilerBotch,4);
-		2*max*CellSize);
       return;
     }
 #endif
@@ -689,7 +694,7 @@ has_cut(yamop *pc)
       pc = NEXTOP(pc,l);
       break;
     case _jump_if_nonvar:
-      pc = NEXTOP(pc,xl);
+      pc = NEXTOP(pc,xll);
       break;
       /* instructions type EC */
     case _alloc_for_logical_pred:
@@ -4655,17 +4660,17 @@ expand_index(struct intermediates *cint) {
       }
       break;
     case _jump_if_nonvar:
-      argno = arg_from_x(ipc->u.xl.x);
+      argno = arg_from_x(ipc->u.xll.x);
       t = Deref(XREGS[argno]);
       i = 0;
       /* expand_index expects to find the new argument */
       if (!IsVarTerm(t)) {
 	argno--;
 	olabp = NULL;
-	labp = &(ipc->u.xl.l);
+	labp = &(ipc->u.xll.l1);
-	ipc = ipc->u.xl.l;
+	ipc = ipc->u.xll.l1;
       } else {
-	ipc = NEXTOP(ipc,xl);
+	ipc = NEXTOP(ipc,xll);
       }
       break;
       /* instructions type EC */
@@ -4911,7 +4916,8 @@ expand_index(struct intermediates *cint) {
   if (Yap_op_from_opcode((*labp)->opc) == _expand_clauses) {
     /* ok, we know how many clauses */
     yamop *ipc = *labp;
-    COUNT nclauses = ipc->u.sp.s2;
+    /* check all slots, not just the ones with values */
+    COUNT nclauses = ipc->u.sp.s1;
     yamop **clp = (yamop **)NEXTOP(ipc,sp);
 
     eblk = cint->expand_block = ipc;
@@ -5516,7 +5522,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
   start = blk->ClCode;
   op0 = Yap_op_from_opcode(start->opc);
   while (op0 == _jump_if_nonvar) {
-    start = NEXTOP(start, xl);
+    start = NEXTOP(start, xll);
     op0 = Yap_op_from_opcode(start->opc);
   }
   if ((op0 != _enter_lu_pred && op0 != _stale_lu_index)
@@ -5828,7 +5834,7 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
   
   while (op == _jump_if_nonvar) {
     jnvs++;
-    begin = NEXTOP(begin, xl);
+    begin = NEXTOP(begin, xll);
     op = Yap_op_from_opcode(begin->opc);
   }
   /* add half the current space plus 1, and also the extra clause */
@@ -5844,13 +5850,13 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
     sz = sizeof(LogUpdIndex)+
       (xcls-1)*((UInt)NEXTOP((yamop *)NULL,l))+
       ((UInt)NEXTOP((yamop *)NULL,ld))+
-      jnvs*((UInt)NEXTOP((yamop *)NULL,xl))+
+      jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
       (UInt)NEXTOP((yamop *)NULL,Ill)+
       (UInt)NEXTOP((yamop *)NULL,p);
   } else {
     sz = sizeof(LogUpdIndex)+
       xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
-      jnvs*((UInt)NEXTOP((yamop *)NULL,xl))+
+      jnvs*((UInt)NEXTOP((yamop *)NULL,xll))+
       (UInt)NEXTOP((yamop *)NULL,Ill)+
       (UInt)NEXTOP((yamop *)NULL,p);
   }
@@ -5891,16 +5897,17 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
   begin = blk->ClCode;
   while (jnvs--) {
     nbegin->opc = begin->opc;
-    nbegin->u.xl.x = begin->u.xl.x;
+    nbegin->u.xll.x = begin->u.xll.x;
-    nbegin->u.xl.l = begin->u.xl.l;
+    nbegin->u.xll.l1 = begin->u.xll.l1;
-    if (nbegin->u.xl.l->opc == Yap_opcode(_expand_clauses)) {
+    nbegin->u.xll.l2 = NEXTOP(nbegin,xll);
+    if (nbegin->u.xll.l1->opc == Yap_opcode(_expand_clauses)) {
       if (!(blk->ClFlags & ErasedMask)) {
 	/* we haven't done erase yet */
-	nbegin->u.xl.l->u.sp.s3++;
+	nbegin->u.xll.l1->u.sp.s3++;
       }
     }
-    begin = NEXTOP(begin, xl);
+    begin = NEXTOP(begin, xll);
-    nbegin = NEXTOP(nbegin, xl);
+    nbegin = NEXTOP(nbegin, xll);
   }
   codep = start = nbegin;
   /* ok, we've allocated and set up things, now let's finish */
@@ -5991,7 +5998,7 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
     UInt ncls;
 
     while (op == _jump_if_nonvar) {
-      codep = NEXTOP(codep, xl);
+      codep = NEXTOP(codep, xll);
       op = Yap_op_from_opcode(codep->opc);
     }
     ncls = codep->u.Ill.s;
@@ -6011,7 +6018,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
 
   /* make sure this is something I can work with */
   while (op == _jump_if_nonvar) {
-    begin = NEXTOP(begin, xl);
+    begin = NEXTOP(begin, xll);
     op = Yap_op_from_opcode(begin->opc);
   }
   if (op != _enter_lu_pred && op != _stale_lu_index) {
@@ -6115,7 +6122,7 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
 
   /* make sure this is something I can work with */
   while (op == _jump_if_nonvar) {
-    begin = NEXTOP(begin, xl);
+    begin = NEXTOP(begin, xll);
     op = Yap_op_from_opcode(begin->opc);
   }
   if (op != _enter_lu_pred && op != _stale_lu_index) {
@@ -6524,8 +6531,9 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
       ipc = NEXTOP(ipc,l);
       break;
     case _jump_if_nonvar:
-      sp = push_path(sp, &(ipc->u.xl.l), cls, cint);
+      sp = push_path(sp, &(ipc->u.xll.l2), cls, cint);
-      ipc = NEXTOP(ipc,xl);
+      sp = cross_block(sp, &ipc->u.xll.l1, ap);
+      ipc = ipc->u.xll.l1;
       break;
       /* instructions type EC */
     case _try_in:
@@ -7090,8 +7098,9 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
       ipc = NEXTOP(ipc,l);
       break;
     case _jump_if_nonvar:
-      sp = push_path(sp, &(ipc->u.xl.l), cls, cint);
+      sp = push_path(sp, &(ipc->u.xll.l2), cls, cint);
-      ipc = NEXTOP(ipc,xl);
+      sp = cross_block(sp, &ipc->u.xll.l1, ap);
+      ipc = ipc->u.xll.l1;
       break;
       /* instructions type e */
     case _switch_on_type:
@@ -7769,12 +7778,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
       break;
     case _jump_if_nonvar:
       {
-	Term t = Deref(XREGS[arg_from_x(ipc->u.xl.x)]);
+	Term t = Deref(XREGS[arg_from_x(ipc->u.xll.x)]);
 	if (!IsVarTerm(t)) {
-	  jlbl = &(ipc->u.xl.l);
+	  jlbl = &(ipc->u.xll.l1);
-	  ipc = ipc->u.xl.l;
+	  ipc = ipc->u.xll.l1;
 	} else {
-	  ipc = NEXTOP(ipc,xl);
+	  ipc = NEXTOP(ipc,xll);
 	}
       }
       break;
@@ -8161,7 +8170,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
       ipc = ipc->u.l.l;
       break;
     case _jump_if_nonvar:
-      ipc = NEXTOP(ipc,xl);
+      ipc = NEXTOP(ipc,xll);
       break;
       /* instructions type e */
     case _switch_on_type:
@@ -8269,10 +8278,10 @@ find_caller(PredEntry *ap, yamop *code, struct intermediates *cint) {
       }
       break;
     case _jump_if_nonvar:
-      if (!IsVarTerm(XREGS[arg_from_x(ipc->u.xllll.x)])) {
+      if (!IsVarTerm(XREGS[arg_from_x(ipc->u.xll.x)])) {
-	ipc = ipc->u.xl.l;
+	ipc = ipc->u.xll.l1;
       } else {
-	ipc = NEXTOP(ipc,xl);
+	ipc = NEXTOP(ipc,xll);
       }
       break;
       /* instructions type EC */
@@ -8507,7 +8516,7 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
     op_numbers op = Yap_op_from_opcode(start->opc);
 
     while (op == _jump_if_nonvar) {
-      start = NEXTOP(start, xl);
+      start = NEXTOP(start, xll);
       op = Yap_op_from_opcode(start->opc);
     }
     codep = start->u.Ill.l1;

H/YapOpcodes.h

@@ -11,8 +11,11 @@
 * File:		YapOpcodes.h						 *
 * comments:	Central Table with all YAP opcodes                       *
 *									 *
-* Last rev:     $Date: 2004-10-26 20:16:04 $							 *
+* Last rev:     $Date: 2005-04-10 04:01:13 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.25  2004/10/26 20:16:04  vsc
+* More bug fixes for overflow handling
+*
 * Revision 1.24  2004/09/27 20:45:04  vsc
 * Mega clauses
 * Fixes to sizeof(expand_clauses) which was being overestimated
@@ -183,7 +186,7 @@
     OPCODE(trust                   ,ld),		
     OPCODE(try_in                  ,l),
     OPCODE(jump_if_var             ,l),	
-    OPCODE(jump_if_nonvar          ,xl),	
+    OPCODE(jump_if_nonvar          ,xll),	
     OPCODE(switch_on_cons          ,sssl),	
     OPCODE(switch_on_type          ,llll),	
     OPCODE(switch_list_nl          ,ollll),

H/amidefs.h

@@ -11,8 +11,11 @@
 * File:		amidefs.h						 *
 * comments:	Abstract machine peculiarities				 *
 *									 *
-* Last rev:     $Date: 2004-09-30 21:37:41 $							 *
+* Last rev:     $Date: 2005-04-10 04:01:13 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.26  2004/09/30 21:37:41  vsc
+* fixes for thread support
+*
 * Revision 1.25  2004/09/27 20:45:04  vsc
 * Mega clauses
 * Fixes to sizeof(expand_clauses) which was being overestimated
@@ -476,9 +479,10 @@ typedef struct yami {
        } xF;
        struct {
 	 wamreg                x;
-	 struct yami	       *l;
+	 struct yami	       *l1;
+	 struct yami	       *l2;
 	 CELL next;
-       } xl; 
+       } xll; 
       struct {
 	 wamreg                xl;
 	 wamreg                xr;

H/clause.h

@@ -256,7 +256,7 @@ same_lu_block(yamop **paddr, yamop *p)
     OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
 
     while (np->opc == jmp_op) {
-      np = NEXTOP(np, xl);
+      np = NEXTOP(np, xll);
       if (np == p) return TRUE;
     }
     return FALSE;

H/rclause.h

@@ -12,8 +12,13 @@
 * File:		rclause.h						 *
 * comments:	walk through a clause					 *
 *									 *
-* Last rev:     $Date: 2005-01-04 02:50:21 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-04-10 04:01:13 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.1  2005/01/04 02:50:21  vsc
+* - allow MegaClauses with blobs
+* - change Diffs to be thread specific
+* - include Christian's updates
+*
 * Revision 1.47  2004/12/02 06:06:47  vsc
 * fix threads so that they at least start
 * allow error handling to work with threads
@@ -166,9 +171,10 @@ restore_opcodes(yamop *pc)
       break;
       /* instructions type EC */
     case _jump_if_nonvar:
-      pc->u.xl.l = PtoOpAdjust(pc->u.xl.l);
+      pc->u.xll.l1 = PtoOpAdjust(pc->u.xll.l1);
-      pc->u.xl.x = XAdjust(pc->u.xl.x);
+      pc->u.xll.l2 = PtoOpAdjust(pc->u.xll.l2);
-      pc = NEXTOP(pc,xl);
+      pc->u.xll.x = XAdjust(pc->u.xll.x);
+      pc = NEXTOP(pc,xll);
       break;
       /* instructions type EC */
     case _alloc_for_logical_pred:

LGPL/JPL/src/jpl.c

@@ -1,4 +1,4 @@
-/*  $Id: jpl.c,v 1.3 2005-03-15 18:29:24 vsc Exp $
+/*  $Id: jpl.c,v 1.4 2005-04-10 04:01:13 vsc Exp $
 
     Part of JPL -- SWI-Prolog/Java interface
 
@@ -1740,8 +1740,8 @@ jni_fetch_buffer_value_plc(
 	    &&	PL_unify_float(tv1,((jfloat*)bp)[i]);
 
     case JNI_XPUT_DOUBLE:
-	return	PL_unify_integer(tv2,((int*)&((jdouble*)bp)[i])[1])
+	return	PL_unify_integer(tv2,0)
-	    &&	PL_unify_integer(tv1,((int*)&((jdouble*)bp)[i])[0]);
+	    &&	YAP_Unify(YAP_GetFromSlot(tv1),YAP_MkFloatTerm(((jdouble*)bp)[i]));
     default:
 	return	FALSE;
 	}
@@ -2170,6 +2170,35 @@ jni_void_2_plc(
     }
 
 
+/*
+%T jni_SetByteArrayElement(+term, +term, +term)
+ */
+static foreign_t
+jni_SetByteArrayElement(
+    term_t	ta1,	// +Arg1
+    term_t	ta2,	// +Arg2
+    term_t	ta3	// +Arg3
+    )
+    {
+      jboolean	r;	// Prolog exit/fail outcome
+      jbyteArray p1;
+      jint i2;
+      jbyte i3;
+
+      if	(   !jni_ensure_jvm()	)
+	{
+	  return FALSE;
+	}
+      r = 
+	JNI_term_to_byte_jarray(env,ta1,&p1)
+	&& JNI_term_to_jint(ta2,&i2)
+	&& JNI_term_to_jbyte(ta3,&i3)
+	&& ( (*env)->SetByteArrayRegion(env,p1,i2,1,&i3) , TRUE );
+
+      return jni_check_exception() && r;
+
+    }
+
 /*
 %T jni_void( +integer, +term, +term, +term)
  */
@@ -3865,6 +3894,7 @@ PL_extension predspecs[] =
       { "jni_func",			 4, jni_func_2_plc,		       0 },
       { "jni_func",			 5, jni_func_3_plc,		       0 },
       { "jni_func",			 6, jni_func_4_plc,		       0 },
+      { "jni_SetByteArrayElement",	 3, jni_SetByteArrayElement,	       0 },
       { "jpl_c_lib_version",		 1, jpl_c_lib_version_1_plc,	       0 },
       { "jpl_c_lib_version",		 4, jpl_c_lib_version_4_plc,	       0 },
       { NULL,				 0, NULL,			       0 }

configure

@@ -2263,7 +2263,7 @@ if test "${enable_dynamic_loading+set}" = set; then
 else
   dynamic_loading=no
 fi;
-# Check whether --enable-use_malloc or --disable-use_malloc was given.
+# Check whether --enable-use-malloc or --disable-use-malloc was given.
 if test "${enable_use_malloc+set}" = set; then
   enableval="$enable_use_malloc"
   use_malloc="$enableval"
@@ -2318,13 +2318,13 @@ if test "${with_jpl+set}" = set; then
   if test "$withval" = yes; then
 		yap_cv_jpl="$JAVA_HOME"
 		dynamic_loading=yes
-		threads=yes
+		maxmemory=yes
 	elif test "$withval" = no; then
 		yap_cv_jpl=no
 	else
 		yap_cv_jpl=$with_jpl
 		dynamic_loading=yes
-		threads=yes
+		maxmemory=yes
 	fi
 else
   yap_cv_jpl=no

configure.in

@@ -1,4 +1,4 @@
-dnl
+Mdnl
 dnl Process this file with autoconf to produce a configure script.
 dnl
 
@@ -57,7 +57,7 @@ AC_ARG_ENABLE(cygwin,
 AC_ARG_ENABLE(dynamic_loading,
 	[ --enable-dynamic-loading    compile Yap as a DLL ],
 	dynamic_loading="$enableval", dynamic_loading=no)
-AC_ARG_ENABLE(use_malloc,
+AC_ARG_ENABLE(use-malloc,
 	[ --enable-use-malloc    use malloc to allocate memory ],
 	use_malloc="$enableval", use_malloc=no)
 AC_ARG_ENABLE(condor,
@@ -90,13 +90,15 @@ AC_ARG_WITH(jpl,
 	if test "$withval" = yes; then
 		yap_cv_jpl="$JAVA_HOME"
 		dynamic_loading=yes
-		threads=yes
+		maxmemory=yes
+dnl		threads=yes
 	elif test "$withval" = no; then
 		yap_cv_jpl=no
 	else
 		yap_cv_jpl=$with_jpl
 		dynamic_loading=yes
-		threads=yes
+		maxmemory=yes
+dnl		threads=yes
 	fi,
 	[yap_cv_jpl=no])
 

console/yap.c

@@ -250,7 +250,7 @@ static int
 parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
 {
   char *p;
-#if SUPPORT_CONDOR||SUPPORT_THREADS
+#if USE_SYSTEM_MALLOC
   int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
 #else
   int BootMode = YAP_BOOT_FROM_SAVED_CODE;

distribute

@@ -83,7 +83,7 @@ cd examples
 splat
 cd ../../../..
 if test "$1" = "--small"; then
-  tar cvzf  "$version"-small.tar.gz --exclude=CVS --exclude=CHR/chr/examples --exclude=CLPQR/clpqr/examples "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,OPTYap,CLPQR,CHR,CLPBN}
+  tar cvzf  "$version"-small.tar.gz --exclude=CVS  "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/jpl_paths.yap.in,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,OPTYap,CLPQR,CHR,CLPBN} # --exclude=CLPQR/clpqr/examples  --exclude=CHR/chr/examples
 else
   tar cvzf "$version".tar.gz --exclude=CVS  "$version"/{Artistic,INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,LGPL/JPL/jpl.yap,LGPL/JPL/Makefile.in,LGPL/JPL/java,LGPL/JPL/src,build-distr,build-distr,OPTYap,CLPQR,CHR,CLPBN,Logtalk}
 fi

docs/yap.tex

@@ -5959,6 +5959,13 @@ must be an atom (named array). The @var{Size} must evaluate to an
 integer.  The @var{Type} must be bound to one of types mentioned
 previously.
 
+@item static_array_location(+@var{Name}, -@var{Ptr})
+@findex static_array_location/4
+@snindex static_array_location/4
+@cnindex static_array_location/4
+Give the location for  a static array with name
+@var{Name}.
+
 @item static_array_properties(?@var{Name}, ?@var{Size}, ?@var{Type})
 @findex static_array_properties/3
 @snindex static_array_properties/3

library/swi.yap

@@ -52,11 +52,11 @@ do_volatile(_,_).
 
 :- use_module(library(lists)).
 
-absolute_file_name(jar(File), Opts, Path) :- !,
+absolute_file_name(jar(File), _Opts, Path) :- !,
 	absolute_file_name(library(File), Path).
-absolute_file_name(library(File), Opts, Path) :- !,
+absolute_file_name(library(File), _Opts, Path) :- !,
 	absolute_file_name(library(File), Path).
-absolute_file_name(File, Opts, Path) :-
+absolute_file_name(File, _Opts, Path) :-
 	absolute_file_name(File, Path).
 
 
@@ -94,7 +94,7 @@ do_forall(X,Y) :-
 do_forall(_,_).
 
 do_for_forall(Y) :- call(Y), !, fail.
-do_for_forall(Y) :- throw(fail_forall).
+do_for_forall(_) :- throw(fail_forall).
 
 between(I,_,I).
 between(I0,I,J) :- I0 < I,