library(system) plus several new support builtins

much improved garbage collector
improvements to compiler
yaptab compiles again


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

C/absmi.c

@@ -292,7 +292,7 @@ absmi(int inp)
 #endif /* USE_THREADED_CODE */
 
     noheapleft:
-      CFREG = MinStackGap*(stack_overflows+1);
+      CFREG = CalculateStackGap();
       saveregs();
 #if PUSH_REGS
       restore_absmi_regs(old_regs);
@@ -1604,7 +1604,7 @@ absmi(int inp)
 	    ASP = (CELL *)B;
 	  goto noheapleft;
 	}
-      if (CFREG != MinStackGap*(stack_overflows+1))
+      if (CFREG != CalculateStackGap())
 	goto creep;
       else
 	goto NoStackExec;
@@ -1752,12 +1752,12 @@ absmi(int inp)
 	if (ReadTimedVar(WokenGoals) != TermNil)
 	  goto creepc;
 	else {
-	  CFREG = MinStackGap*(stack_overflows+1);
+	  CFREG = CalculateStackGap();
 	  JMPNext();
 	}
       }
 #endif
-      if (CFREG != MinStackGap*(stack_overflows+1))
+      if (CFREG != CalculateStackGap())
 	goto creepc;
       ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
       if (ASP > (CELL *)B)
@@ -1830,11 +1830,11 @@ absmi(int inp)
 	if (ReadTimedVar(WokenGoals) != TermNil)
 	  goto creep_either;
 	else {
-	  CFREG = MinStackGap*(stack_overflows+1);
+	  CFREG = CalculateStackGap();
 	  JMPNext();
 	}
       }
-      if (CFREG != MinStackGap*(stack_overflows+1)) {
+      if (CFREG != CalculateStackGap()) {
 	goto either_notest;
       }
       ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
@@ -1916,12 +1916,12 @@ absmi(int inp)
 	if (ReadTimedVar(WokenGoals) != TermNil)
 	  goto creepde;
 	else {
-	  CFREG = MinStackGap*(stack_overflows+1);
+	  CFREG = CalculateStackGap();
 	  JMPNext();
 	}
       }
 #endif
-      if (CFREG != MinStackGap*(stack_overflows+1))
+      if (CFREG != CalculateStackGap())
 	goto creepde;
 
     NoStackExec:
@@ -2041,10 +2041,10 @@ absmi(int inp)
 
 	  /* no more goals to wake up */
 	  UpdateTimedVar(WokenGoals, TermNil);
-	  CFREG = MinStackGap*(stack_overflows+1);
+	  CFREG = CalculateStackGap();
 	}
 	else {
-	  CFREG = MinStackGap*(stack_overflows+1);
+	  CFREG = CalculateStackGap();
 	  /* We haven't changed P yet so this means redo the
 	   * same instruction */
 	  JMPNext();
@@ -2101,7 +2101,7 @@ absmi(int inp)
 	ARG1 = (Term) AbsPair(H);
 
 	H += 2;
-	CFREG = MinStackGap*(stack_overflows+1);
+	CFREG = CalculateStackGap();
 	SREG = (CELL *) (Unsigned(CreepCode) - sizeof(SMALLUNSGN));
 
 #ifdef COROUTINING
@@ -5920,7 +5920,7 @@ absmi(int inp)
 	{
 	  Prop p = GetPredProp (at, 1);
 	  if (p == NIL) {
-	    CFREG = MinStackGap*(stack_overflows+1);
+	    CFREG = CalculateStackGap();
 	    FAIL();
 	  } else {
 	    PredEntry *undefpe;
@@ -5932,7 +5932,7 @@ absmi(int inp)
 	}
       }
       PREG = (yamop *)pred_entry_from_code(UndefCode)->CodeOfPred;
-      CFREG = MinStackGap*(stack_overflows+1);
+      CFREG = CalculateStackGap();
       CACHE_A1();
       JMPNext();
       ENDBOp();
@@ -10144,7 +10144,7 @@ absmi(int inp)
 	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	  /* make sure we have something to show for our trouble */
 	  saveregs();
-	  gc(3, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
+	  gc(0, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
 	  setregs();
 	  goto restart_func2s;
 	}
@@ -10242,7 +10242,7 @@ absmi(int inp)
 	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	  /* make sure we have something to show for our trouble */
 	  saveregs();
-	  gc(3, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
+	  gc(0, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
 	  setregs();
 	  goto restart_func2s_cv;
 	}
@@ -10339,7 +10339,7 @@ absmi(int inp)
       if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	/* make sure we have something to show for our trouble */
 	saveregs();
-	gc(3, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
+	gc(0, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
 	setregs();
 	goto restart_func2s_vc;
       }
@@ -10433,7 +10433,7 @@ absmi(int inp)
 	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	  /* make sure we have something to show for our trouble */
 	  saveregs();
-	  gc(3, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
+	  gc(0, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
 	  setregs();
 	  goto restart_func2s_y;
 	}
@@ -10553,7 +10553,7 @@ absmi(int inp)
 	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	  /* make sure we have something to show for our trouble */
 	  saveregs();
-	  gc(3, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
+	  gc(0, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
 	  setregs();
 	  goto restart_func2s_y_cv;
 	}
@@ -10682,7 +10682,7 @@ absmi(int inp)
       if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
 	/* make sure we have something to show for our trouble */
 	saveregs();
-	gc(3, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
+	gc(0, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
 	setregs();
 	goto restart_func2s_y_vc;
       }

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.6 2001-05-07 19:56:02 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.7 2001-05-21 20:00:05 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -537,6 +537,7 @@ ExtendWorkSpace(Int s)
 {
 #ifdef YAPOR
   abort_optyap("function ExtendWorkSpace called");
+  return(FALSE);
 #else
 
   MALLOC_T a;
@@ -614,9 +615,9 @@ ExtendWorkSpace(Int s)
     return FALSE;
   }
   
-#endif /* YAPOR */
   WorkSpaceTop = (char *) a + s;
   return TRUE;
+#endif /* YAPOR */
 }
 
 int

C/attvar.c

@@ -199,6 +199,8 @@ CurrentTime(void) {
 
 static Int
 InitVarTime(void) {
+  return(0);
+#ifdef BEFORE_TRAIL_COMPRESSION
   if (B->cp_tr == TR) {
     /* we run the risk of not making non-determinate bindings before
        the end of the night */
@@ -206,6 +208,7 @@ InitVarTime(void) {
     Bind((CELL *)(TR+1),AbsAppl(H-1));
   }
   return((CELL *)(B->cp_tr)-(CELL *)TrailBase);
+#endif
 }
 
 static Int

C/c_interface.c

@@ -81,6 +81,8 @@ X_API void   *STD_PROTO(YapAllocSpaceFromYap,(unsigned int));
 X_API void    STD_PROTO(YapFreeSpaceFromYap,(void *));
 X_API void    STD_PROTO(YapFreeSpaceFromYap,(void *));
 X_API int     STD_PROTO(YapStringToBuffer, (Term, char *, unsigned int));
+X_API Term    STD_PROTO(YapBufferToString, (char *));
+X_API Term    STD_PROTO(YapBufferToAtomList, (char *));
 X_API void    STD_PROTO(YapError,(char *));
 X_API int     STD_PROTO(YapRunGoal,(Term));
 X_API int     STD_PROTO(YapRestartGoal,(void));
@@ -96,6 +98,8 @@ X_API int     STD_PROTO(YapReset, (void));
 X_API void    STD_PROTO(YapExit, (int));
 X_API void    STD_PROTO(YapInitSocks, (char *, long));
 X_API void    STD_PROTO(YapSetOutputMessage, (void));
+X_API int     STD_PROTO(YapStreamToFileNo, (Term));
+X_API int     STD_PROTO(YapPopen, (Term));
 
 X_API Term
 YapA(int i)
@@ -359,12 +363,14 @@ YapUnify(Term pt1, Term pt2)
   return(out);
 }
 
-Int YapExecute(CPredicate code)
+Int
+YapExecute(CPredicate code)
 {
   return((code)());
 }
 
-X_API Int YapCallProlog(Term t)
+X_API Int
+YapCallProlog(Term t)
 {
   Int out;
   BACKUP_MACHINE_REGS();
@@ -375,7 +381,8 @@ X_API Int YapCallProlog(Term t)
   return(out);
 }
 
-X_API void *YapAllocSpaceFromYap(unsigned int size)
+X_API void *
+YapAllocSpaceFromYap(unsigned int size)
 {
   void *ptr;
   BACKUP_MACHINE_REGS();
@@ -391,13 +398,15 @@ X_API void *YapAllocSpaceFromYap(unsigned int size)
   return(ptr);
 }
 
-X_API void YapFreeSpaceFromYap(void *ptr)
+X_API void
+YapFreeSpaceFromYap(void *ptr)
 {
   FreeCodeSpace(ptr);
 }
 
 /* copy a string to a buffer */
-X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
+X_API int
+YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
 {
   unsigned int j = 0;
 
@@ -419,7 +428,10 @@ X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
       return(FALSE);		
     }
     buf[j++] = i;
-    if (j > bufsize) return(FALSE);
+    if (j > bufsize) {
+      buf[j-1] = '\0';
+      return(FALSE);
+    }
     t = TailOfTerm(t);
     if (IsVarTerm(t)) {
       Error(INSTANTIATION_ERROR,t,"user defined procedure");
@@ -434,6 +446,33 @@ X_API int YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
 }
 
 
+/* copy a string to a buffer */
+X_API Term
+YapBufferToString(char *s)
+{
+  Term t; 
+  BACKUP_H();
+
+  t = StringToList(s);
+
+  RECOVER_H();
+  return(t);
+}
+
+/* copy a string to a buffer */
+X_API Term
+YapBufferToAtomList(char *s)
+{
+  Term t; 
+  BACKUP_H();
+
+  t = StringToListOfAtoms(s);
+
+  RECOVER_H();
+  return(t);
+}
+
+
 X_API void
 YapError(char *buf)
 {
@@ -742,3 +781,29 @@ YapSetOutputMessage(void)
 #endif
 }
 
+X_API int
+YapStreamToFileNo(Term t)
+{
+  return(StreamToFileNo(t));
+}
+
+X_API void
+YapCloseAllOpenStreams(void)
+{
+  BACKUP_H();
+
+  return(CloseStreams(FALSE));
+
+  RECOVER_H();
+}
+
+X_API Term
+YapOpenStream(void *fh, char *name, Term nm, int flags)
+{
+  BACKUP_H();
+
+  return(OpenStream((FILE *)fh, name, nm, flags));
+
+  RECOVER_H();
+}
+

C/cdmgr.c

@@ -2032,6 +2032,7 @@ Int
 PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
   Int i_table;
   Int val;
+  AtomEntry *chain;
 
   for (i_table = 0; i_table < MaxHash; i_table++) {
     Atom a;
@@ -2048,6 +2049,14 @@ PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
     }
     READ_UNLOCK(HashChain[i_table].AERWLock);
   }
+  chain = RepAtom(INVISIBLECHAIN.Entry);
+  while (!EndOfPAEntr(chain) != 0) {
+    if ((val = check_code_in_atom(chain, codeptr, parity, pmodule)) != 0) {
+      *pat = AbsAtom(chain);
+      return(val);
+    }
+    chain = RepAtom(chain->NextOfAE);
+  }
   /* we didn't find it, must be one of the hidden predicates */
   return(0);
 }

C/compiler.c

@@ -329,7 +329,7 @@ optimize_ce(Term t, unsigned int arity)
   CExpEntry *p = common_exps, *parent = common_exps;
   int cmp = 0;
 
-  if (onbranch || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
+  if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
     return (t);
   while (p != NULL) {
     CELL *OldH = H;
@@ -1041,7 +1041,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
       save_machine_regs();
       longjmp(CompilerBotch,1);
     }
-  } else if (IsNewVar(t3) && cur_branch == 0) {
+  } else if (IsNewVar(t3) /* && cur_branch == 0 */) {
     c_var(t3,f_flag,(unsigned int)Op);
     if (Op == _functor) {
       emit(empty_call_op, Zero, Zero);
@@ -2108,9 +2108,9 @@ CheckUnsafe(PInstr *pc)
       add_bvarray_op(pc, vstat, pc->rnd2);
       break;
     case call_op:
-	emit(label_op, ++labelno, Zero);
+      emit(label_op, ++labelno, Zero);
-	pc->ops.opseqt[1] = (CELL)labelno;
+      pc->ops.opseqt[1] = (CELL)labelno;
-	add_bvarray_op(pc, vstat, pc->rnd2);
+      add_bvarray_op(pc, vstat, pc->rnd2);
     case deallocate_op:
       {
 	int n = pc->op == call_op ? pc->rnd2 : 0;
@@ -2144,6 +2144,7 @@ CheckVoids(void)
 
   cpc = CodeStart;
   while ((ic = cpc->op) != allocate_op) {
+    ic = cpc->op;
 #ifdef M_WILLIAMS
     switch ((int) ic) {
 #else
@@ -2160,14 +2161,12 @@ CheckVoids(void)
       ve = ((Ventry *) cpc->rnd1);
       if ((ve->FlagsOfVE & PermFlag) == 0 && ve->RCountOfVE <= 1) {
 	ve->NoOfVE = ve->KindOfVE = VoidVar;
-#ifndef SFUNC
 	if (ic == get_var_op || ic ==
-	    save_pair_op || ic == save_appl_op) {
+	    save_pair_op || ic == save_appl_op
-#else
+#ifdef SFUNC
-	if (ic == get_var_op || ic ==
+	    || ic == unify_s_var_op
-	    save_appl_op || ic == save_pair_op
-	    || ic == unify_s_var_op) {
 #endif
+	    ) {
 	  cpc->op = nop_op;
 	  break;
 	}
@@ -2202,6 +2201,8 @@ checktemp(void)
   vreg = vadr & MaskVarAdrs;
   if (v->KindOfVE == PermVar || v->KindOfVE == VoidVar)
     return (0);
+  if (v->RCountOfVE == 1)
+     return(0);
   if (vreg) {
     --Uses[vreg];
     return (1);

C/dbase.c

@@ -1939,7 +1939,7 @@ GetDBTerm(DBRef DBSP)
 
     pt = CellPtr(DBSP->Contents);
     NOf = DBSP->NOfCells;
-    if (H+NOf > ASP - MinStackGap*(stack_overflows+1)) {
+    if (H+NOf > ASP-CalculateStackGap()) {
       return((Term)0);
     }
     HeapPtr = cpcells(HOld, pt, NOf);

C/errors.c

@@ -255,7 +255,7 @@ Abort (char *format,...)
     }
   else
     {
-      CreepFlag = MinStackGap*(stack_overflows+1);
+      CreepFlag = CalculateStackGap();
 #if PUSH_REGS
       restore_absmi_regs(&standard_regs);
 #endif
@@ -1801,7 +1801,7 @@ Error (yap_error_number type, Term where, char *format,...)
   if (serious) {
     Int depth;
 
-    CreepFlag = MinStackGap*(stack_overflows+1);
+    CreepFlag = CalculateStackGap();
     if (type == PURE_ABORT)
       depth = SetDBForThrow(MkAtomTerm(LookupAtom("abort")));
     else

C/exec.c

@@ -845,7 +845,7 @@ exec_absmi(int top)
       B = (choiceptr)(LCL0-depth);
 #endif
       yap_flags[SPY_CREEP_FLAG] = 0;
-      CreepFlag = MinStackGap*(stack_overflows+1);
+      CreepFlag = CalculateStackGap();
 #if defined(__GNUC__) && defined(hppa)
      /* siglongjmp resets the TR hardware register */
       restore_TR();

C/grow.c

@@ -695,7 +695,7 @@ growstack(long size)
   fix_tabling_info();
 #endif
   YAPLeaveCriticalSection();
-  CreepFlag = MinStackGap*(stack_overflows+1);
+  CreepFlag = CalculateStackGap();
   ASP += 256;
   growth_time = cputime()-start_growth_time;
   total_stack_overflow_time += growth_time;
@@ -815,7 +815,7 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
   }
   AdjustRegs(MaxTemps);
   YAPLeaveCriticalSection();
-  CreepFlag = MinStackGap*(stack_overflows+1);
+  CreepFlag = CalculateStackGap();
   ASP += 256;
   growth_time = cputime()-start_growth_time;
   total_stack_overflow_time += growth_time;

C/heapgc.c

@@ -21,10 +21,12 @@ static char     SccsId[] = "%W% %G%";
 #include "absmi.h"
 #include "yapio.h"
 
+#define DEBUG 1
 
 #define EARLY_RESET 1
 #define EASY_SHUNTING 1
-#define HYBRID_SCHEME 1
+//#define HYBRID_SCHEME 1
+
 
 #ifdef MULTI_ASSIGNMENT_VARIABLES
 /* 
@@ -153,6 +155,8 @@ static choiceptr current_B;
 static tr_fr_ptr sTR;
 #endif
 
+static tr_fr_ptr new_TR;
+
 STATIC_PROTO(void push_registers, (Int, yamop *));
 STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
 STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
@@ -655,7 +659,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
 
 #ifdef DEBUG
 
-/*#define INSTRUMENT_GC 1*/
+#define INSTRUMENT_GC 1
 /*#define CHECK_CHOICEPOINTS 1*/
 
 #ifdef INSTRUMENT_GC
@@ -780,16 +784,25 @@ check_global(void) {
 #if INSTRUMENT_GC
     if (IsVarTerm(ccurr)) {
       if (IsBlobFunctor((Functor)ccurr)) vars[gc_num]++;
-      else if (ccurr != 0 && ccurr < (CELL)HeapTop) vars[gc_func]++;
+      else if (ccurr != 0 && ccurr < (CELL)HeapTop) {
+	/*	printf("%p: %s/%d\n", current,
+	       RepAtom(NameOfFunctor((Functor)ccurr))->StrOfAE,
+	       ArityOfFunctor((Functor)ccurr));*/
+	vars[gc_func]++;
+      }
       else if (IsUnboundVar((CELL)current)) vars[gc_var]++;
       else vars[gc_ref]++;
     } else if (IsApplTerm(ccurr)) {
+      //      printf("%p: f->%p\n",current,RepAppl(ccurr));
       vars[gc_appl]++;
     } else if (IsPairTerm(ccurr)) {
+      //      printf("%p: l->%p\n",current,RepPair(ccurr));
       vars[gc_list]++;
     } else if (IsAtomTerm(ccurr)) {
+      //      printf("%p: %s\n",current,RepAtom(AtomOfTerm(ccurr))->StrOfAE);
       vars[gc_atom]++;
     } else if (IsIntTerm(ccurr)) {
+      //      printf("%p: %d\n",current,IntOfTerm(ccurr));
       vars[gc_int]++;
     }
 #endif
@@ -1202,12 +1215,18 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 	mark_external_reference(&TrailTerm(trail_ptr));	
 	UNMARK(&TrailTerm(trail_ptr));
 #endif /* EARLY_RESET */
-      } else {
+      } else if (hp < (CELL *)HeapTop) {
-	if (hp < (CELL *)HeapTop) {
 	  /* I decided to allow pointers from the Heap back into the trail.
 	   The point of doing so is to have dynamic arrays */
-	  mark_external_reference(hp);
+	mark_external_reference(hp);
-	}
+      } else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)TrailBase) {
+	/* clean the trail, avoid dangling pointers! */
+	RESET_VARIABLE(&TrailTerm(trail_ptr));
+#ifdef FROZEN_REGS
+	RESET_VARIABLE(&TrailVal(trail_ptr));
+#endif
+	discard_trail_entries++;
+      } else {
 #ifdef EASY_SHUNTING
 	if (hp < gc_H   && hp >= H0) {
 	  CELL *cptr = (CELL *)trail_cell;
@@ -1300,9 +1319,16 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 #if  MULTI_ASSIGNMENT_VARIABLES
   while (live_list != NULL) {
     CELL trail_cell = TrailTerm(live_list->trptr-1);
+    CELL trail_cell2 = TrailTerm(live_list->trptr);
     if (HEAP_PTR(trail_cell)) {
       mark_external_reference(&TrailTerm(live_list->trptr-1));
     }
+    /*
+      swap the two so that the sweep_trail() knows we have
+      a multi-assignment binding
+    */
+    TrailTerm(live_list->trptr) = TrailTerm(live_list->trptr-1);
+    TrailTerm(live_list->trptr-1) = trail_cell2;
     live_list = live_list->ma_list;
   }
 #endif
@@ -1325,10 +1351,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 #endif /* TABLING_SCHEDULING */
 #endif
 
-#ifdef DEBUG
-//#define CHECK_CHOICEPOINTS 1
-#endif
-
 #ifdef CHECK_CHOICEPOINTS
 #ifndef ANALYST
 
@@ -1379,7 +1401,15 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
     case _retry_userc:
     case _trust_logical_pred:
     case _retry_profiled:
-      printf("B  %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
+      {
+	Atom at;
+	UInt arity;
+	SMALLUNSGN mod;
+	if (PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod))
+	  printf("B  %p (%s) at %s/%d  with %d,%d\nf", gc_B, op_names[opnum], RepAtom(at)->StrOfAE, arity, gc_B->cp_h-H0, total_marked);
+        else
+	  printf("B  %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
+      }
       break;
 #ifdef TABLING
     case _table_completion:
@@ -1389,11 +1419,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
 	op_numbers caller_op = op_from_opcode(ENV_ToOp(gc_B->cp_cp));
 	/* first condition  checks if this was a meta-call */
 	if ((caller_op != _call  && caller_op != _fcall) || pe == NULL) {
-	  printf("B  %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
+	  printf("B  %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
 	} else if (pe->ArityOfPE)
-	  printf("B  %p (%s for %s/%d) with %d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked);
+	  printf("B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
 	else
-	  printf("B  %p (%s for %s/0) with %d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked);
+	  printf("B  %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
       }
       break;
 #endif
@@ -1403,14 +1433,21 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
 	if (pe == NULL) {
 	  printf("B  %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
 	} else if (pe->ArityOfPE)
-	  printf("B  %p (%s for %s/%d) with %d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked);
+	  printf("B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
 	else
-	  printf("B  %p (%s for %s/0) with %d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked);
+	  printf("B  %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
       }
     }
 #endif /* CHECK_CHOICEPOINTS */
-    mark_trail(saved_TR, gc_B->cp_tr, gc_B->cp_h, gc_B);
+    {
-    saved_TR = gc_B->cp_tr;
+      /* find out how many cells are still alive in the trail */
+      UInt d0 = discard_trail_entries, diff, orig;
+      orig = saved_TR-gc_B->cp_tr;
+      mark_trail(saved_TR, gc_B->cp_tr, gc_B->cp_h, gc_B);
+      saved_TR = gc_B->cp_tr;
+      diff = discard_trail_entries-d0;
+      gc_B->cp_tr = (tr_fr_ptr)(orig-diff);
+    }
   restart_cp:
     if (opnum == _or_else || opnum == _or_last) {
       /* ; choice point */
@@ -1640,15 +1677,26 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
 static void 
 sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
 {
-  tr_fr_ptr     trail_ptr;
+  tr_fr_ptr     trail_ptr, dest, tri = (tr_fr_ptr)db_vec;
-  CELL *cp_H = gc_B->cp_h;
   Int OldHeapUsed = HeapUsed;
 #ifdef DEBUG
   Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0,
     hp_in_use_erased = 0, code_entries = 0;
 #endif
+#if  MULTI_ASSIGNMENT_VARIABLES
+  tr_fr_ptr next_timestamp = NULL;
+#endif
 
-
+  /* adjust cp_tr pointers */
+ {
+   Int size = old_TR-(tr_fr_ptr)TrailBase;
+   size -= discard_trail_entries;
+   while (gc_B != NULL) {
+     size -= (UInt)(gc_B->cp_tr);
+     gc_B->cp_tr = (tr_fr_ptr)TrailBase+size;
+     gc_B = gc_B->cp_b;
+   }
+ }
 #if DB_SEARCH_METHOD
 #if DEBUG
   {
@@ -1671,129 +1719,173 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
   }
  
   /* next, follows the real trail entries */
-  trail_ptr = old_TR;
+  trail_ptr = (tr_fr_ptr)TrailBase;
-  while (trail_ptr > (tr_fr_ptr)TrailBase) {
+  dest = trail_ptr;
+  while (trail_ptr < old_TR) {
     register CELL trail_cell;
 
-    trail_ptr--;
-
     trail_cell = TrailTerm(trail_ptr);
 
-    if (gc_B && trail_ptr < gc_B->cp_tr) {
+    if (trail_cell == (CELL)trail_ptr) {
-      do {
+      trail_ptr++;
-	gc_B = gc_B->cp_b;
+      /* just skip cell */
-      } while (gc_B && trail_ptr < gc_B->cp_tr);
+    } else {
-      cp_H = gc_B->cp_h;
+      TrailTerm(dest) = trail_cell;
-    }
-
-    if (IsVarTerm(trail_cell)) {
-      /* we need to check whether this is a honest to god trail entry */
-      if ((CELL *)trail_cell < cp_H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
-	if (HEAP_PTR(trail_cell)) {
-	  into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(trail_cell));
-	}
-      } else if ((CELL *)trail_cell < (CELL *)HeapTop) {
-	/* we may have pointers from the heap back into the cell */
-	UNMARK(CellPtr(trail_cell));
-	if (HEAP_PTR(trail_cell)) {
-	  into_relocation_chain(CellPtr(trail_cell), GET_NEXT(*(CELL *)trail_cell));
-	}
-      } else {
-	/* clean the trail, avoid dangling pointers! */
-	if ((CELL *)trail_cell < (CELL *)gc_B && (CELL *)trail_cell >= H0) {
-	  RESET_VARIABLE(&TrailTerm(trail_ptr));
 #ifdef FROZEN_REGS
-	  RESET_VARIABLE(&TrailVal(trail_ptr));
+      TrailVal(dest) = TrailVal(trail_ptr);
 #endif
-	  discard_trail_entries++;
+      if (IsVarTerm(trail_cell)) {
+	/* we need to check whether this is a honest to god trail entry */
+	if ((CELL *)trail_cell < H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
+	  if (HEAP_PTR(trail_cell)) {
+	    into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
+	  }
+	} else if ((CELL *)trail_cell < (CELL *)HeapTop) {
+	  /* we may have pointers from the heap back into the cell */
+	  UNMARK(CellPtr(trail_cell));
+	  if (HEAP_PTR(trail_cell)) {
+	    into_relocation_chain(CellPtr(trail_cell), GET_NEXT(*(CELL *)trail_cell));
+	  }
 	}
-      }
 #ifdef FROZEN_REGS
-      if (MARKED(TrailVal(trail_ptr))) {
+	if (MARKED(TrailVal(dest))) {
-	UNMARK(&TrailVal(trail_ptr));
+	  UNMARK(&TrailVal(dest));
-	if (HEAP_PTR(TrailVal(trail_ptr))) {
+	  if (HEAP_PTR(TrailVal(dest))) {
-	  into_relocation_chain(&TrailVal(trail_ptr), GET_NEXT(TrailVal(trail_ptr)));
+	    into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
+	  }
 	}
-      }
 #endif
-    } else if (IsPairTerm(trail_cell)) {
+      } else if (IsPairTerm(trail_cell)) {
-      CELL *pt0 = RepPair(trail_cell);
+	CELL *pt0 = RepPair(trail_cell);
-      CELL flags;
+	CELL flags;
 
 
 #ifdef FROZEN_REGS  /* TRAIL */
-      /* process all segments */
+	/* process all segments */
-      if (
+	if (
 #ifdef SBA
-	  (ADDR) pt0 >= HeapTop
+	    (ADDR) pt0 >= HeapTop
 #else
-	  (ADDR) pt0 >= TrailBase
+	    (ADDR) pt0 >= TrailBase
 #endif
-	  ) {
+	    ) {
-	continue;
+	  continue;
-      }
+	}
 #endif /* FROZEN_REGS */
-      flags = Flags((CELL)pt0);
+	flags = Flags((CELL)pt0);
 #ifdef DEBUG
-      if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
+	if (FlagOn(DBClMask, flags) && !FlagOn(LogUpdMask, flags)) {
-	hp_entrs++;
+	  hp_entrs++;
-	if (!FlagOn(GcFoundMask, flags)) {
+	  if (!FlagOn(GcFoundMask, flags)) {
-	  hp_not_in_use++;
+	    hp_not_in_use++;
-	  if (FlagOn(ErasedMask, flags)) {
+	    if (FlagOn(ErasedMask, flags)) {
-	    hp_erased++;
+	      hp_erased++;
+	    }
+	  } else {
+	    if (FlagOn(ErasedMask, flags)) {
+	      hp_in_use_erased++;
+	    }		
 	  }
 	} else {
-	  if (FlagOn(ErasedMask, flags)) {
+	  code_entries++;
-	    hp_in_use_erased++;
-	  }		
 	}
-      } else {
-	code_entries++;
-      }
 #endif
       
-      if (!FlagOn(GcFoundMask, flags)) {
+	if (!FlagOn(GcFoundMask, flags)) {
-	if (FlagOn(DBClMask, flags)  && !FlagOn(LogUpdMask, flags)) {
+	  if (FlagOn(DBClMask, flags)  && !FlagOn(LogUpdMask, flags)) {
-	  Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
+	    Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
-	  if (FlagOn(ErasedMask, flags)) {
+	    if (FlagOn(ErasedMask, flags)) {
-	    ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)));
+	      ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)));
+	    }
+	    RESET_VARIABLE(&TrailTerm(dest));
+	    discard_trail_entries++;
 	  }
-	  RESET_VARIABLE(trail_ptr);
+	} else {
-	  discard_trail_entries++;
+	  Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
 	}
-      } else {
-	Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
-      }
 #if  MULTI_ASSIGNMENT_VARIABLES
-    } else {
+      } else {
-      CELL *old_value_ptr = (CELL *)trail_ptr;
+	CELL trail_cell = TrailTerm(trail_ptr);
+	CELL *ptr;
+	CELL old = TrailTerm(trail_ptr+1);
 
-      if (MARKED(trail_cell)) {
+	if (MARKED(trail_cell)) 
-	UNMARK(&TrailTerm(trail_ptr));
+	  ptr = RepAppl(UNMARK_CELL(trail_cell));
-	if (HEAP_PTR(TrailTerm(trail_ptr))) {
+	else
-	  into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(trail_cell));
+	  ptr = RepAppl(trail_cell);
+
+	/* now, we must check whether we are looking at a time-stamp */
+	if (next_timestamp == trail_ptr) {
+	  /* we have a time stamp. Problem is: the trail shifted and we can not trust the
+	     current time stamps */
+	  CELL old_cell = *ptr;
+	  int was_marked = MARKED(old_cell);
+	  tr_fr_ptr old_timestamp;
+
+	  if (was_marked)
+	    old_cell = UNMARK_CELL(old_cell);
+	  old_timestamp = (tr_fr_ptr)TrailBase+IntegerOfTerm(old_cell);
+
+	  if (old_timestamp >= trail_ptr) {
+	    /* first time, we found the current timestamp */
+	    old = MkIntTerm(0);
+	  } else {
+	    /* set time stamp to current */
+	    old = old_cell;
+	  }
+	  *ptr = MkIntegerTerm(dest-(tr_fr_ptr)TrailBase);
+	  if (was_marked)
+	    MARK(ptr);
+	} else if (ptr < H0 || UNMARK_CELL(ptr[-1]) == (CELL)FunctorMutable) {
+	  /* yes, we do have a time stamp */
+	  next_timestamp = trail_ptr+2;
 	}
-      }
+
-      trail_cell = old_value_ptr[-1];
+	TrailTerm(dest) = old;
+	TrailTerm(dest+1) = trail_cell;
+	if (MARKED(old)) {
+	  UNMARK(&TrailTerm(dest));
+	  if (HEAP_PTR(old)) {
+	    into_relocation_chain(&TrailTerm(dest), GET_NEXT(old));
+	  }
+	}
+	dest++;
+	if (MARKED(trail_cell)) {
+	  UNMARK(&TrailTerm(dest));
+	  if (HEAP_PTR(trail_cell)) {
+	    if (next_timestamp == trail_ptr) {
+	      /* wait until we're over to insert in relocation chain */
+	      TrailTerm(tri) = (CELL)dest;
+	      tri++;
+	    } else {
+	      into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
+	    }
+	  }
+	}
+	trail_ptr++;
 #ifdef FROZEN_REGS
-      if (MARKED(TrailVal(trail_ptr))) {
+	TrailVal(dest) = TrailVal(trail_ptr);
-	UNMARK(&TrailVal(trail_ptr));
+	if (MARKED(TrailVal(dest))) {
-	if (HEAP_PTR(TrailVal(trail_ptr))) {
+	  UNMARK(&TrailVal(dest));
-	  into_relocation_chain(&TrailVal(trail_ptr), GET_NEXT(TrailTerm(trail_ptr)));
+	  if (HEAP_PTR(TrailVal(dest))) {
+	    into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest)));
+	  }
 	}
-      }
 #endif
-      old_value_ptr--;
-      if (MARKED(trail_cell)) {
-	UNMARK(old_value_ptr);
-	if (HEAP_PTR(trail_cell)) {
-	  into_relocation_chain(old_value_ptr, GET_NEXT(trail_cell));
-	}
-      }
-      trail_ptr = (tr_fr_ptr)old_value_ptr;
 #endif
+      }
+      trail_ptr++;
+      dest++;
     }
   }
+  while (tri > (tr_fr_ptr)db_vec) {
+    tr_fr_ptr x = (tr_fr_ptr)TrailTerm(--tri);
+    CELL trail_cell = TrailTerm(x);
+    if (HEAP_PTR(trail_cell)) {
+      into_relocation_chain(&TrailTerm(x), GET_NEXT(trail_cell));
+    }
+  }
+  new_TR = dest;
   if (is_gc_verbose()) {
     YP_fprintf(YP_stderr,
 	       "[GC]       Trail: discarded %d (%ld%%) cells out of %ld\n",
@@ -2502,7 +2594,7 @@ icompact_heap(void)
 
 #ifdef EASY_SHUNTING
 static void
-set_conditionals(CELL *TRo) {
+set_conditionals(tr_fr_ptr TRo) {
   while (sTR != TRo) {
     CELL *cptr = (CELL *)TrailTerm(sTR-1);
     *cptr = TrailTerm(sTR-2);
@@ -2580,10 +2672,10 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
   if (total_marked != iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024)
     YP_fprintf(YP_stderr,"[GC] Oops on iptop-H (%d) vs %d\n", iptop-(CELL_PTR *)H, total_marked);
 #endif
-  if (iptop < (CELL_PTR *)ASP-1024 && 10*total_marked < H-H0) {
+  if (iptop < (CELL_PTR *)ASP /* && 10*total_marked < H-H0 */) {
     int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
 #ifdef DEBUG
-    fprintf(stderr,"using pointers (%d)\n", effectiveness);
+    YP_fprintf(YP_stderr,"[GC] using pointers (%d)\n", effectiveness);
 #endif
     quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
     adjust_cp_hbs();
@@ -2591,9 +2683,11 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
   } else
 #endif /* HYBRID_SCHEME */
     {
-#ifdef DEBUG_IN
+#ifdef DEBUG
+#ifdef HYBID_SCHEME
       int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
-      fprintf(stderr,"not using pointers (%d)\n", effectiveness);
+      fprintf(stderr,"[GC] not using pointers (%d) ASP: %p, ip %p (expected %p) \n", effectiveness, ASP, iptop, H+total_marked);
+#endif
 #endif
       compact_heap();
     }
@@ -2690,6 +2784,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   compaction_phase(old_TR, current_env, nextop, max);
   TR = old_TR;
   pop_registers(predarity, nextop);
+  TR = new_TR;
   c_time = cputime();
   YAPLeaveCriticalSection();
   if (gc_verbose) {
@@ -2714,7 +2809,12 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
 int
 is_gc_verbose(void)
 {
+#ifdef INSTRUMENT_GC
+  /* always give info when we are debugging gc */
+  return(TRUE);
+#else
   return(GetValue(AtomGcVerbose) != TermNil);
+#endif
 }
 
 Int total_gc_time(void)
@@ -2765,20 +2865,21 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
       gc_margin <<= 1;
   }
   /* expand the stak if effectiveness is less than 20 % */
-  if (ASP - H < gc_margin || !gc_on || effectiveness < 20) {
+  if (FALSE&& ASP - H < gc_margin || !gc_on || effectiveness < 20) {
+    UInt gap = CalculateStackGap();
     if (ASP-H > gc_margin)
-      gc_margin = (ASP-H)+MinStackGap*(stack_overflows+1);
+      gc_margin = (ASP-H)+gap;
     else
       gc_margin = 8 * (gc_margin - (ASP - H));
     gc_margin = ((gc_margin >> 16) + 1) << 16;
-    if (gc_margin < MinStackGap)
+    if (gc_margin < gap)
-      gc_margin = MinStackGap;
+      gc_margin = gap;
-    while (gc_margin >= MinStackGap && !growstack(gc_margin))
+    while (gc_margin >= gap && !growstack(gc_margin))
       gc_margin = gc_margin/2;
 #ifdef DEBUG
     check_global();
 #endif
-    return(gc_margin >= MinStackGap);
+    return(gc_margin >= gap);
   }
   /*
    * debug for(save_total=1; save_total<=N; ++save_total)

C/init.c

@@ -1015,6 +1015,7 @@ InitYaamRegs(void)
   BBREG = B_FZ = B_BASE;
   TR = TR_FZ = TR_BASE;
 #endif /* FROZEN_REGS */
+  CreepFlag = CalculateStackGap();
 
 }
 
@@ -1124,7 +1125,6 @@ InitStacks(int Heap,
   ReleaseAtom(AtomFoundVar);
   LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
   LookupAtomWithAddress(".",&(SF_STORE->AtDot));
-  CreepFlag = MinStackGap;
   PutValue(LookupAtom("$catch_counter"),
 	   MkIntTerm(0));
   /* InitAbsmi must be done before InitCodes */

C/iopreds.c

@@ -82,6 +82,9 @@ typedef struct
 	Int max_size;	   /* maximum buffer size (may be changed dynamically) */
 	Int pos;
       } mem_string;
+      struct {
+	int fd;
+      } pipe;
 #if USE_SOCKET
       struct {
 	socket_domain domain;
@@ -111,6 +114,8 @@ STATIC_PROTO (int post_process_read_char, (int, StreamDesc *, int));
 STATIC_PROTO (int SocketPutc, (int, int));
 STATIC_PROTO (int ConsoleSocketPutc, (int, int));
 #endif
+STATIC_PROTO (int PipePutc, (int, int));
+STATIC_PROTO (int ConsolePipePutc, (int, int));
 STATIC_PROTO (int NullPutc, (int, int));
 STATIC_PROTO (int ConsolePutc, (int, int));
 STATIC_PROTO (Int p_setprompt, (void));
@@ -119,6 +124,8 @@ STATIC_PROTO (int PlGetc, (int));
 STATIC_PROTO (int MemGetc, (int));
 STATIC_PROTO (int ISOGetc, (int));
 STATIC_PROTO (int ConsoleGetc, (int));
+STATIC_PROTO (int PipeGetc, (int));
+STATIC_PROTO (int ConsolePipeGetc, (int));
 #if USE_SOCKET
 STATIC_PROTO (int SocketGetc, (int));
 STATIC_PROTO (int ConsoleSocketGetc, (int));
@@ -214,6 +221,8 @@ StreamDesc Stream[MaxStreams];
 #define Server_Socket_Stream_f	0x010000
 #endif
 #define InMemory_Stream_f	0x020000
+#define Pipe_Stream_f		0x040000
+#define Popen_Stream_f		0x080000
 
 int YP_stdin = 0;
 int YP_stdout = 1;
@@ -276,7 +285,7 @@ YP_putc(int ch, int sno)
 int
 YP_fflush(int sno)
 {
-  if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f))
+  if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f|Pipe_Stream_f))
     return(0);
   return(fflush(Stream[sno].u.file.file));
 }
@@ -376,7 +385,11 @@ InitStdStream (int sno, SMALLUNSGN flags, YP_File file, Atom name)
     s->stream_getc = ConsoleSocketGetc;
   } else
 #endif
-  if (s->status & InMemory_Stream_f) {
+  if (s->status & Pipe_Stream_f) {
+    /* Console is a socket and socket will prompt */
+    s->stream_putc = ConsolePipePutc;
+    s->stream_getc = ConsolePipeGetc;
+  } else if (s->status & InMemory_Stream_f) {
     s->stream_putc = MemPutc;
     s->stream_getc = MemGetc;    
   } else {
@@ -629,8 +642,42 @@ SocketPutc (int sno, int ch)
   console_count_output_char(ch,s,sno);
   return ((int) ch);
 }
+
 #endif
 
+/* static */
+static int
+ConsolePipePutc (int sno, int ch)
+{
+  StreamDesc *s = &Stream[sno];
+  char c = ch;
+#if MAC || _MSC_VER
+  if (ch == 10)
+    {
+      ch = '\n';
+    }
+#endif
+  write(s->u.pipe.fd,  &c, sizeof(c));
+  count_output_char(ch,s,sno);
+  return ((int) ch);
+}
+
+static int
+PipePutc (int sno, int ch)
+{
+  StreamDesc *s = &Stream[sno];
+  char c = ch;
+#if MAC || _MSC_VER
+  if (ch == 10)
+    {
+      ch = '\n';
+    }
+#endif
+  write(s->u.pipe.fd,  &c, sizeof(c));
+  console_count_output_char(ch,s,sno);
+  return ((int) ch);
+}
+
 static int
 NullPutc (int sno, int ch)
 {
@@ -793,7 +840,12 @@ EOFGetc(int sno)
 	s->stream_putc = SocketPutc;
     } else 
 #endif
-    if (s->status & InMemory_Stream_f) {
+    if (s->status & Pipe_Stream_f) {
+      if (s->status & Promptable_Stream_f)
+	s->stream_putc = ConsolePipePutc;
+      else 
+	s->stream_putc = PipePutc;
+    } else if (s->status & InMemory_Stream_f) {
       s->stream_getc = MemGetc;
       s->stream_putc = MemPutc;
     } else if (s->status & Promptable_Stream_f) {
@@ -946,6 +998,61 @@ ConsoleSocketGetc(int sno)
 }
 #endif
 
+static int
+PipeGetc(int sno)
+{
+  register StreamDesc *s = &Stream[sno];
+  register int ch;
+  char c;
+  int count;
+	/* should be able to use a buffer */
+  count = read(s->u.pipe.fd, &c, sizeof(char));
+  if (count == 0) {
+    ch = EOF;
+  } else if (count > 0) {
+    ch = c;
+  } else {
+    Error(SYSTEM_ERROR, TermNil, "read");
+    return(EOF);
+  }
+  return(post_process_read_char(ch, s, sno));
+}
+
+/*
+  Basically, the same as console but also sends a prompt and takes care of
+  finding out whether we are at the start of a newline.
+*/
+static int
+ConsolePipeGetc(int sno)
+{
+  register StreamDesc *s = &Stream[sno];
+  register int ch;
+  char c;
+  int count;
+
+  /* send the prompt away */
+  if (newline) {
+    char *cptr = Prompt, ch;
+    /* use the default routine */
+    while ((ch = *cptr++) != '\0') {
+      Stream[StdErrStream].stream_putc(StdErrStream, ch);
+    }
+    strncpy(Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
+    newline = FALSE;
+  }
+  /* should be able to use a buffer */
+  count = read(s->u.pipe.fd, &c, sizeof(char));
+  if (count == 0) {
+    ch = EOF;
+  } else if (count > 0) {
+    ch = c;
+  } else {
+    Error(SYSTEM_ERROR, TermNil, "read");
+    return(EOF);
+  }
+  return(console_post_process_read_char(ch, s, sno));
+}
+
 /* standard routine, it should read from anything pointed by a FILE *.
    It could be made more efficient by doing our own buffering and avoiding
    post_process_read_char, something to think about */
@@ -1132,7 +1239,9 @@ GetStreamFd(int sno)
     return(Stream[sno].u.socket.fd);
   } else
 #endif
-  if (Stream[sno].status & InMemory_Stream_f) {
+  if (Stream[sno].status & Pipe_Stream_f) {
+    return(Stream[sno].u.pipe.fd);
+  } else if (Stream[sno].status & InMemory_Stream_f) {
     return(-1);
   }
   return(YP_fileno(Stream[sno].u.file.file));
@@ -1338,7 +1447,10 @@ p_open (void)
 	  st->stream_getc = SocketGetc;
 	} else
 #endif
-	if (st->status & InMemory_Stream_f) {
+	if (st->status & Pipe_Stream_f) {
+	  st->stream_putc = PipePutc;
+	  st->stream_getc = PipeGetc;
+	} else if (st->status & InMemory_Stream_f) {
 	  st->stream_putc = MemPutc;
 	  st->stream_getc = MemGetc;	  
 	} else {
@@ -1498,6 +1610,111 @@ p_open_null_stream (void)
   return (unify (ARG1, t));
 }
 
+Term
+OpenStream(FILE *fd, char *name, Term file_name, int flags)
+{
+  Term t;
+  StreamDesc *st;
+  int sno;
+
+  for (sno = 0; sno < MaxStreams; ++sno)
+    if (Stream[sno].status & Free_Stream_f)
+      break;
+  if (sno == MaxStreams)
+    return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1"));
+  st = &Stream[sno];
+  st->status = 0;
+  if (flags & YAP_INPUT_STREAM)
+    st->status |= Input_Stream_f;
+  if (flags & YAP_OUTPUT_STREAM)
+    st->status |= Output_Stream_f;
+  if (flags & YAP_APPEND_STREAM)
+    st->status |= Append_Stream_f;
+  /*
+    pipes assume an integer file descriptor, not a FILE *:
+    if (flags & YAP_PIPE_STREAM)
+    st->status |= Pipe_Stream_f;
+  */
+  if (flags & YAP_TTY_STREAM)
+    st->status |= Tty_Stream_f;
+  if (flags & YAP_POPEN_STREAM)
+    st->status |= Popen_Stream_f;
+  if (flags & YAP_BINARY_STREAM)
+    st->status |= Binary_Stream_f;
+  if (flags & YAP_SEEKABLE_STREAM)
+    st->status |= Seekable_Stream_f;
+  st->charcount = 0;
+  st->linecount = 1;
+  st->u.file.name = LookupAtom(name);
+  st->u.file.user_name = file_name;
+  st->u.file.file = fd;
+  st->linepos = 0;
+  if (flags & YAP_PIPE_STREAM) {
+    st->stream_putc = PipePutc;
+    st->stream_getc = PipeGetc;
+  } else if (flags & YAP_TTY_STREAM) {
+    st->stream_putc = ConsolePutc;
+    st->stream_getc = ConsoleGetc;
+  } else {
+    st->stream_putc = FilePutc;
+    st->stream_getc = PlGetc;
+    unix_upd_stream_info (st);
+  }
+  if (CharConversionTable != NULL)
+    st->stream_getc_for_read = ISOGetc;
+  else
+    st->stream_getc_for_read = st->stream_getc; 
+  t = MkStream (sno);
+  return (t);
+}
+
+static Int
+p_open_pipe_stream (void)
+{
+  Term t1, t2;
+  StreamDesc *st;
+  int sno;
+  int filedes[2];
+
+  if (pipe(filedes) != 0) {
+    return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
+  }
+  for (sno = 0; sno < MaxStreams; ++sno)
+    if (Stream[sno].status & Free_Stream_f)
+      break;
+  if (sno == MaxStreams)
+    return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
+  st = &Stream[sno];
+  st->status = Input_Stream_f | Pipe_Stream_f;
+  st->linepos = 0;
+  st->charcount = 0;
+  st->linecount = 1;
+  st->stream_putc = PipePutc;
+  st->stream_getc = PipeGetc;
+  st->stream_getc_for_read = PipeGetc;
+  st->u.pipe.fd = filedes[0];
+  t1 = MkStream (sno);
+  for (; sno < MaxStreams; ++sno)
+    if (Stream[sno].status & Free_Stream_f)
+      break;
+  if (sno == MaxStreams)
+    return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
+  st = &Stream[sno];
+  st->status = Output_Stream_f | Pipe_Stream_f;
+  st->linepos = 0;
+  st->charcount = 0;
+  st->linecount = 1;
+  st->stream_putc = PipePutc;
+  st->stream_getc = PipeGetc;
+  if (CharConversionTable != NULL)
+    st->stream_getc_for_read = ISOGetc;
+  else
+    st->stream_getc_for_read = st->stream_getc; 
+  st->u.pipe.fd = filedes[1];
+  t2 = MkStream (sno);
+  return (unify (ARG1, t1) && unify (ARG2, t2));
+}
+
 static Int
 p_open_mem_read_stream (void)   /* $open_mem_read_stream(+List,-Stream) */
 {
@@ -1839,11 +2056,42 @@ p_check_if_stream (void)
 	  != -1);
 }
 
+static Term
+StreamName(int i)
+{
+#if USE_SOCKET
+  if (Stream[i].status & Socket_Stream_f)
+    return(MkAtomTerm(LookupAtom("socket")));
+  else
+#endif
+    if (Stream[i].status & Pipe_Stream_f)
+      return(MkAtomTerm(LookupAtom("pipe")));
+    if (Stream[i].status & InMemory_Stream_f)
+      return(MkAtomTerm(LookupAtom("charsio")));
+    else
+      return(MkAtomTerm(Stream[i].u.file.name));
+}
+
 static Int
 init_cur_s (void)
 {				/* Init current_stream */
-  EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0);
+  Term t3 = Deref(ARG3);
-  return (cont_cur_s ());
+  if (!IsVarTerm(t3)) {
+    Int i = CheckStream (t3, Input_Stream_f|Output_Stream_f, "current_stream/3");
+    Term t1 = StreamName(i), t2;
+    
+    t2 = (Stream[i].status & Input_Stream_f ?
+	  MkAtomTerm (AtomRead) :
+	  MkAtomTerm (AtomWrite));
+    if (unify(ARG1,t1) && unify(ARG2,t2)) {
+      cut_succeed();
+    } else {
+      cut_fail();
+    }
+  } else {
+    EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0);
+    return (cont_cur_s ());
+  }
 }
 
 static Int
@@ -1858,15 +2106,7 @@ cont_cur_s (void)
 	  ++i;
 	  continue;
 	}
-#if USE_SOCKET
+      t1 = StreamName(i);
-      if (Stream[i].status & Socket_Stream_f)
-	t1 = MkAtomTerm(LookupAtom("socket"));
-      else
-#endif
-      if (Stream[i].status & InMemory_Stream_f)
-	t1 = MkAtomTerm(LookupAtom("charsio"));
-      else
-	t1 = MkAtomTerm(Stream[i].u.file.name);
       t2 = (Stream[i].status & Input_Stream_f ?
 	    MkAtomTerm (AtomRead) :
 	    MkAtomTerm (AtomWrite));
@@ -1893,40 +2133,43 @@ void
 CloseStreams (int loud)
 {
   int sno;
-  for (sno = 3; sno < MaxStreams; ++sno)
+  for (sno = 3; sno < MaxStreams; ++sno) {
-    {
+    if (Stream[sno].status & Free_Stream_f)
-      if (Stream[sno].status & Free_Stream_f)
+      continue;
-	continue;
+    if ((Stream[sno].status & Popen_Stream_f))
-      if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
+      pclose (Stream[sno].u.file.file);
-	YP_fclose (Stream[sno].u.file.file);
+    if ((Stream[sno].status & (Pipe_Stream_f|Socket_Stream_f)))
+      close (Stream[sno].u.pipe.fd);
 #if USE_SOCKET
-      else if (Stream[sno].status & (Socket_Stream_f)) {
+    else if (Stream[sno].status & (Socket_Stream_f)) {
-		CloseSocket(Stream[sno].u.socket.fd,
+      CloseSocket(Stream[sno].u.socket.fd,
-		Stream[sno].u.socket.flags,
+		  Stream[sno].u.socket.flags,
-		Stream[sno].u.socket.domain);
+		  Stream[sno].u.socket.domain);
-      } 
+    } 
 #endif
-      else {
+    else if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
+      YP_fclose (Stream[sno].u.file.file);
+    else {
       if (loud)
 	YP_fprintf (YP_stderr, "[ Error: while closing stream: %s ]\n", RepAtom (Stream[sno].u.file.name)->StrOfAE);
-      if (c_input_stream == sno)
-	{
-	  c_input_stream = StdInStream;
-	}
-      else if (c_output_stream == sno)
-	{
-	  c_output_stream = StdOutStream;
-	}
-	  }
-      Stream[sno].status = Free_Stream_f;
     }
+    if (c_input_stream == sno)
+      {
+	c_input_stream = StdInStream;
+      }
+    else if (c_output_stream == sno)
+      {
+	c_output_stream = StdOutStream;
+      }
+  }
+  Stream[sno].status = Free_Stream_f;
 }
 
 
 void
 CloseStream(int sno)
 {
-  if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
+  if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f|Pipe_Stream_f)))
     YP_fclose (Stream[sno].u.file.file);
 #if USE_SOCKET
   else if (Stream[sno].status & (Socket_Stream_f)) {
@@ -1935,6 +2178,9 @@ CloseStream(int sno)
 		Stream[sno].u.socket.domain);
   }
 #endif
+  else if (Stream[sno].status & (Pipe_Stream_f)) {
+    close(Stream[sno].u.pipe.fd);
+  }
   else if (Stream[sno].status & (InMemory_Stream_f)) {
     FreeAtomSpace(Stream[sno].u.mem_string.buf);
   }
@@ -2332,7 +2578,7 @@ p_read (void)
 
     /* Scans the term using stack space */
     eot_before_eof = FALSE;
-    if ((Stream[c_input_stream].status & (Promptable_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || CharConversionTable != NULL)
+    if ((Stream[c_input_stream].status & (Promptable_Stream_f|Pipe_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || CharConversionTable != NULL)
       tokstart = tokptr = toktide = tokenizer (Stream[c_input_stream].stream_getc_for_read, Stream[c_input_stream].stream_getc);
     else {
       tokstart = tokptr = toktide = fast_tokenizer ();
@@ -2507,7 +2753,9 @@ p_user_file_name (void)
     tout = MkAtomTerm(LookupAtom("socket"));
   else
 #endif
-  if (Stream[sno].status & InMemory_Stream_f)
+  if (Stream[sno].status & Pipe_Stream_f)
+    tout = MkAtomTerm(LookupAtom("pipe"));
+  else if (Stream[sno].status & InMemory_Stream_f)
     tout = MkAtomTerm(LookupAtom("charsio"));
   else
     tout = Stream[sno].u.file.user_name;
@@ -2526,7 +2774,9 @@ p_file_name (void)
     tout = MkAtomTerm(LookupAtom("socket"));
   else
 #endif
-  if (Stream[sno].status & InMemory_Stream_f)
+  if (Stream[sno].status & Pipe_Stream_f)
+    tout = MkAtomTerm(LookupAtom("pipe"));
+  else if (Stream[sno].status & InMemory_Stream_f)
     tout = MkAtomTerm(LookupAtom("charsio"));
   else
     tout = MkAtomTerm(Stream[sno].u.file.name);
@@ -2552,13 +2802,16 @@ p_cur_line_no (void)
 	my_stream = LookupAtom("socket");
       else
 #endif
+      if (Stream[sno].status & Pipe_Stream_f)
+	my_stream = LookupAtom("pipe");
+      else
 	if (Stream[sno].status & InMemory_Stream_f)
 	  my_stream = LookupAtom("charsio");
 	else
 	  my_stream = Stream[sno].u.file.name;
       for (i = 0; i < MaxStreams; i++)
 	{
-	  if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|InMemory_Stream_f)) &&
+	  if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)) &&
 	      Stream[i].u.file.name == my_stream)
 	    no += Stream[i].linecount - 1;
 	}
@@ -2643,7 +2896,7 @@ p_show_stream_position (void)
   CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "stream_position/2");
   if (sno < 0)
     return (FALSE);
-  if (Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|InMemory_Stream_f))
+  if (Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f))
     sargs[0] = MkIntTerm (Stream[sno].charcount);
   else if (Stream[sno].status & Null_Stream_f)
     sargs[0] = MkIntTerm (Stream[sno].charcount);
@@ -3897,7 +4150,7 @@ p_flush (void)
   int sno = CheckStream (ARG1, Output_Stream_f, "flush_output/1");
   if (sno < 0)
     return (FALSE);
-  if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
+  if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)))
     YP_fflush (sno);
   return (TRUE);
 }
@@ -4250,6 +4503,21 @@ p_all_char_conversions(void)
   return(unify(ARG1,out));
 }
 
+int
+StreamToFileNo(Term t)
+{
+  int sno  =
+    CheckStream(t, (Input_Stream_f|Output_Stream_f), "StreamToFileNo");
+  if (Stream[sno].status & Pipe_Stream_f) {
+    return(Stream[sno].u.pipe.fd);
+  } else if (Stream[sno].status & Socket_Stream_f) {
+    return(Stream[sno].u.socket.fd);
+  } else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) {
+    return(-1);
+  } else {
+    return(YP_fileno(Stream[sno].u.file.file));
+  }
+}
 
 void
 InitBackIO (void)
@@ -4274,6 +4542,7 @@ InitIOPreds(void)
   InitCPred ("$get_byte", 2, p_get_byte, SafePredFlag|SyncPredFlag);
   InitCPred ("$open", 4, p_open, SafePredFlag|SyncPredFlag);
   InitCPred ("$open_null_stream", 1, p_open_null_stream, SafePredFlag|SyncPredFlag);
+  InitCPred ("$open_pipe_stream", 2, p_open_pipe_stream, SafePredFlag|SyncPredFlag);
   InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
   InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
   InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag);

C/mavar.c

@@ -92,12 +92,11 @@ p_setarg(void)
    timestamps.
 
    Because of !, the only timestamp one can trust is the trailpointer
-   (ouch..). The trail is not reclaimed during backtracking. Also, if
+   (ouch..). The trail is not reclaimed after cuts. Also, if there was
-   there was a conditional binding, the trail is sure to have been
+   a conditional binding, the trail is sure to have been increased
-   increased since the last choicepoint. For maximum effect, we can
+   since the last choicepoint. For maximum effect, we can actually
-   actually store the current value of TR in the timestamp field,
+   store the current value of TR in the timestamp field, giving a way
-   giving a way to actually follow a link of all trailings for these
+   to actually follow a link of all trailings for these variables.
-   variables.
 
 */
 
@@ -114,6 +113,8 @@ static void
 CreateTimedVar(Term val)
 {
   timed_var *tv = (timed_var *)H;
+  tv->clock = MkIntTerm(0);
+#ifdef BEFORE_TRAIL_COMPRESSION
   tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
   if (B->cp_tr == TR) {
     /* we run the risk of not making non-determinate bindings before
@@ -121,6 +122,7 @@ CreateTimedVar(Term val)
     /* so we just init a TR cell that will not harm anyone */
     Bind((CELL *)(TR+1),AbsAppl(H-1));
   }
+#endif
   tv->value = val;
   H += sizeof(timed_var)/sizeof(CELL);
 }
@@ -129,6 +131,8 @@ static void
 CreateEmptyTimedVar(void)
 {
   timed_var *tv = (timed_var *)H;
+  tv->clock = MkIntTerm(0);
+#ifdef BEFORE_TRAIL_COMPRESSION
   tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
   if (B->cp_tr == TR) {
     /* we run the risk of not making non-determinate bindings before
@@ -136,6 +140,7 @@ CreateEmptyTimedVar(void)
     /* so we just init a TR cell that will not harm anyone */
     Bind((CELL *)(TR+1),AbsAppl(H-1));
   }
+#endif
   RESET_VARIABLE(&(tv->value));
   H += sizeof(timed_var)/sizeof(CELL);
 }

C/stdpreds.c

@@ -1247,7 +1247,7 @@ static Int
 p_abort(void)
 {				/* abort			 */
   /* make sure we won't go creeping around */
-  CreepFlag = MinStackGap*(stack_overflows+1);
+  CreepFlag = CalculateStackGap();
   yap_flags[SPY_CREEP_FLAG] = 0;
   Error(PURE_ABORT,TermNil,"");
   return(FALSE);

C/sysbits.c

@@ -82,12 +82,6 @@ static char SccsId[] = "%W% %G%";
 #endif
 #endif
 
-#ifdef __MINGW32__
-#ifdef HAVE_ENVIRON
-#undef HAVE_ENVIRON
-#endif
-#endif
-
 STATIC_PROTO (void InitPageSize, (void));
 STATIC_PROTO (void InitTime, (void));
 STATIC_PROTO (void InitWTime, (void));
@@ -98,11 +92,11 @@ STATIC_PROTO (Int p_mv, (void));
 STATIC_PROTO (Int p_cd, (void));
 STATIC_PROTO (Int p_getcwd, (void));
 STATIC_PROTO (Int p_dir_sp, (void));
-STATIC_PROTO (Int p_getenv, (void));
-STATIC_PROTO (Int p_environ, (void));
 STATIC_PROTO (void InitRandom, (void));
 STATIC_PROTO (Int p_srandom, (void));
 STATIC_PROTO (Int p_alarm, (void));
+STATIC_PROTO (Int p_getenv, (void));
+STATIC_PROTO (Int p_putenv, (void));
 #ifdef MACYAP
 STATIC_PROTO (int chdir, (char *));
 /* #define signal	skel_signal */
@@ -1233,7 +1227,7 @@ HandleSIGINT (int sig)
 #else
 #ifdef HAVE_SETBUF
   /* make sure we are not waiting for the end of line */
-  YP_setbuf (YP_stdin, NULL); 
+  YP_setbuf (stdin, NULL); 
 #endif
   my_signal(SIGINT, HandleSIGINT);
 #endif
@@ -1800,35 +1794,6 @@ SetTextFile (name)
 
 #endif
 
-/* return YAP's environment */
-static Int p_environ(void)
-{
-#if HAVE_ENVIRON
-  extern char **environ;
-  Term t1 = Deref(ARG1);
-  Int i;
-
-  if (IsVarTerm(t1)) {
-    Error(INSTANTIATION_ERROR, t1,
-	  "first arg of environ/2");
-    return(FALSE);
-  } else if (!IsIntTerm(t1)) {
-    Error(TYPE_ERROR_INTEGER, t1,
-	  "first arg of environ/2");
-    return(FALSE);
-  } else i = IntOfTerm(t1);
-  if (environ[i] == NULL)
-    return(FALSE);
-  else {
-    Term t = StringToList(environ[i]);
-    return(unify(t, ARG2));
-  }
-#else
-    Error(SYSTEM_ERROR, TermNil,
-	  "environ not available in this configuration");
-    return (FALSE);
-#endif
-}
 
 /* return YAP's environment */
 static Int p_getenv(void)
@@ -1903,7 +1868,6 @@ static Int p_putenv(void)
 #endif
 }
 
-
 /* wrapper for alarm system call */
 #if defined(_WIN32)
 static VOID CALLBACK HandleTimer(LPVOID v, DWORD d1, DWORD d2) {
@@ -2028,10 +1992,9 @@ InitSysPreds(void)
   InitCPred ("$cd", 1, p_cd, SafePredFlag|SyncPredFlag);
   InitCPred ("$getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag);
   InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag);
-  InitCPred ("$environ", 2, p_environ, SafePredFlag);
+  InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
   InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
   InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
-  InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
 }
 
 

C/tracer.c

@@ -129,10 +129,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   extern int gc_calls;
 
   vsc_count++;
-  if (vsc_count < 2810) return;
+  /* if (vsc_count < 4382) return;*/
   /* if (vsc_count > 500000) exit(0); */
   /* if (gc_calls < 1) return;*/
-  YP_fprintf(YP_stderr,"%lu ",vsc_count);
+  YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H);
   /* check_trail_consistency(); */
   if (pred == NULL) {
     return;

H/Regs.h

@@ -10,7 +10,7 @@
 * File:		Regs.h							 *
 * mods:									 *
 * comments:	YAP abstract machine registers				 *
-* version:      $Id: Regs.h,v 1.1.1.1 2001-04-09 19:53:39 vsc Exp $	 *
+* version:      $Id: Regs.h,v 1.2 2001-05-21 20:00:05 vsc Exp $	 *
 *************************************************************************/
 
 
@@ -682,3 +682,10 @@ EXTERN inline void restore_B(void) {
 REGSTORE standard_regs;
 #endif /* PUSH_REGS */
 
+static inline UInt
+CalculateStackGap(void)
+{
+  UInt gmin = (LCL0-H0)>>1;
+  UInt min_gap = MinStackGap;
+  return(gmin < min_gap ? min_gap : gmin );
+}

H/yapio.h

@@ -259,9 +259,21 @@ int   STD_PROTO(GetStreamFd,(int));
 void  STD_PROTO(CloseStream,(int));
 int   STD_PROTO(PlGetchar,(void));
 int   STD_PROTO(PlFGetchar,(void));
+int   STD_PROTO(StreamToFileNo,(Term));
 
 extern int c_input_stream, c_output_stream, c_error_stream;
 
+#define YAP_INPUT_STREAM	0x01
+#define YAP_OUTPUT_STREAM	0x02
+#define YAP_APPEND_STREAM	0x04
+#define YAP_PIPE_STREAM 	0x08
+#define YAP_TTY_STREAM	 	0x10
+#define YAP_POPEN_STREAM	0x20
+#define YAP_BINARY_STREAM	0x40
+#define YAP_SEEKABLE_STREAM	0x80
+
+Term   STD_PROTO(OpenStream,(FILE *,char *,Term,int));
+
 /* routines in sysbits.c */
 char *STD_PROTO(pfgets,(char *,int,YP_File));
 

Makefile.in

@@ -450,6 +450,7 @@ install_unix:
 	(cd $(srcdir)/CLPQR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
 	(cd $(srcdir)/CHR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
 	@INSTALL_DLLS@ (cd library/regex; make install)
+	@INSTALL_DLLS@ (cd library/system; make install)
 	-mkdir -p $(DESTDIR)$(INCLUDEDIR)
 	for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
 
@@ -473,6 +474,8 @@ install_mingw32:
 	(cd $(srcdir)/CHR ; tar cf - .) | (cd $(DESTDIR)$(YAPLIBDIR)/library ; tar xf -)
 	(cd library/regex; make install_mingw32)
 
+#	(cd library/system; make install_mingw32)
+
 install_library: libYap.a
 	$(INSTALL_DATA) -m 644 libYap.a  $(DESTDIR)$(LIBDIR)/libYap.a
 	-mkdir $(DESTDIR)$(INCLUDEDIR)

OPTYap/or.engine.c

@@ -539,8 +539,8 @@ void share_private_nodes(int worker_q) {
         /* frozen stack segment */
         if (! next_node_on_branch)
           next_node_on_branch = sharing_node;
-        STACK_PUSH(or_frame, stack, stack_top);
+        STACK_PUSH(or_frame, stack, stack_top, stack_base);
-        STACK_PUSH(sharing_node, stack, stack_top);
+        STACK_PUSH(sharing_node, stack, stack_top, stack_base);
         sharing_node = consumer_cp;
         dep_frame = DepFr_next(dep_frame);
         consumer_cp = DepFr_cons_cp(dep_frame);

OPTYap/tab.suspend.c

@@ -4,6 +4,8 @@
 
 #include "Yap.h"
 #if defined(TABLING) && defined(YAPOR)
+#include "Yatom.h"
+#include "Heap.h"
 #include "tab.macros.h"
 #include "or.macros.h"
 

TO_DO

@@ -1,4 +1,5 @@
 BEFORE 4.4:
+- weird going ons with prompt
 - mixed constraints and delays.
 - write infinite terms
 - constraints in DB.
@@ -8,7 +9,11 @@ BEFORE 4.4:
 - timestamps on files.
 - warnings in documentation file.
 - system library
-- fixed restore when code is moved around.
+- fix restore when code is moved around.
+- library(system) for WIN32
+- document system(library)
+- document new interface functions.
+- logtalk.
 
 TO CHECK:
 - bad register allocation for a(X,Y) :- X is Y+2.3 ?
@@ -16,6 +21,7 @@ TO CHECK:
 TABLING
 - pass all tabling tests from Kostis and Bart paper
 - handle floats, long ints and friends in tables.
+- knap-sack
 
 AFTER 4.4(?)
 - change compilation order for arguments

changes.css

@@ -0,0 +1 @@
+body {
	color: black;
	background-color: #FFE4C4;
	font-family: sans-serif;
	margin-left: 2em;
	margin-right: 2em;
}

h1, h2, h3, h4, h5, h6 {
	color: maroon; font-family: helvetica, arial, sans-serif;
	text-align: center;
}

code, pre {
  font-family: courier, monospace;
}

config.h.in

@@ -26,10 +26,12 @@
 #undef  HAVE_ARPA_INET_H
 #undef  HAVE_CTYPE_H
 #undef  HAVE_DIRECT_H
+#undef  HAVE_DIRENT_H
 #undef  HAVE_ERRNO_H
 #undef  HAVE_FCNTL_H
 #undef  HAVE_FENV_H
 #undef  HAVE_FPU_CONTROL_H
+#undef  HAVE_GMP_H
 #undef  HAVE_IEEEFP_H
 #undef  HAVE_LIMITS_H
 #undef  HAVE_MEMORY_H
@@ -37,6 +39,7 @@
 #undef  HAVE_NETINET_IN_H
 #undef  HAVE_REGEX_H
 #undef  HAVE_SIGINFO_H
+#undef  HAVE_SIGNAL_H
 #undef  HAVE_STDARG_H
 #undef  HAVE_STRING_H
 #undef  HAVE_SYS_FILE_H
@@ -56,7 +59,6 @@
 #undef  HAVE_UNISTD_H
 #undef  HAVE_WINSOCK_H
 #undef  HAVE_WINSOCK2_H
-#undef  HAVE_GMP_H
 
 /* Do we have restartable syscalls */
 #undef  HAVE_RESTARTABLE_SYSCALLS
@@ -101,6 +103,9 @@
 #undef  HAVE_DUP2
 #undef  HAVE_FETESTEXCEPT
 #undef  HAVE_FINITE
+#undef  HAVE_GETHOSTBYNAME
+#undef  HAVE_GETHOSTID
+#undef  HAVE_GETHOSTNAME
 #undef  HAVE_GETRUSAGE
 #undef  HAVE_GETCWD
 #undef  HAVE_GETENV
@@ -110,15 +115,22 @@
 #undef  HAVE_GETWD
 #undef  HAVE_ISATTY
 #undef  HAVE_ISNAN
+#undef  HAVE_KILL
 #undef  HAVE_LABS
 #undef  HAVE_LINK
+#undef  HAVE_LOCALTIME
+#undef  HAVE_LSTAT
 #undef  HAVE_MMAP
 #undef  HAVE_MEMCPY
 #undef  HAVE_MEMMOVE
 #undef  HAVE_MKSTEMP
+#undef  HAVE_MKTEMP
+#undef  HAVE_OPENDIR
+#undef  HAVE_POPEN
 #undef  HAVE_PUTENV
 #undef  HAVE_RAND
 #undef  HAVE_RANDOM
+#undef  HAVE_RENAME
 #undef  HAVE_RINT
 #undef  HAVE_SBRK
 #undef  HAVE_STAT
@@ -132,6 +144,7 @@
 #undef  HAVE_SIGPROCMASK
 #undef  HAVE_SIGSEGV
 #undef  HAVE_SIGSETJMP
+#undef  HAVE_SLEEP
 #undef  HAVE_SNPRINTF
 #undef  HAVE_SOCKET
 #undef  HAVE_STRERROR
@@ -140,9 +153,12 @@
 #undef  HAVE_STRCHR
 #undef  HAVE_STRTOD
 #undef  HAVE_SYSTEM
+#undef  HAVE_TIME
 #undef  HAVE_TIMES
 #undef  HAVE_TMPNAM
+#undef  HAVE_USLEEP
 #undef  HAVE_VSNPRINTF
+#undef  HAVE_WAITPID
 #undef  HAVE_ENVIRON
 #undef  HAVE_MPZ_XOR
 

configure

@@ -2461,7 +2461,7 @@ else
 fi
 done
 
-for ac_hdr in sys/select.h direct.h
+for ac_hdr in sys/select.h direct.h dirent.h signal.h
 do
 ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
 echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
@@ -3612,7 +3612,7 @@ else
 fi
 done
 
-for ac_func in setlinebuf
+for ac_func in setlinebuf lstat opendir localtime time gethostname
 do
 echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
 echo "configure:3619: checking for $ac_func" >&5
@@ -3667,15 +3667,125 @@ else
 fi
 done
 
+for ac_func in gethostid gethostbyname kill mktemp popen rename waitpid
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:3674: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3679 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_func in sleep usleep
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:3729: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3734 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3757: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
 
 echo $ac_n "checking for mpz_xor""... $ac_c" 1>&6
-echo "configure:3673: checking for mpz_xor" >&5
+echo "configure:3783: checking for mpz_xor" >&5
 if eval "test \"`echo '$''{'yap_mpz_xor'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   
 cat > conftest.$ac_ext <<EOF
-#line 3679 "configure"
+#line 3789 "configure"
 #include "confdefs.h"
 #include <gmp.h>
 	void check(mpz_t rop,mpz_t op1,mpz_t op2) {
@@ -3686,7 +3796,7 @@ int main() {
 
 ; return 0; }
 EOF
-if { (eval echo configure:3690: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3800: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   yap_mpz_xor=yes
 else
@@ -3713,6 +3823,7 @@ EOF
 fi
 
 mkdir -p  library/regex
+mkdir -p  library/system
 
 trap '' 1 2 15
 cat > confcache <<\EOF
@@ -3815,7 +3926,7 @@ done
 ac_given_srcdir=$srcdir
 ac_given_INSTALL="$INSTALL"
 
-trap 'rm -fr `echo "Makefile library/regex/Makefile .depend config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile library/regex/Makefile library/system/Makefile  .depend config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
 EOF
 cat >> $CONFIG_STATUS <<EOF
 
@@ -3925,7 +4036,7 @@ EOF
 
 cat >> $CONFIG_STATUS <<EOF
 
-CONFIG_FILES=\${CONFIG_FILES-"Makefile library/regex/Makefile .depend"}
+CONFIG_FILES=\${CONFIG_FILES-"Makefile library/regex/Makefile library/system/Makefile  .depend"}
 EOF
 cat >> $CONFIG_STATUS <<\EOF
 for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then

configure.in

@@ -395,7 +395,7 @@ AC_CHECK_HEADERS(sys/param.h errno.h netdb.h netinet/in.h arpa/inet.h)
 AC_CHECK_HEADERS(string.h memory.h sys/mman.h sys/stat.h stdarg.h ctype.h)
 AC_CHECK_HEADERS(sys/resource.h limits.h siginfo.h time.h fenv.h)
 AC_CHECK_HEADERS(fpu_control.h sys/shm.h regex.h winsock.h winsock2.h)
-AC_CHECK_HEADERS(sys/select.h direct.h)
+AC_CHECK_HEADERS(sys/select.h direct.h dirent.h signal.h)
 if test "$yap_cv_gmp" != "no"
 then
   AC_CHECK_HEADERS(gmp.h)
@@ -567,7 +567,9 @@ AC_CHECK_FUNCS(snprintf vsnprintf setbuf system link getpwnam dup2 sigprocmask)
 AC_CHECK_FUNCS(labs strncat tmpnam getenv gettimeofday gethrtime putenv)
 AC_CHECK_FUNCS(strerror socket memmove alarm asinh acosh atanh rint)
 AC_CHECK_FUNCS(stat select fetestexcept finite strncpy mkstemp isnan)
-AC_CHECK_FUNCS(setlinebuf)
+AC_CHECK_FUNCS(setlinebuf lstat opendir localtime time gethostname)
+AC_CHECK_FUNCS(gethostid gethostbyname kill mktemp popen rename waitpid)
+AC_CHECK_FUNCS(sleep usleep)
 
 dnl check for mpz_xor
 AC_MSG_CHECKING(for mpz_xor)
@@ -589,8 +591,9 @@ AC_DEFINE(HAVE_MPZ_XOR,0)
 fi
 
 mkdir -p  library/regex
+mkdir -p  library/system
 
-AC_OUTPUT(Makefile library/regex/Makefile .depend)
+AC_OUTPUT(Makefile library/regex/Makefile library/system/Makefile  .depend)
 
 make depend
 

docs/yap.tex

@@ -3250,7 +3250,8 @@ YAP currently ignores these options.
 @cnindex current_stream/3
 Defines the relation: The stream @var{S} is opened on the file  @var{F} in
 mode @var{M}. It might be used to obtain all open streams (by
-backtracking) or to access the stream for a file @var{F} in mode @var{M}.
+backtracking), to access the stream for a file @var{F} in mode @var{M},
+or to find properties for a stream @var{S}.
 
 @item flush_output [ISO]
 @findex flush_output/0
@@ -11521,7 +11522,7 @@ void init_my_predicates()
 The commands to compile the above file depend on the operating
 system. Under Linux (i386 and Alpha) you should use:
 @example
-      gcc -c -shared -fPIC my_process.c -o my_process.o
+      gcc -c -shared -fPIC my_process.c
       ld -shared -o my_process.so my_process.o
 @end example
 @noindent

include/c_interface.h

@@ -504,6 +504,24 @@ static void (YapIStringToBuffer)() = YapStringToBuffer;
 #define StringToBuffer(T,BUF,SIZE) YapStringToBuffer(T,BUF,SIZE)
 #endif
 
+/*  int BufferToString(char *) */
+extern X_API Term PROTO(YapBufferToString,(char *));
+#ifdef IndirectCalls
+static void (YapIBufferToString)() = YapBufferToString;
+#define BufferToString(BUF) (*YapIBufferToString)(BUF)
+#else
+#define BufferToString(BUF) YapBufferToString(BUF)
+#endif
+
+/*  int BufferToAtomList(char *) */
+extern X_API Term PROTO(YapBufferToAtomList,(char *));
+#ifdef IndirectCalls
+static void (YapIBufferToAtomList)() = YapBufferToAtomList;
+#define BufferToAtomList(BUF) (*YapIBufferToAtomList)(BUF)
+#else
+#define BufferToAtomList(BUF) YapBufferToAtomList(BUF)
+#endif
+
 /*  void YapInitSocks(char *,long) */
 extern X_API int PROTO(YapInitSocks,(char *,long));
 #ifdef IndirectCalls
@@ -534,6 +552,36 @@ static void (*YapISetOutputMessage)() = YapSetOutputMessage;
 #define YapSetOutputMessage() (*YapISetOutputMessage)()
 #endif
 
+/*  Term  YapSetOutputMessage()  */
+extern X_API int PROTO(YapStreamToFileNo,(Term));
+#ifdef IndirectCalls
+static void (*YapIStreamToFileNo)() = YapStreamToFileNo;
+#define YapStreamToFileNo() (*YapIStreamToFileNo)()
+#endif
+
+/*  Term  YapSetOutputMessage()  */
+extern X_API void PROTO(YapCloseAllOpenStreams,(void));
+#ifdef IndirectCalls
+static void (*YapICloseAllOpenStreams)() = YapCloseAllOpenStreams;
+#define YapCloseAllOpenStreams() (*YapICloseAllOpenStreams)()
+#endif
+
+#define YAP_INPUT_STREAM	0x01
+#define YAP_OUTPUT_STREAM	0x02
+#define YAP_APPEND_STREAM	0x04
+#define YAP_PIPE_STREAM 	0x08
+#define YAP_TTY_STREAM	 	0x10
+#define YAP_POPEN_STREAM	0x20
+#define YAP_BINARY_STREAM	0x40
+#define YAP_SEEKABLE_STREAM	0x80
+
+/*  Term  YapP()  */
+extern X_API Term PROTO(YapOpenStream,(void *, char *, Term, int));
+#ifdef IndirectCalls
+static Term (*YapIOpenStream)() = YapOpenStream;
+#define YapOpenStream(FD,S,T,FL) (*YapIOpenStream)(FD,S,T,FL)
+#endif
+
 
 #define InitCPred(N,A,F)  UserCPredicate(N,F,A)
 

misc/yap.def

@@ -42,6 +42,8 @@ Yapcut_succeed
 YapAllocSpaceFromYap
 YapFreeSpaceFromYap
 YapStringToBuffer
+YapBufferToString
+YapBufferToAtomList
 YapError
 YapRunGoal
 YapContinueGoal
@@ -58,4 +60,6 @@ YapSetOutputMessage
 YapWrite
 YapInitConsult
 YapEndConsult
-
+YapStreamToFileNo
+YapCloseAllOpenStreams
+YapOpenStream

pl/arith.yap

@@ -36,6 +36,11 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
 '$c_built_in'(IN, IN).
 
 
+'$do_c_built_in'(\+ G, OUT) :-
+	nonvar(G),
+	G = (A = B),
+	!,
+	OUT = (A \= B).
 '$do_c_built_in'(recorded(K,T,R), OUT) :-
 	nonvar(K),
 	!,

pl/boot.yap

@@ -116,7 +116,8 @@ set_output(Stream) :-
 	 8	use portray(_)
 */
 
-write(T) :- current_output(S), '$write'(S,4,T).
+write(T) :- current_output(S), '$write'(S,4,T), fail.
+write(_).
 
 write(Stream,T) :- 
 	'$write'(Stream,4,T),
@@ -127,7 +128,8 @@ put(Stream,N) :-  N1 is N, '$put'(Stream,N1).
 
 nl(Stream) :- '$put'(Stream,10).
 
-nl :- current_output(Stream), '$put'(Stream,10).
+nl :- current_output(Stream), '$put'(Stream,10), fail.
+nl.
 
 /* main execution loop							*/
 '$read_vars'(Stream,T,V) :-
@@ -1049,7 +1051,7 @@ add_to_path(New) :- add_to_path(New,last).
 add_to_path(New,Pos) :- '$check_path'(New,Str), '$add_to_path'(Str,Pos).
 
 '$add_to_path'(New,_) :- '$recorded'('$path',New,R), erase(R), fail.
-'$add_to_path'(New,last) :- '$recordz'('$path',New,_).
+'$add_to_path'(New,last) :- !, '$recordz'('$path',New,_).
 '$add_to_path'(New,first) :- '$recorda'('$path',New,_).
 
 remove_from_path(New) :- '$check_path'(New,Path),

pl/errors.yap

@@ -101,6 +101,9 @@ print_message(help,M) :-
 '$output_error_message'(domain_error(character_code_list,Opt), Where) :-
 	format(user_error,"[ DOMAIN ERROR- ~w: invalid list of codes ~w ]~n",
 	[Where,Opt]).
+'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
+	format(user_error,"[ DOMAIN ERROR- ~w: invalid list of options ~w ]~n",
+	[Where,Opt]).
 '$output_error_message'(domain_error(operator_specifier,Op), Where) :-
 	format(user_error,"[ DOMAIN ERROR- ~w: invalid operator specifier ~w ]~n",
 	[Where,Op]).
@@ -284,6 +287,9 @@ print_message(help,M) :-
 '$output_error_message'(system_error, Where) :-
 	format(user_error,"[ SYSTEM ERROR- ~w ]~n",
 	[Where]).
+'$output_error_message'(system_error(Message), Where) :-
+	format(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
+	[Message,Where]).
 '$output_error_message'(type_error(T,_,Err,M), Where) :-
 	format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
 	[T,Err,M]).

pl/preds.yap

@@ -61,6 +61,7 @@ assert(C) :- '$assert'(C,last,_,assert(C)).
             throw(error(permission_error(modify,static_procedure,Na/Ar),P))
 	).
 
+
 '$assert_dynamic'(V,Where,R,P) :- var(V), !,
 	'$current_module'(M),
 	throw(error(instantiation_error,P)).

pl/tabling.yap

@@ -51,7 +51,7 @@ show_trie(X) :- var(X), !,
 show_trie(A/N) :- integer(N), atom(A), !,
                   functor(T,A,N), $flags(T,F,F),
                   (
-                    X is F /\ 8'000100, X =\= 0, !, $show_trie(T)
+                    X is F /\ 8'000100, X =\= 0, !, $show_trie(T,_)
                   ;
                     write(user_error, '[ Error: '),
                     write(user_error, A/N),

pl/utils.yap

@@ -249,26 +249,6 @@ rename(Old,New) :- atom(Old), atom(New), !,
 	name(Old,SOld), name(New,SNew),
 	'$rename'(SOld,SNew).
 
-environ(Na,Val) :- atom(Na), !,
-	'$getenv'(Na,Val).
-environ(Na,Val) :-
-	'$environ_enum'(0,I),
-	( '$environ'(I,S) -> '$environ_split'(S,SNa,SVal) ; !, fail ),
-	atom_codes(Na, SNa),
-	atom_codes(Val, SVal).
-
-'$environ_enum'(X,X).
-'$environ_enum'(X,X1) :-
-	Xi is X+1,
-	'$environ_enum'(Xi,X1).
-
-'$environ_split'([61|SVal], [], SVal) :- !.
-'$environ_split'([C|S],[C|SNa],SVal) :-
-	'$environ_split'(S,SNa,SVal).
-
-putenv(Na,Val) :-
-	'$putenv'(Na,Val).
-
 unix(V) :- var(V), !,
 	throw(error(instantiation_error,unix(V))).
 unix(argv(L)) :- (var(L) ; atom(L)), !, '$argv'(L).
@@ -280,7 +260,7 @@ unix(cd(V)) :- var(V), !,
 unix(cd(A)) :- atomic(A), !, cd(A).
 unix(cd(V)) :-
 	throw(error(type_error(atomic,V),unix(cd(V)))).
-unix(environ(X,Y)) :- environ(X,Y).
+unix(environ(X,Y)) :- do_environ(X,Y).
 unix(getcwd(X)) :- getcwd(X).
 unix(shell(V)) :- var(V), !,
 	throw(error(instantiation_error,unix(shell(V)))).
@@ -295,6 +275,11 @@ unix(system(V)) :-
 unix(shell) :- sh.
 unix(putenv(X,Y)) :- '$putenv'(X,Y).
 
+putenv(Na,Val) :-
+	'$putenv'(Na,Val).
+
+getenv(Na,Val) :-
+	'$getenv'(Na,Val).
 
 alarm(_, _, _) :-
 	recorded('$alarm_handler',_, Ref), erase(Ref), fail.

pl/yio.yap

@@ -236,6 +236,8 @@ open(F,T,S,Opts) :-
 
 open_null_stream(S) :- '$open_null_stream'(S).
 
+open_pipe_streams(P1,P2) :- '$open_pipe_stream'(P1, P2).
+
 fileerrors :- '$set_value'(fileerrors,1).
 nofileerrors :- '$set_value'(fileerrors,0).