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

C/globals.c

@@ -23,6 +23,7 @@ static char SccsId[] = "%W% %G%";
 #include "YapHeap.h"
 #include "yapio.h"
 #include "iopreds.h"
+#include "eval.h"
 #include "attvar.h"
 #include <math.h>
 
@@ -908,9 +909,18 @@ p_nb_setarg( USES_REGS1 )
   }
   if (pos < 1 || pos > arity)
     return FALSE;
+
+  to = Deref(ARG3);
   to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena) PASS_REGS) PASS_REGS);
   if (to == 0L)
     return FALSE;
+
+  dest = Deref(ARG2);
+  if (IsPairTerm(dest)) {
+    arity = 2;
+  } else {
+    arity = ArityOfFunctor(FunctorOfTerm(dest));
+  }
   destp[pos] = to;
   return TRUE;
 }
@@ -948,7 +958,7 @@ p_nb_set_shared_arg( USES_REGS1 )
   }
   if (pos < 1 || pos > arity)
     return FALSE;
-  to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena) PASS_REGS) PASS_REGS);
+  to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 3, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena) PASS_REGS) PASS_REGS);
   if (to == 0L)
     return FALSE;
   destp[pos] = to;
@@ -1011,6 +1021,136 @@ p_nb_linkval( USES_REGS1 )
   return TRUE;
 }
 
+
+
+static Int
+p_nb_create_accumulator(void)
+{
+  Term t = Deref(ARG1), acct, to;
+  CELL *destp;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"nb_create_accumulator");
+    return FALSE; 
+  }
+  if (!IsIntegerTerm(t) && !IsBigIntTerm(t) && !IsFloatTerm(t)) {
+    Yap_Error(TYPE_ERROR_NUMBER,t,"nb_create_accumulator");
+    return FALSE; 
+  }
+  acct = Yap_MkApplTerm(FunctorGNumber,1,&t);
+  if (!Yap_unify(ARG2, acct)) {
+    return FALSE;
+  }
+  to = CopyTermToArena(t, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
+  if (to == 0L)
+    return FALSE;
+  destp = RepAppl(Deref(ARG2));
+  destp[1] = to;
+  return TRUE;
+}
+
+static Int
+p_nb_add_to_accumulator(void)
+{
+  Term t = Deref(ARG1), t0, tadd;
+  Functor f;
+  CELL *destp;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"nb_create_accumulator");
+    return FALSE; 
+  }
+  if (!IsApplTerm(t)) {
+    Yap_Error(TYPE_ERROR_NUMBER,t,"nb_accumulator_value");
+    return FALSE; 
+  }
+  f = FunctorOfTerm(t);
+  if (f != FunctorGNumber) {
+    return FALSE;
+  }
+  destp = RepAppl(t);
+  t0 = Deref(destp[1]);
+  tadd = Deref(ARG2);
+  if (IsVarTerm(tadd)) {
+    Yap_Error(INSTANTIATION_ERROR,tadd,"nb_create_accumulator");
+    return FALSE; 
+  }
+  if (IsIntegerTerm(t0) && IsIntegerTerm(tadd)) {
+    Int i0 = IntegerOfTerm(t0);
+    Int i1 = IntegerOfTerm(tadd);
+    Term new = MkIntegerTerm(i0+i1);
+
+    if (IsIntTerm(new)) {
+      /* forget it if it was something else */
+      destp[1] = new;
+    } else {
+      /* long, do we have spapce or not ?? */
+      if (IsLongIntTerm(t0)) {
+	CELL *target = RepAppl(t0);
+	CELL *source = RepAppl(new);
+	target[1] = source[1];
+      } else {
+	/* we need to create a new long int */
+	new = CopyTermToArena(new, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
+	destp = RepAppl(Deref(ARG1));
+	destp[1] = new;
+      }
+    }
+    return TRUE;
+  }
+  if (IsFloatTerm(t0) && IsFloatTerm(tadd)) {
+    Float f0 = FloatOfTerm(t0);
+    Float f1 = FloatOfTerm(tadd);
+    Term new = MkFloatTerm(f0+f1);
+    CELL *target = RepAppl(t0);
+    CELL *source = RepAppl(new);
+
+#if  SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
+    target[2] = source[2];
+#endif
+    target[1] = source[1];
+    return TRUE;
+  }
+  if (IsNumTerm(t0) && IsNumTerm(tadd)) {
+    Term t2[2], new;
+    t2[0] = t0;
+    t2[1] = tadd;
+    new = Yap_MkApplTerm(FunctorPlus, 2, t2);
+
+    new = Yap_Eval(new);
+    new = CopyTermToArena(new, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
+    destp = RepAppl(Deref(ARG1));
+    destp[1] = new;    
+
+    return TRUE;
+  }
+  return FALSE;
+}
+
+
+static Int
+p_nb_accumulator_value(void)
+{
+  Term t = Deref(ARG1), to;
+  Functor f;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"nb_accumulator_value");
+    return FALSE; 
+  }
+  if (!IsApplTerm(t)) {
+    Yap_Error(TYPE_ERROR_NUMBER,t,"nb_accumulator_value");
+    return FALSE; 
+  }
+  f = FunctorOfTerm(t);
+  if (f != FunctorGNumber) {
+    return FALSE;
+  }
+  to = Yap_CopyTerm(RepAppl(t)[1]);
+  return Yap_unify(to, ARG2);
+}
+
+
 Term
 Yap_SetGlobalVal(Atom at, Term t0)
 {
@@ -2437,6 +2577,9 @@ void Yap_InitGlobals(void)
   Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag);
   Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag);
   Yap_InitCPred("nb_beam_keys", 2, p_nb_beam_keys, 0L);
+  Yap_InitCPred("nb_create_accumulator", 2, p_nb_create_accumulator, 0L);
+  Yap_InitCPred("nb_add_to_accumulator", 2, p_nb_add_to_accumulator, 0L);
+  Yap_InitCPred("nb_accumulator_value", 2, p_nb_accumulator_value, 0L);
 #ifdef DEBUG
   Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
 #endif

C/iopreds.c

@@ -215,17 +215,6 @@ Yap_DebugErrorPutc(int c)
 
 
 
-static Int
-p_has_readline( USES_REGS1 )
-{
-#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H
-  return TRUE;
-#else
-  return FALSE;
-#endif
-}
-
-
 int
 Yap_GetCharForSIGINT(void)
 {
@@ -1163,6 +1152,5 @@ Yap_InitIOPreds(void)
     //  Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag);
 #endif
   Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag);
 
 }

C/save.c

@@ -573,6 +573,7 @@ save_crc(void)
 
 static Int
 do_save(int mode USES_REGS) {
+  extern void Scleanup(void);
   Term t1 = Deref(ARG1);
 
   if (Yap_HoleSize) {
@@ -584,6 +585,7 @@ do_save(int mode USES_REGS) {
     Yap_Error(TYPE_ERROR_LIST,t1,"save/1");
     return FALSE;
   }
+  Scleanup();
   Yap_CloseStreams(TRUE);
   if ((splfild = open_file(Yap_FileNameBuf, O_WRONLY | O_CREAT)) < 0) {
     Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)),
@@ -1382,10 +1384,12 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A
     return(FAIL_RESTORE);
   Yap_PrologMode = BootMode;
   if (Yap_HeapBase) {
+    extern void Scleanup(void);
     if (!yap_flags[HALT_AFTER_CONSULT_FLAG] && !yap_flags[QUIET_MODE_FLAG]) {
       Yap_TrueFileName(s,Yap_FileNameBuf2, YAP_FILENAME_MAX);
       fprintf(stderr, "%% Restoring file %s\n", Yap_FileNameBuf2);
     }
+    Scleanup();
     Yap_CloseStreams(TRUE);
   }
 #ifdef DEBUG_RESTORE4
@@ -1758,9 +1762,9 @@ Restore(char *s, char *lib_dir USES_REGS)
   }
 
   Yap_ReOpenLoadForeign();
-  /* restore SWI IO */
+  FreeRecords();
-  initIO ();
+  /* restart IO */
-  Yap_InitPlIO();
+  initIO();
   /* reset time */
   Yap_ReInitWallTime();
   Yap_InitSysPath();
@@ -1769,7 +1773,6 @@ Restore(char *s, char *lib_dir USES_REGS)
     Yap_InitPreAllocCodeSpace();
   }
 #endif
-  FreeRecords();
   CloseRestore();
   if (which_save == 2) {
     Yap_unify(ARG2, MkIntTerm(0));

C/sysbits.c

@@ -1553,12 +1553,11 @@ void (*handler)(int);
 
 static int
 InteractSIGINT(int ch) {
+  CACHE_REGS
   Yap_PrologMode |= AsyncIntMode;
   switch (ch) {
   case 'a':
     /* abort computation */
-    if (Yap_PrologMode &= InReadlineMode) {
-    }
     if (Yap_PrologMode & (GCMode|ConsoleGetcMode|GrowStackMode|GrowHeapMode)) {
       Yap_PrologMode |= AbortMode;
     } else {
@@ -1566,6 +1565,7 @@ InteractSIGINT(int ch) {
       /* in case someone mangles the P register */
     }
     Yap_PrologMode &= ~AsyncIntMode;
+    siglongjmp(Yap_RestartEnv,1);
     return -1;
   case 'b':
     /* continue */

H/Yapproto.h

@@ -254,7 +254,6 @@ void    STD_PROTO(Yap_InitInlines,(void));
 int      STD_PROTO(Yap_eq,(Term, Term));
 
 /* iopreds.c */
-void	STD_PROTO(Yap_InitPlIO,(void));
 void	STD_PROTO(Yap_InitBackIO,(void));
 void	STD_PROTO(Yap_InitIOPreds,(void));
 #ifdef DEBUG

H/iatoms.h

@@ -396,6 +396,7 @@
   FunctorNot = Yap_MkFunctor(AtomNot,1);
   FunctorOr = Yap_MkFunctor(AtomSemic,2);
   FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3);
+  FunctorPlus = Yap_MkFunctor(AtomPlus,2);
   FunctorPortray = Yap_MkFunctor(AtomPortray,1);
   FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
   FunctorQuery = Yap_MkFunctor(AtomQuery,1);

H/ratoms.h

@@ -396,6 +396,7 @@
   FunctorNot = FuncAdjust(FunctorNot);
   FunctorOr = FuncAdjust(FunctorOr);
   FunctorPermissionError = FuncAdjust(FunctorPermissionError);
+  FunctorPlus = FuncAdjust(FunctorPlus);
   FunctorPortray = FuncAdjust(FunctorPortray);
   FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint);
   FunctorQuery = FuncAdjust(FunctorQuery);

H/tatoms.h

@@ -790,6 +790,8 @@
 #define FunctorOr Yap_heap_regs->FunctorOr_
   Functor FunctorPermissionError_;
 #define FunctorPermissionError Yap_heap_regs->FunctorPermissionError_
+  Functor FunctorPlus_;
+#define FunctorPlus Yap_heap_regs->FunctorPlus_
   Functor FunctorPortray_;
 #define FunctorPortray Yap_heap_regs->FunctorPortray_
   Functor FunctorPrologConstraint_;

Makefile.in

@@ -211,6 +211,7 @@ IOLIB_SOURCES=$(srcdir)/packages/PLStream/pl-buffer.c $(srcdir)/packages/PLStrea
 	$(srcdir)/packages/PLStream/pl-glob.c  \
 	$(srcdir)/packages/PLStream/pl-option.c  \
 	$(srcdir)/packages/PLStream/pl-os.c \
+	$(srcdir)/packages/PLStream/pl-prologflag.c \
 	$(srcdir)/packages/PLStream/pl-privitf.c \
 	$(srcdir)/packages/PLStream/pl-read.c \
 	$(srcdir)/packages/PLStream/pl-rl.c  \
@@ -333,6 +334,7 @@ IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o  \
 	pl-glob.o pl-option.o \
 	pl-nt.o \
 	pl-os.o pl-privitf.o \
+	pl-prologflag.o \
 	pl-read.o \
 	pl-rl.o \
 	pl-stream.o pl-string.o pl-table.o \
@@ -386,7 +388,7 @@ BEAM_OBJECTS = \
 STATIC_OBJECTS = \
 	@STATIC_MODE@sys.o yap_random.o regexp.o  @NO_BUILTIN_REGEXP@ regcomp.o regerror.o regfree.o regexec.o
 
-LIB_OBJECTS = $(ENGINE_OBJECTS) $(C_INTERFACE_OBJECTS) $(OR_OBJECTS) $(BEAM_OBJECTS) $(STATIC_OBJECTS)
+LIB_OBJECTS = $(ENGINE_OBJECTS) $(C_INTERFACE_OBJECTS) $(OR_OBJECTS) $(BEAM_OBJECTS) $(STATIC_OBJECTS) $(LIBTAI_OBJECTS)
 
 OBJECTS = yap.o $(LIB_OBJECTS)
 
@@ -570,76 +572,83 @@ pl-ntconsole.o: $(srcdir)/console/LGPL/pl-ntconsole.c config.h
 pl-ntmain.o: $(srcdir)/console/LGPL/pl-ntmain.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ < $(srcdir)/console/LGPL/pl-ntmain.c -o $@
 
-pl-buffer.o: $(srcdir)/packages/PLStream/pl-buffer.c
+pl-buffer.o: $(srcdir)/packages/PLStream/pl-buffer.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream  @EXTRA_INCLUDES_FOR_WIN32@  $(srcdir)/packages/PLStream/pl-buffer.c -o $@
 
-pl-codelist.o: $(srcdir)/packages/PLStream/pl-codelist.c
+pl-codelist.o: $(srcdir)/packages/PLStream/pl-codelist.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-codelist.c -o $@
 
-pl-ctype.o: $(srcdir)/packages/PLStream/pl-ctype.c
+pl-ctype.o: $(srcdir)/packages/PLStream/pl-ctype.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-ctype.c -o $@
 
-pl-dtoa.o: $(srcdir)/packages/PLStream/pl-dtoa.c
+pl-dtoa.o: $(srcdir)/packages/PLStream/pl-dtoa.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-dtoa.c -o $@
 
-pl-error.o: $(srcdir)/packages/PLStream/pl-error.c
+pl-error.o: $(srcdir)/packages/PLStream/pl-error.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-error.c -o $@
 
-pl-file.o: $(srcdir)/packages/PLStream/pl-file.c
+pl-file.o: $(srcdir)/packages/PLStream/pl-file.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-file.c -o $@
 
-pl-files.o: $(srcdir)/packages/PLStream/pl-files.c
+pl-files.o: $(srcdir)/packages/PLStream/pl-files.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-files.c -o $@
 
-pl-fmt.o: $(srcdir)/packages/PLStream/pl-fmt.c
+pl-fmt.o: $(srcdir)/packages/PLStream/pl-fmt.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-fmt.c -o $@
 
-pl-glob.o: $(srcdir)/packages/PLStream/pl-glob.c
+pl-glob.o: $(srcdir)/packages/PLStream/pl-glob.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-glob.c -o $@
 
-pl-option.o: $(srcdir)/packages/PLStream/pl-option.c
+pl-option.o: $(srcdir)/packages/PLStream/pl-option.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-option.c -o $@
 
-pl-os.o: $(srcdir)/packages/PLStream/pl-os.c
+pl-os.o: $(srcdir)/packages/PLStream/pl-os.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-os.c -o $@
 
-pl-privitf.o: $(srcdir)/packages/PLStream/pl-privitf.c
+pl-privitf.o: $(srcdir)/packages/PLStream/pl-privitf.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-privitf.c -o $@
 
-pl-rl.o: $(srcdir)/packages/PLStream/pl-rl.c
+pl-prologflag.o: $(srcdir)/packages/PLStream/pl-prologflag.c config.h
+	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-prologflag.c -o $@
+
+pl-rl.o: $(srcdir)/packages/PLStream/pl-rl.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-rl.c -o $@
 
-pl-read.o: $(srcdir)/packages/PLStream/pl-read.c
+pl-read.o: $(srcdir)/packages/PLStream/pl-read.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-read.c -o $@
 
-pl-stream.o: $(srcdir)/packages/PLStream/pl-stream.c
+pl-stream.o: $(srcdir)/packages/PLStream/pl-stream.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-stream.c -o $@
 
-pl-string.o: $(srcdir)/packages/PLStream/pl-string.c
+pl-string.o: $(srcdir)/packages/PLStream/pl-string.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-string.c -o $@
 
-pl-table.o: $(srcdir)/packages/PLStream/pl-table.c
+pl-table.o: $(srcdir)/packages/PLStream/pl-table.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-table.c -o $@
 
-pl-text.o: $(srcdir)/packages/PLStream/pl-text.c
+pl-text.o: $(srcdir)/packages/PLStream/pl-text.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-text.c -o $@
 
-pl-utf8.o: $(srcdir)/packages/PLStream/pl-utf8.c
+pl-utf8.o: $(srcdir)/packages/PLStream/pl-utf8.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-utf8.c -o $@
 
-pl-write.o: $(srcdir)/packages/PLStream/pl-write.c
+pl-write.o: $(srcdir)/packages/PLStream/pl-write.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-write.c -o $@
 
-pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.c
+pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/pl-yap.c -o $@
 
-pl-tai.o: $(srcdir)/packages/PLStream/pl-tai.c
+pl-tai.o: $(srcdir)/packages/PLStream/pl-tai.c config.h
-	( cd packages/PLStream/libtai ; make )
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@  $(srcdir)/packages/PLStream/pl-tai.c -o $@
 
-uxnt.o: $(srcdir)/packages/PLStream/windows/uxnt.c
+uxnt.o: $(srcdir)/packages/PLStream/windows/uxnt.c config.h
 	$(CC) -c $(CFLAGS) -I$(srcdir)/include  -I$(srcdir)  -I$(srcdir)/packages/PLStream @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/packages/PLStream/windows/uxnt.c -o $@
 
+# libtai rule
+%.o : $(srcdir)/packages/PLStream/libtai/%.c config.h
+	$(CC) -c $(CFLAGS) $< -o $@
+
+
 # default rule
 %.o : $(srcdir)/C/%.c config.h
 	$(CC) -c $(CFLAGS) $< -o $@
@@ -699,11 +708,11 @@ pl-yap@EXEC_SUFFIX@: $(PLCONS_OBJECTS) LGPL/swi_console/plterm.dll packages/PLST
 
 libYap.a: $(LIB_OBJECTS) 
 	-rm -f libYap.a
-	$(AR) rc libYap.a $(addprefix packages/PLStream/libtai/,$(LIBTAI_OBJECTS)) $(LIB_OBJECTS)
+	$(AR) rc libYap.a $(LIB_OBJECTS)
 	$(RANLIB) libYap.a
 
 @DYNYAPLIB@: $(LIB_OBJECTS)
-	@YAPLIB_LD@ -o @YAPLIB@ packages/PLStream/libtai/libtai.a $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) $(SONAMEFLAG)
+	@YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) $(SONAMEFLAG)
 
 install: install_bin install_data
 
@@ -851,7 +860,6 @@ clean: clean_docs
 	@INSTALL_YAPR@ (cd packages/YapR; $(MAKE) clean)
 	@USE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean)
 	@USE_MINISAT@ (cd packages/CLPBN/clpbn/bp; $(MAKE) clean)
-	@INSTALL_DLLS@ (cd packages/tai/libtai; $(MAKE) clean)
 	@INSTALL_DLLS@ (cd packages/zlib; $(MAKE) clean)
 	@ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE) clean)
 	@ENABLE_CPLINT@ (cd packages/cplint; $(MAKE) clean)

include/SWI-Prolog.h

@@ -340,6 +340,9 @@ 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	*
 		 *******************************/
@@ -567,6 +570,7 @@ extern X_API int PL_get_string(term_t, char **, size_t *);
 extern X_API int PL_get_string_chars(term_t, char **, size_t *);
 extern X_API record_t PL_record(term_t);
 extern X_API int PL_recorded(record_t, term_t);
+extern X_API record_t PL_duplicate_record(record_t);
 extern X_API void PL_erase(record_t);
 /* only partial implementation, does not guarantee export between different architectures and versions of YAP */
 extern X_API char *PL_record_external(term_t, size_t *);
@@ -628,7 +632,10 @@ readline overhead.
 #define PL_DISPATCH_WAIT      1		/* Dispatch till input available */
 #define PL_DISPATCH_INSTALLED 2		/* dispatch function installed? */
 
+typedef int  (*PL_dispatch_hook_t)(int fd);
+
 extern X_API int PL_dispatch(int fd, int wait);
+PL_EXPORT(PL_dispatch_hook_t) 	PL_dispatch_hook(PL_dispatch_hook_t);
 PL_EXPORT(void)		PL_add_to_protocol(const char *buf, size_t count);
 PL_EXPORT(char *)	PL_prompt_string(int fd);
 PL_EXPORT(void)		PL_write_prompt(int dowrite);
@@ -639,8 +646,6 @@ PL_EXPORT(pl_wchar_t*)  PL_atom_generator_w(const pl_wchar_t *pref,
 					    size_t buflen,
 					    int state);
 
-typedef int  (*PL_dispatch_hook_t)(int fd);
-
 		 /*******************************
 		 *	 WINDOWS MESSAGES	*
 		 *******************************/

library/dialect/swi/fli/swi.c

@@ -113,7 +113,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
   Term cm = CurrentModule;
   /* fprintf(stderr,"doing %s:%s/%d\n", RepAtom(AtomOfTerm(mod))->StrOfAE, a,arity); */
   CurrentModule = mod;
-  Yap_InitCPred(a, arity, def, UserCPredFlag);
+  Yap_InitCPred(a, arity, def, (UserCPredFlag|CArgsPredFlag|flags));
   if (arity == 0) {
     Atom at;
     while ((at = Yap_LookupAtom(a)) == NULL) {
@@ -136,7 +136,6 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
     f = Yap_MkFunctor(at, arity);
     pe = RepPredProp(PredPropByFunc(f,mod));
   }
-  pe->PredFlags |= (CArgsPredFlag|flags);
   CurrentModule = cm;
 } 
 
@@ -1880,6 +1879,15 @@ PL_recorded(record_t db, term_t ts)
   return TRUE;
 }
 
+X_API record_t
+PL_duplicate_record(record_t db)
+{
+  Term t = YAP_Recorded((void *)db);
+  if (t == ((CELL)0))
+    return FALSE;
+  return (record_t)YAP_Record(t);
+}
+
 X_API void
 PL_erase(record_t db)
 {
@@ -2326,9 +2334,11 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
   Term tmod;
   Int nflags = 0;
 
+#ifdef DEBUG
   if (flags & (PL_FA_NOTRACE|PL_FA_CREF)) {
     fprintf(stderr,"PL_register_foreign_in_module called with non-implemented flag %x when creating predicate %s:%s/%d\n", flags, module, name, arity);
   }      
+#endif
   if (module == NULL) {
     tmod = CurrentModule;
   } else {
@@ -2766,27 +2776,6 @@ X_API pl_wchar_t *PL_atom_generator_w(const pl_wchar_t *pref, pl_wchar_t *buffer
   return NULL;
 }
 
-extern atom_t PrologPrompt(void);
-
-char *
-PL_prompt_string(int fd)
-{ if ( fd == 0 )
-  { atom_t a = PrologPrompt();          /* TBD: deal with UTF-8 */
-    
-    
-    if ( a )
-    {     
-      Atom at = SWIAtomToAtom(a);
-      if (!IsWideAtom(at)  && !IsBlob(at)) {
-	return RepAtom(at)->StrOfAE;
-      }
-    }
-  }
-
-  return NULL;
-}
-
-
 const char *Yap_GetCurrentPredName(void);
 Int Yap_GetCurrentPredArity(void);
 

misc/ATOMS

@@ -401,6 +401,7 @@ F	NBQueue			Queue		4
 F	Not			Not		1
 F	Or			Semic		2
 F	PermissionError		PermissionError	3
+F	Plus			Plus		2
 F	Portray			Portray		1
 F	PrologConstraint	Prolog		2
 F	Query			Query		1

packages/CLPBN/clpbn/aggregates.yap

@@ -55,8 +55,7 @@ cpt_average(AllVars, Key, Els0, Tab, Vs, NewVs) :-
 cpt_average([Ev|Vars], Key, Els0, Softness, p(Els0, CPT, NewParents), Vs, NewVs) :-
 	find_evidence(Vars, 0, TotEvidence, RVars),
 	build_avg_table(RVars, Vars, Els0, Key, TotEvidence, Softness, MAT0, NewParents0, Vs, IVs),
-	include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs),
+	include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
-	matrix_to_list(MAT, CPT), writeln(NewParents: Vs: NewVs: CPT).
 
 % find all fixed kids, this simplifies significantly the function.
 find_evidence([], TotEvidence, TotEvidence, []).
@@ -177,16 +176,13 @@ check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs,
 	sumlist(L1, Tot),
 	nth0(Ev, L1, Val),
 	(Val == Tot ->
-writeln(Ev:L1:Val:1),
 	    MAT1 = MAT,
 	    NewParents = [],
 	    Vs = NewVs
 	;
 	 Val == 0.0 ->
-writeln(Ev:L1:Val:2),
 	    throw(error(domain_error(incompatible_evidence),evidence(Ev)))
 	;
-writeln(Ev:L1:Val:3),
 	    MAT0 = MAT,
 	    NewParents = NewParents0,
 	    IVs = NewVs

packages/PLStream/pl-file.c

@@ -328,12 +328,13 @@ initIO()
   const atom_t *np;
   int i;
 
+#ifdef __YAP_PROLOG__
+  memset(GD, 0, sizeof(gds_t));
+  memset(LD, 0, sizeof(PL_local_data_t));
+#endif
   streamAliases = newHTable(16);
   streamContext = newHTable(16);
   PL_register_blob_type(&stream_blob);
-#if __YAP_PROLOG__
-  init_yap();
-#endif
 #ifdef __unix__
 { int fd;
 
@@ -343,6 +344,10 @@ initIO()
 }
 #endif
   ResetTty();
+#if __YAP_PROLOG__
+  /* needs to be done after tty hacking */
+  init_yap();
+#endif
 
   Sclosehook(freeStream);
 
@@ -4713,6 +4718,9 @@ static const PL_extension foreigns[] = {
 						        META|NDET),
   FRG("$raw_read",		1, pl_raw_read,			0),
   FRG("$raw_read",		2, pl_raw_read2,		0),
+
+  FRG("$swi_current_prolog_flag",	5, pl_prolog_flag5,	     NDET),
+  FRG("$swi_current_prolog_flag",	2, pl_prolog_flag,	 NDET|ISO),
   /* DO NOT ADD ENTRIES BELOW THIS ONE */
   LFRG((char *)NULL,		0, NULL,			0)
 };
@@ -4742,8 +4750,10 @@ static void
 init_yap(void)
 {
   GET_LD
-  setPrologFlagMask(PLFLAG_TTY_CONTROL);
+  /* we need encodings first */
   initCharTypes();
+  initPrologFlags();
+  setPrologFlagMask(PLFLAG_TTY_CONTROL);
   initFiles();
   PL_register_extensions(PL_predicates_from_ctype);
   PL_register_extensions(PL_predicates_from_file);
@@ -4752,6 +4762,7 @@ init_yap(void)
   PL_register_extensions(PL_predicates_from_write);
   PL_register_extensions(PL_predicates_from_read);
   PL_register_extensions(PL_predicates_from_tai);
+  PL_register_extensions(PL_predicates_from_prologflag);
   PL_register_extensions(foreigns);
   fileerrors = TRUE;
   SinitStreams();

packages/PLStream/pl-global.h

@@ -76,6 +76,11 @@ typedef struct {
     atom_t     *for_code[256];		/* code --> one-char-atom */
   } atoms;
 
+  struct
+  {
+    int		optimise;		/* -O: optimised compilation */
+  } cmdline;
+
   struct
   { ExtensionCell _ext_head;		/* head of registered extensions */
     ExtensionCell _ext_tail;		/* tail of this chain */
@@ -167,6 +172,7 @@ typedef struct PL_local_data {
     occurs_check_t occurs_check;	/* Unify and occurs check */
   } feature;
 
+
   source_location read_source;		/* file, line, char of last term */
 
   struct

packages/PLStream/pl-incl.h

@@ -168,6 +168,10 @@ typedef uintptr_t	PL_atomic_t;	/* same a word */
 #define SIG_FREECLAUSES	  (SIG_PROLOG_OFFSET+4)
 #define SIG_PLABORT	  (SIG_PROLOG_OFFSET+5)
 
+#define LOCAL_OVERFLOW    (-1)
+#define GLOBAL_OVERFLOW   (-2)
+#define TRAIL_OVERFLOW    (-3)
+#define ARGUMENT_OVERFLOW (-4)
 
 		/********************************
 		*       UTILITIES               *
@@ -370,12 +374,14 @@ typedef struct
 
 // LOCAL variables (heap will get this form LOCAL
 
-#define FT_ATOM		0		/* atom feature */
+#define FT_ATOM         0               /* atom feature */
-#define FT_BOOL		1		/* boolean feature (true, false) */
+#define FT_BOOL         1               /* boolean feature (true, false) */
-#define FT_INTEGER	2		/* integer feature */
+#define FT_INTEGER      2               /* integer feature */
-#define FT_TERM		3		/* term feature */
+#define FT_FLOAT        3               /* float feature */
-#define FT_INT64	4		/* passed as int64_t */
+#define FT_TERM         4               /* term feature */
-#define FT_MASK		0x0f		/* mask to get type */
+#define FT_INT64        5               /* passed as int64_t */
+#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 */
@@ -778,7 +784,7 @@ COMMON(word) 		pl_write_canonical2(term_t stream, term_t term);
 
 /* empty stub */
 extern void setPrologFlag(const char *name, int flags, ...);
-extern void PL_set_prolog_flag(const char *name, int flags, ...);
+extern int  PL_set_prolog_flag(const char *name, int flags, ...);
 
 extern install_t PL_install_readline(void);
 
@@ -795,6 +801,11 @@ COMMON(Buffer)		codes_or_chars_to_buffer(term_t l, unsigned int flags,
 
 COMMON(bool)		systemMode(bool accept);
 
+
+COMMON(void)		initPrologFlagTable(void);
+COMMON(void)		initPrologFlags(void);
+COMMON(int)		raiseStackOverflow(int overflow);
+
 static inline word
 setBoolean(int *flag, term_t old, term_t new)
 { if ( !PL_unify_bool_ex(old, *flag) ||
@@ -815,6 +826,10 @@ COMMON(void) 		PL_put_term__LD(term_t t1, term_t t2 ARG_LD);
 COMMON(int) 		PL_unify_atom__LD(term_t t, atom_t a ARG_LD);
 COMMON(int) 		PL_unify_integer__LD(term_t t1, intptr_t i ARG_LD);
 
+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);
+
 /* inlines that need ARG_LD */
 static inline intptr_t
 skip_list(Word l, Word *tailp ARG_LD) {
@@ -845,4 +860,5 @@ extern const PL_extension PL_predicates_from_glob[];
 extern const PL_extension PL_predicates_from_read[];
 extern const PL_extension PL_predicates_from_tai[];
 extern const PL_extension PL_predicates_from_write[];
+extern const PL_extension PL_predicates_from_prologflag[];
 

packages/PLStream/pl-prologflag.c

@@ -24,14 +24,21 @@
 
 /*#define O_DEBUG 1*/
 #include "pl-incl.h"
+#ifdef __YAP_PROLOG__
 #include "pl-ctype.h"
+#else
+#include "os/pl-ctype.h"
+#endif
 #include <ctype.h>
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#endif
 #ifdef __WINDOWS__
 #include <process.h>			/* getpid() */
 #endif
 
-#define LOCK()   PL_LOCK(PLFLAG_L)
+#define LOCK()   PL_LOCK(L_PLFLAG)
-#define UNLOCK() PL_UNLOCK(PLFLAG_L)
+#define UNLOCK() PL_UNLOCK(L_PLFLAG)
 
 
 		 /*******************************
@@ -65,10 +72,12 @@ option, but 90% of the prolog flags   are read-only or never changed and
 we want to be able to have a lot of flags and don't harm thread_create/3
 too much.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
+#ifndef __YAP_PROLOG__
-static void setArgvPrologFlag();
+static void setArgvPrologFlag(void);
-static void setTZPrologFlag();
+static void setTZPrologFlag(void);
 static void setVersionPrologFlag(void);
+#endif
+static atom_t lookupAtomFlag(atom_t key);
 
 typedef struct _prolog_flag
 { short		flags;			/* Type | Flags */
@@ -76,6 +85,7 @@ typedef struct _prolog_flag
   union
   { atom_t	a;			/* value as atom */
     int64_t	i;			/* value as integer */
+    double	f;			/* value as float */
     record_t	t;			/* value as term */
   } value;
 } prolog_flag;
@@ -92,13 +102,13 @@ following arguments are to be provided:
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 static int
-indexOfBoolMask(uintptr_t mask)
+indexOfBoolMask(unsigned int mask)
 { int i=1;
 
   if ( !mask )
     return -1;
 
-  while(!(mask & 0x1L))
+  while(!(mask & 0x1))
   { i++;
     mask >>= 1;
   }
@@ -108,7 +118,8 @@ indexOfBoolMask(uintptr_t mask)
 
 void
 setPrologFlag(const char *name, int flags, ...)
-{ atom_t an = PL_new_atom(name);
+{ GET_LD
+  atom_t an = PL_new_atom(name);
   prolog_flag *f;
   Symbol s;
   va_list args;
@@ -134,8 +145,8 @@ setPrologFlag(const char *name, int flags, ...)
   va_start(args, flags);
   switch(type)
   { case FT_BOOL:
-    { int  val           = va_arg(args, int);
+    { int           val = va_arg(args, int);
-      uintptr_t mask = va_arg(args, uintptr_t);
+      unsigned int mask = va_arg(args, unsigned int);
 
       if ( s && mask && f->index < 0 )		/* type definition */
       { f->index = indexOfBoolMask(mask);
@@ -147,7 +158,7 @@ setPrologFlag(const char *name, int flags, ...)
 
       f->value.a = (val ? ATOM_true : ATOM_false);
       if ( f->index >= 0 )
-      { mask = 1L << (f->index-1);
+      { mask = (unsigned int)1 << (f->index-1);
 
 	if ( val )
 	  setPrologFlagMask(mask);
@@ -161,6 +172,11 @@ setPrologFlag(const char *name, int flags, ...)
       f->value.i = val;
       break;
     }
+    case FT_FLOAT:
+    { double val = va_arg(args, double);
+      f->value.f = val;
+      break;
+    }
     case FT_INT64:
     { int64_t val = va_arg(args, int64_t);
       f->value.i = val;
@@ -196,7 +212,8 @@ setPrologFlag(const char *name, int flags, ...)
 #ifdef O_PLMT
 static void
 copySymbolPrologFlagTable(Symbol s)
-{ prolog_flag *f = s->value;
+{ GET_LD
+  prolog_flag *f = s->value;
   prolog_flag *copy = allocHeap(sizeof(*copy));
 
   *copy = *f;
@@ -208,7 +225,8 @@ copySymbolPrologFlagTable(Symbol s)
 
 static void
 freeSymbolPrologFlagTable(Symbol s)
-{ prolog_flag *f = s->value;
+{ GET_LD
+  prolog_flag *f = s->value;
 
   if ( (f->flags & FT_MASK) == FT_TERM )
     PL_erase(f->value.t);
@@ -217,10 +235,11 @@ freeSymbolPrologFlagTable(Symbol s)
 }
 #endif
 
-
+#ifndef __YAP_PROLOG__
 int
 setDoubleQuotes(atom_t a, unsigned int *flagp)
-{ unsigned int flags;
+{ GET_LD
+  unsigned int flags;
 
   if ( a == ATOM_chars )
     flags = DBLQ_CHARS;
@@ -254,15 +273,16 @@ setUnknown(atom_t a, unsigned int *flagp)
   else if ( a == ATOM_warning )
     flags = UNKNOWN_WARNING;
   else if ( a == ATOM_fail )
-    flags = 0;
+    flags = UNKNOWN_FAIL;
   else
-  { term_t value = PL_new_term_ref();
+  { 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);
   }
 
-  *flagp &= ~(UNKNOWN_ERROR|UNKNOWN_WARNING);
+  *flagp &= ~(UNKNOWN_MASK);
   *flagp |= flags;
 
   succeed;
@@ -271,7 +291,8 @@ setUnknown(atom_t a, unsigned int *flagp)
 
 static int
 setWriteAttributes(atom_t a)
-{ int mask = writeAttributeMask(a);
+{ GET_LD
+  int mask = writeAttributeMask(a);
 
   if ( mask )
   { LD->prolog_flag.write_attributes = mask;
@@ -302,7 +323,9 @@ getOccursCheckMask(atom_t a, occurs_check_t *val)
 
 static int
 setOccursCheck(atom_t a)
-{ if ( getOccursCheckMask(a, &LD->prolog_flag.occurs_check) )
+{ GET_LD
+
+  if ( getOccursCheckMask(a, &LD->prolog_flag.occurs_check) )
   { succeed;
   } else
   { term_t value = PL_new_term_ref();
@@ -312,10 +335,12 @@ setOccursCheck(atom_t a)
   }
 }
 
+#endif /* __YAP_PROLOG__ */
 
 static int
 setEncoding(atom_t a)
-{ IOENC enc = atom_to_encoding(a);
+{ GET_LD
+  IOENC enc = atom_to_encoding(a);
 
   if ( enc == ENC_UNKNOWN )
   { term_t value = PL_new_term_ref();
@@ -331,8 +356,9 @@ setEncoding(atom_t a)
 
 
 static word
-set_prolog_flag_unlocked(term_t key, term_t value)
+set_prolog_flag_unlocked(term_t key, term_t value, int flags)
-{ atom_t k;
+{ GET_LD
+  atom_t k;
   Symbol s;
   prolog_flag *f;
   Module m = MODULE_parse;
@@ -375,58 +401,117 @@ set_prolog_flag_unlocked(term_t key, term_t value)
       f = f2;
     }
 #endif
-  } else				/* define new Prolog flag */
+  } else if ( !(flags & FF_NOCREATE) )	/* define new Prolog flag */
-  { prolog_flag *f = allocHeap(sizeof(*f));
+  { prolog_flag *f;
     atom_t a;
     int64_t i;
+    double d;
 
+  anyway:
+    PL_register_atom(k);
+    f = allocHeap(sizeof(*f));
     f->index = -1;
-    if ( PL_get_atom(value, &a) )
+
-    { if ( a == ATOM_true || a == ATOM_false || a == ATOM_on || a == ATOM_off )
+    switch( (flags & FT_MASK) )
-	f->flags = FT_BOOL;
+    { case FT_FROM_VALUE:
-      else
+      { if ( PL_get_atom(value, &a) )
-	f->flags = FT_ATOM;
+	{ if ( a == ATOM_true || a == ATOM_false ||
-      f->value.a = a;
+	       a == ATOM_on || a == ATOM_off )
-      PL_register_atom(a);
+	    f->flags = FT_BOOL;
-    } else if ( PL_get_int64(value, &i) )
+	  else
-    { f->flags = FT_INTEGER;
+	    f->flags = FT_ATOM;
-      f->value.i = i;
+	  f->value.a = a;
-    } else
+	  PL_register_atom(a);
-    { f->flags = FT_TERM;
+	} else if ( PL_get_int64(value, &i) )
-      f->value.t = PL_record(value);
+	{ f->flags = FT_INTEGER;
+	  f->value.i = i;
+	} else if ( PL_get_float(value, &d) )
+	{ f->flags = FT_FLOAT;
+	  f->value.f = d;
+	} else
+	{ f->flags = FT_TERM;
+	  if ( !PL_is_ground(value) )
+	  { PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
+	    goto wrong_type;
+	  }
+	  if ( !(f->value.t = PL_record(value)) )
+	    goto wrong_type;
+	  f->value.t = PL_record(value);
+	}
+	break;
+      }
+      case FT_ATOM:
+	if ( !PL_get_atom_ex(value, &f->value.a) )
+	{ wrong_type:
+	  freeHeap(f, sizeof(*f));
+	  return FALSE;
+	}
+        f->flags = FT_ATOM;
+        PL_register_atom(f->value.a);
+	break;
+      case FT_BOOL:
+      { int b;
+	if ( !PL_get_bool_ex(value, &b) )
+	  goto wrong_type;
+        f->flags = FT_BOOL;
+	f->value.a = (b ? ATOM_true : ATOM_false);
+	break;
+      }
+      case FT_INTEGER:
+	if ( !PL_get_int64_ex(value, &f->value.i) )
+	  goto wrong_type;
+        f->flags = FT_INTEGER;
+	break;
+      case FT_FLOAT:
+	if ( !PL_get_float_ex(value, &f->value.f) )
+	  goto wrong_type;
+        f->flags = FT_FLOAT;
+	break;
+      case FT_TERM:
+	if ( !PL_is_ground(value) )
+	{ PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
+	  goto wrong_type;
+	}
+        if ( !(f->value.t = PL_record(value)) )
+	  goto wrong_type;
+        f->flags = FT_TERM;
+	break;
     }
 
-#ifdef O_PLMT
+    if ( (flags & FF_READONLY) )
-    if ( GD->statistics.threads_created > 1 )
+      f->flags |= FF_READONLY;
-    { if ( !LD->prolog_flag.table )
-      { LD->prolog_flag.table = newHTable(4);
 
-	LD->prolog_flag.table->copy_symbol = copySymbolPrologFlagTable;
+    addHTable(GD->prolog_flag.table, (void *)k, f);
-	LD->prolog_flag.table->free_symbol = freeSymbolPrologFlagTable;
-      }
-      addHTable(LD->prolog_flag.table, (void *)k, f);
-    } else
-#endif
-      addHTable(GD->prolog_flag.table, (void *)k, f);
 
     succeed;
+  } else
+  { atom_t how = lookupAtomFlag(ATOM_user_flags);
+
+    if ( how == ATOM_error )
+      return PL_error(NULL, 0, NULL, ERR_EXISTENCE,
+		      ATOM_prolog_flag, key);
+    else if ( how == ATOM_warning )
+      Sdprintf("WARNING: Flag %s: new Prolog flags must be created using "
+	       "create_prolog_flag/3\n", stringAtom(k));
+
+    goto anyway;
   }
 
   switch(f->flags & FT_MASK)
   { case FT_BOOL:
     { int val;
 
-      if ( !PL_get_bool(value, &val) )
+      if ( !PL_get_bool_ex(value, &val) )
-      { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, value);
+	return FALSE;
-      }
       if ( f->index > 0 )
-      { uintptr_t mask = 1L << (f->index-1);
+      { unsigned int mask = (unsigned int)1 << (f->index-1);
 
 	if ( val )
 	  setPrologFlagMask(mask);
 	else
 	  clearPrologFlagMask(mask);
       }
+#ifndef __YAP_PROLOG__
       if ( k == ATOM_character_escapes )
       { if ( val )
 	  set(m, CHARESCAPE);
@@ -447,6 +532,8 @@ set_prolog_flag_unlocked(term_t key, term_t value)
 	  break;			/* don't change value */
 #endif
       }
+#endif /* __YAP_PROLOG__ */
+
 					/* set the flag value */
       f->value.a = (val ? ATOM_true : ATOM_false);
 
@@ -455,9 +542,10 @@ set_prolog_flag_unlocked(term_t key, term_t value)
     case FT_ATOM:
     { atom_t a;
 
-      if ( !PL_get_atom(value, &a) )
+      if ( !PL_get_atom_ex(value, &a) )
-	return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, value);
+	return FALSE;
 
+#ifndef __YAP_PROLOG__
       if ( k == ATOM_double_quotes )
       { rval = setDoubleQuotes(a, &m->flags);
       } else if ( k == ATOM_unknown )
@@ -466,7 +554,9 @@ set_prolog_flag_unlocked(term_t key, term_t value)
       { rval = setWriteAttributes(a);
       } else if ( k == ATOM_occurs_check )
       { rval = setOccursCheck(a);
-      } else if ( k == ATOM_encoding )
+      } else 
+#endif
+      if ( k == ATOM_encoding )
       { rval = setEncoding(a);
       }
       if ( !rval )
@@ -475,17 +565,13 @@ set_prolog_flag_unlocked(term_t key, term_t value)
       PL_unregister_atom(f->value.a);
       f->value.a = a;
       PL_register_atom(a);
-      if ( k == ATOM_float_format )
-      { PL_register_atom(a);		/* so it will never be lost! */
-	LD->float_format = PL_atom_chars(a);
-      }
       break;
     }
     case FT_INTEGER:
     { int64_t i;
 
-      if ( !PL_get_int64(value, &i) )
+      if ( !PL_get_int64_ex(value, &i) )
-	return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, value);
+	return FALSE;
       f->value.i = i;
 #ifdef O_ATOMGC
       if ( k == ATOM_agc_margin )
@@ -493,6 +579,14 @@ set_prolog_flag_unlocked(term_t key, term_t value)
 #endif
       break;
     }
+    case FT_FLOAT:
+    { double d;
+
+      if ( !PL_get_float_ex(value, &d) )
+	return FALSE;
+      f->value.f = d;
+      break;
+    }
     case FT_TERM:
     { if ( f->value.t )
 	PL_erase(f->value.t);
@@ -507,21 +601,108 @@ set_prolog_flag_unlocked(term_t key, term_t value)
 }
 
 
-word
+/** set_prolog_flag(+Key, +Value) is det.
-pl_set_prolog_flag(term_t key, term_t value)
+*/
+
+static
+PRED_IMPL("set_prolog_flag", 2, set_prolog_flag, PL_FA_ISO)
 { word rc;
 
   LOCK();
-  rc = set_prolog_flag_unlocked(key, value);
+  rc = set_prolog_flag_unlocked(A1, A2, FF_NOCREATE|FT_FROM_VALUE);
   UNLOCK();
 
   return rc;
 }
 
 
+/** create_prolog_flag(+Key, +Value, +Options) is det.
+*/
+
+static const opt_spec prolog_flag_options[] =
+{ { ATOM_type,   OPT_ATOM },
+  { ATOM_access, OPT_ATOM },
+  { NULL_ATOM,   0 }
+};
+
+static
+PRED_IMPL("create_prolog_flag", 3, create_prolog_flag, PL_FA_ISO)
+{ PRED_LD
+  word rc;
+  int flags = 0;
+  atom_t type = 0;
+  atom_t access = ATOM_read_write;
+
+  if ( !scan_options(A3, 0, ATOM_prolog_flag_option, prolog_flag_options,
+		     &type, &access) )
+    return FALSE;
+
+  if ( type == 0 )
+    flags |= FT_FROM_VALUE;
+  else if ( type == ATOM_boolean )
+    flags |= FT_BOOL;
+  else if ( type == ATOM_integer )
+    flags |= FT_INTEGER;
+  else if ( type == ATOM_float )
+    flags |= FT_FLOAT;
+  else if ( type == ATOM_atom )
+    flags |= FT_ATOM;
+  else if ( type == ATOM_term )
+    flags |= FT_TERM;
+  else
+  { term_t a = PL_new_term_ref();
+    PL_put_atom(a, type);
+
+    return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_prolog_flag_type, a);
+  }
+
+  if ( access == ATOM_read_only )
+    flags |= FF_READONLY;
+  else if ( access != ATOM_read_write )
+  { term_t a = PL_new_term_ref();
+    PL_put_atom(a, access);
+    return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_prolog_flag_access, a);
+  }
+
+  LOCK();
+  rc = set_prolog_flag_unlocked(A1, A2, flags);
+  UNLOCK();
+
+  return rc;
+}
+
+
+static atom_t
+lookupAtomFlag(atom_t key)
+{ GET_LD
+  Symbol s;
+  prolog_flag *f = NULL;
+
+#ifdef O_PLMT
+  if ( LD->prolog_flag.table &&
+       (s = lookupHTable(LD->prolog_flag.table, (void *)key)) )
+  { f = s->value;
+  } else
+#endif
+  { if ( (s = lookupHTable(GD->prolog_flag.table, (void *)key)) )
+      f = s->value;
+  }
+
+  if ( f )
+  { assert((f->flags&FT_MASK) == FT_ATOM);
+    return f->value.a;
+  }
+
+  return NULL_ATOM;
+}
+
+
 static int
 unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
-{ if ( key == ATOM_character_escapes )
+{ GET_LD
+
+#ifndef __YAP_PROLOG__
+  if ( key == ATOM_character_escapes )
   { atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false);
 
     return PL_unify_atom(val, v);
@@ -541,12 +722,19 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
   } else if ( key == ATOM_unknown )
   { atom_t v;
 
-    if ( true(m, UNKNOWN_ERROR) )
+    switch ( getUnknownModule(m) )
-      v = ATOM_error;
+    { case UNKNOWN_ERROR:
-    else if ( true(m, UNKNOWN_WARNING) )
+	v = ATOM_error;
-      v = ATOM_warning;
+        break;
-    else
+      case UNKNOWN_WARNING:
-      v = ATOM_fail;
+	v = ATOM_warning;
+        break;
+      case UNKNOWN_FAIL:
+	v = ATOM_fail;
+        break;
+      default:
+	assert(0);
+    }
 
     return PL_unify_atom(val, v);
 #ifdef O_PLMT
@@ -558,11 +746,12 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
   } else if ( key == ATOM_debugger_show_context )
   { return PL_unify_bool_ex(val, debugstatus.showContext);
   }
+#endif /* YAP_PROLOG */
 
   switch(f->flags & FT_MASK)
   { case FT_BOOL:
       if ( f->index >= 0 )
-      { uintptr_t mask = 1L << (f->index-1);
+      { unsigned int mask = (unsigned int)1 << (f->index-1);
 
 	return PL_unify_bool_ex(val, truePrologFlag(mask) != FALSE);
       }
@@ -571,11 +760,15 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
       return PL_unify_atom(val, f->value.a);
     case FT_INTEGER:
       return PL_unify_int64(val, f->value.i);
+    case FT_FLOAT:
+      return PL_unify_float(val, f->value.f);
     case FT_TERM:
     { term_t tmp = PL_new_term_ref();
 
-      PL_recorded(f->value.t, tmp);
+      if ( PL_recorded(f->value.t, tmp) )
-      return PL_unify(val, tmp);
+	return PL_unify(val, tmp);
+      else
+	return raiseStackOverflow(GLOBAL_OVERFLOW);
     }
     default:
       assert(0);
@@ -586,7 +779,9 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
 
 static int
 unify_prolog_flag_access(prolog_flag *f, term_t access)
-{ if ( f->flags & FF_READONLY )
+{ GET_LD
+
+  if ( f->flags & FF_READONLY )
     return PL_unify_atom(access, ATOM_read);
   else
     return PL_unify_atom(access, ATOM_write);
@@ -595,11 +790,12 @@ unify_prolog_flag_access(prolog_flag *f, term_t access)
 
 static int
 unify_prolog_flag_type(prolog_flag *f, term_t type)
-{ atom_t a;
+{ GET_LD
+  atom_t a;
 
   switch(f->flags & FT_MASK)
   { case FT_BOOL:
-      a = ATOM_bool;
+      a = ATOM_boolean;
       break;
     case FT_ATOM:
       a = ATOM_atom;
@@ -607,6 +803,9 @@ unify_prolog_flag_type(prolog_flag *f, term_t type)
     case FT_INTEGER:
       a = ATOM_integer;
       break;
+    case FT_FLOAT:
+      a = ATOM_float;
+      break;
     case FT_TERM:
       a = ATOM_term;
       break;
@@ -630,7 +829,8 @@ word
 pl_prolog_flag5(term_t key, term_t value,
 	    word scope, word access, word type,
 	    control_t h)
-{ prolog_flag_enum *e;
+{ GET_LD
+  prolog_flag_enum *e;
   Symbol s;
   fid_t fid;
   Module module;
@@ -721,10 +921,12 @@ pl_prolog_flag5(term_t key, term_t value,
       { UNLOCK();
 	ForeignRedoPtr(e);
       }
+#ifndef __YAP_PROLOG__
       if ( exception_term )
       { exception_term = 0;
 	setVar(*valTermRef(exception_bin));
       }
+#endif
       PL_rewind_foreign_frame(fid);
     }
 
@@ -762,9 +964,12 @@ pl_prolog_flag(term_t name, term_t value, control_t h)
 #endif
 
 void
-initPrologFlagTable()
+initPrologFlagTable(void)
 { if ( !GD->prolog_flag.table )
-  { initPrologThreads();	/* may be called before PL_initialise() */
+  { 
+#ifndef __YAP_PROLOG__
+    initPrologThreads();	/* may be called before PL_initialise() */
+#endif
 
     GD->prolog_flag.table = newHTable(32);
   }
@@ -772,8 +977,10 @@ initPrologFlagTable()
 
 
 void
-initPrologFlags()
+initPrologFlags(void)
-{ setPrologFlag("iso",  FT_BOOL, FALSE, PLFLAG_ISO);
+{ GET_LD
+#ifndef __YAP_PROLOG__
+  setPrologFlag("iso",  FT_BOOL, FALSE, PLFLAG_ISO);
   setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH);
 #if __WINDOWS__
   setPrologFlag("windows",	FT_BOOL|FF_READONLY, TRUE, 0);
@@ -787,17 +994,9 @@ initPrologFlags()
 #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);
   setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL);
-#ifdef O_PLMT
-  setPrologFlag("abort_with_exception", FT_BOOL|FF_READONLY,
-	     TRUE, PLFLAG_EX_ABORT);
-#else
-  setPrologFlag("abort_with_exception", FT_BOOL,
-	     FALSE, PLFLAG_EX_ABORT);
-#endif
   setPrologFlag("c_libs",	  FT_ATOM|FF_READONLY, C_LIBS);
   setPrologFlag("c_cc",	  FT_ATOM|FF_READONLY, C_CC);
   setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS);
@@ -813,9 +1012,6 @@ initPrologFlags()
   setPrologFlag("open_shared_object",	  FT_BOOL|FF_READONLY, TRUE, 0);
   setPrologFlag("shared_object_extension",	  FT_ATOM|FF_READONLY, SO_EXT);
   setPrologFlag("shared_object_search_path", FT_ATOM|FF_READONLY, SO_PATH);
-#endif
-#if O_DYNAMIC_STACKS
-  setPrologFlag("dynamic_stacks",	FT_BOOL|FF_READONLY, TRUE, 0);
 #endif
   setPrologFlag("address_bits", FT_INTEGER|FF_READONLY, sizeof(void*)*8);
 #ifdef HAVE_POPEN
@@ -824,9 +1020,6 @@ initPrologFlags()
 #ifdef O_PLMT
   setPrologFlag("threads",	FT_BOOL|FF_READONLY, TRUE, 0);
   setPrologFlag("system_thread_id", FT_INTEGER|FF_READONLY, 0, 0);
-#ifdef MAX_THREADS
-  setPrologFlag("max_threads", FT_INTEGER|FF_READONLY, MAX_THREADS);
-#endif
 #else
   setPrologFlag("threads",	FT_BOOL|FF_READONLY, FALSE, 0);
 #endif
@@ -846,7 +1039,8 @@ initPrologFlags()
   setPrologFlag("debug_on_error",	FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
   setPrologFlag("report_error",	FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
 #endif
-  setPrologFlag("editor",		   FT_ATOM, "default");
+  setPrologFlag("user_flags", FT_ATOM, "silent");
+  setPrologFlag("editor", FT_ATOM, "default");
   setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
   setPrologFlag("autoload",  FT_BOOL, TRUE,  PLFLAG_AUTOLOAD);
 #ifndef O_GMP
@@ -868,7 +1062,6 @@ initPrologFlags()
   else
     setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
   setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
-  setPrologFlag("float_format", FT_ATOM, "%g");
   setPrologFlag("answer_format", FT_ATOM, "~p");
   setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
   setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
@@ -880,23 +1073,19 @@ initPrologFlags()
   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_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("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|FF_READONLY,
-	     truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
   setPrologFlag("signals", FT_BOOL|FF_READONLY,
 	     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");
@@ -909,17 +1098,31 @@ initPrologFlags()
     setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, buf);
   }
 #endif
+#endif /* YAP_PROLOG */
+  /* Flags copied by YAP */
+  setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
+  /* FLAGS used by PLStream */
+  setPrologFlag("tty_control", FT_BOOL|FF_READONLY,
+	     truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
+  setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
+  setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
+  setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0);
 
+
+#ifndef __YAP_PROLOG__
   setArgvPrologFlag();
   setTZPrologFlag();
   setOSPrologFlags();
   setVersionPrologFlag();
+#endif /* YAP_PROLOG */
 }
 
 
+#ifndef __YAP_PROLOG__
 static void
 setArgvPrologFlag()
-{ fid_t fid = PL_open_foreign_frame();
+{ GET_LD
+  fid_t fid = PL_open_foreign_frame();
   term_t e = PL_new_term_ref();
   term_t l = PL_new_term_ref();
   int argc    = GD->cmdline.argc;
@@ -929,15 +1132,15 @@ setArgvPrologFlag()
   PL_put_nil(l);
   for(n=argc-1; n>= 0; n--)
   { PL_put_variable(e);
-    PL_unify_chars(e, PL_ATOM|REP_FN, -1, argv[n]);
+    if ( !PL_unify_chars(e, PL_ATOM|REP_FN, -1, argv[n]) ||
-    PL_cons_list(l, e, l);
+	 !PL_cons_list(l, e, l) )
+      fatalError("Could not set Prolog flag argv: not enough stack");
   }
 
   setPrologFlag("argv", FT_TERM, l);
   PL_discard_foreign_frame(fid);
 }
 
-
 static void
 setTZPrologFlag()
 { tzset();
@@ -948,20 +1151,32 @@ setTZPrologFlag()
 
 static void
 setVersionPrologFlag(void)
-{ fid_t fid = PL_open_foreign_frame();
+{ GET_LD
+  fid_t fid = PL_open_foreign_frame();
   term_t t = PL_new_term_ref();
   int major = PLVERSION/10000;
   int minor = (PLVERSION/100)%100;
   int patch = (PLVERSION%100);
 
-  PL_unify_term(t, PL_FUNCTOR_CHARS, "swi", 4,
+  if ( !PL_unify_term(t,
-		PL_INT, major,
+		      PL_FUNCTOR_CHARS, "swi", 4,
-		PL_INT, minor,
+		        PL_INT, major,
-		PL_INT, patch,
+		        PL_INT, minor,
-		PL_ATOM, ATOM_nil);
+		        PL_INT, patch,
+		        PL_ATOM, ATOM_nil) )
+    sysError("Could not set version");
 
   setPrologFlag("version_data", FF_READONLY|FT_TERM, t);
   PL_discard_foreign_frame(fid);
 
   setGITVersion();
 }
+#endif /* YAP_PROLOG */
+		 /*******************************
+		 *      PUBLISH PREDICATES	*
+		 *******************************/
+
+BeginPredDefs(prologflag)
+  PRED_DEF("$swi_set_prolog_flag",    2, set_prolog_flag,    PL_FA_ISO)
+  PRED_DEF("$swi_create_prolog_flag", 3, create_prolog_flag, 0)
+EndPredDefs

packages/PLStream/pl-rl.c

@@ -514,12 +514,6 @@ Sread_readline(void *handle, char *buf, size_t size)
   PL_clock_wait_ticks(clock() - oldclock);
 #endif
 
-#if __YAP_PROLOG__
-  /* handle abort */
-  if (Yap_REGS.P_ == FAILCODE) {
-    return 0;
-  }
-#endif
   return rval;
 }
 

packages/PLStream/pl-stream.c

@@ -3330,7 +3330,7 @@ static const IOSTREAM S__iob0[] =
 
 
 void
-SinitStreams()
+SinitStreams(void)
 { static int done;
 
   if ( !done++ )

packages/PLStream/pl-yap.c

@@ -2,6 +2,8 @@
 /* YAP support for some low-level SWI stuff */
 
 #include <stdio.h>
+#include "Yap.h"
+#include "Yatom.h"
 #include "pl-incl.h"
 #if HAVE_MATH_H
 #include <math.h>
@@ -283,7 +285,7 @@ _PL_unify_atomic(term_t t, PL_atomic_t a)
 int
 _PL_unify_string(term_t t, word w)
 {
-  GET_LD
+  CACHE_REGS  
   return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w);
 }
 
@@ -456,17 +458,55 @@ lengthList(term_t list, int errors)
   return isVar(*tail) ? -2 : -1;
 }
 
-void
+int raiseStackOverflow(int overflow)
-setPrologFlag(const char *name, int flags, ...)
 {
+  return overflow;
 }
 
-void
+		 /*******************************
-PL_set_prolog_flag(const char *name, int flags, ...)
+		 *	    FEATURES		*
-{
+		 *******************************/
 
+int
+PL_set_prolog_flag(const char *name, int type, ...)
+{ va_list args;
+  int rval = TRUE;
+  int flags = (type & FF_MASK);
+
+  initPrologFlagTable();
+
+  va_start(args, type);
+  switch(type & ~FF_MASK)
+  { case PL_BOOL:
+    { int val = va_arg(args, int);
+
+      setPrologFlag(name, FT_BOOL|flags, val, 0);
+      break;
+    }
+    case PL_ATOM:
+    { const char *v = va_arg(args, const char *);
+#ifndef __YAP_PROLOG__
+      if ( !GD->initialised )
+	initAtoms();
+#endif
+      setPrologFlag(name, FT_ATOM|flags, v);
+      break;
+    }
+    case PL_INTEGER:
+    { intptr_t v = va_arg(args, intptr_t);
+      setPrologFlag(name, FT_INTEGER|flags, v);
+      break;
+    }
+    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;
@@ -802,6 +842,24 @@ PL_ttymode(IOSTREAM *s)
     return PL_NOTTY;
 }
 
+char *
+PL_prompt_string(int fd)
+{ if ( fd == 0 )
+  { atom_t a = PrologPrompt();          /* TBD: deal with UTF-8 */
+    
+    if ( a )
+    {     
+      Atom at = YAP_AtomFromSWIAtom(a);
+      if (!IsWideAtom(at)  && !IsBlob(at)) {
+	return RepAtom(at)->StrOfAE;
+      }
+    }
+  }
+
+  return NULL;
+}
+
+
 X_API void
 PL_prompt_next(int fd)
 { GET_LD
@@ -846,6 +904,15 @@ input_on_fd(int fd)
 #endif
 
 
+PL_dispatch_hook_t
+PL_dispatch_hook(PL_dispatch_hook_t hook)
+{ PL_dispatch_hook_t old = GD->foreign.dispatch_events;
+
+  GD->foreign.dispatch_events = hook;
+  return old;
+}
+
+
 X_API int
 PL_dispatch(int fd, int wait)
 { if ( wait == PL_DISPATCH_INSTALLED )
@@ -1023,14 +1090,20 @@ Yap_fetch_module_for_format(term_t args, YAP_Term *modp) {
   return YAP_InitSlot(nt);
 }
 
+word
+pl_readline(term_t flag)
+{
+  
+}
+
+#if THREADS
+
 #define COUNT_MUTEX_INITIALIZER(name) \
  { PTHREAD_MUTEX_INITIALIZER, \
    name, \
    0L \
  }
 
-#if THREADS
-
 static int
 recursive_attr(pthread_mutexattr_t **ap)
 { static int done;

packages/PLStream/pl-yap.h

@@ -24,7 +24,7 @@
 #endif
 #define INTBITSIZE (sizeof(int)*8)
 
-typedef YAP_Term	        Module;
+typedef module_t	        Module;
 typedef YAP_Term	       *Word;		/* Anonymous 4 byte object */
 typedef YAP_Term		(*Func)(term_t);	/* foreign functions */
 
@@ -113,7 +113,7 @@ void PL_license(const char *license, const char *module);
 
 #define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
 
-#define stringAtom(w)	YAP_AtomName((YAP_Atom)(w))
+#define stringAtom(w)	YAP_AtomName(YAP_AtomFromSWIAtom(w))
 #define isInteger(A) (YAP_IsIntTerm((A)) || YAP_IsBigNumTerm((A)))
 #define isString(A) Yap_IsStringTerm(A)
 #define isAtom(A) YAP_IsAtomTerm((A))
@@ -142,6 +142,7 @@ void PL_license(const char *license, const char *module);
 #define wordToTermRef(A) YAP_InitSlot(*(A))
 #define isTaggedInt(A) IsIntegerTerm(A)
 #define valInt(A) IntegerOfTerm(A)
+#define MODULE_parse ((Module)CurrentModule)
 
 extern term_t Yap_CvtTerm(term_t ts);
 

packages/YapR

@@ -1 +1 @@
-Subproject commit c9d945820be9d1a9d6bc3e216721668f6b311feb
+Subproject commit 5c2419f04dcd32f6929be1785621ed57918af1a4

pl/arith.yap

@@ -336,12 +336,12 @@ between(I,M,J) :-
 
 '$between'(I,M,I) :- (I == M -> ! ; true ).
 '$between'(I0,I,J) :- I0 < I, 
-	I1 is I0+1,
+	'$plus'(I0, 1, I1),
 	'$between'(I1,I,J).
 
 '$between_inf'(I,I).
 '$between_inf'(I,J) :-
-	I1 is I+1,
+	'$plus'(I, 1, I1),
 	'$between_inf'(I1,J).
 
 

pl/boot.yap

@@ -63,7 +63,7 @@ true :- true.
 	),
 	'$enter_system_mode',
 	'$init_globals',
-	set_value(fileerrors,1),
+	'$swi_set_prolog_flag'(fileerrors, true),
 	set_value('$gc',on),
 	('$exit_undefp' -> true ; true),
 	prompt1(' ?- '),
@@ -145,10 +145,10 @@ true :- true.
 
 /* main execution loop							*/
 '$read_vars'(user_input, Goal, Mod, Pos, Bindings) :-
-	get_value('$readline',true), !,
+	'$swi_current_prolog_flag'(readline, true),
 	read_history(h, '!h',
                          [trace, end_of_file],
-                         ' ?- ', Goal, Bindings),
+                         ' ?- ', Goal, Bindings), !,
 	(nonvar(Err) ->
 	 print_message(error,Err), fail
 	;

pl/flags.yap

@@ -53,15 +53,26 @@ yap_flag(executable,L) :- '$executable'(L).
 yap_flag(hide,Atom) :- !, hide(Atom).
 yap_flag(unhide,Atom) :- !, unhide(Atom).
 
-% hide/unhide atoms
+% character encoding...
-yap_flag(encoding,DefaultEncoding) :- var(DefaultEncoding), !,
+yap_flag(encoding,X) :-
-	'$default_encoding'(DefCode),
+	var(X), !,
-	'$valid_encoding'(DefaultEncoding, DefCode).
+	'$swi_current_prolog_flag'(encoding, X).
-yap_flag(encoding,Encoding) :-
+yap_flag(encoding,X) :-
-	'$valid_encoding'(Encoding, EncCode), !,
+	'$swi_set_prolog_flag'(encoding, X).
-	'$default_encoding'(EncCode).
+
-yap_flag(encoding,Encoding) :-
+% character encoding...
-	'$do_error'(domain_error(io_mode,encoding(Encoding)),yap_flag(encoding,Encoding)).
+yap_flag(fileerrors,X) :-
+	var(X), !,
+	'$swi_current_prolog_flag'(fileerrors, X).
+yap_flag(fileerrors,X) :-
+	'$swi_set_prolog_flag'(fileerrors, X).
+
+% -O optimisation
+yap_flag(optimise,X) :-
+	var(X), !,
+	'$swi_current_prolog_flag'(optimise, X).
+yap_flag(optimise,X) :-
+	'$swi_set_prolog_flag'(optimise, X).
 
 % control garbage collection
 yap_flag(gc,V) :-
@@ -207,12 +218,9 @@ yap_flag(home,X) :-
 
 yap_flag(readline,X) :-
 	var(X), !,
-	get_value('$readline',X).
+	'$swi_current_prolog_flag'(readline, X).
 yap_flag(readline,X) :-
-	( X = true ; X = false ), !,
+	'$swi_set_prolog_flag'(readline, X).
-	set_value('$readline',X).
-yap_flag(readline,X) :-
-	'$do_error'(domain_error(flag_value,readline+X),yap_flag(bounded,X)).
 
 % tabling mode
 yap_flag(tabling_mode,Options) :- 
@@ -562,7 +570,7 @@ yap_flag(system_options,X) :-
 '$system_options'(rational_trees) :-
 	'$yap_has_rational_trees'.
 '$system_options'(readline) :-
-	'$has_readline'.
+	'$swi_current_prolog_flag'(readline, true).
 '$system_options'(tabling) :-
 	\+ '$undefined'('$c_table'(_,_), prolog).
 '$system_options'(threads) :-
@@ -722,18 +730,6 @@ yap_flag(toplevel_print_options,Opts) :- !,
 	'$check_io_opts'(Opts, yap_flag(toplevel_print_options,Opts)),
 	recorda('$print_options','$toplevel'(Opts),_).
 
-yap_flag(fileerrors,OUT) :-
-	var(OUT), !,
-	get_value(fileerrors,X0),
-	(X0 = [] -> X= 0 ; X = X0),
-	'$transl_to_on_off'(X,OUT).
-yap_flag(fileerrors,on) :- !,
-	set_value(fileerrors,1).
-yap_flag(fileerrors,off) :- !,
-	set_value(fileerrors,0).
-yap_flag(fileerrors,X) :-
-	'$do_error'(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X)).
-
 :- recorda('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
 
 yap_flag(host_type,X) :-
@@ -845,6 +841,7 @@ yap_flag(dialect,yap).
 '$yap_system_flag'(n_of_integer_keys_in_db).
 '$yap_system_flag'(open_expands_filename).
 '$yap_system_flag'(open_shared_object).
+'$yap_system_flag'(optimise).
 '$yap_system_flag'(profiling).
 '$yap_system_flag'(prompt_alternatives_on).
 '$yap_system_flag'(readline).
@@ -907,7 +904,7 @@ yap_flag(dialect,yap).
 	% CHARACTER_ESCAPE
 	'$set_yap_flags'(12,1),
 	'$set_fpu_exceptions',
-	fileerrors,
+	'$swi_set_prolog_flag'(fileerrors, true),
 	unknown(_,error).
 '$adjust_language'(iso) :-
 	'$switch_log_upd'(1),

pl/yio.yap

@@ -88,8 +88,9 @@ open_pipe_streams(Read, Write) :-
 	),
 	unix:pipe(Read, Write).
 
-fileerrors :- set_value(fileerrors,1).
+fileerrors :- 	'$swi_set_prolog_flag'(fileerrors, true).
-nofileerrors :- set_value(fileerrors,0).
+
+nofileerrors :- '$swi_set_prolog_flag'(fileerrors, false).
 
 exists(F) :- access_file(F,exist).