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

This commit is contained in:
Joao 2011-04-07 16:04:19 +01:00
commit 9ab6f7ad36
26 changed files with 708 additions and 258 deletions

View File

@ -23,6 +23,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h" #include "YapHeap.h"
#include "yapio.h" #include "yapio.h"
#include "iopreds.h" #include "iopreds.h"
#include "eval.h"
#include "attvar.h" #include "attvar.h"
#include <math.h> #include <math.h>
@ -908,9 +909,18 @@ p_nb_setarg( USES_REGS1 )
} }
if (pos < 1 || pos > arity) if (pos < 1 || pos > arity)
return FALSE; return FALSE;
to = Deref(ARG3);
to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena) PASS_REGS) PASS_REGS); to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena) PASS_REGS) PASS_REGS);
if (to == 0L) if (to == 0L)
return FALSE; return FALSE;
dest = Deref(ARG2);
if (IsPairTerm(dest)) {
arity = 2;
} else {
arity = ArityOfFunctor(FunctorOfTerm(dest));
}
destp[pos] = to; destp[pos] = to;
return TRUE; return TRUE;
} }
@ -948,7 +958,7 @@ p_nb_set_shared_arg( USES_REGS1 )
} }
if (pos < 1 || pos > arity) if (pos < 1 || pos > arity)
return FALSE; 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) if (to == 0L)
return FALSE; return FALSE;
destp[pos] = to; destp[pos] = to;
@ -1011,6 +1021,136 @@ p_nb_linkval( USES_REGS1 )
return TRUE; 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 Term
Yap_SetGlobalVal(Atom at, Term t0) 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_peek", 3, p_nb_beam_peek, SafePredFlag);
Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, 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_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 #ifdef DEBUG
Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag); Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
#endif #endif

View File

@ -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 int
Yap_GetCharForSIGINT(void) Yap_GetCharForSIGINT(void)
{ {
@ -1163,6 +1152,5 @@ Yap_InitIOPreds(void)
// Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag); // Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag);
#endif #endif
Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag);
} }

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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-glob.c \
$(srcdir)/packages/PLStream/pl-option.c \ $(srcdir)/packages/PLStream/pl-option.c \
$(srcdir)/packages/PLStream/pl-os.c \ $(srcdir)/packages/PLStream/pl-os.c \
$(srcdir)/packages/PLStream/pl-prologflag.c \
$(srcdir)/packages/PLStream/pl-privitf.c \ $(srcdir)/packages/PLStream/pl-privitf.c \
$(srcdir)/packages/PLStream/pl-read.c \ $(srcdir)/packages/PLStream/pl-read.c \
$(srcdir)/packages/PLStream/pl-rl.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-glob.o pl-option.o \
pl-nt.o \ pl-nt.o \
pl-os.o pl-privitf.o \ pl-os.o pl-privitf.o \
pl-prologflag.o \
pl-read.o \ pl-read.o \
pl-rl.o \ pl-rl.o \
pl-stream.o pl-string.o pl-table.o \ pl-stream.o pl-string.o pl-table.o \
@ -386,7 +388,7 @@ BEAM_OBJECTS = \
STATIC_OBJECTS = \ STATIC_OBJECTS = \
@STATIC_MODE@sys.o yap_random.o regexp.o @NO_BUILTIN_REGEXP@ regcomp.o regerror.o regfree.o regexec.o @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) 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 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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 $@ $(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 # default rule
%.o : $(srcdir)/C/%.c config.h %.o : $(srcdir)/C/%.c config.h
$(CC) -c $(CFLAGS) $< -o $@ $(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) libYap.a: $(LIB_OBJECTS)
-rm -f libYap.a -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 $(RANLIB) libYap.a
@DYNYAPLIB@: $(LIB_OBJECTS) @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 install: install_bin install_data
@ -851,7 +860,6 @@ clean: clean_docs
@INSTALL_YAPR@ (cd packages/YapR; $(MAKE) clean) @INSTALL_YAPR@ (cd packages/YapR; $(MAKE) clean)
@USE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean) @USE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean)
@USE_MINISAT@ (cd packages/CLPBN/clpbn/bp; $(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) @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) clean)
@ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE) clean) @ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE) clean)
@ENABLE_CPLINT@ (cd packages/cplint; $(MAKE) clean) @ENABLE_CPLINT@ (cd packages/cplint; $(MAKE) clean)

View File

@ -340,6 +340,9 @@ UNICODE file functions.
#ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */ #ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */
#define FF_NOCREATE 0x4000 /* Fail if flag is non-existent */
#define FF_MASK 0xf000
/******************************* /*******************************
* STREAM SUPPORT * * 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 int PL_get_string_chars(term_t, char **, size_t *);
extern X_API record_t PL_record(term_t); extern X_API record_t PL_record(term_t);
extern X_API int PL_recorded(record_t, 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); extern X_API void PL_erase(record_t);
/* only partial implementation, does not guarantee export between different architectures and versions of YAP */ /* 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 *); 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_WAIT 1 /* Dispatch till input available */
#define PL_DISPATCH_INSTALLED 2 /* dispatch function installed? */ #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); 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(void) PL_add_to_protocol(const char *buf, size_t count);
PL_EXPORT(char *) PL_prompt_string(int fd); PL_EXPORT(char *) PL_prompt_string(int fd);
PL_EXPORT(void) PL_write_prompt(int dowrite); 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, size_t buflen,
int state); int state);
typedef int (*PL_dispatch_hook_t)(int fd);
/******************************* /*******************************
* WINDOWS MESSAGES * * WINDOWS MESSAGES *
*******************************/ *******************************/

View File

@ -113,7 +113,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
Term cm = CurrentModule; Term cm = CurrentModule;
/* fprintf(stderr,"doing %s:%s/%d\n", RepAtom(AtomOfTerm(mod))->StrOfAE, a,arity); */ /* fprintf(stderr,"doing %s:%s/%d\n", RepAtom(AtomOfTerm(mod))->StrOfAE, a,arity); */
CurrentModule = mod; CurrentModule = mod;
Yap_InitCPred(a, arity, def, UserCPredFlag); Yap_InitCPred(a, arity, def, (UserCPredFlag|CArgsPredFlag|flags));
if (arity == 0) { if (arity == 0) {
Atom at; Atom at;
while ((at = Yap_LookupAtom(a)) == NULL) { 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); f = Yap_MkFunctor(at, arity);
pe = RepPredProp(PredPropByFunc(f,mod)); pe = RepPredProp(PredPropByFunc(f,mod));
} }
pe->PredFlags |= (CArgsPredFlag|flags);
CurrentModule = cm; CurrentModule = cm;
} }
@ -1880,6 +1879,15 @@ PL_recorded(record_t db, term_t ts)
return TRUE; 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 X_API void
PL_erase(record_t db) 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; Term tmod;
Int nflags = 0; Int nflags = 0;
#ifdef DEBUG
if (flags & (PL_FA_NOTRACE|PL_FA_CREF)) { 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); 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) { if (module == NULL) {
tmod = CurrentModule; tmod = CurrentModule;
} else { } 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; 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); const char *Yap_GetCurrentPredName(void);
Int Yap_GetCurrentPredArity(void); Int Yap_GetCurrentPredArity(void);

View File

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

View File

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

View File

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

View File

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

View File

@ -168,6 +168,10 @@ typedef uintptr_t PL_atomic_t; /* same a word */
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4) #define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET+5) #define SIG_PLABORT (SIG_PROLOG_OFFSET+5)
#define LOCAL_OVERFLOW (-1)
#define GLOBAL_OVERFLOW (-2)
#define TRAIL_OVERFLOW (-3)
#define ARGUMENT_OVERFLOW (-4)
/******************************** /********************************
* UTILITIES * * UTILITIES *
@ -373,8 +377,10 @@ typedef struct
#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_INT64 5 /* passed as int64_t */
#define FT_FROM_VALUE 0x0f /* Determine type from value */
#define FT_MASK 0x0f /* mask to get type */ #define FT_MASK 0x0f /* mask to get type */
#define FF_READONLY 0x10 /* feature is read-only */ #define FF_READONLY 0x10 /* feature is read-only */
@ -778,7 +784,7 @@ COMMON(word) pl_write_canonical2(term_t stream, term_t term);
/* empty stub */ /* empty stub */
extern void setPrologFlag(const char *name, int flags, ...); 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); 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(bool) systemMode(bool accept);
COMMON(void) initPrologFlagTable(void);
COMMON(void) initPrologFlags(void);
COMMON(int) raiseStackOverflow(int overflow);
static inline word static inline word
setBoolean(int *flag, term_t old, term_t new) setBoolean(int *flag, term_t old, term_t new)
{ if ( !PL_unify_bool_ex(old, *flag) || { 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_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(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 */ /* inlines that need ARG_LD */
static inline intptr_t static inline intptr_t
skip_list(Word l, Word *tailp ARG_LD) { 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_read[];
extern const PL_extension PL_predicates_from_tai[]; extern const PL_extension PL_predicates_from_tai[];
extern const PL_extension PL_predicates_from_write[]; extern const PL_extension PL_predicates_from_write[];
extern const PL_extension PL_predicates_from_prologflag[];

View File

@ -24,14 +24,21 @@
/*#define O_DEBUG 1*/ /*#define O_DEBUG 1*/
#include "pl-incl.h" #include "pl-incl.h"
#ifdef __YAP_PROLOG__
#include "pl-ctype.h" #include "pl-ctype.h"
#else
#include "os/pl-ctype.h"
#endif
#include <ctype.h> #include <ctype.h>
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#ifdef __WINDOWS__ #ifdef __WINDOWS__
#include <process.h> /* getpid() */ #include <process.h> /* getpid() */
#endif #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 we want to be able to have a lot of flags and don't harm thread_create/3
too much. too much.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef __YAP_PROLOG__
static void setArgvPrologFlag(); static void setArgvPrologFlag(void);
static void setTZPrologFlag(); static void setTZPrologFlag(void);
static void setVersionPrologFlag(void); static void setVersionPrologFlag(void);
#endif
static atom_t lookupAtomFlag(atom_t key);
typedef struct _prolog_flag typedef struct _prolog_flag
{ short flags; /* Type | Flags */ { short flags; /* Type | Flags */
@ -76,6 +85,7 @@ typedef struct _prolog_flag
union union
{ atom_t a; /* value as atom */ { atom_t a; /* value as atom */
int64_t i; /* value as integer */ int64_t i; /* value as integer */
double f; /* value as float */
record_t t; /* value as term */ record_t t; /* value as term */
} value; } value;
} prolog_flag; } prolog_flag;
@ -92,13 +102,13 @@ following arguments are to be provided:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int static int
indexOfBoolMask(uintptr_t mask) indexOfBoolMask(unsigned int mask)
{ int i=1; { int i=1;
if ( !mask ) if ( !mask )
return -1; return -1;
while(!(mask & 0x1L)) while(!(mask & 0x1))
{ i++; { i++;
mask >>= 1; mask >>= 1;
} }
@ -108,7 +118,8 @@ indexOfBoolMask(uintptr_t mask)
void void
setPrologFlag(const char *name, int flags, ...) 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; prolog_flag *f;
Symbol s; Symbol s;
va_list args; va_list args;
@ -135,7 +146,7 @@ setPrologFlag(const char *name, int flags, ...)
switch(type) switch(type)
{ case FT_BOOL: { 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 */ if ( s && mask && f->index < 0 ) /* type definition */
{ f->index = indexOfBoolMask(mask); { f->index = indexOfBoolMask(mask);
@ -147,7 +158,7 @@ setPrologFlag(const char *name, int flags, ...)
f->value.a = (val ? ATOM_true : ATOM_false); f->value.a = (val ? ATOM_true : ATOM_false);
if ( f->index >= 0 ) if ( f->index >= 0 )
{ mask = 1L << (f->index-1); { mask = (unsigned int)1 << (f->index-1);
if ( val ) if ( val )
setPrologFlagMask(mask); setPrologFlagMask(mask);
@ -161,6 +172,11 @@ setPrologFlag(const char *name, int flags, ...)
f->value.i = val; f->value.i = val;
break; break;
} }
case FT_FLOAT:
{ double val = va_arg(args, double);
f->value.f = val;
break;
}
case FT_INT64: case FT_INT64:
{ int64_t val = va_arg(args, int64_t); { int64_t val = va_arg(args, int64_t);
f->value.i = val; f->value.i = val;
@ -196,7 +212,8 @@ setPrologFlag(const char *name, int flags, ...)
#ifdef O_PLMT #ifdef O_PLMT
static void static void
copySymbolPrologFlagTable(Symbol s) copySymbolPrologFlagTable(Symbol s)
{ prolog_flag *f = s->value; { GET_LD
prolog_flag *f = s->value;
prolog_flag *copy = allocHeap(sizeof(*copy)); prolog_flag *copy = allocHeap(sizeof(*copy));
*copy = *f; *copy = *f;
@ -208,7 +225,8 @@ copySymbolPrologFlagTable(Symbol s)
static void static void
freeSymbolPrologFlagTable(Symbol s) freeSymbolPrologFlagTable(Symbol s)
{ prolog_flag *f = s->value; { GET_LD
prolog_flag *f = s->value;
if ( (f->flags & FT_MASK) == FT_TERM ) if ( (f->flags & FT_MASK) == FT_TERM )
PL_erase(f->value.t); PL_erase(f->value.t);
@ -217,10 +235,11 @@ freeSymbolPrologFlagTable(Symbol s)
} }
#endif #endif
#ifndef __YAP_PROLOG__
int int
setDoubleQuotes(atom_t a, unsigned int *flagp) setDoubleQuotes(atom_t a, unsigned int *flagp)
{ unsigned int flags; { GET_LD
unsigned int flags;
if ( a == ATOM_chars ) if ( a == ATOM_chars )
flags = DBLQ_CHARS; flags = DBLQ_CHARS;
@ -254,15 +273,16 @@ setUnknown(atom_t a, unsigned int *flagp)
else if ( a == ATOM_warning ) else if ( a == ATOM_warning )
flags = UNKNOWN_WARNING; flags = UNKNOWN_WARNING;
else if ( a == ATOM_fail ) else if ( a == ATOM_fail )
flags = 0; flags = UNKNOWN_FAIL;
else else
{ term_t value = PL_new_term_ref(); { GET_LD
term_t value = PL_new_term_ref();
PL_put_atom(value, a); PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value); return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value);
} }
*flagp &= ~(UNKNOWN_ERROR|UNKNOWN_WARNING); *flagp &= ~(UNKNOWN_MASK);
*flagp |= flags; *flagp |= flags;
succeed; succeed;
@ -271,7 +291,8 @@ setUnknown(atom_t a, unsigned int *flagp)
static int static int
setWriteAttributes(atom_t a) setWriteAttributes(atom_t a)
{ int mask = writeAttributeMask(a); { GET_LD
int mask = writeAttributeMask(a);
if ( mask ) if ( mask )
{ LD->prolog_flag.write_attributes = mask; { LD->prolog_flag.write_attributes = mask;
@ -302,7 +323,9 @@ getOccursCheckMask(atom_t a, occurs_check_t *val)
static int static int
setOccursCheck(atom_t a) setOccursCheck(atom_t a)
{ if ( getOccursCheckMask(a, &LD->prolog_flag.occurs_check) ) { GET_LD
if ( getOccursCheckMask(a, &LD->prolog_flag.occurs_check) )
{ succeed; { succeed;
} else } else
{ term_t value = PL_new_term_ref(); { term_t value = PL_new_term_ref();
@ -312,10 +335,12 @@ setOccursCheck(atom_t a)
} }
} }
#endif /* __YAP_PROLOG__ */
static int static int
setEncoding(atom_t a) setEncoding(atom_t a)
{ IOENC enc = atom_to_encoding(a); { GET_LD
IOENC enc = atom_to_encoding(a);
if ( enc == ENC_UNKNOWN ) if ( enc == ENC_UNKNOWN )
{ term_t value = PL_new_term_ref(); { term_t value = PL_new_term_ref();
@ -331,8 +356,9 @@ setEncoding(atom_t a)
static word 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; Symbol s;
prolog_flag *f; prolog_flag *f;
Module m = MODULE_parse; Module m = MODULE_parse;
@ -375,14 +401,22 @@ set_prolog_flag_unlocked(term_t key, term_t value)
f = f2; f = f2;
} }
#endif #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; atom_t a;
int64_t i; int64_t i;
double d;
anyway:
PL_register_atom(k);
f = allocHeap(sizeof(*f));
f->index = -1; 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) )
{ case FT_FROM_VALUE:
{ if ( PL_get_atom(value, &a) )
{ if ( a == ATOM_true || a == ATOM_false ||
a == ATOM_on || a == ATOM_off )
f->flags = FT_BOOL; f->flags = FT_BOOL;
else else
f->flags = FT_ATOM; f->flags = FT_ATOM;
@ -391,42 +425,93 @@ set_prolog_flag_unlocked(term_t key, term_t value)
} else if ( PL_get_int64(value, &i) ) } else if ( PL_get_int64(value, &i) )
{ f->flags = FT_INTEGER; { f->flags = FT_INTEGER;
f->value.i = i; f->value.i = i;
} else if ( PL_get_float(value, &d) )
{ f->flags = FT_FLOAT;
f->value.f = d;
} else } else
{ f->flags = FT_TERM; { 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); f->value.t = PL_record(value);
} }
break;
#ifdef O_PLMT
if ( GD->statistics.threads_created > 1 )
{ if ( !LD->prolog_flag.table )
{ LD->prolog_flag.table = newHTable(4);
LD->prolog_flag.table->copy_symbol = copySymbolPrologFlagTable;
LD->prolog_flag.table->free_symbol = freeSymbolPrologFlagTable;
} }
addHTable(LD->prolog_flag.table, (void *)k, f); case FT_ATOM:
} else if ( !PL_get_atom_ex(value, &f->value.a) )
#endif { 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;
}
if ( (flags & FF_READONLY) )
f->flags |= FF_READONLY;
addHTable(GD->prolog_flag.table, (void *)k, f); addHTable(GD->prolog_flag.table, (void *)k, f);
succeed; 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) switch(f->flags & FT_MASK)
{ case FT_BOOL: { case FT_BOOL:
{ int val; { 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 ) if ( f->index > 0 )
{ uintptr_t mask = 1L << (f->index-1); { unsigned int mask = (unsigned int)1 << (f->index-1);
if ( val ) if ( val )
setPrologFlagMask(mask); setPrologFlagMask(mask);
else else
clearPrologFlagMask(mask); clearPrologFlagMask(mask);
} }
#ifndef __YAP_PROLOG__
if ( k == ATOM_character_escapes ) if ( k == ATOM_character_escapes )
{ if ( val ) { if ( val )
set(m, CHARESCAPE); set(m, CHARESCAPE);
@ -447,6 +532,8 @@ set_prolog_flag_unlocked(term_t key, term_t value)
break; /* don't change value */ break; /* don't change value */
#endif #endif
} }
#endif /* __YAP_PROLOG__ */
/* set the flag value */ /* set the flag value */
f->value.a = (val ? ATOM_true : ATOM_false); 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: case FT_ATOM:
{ atom_t a; { 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 ) if ( k == ATOM_double_quotes )
{ rval = setDoubleQuotes(a, &m->flags); { rval = setDoubleQuotes(a, &m->flags);
} else if ( k == ATOM_unknown ) } else if ( k == ATOM_unknown )
@ -466,7 +554,9 @@ set_prolog_flag_unlocked(term_t key, term_t value)
{ rval = setWriteAttributes(a); { rval = setWriteAttributes(a);
} else if ( k == ATOM_occurs_check ) } else if ( k == ATOM_occurs_check )
{ rval = setOccursCheck(a); { rval = setOccursCheck(a);
} else if ( k == ATOM_encoding ) } else
#endif
if ( k == ATOM_encoding )
{ rval = setEncoding(a); { rval = setEncoding(a);
} }
if ( !rval ) if ( !rval )
@ -475,17 +565,13 @@ set_prolog_flag_unlocked(term_t key, term_t value)
PL_unregister_atom(f->value.a); PL_unregister_atom(f->value.a);
f->value.a = a; f->value.a = a;
PL_register_atom(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; break;
} }
case FT_INTEGER: case FT_INTEGER:
{ int64_t i; { 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; f->value.i = i;
#ifdef O_ATOMGC #ifdef O_ATOMGC
if ( k == ATOM_agc_margin ) if ( k == ATOM_agc_margin )
@ -493,6 +579,14 @@ set_prolog_flag_unlocked(term_t key, term_t value)
#endif #endif
break; break;
} }
case FT_FLOAT:
{ double d;
if ( !PL_get_float_ex(value, &d) )
return FALSE;
f->value.f = d;
break;
}
case FT_TERM: case FT_TERM:
{ if ( f->value.t ) { if ( f->value.t )
PL_erase(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; { word rc;
LOCK(); LOCK();
rc = set_prolog_flag_unlocked(key, value); rc = set_prolog_flag_unlocked(A1, A2, FF_NOCREATE|FT_FROM_VALUE);
UNLOCK(); UNLOCK();
return rc; 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 static int
unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val) 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); { atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false);
return PL_unify_atom(val, v); 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 ) } else if ( key == ATOM_unknown )
{ atom_t v; { atom_t v;
if ( true(m, UNKNOWN_ERROR) ) switch ( getUnknownModule(m) )
{ case UNKNOWN_ERROR:
v = ATOM_error; v = ATOM_error;
else if ( true(m, UNKNOWN_WARNING) ) break;
case UNKNOWN_WARNING:
v = ATOM_warning; v = ATOM_warning;
else break;
case UNKNOWN_FAIL:
v = ATOM_fail; v = ATOM_fail;
break;
default:
assert(0);
}
return PL_unify_atom(val, v); return PL_unify_atom(val, v);
#ifdef O_PLMT #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 ) } else if ( key == ATOM_debugger_show_context )
{ return PL_unify_bool_ex(val, debugstatus.showContext); { return PL_unify_bool_ex(val, debugstatus.showContext);
} }
#endif /* YAP_PROLOG */
switch(f->flags & FT_MASK) switch(f->flags & FT_MASK)
{ case FT_BOOL: { case FT_BOOL:
if ( f->index >= 0 ) 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); 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); return PL_unify_atom(val, f->value.a);
case FT_INTEGER: case FT_INTEGER:
return PL_unify_int64(val, f->value.i); return PL_unify_int64(val, f->value.i);
case FT_FLOAT:
return PL_unify_float(val, f->value.f);
case FT_TERM: case FT_TERM:
{ term_t tmp = PL_new_term_ref(); { 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: default:
assert(0); assert(0);
@ -586,7 +779,9 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
static int static int
unify_prolog_flag_access(prolog_flag *f, term_t access) 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); return PL_unify_atom(access, ATOM_read);
else else
return PL_unify_atom(access, ATOM_write); return PL_unify_atom(access, ATOM_write);
@ -595,11 +790,12 @@ unify_prolog_flag_access(prolog_flag *f, term_t access)
static int static int
unify_prolog_flag_type(prolog_flag *f, term_t type) unify_prolog_flag_type(prolog_flag *f, term_t type)
{ atom_t a; { GET_LD
atom_t a;
switch(f->flags & FT_MASK) switch(f->flags & FT_MASK)
{ case FT_BOOL: { case FT_BOOL:
a = ATOM_bool; a = ATOM_boolean;
break; break;
case FT_ATOM: case FT_ATOM:
a = ATOM_atom; a = ATOM_atom;
@ -607,6 +803,9 @@ unify_prolog_flag_type(prolog_flag *f, term_t type)
case FT_INTEGER: case FT_INTEGER:
a = ATOM_integer; a = ATOM_integer;
break; break;
case FT_FLOAT:
a = ATOM_float;
break;
case FT_TERM: case FT_TERM:
a = ATOM_term; a = ATOM_term;
break; break;
@ -630,7 +829,8 @@ word
pl_prolog_flag5(term_t key, term_t value, pl_prolog_flag5(term_t key, term_t value,
word scope, word access, word type, word scope, word access, word type,
control_t h) control_t h)
{ prolog_flag_enum *e; { GET_LD
prolog_flag_enum *e;
Symbol s; Symbol s;
fid_t fid; fid_t fid;
Module module; Module module;
@ -721,10 +921,12 @@ pl_prolog_flag5(term_t key, term_t value,
{ UNLOCK(); { UNLOCK();
ForeignRedoPtr(e); ForeignRedoPtr(e);
} }
#ifndef __YAP_PROLOG__
if ( exception_term ) if ( exception_term )
{ exception_term = 0; { exception_term = 0;
setVar(*valTermRef(exception_bin)); setVar(*valTermRef(exception_bin));
} }
#endif
PL_rewind_foreign_frame(fid); PL_rewind_foreign_frame(fid);
} }
@ -762,9 +964,12 @@ pl_prolog_flag(term_t name, term_t value, control_t h)
#endif #endif
void void
initPrologFlagTable() initPrologFlagTable(void)
{ if ( !GD->prolog_flag.table ) { 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); GD->prolog_flag.table = newHTable(32);
} }
@ -772,8 +977,10 @@ initPrologFlagTable()
void 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); setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH);
#if __WINDOWS__ #if __WINDOWS__
setPrologFlag("windows", FT_BOOL|FF_READONLY, TRUE, 0); setPrologFlag("windows", FT_BOOL|FF_READONLY, TRUE, 0);
@ -787,17 +994,9 @@ initPrologFlags()
#if defined(HAVE_GETPID) || defined(EMULATE_GETPID) #if defined(HAVE_GETPID) || defined(EMULATE_GETPID)
setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid()); setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid());
#endif #endif
setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
setPrologFlag("generate_debug_info", FT_BOOL, 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("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_libs", FT_ATOM|FF_READONLY, C_LIBS);
setPrologFlag("c_cc", FT_ATOM|FF_READONLY, C_CC); setPrologFlag("c_cc", FT_ATOM|FF_READONLY, C_CC);
setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS); 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("open_shared_object", FT_BOOL|FF_READONLY, TRUE, 0);
setPrologFlag("shared_object_extension", FT_ATOM|FF_READONLY, SO_EXT); setPrologFlag("shared_object_extension", FT_ATOM|FF_READONLY, SO_EXT);
setPrologFlag("shared_object_search_path", FT_ATOM|FF_READONLY, SO_PATH); 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 #endif
setPrologFlag("address_bits", FT_INTEGER|FF_READONLY, sizeof(void*)*8); setPrologFlag("address_bits", FT_INTEGER|FF_READONLY, sizeof(void*)*8);
#ifdef HAVE_POPEN #ifdef HAVE_POPEN
@ -824,9 +1020,6 @@ initPrologFlags()
#ifdef O_PLMT #ifdef O_PLMT
setPrologFlag("threads", FT_BOOL|FF_READONLY, TRUE, 0); setPrologFlag("threads", FT_BOOL|FF_READONLY, TRUE, 0);
setPrologFlag("system_thread_id", FT_INTEGER|FF_READONLY, 0, 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 #else
setPrologFlag("threads", FT_BOOL|FF_READONLY, FALSE, 0); setPrologFlag("threads", FT_BOOL|FF_READONLY, FALSE, 0);
#endif #endif
@ -846,6 +1039,7 @@ initPrologFlags()
setPrologFlag("debug_on_error", FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR); setPrologFlag("debug_on_error", FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
setPrologFlag("report_error", FT_BOOL, TRUE, PLFLAG_REPORT_ERROR); setPrologFlag("report_error", FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
#endif #endif
setPrologFlag("user_flags", FT_ATOM, "silent");
setPrologFlag("editor", FT_ATOM, "default"); setPrologFlag("editor", FT_ATOM, "default");
setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0); setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
setPrologFlag("autoload", FT_BOOL, TRUE, PLFLAG_AUTOLOAD); setPrologFlag("autoload", FT_BOOL, TRUE, PLFLAG_AUTOLOAD);
@ -868,7 +1062,6 @@ initPrologFlags()
else else
setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero"); setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded"); setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
setPrologFlag("float_format", FT_ATOM, "%g");
setPrologFlag("answer_format", FT_ATOM, "~p"); setPrologFlag("answer_format", FT_ATOM, "~p");
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE); setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION); setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
@ -880,23 +1073,19 @@ initPrologFlags()
setPrologFlag("debug", FT_BOOL, FALSE, 0); setPrologFlag("debug", FT_BOOL, FALSE, 0);
setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal"); setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal");
setPrologFlag("verbose_load", FT_BOOL, TRUE, 0); 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, setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
ALLOW_VARNAME_FUNCTOR); ALLOW_VARNAME_FUNCTOR);
setPrologFlag("toplevel_var_size", FT_INTEGER, 1000); setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0); setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0);
setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS); setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
#ifdef __unix__ #ifdef __unix__
setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0); setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
#endif #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, 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) #if defined(__WINDOWS__) && defined(_DEBUG)
setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug"); setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug");
@ -909,17 +1098,31 @@ initPrologFlags()
setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, buf); setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, buf);
} }
#endif #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(); setArgvPrologFlag();
setTZPrologFlag(); setTZPrologFlag();
setOSPrologFlags(); setOSPrologFlags();
setVersionPrologFlag(); setVersionPrologFlag();
#endif /* YAP_PROLOG */
} }
#ifndef __YAP_PROLOG__
static void static void
setArgvPrologFlag() 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 e = PL_new_term_ref();
term_t l = PL_new_term_ref(); term_t l = PL_new_term_ref();
int argc = GD->cmdline.argc; int argc = GD->cmdline.argc;
@ -929,15 +1132,15 @@ setArgvPrologFlag()
PL_put_nil(l); PL_put_nil(l);
for(n=argc-1; n>= 0; n--) for(n=argc-1; n>= 0; n--)
{ PL_put_variable(e); { 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); setPrologFlag("argv", FT_TERM, l);
PL_discard_foreign_frame(fid); PL_discard_foreign_frame(fid);
} }
static void static void
setTZPrologFlag() setTZPrologFlag()
{ tzset(); { tzset();
@ -948,20 +1151,32 @@ setTZPrologFlag()
static void static void
setVersionPrologFlag(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(); term_t t = PL_new_term_ref();
int major = PLVERSION/10000; int major = PLVERSION/10000;
int minor = (PLVERSION/100)%100; int minor = (PLVERSION/100)%100;
int patch = (PLVERSION%100); int patch = (PLVERSION%100);
PL_unify_term(t, PL_FUNCTOR_CHARS, "swi", 4, if ( !PL_unify_term(t,
PL_FUNCTOR_CHARS, "swi", 4,
PL_INT, major, PL_INT, major,
PL_INT, minor, PL_INT, minor,
PL_INT, patch, PL_INT, patch,
PL_ATOM, ATOM_nil); PL_ATOM, ATOM_nil) )
sysError("Could not set version");
setPrologFlag("version_data", FF_READONLY|FT_TERM, t); setPrologFlag("version_data", FF_READONLY|FT_TERM, t);
PL_discard_foreign_frame(fid); PL_discard_foreign_frame(fid);
setGITVersion(); 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

View File

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

View File

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

View File

@ -2,6 +2,8 @@
/* YAP support for some low-level SWI stuff */ /* YAP support for some low-level SWI stuff */
#include <stdio.h> #include <stdio.h>
#include "Yap.h"
#include "Yatom.h"
#include "pl-incl.h" #include "pl-incl.h"
#if HAVE_MATH_H #if HAVE_MATH_H
#include <math.h> #include <math.h>
@ -283,7 +285,7 @@ _PL_unify_atomic(term_t t, PL_atomic_t a)
int int
_PL_unify_string(term_t t, word w) _PL_unify_string(term_t t, word w)
{ {
GET_LD CACHE_REGS
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w); return Yap_unify(Yap_GetFromSlot(t PASS_REGS), w);
} }
@ -456,17 +458,55 @@ lengthList(term_t list, int errors)
return isVar(*tail) ? -2 : -1; 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 int
PL_unify_chars(term_t t, int flags, size_t len, const char *s) PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text; { PL_chars_t text;
@ -802,6 +842,24 @@ PL_ttymode(IOSTREAM *s)
return PL_NOTTY; 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 X_API void
PL_prompt_next(int fd) PL_prompt_next(int fd)
{ GET_LD { GET_LD
@ -846,6 +904,15 @@ input_on_fd(int fd)
#endif #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 X_API int
PL_dispatch(int fd, int wait) PL_dispatch(int fd, int wait)
{ if ( wait == PL_DISPATCH_INSTALLED ) { if ( wait == PL_DISPATCH_INSTALLED )
@ -1023,14 +1090,20 @@ Yap_fetch_module_for_format(term_t args, YAP_Term *modp) {
return YAP_InitSlot(nt); return YAP_InitSlot(nt);
} }
word
pl_readline(term_t flag)
{
}
#if THREADS
#define COUNT_MUTEX_INITIALIZER(name) \ #define COUNT_MUTEX_INITIALIZER(name) \
{ PTHREAD_MUTEX_INITIALIZER, \ { PTHREAD_MUTEX_INITIALIZER, \
name, \ name, \
0L \ 0L \
} }
#if THREADS
static int static int
recursive_attr(pthread_mutexattr_t **ap) recursive_attr(pthread_mutexattr_t **ap)
{ static int done; { static int done;

View File

@ -24,7 +24,7 @@
#endif #endif
#define INTBITSIZE (sizeof(int)*8) #define INTBITSIZE (sizeof(int)*8)
typedef YAP_Term Module; typedef module_t Module;
typedef YAP_Term *Word; /* Anonymous 4 byte object */ typedef YAP_Term *Word; /* Anonymous 4 byte object */
typedef YAP_Term (*Func)(term_t); /* foreign functions */ 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 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 isInteger(A) (YAP_IsIntTerm((A)) || YAP_IsBigNumTerm((A)))
#define isString(A) Yap_IsStringTerm(A) #define isString(A) Yap_IsStringTerm(A)
#define isAtom(A) YAP_IsAtomTerm((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 wordToTermRef(A) YAP_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A) #define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A) #define valInt(A) IntegerOfTerm(A)
#define MODULE_parse ((Module)CurrentModule)
extern term_t Yap_CvtTerm(term_t ts); extern term_t Yap_CvtTerm(term_t ts);

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

View File

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

View File

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

View File

@ -53,15 +53,26 @@ yap_flag(executable,L) :- '$executable'(L).
yap_flag(hide,Atom) :- !, hide(Atom). yap_flag(hide,Atom) :- !, hide(Atom).
yap_flag(unhide,Atom) :- !, unhide(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 % control garbage collection
yap_flag(gc,V) :- yap_flag(gc,V) :-
@ -207,12 +218,9 @@ yap_flag(home,X) :-
yap_flag(readline,X) :- yap_flag(readline,X) :-
var(X), !, var(X), !,
get_value('$readline',X). '$swi_current_prolog_flag'(readline, X).
yap_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 % tabling mode
yap_flag(tabling_mode,Options) :- yap_flag(tabling_mode,Options) :-
@ -562,7 +570,7 @@ yap_flag(system_options,X) :-
'$system_options'(rational_trees) :- '$system_options'(rational_trees) :-
'$yap_has_rational_trees'. '$yap_has_rational_trees'.
'$system_options'(readline) :- '$system_options'(readline) :-
'$has_readline'. '$swi_current_prolog_flag'(readline, true).
'$system_options'(tabling) :- '$system_options'(tabling) :-
\+ '$undefined'('$c_table'(_,_), prolog). \+ '$undefined'('$c_table'(_,_), prolog).
'$system_options'(threads) :- '$system_options'(threads) :-
@ -722,18 +730,6 @@ yap_flag(toplevel_print_options,Opts) :- !,
'$check_io_opts'(Opts, yap_flag(toplevel_print_options,Opts)), '$check_io_opts'(Opts, yap_flag(toplevel_print_options,Opts)),
recorda('$print_options','$toplevel'(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)]),_). :- recorda('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
yap_flag(host_type,X) :- 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'(n_of_integer_keys_in_db).
'$yap_system_flag'(open_expands_filename). '$yap_system_flag'(open_expands_filename).
'$yap_system_flag'(open_shared_object). '$yap_system_flag'(open_shared_object).
'$yap_system_flag'(optimise).
'$yap_system_flag'(profiling). '$yap_system_flag'(profiling).
'$yap_system_flag'(prompt_alternatives_on). '$yap_system_flag'(prompt_alternatives_on).
'$yap_system_flag'(readline). '$yap_system_flag'(readline).
@ -907,7 +904,7 @@ yap_flag(dialect,yap).
% CHARACTER_ESCAPE % CHARACTER_ESCAPE
'$set_yap_flags'(12,1), '$set_yap_flags'(12,1),
'$set_fpu_exceptions', '$set_fpu_exceptions',
fileerrors, '$swi_set_prolog_flag'(fileerrors, true),
unknown(_,error). unknown(_,error).
'$adjust_language'(iso) :- '$adjust_language'(iso) :-
'$switch_log_upd'(1), '$switch_log_upd'(1),

View File

@ -88,8 +88,9 @@ open_pipe_streams(Read, Write) :-
), ),
unix:pipe(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). exists(F) :- access_file(F,exist).