Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

C/absmi.c

@@ -963,7 +963,7 @@ Yap_absmi(int inp)
 /*****************************************************************
 *        EXO try - retry instructions                  *
 *****************************************************************/
-      /* try_exo    Pred,Label */
+      /* enter_exo    Pred,Label */
       BOp(enter_exo, e);
       {
 	yamop *pt;
@@ -1011,6 +1011,37 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* try_udi    Pred,Label */
+      Op(try_udi, p);
+      /* check if enough space between trail and codespace */
+      check_trail(TR);
+      /* I use YREG =to go through the choicepoint. Usually YREG =is in a
+       * register, but sometimes (X86) not. In this case, have a
+       * new register to point at YREG =*/
+      CACHE_Y(YREG);
+      { 
+	S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */
+      }
+      S_YREG--;
+      /* store arguments for procedure */
+      store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+      /* store abstract machine registers */
+      store_yaam_regs(NEXTOP(PREG,lp), 0);
+      /* On a try_me, set cut to point at previous choicepoint,
+       * that is, to the B before the cut.
+       */
+      set_cut(S_YREG, B);
+      /* now, install the new YREG =*/
+      B = B_YREG;
+#ifdef YAPOR
+      SCH_set_load(B_YREG);
+#endif	/* YAPOR */
+      PREG = NEXTOP(NEXTOP(PREG, lp),lp);
+      SET_BB(B_YREG);
+      ENDCACHE_Y();
+      GONext();
+      ENDOp();
+
       /* check if enough space between trail and codespace */
       /* try_exo    Pred,Label */
       Op(try_all_exo, lp);
@@ -1097,6 +1128,61 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* retry_exo    Pred */
+      Op(retry_udi, p);
+      BEGD(d0);
+      CACHE_Y(B);
+      {
+	// struct udi_index_t *jp = (struct udi_index_t *)((CELL *)(B+1))[it->arity];
+	/* operation has a side-effect: S = (CELL*)NextClause */
+	saveregs();
+	d0 = 0L; // Yap_UDI_NextAlt(jp);
+	setregs();
+#ifdef SHADOW_S
+	SREG = S;
+#endif
+	/* d0 says if we're last */
+      }
+      if (d0) {
+	/* After retry, cut should be pointing at the parent
+	 * choicepoint for the current B */
+	restore_yaam_regs(PREG);
+	restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+#ifdef FROZEN_STACKS
+	S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+	set_cut(S_YREG, B->cp_b);
+#else
+	set_cut(S_YREG, B_YREG->cp_b);
+#endif /* FROZEN_STACKS */
+	SET_BB(B_YREG);
+      } else {
+#ifdef YAPOR
+	if (SCH_top_shared_cp(B)) {
+	  SCH_last_alternative(PREG, B_YREG);
+	  restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+#ifdef FROZEN_STACKS
+	  S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	  set_cut(S_YREG, B->cp_b);
+	} else
+#endif	/* YAPOR */
+	  {
+	    pop_yaam_regs();
+	    pop_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+	    /* After trust, cut should be pointing at the new top
+	     * choicepoint */
+#ifdef FROZEN_STACKS
+	    S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	    set_cut(S_YREG, B);
+	  }
+      }
+      PREG = (yamop *)SREG;
+      ENDCACHE_Y();
+      ENDD(D0);
+      GONext();
+      ENDOp();
+
       /* retry_exo    Pred */
       Op(retry_all_exo, lp);
       BEGD(d0);
@@ -7446,7 +7532,7 @@ Yap_absmi(int inp)
       saveregs();
       save_machine_regs();
       SREG = (CELL *) YAP_ExecuteFirst(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
-      EX = 0L;
+      EX = NULL;
       restore_machine_regs();
       setregs();
       LOCAL_PrologMode = UserMode;
@@ -7489,7 +7575,7 @@ Yap_absmi(int inp)
       saveregs();
       save_machine_regs();
       SREG = (CELL *) YAP_ExecuteNext(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
-      EX = 0L;
+      EX = NULL;
       restore_machine_regs();
       setregs();
       LOCAL_PrologMode = UserMode;

C/arith1.c

@@ -523,8 +523,7 @@ eval1(Int fi, Term t) {
 #endif
 #if HAVE_ISINF
       if (isinf(dbl)) {
-	return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\
+	return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer (%f)",dbl);
-(%f)",dbl);
       }
 #endif
       if (dbl < 0.0)

C/c_interface.c

@@ -1663,6 +1663,10 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
 {
   CACHE_REGS
   Int ret;
+  //  Term omod = CurrentModule;
+  //if (pe->PredFlags & CArgsPredFlag) {
+  //  CurrentModule = pe->ModuleOfPred;
+  //}
   if (pe->PredFlags & SWIEnvPredFlag) {
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context ctx;
@@ -1683,6 +1687,7 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
     ret = (exec_code)( PASS_REGS1 );
   }
   PP = NULL;
+  //CurrentModule = omod;
   if (!ret) {
     Term t;
 
@@ -2429,6 +2434,8 @@ YAP_RunGoal(Term t)
     Yap_StartSlots( PASS_REGS1 );
   } else {
     ENV = B->cp_env;
+    ENV = (CELL *)ENV[E_E];
+    CP = old_CP;
     B = B->cp_b;
     LOCAL_AllowRestart = FALSE;
   }
@@ -2503,11 +2510,13 @@ YAP_RunGoalOnce(Term t)
   Term out;
   yamop *old_CP = CP;
   Int oldPrologMode = LOCAL_PrologMode;
+  Int oldSlot = CurSlot;
 
   BACKUP_MACHINE_REGS();
   LOCAL_PrologMode = UserMode;
   out = Yap_RunTopGoal(t);
   LOCAL_PrologMode = oldPrologMode;
+  CurSlot = oldSlot;
   if (!(oldPrologMode & UserCCallMode)) {
     /* called from top-level */
     LOCAL_AllowRestart = FALSE;
@@ -2538,10 +2547,9 @@ YAP_RunGoalOnce(Term t)
     B = cut_pt;
   }
   ASP = B->cp_env;
-  Yap_PopSlots( PASS_REGS1 );
   ENV = (CELL *)ASP[E_E];
   B = (choiceptr)ASP[E_CB];
-#ifdef  DEPTH_LIMIT
+#ifdef  DEPTH_LIMITxs
   DEPTH = ASP[E_DEPTH];
 #endif
   P = (yamop *)ASP[E_CP];
@@ -2567,7 +2575,6 @@ YAP_RestartGoal(void)
     if (out == FALSE) {
       /* cleanup */
       Yap_trust_last();
-      Yap_CloseSlots( PASS_REGS1 );
       LOCAL_AllowRestart = FALSE;
     }
   } else { 
@@ -3043,42 +3050,11 @@ YAP_Init(YAP_init_args *yap_init)
 	      yap_init->SchedulerLoop,
 	      yap_init->DelayedReleaseLoad
 	      );
-#if THREADS
-  /* make sure we use the correct value of regcache */
-  regcache =  ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
-#endif
-#if USE_SYSTEM_MALLOC
-  if (Trail < MinTrailSpace)
-    Trail = MinTrailSpace;
-  if (Stack < MinStackSpace)
-    Stack = MinStackSpace;
-  if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
-    yap_init->ErrorNo = RESOURCE_ERROR_MEMORY;
-    yap_init->ErrorCause = "could not allocate stack space for main thread";
-    return YAP_BOOT_ERROR;
-  }
-#if THREADS
-  /* don't forget this is a thread */
-  LOCAL_ThreadHandle.stack_address =  LOCAL_GlobalBase;
-  LOCAL_ThreadHandle.ssize =  Trail+Stack;
-#endif
-#endif
-  GLOBAL_AllowGlobalExpansion = TRUE;
-  GLOBAL_AllowLocalExpansion = TRUE;
-  GLOBAL_AllowTrailExpansion = TRUE;
-  Yap_InitExStacks (0, Trail, Stack);
   if (yap_init->QuietMode) {
     yap_flags[QUIET_MODE_FLAG] = TRUE;
   }
 
-  { BACKUP_MACHINE_REGS();
+  { if (yap_init->YapPrologRCFile != NULL) {
-    Yap_InitYaamRegs( 0 );
-
-#if HAVE_MPE
-    Yap_InitMPE ();
-#endif
-    
-    if (yap_init->YapPrologRCFile != NULL) {
       /*
 	This must be done before restore, otherwise
 	restore will print out messages ....

C/cdmgr.c

@@ -5416,27 +5416,55 @@ Yap_dump_code_area_for_profiler(void) {
 #endif /* LOW_PROF */
 
 static UInt
-index_ssz(StaticIndex *x)
+tree_index_ssz(StaticIndex *x)
 {
   UInt sz = x->ClSize;
   x = x->ChildIndex;
   while (x != NULL) {
-    sz += index_ssz(x);
+    sz +=  tree_index_ssz(x);
     x = x->SiblingIndex;
   }
   return sz;
 }
 
+static UInt
+index_ssz(StaticIndex *x, PredEntry *pe)
+{
+  UInt sz = 0;
+  yamop *ep = ExpandClausesFirst;
+  if (pe->PredFlags & MegaClausePredFlag) {
+    MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
+    if (mcl->ClFlags & ExoMask) {
+      struct index_t *i = ((struct index_t **)(pe->cs.p_code.FirstClause))[0];
+      sz = 0;
+
+      while (i) {
+	sz = i->size+sz;
+      }
+      return sz;
+    }
+  }
+  /* expand clause blocks */
+  while (ep) {
+    if (ep->u.sssllp.p == pe)
+      sz += (UInt)NEXTOP((yamop *)NULL,sssllp)+ep->u.sssllp.s1*sizeof(yamop *);
+    ep = ep->u.sssllp.snext;
+  }
+  /* main indexing tree */
+  sz += tree_index_ssz(x);
+  return sz;
+}
+
 static Int
 static_statistics(PredEntry *pe)
 {
   CACHE_REGS
-  UInt sz = 0, cls = 0, isz = 0;
+  UInt sz = sizeof(PredEntry), cls = 0, isz = 0;
   StaticClause *cl = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause);
 
   if (pe->cs.p_code.NOfClauses > 1 &&
       pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause) {
-    isz = index_ssz(ClauseCodeToStaticIndex(pe->cs.p_code.TrueCodeOfPred));
+    isz = index_ssz(ClauseCodeToStaticIndex(pe->cs.p_code.TrueCodeOfPred), pe);
   }
   if (pe->PredFlags & MegaClausePredFlag) {
     MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);

C/compiler.c

@@ -2109,14 +2109,14 @@ c_head(Term t, compiler_struct *cglobs)
   if (IsAtomTerm(t)) {
     Yap_emit(name_op, (CELL) AtomOfTerm(t), Zero, &cglobs->cint);
 #ifdef BEAM
-   if (EAM) {
+    if (EAM) {
-     Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
+      Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
-   }
+    }
 #endif
+    Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
+    cglobs->space_op = cglobs->cint.cpc;
     return;
   }
-  Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
-  cglobs->space_op = cglobs->cint.cpc;
   f = FunctorOfTerm(t);
   Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f), &cglobs->cint);
 #ifdef BEAM
@@ -2124,8 +2124,10 @@ c_head(Term t, compiler_struct *cglobs)
      Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
    }
 #endif
-   if (Yap_ExecutionMode == MIXED_MODE_USER)
+  if (Yap_ExecutionMode == MIXED_MODE_USER)
      Yap_emit(native_op, 0, 0, &cglobs->cint);
+  Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
+  cglobs->space_op = cglobs->cint.cpc;
   c_args(t, 0, cglobs);
 }
 
@@ -3537,6 +3539,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
     }
     if (LOCAL_ErrorMessage)
       return (0);
+    /* make sure we give enough space for the  fact */
+    if (cglobs.space_op)
+      cglobs.space_op->rnd1 = cglobs.space_used;
+
 #ifdef DEBUG
     if (GLOBAL_Option['g' - 96])
       Yap_ShowCode(&cglobs.cint);

C/dbase.c

@@ -3749,7 +3749,7 @@ index_sz(LogUpdIndex *x)
 static Int
 lu_statistics(PredEntry *pe USES_REGS)
 {
-  UInt sz = 0, cls = 0, isz = 0;
+  UInt sz = sizeof(PredEntry), cls = 0, isz = 0;
   
   /* count number of clauses and size */
   LogUpdClause *x;
@@ -3765,10 +3765,16 @@ lu_statistics(PredEntry *pe USES_REGS)
       x = x->ClNext;
     }
   }
+  isz = 0;
   if (pe->PredFlags & IndexedPredFlag) {
-    isz = index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
+    /* expand clause blocks */
-  } else {
+    yamop *ep = ExpandClausesFirst;
-    isz = 0;
+    while (ep) {
+      if (ep->u.sssllp.p == pe)
+	isz += (UInt)NEXTOP((yamop *)NULL,sssllp)+ep->u.sssllp.s1*sizeof(yamop *);
+      ep = ep->u.sssllp.snext;
+    }
+    isz += index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
   }
   return
     Yap_unify(ARG2,MkIntegerTerm(cls)) &&

C/depth_bound.c

@@ -18,6 +18,11 @@
 static char     SccsId[] = "%W% %G%";
 #endif /* SCCS */
 
+#include <math.h>
+#ifndef INFINITY
+#define INFINITY (1.0/0.0)
+#endif
+
 #include "Yap.h"
 
 #ifdef DEPTH_LIMIT
@@ -29,7 +34,10 @@ STD_PROTO(static Int p_set_depth_limit, ( USES_REGS1 ));
 
 static Int p_get_depth_limit( USES_REGS1 )
 {
-  return(Yap_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
+  Int d = IntOfTerm(DEPTH);
+  if (d % 2 == 1) 
+    return(Yap_unify(ARG1, MkFloatTerm(INFINITY)));
+  return(Yap_unify_constant(ARG1, MkIntTerm(d/2)));
 }
 
 static Int p_set_depth_limit( USES_REGS1 )
@@ -40,8 +48,12 @@ static Int p_set_depth_limit( USES_REGS1 )
     Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
     return(FALSE);
   } else if (!IsIntegerTerm(d)) {
-    Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
+    if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
-    return(FALSE);
+      d = RESET_DEPTH();
+    } else {
+      Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
+      return(FALSE);
+    }
   }
   d = MkIntTerm(IntegerOfTerm(d)*2);
 
@@ -59,6 +71,10 @@ static Int p_set_depth_limit_for_next_call( USES_REGS1 )
     Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
     return(FALSE);
   } else if (!IsIntegerTerm(d)) {
+    if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
+      DEPTH = RESET_DEPTH();
+      return TRUE;
+    }
     Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
     return(FALSE);
   }

C/errors.c

@@ -1441,6 +1441,17 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case SAVED_STATE_ERROR:
+    {
+      int i;
+
+      i = strlen(tmpbuf);
+      nt[0] = MkAtomTerm(AtomSystemError);
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case SYSTEM_ERROR:
     {
       int i;

C/exec.c

@@ -33,6 +33,7 @@ STATIC_PROTO(Int  EnterCreepMode, (Term, Term CACHE_TYPE));
 STATIC_PROTO(Int  p_save_cp, ( USES_REGS1 ));
 STATIC_PROTO(Int  p_execute, ( USES_REGS1 ));
 STATIC_PROTO(Int  p_execute0, ( USES_REGS1 ));
+static int execute_pred(PredEntry *ppe, CELL *pt USES_REGS);
 
 static Term
 cp_as_integer(choiceptr cp USES_REGS)
@@ -666,7 +667,7 @@ p_do_goal_expansion( USES_REGS1 )
   if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
     ARG3 = ARG2;
     goto complete;
@@ -675,7 +676,7 @@ p_do_goal_expansion( USES_REGS1 )
   if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
     ARG3 = ARG2;
     goto complete;
@@ -686,7 +687,7 @@ p_do_goal_expansion( USES_REGS1 )
   if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
     goto complete;
   }
@@ -696,7 +697,7 @@ p_do_goal_expansion( USES_REGS1 )
        (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     ARG3 = ARG2;
     out = TRUE;
   }
@@ -728,7 +729,7 @@ p_do_term_expansion( USES_REGS1 )
   if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
     goto complete;
   }
@@ -736,7 +737,7 @@ p_do_term_expansion( USES_REGS1 )
   if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
     goto complete;
   }
@@ -745,7 +746,7 @@ p_do_term_expansion( USES_REGS1 )
        (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) &&
        pe->OpcodeOfPred != FAIL_OPCODE &&
        pe->OpcodeOfPred != UNDEF_OPCODE &&
-       CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
+       execute_pred(pe, NULL PASS_REGS) ) {
     out = TRUE;
   }
  complete:
@@ -1142,7 +1143,7 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
   /* and now create a pseudo choicepoint for much the same reasons */
   /* CP = YESCODE; */
   /* keep a place where you can inform you had an exception */
-  { 
+  if (pt) { 
     int i;
     for (i = 0; i < arity; i++) {
       XREGS[i+1] = *pt++;
@@ -1167,7 +1168,7 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
 }
 
 static Int
-do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
+do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
 {
   choiceptr saved_b = B;
   Int out;
@@ -1193,59 +1194,28 @@ Yap_exec_absmi(int top)
 }
 
 
-Int
+static int
-Yap_execute_goal(Term t, int nargs, Term mod)
+execute_pred(PredEntry *ppe, CELL *pt USES_REGS)
 {
-  CACHE_REGS
-  Int             out;
-  yamop        *CodeAdr;
   yamop *saved_p, *saved_cp;
-  Prop pe;
+  Int saved_slot = CurSlot;
-  PredEntry *ppe;
+  yamop        *CodeAdr;
-  CELL *pt;
+  Int             out;
-  /* preserve the current restart environment */
-  /* visualc*/
-  /* just keep the difference because of possible garbage collections */
-
 
   saved_p = P;
   saved_cp = CP;
   
-  if (IsAtomTerm(t)) {
+  PELOCK(81,ppe);
-    Atom a = AtomOfTerm(t);
+  if (ppe->ArityOfPE == 0) {
-    pt = NULL;
-    pe = PredPropByAtom(a, mod);
-  } else if (IsApplTerm(t)) {
-    Functor f = FunctorOfTerm(t);
-
-    if (IsBlobFunctor(f)) {
-      Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
-      return(FALSE);
-    }
-    /* I cannot use the standard macro here because
-       otherwise I would dereference the argument and
-       might skip a svar */
-    pt = RepAppl(t)+1;
-    pe = PredPropByFunc(f, mod);
-  } else {
-    Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
-    return(FALSE);
-  }
-  ppe = RepPredProp(pe);
-  if (pe == NIL) {
-    return CallMetaCall(t, mod PASS_REGS);
-  }
-  PELOCK(81,RepPredProp(pe));
-  if (IsAtomTerm(t)) {
     CodeAdr = ppe->CodeOfPred;
     UNLOCK(ppe->PELock);
-    out = do_goal(t, CodeAdr, 0, pt, FALSE PASS_REGS);
+    out = do_goal(CodeAdr, 0, pt, FALSE PASS_REGS);
   } else {
-    Functor f = FunctorOfTerm(t);
     CodeAdr = ppe->CodeOfPred;
     UNLOCK(ppe->PELock);
-    out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE PASS_REGS);
+    out = do_goal(CodeAdr, ppe->ArityOfPE, pt, FALSE PASS_REGS);
   }
+  CurSlot = saved_slot;
 
   if (out == 1) {
     choiceptr cut_B;
@@ -1284,15 +1254,13 @@ Yap_execute_goal(Term t, int nargs, Term mod)
     DEPTH= ENV[E_DEPTH];
 #endif
     ENV  = (CELL *)(ENV[E_E]);
-    Yap_StartSlots( PASS_REGS1 );
     /* we have failed, and usually we would backtrack to this B,
        trouble is, we may also have a delayed cut to do */
     if (B != NULL)
       HB   = B->cp_h;
     YENV = ENV;
-    return(TRUE);
+    return TRUE;
   } else if (out == 0) {
-    ASP  = B->cp_env;
     P    = saved_p;
     CP   = saved_cp;
     H    = B->cp_h;
@@ -1314,6 +1282,47 @@ Yap_execute_goal(Term t, int nargs, Term mod)
   }
 }
 
+Int
+Yap_execute_goal(Term t, int nargs, Term mod)
+{
+  CACHE_REGS
+  Prop pe;
+  PredEntry *ppe;
+  CELL *pt;
+  /* preserve the current restart environment */
+  /* visualc*/
+  /* just keep the difference because of possible garbage collections */
+
+
+  if (IsAtomTerm(t)) {
+    Atom a = AtomOfTerm(t);
+    pt = NULL;
+    pe = PredPropByAtom(a, mod);
+  } else if (IsApplTerm(t)) {
+    Functor f = FunctorOfTerm(t);
+
+    if (IsBlobFunctor(f)) {
+      Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
+      return(FALSE);
+    }
+    /* I cannot use the standard macro here because
+       otherwise I would dereference the argument and
+       might skip a svar */
+    pt = RepAppl(t)+1;
+    pe = PredPropByFunc(f, mod);
+  } else {
+    Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
+    return(FALSE);
+  }
+  ppe = RepPredProp(pe);
+  if (pe == NIL) {
+    return CallMetaCall(t, mod PASS_REGS);
+  }
+  return execute_pred(ppe, pt PASS_REGS);
+
+}
+
+
 void
 Yap_trust_last(void)
 {
@@ -1399,7 +1408,7 @@ Yap_RunTopGoal(Term t)
 	  "unable to boot because of too little Trail space");
   }
 #endif
-  goal_out = do_goal(t, CodeAdr, arity, pt, TRUE PASS_REGS);
+  goal_out = do_goal(CodeAdr, arity, pt, TRUE PASS_REGS);
   return goal_out;
 }
 

C/exo.c

@@ -143,6 +143,7 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0, UInt bnd
       if (bnds[k]) {
 	if (*target != cl[k]) {
 	  /* found a new forking point */
+	  //    printf("j=%ld hash0=%ld cl[j]=%lx\n", j, hash0, cl[j]);
 	  INSERT(cl, it, arity, k, hash0, bnds);
 	  return;
 	}
@@ -229,6 +230,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
 static struct index_t *
 add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
 {
+  CACHE_REGS
   UInt ncls = ap->cs.p_code.NOfClauses, j;
   CELL *base = NULL;
   struct index_t *i;
@@ -264,6 +266,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
     }
     bzero(base, 3*sizeof(CELL)*ncls);
   }
+  i->size = sizeof(CELL)*(ncls+i->hsize)+sz+sizeof(struct index_t);
   i->key = (CELL **)base;
   i->links = (CELL *)(base+i->hsize);
   i->ncollisions = i->nentries = i->ntrys = 0;
@@ -308,6 +311,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
   ptr = NEXTOP(ptr, p);
   ptr->opc = Yap_opcode(_Ystop);
   ptr->u.l.l = i->code;
+  Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX); 
   return i;
 }
 

C/heapgc.c

@@ -4173,7 +4173,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
   }
   /*
    * debug for(save_total=1; save_total<=N; ++save_total)
-   * plwrite(XREGS[save_total],NULL,30,0,0); 
+   * plwrite(XREGS[save_total],NULL,30,0,0,0); 
    */
   return TRUE;
 }

C/init.c

@@ -884,6 +884,13 @@ InitStdPreds(void)
 {
   Yap_InitCPreds();
   Yap_InitBackCPreds();
+  BACKUP_MACHINE_REGS();
+  Yap_InitYaamRegs( 0 );
+
+#if HAVE_MPE
+  Yap_InitMPE ();
+#endif
+  initIO();
 }
 
 static void
@@ -1005,9 +1012,12 @@ InitLogDBErasedMarker(void)
 static void 
 InitSWIAtoms(void)
 {
+  extern atom_t ATOM_;
+
   int i=0, j=0;
 #include "iswiatoms.h"
   Yap_InitSWIHash();
+  ATOM_ = PL_new_atom("");
 }
 
 static void 
@@ -1331,6 +1341,29 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
   InitDebug();
   InitVersion();
   Yap_InitSysPath();
+#if THREADS
+  /* make sure we use the correct value of regcache */
+  regcache =  ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
+#endif
+#if USE_SYSTEM_MALLOC
+  if (Trail < MinTrailSpace)
+    Trail = MinTrailSpace;
+  if (Stack < MinStackSpace)
+    Stack = MinStackSpace;
+  if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
+    Yap_Error(RESOURCE_ERROR_MEMORY, 0, "could not allocate stack space for main thread");
+    Yap_exit(1);
+  }
+#if THREADS
+  /* don't forget this is a thread */
+  LOCAL_ThreadHandle.stack_address =  LOCAL_GlobalBase;
+  LOCAL_ThreadHandle.ssize =  Trail+Stack;
+#endif
+#endif
+  GLOBAL_AllowGlobalExpansion = TRUE;
+  GLOBAL_AllowLocalExpansion = TRUE;
+  GLOBAL_AllowTrailExpansion = TRUE;
+  Yap_InitExStacks (0, Trail, Stack);
   InitStdPreds();
   /* make sure tmp area is available */
   {

C/iopreds.c

@@ -219,10 +219,10 @@ Yap_GetCharForSIGINT(void)
 {
   int ch;
   /* ask for a new line */
-  fprintf(stderr, "Action (h for help): ");
+  Sfprintf(Serror, "\nAction (h for help): ");
-  ch = getc(stdin);
+  ch = Sgetchar();
   /* first process up to end of line */
-  while ((fgetc(stdin)) != '\n');
+  while ((Sfgetc(Sinput)) != '\n');
   newline = TRUE;
   return ch;
 }

C/load_dll.c

@@ -27,10 +27,10 @@
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
-  return NULL;
+  return "yap";
 }
 
 void *

C/pl-yap.c

@@ -177,6 +177,23 @@ Yap_SetDefaultEncoding(IOENC new_encoding)
   LD->encoding = new_encoding;
 }
 
+int
+PL_qualify(term_t raw, term_t qualified)
+{ GET_LD
+  Module m = NULL;
+  term_t mname;
+
+  if ( !(mname = PL_new_term_ref()) ||
+       !PL_strip_module(raw, &m, qualified) )
+    return FALSE;
+  
+  /* modules are terms in YAP */
+  Yap_PutInSlot(mname, (Term)m PASS_REGS);
+
+  return PL_cons_functor(qualified, FUNCTOR_colon2, mname, qualified);
+}
+
+
 int
 valueExpression(term_t t, Number r ARG_LD)
 {
@@ -284,6 +301,8 @@ int
 _PL_unify_atomic(term_t t, PL_atomic_t a)
 {
   GET_LD
+    if (IsApplTerm(a) || IsAtomTerm(a))
+  return Yap_unify(Yap_GetFromSlot(t PASS_REGS), a);
   return PL_unify_atom(t, a);
 }
 
@@ -482,8 +501,6 @@ PL_set_prolog_flag(const char *name, int type, ...)
   int rval = TRUE;
   int flags = (type & FF_MASK);
 
-  initPrologFlagTable();
-
   va_start(args, type);
   switch(type & ~FF_MASK)
   { case PL_BOOL:
@@ -496,7 +513,7 @@ PL_set_prolog_flag(const char *name, int type, ...)
     { const char *v = va_arg(args, const char *);
 #ifndef __YAP_PROLOG__
       if ( !GD->initialised )
-	initAtoms();
+        initAtoms();
 #endif
       setPrologFlag(name, FT_ATOM|flags, v);
       break;
@@ -509,13 +526,12 @@ PL_set_prolog_flag(const char *name, int type, ...)
     default:
       rval = FALSE;
   }
-
   va_end(args);
+
   return rval;
 }
 
 
-
 int
 PL_unify_chars(term_t t, int flags, size_t len, const char *s)
 { PL_chars_t text;
@@ -761,6 +777,12 @@ PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags)
   fail;
 }
 
+void *
+PL_malloc_uncollectable(size_t sz)
+{
+  return malloc(sz);
+}
+
 int
 PL_get_list_chars(term_t l, char **s, unsigned flags)
 { return PL_get_list_nchars(l, NULL, s, flags);
@@ -1213,6 +1235,68 @@ nameOfWideAtom(atom_t atom)
   return RepAtom(a)->WStrOfAE;
 }
 
+access_level_t
+setAccessLevel(access_level_t accept)
+{ GET_LD
+  bool old;
+
+  old = LD->prolog_flag.access_level;
+  LD->prolog_flag.access_level = accept;
+  return old;
+}
+
+static bool
+vsysError(const char *fm, va_list args)
+{ GET_LD
+  static int active = 0;
+
+  switch ( active++ )
+  { case 1:
+      PL_halt(3);
+    case 2:
+      abort();
+  }
+
+#ifdef O_PLMT
+  Sfprintf(Serror, "[PROLOG SYSTEM ERROR:  Thread %d\n\t",
+	   PL_thread_self());
+#else
+  Sfprintf(Serror, "[PROLOG SYSTEM ERROR:\n\t");
+#endif
+  Svfprintf(Serror, fm, args);
+
+#if defined(O_DEBUGGER)
+  Sfprintf(Serror, "\n\nPROLOG STACK:\n");
+  PL_backtrace(10, 0);
+  Sfprintf(Serror, "]\n");
+#endif /*O_DEBUGGER*/
+
+#ifdef HAVE_GETPID
+  Sfprintf(Serror, "\n[pid=%d] Action? ", getpid());
+#else
+  Sfprintf(Serror, "\nAction? ");
+#endif
+  Sflush(Soutput);
+  ResetTty();
+
+  PL_halt(3);
+
+  return FALSE;					/* not reached */
+}
+
+
+bool
+sysError(const char *fm, ...)
+{ va_list args;
+
+  va_start(args, fm);
+  vsysError(fm, args);
+  va_end(args);
+
+  PL_fail;
+}
+
+
 
 #if THREADS
 

C/qlyr.c

@@ -47,6 +47,20 @@ typedef enum {
   BAD_READ = 11
 } qlfr_err_t;
 
+static char *
+qlyr_error[] = { "out of temporary space",
+		"out of temporary space",
+		"out of code space",
+		"unknown atom in saved space",
+		"unknown functor in saved space",
+		"unknown predicate in saved space",
+		"unknown YAAM opcode in saved space",
+		"unknown data-base reference in saved space",
+		"corrupted atom in saved space",
+		"formatting mismatch in saved space",
+		"foreign predicate has different definition in saved space",
+		"bad read" };
+
 static char *
 Yap_AlwaysAllocCodeSpace(UInt size)
 {
@@ -62,7 +76,7 @@ Yap_AlwaysAllocCodeSpace(UInt size)
 static void
 QLYR_ERROR(qlfr_err_t my_err)
 {
-  fprintf(stderr,"Error %d\n", my_err);
+  Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); 
   exit(1);
 }
 
@@ -1056,8 +1070,10 @@ Yap_Restore(char *s, char *lib_dir)
   IOSTREAM *stream  = Yap_OpenRestore(s, lib_dir);
   if (!stream) 
     return -1;
+  GLOBAL_RestoreFile = s;
   read_module(stream);
   Sclose( stream );
+  GLOBAL_RestoreFile = NULL;
   return DO_ONLY_CODE;
 }
 

C/save.c

@@ -685,8 +685,8 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
   if (strcmp(pp, msg) != 0) {
     LOCAL_ErrorMessage = LOCAL_ErrorSay;
     strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE);
-    strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE);
+    strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE-1);
-    strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE);
+    strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE-1);
     LOCAL_Error_TYPE = CONSISTENCY_ERROR;
     return FAIL_RESTORE;
   }

C/stdpreds.c

@@ -3886,12 +3886,12 @@ p_statistics_atom_info( USES_REGS1 )
     while (catom != NIL) {
       Atom ncatom;
       count++;
-      spaceused += sizeof(AtomEntry)+strlen(RepAtom(catom)->StrOfAE);
+      spaceused += sizeof(AtomEntry)+strlen(RepAtom(catom)->StrOfAE)+1;
       ncatom = RepAtom(catom)->NextOfAE;
       if (ncatom != NIL) {
 	READ_LOCK(RepAtom(ncatom)->ARWLock);
       }
-      READ_UNLOCK(RepAtom(ncatom)->ARWLock);
+      READ_UNLOCK(RepAtom(catom)->ARWLock);
       catom = ncatom;
     }
   }
@@ -3907,12 +3907,12 @@ p_statistics_atom_info( USES_REGS1 )
     while (catom != NIL) {
       Atom ncatom;
       count++;
-      spaceused += sizeof(AtomEntry)+wcslen((wchar_t *)( RepAtom(catom)->StrOfAE));
+      spaceused += sizeof(AtomEntry)+sizeof(wchar_t)*(wcslen((wchar_t *)( RepAtom(catom)->StrOfAE)+1));
       ncatom = RepAtom(catom)->NextOfAE;
       if (ncatom != NIL) {
 	READ_LOCK(RepAtom(ncatom)->ARWLock);
       }
-      READ_UNLOCK(RepAtom(ncatom)->ARWLock);
+      READ_UNLOCK(RepAtom(catom)->ARWLock);
       catom = ncatom;
     }
   }
@@ -4361,10 +4361,6 @@ Yap_InitBackCPreds(void)
 #if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
   Yap_InitBackMYDDAS_SharedPreds();
 #endif
-  {
-    extern void initIO(void);
-    initIO();
-  }
 }
 
 typedef void (*Proc)(void);

C/utilpreds.c

@@ -2657,6 +2657,353 @@ p_new_variables_in_term( USES_REGS1 )	/* variables within term t		 */
   return Yap_unify(ARG3,out);
 }
 
+static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
+{
+  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  CELL *InitialH = H;
+  *H++ = MkAtomTerm(AtomDollar);
+
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, vars_within_term_unk);
+  vars_within_term_nvar:
+    {
+      if (IsPairTerm(d0)) {
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	pt0 = RepPair(d0) - 1;
+	pt0_end = RepPair(d0) + 1;
+      } else if (IsApplTerm(d0)) {
+	register Functor f;
+	register CELL *ap2;
+	/* store the terms to visit */
+	ap2 = RepAppl(d0);
+	f = (Functor)(*ap2);
+	if (IsExtensionFunctor(f)) {
+	  continue;
+	}
+	/* store the terms to visit */
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	d0 = ArityOfFunctor(f);
+	pt0 = ap2;
+	pt0_end = ap2 + d0;
+      }
+      continue;
+    }
+
+    derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
+    /* do or pt2 are unbound  */
+    *ptd0 = TermNil;
+    /* leave an empty slot to fill in later */
+    if (H+1024 > ASP) {
+      goto global_overflow;
+    }
+    H[0] =  (CELL)ptd0;
+    H ++;
+    /* next make sure noone will see this as a variable again */ 
+    if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+      /* Trail overflow */
+      if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	goto trail_overflow;
+      }
+    }
+    TrailTerm(TR++) = (CELL)ptd0;
+  }
+  /* Do we still have compound terms to visit */
+  if (to_visit > to_visit0) {
+#ifdef RATIONAL_TREES
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+    *pt0 = (CELL)to_visit[2];
+#else
+    to_visit -= 2;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+#endif
+    goto loop;
+  }
+
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  if (H != InitialH+1) {
+    InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (H-InitialH)-1);
+    return AbsAppl(InitialH);
+  } else {
+    return MkAtomTerm(AtomDollar);
+  }
+
+ trail_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
+  LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ aux_overflow:
+  LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ global_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
+  LOCAL_Error_Size = (ASP-H)*sizeof(CELL);
+  return 0L;
+  
+}
+
+static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
+{
+  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  CELL *InitialH = H;
+
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, vars_within_term_unk);
+  vars_within_term_nvar:
+    {
+      if (IsPairTerm(d0)) {
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	pt0 = RepPair(d0) - 1;
+	pt0_end = RepPair(d0) + 1;
+      } else if (IsApplTerm(d0)) {
+	register Functor f;
+	register CELL *ap2;
+	/* store the terms to visit */
+	ap2 = RepAppl(d0);
+	f = (Functor)(*ap2);
+	if (IsExtensionFunctor(f)) {
+	  continue;
+	}
+	/* store the terms to visit */
+	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	  goto aux_overflow;
+	}
+#ifdef RATIONAL_TREES
+	to_visit[0] = pt0;
+	to_visit[1] = pt0_end;
+	to_visit[2] = (CELL *)*pt0;
+	to_visit += 3;
+	*pt0 = TermNil;
+#else
+	if (pt0 < pt0_end) {
+	  to_visit[0] = pt0;
+	  to_visit[1] = pt0_end;
+	  to_visit += 2;
+	}
+#endif
+	d0 = ArityOfFunctor(f);
+	pt0 = ap2;
+	pt0_end = ap2 + d0;
+      }
+      continue;
+    }
+
+    derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
+    /* do or pt2 are unbound  */
+    *ptd0 = TermFoundVar;
+    /* next make sure noone will see this as a variable again */ 
+    if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+      /* Trail overflow */
+      if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	goto trail_overflow;
+      }
+    }
+    TrailTerm(TR++) = (CELL)ptd0;
+  }
+  /* Do we still have compound terms to visit */
+  if (to_visit > to_visit0) {
+#ifdef RATIONAL_TREES
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+    *pt0 = (CELL)to_visit[2];
+#else
+    to_visit -= 2;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+#endif
+    goto loop;
+  }
+
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  return TermNil;
+
+ trail_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
+  LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ aux_overflow:
+  LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+}
+
+static Int 
+p_free_variables_in_term( USES_REGS1 )	/* variables within term t		 */
+{
+  Term out;
+  Term t, t0;
+  Term found_module = 0L;
+
+  do {
+    tr_fr_ptr TR0 = TR; 
+
+    t = t0 = Deref(ARG1);
+    while (!IsVarTerm(t) && IsApplTerm(t)) {
+      Functor f = FunctorOfTerm(t);
+      if (f == FunctorHat) {
+	out = bind_vars_in_complex_term(RepAppl(t),
+			     RepAppl(t)+1, TR0 PASS_REGS);
+	if (out == 0L) {
+	  goto trail_overflow;
+	}
+      } else if (f == FunctorModule) {
+	found_module = ArgOfTerm(1, t);
+      } else {
+	break;
+      }
+      t = ArgOfTerm(2,t);
+    }
+    if (IsVarTerm(t)) {
+      out = free_vars_in_complex_term(VarOfTerm(t)-1,
+				      VarOfTerm(t), TR0 PASS_REGS);
+
+    }  else if (IsPrimitiveTerm(t)) 
+      out = TermNil;
+    else if (IsPairTerm(t)) {
+      out = free_vars_in_complex_term(RepPair(t)-1,
+				      RepPair(t)+1, TR0 PASS_REGS);
+    }
+    else {
+      Functor f = FunctorOfTerm(t);
+      out = free_vars_in_complex_term(RepAppl(t),
+			     RepAppl(t)+
+				      ArityOfFunctor(f), TR0 PASS_REGS);
+    }
+    if (out == 0L) {
+    trail_overflow:
+      if (!expand_vts( 3 PASS_REGS ))
+	return FALSE;
+    }
+  } while (out == 0L);
+  if (found_module && t!=t0) {
+    Term ts[2];
+    ts[0] = found_module;
+    ts[1] = t;
+    t = Yap_MkApplTerm(FunctorModule, 2, ts);
+  }
+  return
+    Yap_unify(ARG2, t) &&
+    Yap_unify(ARG3,out);
+}
+
 static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
 {
 
@@ -5196,6 +5543,7 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
   Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
   Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0);
+  Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
   Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
   Yap_InitCPred("term_variables", 2, p_term_variables, 0);
   Yap_InitCPred("term_variables", 3, p_term_variables3, 0);

H/Yap.h

@@ -88,7 +88,7 @@
 #undef  USE_THREADED_CODE
 #endif /* USE_THREADED_CODE */
 #define inline __inline
-#define YAP_VERSION "YAP-6.3.2"
+#define YAP_VERSION "YAP-6.3.4"
 #define BIN_DIR "c:\\Yap\\bin"
 #define LIB_DIR "c:\\Yap\\lib\\Yap"
 #define SHARE_DIR "c:\\Yap\\share\\Yap"
@@ -121,6 +121,14 @@
 #define DUMMY_FILLER_FOR_ABS_TYPE int dummy;
 #endif /* HAVE_GCC */
 
+#ifdef HAVE___BUILTIN_EXPECT
+#define likely(x)       __builtin_expect((x), 1)
+#define unlikely(x)     __builtin_expect((x), 0)
+#else
+#define likely(x)       (x)
+#define unlikely(x)     (x)
+#endif
+
 #ifdef THREADS
 #if USE_PTHREAD_LOCKING
 #ifndef _XOPEN_SOURCE
@@ -403,6 +411,7 @@ typedef enum
   RESOURCE_ERROR_MEMORY,
   RESOURCE_ERROR_STACK,
   RETRY_COUNTER_UNDERFLOW,
+  SAVED_STATE_ERROR,
   SYNTAX_ERROR,
   SYSTEM_ERROR,
   TYPE_ERROR_ARRAY,

H/YapOpcodes.h

@@ -9,8 +9,10 @@
   OPCODE(trust_me                   ,Otapl),
   OPCODE(enter_exo                  ,e),
   OPCODE(try_exo                    ,lp),
+  OPCODE(try_udi                    ,p),
   OPCODE(try_all_exo                ,lp),
   OPCODE(retry_exo                  ,lp),
+  OPCODE(retry_udi                  ,p),
   OPCODE(retry_all_exo              ,lp),
   OPCODE(enter_profiling            ,p),
   OPCODE(retry_profiled             ,p),

H/clause.h

@@ -173,6 +173,7 @@ typedef struct index_t {
   CELL **key;
   CELL *cls;
   CELL *links;
+  size_t size;
   yamop *code;
 } Index_t;
 

H/dglobals.h

@@ -98,4 +98,5 @@
 #endif
 
 
+#define GLOBAL_RestoreFile Yap_global->RestoreFile_
 

H/dlocals.h

@@ -433,3 +433,6 @@
 #define LOCAL_ibnds LOCAL->ibnds_
 #define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_
 
+#define LOCAL_search_atoms LOCAL->search_atoms_
+#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
+

H/hglobals.h

@@ -98,4 +98,5 @@ typedef struct global_data {
 #endif
 
 
+  char*  RestoreFile_;
 } w_shared;

H/hlocals.h

@@ -243,4 +243,6 @@ typedef struct worker_local {
   Functor  FunctorVar_;
 
   UInt  ibnds_[256];
+
+  struct scan_atoms*  search_atoms_;
 } w_local;

H/iatoms.h

@@ -74,6 +74,7 @@
   AtomDefault = Yap_LookupAtom("default");
   AtomDevNull = Yap_LookupAtom("/dev/null");
   AtomDiff = Yap_LookupAtom("\\=");
+  AtomDollar = Yap_FullLookupAtom("$");
   AtomDoLogUpdClause = Yap_FullLookupAtom("$do_log_upd_clause");
   AtomDoLogUpdClause0 = Yap_FullLookupAtom("$do_log_upd_clause0");
   AtomDoLogUpdClauseErase = Yap_FullLookupAtom("$do_log_upd_clause_erase");
@@ -127,6 +128,7 @@
   AtomGlobalSp = Yap_LookupAtom("global_sp");
   AtomGlobalTrie = Yap_LookupAtom("global_trie");
   AtomGoalExpansion = Yap_LookupAtom("goal_expansion");
+  AtomHat = Yap_LookupAtom("^");
   AtomHERE = Yap_LookupAtom("\n   <====HERE====>  \n");
   AtomHandleThrow = Yap_FullLookupAtom("$handle_throw");
   AtomHeap = Yap_LookupAtom("heap");
@@ -390,6 +392,7 @@
   FunctorGoalExpansion2 = Yap_MkFunctor(AtomGoalExpansion,2);
   FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
   FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
+  FunctorHat = Yap_MkFunctor(AtomHat,2);
   FunctorId = Yap_MkFunctor(AtomId,1);
   FunctorIs = Yap_MkFunctor(AtomIs,2);
   FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1);

H/iglobals.h

@@ -98,4 +98,5 @@ static void InitGlobal(void) {
 #endif
 
 
+
 }

H/ilocals.h

@@ -243,4 +243,6 @@ static void InitWorker(int wid) {
   REMOTE_FunctorVar(wid) = FunctorVar;
 
 
+
+
 }

H/iswiatoms.h

@@ -8,7 +8,9 @@
   SWI_Atoms[i++] = Yap_LookupAtom("$aborted");
   SWI_Atoms[i++] = Yap_LookupAtom("abs");
   SWI_Atoms[i++] = Yap_LookupAtom("access");
+  SWI_Atoms[i++] = Yap_LookupAtom("access_level");
   SWI_Atoms[i++] = Yap_LookupAtom("acos");
+  SWI_Atoms[i++] = Yap_LookupAtom("acosh");
   SWI_Atoms[i++] = Yap_LookupAtom("acyclic_term");
   SWI_Atoms[i++] = Yap_LookupAtom("add_import");
   SWI_Atoms[i++] = Yap_LookupAtom("address");
@@ -32,6 +34,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("as");
   SWI_Atoms[i++] = Yap_LookupAtom("ascii");
   SWI_Atoms[i++] = Yap_LookupAtom("asin");
+  SWI_Atoms[i++] = Yap_LookupAtom("asinh");
   SWI_Atoms[i++] = Yap_LookupAtom("assert");
   SWI_Atoms[i++] = Yap_LookupAtom("asserta");
   SWI_Atoms[i++] = Yap_LookupAtom("at");
@@ -43,6 +46,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("@<");
   SWI_Atoms[i++] = Yap_LookupAtom("@=<");
   SWI_Atoms[i++] = Yap_LookupAtom("atan");
+  SWI_Atoms[i++] = Yap_LookupAtom("atanh");
   SWI_Atoms[i++] = Yap_LookupAtom("atan2");
   SWI_Atoms[i++] = Yap_LookupAtom("atom");
   SWI_Atoms[i++] = Yap_LookupAtom("atom_garbage_collection");
@@ -56,8 +60,10 @@
   SWI_Atoms[i++] = Yap_LookupAtom("\\");
   SWI_Atoms[i++] = Yap_LookupAtom("backtrace");
   SWI_Atoms[i++] = Yap_LookupAtom("|");
+  SWI_Atoms[i++] = Yap_LookupAtom("base");
   SWI_Atoms[i++] = Yap_LookupAtom("begin");
   SWI_Atoms[i++] = Yap_LookupAtom("binary");
+  SWI_Atoms[i++] = Yap_LookupAtom("binary_stream");
   SWI_Atoms[i++] = Yap_LookupAtom("bind");
   SWI_Atoms[i++] = Yap_LookupAtom("\\/");
   SWI_Atoms[i++] = Yap_LookupAtom("blobs");
@@ -67,6 +73,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("boolean");
   SWI_Atoms[i++] = Yap_LookupAtom("brace_term_position");
   SWI_Atoms[i++] = Yap_LookupAtom("break");
+  SWI_Atoms[i++] = Yap_LookupAtom("break_level");
   SWI_Atoms[i++] = Yap_LookupAtom("btree");
   SWI_Atoms[i++] = Yap_LookupAtom("buffer");
   SWI_Atoms[i++] = Yap_LookupAtom("buffer_size");
@@ -80,6 +87,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("canceled");
   SWI_Atoms[i++] = Yap_LookupAtom("case_sensitive_file_names");
   SWI_Atoms[i++] = Yap_LookupAtom("catch");
+  SWI_Atoms[i++] = Yap_LookupAtom("category");
   SWI_Atoms[i++] = Yap_LookupAtom("ceil");
   SWI_Atoms[i++] = Yap_LookupAtom("ceiling");
   SWI_Atoms[i++] = Yap_LookupAtom("char_type");
@@ -90,7 +98,9 @@
   SWI_Atoms[i++] = Yap_LookupAtom("chdir");
   SWI_Atoms[i++] = Yap_LookupAtom("chmod");
   SWI_Atoms[i++] = Yap_LookupAtom("choice");
+  SWI_Atoms[i++] = Yap_LookupAtom("class");
   SWI_Atoms[i++] = Yap_LookupAtom("clause");
+  SWI_Atoms[i++] = Yap_LookupAtom("clauses");
   SWI_Atoms[i++] = Yap_LookupAtom("clause_reference");
   SWI_Atoms[i++] = Yap_LookupAtom("close");
   SWI_Atoms[i++] = Yap_LookupAtom("close_on_abort");
@@ -109,9 +119,11 @@
   SWI_Atoms[i++] = Yap_LookupAtom("context");
   SWI_Atoms[i++] = Yap_LookupAtom("context_module");
   SWI_Atoms[i++] = Yap_LookupAtom("continue");
+  SWI_Atoms[i++] = Yap_LookupAtom("copysign");
   SWI_Atoms[i++] = Yap_LookupAtom("core");
   SWI_Atoms[i++] = Yap_LookupAtom("core_left");
   SWI_Atoms[i++] = Yap_LookupAtom("cos");
+  SWI_Atoms[i++] = Yap_LookupAtom("cosh");
   SWI_Atoms[i++] = Yap_LookupAtom("cputime");
   SWI_Atoms[i++] = Yap_LookupAtom("create");
   SWI_Atoms[i++] = Yap_LookupAtom("csym");
@@ -127,6 +139,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("cut_parent");
   SWI_Atoms[i++] = Yap_LookupAtom("cut");
   SWI_Atoms[i++] = Yap_LookupAtom("cyclic_term");
+  SWI_Atoms[i++] = Yap_LookupAtom("cycles");
   SWI_Atoms[i++] = Yap_LookupAtom("$and");
   SWI_Atoms[i++] = Yap_LookupAtom("date");
   SWI_Atoms[i++] = Yap_LookupAtom("db_reference");
@@ -137,8 +150,10 @@
   SWI_Atoms[i++] = Yap_LookupAtom("$cut");
   SWI_Atoms[i++] = Yap_LookupAtom("dde_error");
   SWI_Atoms[i++] = Yap_LookupAtom("dde_handle");
+  SWI_Atoms[i++] = Yap_LookupAtom("deadline");
   SWI_Atoms[i++] = Yap_LookupAtom("debug");
   SWI_Atoms[i++] = Yap_LookupAtom("debug_on_error");
+  SWI_Atoms[i++] = Yap_LookupAtom("debug_topic");
   SWI_Atoms[i++] = Yap_LookupAtom("debugger_print_options");
   SWI_Atoms[i++] = Yap_LookupAtom("debugger_show_context");
   SWI_Atoms[i++] = Yap_LookupAtom("debugging");
@@ -170,11 +185,13 @@
   SWI_Atoms[i++] = Yap_LookupAtom("double_quotes");
   SWI_Atoms[i++] = Yap_LookupAtom("**");
   SWI_Atoms[i++] = Yap_LookupAtom("$profile_node");
+  SWI_Atoms[i++] = Yap_LookupAtom("$query_loop");
   SWI_Atoms[i++] = Yap_LookupAtom("$recover_and_rethrow");
   SWI_Atoms[i++] = Yap_LookupAtom("$stream");
   SWI_Atoms[i++] = Yap_LookupAtom("$thread_init");
   SWI_Atoms[i++] = Yap_LookupAtom("$throw");
   SWI_Atoms[i++] = Yap_LookupAtom("$time");
+  SWI_Atoms[i++] = Yap_LookupAtom("$toplevel");
   SWI_Atoms[i++] = Yap_LookupAtom("$VAR$");
   SWI_Atoms[i++] = Yap_LookupAtom("$wakeup");
   SWI_Atoms[i++] = Yap_LookupAtom("dynamic");
@@ -268,9 +285,8 @@
   SWI_Atoms[i++] = Yap_LookupAtom("hash");
   SWI_Atoms[i++] = Yap_LookupAtom("hashed");
   SWI_Atoms[i++] = Yap_LookupAtom("^");
-  SWI_Atoms[i++] = Yap_LookupAtom("heap");
-  SWI_Atoms[i++] = Yap_LookupAtom("heaplimit");
   SWI_Atoms[i++] = Yap_LookupAtom("heapused");
+  SWI_Atoms[i++] = Yap_LookupAtom("heap_gc");
   SWI_Atoms[i++] = Yap_LookupAtom("help");
   SWI_Atoms[i++] = Yap_LookupAtom("hidden");
   SWI_Atoms[i++] = Yap_LookupAtom("hide_childs");
@@ -278,6 +294,8 @@
   SWI_Atoms[i++] = Yap_LookupAtom("->");
   SWI_Atoms[i++] = Yap_LookupAtom("ignore");
   SWI_Atoms[i++] = Yap_LookupAtom("ignore_ops");
+  SWI_Atoms[i++] = Yap_LookupAtom("import_into");
+  SWI_Atoms[i++] = Yap_LookupAtom("import_type");
   SWI_Atoms[i++] = Yap_LookupAtom("imported");
   SWI_Atoms[i++] = Yap_LookupAtom("imported_procedure");
   SWI_Atoms[i++] = Yap_LookupAtom("index");
@@ -312,9 +330,11 @@
   SWI_Atoms[i++] = Yap_LookupAtom(">=");
   SWI_Atoms[i++] = Yap_LookupAtom("level");
   SWI_Atoms[i++] = Yap_LookupAtom("li");
+  SWI_Atoms[i++] = Yap_LookupAtom("library");
   SWI_Atoms[i++] = Yap_LookupAtom("limit");
   SWI_Atoms[i++] = Yap_LookupAtom("line");
   SWI_Atoms[i++] = Yap_LookupAtom("line_count");
+  SWI_Atoms[i++] = Yap_LookupAtom("line_position");
   SWI_Atoms[i++] = Yap_LookupAtom("list");
   SWI_Atoms[i++] = Yap_LookupAtom("list_position");
   SWI_Atoms[i++] = Yap_LookupAtom("listing");
@@ -329,6 +349,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("log");
   SWI_Atoms[i++] = Yap_LookupAtom("log10");
   SWI_Atoms[i++] = Yap_LookupAtom("long");
+  SWI_Atoms[i++] = Yap_LookupAtom("loose");
   SWI_Atoms[i++] = Yap_LookupAtom("low");
   SWI_Atoms[i++] = Yap_LookupAtom("lower");
   SWI_Atoms[i++] = Yap_LookupAtom("lsb");
@@ -342,6 +363,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("max_depth");
   SWI_Atoms[i++] = Yap_LookupAtom("max_files");
   SWI_Atoms[i++] = Yap_LookupAtom("max_frame_size");
+  SWI_Atoms[i++] = Yap_LookupAtom("max_length");
   SWI_Atoms[i++] = Yap_LookupAtom("max_path_length");
   SWI_Atoms[i++] = Yap_LookupAtom("max_size");
   SWI_Atoms[i++] = Yap_LookupAtom("max_variable_length");
@@ -361,6 +383,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("mode");
   SWI_Atoms[i++] = Yap_LookupAtom("modify");
   SWI_Atoms[i++] = Yap_LookupAtom("module");
+  SWI_Atoms[i++] = Yap_LookupAtom("module_class");
   SWI_Atoms[i++] = Yap_LookupAtom("module_property");
   SWI_Atoms[i++] = Yap_LookupAtom("module_transparent");
   SWI_Atoms[i++] = Yap_LookupAtom("modules");
@@ -391,6 +414,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("not_unique");
   SWI_Atoms[i++] = Yap_LookupAtom("number");
   SWI_Atoms[i++] = Yap_LookupAtom("number_of_clauses");
+  SWI_Atoms[i++] = Yap_LookupAtom("number_of_rules");
   SWI_Atoms[i++] = Yap_LookupAtom("numbervar_option");
   SWI_Atoms[i++] = Yap_LookupAtom("numbervars");
   SWI_Atoms[i++] = Yap_LookupAtom("occurs_check");
@@ -405,6 +429,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("or");
   SWI_Atoms[i++] = Yap_LookupAtom("order");
   SWI_Atoms[i++] = Yap_LookupAtom("output");
+  SWI_Atoms[i++] = Yap_LookupAtom("owner");
   SWI_Atoms[i++] = Yap_LookupAtom("pair");
   SWI_Atoms[i++] = Yap_LookupAtom("paren");
   SWI_Atoms[i++] = Yap_LookupAtom("parent");
@@ -423,6 +448,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("+");
   SWI_Atoms[i++] = Yap_LookupAtom("popcount");
   SWI_Atoms[i++] = Yap_LookupAtom("portray");
+  SWI_Atoms[i++] = Yap_LookupAtom("portray_goal");
   SWI_Atoms[i++] = Yap_LookupAtom("position");
   SWI_Atoms[i++] = Yap_LookupAtom("posix");
   SWI_Atoms[i++] = Yap_LookupAtom("powm");
@@ -433,6 +459,8 @@
   SWI_Atoms[i++] = Yap_LookupAtom("priority");
   SWI_Atoms[i++] = Yap_LookupAtom("private_procedure");
   SWI_Atoms[i++] = Yap_LookupAtom("procedure");
+  SWI_Atoms[i++] = Yap_LookupAtom("process_comment");
+  SWI_Atoms[i++] = Yap_LookupAtom("process_cputime");
   SWI_Atoms[i++] = Yap_LookupAtom("profile_mode");
   SWI_Atoms[i++] = Yap_LookupAtom("profile_no_cpu_time");
   SWI_Atoms[i++] = Yap_LookupAtom("profile_node");
@@ -457,6 +485,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("quoted");
   SWI_Atoms[i++] = Yap_LookupAtom("radix");
   SWI_Atoms[i++] = Yap_LookupAtom("random");
+  SWI_Atoms[i++] = Yap_LookupAtom("random_float");
   SWI_Atoms[i++] = Yap_LookupAtom("random_option");
   SWI_Atoms[i++] = Yap_LookupAtom("rational");
   SWI_Atoms[i++] = Yap_LookupAtom("rationalize");
@@ -472,6 +501,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("record_position");
   SWI_Atoms[i++] = Yap_LookupAtom("redefine");
   SWI_Atoms[i++] = Yap_LookupAtom("redo");
+  SWI_Atoms[i++] = Yap_LookupAtom("redo_in_skip");
   SWI_Atoms[i++] = Yap_LookupAtom("references");
   SWI_Atoms[i++] = Yap_LookupAtom("rem");
   SWI_Atoms[i++] = Yap_LookupAtom("rename");
@@ -489,6 +519,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("runtime");
   SWI_Atoms[i++] = Yap_LookupAtom("save_class");
   SWI_Atoms[i++] = Yap_LookupAtom("save_option");
+  SWI_Atoms[i++] = Yap_LookupAtom("see");
   SWI_Atoms[i++] = Yap_LookupAtom("seed");
   SWI_Atoms[i++] = Yap_LookupAtom("seek_method");
   SWI_Atoms[i++] = Yap_LookupAtom("select");
@@ -501,15 +532,18 @@
   SWI_Atoms[i++] = Yap_LookupAtom("shared_object");
   SWI_Atoms[i++] = Yap_LookupAtom("shared_object_handle");
   SWI_Atoms[i++] = Yap_LookupAtom("shell");
+  SWI_Atoms[i++] = Yap_LookupAtom("shift_time");
   SWI_Atoms[i++] = Yap_LookupAtom("sign");
   SWI_Atoms[i++] = Yap_LookupAtom("signal");
   SWI_Atoms[i++] = Yap_LookupAtom("signal_handler");
   SWI_Atoms[i++] = Yap_LookupAtom("silent");
   SWI_Atoms[i++] = Yap_LookupAtom("sin");
   SWI_Atoms[i++] = Yap_LookupAtom("singletons");
+  SWI_Atoms[i++] = Yap_LookupAtom("sinh");
   SWI_Atoms[i++] = Yap_LookupAtom("size");
   SWI_Atoms[i++] = Yap_LookupAtom("size_t");
   SWI_Atoms[i++] = Yap_LookupAtom("skip");
+  SWI_Atoms[i++] = Yap_LookupAtom("skipped");
   SWI_Atoms[i++] = Yap_LookupAtom("<");
   SWI_Atoms[i++] = Yap_LookupAtom("=<");
   SWI_Atoms[i++] = Yap_LookupAtom("*->");
@@ -528,6 +562,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("*");
   SWI_Atoms[i++] = Yap_LookupAtom("start");
   SWI_Atoms[i++] = Yap_LookupAtom("stat");
+  SWI_Atoms[i++] = Yap_LookupAtom("state");
   SWI_Atoms[i++] = Yap_LookupAtom("static_procedure");
   SWI_Atoms[i++] = Yap_LookupAtom("statistics");
   SWI_Atoms[i++] = Yap_LookupAtom("status");
@@ -538,9 +573,11 @@
   SWI_Atoms[i++] = Yap_LookupAtom("stream_pair");
   SWI_Atoms[i++] = Yap_LookupAtom("$stream_position");
   SWI_Atoms[i++] = Yap_LookupAtom("stream_property");
+  SWI_Atoms[i++] = Yap_LookupAtom("stream_type_check");
   SWI_Atoms[i++] = Yap_LookupAtom("==");
   SWI_Atoms[i++] = Yap_LookupAtom("string");
   SWI_Atoms[i++] = Yap_LookupAtom("string_position");
+  SWI_Atoms[i++] = Yap_LookupAtom("strong");
   SWI_Atoms[i++] = Yap_LookupAtom("subterm_positions");
   SWI_Atoms[i++] = Yap_LookupAtom("suffix");
   SWI_Atoms[i++] = Yap_LookupAtom("syntax_error");
@@ -551,15 +588,19 @@
   SWI_Atoms[i++] = Yap_LookupAtom("system_thread_id");
   SWI_Atoms[i++] = Yap_LookupAtom("system_time");
   SWI_Atoms[i++] = Yap_LookupAtom("tan");
+  SWI_Atoms[i++] = Yap_LookupAtom("tanh");
   SWI_Atoms[i++] = Yap_LookupAtom("temporary_files");
   SWI_Atoms[i++] = Yap_LookupAtom("term");
   SWI_Atoms[i++] = Yap_LookupAtom("term_expansion");
   SWI_Atoms[i++] = Yap_LookupAtom("term_position");
   SWI_Atoms[i++] = Yap_LookupAtom("terminal");
   SWI_Atoms[i++] = Yap_LookupAtom("terminal_capability");
+  SWI_Atoms[i++] = Yap_LookupAtom("test");
   SWI_Atoms[i++] = Yap_LookupAtom("text");
+  SWI_Atoms[i++] = Yap_LookupAtom("text_stream");
   SWI_Atoms[i++] = Yap_LookupAtom("thread");
   SWI_Atoms[i++] = Yap_LookupAtom("thread_cputime");
+  SWI_Atoms[i++] = Yap_LookupAtom("thread_get_message_option");
   SWI_Atoms[i++] = Yap_LookupAtom("thread_initialization");
   SWI_Atoms[i++] = Yap_LookupAtom("thread_local");
   SWI_Atoms[i++] = Yap_LookupAtom("thread_local_procedure");
@@ -637,6 +678,7 @@
   SWI_Atoms[i++] = Yap_LookupAtom("wakeup");
   SWI_Atoms[i++] = Yap_LookupAtom("walltime");
   SWI_Atoms[i++] = Yap_LookupAtom("warning");
+  SWI_Atoms[i++] = Yap_LookupAtom("weak");
   SWI_Atoms[i++] = Yap_LookupAtom("wchar_t");
   SWI_Atoms[i++] = Yap_LookupAtom("when_condition");
   SWI_Atoms[i++] = Yap_LookupAtom("white");
@@ -656,15 +698,18 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_abs),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_access),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_acos),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_acosh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_alias),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_and),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ar_equals),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ar_not_equal),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asin),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asinh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_assert),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_asserta),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atanh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atan2),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_atom),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_att),3);
@@ -686,6 +731,7 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ceiling),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_chars),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_chars),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_class),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_clause),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_close_on_abort),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_close_on_exec),1);
@@ -694,7 +740,9 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_colon),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_comma),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_context),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_copysign),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cos),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cosh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cputime),0);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_curl),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_cut_call),1);
@@ -762,7 +810,9 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ground),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_hat),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_ifthen),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_import_into),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_input),0);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_input),3);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_integer),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_interrupt),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_io_error),2);
@@ -792,6 +842,7 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_nonvar),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_implemented),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_provable),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_not_strict_equal),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_occurs_check),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_or),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_output),0);
@@ -806,14 +857,17 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_powm),3);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_print),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_print_message),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_priority),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_procedure),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_prove),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_prove),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_punct),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_random),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_random_float),0);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rational),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rationalize),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rdiv),2);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_redo),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_rem),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_reposition),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_representation_error),1);
@@ -831,6 +885,7 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_signal),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_sin),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_singletons),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_sinh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_size),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_smaller),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_smaller_equal),2);
@@ -848,6 +903,7 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_syntax_error),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_syntax_error),3);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_tan),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_tanh),1);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_term_expansion),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_term_position),5);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_timeout),1);
@@ -868,3 +924,4 @@
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_warning),3);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xor),2);
   SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xpceref),1);
+  SWI_Functors[j++] = Yap_MkFunctor(SWIAtomToAtom(ATOM_xpceref),2);

H/pl-global.h

@@ -81,6 +81,15 @@ typedef struct {
     int		optimise;		/* -O: optimised compilation */
   } cmdline;
 
+  struct
+  { char *      CWDdir;
+    size_t      CWDlen;
+    char *      executable;             /* Running executable */
+#ifdef __WINDOWS__
+    char *      module;                 /* argv[0] module passed */
+#endif
+  } paths;
+
   struct
   { ExtensionCell _ext_head;		/* head of registered extensions */
     ExtensionCell _ext_tail;		/* tail of this chain */
@@ -163,6 +172,7 @@ typedef struct PL_local_data {
   { IOSTREAM *streams[6];		/* handles for standard streams */
     struct input_context *input_stack;	/* maintain input stream info */
     struct output_context *output_stack; /* maintain output stream info */
+    st_check stream_type_check;		/* Check bin/text streams? */
   } IO;
 
   struct
@@ -192,6 +202,7 @@ typedef struct PL_local_data {
     pl_features_t mask;                 /* Masked access to booleans */
     int           write_attributes;     /* how to write attvars? */
     occurs_check_t occurs_check;        /* Unify and occurs check */
+    access_level_t access_level;        /* Current access level */
   } prolog_flag;
 
   void *        glob_info;              /* pl-glob.c */
@@ -236,6 +247,10 @@ typedef struct PL_local_data {
     int		_current_buffer_id;
   } fli;
 
+  struct
+  { fid_t	numbervars_frame;	/* Numbervars choice-point */
+  } var_names;
+
 #ifdef O_GMP
   struct
   { 
@@ -253,35 +268,6 @@ extern PL_local_data_t lds;
 
 #define exception_term		(LD->exception.term)
 
-// THIS HAS TO BE ABSTRACTED
-
-#define GLOBAL_LD (LOCAL_PL_local_data_p)
-
-#if !defined(O_PLMT) && !defined(YAPOR)
-#define LOCAL_LD (GLOBAL_LD)
-#define LD (GLOBAL_LD)
-#define ARG1_LD   void
-#define ARG_LD
-#define GET_LD
-#define PRED_LD
-#define PASS_LD
-#define PASS_LD1 
-
-#else
-
-#define LOCAL_LD (__PL_ld)
-#define LD	  LOCAL_LD
-
-#define GET_LD	  CACHE_REGS PL_local_data_t *__PL_ld = GLOBAL_LD;
-#define ARG1_LD   PL_local_data_t *__PL_ld
-
-#define ARG_LD    , ARG1_LD
-#define PASS_LD1  LD
-#define PASS_LD   , LD
-#define PRED_LD   GET_LD
-
-#endif
-
 #define Suser_input             (LD->IO.streams[0])
 #define Suser_output            (LD->IO.streams[1])
 #define Suser_error             (LD->IO.streams[2])

H/pl-incl.h

@@ -36,9 +36,16 @@
 #define O_PLMT 1
 #endif
 
+#if HAVE_ERRNO_H
+#include <errno.h>
+#endif
+
 #include "Yap.h"
 #include "YapHeap.h"
 
+#define PLVERSION YAP_VERSION
+#define PLNAME "yap"
+
 /* try not to pollute the SWI space */
 #ifdef P
 #undef P
@@ -225,6 +232,37 @@ users foreign language code.
                  *******************************/
 
 #define WM_SIGNALLED (WM_USER+4201)     /* how to select a good number!? */
+#endif
+
+// THIS HAS TO BE ABSTRACTED
+
+#define GLOBAL_LD (LOCAL_PL_local_data_p)
+
+#if !defined(O_PLMT) && !defined(YAPOR)
+#define LOCAL_LD (GLOBAL_LD)
+#define LD (GLOBAL_LD)
+#define ARG1_LD   void
+#define ARG_LD
+#define GET_LD
+#define PRED_LD
+#define PASS_LD
+#define PASS_LD1 
+#define IGNORE_LD
+
+#else
+
+#define LOCAL_LD (__PL_ld)
+#define LD	  LOCAL_LD
+
+#define GET_LD	  CACHE_REGS struct PL_local_data *__PL_ld = GLOBAL_LD;
+#define ARG1_LD   struct PL_local_data *__PL_ld
+
+#define ARG_LD    , ARG1_LD
+#define PASS_LD1  LD
+#define PASS_LD   , LD
+#define PRED_LD   GET_LD
+#define IGNORE_LD (void)__PL_ld;
+
 #endif
 
 		/********************************
@@ -339,6 +377,7 @@ typedef struct
 { functor_t functor;			/* Functor to use ($VAR/1) */
   av_action on_attvar;			/* How to handle attvars */
   int	    singletons;			/* Write singletons as $VAR('_') */
+  int       numbered_check;             /* Check for already numbered */
 } nv_options;
 
 
@@ -437,9 +476,6 @@ typedef struct
 #define FT_FROM_VALUE   0x0f            /* Determine type from value */
 #define FT_MASK         0x0f            /* mask to get type */
 
-#define FF_READONLY	0x10		/* feature is read-only */
-#define FF_KEEP		0x20		/* keep value it already set */
-
 #define PLFLAG_CHARESCAPE           0x000001 /* handle \ in atoms */
 #define PLFLAG_GC                   0x000002 /* do GC */
 #define PLFLAG_TRACE_GC             0x000004 /* verbose gc */
@@ -481,6 +517,36 @@ typedef struct exception_frame		/* PL_throw exception environments */
   jmp_buf	exception_jmp_env;	/* longjmp environment */
 } exception_frame;
 
+		 /*******************************
+		 *	    STREAM I/O		*
+		 *******************************/
+
+#define REDIR_MAGIC 0x23a9bef3
+
+typedef struct redir_context
+{ int		magic;			/* REDIR_MAGIC */
+  IOSTREAM     *stream;			/* temporary output */
+  int		is_stream;		/* redirect to stream */
+  int		redirected;		/* output is redirected */
+  term_t	term;			/* redirect target */
+  int		out_format;		/* output type */
+  int		out_arity;		/* 2 for difference-list versions */
+  size_t	size;			/* size of I/O buffer */
+  char	       *data;			/* data written */
+  char		buffer[1024];		/* fast temporary buffer */
+} redir_context;
+
+#include "pl-file.h"
+
+typedef enum
+{ ACCESS_LEVEL_USER = 0,        /* Default user view */
+  ACCESS_LEVEL_SYSTEM           /* Allow low-level access */
+} access_level_t;
+
+#define SYSTEM_MODE         (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM)
+
+#define PL_malloc_atomic malloc
+
 /* vsc: global variables */
 #include "pl-global.h"
 
@@ -514,6 +580,21 @@ it mean anything?
 #define fail			return FALSE
 #define TRY(goal)		if ((goal) == FALSE) fail
 
+/* Flags on module.  Most of these flags are copied to the read context
+   in pl-read.c.
+*/
+
+#define M_SYSTEM                (0x0001) /* system module */
+#define M_CHARESCAPE            (0x0002) /* module */
+#define DBLQ_CHARS              (0x0004) /* "ab" --> ['a', 'b'] */
+#define DBLQ_ATOM               (0x0008) /* "ab" --> 'ab' */
+#define DBLQ_STRING             (0x0010) /* "ab" --> "ab" */
+#define DBLQ_MASK               (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
+#define UNKNOWN_FAIL            (0x0020) /* module */
+#define UNKNOWN_WARNING         (0x0040) /* module */
+#define UNKNOWN_ERROR           (0x0080) /* module */
+#define UNKNOWN_MASK            (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
+
 
 extern int fileerrors;
 
@@ -558,25 +639,6 @@ typedef struct wakeup_state
 } wakeup_state;
 
 
-		 /*******************************
-		 *	    STREAM I/O		*
-		 *******************************/
-
-#define REDIR_MAGIC 0x23a9bef3
-
-typedef struct redir_context
-{ int		magic;			/* REDIR_MAGIC */
-  IOSTREAM     *stream;			/* temporary output */
-  int		is_stream;		/* redirect to stream */
-  int		redirected;		/* output is redirected */
-  term_t	term;			/* redirect target */
-  int		out_format;		/* output type */
-  int		out_arity;		/* 2 for difference-list versions */
-  size_t	size;			/* size of I/O buffer */
-  char	       *data;			/* data written */
-  char		buffer[1024];		/* fast temporary buffer */
-} redir_context;
-
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 Defining built-in predicates using the new interface 
@@ -651,6 +713,7 @@ typedef double			real;
 
 #endif
 
+#define PL_unify_time(A,B) PL_unify_int64(A,B)
 extern int PL_unify_char(term_t chr, int c, int how);
 extern int PL_get_char(term_t chr, int *c, int eof);
 extern void PL_cleanup_fork(void);
@@ -660,6 +723,7 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
 extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
 extern int _PL_unify_string(term_t t, word w);
 
+
 #define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
 
 extern IOSTREAM **			/* provide access to Suser_input, */
@@ -740,7 +804,19 @@ PL_EXPORT(int) 		PL_release_stream(IOSTREAM *s);
 COMMON(atom_t) 		fileNameStream(IOSTREAM *s);
 COMMON(int) 		streamStatus(IOSTREAM *s);
 
-COMMON(int) 		getOutputStream(term_t t, IOSTREAM **s);
+#define getOutputStream(t, k, s)	getOutputStream__LD(t, k, s PASS_LD)
+#define getTextOutputStream(t, s)       getTextOutputStream__LD(t, s PASS_LD)
+#define getBinaryOutputStream(t, s)     getBinaryOutputStream__LD(t, s PASS_LD)
+
+#define getInputStream(t, k, s)	       getInputStream__LD(t, k, s PASS_LD)
+#define getTextInputStream(t, s)       getTextInputStream__LD(t, s PASS_LD)
+#define getBinaryInputStream(t, s)     getBinaryInputStream__LD(t, s PASS_LD)
+
+COMMON(int) 		getTextOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int) 		getBinaryOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int) 		getTextInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int) 		getBinaryInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+
 COMMON(void) 		pushOutputContext(void);
 COMMON(void) 		popOutputContext(void);
 COMMON(int) 		getSingleChar(IOSTREAM *s, int signals);
@@ -754,6 +830,7 @@ COMMON(int)		unicode_separator(pl_wchar_t c);
 COMMON(word) 		pl_raw_read(term_t term);
 COMMON(word) 		pl_raw_read2(term_t stream, term_t term);
 
+COMMON(access_level_t)	setAccessLevel(access_level_t new_level);
 
 /**** stuff from pl-error.c ****/
 extern void		outOfCore(void);
@@ -795,7 +872,7 @@ extern size_t getenv3(const char *name, char *buf, size_t len);
 extern int Setenv(char *name, char *value);
 extern int Unsetenv(char *name);
 extern int System(char *cmd);
-extern bool expandVars(const char *pattern, char *expanded, int maxlen);
+extern char *expandVars(const char *pattern, char *expanded, int maxlen);
 
 /**** SWI stuff (emulated in pl-yap.c) ****/
 extern int writeAtomToStream(IOSTREAM *so, atom_t at);
@@ -819,6 +896,10 @@ COMMON(char)		digitName(int n, int sm);
 /**** stuff from pl-utf8.c ****/
 size_t utf8_strlen(const char *s, size_t len);
 
+/**** stuff from pl-version.c ****/
+COMMON(void) 		setGITVersion(void);
+
+
 /**** stuff from pl-write.c ****/
 COMMON(char *) 		varName(term_t var, char *buf);
 COMMON(int)		writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags);
@@ -856,10 +937,12 @@ COMMON(Buffer)		codes_or_chars_to_buffer(term_t l, unsigned int flags,
 COMMON(bool)		systemMode(bool accept);
 
 
-COMMON(void)		initPrologFlagTable(void);
+COMMON(void)		cleanupPrologFlags(void);
 COMMON(void)		initPrologFlags(void);
 COMMON(int)		raiseStackOverflow(int overflow);
 
+COMMON(int)		PL_qualify(term_t raw, term_t qualified);
+
 static inline word
 setBoolean(int *flag, term_t old, term_t new)
 { if ( !PL_unify_bool_ex(old, *flag) ||
@@ -869,7 +952,21 @@ setBoolean(int *flag, term_t old, term_t new)
   succeed;
 }
 
-COMMON(int) 		getInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+#define BEGIN_NUMBERVARS(save) \
+	{ fid_t _savedf; \
+	  if ( save ) \
+	  { _savedf = LD->var_names.numbervars_frame; \
+	    LD->var_names.numbervars_frame = PL_open_foreign_frame(); \
+	  }
+#define END_NUMBERVARS(save) \
+          if ( save ) \
+	  { PL_discard_foreign_frame(LD->var_names.numbervars_frame); \
+	    LD->var_names.numbervars_frame = _savedf; \
+	  } \
+	}
+
+
+
 
 COMMON(int) 		PL_get_atom__LD(term_t t1, atom_t *a ARG_LD);
 COMMON(int) 		PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
@@ -884,6 +981,8 @@ COMMON(word)		pl_get_prolog_flag(term_t key, term_t value);
 COMMON(word)		pl_prolog_flag5(term_t key, term_t value, word scope, word access, word type, control_t h);
 COMMON(foreign_t)	pl_prolog_flag(term_t name, term_t value, control_t h);
 
+COMMON(struct tm *)	PL_localtime_r(const time_t *t, struct tm *r);
+
 /* inlines that need ARG_LD */
 static inline intptr_t
 skip_list(Word l, Word *tailp ARG_LD) {
@@ -901,7 +1000,14 @@ static inline void *allocHeap__LD(size_t n ARG_LD)
   return YAP_AllocSpaceFromYap(n);
 }
 
-static inline void freeHeap__LD(void *mem, size_t n ARG_LD)
+static inline void *allocHeapOrHalt(size_t n)
+{
+  void *ptr = YAP_AllocSpaceFromYap(n);
+  if (!ptr) Yap_exit(1);
+  return ptr;
+}
+
+static inline void freeHeap(void *mem, size_t n)
 {
   YAP_FreeSpaceFromYap(mem);
 }

H/pl-yap.h

@@ -95,13 +95,14 @@ COMMON(bool) 		ChDir(const char *path);
 COMMON(int) 		DeleteTemporaryFile(atom_t name);
 COMMON(int) 		IsAbsolutePath(const char *spec);
 
+COMMON(bool) 		sysError(const char *fm, ...);
+
 /* TBD */
 
 extern word globalString(size_t size, char *s);
 extern word globalWString(size_t size, wchar_t *s);
 
 #define allocHeap(n)		allocHeap__LD(n PASS_LD)
-#define freeHeap(p, n)		freeHeap__LD(p, n PASS_LD)
 
 #define valHandle(r) valHandle__LD(r PASS_LD)
 
@@ -150,6 +151,7 @@ atomLength(Atom atom)
 #define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
 #define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
 #define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
+
 #define charEscapeWriteOption(A) FALSE  // VSC: to implement
 #define wordToTermRef(A) YAP_InitSlot(*(A))
 #define isTaggedInt(A) IsIntegerTerm(A)
@@ -179,8 +181,6 @@ charCode(Term w)
   return -1;
 }
 
-#define getInputStream(t, s)	getInputStream__LD(t, s PASS_LD)
-
 #define PL_get_atom(t, a)	PL_get_atom__LD(t, a PASS_LD)
 #define PL_get_atom_ex(t, a)	PL_get_atom_ex__LD(t, a PASS_LD)
 #define PL_get_text(l, t, f)	PL_get_text__LD(l, t, f PASS_LD)
@@ -227,5 +227,8 @@ unblockSignal(int sig)
 }
 #endif
 
+#define suspendTrace(x)
+
+atom_t ATOM_;
 
 #endif /* PL_YAP_H */

H/ratoms.h

@@ -74,6 +74,7 @@
   AtomDefault = AtomAdjust(AtomDefault);
   AtomDevNull = AtomAdjust(AtomDevNull);
   AtomDiff = AtomAdjust(AtomDiff);
+  AtomDollar = AtomAdjust(AtomDollar);
   AtomDoLogUpdClause = AtomAdjust(AtomDoLogUpdClause);
   AtomDoLogUpdClause0 = AtomAdjust(AtomDoLogUpdClause0);
   AtomDoLogUpdClauseErase = AtomAdjust(AtomDoLogUpdClauseErase);
@@ -127,6 +128,7 @@
   AtomGlobalSp = AtomAdjust(AtomGlobalSp);
   AtomGlobalTrie = AtomAdjust(AtomGlobalTrie);
   AtomGoalExpansion = AtomAdjust(AtomGoalExpansion);
+  AtomHat = AtomAdjust(AtomHat);
   AtomHERE = AtomAdjust(AtomHERE);
   AtomHandleThrow = AtomAdjust(AtomHandleThrow);
   AtomHeap = AtomAdjust(AtomHeap);
@@ -390,6 +392,7 @@
   FunctorGoalExpansion2 = FuncAdjust(FunctorGoalExpansion2);
   FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
   FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
+  FunctorHat = FuncAdjust(FunctorHat);
   FunctorId = FuncAdjust(FunctorId);
   FunctorIs = FuncAdjust(FunctorIs);
   FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin);

H/rclause.h

@@ -447,6 +447,8 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
     case _lock_lu:
     case _procceed:
     case _retry_profiled:
+    case _retry_udi:
+    case _try_udi:
       pc->u.p.p = PtoPredAdjust(pc->u.p.p);
       pc = NEXTOP(pc,p);
       break;

H/rglobals.h

@@ -98,4 +98,5 @@ static void RestoreGlobal(void) {
 #endif
 
 
+
 }

H/rheap.h

@@ -1042,6 +1042,7 @@ RestoreYapRecords__( USES_REGS1 )
     ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
     ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
     RestoreDBTerm(ptr->dbrecord, FALSE PASS_REGS);
+    ptr = ptr->next_rec;
   }
 }
 

H/rlocals.h

@@ -243,4 +243,6 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
+
 }

H/saveclause.h

@@ -464,6 +464,8 @@
     case _lock_lu:
     case _procceed:
     case _retry_profiled:
+    case _retry_udi:
+    case _try_udi:
       CHECK(save_PtoPred(stream, pc->u.p.p));
       pc = NEXTOP(pc,p);
       break;

H/tatoms.h

@@ -146,6 +146,8 @@
 #define AtomDevNull Yap_heap_regs->AtomDevNull_
   Atom AtomDiff_;
 #define AtomDiff Yap_heap_regs->AtomDiff_
+  Atom AtomDollar_;
+#define AtomDollar Yap_heap_regs->AtomDollar_
   Atom AtomDoLogUpdClause_;
 #define AtomDoLogUpdClause Yap_heap_regs->AtomDoLogUpdClause_
   Atom AtomDoLogUpdClause0_;
@@ -252,6 +254,8 @@
 #define AtomGlobalTrie Yap_heap_regs->AtomGlobalTrie_
   Atom AtomGoalExpansion_;
 #define AtomGoalExpansion Yap_heap_regs->AtomGoalExpansion_
+  Atom AtomHat_;
+#define AtomHat Yap_heap_regs->AtomHat_
   Atom AtomHERE_;
 #define AtomHERE Yap_heap_regs->AtomHERE_
   Atom AtomHandleThrow_;
@@ -778,6 +782,8 @@
 #define FunctorGoalExpansion Yap_heap_regs->FunctorGoalExpansion_
   Functor FunctorHandleThrow_;
 #define FunctorHandleThrow Yap_heap_regs->FunctorHandleThrow_
+  Functor FunctorHat_;
+#define FunctorHat Yap_heap_regs->FunctorHat_
   Functor FunctorId_;
 #define FunctorId Yap_heap_regs->FunctorId_
   Functor FunctorIs_;

H/walkclause.h

@@ -350,6 +350,8 @@
     case _deallocate:
     case _enter_profiling:
     case _retry_profiled:
+    case _retry_udi:
+    case _try_udi:
       pc = NEXTOP(pc,p);
       break;
       /* instructions type plxxs */

LGPL/debug.pl

@@ -1,11 +1,10 @@
-/*  $Id: debug.pl,v 1.1 2008-02-12 17:03:53 vsc Exp $
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        jan@swi.psy.uva.nl
+    E-mail:        J.Wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2002, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
+			      VU University Amsterdam
 
     This program is free software; you can redistribute it and/or
     modify it under the terms of the GNU General Public License
@@ -19,7 +18,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
     As a special exception, if you link this library with other files,
     compiled with a Free Software compiler, to produce an executable, this
@@ -30,19 +29,29 @@
 */
 
 :- module(prolog_debug,
-	  [ debug/3,			% +Topic, +Format, +Args
+	  [ debug/3,			% +Topic, +Format, :Args
 	    debug/1,			% +Topic
 	    nodebug/1,			% +Topic
 	    debugging/1,		% ?Topic
 	    debugging/2,		% ?Topic, ?Bool
 	    list_debug_topics/0,
+	    debug_message_context/1,	% (+|-)What
 
 	    assertion/1			% :Goal
 	  ]).
-
+:- use_module(library(error)).
-:- meta_predicate(assertion(:)).
+:- use_module(library(lists)).
 :- set_prolog_flag(generate_debug_info, false).
 
+:- meta_predicate
+	assertion(0),
+	debug(+,+,:).
+
+:- multifile prolog:assertion_failed/2.
+:- dynamic   prolog:assertion_failed/2.
+
+/*:- use_module(library(prolog_stack)).*/ % We use the autoloader if needed
+
 :- if(current_prolog_flag(dialect, yap)).
 
 :- use_module(library(hacks), [stack_dump/1]).
@@ -53,10 +62,15 @@ backtrace(N) :-
 
 :- endif.
 
-:- dynamic
+%:- set_prolog_flag(generate_debug_info, false).
-	debugging/2.
 
-/** <module> Print debug messages
+:- dynamic
+	debugging/3,			% Topic, Enabled, To
+	debug_context/1.
+
+debug_context(thread).
+
+/** <module> Print debug messages and test assertions
 
 This library is a replacement for  format/3 for printing debug messages.
 Messages are assigned a _topic_. By   dynamically  enabling or disabling
@@ -64,7 +78,7 @@ topics the user can  select  desired   messages.  Debug  statements  are
 removed when the code is compiled for optimization.
 
 See manual for details. With XPCE, you can use the call below to start a
-graphical monitorring tool.
+graphical monitoring tool.
 
 ==
 ?- prolog_ide(debug_monitor).
@@ -80,11 +94,26 @@ program explicit, trapping the debugger if the condition does not hold.
 %%	debugging(-Topic) is nondet.
 %%	debugging(?Topic, ?Bool) is nondet.
 %
-%	Check whether we are debugging Topic or enumerate the topics we
+%	Examine debug topics. The form debugging(+Topic)  may be used to
-%	are debugging.
+%	perform more complex debugging tasks.   A typical usage skeleton
+%	is:
+%
+%	  ==
+%		(   debugging(mytopic)
+%		->  <perform debugging actions>
+%		;   true
+%		),
+%		...
+%	  ==
+%
+%	The other two calls are intended to examine existing and enabled
+%	debugging tokens and are typically not used in user programs.
 
 debugging(Topic) :-
-	debugging(Topic, true).
+	debugging(Topic, true, _To).
+
+debugging(Topic, Bool) :-
+	debugging(Topic, Bool, _To).
 
 %%	debug(+Topic) is det.
 %%	nodebug(+Topic) is det.
@@ -92,27 +121,51 @@ debugging(Topic) :-
 %	Add/remove a topic from being   printed.  nodebug(_) removes all
 %	topics. Gives a warning if the topic is not defined unless it is
 %	used from a directive. The latter allows placing debug topics at
-%	the start a a (load-)file without warnings.
+%	the start of a (load-)file without warnings.
+%
+%	For debug/1, Topic can be  a  term   Topic  >  Out, where Out is
+%	either a stream or  stream-alias  or   a  filename  (atom). This
+%	redirects debug information on this topic to the given output.
 
 debug(Topic) :-
 	debug(Topic, true).
 nodebug(Topic) :-
 	debug(Topic, false).
 
-debug(Topic, Val) :-
+debug(Spec, Val) :-
-	(   (   retract(debugging(Topic, _))
+	debug_target(Spec, Topic, Out),
-	    *-> assert(debugging(Topic, Val)),
+	(   (   retract(debugging(Topic, Enabled0, To0))
+	    *-> update_debug(Enabled0, To0, Val, Out, Enabled, To),
+		assert(debugging(Topic, Enabled, To)),
 		fail
 	    ;   (   prolog_load_context(file, _)
 		->  true
 		;   print_message(warning, debug_no_topic(Topic))
 		),
-	        assert(debugging(Topic, Val))
+		update_debug(false, [], Val, Out, Enabled, To),
+	        assert(debugging(Topic, Enabled, To))
 	    )
 	->  true
 	;   true
 	).
 
+debug_target(Spec, Topic, To) :-
+	nonvar(Spec),
+	Spec = (Topic > To), !.
+debug_target(Topic, Topic, -).
+
+update_debug(_, To0, true, -, true, To) :- !,
+	ensure_output(To0, To).
+update_debug(true, To0, true, Out, true, Output) :- !,
+	append(To0, [Out], Output).
+update_debug(false, _, true, Out, true, [Out]) :- !.
+update_debug(_, _, false, -, false, []) :- !.
+update_debug(true, [Out], false, Out, false, []) :- !.
+update_debug(true, To0, false, Out, true, Output) :- !,
+	delete(To0, Out, Output).
+
+ensure_output([], [user_error]) :- !.
+ensure_output(List, List).
 
 %%	debug_topic(+Topic) is det.
 %
@@ -120,44 +173,108 @@ debug(Topic, Val) :-
 %	topics available for debugging.
 
 debug_topic(Topic) :-
-	(   debugging(Registered, _),
+	(   debugging(Registered, _, _),
 	    Registered =@= Topic
 	->  true
-	;   assert(debugging(Topic, false))
+	;   assert(debugging(Topic, false, []))
 	).
 
 %%	list_debug_topics is det.
-%	
+%
 %	List currently known debug topics and their setting.
 
 list_debug_topics :-
-	format(user_error, '~*t~40|~n', "-"),
+	format(user_error, '~*t~45|~n', "-"),
-	format(user_error, '~w~t~30| ~w~n', ['Debug Topic', 'Activated']),
+	format(user_error, '~w~t ~w~35| ~w~n',
-	format(user_error, '~*t~40|~n', "-"),
+	       ['Debug Topic', 'Activated', 'To']),
-	(   debugging(Topic, Value),
+	format(user_error, '~*t~45|~n', "-"),
-	    format(user_error, '~w~t~30| ~w~n', [Topic, Value]),
+	(   debugging(Topic, Value, To),
+	    format(user_error, '~w~t ~w~35| ~w~n', [Topic, Value, To]),
 	    fail
 	;   true
 	).
 
-%%	debug(+Topic, +Format, +Args) is det.
+%%	debug_message_context(+What) is det.
 %
-%	As format/3 to user_error, but only does something if Topic
+%	Specify additional context for debug messages.   What  is one of
-%	is activated through debug/1.
+%	+Context or -Context, and Context is  one of =thread=, =time= or
+%	time(Format),  where  Format  is    a  format specification  for
+%	format_time/3 (default is =|%T.%3f|=).  Initially, debug/3 shows
+%	only thread information.
+
+debug_message_context(+Topic) :- !,
+	valid_topic(Topic, Del, Add),
+	retractall(debug_context(Del)),
+	assert(debug_context(Add)).
+debug_message_context(-Topic) :- !,
+	valid_topic(Topic, Del, _),
+	retractall(debug_context(Del)).
+debug_message_context(Term) :-
+	type_error(debug_message_context, Term).
+
+valid_topic(thread, thread, thread) :- !.
+valid_topic(time, time(_), time('%T.%3f')) :- !.
+valid_topic(time(Format), time(_), time(Format)) :- !.
+valid_topic(X, _, _) :-
+	domain_error(debug_message_context, X).
+
+
+%%	debug(+Topic, +Format, :Args) is det.
+%
+%	Format a message if debug topic  is enabled. Similar to format/3
+%	to =user_error=, but only prints if   Topic is activated through
+%	debug/1. Args is a  meta-argument  to   deal  with  goal for the
+%	@-command.   Output   is   first    handed     to    the    hook
+%	prolog:debug_print_hook/3.  If  this  fails,    Format+Args   is
+%	translated  to  text   using    the   message-translation   (see
+%	print_message/2) for the  term  debug(Format,   Args)  and  then
+%	printed to every matching destination   (controlled  by debug/1)
+%	using print_message_lines/3.
+%
+%	The message is preceded by '% ' and terminated with a newline.
+%
+%	@see	format/3.
 
 debug(Topic, Format, Args) :-
-	debugging(Topic, true), !,
+	debugging(Topic, true, To), !,
-	print_debug(Topic, Format, Args).
+	print_debug(Topic, To, Format, Args).
 debug(_, _, _).
 
 
+%%	prolog:debug_print_hook(+Topic, +Format, +Args) is semidet.
+%
+%	Hook called by debug/3.  This  hook   is  used  by the graphical
+%	frontend that can be activated using prolog_ide/1:
+%
+%	  ==
+%	  ?- prolog_ide(debug_monitor).
+%	  ==
+
 :- multifile
 	prolog:debug_print_hook/3.
 
-print_debug(Topic, Format, Args) :-
+print_debug(Topic, _To, Format, Args) :-
 	prolog:debug_print_hook(Topic, Format, Args), !.
-print_debug(_, Format, Args) :-
+print_debug(_, [], _, _) :- !.
-	print_message(informational, debug(Format, Args)).
+print_debug(Topic, To, Format, Args) :-
+	phrase('$messages':translate_message(debug(Format, Args)), Lines),
+	(   member(T, To),
+	    debug_output(T, Stream),
+	    print_message_lines(Stream, kind(debug(Topic)), Lines),
+	    fail
+	;   true
+	).
+
+
+debug_output(user, user_error) :- !.
+debug_output(Stream, Stream) :-
+	is_stream(Stream), !.
+debug_output(File, Stream) :-
+	open(File, append, Stream,
+	     [ close_on_abort(false),
+	       alias(File),
+	       buffer(line)
+	     ]).
 
 
 		 /*******************************
@@ -165,27 +282,46 @@ print_debug(_, Format, Args) :-
 		 *******************************/
 
 %%	assertion(:Goal) is det.
-%	
+%
-%	Acts similar to C assert() macro.  It has no effect of Goal
+%	Acts similar to C assert()  macro.  It   has  no  effect if Goal
-%	succeeds.  If Goal fails it prints a message, a stack-trace
+%	succeeds. If Goal fails or throws    an exception, the following
-%	and finally traps the debugger.
+%	steps are taken:
+%
+%	  * call prolog:assertion_failed/2.  If prolog:assertion_failed/2
+%	    fails, then:
+%
+%	    - If this is an interactive toplevel thread, print a
+%	      message, the stack-trace, and finally trap the debugger.
+%	    - Otherwise, throw error(assertion_error(Reason, G),_) where
+%	      Reason is one of =fail= or the exception raised.
 
 assertion(G) :-
-	\+ \+ G, !.			% avoid binding variables
+	\+ \+ catch(G,
+		    Error,
+		    assertion_failed(Error, G)),
+	!.
 assertion(G) :-
-	print_message(error, assumption_failed(G)),
+	assertion_failed(fail, G),
+	assertion_failed.		% prevent last call optimization.
+
+assertion_failed(Reason, G) :-
+	prolog:assertion_failed(Reason, G), !.
+assertion_failed(Reason, G) :-
+	print_message(error, assertion_failed(Reason, G)),
 	backtrace(10),
-	trace,
+	(   current_prolog_flag(break_level, _)	% interactive thread
-	assertion_failed.
+	->  trace
+	;   throw(error(assertion_error(Reason, G), _))
+	).
 
 assertion_failed.
 
 %%	assume(:Goal) is det.
-%	
+%
 %	Acts similar to C assert() macro.  It has no effect of Goal
 %	succeeds.  If Goal fails it prints a message, a stack-trace
 %	and finally traps the debugger.
-%	
+%
 %	@deprecated	Use assertion/1 in new code.
 
 		 /*******************************
@@ -193,34 +329,28 @@ assertion_failed.
 		 *******************************/
 
 :- multifile
-	user:goal_expansion/2.
+	system:goal_expansion/2.
 
-user:goal_expansion(debug(Topic,_,_), true) :-
+system:goal_expansion(debug(Topic,_,_), true) :-
 	(   current_prolog_flag(optimise, true)
 	->  true
 	;   debug_topic(Topic),
 	    fail
 	).
-user:goal_expansion(debugging(Topic), fail) :-
+system:goal_expansion(debugging(Topic), fail) :-
 	(   current_prolog_flag(optimise, true)
 	->  true
 	;   debug_topic(Topic),
 	    fail
 	).
-user:goal_expansion(assertion(G), Goal) :-
+system:goal_expansion(assertion(_), Goal) :-
-	(   current_prolog_flag(optimise, true)
+	current_prolog_flag(optimise, true),
-	->  Goal = true
+	Goal = true.
-	;   expand_goal(G, G2),
+system:goal_expansion(assume(_), Goal) :-
-	    Goal = assertion(G2)
-	).
-user:goal_expansion(assume(G), Goal) :-
 	print_message(informational,
 		      compatibility(renamed(assume/1, assertion/1))),
-	(   current_prolog_flag(optimise, true)
+	current_prolog_flag(optimise, true),
-	->  Goal = true
+	Goal = true.
-	;   expand_goal(G, G2),
-	    Goal = assertion(G2)
-	).
 
 
 		 /*******************************
@@ -230,13 +360,41 @@ user:goal_expansion(assume(G), Goal) :-
 :- multifile
 	prolog:message/3.
 
-prolog:message(assumption_failed(G)) -->
+prolog:message(assertion_failed(_, G)) -->
-	[ 'Assertion failed: ~p'-[G] ].
+	[ 'Assertion failed: ~q'-[G] ].
 prolog:message(debug(Fmt, Args)) -->
-	{ thread_self(Me) },
+	show_thread_context,
-	(   { Me == main }
+	show_time_context,
-	->  [ Fmt-Args ]
+	[ Fmt-Args ].
-	;   [ '[Thread ~w] '-[Me], Fmt-Args ]
-	).
 prolog:message(debug_no_topic(Topic)) -->
 	[ '~q: no matching debug topic (yet)'-[Topic] ].
+
+show_thread_context -->
+	{ debug_context(thread),
+	  thread_self(Me) ,
+	  Me \== main
+	},
+	[ '[Thread ~w] '-[Me] ].
+show_thread_context -->
+	[].
+
+show_time_context -->
+	{ debug_context(time(Format)),
+	  get_time(Now),
+	  format_time(string(S), Format, Now)
+	},
+	[ '[~w] '-[S] ].
+show_time_context -->
+	[].
+
+		 /*******************************
+		 *	       HOOKS		*
+		 *******************************/
+
+%%	prolog:assertion_failed(+Reason, +Goal) is semidet.
+%
+%	This hook is called if the Goal  of assertion/1 fails. Reason is
+%	unified with either =fail= if Goal simply failed or an exception
+%	call otherwise. If this hook  fails,   the  default behaviour is
+%	activated.  If  the  hooks  throws  an   exception  it  will  be
+%	propagated into the caller of assertion/1.

LGPL/record.pl

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
     As a special exception, if you link this library with other files,
     compiled with a Free Software compiler, to produce an executable, this
@@ -32,6 +32,7 @@
 :- module((record),
 	  [ (record)/1,			% +Record
 	    current_record/2,		% ?Name, ?Term
+	    current_record_predicate/2,	% ?Record, :PI
 	    op(1150, fx, record)
 	  ]).
 :- use_module(library(error)).
@@ -59,7 +60,8 @@ _directive_.  Here is a simple example declaration and some calls.
 */
 
 :- multifile
-	error:has_type/2.
+	error:has_type/2,
+	prolog:generated_predicate/1.
 
 error:has_type(record(M:Name), X) :-
 	current_record(Name, M, _, X, IsX), !,
@@ -77,6 +79,7 @@ error:has_type(record(M:Name), X) :-
 %	info the following predicates:
 %
 %	  * <constructor>_<name>(Record, Value)
+%	  * <constructor>_data(?Name, ?Record, ?Value)
 %	  * default_<constructor>(-Record)
 %	  * is_<constructor>(@Term)
 %	  * make_<constructor>(+Fields, -Record)
@@ -120,12 +123,14 @@ compile_record(RecordDef) -->
 	  defaults(Args, Defs, TypedArgs),
 	  types(TypedArgs, Names, Types),
 	  atom_concat(default_, Constructor, DefName),
+	  atom_concat(Constructor, '_data', DataName),
 	  DefRecord =.. [Constructor|Defs],
 	  DefClause =.. [DefName,DefRecord],
 	  length(Names, Arity)
 	},
 	[ DefClause ],
 	access_predicates(Names, 1, Arity, Constructor),
+	data_predicate(Names, 1, Arity, Constructor, DataName),
 	set_predicates(Names, 1, Arity, Types, Constructor),
 	set_field_predicates(Names, 1, Arity, Types, Constructor),
 	make_predicate(Constructor),
@@ -133,7 +138,8 @@ compile_record(RecordDef) -->
 	current_clause(RecordDef).
 
 :- meta_predicate
-	current_record(:).
+	current_record(?, :),
+	current_record_predicate(?, :).
 :- multifile
 	current_record/5.		% Name, Module, Term, X, IsX
 
@@ -156,6 +162,56 @@ current_clause(RecordDef) -->
 	].
 
 
+%%	current_record_predicate(?Record, ?PI) is nondet.
+%
+%	True if PI is the predicate indicator for an access predicate to
+%	Record. This predicate is intended   to support cross-referencer
+%	tools.
+
+current_record_predicate(Record, M:PI) :-
+	(   ground(PI)
+	->  Det = true
+	;   true
+	),
+	current_record(Record, M:RecordDef),
+	(   general_record_pred(Record, M:PI)
+	;   RecordDef =.. [_|Args],
+	    defaults(Args, _Defs, TypedArgs),
+	    types(TypedArgs, Names, _Types),
+	    member(Field, Names),
+	    field_record_pred(Record, Field, M:PI)
+	),
+	(   Det == true
+	->  !
+	;   true
+	).
+
+general_record_pred(Record, _:Name/1) :-
+	atom_concat(is_, Record, Name).
+general_record_pred(Record, _:Name/1) :-
+	atom_concat(default_, Record, Name).
+general_record_pred(Record, _:Name/A) :-
+	member(A, [2,3]),
+	atom_concat(make_, Record, Name).
+general_record_pred(Record, _:Name/3) :-
+	atom_concat(Record, '_data', Name).
+general_record_pred(Record, _:Name/A) :-
+	member(A, [3,4]),
+	atomic_list_concat([set_, Record, '_fields'], Name).
+general_record_pred(Record, _:Name/3) :-
+	atomic_list_concat([set_, Record, '_field'], Name).
+
+field_record_pred(Record, Field, _:Name/2) :-
+	atomic_list_concat([Record, '_', Field], Name).
+field_record_pred(Record, Field, _:Name/A) :-
+	member(A, [2,3]),
+	atomic_list_concat([set_, Field, '_of_', Record], Name).
+field_record_pred(Record, Field, _:Name/2) :-
+	atomic_list_concat([nb_set_, Field, '_of_', Record], Name).
+
+prolog:generated_predicate(P) :-
+	current_record_predicate(_, P).
+
 %%	make_predicate(+Constructor)// is det.
 %
 %	Creates the make_<constructor>(+Fields, -Record) predicate. This
@@ -286,6 +342,22 @@ access_predicates([Name|NT], I, Arity, Constructor) -->
 	access_predicates(NT, I2, Arity, Constructor).
 
 
+%%	data_predicate(+Names, +Idx0, +Arity, +Constructor, +DataName)// is det.
+%
+%	Create the <constructor>_data(Name, Record, Value) predicate.
+
+data_predicate([], _, _, _, _) -->
+	[].
+data_predicate([Name|NT], I, Arity, Constructor, DataName) -->
+	{ functor(Record, Constructor, Arity),
+	  arg(I, Record, Value),
+	  Clause =.. [DataName, Name, Record, Value],
+	  I2 is I + 1
+	},
+	[Clause],
+	data_predicate(NT, I2, Arity, Constructor, DataName).
+
+
 %%	set_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det.
 %
 %	Create the clauses

Makefile.in

@@ -101,7 +101,7 @@ SONAMEFLAG=@SONAMEFLAG@
 #4.1VPATH=@srcdir@:@srcdir@/OPTYap
 CWD=$(PWD)
 #
-VERSION=6.3.2
+VERSION=6.3.4
 MYDDAS_VERSION=MYDDAS-0.9.1
 #
 
@@ -135,14 +135,13 @@ IOLIB_HEADERS=$(srcdir)/os/pl-buffer.h \
 	$(srcdir)/os/dtoa.c  \
 	$(srcdir)/H/pl-incl.h \
 	$(srcdir)/H/pl-global.h \
-	$(srcdir)/os/pl-mswchar.h \
 	$(srcdir)/os/pl-option.h  \
 	$(srcdir)/os/pl-os.h \
 	$(srcdir)/os/pl-privitf.h \
 	$(srcdir)/os/pl-table.h \
 	$(srcdir)/os/pl-text.h \
 	$(srcdir)/os/pl-utf8.h \
-	$(srcdir)/H/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/os/windows/dirent.h $(srcdir)/os/windows/utf8.h $(srcdir)/os/windows/utf8.c $(srcdir)/os/windows/uxnt.h  $(srcdir)/os/windows/mswchar.h  $(srcdir)/os/windows/popen.c 
+	$(srcdir)/H/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/os/windows/dirent.h $(srcdir)/os/windows/utf8.h $(srcdir)/os/windows/utf8.c $(srcdir)/os/windows/uxnt.h  $(srcdir)/os/windows/popen.c 
 
 HEADERS = \
 	$(srcdir)/H/Atoms.h \
@@ -224,6 +223,7 @@ IOLIB_SOURCES=$(srcdir)/os/pl-buffer.c $(srcdir)/os/pl-ctype.c \
 	$(srcdir)/os/pl-table.c \
 	$(srcdir)/os/pl-tai.c  \
 	$(srcdir)/os/pl-text.c \
+	$(srcdir)/os/pl-version.c \
 	$(srcdir)/os/pl-write.c \
 	$(srcdir)/C/pl-yap.c @ENABLE_WINCONSOLE@$(srcdir)/os/windows/uxnt.c
 
@@ -350,7 +350,7 @@ IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o  \
 	pl-rl.o \
 	pl-stream.o pl-string.o pl-table.o \
 	pl-tai.o pl-text.o pl-utf8.o \
-	pl-write.o \
+	pl-version.o pl-write.o \
 	pl-yap.o @ENABLE_WINCONSOLE@ uxnt.o
 
 ENGINE_OBJECTS = \
@@ -649,6 +649,9 @@ pl-text.o: $(srcdir)/os/pl-text.c config.h
 pl-utf8.o: $(srcdir)/os/pl-utf8.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-utf8.c -o $@
 
+pl-version.o: $(srcdir)/os/pl-version.c config.h
+	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-version.c -o $@
+
 pl-write.o: $(srcdir)/os/pl-write.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-write.c -o $@
 
@@ -698,6 +701,7 @@ all: startup.yss
 	@INSTALL_DLLS@ (cd library/system; $(MAKE))
 	@INSTALL_DLLS@ (cd library/tries; $(MAKE))
 	@ENABLE_CLIB@ @INSTALL_DLLS@ (cd packages/clib; $(MAKE))
+	@ENABLE_CHR@ @INSTALL_DLLS@ (cd packages/chr; $(MAKE))
 	@ENABLE_HTTP@ @INSTALL_DLLS@ (cd packages/http; $(MAKE))
 	@ENABLE_PLDOC@  @INSTALL_DLLS@ (cd packages/pldoc; $(MAKE))
 	@ENABLE_PLUNIT@ @INSTALL_DLLS@ (cd packages/plunit; $(MAKE))
@@ -921,6 +925,7 @@ clean: clean_docs
 	@ENABLE_REAL@ (cd packages/real; $(MAKE) clean)
 	@ENABLE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean)
 	@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE) clean)
+	@ENABLE_CHR@ @INSTALL_DLLS@ (cd packages/chr; $(MAKE) clean)
 	@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) clean)
 	@ENABLE_PRISM@ (cd packages/prism/src/c; $(MAKE) clean)
 	@ENABLE_PRISM@ (cd packages/prism/src/prolog; $(MAKE) clean)

config.h.in

@@ -52,6 +52,7 @@
 #undef  HAVE_ARPA_INET_H
 #undef  HAVE_CTYPE_H
 #undef  HAVE_CRYPT_H
+#undef  HAVE_CRTDBG_H
 #undef  HAVE_CUDD_H
 #undef  HAVE_CUDDINT_H
 #undef  HAVE_CUDD_CUDD_H
@@ -87,6 +88,7 @@
 #undef  HAVE_READLINE_HISTORY_H
 #undef  HAVE_REGEX_H
 #undef  HAVE_RINTERFACE_H
+#undef  HAVE_SHLOBJ_H
 #undef  HAVE_SIGINFO_H
 #undef  HAVE_SIGNAL_H
 #undef  HAVE_STDARG_H
@@ -117,6 +119,8 @@
 #undef  HAVE_WCTYPE_H
 #undef  HAVE_WINSOCK_H
 #undef  HAVE_WINSOCK2_H
+#undef  HAVE_WINSOCK2_H
+#undef  HAVE_LIBLOADERAPI_H
 
 #if __MINGW32__
 #define __WINDOWS__ 1
@@ -184,6 +188,7 @@
 #undef  HAVE_FINITE
 #undef  HAVE_FPCLASS
 #undef  HAVE_FTIME
+#undef  HAVE_FTRUNCATE
 #undef  HAVE_GETCWD
 #undef  HAVE_GETENV
 #undef  HAVE_GETEXECNAME

configure

@@ -8038,7 +8038,6 @@ fi
 
 fi
 
-
 INSTALL_DLLS="#"
 EXTRA_OBJS=""
 SHLIB_LD="#"
@@ -8387,6 +8386,7 @@ fi
         fi
 	LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
         DYNYAPLIB=libYap."$SO"
+        YAPLIB_LD=$SHLIB_LD
         SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
         EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
         PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
@@ -9026,7 +9026,7 @@ $as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h
 
 fi
 
-for ac_header in arpa/inet.h alloca.h crypt.h
+for ac_header in arpa/inet.h alloca.h crtdbg.h crypt.h
 do :
   as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
 ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
@@ -9091,7 +9091,7 @@ fi
 
 done
 
-for ac_header in netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h
+for ac_header in netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h shlobj.h
 do :
   as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
 ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
@@ -9221,12 +9221,13 @@ fi
 
 done
 
-for ac_header in mach-o/dyld.h
+for ac_header in mach-o/dyld.h LibLoaderAPI.h
 do :
-  ac_fn_c_check_header_mongrel "$LINENO" "mach-o/dyld.h" "ac_cv_header_mach_o_dyld_h" "$ac_includes_default"
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if test "x$ac_cv_header_mach_o_dyld_h" = xyes; then :
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
   cat >>confdefs.h <<_ACEOF
-#define HAVE_MACH_O_DYLD_H 1
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
 _ACEOF
 
 fi
@@ -10238,7 +10239,7 @@ _ACEOF
 fi
 done
 
-for ac_func in fesettrapenable fgetpos finite fpclass ftime getcwd getenv
+for ac_func in fesettrapenable fgetpos finite fpclass ftime ftruncate getcwd getenv
 do :
   as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
 ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"

configure.in

@@ -1167,7 +1167,6 @@ else
   AC_SYS_RESTARTABLE_SYSCALLS
 fi
 
-
 dnl defaults
 INSTALL_DLLS="#"
 EXTRA_OBJS=""
@@ -1400,6 +1399,7 @@ dnl Linux has both elf and a.out, in this case we found elf
         fi
 	LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
         DYNYAPLIB=libYap."$SO"
+        YAPLIB_LD=$SHLIB_LD
         SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
         EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
         PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
@@ -1694,12 +1694,12 @@ AC_SUBST(PRE_INSTALL_ENV)
 dnl Checks for header files.
 AC_HEADER_STDC
 AC_HEADER_SYS_WAIT
-AC_CHECK_HEADERS(arpa/inet.h alloca.h crypt.h)
+AC_CHECK_HEADERS(arpa/inet.h alloca.h crtdbg.h crypt.h)
 AC_CHECK_HEADERS(ctype.h direct.h dirent.h dlfcn.h)
 AC_CHECK_HEADERS(errno.h execinfo.h fcntl.h fenv.h)
 AC_CHECK_HEADERS(float.h fpu_control.h ieeefp.h io.h limits.h)
 AC_CHECK_HEADERS(locale.h malloc.h math.h memory.h)
-AC_CHECK_HEADERS(netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h)
+AC_CHECK_HEADERS(netdb.h netinet/in.h netinet/tcp.h pwd.h regex.h shlobj.h)
 AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h stdint.h string.h stropts.h)
 AC_CHECK_HEADERS(sys/conf.h sys/dir.h sys/file.h)
 AC_CHECK_HEADERS(sys/mman.h sys/ndir.h sys/param.h)
@@ -1709,7 +1709,7 @@ AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h)
 AC_CHECK_HEADERS(sys/ucontext.h sys/un.h sys/wait.h)
 AC_CHECK_HEADERS(time.h unistd.h utime.h wctype.h winsock.h winsock2.h)
 AC_CHECK_HEADERS(zlib.h zutil.h)
-AC_CHECK_HEADERS(mach-o/dyld.h)
+AC_CHECK_HEADERS(mach-o/dyld.h LibLoaderAPI.h)
 if test "$yap_cv_gmp" != "no"
 then
   AC_CHECK_HEADERS(gmp.h)
@@ -2068,7 +2068,7 @@ AC_CHECK_FUNCS(_NSGetEnviron _chsize_s access acosh)
 AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime)
 AC_CHECK_FUNCS(ctime dlopen dup2)
 AC_CHECK_FUNCS(erf feclearexcept)
-AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime getcwd getenv)
+AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime ftruncate getcwd getenv)
 AC_CHECK_FUNCS(getexecname)
 AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)
 AC_CHECK_FUNCS(gethrtime getpagesize)

docs/yap.tex

@@ -8,7 +8,7 @@
 @c @setchapternewpage odd
 @c %**end of header
 
-@set VERSION 6.3.2
+@set VERSION 6.3.3
 @set EDITION 4.2.9
 @set UPDATED Oct 2010
 
@@ -1686,6 +1686,13 @@ supported encodings.
     is @code{compact} clauses are compiled and no source code is stored;
     if it is @code{source} clauses are compiled and source code is stored;
     if it is @code{assert_all} clauses are asserted into the data-base.
+
+@item comnsult(+@var{Mode})
+    This extension controls the type of file to load. If @var{Mode}
+    is @code{consult}, clauses are added to the data-base,
+    is @code{reconsult}, clauses are recompiled,
+    is @code{db}, these are facts that need to be added to the data-base,
+    is @code{exo}, these are facts with atoms and integers that need a very compact representation.
 @end table
 
 @item ensure_loaded(@var{+F}) [ISO]
@@ -1708,7 +1715,14 @@ if they have not been loaded before, does nothing otherwise.
 @syindex load_db/1
 @cnindex load_db/1
 @noindent
-Load a database of facts with equal structure. Useful when wanting to
+Load a database of facts with equal structure.
+
+@item exo_files(@var{+Files})
+@findex exo_files/1
+@syindex exo_files/1
+@cnindex exo_files/1
+@noindent
+Load compactly a database of facts with equal structure. Useful when wanting to
 read in a very compact way database tables.
 
 @item make

include/SWI-Prolog.h

@@ -127,7 +127,10 @@ typedef unsigned long uintptr_t;
 #include <inttypes.h>			/* more portable than stdint.h */
 #endif
 
+#ifndef PL_HAVE_TERM_T
+#define PL_HAVE_TERM_T
 typedef	uintptr_t    term_t;
+#endif
 typedef	void *module_t;
 typedef	void *record_t;
 typedef uintptr_t	atom_t;
@@ -220,6 +223,15 @@ typedef void *PL_engine_t;
 #define PL_CYCLIC_TERM	 (42)		/* a cyclic list/term */
 #define PL_NOT_A_LIST	 (43)		/* Object is not a list */
 
+/* Or'ed flags for PL_set_prolog_flag() */
+/* MUST fit in a short int! */
+#define FF_READONLY      0x1000         /* Read-only prolog flag */
+#define FF_KEEP          0x2000         /* keep prolog flag if already se
+t */
+#define FF_NOCREATE      0x4000         /* Fail if flag is non-existent */
+#define FF_MASK          0xf000
+
+
 #define CVT_ATOM	0x0001
 #define CVT_STRING	0x0002
 #define CVT_LIST	0x0004
@@ -332,9 +344,6 @@ UNICODE file functions.
 
 #ifdef SIO_MAGIC			/* defined from <SWI-Stream.h> */
 
-#define FF_NOCREATE	 0x4000		/* Fail if flag is non-existent */
-#define FF_MASK		 0xf000
-
 		 /*******************************
 		 *	  STREAM SUPPORT	*
 		 *******************************/
@@ -373,6 +382,10 @@ PL_EXPORT(IOSTREAM *)*_PL_streams(void);	/* base of streams */
 	 PL_WRT_ATTVAR_WRITE | \
 	 PL_WRT_ATTVAR_PORTRAY)
 #define PL_WRT_BLOB_PORTRAY	0x400	/* Use portray to emit non-text blobs */
+#define PL_WRT_NO_CYCLES        0x800   /* Never emit @(Template,Subst) */
+#define PL_WRT_LIST            0x1000   /* Write [...], even with ignoreops */
+#define PL_WRT_NEWLINE         0x2000   /* Add a newline */
+#define PL_WRT_VARNAMES        0x4000   /* Internal: variable_names(List)  */
 
 PL_EXPORT(int) PL_write_term(IOSTREAM *s,
 			     term_t term,
@@ -525,6 +538,7 @@ extern X_API  int PL_is_string(term_t);
 extern X_API  int PL_is_variable(term_t);
 extern X_API  int PL_term_type(term_t);
 extern X_API  int PL_is_inf(term_t);
+extern X_API  int PL_is_acyclic(term_t t);
 /* end PL_is_* functions =============================*/
 extern X_API void PL_halt(int);
 extern X_API  int  PL_initialise(int, char **);
@@ -579,6 +593,7 @@ extern X_API int PL_erase_external(char *);
 extern X_API int PL_action(int,...);
 extern X_API void PL_on_halt(void (*)(int, void *), void *);
 extern X_API void *PL_malloc(size_t);
+extern X_API void *PL_malloc_uncollectable(size_t s);
 extern X_API void *PL_realloc(void*,size_t);
 extern X_API void PL_free(void *);
 extern X_API int  PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
@@ -618,7 +633,7 @@ extern char *PL_prompt_string(int fd);
 PL_EXPORT(int)          PL_get_file_name(term_t n, char **name, int flags);
 PL_EXPORT(int)          PL_get_file_nameW(term_t n, wchar_t **name, int flags);
 PL_EXPORT(void)         PL_changed_cwd(void); /* foreign code changed CWD */
-PL_EXPORT(const char *) PL_cwd(void);
+PL_EXPORT(char *)	PL_cwd(char *buf, size_t buflen);
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 NOTE: the functions in this section are   not  documented, as as yet not
@@ -784,8 +799,6 @@ PL_EXPORT(int)		PL_unify_mpq(term_t t, mpq_t mpz);
 
 #endif
 
-extern X_API  const char *PL_cwd(void);
-
 void swi_install(void);
 
 X_API int PL_warning(const char *msg, ...);

include/yap_structs.h

@@ -120,8 +120,14 @@ typedef enum {
 
 #define YAP_WRITE_QUOTED		1
 #define YAP_WRITE_IGNORE_OPS		2
-#define YAP_WRITE_HANDLE_VARS		2
+#define YAP_WRITE_HANDLE_VARS		4
 #define YAP_WRITE_USE_PORTRAY		8
+#define YAP_WRITE_HANDLE_CYCLES		0x20
+#define YAP_WRITE_BACKQUOTE_STRING	0x80
+#define YAP_WRITE_ATTVAR_NONE		0x100
+#define YAP_WRITE_ATTVAR_DOTS		0x200
+#define YAP_WRITE_ATTVAR_PORTRAY	0x400
+#define YAP_WRITE_BLOB_PORTRAY		0x800
 
 #define YAP_CONSULT_MODE           0
 #define YAP_RECONSULT_MODE         1

library/dialect/swi/fli/blobs.c

@@ -20,6 +20,10 @@
 
 #include <string.h>
 
+/* for freeBSD9.1 */
+#define _WITH_DPRINTF
+#include <stdio.h>
+
 #include	<SWI-Prolog.h>
 
 #include "swi.h"

library/dialect/swi/fli/swi.c

@@ -1738,6 +1738,12 @@ X_API int PL_is_ground(term_t t)
   return Yap_IsGroundTerm(Yap_GetFromSlot(t PASS_REGS));
 }
 
+X_API int PL_is_acyclic(term_t t)
+{
+  CACHE_REGS
+  return Yap_IsAcyclicTerm(Yap_GetFromSlot(t PASS_REGS));
+}
+
 X_API int PL_is_callable(term_t t)
 {
   CACHE_REGS
@@ -2196,6 +2202,7 @@ PL_open_foreign_frame(void)
   new->open = FALSE;
   new->cp = CP;
   new->p = P;
+  new->flags = 0;
   new->b = (CELL)(LCL0-(CELL*)B);
   new->slots = CurSlot;
   LOCAL_execution = new;
@@ -2226,6 +2233,8 @@ PL_close_foreign_frame(fid_t f)
   CurSlot = env->slots;
   B = (choiceptr)(LCL0-env->b);
   ASP = (CELL *)(LCL0-CurSlot);
+  EX = NULL;
+  LOCAL_BallTerm = EX;
   LOCAL_execution = env->old;
   free(env);
 }
@@ -2274,6 +2283,8 @@ PL_discard_foreign_frame(fid_t f)
   LOCAL_execution = env->old;
   ASP = LCL0-CurSlot;
   B = B->cp_b;
+  EX = NULL;
+  LOCAL_BallTerm = EX;
   free(env);
 }
 
@@ -2285,9 +2296,22 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
   Term t[2], m;
 
   /* ignore flags  and module for now */
-  PL_open_foreign_frame();
+  if (!LOCAL_execution) {
+    open_query *new = (open_query *)malloc(sizeof(open_query));
+    if (!new) return 0;
+    new->old = LOCAL_execution;
+    new->g = TermNil;
+    new->open = FALSE;
+    new->cp = CP;
+    new->p = P;
+    new->b = (CELL)(LCL0-(CELL*)B);
+    new->slots = CurSlot;
+    new->flags = 0;
+    LOCAL_execution = new;
+  }
   LOCAL_execution->open=1;
   LOCAL_execution->state=0;
+  LOCAL_execution->flags = flags;
   PredicateInfo((PredEntry *)p, &yname, &arity, &m);
   t[0] = SWIModuleToModule(ctx);
   if (arity == 0) {
@@ -2346,9 +2370,15 @@ X_API void PL_cut_query(qid_t qi)
 
 X_API void PL_close_query(qid_t qi)
 {
+  CACHE_REGS
+  EX = NULL;
+  if (EX && !(qi->flags & (PL_Q_CATCH_EXCEPTION|PL_Q_PASS_EXCEPTION))) {
+    EX = NULL;
+  }
   /* need to implement backtracking here */
-  if (qi->open != 1 || qi->state == 0)
+  if (qi->open != 1 || qi->state == 0) {
     return;
+  }
   YAP_PruneGoal();
   YAP_RestartGoal();
   qi->open = 0;
@@ -2784,6 +2814,11 @@ PL_query(int query)
   }
 }  
 
+X_API void
+PL_cleanup_fork(void)
+{
+}  
+
 
 X_API void (*PL_signal(int sig, void (*func)(int)))(int)
 {
@@ -2796,11 +2831,106 @@ X_API void PL_on_halt(void (*f)(int, void *), void *closure)
   Yap_HaltRegisterHook((HaltHookFunc)f,closure);
 }
 
-X_API char *PL_atom_generator(const char *prefix, int state)
+#define is_signalled() unlikely(LD && LD->signal.pending != 0)
+
+#ifdef O_PLMT
+#include <pthread.h>
+static pthread_key_t atomgen_key;
+#endif
+
+typedef struct scan_atoms {
+  Int pos;
+  Atom atom;
+} scan_atoms_t;
+
+static inline int
+str_prefix(const char *p0, char *s)
 {
+  char *p = (char *)p0;
+  while (*p && *p == *s) { p++; s++; }
+  return p[0] == '\0';
+}
+
+static int
+atom_generator(const char *prefix, char **hit, int state)
+{
+  struct scan_atoms *index;
+  Atom            catom;
+  Int            i;
+
+#ifdef O_PLMT
+  if ( !atomgen_key ) {
+    pthread_key_create(&atomgen_key, NULL);
+    state = FALSE;
+  }
+#endif
+
+  if ( !state )
+    { index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms));
+      i = 0;
+      catom = NIL;
+  } else
+  {
+#ifdef O_PLMT
+    index = (struct scan_atoms *)pthread_getspecific(atomgen_key);
+#else
+    index = LOCAL_search_atoms;
+#endif
+    catom = index->atom;
+    i = index->pos;
+  }
+
+  while (catom != NIL || i < AtomHashTableSize) {
+    //    if ( is_signalled() )		/* Notably allow windows version */
+      //      PL_handle_signals();		/* to break out on ^C */
+    AtomEntry *ap;
+
+    if (catom == NIL) {
+      /* move away from current hash table line */
+      READ_LOCK(HashChain[i].AERWLock);
+      catom = HashChain[i].Entry;
+      READ_UNLOCK(HashChain[i].AERWLock);
+      i++;
+    } else {
+      ap = RepAtom(catom);
+      READ_LOCK(ap->ARWLock);
+      if ( str_prefix(prefix, ap->StrOfAE) ) {
+	index->pos = i;
+	index->atom = ap->NextOfAE;
+#ifdef O_PLMT
+	pthread_setspecific(atomgen_key,index);
+#else
+	LOCAL_search_atoms = index;
+#endif
+	*hit = ap->StrOfAE;
+	READ_UNLOCK(ap->ARWLock);
+	return TRUE;
+      }
+      catom = ap->NextOfAE;
+      READ_UNLOCK(ap->ARWLock);
+    }
+  }
+#ifdef O_PLMT
+  pthread_setspecific(atomgen_key,NULL);
+#else
+  LOCAL_search_atoms = NULL;
+#endif
+  free(index);
+  return FALSE;
+}
+
+
+char *
+PL_atom_generator(const char *prefix, int state)
+{
+  char * hit = NULL;
+  if (atom_generator(prefix, &hit, state)) {
+    return hit;
+  }
   return NULL;
 }
 
+
 X_API pl_wchar_t *PL_atom_generator_w(const pl_wchar_t *pref, pl_wchar_t *buffer, size_t buflen, int state)
 {
   return NULL;

library/dialect/swi/fli/swi.h

@@ -49,6 +49,7 @@ typedef struct open_query_struct {
   yamop *p, *cp;
   Int slots, b;
   jmp_buf env;
+  int flags;
   struct open_query_struct *old;
 } open_query;
 

misc/ATOMS

@@ -79,6 +79,7 @@ A	Dec10			N	"dec10"
 A	Default			N	"default"
 A	DevNull			N	"/dev/null"
 A	Diff			N	"\\="
+A	Dollar			F	"$"
 A	DoLogUpdClause		F	"$do_log_upd_clause"
 A	DoLogUpdClause0		F	"$do_log_upd_clause0"
 A	DoLogUpdClauseErase	F	"$do_log_upd_clause_erase"
@@ -132,6 +133,7 @@ A	GetworkSeq		F	"$getwork_seq"
 A	GlobalSp		N	"global_sp"
 A	GlobalTrie		N	"global_trie"
 A	GoalExpansion		N	"goal_expansion"
+A	Hat			N	"^"
 A	HERE			N	"\n   <====HERE====>  \n"
 A	HandleThrow		F	"$handle_throw"
 A	Heap			N	"heap"
@@ -395,6 +397,7 @@ F	GeneratePredInfo	GeneratePredInfo	4
 F	GoalExpansion2		GoalExpansion	2
 F	GoalExpansion		GoalExpansion	3
 F	HandleThrow		HandleThrow	3
+F	Hat			Hat		2
 F	Id			Id		1
 F	Is			Is		2
 F	LastExecuteWithin	LastExecuteWithin	1

misc/GLOBALS

@@ -118,6 +118,8 @@ char				pwd[YAP_FILENAME_MAX]			void
 //udi.c
 //struct udi_control_block 	RtreeCmd				void	
 
+char*			 	RestoreFile				void	
+
 
 
 END_GLOBAL_DATA

misc/LOCALS

@@ -274,4 +274,7 @@ Functor				FunctorVar				=FunctorVar
 // exo indexing
 UInt				ibnds[256]				void
 
+// atom completion
+struct scan_atoms*		search_atoms				void
+
 END_WORKER_LOCAL

misc/SWIATOMS

@@ -14,7 +14,9 @@ A abort			"abort"
 A aborted		"$aborted"
 A abs			"abs"
 A access		"access"
+A access_level		"access_level"
 A acos			"acos"
+A acosh			"acosh"
 A acyclic_term		"acyclic_term"
 A add_import		"add_import"
 A address		"address"
@@ -38,6 +40,7 @@ A argumentlimit		"argumentlimit"
 A as			"as"
 A ascii			"ascii"
 A asin			"asin"
+A asinh			"asinh"
 A assert		"assert"
 A asserta		"asserta"
 A at			"at"
@@ -49,6 +52,7 @@ A at_not_equals		"\\=@="
 A at_smaller		"@<"
 A at_smaller_eq		"@=<"
 A atan			"atan"
+A atanh			"atanh"
 A atan2			"atan2"
 A atom			"atom"
 A atom_garbage_collection	"atom_garbage_collection"
@@ -62,8 +66,10 @@ A backquoted_string	"backquoted_string"
 A backslash		"\\"
 A backtrace		"backtrace"
 A bar			"|"
+A base			"base"
 A begin			"begin"
 A binary		"binary"
+A binary_stream		"binary_stream"
 A bind			"bind"
 A bitor			"\\/"
 A blobs			"blobs"
@@ -73,6 +79,7 @@ A bool			"bool"
 A boolean		"boolean"
 A brace_term_position	"brace_term_position"
 A break			"break"
+A break_level		"break_level"
 A btree			"btree"
 A buffer		"buffer"
 A buffer_size		"buffer_size"
@@ -86,6 +93,7 @@ A callpred		"$callpred"
 A canceled		"canceled"
 A case_sensitive_file_names "case_sensitive_file_names"
 A catch			"catch"
+A category		"category"
 A ceil			"ceil"
 A ceiling		"ceiling"
 A char_type		"char_type"
@@ -96,11 +104,13 @@ A chars			"chars"
 A chdir			"chdir"
 A chmod			"chmod"
 A choice		"choice"
+A class			"class"
 A clause		"clause"
+A clauses		"clauses"
 A clause_reference	"clause_reference"
 A close			"close"
 A close_on_abort	"close_on_abort"
-A close_on_exec       	"close_on_exec"
+A close_on_exec		"close_on_exec"
 A close_option		"close_option"
 A cm			"cm"
 A cntrl			"cntrl"
@@ -115,9 +125,11 @@ A compound		"compound"
 A context		"context"
 A context_module	"context_module"
 A continue		"continue"
+A copysign		"copysign"
 A core			"core"
 A core_left		"core_left"
 A cos			"cos"
+A cosh			"cosh"
 A cputime		"cputime"
 A create		"create"
 A csym			"csym"
@@ -133,6 +145,7 @@ A cut_exit		"cut_exit"
 A cut_parent		"cut_parent"
 A cutted		"cut"
 A cyclic_term		"cyclic_term"
+A cycles		"cycles"
 A dand			"$and"
 A date			"date"
 A db_reference		"db_reference"
@@ -143,8 +156,10 @@ A dcatch		"$catch"
 A dcut			"$cut"
 A dde_error		"dde_error"
 A dde_handle		"dde_handle"
+A deadline			"deadline"
 A debug			"debug"
 A debug_on_error	"debug_on_error"
+A debug_topic		"debug_topic"
 A debugger_print_options "debugger_print_options"
 A debugger_show_context "debugger_show_context"
 A debugging		"debugging"
@@ -176,11 +191,13 @@ A dots			"dots"
 A double_quotes		"double_quotes"
 A doublestar		"**"
 A dprof_node		"$profile_node"
+A dquery_loop		"$query_loop"
 A drecover_and_rethrow	"$recover_and_rethrow"
 A dstream		"$stream"
 A dthread_init		"$thread_init"
 A dthrow		"$throw"
 A dtime			"$time"
+A dtoplevel		"$toplevel"
 A dvard			"$VAR$"
 A dwakeup		"$wakeup"
 A dynamic		"dynamic"
@@ -274,9 +291,8 @@ A has_alternatives	"has_alternatives"
 A hash			"hash"
 A hashed		"hashed"
 A hat			"^"
-A heap			"heap"
-A heaplimit		"heaplimit"
 A heapused		"heapused"
+A heap_gc		"heap_gc"
 A help			"help"
 A hidden		"hidden"
 A hide_childs		"hide_childs"
@@ -284,6 +300,8 @@ A history_depth		"history_depth"
 A ifthen		"->"
 A ignore		"ignore"
 A ignore_ops		"ignore_ops"
+A import_into		"import_into"
+A import_type		"import_type"
 A imported		"imported"
 A imported_procedure	"imported_procedure"
 A index			"index"
@@ -292,7 +310,7 @@ A inf			"inf"
 A inferences		"inferences"
 A infinite		"infinite"
 A informational		"informational"
-A init_file    		"init_file"
+A init_file		"init_file"
 A initialization	"initialization"
 A input			"input"
 A inserted_char		"inserted_char"
@@ -318,9 +336,11 @@ A larger		">"
 A larger_equal		">="
 A level			"level"
 A li			"li"
+A library		"library"
 A limit			"limit"
 A line			"line"
 A line_count		"line_count"
+A line_position		"line_position"
 A list			"list"
 A list_position		"list_position"
 A listing		"listing"
@@ -335,6 +355,7 @@ A locked		"locked"
 A log			"log"
 A log10			"log10"
 A long			"long"
+A loose			"loose"
 A low			"low"
 A lower			"lower"
 A lsb			"lsb"
@@ -348,6 +369,7 @@ A max_dde_handles	"max_dde_handles"
 A max_depth		"max_depth"
 A max_files		"max_files"
 A max_frame_size	"max_frame_size"
+A max_length		"max_length"
 A max_path_length	"max_path_length"
 A max_size		"max_size"
 A max_variable_length	"max_variable_length"
@@ -367,6 +389,7 @@ A mod			"mod"
 A mode			"mode"
 A modify		"modify"
 A module		"module"
+A module_class		"module_class"
 A module_property	"module_property"
 A module_transparent	"module_transparent"
 A modules		"modules"
@@ -393,15 +416,16 @@ A not_implemented	"not_implemented"
 A not_less_than_one	"not_less_than_one"
 A not_less_than_zero	"not_less_than_zero"
 A not_provable		"\\+"
-A not_strickt_equals	"\\=="
+A not_strict_equal	"\\=="
 A not_unique		"not_unique"
 A number		"number"
 A number_of_clauses	"number_of_clauses"
+A number_of_rules	"number_of_rules"
 A numbervar_option	"numbervar_option"
 A numbervars		"numbervars"
 A occurs_check		"occurs_check"
 A octet		        "octet"
-A off     		"off"
+A off			"off"
 A on			"on"
 A open			"open"
 A operator		"operator"
@@ -411,6 +435,7 @@ A optimise		"optimise"
 A or			"or"
 A order			"order"
 A output		"output"
+A owner			"owner"
 A pair			"pair"
 A paren			"paren"
 A parent		"parent"
@@ -429,6 +454,7 @@ A plain			"plain"
 A plus			"+"
 A popcount		"popcount"
 A portray		"portray"
+A portray_goal		"portray_goal"
 A position		"position"
 A posix			"posix"
 A powm			"powm"
@@ -439,6 +465,8 @@ A print_message		"print_message"
 A priority		"priority"
 A private_procedure	"private_procedure"
 A procedure		"procedure"
+A process_comment	"process_comment"
+A process_cputime	"process_cputime"
 A profile_mode		"profile_mode"
 A profile_no_cpu_time	"profile_no_cpu_time"
 A profile_node		"profile_node"
@@ -463,6 +491,7 @@ A quote			"quote"
 A quoted		"quoted"
 A radix			"radix"
 A random		"random"
+A random_float		"random_float"
 A random_option		"random_option"
 A rational		"rational"
 A rationalize		"rationalize"
@@ -478,6 +507,7 @@ A record		"record"
 A record_position	"record_position"
 A redefine		"redefine"
 A redo			"redo"
+A redo_in_skip		"redo_in_skip"
 A references		"references"
 A rem			"rem"
 A rename		"rename"
@@ -495,6 +525,7 @@ A running		"running"
 A runtime		"runtime"
 A save_class		"save_class"
 A save_option		"save_option"
+A see			"see"
 A seed			"seed"
 A seek_method		"seek_method"
 A select		"select"
@@ -507,15 +538,18 @@ A shared		"shared"
 A shared_object		"shared_object"
 A shared_object_handle	"shared_object_handle"
 A shell			"shell"
+A shift_time		"shift_time"
 A sign			"sign"
 A signal		"signal"
 A signal_handler	"signal_handler"
 A silent		"silent"
 A sin			"sin"
 A singletons		"singletons"
+A sinh			"sinh"
 A size			"size"
 A size_t		"size_t"
 A skip			"skip"
+A skipped		"skipped"
 A smaller		"<"
 A smaller_equal		"=<"
 A softcut		"*->"
@@ -534,6 +568,7 @@ A standard		"standard"
 A star			"*"
 A start			"start"
 A stat			"stat"
+A state			"state"
 A static_procedure	"static_procedure"
 A statistics		"statistics"
 A status		"status"
@@ -544,9 +579,11 @@ A stream_or_alias	"stream_or_alias"
 A stream_pair		"stream_pair"
 A stream_position	"$stream_position"
 A stream_property	"stream_property"
+A stream_type_check	"stream_type_check"
 A strict_equal		"=="
 A string		"string"
 A string_position	"string_position"
+A strong		"strong"
 A subterm_positions	"subterm_positions"
 A suffix		"suffix"
 A syntax_error		"syntax_error"
@@ -554,18 +591,22 @@ A syntax_errors		"syntax_errors"
 A system		"system"
 A system_error		"system_error"
 A system_init_file	"system_init_file"
-A system_thread_id 	"system_thread_id"
+A system_thread_id	"system_thread_id"
 A system_time		"system_time"
 A tan			"tan"
+A tanh			"tanh"
 A temporary_files	"temporary_files"
 A term			"term"
 A term_expansion	"term_expansion"
 A term_position		"term_position"
 A terminal		"terminal"
 A terminal_capability	"terminal_capability"
+A test			"test"
 A text			"text"
+A text_stream		"text_stream"
 A thread		"thread"
 A thread_cputime	"thread_cputime"
+A thread_get_message_option "thread_get_message_option"
 A thread_initialization "thread_initialization"
 A thread_local		"thread_local"
 A thread_local_procedure "thread_local_procedure"
@@ -583,7 +624,7 @@ A timezone		"timezone"
 A to_lower		"to_lower"
 A to_upper		"to_upper"
 A top			"top"
-A top_level    		"top_level"
+A top_level		"top_level"
 A toplevel		"toplevel"
 A trace			"trace"
 A trace_any		"trace_any"
@@ -643,6 +684,7 @@ A wait			"wait"
 A wakeup		"wakeup"
 A walltime		"walltime"
 A warning		"warning"
+A weak			"weak"
 A wchar_t		"wchar_t"
 A when_condition	"when_condition"
 A white			"white"
@@ -663,15 +705,18 @@ A zero_divisor		"zero_divisor"
 F abs			1
 F access		1
 F acos			1
+F acosh			1
 F alias			1
 F and			2
 F ar_equals		2
 F ar_not_equal		2
 F asin			1
+F asinh			1
 F assert		1
 F asserta		1
 F atan			1
 F atan			2
+F atanh			1
 F atan2			2
 F atom			1
 F att			3
@@ -693,15 +738,18 @@ F ceil			1
 F ceiling		1
 F chars			1
 F chars			2
+F class			1
 F clause		1
 F close_on_abort	1
-F close_on_exec  	1
+F close_on_exec		1
 F codes			1
 F codes			2
 F colon			2
 F comma			2
 F context		2
+F copysign		2
 F cos			1
+F cosh			1
 F cputime		0
 F curl			1
 F cut_call		1
@@ -717,7 +765,7 @@ F debugging		1
 F detached		1
 F dexit			2
 F dforeign_registered   2
-F dgarbage_collect 	1
+F dgarbage_collect	1
 F div			2
 F gdiv			2
 F divide		2
@@ -769,7 +817,9 @@ F goal_expansion	2
 F ground		1
 F hat			2
 F ifthen		2
+F import_into		1
 F input			0
+F input			3
 F integer		1
 F interrupt		1
 F io_error		2
@@ -799,6 +849,7 @@ F nlink			1
 F nonvar		1
 F not_implemented	2
 F not_provable		1
+F not_strict_equal	2
 F occurs_check		2
 F or			1
 F output		0
@@ -813,14 +864,17 @@ F position		1
 F powm			3
 F print			1
 F print_message		2
+F priority		1
 F procedure		2
 F prove			1
 F prove			2
 F punct			2
 F random		1
+F random_float		0
 F rational		1
 F rationalize		1
 F rdiv			2
+F redo			1
 F rem			2
 F reposition		1
 F representation_error	1
@@ -838,6 +892,7 @@ F signal		1
 F signal		2
 F sin			1
 F singletons		1
+F sinh			1
 F size			1
 F smaller		2
 F smaller_equal		2
@@ -855,6 +910,7 @@ F string_position	2
 F syntax_error		1
 F syntax_error		3
 F tan			1
+F tanh			1
 F term_expansion	2
 F term_position		5
 F timeout		1
@@ -875,3 +931,4 @@ F wakeup		3
 F warning		3
 F xor			2
 F xpceref		1
+F xpceref		2

misc/Yap.spec

@@ -3,7 +3,7 @@
 
 Name: yap
 Summary: Prolog Compiler
-Version: 6.3.2
+Version: 6.3.4
 Packager: Vitor Santos Costa <vsc@dcc.fc.up.pt>
 Release: 1
 Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

misc/Yap64.spec

@@ -3,7 +3,7 @@
 
 Name: yap
 Summary: Prolog Compiler
-Version: 6.3.2
+Version: 6.3.4
 Packager: Vitor Santos Costa <vsc@dcc.fc.up.pt>
 Release: 1
 Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz

misc/yap.nsi

@@ -268,4 +268,4 @@ Function .onInstFailed
 		    installer, please contact yap-users@sf.net"
 FunctionEnd
 
-outfile "yap-6.3.2-installer.exe"
+outfile "yap-6.3.4-installer.exe"

misc/yap64.nsi

@@ -265,4 +265,4 @@ Function .onInstFailed
 		    installer, please contact yap-users@sf.net"
 FunctionEnd
 
-outfile "yap64-6.3.2-installer.exe"
+outfile "yap64-6.3.4-installer.exe"

os/SWI-Stream.h

@@ -1,388 +1,395 @@
-
+
-#ifndef _PL_STREAM_H
+#ifndef _PL_STREAM_H
-#define _PL_STREAM_H
+#define _PL_STREAM_H
-
+
-#ifndef _PL_EXPORT_DONE
+#ifndef _PL_EXPORT_DONE
-#define _PL_EXPORT_DONE
+#define _PL_EXPORT_DONE
-
+
-#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
+#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
-#define HAVE_DECLSPEC
+#define HAVE_DECLSPEC
-#endif
+#endif
-
+
-#ifdef HAVE_DECLSPEC
+#ifdef HAVE_DECLSPEC
-# ifdef PL_KERNEL
+# ifdef PL_KERNEL
-#define PL_EXPORT(type)		__declspec(dllexport) type
+#define PL_EXPORT(type)		__declspec(dllexport) type
-#define PL_EXPORT_DATA(type)	__declspec(dllexport) type
+#define PL_EXPORT_DATA(type)	__declspec(dllexport) type
-#define install_t	 	void
+#define install_t	 	void
-# else
+# else
-#  ifdef __BORLANDC__
+#  ifdef __BORLANDC__
-#define PL_EXPORT(type)	 	type _stdcall
+#define PL_EXPORT(type)	 	type _stdcall
-#define PL_EXPORT_DATA(type)	extern type
+#define PL_EXPORT_DATA(type)	extern type
-#  else
+#  else
-#define PL_EXPORT(type)	 	extern type
+#define PL_EXPORT(type)	 	extern type
-#define PL_EXPORT_DATA(type)	__declspec(dllimport) type
+#define PL_EXPORT_DATA(type)	__declspec(dllimport) type
-#  endif
+#  endif
-#define install_t	 	__declspec(dllexport) void
+#define install_t	 	__declspec(dllexport) void
-# endif
+# endif
-#else /*HAVE_DECLSPEC*/
+#else /*HAVE_DECLSPEC*/
-#define PL_EXPORT(type)	 	extern type
+#define PL_EXPORT(type)	 	extern type
-#define PL_EXPORT_DATA(type)	extern type
+#define PL_EXPORT_DATA(type)	extern type
-#define install_t	 	void
+#define install_t	 	void
-#endif /*HAVE_DECLSPEC*/
+#endif /*HAVE_DECLSPEC*/
-#endif /*_PL_EXPORT_DONE*/
+#endif /*_PL_EXPORT_DONE*/
-
+
-/* This appears to make the wide-character support compile and work
+/* This appears to make the wide-character support compile and work
-   on HPUX 11.23.  There really should be a cleaner way ...
+   on HPUX 11.23.  There really should be a cleaner way ...
-*/
+*/
-#if defined(__hpux)
+#if defined(__hpux)
-#include <sys/_mbstate_t.h>
+#include <sys/_mbstate_t.h>
-#endif
+#endif
-
+
-#if defined(_MSC_VER) && !defined(__WINDOWS__)
+#if defined(_MSC_VER) && !defined(__WINDOWS__)
-#define __WINDOWS__ 1
+#define __WINDOWS__ 1
-#endif
+#endif
-
+
-#include <stdarg.h>
+#include <stdarg.h>
-#include <wchar.h>
+#include <wchar.h>
-#include <stddef.h>
+#include <stddef.h>
-#ifdef __WINDOWS__
+#ifdef __WINDOWS__
-#ifndef INT64_T_DEFINED
+#ifndef INT64_T_DEFINED
-#define INT64_T_DEFINED 1
+#define INT64_T_DEFINED 1
-typedef __int64 int64_t;
+typedef __int64 int64_t;
-typedef unsigned __int64 uint64_t;
+typedef unsigned __int64 uint64_t;
-#if (_MSC_VER < 1300) && !defined(__MINGW32__)
+#if (_MSC_VER < 1300) && !defined(__MINGW32__)
-typedef long intptr_t;
+typedef long intptr_t;
-typedef unsigned long uintptr_t;
+typedef unsigned long uintptr_t;
-typedef intptr_t ssize_t;		/* signed version of size_t */
+typedef intptr_t ssize_t;		/* signed version of size_t */
-#endif
+#endif
-#endif
+#endif
-#else
+#else
-#include <unistd.h>
+#include <unistd.h>
-#include <inttypes.h>			/* more portable than stdint.h */
+#include <inttypes.h>			/* more portable than stdint.h */
-#endif
+#endif
-
+
-#ifdef __cplusplus
+#ifdef __cplusplus
-extern "C" {
+extern "C" {
-#endif
+#endif
-
+
-		 /*******************************
+#ifndef PL_HAVE_TERM_T
-		 *	    CONSTANTS		*
+#define PL_HAVE_TERM_T
-		 *******************************/
+typedef	uintptr_t    term_t;
-
+#endif
-#ifndef EOF
+		 /*******************************
-#define EOF (-1)
+		 *	    CONSTANTS		*
-#endif
+		 *******************************/
-
+
-#ifndef NULL
+#ifndef EOF
-#define NULL ((void *)0)
+#define EOF (-1)
-#endif
+#endif
-
+
-#if defined(__WINDOWS__) && !defined(EWOULDBLOCK)
+#ifndef NULL
-#define EWOULDBLOCK	1000		/* Needed for socket handling */
+#define NULL ((void *)0)
-#endif
+#endif
-#define EPLEXCEPTION	1001		/* errno: pending Prolog exception */
+
-
+#if defined(__WINDOWS__) && !defined(EWOULDBLOCK)
-#define SIO_BUFSIZE	(4096)		/* buffering buffer-size */
+#define EWOULDBLOCK	1000		/* Needed for socket handling */
-#define SIO_LINESIZE	(1024)		/* Sgets() default buffer size */
+#endif
-#define SIO_MAGIC	(7212676)	/* magic number */
+#define EPLEXCEPTION	1001		/* errno: pending Prolog exception */
-#define SIO_CMAGIC	(42)		/* we are close (and thus illegal!) */
+
-
+#define SIO_BUFSIZE	(4096)		/* buffering buffer-size */
-typedef ssize_t (*Sread_function)(void *handle, char *buf, size_t bufsize);
+#define SIO_LINESIZE	(1024)		/* Sgets() default buffer size */
-typedef ssize_t (*Swrite_function)(void *handle, char*buf, size_t bufsize);
+#define SIO_MAGIC	(7212676)	/* magic number */
-typedef long  (*Sseek_function)(void *handle, long pos, int whence);
+#define SIO_CMAGIC	(42)		/* we are close (and thus illegal!) */
-typedef int64_t (*Sseek64_function)(void *handle, int64_t pos, int whence);
+
-typedef int   (*Sclose_function)(void *handle);
+typedef ssize_t (*Sread_function)(void *handle, char *buf, size_t bufsize);
-typedef int   (*Scontrol_function)(void *handle, int action, void *arg);
+typedef ssize_t (*Swrite_function)(void *handle, char*buf, size_t bufsize);
-
+typedef long  (*Sseek_function)(void *handle, long pos, int whence);
-#include "pl-thread.h"
+typedef int64_t (*Sseek64_function)(void *handle, int64_t pos, int whence);
-
+typedef int   (*Sclose_function)(void *handle);
-typedef struct io_functions
+typedef int   (*Scontrol_function)(void *handle, int action, void *arg);
-{ Sread_function	read;		/* fill the buffer */
+
-  Swrite_function	write;		/* empty the buffer */
+#include "pl-thread.h"
-  Sseek_function	seek;		/* seek to position */
+
-  Sclose_function	close;		/* close stream */
+typedef struct io_functions
-  Scontrol_function	control;	/* Info/control */
+{ Sread_function	read;		/* fill the buffer */
-  Sseek64_function	seek64;		/* seek to position (intptr_t files) */
+  Swrite_function	write;		/* empty the buffer */
-} IOFUNCTIONS;
+  Sseek_function	seek;		/* seek to position */
-
+  Sclose_function	close;		/* close stream */
-typedef struct io_position
+  Scontrol_function	control;	/* Info/control */
-{ int64_t		byteno;		/* byte-position in file */
+  Sseek64_function	seek64;		/* seek to position (intptr_t files) */
-  int64_t		charno;		/* character position in file */
+} IOFUNCTIONS;
-  int			lineno;		/* lineno in file */
+
-  int			linepos;	/* position in line */
+typedef struct io_position
-  intptr_t		reserved[2];	/* future extensions */
+{ int64_t		byteno;		/* byte-position in file */
-} IOPOS;
+  int64_t		charno;		/* character position in file */
-
+  int			lineno;		/* lineno in file */
-					/* NOTE: check with encoding_names */
+  int			linepos;	/* position in line */
-					/* in pl-file.c */
+  intptr_t		reserved[2];	/* future extensions */
-typedef enum
+} IOPOS;
-{ ENC_UNKNOWN = 0,			/* invalid/unknown */
+
-  ENC_OCTET,				/* raw 8 bit input */
+					/* NOTE: check with encoding_names */
-  ENC_ASCII,				/* US-ASCII (0..127) */
+					/* in pl-file.c */
-  ENC_ISO_LATIN_1,			/* ISO Latin-1 (0..256) */
+typedef enum
-  ENC_ANSI,				/* default (multibyte) codepage */
+{ ENC_UNKNOWN = 0,			/* invalid/unknown */
-  ENC_UTF8,
+  ENC_OCTET,				/* raw 8 bit input */
-  ENC_UNICODE_BE,			/* big endian unicode file */
+  ENC_ASCII,				/* US-ASCII (0..127) */
-  ENC_UNICODE_LE,			/* little endian unicode file */
+  ENC_ISO_LATIN_1,			/* ISO Latin-1 (0..256) */
-  ENC_WCHAR				/* pl_wchar_t */
+  ENC_ANSI,				/* default (multibyte) codepage */
-} IOENC;
+  ENC_UTF8,
-
+  ENC_UNICODE_BE,			/* big endian unicode file */
-#define SIO_NL_POSIX  0			/* newline as \n */
+  ENC_UNICODE_LE,			/* little endian unicode file */
-#define SIO_NL_DOS    1			/* newline as \r\n */
+  ENC_WCHAR				/* pl_wchar_t */
-#define SIO_NL_DETECT 3			/* detect processing mode */
+} IOENC;
-
+
-typedef struct io_stream
+#define SIO_NL_POSIX  0			/* newline as \n */
-{ char		       *bufp;		/* `here' */
+#define SIO_NL_DOS    1			/* newline as \r\n */
-  char		       *limitp;		/* read/write limit */
+#define SIO_NL_DETECT 3			/* detect processing mode */
-  char		       *buffer;		/* the buffer */
+
-  char		       *unbuffer;	/* Sungetc buffer */
+typedef struct io_stream
-  int			lastc;		/* last character written */
+{ char		       *bufp;		/* `here' */
-  int			magic;		/* magic number SIO_MAGIC */
+  char		       *limitp;		/* read/write limit */
-  int  			bufsize;	/* size of the buffer */
+  char		       *buffer;		/* the buffer */
-  int			flags;		/* Status flags */
+  char		       *unbuffer;	/* Sungetc buffer */
-  IOPOS			posbuf;		/* location in file */
+  int			lastc;		/* last character written */
-  IOPOS *		position;	/* pointer to above */
+  int			magic;		/* magic number SIO_MAGIC */
-  void		       *handle;		/* function's handle */
+  int  			bufsize;	/* size of the buffer */
-  IOFUNCTIONS	       *functions;	/* open/close/read/write/seek */
+  int			flags;		/* Status flags */
-  int		        locks;		/* lock/unlock count */
+  IOPOS			posbuf;		/* location in file */
-  IOLOCK *		mutex;		/* stream mutex */
+  IOPOS *		position;	/* pointer to above */
-					/* SWI-Prolog 4.0.7 */
+  void		       *handle;		/* function's handle */
-  void			(*close_hook)(void* closure);
+  IOFUNCTIONS	       *functions;	/* open/close/read/write/seek */
-  void *		closure;
+  int		        locks;		/* lock/unlock count */
-					/* SWI-Prolog 5.1.3 */
+  IOLOCK *		mutex;		/* stream mutex */
-  int			timeout;	/* timeout (milliseconds) */
+					/* SWI-Prolog 4.0.7 */
-					/* SWI-Prolog 5.4.4 */
+  void			(*close_hook)(void* closure);
-  char *		message;	/* error/warning message */
+  void *		closure;
-  IOENC			encoding;	/* character encoding used */
+					/* SWI-Prolog 5.1.3 */
-  struct io_stream *	tee;		/* copy data to this stream */
+  int			timeout;	/* timeout (milliseconds) */
-  mbstate_t *		mbstate;	/* ENC_ANSI decoding */
+					/* SWI-Prolog 5.4.4 */
-  struct io_stream *	upstream;	/* stream providing our input */
+  char *		message;	/* error/warning message */
-  struct io_stream *	downstream;	/* stream providing our output */
+  IOENC			encoding;	/* character encoding used */
-  unsigned		newline : 2;	/* Newline mode */
+  struct io_stream *	tee;		/* copy data to this stream */
-  unsigned		erased : 1;	/* Stream was erased */
+  mbstate_t *		mbstate;	/* ENC_ANSI decoding */
-  unsigned		references : 4;	/* Reference-count */
+  struct io_stream *	upstream;	/* stream providing our input */
-  int			io_errno;	/* Save errno value */
+  struct io_stream *	downstream;	/* stream providing our output */
-  void *		exception;	/* pending exception (record_t) */
+  unsigned		newline : 2;	/* Newline mode */
-  intptr_t		reserved[2];	/* reserved for extension */
+  unsigned		erased : 1;	/* Stream was erased */
-} IOSTREAM;
+  unsigned		references : 4;	/* Reference-count */
-
+  int			io_errno;	/* Save errno value */
-#define SmakeFlag(n)	(1<<(n-1))
+  void *		exception;	/* pending exception (record_t) */
-
+  void *		context;	/* getStreamContext() */
-#define SIO_FBUF	SmakeFlag(1)	/* full buffering */
+  intptr_t		reserved[2];	/* reserved for extension */
-#define SIO_LBUF	SmakeFlag(2)	/* line buffering */
+} IOSTREAM;
-#define SIO_NBUF	SmakeFlag(3)	/* no buffering */
+
-#define SIO_FEOF	SmakeFlag(4)	/* end-of-file */
+#define SmakeFlag(n)	(1<<(n-1))
-#define SIO_FERR	SmakeFlag(5)	/* error ocurred */
+
-#define SIO_USERBUF	SmakeFlag(6)	/* buffer is from user */
+#define SIO_FBUF	SmakeFlag(1)	/* full buffering */
-#define SIO_INPUT	SmakeFlag(7)	/* input stream */
+#define SIO_LBUF	SmakeFlag(2)	/* line buffering */
-#define SIO_OUTPUT	SmakeFlag(8)	/* output stream */
+#define SIO_NBUF	SmakeFlag(3)	/* no buffering */
-#define SIO_NOLINENO	SmakeFlag(9)	/* line no. info is void */
+#define SIO_FEOF	SmakeFlag(4)	/* end-of-file */
-#define SIO_NOLINEPOS	SmakeFlag(10)	/* line pos is void */
+#define SIO_FERR	SmakeFlag(5)	/* error ocurred */
-#define SIO_STATIC	SmakeFlag(11)	/* Stream in static memory */
+#define SIO_USERBUF	SmakeFlag(6)	/* buffer is from user */
-#define SIO_RECORDPOS	SmakeFlag(12)	/* Maintain position */
+#define SIO_INPUT	SmakeFlag(7)	/* input stream */
-#define SIO_FILE	SmakeFlag(13)	/* Stream refers to an OS file */
+#define SIO_OUTPUT	SmakeFlag(8)	/* output stream */
-#define SIO_PIPE	SmakeFlag(14)	/* Stream refers to an OS pipe */
+#define SIO_NOLINENO	SmakeFlag(9)	/* line no. info is void */
-#define SIO_NOFEOF	SmakeFlag(15)	/* don't set SIO_FEOF flag */
+#define SIO_NOLINEPOS	SmakeFlag(10)	/* line pos is void */
-#define SIO_TEXT	SmakeFlag(16)	/* text-mode operation */
+#define SIO_STATIC	SmakeFlag(11)	/* Stream in static memory */
-#define SIO_FEOF2	SmakeFlag(17)	/* attempt to read past eof */
+#define SIO_RECORDPOS	SmakeFlag(12)	/* Maintain position */
-#define SIO_FEOF2ERR	SmakeFlag(18)	/* Sfpasteof() */
+#define SIO_FILE	SmakeFlag(13)	/* Stream refers to an OS file */
-#define SIO_NOCLOSE     SmakeFlag(19)	/* Do not close on abort */
+#define SIO_PIPE	SmakeFlag(14)	/* Stream refers to an OS pipe */
-#define SIO_APPEND	SmakeFlag(20)	/* opened in append-mode */
+#define SIO_NOFEOF	SmakeFlag(15)	/* don't set SIO_FEOF flag */
-#define SIO_UPDATE	SmakeFlag(21)	/* opened in update-mode */
+#define SIO_TEXT	SmakeFlag(16)	/* text-mode operation */
-#define SIO_ISATTY	SmakeFlag(22)	/* Stream is a tty */
+#define SIO_FEOF2	SmakeFlag(17)	/* attempt to read past eof */
-#define SIO_CLOSING	SmakeFlag(23)	/* We are closing the stream */
+#define SIO_FEOF2ERR	SmakeFlag(18)	/* Sfpasteof() */
-#define SIO_TIMEOUT	SmakeFlag(24)	/* We had a timeout */
+#define SIO_NOCLOSE     SmakeFlag(19)	/* Do not close on abort */
-#define SIO_NOMUTEX	SmakeFlag(25)	/* Do not allow multi-thread access */
+#define SIO_APPEND	SmakeFlag(20)	/* opened in append-mode */
-#define SIO_ADVLOCK	SmakeFlag(26)	/* File locked with advisory lock */
+#define SIO_UPDATE	SmakeFlag(21)	/* opened in update-mode */
-#define SIO_WARN	SmakeFlag(27)	/* Pending warning */
+#define SIO_ISATTY	SmakeFlag(22)	/* Stream is a tty */
-#define SIO_CLEARERR	SmakeFlag(28)	/* Clear error after reporting */
+#define SIO_CLOSING	SmakeFlag(23)	/* We are closing the stream */
-#define SIO_REPXML	SmakeFlag(29)	/* Bad char --> XML entity */
+#define SIO_TIMEOUT	SmakeFlag(24)	/* We had a timeout */
-#define SIO_REPPL	SmakeFlag(30)	/* Bad char --> Prolog \hex\ */
+#define SIO_NOMUTEX	SmakeFlag(25)	/* Do not allow multi-thread access */
-#define SIO_BOM		SmakeFlag(31)	/* BOM was detected/written */
+#define SIO_ADVLOCK	SmakeFlag(26)	/* File locked with advisory lock */
-
+#define SIO_WARN	SmakeFlag(27)	/* Pending warning */
-#define	SIO_SEEK_SET	0	/* From beginning of file.  */
+#define SIO_CLEARERR	SmakeFlag(28)	/* Clear error after reporting */
-#define	SIO_SEEK_CUR	1	/* From current position.  */
+#define SIO_REPXML	SmakeFlag(29)	/* Bad char --> XML entity */
-#define	SIO_SEEK_END	2	/* From end of file.  */
+#define SIO_REPPL	SmakeFlag(30)	/* Bad char --> Prolog \hex\ */
-
+#define SIO_BOM		SmakeFlag(31)	/* BOM was detected/written */
-PL_EXPORT(IOSTREAM *)	S__getiob(void);	/* get DLL's __iob[] address */
+
-
+#define	SIO_SEEK_SET	0	/* From beginning of file.  */
-PL_EXPORT_DATA(IOFUNCTIONS)  Sfilefunctions;	/* OS file functions */
+#define	SIO_SEEK_CUR	1	/* From current position.  */
-PL_EXPORT_DATA(int)	     Slinesize;		/* Sgets() linesize */
+#define	SIO_SEEK_END	2	/* From end of file.  */
-#if (defined(__CYGWIN__) || defined(__MINGW32__)) && !defined(PL_KERNEL)
+
-#define S__iob S__getiob()
+PL_EXPORT(IOSTREAM *)	S__getiob(void);	/* get DLL's __iob[] address */
-#else
+
-PL_EXPORT_DATA(IOSTREAM)    S__iob[3];		/* Libs standard streams */
+PL_EXPORT_DATA(IOFUNCTIONS)  Sfilefunctions;	/* OS file functions */
-#endif
+PL_EXPORT_DATA(int)	     Slinesize;		/* Sgets() linesize */
-
+#if (defined(__CYGWIN__) || defined(__MINGW32__)) && !defined(PL_KERNEL)
-#define Sinput  (&S__iob[0])		/* Stream Sinput */
+#define S__iob S__getiob()
-#define Soutput (&S__iob[1])		/* Stream Soutput */
+#else
-#define Serror  (&S__iob[2])		/* Stream Serror */
+PL_EXPORT_DATA(IOSTREAM)    S__iob[3];		/* Libs standard streams */
-
+#endif
-#define Sgetchar()	Sgetc(Sinput)
+
-#define Sputchar(c)	Sputc((c), Soutput)
+#define Sinput  (&S__iob[0])		/* Stream Sinput */
-
+#define Soutput (&S__iob[1])		/* Stream Soutput */
-#define S__checkpasteeof(s,c) \
+#define Serror  (&S__iob[2])		/* Stream Serror */
-	if ( (c)==-1 && (s)->flags & (SIO_FEOF|SIO_FERR) ) \
+
-	  ((s)->flags |= SIO_FEOF2)
+#define Sgetchar()	Sgetc(Sinput)
-#define S__updatefilepos_getc(s, c) \
+#define Sputchar(c)	Sputc((c), Soutput)
-	((s)->position ? S__fupdatefilepos_getc((s), (c)) \
+
-		       : S__fcheckpasteeof((s), (c)))
+#define S__checkpasteeof(s,c) \
-
+	if ( (c)==-1 && (s)->flags & (SIO_FEOF|SIO_FERR) ) \
-#define Snpgetc(s) ((s)->bufp < (s)->limitp ? (int)(*(s)->bufp++)&0xff \
+	  ((s)->flags |= SIO_FEOF2)
-					    : S__fillbuf(s))
+#define S__updatefilepos_getc(s, c) \
-#define Sgetc(s) S__updatefilepos_getc((s), Snpgetc(s))
+	((s)->position ? S__fupdatefilepos_getc((s), (c)) \
-
+		       : S__fcheckpasteeof((s), (c)))
-PL_EXPORT(int)		Speekcode(IOSTREAM *s);
+
-
+#define Snpgetc(s) ((s)->bufp < (s)->limitp ? (int)(*(s)->bufp++)&0xff \
-/* Control-operations */
+					    : S__fillbuf(s))
-#define SIO_GETSIZE	(1)		/* get size of underlying object */
+#define Sgetc(s) S__updatefilepos_getc((s), Snpgetc(s))
-#define SIO_GETFILENO	(2)		/* get underlying file (if any) */
+
-#define SIO_SETENCODING	(3)		/* modify encoding of stream */
+PL_EXPORT(int)		Speekcode(IOSTREAM *s);
-#define SIO_FLUSHOUTPUT	(4)		/* flush output */
+
-#define SIO_LASTERROR	(5)		/* string holding last error */
+/* Control-operations */
-#ifdef __WINDOWS__
+#define SIO_GETSIZE	(1)		/* get size of underlying object */
-#define SIO_GETWINSOCK  (6)             /* get underlying SOCKET object */
+#define SIO_GETFILENO	(2)		/* get underlying file (if any) */
-#endif
+#define SIO_SETENCODING	(3)		/* modify encoding of stream */
-
+#define SIO_FLUSHOUTPUT	(4)		/* flush output */
-/* Sread_pending() */
+#define SIO_LASTERROR	(5)		/* string holding last error */
-#define SIO_RP_BLOCK 0x1		/* wait for new input */
+#ifdef __WINDOWS__
-
+#define SIO_GETWINSOCK  (6)             /* get underlying SOCKET object */
-#if IOSTREAM_REPLACES_STDIO
+#endif
-
+
-#undef FILE
+/* Sread_pending() */
-#undef stdin
+#define SIO_RP_BLOCK 0x1		/* wait for new input */
-#undef stdout
+
-#undef stderr
+#if IOSTREAM_REPLACES_STDIO
-#undef putc
+
-#undef getc
+#undef FILE
-#undef putchar
+#undef stdin
-#undef getchar
+#undef stdout
-#undef feof
+#undef stderr
-#undef ferror
+#undef putc
-#undef fileno
+#undef getc
-#undef clearerr
+#undef putchar
-
+#undef getchar
-#define FILE		IOSTREAM
+#undef feof
-#define stdin		Sinput
+#undef ferror
-#define stdout		Soutput
+#undef fileno
-#define stderr		Serror
+#undef clearerr
-
+
-#define	putc		Sputc
+#define FILE		IOSTREAM
-#define	getc		Sgetc
+#define stdin		Sinput
-#define	fputc		Sputc
+#define stdout		Soutput
-#define	fgetc		Sgetc
+#define stderr		Serror
-#define getw		Sgetw
+
-#define putw		Sputw
+#define	putc		Sputc
-#define fread		Sfread
+#define	getc		Sgetc
-#define fwrite		Sfwrite
+#define	fputc		Sputc
-#define	ungetc		Sungetc
+#define	fgetc		Sgetc
-#define putchar		Sputchar
+#define getw		Sgetw
-#define getchar		Sgetchar
+#define putw		Sputw
-#define feof		Sfeof
+#define fread		Sfread
-#define ferror		Sferror
+#define fwrite		Sfwrite
-#define clearerr	Sclearerr
+#define	ungetc		Sungetc
-#define	fflush		Sflush
+#define putchar		Sputchar
-#define	fseek		Sseek
+#define getchar		Sgetchar
-#define	ftell		Stell
+#define feof		Sfeof
-#define	fclose		Sclose
+#define ferror		Sferror
-#define fgets		Sfgets
+#define clearerr	Sclearerr
-#define gets		Sgets
+#define	fflush		Sflush
-#define	fputs		Sfputs
+#define	fseek		Sseek
-#define	puts		Sputs
+#define	ftell		Stell
-#define	fprintf		Sfprintf
+#define	fclose		Sclose
-#define	printf		Sprintf
+#define fgets		Sfgets
-#define	vprintf		Svprintf
+#define gets		Sgets
-#define	vfprintf	Svfprintf
+#define	fputs		Sfputs
-#define	sprintf		Ssprintf
+#define	puts		Sputs
-#define	vsprintf	Svsprintf
+#define	fprintf		Sfprintf
-#define fopen		Sopen_file
+#define	printf		Sprintf
-#define fdopen		Sfdopen
+#define	vprintf		Svprintf
-#define	fileno		Sfileno
+#define	vfprintf	Svfprintf
-#define popen		Sopen_pipe
+#define	sprintf		Ssprintf
-
+#define	vsprintf	Svsprintf
-#endif /*IOSTREAM_REPLACES_STDIO*/
+#define fopen		Sopen_file
-
+#define fdopen		Sfdopen
-		 /*******************************
+#define	fileno		Sfileno
-		 *	    PROTOTYPES		*
+#define popen		Sopen_pipe
-		 *******************************/
+
-
+#endif /*IOSTREAM_REPLACES_STDIO*/
-PL_EXPORT(void)		SinitStreams(void);
+
-PL_EXPORT(void)		Scleanup(void);
+		 /*******************************
-PL_EXPORT(void)		Sreset(void);
+		 *	    PROTOTYPES		*
-PL_EXPORT(int)		S__fupdatefilepos_getc(IOSTREAM *s, int c);
+		 *******************************/
-PL_EXPORT(int)		S__fcheckpasteeof(IOSTREAM *s, int c);
+
-PL_EXPORT(int)		S__fillbuf(IOSTREAM *s);
+PL_EXPORT(void)		SinitStreams(void);
-PL_EXPORT(int)		Sunit_size(IOSTREAM *s);
+PL_EXPORT(void)		Scleanup(void);
-					/* byte I/O */
+PL_EXPORT(void)		Sreset(void);
-PL_EXPORT(int)		Sputc(int c, IOSTREAM *s);
+PL_EXPORT(int)		S__fupdatefilepos_getc(IOSTREAM *s, int c);
-PL_EXPORT(int)		Sfgetc(IOSTREAM *s);
+PL_EXPORT(int)		S__fcheckpasteeof(IOSTREAM *s, int c);
-PL_EXPORT(int)		Sungetc(int c, IOSTREAM *s);
+PL_EXPORT(int)		S__fillbuf(IOSTREAM *s);
-					/* multibyte I/O */
+PL_EXPORT(int)		Sunit_size(IOSTREAM *s);
-PL_EXPORT(int)		Scanrepresent(int c, IOSTREAM *s);
+					/* byte I/O */
-PL_EXPORT(int)		Sputcode(int c, IOSTREAM *s);
+PL_EXPORT(int)		Sputc(int c, IOSTREAM *s);
-PL_EXPORT(int)		Sgetcode(IOSTREAM *s);
+PL_EXPORT(int)		Sfgetc(IOSTREAM *s);
-PL_EXPORT(int)		Sungetcode(int c, IOSTREAM *s);
+PL_EXPORT(int)		Sungetc(int c, IOSTREAM *s);
-					/* word I/O */
+					/* multibyte I/O */
-PL_EXPORT(int)		Sputw(int w, IOSTREAM *s);
+PL_EXPORT(int)		Scanrepresent(int c, IOSTREAM *s);
-PL_EXPORT(int)		Sgetw(IOSTREAM *s);
+PL_EXPORT(int)		Sputcode(int c, IOSTREAM *s);
-PL_EXPORT(size_t)	Sfread(void *data, size_t size, size_t elems,
+PL_EXPORT(int)		Sgetcode(IOSTREAM *s);
-			       IOSTREAM *s);
+PL_EXPORT(int)		Sungetcode(int c, IOSTREAM *s);
-PL_EXPORT(size_t)	Sfwrite(const void *data, size_t size, size_t elems,
+					/* word I/O */
-				IOSTREAM *s);
+PL_EXPORT(int)		Sputw(int w, IOSTREAM *s);
-PL_EXPORT(int)		Sfeof(IOSTREAM *s);
+PL_EXPORT(int)		Sgetw(IOSTREAM *s);
-PL_EXPORT(int)		Sfpasteof(IOSTREAM *s);
+PL_EXPORT(size_t)	Sfread(void *data, size_t size, size_t elems,
-PL_EXPORT(int)		Sferror(IOSTREAM *s);
+			       IOSTREAM *s);
-PL_EXPORT(void)		Sclearerr(IOSTREAM *s);
+PL_EXPORT(size_t)	Sfwrite(const void *data, size_t size, size_t elems,
-PL_EXPORT(void)		Sseterr(IOSTREAM *s, int which, const char *message);
+				IOSTREAM *s);
-#ifdef _FLI_H_INCLUDED
+PL_EXPORT(int)		Sfeof(IOSTREAM *s);
-PL_EXPORT(void)		Sset_exception(IOSTREAM *s, term_t ex);
+PL_EXPORT(int)		Sfpasteof(IOSTREAM *s);
-#else
+PL_EXPORT(int)		Sferror(IOSTREAM *s);
-PL_EXPORT(void)		Sset_exception(IOSTREAM *s, intptr_t ex);
+PL_EXPORT(void)		Sclearerr(IOSTREAM *s);
-#endif
+PL_EXPORT(void)		Sseterr(IOSTREAM *s, int which, const char *message);
-PL_EXPORT(int)		Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
+PL_EXPORT(void)		Sset_exception(IOSTREAM *s, term_t ex);
-PL_EXPORT(int)		Sflush(IOSTREAM *s);
+PL_EXPORT(int)		Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
-PL_EXPORT(long)		Ssize(IOSTREAM *s);
+PL_EXPORT(int)		Sflush(IOSTREAM *s);
-PL_EXPORT(int)		Sseek(IOSTREAM *s, long pos, int whence);
+PL_EXPORT(int64_t)		Ssize(IOSTREAM *s);
-PL_EXPORT(long)		Stell(IOSTREAM *s);
+PL_EXPORT(int)		Sseek(IOSTREAM *s, long pos, int whence);
-PL_EXPORT(int)		Sclose(IOSTREAM *s);
+PL_EXPORT(long)		Stell(IOSTREAM *s);
-PL_EXPORT(char *)	Sfgets(char *buf, int n, IOSTREAM *s);
+PL_EXPORT(int)		Sclose(IOSTREAM *s);
-PL_EXPORT(char *)	Sgets(char *buf);
+PL_EXPORT(char *)	Sfgets(char *buf, int n, IOSTREAM *s);
-PL_EXPORT(ssize_t)	Sread_pending(IOSTREAM *s,
+PL_EXPORT(char *)	Sgets(char *buf);
-				      char *buf, size_t limit, int flags);
+PL_EXPORT(ssize_t)	Sread_pending(IOSTREAM *s,
-PL_EXPORT(int)		Sfputs(const char *q, IOSTREAM *s);
+				      char *buf, size_t limit, int flags);
-PL_EXPORT(int)		Sputs(const char *q);
+PL_EXPORT(int)		Sfputs(const char *q, IOSTREAM *s);
-PL_EXPORT(int)		Sfprintf(IOSTREAM *s, const char *fm, ...);
+PL_EXPORT(int)		Sputs(const char *q);
-PL_EXPORT(int)		Sprintf(const char *fm, ...);
+PL_EXPORT(int)		Sfprintf(IOSTREAM *s, const char *fm, ...);
-PL_EXPORT(int)		Svprintf(const char *fm, va_list args);
+PL_EXPORT(int)		Sprintf(const char *fm, ...);
-PL_EXPORT(int)		Svfprintf(IOSTREAM *s, const char *fm, va_list args);
+PL_EXPORT(int)		Svprintf(const char *fm, va_list args);
-PL_EXPORT(int)		Ssprintf(char *buf, const char *fm, ...);
+PL_EXPORT(int)		Svfprintf(IOSTREAM *s, const char *fm, va_list args);
-PL_EXPORT(int)		Svsprintf(char *buf, const char *fm, va_list args);
+PL_EXPORT(int)		Ssprintf(char *buf, const char *fm, ...);
-PL_EXPORT(int)		Svdprintf(const char *fm, va_list args);
+PL_EXPORT(int)		Svsprintf(char *buf, const char *fm, va_list args);
-PL_EXPORT(int)		Sdprintf(const char *fm, ...);
+PL_EXPORT(int)		Svdprintf(const char *fm, va_list args);
-PL_EXPORT(int)		Slock(IOSTREAM *s);
+PL_EXPORT(int)		Sdprintf(const char *fm, ...);
-PL_EXPORT(int)		StryLock(IOSTREAM *s);
+PL_EXPORT(int)		Slock(IOSTREAM *s);
-PL_EXPORT(int)		Sunlock(IOSTREAM *s);
+PL_EXPORT(int)		StryLock(IOSTREAM *s);
-PL_EXPORT(IOSTREAM *)	Snew(void *handle, int flags, IOFUNCTIONS *functions);
+PL_EXPORT(int)		Sunlock(IOSTREAM *s);
-PL_EXPORT(IOSTREAM *)	Sopen_file(const char *path, const char *how);
+PL_EXPORT(IOSTREAM *)	Snew(void *handle, int flags, IOFUNCTIONS *functions);
-PL_EXPORT(IOSTREAM *)	Sfdopen(int fd, const char *type);
+PL_EXPORT(IOSTREAM *)	Sopen_file(const char *path, const char *how);
-PL_EXPORT(int)	   	Sfileno(IOSTREAM *s);
+PL_EXPORT(IOSTREAM *)	Sfdopen(int fd, const char *type);
-PL_EXPORT(IOSTREAM *)	Sopen_pipe(const char *command, const char *type);
+PL_EXPORT(int)	   	Sfileno(IOSTREAM *s);
-PL_EXPORT(IOSTREAM *)	Sopenmem(char **buffer, size_t *sizep, const char *mode);
+PL_EXPORT(IOSTREAM *)	Sopen_pipe(const char *command, const char *type);
-PL_EXPORT(IOSTREAM *)	Sopen_string(IOSTREAM *s, char *buf, size_t sz, const char *m);
+PL_EXPORT(IOSTREAM *)	Sopenmem(char **buffer, size_t *sizep, const char *mode);
-PL_EXPORT(int)		Sclosehook(void (*hook)(IOSTREAM *s));
+PL_EXPORT(IOSTREAM *)	Sopen_string(IOSTREAM *s, char *buf, size_t sz, const char *m);
-PL_EXPORT(void)		Sfree(void *ptr);
+PL_EXPORT(int)		Sclosehook(void (*hook)(IOSTREAM *s));
-PL_EXPORT(int)		Sset_filter(IOSTREAM *parent, IOSTREAM *filter);
+PL_EXPORT(void)		Sfree(void *ptr);
-PL_EXPORT(void)		Ssetbuffer(IOSTREAM *s, char *buf, size_t size);
+PL_EXPORT(int)		Sset_filter(IOSTREAM *parent, IOSTREAM *filter);
-
+PL_EXPORT(void)		Ssetbuffer(IOSTREAM *s, char *buf, size_t size);
-PL_EXPORT(int64_t)	Stell64(IOSTREAM *s);
+
-PL_EXPORT(int)		Sseek64(IOSTREAM *s, int64_t pos, int whence);
+PL_EXPORT(int64_t)	Stell64(IOSTREAM *s);
-
+PL_EXPORT(int)		Sseek64(IOSTREAM *s, int64_t pos, int whence);
-PL_EXPORT(int)		ScheckBOM(IOSTREAM *s);
+
-PL_EXPORT(int)		SwriteBOM(IOSTREAM *s);
+#ifdef __WINDOWS__
-PL_EXPORT(ssize_t)	Sread_user(void *handle, char *buf, size_t size);
+#if defined(_WINSOCKAPI_) || defined(NEEDS_SWINSOCK)
-
+PL_EXPORT(SOCKET)	Swinsock(IOSTREAM *s);
-#ifdef __cplusplus
+#endif
-}
+#endif
-#endif
+
-
+PL_EXPORT(int)		ScheckBOM(IOSTREAM *s);
-#endif /*_PL_STREAM_H*/
+PL_EXPORT(int)		SwriteBOM(IOSTREAM *s);
+PL_EXPORT(ssize_t)	Sread_user(void *handle, char *buf, size_t size);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /*_PL_STREAM_H*/

os/pl-buffer.c

@@ -28,6 +28,7 @@ int
 growBuffer(Buffer b, size_t minfree)
 { size_t osz = b->max - b->base, sz = osz;
   size_t top = b->top - b->base;
+  char *new;
 
   if ( b->max - b->top >= (int)minfree )
     return TRUE;
@@ -37,20 +38,17 @@ growBuffer(Buffer b, size_t minfree)
   while( top + minfree > sz )
     sz *= 2;
 
-  if ( b->base != b->static_buffer )
+  if ( b->base == b->static_buffer )
-  { b->base = realloc(b->base, sz);
+  { if ( !(new = malloc(sz)) )
-    if ( !b->base )
-      return FALSE;
-  } else			/* from static buffer */
-  { char *new;
-
-    if ( !(new = malloc(sz)) )
       return FALSE;
 
     memcpy(new, b->static_buffer, osz);
-    b->base = new;
+  } else
+  { if ( !(new = realloc(b->base, sz)) )
+      return FALSE;
   }
 
+  b->base = new;
   b->top = b->base + top;
   b->max = b->base + sz;
 
@@ -62,7 +60,7 @@ growBuffer(Buffer b, size_t minfree)
 		 *	    BUFFER RING		*
 		 *******************************/
 
-#define discardable_buffer 	(LD->fli._discardable_buffer)
+#define discardable_buffer	(LD->fli._discardable_buffer)
 #define buffer_ring		(LD->fli._buffer_ring)
 #define current_buffer_id	(LD->fli._current_buffer_id)
 

os/pl-buffer.h

@@ -49,7 +49,7 @@ int	growBuffer(Buffer b, size_t minfree);
 	  { if ( !growBuffer((Buffer)b, sizeof(type)) ) \
 	      outOfCore(); \
 	  } \
- 	  *((type *)(b)->top) = obj; \
+	  *((type *)(b)->top) = obj; \
           (b)->top += sizeof(type); \
 	} while(0)
 
@@ -68,6 +68,24 @@ int	growBuffer(Buffer b, size_t minfree);
 	  (b)->top = (char *)_d; \
 	} while(0)
 
+#define allocFromBuffer(b, bytes) \
+	f__allocFromBuffer((Buffer)(b), (bytes))
+
+static inline void*
+f__allocFromBuffer(Buffer b, size_t bytes)
+{ if ( b->top + bytes <= b->max ||
+       growBuffer(b, bytes) )
+  { void *top = b->top;
+
+    b->top += bytes;
+
+    return top;
+  }
+
+  return NULL;
+}
+
+
 #define baseBuffer(b, type)	 ((type *) (b)->base)
 #define topBuffer(b, type)       ((type *) (b)->top)
 #define inBuffer(b, addr)        ((char *) (addr) >= (b)->base && \
@@ -83,6 +101,8 @@ int	growBuffer(Buffer b, size_t minfree);
 				  sizeof((b)->static_buffer))
 #define emptyBuffer(b)           ((b)->top  = (b)->base)
 #define isEmptyBuffer(b)         ((b)->top == (b)->base)
+#define popBuffer(b,type) \
+	((b)->top -= sizeof(type), *(type*)(b)->top)
 
 #define discardBuffer(b) \
 	do \
@@ -99,6 +119,6 @@ int	growBuffer(Buffer b, size_t minfree);
 
 COMMON(Buffer)		findBuffer(int flags);
 COMMON(int)		unfindBuffer(int flags);
-COMMON(char *) 		buffer_string(const char *s, int flags);
+COMMON(char *)		buffer_string(const char *s, int flags);
 
 #endif /*BUFFER_H_INCLUDED*/

os/pl-cstack.c

@@ -89,15 +89,49 @@ get_trace_store(void)
 }
 
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+next_btrace_id() produces the  id  for  the   next  backtrace  and  sets
+bt->current to the subsequent id. Although bt is thread-local, it may be
+called from a signal  handler  or   (Windows)  exception.  We cannot use
+locking because the mutex functions are not   async  signal safe. So, we
+use atomic instructions if possible. Otherwise, we ensure consistency of
+the datastructures, but we may overwrite an older stack trace.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+static int
+next_btrace_id(btrace *bt)
+{ int current;
+#ifdef COMPARE_AND_SWAP
+  int next;
+
+  do
+  { current = bt->current;
+    next = current+1;
+    if ( next == SAVE_TRACES )
+      next = 0;
+  } while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
+#else
+  current = bt->current++ % SAVE_TRACES;
+
+  if ( bt->current >= SAVE_TRACES )
+    bt->current %= SAVE_TRACES;
+#endif
+
+  return current;
+}
+
+
 void
 save_backtrace(const char *why)
 { btrace *bt = get_trace_store();
 
   if ( bt )
-  { btrace_stack *s = &bt->dumps[bt->current];
+  { btrace_stack *s;
     unw_cursor_t cursor; unw_context_t uc;
     int depth;
+    int current = next_btrace_id(bt);
 
+    s = &bt->dumps[current];
     unw_getcontext(&uc);
     unw_init_local(&cursor, &uc);
     for(depth=0; unw_step(&cursor) > 0 && depth < MAX_DEPTH; depth++)
@@ -107,9 +141,6 @@ save_backtrace(const char *why)
     }
     s->name = why;
     s->depth = depth;
-
-    if ( ++bt->current == SAVE_TRACES )
-      bt->current = 0;
   }
 
 }
@@ -228,6 +259,33 @@ get_trace_store(void)
 }
 
 
+/* Copy of same function above.  Relies on a different btrace structure.
+   Ideally, this should be shared :-(
+*/
+
+static int
+next_btrace_id(btrace *bt)
+{ int current;
+#ifdef COMPARE_AND_SWAP
+  int next;
+
+  do
+  { current = bt->current;
+    next = current+1;
+    if ( next == SAVE_TRACES )
+      next = 0;
+  } while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
+#else
+  current = bt->current++ % SAVE_TRACES;
+
+  if ( bt->current >= SAVE_TRACES )
+    bt->current %= SAVE_TRACES;
+#endif
+
+  return current;
+}
+
+
 void
 save_backtrace(const char *why)
 { btrace *bt = get_trace_store();
@@ -235,15 +293,14 @@ save_backtrace(const char *why)
   if ( bt )
   { void *array[100];
     size_t frames;
+    int current = next_btrace_id(bt);
 
     frames = backtrace(array, sizeof(array)/sizeof(void *));
-    bt->sizes[bt->current] = frames;
+    bt->sizes[current] = frames;
-    if ( bt->symbols[bt->current] )
+    if ( bt->symbols[current] )
-      free(bt->symbols[bt->current]);
+      free(bt->symbols[current]);
-    bt->symbols[bt->current] = backtrace_symbols(array, frames);
+    bt->symbols[current] = backtrace_symbols(array, frames);
-    bt->why[bt->current] = why;
+    bt->why[current] = why;
-    if ( ++bt->current == SAVE_TRACES )
-      bt->current = 0;
   }
 }
 
@@ -358,6 +415,9 @@ initBackTrace(void)
 */
 #define MAX_MODULE_NAME_LENGTH 64
 
+#define LOCK()   PL_LOCK(L_CSTACK)
+#define UNLOCK() PL_UNLOCK(L_CSTACK)
+
 typedef struct
 { char name[MAX_FUNCTION_NAME_LENGTH];	/* function called */
   DWORD64 offset;			/* offset in function */
@@ -397,6 +457,32 @@ get_trace_store(void)
   return LD->btrace_store;
 }
 
+/* Copy of same function above.  Relies on a different btrace structure.
+   Ideally, this should be shared :-(
+*/
+
+static int
+next_btrace_id(btrace *bt)
+{ int current;
+#ifdef COMPARE_AND_SWAP
+  int next;
+
+  do
+  { current = bt->current;
+    next = current+1;
+    if ( next == SAVE_TRACES )
+      next = 0;
+  } while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
+#else
+  current = bt->current++ % SAVE_TRACES;
+
+  if ( bt->current >= SAVE_TRACES )
+    bt->current %= SAVE_TRACES;
+#endif
+
+  return current;
+}
+
 int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
 { STACKFRAME64 frame;
   CONTEXT context;
@@ -406,7 +492,6 @@ int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
   char symbolScratch[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LEN];
   SYMBOL_INFO* symbol = (SYMBOL_INFO*)&symbolScratch;
   IMAGEHLP_MODULE64 moduleInfo;
-  EXCEPTION_POINTERS *pExp = NULL;
   DWORD64 offset;
   DWORD imageType;
   int skip = 0;
@@ -529,11 +614,12 @@ void
 win_save_backtrace(const char *why, PEXCEPTION_POINTERS pExceptionInfo)
 { btrace *bt = get_trace_store();
   if ( bt )
-  { btrace_stack *s = &bt->dumps[bt->current];
+  { int current = next_btrace_id(bt);
+    btrace_stack *s = &bt->dumps[current];
+    LOCK();
     s->depth = backtrace(s, pExceptionInfo);
+    UNLOCK();
     s->name = why;
-    if ( ++bt->current == SAVE_TRACES )
-      bt->current = 0;
   }
 }
 

os/pl-ctype.c

@@ -471,7 +471,7 @@ init_tout(PL_chars_t *t, size_t len)
       { t->text.t = t->buf;
 	t->storage = PL_CHARS_LOCAL;
       } else
-      { t->text.t = PL_malloc(len+1);
+      { t->text.t = PL_malloc(len);
 	t->storage = PL_CHARS_MALLOC;
       }
       succeed;
@@ -480,7 +480,7 @@ init_tout(PL_chars_t *t, size_t len)
       { t->text.w = (pl_wchar_t*)t->buf;
 	t->storage = PL_CHARS_LOCAL;
       } else
-	{ t->text.w = PL_malloc((len+1)*sizeof(pl_wchar_t));
+      { t->text.w = PL_malloc(len*sizeof(pl_wchar_t));
 	t->storage = PL_CHARS_MALLOC;
       }
       succeed;

os/pl-file.h

@@ -0,0 +1,81 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 1985-2011, University of Amsterdam
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+#ifndef PL_FILE_H_INCLUDED
+#define PL_FILE_H_INCLUDED
+
+typedef enum
+{ ST_FALSE = -1,			/* Do not check stream types */
+  ST_LOOSE = 0,				/* Default: accept latin-1 for binary */
+  ST_TRUE  = 1				/* Strict checking */
+} st_check;
+
+/* pl-file.c */
+COMMON(void)		initIO(void);
+COMMON(void)		dieIO(void);
+COMMON(void)		closeFiles(int all);
+COMMON(int)		openFileDescriptors(unsigned char *buf, int size);
+COMMON(void)		protocol(const char *s, size_t n);
+COMMON(int)		getTextInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int)		getBinaryInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int)		getTextOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int)		getBinaryOutputStream__LD(term_t t, IOSTREAM **s ARG_LD);
+COMMON(int)	        reportStreamError(IOSTREAM *s);
+COMMON(int)		streamStatus(IOSTREAM *s);
+COMMON(atom_t)		fileNameStream(IOSTREAM *s);
+COMMON(int)		getSingleChar(IOSTREAM *s, int signals);
+COMMON(int)		readLine(IOSTREAM *in, IOSTREAM *out, char *buffer);
+COMMON(int)		LockStream(void);
+COMMON(int)		UnlockStream(void);
+COMMON(IOSTREAM *)	PL_current_input(void);
+COMMON(IOSTREAM *)	PL_current_output(void);
+COMMON(int)		pl_see(term_t f);
+COMMON(int)		pl_seen(void);
+COMMON(int)		seeString(const char *s);
+COMMON(int)		seeingString(void);
+COMMON(int)		seenString(void);
+COMMON(int)		tellString(char **s, size_t *size, IOENC enc);
+COMMON(int)		toldString(void);
+COMMON(void)		prompt1(atom_t prompt);
+COMMON(atom_t)		PrologPrompt(void);
+COMMON(int)		streamNo(term_t spec, int mode);
+COMMON(void)		release_stream_handle(term_t spec);
+COMMON(int)		unifyTime(term_t t, time_t time);
+#ifdef __WINDOWS__
+COMMON(word)		pl_make_fat_filemap(term_t dir);
+#endif
+COMMON(int)		PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
+COMMON(void)		pushOutputContext(void);
+COMMON(void)		popOutputContext(void);
+COMMON(IOENC)		atom_to_encoding(atom_t a);
+COMMON(atom_t)		encoding_to_atom(IOENC enc);
+COMMON(int)		setupOutputRedirect(term_t to,
+					    redir_context *ctx,
+					    int redir);
+COMMON(int)		closeOutputRedirect(redir_context *ctx);
+COMMON(void)		discardOutputRedirect(redir_context *ctx);
+COMMON(int)		push_input_context(atom_t type);
+COMMON(int)		pop_input_context(void);
+
+#endif /*PL_FILE_H_INCLUDED*/

os/pl-files.c

@@ -3,9 +3,10 @@
     Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        J.Wielemaker@uva.nl
+    E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2008, University of Amsterdam
+    Copyright (C): 1985-2011, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +20,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "pl-incl.h"
@@ -44,26 +45,89 @@
 General file operations and binding to Prolog
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+#ifdef __WINDOWS__
+static void
+set_posix_error(int win_error)
+{ int error = 0;
+
+  switch(win_error)
+  { case ERROR_ACCESS_DENIED:	  error = EACCES; break;
+    case ERROR_FILE_NOT_FOUND:    error = ENOENT; break;
+    case ERROR_SHARING_VIOLATION: error = EAGAIN; break;
+    case ERROR_ALREADY_EXISTS:    error = EEXIST; break;
+  }
+
+  errno = error;
+}
+#endif /*__WINDOWS__*/
+
+
 		 /*******************************
 		 *	      OS STUFF		*
 		 *******************************/
 
-/** time_t LastModifiedFile(const char *file)
+/** int LastModifiedFile(const char *file, double *t)
 
 Return the last modification time of file  as a POSIX timestamp. Returns
 (time_t)-1 on failure.
+
+Contains a 64-bit value representing the number of 100-nanosecond
+intervals since January 1, 1601 (UTC).
 */
 
+int
+LastModifiedFile(const char *name, double *tp)
+{
+#ifdef __WINDOWS__
+  HANDLE hFile;
+  wchar_t wfile[MAXPATHLEN];
 
-time_t
+#define nano * 0.000000001
-LastModifiedFile(const char *file)
+#define ntick 100.0
-{ char tmp[MAXPATHLEN];
+#define SEC_TO_UNIX_EPOCH 11644473600.0
+
+  if ( !_xos_os_filenameW(name, wfile, MAXPATHLEN) )
+    return FALSE;
+
+  if ( (hFile=CreateFileW(wfile,
+			  0,
+			  FILE_SHARE_DELETE|FILE_SHARE_READ|FILE_SHARE_WRITE,
+			  NULL,
+			  OPEN_EXISTING,
+			  FILE_FLAG_BACKUP_SEMANTICS,
+			  NULL)) != INVALID_HANDLE_VALUE )
+  { FILETIME wt;
+    int rc;
+
+    rc = GetFileTime(hFile, NULL, NULL, &wt);
+    CloseHandle(hFile);
+
+    if ( rc )
+    { double t;
+
+      t  = (double)wt.dwHighDateTime * (4294967296.0 * ntick nano);
+      t += (double)wt.dwLowDateTime  * (ntick nano);
+      t -= SEC_TO_UNIX_EPOCH;
+
+      *tp = t;
+
+      return TRUE;
+    }
+  }
+
+  set_posix_error(GetLastError());
+
+  return FALSE;
+#else
+  char tmp[MAXPATHLEN];
   statstruct buf;
 
-  if ( statfunc(OsPath(file, tmp), &buf) < 0 )
+  if ( statfunc(OsPath(name, tmp), &buf) < 0 )
-    return (time_t)-1;
+    return FALSE;
 
-  return buf.st_mtime;
+  *tp = (double)buf.st_mtime;
+  return TRUE;
+#endif
 }
 
 
@@ -349,13 +413,7 @@ MarkExecutable(const char *name)
 
 int
 unifyTime(term_t t, time_t time)
-{ 
+{ return PL_unify_time(t, time);
-#if __YAP_PROLOG__
-  /* maintain compatibility with old Prolog systems, and avoid losing precision unnecessarily */
-  return PL_unify_int64(t, (int64_t)time);
-#else
-  return PL_unify_float(t, (double)time);
-#endif
 }
 
 
@@ -433,9 +491,12 @@ get_file_name(term_t n, char **namep, char *tmp, int flags)
     return PL_error(NULL, 0, "file name contains a 0-code",
 		    ERR_DOMAIN, ATOM_file_name, n);
   }
+  if ( len+1 >= MAXPATHLEN )
+    return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
+		    ATOM_max_path_length);
 
   if ( truePrologFlag(PLFLAG_FILEVARS) )
-  { if ( !(name = ExpandOneFile(name, tmp)) )
+  { if ( !(name = expandVars(name, tmp, MAXPATHLEN)) )
       return FALSE;
   }
 
@@ -529,13 +590,13 @@ PRED_IMPL("time_file", 2, time_file, 0)
 { char *fn;
 
   if ( PL_get_file_name(A1, &fn, 0) )
-  { time_t time;
+  { double time;
 
-    if ( (time = LastModifiedFile(fn)) == (time_t)-1 )
+    if ( LastModifiedFile(fn, &time) )
-      return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION,
+      return PL_unify_float(A2, time);
-		      ATOM_time, ATOM_file, A1);
 
-    return unifyTime(A2, time);
+    return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION,
+		    ATOM_time, ATOM_file, A1);
   }
 
   return FALSE;
@@ -544,7 +605,8 @@ PRED_IMPL("time_file", 2, time_file, 0)
 
 static
 PRED_IMPL("size_file", 2, size_file, 0)
-{ char *n;
+{ PRED_LD
+  char *n;
 
   if ( PL_get_file_name(A1, &n, 0) )
   { int64_t size;
@@ -680,7 +742,7 @@ static
 PRED_IMPL("file_base_name", 2, file_base_name, 0)
 { char *n;
 
-  if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) )
+  if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
     return FALSE;
 
   return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n));
@@ -692,7 +754,7 @@ PRED_IMPL("file_directory_name", 2, file_directory_name, 0)
 { char *n;
   char tmp[MAXPATHLEN];
 
-  if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) )
+  if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) )
     return FALSE;
 
   return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n, tmp));
@@ -868,12 +930,13 @@ PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0)
 static
 PRED_IMPL("working_directory", 2, working_directory, 0)
 { PRED_LD
+  char buf[MAXPATHLEN];
   const char *wd;
 
   term_t old = A1;
   term_t new = A2;
 
-  if ( !(wd = PL_cwd()) )
+  if ( !(wd = PL_cwd(buf, sizeof(buf))) )
     return FALSE;
 
   if ( PL_unify_chars(old, PL_ATOM|REP_FN, -1, wd) )
@@ -966,8 +1029,8 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0)
     PL_fail;
   }
 
-  if ( PL_get_chars_ex(base, &b, CVT_ALL|BUF_RING|REP_FN) &&
+  if ( PL_get_chars(base, &b, CVT_ALL|BUF_RING|REP_FN|CVT_EXCEPTION) &&
-       PL_get_chars_ex(ext, &e, CVT_ALL|REP_FN) )
+       PL_get_chars(ext, &e, CVT_ALL|REP_FN|CVT_EXCEPTION) )
   { char *s;
 
     if ( e[0] == '.' )		/* +Base, +Extension, -full */
@@ -989,20 +1052,19 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0)
 
 static
 PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0)
-{
+{ PRED_LD
 
   term_t pl = A1;
   term_t os = A2;
 
 #ifdef O_XOS
-  PRED_LD
   wchar_t *wn;
 
   if ( !PL_is_variable(pl) )
   { char *n;
     wchar_t buf[MAXPATHLEN];
 
-    if ( PL_get_chars_ex(pl, &n, CVT_ALL|REP_UTF8) )
+    if ( PL_get_chars(pl, &n, CVT_ALL|REP_UTF8|CVT_EXCEPTION) )
     { if ( !_xos_os_filenameW(n, buf, MAXPATHLEN) )
 	return name_too_long();
 

os/pl-files.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifndef PL_FILES_H_INCLUDED
@@ -31,11 +31,11 @@
 #define ACCESS_WRITE	4
 
 COMMON(void)		initFiles(void);
-COMMON(time_t)	 	LastModifiedFile(const char *f);
+COMMON(int)		LastModifiedFile(const char *f, double *t);
-COMMON(int) 		RemoveFile(const char *path);
+COMMON(int)		RemoveFile(const char *path);
 COMMON(int)		AccessFile(const char *path, int mode);
-COMMON(char *) 		DeRefLink(const char *link, char *buf);
+COMMON(char *)		DeRefLink(const char *link, char *buf);
-COMMON(int) 		ExistsFile(const char *path);
+COMMON(int)		ExistsFile(const char *path);
-COMMON(int) 		ExistsDirectory(const char *path);
+COMMON(int)		ExistsDirectory(const char *path);
 
 #endif /*PL_FILES_H_INCLUDED*/

os/pl-fmt.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -53,9 +53,9 @@ typedef struct
   struct rubber rub[MAXRUBBER];
 } format_state;
 
-#define BUFSIZE 	1024
+#define BUFSIZE		1024
-#define DEFAULT 	(-1)
+#define DEFAULT		(-1)
-#define SHIFT   	{ argc--; argv++; }
+#define SHIFT		{ argc--; argv++; }
 #define NEED_ARG	{ if ( argc <= 0 ) \
 			  { FMT_ERROR("not enough arguments"); \
 			  } \
@@ -189,7 +189,8 @@ outtext(format_state *state, PL_chars_t *txt)
 #define format_predicates (GD->format.predicates)
 
 static int	update_column(int, Char);
-static bool	do_format(IOSTREAM *fd, PL_chars_t *fmt, int ac, term_t av);
+static bool	do_format(IOSTREAM *fd, PL_chars_t *fmt,
+			  int ac, term_t av, Module m);
 static void	distribute_rubber(struct rubber *, int, int);
 static int	emit_rubber(format_state *state);
 
@@ -272,7 +273,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
 
 
 static word
-format_impl(IOSTREAM *out, term_t format, term_t Args)
+format_impl(IOSTREAM *out, term_t format, term_t Args, Module m)
 { GET_LD
   term_t argv;
   int argc = 0;
@@ -307,7 +308,7 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
       break;
   }
 
-  rval = do_format(out, &fmt, argc, argv);
+  rval = do_format(out, &fmt, argc, argv, m);
   PL_free_text(&fmt);
   if ( !endCritical )
     return FALSE;
@@ -318,31 +319,20 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
 
 word
 pl_format3(term_t out, term_t format, term_t args)
-{ redir_context ctx;
+{ GET_LD
+  redir_context ctx;
   word rc;
-#if __YAP_PROLOG__
+  Module m = NULL;
-  /*
+  term_t list = PL_new_term_ref();
-    YAP allows the last argument to format to be of the form
-    module:[]
-  */
-  YAP_Term mod;
-#endif    
 
-  if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) ) {
+  if ( !PL_strip_module(args, &m, list) )
-#if __YAP_PROLOG__
+    return FALSE;
-    /* module processing */
+
-    {
+  if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) )
-      args = Yap_fetch_module_for_format(args, &mod);
+  { if ( (rc = format_impl(ctx.stream, format, list, m)) )
-    }
+      rc = closeOutputRedirect(&ctx);
-#endif    
+    else
-    { if ( (rc = format_impl(ctx.stream, format, args)) )
-	rc = closeOutputRedirect(&ctx);
-      else
       discardOutputRedirect(&ctx);
-    }
-#if __YAP_PROLOG__
-    YAP_SetCurrentModule(mod);
-#endif    
   }
 
   return rc;
@@ -374,7 +364,7 @@ get_chr_from_text(const PL_chars_t *t, int index)
 		********************************/
 
 static bool
-do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
+do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv, Module m)
 { GET_LD
   format_state state;			/* complete state */
   int tab_stop = 0;			/* padded tab stop */
@@ -443,7 +433,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 	    char buf[BUFSIZE];
 	    char *str = buf;
 	    size_t bufsize = BUFSIZE;
-	    unsigned int i;
+	    int i;
 
 	    PL_predicate_info(proc, NULL, &arity, NULL);
 	    av = PL_new_term_refs(arity);
@@ -481,7 +471,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  if ( !PL_get_text(argv, &txt, CVT_ATOMIC) )
 		    FMT_ARG("a", argv);
 		  SHIFT;
-		  outtext(&state, &txt);
+		  rc = outtext(&state, &txt);
+                  if ( !rc )
+		    goto out;
 		  here++;
 		  break;
 		}
@@ -494,7 +486,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 
 		    SHIFT;
 		    while(times-- > 0)
-		    { outchr(&state, chr);
+		    { rc = outchr(&state, chr);
+		      if ( !rc )
+		        goto out;
 		    }
 		  } else
 		    FMT_ARG("c", argv);
@@ -508,7 +502,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 	      case 'G':			/* shortest of 'f' and 'E' */
 		{ number n;
 		  union {
-		    tmp_buffer b;
+		  tmp_buffer b;
 		    buffer b1;
 		  } u;
 
@@ -525,8 +519,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  initBuffer(&u.b);
 		  formatFloat(c, arg, &n, &u.b1);
 		  clearNumber(&n);
-		  outstring0(&state, baseBuffer(&u.b, char));
+		  rc = outstring0(&state, baseBuffer(&u.b, char));
 		  discardBuffer(&u.b);
+                  if ( !rc )
+		    goto out;
 		  here++;
 		  break;
 		}
@@ -564,8 +560,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		    formatNumber(FALSE, 0, arg, c == 'r', &i, (Buffer)&b);
 		  }
 		  clearNumber(&i);
-		  outstring0(&state, baseBuffer(&b, char));
+		  rc = outstring0(&state, baseBuffer(&b, char));
 		  discardBuffer(&b);
+		  if ( !rc )
+		    goto out;
 		  here++;
 		  break;
 		}
@@ -576,8 +574,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  if ( !PL_get_text(argv, &txt, CVT_LIST|CVT_STRING) &&
 		       !PL_get_text(argv, &txt, CVT_ATOM) ) /* SICStus compat */
 		    FMT_ARG("s", argv);
-		  outtext(&state, &txt);
+		  rc = outtext(&state, &txt);
 		  SHIFT;
+		  if ( !rc )
+		    goto out;
 		  here++;
 		  break;
 		}
@@ -610,8 +610,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 
 		    str = buf;
 		    tellString(&str, &bufsize, ENC_UTF8);
-		    (*f)(argv);
+		    rc = (*f)(argv);
 		    toldString();
+		    if ( !rc )
+		      goto out;
 		    oututf8(&state, str, bufsize);
 		    if ( str != buf )
 		      free(str);
@@ -632,8 +634,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 
 		      str = buf;
 		      tellString(&str, &bufsize, ENC_UTF8);
-		      (*f)(argv);
+		      rc = (*f)(argv);
 		      toldString();
+		      if ( !rc )
+		        goto out;
 		      oututf8(&state, str, bufsize);
 		      if ( str != buf )
 			free(str);
@@ -704,7 +708,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  { FMT_ERROR("not enough arguments");
 		  }
 		  tellString(&str, &bufsize, ENC_UTF8);
-		  rval = callProlog(NULL, argv, PL_Q_CATCH_EXCEPTION, &ex);
+		  rval = callProlog(m, argv, PL_Q_CATCH_EXCEPTION, &ex);
 		  toldString();
 		  oututf8(&state, str, bufsize);
 		  if ( str != buf )
@@ -724,7 +728,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  break;
 	        }
 	      case '~':			/* ~ */
-		{ outchr(&state, '~');
+		{ rc = outchr(&state, '~');
+		  if ( !rc )
+		    goto out;
 		  here++;
 		  break;
 		}
@@ -735,7 +741,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 		  if ( c == 'N' && state.column == 0 )
 		    arg--;
 		  while( arg-- > 0 )
-		    outchr(&state, '\n');
+                  { rc = outchr(&state, '\n');
+		    if ( !rc )
+		      goto out;
+                  }
 		  here++;
 		  break;
 		}
@@ -790,7 +799,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 	  break;			/* the '~' switch */
 	}
       default:
-	{ outchr(&state, c);
+	{ rc = outchr(&state, c);
+	  if ( !rc )
+	    goto out;
 	  here++;
 	  break;
 	}
@@ -1032,7 +1043,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
       while(written >= size)
       { size = written+1;
 
-	growBuffer(out, size);		/* reserve for -.e<null> */
+	if ( !growBuffer(out, size) )	/* reserve for -.e<null> */
+	  outOfCore();
 	written = gmp_snprintf(baseBuffer(out, char), size, tmp, mpf);
       }
       mpf_clear(mpf);
@@ -1053,7 +1065,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
       while(written >= size)
       { size = written+1;
 
-	growBuffer(out, size);
+	if ( !growBuffer(out, size) )
+	  outOfCore();
 	written = snprintf(baseBuffer(out, char), size, tmp, f->value.f);
       }
       out->top = out->base + written;

os/pl-glob.c

@@ -3,9 +3,10 @@
     Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        jan@swi.psy.uva.nl
+    E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2002, University of Amsterdam
+    Copyright (C): 1985-2011, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +20,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "pl-incl.h"
@@ -29,9 +30,9 @@
 #include <unistd.h>
 #endif
 
-#ifdef __WATCOMC__
+#ifdef O_XOS
-#include <direct.h>
+# include "windows/dirent.h"
-#else /*__WATCOMC__*/
+#else
 #if HAVE_DIRENT_H
 # include <dirent.h>
 #else
@@ -46,7 +47,7 @@
 #  include <ndir.h>
 # endif
 #endif
-#endif /*__WATCOMC__*/
+#endif /*O_XOS*/
 
 #ifdef HAVE_SYS_STAT_H
 #include <sys/stat.h>
@@ -326,8 +327,8 @@ PRED_IMPL("wildcard_match", 2, wildcard_match, 0)
 { char *p, *s;
   compiled_pattern buf;
 
-  if ( !PL_get_chars_ex(A1, &p, CVT_ALL) ||
+  if ( !PL_get_chars(A1, &p, CVT_ALL|CVT_EXCEPTION) ||
-       !PL_get_chars_ex(A2,  &s, CVT_ALL) )
+       !PL_get_chars(A2,  &s, CVT_ALL|CVT_EXCEPTION) )
     fail;
 
   if ( compilePattern(p, &buf) )
@@ -423,6 +424,7 @@ expand(const char *pattern, GlobInfo info)
   compiled_pattern cbuf;
   char prefix[MAXPATHLEN];		/* before first pattern */
   char patbuf[MAXPATHLEN];		/* pattern buffer */
+  size_t prefix_len;
   int end, dot;
 
   initBuffer(&info->files);
@@ -441,20 +443,25 @@ expand(const char *pattern, GlobInfo info)
       switch( (c=*s++) )
       { case EOS:
 	  if ( s > pat )		/* something left and expanded */
-	  { un_escape(prefix, pat, s);
+	  { size_t prefix_len;
+
+	    un_escape(prefix, pat, s);
+	    prefix_len = strlen(prefix);
 
 	    end = info->end;
 	    for( ; info->start < end; info->start++ )
 	    { char path[MAXPATHLEN];
-	      size_t plen;
+	      const char *entry = expand_entry(info, info->start);
+	      size_t plen = strlen(entry);
 
-	      strcpy(path, expand_entry(info, info->start));
+	      if ( plen+prefix_len+2 <= MAXPATHLEN )
-	      plen = strlen(path);
+	      { strcpy(path, entry);
-	      if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
+		if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
-		path[plen++] = '/';
+		  path[plen++] = '/';
-	      strcpy(&path[plen], prefix);
+		strcpy(&path[plen], prefix);
-	      if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
+		if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
-		add_path(path, info);
+		  add_path(path, info);
+	      }
 	    }
 	  }
 	  succeed;
@@ -489,8 +496,9 @@ expand(const char *pattern, GlobInfo info)
 */
     un_escape(prefix, pat, head);
     un_escape(patbuf, head, tail);
+    prefix_len = strlen(prefix);
 
-    if ( !compilePattern(patbuf, &cbuf) )		/* syntax error */
+    if ( !compilePattern(patbuf, &cbuf) )	/* syntax error */
       fail;
     dot = (patbuf[0] == '.');			/* do dots as well */
 
@@ -502,6 +510,10 @@ expand(const char *pattern, GlobInfo info)
       char path[MAXPATHLEN];
       char tmp[MAXPATHLEN];
       const char *current = expand_entry(info, info->start);
+      size_t clen = strlen(current);
+
+      if ( clen+prefix_len+1 > sizeof(path) )
+	continue;
 
       strcpy(path, current);
       strcat(path, prefix);
@@ -521,12 +533,11 @@ expand(const char *pattern, GlobInfo info)
 	       matchPattern(e->d_name, &cbuf) )
 	  { char newp[MAXPATHLEN];
 
-	    strcpy(newp, path);
+	    if ( plen+strlen(e->d_name)+1 < sizeof(newp) )
-	    strcpy(&newp[plen], e->d_name);
+	    { strcpy(newp, path);
-/*	    if ( !tail[0] || ExistsDirectory(newp) )
+	      strcpy(&newp[plen], e->d_name);
-	    Saves memory, but involves one more file-access
-*/
 	      add_path(newp, info);
+	    }
 	  }
 	}
 	closedir(d);
@@ -579,11 +590,11 @@ PRED_IMPL("expand_file_name", 2, expand_file_name, 0)
   term_t head = PL_new_term_ref();
   int i;
 
-  if ( !PL_get_chars_ex(A1, &s, CVT_ALL|REP_FN) )
+  if ( !PL_get_chars(A1, &s, CVT_ALL|REP_FN|CVT_EXCEPTION) )
     fail;
   if ( strlen(s) > sizeof(spec)-1 )
-    return PL_error(NULL, 0, "File name too intptr_t",
+    return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
-		    ERR_DOMAIN, ATOM_pattern, A1);
+		    ATOM_max_path_length);
 
   if ( !expandVars(s, spec, sizeof(spec)) )
     fail;

os/pl-mswchar.h

@@ -1,39 +0,0 @@
-/*  $Id$
-
-    Part of SWI-Prolog
-
-    Author:        Jan Wielemaker
-    E-mail:        wielemak@science.uva.nl
-    WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2005, University of Amsterdam
-
-    This library is free software; you can redistribute it and/or
-    modify it under the terms of the GNU Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2.1 of the License, or (at your option) any later version.
-
-    This library is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-*/
-
-#include <wchar.h>
-
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-See pl-mswchar.cpp for  the  motivation  for   this  nonsense.  Used  in
-pl-fli.c and pl-text.c.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-#if defined(__WINDOWS__) && !defined(__MINGW32__)
-
-#define wcrtomb(s, wc, ps)	ms_wcrtomb(s, wc, ps)
-#define mbrtowc(pwc, s, n, ps)	ms_mbrtowc(pwc, s, n, ps)
-
-extern size_t ms_wcrtomb(char *s, wchar_t wc, mbstate_t *ps);
-extern size_t ms_mbrtowc(wchar_t *pwc, const char *s, size_t n, mbstate_t *ps);
-#endif

os/pl-nt.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifdef __MINGW32__
@@ -27,8 +27,8 @@
 #endif
 
 #ifdef __WINDOWS__
-#define _WIN32_WINNT 0x0400
+#define WINVER 0x0501
-#if (_MSC_VER >= 1300) || defined(__MINGW32__)
+#if (_MSC_VER >= 1300) || __MINGW32__
 #include <winsock2.h>			/* Needed on VC8 */
 #include <windows.h>
 #else
@@ -36,16 +36,40 @@
 #include <winsock2.h>
 #endif
 
+#ifdef __MINGW32__
+#ifndef _WIN32_IE
+#define _WIN32_IE 0x0400
+#endif
+/* FIXME: these are copied from SWI-Prolog.h. */
+#define PL_MSG_EXCEPTION_RAISED -1
+#define PL_MSG_IGNORED 0
+#define PL_MSG_HANDLED 1
+#endif
+
 #include "pl-incl.h"
+#ifdef __YAP_PROLOG__
 #include "pl-utf8.h"
-//#include <crtdbg.h>
+#else
+#include "os/pl-utf8.h"
+#endif
 #include <process.h>
+#ifdef __YAP_PROLOG__
 #include "pl-ctype.h"
+#else
+#include "os/pl-ctype.h"
+#endif
 #include <stdio.h>
 #include <stdarg.h>
+#ifdef __YAP_PROLOG__
 #include "SWI-Stream.h"
+#else
+#include "os/SWI-Stream.h"
+#endif
 #include <process.h>
 #include <winbase.h>
+#ifdef HAVE_CRTDBG_H
+#include <crtdbg.h>
+#endif
 
 
 		 /*******************************
@@ -135,8 +159,8 @@ PlMessage(const char *fm, ...)
 		 *	WinAPI ERROR CODES	*
 		 *******************************/
 
-char *
+const char *
-WinError()
+WinError(void)
 { int id = GetLastError();
   char *msg;
   static WORD lang;
@@ -232,23 +256,21 @@ Pause(double t)
 		 *	  SET FILE SIZE		*
 		 *******************************/
 
+#ifndef HAVE_FTRUNCATE
+
 int
 ftruncate(int fileno, int64_t length)
-{ int e;
+{ errno_t e;
 
-#if HAVE__CHSIZE_S
-  /* not always available in mingw */
   if ( (e=_chsize_s(fileno, length)) == 0 )
     return 0;
-#else
-  if ( (e=_chsize(fileno, (long)length)) == 0 )
-    return 0;
-#endif
 
   errno = e;
   return -1;
 }
 
+#endif
+
 
 		 /*******************************
 		 *	 QUERY CPU TIME		*
@@ -273,13 +295,14 @@ CpuTime(cputime_kind which)
       case CPU_SYSTEM:
 	p = &kerneltime;
         break;
+      default:
+	assert(0);
+        return 0.0;
     }
     t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano);
     t += (double)p->dwLowDateTime  * (ntick nano);
   } else				/* '95, Windows 3.1/win32s */
-  { extern intptr_t clock_wait_ticks;
+  { t = 0.0;
-
-    t = (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
   }
 
   return t;
@@ -287,7 +310,7 @@ CpuTime(cputime_kind which)
 
 
 static int
-CpuCount()
+CpuCount(void)
 { SYSTEM_INFO si;
 
   GetSystemInfo(&si);
@@ -297,7 +320,7 @@ CpuCount()
 
 
 void
-setOSPrologFlags()
+setOSPrologFlags(void)
 { PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount());
 }
 
@@ -310,7 +333,7 @@ findExecutable(const char *module, char *exe)
 
   if ( module )
   { if ( !(hmod = GetModuleHandle(module)) )
-    { hmod = GetModuleHandle("libpl.dll");
+    { hmod = GetModuleHandle("libswipl.dll");
       DEBUG(0,
 	    Sdprintf("Warning: could not find module from \"%s\"\n"
 		     "Warning: Trying %s to find home\n",
@@ -340,7 +363,7 @@ findExecutable(const char *module, char *exe)
 
 typedef struct
 { const char *name;
-  int         id;
+  UINT        id;
 } showtype;
 
 static int
@@ -348,12 +371,12 @@ get_showCmd(term_t show, UINT *cmd)
 { char *s;
   showtype *st;
   static showtype types[] =
-  { { "hide", 		 SW_HIDE },
+  { { "hide",		 SW_HIDE },
-    { "maximize", 	 SW_MAXIMIZE },
+    { "maximize",	 SW_MAXIMIZE },
-    { "minimize", 	 SW_MINIMIZE },
+    { "minimize",	 SW_MINIMIZE },
-    { "restore", 	 SW_RESTORE },
+    { "restore",	 SW_RESTORE },
-    { "show", 		 SW_SHOW },
+    { "show",		 SW_SHOW },
-    { "showdefault", 	 SW_SHOWDEFAULT },
+    { "showdefault",	 SW_SHOWDEFAULT },
     { "showmaximized",   SW_SHOWMAXIMIZED },
     { "showminimized",   SW_SHOWMINIMIZED },
     { "showminnoactive", SW_SHOWMINNOACTIVE },
@@ -361,8 +384,8 @@ get_showCmd(term_t show, UINT *cmd)
     { "shownoactive",    SW_SHOWNOACTIVATE },
     { "shownormal",      SW_SHOWNORMAL },
 					/* compatibility */
-    { "normal", 	 SW_SHOWNORMAL },
+    { "normal",		 SW_SHOWNORMAL },
-    { "iconic", 	 SW_MINIMIZE },
+    { "iconic",		 SW_MINIMIZE },
     { NULL, 0 },
   };
 
@@ -422,8 +445,9 @@ win_exec(size_t len, const wchar_t *cmd, UINT show)
   } else
   { term_t tmp = PL_new_term_ref();
 
-    PL_unify_wchars(tmp, PL_ATOM, len, cmd);
+    return ( PL_unify_wchars(tmp, PL_ATOM, len, cmd) &&
-    return PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp);
+	     PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp)
+	   );
   }
 }
 
@@ -524,7 +548,7 @@ static const shell_error se_errors[] =
   { SE_ERR_DDETIMEOUT,	    "DDE request timed out" },
   { SE_ERR_DLLNOTFOUND,	    "DLL not found" },
   { SE_ERR_FNF,		    "File not found (FNF)" },
-  { SE_ERR_NOASSOC, 	    "No association" },
+  { SE_ERR_NOASSOC,	    "No association" },
   { SE_ERR_OOM,		    "Not enough memory" },
   { SE_ERR_PNF,		    "Path not found (PNF)" },
   { SE_ERR_SHARE,	    "Sharing violation" },
@@ -550,7 +574,7 @@ win_shell(term_t op, term_t file, term_t how)
   { const shell_error *se;
 
     for(se = se_errors; se->message; se++)
-    { if ( se->eno == (int)instance )
+      { if ( se->eno == (int)(intptr_t)instance )
 	return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
     }
     PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
@@ -621,22 +645,113 @@ need. They are used  by  pl-load.c,   which  defines  the  actual Prolog
 interface.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-static char *dlmsg;
+#ifdef HAVE_LIBLOADERAPI_H
+#include <LibLoaderAPI.h>
+#else
+#ifndef LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR
+#define LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR 0x00000100
+#endif
+#ifndef LOAD_LIBRARY_SEARCH_DEFAULT_DIRS
+#define LOAD_LIBRARY_SEARCH_DEFAULT_DIRS 0x00001000
+#endif
+typedef void * DLL_DIRECTORY_COOKIE;
+#endif
+
+static const char *dlmsg;
+static DLL_DIRECTORY_COOKIE WINAPI (*f_AddDllDirectoryW)(wchar_t* dir);
+static BOOL WINAPI (*f_RemoveDllDirectory)(DLL_DIRECTORY_COOKIE);
+
+static DWORD
+load_library_search_flags(void)
+{ static int done = FALSE;
+  static DWORD flags = 0;
+
+  if ( !done )
+  { HMODULE kernel = GetModuleHandle(TEXT("kernel32.dll"));
+
+    if ( (f_AddDllDirectoryW   = (void*)GetProcAddress(kernel, "AddDllDirectory")) &&
+	 (f_RemoveDllDirectory = (void*)GetProcAddress(kernel, "RemoveDllDirectory")) )
+    { flags = ( LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR|
+		LOAD_LIBRARY_SEARCH_DEFAULT_DIRS );
+    }
+    done = TRUE;
+  }
+
+  return flags;
+}
+
+
+static
+PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0)
+{ PRED_LD
+  char *dirs;
+
+  if ( PL_get_file_name(A1, &dirs, REP_UTF8) )
+  { size_t len = utf8_strlen(dirs, strlen(dirs));
+    wchar_t *dirw = alloca((len+10)*sizeof(wchar_t));
+    DLL_DIRECTORY_COOKIE cookie;
+
+    if ( _xos_os_filenameW(dirs, dirw, len+10) == NULL )
+      return PL_representation_error("file_name");
+    if ( load_library_search_flags() )
+    { if ( (cookie = (*f_AddDllDirectoryW)(dirw)) )
+	return PL_unify_int64(A2, (int64_t)cookie);
+      return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "AddDllDirectory()");
+    } else
+      return FALSE;
+  } else
+    return FALSE;
+}
+
+
+static
+PRED_IMPL("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
+{ int64_t icookie;
+
+  if ( PL_get_int64_ex(A1, &icookie) )
+  { if ( f_RemoveDllDirectory )
+    { if ( (*f_RemoveDllDirectory)((DLL_DIRECTORY_COOKIE)icookie) )
+	return TRUE;
+
+      return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "RemoveDllDirectory()");
+    } else
+      return FALSE;
+  } else
+    return FALSE;
+}
+
+
+static int
+is_windows_abs_path(const wchar_t *path)
+{ if ( path[1] == ':' && path[0] < 0x80 && iswalpha(path[0]) )
+    return TRUE;			/* drive */
+  if ( path[0] == '\\' && path[1] == '\\' )
+    return TRUE;			/* UNC */
+
+  return FALSE;
+}
 
 void *
-dlopen(const char *file, int flags)	/* file is in UTF-8 */
+dlopen(const char *file, int flags)	/* file is in UTF-8, POSIX path */
 { HINSTANCE h;
+  DWORD llflags = 0;
   size_t len = utf8_strlen(file, strlen(file));
-  wchar_t *wfile = alloca((len+1)*sizeof(wchar_t));
+  wchar_t *wfile = alloca((len+10)*sizeof(wchar_t));
 
   if ( !wfile )
   { dlmsg = "No memory";
     return NULL;
   }
 
-  utf8towcs(wfile, file);
+  if ( _xos_os_filenameW(file, wfile, len+10) == NULL )
+  { dlmsg = "Name too long";
+    return NULL;
+  }
 
-  if ( (h = LoadLibraryW(wfile)) )
+  if ( is_windows_abs_path(wfile) )
+    llflags |= load_library_search_flags();
+
+  if ( (h = LoadLibraryExW(wfile, NULL, llflags)) )
   { dlmsg = "No Error";
     return (void *)h;
   }
@@ -647,7 +762,7 @@ dlopen(const char *file, int flags)	/* file is in UTF-8 */
 
 
 const char *
-dlerror()
+dlerror(void)
 { return dlmsg;
 }
 
@@ -676,11 +791,59 @@ dlclose(void *handle)
 #endif /*EMULATE_DLOPEN*/
 
 
+		 /*******************************
+		 *	 SNPRINTF MADNESS	*
+		 *******************************/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+MS-Windows _snprintf() may look like C99 snprintf(), but is is not quite
+the same: on overflow, the buffer is   *not* 0-terminated and the return
+is negative (unspecified how negative).  The   code  below  works around
+this, returning count on overflow. This is still not the same as the C99
+version that returns the  number  of   characters  that  would have been
+written, but it seems to be enough for our purposes.
+
+See http://www.di-mgt.com.au/cprog.html#snprintf
+
+The above came from the provided link, but it is even worse (copied from
+VS2005 docs):
+
+  - If len < count, then len characters are stored in buffer, a
+  null-terminator is appended, and len is returned.
+
+  - If len = count, then len characters are stored in buffer, no
+  null-terminator is appended, and len is returned.
+
+  - If len > count, then count characters are stored in buffer, no
+  null-terminator is appended, and a negative value is returned.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+int
+ms_snprintf(char *buffer, size_t count, const char *fmt, ...)
+{ va_list ap;
+  int ret;
+
+  va_start(ap, fmt);
+  ret = _vsnprintf(buffer, count-1, fmt, ap);
+  va_end(ap);
+
+  if ( ret < 0 || ret == count )
+  { ret = (int)count;
+    buffer[count-1] = '\0';
+  }
+
+  return ret;
+}
+
+
+
 		 /*******************************
 		 *	      FOLDERS		*
 		 *******************************/
 
-#include <Shlobj.h>
+#ifdef HAVE_SHLOBJ_H
+#include <shlobj.h>
+#endif
 
 typedef struct folderid
 { int csidl;
@@ -727,7 +890,7 @@ static int
 unify_csidl_path(term_t t, int csidl)
 { wchar_t buf[MAX_PATH];
 
-  if ( SHGetFolderPathW(0, csidl, NULL, FALSE, buf) )
+  if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
   { wchar_t *p;
 
     for(p=buf; *p; p++)
@@ -935,7 +1098,7 @@ setStacksFromKey(HKEY key)
 
 
 void
-getDefaultsFromRegistry()
+getDefaultsFromRegistry(void)
 { HKEY key;
 
   if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) )
@@ -948,44 +1111,6 @@ getDefaultsFromRegistry()
   }
 }
 
-static
-PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
-{ GET_LD
-    OPENFILENAMEW ofn;
-    wchar_t szFileName[MAX_PATH];
-    void *x;
-    HWND hwnd;
-    wchar_t *yap_cwd;
-
-    if(!PL_get_pointer(A1, &x))
-      return FALSE;
-    if(!PL_get_wchars(A2, NULL, &yap_cwd, CVT_ATOM|CVT_EXCEPTION))
-      return FALSE;
-    hwnd = (HWND)x;
-    ZeroMemory(&ofn, sizeof(ofn));
-
-    ofn.lStructSize = sizeof(ofn); // SEE NOTE BELOW
-    ofn.hwndOwner = hwnd;
-    ofn.lpstrFilter = L"Prolog Files (*.pl;*.yap)\0*.pl;*.yap\0All Files (*.*)\0*.*\0";
-    ofn.lpstrFile = szFileName;
-    ofn.lpstrInitialDir = yap_cwd;
-    ofn.nMaxFile = MAX_PATH;
-    ofn.Flags = OFN_EXPLORER | OFN_FILEMUSTEXIST 
-      //| OFN_HIDEREADONLY
-      //|OFN_ALLOWMULTISELECT
-      ;
-    ofn.lpstrDefExt = "pl";
-
-    if(GetOpenFileNameW(&ofn))
-    {
-        // Do something usefull with the filename stored in szFileName 
-	return PL_unify_wchars(A3, PL_ATOM,
-			       MAX_PATH-1, szFileName);
-    }
-    return TRUE;
-}
-
-
 		 /*******************************
 		 *      PUBLISH PREDICATES	*
 		 *******************************/
@@ -993,9 +1118,12 @@ PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
 BeginPredDefs(win)
   PRED_DEF("win_shell", 2, win_shell2, 0)
   PRED_DEF("win_shell", 3, win_shell3, 0)
-  PRED_DEF("win_open_file_name", 3, win_open_file_name, 0)
   PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
   PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
+#ifdef EMULATE_DLOPEN
+  PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0)
+  PRED_DEF("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
+#endif
 EndPredDefs
 
 #endif /*__WINDOWS__*/

os/pl-os.c

@@ -1,11 +1,10 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        wielemak@science.uva.nl
+    E-mail:        J.Wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2007, University of Amsterdam
+    Copyright (C): 1985-2013, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +18,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 /*  Modified (M) 1993 Dave Sherratt  */
@@ -30,6 +29,17 @@
 #include <os2.h>                /* this has to appear before pl-incl.h */
 #endif
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS
+is supposed to give the POSIX standard one.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+#if defined(__sun__) || defined(__sun)
+#define _POSIX_PTHREAD_SEMANTICS 1
+#endif
+
+#define __MINGW_USE_VC2005_COMPAT		/* Get Windows time_t as 64-bit */
+
 #include "pl-incl.h"
 #include "pl-ctype.h"
 #include "pl-utf8.h"
@@ -96,27 +106,11 @@ static double initial_time;
 static void	initExpand(void);
 static void	cleanupExpand(void);
 static void	initEnviron(void);
-static char *	Which(const char *program, char *fullname);
 
 #ifndef DEFAULT_PATH
 #define DEFAULT_PATH "/bin:/usr/bin"
 #endif
 
-		 /*******************************
-		 *	       GLOBALS		*
-		 *******************************/
-#ifdef HAVE_CLOCK
-long clock_wait_ticks;
-#endif
-
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-This module is a contraction of functions that used to be all  over  the
-place.   together  with  pl-os.h  (included  by  pl-incl.h) this file
-should define a basic  layer  around  the  OS,  on  which  the  rest  of
-SWI-Prolog  is  based.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-
 		/********************************
 		*         INITIALISATION        *
 		*********************************/
@@ -145,20 +139,6 @@ initOs(void)
   setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING);
 #endif
 
-#ifdef HAVE_CLOCK
-  clock_wait_ticks = 0L;
-#endif
-
-#if OS2
-  { DATETIME i;
-    DosGetDateTime((PDATETIME)&i);
-    initial_time = (i.hours * 3600.0)
-                   + (i.minutes * 60.0)
-		   + i.seconds
-		   + (i.hundredths / 100.0);
-  }
-#endif /* OS2 */
-
   DEBUG(1, Sdprintf("OS:done\n"));
 
   succeed;
@@ -239,11 +219,26 @@ static char errmsg[64];
 #endif /*_SC_CLK_TCK*/
 #endif /*HAVE_TIMES*/
 
+#ifdef HAVE_CLOCK_GETTIME
+#define timespec_to_double(ts) \
+	((double)(ts).tv_sec + (double)(ts).tv_nsec/(double)1000000000.0)
+#endif
 
 double
 CpuTime(cputime_kind which)
 {
-#ifdef HAVE_TIMES
+#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_PROCESS_CPUTIME_ID)
+#define CPU_TIME_DONE
+  struct timespec ts;
+  (void)which;
+
+  if ( clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts) == 0 )
+    return timespec_to_double(ts);
+  return 0.0;
+#endif
+
+#if !defined(CPU_TIME_DONE) && defined(HAVE_TIMES)
+#define CPU_TIME_DONE
   struct tms t;
   double used;
   static int MTOK_got_hz = FALSE;
@@ -268,39 +263,17 @@ CpuTime(cputime_kind which)
     used = 0.0;				/* happens when running under GDB */
 
   return used;
-#else
+#endif
 
-#if OS2 && EMX
+#if !defined(CPU_TIME_DONE)
-  DATETIME i;
+  (void)which;
-
-  DosGetDateTime((PDATETIME)&i);
-  return (((i.hours * 3600)
-                 + (i.minutes * 60)
-		 + i.seconds
-	         + (i.hundredths / 100.0)) - initial_time);
-#else
-
-#ifdef HAVE_CLOCK
-  return (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
-#else
 
   return 0.0;
-
-#endif
-#endif
 #endif
 }
 
 #endif /*__WINDOWS__*/
 
-void
-PL_clock_wait_ticks(long waited)
-{
-#ifdef HAVE_CLOCK
-  clock_wait_ticks += waited;
-#endif
-}
-
 
 double
 WallTime(void)
@@ -310,7 +283,7 @@ WallTime(void)
   struct timespec tp;
 
   clock_gettime(CLOCK_REALTIME, &tp);
-  stime = (double)tp.tv_sec + (double)tp.tv_nsec/1000000000.0;
+  stime = timespec_to_double(tp);
 #else
 #ifdef HAVE_GETTIMEOFDAY
   struct timeval tp;
@@ -389,7 +362,7 @@ CpuCount()
 #include <sys/sysctl.h>
 
 int
-CpuCount()
+CpuCount(void)
 { int     count ;
   size_t  size=sizeof(count) ;
 
@@ -415,7 +388,7 @@ setOSPrologFlags(void)
 { int cpu_count = CpuCount();
 
   if ( cpu_count > 0 )
-    PL_set_prolog_flag("cpu_count", PL_INTEGER|FF_READONLY, cpu_count);
+    PL_set_prolog_flag("cpu_count", PL_INTEGER, cpu_count);
 }
 #endif
 
@@ -436,8 +409,7 @@ UsedMemory(void)
   }
 #endif
 
-  return (GD->statistics.heap +
+  return (usedStack(global) +
-	  usedStack(global) +
 	  usedStack(local) +
 	  usedStack(trail));
 }
@@ -448,8 +420,7 @@ FreeMemory(void)
 {
 #if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
   uintptr_t used = UsedMemory();
-
+  struct rlimit limit;
- struct rlimit limit;
 
   if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
     return limit.rlim_cur - used;
@@ -470,7 +441,7 @@ FreeMemory(void)
     some systems (__WINDOWS__) the seed of rand() is thread-local, while on
     others it is global.  We appear to have the choice between
 
-    	# srand()/rand()
+	# srand()/rand()
 	Differ in MT handling, often bad distribution
 
 	# srandom()/random()
@@ -522,16 +493,14 @@ _PL_Random(void)
   }
 
 #ifdef HAVE_RANDOM
-#if SIZEOF_VOIDP == 4
   { uint64_t l = random();
 
-    l ^= (uint64_t)random()<<32;
+    l ^= (uint64_t)random()<<15;
+    l ^= (uint64_t)random()<<30;
+    l ^= (uint64_t)random()<<45;
 
     return l;
   }
-#else
-  return random();
-#endif
 #else
   { uint64_t l = rand();			/* 0<n<2^15-1 */
 
@@ -845,19 +814,16 @@ struct canonical_dir
 forwards char   *canoniseDir(char *);
 #endif /*O_CANONISE_DIRS*/
 
-#define CWDdir	(LD->os._CWDdir)	/* current directory */
-#define CWDlen	(LD->os._CWDlen)	/* strlen(CWDdir) */
-
 static void
 initExpand(void)
-{ GET_LD
+{
 #ifdef O_CANONISE_DIRS
   char *dir;
   char *cpaths;
 #endif
 
-  CWDdir = NULL;
+  GD->paths.CWDdir = NULL;
-  CWDlen = 0;
+  GD->paths.CWDlen = 0;
 
 #ifdef O_CANONISE_DIRS
 { char envbuf[MAXPATHLEN];
@@ -898,7 +864,15 @@ cleanupExpand(void)
   canonical_dirlist = NULL;
   for( ; dn; dn = next )
   { next = dn->next;
-    free(dn);
+    if ( dn->canonical && dn->canonical != dn->name )
+      remove_string(dn->canonical);
+    remove_string(dn->name);
+    PL_free(dn);
+  }
+  if ( GD->paths.CWDdir )
+  { remove_string(GD->paths.CWDdir);
+    GD->paths.CWDdir = NULL;
+    GD->paths.CWDlen = 0;
   }
 }
 
@@ -925,7 +899,7 @@ registerParentDirs(const char *path)
     }
 
     if ( statfunc(OsPath(dirname, tmp), &buf) == 0 )
-    { CanonicalDir dn   = malloc(sizeof(*dn));
+    { CanonicalDir dn   = PL_malloc(sizeof(*dn));
 
       dn->name		= store_string(dirname);
       dn->inode		= buf.st_ino;
@@ -980,7 +954,7 @@ verify_entry(CanonicalDir d)
     remove_string(d->name);
     if ( d->canonical != d->name )
       remove_string(d->canonical);
-    free(d);
+    PL_free(d);
   }
 
   return FALSE;
@@ -1008,12 +982,12 @@ canoniseDir(char *path)
   }
 
 					/* we need to use malloc() here */
-					/* because allocHeap() only ensures */
+					/* because allocHeapOrHalt() only ensures */
 					/* alignment for `word', and inode_t */
 					/* is sometimes bigger! */
 
   if ( statfunc(OsPath(path, tmp), &buf) == 0 )
-  { CanonicalDir dn = malloc(sizeof(*dn));
+  { CanonicalDir dn = PL_malloc(sizeof(*dn));
     char dirname[MAXPATHLEN];
     char *e = path + strlen(path);
 
@@ -1082,8 +1056,7 @@ cleanupExpand(void)
 char *
 canoniseFileName(char *path)
 { char *out = path, *in = path, *start = path;
-  char *osave[100];
+  tmp_buffer saveb;
-  int  osavep = 0;
 
 #ifdef O_HASDRIVES			/* C: */
   if ( in[1] == ':' && isLetter(in[0]) )
@@ -1092,8 +1065,8 @@ canoniseFileName(char *path)
     out = start = in;
   }
 #ifdef __MINGW32__ /* /c/ in MINGW is the same as c: */
-  if ( in[0] == '/' && isLetter(in[1]) &&
+  else if ( in[0] == '/' && isLetter(in[1]) &&
-       in[2] == '/' )
+	    in[2] == '/' )
   {
     out[0] = in[1];
     out[1] = ':';
@@ -1101,13 +1074,13 @@ canoniseFileName(char *path)
     out = start = in;
   }
 #endif
-
 #endif
+
 #ifdef O_HASSHARES			/* //host/ */
   if ( in[0] == '/' && in[1] == '/' && isAlpha(in[2]) )
   { char *s;
 
-    for(s = in+3; *s && (isAlpha(*s) || *s == '.'); s++)
+    for(s = in+3; *s && (isAlpha(*s) || *s == '-' || *s == '.'); s++)
       ;
     if ( *s == '/' )
     { in = out = s+1;
@@ -1122,7 +1095,8 @@ canoniseFileName(char *path)
     in += 2;
   if ( in[0] == '/' )
     *out++ = '/';
-  osave[osavep++] = out;
+  initBuffer(&saveb);
+  addBuffer(&saveb, out, char*);
 
   while(*in)
   { if (*in == '/')
@@ -1138,15 +1112,15 @@ canoniseFileName(char *path)
 	  }
 	  if ( in[2] == EOS )		/* delete trailing /. */
 	  { *out = EOS;
-	    return path;
+	    goto out;
 	  }
 	  if ( in[2] == '.' && (in[3] == '/' || in[3] == EOS) )
-	  { if ( osavep > 0 )		/* delete /foo/../ */
+	  { if ( !isEmptyBuffer(&saveb) )		/* delete /foo/../ */
-	    { out = osave[--osavep];
+	    { out = popBuffer(&saveb, char*);
 	      in += 3;
 	      if ( in[0] == EOS && out > start+1 )
 	      { out[-1] = EOS;		/* delete trailing / */
-		return path;
+		goto out;
 	      }
 	      goto again;
 	    } else if (	start[0] == '/' && out == start+1 )
@@ -1160,12 +1134,15 @@ canoniseFileName(char *path)
 	in++;
       if ( out > path && out[-1] != '/' )
 	*out++ = '/';
-      osave[osavep++] = out;
+      addBuffer(&saveb, out, char*);
     } else
       *out++ = *in++;
   }
   *out++ = *in++;
 
+out:
+  discardBuffer(&saveb);
+
   return path;
 }
 
@@ -1201,15 +1178,18 @@ canonisePath(char *path)
 #ifdef O_CANONISE_DIRS
 { char *e;
   char dirname[MAXPATHLEN];
+  size_t plen = strlen(path);
 
-  e = path + strlen(path) - 1;
+  if ( plen > 0 )
-  for( ; *e != '/' && e > path; e-- )
+  { e = path + plen - 1;
-    ;
+    for( ; *e != '/' && e > path; e-- )
-  strncpy(dirname, path, e-path);
+      ;
-  dirname[e-path] = EOS;
+    strncpy(dirname, path, e-path);
-  canoniseDir(dirname);
+    dirname[e-path] = EOS;
-  strcat(dirname, e);
+    canoniseDir(dirname);
-  strcpy(path, dirname);
+    strcat(dirname, e);
+    strcpy(path, dirname);
+  }
 }
 #endif
 
@@ -1238,11 +1218,12 @@ takeWord(const char **string, char *wrd, int maxlen)
 }
 
 
-bool
+char *
 expandVars(const char *pattern, char *expanded, int maxlen)
 { GET_LD
   int size = 0;
   char wordbuf[MAXPATHLEN];
+  char *rc = expanded;
 
   if ( *pattern == '~' )
   { char *user;
@@ -1305,7 +1286,9 @@ expandVars(const char *pattern, char *expanded, int maxlen)
 #endif
     size += (l = (int) strlen(value));
     if ( size+1 >= maxlen )
-      return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
+    { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
+      return NULL;
+    }
     strcpy(expanded, value);
     expanded += l;
     UNLOCK();
@@ -1345,8 +1328,9 @@ expandVars(const char *pattern, char *expanded, int maxlen)
 	  size += (l = (int)strlen(value));
 	  if ( size+1 >= maxlen )
 	  { UNLOCK();
-	    return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
+	    PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
-			    ATOM_max_path_length);
+		     ATOM_max_path_length);
+	    return NULL;
 	  }
 	  strcpy(expanded, value);
 	  UNLOCK();
@@ -1359,8 +1343,10 @@ expandVars(const char *pattern, char *expanded, int maxlen)
       def:
 	size++;
 	if ( size+1 >= maxlen )
-	  return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
+	{ PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
-			  ATOM_max_path_length);
+		   ATOM_max_path_length);
+	  return NULL;
+	}
 	*expanded++ = c;
 
 	continue;
@@ -1369,61 +1355,14 @@ expandVars(const char *pattern, char *expanded, int maxlen)
   }
 
   if ( ++size >= maxlen )
-    return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
+  { PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
-		    ATOM_max_path_length);
+	     ATOM_max_path_length);
+    return NULL;
+  }
+
   *expanded = EOS;
 
-  succeed;
+  return rc;
-}
-
-
-static int
-ExpandFile(const char *pattern, char **vector)
-{ char expanded[MAXPATHLEN];
-  int matches = 0;
-
-  if ( !expandVars(pattern, expanded, sizeof(expanded)) )
-    return -1;
-
-  vector[matches++] = store_string(expanded);
-
-  return matches;
-}
-
-
-char *
-ExpandOneFile(const char *spec, char *file)
-{ GET_LD
-  char *vector[256];
-  int size;
-
-  switch( (size=ExpandFile(spec, vector)) )
-  { case -1:
-      return NULL;
-    case 0:
-    { term_t tmp = PL_new_term_ref();
-
-      PL_put_atom_chars(tmp, spec);
-      PL_error(NULL, 0, "no match", ERR_EXISTENCE, ATOM_file, tmp);
-
-      return NULL;
-    }
-    case 1:
-      strcpy(file, vector[0]);
-      remove_string(vector[0]);
-      return file;
-    default:
-    { term_t tmp = PL_new_term_ref();
-      int n;
-
-      for(n=0; n<size; n++)
-	remove_string(vector[n]);
-      PL_put_atom_chars(tmp, spec);
-      PL_error(NULL, 0, "ambiguous", ERR_EXISTENCE, ATOM_file, tmp);
-
-      return NULL;
-    }
-  }
 }
 
 
@@ -1507,7 +1446,7 @@ AbsoluteFile(const char *spec, char *path)
   if ( !file )
      return (char *) NULL;
   if ( truePrologFlag(PLFLAG_FILEVARS) )
-  { if ( !(file = ExpandOneFile(buf, tmp)) )
+  { if ( !(file = expandVars(buf, tmp, sizeof(tmp))) )
       return (char *) NULL;
   }
 
@@ -1530,17 +1469,17 @@ AbsoluteFile(const char *spec, char *path)
   }
 #endif /*O_HASDRIVES*/
 
-  if ( !PL_cwd() )
+  if ( !PL_cwd(path, MAXPATHLEN) )
     return NULL;
 
-  if ( (CWDlen + strlen(file) + 1) >= MAXPATHLEN )
+  if ( (GD->paths.CWDlen + strlen(file) + 1) >= MAXPATHLEN )
   { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
     return (char *) NULL;
   }
 
-  strcpy(path, CWDdir);
+  strcpy(path, GD->paths.CWDdir);
   if ( file[0] != EOS )
-    strcpy(&path[CWDlen], file);
+    strcpy(&path[GD->paths.CWDlen], file);
   if ( strchr(file, '.') || strchr(file, '/') )
     return canonisePath(path);
   else
@@ -1550,20 +1489,20 @@ AbsoluteFile(const char *spec, char *path)
 
 void
 PL_changed_cwd(void)
-{ GET_LD
+{ LOCK();
-
+  if ( GD->paths.CWDdir )
-  if ( CWDdir )
+    remove_string(GD->paths.CWDdir);
-    remove_string(CWDdir);
+  GD->paths.CWDdir = NULL;
-  CWDdir = NULL;
+  GD->paths.CWDlen = 0;
-  CWDlen = 0;
+  UNLOCK();
 }
 
 
-const char *
+static char *
-PL_cwd(void)
+cwd_unlocked(char *cwd, size_t cwdlen)
 { GET_LD
 
-  if ( CWDlen == 0 )
+  if ( GD->paths.CWDlen == 0 )
   { char buf[MAXPATHLEN];
     char *rval;
 
@@ -1593,16 +1532,34 @@ to be implemented directly.  What about other Unixes?
     }
 
     canonisePath(buf);
-    CWDlen = strlen(buf);
+    GD->paths.CWDlen = strlen(buf);
-    buf[CWDlen++] = '/';
+    buf[GD->paths.CWDlen++] = '/';
-    buf[CWDlen] = EOS;
+    buf[GD->paths.CWDlen] = EOS;
 
-    if ( CWDdir )
+    if ( GD->paths.CWDdir )
-      remove_string(CWDdir);
+      remove_string(GD->paths.CWDdir);
-    CWDdir = store_string(buf);
+    GD->paths.CWDdir = store_string(buf);
   }
 
-  return (const char *)CWDdir;
+  if ( GD->paths.CWDlen < cwdlen )
+  { memcpy(cwd, GD->paths.CWDdir, GD->paths.CWDlen+1);
+    return cwd;
+  } else
+  { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
+    return NULL;
+  }
+}
+
+
+char *
+PL_cwd(char *cwd, size_t cwdlen)
+{ char *rc;
+
+  LOCK();
+  rc = cwd_unlocked(cwd, cwdlen);
+  UNLOCK();
+
+  return rc;
 }
 
 
@@ -1652,14 +1609,13 @@ DirName(const char *f, char *dir)
 
 bool
 ChDir(const char *path)
-{ GET_LD
+{ char ospath[MAXPATHLEN];
-  char ospath[MAXPATHLEN];
   char tmp[MAXPATHLEN];
 
   OsPath(path, ospath);
 
   if ( path[0] == EOS || streq(path, ".") ||
-       (CWDdir && streq(path, CWDdir)) )
+       (GD->paths.CWDdir && streq(path, GD->paths.CWDdir)) )
     succeed;
 
   AbsoluteFile(path, tmp);
@@ -1672,10 +1628,12 @@ ChDir(const char *path)
     { tmp[len++] = '/';
       tmp[len] = EOS;
     }
-    CWDlen = len;
+    LOCK();					/* Lock with PL_changed_cwd() */
-    if ( CWDdir )
+    GD->paths.CWDlen = len;			/* and PL_cwd() */
-      remove_string(CWDdir);
+    if ( GD->paths.CWDdir )
-    CWDdir = store_string(tmp);
+      remove_string(GD->paths.CWDdir);
+    GD->paths.CWDdir = store_string(tmp);
+    UNLOCK();
 
     succeed;
   }
@@ -1689,7 +1647,7 @@ ChDir(const char *path)
 		*********************************/
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    struct tm *LocalTime(time_t time, struct tm *r)
+    struct tm *PL_localtime_r(time_t time, struct tm *r)
 
     Convert time in Unix internal form (seconds since Jan 1 1970) into a
     structure providing easier access to the time.
@@ -1713,17 +1671,52 @@ ChDir(const char *path)
     time_t Time()
 
     Return time in seconds after Jan 1 1970 (Unix' time notion).
+
+Note: MinGW has localtime_r(),  but  it  is   not  locked  and  thus not
+thread-safe. MinGW does not have localtime_s(), but   we  test for it in
+configure.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 struct tm *
-LocalTime(long *t, struct tm *r)
+PL_localtime_r(const time_t *t, struct tm *r)
 {
-#if defined(_REENTRANT) && defined(HAVE_LOCALTIME_R)
+#ifdef HAVE_LOCALTIME_R
   return localtime_r(t, r);
 #else
-  *r = *localtime((const time_t *) t);
+#ifdef HAVE_LOCALTIME_S
+  return localtime_s(r, t) == EINVAL ? NULL : t;
+#else
+  struct tm *rc;
+
+  LOCK();
+  if ( (rc = localtime(t)) )
+    *r = *rc;
+  else
+    r = NULL;
+  UNLOCK();
+
   return r;
 #endif
+#endif
+}
+
+char *
+PL_asctime_r(const struct tm *tm, char *buf)
+{
+#ifdef HAVE_ASCTIME_R
+  return asctime_r(tm, buf);
+#else
+  char *rc;
+
+  LOCK();
+  if ( (rc = asctime(tm)) )
+    strcpy(buf, rc);
+  else
+    buf = NULL;
+  UNLOCK();
+
+  return buf;
+#endif
 }
 
 
@@ -1857,7 +1850,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
   if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
     succeed;
 
-  buf->state = allocHeap(sizeof(tty_state));
+  buf->state = allocHeapOrHalt(sizeof(tty_state));
 
 #ifdef HAVE_TCSETATTR
   if ( tcgetattr(fd, &TTY_STATE(buf)) )	/* save the old one */
@@ -1915,9 +1908,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
 
 bool
 PopTty(IOSTREAM *s, ttybuf *buf, int do_free)
-{ GET_LD
+{ ttymode = buf->mode;
-
-  ttymode = buf->mode;
 
   if ( buf->state )
   { int fd = Sfileno(s);
@@ -1963,7 +1954,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
   if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
     succeed;
 
-  buf->state = allocHeap(sizeof(tty_state));
+  buf->state = allocHeapOrHalt(sizeof(tty_state));
 
   if ( ioctl(fd, TIOCGETP, &TTY_STATE(buf)) )  /* save the old one */
     fail;
@@ -2178,7 +2169,7 @@ growEnviron(char **e, int amount)
     for(e1=e, filled=0; *e1; e1++, filled++)
       ;
     size = ROUND(filled+10+amount, 32);
-    env = (char **)malloc(size * sizeof(char *));
+    env = (char **)PL_malloc(size * sizeof(char *));
     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
       ;
     *e2 = (char *) NULL;
@@ -2192,7 +2183,7 @@ growEnviron(char **e, int amount)
   { char **env, **e1, **e2;
 
     size += 32;
-    env = (char **)realloc(e, size * sizeof(char *));
+    env = (char **)PL_realloc(e, size * sizeof(char *));
     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
       ;
     *e2 = (char *) NULL;
@@ -2224,9 +2215,9 @@ matchName(const char *e, const char *name)
 
 static void
 setEntry(char **e, char *name, char *value)
-{ int l = (int)strlen(name);
+{ size_t l = strlen(name);
 
-  *e = (char *) malloc(l + strlen(value) + 2);
+  *e = PL_malloc_atomic(l + strlen(value) + 2);
   strcpy(*e, name);
   e[0][l++] = '=';
   strcpy(&e[0][l], value);
@@ -2292,7 +2283,7 @@ Unsetenv(char *name)
     an alternative.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-#if defined(__unix__)
+#ifdef __unix__
 #define SPECIFIC_SYSTEM 1
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2465,30 +2456,15 @@ char *command;
 
 #endif
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-[candidate]
-
-exec(+Cmd, [+In, +Out, +Error], -Pid)
-
-The streams may be one of standard   stream,  std, null stream, null, or
-pipe(S), where S is a pipe stream
-
-Detach if none is std!
-
-TBD: Sort out status. The above is SICStus 3. YAP uses `Status' for last
-argument (strange). SICStus 4 appears to drop this altogether.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-
-
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    char *Symbols(char *buf)
+    char *findExecutable(char *buf)
 
     Return the path name of the executable of SWI-Prolog.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 #ifndef __WINDOWS__			/* Win32 version in pl-nt.c */
+static char *	Which(const char *program, char *fullname);
 
 char *
 findExecutable(const char *av0, char *buffer)
@@ -2500,7 +2476,7 @@ findExecutable(const char *av0, char *buffer)
     return NULL;
   file = Which(buf, tmp);
 
-#if __unix__ 		/* argv[0] can be an #! script! */
+#if __unix__				/* argv[0] can be an #! script! */
   if ( file )
   { int n, fd;
     char buf[MAXPATHLEN];
@@ -2532,14 +2508,8 @@ findExecutable(const char *av0, char *buffer)
 
   return strcpy(buffer, file ? file : buf);
 }
-#endif /*__WINDOWS__*/
 
-
+#ifdef __unix__
-#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
-#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
-#define PATHSEP ';'
-#else
-/* not Windows, must be a Linux-like thingy */
 static char *
 okToExec(const char *s)
 { statstruct stbuff;
@@ -2552,6 +2522,11 @@ okToExec(const char *s)
     return (char *) NULL;
 }
 #define PATHSEP	':'
+#endif /* __unix__ */
+
+#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
+#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
+#define PATHSEP ';'
 #endif
 
 #ifdef EXEC_EXTENSIONS
@@ -2636,6 +2611,7 @@ Which(const char *program, char *fullname)
   return NULL;
 }
 
+#endif /*__WINDOWS__*/
 
 /** int Pause(double time)
 

os/pl-privitf.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "pl-incl.h"
@@ -173,7 +173,7 @@ unifyList(term_t term, list_ctx *ctx)
 
   a = valTermRef(term);
   deRef(a);
-  if ( !unify_ptrs(a, ctx->lp PASS_LD) )
+  if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
   { gTop = ctx->lp;
     return FALSE;
   }
@@ -191,13 +191,13 @@ unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
 
   a = valTermRef(head);
   deRef(a);
-  if ( !unify_ptrs(a, ctx->lp PASS_LD) )
+  if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
   { gTop = ctx->lp;
     return FALSE;
   }
   a = valTermRef(tail);
   deRef(a);
-  if ( !unify_ptrs(a, ctx->gstore PASS_LD) )
+  if ( !unify_ptrs(a, ctx->gstore, 0 PASS_LD) )
   { gTop = ctx->lp;
     return FALSE;
   }

os/pl-prologflag.c

@@ -1,11 +1,10 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        J.wielemaker@uva.nl
+    E-mail:        J.wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2008, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +18,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 /*#define O_DEBUG 1*/
@@ -76,10 +75,10 @@ too much.
 static void setArgvPrologFlag(void);
 #endif
 static void setTZPrologFlag(void);
-#ifndef __YAP_PROLOG__
 static void setVersionPrologFlag(void);
-#endif
 static atom_t lookupAtomFlag(atom_t key);
+static void initPrologFlagTable(void);
+
 
 typedef struct _prolog_flag
 { short		flags;			/* Type | Flags */
@@ -138,7 +137,7 @@ setPrologFlag(const char *name, int flags, ...)
     if ( flags & FF_KEEP )
       return;
   } else
-  { f = allocHeap(sizeof(*f));
+  { f = allocHeapOrHalt(sizeof(*f));
     f->index = -1;
     f->flags = flags;
     addHTable(GD->prolog_flag.table, (void *)an, f);
@@ -155,7 +154,8 @@ setPrologFlag(const char *name, int flags, ...)
 	val = (f->value.a == ATOM_true);
       } else if ( !s )				/* 1st definition */
       { f->index = indexOfBoolMask(mask);
-	DEBUG(2, Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
+	DEBUG(MSG_PROLOG_FLAG,
+	      Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
       }
 
       f->value.a = (val ? ATOM_true : ATOM_false);
@@ -211,12 +211,20 @@ setPrologFlag(const char *name, int flags, ...)
 }
 
 
+static void
+freePrologFlag(prolog_flag *f)
+{ if ( (f->flags & FT_MASK) == FT_TERM )
+    PL_erase(f->value.t);
+
+  freeHeap(f, sizeof(*f));
+}
+
+
 #ifdef O_PLMT
 static void
 copySymbolPrologFlagTable(Symbol s)
-{ GET_LD
+{ prolog_flag *f = s->value;
-  prolog_flag *f = s->value;
+  prolog_flag *copy = allocHeapOrHalt(sizeof(*copy));
-  prolog_flag *copy = allocHeap(sizeof(*copy));
 
   *copy = *f;
   if ( (f->flags & FT_MASK) == FT_TERM )
@@ -227,13 +235,7 @@ copySymbolPrologFlagTable(Symbol s)
 
 static void
 freeSymbolPrologFlagTable(Symbol s)
-{ GET_LD
+{ freePrologFlag(s->value);
-  prolog_flag *f = s->value;
-
-  if ( (f->flags & FT_MASK) == FT_TERM )
-    PL_erase(f->value.t);
-
-  freeHeap(f, sizeof(*f));
 }
 #endif
 
@@ -267,25 +269,34 @@ setDoubleQuotes(atom_t a, unsigned int *flagp)
 
 
 static int
-setUnknown(atom_t a, unsigned int *flagp)
+setUnknown(term_t value, atom_t a, Module m)
-{ unsigned int flags;
+{ unsigned int flags = m->flags & ~(UNKNOWN_MASK);
 
   if ( a == ATOM_error )
-    flags = UNKNOWN_ERROR;
+    flags |= UNKNOWN_ERROR;
   else if ( a == ATOM_warning )
-    flags = UNKNOWN_WARNING;
+    flags |= UNKNOWN_WARNING;
   else if ( a == ATOM_fail )
-    flags = UNKNOWN_FAIL;
+    flags |= UNKNOWN_FAIL;
   else
-  { GET_LD
-    term_t value = PL_new_term_ref();
-
-    PL_put_atom(value, a);
     return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value);
+
+  if ( !(flags&UNKNOWN_ERROR) && (m == MODULE_user || m == MODULE_system) )
+  { GET_LD
+
+    if ( m == MODULE_system && !SYSTEM_MODE )
+    { term_t key = PL_new_term_ref();
+
+      PL_put_atom(key, ATOM_unknown);
+      return PL_error(NULL, 0, NULL, ERR_PERMISSION,
+		      ATOM_modify, ATOM_flag, key);
+    }
+
+    if ( !SYSTEM_MODE )
+      printMessage(ATOM_warning, PL_CHARS, "unknown_in_module_user");
   }
 
-  *flagp &= ~(UNKNOWN_MASK);
+  m->flags = flags;
-  *flagp |= flags;
 
   succeed;
 }
@@ -308,6 +319,21 @@ setWriteAttributes(atom_t a)
 }
 
 
+static int
+setAccessLevelFromAtom(atom_t a)
+{ GET_LD
+
+  if ( getAccessLevelMask(a, &LD->prolog_flag.access_level) )
+  { succeed;
+  } else
+  { term_t value = PL_new_term_ref();
+
+    PL_put_atom(value, a);
+    return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_access_level, value);
+  }
+}
+
+
 static int
 getOccursCheckMask(atom_t a, occurs_check_t *val)
 { if ( a == ATOM_false )
@@ -357,6 +383,30 @@ setEncoding(atom_t a)
 }
 
 
+static int
+setStreamTypeCheck(atom_t a)
+{ GET_LD
+  st_check check;
+
+  if ( a == ATOM_false )
+    check = ST_FALSE;
+  else if ( a == ATOM_loose )
+    check = ST_LOOSE;
+  else if ( a == ATOM_true )
+    check = ST_TRUE;
+  else
+  { term_t value = PL_new_term_ref();
+
+    PL_put_atom(value, a);
+    return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_type_check, value);
+  }
+
+  LD->IO.stream_type_check = check;
+  return TRUE;
+}
+
+
+
 static word
 set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 { GET_LD
@@ -385,7 +435,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 
 #ifdef O_PLMT
     if ( GD->statistics.threads_created > 1 )
-    { prolog_flag *f2 = allocHeap(sizeof(*f2));
+    { prolog_flag *f2 = allocHeapOrHalt(sizeof(*f2));
 
       *f2 = *f;
       if ( (f2->flags & FT_MASK) == FT_TERM )
@@ -399,7 +449,8 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
       }
 
       addHTable(LD->prolog_flag.table, (void *)k, f2);
-      DEBUG(1, Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
+      DEBUG(MSG_PROLOG_FLAG,
+	    Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
       f = f2;
     }
 #endif
@@ -411,7 +462,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 
   anyway:
     PL_register_atom(k);
-    f = allocHeap(sizeof(*f));
+    f = allocHeapOrHalt(sizeof(*f));
     f->index = -1;
 
     switch( (flags & FT_MASK) )
@@ -437,8 +488,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 	    goto wrong_type;
 	  }
 	  if ( !(f->value.t = PL_record(value)) )
-	    goto wrong_type;
+	  { freeHeap(f, sizeof(*f));
-	  f->value.t = PL_record(value);
+	    return FALSE;
+	  }
 	}
 	break;
       }
@@ -483,7 +535,10 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
     if ( (flags & FF_READONLY) )
       f->flags |= FF_READONLY;
 
-    addHTable(GD->prolog_flag.table, (void *)k, f);
+    if ( !addHTable(GD->prolog_flag.table, (void *)k, f) )
+    { freePrologFlag(f);
+      Sdprintf("OOPS; failed to set Prolog flag!?\n");
+    }
 
     succeed;
   } else
@@ -516,9 +571,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 #ifndef __YAP_PROLOG__
       if ( k == ATOM_character_escapes )
       { if ( val )
-	  set(m, CHARESCAPE);
+	  set(m, M_CHARESCAPE);
 	else
-	  clear(m, CHARESCAPE);
+	  clear(m, M_CHARESCAPE);
       } else if ( k == ATOM_debug )
       { if ( val )
 	{ debugmode(DBG_ALL, NULL);
@@ -551,15 +606,19 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
       if ( k == ATOM_double_quotes )
       { rval = setDoubleQuotes(a, &m->flags);
       } else if ( k == ATOM_unknown )
-      { rval = setUnknown(a, &m->flags);
+      { rval = setUnknown(value, a, m);
       } else if ( k == ATOM_write_attributes )
       { rval = setWriteAttributes(a);
       } else if ( k == ATOM_occurs_check )
       { rval = setOccursCheck(a);
-      } else 
+      } else if ( k == ATOM_access_level )
+      { rval = setAccessLevelFromAtom(a);
+      } else
 #endif
       if ( k == ATOM_encoding )
       { rval = setEncoding(a);
+      } else if ( k == ATOM_stream_type_check )
+      { rval = setStreamTypeCheck(a);
       }
       if ( !rval )
 	fail;
@@ -705,7 +764,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
 
 #ifndef __YAP_PROLOG__
   if ( key == ATOM_character_escapes )
-  { atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false);
+  { atom_t v = (true(m, M_CHARESCAPE) ? ATOM_true : ATOM_false);
 
     return PL_unify_atom(val, v);
   } else if ( key == ATOM_double_quotes )
@@ -736,6 +795,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
         break;
       default:
 	assert(0);
+        return FALSE;
     }
 
     return PL_unify_atom(val, v);
@@ -747,6 +807,14 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
   { return PL_unify_bool_ex(val, debugstatus.debugging);
   } else if ( key == ATOM_debugger_show_context )
   { return PL_unify_bool_ex(val, debugstatus.showContext);
+  } else if ( key == ATOM_break_level )
+  { int bl = currentBreakLevel();
+
+    if ( bl >= 0 )
+      return PL_unify_integer(val, bl);
+    return FALSE;
+  } else if ( key == ATOM_access_level )
+  { return PL_unify_atom(val, accessLevel());
   }
 #endif /* YAP_PROLOG */
 
@@ -861,7 +929,7 @@ pl_prolog_flag5(term_t key, term_t value,
 
 	fail;
       } else if ( PL_is_variable(key) )
-      { e = allocHeap(sizeof(*e));
+      { e = allocHeapOrHalt(sizeof(*e));
 
 	e->module = module;
 
@@ -965,7 +1033,7 @@ pl_prolog_flag(term_t name, term_t value, control_t h)
 #define SO_PATH "LD_LIBRARY_PATH"
 #endif
 
-void
+static void
 initPrologFlagTable(void)
 { if ( !GD->prolog_flag.table )
   { 
@@ -973,7 +1041,7 @@ initPrologFlagTable(void)
     initPrologThreads();	/* may be called before PL_initialise() */
 #endif
 
-    GD->prolog_flag.table = newHTable(32);
+    GD->prolog_flag.table = newHTable(64);
   }
 }
 
@@ -983,7 +1051,7 @@ initPrologFlags(void)
 { GET_LD
 #ifndef __YAP_PROLOG__
   setPrologFlag("iso",  FT_BOOL, FALSE, PLFLAG_ISO);
-  setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH);
+  setPrologFlag("arch", FT_ATOM|FF_READONLY, PLARCH);
 #if __WINDOWS__
   setPrologFlag("windows",	FT_BOOL|FF_READONLY, TRUE, 0);
 #endif
@@ -996,12 +1064,17 @@ initPrologFlags(void)
 #if defined(HAVE_GETPID) || defined(EMULATE_GETPID)
   setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid());
 #endif
+  setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
   setPrologFlag("generate_debug_info", FT_BOOL,
-	     truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
+		truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
   setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL);
-  setPrologFlag("c_libs",	  FT_ATOM|FF_READONLY, C_LIBS);
+  setPrologFlag("warn_override_implicit_import", FT_BOOL, TRUE,
-  setPrologFlag("c_cc",	  FT_ATOM|FF_READONLY, C_CC);
+		PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT);
-  setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS);
+  setPrologFlag("c_cc",	     FT_ATOM, C_CC);
+  setPrologFlag("c_libs",    FT_ATOM, C_LIBS);
+  setPrologFlag("c_libplso", FT_ATOM, C_LIBPLSO);
+  setPrologFlag("c_ldflags", FT_ATOM, C_LDFLAGS);
+  setPrologFlag("c_cflags",  FT_ATOM, C_CFLAGS);
 #if defined(O_LARGEFILES) || SIZEOF_LONG == 8
   setPrologFlag("large_files", FT_BOOL|FF_READONLY, TRUE, 0);
 #endif
@@ -1041,6 +1114,7 @@ initPrologFlags(void)
   setPrologFlag("debug_on_error",	FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
   setPrologFlag("report_error",	FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
 #endif
+  setPrologFlag("break_level", FT_INTEGER|FF_READONLY, 0, 0);
   setPrologFlag("user_flags", FT_ATOM, "silent");
   setPrologFlag("editor", FT_ATOM, "default");
   setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
@@ -1065,28 +1139,39 @@ initPrologFlags(void)
     setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
   setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
   setPrologFlag("answer_format", FT_ATOM, "~p");
+  setPrologFlag("colon_sets_calling_context", FT_BOOL, TRUE, 0);
   setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
   setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
   setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING);
   setPrologFlag("write_attributes", FT_ATOM, "ignore");
+  setPrologFlag("stream_type_check", FT_ATOM, "loose");
   setPrologFlag("occurs_check", FT_ATOM, "false");
+  setPrologFlag("access_level", FT_ATOM, "user");
   setPrologFlag("double_quotes", FT_ATOM, "codes");
   setPrologFlag("unknown", FT_ATOM, "error");
   setPrologFlag("debug", FT_BOOL, FALSE, 0);
   setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal");
-  setPrologFlag("verbose_load", FT_BOOL, TRUE, 0);
+  setPrologFlag("verbose_load", FT_ATOM, "normal");
   setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0);
   setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0);
   setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
 	     ALLOW_VARNAME_FUNCTOR);
   setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
   setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0);
+  setPrologFlag("toplevel_prompt", FT_ATOM, "~m~d~l~! ?- ");
+  setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
+  setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
 #ifdef __unix__
   setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
 #endif
 
+  setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
+
+  setPrologFlag("tty_control", FT_BOOL,
+		truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
   setPrologFlag("signals", FT_BOOL|FF_READONLY,
-	     truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
+		truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
+  setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0);
 
 #if defined(__WINDOWS__) && defined(_DEBUG)
   setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug");
@@ -1117,14 +1202,14 @@ initPrologFlags(void)
   setTZPrologFlag();
 #ifndef __YAP_PROLOG__
   setOSPrologFlags();
-  setVersionPrologFlag();
 #endif /* YAP_PROLOG */
+  setVersionPrologFlag();
 }
 
 
 #ifndef __YAP_PROLOG__
 static void
-setArgvPrologFlag()
+setArgvPrologFlag(void)
 { GET_LD
   fid_t fid = PL_open_foreign_frame();
   term_t e = PL_new_term_ref();
@@ -1148,14 +1233,12 @@ setArgvPrologFlag()
 #endif
 
 static void
-setTZPrologFlag()
+setTZPrologFlag(void)
 { tzset();
 
   setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone);
 }
 
-#ifndef __YAP_PROLOG__
-
 static void
 setVersionPrologFlag(void)
 { GET_LD
@@ -1166,7 +1249,7 @@ setVersionPrologFlag(void)
   int patch = (PLVERSION%100);
 
   if ( !PL_unify_term(t,
-		      PL_FUNCTOR_CHARS, "swi", 4,
+		      PL_FUNCTOR_CHARS, PLNAME, 4,
 		        PL_INT, major,
 		        PL_INT, minor,
 		        PL_INT, patch,
@@ -1178,7 +1261,21 @@ setVersionPrologFlag(void)
 
   setGITVersion();
 }
-#endif /* YAP_PROLOG */
+
+void
+cleanupPrologFlags(void)
+{ if ( GD->prolog_flag.table )
+  { Table t = GD->prolog_flag.table;
+
+    GD->prolog_flag.table = NULL;
+#ifdef O_PLMT
+    t->free_symbol = freeSymbolPrologFlagTable;
+#endif
+    destroyHTable(t);
+  }
+}
+
+
 		 /*******************************
 		 *      PUBLISH PREDICATES	*
 		 *******************************/

os/pl-read.c

@@ -943,7 +943,7 @@ pl_raw_read2(term_t from, term_t term)
   int chr;
   PL_chars_t txt;
 
-  if ( !getInputStream(from, &in) )
+  if ( !getTextInputStream(from, &in) )
     fail;
 
   init_read_data(&rd, in PASS_LD);

os/pl-rl.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -40,12 +40,14 @@ SWI-Prolog.h and SWI-Stream.h
 #include "SWI-Stream.h"
 #include "SWI-Prolog.h"
 
-#if defined(__WINDOWS__) && !defined(__YAP_PROLOG__)
+#ifdef __WINDOWS__
+#ifndef __YAP_PROLOG__
 #ifdef WIN64
 #include "config/win64.h"
 #else
 #include "config/win32.h"
 #endif
+#endif
 #else
 #include <config.h>
 #endif
@@ -102,7 +104,6 @@ extern void add_history(char *);	/* should be in readline.h */
 extern int rl_begin_undo_group(void);	/* delete when conflict arrises! */
 extern int rl_end_undo_group(void);
 extern Function *rl_event_hook;
-
 #ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION
 #define rl_filename_completion_function filename_completion_function
 extern char *filename_completion_function(const char *, int);
@@ -368,7 +369,6 @@ input_on_fd(int fd)
   return select(fd+1, &rfds, NULL, NULL, &tv) != 0;
 }
 
-
 static int
 event_hook(void)
 { if ( Sinput->position )
@@ -487,9 +487,8 @@ Sread_readline(void *handle, char *buf, size_t size)
 	  rl_prep_terminal(FALSE);
 	  rl_readline_state = state;
 	  rl_done = 0;
-	} else {
+	} else
 	  line = pl_readline(prompt);
-	}
 	in_readline--;
 
 	if ( my_prompt )
@@ -515,31 +514,26 @@ Sread_readline(void *handle, char *buf, size_t size)
     }
   }
 
-#ifdef HAVE_CLOCK
-  PL_clock_wait_ticks(clock() - oldclock);
-#endif
-
   return rval;
 }
 
 
 static int
 prolog_complete(int ignore, int key)
-{ 
+{ if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' )
-  if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' )
+  { rl_begin_undo_group();
-    { rl_begin_undo_group();
+    rl_complete(ignore, key);
-      rl_complete(ignore, key);
+    if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' )
-      if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' )
+    {
-	{
 #ifdef HAVE_RL_INSERT_CLOSE		/* actually version >= 1.2 */
-	  rl_delete_text(rl_point-1, rl_point);
+      rl_delete_text(rl_point-1, rl_point);
-	  rl_point -= 1;
+      rl_point -= 1;
 #else
-	  rl_delete(-1, key);
+      rl_delete(-1, key);
 #endif
-	}
+    }
-      rl_end_undo_group();
+    rl_end_undo_group();
-    } else
+  } else
     rl_complete(ignore, key);
 
   return 0;
@@ -551,7 +545,12 @@ atom_generator(const char *prefix, int state)
 { char *s = PL_atom_generator(prefix, state);
 
   if ( s )
-    return strcpy(PL_malloc(1 + strlen(s)), s);
+  { char *copy = malloc(1 + strlen(s));
+
+    if ( copy )				/* else pretend no completion */
+      strcpy(copy, s);
+    s = copy;
+  }
 
   return s;
 }
@@ -574,20 +573,26 @@ prolog_completion(const char *text, int start, int end)
 
 #undef read				/* UXNT redefinition */
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+For some obscure reasons,  notably  libreadline   6  can  show  very bad
+interactive behaviour. There is a timeout set   to  100000 (0.1 sec). It
+isn't particularly clear what this timeout is doing. I _think_ it should
+be synchronized PL_dispatch_hook(),  and  set  to   0  if  this  hook is
+non-null.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
 install_t
 PL_install_readline(void)
 { GET_LD
-  bool old;
+  access_level_t alevel;
 
 #ifndef __WINDOWS__
   if ( !truePrologFlag(PLFLAG_TTY_CONTROL) || !isatty(0) )
     return;
 #endif
 
-  old = systemMode(TRUE);
+  alevel = setAccessLevel(ACCESS_LEVEL_SYSTEM);
-#if HAVE_DECL_RL_CATCH_SIGNALS
   rl_catch_signals = 0;
-#endif
   rl_readline_name = "Prolog";
   rl_attempted_completion_function = prolog_completion;
 #ifdef __WINDOWS__
@@ -599,6 +604,9 @@ PL_install_readline(void)
 #if HAVE_RL_INSERT_CLOSE
   rl_add_defun("insert-close", rl_insert_close, ')');
 #endif
+#if HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT	/* see (*) */
+  rl_set_keyboard_input_timeout(20000);
+#endif
 
   GD->os.rl_functions = *Sinput->functions;	/* structure copy */
   GD->os.rl_functions.read = Sread_readline;	/* read through readline */
@@ -607,14 +615,17 @@ PL_install_readline(void)
   Soutput->functions = &GD->os.rl_functions;
   Serror->functions  = &GD->os.rl_functions;
 
-  PL_register_foreign("rl_read_init_file", 1, pl_rl_read_init_file, 0);
+#define PRED(name, arity, func, attr) \
-  PL_register_foreign("rl_add_history",    1, pl_rl_add_history, PL_FA_NOTRACE);
+	PL_register_foreign_in_module("system", name, arity, func, attr)
-  PL_register_foreign("rl_write_history",  1, pl_rl_write_history, 0);
+
-  PL_register_foreign("rl_read_history",   1, pl_rl_read_history, 0);
+  PRED("rl_read_init_file", 1, pl_rl_read_init_file, 0);
+  PRED("rl_add_history",    1, pl_rl_add_history,    PL_FA_NOTRACE);
+  PRED("rl_write_history",  1, pl_rl_write_history,  0);
+  PRED("rl_read_history",   1, pl_rl_read_history,   0);
   PL_set_prolog_flag("readline",    PL_BOOL, TRUE);
   PL_set_prolog_flag("tty_control", PL_BOOL, TRUE);
   PL_license("gpl", "GNU Readline library");
-  systemMode(old);
+  setAccessLevel(alevel);
 }
 
 #else /*HAVE_LIBREADLINE*/

os/pl-stream.c

@@ -1,11 +1,10 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        J.Wielemaker@uva.nl
+    E-mail:        J.Wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2009, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,21 +18,24 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
-#if defined(__WINDOWS__)||defined(__WIN32)
+#if defined(__WINDOWS__)|| defined(__WIN32)
-#include <windows/uxnt.h>
+#include "windows/uxnt.h"
-#ifndef _YAP_NOT_INSTALLED_
+#ifdef _YAP_NOT_INSTALLED_
-#ifdef WIN64
+#include <config.h>
-#define MD "config/win64.h"
 #else
-#define MD "config/win32.h"
+#ifdef WIN64
+#include "config/win64.h"
+#else
+#include "config/win32.h"
 #endif
 #endif
 #include <winsock2.h>
-#include "windows/mswchar.h"
 #define CRLF_MAPPING 1
+#else
+#include <config.h>
 #endif
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -48,12 +50,6 @@ recursive locks. If a stream handle  might   be  known to another thread
 locking is required.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-#ifdef MD
-#include MD
-#else
-#include <config.h>
-#endif
-
 #if _FILE_OFFSET_BITS == 64 || defined(_LARGE_FILES)
 #define O_LARGEFILES 1		/* use for conditional code in Prolog */
 #else
@@ -62,8 +58,9 @@ locking is required.
 
 #define PL_KERNEL 1
 #include <wchar.h>
-typedef wchar_t pl_wchar_t;
+#define NEEDS_SWINSOCK
 #include "SWI-Stream.h"
+#include "SWI-Prolog.h"
 #include "pl-utf8.h"
 #include <sys/types.h>
 #ifdef HAVE_SYS_TIME_H
@@ -104,7 +101,7 @@ typedef wchar_t pl_wchar_t;
 #endif
 
 #define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
-#define UNDO_SIZE ROUND(MB_LEN_MAX, sizeof(wchar_t))
+#define UNDO_SIZE ROUND(PL_MB_LEN_MAX, sizeof(wchar_t))
 
 #ifndef FALSE
 #define FALSE 0
@@ -127,7 +124,7 @@ static int	S__seterror(IOSTREAM *s);
 #ifdef O_PLMT
 #define SLOCK(s)    if ( s->mutex ) recursiveMutexLock(s->mutex)
 #define SUNLOCK(s)  if ( s->mutex ) recursiveMutexUnlock(s->mutex)
-static inline int
+inline int
 STRYLOCK(IOSTREAM *s)
 { if ( s->mutex &&
        recursiveMutexTryLock(s->mutex) == EBUSY )
@@ -141,13 +138,9 @@ STRYLOCK(IOSTREAM *s)
 #define STRYLOCK(s) (TRUE)
 #endif
 
-typedef void *record_t;
-typedef void *Module;
-typedef intptr_t term_t;
-typedef intptr_t atom_t;
 #include "pl-error.h"
 
-extern int 			fatalError(const char *fm, ...);
+extern int			fatalError(const char *fm, ...);
 extern int			PL_handle_signals(void);
 extern IOENC			initEncoding(void);
 extern int			reportStreamError(IOSTREAM *s);
@@ -368,6 +361,69 @@ Sunlock(IOSTREAM *s)
 }
 
 
+		 /*******************************
+		 *		TIMEOUT		*
+		 *******************************/
+
+#ifdef HAVE_SELECT
+
+#ifndef __WINDOWS__
+typedef int SOCKET;
+#define INVALID_SOCKET -1
+#define Swinsock(s) Sfileno(s)
+#define NFDS(n) (n+1)
+#else
+#define NFDS(n) (0)			/* 1st arg of select is ignored */
+#endif
+
+
+static int
+S__wait(IOSTREAM *s)
+{ SOCKET fd = Swinsock(s);
+  fd_set wait;
+  struct timeval time;
+  int rc;
+
+  if ( fd == INVALID_SOCKET )
+  { errno = EPERM;			/* no permission to select */
+    s->flags |= SIO_FERR;
+    return -1;
+  }
+
+  time.tv_sec  = s->timeout / 1000;
+  time.tv_usec = (s->timeout % 1000) * 1000;
+  FD_ZERO(&wait);
+  FD_SET(fd, &wait);
+
+  for(;;)
+  { if ( (s->flags & SIO_INPUT) )
+      rc = select(NFDS(fd), &wait, NULL, NULL, &time);
+    else
+      rc = select(NFDS(fd), NULL, &wait, NULL, &time);
+
+    if ( rc < 0 && errno == EINTR )
+    { if ( PL_handle_signals() < 0 )
+      { errno = EPLEXCEPTION;
+	return -1;
+      }
+
+      continue;
+    }
+
+    break;
+  }
+
+  if ( rc == 0 )
+  { s->flags |= (SIO_TIMEOUT|SIO_FERR);
+    return -1;
+  }
+
+  return 0;				/* ok, data available */
+}
+
+#endif /*HAVE_SELECT*/
+
+
 		 /*******************************
 		 *	     FLUSH/FILL		*
 		 *******************************/
@@ -385,7 +441,18 @@ S__flushbuf(IOSTREAM *s)
 
   while ( from < to )
   { size_t size = (size_t)(to - from);
-    ssize_t n = (*s->functions->write)(s->handle, from, size);
+    ssize_t n;
+
+#ifdef HAVE_SELECT
+    s->flags &= ~SIO_TIMEOUT;
+
+    if ( s->timeout >= 0 )
+    { if ( (rc=S__wait(s)) < 0 )
+	goto partial;
+    }
+#endif
+
+    n = (*s->functions->write)(s->handle, from, size);
 
     if ( n > 0 )			/* wrote some */
     { from += n;
@@ -398,6 +465,9 @@ S__flushbuf(IOSTREAM *s)
     }
   }
 
+#ifdef HAVE_SELECT
+partial:
+#endif
   if ( to == from )			/* full flush */
   { rc = s->bufp - s->buffer;
     s->bufp = s->buffer;
@@ -442,52 +512,6 @@ S__flushbufc(int c, IOSTREAM *s)
 }
 
 
-static int
-Swait_for_data(IOSTREAM *s)
-{ int fd = Sfileno(s);
-  fd_set wait;
-  struct timeval time;
-  int rc;
-
-  if ( fd < 0 )
-  { errno = EPERM;			/* no permission to select */
-    s->flags |= SIO_FERR;
-    return -1;
-  }
-
-  time.tv_sec  = s->timeout / 1000;
-  time.tv_usec = (s->timeout % 1000) * 1000;
-  FD_ZERO(&wait);
-#ifdef __WINDOWS__
-  FD_SET((SOCKET)fd, &wait);
-#else
-  FD_SET(fd, &wait);
-#endif
-
-  for(;;)
-  { rc = select(fd+1, &wait, NULL, NULL, &time);
-
-    if ( rc < 0 && errno == EINTR )
-    { if ( PL_handle_signals() < 0 )
-      { errno = EPLEXCEPTION;
-	return -1;
-      }
-
-      continue;
-    }
-
-    break;
-  }
-
-  if ( rc == 0 )
-  { s->flags |= (SIO_TIMEOUT|SIO_FERR);
-    return -1;
-  }
-
-  return 0;				/* ok, data available */
-}
-
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 S__fillbuf() fills the read-buffer, returning the first character of it.
 It also realises the SWI-Prolog timeout facility.
@@ -497,8 +521,11 @@ int
 S__fillbuf(IOSTREAM *s)
 { int c;
 
-  if ( s->flags & (SIO_FEOF|SIO_FERR) )
+  if ( s->flags & (SIO_FEOF|SIO_FERR) )	/* reading past eof */
-  { s->flags |= SIO_FEOF2;		/* reading past eof */
+  { if ( s->flags & SIO_FEOF2ERR )
+      s->flags |= (SIO_FEOF2|SIO_FERR);
+    else
+      s->flags |= SIO_FEOF2;
     return -1;
   }
 
@@ -508,7 +535,7 @@ S__fillbuf(IOSTREAM *s)
   if ( s->timeout >= 0 && !s->downstream )
   { int rc;
 
-    if ( (rc=Swait_for_data(s)) < 0 )
+    if ( (rc=S__wait(s)) < 0 )
       return rc;
   }
 #endif
@@ -517,7 +544,8 @@ S__fillbuf(IOSTREAM *s)
   { char chr;
     ssize_t n;
 
-    if ( (n=(*s->functions->read)(s->handle, &chr, 1)) == 1 )
+    n = (*s->functions->read)(s->handle, &chr, 1);
+    if ( n == 1 )
     { c = char_to_int(chr);
       return c;
     } else if ( n == 0 )
@@ -548,7 +576,8 @@ S__fillbuf(IOSTREAM *s)
       len = s->bufsize;
     }
 
-    if ( (n=(*s->functions->read)(s->handle, s->limitp, len)) > 0 )
+    n = (*s->functions->read)(s->handle, s->limitp, len);
+    if ( n > 0 )
     { s->limitp += n;
       c = char_to_int(*s->bufp++);
       return c;
@@ -777,7 +806,7 @@ put_code(int c, IOSTREAM *s)
       }
       goto simple;
     case ENC_ANSI:
-    { char b[MB_LEN_MAX];
+    { char b[PL_MB_LEN_MAX];
       size_t n;
 
       if ( !s->mbstate )
@@ -863,7 +892,10 @@ Sputcode(int c, IOSTREAM *s)
   if ( s->tee && s->tee->magic == SIO_MAGIC )
     Sputcode(c, s->tee);
 
-  if ( c == '\n' && (s->flags&SIO_TEXT) && s->newline == SIO_NL_DOS )
+  if ( c == '\n' &&
+       (s->flags&SIO_TEXT) &&
+       s->newline == SIO_NL_DOS &&
+       s->lastc != '\r' )
   { if ( put_code('\r', s) < 0 )
       return -1;
   }
@@ -886,7 +918,7 @@ Scanrepresent(int c, IOSTREAM *s)
       return -1;
     case ENC_ANSI:
     { mbstate_t state;
-      char b[MB_LEN_MAX];
+      char b[PL_MB_LEN_MAX];
 
       memset(&state, 0, sizeof(state));
       if ( wcrtomb(b, (wchar_t)c, &state) != (size_t)-1 )
@@ -1072,14 +1104,15 @@ returns \n, but it returns the same for a single \n.
 
 Often, we could keep track of bufp and reset this, but we must deal with
 the case where we fetch a new buffer. In this case, we must copy the few
-remaining bytes to the `unbuffer' area.
+remaining bytes to the `unbuffer' area. If SIO_USERBUF is set, we do not
+have this spare buffer space. This  is   used  for reading from strings,
+which cannot fetch a new buffer anyway.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 int
 Speekcode(IOSTREAM *s)
 { int c;
   char *start;
-  IOPOS *psave = s->position;
   size_t safe = (size_t)-1;
 
   if ( !s->buffer )
@@ -1094,15 +1127,19 @@ Speekcode(IOSTREAM *s)
   if ( (s->flags & SIO_FEOF) )
     return -1;
 
-  if ( s->bufp + UNDO_SIZE > s->limitp )
+  if ( s->bufp + UNDO_SIZE > s->limitp && !(s->flags&SIO_USERBUF) )
   { safe = s->limitp - s->bufp;
     memcpy(s->buffer-safe, s->bufp, safe);
   }
 
   start = s->bufp;
-  s->position = NULL;
+  if ( s->position )
-  c = Sgetcode(s);
+  { IOPOS psave = *s->position;
-  s->position = psave;
+    c = Sgetcode(s);
+    *s->position = psave;
+  } else
+  { c = Sgetcode(s);
+  }
   if ( Sferror(s) )
     return -1;
 
@@ -1110,7 +1147,7 @@ Speekcode(IOSTREAM *s)
 
   if ( s->bufp > start )
   { s->bufp = start;
-  } else
+  } else if ( c != -1 )
   { assert(safe != (size_t)-1);
     s->bufp = s->buffer-safe;
   }
@@ -1341,10 +1378,6 @@ Sfeof(IOSTREAM *s)
     return -1;
   }
 
-  if ( s->downstream != NULL &&
-       Sfeof(s->downstream))
-    return TRUE;
-
   if ( S__fillbuf(s) == -1 )
     return TRUE;
 
@@ -1440,6 +1473,11 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old)
   }
 
   s->encoding = enc;
+  if ( enc == ENC_OCTET )
+    s->flags &= ~SIO_TEXT;
+  else
+    s->flags |= SIO_TEXT;
+
   return 0;
 }
 
@@ -1490,23 +1528,23 @@ Sunit_size(IOSTREAM *s)
 Return the size of the underlying data object.  Should be optimized;
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-long
+int64_t
 Ssize(IOSTREAM *s)
 { if ( s->functions->control )
-  { long size;
+  { int64_t size;
 
     if ( (*s->functions->control)(s->handle, SIO_GETSIZE, (void *)&size) == 0 )
       return size;
   }
   if ( s->functions->seek )
-  { long here = Stell(s);
+  { int64_t here = Stell64(s);
-    long end;
+    int64_t end;
 
-    if ( Sseek(s, 0, SIO_SEEK_END) == 0 )
+    if ( Sseek64(s, 0, SIO_SEEK_END) == 0 )
-      end = Stell(s);
+      end = Stell64(s);
     else
       end = -1;
-    Sseek(s, here, SIO_SEEK_SET);
+    Sseek64(s, here, SIO_SEEK_SET);
 
     return end;
   }
@@ -1667,13 +1705,13 @@ unallocStream(IOSTREAM *s)
 #ifdef O_PLMT
   if ( s->mutex )
   { recursiveMutexDelete(s->mutex);
-    free(s->mutex);
+    PL_free(s->mutex);
     s->mutex = NULL;
   }
 #endif
 
   if ( !(s->flags & SIO_STATIC) )
-    free(s);
+    PL_free(s);
 }
 
 
@@ -1711,7 +1749,7 @@ Sclose(IOSTREAM *s)
 #ifdef __WINDOWS__
   if ( (s->flags & SIO_ADVLOCK) )
   { OVERLAPPED ov;
-    HANDLE h = (HANDLE)_get_osfhandle((int)s->handle);
+    HANDLE h = (HANDLE)_get_osfhandle((int)((uintptr_t)s->handle));
 
     memset(&ov, 0, sizeof(ov));
     UnlockFileEx(h, 0, 0, 0xffffffff, &ov);
@@ -1732,9 +1770,9 @@ Sclose(IOSTREAM *s)
   if ( rval < 0 )
     reportStreamError(s);
   run_close_hooks(s);			/* deletes Prolog registration */
+  s->magic = SIO_CMAGIC;
   SUNLOCK(s);
 
-  s->magic = SIO_CMAGIC;
   if ( s->message )
     free(s->message);
   if ( s->references == 0 )
@@ -1845,11 +1883,23 @@ Svprintf(const char *fm, va_list args)
 }
 
 
-#define NEXTCHR(s, c)	if ( utf8 ) \
+#define NEXTCHR(s, c)				\
-			{ (s) = utf8_get_char((s), &(c)); \
+	switch (enc)				\
-			} else \
+	{ case ENC_ANSI:			\
-			{ c = *(s)++; c &= 0xff; \
+	    c = *(s)++; c &= 0xff;		\
-			}
+	    break;				\
+	  case ENC_UTF8:			\
+	    (s) = utf8_get_char((s), &(c));	\
+	    break;				\
+	  case ENC_WCHAR:			\
+	  { wchar_t *_w = (wchar_t*)(s);	\
+	    c = *_w++;				\
+	    (s) = (char*)_w;			\
+	    break;				\
+	  }					\
+	  default:				\
+	    break;				\
+	}
 
 #define OUTCHR(s, c)	do { printed++; \
 			     if ( Sputcode((c), (s)) < 0 ) goto error; \
@@ -1911,7 +1961,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
 	char fbuf[100], *fs = fbuf, *fe = fbuf;
 	int islong = 0;
 	int pad = ' ';
-	int utf8 = FALSE;
+	IOENC enc = ENC_ANSI;
 
 	for(;;)
 	{ switch(*fm)
@@ -1952,13 +2002,19 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
 	{ islong++;			/* 1: %ld */
 	  fm++;
 	}
-	if ( *fm == 'l' )
+	switch ( *fm )
-	{ islong++;			/* 2: %lld */
+	{ case 'l':
-	  fm++;
+	    islong++;			/* 2: %lld */
-	}
+	    fm++;
-	if ( *fm == 'U' )		/* %Us: UTF-8 string */
+	    break;
-	{ utf8 = TRUE;
+	  case 'U':			/* %Us: UTF-8 string */
-	  fm++;
+	    enc = ENC_UTF8;
+	    fm++;
+	    break;
+	  case 'W':			/* %Ws: wide string */
+	    enc = ENC_WCHAR;
+	    fm++;
+	    break;
 	}
 
 	switch(*fm)
@@ -1983,41 +2039,53 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
 	  case 'u':
 	  case 'x':
 	  case 'X':
-	  { intptr_t v = 0;			/* make compiler silent */
+	  { int      vi = 0;
-	    int64_t vl = 0;
+	    long     vl = 0;			/* make compiler silent */
+	    int64_t vll = 0;
 	    char fmbuf[8], *fp=fmbuf;
 
 	    switch( islong )
 	    { case 0:
-		v = va_arg(args, int);
+		vi = va_arg(args, int);
 	        break;
 	      case 1:
-		v = va_arg(args, long);
+		vl = va_arg(args, long);
 	        break;
 	      case 2:
-	        vl = va_arg(args, int64_t);
+	        vll = va_arg(args, int64_t);
 		break;
+	      default:
+		assert(0);
 	    }
 
 	    *fp++ = '%';
 	    if ( modified )
 	      *fp++ = '#';
-	    *fp++ = 'l';
+	    switch( islong )
-	    if ( islong < 2 )
+	    { case 0:
-	    { *fp++ = *fm;
+		*fp++ = *fm;
-	      *fp   = '\0';
+	        *fp   = '\0';
-	      SNPRINTF3(fmbuf, v);
+		SNPRINTF3(fmbuf, vi);
-	    } else
+		break;
-	    {
+	      case 1:
+		*fp++ = 'l';
+	        *fp++ = *fm;
+		*fp   = '\0';
+		SNPRINTF3(fmbuf, vl);
+		break;
+	      case 2:
 #ifdef __WINDOWS__
-	      strcat(fp-1, "I64");	/* Synchronise with INT64_FORMAT! */
+	        *fp++ = 'I';		/* Synchronise with INT64_FORMAT! */
-	      fp += strlen(fp);
+	        *fp++ = '6';
+		*fp++ = '4';
 #else
-	      *fp++ = 'l';
+	        *fp++ = 'l';
+	        *fp++ = 'l';
 #endif
-	      *fp++ = *fm;
+	        *fp++ = *fm;
-	      *fp   = '\0';
+	        *fp   = '\0';
-	      SNPRINTF3(fmbuf, vl);
+	        SNPRINTF3(fmbuf, vll);
+		break;
 	    }
 
 	    break;
@@ -2075,12 +2143,25 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
 	  { size_t w;
 
 	    if ( fs == fbuf )
-	      w = fe - fs;
+	    { w = fe - fs;
-	    else
+	    } else
-	      w = strlen(fs);
+	    { switch(enc)
-
+	      { case ENC_ANSI:
-	    if ( utf8 )
+		  w = strlen(fs);
-	      w = utf8_strlen(fs, w);
+		  break;
+		case ENC_UTF8:
+		  w = strlen(fs);
+		  w = utf8_strlen(fs, w);
+		  break;
+		case ENC_WCHAR:
+		  w = wcslen((wchar_t*)fs);
+		  break;
+		default:
+		  assert(0);
+		  w = 0;		/* make compiler happy */
+		  break;
+	      }
+	    }
 
 	    if ( (ssize_t)w < arg1 )
 	    { w = arg1 - w;
@@ -2609,7 +2690,7 @@ Scontrol_file(void *handle, int action, void *arg)
 
   switch(action)
   { case SIO_GETSIZE:
-    { intptr_t *rval = arg;
+    { int64_t *rval = arg;
       struct stat buf;
 
       if ( fstat(fd, &buf) == 0 )
@@ -2621,6 +2702,11 @@ Scontrol_file(void *handle, int action, void *arg)
     case SIO_SETENCODING:
     case SIO_FLUSHOUTPUT:
       return 0;
+    case SIO_GETFILENO:
+    { int *p = arg;
+      *p = fd;
+      return 0;
+    }
     default:
       return -1;
   }
@@ -2662,13 +2748,20 @@ provide  the  socket-id  through   Sfileno,    this   code   crashes  on
 tcp_open_socket(). As ttys and its detection is   of no value on Windows
 anyway, we skip this. Second, Windows doesn't have fork(), so FD_CLOEXEC
 is of no value.
+
+For now, we use PL_malloc_uncollectable(). In   the  end, this is really
+one of the object-types we want to leave to GC.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+#ifndef FD_CLOEXEC			/* This is not defined in MacOS */
+#define FD_CLOEXEC 1
+#endif
+
 IOSTREAM *
 Snew(void *handle, int flags, IOFUNCTIONS *functions)
 { IOSTREAM *s;
 
-  if ( !(s = malloc(sizeof(IOSTREAM))) )
+  if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) )
   { errno = ENOMEM;
     return NULL;
   }
@@ -2680,7 +2773,11 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
   s->functions     = functions;
   s->timeout       = -1;		/* infinite */
   s->posbuf.lineno = 1;
-  s->encoding      = ENC_ISO_LATIN_1;
+  if ( (flags&SIO_TEXT) )
+  { s->encoding    = initEncoding();
+  } else
+  { s->encoding	   = ENC_OCTET;
+  }
 #if CRLF_MAPPING
   s->newline       = SIO_NL_DOS;
 #endif
@@ -2688,8 +2785,8 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
     s->position = &s->posbuf;
 #ifdef O_PLMT
   if ( !(flags & SIO_NOMUTEX) )
-  { if ( !(s->mutex = malloc(sizeof(recursiveMutex))) )
+  { if ( !(s->mutex = PL_malloc(sizeof(recursiveMutex))) )
-    { free(s);
+    { PL_free(s);
       return NULL;
     }
     recursiveMutexInit(s->mutex);
@@ -2701,7 +2798,7 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
   if ( (fd = Sfileno(s)) >= 0 )
   { if ( isatty(fd) )
       s->flags |= SIO_ISATTY;
-#if defined(F_SETFD) && defined(FD_CLOEXEC)
+#ifdef F_SETFD
     fcntl(fd, F_SETFD, FD_CLOEXEC);
 #endif
   }
@@ -2804,13 +2901,23 @@ Sopen_file(const char *path, const char *how)
     struct flock buf;
 
     memset(&buf, 0, sizeof(buf));
-    buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK);
+    buf.l_whence = SEEK_SET;
+    buf.l_type   = (lock == lread ? F_RDLCK : F_WRLCK);
 
-    if ( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) < 0 )
+    while( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) != 0 )
-    { int save = errno;
+    { if ( errno == EINTR )
-      close(fd);
+      { if ( PL_handle_signals() < 0 )
-      errno = save;
+	{ close(fd);
-      return NULL;
+	  return NULL;
+	}
+	continue;
+      } else
+      { int save = errno;
+
+	close(fd);
+	errno = save;
+	return NULL;
+      }
     }
 #else					/* we don't have locking */
 #if __WINDOWS__
@@ -2891,12 +2998,10 @@ Sfileno(IOSTREAM *s)
   if ( s->flags & SIO_FILE )
   { intptr_t h = (intptr_t)s->handle;
     n = (int)h;
-  } else if ( s->flags & SIO_PIPE )
-  { n = fileno((FILE *)s->handle);
   } else if ( s->functions->control &&
 	      (*s->functions->control)(s->handle,
 				       SIO_GETFILENO,
-				       (void *)&n)  == 0 )
+				       (void *)&n) == 0 )
   { ;
   } else
   { errno = EINVAL;
@@ -2907,6 +3012,30 @@ Sfileno(IOSTREAM *s)
 }
 
 
+#ifdef __WINDOWS__
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+On  Windows,  type  SOCKET  is   an    unsigned   int   and  all  values
+[0..INVALID_SOCKET) are valid. It is  also   not  allowed  to run normal
+file-functions on it or the application will crash. There seems to be no
+way out except for introducing an extra function at this level :-(
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+SOCKET
+Swinsock(IOSTREAM *s)
+{ SOCKET n = INVALID_SOCKET;
+
+  if ( s->functions->control &&
+       (*s->functions->control)(s->handle,
+				SIO_GETWINSOCK,
+				(void *)&n) == 0 )
+  { return n;
+  }
+
+  errno = EINVAL;
+  return INVALID_SOCKET;
+}
+#endif
+
 		 /*******************************
 		 *	       PIPES		*
 		 *******************************/
@@ -2915,13 +3044,9 @@ Sfileno(IOSTREAM *s)
 #ifdef __WINDOWS__
 #include "windows/popen.c"
 
-#ifdef popen
 #undef popen
-#endif
-#define popen(cmd, how) pt_popen(cmd, how)
-#ifdef pclose
 #undef pclose
-#endif
+#define popen(cmd, how) pt_popen(cmd, how)
 #define pclose(fd)	pt_pclose(fd)
 #endif
 
@@ -2958,11 +3083,31 @@ Sclose_pipe(void *handle)
 }
 
 
+static int
+Scontrol_pipe(void *handle, int action, void *arg)
+{ FILE *fp = handle;
+
+  switch(action)
+  { case SIO_GETFILENO:
+    { int *ap = arg;
+      *ap = fileno(fp);
+      return 0;
+    }
+    case SIO_FLUSHOUTPUT:
+    case SIO_SETENCODING:
+      return 0;
+    default:
+      return -1;
+  }
+}
+
+
 IOFUNCTIONS Spipefunctions =
 { Sread_pipe,
   Swrite_pipe,
   (Sseek_function)0,
-  Sclose_pipe
+  Sclose_pipe,
+  Scontrol_pipe
 };
 
 
@@ -2983,9 +3128,9 @@ Sopen_pipe(const char *command, const char *type)
   { int flags;
 
     if ( *type == 'r' )
-      flags = SIO_PIPE|SIO_INPUT|SIO_FBUF;
+      flags = SIO_INPUT|SIO_FBUF;
     else
-      flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF;
+      flags = SIO_OUTPUT|SIO_FBUF;
 
     return Snew((void *)fd, flags, &Spipefunctions);
   }
@@ -3229,12 +3374,20 @@ Sopenmem(char **buffer, size_t *sizep, const char *mode)
 
 static ssize_t
 Sread_string(void *handle, char *buf, size_t size)
-{ return 0;				/* signal EOF */
+{ (void)handle;
+  (void)buf;
+  (void)size;
+
+  return 0;				/* signal EOF */
 }
 
 static ssize_t
 Swrite_string(void *handle, char *buf, size_t size)
-{ errno = ENOSPC;			/* signal error */
+{ (void)handle;
+  (void)buf;
+  (void)size;
+
+  errno = ENOSPC;			/* signal error */
   return -1;
 }
 
@@ -3267,7 +3420,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
 { int flags = SIO_FBUF|SIO_USERBUF;
 
   if ( !s )
-  { if ( !(s = malloc(sizeof(IOSTREAM))) )
+  { if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) ) /* TBD: Use GC */
     { errno = ENOMEM;
       return NULL;
     }
@@ -3310,7 +3463,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
 
 #define STDIO(n, f) { NULL, NULL, NULL, NULL, \
 		      EOF, SIO_MAGIC, 0, f, {0, 0, 0}, NULL, \
-		      ((void *)(n)), &Sttyfunctions, \
+		      (void *)(n), &Sttyfunctions, \
 		      0, NULL, \
 		      (void (*)(void *))0, NULL, \
 		      -1, \
@@ -3321,7 +3474,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
 #define SIO_STDIO (SIO_FILE|SIO_STATIC|SIO_NOCLOSE|SIO_ISATTY|SIO_TEXT)
 #define STDIO_STREAMS \
   STDIO(0, SIO_STDIO|SIO_LBUF|SIO_INPUT|SIO_NOFEOF),	/* Sinput */ \
-  STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), 	/* Soutput */ \
+  STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL),	/* Soutput */ \
   STDIO(2, SIO_STDIO|SIO_NBUF|SIO_OUTPUT|SIO_REPPL)	/* Serror */
 
 
@@ -3335,31 +3488,33 @@ static const IOSTREAM S__iob0[] =
 };
 
 
-/* vsc: Scleanup should reset init done */
+static int S__initialised = FALSE;
-static int done;
 
 void
 SinitStreams(void)
-{
+{ if ( !S__initialised )
-
-  if ( !done++ )
   { int i;
-    IOENC enc = initEncoding();
+    IOENC enc;
+
+    S__initialised = TRUE;
+    enc = initEncoding();
 
     for(i=0; i<=2; i++)
-    { if ( !isatty(i) )
+    { IOSTREAM *s = &S__iob[i];
-      { S__iob[i].flags &= ~SIO_ISATTY;
+
-	S__iob[i].functions = &Sfilefunctions; /* Check for pipe? */
+      if ( !isatty(i) )
+      { s->flags &= ~SIO_ISATTY;
+	s->functions = &Sfilefunctions; /* Check for pipe? */
       }
-      if ( S__iob[i].encoding == ENC_ISO_LATIN_1 )
+      if ( s->encoding == ENC_ISO_LATIN_1 )
-	S__iob[i].encoding = enc;
+	s->encoding = enc;
 #ifdef O_PLMT
-      S__iob[i].mutex = malloc(sizeof(recursiveMutex));
+      s->mutex = PL_malloc(sizeof(recursiveMutex));
-      recursiveMutexInit(S__iob[i].mutex);
+      recursiveMutexInit(s->mutex);
 #endif
 #if CRLF_MAPPING
       _setmode(i, O_BINARY);
-      S__iob[i].newline = SIO_NL_DOS;
+      s->newline = SIO_NL_DOS;
 #endif
     }
 
@@ -3371,7 +3526,7 @@ SinitStreams(void)
 
 
 IOSTREAM *
-S__getiob()
+S__getiob(void)
 { return S__iob;
 }
 
@@ -3461,11 +3616,12 @@ Scleanup(void)
 
       S__iob[i].mutex = NULL;
       recursiveMutexDelete(m);
-      free(m);
+      PL_free(m);
     }
 #endif
 
     *s = S__iob0[i];			/* re-initialise */
   }
-  done = 0;
+
+  S__initialised = FALSE;
 }

os/pl-string.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "pl-incl.h"
@@ -34,45 +34,10 @@ String operations that are needed for the shared IO library.
 		 *	     ALLOCATION		*
 		 *******************************/
 
-#ifdef O_DEBUG
-#define CHAR_INUSE 0x42
-#define CHAR_FREED 0x41
-
 char *
 store_string(const char *s)
 { if ( s )
-  { GET_LD
+  { char *copy = (char *)allocHeapOrHalt(strlen(s)+1);
-    char *copy = (char *)allocHeap(strlen(s)+2);
-
-    *copy++ = CHAR_INUSE;
-    strcpy(copy, s);
-
-    return copy;
-  } else
-  { return NULL;
-  }
-}
-
-
-void
-remove_string(char *s)
-{ if ( s )
-  { GET_LD
-    assert(s[-1] == CHAR_INUSE);
-
-    s[-1] = CHAR_FREED;
-    freeHeap(s-1, strlen(s)+2);
-  }
-}
-
-#else /*O_DEBUG*/
-
-char *
-store_string(const char *s)
-{ if ( s )
-  { GET_LD
-
-    char *copy = (char *)allocHeap(strlen(s)+1);
 
     strcpy(copy, s);
     return copy;
@@ -85,14 +50,9 @@ store_string(const char *s)
 void
 remove_string(char *s)
 { if ( s )
-  { GET_LD
     freeHeap(s, strlen(s)+1);
-  }
 }
 
-#endif /*O_DEBUG*/
-
-
 		 /*******************************
 		 *	     NUMBERS		*
 		 *******************************/
@@ -239,13 +199,13 @@ int_mbscoll(const char *s1, const char *s2, int icase)
   if ( l1 < 1024 && (w1 = alloca(sizeof(wchar_t)*(l1+1))) )
   { ml1 = FALSE;
   } else
-  { w1 = PL_malloc(sizeof(wchar_t)*(l1+1));
+  { w1 = PL_malloc_atomic(sizeof(wchar_t)*(l1+1));
     ml1 = TRUE;
   }
   if ( l2 < 1024 && (w2 = alloca(sizeof(wchar_t)*(l2+1))) )
   { ml2 = FALSE;
   } else
-  { w2 = PL_malloc(sizeof(wchar_t)*(l2+1));
+  { w2 = PL_malloc_atomic(sizeof(wchar_t)*(l2+1));
     ml2 = TRUE;
   }
 

os/pl-string.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifndef PL_STRING_H_INCLUDED
@@ -27,7 +27,7 @@
 
 COMMON(char *) 		store_string(const char *s);
 COMMON(void) 		remove_string(char *s);
-COMMON(char) 		digitName(int n, int smll);
+//COMMON(char) 		digitName(int n, int small);
 COMMON(int) 		digitValue(int b, int c);
 COMMON(bool) 		strprefix(const char *string, const char *prefix);
 COMMON(bool) 		strpostfix(const char *string, const char *postfix);

os/pl-table.c

@@ -1,11 +1,10 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        jan@swi.psy.uva.nl
+    E-mail:        J.Wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2002, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
+			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +18,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 /*#define O_DEBUG 1*/
@@ -41,35 +40,35 @@ create, advance over and destroy enumerator   objects. These objects are
 used to enumerate the symbols of these   tables,  used primarily for the
 pl_current_* predicates.
 
-The  enumerators  cause  two  things:  (1)    as  intptr_t  enumerators  are
+The enumerators cause  two  things:  (1)   as  long  as  enumerators are
 associated, the table will not  be  rehashed   and  (2)  if  symbols are
 deleted  that  are  referenced  by  an  enumerator,  the  enumerator  is
-automatically advanced to the next free symbol.  This, in general, makes
+automatically advanced to the next free  symbol. This, in general, makes
 the enumeration of hash-tables safe.
 
-TODO: abort should delete  any  pending   enumerators.  This  should  be
+TBD: Resizing hash-tables causes major  headaches for concurrent access.
-thread-local, as thread_exit/1 should do the same.
+We can avoid this by using a dynamic array for the list of hash-entries.
+Ongoing work in  the  RDF  store   shows  hash-tables  that  can  handle
+concurrent lock-free access.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-static void
+static Symbol *
-allocHTableEntries(Table ht)
+allocHTableEntries(int buckets)
-{ GET_LD
+{ size_t bytes = buckets * sizeof(Symbol);
-  int n;
   Symbol *p;
 
-  ht->entries = allocHeap(ht->buckets * sizeof(Symbol));
+  p = allocHeapOrHalt(bytes);
+  memset(p, 0, bytes);
 
-  for(n=0, p = &ht->entries[0]; n < ht->buckets; n++, p++)
+  return p;
-    *p = NULL;
 }
 
 
 Table
 newHTable(int buckets)
-{ GET_LD
+{ Table ht;
-  Table ht;
 
-  ht		  = allocHeap(sizeof(struct table));
+  ht		  = allocHeapOrHalt(sizeof(struct table));
   ht->buckets	  = (buckets & ~TABLE_MASK);
   ht->size	  = 0;
   ht->enumerators = NULL;
@@ -79,25 +78,24 @@ newHTable(int buckets)
   if ( (buckets & TABLE_UNLOCKED) )
     ht->mutex = NULL;
   else
-  { ht->mutex     = allocHeap(sizeof(simpleMutex));
+  { ht->mutex     = allocHeapOrHalt(sizeof(simpleMutex));
     simpleMutexInit(ht->mutex);
   }
 #endif
 
-  allocHTableEntries(ht);
+  ht->entries = allocHTableEntries(ht->buckets);
   return ht;
 }
 
 
 void
 destroyHTable(Table ht)
-{ GET_LD
+{
-
 #ifdef O_PLMT
   if ( ht->mutex )
   { simpleMutexDelete(ht->mutex);
     freeHeap(ht->mutex, sizeof(*ht->mutex));
-	ht->mutex = NULL;
+    ht->mutex = NULL;
   }
 #endif
 
@@ -107,19 +105,19 @@ destroyHTable(Table ht)
 }
 
 
-#if O_DEBUG || O_HASHSTAT
+#if O_DEBUG
-#define HASHSTAT(c) c
 static int lookups;
 static int cmps;
 
 void
 exitTables(int status, void *arg)
-{ Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
+{ (void)status;
+  (void)arg;
+
+  Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
 	   lookups, cmps);
 }
-#else
+#endif
-#define HASHSTAT(c)
-#endif /*O_DEBUG*/
 
 
 void
@@ -129,7 +127,7 @@ initTables(void)
   if ( !done )
   { done = TRUE;
 
-    HASHSTAT(PL_on_halt(exitTables, NULL));
+    DEBUG(MSG_HASH_STAT, PL_on_halt(exitTables, NULL));
   }
 }
 
@@ -138,9 +136,9 @@ Symbol
 lookupHTable(Table ht, void *name)
 { Symbol s = ht->entries[pointerHashValue(name, ht->buckets)];
 
-  HASHSTAT(lookups++);
+  DEBUG(MSG_HASH_STAT, lookups++);
   for( ; s; s = s->next)
-  { HASHSTAT(cmps++);
+  { DEBUG(MSG_HASH_STAT, cmps++);
     if ( s->name == name )
       return s;
   }
@@ -170,41 +168,79 @@ checkHTable(Table ht)
 /* MT: Locked by calling addHTable()
 */
 
-static void
+static Symbol
-rehashHTable(Table ht)
+rehashHTable(Table ht, Symbol map)
-{ GET_LD
+{ Symbol *newentries, *oldentries;
-  Symbol *oldtab;
+  int     newbuckets, oldbuckets;
-  int    oldbucks;
+  int     i;
-  int    i;
+#ifdef O_PLMT
+  int     safe_copy = (ht->mutex != NULL);
+#else
+  int     safe_copy = TRUE;
+#endif
 
-  oldtab   = ht->entries;
+  newbuckets = ht->buckets*2;
-  oldbucks = ht->buckets;
+  newentries = allocHTableEntries(newbuckets);
-  ht->buckets *= 2;
-  allocHTableEntries(ht);
 
-  DEBUG(1, Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
+  DEBUG(MSG_HASH_STAT,
+	Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
 
-  for(i=0; i<oldbucks; i++)
+  for(i=0; i<ht->buckets; i++)
   { Symbol s, n;
 
-    for(s=oldtab[i]; s; s = n)
+    if ( safe_copy )
-    { int v = (int)pointerHashValue(s->name, ht->buckets);
+    { for(s=ht->entries[i]; s; s = n)
+      { int v = (int)pointerHashValue(s->name, newbuckets);
+	Symbol s2 = allocHeapOrHalt(sizeof(*s2));
 
-      n = s->next;
+	n = s->next;
-      s->next = ht->entries[v];
+	if ( s == map )
-      ht->entries[v] = s;
+	  map = s2;
+	*s2 = *s;
+	s2->next = newentries[v];
+	newentries[v] = s2;
+      }
+    } else
+    { for(s=ht->entries[i]; s; s = n)
+      { int v = (int)pointerHashValue(s->name, newbuckets);
+
+	n = s->next;
+	s->next = newentries[v];
+	newentries[v] = s;
+      }
     }
   }
 
-  freeHeap(oldtab, oldbucks * sizeof(Symbol));
+  oldentries  = ht->entries;
-  DEBUG(0, checkHTable(ht));
+  oldbuckets  = ht->buckets;
+  ht->entries = newentries;
+  ht->buckets = newbuckets;
+
+  if ( safe_copy )
+  {					/* Here we should be waiting until */
+					/* active lookup are finished */
+    for(i=0; i<oldbuckets; i++)
+    { Symbol s, n;
+
+      for(s=oldentries[i]; s; s = n)
+      { n = s->next;
+
+	s->next = NULL;			/* that causes old readers to stop */
+	freeHeap(s, sizeof(*s));
+      }
+    }
+  }
+
+  freeHeap(oldentries, oldbuckets * sizeof(Symbol));
+  DEBUG(CHK_SECURE, checkHTable(ht));
+
+  return map;
 }
 
 
 Symbol
 addHTable(Table ht, void *name, void *value)
-{ GET_LD
+{ Symbol s;
-  Symbol s;
   int v;
 
   LOCK_TABLE(ht);
@@ -213,7 +249,7 @@ addHTable(Table ht, void *name, void *value)
   { UNLOCK_TABLE(ht);
     return NULL;
   }
-  s = allocHeap(sizeof(struct symbol));
+  s = allocHeapOrHalt(sizeof(struct symbol));
   s->name  = name;
   s->value = value;
   s->next  = ht->entries[v];
@@ -223,7 +259,7 @@ addHTable(Table ht, void *name, void *value)
 		    ht, name, value, ht->size));
 
   if ( ht->buckets * 2 < ht->size && !ht->enumerators )
-    rehashHTable(ht);
+    s = rehashHTable(ht, s);
   UNLOCK_TABLE(ht);
 
   DEBUG(1, checkHTable(ht));
@@ -237,8 +273,7 @@ Note: s must be in the table!
 
 void
 deleteSymbolHTable(Table ht, Symbol s)
-{ GET_LD
+{ int v;
-  int v;
   Symbol *h;
   TableEnum e;
 
@@ -255,6 +290,9 @@ deleteSymbolHTable(Table ht, Symbol s)
   { if ( *h == s )
     { *h = (*h)->next;
 
+      s->next = NULL;				/* force crash */
+      s->name = NULL;
+      s->value = NULL;
       freeHeap(s, sizeof(struct symbol));
       ht->size--;
 
@@ -268,8 +306,7 @@ deleteSymbolHTable(Table ht, Symbol s)
 
 void
 clearHTable(Table ht)
-{ GET_LD
+{ int n;
-  int n;
   TableEnum e;
 
   LOCK_TABLE(ht);
@@ -309,24 +346,23 @@ Table copyHTable(Table org)
 
 Table
 copyHTable(Table org)
-{ GET_LD
+{ Table ht;
-  Table ht;
   int n;
 
-  ht = allocHeap(sizeof(struct table));
+  ht = allocHeapOrHalt(sizeof(struct table));
   LOCK_TABLE(org);
   *ht = *org;				/* copy all attributes */
 #ifdef O_PLMT
   ht->mutex = NULL;
 #endif
-  allocHTableEntries(ht);
+  ht->entries = allocHTableEntries(ht->buckets);
 
   for(n=0; n < ht->buckets; n++)
   { Symbol s, *q;
 
     q = &ht->entries[n];
     for(s = org->entries[n]; s; s = s->next)
-    { Symbol s2 = allocHeap(sizeof(*s2));
+    { Symbol s2 = allocHeapOrHalt(sizeof(*s2));
 
       *q = s2;
       q = &s2->next;
@@ -340,7 +376,7 @@ copyHTable(Table org)
   }
 #ifdef O_PLMT
   if ( org->mutex )
-  { ht->mutex = allocHeap(sizeof(simpleMutex));
+  { ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
     simpleMutexInit(ht->mutex);
   }
 #endif
@@ -356,8 +392,7 @@ copyHTable(Table org)
 
 TableEnum
 newTableEnum(Table ht)
-{ GET_LD
+{ TableEnum e = allocHeapOrHalt(sizeof(struct table_enum));
-  TableEnum e = allocHeap(sizeof(struct table_enum));
   Symbol n;
 
   LOCK_TABLE(ht);
@@ -378,8 +413,7 @@ newTableEnum(Table ht)
 
 void
 freeTableEnum(TableEnum e)
-{ GET_LD
+{ TableEnum *ep;
-  TableEnum *ep;
   Table ht;
 
   if ( !e )

os/pl-table.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifndef TABLE_H_INCLUDED
@@ -27,7 +27,7 @@
 
 typedef struct table *		Table;		/* (numeric) hash table */
 typedef struct symbol *		Symbol;		/* symbol of hash table */
-typedef struct table_enum *	TableEnum; 	/* Enumerate table entries */
+typedef struct table_enum *	TableEnum;	/* Enumerate table entries */
 
 struct table
 { int		buckets;	/* size of hash table */
@@ -36,8 +36,8 @@ struct table
 #ifdef O_PLMT
   simpleMutex  *mutex;		/* Mutex to guard table */
 #endif
-  void 		(*copy_symbol)(Symbol s);
+  void		(*copy_symbol)(Symbol s);
-  void 		(*free_symbol)(Symbol s);
+  void		(*free_symbol)(Symbol s);
   Symbol	*entries;	/* array of hash symbols */
 };
 
@@ -54,17 +54,17 @@ struct table_enum
   TableEnum	next;		/* More choice points */
 };
 
-COMMON(void) 		initTables(void);
+COMMON(void)		initTables(void);
-COMMON(Table) 		newHTable(int size);
+COMMON(Table)		newHTable(int size);
-COMMON(void) 		destroyHTable(Table ht);
+COMMON(void)		destroyHTable(Table ht);
-COMMON(Symbol) 		lookupHTable(Table ht, void *name);
+COMMON(Symbol)		lookupHTable(Table ht, void *name);
-COMMON(Symbol) 		addHTable(Table ht, void *name, void *value);
+COMMON(Symbol)		addHTable(Table ht, void *name, void *value);
-COMMON(void) 		deleteSymbolHTable(Table ht, Symbol s);
+COMMON(void)		deleteSymbolHTable(Table ht, Symbol s);
-COMMON(void) 		clearHTable(Table ht);
+COMMON(void)		clearHTable(Table ht);
-COMMON(Table) 		copyHTable(Table org);
+COMMON(Table)		copyHTable(Table org);
-COMMON(TableEnum) 	newTableEnum(Table ht);
+COMMON(TableEnum)	newTableEnum(Table ht);
-COMMON(void) 		freeTableEnum(TableEnum e);
+COMMON(void)		freeTableEnum(TableEnum e);
-COMMON(Symbol) 		advanceTableEnum(TableEnum e);
+COMMON(Symbol)		advanceTableEnum(TableEnum e);
 
 #define TABLE_UNLOCKED		0x10000000L /* do not create mutex for table */
 #define TABLE_MASK		0xf0000000UL

os/pl-tai.c

@@ -1,11 +1,9 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
     E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2010, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
 			      VU University Amsterdam
 
     This library is free software; you can redistribute it and/or
@@ -20,17 +18,10 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#define __MINGW_USE_VC2005_COMPAT		/* Get Windows time_t as 64-bit */
-Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS
-is supposed to give the POSIX standard one.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-#if defined(__sun__) || defined(__sun)
-#define _POSIX_PTHREAD_SEMANTICS 1
-#endif
 
 #include <math.h>
 #include "pl-incl.h"
@@ -62,37 +53,6 @@ extern long timezone;
 #endif
 #endif
 
-#if defined(__MINGW32__)
-#include <stdlib.h>
-#include <time.h>
-#include <string.h>
-
-#ifndef localtime_r
-struct tm *localtime_r (const time_t *, struct tm *);
-
-struct tm *
-localtime_r (const time_t *timer, struct tm *result)
-{
-   struct tm *local_result;
-   local_result = localtime (timer);
-
-   if (local_result == NULL || result == NULL)
-     return NULL;
-
-   memcpy (result, local_result, sizeof (result));
-   return result;
-}
-#endif
-
-#ifndef asctime_r
-#define asctime_r(_Tm, _Buf)	({ char *___tmp_tm = asctime((_Tm));	\
-						if (___tmp_tm)		\
-						 ___tmp_tm =		\
-						   strcpy((_Buf),___tmp_tm);\
-						___tmp_tm;	})
-#endif
-#endif
-
 #define TAI_UTC_OFFSET LL(4611686018427387914)
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -102,6 +62,8 @@ struct ftm is a `floating' version of the system struct tm.
 #define		HAS_STAMP	0x0001
 #define		HAS_WYDAY	0x0002
 
+#define		NO_UTC_OFFSET	0x7fffffff
+
 typedef struct ftm
 { struct	tm tm;			/* System time structure */
   double	sec;			/* float version of tm.tm_sec */
@@ -147,7 +109,7 @@ tz_offset(void)
   { time_t t = time(NULL);
     struct tm tm;
 
-    localtime_r(&t, &tm);
+    PL_localtime_r(&t, &tm);
 
     offset = -tm.tm_gmtoff;
     if ( tm.tm_isdst > 0 )
@@ -177,7 +139,7 @@ static atom_t
 tz_name_as_atom(int dst)
 { static atom_t a[2];
 
-  dst = (dst != 0);			/* 0 or 1 */
+  dst = (dst > 0);			/* 0 or 1 */
 
   if ( !a[dst] )
   { wchar_t wbuf[256];
@@ -245,10 +207,12 @@ get_tz_arg(int i, term_t t, term_t a, atom_t *tz)
   atom_t name;
 
   _PL_get_arg(i, t, a);
-  if ( !PL_get_atom_ex(a, &name) )
+  if ( !PL_is_variable(a) )
-    fail;
+  { if ( !PL_get_atom_ex(a, &name) )
-  if ( name != ATOM_minus )
+      fail;
-    *tz = name;
+    if ( name != ATOM_minus )
+      *tz = name;
+  }
 
   succeed;
 }
@@ -264,6 +228,21 @@ get_int_arg(int i, term_t t, term_t a, int *val)
 }
 
 
+static int
+get_voff_arg(int i, term_t t, term_t a, int *val)
+{ GET_LD
+
+  _PL_get_arg(i, t, a);
+
+  if ( PL_is_variable(a) )
+  { *val = NO_UTC_OFFSET;
+    return TRUE;
+  } else
+  { return PL_get_integer_ex(a, val);
+  }
+}
+
+
 static int
 get_float_arg(int i, term_t t, term_t a, double *val)
 { GET_LD
@@ -275,7 +254,7 @@ get_float_arg(int i, term_t t, term_t a, double *val)
 
 
 static int
-get_bool_arg(int i, term_t t, term_t a, int *val)
+get_dst_arg(int i, term_t t, term_t a, int *val)
 { GET_LD
   atom_t name;
 
@@ -284,10 +263,16 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
   { if ( name == ATOM_true )
     { *val = TRUE;
       return TRUE;
-    } else if ( name == ATOM_false || name == ATOM_minus )
+    } else if ( name == ATOM_false )
     { *val = FALSE;
       return TRUE;
+    } else if ( name == ATOM_minus )
+    { *val = -1;
+      return TRUE;
     }
+  } else if ( PL_is_variable(a) )
+  { *val = -2;
+    return TRUE;
   }
 
   return PL_get_bool_ex(a, val);	/* generate an error */
@@ -297,23 +282,25 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
 static int
 get_ftm(term_t t, ftm *ftm)
 { GET_LD
+  term_t tmp = PL_new_term_ref();
+  int date9;
 
-  if ( PL_is_functor(t, FUNCTOR_date9) )
+  memset(ftm, 0, sizeof(*ftm));
-  { term_t tmp = PL_new_term_ref();
 
-    memset(ftm, 0, sizeof(*ftm));
+  if ( (date9=PL_is_functor(t, FUNCTOR_date9)) )
-
+  { if ( get_int_arg  (1, t, tmp, &ftm->tm.tm_year) &&
-    if ( get_int_arg  (1, t, tmp, &ftm->tm.tm_year) &&
 	 get_int_arg  (2, t, tmp, &ftm->tm.tm_mon)  &&
 	 get_int_arg  (3, t, tmp, &ftm->tm.tm_mday) &&
 	 get_int_arg  (4, t, tmp, &ftm->tm.tm_hour) &&
 	 get_int_arg  (5, t, tmp, &ftm->tm.tm_min)  &&
 	 get_float_arg(6, t, tmp, &ftm->sec)	    &&
-	 get_int_arg  (7, t, tmp, &ftm->utcoff)     &&
+	 get_voff_arg (7, t, tmp, &ftm->utcoff)     &&
 	 get_tz_arg   (8, t, tmp, &ftm->tzname)     &&
-	 get_bool_arg (9, t, tmp, &ftm->isdst) )
+	 get_dst_arg  (9, t, tmp, &ftm->isdst) )
     { double fp, ip;
 
+      ftm->tm.tm_isdst = (ftm->isdst == -2 ? -1 : ftm->isdst);
+
     fixup:
       fp = modf(ftm->sec, &ip);
       if ( fp < 0.0 )
@@ -325,20 +312,62 @@ get_ftm(term_t t, ftm *ftm)
       ftm->tm.tm_year -= 1900;		/* 1900 based */
       ftm->tm.tm_mon--;			/* 0-based */
 
+      if ( ftm->utcoff == NO_UTC_OFFSET )
+      { if ( ftm->tm.tm_isdst < 0 )	/* unknown DST */
+	{ int offset;
+
+	  if ( mktime(&ftm->tm) == (time_t)-1 )
+	    return PL_representation_error("dst");
+	  ftm->flags |= HAS_WYDAY;
+
+	  offset = tz_offset();
+	  if ( ftm->tm.tm_isdst > 0 )
+	    offset -= 3600;
+	  ftm->utcoff = offset;
+
+	  if ( date9 ) /* variable */
+	  { _PL_get_arg(7, t, tmp);
+	    if ( !PL_unify_integer(tmp, ftm->utcoff) )
+	      return FALSE;
+	  } else
+	  { ftm->utcoff = offset;
+	  }
+	}
+
+	if ( ftm->isdst == -2 )
+	{ ftm->isdst = ftm->tm.tm_isdst;
+	  _PL_get_arg(9, t, tmp);
+	  if ( ftm->isdst < 0 )
+	  { if ( !PL_unify_atom(tmp, ATOM_minus) )
+	      return FALSE;
+	  } else
+	  { if ( !PL_unify_bool(tmp, ftm->isdst) )
+	      return FALSE;
+	  }
+	}
+
+	if ( !ftm->tzname )
+	{ ftm->tzname = tz_name_as_atom(ftm->isdst);
+	  _PL_get_arg(8, t, tmp);
+	  if ( PL_is_variable(tmp) &&
+	       !PL_unify_atom(tmp, ftm->tzname) )
+	    return FALSE;
+	}
+      }
+
       succeed;
     }
   } else if ( PL_is_functor(t, FUNCTOR_date3) )
-  { term_t tmp = PL_new_term_ref();
+  { if ( get_int_arg  (1, t, tmp, &ftm->tm.tm_year) &&
-
-    memset(ftm, 0, sizeof(*ftm));
-
-    if ( get_int_arg  (1, t, tmp, &ftm->tm.tm_year) &&
 	 get_int_arg  (2, t, tmp, &ftm->tm.tm_mon)  &&
 	 get_int_arg  (3, t, tmp, &ftm->tm.tm_mday) )
+    { ftm->tm.tm_isdst = -1;
+      ftm->utcoff = NO_UTC_OFFSET;
       goto fixup;
+    }
   }
 
-  fail;
+  return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, t);
 }
 
 
@@ -407,7 +436,7 @@ PRED_IMPL("stamp_date_time", 3, stamp_date_time, 0)
 	if ( (int64_t)unixt == ut64 )
 	{ double ip;
 
-	  localtime_r(&unixt, &tm);
+	  PL_localtime_r(&unixt, &tm);
 	  sec = (double)tm.tm_sec + modf(argsec, &ip);
 	  ct.date.year  = tm.tm_year+1900;
 	  ct.date.month = tm.tm_mon+1;
@@ -562,7 +591,7 @@ fmt_not_implemented(int c)
 	{ format_time(fd, f, ftm, posix); \
 	}
 #define OUTCHR(fd, c) \
- 	{ Sputcode(c, fd); \
+	{ Sputcode(c, fd); \
 	}
 #define OUTSTR(str) \
 	{ Sfputs(str, fd); \
@@ -654,7 +683,6 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
 	  case_b:
 	  { char fmt[3];
 	    char buf[256];
-	    size_t n;
 
 	    fmt[0] = '%';
 	    fmt[1] = (char)c;
@@ -662,7 +690,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
 
 	    cal_ftm(ftm, HAS_STAMP|HAS_WYDAY);
 					/* conversion is not thread-safe under locale switch */
-	    n = strftime(buf, sizeof(buf), fmt, &ftm->tm);
+	    strftime(buf, sizeof(buf), fmt, &ftm->tm);
 	    OUTSTRA(buf);
 	    break;
 	  }
@@ -856,7 +884,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
 	    { char buf[26];
 
 	      cal_ftm(ftm, HAS_WYDAY);
-	      asctime_r(&ftm->tm, buf);
+	      PL_asctime_r(&ftm->tm, buf);
 	      buf[24] = EOS;
 	      OUTSTRA(buf);
 	    }
@@ -920,7 +948,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
 
     if ( (int64_t)unixt == ut64 )
     { tb.utcoff = tz_offset();
-      localtime_r(&unixt, &tb.tm);
+      PL_localtime_r(&unixt, &tb.tm);
       tb.sec = (double)tb.tm.tm_sec + modf(tb.stamp, &ip);
       if ( tb.tm.tm_isdst > 0 )
       { tb.utcoff -= 3600;
@@ -942,7 +970,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
       tb.utcoff     = 0;
     }
   } else if ( !get_ftm(time, &tb) )
-  { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, time);
+  { return FALSE;
   }
 
   if ( !setupOutputRedirect(out, &ctx, FALSE) )

os/pl-text.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "pl-incl.h"
@@ -28,9 +28,6 @@
 #include "pl-codelist.h"
 #include <errno.h>
 #include <stdio.h>
-#ifdef __WINDOWS__
-#include "pl-mswchar.h"			/* Terrible hack */
-#endif
 #if HAVE_LIMITS_H
 #include <limits.h>			/* solaris compatibility */
 #endif
@@ -121,12 +118,52 @@ PL_from_stack_text(PL_chars_t *text)
 }
 
 
+#define INT64_DIGITS 20
+
+static char *
+ui64toa(uint64_t val, char *out)
+{ char tmpBuf[INT64_DIGITS + 1];
+  char *ptrOrg = tmpBuf + INT64_DIGITS;
+  char *ptr = ptrOrg;
+  size_t nbDigs;
+
+  do
+  { int rem = val % 10;
+
+    *--ptr = rem + '0';
+    val /= 10;
+  } while ( val );
+
+  nbDigs = ptrOrg - ptr;
+  memcpy(out, ptr, nbDigs);
+  out += nbDigs;
+  *out = '\0';
+
+  return out;				/* points to the END */
+};
+
+
+static char *
+i64toa(int64_t val, char *out)
+{ if ( val < 0 )
+  { *out++ = '-';
+    val = -val;
+  }
+
+  return ui64toa((uint64_t)val, out);
+}
+
+
 int
 PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
 { word w = valHandle(l);
 
   if ( (flags & CVT_ATOM) && isAtom(w) )
+#if __YAP_PROLOG__
     { if ( !get_atom_text(atomFromTerm(w), text) )
+#else
+    { if ( !get_atom_text(w, text) )
+#endif
       goto maybe_write;
   } else if ( (flags & CVT_STRING) && isString(w) )
   { if ( !get_string_text(w, text PASS_LD) )
@@ -138,17 +175,20 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
     PL_get_number(l, &n);
     switch(n.type)
     { case V_INTEGER:
-	sprintf(text->buf, INT64_FORMAT, n.value.i);
+      { char *ep = i64toa(n.value.i, text->buf);
+
         text->text.t    = text->buf;
-	text->length    = strlen(text->text.t);
+	text->length    = ep-text->text.t;
 	text->storage   = PL_CHARS_LOCAL;
 	break;
+      }
 #ifdef O_GMP
       case V_MPZ:
       { size_t sz = mpz_sizeinbase(n.value.mpz, 10) + 2;
 	Buffer b  = findBuffer(BUF_RING);
 
-	growBuffer(b, sz);
+	if ( !growBuffer(b, sz) )
+	  outOfCore();
 	mpz_get_str(b->base, 10, n.value.mpz);
 	b->top = b->base + strlen(b->base);
 	text->text.t  = baseBuffer(b, char);
@@ -196,7 +236,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
 	{ case CVT_partial:
 	    return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
 	  case CVT_nolist:
-	    return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
+	    goto error;
 	  case CVT_nocode:
 	  case CVT_nochar:
 	  { term_t culprit = PL_new_term_ref();
@@ -295,7 +335,9 @@ error:
   if ( (flags & CVT_EXCEPTION) )
   { atom_t expected;
 
-    if ( flags & CVT_LIST )
+    if ( (flags & CVT_LIST) && !(flags&(CVT_ATOM|CVT_NUMBER)) )
+      expected = ATOM_list;		/* List and/or string object */
+    else if ( flags & CVT_LIST )
       expected = ATOM_text;
     else if ( flags & CVT_NUMBER )
       expected = ATOM_atomic;
@@ -353,7 +395,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
     { word w = textToString(text);
 
       if ( w )
-	return _PL_unify_string(term, w);
+	return _PL_unify_atomic(term, w);
       else
 	return FALSE;
     }
@@ -473,6 +515,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
 	    return FALSE;
 	  }
 	}
+
 	return CLOSE_SEQ_STRING(p, p0, tail, term, l );
       }
     }
@@ -497,6 +540,18 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
     if ( offset > text->length || offset + len > text->length )
       return FALSE;
 
+    if ( len == 1 && type == PL_ATOM )
+    { GET_LD
+      int c;
+
+      if ( text->encoding == ENC_ISO_LATIN_1 )
+	c = text->text.t[offset]&0xff;
+      else
+	c = text->text.w[offset];
+
+      return PL_unify_atom(term, codeToAtom(c));
+    }
+
     sub.length = len;
     sub.storage = PL_CHARS_HEAP;
     if ( text->encoding == ENC_ISO_LATIN_1 )
@@ -659,7 +714,7 @@ represented.
 
 static int
 wctobuffer(wchar_t c, mbstate_t *mbs, Buffer buf)
-{ char b[MB_LEN_MAX];
+{ char b[PL_MB_LEN_MAX];
   size_t n;
 
   if ( (n=wcrtomb(b, c, mbs)) != (size_t)-1 )

os/pl-text.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifndef PL_TEXT_H_INCLUDED

os/pl-thread.h

@@ -46,26 +46,43 @@ extern void             freeSimpleMutex(counting_mutex *m);
 
 extern counting_mutex _PL_mutexes[];	/* Prolog mutexes */
 
-#define L_MISC		0
+#define L_MISC          0
-#define L_ALLOC		1
+#define L_ALLOC         1
-#define L_ATOM		2
+#define L_ATOM          2
-#define L_FLAG	        3
+#define L_FLAG          3
-#define L_FUNCTOR	4
+#define L_FUNCTOR       4
-#define L_RECORD	5
+#define L_RECORD        5
-#define L_THREAD	6
+#define L_THREAD        6
-#define L_PREDICATE	7
+#define L_PREDICATE     7
-#define L_MODULE	8
+#define L_MODULE        8
-#define L_TABLE		9
+#define L_TABLE         9
-#define L_BREAK	       10
+#define L_BREAK        10
-#define L_FILE	       11
+#define L_FILE         11
-#define L_PLFLAG       12
+#define L_SEETELL      12
-#define L_OP	       13
+#define L_PLFLAG       13
-#define L_INIT	       14
+#define L_OP           14
-#define L_TERM	       15
+#define L_INIT         15
-#define L_GC	       16
+#define L_TERM         16
-#define L_AGC	       17
+#define L_GC           17
-#define L_FOREIGN      18
+#define L_AGC          18
-#define L_OS	       19
+#define L_STOPTHEWORLD 19
+#define L_FOREIGN      20
+#define L_OS           21
+#ifdef __WINDOWS__
+#define L_DDE          22
+#define L_CSTACK       23
+#endif
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+The IF_MT(id, g) macro  is  used  to   bypass  mutexes  if  threading  is
+disabled. We cannot do this for the L_THREAD mutex however as we need to
+control when threads can be created.
+
+We  assume  id  ==  L_THREAD  is  optimized  away  if  id  is  known  at
+compile-time
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+#define IF_MT(id, g) if ( id == L_THREAD || GD->thread.enabled ) g
 
 #ifdef O_CONTENTION_STATISTICS
 #define countingMutexLock(cm) \

os/pl-utf8.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include <string.h>			/* get size_t */

os/pl-utf8.h

@@ -19,13 +19,15 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 
 #ifndef UTF8_H_INCLUDED
 #define UTF8_H_INCLUDED
 
+#define PL_MB_LEN_MAX 16
+
 #define UTF8_MALFORMED_REPLACEMENT 0xfffd
 
 #define ISUTF8_MB(c) ((unsigned)(c) >= 0xc0 && (unsigned)(c) <= 0xfd)

os/pl-version.c

@@ -5,7 +5,7 @@
     Author:        Jan Wielemaker
     E-mail:        wielemak@science.uva.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2005, University of Amsterdam
+    Copyright (C): 1985-2007, University of Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,20 +19,18 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
-#include <wchar.h>
+#include "pl-incl.h"
-
+#ifdef USE_GIT_VERSION_H
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#include <version.h>
-See pl-mswchar.cpp for  the  motivation  for   this  nonsense.  Used  in
-pl-fli.c and pl-text.c.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-#ifdef __WINDOWS__
-#define wcrtomb(s, wc, ps)	ms_wcrtomb(s, wc, ps)
-#define mbrtowc(pwc, s, n, ps)	ms_mbrtowc(pwc, s, n, ps)
-
-extern size_t ms_wcrtomb(char *s, wchar_t wc, mbstate_t *ps);
-extern size_t ms_mbrtowc(wchar_t *pwc, const char *s, size_t n, mbstate_t *ps);
 #endif
+
+void
+setGITVersion(void)
+{
+#ifdef GIT_VERSION
+  PL_set_prolog_flag("version_git", PL_ATOM|FF_READONLY, GIT_VERSION);
+#endif
+}

os/pl-write.c

@@ -60,16 +60,19 @@ typedef struct
   int   max_depth;			/* depth limit */
   int   depth;				/* current depth */
   atom_t spacing;			/* Where to insert spaces */
-  Term   module;			/* Module for operators */
+  Term module;			/* Module for operators */
   IOSTREAM *out;			/* stream to write to */
-  visited *visited;			/* visited (attributed-) variables */
+  term_t portray_goal;			/* call/2 activated portray hook */
+  term_t write_options;			/* original write options */
+  term_t prec_opt;			/* term in write options with prec */
 } write_options;
 
 word
 pl_nl1(term_t stream)
-{ IOSTREAM *s;
+{ GET_LD
+  IOSTREAM *s;
 
-  if ( getOutputStream(stream, &s) )
+  if ( getTextOutputStream(stream, &s) )
   { Sputcode('\n', s);
     return streamStatus(s);
   }
@@ -165,6 +168,28 @@ format_float(double f, char *buf)
   return buf;
 }
 
+static int
+bind_varnames(term_t varnames ARG_LD)
+{
+  CACHE_REGS
+  Term t = Yap_GetFromSlot(varnames PASS_REGS);
+  while(!IsVarTerm(t) && IsPairTerm(t)) {
+    Term tl = HeadOfTerm(t);
+    Functor f;
+    Term tv, t2, t1;
+
+    if (!IsApplTerm(tl)) return FALSE;
+    if ((f = FunctorOfTerm(tl)) != FunctorEq)
+      return FALSE;
+    t1 = ArgOfTerm(1, tl);
+    t2 = ArgOfTerm(2, tl);
+    tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
+    if (!Yap_unify(t2, tv))
+      return FALSE;
+    t = TailOfTerm(t);
+  }
+  return TRUE;
+}
 
 char *
 varName(term_t t, char *name)
@@ -183,7 +208,7 @@ varName(term_t t, char *name)
 
 
 static bool
-writeTerm(term_t t, int prec, write_options *options)
+writeTopTerm(term_t t, int prec, write_options *options)
 {
   CACHE_REGS
   UInt yap_flag = Use_SWI_Stream_f;
@@ -194,6 +219,8 @@ writeTerm(term_t t, int prec, write_options *options)
     yap_flag |= Quote_illegal_f;
   if (options->flags & PL_WRT_NUMBERVARS)
     yap_flag |=  Handle_vars_f;
+  if (options->flags & PL_WRT_VARNAMES)
+    yap_flag |=  Handle_vars_f;
   if (options->flags & PL_WRT_IGNOREOPS)
     yap_flag |= Ignore_ops_f;
   if (flags & PL_WRT_PORTRAY)
@@ -221,21 +248,6 @@ writeAtomToStream(IOSTREAM *s, atom_t atom)
   return 1;
 }
 
-int
-writeAttributeMask(atom_t a)
-{ if ( a == ATOM_ignore )
-  { return PL_WRT_ATTVAR_IGNORE;
-  } else if ( a == ATOM_dots )
-  { return PL_WRT_ATTVAR_DOTS;
-  } else if ( a == ATOM_write )
-  { return PL_WRT_ATTVAR_WRITE;
-  } else if ( a == ATOM_portray )
-  { return PL_WRT_ATTVAR_PORTRAY;
-  } else
-    return 0;
-}
-
-
 static int
 writeBlobMask(atom_t a)
 { if ( a == ATOM_default )
@@ -247,23 +259,6 @@ writeBlobMask(atom_t a)
 }
 
 
-static const opt_spec write_term_options[] =
-{ { ATOM_quoted,	    OPT_BOOL },
-  { ATOM_ignore_ops,	    OPT_BOOL },
-  { ATOM_numbervars,        OPT_BOOL },
-  { ATOM_portray,           OPT_BOOL },
-  { ATOM_character_escapes, OPT_BOOL },
-  { ATOM_max_depth,	    OPT_INT  },
-  { ATOM_module,	    OPT_ATOM },
-  { ATOM_backquoted_string, OPT_BOOL },
-  { ATOM_attributes,	    OPT_ATOM },
-  { ATOM_priority,	    OPT_INT },
-  { ATOM_partial,	    OPT_BOOL },
-  { ATOM_spacing,	    OPT_ATOM },
-  { ATOM_blobs,		    OPT_ATOM },
-  { NULL_ATOM,	     	    0 }
-};
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 PutOpenToken() inserts a space in the output stream if the last-written
 and given character require a space to ensure a token-break.
@@ -317,6 +312,84 @@ PutOpenToken(int c, IOSTREAM *s)
   return TRUE;
 }
 
+
+
+		 /*******************************
+		 *	      TOPLEVEL		*
+		 *******************************/
+
+int
+writeAttributeMask(atom_t a)
+{ if ( a == ATOM_ignore )
+  { return PL_WRT_ATTVAR_IGNORE;
+  } else if ( a == ATOM_dots )
+  { return PL_WRT_ATTVAR_DOTS;
+  } else if ( a == ATOM_write )
+  { return PL_WRT_ATTVAR_WRITE;
+  } else if ( a == ATOM_portray )
+  { return PL_WRT_ATTVAR_PORTRAY;
+  } else
+    return 0;
+}
+
+
+static const opt_spec write_term_options[] =
+{ { ATOM_quoted,	    OPT_BOOL },
+  { ATOM_ignore_ops,	    OPT_BOOL },
+  { ATOM_numbervars,        OPT_BOOL },
+  { ATOM_portray,           OPT_BOOL },
+  { ATOM_portray_goal,      OPT_TERM },
+  { ATOM_character_escapes, OPT_BOOL },
+  { ATOM_max_depth,	    OPT_INT  },
+  { ATOM_module,	    OPT_ATOM },
+  { ATOM_backquoted_string, OPT_BOOL },
+  { ATOM_attributes,	    OPT_ATOM },
+  { ATOM_priority,	    OPT_INT },
+  { ATOM_partial,	    OPT_BOOL },
+  { ATOM_spacing,	    OPT_ATOM },
+  { ATOM_blobs,		    OPT_ATOM },
+  { ATOM_cycles,	    OPT_BOOL },
+  { ATOM_variable_names,    OPT_TERM },
+  { NULL_ATOM,		    0 }
+};
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Call user:portray/1 if defined.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+static int
+put_write_options(term_t opts_in, write_options *options)
+{ GET_LD
+  term_t newlist = PL_new_term_ref();
+  term_t precopt = PL_new_term_ref();
+  fid_t fid = PL_open_foreign_frame();
+  term_t head = PL_new_term_ref();
+  term_t tail = PL_copy_term_ref(opts_in);
+  term_t newhead = PL_new_term_ref();
+  term_t newtail = PL_copy_term_ref(newlist);
+  int rc = TRUE;
+
+  while(rc && PL_get_list(tail, head, tail))
+  { if ( !PL_is_functor(head, FUNCTOR_priority1) )
+      rc = ( PL_unify_list(newtail, newhead, newtail) &&
+	     PL_unify(newhead, head) );
+  }
+
+  if ( rc )
+  { rc = ( PL_unify_list(newtail, head, newtail) &&
+	   PL_unify_functor(head, FUNCTOR_priority1) &&
+	   PL_get_arg(1, head, precopt) &&
+	   PL_unify_nil(newtail) );
+  }
+  if ( rc )
+  { options->write_options = newlist;
+    options->prec_opt = precopt;
+  }
+
+  PL_close_foreign_frame(fid);
+  return rc;
+}
+
 word
 pl_write_term3(term_t stream, term_t term, term_t opts)
 { GET_LD
@@ -324,6 +397,7 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   bool ignore_ops = FALSE;
   bool numbervars = -1;			/* not set */
   bool portray    = FALSE;
+  term_t gportray = 0;
   bool bqstring   = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
   bool charescape = -1;			/* not set */
   atom_t mname    = ATOM_user;
@@ -331,7 +405,10 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   atom_t blobs    = ATOM_nil;
   int  priority   = 1200;
   bool partial    = FALSE;
-  IOSTREAM *s;
+  bool cycles     = TRUE;
+  term_t varnames = 0;
+  int local_varnames;
+  IOSTREAM *s = NULL;
   write_options options;
   int rc;
 
@@ -339,10 +416,10 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   options.spacing = ATOM_standard;
 
   if ( !scan_options(opts, 0, ATOM_write_option, write_term_options,
-		     &quoted, &ignore_ops, &numbervars, &portray,
+		     &quoted, &ignore_ops, &numbervars, &portray, &gportray,
 		     &charescape, &options.max_depth, &mname,
 		     &bqstring, &attr, &priority, &partial, &options.spacing,
-		     &blobs) )
+		     &blobs, &cycles, &varnames) )
     fail;
 
   if ( attr == ATOM_nil )
@@ -381,14 +458,21 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
     }
   }
 
-  if ( !getOutputStream(stream, &s) )
-    fail;
-
   options.module = lookupModule(mname);
   if ( charescape == TRUE ||
-       //       (charescape == -1 && true(options.module, CHARESCAPE)) )
+       (charescape == -1 
-       charEscapeWriteOption(options))
+#ifndef __YAP_PROLOG__
+&& true(options.module, M_CHARESCAPE)
+#endif
+	) )
     options.flags |= PL_WRT_CHARESCAPES;
+  if ( gportray )
+  { options.portray_goal = gportray;
+    if ( !put_write_options(opts, &options) ||
+	 !PL_qualify(options.portray_goal, options.portray_goal) )
+      return FALSE;
+    portray = TRUE;
+  }
   if ( numbervars == -1 )
     numbervars = (portray ? TRUE : FALSE);
 
@@ -397,19 +481,35 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   if ( numbervars ) options.flags |= PL_WRT_NUMBERVARS;
   if ( portray )    options.flags |= PL_WRT_PORTRAY;
   if ( bqstring )   options.flags |= PL_WRT_BACKQUOTED_STRING;
+  if ( !cycles )    options.flags |= PL_WRT_NO_CYCLES;
+
+  local_varnames = (varnames && false(&options, PL_WRT_NUMBERVARS));
+
+  BEGIN_NUMBERVARS(local_varnames);
+  if ( varnames )
+      { if ( (rc=bind_varnames(varnames PASS_LD)) )
+      options.flags |= PL_WRT_VARNAMES;
+    else
+      goto out;
+  }
+  if ( !(rc=getTextOutputStream(stream, &s)) )
+    goto out;
 
   options.out = s;
   if ( !partial )
     PutOpenToken(EOF, s);		/* reset this */
   if ( (options.flags & PL_WRT_QUOTED) && !(s->flags&SIO_REPPL) )
   { s->flags |= SIO_REPPL;
-    rc = writeTerm(term, priority, &options);
+    rc = writeTopTerm(term, priority, &options);
     s->flags &= ~SIO_REPPL;
   } else
-  { rc = writeTerm(term, priority, &options);
+  { rc = writeTopTerm(term, priority, &options);
   }
 
-  return streamStatus(s) && rc;
+out:
+  END_NUMBERVARS(local_varnames);
+
+  return (!s || streamStatus(s)) && rc;
 }
 
 
@@ -426,10 +526,10 @@ PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags)
   memset(&options, 0, sizeof(options));
   options.flags	    = flags;
   options.out	    = s;
-  options.module    = USER_MODULE; //MODULE_user;
+  options.module    = MODULE_user;
 
   PutOpenToken(EOF, s);			/* reset this */
-  return writeTerm(term, precedence, &options);
+  return writeTopTerm(term, precedence, &options);
 }
 
 
@@ -438,22 +538,27 @@ do_write2(term_t stream, term_t term, int flags)
 { GET_LD
   IOSTREAM *s;
 
-  if ( getOutputStream(stream, &s) )
+  if ( getTextOutputStream(stream, &s) )
   { write_options options;
     int rc;
 
     memset(&options, 0, sizeof(options));
     options.flags     = flags;
     options.out	      = s;
-    options.module    = USER_MODULE; // MODULE_user;
+    options.module    = MODULE_user;
-    //    if ( options.module && true(options.module, CHARESCAPE) )
+    if ( options.module 
-    if (charEscapeWriteOption(options))
+#ifndef __YAP_PROLOG__
+	 && true(options.module, M_CHARESCAPE) 
+#endif
+	 )
       options.flags |= PL_WRT_CHARESCAPES;
     if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
       options.flags |= PL_WRT_BACKQUOTED_STRING;
 
     PutOpenToken(EOF, s);		/* reset this */
-    rc = writeTerm(term, 1200, &options);
+    rc = writeTopTerm(term, 1200, &options);
+    if ( rc && (flags&PL_WRT_NEWLINE) )
+      rc = Putc('\n', s);
 
     return streamStatus(s) && rc;
   }
@@ -481,25 +586,22 @@ pl_print2(term_t stream, term_t term)
 word
 pl_write_canonical2(term_t stream, term_t term)
 { GET_LD
-  fid_t fid;
   nv_options options;
   word rc;
 
-  if ( !(fid = PL_open_foreign_frame()) )
+  BEGIN_NUMBERVARS(TRUE);
-    return FALSE;
+
   options.functor = FUNCTOR_isovar1;
   options.on_attvar = AV_SKIP;
-  options.singletons = TRUE;
+  options.singletons = PL_is_acyclic(term);
-#if __YAP_PROLOG__
+  options.numbered_check = FALSE;
-  LOCAL_FunctorVar = FunctorHiddenVar;
+
-#endif
+  rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
-  numberVars(term, &options, 0 PASS_LD);
+	 do_write2(stream, term,
-  rc = do_write2(stream, term,
+		   PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS)
-		 PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS);
+       );
-#if __YAP_PROLOG__
+
-  LOCAL_FunctorVar = FunctorVar;
+  END_NUMBERVARS(TRUE);
-#endif
-  PL_discard_foreign_frame(fid);
 
   return rc;
 }
@@ -524,17 +626,13 @@ pl_write_canonical(term_t term)
 { return pl_write_canonical2(0, term);
 }
 
-word					/* for debugging purposes! */
+word
 pl_writeln(term_t term)
-{ if ( PL_write_term(Serror, term, 1200,
+{ return do_write2(0, term, PL_WRT_NUMBERVARS|PL_WRT_NEWLINE);
-		     PL_WRT_QUOTED|PL_WRT_NUMBERVARS) &&
-       Sdprintf("\n") >= 0 )
-    succeed;
-
-  fail;
 }
 
 
+
 		 /*******************************
 		 *      PUBLISH PREDICATES	*
 		 *******************************/

os/windows/dirent.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #ifndef _DIRENT_H_INCLUDED
@@ -28,8 +28,8 @@
 #include <io.h>
 
 #undef _export
-#if defined(_UXNT_KERNEL) && !defined(__LCC__)
+#if defined(_UXNT_KERNEL) && !defined(__MINGW32__)
-#define _export __declspec(dllexport)
+#define _export _declspec(dllexport)
 #else
 #define _export extern
 #endif
@@ -37,7 +37,7 @@
 #define DIRENT_MAX 512
 
 typedef struct dirent
-{ void *      		data;		/* actually WIN32_FIND_DATA * */
+{ void *		data;		/* actually WIN32_FIND_DATA * */
   int			first;
   void *		handle;		/* actually HANDLE */
 					/* dirent */

os/windows/popen.c

@@ -297,9 +297,9 @@ pt_popen(const char *cmd, const char *mode)
   }
 
   if ( pc->mode == 'r' )
-    fptr = _fdopen(_open_osfhandle((long)pc->out[0],_O_BINARY),"r");
+    fptr = _fdopen(_open_osfhandle((intptr_t)pc->out[0],_O_BINARY),"r");
   else
-    fptr = _fdopen(_open_osfhandle((long)pc->in[1],_O_BINARY),"w");
+    fptr = _fdopen(_open_osfhandle((intptr_t)pc->in[1],_O_BINARY),"w");
 
 finito:
   if ( fptr )

os/windows/utf8.c

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #include "utf8.h"
@@ -31,7 +31,7 @@ UTF-8 Decoding, based on http://www.cl.cam.ac.uk/~mgk25/unicode.html
 #define CONT(i)   ISUTF8_CB(in[1])
 #define VAL(i, s) ((in[i]&0x3f) << s)
 
-char *
+static char *
 _xos_utf8_get_char(const char *in, int *chr)
 { 					/* 2-byte, 0x80-0x7ff */
   if ( (in[0]&0xe0) == 0xc0 && CONT(1) )
@@ -60,12 +60,12 @@ _xos_utf8_get_char(const char *in, int *chr)
   }
 
   *chr = *in;
-  
+
   return (char *)in+1;
 }
 
 
-char *
+static char *
 _xos_utf8_put_char(char *out, int chr)
 { if ( chr < 0x80 )
   { *out++ = chr;

os/windows/utf8.h

@@ -19,7 +19,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 
@@ -52,7 +52,7 @@
 	((chr) < 0x80 ? out[0]=(char)(chr), out+1 \
 		      : _xos_utf8_put_char(out, (chr)))
 
-extern char *_xos_utf8_get_char(const char *in, int *chr);
+static char *_xos_utf8_get_char(const char *in, int *chr);
-extern char *_xos_utf8_put_char(char *out, int chr);
+static char *_xos_utf8_put_char(char *out, int chr);
 
 #endif /*UTF8_H_INCLUDED*/

os/windows/uxnt.c

@@ -1,11 +1,10 @@
-/*  $Id$
+/*  Part of SWI-Prolog
-
-    Part of SWI-Prolog
 
     Author:        Jan Wielemaker
-    E-mail:        jan@swi.psy.uva.nl
+    E-mail:        J.Wielemaker@vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 1985-2002, University of Amsterdam
+    Copyright (C): 1985-2012, University of Amsterdam
+			      Vu University Amsterdam
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -19,7 +18,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 */
 
 #define UNICODE 1
@@ -52,11 +51,6 @@
 #define FALSE 0
 #endif
 
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 256
-#endif
-
-
 #ifdef __LCC__
 #define _close close
 #define _read read
@@ -72,6 +66,10 @@
 #define XENOMAP 1
 #define XENOMEM 2
 
+#ifndef PATH_MAX
+#define PATH_MAX 260
+#endif
+
 
 		 /*******************************
 		 *	       ERRNO		*
@@ -146,6 +144,21 @@ utf8towcs(wchar_t *dest, const char *src, size_t len)
 }
 
 
+static size_t
+utf8_strlen(const char *s, size_t len)
+{ const char *e = &s[len];
+  unsigned int l = 0;
+
+  while(s<e)
+  { int chr;
+
+    s = utf8_get_char(s, &chr);
+    l++;
+  }
+
+  return l;
+}
+
 
 
 		 /*******************************
@@ -169,11 +182,11 @@ existsAndWriteableDir(const TCHAR *name)
 
 char *
 _xos_home()				/* expansion of ~ */
-{ static char home[MAXPATHLEN];
+{ static char home[PATH_MAX];
   static int done = FALSE;
 
   if ( !done )
-  { TCHAR h[MAXPATHLEN];
+  { TCHAR h[PATH_MAX];
 
 					/* Unix, set by user */
     if ( GetEnvironmentVariable(_T("HOME"), h, sizeof(h)) &&
@@ -184,8 +197,8 @@ _xos_home()				/* expansion of ~ */
     { _xos_canonical_filenameW(h, home, sizeof(home), 0);
     } else
     { TCHAR d[100];
-      TCHAR p[MAXPATHLEN];
+      TCHAR p[PATH_MAX];
-      TCHAR tmp[MAXPATHLEN];
+      TCHAR tmp[PATH_MAX];
       int haved, havep;
 
       haved = GetEnvironmentVariable(_T("HOMEDRIVE"), d, sizeof(d));
@@ -245,7 +258,8 @@ _xos_os_filenameW(const char *cname, wchar_t *osname, size_t len)
     q += 3;
   }
 
-  if ( q[0] == '/' || q[0] == '\\' )	/* deal with //host/share */
+  if ( (q[0] == '/' || q[0] == '\\') &&
+       (q[1] == '/' || q[1] == '\\') )	/* deal with //host/share */
   { if ( s+1 >= e )
     { errno = ENAMETOOLONG;
       return NULL;
@@ -600,7 +614,6 @@ _xos_fopen(const char *path, const char *mode)
 }
 
 
-
 		 /*******************************
 		 *      FILE MANIPULATIONS	*
 		 *******************************/
@@ -608,11 +621,101 @@ _xos_fopen(const char *path, const char *mode)
 int
 _xos_access(const char *path, int mode)
 { TCHAR buf[PATH_MAX];
+  char sd_buf[512];
+  SECURITY_DESCRIPTOR *sd;
+  BOOL access_status;
+  DWORD desired_access = 0;
+  DWORD sd_size, granted_access;
+  HANDLE token = 0, imp_token = 0;
+  GENERIC_MAPPING generic_mapping;
+  PRIVILEGE_SET privelege_set;
+  DWORD  priv_set_len = sizeof(PRIVILEGE_SET);
+  int retval = -1;
+  SECURITY_INFORMATION sec_info =
+    DACL_SECURITY_INFORMATION |
+    OWNER_SECURITY_INFORMATION |
+    GROUP_SECURITY_INFORMATION;
 
   if ( !_xos_os_filenameW(path, buf, PATH_MAX) )
     return -1;
 
-  return _waccess(buf, mode);
+  if ( mode == F_OK )
+    return _waccess(buf, F_OK);
+
+  sd = (SECURITY_DESCRIPTOR*)&sd_buf;
+  if ( !GetFileSecurity(buf, sec_info, sd, sizeof(sd_buf), &sd_size) )
+  { if ( GetLastError() == ERROR_INVALID_FUNCTION )
+    { goto simple;
+    } else if ( GetLastError() != ERROR_INSUFFICIENT_BUFFER )
+    { errno = ENOENT;
+      return -1;
+    }
+
+    if ( !(sd = malloc(sd_size)) )
+    { errno = ENOMEM;
+      return -1;
+    }
+
+    if ( !GetFileSecurity(buf, sec_info, sd, sd_size, &sd_size) )
+      goto simple;
+  }
+
+  if ( mode & W_OK )
+  { if ( _waccess(buf, W_OK ) < 0 )		/* read-only bit set */
+      goto out;
+  }
+
+  if ( !OpenThreadToken(GetCurrentThread(),
+			TOKEN_DUPLICATE | TOKEN_READ,
+			TRUE,
+			&token) )
+  { if ( GetLastError() != ERROR_NO_TOKEN )
+      goto simple;
+
+    if ( !OpenProcessToken(GetCurrentProcess(),
+			   TOKEN_DUPLICATE | TOKEN_READ,
+			   &token) )
+      goto simple;
+  }
+
+  if ( !DuplicateToken(token,
+		       SecurityImpersonation,
+		       &imp_token) )
+    goto simple;
+
+  if (mode & R_OK) desired_access |= GENERIC_READ;
+  if (mode & W_OK) desired_access |= GENERIC_WRITE;
+  if (mode & X_OK) desired_access |= GENERIC_EXECUTE;
+
+  generic_mapping.GenericRead    = FILE_GENERIC_READ;
+  generic_mapping.GenericWrite   = FILE_GENERIC_WRITE;
+  generic_mapping.GenericExecute = FILE_GENERIC_EXECUTE;
+  generic_mapping.GenericAll     = FILE_ALL_ACCESS;
+  MapGenericMask(&desired_access, &generic_mapping);
+
+  if ( !AccessCheck(sd,
+		    imp_token,
+		    desired_access,
+		    &generic_mapping,
+		    &privelege_set,
+		    &priv_set_len,
+		    &granted_access,
+		    &access_status) )
+    goto simple;
+
+  if ( access_status )
+    retval  = 0;
+
+out:
+  if ( sd && (char*)sd != sd_buf ) free(sd);
+  if (imp_token) CloseHandle(imp_token);
+  if (token) CloseHandle(token);
+
+  return retval;
+
+simple:
+  retval = _waccess(buf, mode);
+  goto out;
 }
 
 
@@ -858,6 +961,7 @@ _xos_getenv(const char *name, char *buf, size_t buflen)
       size = GetEnvironmentVariable(nm, valp, size+1);
     }
 
+    size = wcslen(valp);		/* return sometimes holds 0-bytes */
     if ( wcstoutf8(buf, valp, buflen) )
       rc = strlen(buf);
     else
@@ -876,16 +980,27 @@ _xos_getenv(const char *name, char *buf, size_t buflen)
 int
 _xos_setenv(const char *name, char *value, int overwrite)
 { TCHAR nm[PATH_MAX];
-  TCHAR val[PATH_MAX];
+  TCHAR buf[PATH_MAX];
+  TCHAR *val = buf;
+  int rc;
 
   if ( !utf8towcs(nm, name, PATH_MAX) )
     return -1;
   if ( !overwrite && GetEnvironmentVariable(nm, NULL, 0) > 0 )
     return 0;
   if ( !utf8towcs(val, value, PATH_MAX) )
-    return -1;
+  { size_t wlen = utf8_strlen(value, strlen(value)) + 1;
 
-  if ( SetEnvironmentVariable(nm, val) )
+    if ( (val = malloc(wlen*sizeof(TCHAR))) == NULL )
+      return -1;
+    utf8towcs(val, value, wlen);
+  }
+
+  rc = SetEnvironmentVariable(nm, val);
+  if ( val != buf )
+    free(val);
+
+  if ( rc )
     return 0;
 
   return -1;				/* TBD: convert error */

packages/Dialect.defs.in

@@ -37,7 +37,7 @@ LIBDIR=@libdir@
 YAPLIBDIR=@libdir@/Yap
 SHAREDIR=$(ROOTDIR)/share/Yap
 abs_top_builddir=@abs_top_builddir@
-PL=@INSTALL_ENV@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss
+PL=@PRE_INSTALL_ENV@ $(abs_top_builddir)/yap $(abs_top_builddir)/startup.yss
 
 CC=@CC@
 LD=@SHLIB_LD@

packages/RDF

@@ -1 +1 @@
-Subproject commit 270146c1f4117ebb58d20c2f06e58d7d23cbc9ca
+Subproject commit 79a369f81a44a6cbf16d50351fbfbffc23f90f03