diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

cmake & text support

This commit is contained in:
Vítor Santos Costa 2015-06-19 01:30:13 +01:00
parent 59de30d606
commit 1c06bfdc05
75 changed files with 1462 additions and 7041 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -62,3 +62,5 @@ cmake_install.cmake
cmake_clean.cmake
*.build
Makefile
C/myabsmi.c

2
.gitmodules vendored
View File

@ -15,7 +15,7 @@
url = git://git.code.sf.net/p/yap/http
[submodule "packages/clib"]
path = packages/clib
url = sssh://git.code.sf.net/p/yap/clib
url = git://git.code.sf.net/p/yap/clib
[submodule "packages/sgml"]
path = packages/sgml
url = git://git.code.sf.net/p/yap/sgml

111
C/cdmgr.c
View File

@ -527,12 +527,14 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
(CODEADDR)(P) < (CODEADDR)(B)+(SZ))
static PredEntry *
PredForChoicePt(yamop *p_code) {
PredForChoicePt(yamop *p_code, op_numbers *opn) {
while (TRUE) {
op_numbers opnum;
if (!p_code)
return NULL;
opnum = Yap_op_from_opcode(p_code->opc);
if (opn)
*opn = opnum;
switch(opnum) {
case _Nstop:
return NULL;
@ -626,10 +628,10 @@ PredForChoicePt(yamop *p_code) {
}
PredEntry *
Yap_PredForChoicePt(choiceptr cp) {
Yap_PredForChoicePt(choiceptr cp, op_numbers *op) {
if (cp == NULL)
return NULL;
return PredForChoicePt(cp->cp_ap);
return PredForChoicePt(cp->cp_ap, op);
}
static void
@ -974,9 +976,9 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc)
Term tmod = ap->ModuleOfPred;
if (!tmod)
tmod = TermProlog;
Yap_DebugPutc(LOCAL_c_error_stream,'\t');
Yap_DebugPutc(stderr,'\t');
Yap_DebugPlWrite(tmod);
Yap_DebugPutc(LOCAL_c_error_stream,':');
Yap_DebugPutc(stderr,':');
if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1);
if (IsAtomTerm(t)) {
@ -987,7 +989,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc)
Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPutc(stderr,'/');
Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f)));
}
} else {
@ -998,11 +1000,11 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc)
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPutc(stderr,'/');
Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f)));
}
}
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
Yap_DebugPutc(stderr,'\n');
}
#endif
/* Do not try to index a dynamic predicate or one whithout args */
@ -1030,7 +1032,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc)
}
#ifdef DEBUG
if (GLOBAL_Option['i' - 'a' + 1])
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
Yap_DebugPutc(stderr,'\n');
#endif
}
@ -1638,7 +1640,7 @@ source_pred(PredEntry *p, yamop *q)
return FALSE;
if (p->PredFlags & MultiFileFlag)
return TRUE;
if (yap_flags[SOURCE_MODE_FLAG]) {
if (trueGlobalPrologFlag(SOURCE_FLAG)) {
return TRUE;
}
return FALSE;
@ -2290,6 +2292,21 @@ goal_expansion_support(PredEntry *p, Term tf)
}
}
Int
Yap_source_line_no( void )
{
CACHE_REGS
return LOCAL_SourceFileLineno;
}
Atom
Yap_source_file_name( void )
{
CACHE_REGS
return LOCAL_SourceFileName;
}
static int
addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
/*
@ -3605,7 +3622,7 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
/* now mark the choicepoint */
if (b_ptr)
pe = PredForChoicePt(b_ptr->cp_ap);
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
else
return FALSE;
if (pe == p) {
@ -3671,6 +3688,7 @@ do_toggle_static_predicates_in_use(int mask)
do {
PredEntry *pe;
/* check first environments that are younger than our latest choicepoint */
while (b_ptr > (choiceptr)env_ptr) {
PredEntry *pe = EnvPreg((yamop *)env_ptr[E_CP]);
@ -3680,7 +3698,7 @@ do_toggle_static_predicates_in_use(int mask)
}
/* now mark the choicepoint */
if ((b_ptr)) {
if ((pe = PredForChoicePt(b_ptr->cp_ap))) {
if ((pe = PredForChoicePt(b_ptr->cp_ap, NULL))) {
mark_pred(mask, pe);
}
}
@ -3814,7 +3832,7 @@ all_calls( USES_REGS1 )
ts[0] = MkIntegerTerm((Int)P);
ts[1] = MkIntegerTerm((Int)CP);
if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
if (trueLocalPrologFlag(STACK_DUMP_ON_ERROR_FLAG)) {
ts[2] = all_envs(ENV PASS_REGS);
ts[3] = all_cps(B PASS_REGS);
if (ts[2] == 0L ||
@ -4128,7 +4146,7 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, arity_t *p
PredEntry *p;
if (where_from == FIND_PRED_FROM_CP) {
p = PredForChoicePt(codeptr);
p = PredForChoicePt(codeptr, NULL);
} else if (where_from == FIND_PRED_FROM_ENV) {
p = EnvPreg(codeptr);
if (p) {
@ -4320,7 +4338,7 @@ PredEntry *
Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, CODEADDR *startp, CODEADDR *endp) {
CACHE_REGS
if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr);
PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
@ -6663,6 +6681,68 @@ p_nth_instance( USES_REGS1 )
}
static Int predicate_flags(USES_REGS1) { /* $predicate_flags(+Functor,+Mod,?OldFlags,?NewFlags) */
PredEntry *pe;
pred_flags_t newFl;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
return (FALSE);
}
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
while ((pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod))) == NULL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate");
return FALSE;
}
t1 = Deref(ARG1);
mod = Deref(ARG2);
}
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
while ((pe = RepPredProp(PredPropByFunc(funt, mod))) == NULL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate");
return FALSE;
}
t1 = Deref(ARG1);
mod = Deref(ARG2);
}
} else
return (FALSE);
if (EndOfPAEntr(pe))
return (FALSE);
PELOCK(92, pe);
if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) {
UNLOCK(pe->PELock);
return (FALSE);
}
ARG4 = Deref(ARG4);
if (IsVarTerm(ARG4)) {
UNLOCK(pe->PELock);
return (TRUE);
} else if (!IsIntegerTerm(ARG4)) {
Term te = Yap_Eval(ARG4);
if (IsIntegerTerm(te)) {
newFl = IntegerOfTerm(te);
} else {
UNLOCK(pe->PELock);
Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");
return (FALSE);
}
} else
newFl = IntegerOfTerm(ARG4);
pe->PredFlags = newFl;
UNLOCK(pe->PELock);
return TRUE;
}
void
Yap_InitCdMgr(void)
{
@ -6677,6 +6757,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$rm_spy", 2, p_rmspy, SafePredFlag|SyncPredFlag);
/* gc() may happen during compilation, hence these predicates are
now unsafe */
Yap_InitCPred("$predicate_flags", 4, predicate_flags, SyncPredFlag);
Yap_InitCPred("$compile", 4, p_compile, SyncPredFlag);
Yap_InitCPred("$compile_dynamic", 5, p_compile_dynamic, SyncPredFlag);
Yap_InitCPred("$purge_clauses", 2, p_purge_clauses, SafePredFlag|SyncPredFlag);

156
C/errors.c
View File

@ -38,12 +38,12 @@ Yap_PrintPredName( PredEntry *ap )
if (!tmod) tmod = TermProlog;
#if THREADS
Yap_DebugPlWrite(MkIntegerTerm(worker_id));
Yap_DebugPutc(LOCAL_c_error_stream,' ');
Yap_DebugPutc(stderr,' ');
#endif
Yap_DebugPutc(LOCAL_c_error_stream,'>');
Yap_DebugPutc(LOCAL_c_error_stream,'\t');
Yap_DebugPutc(stderr,'>');
Yap_DebugPutc(stderr,'\t');
Yap_DebugPlWrite(tmod);
Yap_DebugPutc(LOCAL_c_error_stream,':');
Yap_DebugPutc(stderr,':');
if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1);
if (IsAtomTerm(t)) {
@ -54,7 +54,7 @@ Yap_PrintPredName( PredEntry *ap )
Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPutc(stderr,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
} else {
@ -65,14 +65,40 @@ Yap_PrintPredName( PredEntry *ap )
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPutc(stderr,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
}
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
char s[1024];
if (ap->PredFlags & StandardPredFlag)
fprintf(stderr,"S");
if (ap->PredFlags & CPredFlag)
fprintf(stderr,"C");
if (ap->PredFlags & UserCPredFlag)
fprintf(stderr,"U");
if (ap->PredFlags & SyncPredFlag)
fprintf(stderr,"Y");
if (ap->PredFlags & LogUpdatePredFlag)
fprintf(stderr,"Y");
if (ap->PredFlags & HiddenPredFlag)
fprintf(stderr,"H");
sprintf(s," %llx\n",ap->PredFlags);
Yap_DebugPuts(stderr,s);
}
#endif
bool
Yap_Warning( const char *s, ... )
{
va_list args;
va_start(args, s);
fprintf(stderr,"warning: %s\n", s);
va_end(args);
return true;
}
int Yap_HandleError( const char *s, ... ) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
@ -208,18 +234,11 @@ legal_env (CELL *ep USES_REGS)
}
static int
YapPutc(int sno, wchar_t ch)
YapPutc(FILE *f, wchar_t ch)
{
return (putc(ch, stderr));
return (putc(ch, f));
}
static void
YapPlWrite(Term t)
{
Yap_plwrite(t, NULL, 15, 0, 1200);
}
void
DumpActiveGoals ( USES_REGS1 )
{
@ -261,16 +280,16 @@ DumpActiveGoals ( USES_REGS1 )
if (first++ == 1)
fprintf(stderr,"Active ancestors:\n");
if (pe->ModuleOfPred) mod = pe->ModuleOfPred;
YapPlWrite (mod);
YapPutc (LOCAL_c_error_stream,':');
Yap_DebugPlWrite (mod);
YapPutc (stderr,':');
if (pe->ArityOfPE == 0) {
YapPlWrite (MkAtomTerm ((Atom)f));
Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
} else {
YapPlWrite (MkAtomTerm (NameOfFunctor (f)));
YapPutc (LOCAL_c_error_stream,'/');
YapPlWrite (MkIntTerm (ArityOfFunctor (f)));
Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
YapPutc (stderr,'/');
Yap_DebugPlWrite (MkIntTerm (ArityOfFunctor (f)));
}
YapPutc (LOCAL_c_error_stream,'\n');
YapPutc (stderr,'\n');
} else {
UNLOCK(pe->PELock);
}
@ -282,13 +301,14 @@ DumpActiveGoals ( USES_REGS1 )
while (TRUE)
{
PredEntry *pe;
op_numbers opnum;
if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL)
break;
pe = Yap_PredForChoicePt(b_ptr);
if (!pe)
break;
{
fprintf(stderr,"%p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n");
} else {
Functor f;
Term mod = PROLOG_MODULE;
@ -298,23 +318,58 @@ DumpActiveGoals ( USES_REGS1 )
else mod = TermProlog;
if (mod != TermProlog &&
mod != MkAtomTerm(AtomUser) ) {
YapPlWrite (mod);
YapPutc (LOCAL_c_error_stream,':');
Yap_DebugPlWrite (mod);
YapPutc (stderr,':');
}
if (pe->ArityOfPE == 0) {
YapPlWrite (MkAtomTerm ((Atom)f));
if (mod == IDB_MODULE) {
if (pe->PredFlags & NumberDBPredFlag) {
Int id = pe->src.IndxId;
Yap_DebugPlWrite(MkIntegerTerm(id));
} else if (pe->PredFlags & AtomDBPredFlag) {
Atom At = (Atom)pe->FunctorOfPred;
Yap_DebugPlWrite(MkAtomTerm(At));
} else {
Functor f = pe->FunctorOfPred;
Atom At = NameOfFunctor(f);
arity_t arity = ArityOfFunctor(f);
int i;
Yap_DebugPlWrite(MkAtomTerm(At));
YapPutc (stderr,'(');
for (i= 0; i < arity; i++) {
if (i > 0) YapPutc (stderr,',');
YapPutc (stderr,'_');
}
YapPutc (stderr,')');
}
YapPutc (stderr,'(');
Yap_DebugPlWrite(b_ptr->cp_a2);
YapPutc (stderr,')');
} else if (pe->ArityOfPE == 0) {
Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
} else {
Int i = 0, arity = pe->ArityOfPE;
Term *args = &(b_ptr->cp_a1);
YapPlWrite (MkAtomTerm (NameOfFunctor (f)));
YapPutc (LOCAL_c_error_stream,'(');
for (i= 0; i < arity; i++) {
if (i > 0) YapPutc (LOCAL_c_error_stream,',');
YapPlWrite(args[i]);
if (opnum == _or_last||
opnum == _or_else) {
Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
YapPutc (stderr,'(');
for (i= 0; i < arity; i++) {
if (i > 0) YapPutc (stderr,',');
YapPutc(stderr, '_');
}
Yap_DebugErrorPuts (") :- ... ( _ ; _ ");
} else {
Term *args = &(b_ptr->cp_a1);
Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
YapPutc (stderr,'(');
for (i= 0; i < arity; i++) {
if (i > 0) YapPutc (stderr,',');
Yap_DebugPlWrite(args[i]);
}
}
YapPutc (LOCAL_c_error_stream,')');
YapPutc (stderr,')');
}
YapPutc (LOCAL_c_error_stream,'\n');
YapPutc (stderr,'\n');
}
b_ptr = b_ptr->cp_b;
}
@ -559,7 +614,7 @@ Yap_Error(yap_error_number type, Term where, const char *format,...)
where = TermNil;
#if DEBUG_STRICT
if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode))
fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_ActiveSignals,LOCAL_PrologMode,format);
fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_Signals,LOCAL_PrologMode,format);
else
fprintf(stderr,"***** Processing Error %d (%x) %s***\n", type,LOCAL_PrologMode,format);
#endif
@ -620,7 +675,6 @@ Yap_Error(yap_error_number type, Term where, const char *format,...)
fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR);
detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf (stderr,"%% Continuation: %s\n",(char *)HR);
DumpActiveGoals( PASS_REGS1 );
error_exit_yap (1);
}
if (P == (yamop *)(FAILCODE))
@ -669,8 +723,8 @@ Yap_Error(yap_error_number type, Term where, const char *format,...)
fprintf(stderr,"%% YAP Fatal Error: %s exiting....\n",tmpbuf);
error_exit_yap (1);
}
#ifdef DEBUGX
DumpActiveGoals( USES_REGS1 );
#ifdef DEBUG
// DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */
switch (type) {
case INTERNAL_ERROR:
@ -1883,6 +1937,20 @@ Yap_Error(yap_error_number type, Term where, const char *format,...)
serious = TRUE;
}
break;
case TYPE_ERROR_PARAMETER:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomParameter);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case TYPE_ERROR_PREDICATE_INDICATOR:
{
int i;

11
C/exo.c
View File

@ -1,3 +1,4 @@
/*************************************************************************
* *
* YAP Prolog *
@ -39,7 +40,7 @@
#endif
bool YAP_NewExo( PredEntry *ap, size_t data, struct udi_info *udi);
bool YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t m);
bool YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t offset, size_t m);
//static int exo_write=FALSE;
@ -719,20 +720,22 @@ store_exo(yamop *pc, UInt arity, Term t0)
for (i = 0; i< arity; i++) {
DerefAndCheck(t, tp[0]);
*cpc = t;
Yap_DebugPlWrite(t); fprintf(stderr,"\n");
tp++;
cpc++;
}
fprintf(stderr,"\n");
return TRUE;
}
bool
YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t m)
YAP_AssertTuples( PredEntry *pe, const Term *ts, size_t offset, size_t m)
{
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
size_t i, n = pe->cs.p_code.NOfClauses;
ADDR base = (ADDR)mcl->ClCode+2*sizeof(struct index_t *);
for (i=0; i<n; i++) {
yamop *ptr = (yamop *)(base+n*(mcl->ClItemSize));
for (i=0; i<m; i++) {
yamop *ptr = (yamop *)(base+offset*(mcl->ClItemSize));
store_exo( ptr, pe->ArityOfPE, ts[i]);
}
return true;

22
C/init.c
View File

@ -69,7 +69,6 @@ static void InitOps(void);
static void InitDebug(void);
static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
static void InitStdPreds(void);
static void InitFlags(void);
static void InitCodes(void);
static void InitVersion(void);
void exit(int);
@ -86,7 +85,7 @@ static char *optypes[] =
{"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"};
/* OS page size for memory allocation */
int Yap_page_size;
size_t Yap_page_size;
#if DEBUG
#if COROUTINING
@ -439,7 +438,7 @@ InitDebug(void)
fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
fprintf(stderr,"m Machine\t p parser\n");
while ((ch = YP_putchar(YP_getchar())) != '\n')
while ((ch = putchar(getchar())) != '\n')
if (ch >= 'a' && ch <= 'z')
GLOBAL_Option[ch - 'a' + 1] = 1;
if (GLOBAL_Option['l' - 96]) {
@ -977,17 +976,15 @@ Yap_InitCPredBack_(const char *Name, UInt Arity,
static void
InitStdPreds(void)
{
void initIO(void);
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
Yap_InitYaamRegs( 0 );
Yap_InitPlIO();
Yap_InitFlags(false);
#if HAVE_MPE
Yap_InitMPE ();
#endif
initIO();
}
@ -1084,6 +1081,7 @@ InitSWIAtoms(void)
#include "iswiatoms.h"
Yap_InitSWIHash();
ATOM_ = PL_new_atom("");
*/
}
static void
@ -1326,6 +1324,9 @@ InitCodes(void)
/* make sure no one else can use these two atoms */
LOCAL_SourceModule = CurrentModule = 0;
Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));
/* flags require atom table done, but must be done as soon as possible,
definitely before any predicate initialization */
// Yap_InitFlags(); moved to HEAPFIELDS
/* make sure we have undefp defined */
/* predicates can only be defined after this point */
{
@ -1353,7 +1354,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
int n_workers, int sch_loop, int delay_load)
{
CACHE_REGS
int i;
/* initialise system stuff */
#if PUSH_REGS
@ -1425,9 +1425,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
Yap_InitTime( 0 );
/* InitAbsmi must be done before InitCodes */
/* This must be done before initialising predicates */
for (i = 0; i < NUMBER_OF_YAP_FLAGS; i++) {
yap_flags[i] = 0;
}
#ifdef MPW
Yap_InitAbsmi(REGS, FunctorList);
#else
@ -1440,7 +1437,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
#if THREADS
/* make sure we use the correct value of regcache */
regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
LOCAL_PL_local_data_p->reg_cache = regcache;
#endif
#if USE_SYSTEM_MALLOC
if (Trail < MinTrailSpace)
@ -1513,6 +1509,6 @@ Yap_exit (int value)
run_halt_hooks(value);
Yap_ShutdownLoadForeign();
}
closeFiles(TRUE);
Yap_CloseStreams (false);
exit(value);
}

1052
C/iopreds.c
View File

File diff suppressed because it is too large Load Diff

4
C/load_foreign.c
View File

@ -21,7 +21,6 @@ static char SccsId[] = "%W% %G%.2";
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "pl-shared.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_STRING_H
@ -51,6 +50,9 @@ p_load_foreign( USES_REGS1 )
yhandle_t CurSlot = Yap_StartSlots();
strcpy(LOCAL_ErrorSay,"Invalid arguments");
Yap_DebugPlWrite(ARG1); printf("%s\n", " \n");
Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
Yap_DebugPlWrite(ARG3); printf("%s\n", " \n");
/* collect the list of object files */
t = Deref(ARG1);

35
C/modules.c
View File

@ -44,7 +44,9 @@ static ModEntry *LookupModule(Term a);
}
READ_UNLOCK(ae->ARWLock);
return NULL;
}inline static ModEntry *GetModuleEntry(Atom at)
}
inline static ModEntry *GetModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
@ -60,6 +62,7 @@ static ModEntry *LookupModule(Term a);
}
{
CACHE_REGS
ModEntry *old;
new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
@ -67,23 +70,33 @@ static ModEntry *LookupModule(Term a);
new->NextME = CurrentModules;
CurrentModules = new;
new->AtomOfME = ae;
if (at == AtomProlog)
new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE;
else
new->flags = LookupModule(LOCAL_SourceModule)->flags;
if (CurrentModule == PROLOG_MODULE || AtomOfTerm(CurrentModule) == at) {
old = NULL;
} else
old = GetModuleEntry(AtomOfTerm(CurrentModule));
Yap_setModuleFlags(new, old);
AddPropToAtom(ae, (PropEntry *)new);
}
return new;
}
unsigned int getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_MASK)
return m->flags & UNKNOWN_MASK;
else {
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
Term Yap_getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_ERROR) {
return TermError;
} else if (m && m->flags & UNKNOWN_WARNING) {
return TermWarning;
} else {
return TermFail;
}
}
bool Yap_CharacterEscapes(Term mt) {
if (mt == PROLOG_MODULE) mt = TermProlog;
return GetModuleEntry(AtomOfTerm(mt))->flags & M_CHARESCAPE;
}
#define ByteAdr(X) ((char *)&(X))
Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS
@ -395,8 +408,6 @@ void Yap_InitModulesC(void) {
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, p_context_module, 0);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module,

31
C/pl-yap.c
View File

@ -31,8 +31,6 @@
//#define LOCK() PL_LOCK(L_PLFLAG)
//#define UNLOCK() PL_UNLOCK(L_PLFLAG)
int fileerrors;
PL_local_data_t lds;
gds_t gds;
@ -173,19 +171,6 @@ Yap_Eval(YAP_Term t USES_REGS)
return Yap_InnerEval__(t PASS_REGS);
}
IOENC
Yap_DefaultEncoding(void)
{
GET_LD
return LD->encoding;
}
void
Yap_SetDefaultEncoding(IOENC new_encoding)
{
GET_LD
LD->encoding = new_encoding;
}
int
PL_qualify(term_t raw, term_t qualified)
@ -926,7 +911,7 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
}
char *
Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags)
Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, int *encoding, int flags)
{
char *buf;
@ -1357,7 +1342,7 @@ setAccessLevel(access_level_t accept)
}
static bool
vsysError(const char *fm, va_list args)
sysError(const char *fm, va_list args)
{ static int active = 0;
switch ( active++ )
@ -1406,18 +1391,6 @@ sysError(const char *fm, ...)
PL_fail;
}
Int
Yap_source_line_no( void )
{ GET_LD
return source_line_no;
}
Atom
Yap_source_file_name( void )
{ GET_LD
return YAP_AtomFromSWIAtom(source_file_name);
}
atom_t
accessLevel(void)
{ GET_LD

56
C/save.c
View File

@ -86,9 +86,9 @@ void initIO(void);
#endif
static int myread(IOSTREAM *, char *, Int);
static Int mywrite(IOSTREAM *, char *, Int);
static IOSTREAM *open_file(char *, int);
static int myread(FILE *, char *, Int);
static Int mywrite(FILE *, char *, Int);
static FILE *open_file(char *, int);
static int close_file(void);
static Int putout(CELL);
static Int putcellptr(CELL *);
@ -124,7 +124,7 @@ static void restore_heap(void);
static void ShowAtoms(void);
static void ShowEntries(PropEntry *);
#endif
static int OpenRestore(char *, char *, CELL *, CELL *, CELL *, CELL *, IOSTREAM **);
static int OpenRestore(char *, char *, CELL *, CELL *, CELL *, CELL *, FILE **);
static void CloseRestore(void);
#ifndef _WIN32
static int check_opcodes(OPCODE []);
@ -184,11 +184,11 @@ do_system_error(yap_error_number etype, const char *msg)
inline static
int myread(IOSTREAM *fd, char *buffer, Int len) {
int myread(FILE *fd, char *buffer, Int len) {
ssize_t nread;
while (len > 0) {
nread = Sfread(buffer, 1, (int)len, fd);
nread = fread(buffer, 1, (int)len, fd);
if (nread < 1) {
return do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"bad read on saved state");
}
@ -200,11 +200,11 @@ int myread(IOSTREAM *fd, char *buffer, Int len) {
inline static
Int
mywrite(IOSTREAM *fd, char *buff, Int len) {
mywrite(FILE *fd, char *buff, Int len) {
ssize_t nwritten;
while (len > 0) {
nwritten = Sfwrite(buff, 1, (size_t)len, fd);
nwritten = fwrite(buff, 1, (size_t)len, fd);
if (nwritten < 0) {
return do_system_error(SYSTEM_ERROR,"bad write on saved state");
}
@ -222,7 +222,7 @@ mywrite(IOSTREAM *fd, char *buff, Int len) {
typedef CELL *CELLPOINTER;
static IOSTREAM *splfild = NULL;
static FILE *splfild = NULL;
#ifdef DEBUG
@ -239,10 +239,10 @@ static Int OldHeapUsed;
static CELL which_save;
/* Open a file to read or to write */
static IOSTREAM *
static FILE *
open_file(char *my_file, int flag)
{
IOSTREAM *splfild;
FILE *splfild;
char flags[6];
int i=0;
@ -264,7 +264,7 @@ open_file(char *my_file, int flag)
}
#endif
flags[i] = '\0';
splfild = Sopen_file( my_file, flags);
splfild = fopen( my_file, flags);
#ifdef undf0
fprintf(errout, "Opened file %s\n", my_file);
#endif
@ -276,7 +276,7 @@ close_file(void)
{
if (splfild == 0)
return 0;
if (Sclose(splfild) < 0)
if (fclose(splfild) < 0)
return do_system_error(SYSTEM_ERROR,"bad close on saved state");
splfild = 0;
return 1;
@ -313,7 +313,7 @@ get_header_cell(void)
size_t count = 0;
int n;
while (count < sizeof(CELL)) {
if ((n = Sfread(&l, 1, sizeof(CELL)-count, splfild)) < 0) {
if ((n = fread(&l, 1, sizeof(CELL)-count, splfild)) < 0) {
do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to read saved state header");
return 0L;
}
@ -578,7 +578,6 @@ save_crc(void)
static Int
do_save(int mode USES_REGS) {
extern void Scleanup(void);
Term t1 = Deref(ARG1);
if (Yap_HoleSize) {
@ -590,7 +589,6 @@ do_save(int mode USES_REGS) {
Yap_Error(TYPE_ERROR_LIST,t1,"save/1");
return FALSE;
}
Scleanup();
Yap_CloseStreams(TRUE);
if ((splfild = open_file(LOCAL_FileNameBuf, O_WRONLY | O_CREAT)) < 0) {
Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)),
@ -670,7 +668,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
/* skip the first line */
pp[0] = '\0';
do {
if ((n = Sfread(pp, 1, 1, splfild)) <= 0) {
if ((n = fread(pp, 1, 1, splfild)) <= 0) {
do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to scan first line from saved state");
return FAIL_RESTORE;
}
@ -680,7 +678,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
{
int count = 0, n, to_read = Unsigned(strlen(msg) + 1);
while (count < to_read) {
if ((n = Sfread(pp, 1, to_read-count, splfild)) <= 0) {
if ((n = fread(pp, 1, to_read-count, splfild)) <= 0) {
do_system_error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,"failed to scan version info from saved state");
return FAIL_RESTORE;
}
@ -1205,7 +1203,7 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS)
static void
RestoreSWIHash(void)
{
Yap_InitSWIHash();
// Yap_InitSWIHash();
}
@ -1394,12 +1392,10 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A
return(FAIL_RESTORE);
LOCAL_PrologMode = BootMode;
if (Yap_HeapBase) {
extern void Scleanup(void);
if (!yap_flags[HALT_AFTER_CONSULT_FLAG] && !yap_flags[QUIET_MODE_FLAG]) {
if (falseGlobalPrologFlag( HALT_AFTER_CONSULT_FLAG ) && !silentMode( )) {
Yap_TrueFileName(s,LOCAL_FileNameBuf2, YAP_FILENAME_MAX);
fprintf(stderr, "%% Restoring file %s\n", LOCAL_FileNameBuf2);
}
Scleanup();
Yap_CloseStreams(TRUE);
}
#ifdef DEBUG_RESTORE4
@ -1411,11 +1407,11 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A
return mode;
}
static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, IOSTREAM **streamp) {
static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp) {
int mode;
if (streamp) {
if ((*streamp = Sopen_file(inpf, "rb"))) {
if ((*streamp = fopen(inpf, "rb"))) {
return DO_ONLY_CODE;
}
return FAIL_RESTORE;
@ -1432,7 +1428,7 @@ static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *
}
static int
OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, IOSTREAM **streamp)
OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp)
{
CACHE_REGS
@ -1441,7 +1437,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
if (!Yap_trueFileName( inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_SAVED_STATE, true, true))
return false;
if (fname != NULL &&
if (fname[0] &&
(mode = try_open(fname,Astate,ATrail,AStack,AHeap,streamp)) != FAIL_RESTORE) {
return mode;
}
@ -1456,10 +1452,10 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
return FAIL_RESTORE;
}
IOSTREAM *
FILE *
Yap_OpenRestore(char *inpf, char *YapLibDir)
{
IOSTREAM *stream = NULL;
FILE *stream = NULL;
OpenRestore(inpf, YapLibDir, NULL, NULL, NULL, NULL, &stream);
return stream;
@ -1677,7 +1673,7 @@ Restore(char *s, char *lib_dir USES_REGS)
Yap_ReOpenLoadForeign();
FreeRecords();
/* restart IO */
initIO();
// initIO();
/* reset time */
Yap_ReInitWallTime();
#if USE_DL_MALLOC || USE_SYSTEM_MALLOC

149
C/scanner.c
View File

@ -410,8 +410,6 @@ writing, writing a BOM can be requested using the option
#include "alloc.h"
#include "eval.h"
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
#include "pl-read.h"
#include "YapText.h"
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_FINITE == 1
@ -437,7 +435,25 @@ writing, writing a BOM can be requested using the option
#define my_islower(C) (C >= 'a' && C <= 'z')
static Term float_send(char *, int);
static Term get_num(int *, int *, IOSTREAM *, char *, UInt, int);
static Term get_num(int *, int *, struct stream_desc *, char *, UInt, int);
static void
Yap_setCurrentSourceLocation( struct stream_desc *s )
{
CACHE_REGS
#if HAVE_SOCKET
if (s->status & Socket_Stream_f)
LOCAL_SourceFileName = AtomSocket;
else
#endif
if (s->status & Pipe_Stream_f)
LOCAL_SourceFileName =AtomPipe;
else if (s->status & InMemory_Stream_f)
LOCAL_SourceFileName = AtomCharsio;
else
LOCAL_SourceFileName = s->name;
LOCAL_SourceFileLineno = s->linecount;
}
/* token table with some help from Richard O'Keefe's PD scanner */
static char chtype0[NUMBER_OF_CHARS + 1] = {
@ -538,21 +554,16 @@ int Yap_wide_chtype(Int ch) {
return BS;
}
static inline int getchr__(IOSTREAM *inp) {
int c = Sgetcode(inp);
if (!CharConversionTable || c < 0 || c >= 256)
static inline int getchr__(struct stream_desc* inp) {
int c = inp->stream_wgetc_for_read(inp-GLOBAL_Stream);
if (!GLOBAL_CharConversionTable || c < 0 || c >= 256)
return c;
return CharConversionTable[c];
return GLOBAL_CharConversionTable[c];
}
#define getchr(inp) getchr__(inp)
#define getchrq(inp) Sgetcode(inp)
static int GetCurInpPos(IOSTREAM *inp_stream) {
return inp_stream->posbuf.lineno;
}
#define getchrq(inp) inp->stream_wgetc(inp-GLOBAL_Stream)
/* in case there is an overflow */
typedef struct scanner_extra_alloc {
@ -617,24 +628,27 @@ char *Yap_AllocScannerMemory(unsigned int size) {
extern double atof(const char *);
static Term float_send(char *s, int sign) {
GET_LD
Float f = (Float)(sign * atof(s));
#if HAVE_ISFINITE || defined(isfinite)
if (truePrologFlag(PLFLAG_ISO)) { /* iso */
if (trueGlobalPrologFlag(ISO_FLAG)) { /* iso */
if (!isfinite(f)) {
CACHE_REGS
LOCAL_ErrorMessage = "Float overflow while scanning";
return (MkEvalFl(f));
}
}
#elif HAVE_FINITE
if (truePrologFlag(PLFLAG_ISO)) { /* iso */
if (trueGlobalPrologFlag(ISO_FLAG)) { /* iso */
if (!finite(f)) {
LOCAL_ErrorMessage = "Float overflow while scanning";
return (MkEvalFl(f));
}
}
#endif
return (MkEvalFl(f));
{
CACHE_REGS
return (MkEvalFl(f));
}
}
/* we have an overflow at s */
@ -663,9 +677,8 @@ static int send_error_message(char s[]) {
return 0;
}
static wchar_t read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream) {
GET_LD
int ch;
static wchar_t read_quoted_char(int *scan_nextp, struct stream_desc* inp_stream) {
int ch;
/* escape sequence */
do_switch:
@ -749,7 +762,7 @@ do_switch:
case '`':
return '`';
case '^':
if (truePrologFlag(PLFLAG_ISO)) {
if (trueGlobalPrologFlag(ISO_FLAG)) {
return send_error_message("invalid escape sequence");
} else {
ch = getchrq(inp_stream);
@ -846,9 +859,8 @@ static int num_send_error_message(char s[]) {
/* reads a number, either integer or float */
static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
UInt max_size, int sign) {
GET_LD
char *sp = s;
int ch = *chp;
Int val = 0L, base = ch - '0';
@ -880,6 +892,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
*sp++ = ch;
ch = getchr(inp_stream);
if (base == 0) {
CACHE_REGS
wchar_t ascii = ch;
int scan_extra = TRUE;
@ -956,6 +969,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
*sp++ = ch;
}
if (ch - '0' >= base) {
CACHE_REGS
if (sign == -1)
return MkIntegerTerm(-val);
return MkIntegerTerm(val);
@ -973,10 +987,11 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
if (chtype(ch = getchr(inp_stream)) != NU) {
if (ch == 'e' || ch == 'E') {
if (truePrologFlag(PLFLAG_ISO))
if (trueGlobalPrologFlag(ISO_FLAG))
return num_send_error_message(
"Float format not allowed in ISO mode");
} else { /* followed by a letter, end of term? */
CACHE_REGS
sp[0] = '\0';
*chbuffp = '.';
*chp = ch;
@ -1026,6 +1041,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
ch = getchr(inp_stream);
}
if (chtype(ch) != NU) {
CACHE_REGS
if (has_dot)
return float_send(s, sign);
return MkIntegerTerm(sign * val);
@ -1056,6 +1072,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
return read_int_overflow(s + 3, base, val, sign);
return read_int_overflow(s, base, val, sign);
} else {
CACHE_REGS
*chp = ch;
return MkIntegerTerm(val * sign);
}
@ -1063,7 +1080,7 @@ static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
/* given a function getchr scan until we either find the number
or end of file */
Term Yap_scan_num(IOSTREAM *inp) {
Term Yap_scan_num(StreamDesc *inp) {
CACHE_REGS
Term out;
int sign = 1;
@ -1089,7 +1106,7 @@ Term Yap_scan_num(IOSTREAM *inp) {
ch = getchr(inp);
}
if (chtype(ch) != NU) {
Yap_clean_tokenizer(NULL, NULL, NULL, 0L);
Yap_clean_tokenizer(NULL, NULL, NULL);
return TermNil;
}
cherr = '\0';
@ -1097,7 +1114,7 @@ Term Yap_scan_num(IOSTREAM *inp) {
return TermNil;
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
PopScannerMemory(ptr, 4096);
Yap_clean_tokenizer(NULL, NULL, NULL, 0L);
Yap_clean_tokenizer(NULL, NULL, NULL);
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr)
return TermNil;
return out;
@ -1109,12 +1126,12 @@ Term Yap_scan_num(IOSTREAM *inp) {
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \
LOCAL_Error_Size = 0L; \
if (p) \
p->Tok = Ord(kind = eot_tok); \
p->Tok = Ord(kind = eot_tok); \
/* serious error now */ \
return l; \
}
static void open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) {
CELL *h0 = HR;
HR += 5;
h0[0] = AbsAppl(h0 + 2);
@ -1129,7 +1146,8 @@ static void open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
LOCAL_CommentsTail = h0 + 1;
h0 += 2;
h0[0] = (CELL)FunctorMinus;
h0[1] = Yap_StreamPosition(inp_stream);
h0[1] = Yap_StreamPosition(inp_stream-GLOBAL_Stream
);
h0[2] = TermNil;
LOCAL_CommentsNextChar = h0 + 2;
LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t));
@ -1203,16 +1221,16 @@ static wchar_t *ch_to_wide(char *base, char *charp) {
} \
}
TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
void *rd0) {
GET_LD
TokEntry *Yap_tokenizer( struct stream_desc *inp_stream,
bool store_comments, Term *tposp) {
CACHE_REGS
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int ch;
wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL;
struct read_data_t *rd = rd0;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0;
@ -1226,9 +1244,9 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
while (chtype(ch) == BS) {
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(rd);
LOCAL_StartLine = inp_stream->posbuf.lineno;
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream);
LOCAL_StartLine = inp_stream->linecount;
do {
wchar_t och;
int quote, isvar;
@ -1290,8 +1308,8 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
ch = getchr(inp_stream);
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(rd);
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream);
}
goto restart;
} else {
@ -1324,7 +1342,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
}
add_ch_to_buff(ch);
}
while (ch == '\'' && isvar && yap_flags[VARS_CAN_HAVE_QUOTE_FLAG]) {
while (ch == '\'' && isvar &&trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
if (charp == (char *)AuxSp - 1024) {
goto huge_var_error;
}
@ -1492,7 +1510,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
"Heap Overflow While Scanning: please increase code space (-h)";
break;
}
if (ch == 10 && truePrologFlag(PLFLAG_ISO)) {
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {
/* in ISO a new line terminates a string */
LOCAL_ErrorMessage = "layout character \n inside quotes";
break;
@ -1605,7 +1623,7 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
break;
case SY:
if (ch == '`' && truePrologFlag(PLFLAG_BACKQUOTED_STRING))
if (ch == '`' && trueGlobalPrologFlag(BACKQUOTED_STRING_FLAG))
goto quoted_string;
och = ch;
ch = getchr(inp_stream);
@ -1641,8 +1659,8 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
ch = getchr(inp_stream);
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(rd);
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream);
}
}
goto restart;
@ -1757,11 +1775,15 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
cur_qq = qq;
}
t->TokInfo = (CELL)qq;
qq->start.byteno = inp_stream->position->byteno;
qq->start.lineno = inp_stream->position->lineno;
qq->start.linepos = inp_stream->position->linepos - 1;
qq->start.charno = inp_stream->position->charno - 1;
t->Tok = Ord(kind = QuasiQuotes_tok);
if (inp_stream->status & Seekable_Stream_f ) {
qq->start.byteno = fseek (inp_stream->file, 0, 0);
}else {
qq->start.byteno = inp_stream->charcount - 1;
}
qq->start.lineno = inp_stream->linecount;
qq->start.linepos = inp_stream->linepos - 1;
qq->start.charno = inp_stream->charcount - 1;
t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(inp_stream);
solo_flag = FALSE;
break;
@ -1788,10 +1810,14 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
}
cur_qq = NULL;
t->TokInfo = (CELL)qq;
qq->mid.byteno = inp_stream->position->byteno;
qq->mid.lineno = inp_stream->position->lineno;
qq->mid.linepos = inp_stream->position->linepos - 1;
qq->mid.charno = inp_stream->position->charno - 1;
if (inp_stream->status & Seekable_Stream_f ) {
qq->mid.byteno = fseek (inp_stream->file, 0, 0);
}else {
qq->mid.byteno = inp_stream->charcount - 1;
}
qq->mid.lineno = inp_stream->linecount;
qq->mid.linepos = inp_stream->linepos - 1;
qq->mid.charno = inp_stream->charcount - 1;
t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(inp_stream);
@ -1849,10 +1875,14 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
strncpy(mp, TokImage, len + 1);
qq->text = (unsigned char *)mp;
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
qq->end.byteno = inp_stream->position->byteno;
qq->end.lineno = inp_stream->position->lineno;
qq->end.linepos = inp_stream->position->linepos - 1;
qq->end.charno = inp_stream->position->charno - 1;
if (inp_stream->status & Seekable_Stream_f ) {
qq->end.byteno = fseek (inp_stream->file, 0, 0);
}else {
qq->end.byteno = inp_stream->charcount - 1;
}
qq->end.lineno = inp_stream->linecount;
qq->end.linepos = inp_stream->linepos - 1;
qq->end.charno = inp_stream->charcount - 1;
if (!(t->TokInfo)) {
LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;
LOCAL_ErrorMessage = "Code Space Overflow";
@ -1905,8 +1935,9 @@ TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
return (l);
}
void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
VarEntry *anonvartable, Term commentable) {
void Yap_clean_tokenizer(TokEntry *tokstart,
VarEntry *vartable,
VarEntry *anonvartable) {
CACHE_REGS
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
while (ptr) {

7
C/signals.c
View File

@ -21,6 +21,9 @@ static char SccsId[] = "%W% %G%";
#define HAS_CACHE_REGS 1
#include "Yap.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if _WIN32
#include <stdio.h>
#include <io.h>
@ -57,7 +60,7 @@ static yap_signals
InteractSIGINT(int ch) {
#ifdef HAVE_SETBUF
/* make sure we are not waiting for the end of line */
YP_setbuf (stdin, NULL);
setbuf (stdin, NULL);
#endif
switch (ch) {
case 'a':
@ -337,7 +340,7 @@ p_first_signal( USES_REGS1 )
#elif HAVE_FFSLL
sig = ffsll(mask);
#else
sig = Yap_msb( mask )+1;
sig = Yap_msb( mask PASS_REGS)+1;
#endif
if (get_signal(sig PASS_REGS)) {
break;

261
C/text.c
View File

@ -22,6 +22,12 @@
#include "yapio.h"
#include "YapText.h"
#if defined(__BIG_ENDIAN__)
#define ENC_WCHAR ENC_ISO_UTF32_BE
#else
#define ENC_WCHAR ENC_ISO_UTF32_LE
#endif
#include <string.h>
#include <wchar.h>
@ -389,8 +395,8 @@ gen_type_error(int flags) {
return TYPE_ERROR_NUMBER;
}
static void *
read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS)
void *
Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS)
{
char *s;
wchar_t *ws;
@ -414,7 +420,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
return 0L;
}
// this is a term, extract the UTF8 representation
*enc = YAP_UTF8;
*enc = ENC_ISO_UTF8;
*minimal = FALSE;
*lengp = strlen(s);
return (void *)s;
@ -428,7 +434,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (!s) {
return NULL;
}
*enc = ( wide ? YAP_WCHAR : YAP_CHAR );
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
}
return s;
case YAP_STRING_ATOMS:
@ -438,8 +444,8 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
int wide = FALSE;
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) return NULL;
if (wide) { *enc = YAP_WCHAR; }
else { *enc = YAP_CHAR; }
if (wide) { *enc = ENC_WCHAR; }
else { *enc = ENC_ISO_LATIN1; }
}
return s;
case YAP_STRING_ATOMS_CODES:
@ -451,7 +457,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (!s) {
return NULL;
}
*enc = ( wide ? YAP_WCHAR : YAP_CHAR );
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
}
return s;
case YAP_STRING_ATOM:
@ -470,12 +476,12 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (IsWideAtom(at)) {
ws = at->WStrOfAE;
*lengp = wcslen(ws);
*enc = YAP_WCHAR;
*enc = ENC_WCHAR;
return ws;
} else {
s = at->StrOfAE;
*lengp = strlen(s);
*enc = YAP_CHAR;
*enc = ENC_ISO_LATIN1;
return s;
}
}
@ -487,7 +493,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, inp->val.i) < 0) {
AUX_ERROR( MkIntTerm(inp->val.i), 2*LOCAL_MAX_SIZE, s, char);
}
*enc = YAP_CHAR;
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
case YAP_STRING_FLOAT:
@ -498,7 +504,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
AUX_ERROR( MkFloatTerm(inp->val.f), 2*LOCAL_MAX_SIZE, s, char);
}
*lengp = strlen(s);
*enc = YAP_CHAR;
*enc = ENC_ISO_LATIN1;
return s;
#if USE_GMP
case YAP_STRING_BIG:
@ -507,19 +513,19 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if ( !Yap_mpz_to_string( inp->val.b, s, LOCAL_MAX_SIZE-1 , 10 ) ) {
AUX_ERROR( MkIntTerm(0), LOCAL_MAX_SIZE, s, char);
}
*enc = YAP_CHAR;
*enc = ENC_ISO_LATIN1;
*lengp = strlen(s);
return s;
#endif
case YAP_STRING_CHARS:
*enc = YAP_CHAR;
*enc = ENC_ISO_LATIN1;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
*lengp = strlen(inp->val.c);
return (void *)inp->val.c;
case YAP_STRING_WCHARS:
*enc = YAP_WCHAR;
*enc = ENC_WCHAR;
if (inp->type & YAP_STRING_NCHARS)
*lengp = inp->sz;
else
@ -527,23 +533,11 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
return (void *)inp->val.w;
case YAP_STRING_LITERAL:
{
yhandle_t CurSlot = Yap_StartSlots( );
char *s, *o;
if (buf) s = buf;
else s = Yap_PreAllocCodeSpace();
size_t sz = LOCAL_MAX_SIZE-1;
IOSTREAM *fd;
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
CurSlot = Yap_StartSlots();
fd = Sopenmem(&s, &sz, "w");
fd->encoding = ENC_UTF8;
if ( ! PL_write_term(fd, Yap_InitSlot(inp->val.t), 1200, 0) ||
Sputcode(EOS, fd) < 0 ||
Sflush(fd) < 0 ) {
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
}
*enc = YAP_UTF8;
*lengp = strlen(s);
Yap_CloseSlots(CurSlot);
o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0);
return s;
}
default:
@ -558,7 +552,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else if (IsStringTerm(t)) {
if (inp->type & (YAP_STRING_STRING)) {
inp->type &= (YAP_STRING_STRING);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
@ -566,7 +560,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else if (IsPairTerm(t) ) {
if (inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) {
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
@ -574,11 +568,11 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
} else if (IsAtomTerm(t)) {
if (t == TermNil && inp->type & (YAP_STRING_CODES|YAP_STRING_ATOMS)) {
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else if (inp->type & (YAP_STRING_ATOM)) {
inp->type &= (YAP_STRING_ATOM);
inp->val.t = t;
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
// [] is special...
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
@ -588,7 +582,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (inp->type & (YAP_STRING_INT)) {
inp->type &= (YAP_STRING_INT);
inp->val.i = IntegerOfTerm(t);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
@ -597,7 +591,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (inp->type & (YAP_STRING_FLOAT)) {
inp->type &= (YAP_STRING_FLOAT);
inp->val.f = FloatOfTerm(t);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
@ -607,7 +601,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *leng
if (inp->type & (YAP_STRING_BIG)) {
inp->type &= (YAP_STRING_BIG);
inp->val.b = Yap_BigIntOfTerm(t);
return read_Text( buf, inp, enc, minimal, lengp PASS_REGS);
return Yap_readText( buf, inp, enc, minimal, lengp PASS_REGS);
} else {
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
@ -634,7 +628,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
}
switch (enc) {
case YAP_UTF8:
case ENC_ISO_UTF8:
{ char *s = s0, *lim = s + (max = strnlen(s, max));
Term t = init_tstring( PASS_REGS1 );
char *cp = s, *buf;
@ -656,7 +650,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
out->val.t = t;
}
break;
case YAP_CHAR:
case ENC_ISO_LATIN1:
{ unsigned char *s = s0, *lim = s + (max = strnlen(s0, max));
Term t = init_tstring( PASS_REGS1 );
unsigned char *cp = s;
@ -678,7 +672,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
out->val.t = t;
}
break;
case YAP_WCHAR:
case ENC_WCHAR:
{ wchar_t *s = s0, *lim = s + (max = wcsnlen(s, max));
Term t = init_tstring( PASS_REGS1 );
wchar_t *wp = s;
@ -699,6 +693,9 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
close_tstring( buf PASS_REGS );
out->val.t = t;
}
break;
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
return out->val.t;
@ -719,7 +716,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
switch (enc) {
case YAP_UTF8:
case ENC_ISO_UTF8:
{ char *s = s0, *lim = s + strnlen(s, max);
char *cp = s;
wchar_t w[2];
@ -740,7 +737,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
break;
}
case YAP_CHAR:
case ENC_ISO_LATIN1:
{ unsigned char *s = s0, *lim = s + strnlen(s0, max);
unsigned char *cp = s;
char w[2];
@ -760,7 +757,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
break;
}
case YAP_WCHAR:
case ENC_WCHAR:
{ wchar_t *s = s0, *lim = s + wcsnlen(s, max);
wchar_t *cp = s;
wchar_t w[2];
@ -778,7 +775,10 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
sz++;
if (sz == max) break;
}
break;
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
if (out->type & YAP_STRING_DIFF) {
if (sz == 0) t = out->dif;
@ -804,7 +804,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
switch (enc) {
case YAP_UTF8:
case ENC_ISO_UTF8:
{ char *s = s0, *lim = s + strnlen(s, max);
char *cp = s;
LOCAL_TERM_ERROR( 2*(lim-s) );
@ -819,7 +819,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
break;
}
case YAP_CHAR:
case ENC_ISO_LATIN1:
{ unsigned char *s = s0, *lim = s + strnlen(s0, max);
unsigned char *cp = s;
@ -835,7 +835,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
break;
}
case YAP_WCHAR:
case ENC_WCHAR:
{ wchar_t *s = s0, *lim = s + wcsnlen(s, max);
wchar_t *cp = s;
@ -849,7 +849,10 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
sz++;
if (sz == max) break;
}
break;
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
while (sz < min) {
HR[0] = MkIntTerm(MkIntTerm(0));
@ -878,7 +881,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
}
switch (enc) {
case YAP_UTF8:
case ENC_ISO_UTF8:
{ char *s = s0, *lim = s + strnlen(s, max);
wchar_t *buf = malloc(sizeof(wchar_t)*((lim+1)-s)), *ptr = buf;
Atom at;
@ -894,7 +897,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
out->val.a = at;
return at;
}
case YAP_CHAR:
case ENC_ISO_LATIN1:
{ char *s = s0;
Atom at;
@ -903,7 +906,7 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
out->val.a = at;
return at;
}
case YAP_WCHAR:
case ENC_WCHAR:
{ wchar_t *s = s0;
Atom at;
@ -911,6 +914,8 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng US
out->val.a = at = Yap_LookupMaybeWideAtomWithLength(s, max);
return at;
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
return NULL;
}
@ -927,21 +932,23 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
}
switch (enc) {
case YAP_UTF8:
case ENC_ISO_UTF8:
{
const char *s = s0;
return utf8_strlen1(s);
}
case YAP_CHAR:
case ENC_ISO_LATIN1:
{
const char *s = s0;
return strnlen(s, max);
}
case YAP_WCHAR:
case ENC_WCHAR:
{
const wchar_t *s = s0;
return wcsnlen(s, max);
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
return (size_t)-1;
}
@ -949,71 +956,13 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
static Term
write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USES_REGS)
{
// call the scanner
IOSTREAM *st;
char *s = s0;
Term t = 0L;
if ( (st=Sopenmem( &s, NULL, "r")) != NULL )
{
if (enc == YAP_UTF8)
st->encoding = ENC_UTF8;
else if (enc == YAP_WCHAR)
st->encoding = ENC_WCHAR;
else
st->encoding = ENC_OCTET;
t = Yap_scan_num(st);
Sclose(st);
/* not ever iso */
if (t == TermNil && yap_flags[LANGUAGE_MODE_FLAG] != 1) {
s = s0;
int sign = 1;
if (s[0] == '+') {
s++;
}
if (s[0] == '-') {
s++;
sign = -1;
}
if(strcmp(s,"inf") == 0) {
if (sign > 0) {
return MkFloatTerm(INFINITY);
} else {
return MkFloatTerm(-INFINITY);
}
}
if(strcmp(s,"nan") == 0) {
if (sign > 0) {
return MkFloatTerm(NAN);
} else {
return MkFloatTerm(-NAN);
}
}
}
if (t == TermNil)
return 0;
return t;
}
return 0L;
return Yap_StringToNumberTerm(s0, enc);
}
static Term
write_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
string_to_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{
// call the scanner
IOSTREAM *st;
size_t len = out->sz;
Term t = 0L;
if ( (st=Sopenmem( s0, &len, "r")) )
{
if (enc == YAP_UTF8)
st->encoding = ENC_UTF8;
else if (enc == YAP_WCHAR)
st->encoding = ENC_WCHAR;
else
st->encoding = ENC_OCTET;
return t;
}
return 0L;
return Yap_StringToTerm(s0, strlen(s0)+1, enc, 1200, NULL);
}
@ -1072,13 +1021,13 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
}
if (out->type & (YAP_STRING_LITERAL))
if ((out->val.t =
write_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L)
string_to_term( inp, out, enc, minimal, leng PASS_REGS)) != 0L)
return out->val.t != 0;
return FALSE;
}
}
int
int
Yap_CVT_Text( seq_tv_t *inp, seq_tv_t *out USES_REGS)
{
encoding_t enc;
@ -1086,7 +1035,7 @@ Yap_CVT_Text( seq_tv_t *inp, seq_tv_t *out USES_REGS)
char *buf;
size_t leng;
buf = read_Text( NULL, inp, &enc, &minimal, &leng PASS_REGS );
buf = Yap_readText( NULL, inp, &enc, &minimal, &leng PASS_REGS );
if (!buf)
return 0L;
return write_Text( buf, out, enc, minimal, leng PASS_REGS );
@ -1096,17 +1045,19 @@ static void *
compute_end( void *s0, encoding_t enc )
{
switch (enc) {
case YAP_CHAR:
case YAP_UTF8:
case ENC_ISO_LATIN1:
case ENC_ISO_UTF8:
{
char *s = (char *)s0;
return s+(1+strlen(s));
}
case YAP_WCHAR:
case ENC_WCHAR:
{
wchar_t *s = (wchar_t *)s0;
return s + (1+wcslen(s));
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
return NULL;
}
@ -1115,12 +1066,14 @@ static void *
advance_Text( void *s, int l, encoding_t enc )
{
switch (enc) {
case YAP_CHAR:
case ENC_ISO_LATIN1:
return ((char *)s)+l;
case YAP_UTF8:
case ENC_ISO_UTF8:
return (char *)utf8_skip((const char *)s,l);
case YAP_WCHAR:
case ENC_WCHAR:
return ((wchar_t *)s)+l;
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc), __FUNCTION__);
}
return s;
}
@ -1130,77 +1083,85 @@ cmp_Text( void *s1, void *s2, int l, encoding_t enc1, encoding_t enc2 )
{
Int i;
switch (enc1) {
case YAP_CHAR:
case ENC_ISO_LATIN1:
{
char *w1 = (char *)s1;
switch (enc2) {
case YAP_CHAR:
case ENC_ISO_LATIN1:
return strncmp(s1, s2, l);
case YAP_UTF8:
case ENC_ISO_UTF8:
{
int chr1, chr2;
char *w2 = s2;
for (i = 0; i < l; i++) { chr1 = *w1++; w2 = utf8_get_char(w2, &chr2); if (chr1-chr2) return chr1-chr2; }
}
return 0;
case YAP_WCHAR:
case ENC_WCHAR:
{
int chr1, chr2;
wchar_t *w2 = s2;
for (i = 0; i < l; i++) { chr1 = *w1++; chr2 = *w2++; if (chr1-chr2) return chr1-chr2; }
}
return 0;
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__);
}
}
case YAP_UTF8:
}
case ENC_ISO_UTF8:
{
char *w1 = (char *)s1;
switch (enc2) {
case YAP_CHAR:
case ENC_ISO_LATIN1:
{
int chr1, chr2;
char *w2 = s2;
for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; }
}
return 0;
case YAP_UTF8:
case ENC_ISO_UTF8:
{
int chr1, chr2;
char *w2 = s2;
for (i = 0; i < l; i++) { w2 = utf8_get_char(w2, &chr2); w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; }
}
return 0;
case YAP_WCHAR:
case ENC_WCHAR:
{
int chr1, chr2;
wchar_t *w2 = s2;
for (i = 0; i < l; i++) { chr2 = *w2++; w1 = utf8_get_char(w1, &chr1); if (chr1-chr2) return chr1-chr2; }
}
return 0;
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__);
}
}
case YAP_WCHAR:
case ENC_WCHAR:
{
wchar_t *w1 = (wchar_t *)s1;
switch (enc2) {
case YAP_CHAR:
case ENC_ISO_LATIN1:
{
int chr1, chr2;
char *w2 = s2;
for (i = 0; i < l; i++) { chr1 = *w1++; chr2 = *w2++; if (chr1-chr2) return chr1-chr2; }
}
return 0;
case YAP_UTF8:
case ENC_ISO_UTF8:
{
int chr1, chr2;
char *w2 = s2;
for (i = 0; i < l; i++) { chr1 = *w1++; w2 = utf8_get_char(w2, &chr2); if (chr1-chr2) return chr1-chr2; }
}
return 0;
case YAP_WCHAR:
case ENC_WCHAR:
return wcsncmp(s1, s2, l);
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc2), __FUNCTION__);
}
}
default:
Yap_Error(SYSTEM_ERROR, TermNil, "Unsupported Encoding ~s in %s", enc_name(enc1), __FUNCTION__);
}
return 0;
}
@ -1214,11 +1175,11 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES
char *buf = buf_from_tstring(HR);
int i;
for (i = 0; i < n; i++) {
if (encv[i] == YAP_WCHAR) {
if (encv[i] == ENC_WCHAR) {
wchar_t *ptr = sv[i];
int chr;
while ( (chr = *ptr++) ) buf = utf8_put_char(buf, chr);
} else if (encv[i] == YAP_CHAR) {
} else if (encv[i] == ENC_ISO_LATIN1) {
char *ptr = sv[i];
int chr;
while ( (chr = *ptr++) ) buf = utf8_put_char(buf, chr);
@ -1233,28 +1194,28 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES
out->val.t = t;
return HR;
} else {
encoding_t enc = YAP_CHAR;
encoding_t enc = ENC_ISO_LATIN1;
size_t sz = 0;
int i;
for (i = 0; i < n; i++) {
if (encv[i] != YAP_CHAR) {
enc = YAP_WCHAR;
if (encv[i] != ENC_ISO_LATIN1) {
enc = ENC_WCHAR;
}
sz += write_length(sv[i], out, encv[i], FALSE, lengv[i] PASS_REGS);
}
if (enc == YAP_WCHAR) {
if (enc == ENC_WCHAR) {
/* wide atom */
wchar_t *buf = (wchar_t *)HR;
Atom at;
Term t = ARG1;
LOCAL_ERROR( sz+3 );
for (i = 0; i < n ; i ++) {
if (encv[i] == YAP_WCHAR) {
if (encv[i] == ENC_WCHAR) {
wchar_t *ptr = sv[i];
int chr;
while ( (chr = *ptr++) != '\0' ) *buf++ = chr;
} else if (encv[i] == YAP_CHAR) {
} else if (encv[i] == ENC_ISO_LATIN1) {
char *ptr = sv[i];
int chr;
while ( (chr = *ptr++) != '\0' ) *buf++ = (unsigned char)chr;
@ -1294,11 +1255,11 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
/* we assume we concatenate strings only, or ASCII stuff like numbers */
Term t = init_tstring( PASS_REGS1 );
char *nbuf = buf_from_tstring(HR);
if (enc == YAP_WCHAR) {
if (enc == ENC_WCHAR) {
wchar_t *ptr = (wchar_t *)buf + min;
int chr;
while ( min++ < max ) { chr = *ptr++; nbuf = utf8_put_char(nbuf, chr); }
} else if (enc == YAP_CHAR) {
} else if (enc == ENC_ISO_LATIN1) {
char *ptr = (char *)buf + min;
int chr;
while ( min++ < max ) { chr = *ptr++; nbuf = utf8_put_char(nbuf, chr); }
@ -1315,7 +1276,7 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
} else {
Atom at;
/* atom */
if (enc == YAP_WCHAR) {
if (enc == ENC_WCHAR) {
/* wide atom */
wchar_t *nbuf = (wchar_t *)HR;
Term t = TermNil;
@ -1326,7 +1287,7 @@ slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REG
}
nbuf[max-min] = '\0';
at = Yap_LookupMaybeWideAtom( nbuf );
} else if (enc == YAP_CHAR) {
} else if (enc == ENC_ISO_LATIN1) {
/* atom */
char *nbuf = (char *)HR;
@ -1375,7 +1336,7 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS)
HEAP_ERROR(encv, encoding_t);
buf = NULL;
for (i = 0 ; i < n ; i++) {
void *nbuf = read_Text( buf, inp+i, encv+i, &minimal, &leng PASS_REGS );
void *nbuf = Yap_readText( buf, inp+i, encv+i, &minimal, &leng PASS_REGS );
if (!nbuf)
return 0L;
@ -1401,7 +1362,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv
size_t l, leng;
int i, min;
buf = read_Text( NULL, inp, &enc, &minimal, &leng PASS_REGS );
buf = Yap_readText( NULL, inp, &enc, &minimal, &leng PASS_REGS );
if (!buf)
return NULL;
l = write_length( buf, inp, enc, minimal, leng PASS_REGS);
@ -1422,7 +1383,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv
void *buf0, *buf1;
if (outv[0].val.t) {
buf0 = read_Text( store, outv, &enc0, &minimal0, &leng0 PASS_REGS );
buf0 = Yap_readText( store, outv, &enc0, &minimal0, &leng0 PASS_REGS );
if (!buf0)
return NULL;
l0 = write_length( buf0, outv, enc, minimal0, leng0 PASS_REGS);
@ -1436,7 +1397,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv
encv[1] = enc;
return buf1;
} else /* if (outv[1].val.t) */ {
buf1 = read_Text( store, outv+1, &enc1, &minimal1, &leng1 PASS_REGS );
buf1 = Yap_readText( store, outv+1, &enc1, &minimal1, &leng1 PASS_REGS );
if (!buf1)
return NULL;
l1 = write_length( buf1, outv+1, enc1, minimal1, leng1 PASS_REGS);

71
C/threads.c
View File

@ -28,9 +28,8 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "eval.h"
#include "yapio.h"
#include "pl-shared.h"
#include "blobs.h"
#include <stdio.h>
#include <SWI-Prolog.h>
#if HAVE_STRING_H
#include <string.h>
#endif
@ -39,8 +38,8 @@ static char SccsId[] = "%W% %G%";
#endif /* TABLING */
PL_blob_t PL_Message_Queue = {
PL_BLOB_MAGIC,
blob_type_t PL_Message_Queue = {
YAP_BLOB_MAGIC_B,
PL_BLOB_UNIQUE | PL_BLOB_NOCOPY,
"message_queue",
0, // release
@ -64,32 +63,6 @@ static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; debug_pe_locks = 0;
#include "threads.h"
/*
* This file includes the definition of threads in Yap. Threads
* are supposed to be compatible with the SWI-Prolog thread package.
*
*/
static void
set_system_thread_id(int wid, PL_thread_info_t *info)
{
if (!info)
info = (PL_thread_info_t *)malloc(sizeof(PL_thread_info_t));
info = SWI_thread_info(wid, info);
info->tid = pthread_self();
info->has_tid = TRUE;
#ifdef HAVE_GETTID_SYSCALL
info->pid = syscall(__NR_gettid);
#else
#ifdef HAVE_GETTID_MACRO
info->pid = gettid();
#else
#ifdef __WINDOWS__
info->w32id = GetCurrentThreadId();
#endif
#endif
#endif
}
int
Yap_ThreadID( void )
@ -358,7 +331,6 @@ kill_thread_engine (int wid, int always_die)
free(REMOTE_ScratchPad(wid).ptr);
// if (REMOTE_TmpPred(wid).ptr)
// free(REMOTE_TmpPred(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache =
REMOTE_ThreadHandle(wid).current_yaam_regs = NULL;
if (REMOTE_ThreadHandle(wid).start_of_timesp)
free(REMOTE_ThreadHandle(wid).start_of_timesp);
@ -394,7 +366,6 @@ setup_engine(int myworker_id, int init_thread)
CACHE_REGS
REGSTORE *standard_regs;
set_system_thread_id( myworker_id, NULL );
standard_regs = (REGSTORE *)calloc(1,sizeof(REGSTORE));
if (!standard_regs)
return FALSE;
@ -402,7 +373,6 @@ setup_engine(int myworker_id, int init_thread)
/* create the YAAM descriptor */
REMOTE_ThreadHandle(myworker_id).default_yaam_regs = standard_regs;
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = standard_regs;
REMOTE_PL_local_data_p(myworker_id)->reg_cache = standard_regs;
Yap_InitExStacks(myworker_id, REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize);
REMOTE_SourceModule(myworker_id) = CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
// create a mbox
@ -711,12 +681,10 @@ Yap_thread_attach_engine(int wid)
if (REMOTE_ThreadHandle(wid).ref_count ) {
REMOTE_ThreadHandle(wid).ref_count++;
REMOTE_ThreadHandle(wid).pthread_handle = pthread_self();
set_system_thread_id(wid, SWI_thread_info(wid, NULL));
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
return TRUE;
}
REMOTE_ThreadHandle(wid).pthread_handle = pthread_self();
set_system_thread_id(wid, SWI_thread_info(wid, NULL));
REMOTE_ThreadHandle(wid).ref_count++;
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(wid).current_yaam_regs);
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
@ -1196,7 +1164,7 @@ p_with_mutex( USES_REGS1 )
}
if (
pe->OpcodeOfPred != FAIL_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS) ) {
Yap_execute_pred(pe, NULL, true PASS_REGS) ) {
rc = TRUE;
}
end:
@ -1592,38 +1560,29 @@ p_thread_unlock( USES_REGS1 )
}
intptr_t
system_thread_id(PL_thread_info_t *info)
{ if ( !info )
{ CACHE_REGS
if ( LOCAL )
info = SWI_thread_info(worker_id, NULL);
else
return -1;
}
#ifdef __linux__
return info->pid;
#else
#ifdef __WINDOWS__
return info->w32id;
#else
return (intptr_t)info->tid;
#endif
system_thread_id(void)
{
#ifdef HAVE_GETTID_SYSCALL
return syscall(__NR_gettid);
#elif defined( HAVE_GETTID_MACRO )
return gettid();
#elif defined(__WINDOWS__)
return GetCurrentThreadId();
#endif
}
void
Yap_InitFirstWorkerThreadHandle(void)
{
CACHE_REGS
set_system_thread_id(0, NULL);
LOCAL_ThreadHandle.id = 0;
LOCAL_ThreadHandle.in_use = TRUE;
LOCAL_ThreadHandle.default_yaam_regs =
&Yap_standard_regs;
LOCAL_ThreadHandle.current_yaam_regs =
&Yap_standard_regs;
LOCAL_PL_local_data_p->reg_cache =
&Yap_standard_regs;
LOCAL_ThreadHandle.pthread_handle = pthread_self();
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock, NULL);
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
@ -1840,7 +1799,7 @@ p_new_mutex(void)
}
if (
pe->OpcodeOfPred != FAIL_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS) ) {
Yap_execute_pred(pe, NULL, false PASS_REGS) ) {
rc = TRUE;
}
end:

146
C/traced_absmi_insts.h
View File

@ -1,4 +1,9 @@
#ifndef THREADS
#define PASS_REGS
#else
#define PASS_REGS , regcache
#endif
#define undef_goal( x )
if (P == NULL) goto fail;
@ -1506,7 +1511,7 @@ Op(cut, s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
/* assume cut is always in stack */
saveregs();
prune((choiceptr)YREG[E_CB]);
prune((choiceptr)YREG[E_CB] PASS_REGS);
setregs();
GONext();
ENDOp();
@ -1528,7 +1533,7 @@ Op(cut, s);
SET_ASP(YREG, PREG->y_u.s.s);
/* assume cut is always in stack */
saveregs();
prune((choiceptr)YREG[E_CB]);
prune((choiceptr)YREG[E_CB] PASS_REGS);
setregs();
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
GONext();
@ -1550,7 +1555,7 @@ prune((choiceptr)YREG[E_CB]);
SET_ASP(YREG, PREG->y_u.s.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
saveregs();
prune((choiceptr)SREG[E_CB]);
prune((choiceptr)SREG[E_CB] PASS_REGS);
setregs();
GONext();
ENDOp();
@ -1617,7 +1622,7 @@ prune((choiceptr)YREG[E_CB]);
#endif /* YAPOR_SBA && FROZEN_STACKS */
EMIT_SIMPLE_BLOCK_TEST(COMMIT_B_X_POST_YSBA_FROZEN);
saveregs();
prune(pt0);
prune(pt0 PASS_REGS);
setregs();
}
GONext();
@ -1660,7 +1665,7 @@ prune((choiceptr)YREG[E_CB]);
#endif
EMIT_SIMPLE_BLOCK_TEST(COMMIT_B_Y_POST_YSBA_FROZEN);
saveregs();
prune(pt0);
prune(pt0 PASS_REGS);
setregs();
}
GONext();
@ -2016,11 +2021,11 @@ prune((choiceptr)YREG[E_CB]);
GONext();
ENDOp();
/**********************************************
* OPTYap instructions *
**********************************************/
#if EAM
/**********************************************
* EAM instructions *
**********************************************/
Op(retry_eam, e);
//goto retry_eam;
@ -2031,6 +2036,9 @@ prune((choiceptr)YREG[E_CB]);
{ printf("run_eam not supported by JIT!!\n"); exit(1); }
ENDOp();
#endif
/************************************************************************\
* Get Instructions *
\************************************************************************/
@ -6814,24 +6822,18 @@ S_SREG = RepAppl(d0);
JMPNext();
ENDBOp();
#if THREADS
BOp(thread_local, e);
{
#if THREADS
EMIT_ENTRY_BLOCK(PREG,THREAD_LOCAL_INSTINIT);
EMIT_ENTRY_BLOCK(PREG,THREAD_LOCAL_INSTINIT);
PredEntry *ap = PredFromDefCode(PREG);
ap = Yap_GetThreadPred(ap PASS_REGS);
PREG = ap->CodeOfPred;
#else
saveregs();
undef_goal( PASS_REGS1 );
setregs();
/* for profiler */
#endif
CACHE_A1();
}
}
JMPNext();
ENDBOp();
#endif
BOp(expand_index, e);
{
@ -9200,7 +9202,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_PLUS_VV_PLUS_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9252,7 +9254,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_PLUS_VC_PLUS_VC_NVAR_NOINT);
saveregs();
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9300,7 +9302,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_PLUS_Y_VV_PLUS_Y_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9356,7 +9358,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_PLUS_Y_VC_PLUS_Y_VC_NVAR_NOINT);
saveregs();
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9407,7 +9409,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_MINUS_VV_MINUS_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9457,7 +9459,7 @@ S_SREG = RepAppl(d0);
else {
EMIT_SIMPLE_BLOCK_TEST(P_MINUS_CV_MINUS_CV_NVAR_NOINT);
saveregs();
d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0));
d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9511,7 +9513,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_MINUS_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -9583,7 +9585,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_MINUS_Y_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -9636,13 +9638,13 @@ S_SREG = RepAppl(d0);
if (IsIntTerm(d0) && IsIntTerm(d1)) {
EMIT_CONDITIONAL_SUCCESS("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VV_TIMES_VV_NVAR_NVAR_INT);
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1));
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
}
else {
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VV_TIMES_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9688,13 +9690,13 @@ S_SREG = RepAppl(d0);
if (IsIntTerm(d0)) {
EMIT_CONDITIONAL_SUCCESS("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VC_TIMES_VC_NVAR_INT);
d0 = times_int(IntOfTerm(d0), d1);
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
}
else {
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_VC_TIMES_VC_NVAR_NOINT);
saveregs();
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9741,14 +9743,14 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_TIMES_Y_VV_INTTERM);
///#endif
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1));
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
}
else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_TIMES_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -9806,12 +9808,12 @@ S_SREG = RepAppl(d0);
Int d1 = PREG->y_u.yxn.c;
if (IsIntTerm(d0)) {
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_Y_VC_TIMES_Y_VC_NVAR_INT);
d0 = times_int(IntOfTerm(d0), d1);
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
}
else {
EMIT_SIMPLE_BLOCK_TEST(P_TIMES_Y_VC_TIMES_Y_VC_NVAR_NOINT);
saveregs();
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9870,8 +9872,8 @@ S_SREG = RepAppl(d0);
else {
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_DIV_VV_DIV_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1));
saveregs();
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9930,7 +9932,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_DIV_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1));
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10001,7 +10003,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_DIV_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0));
d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_DIV_CV_D0EQUALS0L);
@ -10075,7 +10077,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_DIV_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10147,7 +10149,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_DIV_Y_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1));
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10221,7 +10223,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_DIV_Y_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10281,7 +10283,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0) && IsIntTerm(d1)");
EMIT_SIMPLE_BLOCK_TEST(P_AND_VV_AND_VV_NVAR_NVAR_NOINT);
saveregs();
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10333,7 +10335,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_AND_VC_AND_VC_NVAR_NOINT);
saveregs();
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10387,7 +10389,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_AND_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10459,7 +10461,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_AND_Y_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10525,7 +10527,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_OR_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10594,7 +10596,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_OR_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_OR_VC_D0EQUALS0L);
@ -10655,7 +10657,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_OR_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10727,7 +10729,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_OR_Y_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -10795,7 +10797,7 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_VV_INTTERM_GREATER);
///#endif
d0 = do_sll(IntOfTerm(d0),i2);
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
}
}
else {
@ -10803,7 +10805,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLL_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -10865,14 +10867,14 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_VC_INTTERM);
///#endif
d0 = do_sll(IntOfTerm(d0), (Int)d1);
d0 = do_sll(IntOfTerm(d0), (Int)d1 PASS_REGS);
}
else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
}
}
@ -10921,13 +10923,13 @@ S_SREG = RepAppl(d0);
if (i2 < 0) {
d0 = MkIntegerTerm(SLR(d1, -i2));
} else {
d0 = do_sll(d1,i2);
d0 = do_sll(d1,i2 PASS_REGS);
}
} else {
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_SLL_CV_SLL_CV_NVAR_NOINT);
saveregs();
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}
@ -10984,14 +10986,14 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_VV_INTTERM_GREATER);
///#endif
d0 = do_sll(IntOfTerm(d0),i2);
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
}
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -11056,14 +11058,14 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_VC_INTTERM);
///#endif
d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1));
d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1) PASS_REGS);
}
else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
}
}
@ -11128,14 +11130,14 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_CV_INTTERM_GREATER);
///#endif
d0 = do_sll(d1,i2);
d0 = do_sll(d1,i2 PASS_REGS);
}
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLL_Y_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0));
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0) PASS_REGS);
setregs();
}
}
@ -11198,7 +11200,7 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_VV_INTTERM_LESS);
///#endif
d0 = do_sll(IntOfTerm(d0), -i2);
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_VV_INTTERM_GREATER);
@ -11210,7 +11212,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLR_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -11272,7 +11274,7 @@ S_SREG = RepAppl(d0);
EMIT_CONDITIONAL_FAIL("IsIntTerm(d0)");
EMIT_SIMPLE_BLOCK_TEST(P_SLR_VC_SLR_VC_NVAR_NOINT);
saveregs();
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -11320,7 +11322,7 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_CV_INTTERM_LESS);
///#endif
d0 = do_sll(d1, -i2);
d0 = do_sll(d1, -i2 PASS_REGS);
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_CV_INTTERM_GREATER);
@ -11332,7 +11334,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLR_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}
@ -11392,7 +11394,7 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_INTTERM_LESS);
///#endif
d0 = do_sll(IntOfTerm(d0), -i2);
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_INTTERM_GREATER);
@ -11404,7 +11406,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLR_Y_VV_NOINTTERM);
///#endif
saveregs();
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
BEGP(pt0);
@ -11476,7 +11478,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLR_Y_VC_NOINTTERM);
///#endif
saveregs();
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
///#ifdef PROFILED_ABSMI
@ -11534,7 +11536,7 @@ S_SREG = RepAppl(d0);
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_INTTERM_LESS);
///#endif
d0 = do_sll(d1, -i2);
d0 = do_sll(d1, -i2 PASS_REGS);
} else {
///#ifdef PROFILED_ABSMI
EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_INTTERM_GREATER);
@ -11546,7 +11548,7 @@ S_SREG = RepAppl(d0);
EMIT_SIMPLE_BLOCK(P_SLR_Y_CV_NOINTTERM);
///#endif
saveregs();
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}

96
C/tracer.c
View File

@ -25,41 +25,39 @@
#include "yapio.h"
#include "clause.h"
#include "tracer.h"
#include "SWI-Stream.h"
static void send_tracer_message(char *, char *, Int, char *, CELL *);
static void
send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
{
if (name == NULL) {
#ifdef YAPOR
Sfprintf(GLOBAL_stderr, "(%d)%s", worker_id, start);
fprintf(stderr, "(%d)%s", worker_id, start);
#else
Sfprintf(GLOBAL_stderr, "%s", start);
fprintf(stderr, "%s", start);
#endif
} else {
int i;
if (arity) {
if (args)
Sfprintf(GLOBAL_stderr, "%s %s:%s(", start, mname, name);
fprintf(stderr, "%s %s:%s(", start, mname, name);
else
Sfprintf(GLOBAL_stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity);
fprintf(stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity);
} else {
Sfprintf(GLOBAL_stderr, "%s %s:%s", start, mname, name);
fprintf(stderr, "%s %s:%s", start, mname, name);
}
if (args) {
for (i= 0; i < arity; i++) {
if (i > 0) Sfprintf(GLOBAL_stderr, ",");
Yap_plwrite(args[i], GLOBAL_stderr, 15, Handle_vars_f|AttVar_Portray_f, 1200);
if (i > 0) fprintf(stderr, ",");
Yap_plwrite(args[i], NULL, 15, Handle_vars_f|AttVar_Portray_f, 1200);
}
if (arity) {
Sfprintf(GLOBAL_stderr, ")");
fprintf(stderr, ")");
}
}
}
Sfprintf(GLOBAL_stderr, "\n");
fprintf(stderr, "\n");
}
#if defined(__GNUC__)
@ -121,7 +119,7 @@ check_area(void)
first = i;
found = TRUE;
}
Sfprintf(stderr,"%lld changed %d\n",vsc_count,i);
fprintf(stderr,"%lld changed %d\n",vsc_count,i);
}
array[i] = ((CELL *)0x187a800)[i];
}
@ -163,12 +161,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;
//if (vsc_count == 161862) jmp_deb(1);
// Sfprintf(stderr,"B=%p ", B);
// fprintf(stderr,"B=%p ", B);
#ifdef THREADS
LOCAL_ThreadHandle.thread_inst_count++;
#endif
#ifdef COMMENTED
Sfprintf(stderr,"in %p\n");
fprintf(stderr,"in %p\n");
CELL * gc_ENV = ENV;
while (gc_ENV != NULL) { /* no more environments */
fprintf(stderr,"%ld\n", LCL0-gc_ENV);
@ -197,7 +195,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
if (vsc_count % 1LL == 0) {
UInt sz = Yap_regp->H0_[17];
UInt end = sizeof(MP_INT)/sizeof(CELL)+sz+1;
Sfprintf(GLOBAL_stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]);
fprintf(stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]);
}
} else
return;
@ -309,9 +307,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
printf("\n");
}
#endif
Sfprintf(GLOBAL_stderr,"%lld ",vsc_count);
fprintf(stderr,"%lld ",vsc_count);
#if defined(THREADS) || defined(YAPOR)
Sfprintf(GLOBAL_stderr,"(%d)", worker_id);
fprintf(stderr,"(%d)", worker_id);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {
@ -394,7 +392,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
break;
}
Sflush(GLOBAL_stderr);
fflush(NULL);
UNLOCK(Yap_heap_regs->low_level_trace_lock);
}
@ -405,32 +402,31 @@ toggle_low_level_trace(void)
Yap_do_low_level_trace = !Yap_do_low_level_trace;
}
static Int p_start_low_level_trace( USES_REGS1 )
static Int start_low_level_trace( USES_REGS1 )
{
GLOBAL_stderr = Serror; //Sopen_file("TRACER_LOG", "w");
Yap_do_low_level_trace = TRUE;
return(TRUE);
}
static Int p_total_choicepoints( USES_REGS1 )
static Int total_choicepoints( USES_REGS1 )
{
return Yap_unify(MkIntegerTerm(LOCAL_total_choicepoints),ARG1);
}
static Int p_reset_total_choicepoints( USES_REGS1 )
static Int reset_total_choicepoints( USES_REGS1 )
{
LOCAL_total_choicepoints = 0;
return TRUE;
}
static Int p_show_low_level_trace( USES_REGS1 )
static Int show_low_level_trace( USES_REGS1 )
{
Sfprintf(GLOBAL_stderr,"Call counter=%lld\n",vsc_count);
fprintf(stderr,"Call counter=%lld\n",vsc_count);
return(TRUE);
}
#ifdef THREADS
static Int p_start_low_level_trace2( USES_REGS1 )
static Int start_low_level_trace2( USES_REGS1 )
{
thread_trace = IntegerOfTerm(Deref(ARG1))+1;
Yap_do_low_level_trace = TRUE;
@ -440,7 +436,15 @@ static Int p_start_low_level_trace2( USES_REGS1 )
#include <stdio.h>
static Int p_stop_low_level_trace( USES_REGS1 )
/** @pred stop_low_level_trace
Stop displaying messages at procedure entry and retry.
Note that using this compile-time option will slow down execution, even if messages are
not being output.
*/
static Int stop_low_level_trace( USES_REGS1 )
{
Yap_do_low_level_trace = FALSE;
LOCAL_do_trace_primitives = TRUE;
@ -450,19 +454,24 @@ static Int p_stop_low_level_trace( USES_REGS1 )
return(TRUE);
}
volatile int vsc_wait;
volatile int v_wait;
static Int p_vsc_wait( USES_REGS1 )
static Int vsc_wait( USES_REGS1 )
{
while (!vsc_wait);
vsc_wait=1;
return(TRUE);
while (!v_wait);
return true;
}
static Int vsc_go( USES_REGS1 )
{
v_wait=1;
return true;
}
void
Yap_InitLowLevelTrace(void)
{
Yap_InitCPred("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag);
Yap_InitCPred("start_low_level_trace", 0, start_low_level_trace, SafePredFlag);
/** @pred start_low_level_trace
@ -471,23 +480,14 @@ Begin display of messages at procedure entry and retry.
*/
#if THREADS
Yap_InitCPred("start_low_level_trace", 1, p_start_low_level_trace2, SafePredFlag);
Yap_InitCPred("start_low_level_trace", 1, start_low_level_trace2, SafePredFlag);
#endif
Yap_InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag);
/** @pred stop_low_level_trace
Stop display of messages at procedure entry and retry.
Note that this compile-time option will slow down execution.
*/
Yap_InitCPred("show_low_level_trace", 0, p_show_low_level_trace, SafePredFlag);
Yap_InitCPred("total_choicepoints", 1, p_total_choicepoints, SafePredFlag);
Yap_InitCPred("reset_total_choicepoints", 0, p_reset_total_choicepoints, SafePredFlag);
Yap_InitCPred("vsc_wait", 0, p_vsc_wait, SafePredFlag);
Yap_InitCPred("stop_low_level_trace", 0, stop_low_level_trace, SafePredFlag);
Yap_InitCPred("show_low_level_trace", 0, show_low_level_trace, SafePredFlag);
Yap_InitCPred("total_choicepoints", 1, total_choicepoints, SafePredFlag);
Yap_InitCPred("reset_total_choicepoints", 0, reset_total_choicepoints, SafePredFlag);
Yap_InitCPred("vsc_wait", 0, vsc_wait, SafePredFlag);
Yap_InitCPred("vsc_go", 0, vsc_go, SafePredFlag);
}
#endif

132
C/write.c
View File

@ -28,7 +28,7 @@ static char SccsId[] = "%W% %G%";
#if COROUTINING
#include "attvar.h"
#endif
#include "pl-shared.h"
#include "iopreds.h"
#include "pl-utf8.h"
#if HAVE_STRING_H
@ -43,12 +43,13 @@ static char SccsId[] = "%W% %G%";
/* describe the type of the previous term to have been written */
typedef enum {
start, /* initialization */
separator, /* the previous term was a separator like ',', ')', ... */
alphanum, /* the previous term was an atom or number */
symbol /* the previous term was a symbol like +, -, *, .... */
} wtype;
typedef void *wrf;
typedef StreamDesc *wrf;
typedef struct union_slots {
Int old;
@ -69,7 +70,7 @@ typedef struct rewind_term {
} rwts;
typedef struct write_globs {
IOSTREAM *stream;
StreamDesc *stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
@ -89,7 +90,7 @@ static bool callPortray(Term t, struct DB_TERM **old_EXp USES_REGS) {
EX = NULL;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t PASS_REGS)) {
Yap_execute_pred(pe, &t, true PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0);
if (EX && !*old_EXp)
*old_EXp = EX;
@ -112,14 +113,14 @@ static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *);
#define wrputc(X, WF) Sputcode(X, WF) /* writes a character */
#define wrputc(WF, X) (X)->stream_wputc(X-GLOBAL_Stream, WF) /* writes a character */
/*
protect bracket from merging with previoous character.
avoid stuff like not (2,3) -> not(2,3) or
*/
static void wropen_bracket(struct write_globs *wglb, int protect) {
wrf stream = wglb->stream;
StreamDesc *stream = wglb->stream;
if (lastw != separator && protect)
wrputc(' ', stream);
@ -176,7 +177,11 @@ static void wrputn(Int n,
protect_close_number(wglb, ob);
}
#define wrputs(s, stream) Sfputs(s, stream)
inline static void
wrputs(char *s, StreamDesc *stream) {
int c;
while ((c = *s++)) wrputc(c, stream);
}
static void wrputws(wchar_t *s, wrf stream) /* writes a string */
{
@ -274,7 +279,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
blob_info = big_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers &&
(f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0);
(f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
return;
}
}
@ -284,8 +289,10 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
{
char s[256];
wrf stream = wglb->stream;
#if THREADS
char s[256];
#endif
wrf stream = wglb->stream;
int sgn;
int ob;
@ -358,30 +365,28 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
wrputs(".0", stream);
}
#else
char *format_float(double f, char *buf);
char *buf;
char buf[256];
if (lastw == symbol || lastw == alphanum) {
wrputc(' ', stream);
}
/* use SWI's format_float */
buf = format_float(f, s);
if (!buf)
return;
sprintf(buf, floatFormat(),f);
wrputs(buf, stream);
#endif
protect_close_number(wglb, ob);
}
int Yap_FormatFloat(Float f, const char *s, size_t sz) {
CACHE_REGS
struct write_globs wglb;
char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
wglb.stream = smem;
wglb.lw = separator;
wglb.last_atom_minus = FALSE;
wrputf(f, &wglb);
Sclose(smem);
int sno;
sno = Yap_open_buf_read_stream(s, strlen(s)+1, LOCAL_encoding, MEM_BUF_USER);
if (sno < 0)
return FALSE;
wrputf(f, &wglb);
GLOBAL_Stream[sno].status = Free_Stream_f;
return TRUE;
}
@ -404,22 +409,13 @@ static void wrputref(CODEADDR ref, int Quote_illegal,
/* writes a blob (default) */
static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) {
char s[256];
wrf stream = wglb->stream;
PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t;
if (type->write) {
atom_t at = YAP_SWIAtomFromAtom(AbsAtom(ref));
return type->write(stream, at, 0);
} else {
putAtom(AtomSWIStream, Quote_illegal, wglb);
#if defined(__linux__) || defined(__APPLE__)
sprintf(s, "(%p)", ref);
#else
sprintf(s, "(0x%p)", ref);
#endif
wrputs(s, stream);
}
int rc;
int Yap_write_blob(AtomEntry *ref, StreamDesc *stream);
if ((rc = Yap_write_blob(ref, stream))) {
return rc;
}
lastw = alphanum;
return 1;
}
@ -550,7 +546,7 @@ static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
static void write_string(const char *s,
struct write_globs *wglb) /* writes an integer */
{
IOSTREAM *stream = wglb->stream;
StreamDesc *stream = wglb->stream;
int chr, qt;
char *ptr = (char *)s;
@ -622,7 +618,7 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
}
}
void Yap_WriteAtom(IOSTREAM *s, Atom atom) {
void Yap_WriteAtom(StreamDesc *s, Atom atom) {
struct write_globs wglb;
wglb.stream = s;
wglb.Quote_illegal = FALSE;
@ -727,8 +723,8 @@ static CELL *restore_from_write(struct rewind_term *rwt,
if (wglb->Keep_terms) {
ptr = (CELL *)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS);
if (!Yap_RecoverSlots(2, rwt->u_sd.s.ptr PASS_REGS))
return NULL;
Yap_RecoverSlots(2, rwt->u_sd.s.old PASS_REGS);
// printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ;
} else {
ptr = rwt->u_sd.d.ptr;
}
@ -875,13 +871,13 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return;
}
if (EX)
return;
DBTerm *oEX = EX;
EX = NULL;
t = Deref(t);
if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt);
@ -903,12 +899,15 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE);
EX = oEX;
return;
}
if (wglb->Use_portray)
if (callPortray(t, &EX PASS_REGS))
return;
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
if (wglb->Use_portray)
if (callPortray(t, &EX PASS_REGS)) {
EX = oEX;
return;
}
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
putString(t, wglb);
} else {
wrputc('[', wglb->stream);
@ -978,8 +977,10 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
}
#endif
if (wglb->Use_portray) {
if (callPortray(t, &EX PASS_REGS))
if (callPortray(t, &EX PASS_REGS)) {
EX = oEX;
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
@ -1187,21 +1188,23 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrclose_bracket(wglb, TRUE);
}
}
EX = oEX;
}
struct write_globs wglb;
struct rewind_term rwt;
void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority)
/* term to be written */
/* consumer */
/* write options */
{
if (!mywrite)
wglb.stream = Serror;
else
struct write_globs wglb;
struct rewind_term rwt;
if (!mywrite) {
CACHE_REGS
wglb.stream = GLOBAL_Stream+LOCAL_c_error_stream;
} else
wglb.stream = mywrite;
wglb.lw = separator;
wglb.lw = start;
wglb.last_atom_minus = FALSE;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.Handle_vars = flags & Handle_vars_f;
@ -1218,5 +1221,20 @@ void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
wglb.Write_strings = flags & BackQuote_String_f;
/* protect slots for portray */
writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);
} else {
wrputc('\n', wglb.stream);
}
} else {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc(' ', wglb.stream);
} else {
wrputc(' ', wglb.stream);
}
}
restore_from_write(&rwt, &wglb);
}

10
C/yap-args.c
View File

@ -19,12 +19,14 @@
#include "config.h"
#include "Yap.h"
#include "YapHeap.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#include <stdlib.h>
#include <stddef.h>
#include "pl-shared.h"
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
@ -150,7 +152,7 @@ dump_runtime_variables(void)
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT);
fprintf(stdout,"YAP_VERSION=%d\n",YAP_NUMERIC_VERSION);
fprintf(stdout,"YAP_VERSION=%s\n",YAP_NUMERIC_VERSION);
exit(0);
return 1;
}
@ -202,8 +204,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->ErrorCause = NULL;
iap->QuietMode = FALSE;
GD->cmdline.os_argc = argc;
GD->cmdline.os_argv = argv;
while (--argc > 0)
{
p = *++argv;
@ -548,8 +548,6 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->SavedState = p;
}
}
GD->cmdline.appl_argc = argc;
GD->cmdline.appl_argv = argv;
//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode);
return BootMode;
}

307
C/ypstdio.c
View File

@ -1,307 +0,0 @@
/*************************************************************************
* *
* YAP Prolog %W% %G%
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: io.h *
* Last rev: 19/2/88 *
* mods: *
* comments: simple replacement for stdio *
* *
*************************************************************************/
#include "Yap.h"
#ifdef YAP_STDIO
#include <malloc.h>
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if WINDOWS
#include <io.h>
#endif
#include <stdarg.h>
#ifndef O_BINARY
#define O_BINARY 0
#endif
YP_FILE yp_iob[YP_MAX_FILES];
static void
clear_iob(YP_FILE *f)
{
f->flags = f->cnt = 0;
f->buflen = 1;
f->ptr = f->base = (char *) &f->buf;
f->close = close;
f->read = read;
f->write = write;
}
void
init_yp_stdio()
{
int i;
/* mark all descriptors as free */
for(i=0; i<YP_MAX_FILES; ++i) {
yp_iob[i].check = i;
clear_iob(&yp_iob[i]);
}
/* initialize standard ones */
yp_iob[0].fd = 0;
yp_iob[0].flags = _YP_IO_FILE | _YP_IO_READ;
yp_iob[1].fd = 1;
yp_iob[1].flags = _YP_IO_FILE | _YP_IO_WRITE;
yp_iob[2].fd = 2;
yp_iob[2].flags = _YP_IO_FILE | _YP_IO_WRITE;
}
int
YP_fillbuf(YP_FILE *f)
{
if (!(f->flags & _YP_IO_READ)||(f->flags & (_YP_IO_ERR|_YP_IO_EOF)))
return -1;
if ((f->cnt = (f->read)(f->fd,f->base,f->buflen)) < 0) {
f->flags |= _YP_IO_ERR;
return -1;
}
if (f->cnt==0) {
f->flags |= _YP_IO_EOF;
return -1;
}
f->ptr = f->base;
return YP_getc(f);
}
int
YP_flushbuf(int c,YP_FILE *f)
{
if(!(f->flags & _YP_IO_WRITE)||(f->flags & _YP_IO_ERR)) return -1;
*(f->ptr++) = c;
{
int cnt = f->ptr-f->base;
int r = (f->write)(f->fd,f->base,cnt);
f->ptr = f->base;
if (r!=cnt) {
f->flags |= _YP_IO_ERR;
return -1;
}
f->ptr = f->base;
f->cnt = f->buflen-1;
}
return c;
}
int
YP_fflush(YP_FILE *f)
{
if(!(f->flags & _YP_IO_WRITE)||(f->flags & _YP_IO_ERR)) return -1;
if (f->ptr==f->base) return 0;
{
int cnt = f->ptr-f->base;
int r = (f->write)(f->fd,f->base,cnt);
f->ptr = f->base;
if (r!=cnt) {
f->flags |= _YP_IO_ERR;
return -1;
}
f->ptr = f->base;
f->cnt = f->buflen-1;
}
return 0;
}
int
YP_fputs(char *s, YP_FILE *f)
{
int count = 0;
while (*s) {
if (putc(*s++,f)<0) return -1;
++count;
}
return count;
}
int
YP_puts(char *s)
{
return YP_fputs(s,YP_stdout);
}
char *
YP_fgets(char *s, int n, YP_FILE *f)
{
char *p=s;
if (f->flags & _YP_IO_ERR) return 0;
while(--n) {
int ch = YP_getc(f);
if (ch<0) return 0;
*p++ = ch;
if (ch=='\n') break;
}
*p = 0;
return s;
}
char *
YP_gets(char *s)
{
char *p=s;
while(1) {
int ch = YP_getchar();
if (ch<0) return 0;
if (ch=='\n') break;
*p++ = ch;
}
*p = 0;
return s;
}
YP_FILE*
YP_fopen(char *path, char *mode)
{
YP_FILE *f = 0;
int i, fd, flags, ch1, ch2;
for(i=3; i<YP_MAX_FILES; ++i)
if (!yp_iob[i].flags) {
f = &yp_iob[i];
break;
}
if (!f) return f;
/* try to open the file */
flags = 0;
ch1 = *mode++;
ch2 = *mode;
if(ch2=='b') {
flags = O_BINARY;
ch2 = *++mode;
}
if (ch2) return 0;
switch (ch1) {
case 'r':
flags |= O_RDONLY;
break;
case 'w':
flags |= O_WRONLY | O_TRUNC | O_CREAT;
break;
case 'a':
flags |= O_WRONLY | O_CREAT | O_APPEND;
break;
default:
return 0;
}
if ((fd=open(path,flags,0644))<0) return 0;
f->fd = fd;
f->flags = _YP_IO_FILE | (ch1=='r' ? _YP_IO_READ : _YP_IO_WRITE);
f->ptr = f->base;
/* todo: add buffers */
f->cnt = 0;
f->close = close;
f->read = read;
f->write = write;
return f;
}
int
YP_fclose(YP_FILE *f)
{
if (f != &yp_iob[f->check]) return -1;
if (f->flags & _YP_IO_WRITE) {
YP_fflush(f);
}
(f->close)(f->fd);
/* todo: release buffers */
clear_iob(f);
return 0;
}
#define MAXBSIZE 32768
int
YP_printf(char *format,...)
{
va_list ap;
char *buf = (char *) alloca(MAXBSIZE);
int r;
va_start(ap,format);
vsprintf(buf,format,ap);
r = YP_puts(buf);
va_end(ap);
return r;
}
int
YP_fprintf(YP_FILE *f, char *format,...)
{
va_list ap;
char *buf = (char *) alloca(MAXBSIZE);
int r;
va_start(ap,format);
vsprintf(buf,format,ap);
r = YP_fputs(buf,f);
va_end(ap);
return r;
}
int
YP_fileno(YP_FILE *f)
{
return f->fd;
}
int
YP_clearerr(YP_FILE *f)
{
f->flags &= ~ _YP_IO_ERR | _YP_IO_EOF;
return 0;
}
int
YP_feof(YP_FILE *f)
{
return f->flags & _YP_IO_EOF ? 1 : 0;
}
int
YP_setbuf(YP_FILE *f, char *b)
{
return 0;
}
int
YP_fseek(YP_FILE *f, int offset, int whence)
{
/* todo: implement fseek */
return 0;
}
int
YP_ftell(YP_FILE*f)
{
return 0;
}
#endif /* YAP_STDIO */

488
CMakeLists.txt
View File

@ -4,17 +4,20 @@
# system core
# libraries
cmake_minimum_required(VERSION 2.8)
if (${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
cmake_policy( SET CMP0042 NEW)
cmake_policy( NO_POLICY_SCOPE )
endif()
cmake_minimum_required(VERSION 3.0)
# where we have most scripts
# set path to additional CMake modules
set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH})
set(configurations Debug)
if(POLICY CMP0042)
cmake_policy(SET CMP0042 NEW) # Set MACOSX_RPATH=YES by default
endif()
if(POLICY CMP0042)
cmake_policy(SET CMP0043 NEW)
project(YAP C CXX)
endif()
set(YAP_FOUND ON)
@ -45,8 +48,73 @@ site_name( YAP_SITE )
message(STATUS "Building YAP version ${YAP_VERSION}")
# set path to additional CMake modules
set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH})
#
# Optional Components
#
include(CheckIncludeFile)
include(CheckIncludeFileCXX)
INCLUDE (CheckIncludeFiles)
include(CheckLibraryExists)
include(CheckSymbolExists)
include(CheckFunctionExists)
include(CheckIncludeFiles)
include(CheckFunctionExists)
include(CheckPrototypeExists)
include(CheckTypeSize)
include(CheckCXXSourceCompiles)
include(TestBigEndian)
include (CMakeDependentOption)
include (MacroOptionalAddSubdirectory)
include (MacroOptionalFindPackage)
include (MacroLogFeature)
include(GetGitRevisionDescription)
# Test signal handler return type (mimics AC_TYPE_SIGNAL)
include(TestSignalType) #check if this is really needed as c89 defines this as void
# Test standard headers (mimics AC_HEADER_STDC)
include(TestSTDC)
set(bitness 32)
if(CMAKE_SIZEOF_VOID_P EQUAL 8)
set(bitness 64)
endif()
get_git_head_revision(GIT_HEAD GIT_SHA1)
git_describe(GIT_DESCRIBE)
if (${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
cmake_policy( SET CMP0042 NEW)
#cmake_policy( NO_POLICY_SCOPE )
endif()
## define system
include (Sources)
add_library(libYap SHARED
${ENGINE_SOURCES}
${C_INTERFACE_SOURCES}
${STATIC_SOURCES}
${OPTYAP_SOURCES}
${HEADERS}
$<TARGET_OBJECTS:libYAPOs>
$<TARGET_OBJECTS:libOPTYap>
)
# Optional libraries that affect compilation
#
include (Config)
set_target_properties(libYap
PROPERTIES VERSION ${YAP_FULL_VERSION}
SOVERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}
OUTPUT_NAME Yap
)
set(CMAKE_TOP_BINARY_DIR ${CMAKE_BINARY_DIR})
set(YAP_PL_SRCDIR ${CMAKE_SOURCE_DIR}/pl)
@ -69,10 +137,10 @@ set(YAP_ROOTDIR ${prefix})
# erootdir -> rootdir
# bindir defined above
# libdir defined above
set(YAP_LIB_DIR "${dlls}")
set(YAP_SHARE_DIR "${datarootdir}")
set(YAP_BIN_DIR "${bindir}")
set(YAP_INCLUDE_DIR "${includedir}")
set(YAP_LIBDIR "${dlls}")
set(YAP_SHAREDIR "${datarootdir}")
set(YAP_BINDIR "${bindir}")
set(YAP_INCLUDEDIR "${includedir}")
set(YAP_ROOTDIR "${prefix}")
set(YAP_YAPLIB libYap${CMAKE_SHARED_LIBRARY_SUFFIX})
@ -83,20 +151,30 @@ string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT )
include_directories (H include os)
include_directories (BEFORE ${CMAKE_BINARY_DIR})
# Optional libraries that affect compilation
#
include (ConfigureChecks)
include (MacroOptionalAddSubdirectory)
include (MacroOptionalFindPackage)
include (MacroLogFeature)
# rpath stuff, hopefully it works
# use, i.e. don't skip the full RPATH for the build tree
SET(CMAKE_SKIP_BUILD_RPATH FALSE)
# when building, don't use the install RPATH already
# (but later on when installing)
SET(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
SET(CMAKE_INSTALL_RPATH "${dlls}:${libdir}")
# add the automatically determined parts of the RPATH
# which point to directories outside the build tree to the install RPATH
SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
# the RPATH to be used when installing, but only if it's not a system directory
LIST(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib" isSystemDir)
IF("${isSystemDir}" STREQUAL "-1")
SET(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib")
ENDIF("${isSystemDir}" STREQUAL "-1")
#
# Optional Components
#
include (CMakeDependentOption)
include (CheckSymbolExists)
set ( YAP_MALLOC_T void *)
set ( MIN_STACKSPACE 1024*SIZEOF_INT_P )
set ( MIN_HEAPSPACE 2*1024*SIZEOF_INT_P )
@ -115,12 +193,13 @@ set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS DEPTH_LIMIT=1;COROU
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS _YAP_NOT_INSTALLED_=1;HAVE_CONFIG_H )
# Compilation model
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS GNU_SOURCE=1;_XOPEN_SOURCE=700 )
#set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS _XOPEN_SOURCE=700 )
#add_definitions( -Wall -Wstrict-prototypes -Wmissing-prototypes)
# Model Specific
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$<CONFIG:Debug>:DEBUG=1;LOW_LEVEL_TRACER=1> )
#set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$<CONFIG:Debug>:DEBUG=1;LOW_LEVEL_TRACER=1> )
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS DEBUG=1;LOW_LEVEL_TRACER=1 )
#ensure cells are properly aligned in code
set (ALIGN_LONGS 1)
@ -170,12 +249,23 @@ endif (HAVE_GCC)
#
set (BUILD_SHARED_LIBS ON)
option (YAP_SWI_IO ON)
#option (YAP_SWI_IO ON)
#
# include libtai package as an independent library
#
add_subdirectory (os/libtai)
macro_optional_find_package (GMP ON)
macro_log_feature (GMP_FOUND "libgmp"
"GNU big integers and rationals"
"http://gmplib.org")
if (GMP_FOUND)
include_directories (${GMP_INCLUDE_DIR})
#add_executable(test ${SOURCES})
# target_link_libraries(libYap ${GMP_LIBRARIES})
#config.h needs this (TODO: change in code latter)
set (USE_GMP 1)
set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} )
# set( CMAKE_REQUIRED_LIBRARIES ${GMP_LIBRARIES} ${CMAKE_REQUIRED_LIBRARIES} )
endif (GMP_FOUND)
option (YAP_TABLING "Support tabling" ON)
if (YAP_TABLING)
@ -185,7 +275,6 @@ if (YAP_TABLING)
#and it is used across several files outside OPTYap
add_definitions (-DTABLING=1)
include_directories (OPTYap)
add_subdirectory (OPTYap)
endif(YAP_TABLING)
option (YAP_EAM "enable EAM (Extended Andorra Model)" OFF)
@ -209,256 +298,11 @@ if (YAP_CALL_TRACER)
set_directory_properties(PROPERTIES COMPILE_DEFINITIONS_DEBUG LOW_LEVEL_TRACER=1)
endif (YAP_CALL_TRACER)
#set( CMAKE_REQUIRED_LIBRARIES ${READLINE_LIBS} ${CMAKE_REQUIRED_LIBRARIES} )
#target_link_libraries(libYap ${READLINE_LIBS})
option (YAP_THREADS
"support system threads" OFF)
#TODO:
#
# Sources Section
#
set(IOLIB_SOURCES
os/pl-buffer.c
os/pl-codelist.c
os/pl-ctype.c
os/pl-dtoa.c
os/pl-error.c
os/pl-file.c
os/pl-files.c
os/pl-fmt.c
os/pl-glob.c
os/pl-option.c
os/pl-nt.c
os/pl-os.c
os/pl-privitf.c
os/pl-prologflag.c
os/pl-read.c
os/pl-rl.c
os/pl-stream.c
os/pl-string.c
os/pl-table.c
os/pl-tai.c
os/pl-text.c
os/pl-utf8.c
os/pl-write.c
C/pl-yap.c
)
if (WIN32)
set(IOLIBS_SOURCES
${IOLIBS_SOURCES}
os/windows/uxnt.c
)
endif (WIN32)
set (ABSMI_SOURCES
C/absmi.c
C/absmi_insts.h
C/fli_absmi_insts.h
C/or_absmi_insts.h
C/control_absmi_insts.h
C/index_absmi_insts.h
C/prim_absmi_insts.h
C/cp_absmi_insts.h
C/lu_absmi_insts.h
C/unify_absmi_insts.h
C/fail_absmi_insts.h
C/meta_absmi_insts.h
)
set (ENGINE_SOURCES
${ABSMI_SOURCES}
C/agc.c
C/adtdefs.c
C/alloc.c
C/amasm.c
C/analyst.c
C/arrays.c
C/arith0.c
C/arith1.c
C/arith2.c
C/atomic.c
C/attvar.c
C/bignum.c
C/bb.c
C/cdmgr.c
C/cmppreds.c
C/compiler.c
C/computils.c
C/corout.c
C/cut_c.c
C/dbase.c
C/dlmalloc.c
C/errors.c
C/eval.c
C/exec.c
C/exo.c
C/exo_udi.c
C/globals.c
C/gmp_support.c
C/gprof.c
C/grow.c
C/heapgc.c
C/index.c
C/init.c
C/inlines.c
C/iopreds.c
C/depth_bound.c
C/mavar.c
C/modules.c
C/other.c
C/parser.c
C/qlyr.c
C/qlyw.c
C/range.c
C/save.c
C/scanner.c
C/signals.c
C/sort.c
C/stdpreds.c
C/sysbits.c
C/text.c
C/threads.c
C/tracer.c
C/unify.c
C/userpreds.c
C/utilpreds.c
C/yap-args.c
C/write.c
C/ypstdio.c
library/dialect/swi/fli/swi.c
library/dialect/swi/fli/blobs.c
C/udi.c
#packages/udi/rtree.c
#packages/udi/rtree_udi.c
# ${IOLIB_SOURCES}
# MPI_SOURCES
)
set(C_INTERFACE_SOURCES
C/load_foreign.c
C/load_dl.c
C/load_dld.c
C/load_dyld.c
C/load_none.c
C/load_aout.c
C/load_aix.c
C/load_dll.c
C/load_shl.c
C/c_interface.c
C/clause_list.c
)
SET(OPTYAP_SOURCES
OPTYap/or.memory.c
OPTYap/opt.init.c
OPTYap/opt.preds.c
OPTYap/or.copy_engine.c
OPTYap/or.cow_engine.c
OPTYap/or.sba_engine.c
OPTYap/or.thread_engine.c
OPTYap/or.scheduler.c
OPTYap/or.cut.c
OPTYap/tab.tries.c
OPTYap/tab.completion.c
)
set(STATIC_SOURCES
#NOT INCLUDED FOR NOW
)
set(CONSOLE_SOURCES console/yap.c)
#MPI STUFF
# library/mpi/mpi.c library/mpi/mpe.c
# library/lammpi/yap_mpi.c library/lammpi/hash.c library/lammpi/prologterms2c.c
# )
#WIN STUFF
# SET(PLCONS_SOURCES
# console/LGPL/pl-nt.c
# console/LGPL/pl-ntcon.c
# console/LGPL/pl-ntconsole.c
# console/LGPL/pl-ntmain.c
# )
## define system
add_library(libYap SHARED
${ENGINE_SOURCES}
${IOLIB_SOURCES}
${C_INTERFACE_SOURCES}
${STATIC_SOURCES}
${OPTYAP_SOURCES}
$<TARGET_OBJECTS:libyaptai>
)
target_link_libraries(libYap
m resolv stdc++ )
set_target_properties(libYap
PROPERTIES VERSION ${YAP_FULL_VERSION}
SOVERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}
OUTPUT_NAME Yap
)
#TODO:
#TODO:
#
# Arch checks
#
#include(ConfigureChecks)
include (Config)
macro_optional_find_package (GMP ON)
macro_log_feature (GMP_FOUND "libgmp"
"GNU Multiple Precision"
"http://gmplib.org")
if (GMP_FOUND)
include_directories (${GMP_INCLUDE_DIR})
target_link_libraries(libYap ${GMP_LIBRARIES})
#config.h needs this (TODO: change in code latter)
set (USE_GMP 1)
set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} )
set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} )
endif (GMP_FOUND)
macro_optional_find_package (Readline ON)
macro_log_feature (READLINE_FOUND "libreadline"
"GNU Readline Library (or similar)"
"http://www.gnu.org/software/readline")
if (READLINE_FOUND)
include_directories (${READLINE_INCLUDE_DIR})
target_link_libraries(libYap ${READLINE_LIBRARIES})
set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${READLINE_INCLUDE_DIR} )
set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} )
check_include_file( readline/readline.h HAVE_READLINE_READLINE_H )
check_function_exists( add_history HAVE_ADD_HISTORY )
check_function_exists( rl_begin_undo_group HAVE_RL_BEGIN_UNDO_GROUP)
check_function_exists( rl_clear_pending_input HAVE_RL_CLEAR_PENDING_INPUT)
check_function_exists( rl_discard_argument HAVE_RL_DISCARD_ARGUMENT)
check_function_exists( rl_filename_completion_function HAVE_RL_FILENAME_COMPLETION_FUNCTION)
check_function_exists( rl_free_line_state HAVE_RL_FREE_LINE_STATE )
check_function_exists( rl_insert_close HAVE_RL_INSERT_CLOSE )
check_function_exists( rl_reset_after_signal HAVE_RL_RESET_AFTER_SIGNAL )
check_function_exists( rl_set_keyboard_input_timeout HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT )
check_function_exists( rl_set_prompt HAVE_RL_SET_PROMPT)
check_symbol_exists( rl_catch_signals stdio.h;readline/readline.h HAVE_DECL_RL_CATCH_SIGNALS )
check_symbol_exists( rl_completion_func_t stdio.h;readline/readline.h HAVE_DECL_RL_COMPLETION_FUNC_T )
check_symbol_exists( rl_done stdio.h;readline/readline.h HAVE_DECL_RL_DONE )
check_symbol_exists( rl_hook_func_t stdio.h;readline/readline.h HAVE_DECL_RL_HOOK_FUNC_T )
check_symbol_exists( rl_event_hook stdio.h;readline/readline.h HAVE_DECL_RL_EVENT_HOOK )
check_symbol_exists( rl_readline_state stdio.h;readline/readline.h HAVE_DECL_RL_READLINE_STATE )
endif (READLINE_FOUND)
option (YAP_THREADS OFF)
"support system threads" OFF)
macro_optional_find_package (Threads ON)
macro_log_feature (THREADS_FOUND "Threads Support"
"GNU Threads Library (or similar)"
@ -493,23 +337,41 @@ if (YAP_THREADS AND THREADS_FOUND)
if (CMAKE_USE_PTHREADS_INIT)
target_link_libraries(libYap pthread)
set (HAVE_READLINE_READLINE_H 1)
set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${CMAKE_THREAD_LIBS_INIT} )
# set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${CMAKE_THREAD_LIBS_INIT} )
check_function_exists( pthread_mutexattr_setkind_np HAVE_PTHREAD_MUTEXATTR_SETKIND_NP )
check_function_exists( pthread_mutexattr_settype HAVE_PTHREAD_MUTEXATTR_SETTYPE )
check_function_exists( pthread_setconcurrency HAVE_PTHREAD_SETCONCURRENCY )
endif (CMAKE_USE_PTHREADS_INIT)
add_definitions (-DTHREADS=1)
set (MAX_WORKERS 64)
set (MAX_THREADS 1024)
#
# Please note that the compiler flag can only be used with the imported
# target. Use of both the imported target as well as this switch is highly
# recommended for new code.
else()
set (MAX_WORKERS 1)
set (MAX_THREADS 1)
endif (YAP_THREADS AND THREADS_FOUND)
cmake_dependent_option (YAP_PTHREADLOCKING
"use pthread locking primitives for internal locking" ON
"NOT YAP_THREADS; NOT THREADS_FOUND" OFF)
add_subdirectory (pl)
add_subdirectory (CXX)
#
# include OS and I/o stuff
#
# convenience libraries
add_subdirectory (os)
add_subdirectory (OPTYap)
#bootstrap and saved state
add_subdirectory (pl)
#C++ interface
add_subdirectory (CXX)
#major libraries
ADD_SUBDIRECTORY(library)
ADD_SUBDIRECTORY(swi/library)
# ADD_SUBDIRECTORY(os)
@ -531,16 +393,12 @@ macro_optional_add_subdirectory(library/lammpi)
macro_optional_add_subdirectory (packages/gecode)
macro_optional_add_subdirectory (packages/cuda)
macro_optional_add_subdirectory (packages/myddas)
macro_optional_add_subdirectory (packages/real)
macro_optional_add_subdirectory (packages/python)
macro_optional_add_subdirectory (packages/raptor)
#add_subdirectory (packages/archive)
macro_optional_add_subdirectory (packages/jpl)
@ -549,6 +407,17 @@ macro_optional_add_subdirectory (packages/swig)
macro_optional_add_subdirectory (packages/bdd)
macro_optional_add_subdirectory (packages/CLPBN)
macro_optional_add_subdirectory (packages/CLPBN/horus)
macro_optional_add_subdirectory (packages/Problog)
macro_optional_add_subdirectory (packages/raptor)
#macro_optional_add_subdirectory (packages/cuda)
#add_subdirectory (packages/prosqlite)
#add_subdirectory (packages/zlib)
@ -605,17 +474,6 @@ option(YAP_CONDOR
# option (DLCOMPAT
# "use dlcompat library for dynamic loading on Mac OS X" OFF)
# find_package(R)
# if (R_FOUND)
# MESSAGE(STATUS "RFOUND ${R_LIBRARIES} ${R_DEFINITIONS} ${R_EXECUTABLE}")
# endif (R_FOUND)
#TODO: check REAL_TARGET REAL#TODO: Switch to feature
# OPTION(CPLINT
# "enable the cplint library using the CUDD library in DIR/lib" OFF)
# OPTION(yap_cv_clpbn_bp
# "enable belief propagation solver in CLPBN." OFF)
# OPTION(
# SHARED PACKAGES with SWI
# swi packages have both Makefile.in which we will use and
# Makefile.mak, we will use the later to identify this packages
@ -628,17 +486,11 @@ option(YAP_CONDOR
#configure_file(packages/Dialect.defs.cmake packages/Dialect.defs)
#
# include subdirectories configuration
## after we have all functionality in
#
configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake"
"${PROJECT_BINARY_DIR}/config.h" )
configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake"
"${PROJECT_BINARY_DIR}/YapConfig.h" )
configure_file ("${PROJECT_SOURCE_DIR}/YapTermConfig.h.cmake"
"${PROJECT_BINARY_DIR}/YapTermConfig.h" )
target_link_libraries(libYap
${GMP_LIBRARIES}
${READLINE_LIBS}
${CMAKE_DL_LIBS}
)
add_executable (yap-bin ${CONSOLE_SOURCES})
@ -663,6 +515,20 @@ endif (MPI_C_FOUND)
add_custom_target (main ALL DEPENDS ${YAP_STARTUP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
#
# include subdirectories configuration
## after we have all functionality in
#
configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake"
"${PROJECT_BINARY_DIR}/config.h" )
configure_file ("${PROJECT_SOURCE_DIR}/config.h.cmake"
"${PROJECT_BINARY_DIR}/YapConfig.h" )
configure_file ("${PROJECT_SOURCE_DIR}/YapTermConfig.h.cmake"
"${PROJECT_BINARY_DIR}/YapTermConfig.h" )
configure_file("${PROJECT_SOURCE_DIR}/GitSHA1.c.in" "${PROJECT_BINARY_DIR}/GitSHA1.c" @ONLY)
install (
TARGETS yap-bin libYap

3
H/Atoms.h
View File

@ -94,8 +94,6 @@ typedef struct ExtraAtomEntryStruct
# define EndOfPAEntr(P) ( Addr(P) == NIL )
#endif
#define AtomName(at) RepAtom(at)->StrOfAE
/* ********************** Properties **********************************/
@ -143,4 +141,5 @@ typedef struct FunctorEntryStruct
typedef FunctorEntry *Functor;
#endif /* ATOMS_H */

5
H/absmi.h
View File

@ -180,7 +180,7 @@ register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
#ifdef LOW_LEVEL_TRACER
#include "tracer.h"
#endif
#include "pl-shared.h"
#ifdef DEBUG
/**********************************************************************
* *
@ -222,7 +222,8 @@ restore_absmi_regs(REGSTORE * old_regs)
#else
Yap_regp = old_regs;
#endif
LOCAL_PL_local_data_p->reg_cache = old_regs;
// not neeeded any more
// LOCAL_PL_local_data_p->reg_cache = old_regs;
}
#endif /* PUSH_REGS */

2
H/alloc.h
View File

@ -94,7 +94,7 @@ typedef struct FREEB {
#define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size]
/* Operating system and architecture dependent page size */
extern int Yap_page_size;
extern size_t Yap_page_size;
void Yap_InitHeap(void *);
UInt Yap_ExtendWorkSpaceThroughHole(UInt);

20
H/arrays.h
View File

@ -18,6 +18,20 @@
static char SccsId[]="%W% %G%";
#endif
/* first, the valid types */
typedef enum
{
array_of_ints,
array_of_chars,
array_of_uchars,
array_of_doubles,
array_of_ptrs,
array_of_atoms,
array_of_dbrefs,
array_of_nb_terms,
array_of_terms
} static_array_types;
/* This should never be followed by GC */
typedef struct array_access_struct {
Functor array_access_func; /* identifier of array access */
@ -25,3 +39,9 @@ typedef struct array_access_struct {
Term indx; /* index in array, for now
keep it as an integer! */
} array_access;
struct static_array_entry *
Yap_StaticVector( Atom Name, size_t size, static_array_types props );
struct static_array_entry *
Yap_StaticArray(Atom na, size_t dim, static_array_types type, CODEADDR start_addr, struct static_array_entry *p);

2
H/eval.h
View File

@ -410,7 +410,7 @@ Yap_FoundArithError__(USES_REGS1)
{
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return LOCAL_Error_TYPE;
if (yap_flags[FLOATING_POINT_EXCEPTION_MODE_FLAG]) // test support for exception
if (trueGlobalPrologFlag( ARITHMETIC_EXCEPTIONS_FLAG ) ) // test support for exception
return Yap_MathException();
return YAP_NO_ERROR;
}

57
H/iopreds.h
View File

@ -1,57 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Input/Output C implemented predicates *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/*
* This file defines main data-structure for stream management,
*
*/
#if defined(_MSC_VER) || defined(__MINGW32__)
#include <windows.h>
#endif
#include <wchar.h>
#if HAVE_LIBREADLINE
#if defined(_MSC_VER) || defined(__MINGW32__)
FILE *rl_instream, *rl_outstream;
#endif
#endif
#define MEM_BUF_CODE 0
#define MEM_BUF_MALLOC 1
typedef int (*GetsFunc)(int, UInt, char *);
#define StdInStream 0
#define StdOutStream 1
#define StdErrStream 2
#define ALIASES_BLOCK_SIZE 8
void Yap_InitStdStreams(void);
Term Yap_StreamPosition(struct io_stream *);
void Yap_InitPlIO(void);

323
H/yapio.h
View File

@ -1,323 +0,0 @@
/*************************************************************************
* *
* YAP Prolog %W% %G%
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2003 *
* *
**************************************************************************
* *
* File: yapio.h *
* Last rev: 22/1/03 *
* mods: *
* comments: Input/Output information *
* *
*************************************************************************/
#ifdef SIMICS
#undef HAVE_LIBREADLINE
#endif
#include <stdio.h>
#include <wchar.h>
#include "SWI-Stream.h"
#ifndef YAP_STDIO
#define YP_printf printf
#define YP_putchar putchar
#define YP_getc getc
#define YP_fgetc fgetc
#define YP_getchar getchar
#define YP_fgets fgets
#define YP_clearerr clearerr
#define YP_feof feof
#define YP_ferror ferror
#if defined(_MSC_VER) || defined(__MINGW32__)
#define YP_fileno _fileno
#else
#define YP_fileno fileno
#endif
#define YP_fopen fopen
#define YP_fclose fclose
#define YP_ftell ftell
#define YP_fseek fseek
#define YP_setbuf setbuf
#define YP_fputs fputs
#define YP_ungetc ungetc
#define YP_fdopen fdopen
#define init_yp_stdio()
#define YP_FILE FILE
int YP_putc(int, int);
#else
#ifdef putc
#undef putc
#undef getc
#undef putchar
#undef getchar
#undef stdin
#undef stdout
#undef stderr
#endif
#define printf ERR_printf
#define fprintf ERR_fprintf
#define putchar ERR_putchar
#define putc ERR_putc
#define getc ERR_getc
#define fgetc ERR_fgetc
#define getchar ERR_getchar
#define fgets ERR_fgets
#define clearerr ERR_clearerr
#define feof ERR_feof
#define ferror ERR_ferror
#define fileno ERR_fileno
#define fopen ERR_fopen
#define fclose ERR_fclose
#define fflush ERR_fflush
/* flags for files in IOSTREAM struct */
#define _YP_IO_WRITE 1
#define _YP_IO_READ 2
#define _YP_IO_ERR 0x04
#define _YP_IO_EOF 0x08
#define _YP_IO_FILE 0x10
#define _YP_IO_SOCK 0x20
typedef struct IOSTREAM {
int check;
int fd; /* file descriptor */
int flags;
int cnt;
int buflen;
char buf[2];
char *ptr;
char *base;
int (*close)(int fd); /* close file */
int (*read)(int fd, char *b, int n); /* read bytes */
int (*write)(int fd, char *b, int n);/* write bytes */
} YP_FILE;
#define YP_stdin &yp_iob[0]
#define YP_stdout &yp_iob[1]
#define YP_stderr &yp_iob[2]
#define YP_getc(f) (--(f)->cnt < 0 ? YP_fillbuf(f) : *((unsigned char *) ((f)->ptr++)))
#define YP_fgetc(f) YP_fgetc(f)
#define YP_putc(c,f) (--(f)->cnt < 0 ? YP_flushbuf(c,f) : (unsigned char) (*(f)->ptr++ = (char) c))
#define YP_putchar(cc) YP_putc(cc,YP_stdout)
#define YP_getchar() YP_getc(YP_stdin)
int YP_fillbuf(YP_FILE *f);
int YP_flushbuf(int c, YP_FILE *f);
int YP_printf(char *, ...);
int YP_fprintf(YP_FILE *, char *, ...);
char* YP_fgets(char *, int, YP_FILE *);
char* YP_gets(char *);
YP_FILE *YP_fopen(char *, char *);
int YP_fclose(YP_FILE *);
int YP_fileno(YP_FILE *);
int YP_fflush(YP_FILE *);
int YP_feof(YP_FILE *);
int YP_ftell(YP_FILE *);
int YP_fseek(YP_FILE *, int, int);
int YP_clearerr(YP_FILE *);
void init_yp_stdio(void);
int YP_fputs(char *s, YP_FILE *f);
int YP_puts(char *s);
int YP_setbuf(YP_FILE *f, char *buf);
#define YP_MAX_FILES 40
extern YP_FILE yp_iob[YP_MAX_FILES];
#endif /* YAP_STDIO */
typedef YP_FILE *YP_File;
#ifndef _PL_WRITE_
/* Character types for tokenizer and write.c */
#define UC 1 /* Upper case */
#define UL 2 /* Underline */
#define LC 3 /* Lower case */
#define NU 4 /* digit */
#define QT 5 /* single quote */
#define DC 6 /* double quote */
#define SY 7 /* Symbol character */
#define SL 8 /* Solo character */
#define BK 9 /* Brackets & friends */
#define BS 10 /* Blank */
#define EF 11 /* End of File marker */
#define CC 12 /* comment char % */
#define EOFCHAR EOF
#endif
/* info on aliases */
typedef struct AliasDescS {
Atom name;
int alias_stream;
} * AliasDesc;
/************ SWI compatible support for different encodings ************/
#define MAX_ISO_LATIN1 255
/****************** character definition table **************************/
#define NUMBER_OF_CHARS 256
extern char *Yap_chtype;
#include "inline-only.h"
INLINE_ONLY EXTERN inline int chtype(Int);
int Yap_wide_chtype(Int);
INLINE_ONLY EXTERN inline int
chtype(Int ch)
{
if (ch < NUMBER_OF_CHARS)
return Yap_chtype[ch];
return Yap_wide_chtype(ch);
}
/* parser stack, used to be AuxSp, now is ASP */
#define ParserAuxSp LOCAL_ScannerStack
/* routines in parser.c */
VarEntry *Yap_LookupVar(char *);
Term Yap_VarNames(VarEntry *,Term);
Term Yap_Variables(VarEntry *,Term);
Term Yap_Singletons(VarEntry *,Term);
/* routines in scanner.c */
TokEntry *Yap_tokenizer(struct io_stream *, int, Term *, void *rd);
void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term);
Term Yap_scan_num(struct io_stream *);
char *Yap_AllocScannerMemory(unsigned int);
/* routines in iopreds.c */
FILE *Yap_FileDescriptorFromStream(Term);
Int Yap_FirstLineInParse(void);
int Yap_CheckIOStream(Term, char *);
#if defined(YAPOR) || defined(THREADS)
void Yap_LockStream(struct io_stream *);
void Yap_UnLockStream(struct io_stream *);
#else
#define Yap_LockStream(X)
#define Yap_UnLockStream(X)
#endif
Int Yap_GetStreamFd(int);
void Yap_CloseStreams(int);
void Yap_FlushStreams(void);
void Yap_CloseStream(int);
int Yap_PlGetchar(void);
int Yap_PlGetWchar(void);
int Yap_PlFGetchar(void);
int Yap_GetCharForSIGINT(void);
Int Yap_StreamToFileNo(Term);
Term Yap_OpenStream(FILE *,char *,Term,int);
char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags);
char *Yap_HandleToString(term_t l, size_t sz, size_t *length, int *encoding, int flags);
int Yap_GetFreeStreamD(void);
int Yap_GetFreeStreamDForReading(void);
Term Yap_WStringToList(wchar_t *);
Term Yap_WStringToListOfAtoms(wchar_t *);
Atom Yap_LookupWideAtom( const wchar_t * );
#define YAP_INPUT_STREAM 0x01
#define YAP_OUTPUT_STREAM 0x02
#define YAP_APPEND_STREAM 0x04
#define YAP_PIPE_STREAM 0x08
#define YAP_TTY_STREAM 0x10
#define YAP_POPEN_STREAM 0x20
#define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80
#define Quote_illegal_f 0x01
#define Ignore_ops_f 0x02
#define Handle_vars_f 0x04
#define Use_portray_f 0x08
#define To_heap_f 0x10
#define Unfold_cyclics_f 0x20
#define Use_SWI_Stream_f 0x40
#define BackQuote_String_f 0x80
#define AttVar_None_f 0x100
#define AttVar_Dots_f 0x200
#define AttVar_Portray_f 0x400
#define Blob_Portray_f 0x800
/* grow.c */
int Yap_growheap_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **);
int Yap_growstack_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **);
int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **);
#ifdef HAVE_ERRNO_H
#include <errno.h>
#else
extern int errno;
#endif
INLINE_ONLY EXTERN UInt inline HashFunction(unsigned char *);
INLINE_ONLY EXTERN UInt inline WideHashFunction(wchar_t *);
INLINE_ONLY EXTERN inline UInt
HashFunction(unsigned char *CHP)
{
/* djb2 */
UInt hash = 5381;
UInt c;
while ((c = *CHP++) != '\0') {
/* hash = ((hash << 5) + hash) + c; hash * 33 + c */
hash = hash * 33 ^ c;
}
return hash;
/*
UInt OUT=0, i = 1;
while(*CHP != '\0') { OUT += (UInt)(*CHP++); }
return OUT;
*/
}
INLINE_ONLY EXTERN UInt inline
WideHashFunction(wchar_t *CHP)
{
UInt hash = 5381;
UInt c;
while ((c = *CHP++) != '\0') {
hash = hash * 33 ^ c;
}
return hash;
}
#define FAIL_ON_PARSER_ERROR 0
#define QUIET_ON_PARSER_ERROR 1
#define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3

120
Makefile.in
View File

@ -145,20 +145,10 @@ INTERFACE_HEADERS = \
os/pl-thread.h \
os/SWI-Stream.h
IOLIB_HEADERS=os/pl-buffer.h \
os/pl-ctype.h \
H/pl-codelist.h \
os/pl-dtoa.h \
os/dtoa.c \
H/pl-incl.h \
H/pl-global.h \
os/pl-option.h \
os/pl-os.h \
os/pl-privitf.h \
os/pl-table.h \
os/pl-text.h \
os/pl-utf8.h \
H/pl-yap.h @WINDOWS@ os/windows/dirent.h os/windows/utf8.h os/windows/utf8.c os/windows/uxnt.h os/windows/popen.c
IOLIB_HEADERS= \
os/iopreds.h \
os/fmemopen.c\
os/yapio.h
HEADERS = \
H/Atoms.h \
@ -175,6 +165,7 @@ HEADERS = \
H/arrays.h \
H/arith2.h \
H/attvar.h \
H/blobs.h \
H/clause.h \
H/compile.h \
H/corout.h \
@ -192,7 +183,6 @@ HEADERS = \
H/ilocals.h \
H/index.h \
H/inline-only.h \
H/iopreds.h \
H/iswiatoms.h \
H/qly.h \
H/rclause.h \
@ -203,7 +193,6 @@ HEADERS = \
H/threads.h \
H/tracer.h \
H/trim_trail.h \
H/yapio.h \
H/YapSignals.h \
H/YapText.h \
H/cut_c.h \
@ -225,37 +214,35 @@ HEADERS = \
JIT/HPP/JIT_Compiler.hpp \
JIT/HPP/jit_predicates.hpp
IOLIB_SOURCES=os/pl-buffer.c os/pl-ctype.c \
os/pl-codelist.c \
os/pl-dtoa.c \
os/pl-error.c \
os/pl-file.c \
os/pl-files.c \
os/pl-fmt.c \
os/pl-locale.h \
os/pl-glob.c \
os/pl-option.c \
os/pl-os.c \
os/pl-prologflag.c \
os/pl-privitf.c \
os/pl-read.c \
os/pl-rl.c \
os/pl-stream.c os/pl-string.c \
os/pl-table.c \
os/pl-tai.c \
os/pl-text.c \
os/pl-version.c \
os/pl-write.c \
C/pl-yap.c @WINDOWS@os/windows/uxnt.c
IOLIB_SOURCES= os/charsio.c \
os/chartypes.c\
os/console.c\
os/files.c\
os/fmemopen.c\
os/format.c\
os/iopreds.c\
os/mem.c\
os/pipes.c\
os/readline.c\
os/readterm.c\
os/readutil.c\
os/sockets.c\
os/streams.c\
os/sysbits.c\
os/writeterm.c\
os/ypsocks.c\
os/ypstdio.c
C_SOURCES= \
$(IOLIB_SOURCES) \
#$(IOLIB_SOURCES) \
C/absmi.c C/adtdefs.c \
C/agc.c C/alloc.c \
C/args.c \
C/amasm.c C/analyst.c \
C/arith0.c C/arith1.c C/arith2.c \
C/atomic.c \
C/arrays.c \
C/arrays.c \C/blobs.c \
C/attvar.c C/bb.c \
C/bignum.c \
C/c_interface.c C/cdmgr.c C/cmppreds.c \
@ -266,6 +253,7 @@ C_SOURCES= \
C/eval.c C/exec.c \
C/exo.c \
C/exo_udi.c \
C/flags.c \
C/globals.c C/gmp_support.c \
C/gprof.c C/grow.c \
C/heapgc.c C/index.c \
@ -286,6 +274,7 @@ C_SOURCES= \
C/threads.c \
C/tracer.c C/unify.c C/userpreds.c \
C/udi.c \
C/utf8.c\
C/utilpreds.c C/write.c console/yap.c \
C/yap-args.c \
C/ypstdio.c \
@ -300,7 +289,7 @@ C_SOURCES= \
OPTYap/tab.tries.c OPTYap/tab.completion.c \
C/cut_c.c \
library/dialect/swi/fli/swi.c \
library/dialect/swi/fli/blobs.c \
C/blobs.c \
# library/mpi/mpi.c library/mpi/mpe.c \
# library/lammpi/yap_mpi.c library/lamm1pi/hash.c library/lammpi/prologterms2c.c
@ -374,26 +363,35 @@ SWI_LIB_SOURCES= \
YAPDOCS=docs/yap.tex docs/chr.tex \
docs/clpr.tex docs/swi.tex
IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o \
pl-file.o pl-files.o pl-fmt.o \
pl-glob.o pl-locale.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 \
pl-tai.o pl-text.o pl-utf8.o \
pl-version.o pl-write.o \
pl-yap.o @WINDOWS@ uxnt.o
IOLIB_OBJECTS=\
os/charsio.o \
os/chartypes.o\
os/console.o\
os/files.o\
os/fmemopen.o\
os/format.o\
os/iopreds.o\
os/mem.o\
os/pipes.o\
os/readline.o\
os/readterm.o\
os/readutil.o\
os/sockets.o\
os/streams.o\
os/sysbits.o\
os/writeterm.o\
os/ypsocks.o\
os/ypstdio.o
ENGINE_OBJECTS = \
agc.o absmi.o adtdefs.o alloc.o amasm.o analyst.o arrays.o \
args.o \
arith0.o arith1.o arith2.o atomic.o attvar.o \
bignum.o bb.o \
cdmgr.o cmppreds.o compiler.o computils.o \
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
exec.o exo.o exo_udi.o globals.o gmp_support.o gprof.o grow.o \
exec.o exo.o exo_udi.o flags.o \
globals.o gmp_support.o gprof.o grow.o \
heapgc.o index.o init.o inlines.o \
iopreds.o depth_bound.o mavar.o \
modules.o other.o \
@ -401,9 +399,10 @@ ENGINE_OBJECTS = \
save.o scanner.o signals.o text.o sort.o stdpreds.o \
sysbits.o threads.o tracer.o \
udi.o\
utf8.o\
unify.o userpreds.o utilpreds.o \
yap-args.o write.o \
blobs.o swi.o ypstdio.o \
blobs.o library/dialect/swi/fli/swi.o library/dialect/swi/fli/blobs.o ypstdio.o \
$(IOLIB_OBJECTS)
JIT_OBJECTS = \
@ -428,6 +427,7 @@ MYDDAS_ALL_OBJECTS = \
MYDDAS_OBJECTS = @OBJECTS_MYDDAS@
# not being compiled.
LIBTAI_OBJECTS = \
tai_add.o tai_now.o tai_pack.o \
tai_sub.o tai_unpack.o taia_add.o taia_approx.o \
@ -458,7 +458,7 @@ STATIC_OBJECTS = \
LIB_OBJECTS = $(ENGINE_OBJECTS) \
$(C_INTERFACE_OBJECTS) $(OR_OBJECTS) \
$(BEAM_OBJECTS) $(STATIC_OBJECTS) \
$(LIBTAI_OBJECTS) $(JIT_OBJECTS) \
$(JIT_OBJECTS) \
$(MYDDAS_OBJECTS)
OBJECTS = yap.o yapi.o $(LIB_OBJECTS)
@ -474,7 +474,7 @@ all: startup.yss windowsi
windowsi:
@WINDOWS@ yap-win@EXEC_SUFFIX@
Makefile: Makefile.in
Makefile: $(srcdir)/Makefile.in
H/Yap.h: config.h YapTermConfig.h \
H/YapTags.h \
@ -502,6 +502,9 @@ udi.o: C/udi.c config.h
save.o: C/save.c
$(CC) -c $(C_INTERF_FLAGS) -DYAPSTARTUP=\"$(YAPSTARTUP)\" $< -o $@
library/dialect/swi/fli/%.o: library/dialect/swi/fli/%.c library/dialect/swi/fli/swi.h include/SWI-Prolog.h library/dialect/swi/os/SWI-Stream.h config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/library/dialect/swi/fli -I$(srcdir)/library/dialect/swi/os $< -o $@
%.o: C/%.c config.h
$(CC) -c $(CFLAGS) $< -o $@
@ -526,9 +529,6 @@ yap_random.o: library/random/yap_random.c config.h
%.o: library/regex/%.c @NO_BUILTIN_REGEXP@ library/regex/regex2.h library/regex/engine.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -Ilibrary/regex $< -o $@
%.o: library/dialect/swi/fli/%.c library/dialect/swi/fli/swi.h include/SWI-Prolog.h os/SWI-Stream.h config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -Ilibrary/dialect/swi/fli $< -o $@
%.o: os/%.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -Ios @EXTRA_INCLUDES_FOR_WIN32@ $< -o $@

11
OPTYap/locks_pthread.h
View File

@ -15,27 +15,26 @@
** Atomic locks for PTHREADS **
************************************************************************/
#ifndef LOCK_PTHREAD_H
#ifndef LOCK_PTHREAD_H0
#define LOCK_PTHREAD_H 1
#include <pthread.h>
//#define DEBUG_PE_LOCKS 1
//#define DEBUG_LOCKS
#define DEBUG_LOCKS 1
#include <stdio.h>
int Yap_ThreadID( void );
extern FILE *debugf;
#define debugf stdout
#define INIT_LOCK(LOCK_VAR) pthread_mutex_init(&(LOCK_VAR), NULL)
#define INIT_LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_init(&(LOCK_VAR), NULL) )
#define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR))
#define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR))
#if DEBUG_LOCKS
extern int debug_locks;
#define LOCK(LOCK_VAR) (void)(fprintf(debugf,"[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(), \
__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) )
#define LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) )
#define UNLOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: UNLOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_unlock(&(LOCK_VAR)) )
#else
#define LOCK(LOCK_VAR) pthread_mutex_lock(&(LOCK_VAR))

10
OPTYap/opt.macros.h
View File

@ -15,7 +15,7 @@
** Memory management **
************************************************************************/
extern int Yap_page_size;
extern size_t Yap_page_size;
#ifdef USE_PAGES_MALLOC
#include <sys/shm.h>
@ -513,8 +513,8 @@ extern int Yap_page_size;
** Debug macros **
************************************************************************/
#define INFORMATION_MESSAGE(MESSAGE,ARGS...) \
Sfprintf(Serror, "[ " MESSAGE " ]\n", ##ARGS)
#define INFORMATION_MESSAGE(MESSAGE, ...) \
fprintf( stderr, "[ " MESSAGE " ]\n", __VA_ARGS__)
#ifdef YAPOR
#define ERROR_MESSAGE(MESSAGE) \
@ -551,6 +551,6 @@ extern int Yap_page_size;
#define INFO_THREADS_MAIN_THREAD(MESSAGE, ARGS...) \
Sfprintf(Serror, "[ " MESSAGE " ]\n", ##ARGS)
#else
#define INFO_THREADS(MESG, ARGS...)
#define INFO_THREADS_MAIN_THREAD(MESSAGE, ARGS...)
#define INFO_THREADS(MESG, ...)
#define INFO_THREADS_MAIN_THREAD(MESSAGE, ...)
#endif /* OUTPUT_THREADS_TABLING */

218
OPTYap/opt.preds.c
View File

@ -32,6 +32,7 @@
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#include "iopreds.h"
#ifdef TABLING
static Int p_freeze_choice_point( USES_REGS1 );
@ -70,32 +71,32 @@ static inline realtime current_time(void);
#endif /* YAPOR */
#ifdef TABLING
static inline struct page_statistics show_statistics_table_entries(IOSTREAM *out);
static inline struct page_statistics show_statistics_table_entries(FILE *out);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
static inline struct page_statistics show_statistics_subgoal_entries(IOSTREAM *out);
static inline struct page_statistics show_statistics_subgoal_entries(FILE *out);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
static inline struct page_statistics show_statistics_subgoal_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_dependency_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_subgoal_trie_nodes(IOSTREAM *out);
static inline struct page_statistics show_statistics_subgoal_trie_hashes(IOSTREAM *out);
static inline struct page_statistics show_statistics_answer_trie_nodes(IOSTREAM *out);
static inline struct page_statistics show_statistics_answer_trie_hashes(IOSTREAM *out);
static inline struct page_statistics show_statistics_subgoal_frames(FILE *out);
static inline struct page_statistics show_statistics_dependency_frames(FILE *out);
static inline struct page_statistics show_statistics_subgoal_trie_nodes(FILE *out);
static inline struct page_statistics show_statistics_subgoal_trie_hashes(FILE *out);
static inline struct page_statistics show_statistics_answer_trie_nodes(FILE *out);
static inline struct page_statistics show_statistics_answer_trie_hashes(FILE *out);
#if defined(THREADS_FULL_SHARING)
static inline struct page_statistics show_statistics_answer_ref_nodes(IOSTREAM *out);
static inline struct page_statistics show_statistics_answer_ref_nodes(FILE *out);
#endif /* THREADS_FULL_SHARING */
static inline struct page_statistics show_statistics_global_trie_nodes(IOSTREAM *out);
static inline struct page_statistics show_statistics_global_trie_hashes(IOSTREAM *out);
static inline struct page_statistics show_statistics_global_trie_nodes(FILE *out);
static inline struct page_statistics show_statistics_global_trie_hashes(FILE *out);
#endif /* TABLING */
#ifdef YAPOR
static inline struct page_statistics show_statistics_or_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_query_goal_solution_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_query_goal_answer_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_or_frames(FILE *out);
static inline struct page_statistics show_statistics_query_goal_solution_frames(FILE *out);
static inline struct page_statistics show_statistics_query_goal_answer_frames(FILE *out);
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
static inline struct page_statistics show_statistics_suspension_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_suspension_frames(FILE *out);
#ifdef TABLING_INNER_CUTS
static inline struct page_statistics show_statistics_table_subgoal_solution_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_table_subgoal_answer_frames(IOSTREAM *out);
static inline struct page_statistics show_statistics_table_subgoal_solution_frames(FILE *out);
static inline struct page_statistics show_statistics_table_subgoal_answer_frames(FILE *out);
#endif /* TABLING_INNER_CUTS */
#endif /* YAPOR && TABLING */
@ -188,7 +189,7 @@ struct page_statistics {
#define SHOW_PAGE_STATS(OUT_STREAM, STR_TYPE, _PAGES, STR_NAME) \
{ struct page_statistics stats; \
GET_PAGE_STATS(stats, STR_TYPE, _PAGES); \
Sfprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \
fprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \
return stats; \
}
@ -434,37 +435,37 @@ static Int p_tabling_mode( USES_REGS1 ) {
Int value = IntOfTerm(tvalue);
if (value == 1) { /* batched */
SetMode_Batched(TabEnt_flags(tab_ent));
if (! IsMode_Local(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_Local(LOCAL_TabMode)) {
SetMode_Batched(TabEnt_mode(tab_ent));
return(TRUE);
}
} else if (value == 2) { /* local */
SetMode_Local(TabEnt_flags(tab_ent));
if (! IsMode_Batched(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_Batched(LOCAL_TabMode)) {
SetMode_Local(TabEnt_mode(tab_ent));
return(TRUE);
}
} else if (value == 3) { /* exec_answers */
SetMode_ExecAnswers(TabEnt_flags(tab_ent));
if (! IsMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_LoadAnswers(LOCAL_TabMode)) {
SetMode_ExecAnswers(TabEnt_mode(tab_ent));
return(TRUE);
}
} else if (value == 4) { /* load_answers */
SetMode_LoadAnswers(TabEnt_flags(tab_ent));
if (! IsMode_ExecAnswers(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_ExecAnswers(LOCAL_TabMode)) {
SetMode_LoadAnswers(TabEnt_mode(tab_ent));
return(TRUE);
}
} else if (value == 5) { /* local_trie */
SetMode_LocalTrie(TabEnt_flags(tab_ent));
if (! IsMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_GlobalTrie(LOCAL_TabMode)) {
SetMode_LocalTrie(TabEnt_mode(tab_ent));
return(TRUE);
}
} else if (value == 6) { /* global_trie */
SetMode_GlobalTrie(TabEnt_flags(tab_ent));
if (! IsMode_LocalTrie(yap_flags[TABLING_MODE_FLAG])) {
if (! IsMode_LocalTrie(LOCAL_TabMode)) {
SetMode_GlobalTrie(TabEnt_mode(tab_ent));
return(TRUE);
}
@ -507,36 +508,36 @@ static Int p_abolish_all_tables( USES_REGS1 ) {
static Int p_show_tabled_predicates( USES_REGS1 ) {
IOSTREAM *out;
FILE *out;
tab_ent_ptr tab_ent;
Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
if (!(out = Yap_GetStreamHandle(t)->file))
return FALSE;
tab_ent = GLOBAL_root_tab_ent;
Sfprintf(out, "Tabled predicates\n");
fprintf(out, "Tabled predicates\n");
if (tab_ent == NULL)
Sfprintf(out, " NONE\n");
fprintf(out, " NONE\n");
else while(tab_ent) {
Sfprintf(out, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent));
fprintf(out, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
PL_release_stream(out);
//PL_release_stream(out);
return (TRUE);
}
static Int p_show_table( USES_REGS1 ) {
IOSTREAM *out;
Term mod, t;
tab_ent_ptr tab_ent;
Term t1 = Deref(ARG1);
FILE *out;
if (IsVarTerm(t1) || !IsAtomTerm(t1))
if (!IsStreamTerm(t1))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t1))))
if (!(out = Yap_GetStreamHandle(t1)->file))
return FALSE;
mod = Deref(ARG2);
t = Deref(ARG3);
@ -545,70 +546,65 @@ static Int p_show_table( USES_REGS1 ) {
else if (IsApplTerm(t))
tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred;
else {
PL_release_stream(out);
return (FALSE);
}
show_table(tab_ent, SHOW_MODE_STRUCTURE, out);
PL_release_stream(out);
showTable(tab_ent, SHOW_MODE_STRUCTURE, out);
return (TRUE);
}
static Int p_show_all_tables( USES_REGS1 ) {
IOSTREAM *out;
tab_ent_ptr tab_ent;
Term t = Deref(ARG1);
FILE *out;
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
if (!(out = Yap_GetStreamHandle(t)->file))
return FALSE;
tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
show_table(tab_ent, SHOW_MODE_STRUCTURE, out);
showTable(tab_ent, SHOW_MODE_STRUCTURE, out);
tab_ent = TabEnt_next(tab_ent);
}
PL_release_stream(out);
return (TRUE);
}
static Int p_show_global_trie( USES_REGS1 ) {
IOSTREAM *out;
Term t = Deref(ARG1);
FILE *out;
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
if (!(out = Yap_GetStreamHandle(t)->file))
return FALSE;
show_global_trie(SHOW_MODE_STRUCTURE, out);
PL_release_stream(out);
showGlobalTrie(SHOW_MODE_STRUCTURE, out);
return (TRUE);
}
static Int p_show_statistics_table( USES_REGS1 ) {
IOSTREAM *out;
Term mod, t;
tab_ent_ptr tab_ent;
Term t1 = Deref(ARG1);
FILE *out;
if (IsVarTerm(t1) || !IsAtomTerm(t1))
if (!IsStreamTerm(t1))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t1))))
if (!(out = Yap_GetStreamHandle(t1)->file))
return FALSE;
mod = Deref(ARG2);
mod = Deref(ARG2);
t = Deref(ARG3);
if (IsAtomTerm(t))
tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred;
else if (IsApplTerm(t))
tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred;
else {
PL_release_stream(out);
//PL_release_stream(out);
return (FALSE);
}
show_table(tab_ent, SHOW_MODE_STATISTICS, out);
PL_release_stream(out);
showTable(tab_ent, SHOW_MODE_STATISTICS, out);
return (TRUE);
}
@ -619,15 +615,15 @@ static Int p_show_statistics_tabling( USES_REGS1 ) {
#ifdef USE_PAGES_MALLOC
long total_pages = 0;
#endif /* USE_PAGES_MALLOC */
IOSTREAM *out;
FILE *out;
Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
if (!(out = Yap_GetStreamHandle(t)->file))
return FALSE;
bytes = 0;
Sfprintf(out, "Execution data structures\n");
fprintf(out, "Execution data structures\n");
stats = show_statistics_table_entries(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
@ -638,10 +634,10 @@ static Int p_show_statistics_tabling( USES_REGS1 ) {
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_dependency_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Local trie data structures\n");
fprintf(out, "Local trie data structures\n");
stats = show_statistics_subgoal_trie_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_answer_trie_nodes(out);
@ -654,39 +650,38 @@ static Int p_show_statistics_tabling( USES_REGS1 ) {
stats = show_statistics_answer_ref_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
#endif /* THREADS_FULL_SHARING */
Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Global trie data structures\n");
fprintf(out, "Global trie data structures\n");
stats = show_statistics_global_trie_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_global_trie_hashes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes);
total_bytes += bytes;
#ifdef USE_PAGES_MALLOC
Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n",
fprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes);
fprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
PL_release_stream(out);
//PL_release_stream(out);
return (TRUE);
}
static Int p_show_statistics_global_trie( USES_REGS1 ) {
IOSTREAM *out;
Term t = Deref(ARG1);
FILE *out;
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
if (!(out = Yap_GetStreamHandle(t)->file))
return FALSE;
show_global_trie(SHOW_MODE_STATISTICS, out);
PL_release_stream(out);
showGlobalTrie(SHOW_MODE_STATISTICS, out);
return (TRUE);
}
#endif /* TABLING */
@ -809,34 +804,31 @@ static Int p_show_statistics_or( USES_REGS1 ) {
#ifdef USE_PAGES_MALLOC
long total_pages = 0;
#endif /* USE_PAGES_MALLOC */
IOSTREAM *out;
Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsAtomTerm(t))
if (!IsStreamTerm(t))
return FALSE;
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
return FALSE;
bytes = 0;
Sfprintf(out, "Execution data structures\n");
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ bytes = 0;
fprintf(out, "Execution data structures\n");
stats = show_statistics_or_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Cut support data structures\n");
fprintf(out, "Cut support data structures\n");
stats = show_statistics_query_goal_solution_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_query_goal_answer_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
total_bytes += bytes;
#ifdef USE_PAGES_MALLOC
Sfprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n",
fprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes);
fprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
PL_release_stream(out);
return (TRUE);
@ -862,7 +854,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
#ifdef USE_PAGES_MALLOC
long total_pages = 0;
#endif /* USE_PAGES_MALLOC */
IOSTREAM *out;
FILE *out;
Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsAtomTerm(t))
@ -870,7 +862,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
if (!(out = Yap_GetStreamHandle(AtomOfTerm(t))))
return FALSE;
bytes = 0;
Sfprintf(out, "Execution data structures\n");
fprintf(out, "Execution data structures\n");
stats = show_statistics_table_entries(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
@ -885,10 +877,10 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_suspension_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (I): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Local trie data structures\n");
fprintf(out, "Local trie data structures\n");
stats = show_statistics_subgoal_trie_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_answer_trie_nodes(out);
@ -901,18 +893,18 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
stats = show_statistics_answer_ref_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
#endif /* THREADS_FULL_SHARING */
Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Global trie data structures\n");
fprintf(out, "Global trie data structures\n");
stats = show_statistics_global_trie_nodes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_global_trie_hashes(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes);
total_bytes += bytes;
bytes = 0;
Sfprintf(out, "Cut support data structures\n");
fprintf(out, "Cut support data structures\n");
stats = show_statistics_query_goal_solution_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
stats = show_statistics_query_goal_answer_frames(out);
@ -923,15 +915,15 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
stats = show_statistics_table_subgoal_answer_frames(out);
INCREMENT_AUX_STATS(stats, bytes, total_pages);
#endif /* TABLING_INNER_CUTS */
Sfprintf(out, " Memory in use (IV): %10ld bytes\n\n", bytes);
fprintf(out, " Memory in use (IV): %10ld bytes\n\n", bytes);
total_bytes += bytes;
#ifdef USE_PAGES_MALLOC
Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n",
fprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
fprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes);
fprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
PL_release_stream(out);
return (TRUE);
@ -1088,96 +1080,96 @@ static inline realtime current_time(void) {
#ifdef TABLING
static inline struct page_statistics show_statistics_table_entries(IOSTREAM *out) {
static inline struct page_statistics show_statistics_table_entries(FILE *out) {
SHOW_PAGE_STATS(out, struct table_entry, _pages_tab_ent, "Table entries: ");
}
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
static inline struct page_statistics show_statistics_subgoal_entries(IOSTREAM *out) {
static inline struct page_statistics show_statistics_subgoal_entries(FILE *out) {
SHOW_PAGE_STATS(out, struct subgoal_entry, _pages_sg_ent, "Subgoal entries: ");
}
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
static inline struct page_statistics show_statistics_subgoal_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_subgoal_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct subgoal_frame, _pages_sg_fr, "Subgoal frames: ");
}
static inline struct page_statistics show_statistics_dependency_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_dependency_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct dependency_frame, _pages_dep_fr, "Dependency frames: ");
}
static inline struct page_statistics show_statistics_subgoal_trie_nodes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_subgoal_trie_nodes(FILE *out) {
SHOW_PAGE_STATS(out, struct subgoal_trie_node, _pages_sg_node, "Subgoal trie nodes: ");
}
static inline struct page_statistics show_statistics_subgoal_trie_hashes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_subgoal_trie_hashes(FILE *out) {
SHOW_PAGE_STATS(out, struct subgoal_trie_hash, _pages_sg_hash, "Subgoal trie hashes: ");
}
static inline struct page_statistics show_statistics_answer_trie_nodes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_answer_trie_nodes(FILE *out) {
SHOW_PAGE_STATS(out, struct answer_trie_node, _pages_ans_node, "Answer trie nodes: ");
}
static inline struct page_statistics show_statistics_answer_trie_hashes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_answer_trie_hashes(FILE *out) {
SHOW_PAGE_STATS(out, struct answer_trie_hash, _pages_ans_hash, "Answer trie hashes: ");
}
#if defined(THREADS_FULL_SHARING)
static inline struct page_statistics show_statistics_answer_ref_nodes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_answer_ref_nodes(FILE *out) {
SHOW_PAGE_STATS(out, struct answer_ref_node, _pages_ans_ref_node, "Answer ref nodes: ");
}
#endif /* THREADS_FULL_SHARING */
static inline struct page_statistics show_statistics_global_trie_nodes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_global_trie_nodes(FILE *out) {
SHOW_PAGE_STATS(out, struct global_trie_node, _pages_gt_node, "Global trie nodes: ");
}
static inline struct page_statistics show_statistics_global_trie_hashes(IOSTREAM *out) {
static inline struct page_statistics show_statistics_global_trie_hashes(FILE *out) {
SHOW_PAGE_STATS(out, struct global_trie_hash, _pages_gt_hash, "Global trie hashes: ");
}
#endif /* TABLING */
#ifdef YAPOR
static inline struct page_statistics show_statistics_or_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_or_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct or_frame, _pages_or_fr, "Or-frames: ");
}
static inline struct page_statistics show_statistics_query_goal_solution_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_query_goal_solution_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct query_goal_solution_frame, _pages_qg_sol_fr, "Query goal solution frames: ");
}
static inline struct page_statistics show_statistics_query_goal_answer_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_query_goal_answer_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct query_goal_answer_frame, _pages_qg_ans_fr, "Query goal answer frames: ");
}
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
static inline struct page_statistics show_statistics_suspension_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_suspension_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct suspension_frame, _pages_susp_fr, "Suspension frames: ");
}
#ifdef TABLING_INNER_CUTS
static inline struct page_statistics show_statistics_table_subgoal_solution_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_table_subgoal_solution_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct table_subgoal_solution_frame, _pages_tg_sol_fr, "Table subgoal solution frames:");
}
static inline struct page_statistics show_statistics_table_subgoal_answer_frames(IOSTREAM *out) {
static inline struct page_statistics show_statistics_table_subgoal_answer_frames(FILE *out) {
SHOW_PAGE_STATS(out, struct table_subgoal_answer_frame, _pages_tg_ans_fr, "Table subgoal answer frames: ");
}
#endif /* TABLING_INNER_CUTS */

8
OPTYap/opt.proto.h
View File

@ -11,10 +11,6 @@
** **
************************************************************************/
#if defined(TABLING) || defined(YAPOR)
#include "SWI-Stream.h"
#endif /* TABLING || YAPOR */
/*************************
@ -55,8 +51,8 @@ void free_subgoal_trie(sg_node_ptr, int, int);
void free_answer_trie(ans_node_ptr, int, int);
void free_answer_hash_chain(ans_hash_ptr);
void abolish_table(tab_ent_ptr);
void show_table(tab_ent_ptr, int, IOSTREAM *);
void show_global_trie(int, IOSTREAM *);
void showTable(tab_ent_ptr, int, FILE *);
void showGlobalTrie(int, FILE *);
#endif /* TABLING */

9
OPTYap/tab.macros.h
View File

@ -478,7 +478,6 @@ typedef enum {
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
#define new_table_entry(TAB_ENT, PRED_ENTRY, ATOM, ARITY, MODE_ARRAY) \
ALLOC_TABLE_ENTRY(TAB_ENT); \
INIT_LOCK_TAB_ENT(TAB_ENT); \
@ -490,11 +489,11 @@ typedef enum {
SetMode_ExecAnswers(TabEnt_flags(TAB_ENT)); \
SetMode_LocalTrie(TabEnt_flags(TAB_ENT)); \
TabEnt_mode(TAB_ENT) = TabEnt_flags(TAB_ENT); \
if (IsMode_Local(yap_flags[TABLING_MODE_FLAG])) \
if (IsMode_Local(LOCAL_TabMode)) \
SetMode_Local(TabEnt_mode(TAB_ENT)); \
if (IsMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG])) \
if (IsMode_LoadAnswers(LOCAL_TabMode)) \
SetMode_LoadAnswers(TabEnt_mode(TAB_ENT)); \
if (IsMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG])) \
if (IsMode_GlobalTrie(LOCAL_TabMode)) \
SetMode_GlobalTrie(TabEnt_mode(TAB_ENT)); \
TabEnt_init_mode_directed_field(TAB_ENT, MODE_ARRAY); \
TabEnt_init_subgoal_trie_field(TAB_ENT); \
@ -1237,7 +1236,7 @@ static inline void __restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr U
static inline CELL *__expand_auxiliary_stack(CELL *stack USES_REGS) {
char *old_top = (char *)LOCAL_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
INFORMATION_MESSAGE("Expanding trail in " UInt_FORMAT " bytes", K64);
if (! Yap_growtrail(K64, TRUE)) { /* TRUE means 'contiguous_only' */
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)");
return NULL;

66
OPTYap/tab.tries.c
View File

@ -78,7 +78,7 @@ static inline void traverse_update_arity(char *, int *, int *);
*******************************/
static struct trie_statistics{
IOSTREAM *out;
FILE *out;
int show;
long subgoals;
long subgoals_incomplete;
@ -144,7 +144,7 @@ static struct trie_statistics{
#define SHOW_TABLE_ARITY_ARRAY_SIZE 10000
#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \
if (TrStat_show == SHOW_MODE_STRUCTURE) \
Sfprintf(TrStat_out, MESG, ##ARGS)
fprintf(TrStat_out, MESG, ##ARGS)
#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \
if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \
@ -1637,7 +1637,7 @@ void abolish_table(tab_ent_ptr tab_ent) {
}
void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) {
void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) {
CACHE_REGS
sg_node_ptr sg_node;
@ -1655,40 +1655,40 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) {
TrStat_ans_nodes = 0;
TrStat_gt_refs = 0;
if (show_mode == SHOW_MODE_STATISTICS)
Sfprintf(TrStat_out, "Table statistics for predicate '%s", AtomName(TabEnt_atom(tab_ent)));
fprintf(TrStat_out, "Table statistics for predicate '%s", AtomName(TabEnt_atom(tab_ent)));
else /* SHOW_MODE_STRUCTURE */
Sfprintf(TrStat_out, "Table structure for predicate '%s", AtomName(TabEnt_atom(tab_ent)));
fprintf(TrStat_out, "Table structure for predicate '%s", AtomName(TabEnt_atom(tab_ent)));
#ifdef MODE_DIRECTED_TABLING
if (TabEnt_mode_directed(tab_ent)) {
int i, *mode_directed = TabEnt_mode_directed(tab_ent);
Sfprintf(TrStat_out, "(");
fprintf(TrStat_out, "(");
for (i = 0; i < TabEnt_arity(tab_ent); i++) {
int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]);
if (mode == MODE_DIRECTED_INDEX) {
Sfprintf(TrStat_out, "index");
fprintf(TrStat_out, "index");
} else if (mode == MODE_DIRECTED_MIN) {
Sfprintf(TrStat_out, "min");
fprintf(TrStat_out, "min");
} else if (mode == MODE_DIRECTED_MAX) {
Sfprintf(TrStat_out, "max");
fprintf(TrStat_out, "max");
} else if (mode == MODE_DIRECTED_ALL) {
Sfprintf(TrStat_out, "all");
fprintf(TrStat_out, "all");
} else if (mode == MODE_DIRECTED_SUM) {
Sfprintf(TrStat_out, "sum");
fprintf(TrStat_out, "sum");
} else if (mode == MODE_DIRECTED_LAST) {
Sfprintf(TrStat_out, "last");
fprintf(TrStat_out, "last");
} else if (mode == MODE_DIRECTED_FIRST) {
Sfprintf(TrStat_out, "first");
fprintf(TrStat_out, "first");
} else
Yap_Error(INTERNAL_ERROR, TermNil, "show_table: unknown mode");
if (i != MODE_DIRECTED_GET_ARG(mode_directed[i]))
Sfprintf(TrStat_out, "(ARG%d)", MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1);
fprintf(TrStat_out, "(ARG%d)", MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1);
if (i + 1 != TabEnt_arity(tab_ent))
Sfprintf(TrStat_out, ",");
fprintf(TrStat_out, ",");
}
Sfprintf(TrStat_out, ")'\n");
fprintf(TrStat_out, ")'\n");
} else
#endif /* MODE_DIRECTED_TABLING */
Sfprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent));
fprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent));
sg_node = get_subgoal_trie(tab_ent);
if (sg_node) {
if (TrNode_child(sg_node)) {
@ -1726,25 +1726,25 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) {
if (TrStat_subgoals == 0)
SHOW_TABLE_STRUCTURE(" EMPTY\n");
if (show_mode == SHOW_MODE_STATISTICS) {
Sfprintf(TrStat_out, " Subgoal trie structure\n");
Sfprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete);
Sfprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes);
Sfprintf(TrStat_out, " Answer trie structure(s)\n");
fprintf(TrStat_out, " Subgoal trie structure\n");
fprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete);
fprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes);
fprintf(TrStat_out, " Answer trie structure(s)\n");
#ifdef TABLING_INNER_CUTS
Sfprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned);
fprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned);
#else
Sfprintf(TrStat_out, " Answers: %ld\n", TrStat_answers);
fprintf(TrStat_out, " Answers: %ld\n", TrStat_answers);
#endif /* TABLING_INNER_CUTS */
Sfprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true);
Sfprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no);
Sfprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes);
Sfprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs);
fprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true);
fprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no);
fprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes);
fprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs);
}
return;
}
void show_global_trie(int show_mode, IOSTREAM *out) {
void showGlobalTrie(int show_mode, FILE *out) {
CACHE_REGS
TrStat_out = out;
@ -1753,9 +1753,9 @@ void show_global_trie(int show_mode, IOSTREAM *out) {
TrStat_gt_nodes = 1;
TrStat_gt_refs = 0;
if (show_mode == SHOW_MODE_STATISTICS)
Sfprintf(TrStat_out, "Global trie statistics\n");
fprintf(TrStat_out, "Global trie statistics\n");
else /* SHOW_MODE_STRUCTURE */
Sfprintf(TrStat_out, "Global trie structure\n");
fprintf(TrStat_out, "Global trie structure\n");
if (TrNode_child(GLOBAL_root_gt)) {
char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
@ -1766,9 +1766,9 @@ void show_global_trie(int show_mode, IOSTREAM *out) {
} else
SHOW_TABLE_STRUCTURE(" EMPTY\n");
if (show_mode == SHOW_MODE_STATISTICS) {
Sfprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms);
Sfprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes);
Sfprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs);
fprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms);
fprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes);
fprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs);
}
return;
}

7
OPTYap/traced_tab.insts.h
View File

@ -23,6 +23,7 @@
#define VARS_ENTRY(INDEX) (VARS_ARITY_ENTRY + 1 + vars_arity - (INDEX))
#define SUBS_ENTRY(INDEX) (SUBS_ARITY_ENTRY + 1 + subs_arity - (INDEX))
#if 0
/************************************************************************
** clause_with_cut **
************************************************************************/
@ -31,7 +32,7 @@ Op(clause_with_cut, e)
{ printf("clause_with_cut not supported by JIT!!\n"); exit(1); }
ENDOp();
#endif
/************************************************************************
** table_load_answer **
@ -157,8 +158,8 @@ PBOp(table_load_answer, Otapl)
** table_answer_resolution_completion **
************************************************************************/
BOp(table_answer_resolution_completion, Otapl)
#ifdef THREADS_CONSUMER_SHARING
BOp(table_answer_resolution_completion, Otapl)
{ printf("table_answer_resolution_completion not supported by JIT!!\n"); exit(1); }
#endif /* THREADS_CONSUMER_SHARING */
ENDBOp();
#endif /* THREADS_CONSUMER_SHARING */

230
config.h.cmake
View File

@ -19,6 +19,11 @@
#define ALIGN_LONGS 1
#endif
/* size in bits of words. */
#ifndef BITNESS
#define BITNESS "${bitness}"
#endif
/* if fflush(NULL) clobbers input pipes1 */
#ifndef BROKEN_FFLUSH_NULL
#cmakedefine BROKEN_FFLUSH_NULL "${BROKEN_FFLUSH_NULL}"
@ -36,17 +41,17 @@
/* compilation flags */
#ifndef C_CFLAGS
#define C_CFLAGS "${CMAKE_C_CFLAGS}"
#define C_CFLAGS "${CFLAGS_EXPORT} ${CMAKE_C_FLAGS} ${FLAGS} ${LANGUAGE_COMPILE_FLAGS}"
#endif
/* linking flags */
#ifndef C_LDFLAGS
#define C_LDFLAGS "${CMAKE_SHARED_LINKER_FLAGS}"
#define C_LDFLAGS "${LINK_FLAGS} ${LINK_LIBRARIES}"
#endif
/* libs for linking with DLLs */
#ifndef C_LIBPLSO
#define C_LIBPLSO "${CMAKE_SHARED_LINKER_FLAGS} -lYap"
#define C_LIBPLSO "${CMAKE_SHARED_LINKER_FLAGS} ${LINK_FLAGS} ${LINK_LIBRARIES}"
#endif
/* main libs for YAP */
@ -255,30 +260,6 @@ function. */
#cmakedefine HAVE_CTYPE_H ${HAVE_CTYPE_H}
#endif
/* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if
you don't. */
#ifndef HAVE_DECL_RL_CATCH_SIGNALS_
#cmakedefine HAVE_DECL_RL_CATCH_SIGNALS ${HAVE_DECL_RL_CATCH_SIGNALS}
#endif
/* Define to 1 if you have the declaration of `rl_done ', and to 0 if you
don't. */
#ifndef HAVE_DECL_RL_DONE_
#cmakedefine HAVE_DECL_RL_DONE_ ${HAVE_DECL_RL_DONE_}
#endif
/* Define to 1 if you have the declaration of `rl_event_hook', and to 0 if you
don't. */
#ifndef HAVE_DECL_RL_EVENT_HOOK
#cmakedefine HAVE_DECL_RL_EVENT_HOOK ${HAVE_DECL_RL_EVENT_HOOK}
#endif
/* Define to 1 if you have the declaration of `rl_readline_state', and to 0 if
you don't. */
#ifndef HAVE_DECL_RL_READLINE_STATE
#cmakedefine HAVE_DECL_RL_READLINE_STATE ${HAVE_DECL_RL_READLINE_STATE}
#endif
/* Define to 1 if you have the <direct.h> header file. */
#ifndef HAVE_DIRECT_H
#cmakedefine HAVE_DIRECT_H ${HAVE_DIRECT_H}
@ -404,6 +385,11 @@ you don't. */
#cmakedefine HAVE_FLSLL ${HAVE_FLSLL}
#endif
/* Define to 1 if you have the `fmemopen' function. */
#ifndef HAVE_FMEMOPEN
#cmakedefine HAVE_FMEMOPEN ${HAVE_FMEMOPEN}
#endif
/* Define to 1 if you have the `fpclass' function. */
#ifndef HAVE_FPCLASS
#cmakedefine HAVE_FPCLASS ${HAVE_FPCLASS}
@ -424,6 +410,11 @@ you don't. */
#cmakedefine HAVE_FTRUNCATE ${HAVE_FTRUNCATE}
#endif
/* Define to 1 if you have the `funopen' function. */
#ifndef HAVE_FUNOPEN
#cmakedefine HAVE_FUNOPEN ${HAVE_FUNOPEN}
#endif
/* Old m4 auto-heder generation, not really useful now */
#ifndef HAVE_GCC
#cmakedefine HAVE_GCC ${HAVE_GCC}
@ -594,6 +585,11 @@ you don't. */
#cmakedefine HAVE_CRYPT ${HAVE_CRYPT}
#endif
/* Define to 1 if you have the <memory.h> header file. */
#ifndef HAVE_LIBGEN_H
#cmakedefine HAVE_LIBGEN_H ${HAVE_LIBGEN_H}
#endif
/* Define to 1 if you have the `gmp' library (-lgmp). */
#ifndef HAVE_LIBGMP
@ -725,10 +721,6 @@ you don't. */
#define HAVE_LIBRAPTOR2 ${HAVE_LIBRAPTOR2}
#endif
/* Define if you have libreadline */
#ifndef HAVE_LIBREADLINE
#define HAVE_LIBREADLINE ${READLINE_FOUND}
#endif
/* Define to 1 if you have the `resolv' library (-lresolv). */
#ifndef HAVE_LIBRESOLV
@ -930,11 +922,17 @@ you don't. */
#cmakedefine HAVE_NULLPTR ${HAVE_NULLPTR}
#endif
/* Define to 1 if you have the `open_memstream' function. */
#ifndef HAVE_OPEN_MEMSTREAM
#cmakedefine HAVE_OPEN_MEMSTREAM ${HAVE_OPEN_MEMSTREAM}
#endif
/* Define to 1 if you have the `opendir' function. */
#ifndef HAVE_OPENDIR
#cmakedefine HAVE_OPENDIR ${HAVE_OPENDIR}
#endif
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#cmakedefine HAVE_OPENSSL_RIPEMD_H ${HAVE_OPENSSL_RIPEMD_H}
@ -998,15 +996,6 @@ you don't. */
#cmakedefine HAVE_RAPTOR_H ${HAVE_RAPTOR_H}
#endif
/* Define to 1 if you have the <readline/history.h> header file. */
#ifndef HAVE_READLINE_HISTORY_H
#cmakedefine HAVE_READLINE_HISTORY_H ${HAVE_READLINE_HISTORY_H}
#endif
/* Define to 1 if you have the <readline/readline.h> header file. */
#ifndef HAVE_READLINE_READLINE_H
#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H}
#endif
/* Define to 1 if you have the `readlink' function. */
#ifndef HAVE_READLINK
@ -1054,76 +1043,6 @@ signal. */
#cmakedefine HAVE_RINTERFACE_H ${HAVE_RINTERFACE_H}
#endif
/* Define to 1 if you have the `rl_begin_undo_group' function. */
#ifndef HAVE_RL_BEGIN_UNDO_GROUP
#cmakedefine HAVE_RL_BEGIN_UNDO_GROUP ${HAVE_RL_BEGIN_UNDO_GROUP}
#endif
/* Define to 1 if you have the `rl_clear_pending_input' function. */
#ifndef HAVE_RL_CLEAR_PENDING_INPUT
#cmakedefine HAVE_RL_CLEAR_PENDING_INPUT ${HAVE_RL_CLEAR_PENDING_INPUT}
#endif
/* Define to 1 if the system has the type `rl_completion_func_t'). */
#ifndef HAVE_RL_COMPLETION_FUNC_T
#cmakedefine HAVE_RL_COMPLETION_FUNC_T ${HAVE_RL_COMPLETION_FUNC_T}
#endif
/* Define to 1 if the system has the type `rl_completion_func_t'. */
#ifndef HAVE_RL_COMPLETION_FUNC_T
#cmakedefine HAVE_RL_COMPLETION_FUNC_T ${HAVE_RL_COMPLETION_FUNC_T}
#endif
/* Define to 1 if you have the `rl_completion_matches' function. */
#ifndef HAVE_RL_COMPLETION_MATCHES
#cmakedefine HAVE_RL_COMPLETION_MATCHES ${HAVE_RL_COMPLETION_MATCHES}
#endif
/* Define to 1 if you have the `rl_discard_argument' function. */
#ifndef HAVE_RL_DISCARD_ARGUMENT
#cmakedefine HAVE_RL_DISCARD_ARGUMENT ${HAVE_RL_DISCARD_ARGUMENT}
#endif
/* Define to 1 if you have the `rl_done' variable. */
#ifndef HAVE_RL_DONE
#define HAVE_RL_DONE ${HAVE_RL_DONE}
#endif
/* Define to 1 if you have the `rl_filename_completion_function' function. */
#ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION
#define HAVE_RL_FILENAME_COMPLETION_FUNCTION ${HAVE_RL_FILENAME_COMPLETION_FUNCTION}
#endif
/* Define to 1 if you have the `rl_free_line_state' function. */
#ifndef HAVE_RL_FREE_LINE_STATE
#cmakedefine HAVE_RL_FREE_LINE_STATE ${HAVE_RL_FREE_LINE_STATE}
#endif
/* Define to 1 if the system has the type `rl_hook_func_t'. */
#ifndef HAVE_RL_HOOK_FUNC_T
#cmakedefine HAVE_RL_HOOK_FUNC_T ${HAVE_RL_HOOK_FUNC_T}
#endif
/* Define to 1 if you have the `rl_insert_close' function. */
#ifndef HAVE_RL_INSERT_CLOSE
#cmakedefine HAVE_RL_INSERT_CLOSE ${HAVE_RL_INSERT_CLOSE}
#endif
/* Define to 1 if you have the `rl_reset_after_signal' function. */
#ifndef HAVE_RL_RESET_AFTER_SIGNAL
#cmakedefine HAVE_RL_RESET_AFTER_SIGNAL ${HAVE_RL_RESET_AFTER_SIGNAL}
#endif
/* Define to 1 if you have the `rl_set_keyboard_input_timeout' function. */
#ifndef HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT
#cmakedefine HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT ${HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT}
#endif
/* Define to 1 if you have the `rl_set_prompt' function. */
#ifndef HAVE_RL_SET_PROMPT
#cmakedefine HAVE_RL_SET_PROMPT ${HAVE_RL_SET_PROMPT}
#endif
/* Define to 1 if you have the <R.h> header file. */
#ifndef HAVE_R_H
#cmakedefine HAVE_R_H ${HAVE_R_H}
@ -1747,8 +1666,18 @@ signal. */
#endif
/* Define to the version of this package. */
#ifndef PACKAGE_VERSION
#define PACKAGE_VERSION "${YAP_VERSION}"
#ifndef YAP_FULL_VERSION
#define YAP_FULL_VERSION "[ YAP ${YAP_FULL_GIT_VERSION} (${CMAKE_SYSTEM}-${YAP_ARCH}): ${YAP_TIMESTAMP}@${YAP_SITE} ]\n"
#endif
/* Define to the version of this package. */
#ifndef YAP_GIT_HEAD
#define YAP_GIT_HEAD g_GIT_SHA1
#endif
/* Define to the version of this package. */
#ifndef YAP_NUMERIC_VERSION
#define YAP_NUMERIC_VERSION "${YAP_NUMERIC_VERSION}"
#endif
/* Define as the return type of signal handlers (`int' or `void'). */
@ -1838,7 +1767,7 @@ signal. */
/* library search variable */
#ifndef SO_PATH
#cmakedefine SO_PATH "${SO_PATH}"
#define SO_PATH "${dlls}"
#endif
/* enable condor distributed execution, static compilation */
@ -1928,42 +1857,15 @@ significant byte first (like Motorola and SPARC, unlike Intel). */
/* architecture */
#ifndef YAP_ARCH
#define YAP_ARCH "${YAP_ARCH}"
#define YAP_ARCH "${YAP_ARCH}"
#endif
/* where the yap executable lives */
#ifndef YAP_BINDIR
#define YAP_BINDIR "${YAP_BINDIR}"
#endif
/* YAP version string */
#ifndef YAP_FULL_VERSION
#define YAP_FULL_VERSION "YAP ${YAP_FULL_VERSION}: ${YAP_ARCH}-${CMAKE_SYSTEM}, @${YAP_SITE}, ${YAP_TIMESTAMP}"
#endif
/* where to look for shared libraries */
#ifndef YAP_LIBDIR
#define YAP_LIBDIR "${YAP_LIBDIR}"
#endif
/* numerical version */
#ifndef YAP_NUMERIC_VERSION
#define YAP_NUMERIC_VERSION ${YAP_NUMERIC_VERSION}
#endif
/* where to look for Prolog sources */
#ifndef YAP_PL_SRCDIR
#define YAP_PL_SRCDIR "${YAP_PL_SRCDIR}"
#define YAP_PL_SRCDIR "${PROJECT_SOURCE_DIR}/pl}"
#endif
/* where YAP lives */
#ifndef YAP_ROOTDIR
#define YAP_ROOTDIR "${YAP_ROOTDIR}"
#endif
/* where to look for the Prolog library */
#ifndef YAP_SHAREDIR
#define YAP_SHAREDIR "${YAP_SHAREDIR}"
#define YAP_SHAREDIR "${YAP_SHAREDIR}"
#endif
/* saved state file */
@ -1973,17 +1875,22 @@ significant byte first (like Motorola and SPARC, unlike Intel). */
/* date of compilation */
#ifndef YAP_TIMESTAMP
#define YAP_TIMESTAMP "${YAP_TIMESTAMP}"
#define YAP_TIMESTAMP ${YAP_TIMESTAMP}
#endif
/* yap version as a term */
#ifndef YAP_TVERSION
#define YAP_TVERSION "yap(${YAP_MAJOR_VERSION},${YAP_MINOR_VERSION},${YAP_PATCH_VERSION},0)"
#endif
/* what timezone we are in */
#ifndef YAP_VAR_TIMEZONE
#define YAP_VAR_TIMEZONE "${YAP_VAR_TIMEZONE}"
#define YAP_VAR_TIMEZONE ${YAP_VAR_TIMEZONE}
#endif
/* yap version */
#ifndef YAP_VERSION
#define YAP_VERSION "${YAP_VERSION}"
/* yap compiled at */
#ifndef YAP_COMPILED_AT
#define YAP_COMPILED_AT "${YAP_TIMESTAMP}@${YAP_SITE}"
#endif
/* name of YAP library */
@ -1991,6 +1898,21 @@ significant byte first (like Motorola and SPARC, unlike Intel). */
#define YAP_YAPLIB "${YAP_YAPLIB}"
#endif
/* name of YAP library */
#ifndef YAP_BINDIR
#define YAP_BINDIR "${bindir}"
#endif
/* name of YAP library */
#ifndef YAP_ROOTDIR
#define YAP_ROOTDIR "${YAP_ROOTDIR}"
#endif
/* name of YAP library */
#ifndef YAP_LIBDIR
#define YAP_LIBDIR "${YAP_LIBDIR}"
#endif
/* name of YAP JIT library */
#ifndef YAP_YAPJITLIB
#define YAP_YAPJITLIB "${YAP_YAPJITLIB}"
@ -2006,10 +1928,6 @@ significant byte first (like Motorola and SPARC, unlike Intel). */
#cmakedefine _XOPEN_SOURCE_EXTENDED "${_XOPEN_SOURCE_EXTENDED}"
#endif
/* compiling for Windows */
#ifndef __WINDOWS__
#cmakedefine __WINDOWS__ "${__WINDOWS__}"
#endif
/* Define to empty if `const' does not conform to ANSI C. */
#ifndef const
@ -2034,4 +1952,12 @@ calls it, or to nothing if 'inline' is not supported under any name. */
#cmakedefine pid_t "${pid_t}"
#endif
#ifndef MAXPATHLEN
#ifdef PATH_MAX
#define MAXPATHLEN PATH_MAX
#else
#define MAXPATHLEN 1024
#endif
#endif
#endif

35
configure vendored
View File

@ -712,6 +712,7 @@ JITLIBS
JITLD
JITFLAGS
LLVM_CONFIG
MYDDAS_LDFLAGS
MYDDAS_LIBS
MYDDAS_CPPFLAGS
OBJECTS_MYDDAS
@ -4626,7 +4627,8 @@ fi
if test "${with_gmp+set}" = set; then :
withval=$with_gmp; if test "$withval" = yes; then
yap_cv_gmp=yes
GMPDIR=/usr
gmp_in_usr=`echo /usr/lib/gmp*`
GMPDIR=/usr:/usr/lo
elif test "$withval" = no; then
yap_cv_gmp=no
else
@ -7776,7 +7778,7 @@ fi
$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
have_dl=yes
1
else
have_dl=no
fi
@ -7814,7 +7816,13 @@ fi
fi
INSTALL_DLLS="yes"
fi
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
if test "$CLANG" = "yes"
then
# CC="$CC -fstrict-aliasing -fno-diagnostics-fixit-info -fno-color-diagnostics -fno-caret-diagnostics -fno-show-column -fsched-interblock -Wall"
CC="$CC -fstrict-aliasing -fsched-interblock -Wall"
else
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
fi
DYNYAPLIB=libYap."$YAP_VERSION.$SO"
SONAMEFLAG="-Wl,-install_name,$prefix/lib/libYap.$YAP_MAJOR_VERSION.$SO -Wl,-compatibility_version,$YAP_MAJOR_VERSION.$YAP_MINOR_VERSION -Wl,-current_version,$YAP_VERSION"
YAPLIB_LD="$CC -dynamiclib"
@ -10576,6 +10584,7 @@ _ACEOF
OLD_LIBS="$LIBS"
OLD_CPPFLAGS="$CPPFLAGS"
MYDDAS_CPPFLAGS=""
MYDDAS_LDFLAGS=""
# Check whether --enable-myddas was given.
if test "${enable_myddas+set}" = set; then :
@ -10585,7 +10594,8 @@ if test "${enable_myddas+set}" = set; then :
yap_cv_myddas=no
else
yap_cv_myddas=$withval
LDFLAGS="$LDFLAGS -L${yap_cv_myddas}/lib "
LDFLAGS="$LDFLAGS -L${yap_cv_myddas}/lib "
MYDDAS_LDFLAGS+=" -L${yap_cv_myddas}/lib "
CPPFLAGS="$CPPFLAGS -I${yap_cv_myddas}/include "
MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_myddas}/include "
fi
@ -10604,6 +10614,7 @@ if test "${with_mysql+set}" = set; then :
else
yap_cv_mysql=$withval
LDFLAGS="$LDFLAGS -L${yap_cv_mysql}/lib "
MYDDAS_LDFLAGS+=" -L${yap_cv_mysql}/lib "
CPPFLAGS="$CPPFLAGS -I${yap_cv_mysql}/include "
MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_mysql}/include "
fi
@ -10622,6 +10633,7 @@ if test "${with_odbc+set}" = set; then :
else
yap_cv_odbc=$withval
LDFLAGS="$LDFLAGS -L${yap_cv_odbc}/lib "
MYDDAS_LDFLAGS+=" -L${yap_cv_odbc}/lib "
CPPFLAGS="$CPPFLAGS -I${yap_cv_odbc}/include "
MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_odbc}/include "
fi
@ -10640,6 +10652,7 @@ if test "${with_sqlite3+set}" = set; then :
else
yap_cv_sqlite3=$withval
LDFLAGS="$LDFLAGS -L${yap_cv_sqlite3}/lib "
MYDDAS_LDFLAGS+=" -L${yap_cv_sqlite3}/lib "
CPPFLAGS="$CPPFLAGS -I${yap_cv_sqlite3}/include "
MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_sqlite3}/include "
fi
@ -10658,6 +10671,7 @@ if test "${with_postgres+set}" = set; then :
else
yap_cv_postgres=$withval
LDFLAGS="$LDFLAGS -L${yap_cv_postgres}/lib "
MYDDAS_LDFLAGS+=" -L${yap_cv_postgres}/lib "
CPPFLAGS="$CPPFLAGS -I${yap_cv_postgres}/include "
MYDDAS_CPPFLAGS="$MYDDAS_CPPFLAGS -I${yap_cv_postgres}/include "
fi
@ -11191,7 +11205,9 @@ done
fi
MYDDAS_LIBS="$LIBS"
MYDDAS_LDFLAGS="$LDFLAGS"
MYDDAS_LIBS="$LIBS"
MYDDAS_LIBS="$LIBS"
LIBS="$OLD_LIBS"
CPPFLAGS="$OLD_CPPFLAGS"
else
@ -11225,6 +11241,7 @@ fi
# Check whether --enable-jit was given.
@ -14134,7 +14151,7 @@ else
JAVA_TEST=Test.java
CLASS_TEST=Test.class
cat << \EOF > $JAVA_TEST
/* #line 14137 "configure" */
/* #line 14154 "configure" */
public class Test {
}
EOF
@ -14310,7 +14327,7 @@ EOF
if uudecode$EXEEXT Test.uue; then
ac_cv_prog_uudecode_base64=yes
else
echo "configure: 14313: uudecode had trouble decoding base 64 file 'Test.uue'" >&5
echo "configure: 14330: uudecode had trouble decoding base 64 file 'Test.uue'" >&5
echo "configure: failed file was:" >&5
cat Test.uue >&5
ac_cv_prog_uudecode_base64=no
@ -14441,7 +14458,7 @@ else
JAVA_TEST=Test.java
CLASS_TEST=Test.class
cat << \EOF > $JAVA_TEST
/* #line 14444 "configure" */
/* #line 14461 "configure" */
public class Test {
}
EOF
@ -14476,7 +14493,7 @@ JAVA_TEST=Test.java
CLASS_TEST=Test.class
TEST=Test
cat << \EOF > $JAVA_TEST
/* [#]line 14479 "configure" */
/* [#]line 14496 "configure" */
public class Test {
public static void main (String args[]) {
System.exit (0);

13
configure.in
View File

@ -277,7 +277,8 @@ AC_ARG_WITH(gmp,
[ --with-gmp[=DIR] use GNU Multiple Precision in DIR],
if test "$withval" = yes; then
yap_cv_gmp=yes
GMPDIR=/usr
gmp_in_usr=`echo /usr/lib/gmp*`
GMPDIR=/usr:/usr/lo
elif test "$withval" = no; then
yap_cv_gmp=no
else
@ -1080,7 +1081,7 @@ dnl Linux has both elf and a.out, in this case we found elf
then
AC_CHECK_LIB(dl,dlopen,
have_dl=yes
,
1 ,
have_dl=no)
if test ${have_dl} = yes
then
@ -1115,7 +1116,13 @@ dnl Linux has both elf and a.out, in this case we found elf
fi
INSTALL_DLLS="yes"
fi
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
if test "$CLANG" = "yes"
then
# CC="$CC -fstrict-aliasing -fno-diagnostics-fixit-info -fno-color-diagnostics -fno-caret-diagnostics -fno-show-column -fsched-interblock -Wall"
CC="$CC -fstrict-aliasing -fsched-interblock -Wall"
else
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
fi
DYNYAPLIB=libYap."$YAP_VERSION.$SO"
SONAMEFLAG="-Wl,-install_name,$prefix/lib/libYap.$YAP_MAJOR_VERSION.$SO -Wl,-compatibility_version,$YAP_MAJOR_VERSION.$YAP_MINOR_VERSION -Wl,-current_version,$YAP_VERSION"
YAPLIB_LD="$CC -dynamiclib"

2
console/yap.c
View File

@ -131,7 +131,7 @@ exec_top_level(int BootMode, YAP_init_args *iap)
YAP_Exit(EXIT_SUCCESS);
}
FILE *debugf;
//FILE *debugf;
#ifdef LIGHT
int

52
include/SWI-Prolog.h
View File

@ -69,7 +69,6 @@ typedef int _Bool;
#define __WINDOWS__ 1
#endif
#endif
#ifndef X_API
#if (defined(_MSC_VER) || defined(__MINGW32__)) && defined(PL_KERNEL)
#define X_API __declspec(dllexport)
@ -79,6 +78,11 @@ typedef int _Bool;
#endif
#include "pl-types.h"
/*******************************
* EXPORT *
*******************************/
@ -129,47 +133,7 @@ stuff.
#endif
/*******************************
* TYPES *
*******************************/
#ifdef __WINDOWS__
#ifndef INT64_T_DEFINED
#define INT64_T_DEFINED 1
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
#if (_MSC_VER < 1300) && !defined(__MINGW32__)
typedef long intptr_t;
typedef unsigned long uintptr_t;
#endif
#endif
#else
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef intptr_t term_t;
#endif
typedef struct mod_entry *module_t;
typedef struct DB_STRUCT *record_t;
typedef uintptr_t atom_t;
typedef struct pred_entry *predicate_t;
typedef struct open_query_struct *qid_t;
typedef uintptr_t functor_t;
typedef int (*PL_agc_hook_t)(atom_t);
typedef uintptr_t foreign_t; /* return type of foreign functions */
typedef wchar_t pl_wchar_t; /* wide character support */
#include <inttypes.h> /* more portable than stdint.h */
#if !defined(_MSC_VER)
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
typedef int (*PL_dispatch_hook_t)(int fd);
typedef void *pl_function_t;
#define fid_t PL_fid_t /* avoid AIX name-clash */
#include "pl-types.h"
typedef struct _PL_extension
{ const char *predicate_name; /* Name of the predicate */
short arity; /* Arity of the predicate */
@ -775,7 +739,7 @@ PL_EXPORT(int) PL_set_prolog_flag(const char *name, int type, ...);
/*******************************
* BLOBS *
*******************************/
#ifndef BLOBS_H
#define PL_BLOB_MAGIC_B 0x75293a00 /* Magic to validate a blob-type */
#define PL_BLOB_VERSION 1 /* Current version */
#define PL_BLOB_MAGIC (PL_BLOB_MAGIC_B|PL_BLOB_VERSION)
@ -830,7 +794,7 @@ PL_EXPORT(PL_blob_t*) YAP_find_blob_type(YAP_Atom at);
PL_EXPORT(int) PL_unregister_blob_type(PL_blob_t *type);
PL_EXPORT(int) PL_raise(int sig);
#endif
#if USE_GMP
PL_EXPORT(int) PL_get_mpz(term_t t, mpz_t mpz);

39
include/YapDefs.h
View File

@ -18,6 +18,7 @@
#define _YAPDEFS_H 1
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h>
@ -43,7 +44,7 @@
#else
#ifndef true
typedef int _Bool;
v
#define bool _Bool;
#define false 0
@ -312,7 +313,7 @@ typedef void (*YAP_halt_hook)(int exit_code, void *closure);
typedef YAP_Int YAP_opaque_tag_t;
typedef YAP_Bool (*YAP_Opaque_CallOnFail)(void *);
typedef YAP_Bool (*YAP_Opaque_CallOnWrite)(void *, YAP_opaque_tag_t, void *, int);
typedef YAP_Bool (*YAP_Opaque_CallOnWrite)(FILE *, YAP_opaque_tag_t, void *, int);
typedef YAP_Int (*YAP_Opaque_CallOnGCMark)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int);
typedef YAP_Bool (*YAP_Opaque_CallOnGCRelocate)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int);
@ -334,6 +335,38 @@ typedef enum
YAPC_COMPILE_ALL /* compile all predicates */
} yapc_exec_mode;
/** Stream Modes: */
typedef enum stream_f {
Free_Stream_f = 0x000001, /**< Free YAP Stream */
Input_Stream_f = 0x000002, /**< Input Stream */
Output_Stream_f = 0x000004, /**< Output Stream in Truncate Mode */
Append_Stream_f = 0x000008, /**< Output Stream in Append Mod */
Eof_Stream_f = 0x000010, /**< Stream found an EOF */
Null_Stream_f = 0x000020, /**< Stream is /dev/null, or equivant */
Tty_Stream_f = 0x000040, /**< Stream is a terminal */
Socket_Stream_f = 0x000080, /**< Socket Stream */
Binary_Stream_f = 0x000100, /**< Stream is not eof */
Eof_Error_Stream_f = 0x000200, /**< Stream should generate error on trying to read after EOF */
Reset_Eof_Stream_f = 0x000400, /**< Stream should be reset on findind an EO (C-D and console.*/
Past_Eof_Stream_f = 0x000800, /**< Read EOF from stream */
Push_Eof_Stream_f = 0x001000, /**< keep on sennding EOFs */
Seekable_Stream_f = 0x002000, /**< we can jump around the stream (std regular files) */
Promptable_Stream_f = 0x004000, /**< Interactive line-by-line stream */
Client_Socket_Stream_f= 0x008000, /**< socket in client mode */
Server_Socket_Stream_f= 0x010000, /**< socket in server mode */
InMemory_Stream_f = 0x020000, /**< buffer */
Pipe_Stream_f = 0x040000, /**< FIFO buffer */
Popen_Stream_f = 0x080000, /**< popen open, pipes mosylyn */
User_Stream_f = 0x100000, /**< usually user_ipiy */
HAS_BOM_f = 0x200000, /**< media for streamhas a BOM mar. */
RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */
RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */
DoNotCloseOnAbort_Stream_f= 0x1000000 /**< do not close the stream after an abort event */
} estream_f;
typedef uint64_t stream_flags_t;
/********* encoding ***********************/
typedef enum
@ -355,7 +388,7 @@ typedef enum
{
YAPC_ENABLE_GC, /* enable or disable garbage collection */
YAPC_ENABLE_AGC /* enable or disable atom garbage collection */
} yap_flag_t;
} yap_flag_gc_t;
typedef enum yap_enum_reset_t {
YAP_EXEC_ABSMI = 0,

2
include/YapError.h
View File

@ -88,6 +88,7 @@ typedef enum
PERMISSION_ERROR_OUTPUT_STREAM,
PERMISSION_ERROR_OUTPUT_TEXT_STREAM,
PERMISSION_ERROR_RESIZE_ARRAY,
PERMISSION_ERROR_READ_ONLY_FLAG,
PERMISSION_ERROR_REPOSITION_STREAM,
PRED_ENTRY_COUNTER_UNDERFLOW,
REPRESENTATION_ERROR_CHARACTER,
@ -121,6 +122,7 @@ typedef enum
TYPE_ERROR_KEY,
TYPE_ERROR_LIST,
TYPE_ERROR_NUMBER,
TYPE_ERROR_PARAMETER,
TYPE_ERROR_PREDICATE_INDICATOR,
TYPE_ERROR_PTR,
TYPE_ERROR_REFERENCE,

21
include/YapInterface.h
View File

@ -1878,7 +1878,7 @@ extern X_API char *YAP_CompileClause(YAP_Term);
extern X_API int YAP_NewExo( YAP_PredEntryPtr ap, size_t data, void *user_di);
extern X_API int YAP_AssertTuples( YAP_PredEntryPtr pred, const YAP_Term *ts, size_t sz);
extern X_API int YAP_AssertTuples( YAP_PredEntryPtr pred, const YAP_Term *ts, size_t offset, size_t sz);
/* int YAP_Init(YAP_init_args *) */
extern X_API YAP_Int YAP_Init(YAP_init_args *);
@ -1891,15 +1891,17 @@ extern X_API YAP_Int YAP_FastInit(char saved_state[]);
#define IOSTREAM void
#endif /* FPL_STREAM_H */
extern X_API YAP_Term YAP_Read(IOSTREAM *s);
extern X_API YAP_Term YAP_Read(FILE *s);
extern X_API void YAP_Write(YAP_Term t,IOSTREAM *s,int);
extern X_API YAP_Term YAP_ReadFromStream(int s);
extern X_API IOSTREAM * YAP_TermToStream(YAP_Term t);
extern X_API void YAP_Write(YAP_Term t,FILE *s,int);
extern X_API IOSTREAM * YAP_InitConsult(int mode, const char *filename);
extern X_API FILE * YAP_TermToStream(YAP_Term t);
extern X_API void YAP_EndConsult(IOSTREAM *s);
extern X_API int YAP_InitConsult(int mode, const char *filename);
extern X_API void YAP_EndConsult(int s);
#ifndef _PL_STREAM_H
// if we don't know what a stream is, just don't assume nothing about the pointer
@ -1973,13 +1975,6 @@ extern X_API void YAP_CloseAllOpenStreams(void);
extern X_API void YAP_FlushAllStreams(void);
#define YAP_APPEND_STREAM 0x04
#define YAP_PIPE_STREAM 0x08
#define YAP_TTY_STREAM 0x10
#define YAP_POPEN_STREAM 0x20
#define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80
/* YAP_Term *YAP_NewSlots() */
extern X_API YAP_handle_t YAP_NewSlots(int);

3
os/alias.c
View File

@ -8,7 +8,7 @@
* *
**************************************************************************
* *
* File: iopreds.c *
* File: alias.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Input/Output C implemented predicates *
@ -402,6 +402,7 @@ Yap_AddAlias (Atom arg, int sno)
struct AliasDescS *
Yap_InitStandardAliases(void)
{
CACHE_REGS
/* init standard aliases */
/* alloca alias array */

6
os/format.c
View File

@ -791,7 +791,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
}
repeats -= GLOBAL_Stream[sno].linepos;
repeats = (repeats < 0 ? 0 : repeats);
fill_pads( sno, repeats, &finfo);
fill_pads( sno, repeats, &finfo PASS_REGS);
break;
case '+':
if (osno) {
@ -800,7 +800,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
osno = 0;
}
repeats = (repeats < 0 ? 0 : repeats);
fill_pads( sno, repeats, &finfo);
fill_pads( sno, repeats, &finfo PASS_REGS);
break;
case 't':
{
@ -914,7 +914,7 @@ format2(Term tin, Term tf, Term tas USES_REGS)
(f == FunctorAtom || f == FunctorString ||
f == FunctorCodes1 || f == FunctorCodes ||
f == FunctorChars1 || f == FunctorChars) ) {
output_stream = Yap_OpenBufWriteStream();
output_stream = Yap_OpenBufWriteStream( PASS_REGS1);
mem_stream = true;
} else {
/* needs to change LOCAL_c_output_stream for write */

12
os/iopreds.c
View File

@ -144,6 +144,10 @@ unix_upd_stream_info (StreamDesc * s)
#else
{
int filedes; /* visualc */
if (!s->file) {
s->name = AtomNil;
return;
}
filedes = fileno (s->file);
if (isatty (filedes)) {
#if HAVE_TTYNAME
@ -1612,8 +1616,9 @@ binary_file(char *file_name)
}
int
Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
{
Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
{
CACHE_REGS
int sno;
Atom at;
@ -1628,7 +1633,6 @@ binary_file(char *file_name)
} else
at = AtomRead;
initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at );
UNLOCK(st->streamlock);
return sno;
}
@ -1794,8 +1798,6 @@ binary_file(char *file_name)
void
Yap_InitPlIO (void)
{
CACHE_REGS
Int i;
Yap_stdin = stdin;

2
os/iopreds.h
View File

@ -262,7 +262,7 @@ void Yap_ConsolePipeOps( StreamDesc *st );
void Yap_SocketOps( StreamDesc *st );
void Yap_ConsoleSocketOps( StreamDesc *st );
bool Yap_ReadlineOps( StreamDesc *st );
int Yap_OpenBufWriteStream(void);
int Yap_OpenBufWriteStream( USES_REGS1);
void Yap_ConsoleOps( StreamDesc *s );
void Yap_init_socks(char *host, long interface_port);

1
os/mem.c
View File

@ -252,7 +252,6 @@ Yap_open_buf_write_stream(char **nbufp, size_t *ncharsp)
}
nbuf = malloc( nchars );
if(!nbuf) {
UNLOCK(st->streamlock);
return -1;
}
}

25
os/readline.c
View File

@ -68,28 +68,19 @@ typedef struct scan_atoms {
static char *
atom_enumerate(const char *prefix, int state)
{
CACHE_REGS
struct scan_atoms *index;
Atom catom;
Int i;
#ifdef THREADS
if ( !atomgen_key ) {
pthread_key_create(&atomgen_key, NULL);
state = FALSE;
}
#endif
if ( !state )
{ index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms));
i = 0;
catom = NIL;
} else
{
#ifdef O_PLMT
index = (struct scan_atoms *)pthread_getspecific(atomgen_key);
#else
index = LOCAL_search_atoms;
#endif
CACHE_REGS
index = LOCAL_search_atoms;
catom = index->atom;
i = index->pos;
}
@ -111,11 +102,7 @@ atom_enumerate(const char *prefix, int state)
if ( strstr( ap->StrOfAE, prefix) == ap->StrOfAE) {
index->pos = i;
index->atom = ap->NextOfAE;
#ifdef O_PLMT
pthread_setspecific(atomgen_key,index);
#else
LOCAL_search_atoms = index;
#endif
READ_UNLOCK(ap->ARWLock);
return ap->StrOfAE;
}
@ -123,11 +110,7 @@ atom_enumerate(const char *prefix, int state)
READ_UNLOCK(ap->ARWLock);
}
}
#ifdef THREADS
pthread_setspecific(atomgen_key,NULL);
#else
LOCAL_search_atoms = NULL;
#endif
free(index);
return NULL;
}
@ -255,6 +238,7 @@ InitReadline(void) {
static bool
getLine( int inp, int out )
{
CACHE_REGS
rl_instream = GLOBAL_Stream[inp].file;
rl_outstream = GLOBAL_Stream[out].file;
const char *myrl_line;
@ -324,7 +308,6 @@ ReadlinePutc (int sno, int ch)
static int
ReadlineGetc(int sno)
{
CACHE_REGS
StreamDesc *s = &GLOBAL_Stream[sno];
int ch;
bool fetch = (s->u.irl.buf == NULL);

9
os/readterm.c
View File

@ -875,8 +875,7 @@ static Int nofileerrors( USES_REGS1 )
static Int style_checker( USES_REGS1 )
{
Term t = Deref( ARG1 );
CACHE_REGS
if (IsVarTerm(t)) {
Term t = TermNil;
if ( getYapFlag( MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) {
@ -922,10 +921,10 @@ static Int style_checker( USES_REGS1 )
Term
Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings)
{
CACHE_REGS
Term bvar = MkVarTerm(), ctl;
yhandle_t sl;
CACHE_REGS
if (bindings) {
ctl = Yap_MkApplTerm( Yap_MkFunctor(AtomVariableNames,1),1,&bvar);
sl = Yap_InitSlot( bvar );
@ -941,7 +940,7 @@ Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bind
Yap_CloseStream(stream);
if (bindings) {
*bindings = Yap_GetFromSlot( sl );
Yap_RecoverSlots( sl, 1 );
Yap_RecoverSlots( sl, 1 PASS_REGS);
}
return rval;
}
@ -951,7 +950,6 @@ Yap_ReadFromAtom(Atom a, Term opts)
{
Term rval;
int sno;
CACHE_REGS
if (IsWideAtom( a )) {
wchar_t *ws = a->WStrOfAE;
size_t len = wcslen(ws);
@ -972,7 +970,6 @@ readFromBuffer(const char *s, Term opts)
{
Term rval;
int sno;
CACHE_REGS
sno = Yap_open_buf_read_stream((char *)s, utf8_strlen1(s), ENC_ISO_UTF8, MEM_BUF_USER);
rval = Yap_read_term(sno, opts, 3);

3
os/streams.c
View File

@ -451,6 +451,7 @@ SetBuffering ( int sno, Atom at )
if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IONBF, 0) < 0)
return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set disable buffering");
} else {
CACHE_REGS
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_ErrorMessage = "in set_stream/2:buffer";
return false;
@ -725,7 +726,7 @@ do_set_stream (int sno, Term opts USES_REGS)
break;
case SET_STREAM_CLOSE_ON_ABORT:
rc = rc &&
SetCloseOnAbort ( sno, (args[SET_STREAM_CLOSE_ON_ABORT].tvalue == TermTrue) PASS_REGS);
SetCloseOnAbort ( sno, (args[SET_STREAM_CLOSE_ON_ABORT].tvalue == TermTrue));
break;
case SET_STREAM_ENCODING:
GLOBAL_Stream[sno]. encoding = enc_id(AtomOfTerm(args[SET_STREAM_ENCODING].tvalue)->StrOfAE);

182
packages/ProbLog/simplecudd/LICENSE
View File

@ -1,182 +0,0 @@
Artistic License 2.0
Copyright (c) 2000-2006, The Perl Foundation.
Everyone is permitted to copy and distribute verbatim copies of this
license document, but changing it is not allowed. Preamble
This license establishes the terms under which a given free software
Package may be copied, modified, distributed, and/or
redistributed. The intent is that the Copyright Holder maintains some
artistic control over the development of that Package while still
keeping the Package available as open source and free software.
You are always permitted to make arrangements wholly outside of this
license directly with the Copyright Holder of a given Package. If the
terms of this license do not permit the full use that you propose to
make of the Package, you should contact the Copyright Holder and seek
a different licensing arrangement. Definitions
"Copyright Holder" means the individual(s) or organization(s) named in
the copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other
material to the Package, in accordance with the Copyright Holder's
procedures.
"You" and "your" means any person who would like to copy, distribute,
or modify the Package.
"Package" means the collection of files distributed by the Copyright
Holder, and derivatives of that collection and/or of those files. A
given Package may consist of either the Standard Version, or a
Modified Version.
"Distribute" means providing a copy of the Package or making it
accessible to anyone else, or in the case of a company or
organization, to others outside of your company or organization.
"Distributor Fee" means any fee that you charge for Distributing this
Package or providing support for this Package to another party. It
does not mean licensing fees.
"Standard Version" refers to the Package if it has not been modified,
or has been modified only in ways explicitly requested by the
Copyright Holder.
"Modified Version" means the Package, if it has been changed, and such
changes were not explicitly requested by the Copyright Holder.
"Original License" means this Artistic License as Distributed with the
Standard Version of the Package, in its current version or as it may
be modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and
configuration files for the Package.
"Compiled" form means the compiled bytecode, object code, binary, or
any other form resulting from mechanical transformation or translation
of the Source form.
Permission for Use and Modification Without Distribution
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder of the
Standard Version, under the Original License, so that the Copyright
Holder may include your modifications in the Standard Version. (b)
ensure that installation of your Modified Version does not prevent the
user installing or running the Standard Version. In addition, the
modified Version must bear a name that is different from the name of
the Standard Version. (c) allow anyone who receives a copy of the
Modified Version to make the Source form of the Modified Version
available to others under (i) the Original License or (ii) a license
that permits the licensee to freely copy, modify and redistribute the
Modified Version using the same licensing terms that apply to the copy
that the licensee received, and requires that the Source form of the
Modified Version, and of any works derived from it, be made freely
available in that license fees are prohibited but Distributor Fees are
allowed.
Distribution of Compiled Forms of the Standard Version or Modified Versions
without the Source
(5) You may Distribute Compiled forms of the Standard Version without
the Source, provided that you include complete instructions on how to
get the Source of the Standard Version. Such instructions must be
valid at the time of your distribution. If these instructions, at any
time while you are carrying out such distribution, become invalid, you
must provide new instructions on demand or cease further
distribution. If you provide valid instructions or cease distribution
within thirty days after you become aware that the instructions are
invalid, then you do not forfeit any of your rights under this
license.
(6) You may Distribute a Modified Version in Compiled form without the
Source, provided that you comply with Section 4 with respect to the
Source of the Modified Version.
Aggregating or Linking the Package
(7) You may aggregate the Package (either the Standard Version or
Modified Version) with other packages and Distribute the resulting
aggregation provided that you do not charge a licensing fee for the
Package. Distributor Fees are permitted, and licensing fees for other
components in the aggregation are permitted. The terms of this license
apply to the use and Distribution of the Standard or Modified Versions
as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with
other works, to embed the Package in a larger work of your own, or to
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
General Provisions
(10) Any use, modification, and distribution of the Standard or
Modified Versions is governed by this Artistic License. By using,
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
(11) If your Modified Version has been derived from a Modified Version
made by someone other than you, you are nevertheless required to
ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
(14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

68
packages/ProbLog/simplecudd/Makefile.in
View File

@ -1,68 +0,0 @@
#
# default base directory for YAP installation
# (EROOT for architecture-dependent files)
#
prefix = @prefix@
exec_prefix = @exec_prefix@
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
abs_top_builddir = @abs_top_builddir@
#
# where the binary should be
#
BINDIR = $(EROOTDIR)/bin
#
# where YAP should look for libraries
#
LIBDIR=@libdir@
YAPLIBDIR=@libdir@/Yap
#
# where YAP should look for architecture-independent Prolog libraries
#
SHAREDIR=$(ROOTDIR)/share
#
#
CC=@CC@
#
#
# You shouldn't need to change what follows.
#
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
SHELL=/bin/sh
RANLIB=@RANLIB@
srcdir=@srcdir@
SO=@SO@
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
DYNAMIC =
CFLAGS = @CFLAGS@
INCLUDE = -I@abs_top_builddir@ @CUDD_CPPFLAGS@
LINKFLAGS = -lm
LINKLIBS = @CUDD_LIBS@
default: problogbdd
problogbdd: problogbdd.o simplecudd.o general.o problogmath.o
@echo Making problogbdd...
@echo Copyright Katholieke Universiteit Leuven 2008
@echo Authors: T. Mantadelis, A. Kimmig, B. Gutmann, I. Thon, G. Van den Broeck
$(CC) problogbdd.o simplecudd.o general.o problogmath.o $(LINKLIBS) $(LINKFLAGS) -o problogbdd
%.o : $(srcdir)/%.c
$(CC) $(CFLAGS) $(INCLUDE) $(DYNAMIC) -c $<
clean:
rm -f *.o problogbdd
install: default
$(INSTALL_PROGRAM) problogbdd $(DESTDIR)$(BINDIR)
install-examples:
distclean: clean
rm -f Makefile

298
packages/ProbLog/simplecudd/general.c
View File

@ -1,298 +0,0 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 *
* *
* Author: Theofrastos Mantadelis *
* File: general.c *
* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ *
* $Revision:: 4880 $ *
* *
********************************************************************************
* *
* Artistic License 2.0 *
* *
* Copyright (c) 2000-2006, The Perl Foundation. *
* *
* Everyone is permitted to copy and distribute verbatim copies of this license *
* document, but changing it is not allowed. *
* *
* Preamble *
* *
* This license establishes the terms under which a given free software Package *
* may be copied, modified, distributed, and/or redistributed. The intent is *
* that the Copyright Holder maintains some artistic control over the *
* development of that Package while still keeping the Package available as *
* open source and free software. *
* *
* You are always permitted to make arrangements wholly outside of this license *
* directly with the Copyright Holder of a given Package. If the terms of this *
* license do not permit the full use that you propose to make of the Package, *
* you should contact the Copyright Holder and seek a different licensing *
* arrangement. *
* Definitions *
* *
* "Copyright Holder" means the individual(s) or organization(s) named in the *
* copyright notice for the entire Package. *
* *
* "Contributor" means any party that has contributed code or other material to *
* the Package, in accordance with the Copyright Holder's procedures. *
* *
* "You" and "your" means any person who would like to copy, distribute, or *
* modify the Package. *
* *
* "Package" means the collection of files distributed by the Copyright Holder, *
* and derivatives of that collection and/or of those files. A given Package *
* may consist of either the Standard Version, or a Modified Version. *
* *
* "Distribute" means providing a copy of the Package or making it accessible *
* to anyone else, or in the case of a company or organization, to others *
* outside of your company or organization. *
* *
* "Distributor Fee" means any fee that you charge for Distributing this *
* Package or providing support for this Package to another party. It does not *
* mean licensing fees. *
* *
* "Standard Version" refers to the Package if it has not been modified, or has *
* been modified only in ways explicitly requested by the Copyright Holder. *
* *
* "Modified Version" means the Package, if it has been changed, and such *
* changes were not explicitly requested by the Copyright Holder. *
* *
* "Original License" means this Artistic License as Distributed with the *
* Standard Version of the Package, in its current version or as it may be *
* modified by The Perl Foundation in the future. *
* *
* "Source" form means the source code, documentation source, and configuration *
* files for the Package. *
* *
* "Compiled" form means the compiled bytecode, object code, binary, or any *
* other form resulting from mechanical transformation or translation of the *
* Source form. *
* Permission for Use and Modification Without Distribution *
* *
* (1) You are permitted to use the Standard Version and create and use *
* Modified Versions for any purpose without restriction, provided that you do *
* not Distribute the Modified Version. *
* Permissions for Redistribution of the Standard Version *
* *
* (2) You may Distribute verbatim copies of the Source form of the Standard *
* Version of this Package in any medium without restriction, either gratis or *
* for a Distributor Fee, provided that you duplicate all of the original *
* copyright notices and associated disclaimers. At your discretion, such *
* verbatim copies may or may not include a Compiled form of the Package. *
* *
* (3) You may apply any bug fixes, portability changes, and other *
* modifications made available from the Copyright Holder. The resulting *
* Package will still be considered the Standard Version, and as such will be *
* subject to the Original License. *
* Distribution of Modified Versions of the Package as Source *
* *
* (4) You may Distribute your Modified Version as Source (either gratis or for *
* a Distributor Fee, and with or without a Compiled form of the Modified *
* Version) provided that you clearly document how it differs from the Standard *
* Version, including, but not limited to, documenting any non-standard *
* features, executables, or modules, and provided that you do at least ONE of *
* the following: *
* *
* (a) make the Modified Version available to the Copyright Holder of the *
* Standard Version, under the Original License, so that the Copyright Holder *
* may include your modifications in the Standard Version. *
* (b) ensure that installation of your Modified Version does not prevent the *
* user installing or running the Standard Version. In addition, the Modified *
* Version must bear a name that is different from the name of the Standard *
* Version. *
* (c) allow anyone who receives a copy of the Modified Version to make the *
* Source form of the Modified Version available to others under *
* (i) the Original License or *
* (ii) a license that permits the licensee to freely copy, modify and *
* redistribute the Modified Version using the same licensing terms that apply *
* to the copy that the licensee received, and requires that the Source form of *
* the Modified Version, and of any works derived from it, be made freely *
* available in that license fees are prohibited but Distributor Fees are *
* allowed. *
* Distribution of Compiled Forms of the Standard Version or Modified Versions *
* without the Source *
* *
* (5) You may Distribute Compiled forms of the Standard Version without the *
* Source, provided that you include complete instructions on how to get the *
* Source of the Standard Version. Such instructions must be valid at the time *
* of your distribution. If these instructions, at any time while you are *
* carrying out such distribution, become invalid, you must provide new *
* instructions on demand or cease further distribution. If you provide valid *
* instructions or cease distribution within thirty days after you become aware *
* that the instructions are invalid, then you do not forfeit any of your *
* rights under this license. *
* *
* (6) You may Distribute a Modified Version in Compiled form without the *
* Source, provided that you comply with Section 4 with respect to the Source *
* of the Modified Version. *
* Aggregating or Linking the Package *
* *
* (7) You may aggregate the Package (either the Standard Version or Modified *
* Version) with other packages and Distribute the resulting aggregation *
* provided that you do not charge a licensing fee for the Package. Distributor *
* Fees are permitted, and licensing fees for other components in the *
* aggregation are permitted. The terms of this license apply to the use and *
* Distribution of the Standard or Modified Versions as included in the *
* aggregation. *
* *
* (8) You are permitted to link Modified and Standard Versions with other *
* works, to embed the Package in a larger work of your own, or to build *
* stand-alone binary or bytecode versions of applications that include the *
* Package, and Distribute the result without restriction, provided the result *
* does not expose a direct interface to the Package. *
* Items That are Not Considered Part of a Modified Version *
* *
* (9) Works (including, but not limited to, modules and scripts) that merely *
* extend or make use of the Package, do not, by themselves, cause the Package *
* to be a Modified Version. In addition, such works are not considered parts *
* of the Package itself, and are not subject to the terms of this license. *
* General Provisions *
* *
* (10) Any use, modification, and distribution of the Standard or Modified *
* Versions is governed by this Artistic License. By using, modifying or *
* distributing the Package, you accept this license. Do not use, modify, or *
* distribute the Package, if you do not accept this license. *
* *
* (11) If your Modified Version has been derived from a Modified Version made *
* by someone other than you, you are nevertheless required to ensure that your *
* Modified Version complies with the requirements of this license. *
* *
* (12) This license does not grant you the right to use any trademark, service *
* mark, tradename, or logo of the Copyright Holder. *
* *
* (13) This license includes the non-exclusive, worldwide, free-of-charge *
* patent license to make, have made, use, offer to sell, sell, import and *
* otherwise transfer the Package with respect to any patent claims licensable *
* by the Copyright Holder that are necessarily infringed by the Package. If *
* you institute patent litigation (including a cross-claim or counterclaim) *
* against any party alleging that the Package constitutes direct or *
* contributory patent infringement, then this Artistic License to you shall *
* terminate on the date that such litigation is filed. *
* *
* (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER *
* AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE *
* IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR *
* NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. *
* UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE *
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN *
* ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF *
* SUCH DAMAGE. *
* *
* The End *
* *
\******************************************************************************/
#include "general.h"
/* Number Handling */
int getRealNumber(char *c, double *number) {
char *unparsed_string;
errno = 0;
*number = strtod(c, &unparsed_string);
return !(errno == ERANGE || unparsed_string == c || *unparsed_string != '\0');
}
int getIntNumber(char *c, int *number) {
char *unparsed_string;
errno = 0;
long int numberl = strtol(c, &unparsed_string, 10);
*number = (int) numberl;
return !(errno == ERANGE || unparsed_string == c || *unparsed_string != '\0' || numberl > INT_MAX || numberl < INT_MIN);
}
inline int getPosNumber(char *c, int *number) {
return (getIntNumber(c, number) && *number >= 0);
}
int IsRealNumber(char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (c[i] == '.') return IsPosNumber(&c[i + 1]);
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
int IsPosNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
for(i = 0; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return 1;
}
int IsNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
/* File Handling */
char * freadstr(FILE *fd, const char *separators) {
char *str;
int buf, icur = 0, max = 10;
str = (char *) malloc(sizeof(char) * max);
str[0] = '\0';
do {
if ((buf = fgetc(fd)) != EOF) {
if (icur == (max - 1)) {
max = max * 2;
str = (char *) realloc(str, sizeof(char) * max);
}
if (!CharIn((char) buf, separators)) {
str[icur] = (char) buf;
icur++;
str[icur] = '\0';
}
}
} while(!CharIn(buf, separators) && !feof(fd));
return str;
}
int CharIn(const char c, const char *in) {
int i;
for (i = 0; i < strlen(in); i++)
if (c == in[i]) return 1;
return 0;
}
/* string handling */
int patternmatch(char *pattern, char *thestr) {
int i, j = -1, pl = strlen(pattern), sl = strlen(thestr);
for(i = 0; i < pl; i++) {
if (pattern[i] == '*') {
do {
i++;
if (i == pl) return 1;
} while(pattern[i] == '*');
do {
j++;
if (j >= sl) return 0;
if ((thestr[j] == pattern[i]) && patternmatch(pattern + i, thestr + j)) return 1;
} while(1);
} else {
j++;
if (j >= sl) return 0;
if (pattern[i] != thestr[j]) return 0;
}
}
return (pl == sl);
}

209
packages/ProbLog/simplecudd/general.h
View File

@ -1,209 +0,0 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 *
* *
* Author: Theofrastos Mantadelis *
* File: general.h *
* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ *
* $Revision:: 4880 $ *
* *
********************************************************************************
* *
* Artistic License 2.0 *
* *
* Copyright (c) 2000-2006, The Perl Foundation. *
* *
* Everyone is permitted to copy and distribute verbatim copies of this license *
* document, but changing it is not allowed. *
* *
* Preamble *
* *
* This license establishes the terms under which a given free software Package *
* may be copied, modified, distributed, and/or redistributed. The intent is *
* that the Copyright Holder maintains some artistic control over the *
* development of that Package while still keeping the Package available as *
* open source and free software. *
* *
* You are always permitted to make arrangements wholly outside of this license *
* directly with the Copyright Holder of a given Package. If the terms of this *
* license do not permit the full use that you propose to make of the Package, *
* you should contact the Copyright Holder and seek a different licensing *
* arrangement. *
* Definitions *
* *
* "Copyright Holder" means the individual(s) or organization(s) named in the *
* copyright notice for the entire Package. *
* *
* "Contributor" means any party that has contributed code or other material to *
* the Package, in accordance with the Copyright Holder's procedures. *
* *
* "You" and "your" means any person who would like to copy, distribute, or *
* modify the Package. *
* *
* "Package" means the collection of files distributed by the Copyright Holder, *
* and derivatives of that collection and/or of those files. A given Package *
* may consist of either the Standard Version, or a Modified Version. *
* *
* "Distribute" means providing a copy of the Package or making it accessible *
* to anyone else, or in the case of a company or organization, to others *
* outside of your company or organization. *
* *
* "Distributor Fee" means any fee that you charge for Distributing this *
* Package or providing support for this Package to another party. It does not *
* mean licensing fees. *
* *
* "Standard Version" refers to the Package if it has not been modified, or has *
* been modified only in ways explicitly requested by the Copyright Holder. *
* *
* "Modified Version" means the Package, if it has been changed, and such *
* changes were not explicitly requested by the Copyright Holder. *
* *
* "Original License" means this Artistic License as Distributed with the *
* Standard Version of the Package, in its current version or as it may be *
* modified by The Perl Foundation in the future. *
* *
* "Source" form means the source code, documentation source, and configuration *
* files for the Package. *
* *
* "Compiled" form means the compiled bytecode, object code, binary, or any *
* other form resulting from mechanical transformation or translation of the *
* Source form. *
* Permission for Use and Modification Without Distribution *
* *
* (1) You are permitted to use the Standard Version and create and use *
* Modified Versions for any purpose without restriction, provided that you do *
* not Distribute the Modified Version. *
* Permissions for Redistribution of the Standard Version *
* *
* (2) You may Distribute verbatim copies of the Source form of the Standard *
* Version of this Package in any medium without restriction, either gratis or *
* for a Distributor Fee, provided that you duplicate all of the original *
* copyright notices and associated disclaimers. At your discretion, such *
* verbatim copies may or may not include a Compiled form of the Package. *
* *
* (3) You may apply any bug fixes, portability changes, and other *
* modifications made available from the Copyright Holder. The resulting *
* Package will still be considered the Standard Version, and as such will be *
* subject to the Original License. *
* Distribution of Modified Versions of the Package as Source *
* *
* (4) You may Distribute your Modified Version as Source (either gratis or for *
* a Distributor Fee, and with or without a Compiled form of the Modified *
* Version) provided that you clearly document how it differs from the Standard *
* Version, including, but not limited to, documenting any non-standard *
* features, executables, or modules, and provided that you do at least ONE of *
* the following: *
* *
* (a) make the Modified Version available to the Copyright Holder of the *
* Standard Version, under the Original License, so that the Copyright Holder *
* may include your modifications in the Standard Version. *
* (b) ensure that installation of your Modified Version does not prevent the *
* user installing or running the Standard Version. In addition, the Modified *
* Version must bear a name that is different from the name of the Standard *
* Version. *
* (c) allow anyone who receives a copy of the Modified Version to make the *
* Source form of the Modified Version available to others under *
* (i) the Original License or *
* (ii) a license that permits the licensee to freely copy, modify and *
* redistribute the Modified Version using the same licensing terms that apply *
* to the copy that the licensee received, and requires that the Source form of *
* the Modified Version, and of any works derived from it, be made freely *
* available in that license fees are prohibited but Distributor Fees are *
* allowed. *
* Distribution of Compiled Forms of the Standard Version or Modified Versions *
* without the Source *
* *
* (5) You may Distribute Compiled forms of the Standard Version without the *
* Source, provided that you include complete instructions on how to get the *
* Source of the Standard Version. Such instructions must be valid at the time *
* of your distribution. If these instructions, at any time while you are *
* carrying out such distribution, become invalid, you must provide new *
* instructions on demand or cease further distribution. If you provide valid *
* instructions or cease distribution within thirty days after you become aware *
* that the instructions are invalid, then you do not forfeit any of your *
* rights under this license. *
* *
* (6) You may Distribute a Modified Version in Compiled form without the *
* Source, provided that you comply with Section 4 with respect to the Source *
* of the Modified Version. *
* Aggregating or Linking the Package *
* *
* (7) You may aggregate the Package (either the Standard Version or Modified *
* Version) with other packages and Distribute the resulting aggregation *
* provided that you do not charge a licensing fee for the Package. Distributor *
* Fees are permitted, and licensing fees for other components in the *
* aggregation are permitted. The terms of this license apply to the use and *
* Distribution of the Standard or Modified Versions as included in the *
* aggregation. *
* *
* (8) You are permitted to link Modified and Standard Versions with other *
* works, to embed the Package in a larger work of your own, or to build *
* stand-alone binary or bytecode versions of applications that include the *
* Package, and Distribute the result without restriction, provided the result *
* does not expose a direct interface to the Package. *
* Items That are Not Considered Part of a Modified Version *
* *
* (9) Works (including, but not limited to, modules and scripts) that merely *
* extend or make use of the Package, do not, by themselves, cause the Package *
* to be a Modified Version. In addition, such works are not considered parts *
* of the Package itself, and are not subject to the terms of this license. *
* General Provisions *
* *
* (10) Any use, modification, and distribution of the Standard or Modified *
* Versions is governed by this Artistic License. By using, modifying or *
* distributing the Package, you accept this license. Do not use, modify, or *
* distribute the Package, if you do not accept this license. *
* *
* (11) If your Modified Version has been derived from a Modified Version made *
* by someone other than you, you are nevertheless required to ensure that your *
* Modified Version complies with the requirements of this license. *
* *
* (12) This license does not grant you the right to use any trademark, service *
* mark, tradename, or logo of the Copyright Holder. *
* *
* (13) This license includes the non-exclusive, worldwide, free-of-charge *
* patent license to make, have made, use, offer to sell, sell, import and *
* otherwise transfer the Package with respect to any patent claims licensable *
* by the Copyright Holder that are necessarily infringed by the Package. If *
* you institute patent litigation (including a cross-claim or counterclaim) *
* against any party alleging that the Package constitutes direct or *
* contributory patent infringement, then this Artistic License to you shall *
* terminate on the date that such litigation is filed. *
* *
* (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER *
* AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE *
* IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR *
* NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. *
* UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE *
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN *
* ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF *
* SUCH DAMAGE. *
* *
* The End *
* *
\******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <limits.h>
#define IsNumberDigit(c) ('0' <= c && c <= '9')
#define IsSignDigit(c) (c == '+' || c == '-')
#define isOperator(x) (x == '+' || x == '*' || x == '#' || x == '=')
#define freadline(fd) freadstr(fd, "\n");
int getRealNumber(char *c, double *number);
int getIntNumber(char *c, int *number);
inline int getPosNumber(char *c, int *number);
int IsRealNumber(char *c);
int IsPosNumber(const char *c);
int IsNumber(const char *c);
char * freadstr(FILE *fd, const char *separators);
int CharIn(const char c, const char *in);
int patternmatch(char *pattern, char *thestr);

1980
packages/ProbLog/simplecudd/problogbdd.c
View File

File diff suppressed because it is too large Load Diff

347
packages/ProbLog/simplecudd/problogmath.c
View File

@ -1,347 +0,0 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 *
* *
* Author: Bernd Gutmann *
* File: problogmath.c *
* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ *
* $Revision:: 5159 $ *
* *
********************************************************************************
* *
* Artistic License 2.0 *
* *
* Copyright (c) 2000-2006, The Perl Foundation. *
* *
* Everyone is permitted to copy and distribute verbatim copies of this license *
* document, but changing it is not allowed. *
* *
* Preamble *
* *
* This license establishes the terms under which a given free software Package *
* may be copied, modified, distributed, and/or redistributed. The intent is *
* that the Copyright Holder maintains some artistic control over the *
* development of that Package while still keeping the Package available as *
* open source and free software. *
* *
* You are always permitted to make arrangements wholly outside of this license *
* directly with the Copyright Holder of a given Package. If the terms of this *
* license do not permit the full use that you propose to make of the Package, *
* you should contact the Copyright Holder and seek a different licensing *
* arrangement. *
* Definitions *
* *
* "Copyright Holder" means the individual(s) or organization(s) named in the *
* copyright notice for the entire Package. *
* *
* "Contributor" means any party that has contributed code or other material to *
* the Package, in accordance with the Copyright Holder's procedures. *
* *
* "You" and "your" means any person who would like to copy, distribute, or *
* modify the Package. *
* *
* "Package" means the collection of files distributed by the Copyright Holder, *
* and derivatives of that collection and/or of those files. A given Package *
* may consist of either the Standard Version, or a Modified Version. *
* *
* "Distribute" means providing a copy of the Package or making it accessible *
* to anyone else, or in the case of a company or organization, to others *
* outside of your company or organization. *
* *
* "Distributor Fee" means any fee that you charge for Distributing this *
* Package or providing support for this Package to another party. It does not *
* mean licensing fees. *
* *
* "Standard Version" refers to the Package if it has not been modified, or has *
* been modified only in ways explicitly requested by the Copyright Holder. *
* *
* "Modified Version" means the Package, if it has been changed, and such *
* changes were not explicitly requested by the Copyright Holder. *
* *
* "Original License" means this Artistic License as Distributed with the *
* Standard Version of the Package, in its current version or as it may be *
* modified by The Perl Foundation in the future. *
* *
* "Source" form means the source code, documentation source, and configuration *
* files for the Package. *
* *
* "Compiled" form means the compiled bytecode, object code, binary, or any *
* other form resulting from mechanical transformation or translation of the *
* Source form. *
* Permission for Use and Modification Without Distribution *
* *
* (1) You are permitted to use the Standard Version and create and use *
* Modified Versions for any purpose without restriction, provided that you do *
* not Distribute the Modified Version. *
* Permissions for Redistribution of the Standard Version *
* *
* (2) You may Distribute verbatim copies of the Source form of the Standard *
* Version of this Package in any medium without restriction, either gratis or *
* for a Distributor Fee, provided that you duplicate all of the original *
* copyright notices and associated disclaimers. At your discretion, such *
* verbatim copies may or may not include a Compiled form of the Package. *
* *
* (3) You may apply any bug fixes, portability changes, and other *
* modifications made available from the Copyright Holder. The resulting *
* Package will still be considered the Standard Version, and as such will be *
* subject to the Original License. *
* Distribution of Modified Versions of the Package as Source *
* *
* (4) You may Distribute your Modified Version as Source (either gratis or for *
* a Distributor Fee, and with or without a Compiled form of the Modified *
* Version) provided that you clearly document how it differs from the Standard *
* Version, including, but not limited to, documenting any non-standard *
* features, executables, or modules, and provided that you do at least ONE of *
* the following: *
* *
* (a) make the Modified Version available to the Copyright Holder of the *
* Standard Version, under the Original License, so that the Copyright Holder *
* may include your modifications in the Standard Version. *
* (b) ensure that installation of your Modified Version does not prevent the *
* user installing or running the Standard Version. In addition, the Modified *
* Version must bear a name that is different from the name of the Standard *
* Version. *
* (c) allow anyone who receives a copy of the Modified Version to make the *
* Source form of the Modified Version available to others under *
* (i) the Original License or *
* (ii) a license that permits the licensee to freely copy, modify and *
* redistribute the Modified Version using the same licensing terms that apply *
* to the copy that the licensee received, and requires that the Source form of *
* the Modified Version, and of any works derived from it, be made freely *
* available in that license fees are prohibited but Distributor Fees are *
* allowed. *
* Distribution of Compiled Forms of the Standard Version or Modified Versions *
* without the Source *
* *
* (5) You may Distribute Compiled forms of the Standard Version without the *
* Source, provided that you include complete instructions on how to get the *
* Source of the Standard Version. Such instructions must be valid at the time *
* of your distribution. If these instructions, at any time while you are *
* carrying out such distribution, become invalid, you must provide new *
* instructions on demand or cease further distribution. If you provide valid *
* instructions or cease distribution within thirty days after you become aware *
* that the instructions are invalid, then you do not forfeit any of your *
* rights under this license. *
* *
* (6) You may Distribute a Modified Version in Compiled form without the *
* Source, provided that you comply with Section 4 with respect to the Source *
* of the Modified Version. *
* Aggregating or Linking the Package *
* *
* (7) You may aggregate the Package (either the Standard Version or Modified *
* Version) with other packages and Distribute the resulting aggregation *
* provided that you do not charge a licensing fee for the Package. Distributor *
* Fees are permitted, and licensing fees for other components in the *
* aggregation are permitted. The terms of this license apply to the use and *
* Distribution of the Standard or Modified Versions as included in the *
* aggregation. *
* *
* (8) You are permitted to link Modified and Standard Versions with other *
* works, to embed the Package in a larger work of your own, or to build *
* stand-alone binary or bytecode versions of applications that include the *
* Package, and Distribute the result without restriction, provided the result *
* does not expose a direct interface to the Package. *
* Items That are Not Considered Part of a Modified Version *
* *
* (9) Works (including, but not limited to, modules and scripts) that merely *
* extend or make use of the Package, do not, by themselves, cause the Package *
* to be a Modified Version. In addition, such works are not considered parts *
* of the Package itself, and are not subject to the terms of this license. *
* General Provisions *
* *
* (10) Any use, modification, and distribution of the Standard or Modified *
* Versions is governed by this Artistic License. By using, modifying or *
* distributing the Package, you accept this license. Do not use, modify, or *
* distribute the Package, if you do not accept this license. *
* *
* (11) If your Modified Version has been derived from a Modified Version made *
* by someone other than you, you are nevertheless required to ensure that your *
* Modified Version complies with the requirements of this license. *
* *
* (12) This license does not grant you the right to use any trademark, service *
* mark, tradename, or logo of the Copyright Holder. *
* *
* (13) This license includes the non-exclusive, worldwide, free-of-charge *
* patent license to make, have made, use, offer to sell, sell, import and *
* otherwise transfer the Package with respect to any patent claims licensable *
* by the Copyright Holder that are necessarily infringed by the Package. If *
* you institute patent litigation (including a cross-claim or counterclaim) *
* against any party alleging that the Package constitutes direct or *
* contributory patent infringement, then this Artistic License to you shall *
* terminate on the date that such litigation is filed. *
* *
* (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER *
* AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE *
* IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR *
* NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. *
* UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE *
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN *
* ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF *
* SUCH DAMAGE. *
* *
* The End *
* *
\******************************************************************************/
#include "problogmath.h"
#include "general.h"
double sigmoid(double x, double slope) {
return 1.0 / (1.0 + exp(-x * slope));
}
// This function calculates the accumulated density of the normal distribution
// For details see G. Marsaglia, Evaluating the Normal Distribution, Journal of Statistical Software, 2004:11(4).
double Phi(double x) {
double s=x;
double t=0.0;
double b=x;
double q=x*x;
double i=1;
// if the value is too small or too big, return
// 0/1 to avoid long computations
if (x < -10.0) {
return 0.0;
}
if (x > 10.0) {
return 1.0;
}
// t is the value from last iteration
// s is the value from the current iteration
// iterate until they are equal
while(fabs(s-t) >= DBL_MIN) {
t=s;
i+=2;
b*=q/i;
s+=b;
}
return 0.5+s*exp(-0.5*q-0.91893853320467274178);
}
// integrates the normal distribution over [low,high]
double cumulative_normal(double low, double high, double mu, double sigma) {
return Phi((high-mu)/sigma) - Phi((low-mu)/sigma);
}
// integrates the normal distribution over [-oo,high]
double cumulative_normal_upper(double high, double mu, double sigma) {
return Phi((high-mu)/sigma);
}
// evaluates the density of the normal distribution
double normal(double x, double mu,double sigma) {
double inner=(x-mu)/sigma;
double denom=sigma*sqrt(2*3.14159265358979323846);
return exp(-inner*inner/2)/denom;
}
double cumulative_normal_dmu(double low, double high,double mu,double sigma) {
return normal(low,mu,sigma) - normal(high,mu,sigma);
}
double cumulative_normal_upper_dmu(double high,double mu,double sigma) {
return - normal(high,mu,sigma);
}
double cumulative_normal_dsigma(double low, double high,double mu,double sigma) {
return (((mu-high)*normal(high,mu,sigma) - (mu-low)*normal(low,mu,sigma))/sigma);
}
double cumulative_normal_upper_dsigma(double high,double mu,double sigma) {
return (mu-high)*normal(high,mu,sigma);
}
// this function parses two strings "$a;$b" and "???_???l$ch$d" where $a-$d are (real) numbers
// it is used to parse in the parameters of continues variables from the input file
density_integral parse_density_integral_string(char *input, char *variablename) {
density_integral result;
double sigma;
int i;
char garbage[64], s1[64],s2[64],s3[64],s4[64];
if(sscanf(input, "%64[^;];%64[^;]", s1,s2) != 2) {
fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "The string should contain 2 fields seperated by ; characters.\n");
exit(EXIT_FAILURE);
}
if (!getRealNumber(s1, &result.mu)) {
fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "%s is not a number\n",s1);
exit(EXIT_FAILURE);
}
if (!getRealNumber(s2, &sigma) || sigma<=0.0) {
fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "%s is not a number\n",s2);
exit(EXIT_FAILURE);
}
result.log_sigma=log(sigma);
/* if (result.sigma<=0) { */
/* fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string",input); */
/* fprintf(stderr, "The value for sigma has to be larger than 0.\n"); */
/* exit(EXIT_FAILURE); */
/* } */
if (sscanf(variablename,"%64[^lh]l%64[^lh]h%64[^lh]",garbage,s3,s4) != 3) {
fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",variablename);
fprintf(stderr, "The string should contain 2 fields seperated by ; characters.\n");
exit(EXIT_FAILURE);
}
// replace the d by . in s1 and s2
for(i=0; s3[i]!='\0' ; i++) {
if (s3[i]=='d') {
s3[i]='.';
}
if (s3[i]=='m') {
s3[i]='-';
}
}
for(i=0; s4[i]!='\0' ; i++) {
if (s4[i]=='d') {
s4[i]='.';
}
if (s4[i]=='m') {
s4[i]='-';
}
}
if (!getRealNumber(s3, &result.low)) {
fprintf(stderr, "Error at parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "%s is not a number\n",s1);
exit(EXIT_FAILURE);
}
if (!getRealNumber(s4, &result.high)) {
fprintf(stderr, "Error ar parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "%s is not a number\n",s1);
exit(EXIT_FAILURE);
}
if (result.low>result.high) {
fprintf(stderr, "Error ar parsing the string %s in the function parse_density_integral_string\n",input);
fprintf(stderr, "The value for low has to be larger than then value for high.\n");
fprintf(stderr, " was [%f, %f]\n",result.low, result.high);
fprintf(stderr, " input %s \n",input);
fprintf(stderr, " variablename %s \n",variablename);
exit(EXIT_FAILURE);
}
return result;
}

217
packages/ProbLog/simplecudd/problogmath.h
View File

@ -1,217 +0,0 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright Katholieke Universiteit Leuven 2008, 2009, 2010 *
* *
* Author: Bernd Gutmann *
* File: problogmath.h *
* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ *
* $Revision:: 5159 $ *
* *
********************************************************************************
* *
* Artistic License 2.0 *
* *
* Copyright (c) 2000-2006, The Perl Foundation. *
* *
* Everyone is permitted to copy and distribute verbatim copies of this license *
* document, but changing it is not allowed. *
* *
* Preamble *
* *
* This license establishes the terms under which a given free software Package *
* may be copied, modified, distributed, and/or redistributed. The intent is *
* that the Copyright Holder maintains some artistic control over the *
* development of that Package while still keeping the Package available as *
* open source and free software. *
* *
* You are always permitted to make arrangements wholly outside of this license *
* directly with the Copyright Holder of a given Package. If the terms of this *
* license do not permit the full use that you propose to make of the Package, *
* you should contact the Copyright Holder and seek a different licensing *
* arrangement. *
* Definitions *
* *
* "Copyright Holder" means the individual(s) or organization(s) named in the *
* copyright notice for the entire Package. *
* *
* "Contributor" means any party that has contributed code or other material to *
* the Package, in accordance with the Copyright Holder's procedures. *
* *
* "You" and "your" means any person who would like to copy, distribute, or *
* modify the Package. *
* *
* "Package" means the collection of files distributed by the Copyright Holder, *
* and derivatives of that collection and/or of those files. A given Package *
* may consist of either the Standard Version, or a Modified Version. *
* *
* "Distribute" means providing a copy of the Package or making it accessible *
* to anyone else, or in the case of a company or organization, to others *
* outside of your company or organization. *
* *
* "Distributor Fee" means any fee that you charge for Distributing this *
* Package or providing support for this Package to another party. It does not *
* mean licensing fees. *
* *
* "Standard Version" refers to the Package if it has not been modified, or has *
* been modified only in ways explicitly requested by the Copyright Holder. *
* *
* "Modified Version" means the Package, if it has been changed, and such *
* changes were not explicitly requested by the Copyright Holder. *
* *
* "Original License" means this Artistic License as Distributed with the *
* Standard Version of the Package, in its current version or as it may be *
* modified by The Perl Foundation in the future. *
* *
* "Source" form means the source code, documentation source, and configuration *
* files for the Package. *
* *
* "Compiled" form means the compiled bytecode, object code, binary, or any *
* other form resulting from mechanical transformation or translation of the *
* Source form. *
* Permission for Use and Modification Without Distribution *
* *
* (1) You are permitted to use the Standard Version and create and use *
* Modified Versions for any purpose without restriction, provided that you do *
* not Distribute the Modified Version. *
* Permissions for Redistribution of the Standard Version *
* *
* (2) You may Distribute verbatim copies of the Source form of the Standard *
* Version of this Package in any medium without restriction, either gratis or *
* for a Distributor Fee, provided that you duplicate all of the original *
* copyright notices and associated disclaimers. At your discretion, such *
* verbatim copies may or may not include a Compiled form of the Package. *
* *
* (3) You may apply any bug fixes, portability changes, and other *
* modifications made available from the Copyright Holder. The resulting *
* Package will still be considered the Standard Version, and as such will be *
* subject to the Original License. *
* Distribution of Modified Versions of the Package as Source *
* *
* (4) You may Distribute your Modified Version as Source (either gratis or for *
* a Distributor Fee, and with or without a Compiled form of the Modified *
* Version) provided that you clearly document how it differs from the Standard *
* Version, including, but not limited to, documenting any non-standard *
* features, executables, or modules, and provided that you do at least ONE of *
* the following: *
* *
* (a) make the Modified Version available to the Copyright Holder of the *
* Standard Version, under the Original License, so that the Copyright Holder *
* may include your modifications in the Standard Version. *
* (b) ensure that installation of your Modified Version does not prevent the *
* user installing or running the Standard Version. In addition, the Modified *
* Version must bear a name that is different from the name of the Standard *
* Version. *
* (c) allow anyone who receives a copy of the Modified Version to make the *
* Source form of the Modified Version available to others under *
* (i) the Original License or *
* (ii) a license that permits the licensee to freely copy, modify and *
* redistribute the Modified Version using the same licensing terms that apply *
* to the copy that the licensee received, and requires that the Source form of *
* the Modified Version, and of any works derived from it, be made freely *
* available in that license fees are prohibited but Distributor Fees are *
* allowed. *
* Distribution of Compiled Forms of the Standard Version or Modified Versions *
* without the Source *
* *
* (5) You may Distribute Compiled forms of the Standard Version without the *
* Source, provided that you include complete instructions on how to get the *
* Source of the Standard Version. Such instructions must be valid at the time *
* of your distribution. If these instructions, at any time while you are *
* carrying out such distribution, become invalid, you must provide new *
* instructions on demand or cease further distribution. If you provide valid *
* instructions or cease distribution within thirty days after you become aware *
* that the instructions are invalid, then you do not forfeit any of your *
* rights under this license. *
* *
* (6) You may Distribute a Modified Version in Compiled form without the *
* Source, provided that you comply with Section 4 with respect to the Source *
* of the Modified Version. *
* Aggregating or Linking the Package *
* *
* (7) You may aggregate the Package (either the Standard Version or Modified *
* Version) with other packages and Distribute the resulting aggregation *
* provided that you do not charge a licensing fee for the Package. Distributor *
* Fees are permitted, and licensing fees for other components in the *
* aggregation are permitted. The terms of this license apply to the use and *
* Distribution of the Standard or Modified Versions as included in the *
* aggregation. *
* *
* (8) You are permitted to link Modified and Standard Versions with other *
* works, to embed the Package in a larger work of your own, or to build *
* stand-alone binary or bytecode versions of applications that include the *
* Package, and Distribute the result without restriction, provided the result *
* does not expose a direct interface to the Package. *
* Items That are Not Considered Part of a Modified Version *
* *
* (9) Works (including, but not limited to, modules and scripts) that merely *
* extend or make use of the Package, do not, by themselves, cause the Package *
* to be a Modified Version. In addition, such works are not considered parts *
* of the Package itself, and are not subject to the terms of this license. *
* General Provisions *
* *
* (10) Any use, modification, and distribution of the Standard or Modified *
* Versions is governed by this Artistic License. By using, modifying or *
* distributing the Package, you accept this license. Do not use, modify, or *
* distribute the Package, if you do not accept this license. *
* *
* (11) If your Modified Version has been derived from a Modified Version made *
* by someone other than you, you are nevertheless required to ensure that your *
* Modified Version complies with the requirements of this license. *
* *
* (12) This license does not grant you the right to use any trademark, service *
* mark, tradename, or logo of the Copyright Holder. *
* *
* (13) This license includes the non-exclusive, worldwide, free-of-charge *
* patent license to make, have made, use, offer to sell, sell, import and *
* otherwise transfer the Package with respect to any patent claims licensable *
* by the Copyright Holder that are necessarily infringed by the Package. If *
* you institute patent litigation (including a cross-claim or counterclaim) *
* against any party alleging that the Package constitutes direct or *
* contributory patent infringement, then this Artistic License to you shall *
* terminate on the date that such litigation is filed. *
* *
* (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER *
* AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE *
* IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR *
* NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. *
* UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE *
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN *
* ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF *
* SUCH DAMAGE. *
* *
* The End *
* *
\******************************************************************************/
#include <math.h>
#include <float.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
typedef struct _density_integral {
double low;
double high;
double mu;
double log_sigma;
} density_integral;
double sigmoid(double x, double slope);
double Phi(double x);
double cumulative_normal(double low, double high, double sigma, double mu);
double cumulative_normal_dmu(double low, double high,double mu,double sigma);
double cumulative_normal_dsigma(double low, double high,double mu,double sigma);
double cumulative_normal_upper(double high, double mu, double sigma);
double cumulative_normal_upper_dsigma(double high,double mu,double sigma);
double cumulative_normal_upper_dmu(double high,double mu,double sigma);
double normal(double x, double mu,double sigma);
density_integral parse_density_integral_string(char *input, char *variablename);

66
packages/ProbLog/simplecudd_lfi/iqueue.h
View File

@ -1,66 +0,0 @@
/******************************************************************
**
** IQUEUE.H:
**
** ADT Queue Iterator Implementation
**
** This file is part of Apt Abstract Data Types (ADT)
** Copyright (c) 1991 -- Apt Technologies
** All rights reserved
**
******************************************************************/
#ifndef IQUEUE_H
#define IQUEUE_H
/* ---------- Headers */
#include "pqueue.h"
/* ---------- Types */
typedef struct _QueueIterator {
int position;
Queue queue;
QueueItem currentItem, previousItem;
} _QueueIterator, *QueueIterator;
/* ---------- Exported Function Prototypes */
#ifdef __ANSI_C__
QueueIterator QueueIteratorNew(Queue,int);
void QueueIteratorDispose(QueueIterator);
int QueueIteratorAtTop(QueueIterator);
int QueueIteratorAtBottom(QueueIterator);
int QueueIteratorAtPosition(QueueIterator,int);
int QueueIteratorPosition(QueueIterator);
void *QueueIteratorCurrentData(QueueIterator);
void *QueueIteratorPreviousData(QueueIterator);
void QueueIteratorAdvance(QueueIterator);
void QueueIteratorBackup(QueueIterator);
void QueueIteratorAbsoluteSeek(QueueIterator,int);
void QueueIteratorRelativeSeek(QueueIterator,int);
#else
QueueIterator QueueIteratorNew();
void QueueIteratorDispose();
int QueueIteratorAtTop();
int QueueIteratorAtBottom();
int QueueIteratorAtPosition();
int QueueIteratorPosition();
void *QueueIteratorCurrentData();
void *QueueIteratorPreviousData();
void QueueIteratorAdvance();
void QueueIteratorBackup();
void QueueIteratorAbsoluteSeek();
void QueueIteratorRelativeSeek();
#endif /* __ANSI_C__ */
#endif /* QUEUE_H */

47
packages/cuda/CMakeLists.txt
View File

@ -3,7 +3,7 @@
macro_optional_find_package (CUDA ON)
macro_log_feature (CUDA_FOUND "CUDA"
"CUDA GGPU Programming "
"http://www.r.org" FALSE)
"http://www.nvidia.com/object/cuda_home_new.html" FALSE)
if (CUDA_FOUND)
# CUDA_VERSION_MAJOR -- The major version of cuda as reported by nvcc.
@ -50,6 +50,51 @@ if (CUDA_FOUND)
# CUDA_nvcuvid_LIBRARY -- CUDA Video Decoder library.
# Only available for CUDA version 3.2+.
# Windows only.
#
macro_optional_find_package (FindThrust ON)
set (CUDA_SOURCES
lista.cu
memory.cu
cuda.c
)
set (PL_SOURCES
cuda.yap
)
cuda_add_library (libcuda SHARED ${CUDA_SOURCES})
target_link_libraries(libcuda libYap
${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} ${CUDA_nppc_LIBRARY}
stdc++ )
if( THRUST_INCLUDE_DIR )
list( REMOVE_DUPLICATES THRUST_INCLUDE_DIR )
include_directories( ${THRUST_INCLUDE_DIR} )
endif( THRUST_INCLUDE_DIR )
set(CUDA_ATTACH_VS_BUILD_RULE_TO_CUDA_FILE ON)
#set(BUILD_SHARED_LIBS OFF)
set(CUDA_SEPARABLE_COMPILATION ON)
#list(APPEND CUDA_NVCC_FLAGS -arch=sm_20)
set_target_properties (libcuda PROPERTIES PREFIX "")
include_directories (${CUDA_INCLUDE_DIRS}
${CMAKE_CURRENT_SOURCE_DIR}
)
install(TARGETS libcuda
LIBRARY DESTINATION ${dlls}
)
install(FILES ${PL_SOURCES}
DESTINATION ${libpl}
)
endif (CUDA_FOUND)

4
packages/cuda/Makefile.in
View File

@ -39,7 +39,7 @@ SO=@SO@
CWD=$(PWD)
#
BDD_PROLOG= \
CUDA_PROLOG= \
$(srcdir)/cuda.yap
OBJS=cuda.o memory.o lista.o
@ -64,7 +64,7 @@ memory.o: $(srcdir)/memory.cu $(srcdir)/pred.h
install: all install-examples
mkdir -p $(DESTDIR)$(SHAREDIR)
for h in $(BDD_PROLOG); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
for h in $(CUDA_PROLOG); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
install-examples:

2
packages/jpl

@ -1 +1 @@
Subproject commit 9b727827845bf5cf309b831c7372715b07412931
Subproject commit 8b043d9f8261e701723d7e75391dcb99937206d5

2
packages/raptor

@ -1 +1 @@
Subproject commit b36fdac2281b7eef141095375d81456410dbcd2f
Subproject commit 8dbcba9ff8f87abba5db6e65aaeaad7ad1b383f2

2
packages/real

@ -1 +1 @@
Subproject commit 09c8bd21fbbf611ef1164b59b645af2c5ff6c307
Subproject commit e0e072ad7fbe7558e69197135cc657a02365224a

8
pl/CMakeLists.txt
View File

@ -53,21 +53,21 @@ set(PL_SOURCES
yio.yap
)
add_custom_target (${YAP_STARTUP} ALL DEPENDS ${PL_SOURCES} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
add_custom_target (${YAP_STARTUP} ALL SOURCES ${PL_SOURCES} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
# create a startup.yss on the top directory.
add_custom_command (TARGET ${YAP_STARTUP}
COMMAND yap-bin -b ${CMAKE_SOURCE_DIR}/pl/boot.yap -L ${CMAKE_SOURCE_DIR}/pl/init.yap -z qend_program
VERBATIM
WORKING_DIRECTORY ${CMAKE_TOP_BINARY_DIR}
DEPENDS yap-bin
DEPENDS yap-bin ${PL_SOURCES}
USES_TERMINAL
)
install (FILES ${PL_SOURCES}
DESTINATION ${libpl}/boot
)
install (FILES ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP}
DESTINATION ${dlls}
)

55
pl/absf.yap
View File

@ -21,7 +21,6 @@
variables and registry information to search for files.
**/
:- system_module( absolute_file_name, [absolute_file_name/2,
absolute_file_name/3,
add_to_path/1,
@ -138,16 +137,23 @@ absolute_file_name(File0,File) :-
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
'$do_error'(instantiation_error, G).
'$absolute_file_name'(File,Opts,TrueFileName, G) :-
current_prolog_flag( fileerrors, PreviousFileErrors ),
'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
( FErrors = fail ->
set_prolog_flag( fileerrors, false )
;
set_prolog_flag( fileerrors, true )
),
/* our own local findall */
nb:nb_queue(Ref),
(
'$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
'$find_in_path'(File,opts(Extensions,RelTo,Type,Access,Errors,Expand,Debug),TrueFileName,G),
nb:nb_queue_enqueue(Ref, TrueFileName),
fail
;
nb:nb_queue_close(Ref, FileNames, [])
),
),
set_prolog_flag( fileerrors, PreviousFileErrors ),
'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
@ -159,7 +165,13 @@ absolute_file_name(File0,File) :-
'$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !,
'$do_error'(instantiation_error, G).
'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !.
'$process_fn_opts'([],[],_,txt,none,OnError,first,false,false,_) :- !,
current_prolog_flag(fileerrors, Flag),
( OnError == error ;
OnError == fail ;
Flag == true, OnError = error ;
Flag == false, OnError = fail ;
OnError = error ), !.
'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
@ -282,14 +294,14 @@ absolute_file_name(File0,File) :-
'$to_list_of_atoms'(Bs, L2, LF).
'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
'$swi_current_prolog_flag'(file_name_variables, OldF),
'$swi_set_prolog_flag'(file_name_variables, Expand),
current_prolog_flag(file_name_variables, OldF),
set_prolog_flag(file_name_variables, Expand),
(
'$absolute_file_name'(File,ExpFile)
->
'$swi_set_prolog_flag'(file_name_variables, OldF)
set_prolog_flag(file_name_variables, OldF)
;
'$swi_set_prolog_flag'(file_name_variables, OldF),
set_prolog_flag(file_name_variables, OldF),
fail
),
(
@ -314,14 +326,14 @@ absolute_file_name(File0,File) :-
'$add_type_extensions'(Type, File, F0),
'$check_file'(F0, Type, Access, F).
% always verify if a directory
'$check_file'(F, directory, _, F) :-
!,
exists_directory(F).
'$check_file'(F, _Type, none, F) :- !.
'$check_file'(F0, Type, Access, F0) :-
'$check_file'(F0, _Type, Access, F0) :-
access_file(F0, Access),
(Type == directory ->
exists_directory(F0)
;
\+ exists_directory(F0) % if it has a type cannot be a directory.
).
\+ exists_directory(F0). % if it has a type cannot be a directory..
'$add_extensions'([Ext|_],File,F) :-
'$mk_sure_true_ext'(Ext,NExt),
@ -363,7 +375,7 @@ absolute_file_name(File0,File) :-
'$split_by_sep'(Start, Next, Dirs, Dir) :-
'$swi_current_prolog_flag'(windows, true),
current_prolog_flag(windows, true),
'$split_by_sep'(Start, Next, Dirs, ';', Dir), !.
'$split_by_sep'(Start, Next, Dirs, Dir) :-
'$split_by_sep'(Start, Next, Dirs, ':', Dir).
@ -501,9 +513,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
This directory is initialized by a rule that calls the system predicate
system_library/1.
*/
:- multifile user:library_directory/1.
:- dynamic user:library_directory/1.
%% user:library_directory( ?Dir )
@ -513,13 +523,13 @@ remove_from_path(New) :- '$check_path'(New,Path),
% 1. honor YAPSHAREDIR
user:library_directory( Dir ) :-
getenv( 'YAPSHAREDIR', Dir0),
absolute_file_name( Dir0, [file_type(directory), expand(true)], Dir ).
absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 2. honor user-library
user:library_directory( Dir ) :-
absolute_file_name( '~/share/Yap', [file_type(directory), expand(true)], Dir ).
absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 3. honor current directory
user:library_directory( Dir ) :-
absolute_file_name( '.', [file_type(directory), expand(true)], Dir ).
absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 4. honor default location.
user:library_directory( Dir ) :-
system_library( Dir ).
@ -537,6 +547,7 @@ user:library_directory( Dir ) :-
:- dynamic user:commons_directory/1.
user:commons_directory( Path ):-
system_commons( Path ).
@ -638,7 +649,6 @@ file_search_path(path, C) :-
:- multifile user:file_search_path/2.
:- dynamic user:file_search_path/2.
user:file_search_path(library, Dir) :-
user:library_directory(Dir).
user:file_search_path(commons, Dir) :-
@ -661,4 +671,5 @@ user:file_search_path(path, C) :-
lists:member(C, B)
).
%%@}
%%@}

91
pl/qly.yap
View File

@ -1,4 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -80,7 +79,7 @@ qsave_program(File) :-
'$save_program_status'([], qsave_program(File)),
open(File, write, S, [type(binary)]),
'$qsave_program'(S),
close(S).
close(S).
/** @pred qsave_program(+ _F_, Opts)
@ -105,7 +104,7 @@ qsave_program(File, Opts) :-
open(File, write, S, [type(binary)]),
'$qsave_program'(S),
% make sure we're not going to bootstrap from this file.
close(S).
close(S).
/** @pred save_program(+ _F_, : _G_)
@ -114,7 +113,7 @@ Saves an image of the current state of the YAP database in file
trying goal _G_.
**/
save_program(_File, Goal) :-
recorda('$restore_goal', Goal ,_R),
recorda('$restore_goal', Goal ,_R),
fail.
save_program(File, _Goal) :-
qsave_program(File).
@ -130,7 +129,7 @@ qend_program :-
halt(0).
'$save_program_status'(Flags, G) :-
findall(F:V,'$x_yap_flag'(F,V),L),
findall(F-V, '$x_yap_flag'(F,V),L),
recordz('$program_state',L,_),
'$cvt_qsave_flags'(Flags, G),
fail.
@ -156,7 +155,7 @@ qend_program :-
var(Flag), !,
'$do_error'(instantiation_error,G).
'$cvt_qsave_flag'(local(B), G, _) :- !,
( number(B) ->
( number(B) ->
(
B > 0 -> recordz('$restore_flag',local(B),_) ;
B =:= 0 -> true ;
@ -165,7 +164,7 @@ qend_program :-
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(global(B), G, _) :- !,
( number(B) ->
( number(B) ->
(
B > 0 -> recordz('$restore_flag',global(B),_) ;
B =:= 0 -> true ;
@ -174,7 +173,7 @@ qend_program :-
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(stack(B), G, _) :- !,
( number(B) ->
( number(B) ->
(
B > 0 -> recordz('$restore_flag',stack(B),_) ;
B =:= 0 -> true ;
@ -183,7 +182,7 @@ qend_program :-
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(trail(B), G, _) :- !,
( number(B) ->
( number(B) ->
(
B > 0 -> recordz('$restore_flag',trail(B),_) ;
B =:= 0 -> true ;
@ -192,7 +191,7 @@ qend_program :-
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(goal(B), G, M) :- !,
( callable(B) ->
( callable(B) ->
strip_module(M:B, M1, G1),
recordz('$restore_flag',goal(M1:G1),_)
;
@ -200,7 +199,7 @@ qend_program :-
'$do_error'(type_error(callable,G1),G)
).
'$cvt_qsave_flag'(toplevel(B), G, M) :- !,
( callable(B) ->
( callable(B) ->
strip_module(M:B, M1, G1),
recordz('$restore_flag',toplevel(M1:G1),_)
;
@ -208,7 +207,7 @@ qend_program :-
'$do_error'(type_error(callable,G1),G)
).
'$cvt_qsave_flag'(init_file(B), G, M) :- !,
( atom(B) ->
( atom(B) ->
recordz('$restore_flag', init_file(M:B), _)
;
'$do_error'(type_error(atom,B),G)
@ -222,31 +221,23 @@ qend_program :-
'$do_error'(domain_error(qsave_program,Opt), G).
% there is some ordering between flags.
'$x_yap_flag'(goal, _Goal).
'$x_yap_flag'(language, _V).
'$x_yap_flag'(M:unknown, V) :-
'$x_yap_flag'(language, V) :-
yap_flag(language, V).
'$x_yap_flag'(M:P, V) :-
current_module(M),
yap_flag(M:unknown, V).
yap_flag(M:P, V).
'$x_yap_flag'(X, V) :-
prolog_flag_property(X, [access(read_write)]),
atom(X),
yap_flag(X, V),
X \= gc_margin, % different machines will have different needs,
X \= argv,
X \= os_argv,
X \= language,
X \= max_threads,
X \= max_workers,
X \= readline,
X \= timezone,
X \= tty_control,
X \= undefined,
X \= user_input,
X \= user_output,
X \= user_error,
X \= version,
X \= version_data.
X \= encoding.
'$init_state' :-
recorded('$program_state', _, _), !,
recorded('$program_state', P, _), !,
'$do_init_state'.
'$init_state'.
@ -257,7 +248,7 @@ qend_program :-
'$do_init_state' :-
recorded('$program_state',L,R),
erase(R),
lists:member(F:V,L),
lists:member(F-V,L),
catch(yap_flag(F,V),_,fail),
fail.
'$do_init_state' :-
@ -294,7 +285,7 @@ qend_program :-
fail.
% this should be done before -l kicks in.
'$init_from_saved_state_and_args' :-
'$access_yap_flags'(16,0),
current_prolog_flag(fast_boot, false),
( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ),
@ -332,7 +323,7 @@ qend_program :-
set_value('$extend_file_search_path',[]),
'$extend_file_search_path'(P).
'$init_path_extensions'.
% then we can execute the programs.
'$startup_goals' :-
recorded('$startup_goal',G,_),
@ -391,30 +382,30 @@ qsave_file(F0) :-
ensure_loaded( F0 ),
absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
absolute_file_name( F0, State, [expand(true),file_type(qly)]),
'$qsave_file_'(File, State).
'$qsave_file_'(File, State).
/** @pred qsave_file(+ _File_, +_State_)
Saves an image of all the information compiled by the system from file _F_ to _State_.
Saves an image of all the information compiled by the system from file _F_ to _State_.
This includes modules and predicates eventually including multi-predicates.
**/
qsave_file(F0, State) :-
ensure_loaded( F0 ),
absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
'$qsave_file_'(File, State).
'$qsave_file_'(File, State).
'$qsave_file_'(File, UserF, _State) :-
'$qsave_file_'(File, UserF, _State) :-
( File == user_input -> Age = 0 ; time_file64(File, Age) ),
'$current_module'(M),
assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
'$set_owner_file'( '$file_property'( _ ), user, File ),
fail.
'$qsave_file_'(File, UserF, _State) :-
'$qsave_file_'(File, UserF, _State) :-
recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
'$set_owner_file'( '$file_property'( _ ), user, File ),
fail.
'$qsave_file_'(File, _UserF, _State) :-
'$qsave_file_'(File, _UserF, _State) :-
recorded('$directive',directive( File, M:G, Mode, VL, Pos ), _),
assert(user:'$file_property'( directive( M:G, Mode, VL, Pos ) ) ),
'$set_owner_file'('$file_property'( _ ), user, File ),
@ -433,7 +424,7 @@ qsave_file(F0, State) :-
open(State, write, S, [type(binary)]),
'$qsave_file_preds'(S, File),
close(S)
),
),
abolish(user:'$file_property'/1).
'$fetch_multi_files_file'(File, Multi_Files) :-
@ -441,16 +432,16 @@ qsave_file(F0, State) :-
'$fetch_multi_file_file'(FileName, (M:G :- Body)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,M), _),
functor(G, Name, Arity ),
functor(G, Name, Arity ),
clause(M:G, Body, ClauseRef),
clause_property(ClauseRef, file(FileName) ).
/** @pred qsave_module(+ _Module_, +_State_)
Saves an image of all the information compiled by the systemm on module _F_ to _State_.
Saves an image of all the information compiled by the systemm on module _F_ to _State_.
**/
qsave_module(Mod, OF) :-
qsave_module(Mod, OF) :-
recorded('$module', '$module'(_F,Mod,Source,Exps,L), _),
'$fetch_parents_module'(Mod, Parents),
'$fetch_imports_module'(Mod, Imps),
@ -501,7 +492,7 @@ available it tries reconsulting the source file.
*/
qload_module(Mod) :-
( '$swi_current_prolog_flag'(verbose_load, false)
( current_prolog_flag(verbose_load, false)
->
Verbosity = silent
;
@ -529,7 +520,7 @@ qload_module(Mod) :-
'$qload_module'(S , Mod, File, SourceModule)
;
Type == file ->
'$qload_file'(S, File)
'$qload_file'(S, File)
).
'$qload_module'(Mod, File, SourceModule) :-
open(File, read, S, [type(binary)]),
@ -538,7 +529,7 @@ qload_module(Mod) :-
'$qload_module'(S , Mod, File, SourceModule)
;
Type == file ->
'$qload_file'(S, File)
'$qload_file'(S, File)
),
close(S).
@ -685,7 +676,7 @@ qload_module(Mod) :-
'$do_foreign'('$swi_foreign'(_,_), _More).
'$init_foreigns'([], _Handle, _NewHandle).
'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :-
'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :-
!,
call_shared_object_function( NewHandle, Function),
'$init_foreigns'(More, Handle, NewHandle).
@ -699,7 +690,7 @@ Restores a previously saved state of YAP contaianing a qly file _F_.
*/
qload_file( F0 ) :-
( '$swi_current_prolog_flag'(verbose_load, false)
( current_prolog_flag(verbose_load, false)
->
Verbosity = silent
;
@ -708,9 +699,9 @@ qload_file( F0 ) :-
StartMsg = loading_module,
EndMsg = module_loaded,
'$current_module'( SourceModule ),
H0 is heapused,
H0 is heapused,
'$cputime'(T0,_),
( is_stream( F0 )
( is_stream( F0 )
->
stream_property(F0, file_name(File) ),
File = FilePl,
@ -732,7 +723,7 @@ qload_file( F0 ) :-
'$lf_option'(last_opt, LastOpt),
functor( TOpts, opt, LastOpt ),
'$lf_default_opts'(1, LastOpt, TOpts),
'$qload_file'(S, SourceModule, File, FilePl, F0, all, TOpts)
'$qload_file'(S, SourceModule, File, FilePl, F0, all, TOpts)
),
close(S),
working_directory( _, OldD),
@ -779,5 +770,3 @@ qload_file( F0 ) :-
fail.
'$process_directives'( _FilePl ) :-
abolish(user:'$file_property'/1).

8
pl/strict_iso.yap
View File

@ -22,13 +22,13 @@
'$iso_check_a_goal'(G2,(G1->G2),G0).
'$iso_check_goal'(!,_) :- !.
'$iso_check_goal'((G1|G2),G0) :-
'$access_yap_flags'(9,1), !,
current_prolog_flag(language, iso), !,
'$do_error'(domain_error(builtin_procedure,(G1|G2)), call(G0)).
'$iso_check_goal'((G1|G2),G0) :- !,
'$iso_check_a_goal'(G1,(G1|G2),G0),
'$iso_check_a_goal'(G2,(G1|G2),G0).
'$iso_check_goal'(G,G0) :-
'$access_yap_flags'(9,1),
current_prolog_flag(language, iso),
'$system_predicate'(G,0),
(
'$iso_builtin'(G)
@ -58,11 +58,11 @@
'$iso_check_a_goal'(G2,E,G0).
'$iso_check_a_goal'(!,_,_) :- !.
'$iso_check_a_goal'((_|_),E,G0) :-
'$access_yap_flags'(9,1), !,
current_prolog_flag(language, iso), !,
'$do_error'(domain_error(builtin_procedure,E), call(G0)).
'$iso_check_a_goal'((_|_),_,_) :- !.
'$iso_check_a_goal'(G,_,G0) :-
'$access_yap_flags'(9,1),
current_prolog_flag(language, iso),
'$system_predicate'(G,0),
(
'$iso_builtin'(G)

14
pl/tabling.yap
View File

@ -291,10 +291,10 @@ table(Pred) :-
'$undefined'(PredFunctor,Mod), !,
'$c_table'(Mod,PredFunctor,PredModeList).
'$set_table'(Mod,PredFunctor,_PredModeList) :-
'$flags'(PredFunctor,Mod,Flags,Flags),
'$predicate_flags'(PredFunctor,Mod,Flags,Flags),
Flags /\ 0x00000040 =:= 0x00000040, !.
'$set_table'(Mod,PredFunctor,PredModeList) :-
'$flags'(PredFunctor,Mod,Flags,Flags),
'$predicate_flags'(PredFunctor,Mod,Flags,Flags),
Flags /\ 0x1991F8C0 =:= 0,
'$c_table'(Mod,PredFunctor,PredModeList), !.
'$set_table'(Mod,PredFunctor,_PredModeList) :-
@ -346,7 +346,7 @@ is_tabled(Pred) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
'$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
Flags /\ 0x000040 =\= 0.
'$do_is_tabled'(Mod,Pred) :-
'$do_pi_error'(type_error(callable,Pred),is_tabled(Mod:Pred)).
@ -377,7 +377,7 @@ tabling_mode(Pred,Options) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
'$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
(
Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options)
;
@ -438,7 +438,7 @@ abolish_table(Pred) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
'$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
(
Flags /\ 0x000040 =\= 0, !, '$c_abolish_table'(Mod,PredFunctor)
;
@ -478,7 +478,7 @@ show_table(Stream,Pred) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
'$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
(
Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Stream,Mod,PredFunctor)
;
@ -518,7 +518,7 @@ table_statistics(Stream,Pred) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
'$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
(
Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Stream,Mod,PredFunctor)
;

2
pl/threads.yap
View File

@ -1368,7 +1368,7 @@ thread_local(X) :-
'$thread_local2'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
(Mod \= idb -> '$flags'(T,Mod,F,F) ; true),
(Mod \= idb -> '$predicate_flags'(T,Mod,F,F) ; true),
( '$install_thread_local'(T,Mod) -> true ;
F /\ 0x08002000 =\= 0 -> '$do_error'(permission_error(modify,dynamic_procedure,A/N),thread_local(Mod:A/N)) ;
'$do_error'(permission_error(modify,static_procedure,A/N),thread_local(Mod:A/N))

6
pl/undefined.yap
View File

@ -105,16 +105,16 @@ followed by the failure of that call.
*/
:- multifile user:unknown_predicate_handler/3.
'$handle_error'(0x0080,Goal,Mod) :-
'$handle_error'(error,Goal,Mod) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
'$handle_error'(0x0040,Goal,Mod) :-
'$handle_error'(warning,Goal,Mod) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
fail.
'$handle_error'(0x0020,_Goal,_Mod) :-
'$handle_error'(fail,_Goal,_Mod) :-
fail.
'$complete_goal'(M, G, CurG, CurMod, NG) :-

157
pl/yio.yap
View File

@ -67,67 +67,6 @@ setting and clearing this flag are given under 7.7.
/* stream predicates */
/* check whether a list of options is valid */
'$check_io_opts'(V,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_io_opts'([],_) :- !.
'$check_io_opts'([H|_],G) :- var(H), !,
'$do_error'(instantiation_error,G).
'$check_io_opts'([Opt|T],G) :- !,
'$check_opt'(G,Opt,G),
'$check_io_opts'(T,G).
'$check_io_opts'(T,G) :-
'$do_error'(type_error(list,T),G).
'$check_opt'(read_term(_,_),Opt,G) :-
'$check_opt_read'(Opt, G).
'$check_opt'(stream_property(_,_),Opt,G) :-
'$check_opt_sp'(Opt, G).
'$check_opt_read'(variables(_), _) :- !.
'$check_opt_read'(variable_names(_), _) :- !.
'$check_opt_read'(singletons(_), _) :- !.
'$check_opt_read'(syntax_errors(T), G) :- !,
'$check_read_syntax_errors_arg'(T, G).
'$check_opt_read'(term_position(_), _) :- !.
'$check_opt_read'(term_position(_), _) :- !.
'$check_opt_read'(comments(_), _) :- !.
'$check_opt_read'(module(_), _) :- !.
'$check_opt_read'(A, G) :-
'$do_error'(domain_error(read_option,A),G).
'$check_opt_sp'(file_name(_), _) :- !.
'$check_opt_sp'(mode(_), _) :- !.
'$check_opt_sp'(input, _) :- !.
'$check_opt_sp'(output, _) :- !.
'$check_opt_sp'(alias(_), _) :- !.
'$check_opt_sp'(position(_), _) :- !.
'$check_opt_sp'(end_of_stream(_), _) :- !.
'$check_opt_sp'(eof_action(_), _) :- !.
'$check_opt_sp'(reposition(_), _) :- !.
'$check_opt_sp'(type(_), _) :- !.
'$check_opt_sp'(bom(_), _) :- !.
'$check_opt_sp'(encoding(_), _) :- !.
'$check_opt_sp'(representation_errors(_), _) :- !.
'$check_opt_sp'(A, G) :-
'$do_error'(domain_error(stream_property,A),G).
'$check_read_syntax_errors_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_read_syntax_errors_arg'(dec10,_) :- !.
'$check_read_syntax_errors_arg'(fail,_) :- !.
'$check_read_syntax_errors_arg'(error,_) :- !.
'$check_read_syntax_errors_arg'(quiet,_) :- !.
'$check_read_syntax_errors_arg'(X,G) :-
'$do_error'(domain_error(read_option,syntax_errors(X)),G).
'$check_boolean'(X, _, _, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_boolean'(true,_,_,_) :- !.
'$check_boolean'(false,_,_,_) :- !.
'$check_boolean'(_X, B, T, G) :-
'$do_error'(domain_error(B,T),G).
/** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface
@ingroup InputOutput
@{
@ -143,15 +82,6 @@ Call socket/4 with _TYPE_ bound to `SOCK_STREAM'` and
*/
socket(Domain, Sock) :-
(
'$undefined'(ip_socket(_,_),yap_sockets)
->
load_files(library(sockets), [silent(true),if(not_loaded)])
;
true
),
yap_sockets:ip_socket(Domain, Sock).
/** @pred socket(+ _DOMAIN_,+ _TYPE_,+ _PROTOCOL_,- _SOCKET_)
@ -170,16 +100,6 @@ supported: `SOCK_STREAM'` and `SOCK_DGRAM'` (untested in 6.3).
*/
socket(Domain, Type, Protocol, Sock) :-
(
'$undefined'(ip_socket(_,_),yap_sockets)
->
load_files(library(sockets), [silent(true),if(not_loaded)])
;
true
),
yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
/** @pred socket_connect(+ _SOCKET_, + _PORT_, - _STREAM_)
@ -196,58 +116,18 @@ connect to socket at file _FILENAME_.
+ 'AF_INET'(+ _HOST_,+ _PORT_)
Connect to socket at host _HOST_ and port _PORT_.
*/
*/
socket_connect(Sock, Host, Read) :-
(
'$undefined'(ip_socket(_,_),yap_sockets)
->
load_files(library(sockets), [silent(true),if(not_loaded)])
;
true
),
yap_sockets:tcp_connect(Sock, Host:Read).
/** @pred open_pipe_streams(Read, Write)
Autoload old pipe access interface
*/
open_pipe_streams(Read, Write) :-
(
'$undefined'(pipe(_,_),unix)
->
load_files(library(unix), [silent(true),if(not_loaded)])
;
true
),
unix:pipe(Read, Write),
yap_flag(encoding, X),
set_stream(Read, encoding(X) ),
set_stream(Write, encoding(X) ).
%! @}
/** @pred fileerrors
Switches on the file_errors flag so that in certain error conditions
Input/Output predicates will produce an appropriated message and abort.
*/
fileerrors :- '$swi_set_prolog_flag'(fileerrors, true).
/** @pred nofileerrors
Switches off the file_errors flag, so that the predicates see/1,
tell/1, open/3 and close/1 just fail, instead of producing
an error message and aborting whenever the specified file cannot be
opened or closed.
*/
nofileerrors :- '$swi_set_prolog_flag'(fileerrors, false).
/** @pred exists(+ _F_)
@ -262,28 +142,6 @@ exists(F) :-
/* Term IO */
/** @pred read(- _T_) is iso
Reads the next term from the current input stream, and unifies it with
_T_. The term must be followed by a dot (`.`) and any blank-character
as previously defined. The syntax of the term must match the current
declarations for operators (see op). If the end-of-stream is reached,
_T_ is unified with the atom `end_of_file`. Further reads from of
the same stream may cause an error failure (see open/3).
*/
read(T) :-
read_term(T, []).
/** @pred read(+ _S_,- _T_) is iso
Reads term _T_ from the stream _S_ instead of from the current input
stream.
*/
read(Stream,T) :-
read_term(Stream, T, []).
%! @}
@ -475,6 +333,7 @@ current_char_conversion(X,Y) :-
'$fetch_char_conversion'(List,X,Y).
/** @pred current_stream( _F_, _M_, _S_)
@ -489,6 +348,7 @@ with _S_.
*/
current_stream(File, Mode, Stream) :-
stream_property(Stream, mode(Mode)),
'$stream_name'(Stream, File).
@ -560,16 +420,7 @@ stream_position_data(Prop, Term, Value) :-
'$stream_position_field'(byte_count, 4).
'$default_expand'(Expand) :-
get_value('$open_expands_filename',Expand).
'$set_default_expand'(true) :- !,
set_value('$open_expands_filename',true).
'$set_default_expand'(false) :- !,
set_value('$open_expands_filename',false).
'$set_default_expand'(V) :- !,
'$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,V)).
%! @}

1
swi/library/CMakeLists.txt
View File

@ -23,7 +23,6 @@ set (LIBRARY_PL
pure_input.pl
quasi_quotations.pl
quintus.pl
readutil.pl
record.pl
settings.pl
shlib.pl

272
swi/library/readutil.pl
View File

@ -1,272 +0,0 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(read_util,
[ read_line_to_codes/2, % +Fd, -Codes (without trailing \n)
read_line_to_codes/3, % +Fd, -Codes, ?Tail
read_stream_to_codes/2, % +Fd, -Codes
read_stream_to_codes/3, % +Fd, -Codes, ?Tail
read_line_to_string/2, % +Fd, -Codes (without trailing \n)
read_stream_to_string/2, % +Fd, -Codes, ?Tail
read_file_to_codes/3, % +File, -Codes, +Options
read_file_to_string/3, % +File, -Codes, +Options
read_file_to_terms/3 % +File, -Terms, +Options
]).
:- use_module(library(shlib)).
:- use_module(library(lists), [select/3]).
:- use_module(library(error)).
/** <module> Read utilities
@ingroup swi
This library provides some commonly used reading predicates. As these
predicates have proven to be time-critical in some applications we moved
them to C. For compatibility as well as to reduce system dependency, we
link the foreign code at runtime and fallback to the Prolog
implementation if the shared object cannot be found.
*/
:- volatile
read_line_to_codes/2,
read_line_to_codes/3,
read_stream_to_codes/2,
read_stream_to_codes/3,
read_line_to_string/2,
read_stream_to_string/2,
read_stream_to_string/3.
link_foreign :-
catch(load_foreign_library(foreign(readutil)), _, fail), !.
link_foreign :-
assertz((read_line_to_codes(Stream, Line) :-
pl_read_line_to_codes(Stream, Line))),
assertz((read_line_to_codes(Stream, Line, Tail) :-
pl_read_line_to_codes(Stream, Line, Tail))),
assertz((read_stream_to_codes(Stream, Content) :-
pl_read_stream_to_codes(Stream, Content))),
assertz((read_stream_to_codes(Stream, Content, Tail) :-
pl_read_stream_to_codes(Stream, Content, Tail))),
compile_predicates([ read_line_to_codes/2,
read_line_to_codes/3,
read_stream_to_codes/2,
read_stream_to_codes/3
]),
assertz((read_line_to_string(Stream, Line) :-
pl_read_line_to_string(Stream, Line))),
assertz((read_line_to_string(Stream, Line, Tail) :-
pl_read_line_to_string(Stream, Line, Tail))),
assertz((read_stream_to_string(Stream, Content) :-
pl_read_stream_to_string(Stream, Content))),
assertz((read_stream_to_string(Stream, Content, Tail) :-
pl_read_stream_to_string(Stream, Content, Tail))),
compile_predicates([ read_line_to_string/2,
read_stream_to_string/2
]).
:- initialization(link_foreign, now).
/*******************************
* LINES *
*******************************/
%% read_line_to_codes(+In:stream, -Line:codes) is det.
%
% Read a line of input from In into a list of character codes.
% Trailing newline and or return are deleted. Upon reaching
% end-of-file Line is unified to the atom =end_of_file=.
pl_read_line_to_string(Fd, String) :-
get_code(Fd, C0),
( C0 == -1
-> String = end_of_file
; read_1line_to_codes(C0, Fd, Codes0)
),
string_codes( String, Codes0 ).
pl_read_line_to_codes(Fd, Codes) :-
get_code(Fd, C0),
( C0 == -1
-> Codes = end_of_file
; read_1line_to_codes(C0, Fd, Codes0)
),
Codes = Codes0.
read_1line_to_codes(-1, _, []) :- !.
read_1line_to_codes(10, _, []) :- !.
read_1line_to_codes(13, Fd, L) :- !,
get_code(Fd, C2),
read_1line_to_codes(C2, Fd, L).
read_1line_to_codes(C, Fd, [C|T]) :-
get_code(Fd, C2),
read_1line_to_codes(C2, Fd, T).
%% read_line_to_codes(+Fd, -Line, ?Tail) is det.
%
% Read a line of input as a difference list. This should be used
% to read multiple lines efficiently. On reaching end-of-file,
% Tail is bound to the empty list.
pl_read_line_to_codes(Fd, Codes, Tail) :-
get_code(Fd, C0),
read_line_to_codes(C0, Fd, Codes0, Tail),
Codes = Codes0.
read_line_to_codes(-1, _, Tail, Tail) :- !,
Tail = [].
read_line_to_codes(10, _, [10|Tail], Tail) :- !.
read_line_to_codes(C, Fd, [C|T], Tail) :-
get_code(Fd, C2),
read_line_to_codes(C2, Fd, T, Tail).
/*******************************
* STREAM (ENTIRE INPUT) *
*******************************/
%% read_stream_to_codes(+Stream, -Codes) is det.
%% read_stream_to_codes(+Stream, -Codes, ?Tail) is det.
%
% Read input from Stream to a list of character codes. The version
% read_stream_to_codes/3 creates a difference-list.
pl_read_stream_to_string(Fd, String) :-
pl_read_stream_to_codes(Fd, Codes, []),
string_codes( String, Codes ).
pl_read_stream_to_codes(Fd, Codes) :-
pl_read_stream_to_codes(Fd, Codes, []).
pl_read_stream_to_codes(Fd, Codes, Tail) :-
get_code(Fd, C0),
read_stream_to_codes(C0, Fd, Codes0, Tail),
Codes = Codes0.
read_stream_to_codes(-1, _, Tail, Tail) :- !.
read_stream_to_codes(C, Fd, [C|T], Tail) :-
get_code(Fd, C2),
read_stream_to_codes(C2, Fd, T, Tail).
%% read_stream_to_terms(+Stream, -Terms, ?Tail, +Options) is det.
read_stream_to_terms(Fd, Terms, Tail, Options) :-
read_term(Fd, C0, Options),
read_stream_to_terms(C0, Fd, Terms0, Tail, Options),
Terms = Terms0.
read_stream_to_terms(end_of_file, _, Tail, Tail, _) :- !.
read_stream_to_terms(C, Fd, [C|T], Tail, Options) :-
read_term(Fd, C2, Options),
read_stream_to_terms(C2, Fd, T, Tail, Options).
/*******************************
* FILE (ENTIRE INPUT) *
*******************************/
%% read_file_to_codes(+Spec, -Codes, +Options) is det.
%
% Read the file Spec into a list of Codes. Options is split into
% options for absolute_file_name/3 and open/4.
read_file_to_codes(Spec, Codes, Options) :-
must_be(proper_list, Options),
( select(tail(Tail), Options, Options1)
-> true
; Tail = [],
Options1 = Options
),
split_options(Options1, file_option, FileOptions, OpenOptions),
absolute_file_name(Spec,
[ access(read)
| FileOptions
],
Path),
open(Path, read, Fd, OpenOptions),
call_cleanup(read_stream_to_codes(Fd, Codes0, Tail),
close(Fd)),
Codes = Codes0.
%% read_file_to_terms(+Spec, -Terms, +Options) is det.
%
% Read the file Spec into a list of terms. Options is split over
% absolute_file_name/3, open/4 and read_term/3.
read_file_to_terms(Spec, Terms, Options) :-
must_be(proper_list, Options),
( select(tail(Tail), Options, Options1)
-> true
; Tail = [],
Options1 = Options
),
split_options(Options1, file_option, FileOptions, Options2),
split_options(Options2, read_option, ReadOptions, OpenOptions),
absolute_file_name(Spec,
[ access(read)
| FileOptions
],
Path),
open(Path, read, Fd, OpenOptions),
call_cleanup(read_stream_to_terms(Fd, Terms0, Tail, ReadOptions),
close(Fd)),
Terms = Terms0.
split_options([], _, [], []).
split_options([H|T], G, File, Open) :-
( call(G, H)
-> File = [H|FT],
OT = Open
; Open = [H|OT],
FT = File
),
split_options(T, G, FT, OT).
read_option(module(_)).
read_option(syntax_errors(_)).
read_option(character_escapes(_)).
read_option(double_quotes(_)).
read_option(backquoted_string(_)).
file_option(extensions(_)).
file_option(file_type(_)).
file_option(file_errors(_)).
file_option(relative_to(_)).
file_option(expand(_)).
/*******************************
* XREF *
*******************************/
:- multifile prolog:meta_goal/2.
:- dynamic prolog:meta_goal/2.
prolog:meta_goal(split_options(_,G,_,_), [G+1]).