YAP would break when gc was called from portray:

always save arguments before calling plwrite with possible portray
 only do it for portray because plwrite may be called from unsafe environments
 make Slot machinery mainstream.


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

C/absmi.c

@@ -1746,8 +1746,9 @@ absmi(int inp)
 	DEPTH -= MkIntConstant(2);
 #endif	/* DEPTH_LIMIT */
 #ifdef LOW_LEVEL_TRACER
-      if (do_low_level_trace)
+      if (do_low_level_trace) {
 	low_level_trace(enter_pred,pred_entry(pt0),XREGS+1);
+      }
 #endif	/* LOW_LEVEL_TRACE */
       /* this is the equivalent to setting up the stack */
       ALWAYS_GONext();
@@ -5810,6 +5811,7 @@ absmi(int inp)
       } else {
 	ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
       }
+      /* for slots to work */
 #endif /* FROZEN_STACKS */
 #ifdef LOW_LEVEL_TRACER
       if (do_low_level_trace)
@@ -6053,7 +6055,12 @@ absmi(int inp)
 	WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
 	JMPNext();
       }
-#endif 
+#endif
+      /* update ASP before calling IPred */
+      ASP = Y+E_CB;
+      if (ASP > (CELL *) B) {
+	ASP = (CELL *) B;
+      }
       IPred((CODEADDR)PredFromDefCode(PREG));
       /* IPred can generate errors, it thus must get rid of the lock itself */
       setregs();

C/adtdefs.c

@@ -671,3 +671,54 @@ ArgsOfSFTerm(Term t)
 }
 
 #endif
+
+long
+_YAP_NewSlots(int n)
+{
+  Int old_slots = IntOfTerm(ASP[0]), oldn = n;
+  while (n > 0) {
+    RESET_VARIABLE(ASP);
+    ASP--;
+    n--;
+  }
+  ASP[0] = MkIntTerm(old_slots+oldn);
+  return((ASP+1)-LCL0);
+}
+
+long
+_YAP_InitSlot(Term t)
+{
+  Int old_slots = IntOfTerm(ASP[0]);
+  *ASP = t;
+  ASP--;
+  ASP[0] = MkIntTerm(old_slots+1);
+  return((ASP+1)-LCL0);
+}
+
+void
+_YAP_RecoverSlots(int n)
+{
+  Int old_slots = IntOfTerm(ASP[0]);
+  ASP += n;
+  ASP[0] = MkIntTerm(old_slots-n);
+}
+
+Term
+_YAP_GetFromSlot(long slot)
+{
+  return(Deref(LCL0[slot]));
+}
+
+Term *
+_YAP_AddressFromSlot(long slot)
+{
+  return(LCL0+slot);
+}
+
+void
+_YAP_PutInSlot(long slot, Term t)
+{
+  LCL0[slot] = t;
+}
+
+

C/c_interface.c

@@ -431,50 +431,37 @@ YAP_Unify(Term t1, Term t2)
 X_API long
 YAP_NewSlots(int n)
 {
-  Int old_slots = IntOfTerm(ASP[0]), oldn = n;
+  return _YAP_NewSlots(n);
-  while (n > 0) {
-    RESET_VARIABLE(ASP);
-    ASP--;
-    n--;
-  }
-  ASP[0] = MkIntTerm(old_slots+oldn);
-  return((ASP+1)-LCL0);
 }
 
 X_API long
 YAP_InitSlot(Term t)
 {
-  Int old_slots = IntOfTerm(ASP[0]);
+  return _YAP_InitSlot(t);
-  *ASP = t;
-  ASP--;
-  ASP[0] = MkIntTerm(old_slots+1);
-  return((ASP+1)-LCL0);
 }
 
 X_API void
 YAP_RecoverSlots(int n)
 {
-  Int old_slots = IntOfTerm(ASP[0]);
+  return _YAP_RecoverSlots(n);
-  ASP += n;
-  ASP[0] = MkIntTerm(old_slots-n);
 }
 
 X_API Term
 YAP_GetFromSlot(long slot)
 {
-  return(Deref(LCL0[slot]));
+  return _YAP_GetFromSlot(slot);
 }
 
 X_API Term *
 YAP_AddressFromSlot(long slot)
 {
-  return(LCL0+slot);
+  return _YAP_AddressFromSlot(slot);
 }
 
 X_API void
 YAP_PutInSlot(long slot, Term t)
 {
-  LCL0[slot] = t;
+  _YAP_PutInSlot(slot, t);
 }
 
 

C/errors.c

@@ -181,7 +181,7 @@ DumpActiveGoals (void)
 	  DebugPutc (c_output_stream,'(');
 	  for (i= 0; i < arity; i++) {
 	    if (i > 0) DebugPutc (c_output_stream,',');
-	    plwrite(args[i], DebugPutc, 4);
+	    plwrite(args[i], DebugPutc, Handle_vars_f);
 	  }
 	  DebugPutc (c_output_stream,')');
 	}

C/exec.c

@@ -1447,8 +1447,11 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
 #ifdef DEPTH_LIMIT
     DEPTH= B->cp_depth;
 #endif
-    YENV= ASP = B->cp_env;
+    /* ASP should be set to the top of the local stack when we
-    ENV  = (CELL *)((B->cp_env)[E_E]);
+       did the call */
+    ASP = B->cp_env;
+    /* YENV should be set to the current environment */
+    YENV = ENV  = (CELL *)((B->cp_env)[E_E]);
     B    = B->cp_b;
     SET_BB(B);
     HB = PROTECT_FROZEN_H(B);

C/heapgc.c

@@ -3020,6 +3020,9 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
     return(0);
   }
   gc_calls++;
+  if (gc_calls == 19) {
+    fprintf(stderr,"here I go\n");
+  }
   if (gc_trace) {
     YP_fprintf(YP_stderr, "[gc]\n");
   } else if (gc_verbose) {

C/iopreds.c

@@ -2584,7 +2584,11 @@ p_current_output (void)
 static Int
 p_write (void)
 {				/* '$write'(+Flags,?Term) */
-  plwrite (ARG2, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG1)));
+  int flags = (int) IntOfTerm (Deref (ARG1));
+  /* notice: we must have ASP well set when using portray, otherwise
+     we cannot make recursive Prolog calls */
+  *--ASP = MkIntTerm(0);
+  plwrite (ARG2, Stream[c_output_stream].stream_putc, flags);
   if (EX != 0L) {
     Term ball = EX;
     EX = 0L;
@@ -2603,6 +2607,9 @@ p_write2 (void)
     c_output_stream = old_output_stream;
     return(FALSE);
   }
+  /* notice: we must have ASP well set when using portray, otherwise
+     we cannot make recursive Prolog calls */
+  *--ASP = MkIntTerm(0);
   plwrite (ARG3, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG2)));
   c_output_stream = old_output_stream;
   if (EX != 0L) {
@@ -3789,7 +3796,7 @@ format(Term tail, Term args, int sno)
 		Error(TYPE_ERROR_ATOM,arghd,"~a in format/2");
 		return(FALSE);
 	      }
-	      plwrite (arghd, format_putc, 4);
+	      plwrite (arghd, format_putc, Handle_vars_f);
 	      break;
 	    case 'c':
 	      if (IsVarTerm (args)) {
@@ -3888,7 +3895,7 @@ format(Term tail, Term args, int sno)
 		return(FALSE);
 	      }
 	      if (!arg_size) {
-		plwrite (arghd, format_putc, 4);
+		plwrite (arghd, format_putc, Handle_vars_f);
 	      } else {
 		Int siz;
 		/*
@@ -4166,7 +4173,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      plwrite (arghd, format_putc, (int) 3);
+	      plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f );
 	      break;
 	    case 'p':
 	      if (size_args) {
@@ -4186,7 +4193,13 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      plwrite (arghd, format_putc, (int) 12);
+	      *--ASP = MkIntTerm(0);
+	      { 
+		long sl = _YAP_InitSlot(args);
+		plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f);
+		args = _YAP_GetFromSlot(sl);
+		_YAP_RecoverSlots(1);
+	      }
 	      if (EX != 0L) {
 		Term ball = EX;
 		EX = 0L;
@@ -4213,7 +4226,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      plwrite (arghd, format_putc, (int) 5);
+	      plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f);
 	      break;
 	    case 'w':
 	      if (size_args) {
@@ -4233,7 +4246,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      plwrite (arghd, format_putc, (int) 4);
+	      plwrite (arghd, format_putc, Handle_vars_f);
 	      break;
 	    case '~':
 	      if (size_args) {

C/tracer.c

@@ -60,7 +60,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
       Portray_delays = TRUE;
 #endif
 #endif
-      plwrite(args[i], TracePutchar, 4);
+      plwrite(args[i], TracePutchar, Handle_vars_f);
 #if DEBUG
 #if COROUTINING
       Portray_delays = FALSE;
@@ -112,12 +112,13 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /*  extern int gc_calls; */
 
   vsc_count++;
-  /* if (vsc_count < 24200) return; */
+  /* return;*/
+  /*  if (vsc_count < 38372100LL) return;*/
   /* if (vsc_count == 80) {
      printf("Here I go\n");
      } */
   /* if (vsc_count > 500000) exit(0); */
-  /* if (gc_calls < 1) return;*/
+  /* if (gc_calls < 1) return; */
 #if defined(__GNUC__)
   YP_fprintf(YP_stderr,"%llu ", vsc_count);
 #endif

C/write.c

@@ -57,13 +57,9 @@ STATIC_PROTO(void writeTerm, (Term, int, int, int));
 
 static int      (*writech) (int, int);
 static int      Quote_illegal, Ignore_ops, Handle_vars, Use_portray;
+static int      keep_terms;
 
 
-#define	Quote_illegal_f	1
-#define	Ignore_ops_f	2
-#define	Handle_vars_f	4
-#define	Use_portray_f	8
-
 #if DEBUG
 #if COROUTINING
 int  Portray_delays = FALSE;
@@ -324,15 +320,34 @@ write_var(CELL *t)
       } else if (ext == attvars_ext) {
 	attvar_record *attv = (attvar_record *)t;
 	int i;
+	long sl = 0;
 
 	wrputs("$AT(");
 	write_var(t);
 	wrputc(',');      
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot((CELL)attv);
+	}
 	writeTerm((Term)&(attv->Value), 999, 1, FALSE);
+	if (keep_terms) {
+	  attv = (attvar_record *)_YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	for (i = 0; i < NUM_OF_ATTS; i ++) {
 	  if (!IsVarTerm(attv->Atts[2*i+1])) {
+	    long sl = 0;
+
 	    wrputc(',');
+	    if (keep_terms) {
+	      /* garbage collection may be called */
+	      sl = _YAP_InitSlot((CELL)attv);
+	    }
 	    writeTerm((Term)&(attv->Atts[2*i+1]), 999, 1, FALSE);
+	    if (keep_terms) {
+	      attv = (attvar_record *)_YAP_GetFromSlot(sl);
+	      _YAP_RecoverSlots(1);
+	    }
 	  }
 	}
 	wrputc(')');
@@ -389,12 +404,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
     if (Use_portray) {
       Term targs[1];
       Term old_EX = 0L;
+      long sl = 0;
 
       targs[0] = t;
       PutValue(AtomPortray, MkAtomTerm(AtomNil));
       if (EX != 0L) old_EX = EX;
-      *--ASP = MkIntTerm(0);
+      /* *--ASP = MkIntTerm(0); */
+      sl = _YAP_InitSlot(t);      
       execute_goal(MkApplTerm(FunctorPortray, 1, targs), 0, 1);
+      t = _YAP_GetFromSlot(sl);
+      _YAP_RecoverSlots(1);
       if (old_EX != 0L) EX = old_EX;
       Use_portray = TRUE;
       Use_portray = TRUE;
@@ -408,6 +427,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
       lastw = separator;
       while (1) {
 	int             new_depth = depth + 1;
+	long            sl= 0;
 
 	if (*max_list && eldepth > *max_list) {
 	  putAtom(LookupAtom("..."));
@@ -416,7 +436,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 	  return;
 	} else
 	  eldepth++;
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot(t);
+	}
 	writeTerm(HeadOfTermCell(t), 999, new_depth, FALSE);
+	if (keep_terms) {
+	  t = _YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	ti = TailOfTerm(t);
 	if (IsVarTerm(ti))
 	  break;
@@ -452,6 +480,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
       wrputc('(');
       lastw = separator;
       while (*p) {
+	long sl = 0;
+
 	while (argno < *p) {
 	  wrputc('_'), wrputc(',');
 	  ++argno;
@@ -459,7 +489,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 	*p++;
 	lastw = separator;
 	/* cannot use the term directly with the SBA */
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot((CELL)p);
+	}
 	writeTerm(Deref(p++), 999, depth + 1, FALSE);
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  p = (CELL *)_YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	if (*p)
 	  wrputc(',');
 	argno++;
@@ -472,11 +511,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
     if (Use_portray) {
       Term targs[1];
       Term old_EX = 0L;
+      long sl = 0;
+
       targs[0] = t;
       PutValue(AtomPortray, MkAtomTerm(AtomNil));
       if (EX != 0L) old_EX = EX;
-      *--ASP = MkIntTerm(0);
+      sl = _YAP_InitSlot(t);      
       execute_goal(MkApplTerm(FunctorPortray, 1, targs),0, 1);
+      t = _YAP_GetFromSlot(sl);
+      _YAP_RecoverSlots(1);
       if (old_EX != 0L) EX = old_EX;
       Use_portray = TRUE;
       if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
@@ -522,6 +565,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
     } else if (!Ignore_ops &&
 	       Arity == 1 && opinfo && IsPosfixOp(opinfo, &op, &lp)) {
       Term  tleft = ArgOfTerm(1, t);
+      long sl = 0;
       int            bracket_left =
 	!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
 	LeftOpToProtect(AtomOfTerm(tleft), lp); 
@@ -536,7 +580,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 	wrputc('(');
 	lastw = separator;
       }
+      if (keep_terms) {
+	/* garbage collection may be called */
+	sl = _YAP_InitSlot(t);      
+      }
       writeTerm(ArgOfTermCell(1,t), lp, depth + 1, rinfixarg);
+      if (keep_terms) {
+	/* garbage collection may be called */
+	t = _YAP_GetFromSlot(sl);
+	_YAP_RecoverSlots(1);
+      }
       if (bracket_left) {
 	wrputc(')');
 	lastw = separator;
@@ -551,6 +604,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 						 &rp) ) {
       Term  tleft = ArgOfTerm(1, t);
       Term  tright = ArgOfTerm(2, t);
+      long sl = 0;
       int   bracket_left =
 	!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
 	LeftOpToProtect(AtomOfTerm(tleft), lp);
@@ -569,7 +623,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 	wrputc('(');
 	lastw = separator;
       }
+      if (keep_terms) {
+	/* garbage collection may be called */
+	sl = _YAP_InitSlot(t);      
+      }
       writeTerm(ArgOfTermCell(1, t), lp, depth + 1, rinfixarg);
+      if (keep_terms) {
+	/* garbage collection may be called */
+	t = _YAP_GetFromSlot(sl);
+	_YAP_RecoverSlots(1);
+      }
       if (bracket_left) {
 	wrputc(')');
 	lastw = separator;
@@ -619,9 +682,20 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
 	  putUnquotedString(ti);
 	}
       } else {
+	long sl = 0;
+
 	wrputs("'$VAR'(");
 	lastw = separator;
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot(t);      
+	}
 	writeTerm(ArgOfTermCell(1,t), 999, depth + 1, FALSE);
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  t = _YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	wrputc(')');
 	lastw = separator;
       }
@@ -632,10 +706,21 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
       wrputc('}');
       lastw = separator;
     } else  if (atom == AtomArray) {
+      long sl = 0;
+
       wrputc('{');
       lastw = separator;
       for (op = 1; op <= Arity; ++op) {
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot(t);      
+	}
 	writeTerm(ArgOfTermCell(op, t), 999, depth + 1, FALSE);
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  t = _YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	if (op != Arity) {
 	  wrputc(',');
 	  lastw = separator;
@@ -648,7 +733,18 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
       lastw = separator;
       wrputc('(');
       for (op = 1; op <= Arity; ++op) {
+	long sl = 0;
+
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  sl = _YAP_InitSlot(t);      
+	}
 	writeTerm(ArgOfTermCell(op, t), 999, depth + 1, FALSE);
+	if (keep_terms) {
+	  /* garbage collection may be called */
+	  t = _YAP_GetFromSlot(sl);
+	  _YAP_RecoverSlots(1);
+	}
 	if (op != Arity) {
 	  wrputc(',');
 	  lastw = separator;
@@ -671,6 +767,9 @@ plwrite(Term t, int (*mywrite) (int, int), int flags)
   Quote_illegal = flags & Quote_illegal_f;
   Handle_vars = flags & Handle_vars_f;
   Use_portray = flags & Use_portray_f;
+  /* notice: we must have ASP well set when using portray, otherwise
+     we cannot make recursive Prolog calls */
+  keep_terms = Use_portray;
   Ignore_ops = flags & Ignore_ops_f;
   writeTerm(t, 1200, 1, FALSE);
 }

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.23 2002-10-03 17:29:46 stasinos Exp $	 *
+* version:      $Id: Yapproto.h,v 1.24 2002-10-17 00:05:29 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -49,6 +49,14 @@ void	STD_PROTO(ReleaseAtom,(Atom));
 Term	STD_PROTO(StringToList,(char *));
 Term	STD_PROTO(StringToListOfAtoms,(char *));
 
+long    STD_PROTO(_YAP_InitSlot,(Term));
+Term    STD_PROTO(_YAP_GetFromSlot,(long));
+void    STD_PROTO(_YAP_RecoverSlots,(int));
+Term    STD_PROTO(_YAP_GetFromSlot,(long));
+Term   *STD_PROTO(_YAP_AddressFromSlot,(long));
+void    STD_PROTO(_YAP_PutInSlot,(long, Term));
+
+
 #if SFUNC
 Term	STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
 CELL	STD_PROTO(*ArgsOfSFTerm,(Term));

H/yapio.h

@@ -291,6 +291,11 @@ extern int c_input_stream, c_output_stream, c_error_stream;
 
 Term   STD_PROTO(OpenStream,(FILE *,char *,Term,int));
 
+#define	Quote_illegal_f		1
+#define	Ignore_ops_f		2
+#define	Handle_vars_f		4
+#define	Use_portray_f		8
+
 /* routines in sysbits.c */
 char *STD_PROTO(pfgets,(char *,int,YP_File));