fixes for thread support

fix indexing bug (serious)


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

C/bignum.c

@@ -186,6 +186,10 @@ Yap_MkBigIntTerm(MP_INT *big)
     ret[0] = (CELL)FunctorBigInt;
     memmove((void *)new, (const void *)(big->_mp_d), nlimbs*CellSize);
     H = (CELL *)(new+nlimbs);
+    if ((char *)H-(char *)ret > MAX_SPECIALS_TAG-EndSpecials) {
+      /* too large */
+      return TermNil;
+    }
 #if GC_NO_TAGS
     H[0] = (H-ret)*sizeof(CELL)+EndSpecials;
 #else

C/grow.c

@@ -1022,7 +1022,10 @@ execute_growstack(long size0, int from_trail)
     MoveLocalAndTrail();
   }
   if (GDiff) {
+#if !USE_SYSTEM_MALLOC
+    /* That is done by realloc */
     MoveGlobal();
+#endif
     AdjustStacksAndTrail();
     AdjustRegs(MaxTemps);
 #ifdef TABLING

C/heapgc.c

@@ -1000,7 +1000,9 @@ check_global(void) {
 
     if (MARKED_PTR(current)) {
       CELL ccell = UNMARK_CELL(ccurr);
-      if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)) {
+      if (
+	  ccell < MAX_SPECIALS_TAG &&  /* two first pages */
+	  ccell > EndSpecials && IsVarTerm(ccell)) {
 	/* oops, we found a blob */
 	int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
 	CELL *ptr = current - nofcells ;
@@ -2305,11 +2307,13 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
 		 (long int)(hp_erased*100/(hp_erased+hp_in_use_erased)),
 		 (long int)(hp_erased+hp_in_use_erased));
 #endif
+#if !USE_SYSTEM_MALLOC
     fprintf(Yap_stderr,
-	       "%%       Heap: recovered %ld bytes (%ld%%) out of %ld\n",
+	    "%%       Heap: recovered %ld bytes (%ld%%) out of %ld\n",
-	       (unsigned long int)(OldHeapUsed-HeapUsed),
+	    (unsigned long int)(OldHeapUsed-HeapUsed),
-	       (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)),
+	    (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)),
-	       (unsigned long int)OldHeapUsed);
+	    (unsigned long int)OldHeapUsed);
+#endif
   }
   {
     DeadClause **cptr;
@@ -2838,7 +2842,9 @@ compact_heap(void)
   for (current = H - 1; current >= H0; current--) {
     if (MARKED_PTR(current)) {
       CELL ccell = UNMARK_CELL(*current);
-      if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)
+      if (
+	  ccell < MAX_SPECIALS_TAG &&  /* two first pages */
+	  ccell > EndSpecials && IsVarTerm(ccell)
 	  ) {
 	/* oops, we found a blob */
 	int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
@@ -2927,7 +2933,9 @@ compact_heap(void)
     CELL ccur = *current;
     if (MARKED_PTR(current)) {
       CELL uccur = UNMARK_CELL(ccur);
-      if (uccur < (CELL)AtomBase && uccur > EndSpecials && IsVarTerm(uccur)) {
+      if (
+	  uccur < MAX_SPECIALS_TAG &&  /* two first pages */
+	  uccur > EndSpecials && IsVarTerm(uccur)) {
 	/* oops, we found a blob */
 	int nofcells = (uccur-EndSpecials) / sizeof(CELL) , i;
 
@@ -3063,7 +3071,8 @@ icompact_heap(void)
 
     current = *iptr;
     ccell = UNMARK_CELL(*current);
-    if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)
+    if (ccell < MAX_SPECIALS_TAG &&  /* two first pages */
+	ccell > EndSpecials && IsVarTerm(ccell)
 	) {
       /* oops, we found a blob */
       int nofcells = (UNMARK_CELL(*current)-EndSpecials) / sizeof(CELL);
@@ -3128,7 +3137,7 @@ icompact_heap(void)
     CELL ccur = *current;
     CELL_PTR dest = H0+(iptr-ibase);
     CELL uccur = UNMARK_CELL(ccur);
-    if (uccur < (CELL)AtomBase && uccur > EndSpecials && IsVarTerm(uccur)) {
+    if (uccur < MAX_SPECIALS_TAG && uccur > EndSpecials && IsVarTerm(uccur)) {
       /* oops, we found a blob */
       int nofcells = (uccur-EndSpecials) / sizeof(CELL) , i;
 
@@ -3309,10 +3318,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   Int           effectiveness = 0;
   int           gc_trace = FALSE;
 
-#if USE_SYSTEM_MALLOC
-  /* I can't use it because I may have pointers to high memory */
-  return 0;
-#endif
 #if COROUTINING
   if (H0 - max < 1024+(2*NUM_OF_ATTS)) {
     if (!Yap_growglobal(&current_env)) {

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2004-09-30 21:37:41 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-10-04 18:56:19 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.101  2004/09/30 21:37:41  vsc
+* fixes for thread support
+*
 * Revision 1.100  2004/09/30 19:51:54  vsc
 * fix overflow from within clause/2
 *
@@ -2712,6 +2715,21 @@ valid_instructions(yamop *end, yamop *cl)
     case _get_atom:
       cl = NEXTOP(cl,xc);
       break;
+    case _get_2atoms:
+      cl = NEXTOP(cl,cc);
+      break;
+    case _get_3atoms:
+      cl = NEXTOP(cl,ccc);
+      break;
+    case _get_4atoms:
+      cl = NEXTOP(cl,cccc);
+      break;
+    case _get_5atoms:
+      cl = NEXTOP(cl,ccccc);
+      break;
+    case _get_6atoms:
+      cl = NEXTOP(cl,cccccc);
+      break;
     case _get_struct:
       cl = NEXTOP(cl,xf);
       break;      
@@ -6215,11 +6233,11 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
       LogUpdClause *lc = lu_clause(ipc);
 
       if (first) {
-	cld[0].Code = lc->ClCode;
-	cld[1].Code = cls[0].Code;
-      } else {
 	cld[0].Code = cls[0].Code;
 	cld[1].Code = lc->ClCode;
+      } else {
+	cld[0].Code = lc->ClCode;
+	cld[1].Code = cls[0].Code;
       }
       intrs.expand_block = NULL;
       *sp->u.cle.entry_code = (yamop *)suspend_indexing(cld, cld+1, ap, &intrs);

m4/TermExt.h.m4

@@ -10,7 +10,7 @@
 * File:		TermExt.h						 *
 * mods:									 *
 * comments:	Extensions to standard terms for YAP			 *
-* version:      $Id: TermExt.h.m4,v 1.15 2004-09-16 17:29:08 vsc Exp $	 *
+* version:      $Id: TermExt.h.m4,v 1.16 2004-10-04 18:56:20 vsc Exp $	 *
 *************************************************************************/
 
 #ifdef USE_SYSTEM_MALLOC
@@ -33,7 +33,7 @@
 #define   TermNil MkAtomTerm(AtomNil)
 #define   TermDot MkAtomTerm(AtomDot)
 
-#ifdef IN_SECOND_QUADRANT
+#if defined(IN_SECOND_QUADRANT) && !GC_NO_TAGS
 typedef enum {
   db_ref_e = sizeof(Functor *)|RBIT,
   long_int_e = 2*sizeof(Functor *)|RBIT,
@@ -109,6 +109,12 @@ typedef struct special_functors_struct
 }
 special_functors;
 
+#if USE_SYSTEM_MALLOC
+#define MAX_SPECIALS_TAG (4*4096)
+#else
+#define MAX_SPECIALS_TAG ((CELL)AtomBase)
+#endif
+
 #if SIZEOF_DOUBLE == SIZEOF_LONG_INT
 #if GC_NO_TAGS
 Inline(MkFloatTerm, Term, Float, dbl, (H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=(2*sizeof(CELL)+EndSpecials),H+=3,AbsAppl(H-3)))

m4/Yap.h.m4

@@ -10,11 +10,9 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.68 2004-09-30 19:52:55 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.69 2004-10-04 18:56:20 vsc Exp $	 *
 *************************************************************************/
 
-/* #define GC_NO_TAGS 1 */
-
 #include "config.h"
 
 /*
@@ -87,6 +85,10 @@
 #define FROZEN_STACKS 1
 #endif /* TABLING || SBA */
 
+#if USE_SYSTEM_MALLOC
+#define GC_NO_TAGS 1
+#endif
+
 #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
 /* adjust a config.h from mingw32 to work with vc++ */
 #ifdef HAVE_GCC

pl/errors.yap

@@ -11,8 +11,11 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2004-09-17 19:34:53 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-10-04 18:56:20 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.55  2004/09/17 19:34:53  vsc
+* simplify frozen/2
+*
 * Revision 1.54  2004/07/22 21:32:22  vsc
 * debugger fixes
 * initial support for JPL
@@ -113,6 +116,9 @@ print_message(Level, Mss) :-
 	'$show_consult_level'(LC),
 	format(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
 '$do_informational_message'(loaded(_,user,_,_,_)) :- !.
+'$do_informational_message'(loaded(included,AbsoluteFileName,Mod,Time,Space)) :- !,
+	'$show_consult_level'(LC),
+	format(user_error, '~*|% ~a included in module ~a, ~d msec ~d bytes~n', [LC, AbsoluteFileName,Mod,Time,Space]).
 '$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
 	'$show_consult_level'(LC0),
 	LC is LC0+1,