From 661f33ac7ea47d45d12b82fbf5a19e560ad723c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 3 Jan 2016 02:06:09 +0000 Subject: [PATCH] bug fices --- C/modules.c | 23 +- C/parser.c | 18 +- C/qlyr.c | 41 +- C/qlyw.c | 9 +- C/save.c | 6 +- C/signals.c | 466 ++--- C/stdpreds.c | 54 +- C/threads.c | 5 +- C/tracer.c | 22 +- C/write.c | 20 +- CMakeLists.txt | 26 +- CXX/yapi.cpp | 2 +- GitSHA1.c | 2 +- H/Yap.h | 28 +- H/YapFlags.h | 63 +- H/YapGFlagInfo.h | 18 +- H/YapHandles.h | 102 +- H/YapHeap.h | 100 +- H/YapLFlagInfo.h | 2 +- H/YapText.h | 9 +- H/Yapproto.h | 5 +- H/Yatom.h | 1971 +++++++----------- H/clause.h | 365 ++-- H/dglobals.h | 146 -- H/dlocals.h | 493 ----- H/iatoms.h | 2 + H/ihstruct.h | 301 --- H/ilocals.h | 277 --- H/qly.h | 2 +- H/ratoms.h | 2 + H/rglobals.h | 146 -- H/rheap.h | 1296 +++++------- H/rhstruct.h | 301 --- H/rlocals.h | 277 --- H/tatoms.h | 5 + OPTYap/CMakeLists.txt | 24 +- OPTYap/opt.init.c | 103 +- OPTYap/opt.preds.c | 783 +++---- OPTYap/tab.tries.c | 1415 +++++++------ cmake/Sources.cmake | 24 +- config.h.cmake | 1 + include/YapErrors.h | 269 ++- library/CMakeLists.txt | 3 +- library/dbqueues.yap | 8 +- library/dialect/#swi.yap# | 324 --- library/dialect/swi.yap | 3 - library/dialect/swi/fli/blobs.c | 2 +- library/dialect/swi/fli/swi.c | 82 +- library/expand_macros.yap | 28 +- library/hacks.yap | 12 +- library/lists.yap | 104 +- library/maplist.yap | 8 +- library/random.yap | 61 +- library/ytest.yap | 58 +- library/ytest/preds.yap | 13 +- misc/ATOMS | 5 +- misc/HEAPFIELDS | 358 ++-- misc/buildheap | 43 +- misc/buildlocalglobal | 230 +- misc/prolog.el | 8 +- misc/sysgraph | 831 -------- misc/tests | 37 +- os/CMakeLists.txt | 12 +- os/charsio.c | 61 +- os/format.c | 2 +- os/iopreds.c | 44 +- os/readterm.c | 38 +- os/readutil.c | 4 +- os/time.c | 4 +- os/write.c | 19 +- os/yapio.h | 32 +- packages/CLPBN/clpbn.yap | 5 +- packages/CLPBN/pfl.yap | 10 +- packages/ProbLog/problog/grounder.yap | 7 +- packages/ProbLog/problog/logger.yap | 5 +- packages/ProbLog/problog_examples/alarm.pl | 3 +- packages/ProbLog/problog_lfi.yap | 138 +- packages/bdd/CMakeLists.txt | 7 +- packages/bdd/cudd_config.h | 6 +- packages/bdd/simplecudd_lfi/general.c | 2 +- packages/bdd/simplecudd_lfi/general.h | 2 +- packages/bdd/simplecudd_lfi/problogbdd_lfi.c | 6 +- packages/bdd/simplecudd_lfi/simplecudd.c | 18 +- packages/bdd/simplecudd_lfi/simplecudd.h | 10 +- packages/bdd/simplecudd_lfi/simplecudd_lfi | Bin 92360 -> 92360 bytes packages/cplint/lpadclpbn.pl | 1 - packages/jpl/CMakeLists.txt | 2 + packages/jpl/jpl.pl | 4 +- packages/jpl/jpl/jpl.pl | 4 +- packages/myddas/#MyddasProto.h# | 79 - packages/myddas/CMakeLists.txt | 5 +- packages/myddas/MyddasProto.h | 77 +- packages/myddas/myddas_initialization.c | 70 +- packages/myddas/myddas_shared.c | 18 - packages/myddas/myddas_util.c | 415 ++-- packages/myddas/myddas_util.h | 50 +- packages/myddas/myddas_util_connection.c | 17 +- packages/myddas/myddas_wkb.h | 25 - packages/myddas/myddas_wkb2prolog.c | 382 ---- packages/myddas/myddas_wkb2prolog.h | 6 - packages/myddas/mysql/CMakeLists.txt | 15 +- packages/myddas/mysql/myddas_mysql.c | 1 + packages/myddas/mysql/myddas_util.c | 106 +- packages/myddas/odbc/myddas_odbc.c | 1033 +++++---- packages/myddas/pl/myddas.ypp | 2 + packages/myddas/postgres/CMakeLists.txt | 16 +- packages/myddas/sqlite3/CMakeLists.txt | 13 +- packages/myddas/sqlite3/myddas_sqlite3.c | 669 +++--- pl/CMakeLists.txt | 4 +- pl/absf.yap | 1 + pl/arith.yap | 35 +- pl/attributes.yap | 10 +- pl/boot.yap | 145 +- pl/consult.yap | 17 +- pl/debug.yap | 123 +- pl/error.yap | 4 +- pl/grammar.yap | 57 +- pl/init.yap | 15 +- pl/listing.yap | 3 +- pl/lists.yap | 30 +- pl/load_foreign.yap | 1 + pl/meta.yap | 222 +- pl/modules.yap | 21 +- pl/newmod.yap | 2 +- pl/preddecls.yap | 2 + pl/preddyns.yap | 25 +- pl/preds.yap | 86 +- pl/protect.yap | 34 +- pl/qly.yap | 2 +- pl/signals.yap | 1 + pl/spy.yap | 2 +- pl/strict_iso.yap | 4 +- pl/undefined.yap | 157 +- 133 files changed, 6000 insertions(+), 9890 deletions(-) delete mode 100644 H/dglobals.h delete mode 100644 H/dlocals.h delete mode 100644 H/ihstruct.h delete mode 100755 H/ilocals.h delete mode 100644 H/rglobals.h delete mode 100644 H/rhstruct.h delete mode 100644 H/rlocals.h delete mode 100644 library/dialect/#swi.yap# delete mode 100755 misc/sysgraph delete mode 100644 packages/myddas/#MyddasProto.h# delete mode 100644 packages/myddas/myddas_wkb.h delete mode 100644 packages/myddas/myddas_wkb2prolog.c delete mode 100644 packages/myddas/myddas_wkb2prolog.h diff --git a/C/modules.c b/C/modules.c index 6d560aff0..da5448cdf 100644 --- a/C/modules.c +++ b/C/modules.c @@ -70,6 +70,7 @@ inline static ModEntry *GetModuleEntry(Atom at) new->NextME = CurrentModules; CurrentModules = new; new->AtomOfME = ae; + new->OwnerFile = Yap_ConsultingFile( PASS_REGS1); AddPropToAtom(ae, (PropEntry *)new); if (CurrentModule == 0L || (oat = GetModuleEntry(AtomOfTerm(CurrentModule))) == new) { Yap_setModuleFlags(new, NULL); @@ -85,6 +86,8 @@ Term Yap_getUnknownModule(ModEntry *m) { return TermError; } else if (m && m->flags & UNKNOWN_WARNING) { return TermWarning; + } else if (m && m->flags & UNKNOWN_FAST_FAIL) { + return TermFastFail; } else { return TermFail; } @@ -92,13 +95,7 @@ Term Yap_getUnknownModule(ModEntry *m) { bool Yap_getUnknown ( Term mod) { ModEntry *m = LookupModule( mod ); - if (m && m->flags & UNKNOWN_ERROR) { - return TermError; - } else if (m && m->flags & UNKNOWN_WARNING) { - return TermWarning; - } else { - return TermFail; - } + return Yap_getUnknownModule( m ); } @@ -131,8 +128,10 @@ Term Yap_Module_Name(PredEntry *ap) { } static ModEntry *LookupSystemModule(Term a) { + CACHE_REGS Atom at; ModEntry *me; + /* prolog module */ if (a == 0) { @@ -141,6 +140,7 @@ static ModEntry *LookupSystemModule(Term a) { at = AtomOfTerm(a); me = GetModuleEntry(at); me->flags |= M_SYSTEM; + me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 ); return me;} @@ -316,7 +316,7 @@ static Int init_ground_module(USES_REGS1) { } /** - * @pred is_system_module( + _Mod_) + * @pred system_module( + _Mod_) * * @param module * @@ -335,7 +335,7 @@ static Int is_system_module( USES_REGS1 ) return Yap_isSystemModule( t ); } -static Int system_module( USES_REGS1 ) +static Int new_system_module( USES_REGS1 ) { ModEntry *me; Term t; @@ -348,6 +348,7 @@ static Int system_module( USES_REGS1 ) return false; } me = LookupSystemModule( t ); + me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); return me != NULL; } @@ -495,8 +496,8 @@ void Yap_InitModulesC(void) { Yap_InitCPred("$yap_strip_module", 3, yap_strip_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("context_module", 1, context_module, 0); - Yap_InitCPred("system_module", 1, system_module, SafePredFlag); - Yap_InitCPred("is_system_module", 1, is_system_module, SafePredFlag); + Yap_InitCPred("$is_system_module", 1, is_system_module, SafePredFlag); + Yap_InitCPred("new_system_module", 1, new_system_module, SafePredFlag); Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module, SafePredFlag | SyncPredFlag); Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module, diff --git a/C/parser.c b/C/parser.c index c8a948cab..ed55f6a7c 100755 --- a/C/parser.c +++ b/C/parser.c @@ -745,34 +745,46 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) { case String_tok: /* build list on the heap */ { Volatile char *p = (char *)LOCAL_tokptr->TokInfo; + // we may be operating under a syntax error + yap_error_number oerr = LOCAL_Error_TYPE; + LOCAL_Error_TYPE = YAP_NO_ERROR; t = Yap_CharsToTDQ(p, CurrentModule, LOCAL_encoding PASS_REGS); if (!t) { syntax_msg("could not convert \"%s\"", (char *)LOCAL_tokptr->TokInfo); FAIL; } + LOCAL_Error_TYPE = oerr; NextToken; } break; case WString_tok: /* build list on the heap */ { Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; + // we may be operating under a syntax error + yap_error_number oerr = LOCAL_Error_TYPE; + LOCAL_Error_TYPE = YAP_NO_ERROR; t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS); if (!t) { syntax_msg("could not convert \'%S\'", (wchar_t *)LOCAL_tokptr->TokInfo); FAIL; } - NextToken; + LOCAL_Error_TYPE = oerr; + NextToken; } break; case BQString_tok: /* build list on the heap */ { Volatile char *p = (char *)LOCAL_tokptr->TokInfo; + // we may be operating under a syntax error + yap_error_number oerr = LOCAL_Error_TYPE; + LOCAL_Error_TYPE = YAP_NO_ERROR; t = Yap_CharsToTBQ(p, CurrentModule, LOCAL_encoding PASS_REGS); if (!t) { syntax_msg("could not convert \'%s\"", (char *)LOCAL_tokptr->TokInfo); FAIL; } + LOCAL_Error_TYPE = oerr; NextToken; } break; @@ -780,10 +792,14 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) { { Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS); + // we may be operating under a syntax error + yap_error_number oerr = LOCAL_Error_TYPE; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!t) { syntax_msg("could not convert \"%S\"", (wchar_t *)LOCAL_tokptr->TokInfo); FAIL; } + LOCAL_Error_TYPE = oerr; NextToken; } break; diff --git a/C/qlyr.c b/C/qlyr.c index c13aefb77..dc7016ede 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -698,7 +698,7 @@ read_tag(FILE *stream) return ch; } -static UInt +static pred_flags_t read_predFlags(FILE *stream) { pred_flags_t v; @@ -1018,23 +1018,30 @@ read_pred(FILE *stream, Term mod) { ap = LookupPredEntry((PredEntry *)read_UInt(stream)); flags = read_predFlags(stream); +#if 0 + if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE) + // __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); + printf(" %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); + else if (ap->ModuleOfPred != IDB_MODULE) + //__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); + printf(" %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); + //else + // __android_log_print(ANDROID_LOG_INFO, "YAP "," number\n"); +#endif + if (flags & ForeignPredFlags) { + if (!(ap->PredFlags & ForeignPredFlags)) + QLYR_ERROR(INCONSISTENT_CPRED); + if (flags & MetaPredFlag) + ap->PredFlags |= MetaPredFlag; + return; + } nclauses = read_UInt(stream); if (ap->PredFlags & IndexedPredFlag) { Yap_RemoveIndexation(ap); } -#if 0 - if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE) - __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); - /* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */ - else if (ap->ModuleOfPred != IDB_MODULE) - __android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); - /* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */ - else - __android_log_print(ANDROID_LOG_INFO, "YAP "," number\n"); -#endif - fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); - ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); - ap->PredFlags |= fl1; + //fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); + //ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); + ap->PredFlags = flags & ~StatePredFlags; if (flags & NumberDBPredFlag) { ap->src.IndxId = read_UInt(stream); } else { @@ -1046,9 +1053,9 @@ read_pred(FILE *stream, Term mod) { } ap->TimeStampOfPred = read_UInt(stream); /* multifile predicates cannot reside in module 0 */ - if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) { - ap->ModuleOfPred = TermProlog; - } + // if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) { + // ap->ModuleOfPred = TermProlog; + // } if (nclauses) read_clauses(stream, ap, nclauses, flags); #if DEBUG diff --git a/C/qlyw.c b/C/qlyw.c index b77851a8f..30f81beb6 100755 --- a/C/qlyw.c +++ b/C/qlyw.c @@ -698,6 +698,8 @@ static size_t save_pred(FILE *stream, PredEntry *ap) { CHECK(save_UInt(stream, (UInt)ap)); CHECK(save_predFlags(stream, ap->PredFlags)); + if (ap->PredFlags & ForeignPredFlags) + return 1; CHECK(save_UInt(stream, ap->cs.p_code.NOfClauses)); CHECK(save_UInt(stream, ap->src.IndxId)); CHECK(save_UInt(stream, ap->TimeStampOfPred)); @@ -706,11 +708,8 @@ save_pred(FILE *stream, PredEntry *ap) { static int clean_pred(PredEntry *pp USES_REGS) { - if (pp->PredFlags & (AsmPredFlag|CPredFlag)) { - /* assembly */ - if (pp->CodeOfPred) { - CleanClauses(pp->CodeOfPred, pp->CodeOfPred, pp PASS_REGS); - } + if (pp->PredFlags & ForeignPredFlags) { + return true; } else { CleanClauses(pp->cs.p_code.FirstClause, pp->cs.p_code.LastClause, pp PASS_REGS); } diff --git a/C/save.c b/C/save.c index 48fa9a416..db3ff53b9 100755 --- a/C/save.c +++ b/C/save.c @@ -455,7 +455,7 @@ save_regs(int mode USES_REGS) if (putcellptr(CellPtr(HeapTop)) < 0) return -1; /* and the space it ocuppies */ - if (putout(Unsigned(Yap_heap_regs->heap_used)) < 0) + if (putout(Unsigned(HeapUsed)) < 0) return -1; /* Then the start of the free code */ if (putcellptr(CellPtr(FreeBlocks)) < 0) @@ -1035,6 +1035,8 @@ get_coded(int flag, OPCODE old_ops[] USES_REGS) return 1; } + + /* restore some heap registers */ static void restore_heap_regs( USES_REGS1 ) @@ -1043,7 +1045,7 @@ restore_heap_regs( USES_REGS1 ) HeapTop = AddrAdjust(HeapTop); *((YAP_SEG_SIZE *) HeapTop) = InUseFlag; } - HeapMax = Yap_heap_regs->heap_used = OldHeapUsed; + HeapMax = HeapUsed = OldHeapUsed; HeapLim = LOCAL_GlobalBase; } diff --git a/C/signals.c b/C/signals.c index f31005e0b..bd1e1c369 100755 --- a/C/signals.c +++ b/C/signals.c @@ -8,14 +8,14 @@ * * ************************************************************************** * * - * File: signal.c * + * File: signal.c * * comments: Signal Handling & Debugger Support * * * * * * * *************************************************************************/ #ifdef SCCS -static char SccsId[] = "%W% %G%"; +static char SccsId[] = "%W% %G%"; #endif #define HAS_CACHE_REGS 1 @@ -51,59 +51,59 @@ static char SccsId[] = "%W% %G%"; #include #endif - /* - * The InteractSIGINT function is called after a normal interrupt had been caught. + * The InteractSIGINT function is called after a normal interrupt had been + * caught. * It allows 6 possibilities: abort, continue, trace, debug, help, exit. */ -static yap_signals -InteractSIGINT(int ch) { +static yap_signals InteractSIGINT(int ch) { #ifdef HAVE_SETBUF /* make sure we are not waiting for the end of line */ - setbuf (stdin, NULL); + setbuf(stdin, NULL); #endif switch (ch) { - case 'a': - /* abort computation */ - return YAP_ABORT_SIGNAL; - case 'b': - /* continue */ - return YAP_BREAK_SIGNAL; - case 'c': - /* continue */ - return YAP_NO_SIGNAL; - case 'd': - /* enter debug mode */ - return YAP_DEBUG_SIGNAL; - case 'e': - /* exit */ - Yap_exit(1); - return YAP_EXIT_SIGNAL; - case 'g': - /* stack dump */ - return YAP_STACK_DUMP_SIGNAL; - case 't': - /* start tracing */ - return YAP_TRACE_SIGNAL; + case 'a': + /* abort computation */ + return YAP_ABORT_SIGNAL; + case 'b': + /* continue */ + return YAP_BREAK_SIGNAL; + case 'c': + /* continue */ + return YAP_NO_SIGNAL; + case 'd': + /* enter debug mode */ + return YAP_DEBUG_SIGNAL; + case 'e': + /* exit */ + Yap_exit(1); + return YAP_EXIT_SIGNAL; + case 'g': + /* stack dump */ + return YAP_STACK_DUMP_SIGNAL; + case 't': + /* start tracing */ + return YAP_TRACE_SIGNAL; #ifdef LOW_LEVEL_TRACER - case 'T': - toggle_low_level_trace(); - return YAP_NO_SIGNAL; + case 'T': + toggle_low_level_trace(); + return YAP_NO_SIGNAL; #endif - case 's': - /* show some statistics */ - return YAP_STATISTICS_SIGNAL; - case EOF: - return YAP_NO_SIGNAL; - case 'h': - case '?': - default: - /* show an helpful message */ - fprintf(stderr, "Please press one of:\n"); - fprintf(stderr, " a for abort\n c for continue\n d for debug\n"); - fprintf(stderr, " e for exit\n g for stack dump\n s for statistics\n t for trace\n"); - fprintf(stderr, " b for break\n"); - return YAP_NO_SIGNAL; + case 's': + /* show some statistics */ + return YAP_STATISTICS_SIGNAL; + case EOF: + return YAP_NO_SIGNAL; + case 'h': + case '?': + default: + /* show an helpful message */ + fprintf(stderr, "Please press one of:\n"); + fprintf(stderr, " a for abort\n c for continue\n d for debug\n"); + fprintf(stderr, " e for exit\n g for stack dump\n s for statistics\n t " + "for trace\n"); + fprintf(stderr, " b for break\n"); + return YAP_NO_SIGNAL; } } @@ -111,162 +111,146 @@ InteractSIGINT(int ch) { This function talks to the user about a signal. We assume we are in the context of the main Prolog thread (trivial in Unix, but hard in WIN32) */ -static yap_signals -ProcessSIGINT(void) -{ +static yap_signals ProcessSIGINT(void) { CACHE_REGS int ch, out; #if _WIN32 if (!_isatty(0)) { - return YAP_INT_SIGNAL; + return YAP_INT_SIGNAL; } #elif HAVE_ISATTY if (!isatty(0)) { - return YAP_INT_SIGNAL; + return YAP_INT_SIGNAL; } #endif LOCAL_PrologMode |= AsyncIntMode; do { - ch = Yap_GetCharForSIGINT(); + ch = Yap_GetCharForSIGINT(); } while (!(out = InteractSIGINT(ch))); LOCAL_PrologMode &= ~AsyncIntMode; - return(out); + return (out); } -inline static void -do_signal(int wid, yap_signals sig USES_REGS) -{ +inline static void do_signal(int wid, yap_signals sig USES_REGS) { #if THREADS - __sync_fetch_and_or ( &REMOTE(wid)->Signals_, SIGNAL_TO_BIT(sig)); + __sync_fetch_and_or(&REMOTE(wid)->Signals_, SIGNAL_TO_BIT(sig)); if (!REMOTE_InterruptsDisabled(wid)) { - REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ = - Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_); + REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ = + Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_); } #else LOCAL_Signals |= SIGNAL_TO_BIT(sig); if (!LOCAL_InterruptsDisabled) { - CreepFlag = - Unsigned(LCL0); + CreepFlag = Unsigned(LCL0); } #endif } - - -inline static int -get_signal(yap_signals sig USES_REGS) -{ +inline static bool get_signal(yap_signals sig USES_REGS) { #if THREADS uint64_t old; // first, clear the Creep Flag, now if someone sets it it is their problem - CalculateStackGap( PASS_REGS1 ); + CalculateStackGap(PASS_REGS1); // reset the flag - if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) != + if ((old = __sync_fetch_and_and(&LOCAL_Signals, ~SIGNAL_TO_BIT(sig))) != SIGNAL_TO_BIT(sig)) { - if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) { - CreepFlag = (CELL)LCL0; - } - if (!(old & SIGNAL_TO_BIT(sig)) ) { - // not there? - return FALSE; - } - // more likely case, we have other interrupts. - return TRUE; + if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) { + CreepFlag = (CELL)LCL0; + } + if (!(old & SIGNAL_TO_BIT(sig))) { + // not there? + return FALSE; + } + // more likely case, we have other interrupts. + return TRUE; } // success, we are good return TRUE; - // should we set the flag? +// should we set the flag? #else if (LOCAL_Signals & SIGNAL_TO_BIT(sig)) { - LOCAL_Signals &= ~SIGNAL_TO_BIT(sig); - if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) { - CreepFlag = (CELL)LCL0; - } else { - CalculateStackGap( PASS_REGS1 ); - } - return TRUE; + LOCAL_Signals &= ~SIGNAL_TO_BIT(sig); + if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) { + CreepFlag = (CELL)LCL0; + } else { + CalculateStackGap(PASS_REGS1); + } + return TRUE; } else { - return FALSE; + return FALSE; } #endif } /** - Function called to handle delayed interrupts. + Function called to handle delayed interrupts. */ -int -Yap_HandleInterrupts( void ) -{ +int Yap_HandleInterrupts(void) { CACHE_REGS yap_signals sig; - if ( get_signal( YAP_INT_SIGNAL PASS_REGS )) { - if ( (sig = ProcessSIGINT()) != YAP_NO_SIGNAL ) - do_signal(worker_id, sig PASS_REGS); - LOCAL_PrologMode &= ~InterruptMode; - return 1; + if (get_signal(YAP_INT_SIGNAL PASS_REGS)) { + if ((sig = ProcessSIGINT()) != YAP_NO_SIGNAL) + do_signal(worker_id, sig PASS_REGS); + LOCAL_PrologMode &= ~InterruptMode; + return 1; } return 0; } -static Int -p_creep( USES_REGS1 ) -{ - Atom at; - PredEntry *pred; +static Int p_creep(USES_REGS1) { + Atom at; + PredEntry *pred; at = AtomCreep; - pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); + pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1), 0)); CreepCode = pred; do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS); return TRUE; } -static Int -p_creep_fail( USES_REGS1 ) -{ - Atom at; - PredEntry *pred; +static Int p_creep_fail(USES_REGS1) { + Atom at; + PredEntry *pred; at = AtomCreep; - pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); + pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1), 0)); CreepCode = pred; do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS); return FALSE; } -static Int stop_creeping( USES_REGS1 ) -{ - get_signal( YAP_CREEP_SIGNAL PASS_REGS ); +static Int stop_creeping(USES_REGS1) { + if (get_signal(YAP_CREEP_SIGNAL PASS_REGS)) { + return Yap_unify(ARG1, TermTrue); + } + return Yap_unify(ARG1, TermFalse); +} + +static Int disable_debugging(USES_REGS1) { + get_signal(YAP_CREEP_SIGNAL PASS_REGS); return true; } -static Int -creep_allowed( USES_REGS1 ) -{ +static Int creep_allowed(USES_REGS1) { if (PP != NULL) { - get_signal(YAP_CREEP_SIGNAL PASS_REGS); - return true; + get_signal(YAP_CREEP_SIGNAL PASS_REGS); + return true; } return false; } -void -Yap_signal(yap_signals sig) -{ +void Yap_signal(yap_signals sig) { CACHE_REGS do_signal(worker_id, sig PASS_REGS); } #ifdef DEBUG -static Int -p_debug( USES_REGS1 ); +static Int p_debug(USES_REGS1); #endif -void -Yap_external_signal(int wid, yap_signals sig) -{ +void Yap_external_signal(int wid, yap_signals sig) { #if THREADS REGSTORE *regcache = REMOTE_ThreadHandle(wid).current_yaam_regs; #endif @@ -274,195 +258,177 @@ Yap_external_signal(int wid, yap_signals sig) LOCAL_PrologMode &= ~InterruptMode; } -int -Yap_get_signal__(yap_signals sig USES_REGS) -{ +int Yap_get_signal__(yap_signals sig USES_REGS) { return get_signal(sig PASS_REGS); } // the caller holds the lock. -int -Yap_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) -{ - return LOCAL_Signals & (SIGNAL_TO_BIT(sig1)|SIGNAL_TO_BIT(sig2)); +int Yap_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) { + return LOCAL_Signals & (SIGNAL_TO_BIT(sig1) | SIGNAL_TO_BIT(sig2)); } - -int -Yap_only_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) -{ - uint64_t sigs = LOCAL_Signals; +int Yap_only_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) { + uint64_t sigs = LOCAL_Signals; return sigs & (SIGNAL_TO_BIT(sig1) | SIGNAL_TO_BIT(sig2)) && - ! (sigs & ~(SIGNAL_TO_BIT(sig1) | SIGNAL_TO_BIT(sig2))) ; + !(sigs & ~(SIGNAL_TO_BIT(sig1) | SIGNAL_TO_BIT(sig2))); } #ifdef DEBUG volatile int volat = 0; -static Int -p_debug( USES_REGS1 ) -{ /* $debug(+Flag) */ - int i = IntOfTerm(Deref(ARG1)); +static Int p_debug(USES_REGS1) { /* $debug(+Flag) */ + int i = IntOfTerm(Deref(ARG1)); while (volat == 0) { } if (i >= 'a' && i <= 'z') GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96]; - return (1); + return 1; } void Yap_loop(void); void Yap_debug_end_loop(void); -void Yap_loop(void) -{ - while (volat == 0); +void Yap_loop(void) { + while (volat == 0) + ; } -void Yap_debug_end_loop(void) -{ - volat = 1; -} +void Yap_debug_end_loop(void) { volat = 1; } #endif -static Int -first_signal( USES_REGS1 ) -{ +static Int first_signal(USES_REGS1) { Atom at; yap_signals sig; while (TRUE) { - uint64_t mask = LOCAL_Signals; - if (mask == 0) - return FALSE; + uint64_t mask = LOCAL_Signals; + if (mask == 0) + return FALSE; #if HAVE___BUILTIN_FFSLL - sig = __builtin_ffsll(mask); + sig = __builtin_ffsll(mask); #elif HAVE_FFSLL - sig = ffsll(mask); + sig = ffsll(mask); #else - sig = Yap_msb( mask PASS_REGS)+1; + sig = Yap_msb(mask PASS_REGS) + 1; #endif - if (get_signal(sig PASS_REGS)) { - break; - } + if (get_signal(sig PASS_REGS)) { + break; + } } - loop: +loop: switch (sig) { - case YAP_INT_SIGNAL: - sig = ProcessSIGINT(); - if (sig == YAP_INT_SIGNAL) { - at = AtomSigInt; - break; - } - if (sig != YAP_NO_SIGNAL) - goto loop; - return FALSE; - case YAP_ABORT_SIGNAL: - /* abort computation */ - LOCAL_PrologMode &= ~AsyncIntMode; - if (LOCAL_PrologMode & (GCMode|ConsoleGetcMode|CritMode)) { - LOCAL_PrologMode |= AbortMode; - return -1; - } else { - Yap_Error(ABORT_EVENT, TermNil, "abort from console"); - } - Yap_RestartYap( 1 ); - return FALSE; - case YAP_CREEP_SIGNAL: - at = AtomSigCreep; - break; - case YAP_TRACE_SIGNAL: - at = AtomSigTrace; - break; - case YAP_DEBUG_SIGNAL: - at = AtomSigDebug; - break; - case YAP_BREAK_SIGNAL: - at = AtomSigBreak; - break; - case YAP_FAIL_SIGNAL: - at = AtomFail; - break; - case YAP_STACK_DUMP_SIGNAL: - at = AtomSigStackDump; - break; - case YAP_STATISTICS_SIGNAL: - at = AtomSigStatistics; + case YAP_INT_SIGNAL: + sig = ProcessSIGINT(); + if (sig == YAP_INT_SIGNAL) { + at = AtomSigInt; break; + } + if (sig != YAP_NO_SIGNAL) + goto loop; + return FALSE; + case YAP_ABORT_SIGNAL: + /* abort computation */ + LOCAL_PrologMode &= ~AsyncIntMode; + if (LOCAL_PrologMode & (GCMode | ConsoleGetcMode | CritMode)) { + LOCAL_PrologMode |= AbortMode; + return -1; + } else { + Yap_Error(ABORT_EVENT, TermNil, "abort from console"); + } + Yap_RestartYap(1); + return FALSE; + case YAP_CREEP_SIGNAL: + at = AtomSigCreep; + break; + case YAP_TRACE_SIGNAL: + at = AtomSigTrace; + break; + case YAP_DEBUG_SIGNAL: + at = AtomSigDebug; + break; + case YAP_BREAK_SIGNAL: + at = AtomSigBreak; + break; + case YAP_FAIL_SIGNAL: + at = AtomFail; + break; + case YAP_STACK_DUMP_SIGNAL: + at = AtomSigStackDump; + break; + case YAP_STATISTICS_SIGNAL: + at = AtomSigStatistics; + break; #ifdef SIGALRM - case YAP_ALARM_SIGNAL: + case YAP_ALARM_SIGNAL: #endif - case YAP_WINTIMER_SIGNAL: - at = AtomSigAlarm; - break; + case YAP_WINTIMER_SIGNAL: + at = AtomSigAlarm; + break; #ifdef SIGVTALRM - case YAP_VTALARM_SIGNAL: - at = AtomSigVTAlarm; - break; + case YAP_VTALARM_SIGNAL: + at = AtomSigVTAlarm; + break; #endif - case YAP_EXIT_SIGNAL: - Yap_exit(1); - return FALSE; - case YAP_WAKEUP_SIGNAL: - at = AtomSigWakeUp; - break; - case YAP_ITI_SIGNAL: - at = AtomSigIti; - break; + case YAP_EXIT_SIGNAL: + Yap_exit(1); + return FALSE; + case YAP_WAKEUP_SIGNAL: + at = AtomSigWakeUp; + break; + case YAP_ITI_SIGNAL: + at = AtomSigIti; + break; #ifdef SIGPIPE - case YAP_PIPE_SIGNAL: - at = AtomSigPipe; - break; + case YAP_PIPE_SIGNAL: + at = AtomSigPipe; + break; #endif #ifdef SIGHUP - case YAP_HUP_SIGNAL: - at = AtomSigHup; - break; + case YAP_HUP_SIGNAL: + at = AtomSigHup; + break; #endif #ifdef SIGUSR1 - case YAP_USR1_SIGNAL: - at = AtomSigUsr1; - break; + case YAP_USR1_SIGNAL: + at = AtomSigUsr1; + break; #endif #ifdef SIGUSR2 - case YAP_USR2_SIGNAL: - at = AtomSigUsr2; - break; + case YAP_USR2_SIGNAL: + at = AtomSigUsr2; + break; #endif #ifdef SIGFPE - case YAP_FPE_SIGNAL: - at = AtomSigFPE; - break; + case YAP_FPE_SIGNAL: + at = AtomSigFPE; + break; #endif - default: - return FALSE; + default: + return FALSE; } return Yap_unify(ARG1, MkAtomTerm(at)); } -static Int -continue_signals( USES_REGS1 ) -{ - return first_signal( PASS_REGS1 ); -} +static Int continue_signals(USES_REGS1) { return first_signal(PASS_REGS1); } -void -Yap_InitSignalCPreds(void) -{ +void Yap_InitSignalCPreds(void) { /* Basic predicates for the debugger */ Yap_InitCPred("$creep", 0, p_creep, SafePredFlag); Yap_InitCPred("$creep_fail", 0, p_creep_fail, SafePredFlag); - Yap_InitCPred("$stop_creeping", 0, stop_creeping, NoTracePredFlag|HiddenPredFlag|SafePredFlag); - Yap_InitCPred("$disable_debugging", 0, stop_creeping, NoTracePredFlag|HiddenPredFlag|SafePredFlag); - Yap_InitCPred ("$first_signal", 1, first_signal, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$continue_signals", 0, continue_signals, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$stop_creeping", 1, stop_creeping, + NoTracePredFlag | HiddenPredFlag | SafePredFlag); + Yap_InitCPred("$disable_debugging", 0, disable_debugging, + NoTracePredFlag | HiddenPredFlag | SafePredFlag); + Yap_InitCPred("$first_signal", 1, first_signal, SafePredFlag | SyncPredFlag); + Yap_InitCPred("$continue_signals", 0, continue_signals, + SafePredFlag | SyncPredFlag); Yap_InitCPred("creep_allowed", 0, creep_allowed, 0); #ifdef DEBUG - Yap_InitCPred("sys_debug", 1, p_debug, SafePredFlag|SyncPredFlag); + Yap_InitCPred("sys_debug", 1, p_debug, SafePredFlag | SyncPredFlag); #endif } -void *Yap_InitSignals(int wid) -{ - void *ptr = (void *)malloc(sizeof(UInt)*REMOTE_MaxActiveSignals(wid)); +void *Yap_InitSignals(int wid) { + void *ptr = (void *)malloc(sizeof(UInt) * REMOTE_MaxActiveSignals(wid)); return ptr; } diff --git a/C/stdpreds.c b/C/stdpreds.c index 8f30469da..9a17c2a0a 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -981,15 +982,7 @@ static PredEntry *firstModulePred(PredEntry *npp, Term task) { return npp; } -static PredEntry *firstModulesPred(PredEntry *npp, Term task) { - ModEntry *m; - if (npp) { - m = Yap_GetModuleEntry(npp->ModuleOfPred); - npp = npp->NextPredOfModule; - } else { - m = CurrentModules; - npp = m->PredForME; - } +static PredEntry *firstModulesPred(PredEntry *npp, ModEntry *m, Term task) { do { while (npp && !valid_prop(AbsPredProp(npp), task)) npp = npp->NextPredOfModule; @@ -998,7 +991,8 @@ static PredEntry *firstModulesPred(PredEntry *npp, Term task) { m = m->NextME; if (m) { npp = m->PredForME; - } + } else + return NULL; } while (npp || m); return npp; } @@ -1017,21 +1011,19 @@ static Int cont_current_predicate(USES_REGS1) { pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); if (IsNonVarTerm(t3)) { PropEntry *np, *p; - + if (IsNonVarTerm(t2)) { // module and functor known, should be easy if (IsAtomTerm(t2)) { if ((p = Yap_GetPredPropByAtom(AtomOfTerm(t3), t2)) && - valid_prop(p, task) - ) { + valid_prop(p, task)) { cut_succeed(); } else { cut_fail(); } } else { if ((p = Yap_GetPredPropByFunc(FunctorOfTerm(t3), t2)) && - valid_prop(p, task) - ) { + valid_prop(p, task)) { cut_succeed(); } else { cut_fail(); @@ -1050,19 +1042,21 @@ static Int cont_current_predicate(USES_REGS1) { if (p == NIL) cut_fail(); pp = RepPredProp(p); - } + } np = followLinkedListOfProps(p->NextOfPE, task); Term mod = pp->ModuleOfPred; if (mod == PROLOG_MODULE) mod = TermProlog; bool b = Yap_unify(t2, mod); if (!np) { - if (b) cut_succeed(); - else cut_fail(); + if (b) + cut_succeed(); + else + cut_fail(); } else { EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np)); B->cp_h = HR; - return b; + return b; } } else if (IsNonVarTerm(t1)) { PropEntry *np, *p; @@ -1080,6 +1074,7 @@ static Int cont_current_predicate(USES_REGS1) { p = getPredProp(RepAtom(at)->PropsOfAE, task); } else { Yap_Error(TYPE_ERROR_CALLABLE, t1, "current_predicate/2"); + return false; } if (!p) cut_fail(); @@ -1117,18 +1112,21 @@ static Int cont_current_predicate(USES_REGS1) { } } else { // operating across all modules. - PredEntry *npp; - + PredEntry *npp = pp; + ModEntry *me; if (!pp) { - pp = firstModulesPred(CurrentModules->PredForME, task); - if (!pp) - cut_fail(); + pp = firstModulesPred(CurrentModules->PredForME, CurrentModules, task); } - npp = firstModulesPred(pp, task); - + if (!pp) + cut_fail(); + if (pp->ModuleOfPred == PROLOG_MODULE) + me = Yap_GetModuleEntry(TermProlog); + else + me = Yap_GetModuleEntry(pp->ModuleOfPred); + npp = firstModulesPred(pp->NextPredOfModule, me, task); if (!npp) will_cut = true; - // just try next one + // just try next module. else { EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp); B->cp_h = HR; @@ -1800,9 +1798,7 @@ void Yap_InitCPreds(void) { #ifdef ANALYST Yap_InitAnalystPreds(); #endif -#ifdef LOW_LEVEL_TRACER Yap_InitLowLevelTrace(); -#endif Yap_InitEval(); Yap_InitGrowPreds(); Yap_InitLowProf(); diff --git a/C/threads.c b/C/threads.c index d8331ff9c..c1c3dc761 100644 --- a/C/threads.c +++ b/C/threads.c @@ -30,6 +30,7 @@ static char SccsId[] = "%W% %G%"; #include "yapio.h" #include "blobs.h" #include +#include #if HAVE_STRING_H #include #endif @@ -1565,7 +1566,9 @@ p_thread_unlock( USES_REGS1 ) intptr_t system_thread_id(void) { -#if HAVE_SYS_GETTID +#if defined(__APPLE__) + return syscall(SYS_thread_selfid); +#elif HAVE_SYS_GETTID || defined(__APPLE__) return syscall( SYS_GETTID ); #elif HAVE_GETTID_SYSCALL return syscall(__NR_gettid); diff --git a/C/tracer.c b/C/tracer.c index e91fffa53..c9df6b982 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -50,7 +50,8 @@ static void send_tracer_message(char *start, char *name, Int arity, char *mname, for (i = 0; i < arity; i++) { if (i > 0) fprintf(stderr, ","); - Yap_plwrite(args[i], NULL, 15, Handle_vars_f | AttVar_Portray_f, GLOBAL_MaxPriority); + Yap_plwrite(args[i], NULL, 15, Handle_vars_f | AttVar_Portray_f, + GLOBAL_MaxPriority); } if (arity) { fprintf(stderr, ")"); @@ -174,8 +175,8 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) { // if (!worker_id) return; LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; - // if (vsc_count == 161862) jmp_deb(1); -#ifdef THREADS +// if (vsc_count == 161862) jmp_deb(1); +#ifdef THREADS LOCAL_ThreadHandle.thread_inst_count++; #endif #ifdef COMMENTED @@ -319,7 +320,7 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) { printf("\n"); } #endif - fprintf(stderr, "%lld %ld ", vsc_count, LCL0-(CELL*)B); + fprintf(stderr, "%lld %ld ", vsc_count, LCL0 - (CELL *)B); #if defined(THREADS) || defined(YAPOR) fprintf(stderr, "(%d)", worker_id); #endif @@ -475,6 +476,8 @@ static Int vsc_go(USES_REGS1) { void Yap_InitLowLevelTrace(void) { Yap_InitCPred("start_low_level_trace", 0, start_low_level_trace, SafePredFlag); + Yap_InitCPred("$start_low_level_trace", 0, start_low_level_trace, + SafePredFlag); /** @pred start_low_level_trace @@ -488,6 +491,7 @@ Begin display of messages at procedure entry and retry. #endif 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("$stop_low_level_trace", 0, stop_low_level_trace, SafePredFlag); Yap_InitCPred("total_choicepoints", 1, total_choicepoints, SafePredFlag); Yap_InitCPred("reset_total_choicepoints", 0, reset_total_choicepoints, SafePredFlag); @@ -495,4 +499,14 @@ Begin display of messages at procedure entry and retry. Yap_InitCPred("vsc_go", 0, vsc_go, SafePredFlag); } +#else + +static null(USES_REGS1) { return true; } + +void Yap_InitLowLevelTrace(void) { + Yap_InitCPred("$start_low_level_trace", 0, null, + SafePredFlag | HiddenPredFlag); + Yap_InitCPred("$stop_low_level_trace", 0, null, + SafePredFlag | HiddenPredFlag); +} #endif diff --git a/C/write.c b/C/write.c index e2049a400..75f9a7090 100644 --- a/C/write.c +++ b/C/write.c @@ -444,26 +444,28 @@ static int legalAtom(unsigned char *s) /* Is this a legal atom ? */ return (s[1] == '}' && !s[2]); } else if (Yap_chtype[ch] == SL) { return (!s[1]); + } else if (ch == '`') { + return false; } else if ((ch == ',' || ch == '.') && !s[1]) { return false; } else { if (ch == '/') { if (s[1] == '*') - return FALSE; + return false; } while (ch) { if (Yap_chtype[ch] != SY) { - return FALSE; + return false; } ch = *++s; } } - return TRUE; + return true; } else while ((ch = *++s) != 0) if (Yap_chtype[ch] > NU) - return FALSE; - return (TRUE); + return false; + return true; } static wtype @@ -709,7 +711,7 @@ static Term from_pointer(CELL *ptr0, struct rewind_term *rwt, if (!IsAtomicTerm(t) && !IsVarTerm(t)) { while (x) { - if (Yap_GetDerefedFromSlot(x->u_sd.s.old PASS_REGS) == t) + if (Yap_GetDerefedFromSlot(x->u_sd.s.old) == t) return TermFoundVar; x = x->parent; } @@ -736,8 +738,8 @@ static CELL *restore_from_write(struct rewind_term *rwt, CELL *ptr; if (wglb->Keep_terms) { - ptr = (CELL *)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS); - Yap_RecoverSlots(2, rwt->u_sd.s.old PASS_REGS); + ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr ); + Yap_RecoverSlots(2, rwt->u_sd.s.old ); // printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ; } else { ptr = rwt->u_sd.d.ptr; @@ -1232,7 +1234,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, CACHE_REGS struct write_globs wglb; struct rewind_term rwt; - yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); + yhandle_t sls = Yap_CurrentSlot(); if (!mywrite) { CACHE_REGS diff --git a/CMakeLists.txt b/CMakeLists.txt index 8d97f1417..f94fd3167 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -28,14 +28,18 @@ set(YAP_MAJOR_VERSION 6) set(YAP_MINOR_VERSION 3) set(YAP_PATCH_VERSION 4) +set(YAP_SYSTEM_OPTIONS "attributed_variables" ) + if (WIN32) set (YAP_ARCH $ENV{PROCESSOR_ARCHITECTURE}) + set(YAP_SYSTEM_OPTIONS "windows " ${YAP_SYSTEM_OPTIONS}) endif() if (UNIX) find_program (UNAME uname) execute_process ( COMMAND ${UNAME} -m OUTPUT_VARIABLE YAP_ARCH OUTPUT_STRIP_TRAILING_WHITESPACE ) + set(YAP_SYSTEM_OPTIONS "unix " ${YAP_SYSTEM_OPTIONS}) endif() set(YAP_FULL_VERSION @@ -92,21 +96,22 @@ if (${CMAKE_SYSTEM_NAME} MATCHES "Darwin") #cmake_policy( NO_POLICY_SCOPE ) endif() +set (BUILD_SHARED_LIBS ON) ## define system include (Sources) -add_library(libYap SHARED +add_library(libYap ${ENGINE_SOURCES} ${C_INTERFACE_SOURCES} ${STATIC_SOURCES} ${OPTYAP_SOURCES} ${HEADERS} - $ + $ $ -# $ + $ ) set_property(DIRECTORY PROPERTY CXX_STANDARD 11) @@ -249,15 +254,14 @@ if (HAVE_GCC) endif (HAVE_GCC) # -set (BUILD_SHARED_LIBS ON) - #option (YAP_SWI_IO ON) OPTION (WITH_CALL_TRACER "support for procedure-call tracing" ON) #TODO: if (WITH_CALL_TRACER) - set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:LOW_LEVEL_TRACER=1> ) + set(YAP_SYSTEM_OPTIONS "call_tracer " ${YAP_SYSTEM_OPTIONS}) +set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:LOW_LEVEL_TRACER=1> ) endif (WITH_CALL_TRACER) #set( CMAKE_REQUIRED_LIBRARIES ${READLINE_LIBS} ${CMAKE_REQUIRED_LIBRARIES} ) @@ -275,6 +279,7 @@ macro_log_feature (GMP_FOUND "libgmp" "GNU big integers and rationals" "http://gmplib.org") + set(YAP_SYSTEM_OPTIONS "big_numbers " ${YAP_SYSTEM_OPTIONS}) if (GMP_FOUND) include_directories (${GMP_INCLUDE_DIR}) #add_executable(test ${SOURCES}) @@ -323,7 +328,8 @@ if (WITH_Threads) check_function_exists( pthread_mutexattr_settype HAVE_PTHREAD_MUTEXATTR_SETTYPE ) check_function_exists( pthread_setconcurrency HAVE_PTHREAD_SETCONCURRENCY ) endif (CMAKE_USE_PTHREADS_INIT) - set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS THREADS=1) + set(YAP_SYSTEM_OPTIONS "threads " ${YAP_SYSTEM_OPTIONS}) + set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS THREADS=1) # # 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 @@ -344,7 +350,6 @@ IF(WITH_Pthread_Lockin) set_DIRECTORY_properties(PROPERTIES APPEND COMPILE_DEFINITIONS USE_PTHREAD_LOCKING=1) ENDIF() - # # include OS and I/o stuff # @@ -353,7 +358,7 @@ ENDIF() # add_subDIRECTORY (OPTYap) -#add_subDIRECTORY (packages/myddas) +add_subDIRECTORY (packages/myddas) add_subDIRECTORY (os) @@ -369,6 +374,7 @@ ADD_SUBDIRECTORY(swi/library) # ADD_SUBDIRECTORY(os) # ADD_SUBDIRECTORY(packages) + option (WITH_JIT "just in Time Clause Compilation" OFF) if (WITH_JIT) @@ -397,7 +403,7 @@ add_subDIRECTORY (packages/cplint) add_subDIRECTORY (packages/raptor) -add_subDIRECTORY (docs) +# add_subDIRECTORY (docs) # add_subDIRECTORY (packages/cuda) diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index c245e85a5..9e766041a 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -428,7 +428,7 @@ YAPQuery::initQuery( YAPTerm ts[], arity_t arity ) if (arity) { q_g = Yap_NewSlots( arity ); for (arity_t i=0; i < arity; i++) { - Yap_PutInSlot(q_g+i, ts[i].term() PASS_REGS); + Yap_PutInSlot(q_g+i, ts[i].term()); } Term t = Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, Yap_AddressFromSlot(q_g)); goal = YAPTerm( t ); diff --git a/GitSHA1.c b/GitSHA1.c index fba88e3c2..f86684b38 100644 --- a/GitSHA1.c +++ b/GitSHA1.c @@ -1,2 +1,2 @@ -#define GIT_SHA1 "036876299f12a4761f8d1de2dfba9709d5c91739" +#define GIT_SHA1 "60a8efb467c383c47e440c3552cca7d179f66c2e" const char g_GIT_SHA1[] = GIT_SHA1; diff --git a/H/Yap.h b/H/Yap.h index e4e4adee2..58ca4a732 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -376,6 +376,17 @@ typedef volatile int lockvar; #include "Regs.h" +/************************************************************************************************* + OPTYAP includes +*************************************************************************************************/ + +#if defined(YAPOR) || defined(TABLING) +#include "opt.structs.h" +#include "opt.proto.h" +#include "opt.macros.h" +#endif /* YAPOR || TABLING */ + + /************************************************************************************************* variables concerned with Error Handling *************************************************************************************************/ @@ -733,17 +744,6 @@ typedef struct scratch_block_struct { /* scanner types */ #include "ScannerTypes.h" -/************************************************************************************************* - OPTYAP includes -*************************************************************************************************/ - -#if defined(YAPOR) || defined(TABLING) -#include "opt.structs.h" -#include "opt.proto.h" -#include "opt.macros.h" -#endif /* YAPOR || TABLING */ - - /************************************************************************************************* GLOBAL and LOCAL variables *************************************************************************************************/ @@ -771,10 +771,8 @@ extern struct worker_local Yap_local; #include #define YP_FILE FILE -#include "hglobals.h" -#include "dglobals.h" -#include "hlocals.h" -#include "dlocals.h" + +#include /************************************************************************************************* diff --git a/H/YapFlags.h b/H/YapFlags.h index 1265249bf..968257fbf 100644 --- a/H/YapFlags.h +++ b/H/YapFlags.h @@ -25,37 +25,66 @@ // INLINE_ONLY inline EXTERN bool nat( Term inp ); +#define SYSTEM_OPTION_0 "attributed_variables,rational_trees]" +#if THREADS +#define SYSTEM_OPTION_1 "threads," +#endif +#if USE_GMP +#define SYSTEM_OPTION_3 "big_numbers," +#endif +#if DEPTH_LIMIT +#define SYSTEM_OPTION_4 "depth_limit," +#endif +#if LOW_LEVEL_TRACE +#define SYSTEM_OPTION_5 "low_level_tracer," +#endif +#if YAPOR +#define SYSTEM_OPTION_6 "or_parallelism," +#endif +#if USE_READLINE +#define SYSTEM_OPTION_7 "readline," +#endif +#if TABLING +#define SYSTEM_OPTION_8 "tabling," +#endif + static inline bool nat(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", "bound"); + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", + "bound"); return false; } if (IsIntTerm(inp)) { Int i = IntOfTerm(inp); if (i >= 0) return true; - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp, "set_prolog_flag: value must be %s", ">= 0"); + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp, + "set_prolog_flag: value must be %s", ">= 0"); return false; } - Yap_Error(TYPE_ERROR_INTEGER, inp, "set_prolog_flag: value must be %s", "integer"); + Yap_Error(TYPE_ERROR_INTEGER, inp, "set_prolog_flag: value must be %s", + "integer"); return false; } static inline bool at2n(Term inp) { - Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", "flag is read-only"); + Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", + "flag is read-only"); return false; } static inline bool isfloat(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", "integer"); + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", + "integer"); return false; } if (IsFloatTerm(inp)) { return true; } - Yap_Error(TYPE_ERROR_FLOAT, inp, "set_prolog_flag: value must be %s", "floating-point"); + Yap_Error(TYPE_ERROR_FLOAT, inp, "set_prolog_flag: value must be %s", + "floating-point"); return false; } @@ -63,20 +92,24 @@ INLINE_ONLY inline EXTERN bool ro(Term inp); INLINE_ONLY inline EXTERN bool ro(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", "bound"); + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", + "bound"); return false; } - Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", "flag is read-only"); + Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", + "flag is read-only"); return false; } INLINE_ONLY inline EXTERN bool aro(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", "value must be bound"); + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", + "value must be bound"); return false; } - Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", "flag is read-only"); + Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag %s", + "flag is read-only"); return false; } @@ -87,8 +120,9 @@ static inline bool boolean(Term inp) { if (inp == TermTrue || inp == TermFalse || inp == TermOn || inp == TermOff) return true; if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", "value must be bound"); -; + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", + "value must be bound"); + ; return false; } if (IsAtomTerm(inp)) { @@ -134,7 +168,8 @@ static bool bqs(Term inp) { static inline bool isatom(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", "value must be bound"); + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s", + "value must be bound"); return false; } if (IsAtomTerm(inp)) @@ -143,6 +178,8 @@ static inline bool isatom(Term inp) { return false; } +static inline bool options(Term inp) { return Yap_IsGroundTerm(inp); } + // INLINE_ONLY inline EXTERN bool ok( Term inp ); static inline bool ok(Term inp) { return true; } diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 635115314..9e50f99de 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -63,7 +63,7 @@ Prolog exceptions. If enabled: ~~~~ ?- X is 2/0. ERROR!! -ZERO DIVISOR ERROR- X is Exp +ZERO DIVISO]]R ERROR- X is Exp ~~~~ If disabled: @@ -364,7 +364,7 @@ bound to `off` disable strict mode, and keep the current language mode. The default for YAP is `off`. Under strict ISO Prolog mode all calls to non-ISO built-ins generate an error. Compilation of clauses that would call non-ISO built-ins will -§§also generate errors. Pre-processing for grammar rules is also +also generate errors. Pre-processing for grammar rules is also disabled. Module expansion is still performed. Arguably, ISO Prolog does not provide all the functionality required from a modern Prolog system. Moreover, because most Prolog @@ -376,10 +376,9 @@ will work the same way in every Prolog and in every platform. We thus believe this mode is mostly useful when investigating how a program depends on a Prolog's platform specific features. -*/ - YAP_FLAG(SYSTEM_OPTIONS_FLAG, "system_options", false, ro, - "[big_numbers,coroutining,depth_limit,low_level_tracer,rational_" - "trees,threads,tabling]", + */ + YAP_FLAG(SYSTEM_OPTIONS_FLAG, "system_options", false, options, + SYSTEM_OPTIONS, NULL), /**< `system_options ` This read only flag tells which options were used to compile @@ -411,8 +410,8 @@ presented. Only the first solution is considered and the goal is not backtracked into. */ - YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, - "?- ", mkprompt), + YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ", + mkprompt), YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, boolean, "true", NULL), YAP_FLAG(UNIX_FLAG, "unix", false, ro, "true", NULL), /**< `unix` @@ -445,7 +444,8 @@ follows immediate semantics. Yap_unknown), /**< `unknown is iso` Corresponds to calling the unknown/2 built-in. Possible ISO values -are `error`, `fail`, and `warning`. Yap includes the following extensions: `fast_fail` does not invoke any handler. +are `error`, `fail`, and `warning`. Yap includes the following extensions: +`fast_fail` does not invoke any handler. */ YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG, "variable_names_may_end_with_quotes", true, boolean, "false", diff --git a/H/YapHandles.h b/H/YapHandles.h index 02239d1e0..06b3551fb 100755 --- a/H/YapHandles.h +++ b/H/YapHandles.h @@ -67,61 +67,80 @@ static inline void Yap_RebootSlots__(int wid USES_REGS) { /// @brief declares a new set of slots. /// Used to tell how many slots we had when we entered a segment of code. -//#define Yap_StartSlots() ( printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurSlot)?Yap_StartSlots__(PASS_REGS1): -1) +//#define Yap_StartSlots() ( +// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurSlot)?Yap_StartSlots__(PASS_REGS1): +//-1) #define Yap_StartSlots() Yap_StartSlots__(PASS_REGS1) -static inline yhandle_t Yap_StartSlots__(USES_REGS1) { +INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1); +INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1) { // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); - // fprintf(stderr,"SS %s:%d\n", __FUNCTION__, __LINE__);; + // fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);; if (LOCAL_CurSlot < 0) { Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartSlots = %ld", LOCAL_CurSlot); } return LOCAL_CurSlot; } - /// @brief reset slots to a well-known position in the stack -//#define Yap_CloseSlots(slot) ( printf("- %s,%s,%d %ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseSlots__(slot PASS_REGS):-1) +//#define Yap_CloseSlots(slot) ( printf("- %s,%s,%d +//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseSlots__(slot +// PASS_REGS):-1) #define Yap_CloseSlots(slot) Yap_CloseSlots__(slot PASS_REGS) -static inline void Yap_CloseSlots__(yhandle_t slot USES_REGS) { - // fprintf(stderr,"CS %s:%d\n", __FUNCTION__, __LINE__);; +INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS) { + // fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);; LOCAL_CurSlot = slot; } +#define Yap_CurrentSlot() Yap_CurrentSlot__(PASS_REGS1) /// @brief report the current position of the slots, assuming that they occupy /// the top of the stack. -static inline yhandle_t Yap_CurrentSlot(USES_REGS1) { return LOCAL_CurSlot; } +INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1); +INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1) { + return LOCAL_CurSlot; +} #define Yap_GetFromSlot(slot) Yap_GetFromSlot__(slot PASS_REGS) /// @brief read from a slot. -static inline Term Yap_GetFromSlot__(yhandle_t slot USES_REGS) { - // fprintf(stderr,"GS %s:%d\n", __FUNCTION__, __LINE__);; - return (Deref(LOCAL_SlotBase[slot])); +INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS) { + // fprintf(stderr, "GS %s:%d\n", __FILE__, __LINE__); + return Deref(LOCAL_SlotBase[slot]); } +#define Yap_GetDerefedFromSlot( slot ) Yap_GetDerefedFromSlot__(slot PASS_REGS) /// @brief read from a slot. but does not try to dereference the slot. -static inline Term Yap_GetDerefedFromSlot(yhandle_t slot USES_REGS) { - // fprintf(stderr,"GDS %s:%d\n", __FUNCTION__, __LINE__); +INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS) { + // fprintf(stderr,"GDS %s:%d\n", __FILE__, __LINE__); return LOCAL_SlotBase[slot]; } +#define Yap_GetPtrFromSlot( slot ) Yap_GetPtrFromSlot__(slot PASS_REGS) + /// @brief read the object in a slot. but do not try to dereference the slot. -static inline Term Yap_GetPtrFromSlot(yhandle_t slot USES_REGS) { - // fprintf(stderr,"GPS %s:%d\n", __FUNCTION__, __LINE__); - return LOCAL_SlotBase[slot]; +INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS) { + // fprintf(stderr,"GPS %s:%d\n", __FILE__, __LINE__); + return (Term *)LOCAL_SlotBase[slot]; } #define Yap_AddressFromSlot(slot) Yap_AddressFromSlot__(slot PASS_REGS) -/// @brief get the memory address of a slot -static inline Term *Yap_AddressFromSlot__(yhandle_t slot USES_REGS) { +INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS) { + /// @brief get the memory address of a slot + return LOCAL_SlotBase + slot; } +#define Yap_PutInSlot(slot, t) Yap_PutInSlot__(slot, t PASS_REGS) /// @brief store term in a slot -static inline void Yap_PutInSlot(yhandle_t slot, Term t USES_REGS) { - // fprintf(stderr,"PS %s:%d\n", __FUNCTION__, __LINE__); +INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS); +INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS) { + // fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__); LOCAL_SlotBase[slot] = t; } @@ -129,7 +148,7 @@ static inline void Yap_PutInSlot(yhandle_t slot, Term t USES_REGS) { #define max(X, Y) (X > Y ? X : Y) #endif -static inline void ensure_slots(int N USES_REGS) { +INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) { if (LOCAL_CurSlot + N >= LOCAL_NSlots) { size_t inc = max(16 * 1024, LOCAL_NSlots / 2); // measured in cells inc = max(inc, N + 16); // measured in cells @@ -147,12 +166,15 @@ static inline void ensure_slots(int N USES_REGS) { } /// @brief create a new slot with term t -//#define Yap_InitSlot(t) ( printf("+%d %s,%s,%d>>>]\n",1,__FILE__,__FUNCTION__,__LINE__)?Yap_InitSlot__(t PASS_REGS):-1) + // #define Yap_InitSlot(t) \ + // (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__) \ + // ? Yap_InitSlot__(t PASS_REGS) \ + // : -1) #define Yap_InitSlot(t) Yap_InitSlot__(t PASS_REGS) -static inline yhandle_t Yap_InitSlot__(Term t USES_REGS) { +INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; - // fprintf(stderr,"IS %s:%d\n", __FUNCTION__, __LINE__); ensure_slots(1 PASS_REGS); LOCAL_SlotBase[old_slots] = t; @@ -160,14 +182,14 @@ static inline yhandle_t Yap_InitSlot__(Term t USES_REGS) { return old_slots; } -//#define Yap_NewSlots(n) ( printf("+%d %s,%s,%d>>>]\n",n,__FILE__,__FUNCTION__,__LINE__)?Yap_NewSlots__(n PASS_REGS):-1) -#define Yap_NewSlots(n) Yap_NewSlots__(n PASS_REGS) +//#define Yap_NewSlots(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurSlot,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewSlots__(n PASS_REGS):-1) +#define Yap_NewSlots(n) Yap_NewSlots__(n PASS_REGS) -/// @brief allocate n empty new slots -static inline yhandle_t Yap_NewSlots__(int n USES_REGS) { +INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; int i; - // fprintf(stderr,"NS %s:%d\n", __FUNCTION__, __LINE__); + //fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__); ensure_slots(n PASS_REGS); for (i = 0; i < n; i++) { @@ -177,15 +199,17 @@ static inline yhandle_t Yap_NewSlots__(int n USES_REGS) { return old_slots; } -//#define Yap_InitSlots(n, ts) ( printf("+%d %s,%s,%d>>>]\n",n,__FILE__,__FUNCTION__,__LINE__)?Yap_InitSlots__(n, ts PASS_REGS):-1) +//#define Yap_InitSlots(n, ts) \ + // (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__) \ + // ? Yap_InitSlots__(n, ts PASS_REGS) \ + // : -1) #define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS) /// @brief create n new slots with terms ts[] -static inline yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS) { +INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS) { yhandle_t old_slots = LOCAL_CurSlot; int i; - // fprintf(stderr,"1S %s:%d\n", __FUNCTION__, __LINE__); - ensure_slots(n PASS_REGS); for (i = 0; i < n; i++) LOCAL_SlotBase[old_slots + i] = ts[i]; @@ -193,19 +217,23 @@ static inline yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS) { return old_slots; } +#define Yap_RecoverSlots(n, ts) Yap_RecoverSlots__(n, ts PASS_REGS) + /// @brief Succeeds if it is to recover the space allocated for $n$ contiguos /// slots starting at topSlot. -static inline bool Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS) { - if (topSlot+n < LOCAL_CurSlot) +static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS); +static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS) { + if (topSlot + n < LOCAL_CurSlot) return false; #ifdef DEBUG if (n > LOCAL_CurSlot) { - Yap_Error(SYSTEM_ERROR_INTERNAL, 0 , "Inconsistent slot state in Yap_RecoverSlots.", 0); + Yap_Error(SYSTEM_ERROR_INTERNAL, 0, + "Inconsistent slot state in Yap_RecoverSlots.", 0); return false; } #endif LOCAL_CurSlot -= n; -// fprintf(stderr,"RS %s:%d\n", __FUNCTION__, __LINE__); + //fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurSlot, __FILE__, __LINE__); return true; } diff --git a/H/YapHeap.h b/H/YapHeap.h index 5f84d0576..3eb2e2bdb 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -72,7 +72,7 @@ typedef struct swi_reverse_hash { //#define GC_MAVARS_HASH_SIZE 512 // -//typedef struct gc_ma_hash_entry_struct { +// typedef struct gc_ma_hash_entry_struct { // UInt timestmp; //#ifdef TABLING // tr_fr_ptr loc; @@ -85,12 +85,12 @@ typedef struct swi_reverse_hash { typedef void (*HaltHookFunc)(int, void *); typedef struct halt_hook { - void * environment; + void *environment; HaltHookFunc hook; struct halt_hook *next; } halt_hook_entry; -int Yap_HaltRegisterHook(HaltHookFunc, void *); +int Yap_HaltRegisterHook(HaltHookFunc, void *); typedef struct atom_hash_entry { #if defined(YAPOR) || defined(THREADS) @@ -99,7 +99,7 @@ typedef struct atom_hash_entry { Atom Entry; } AtomHashEntry; -//typedef struct scratch_block_struct { +// typedef struct scratch_block_struct { // char *ptr; // UInt sz, msz; //} scratch_block; @@ -112,7 +112,7 @@ typedef struct record_list { /* SWI Emulation */ #define SWI_BUF_SIZE 512 -#define SWI_TMP_BUF_SIZE 2*SWI_BUF_SIZE +#define SWI_TMP_BUF_SIZE 2 * SWI_BUF_SIZE #define SWI_BUF_RINGS 16 /* ricardo @@ -151,21 +151,51 @@ typedef struct thandle { } yap_thandle; #endif */ -//typedef int (*Agc_hook)(Atom); +// typedef int (*Agc_hook)(Atom); /******************* this is the data base: everything here should be possible to restore ********************/ +#if YAPOR typedef struct various_codes { /* memory allocation and management */ special_functors funcs; -#include "hstruct.h" +#include "heap/hstruct.h" } all_heap_codes; -//#include "hglobals.h" -//#include "hlocals.h" +#include "heap/hglobals.h" + +#include "heap/dhstruct.h" +#include "heap/dglobals.h" +#else +typedef struct various_codes { + /* memory allocation and management */ + special_functors funcs; + + #include "tatoms.h" + +} all_heap_codes; + +#if __INIT_C__ +#define EXTERNAL +#else +#define EXTERNAL extern +#endif + +#include "heap/h0struct.h" + +#include "heap/h0globals.h" + +#endif + +#include "heap/hlocals.h" + + + +#include "heap/dlocals.h" + /* ricardo #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) @@ -191,74 +221,56 @@ extern struct worker_local Yap_local; #ifdef USE_SYSTEM_MALLOC extern struct various_codes *Yap_heap_regs; #else -#define Yap_heap_regs ((all_heap_codes *)HEAP_INIT_BASE) +#define Yap_heap_regs ((all_heap_codes *)HEAP_INIT_BASE) #endif -#include "dhstruct.h" -//#include "dglobals.h" -//#include "dlocals.h" - /** * gc-P: how to start-up the grbage collector in C-code */ -static inline -yamop * -gc_P(yamop *p, yamop *cp) -{ - return (p->opc == EXECUTE_CPRED_OPCODE ? cp : p); +static inline yamop *gc_P(yamop *p, yamop *cp) { + return (p && p->opc == EXECUTE_CPRED_OPCODE ? cp : p); } - /** Yap_CurrentModule: access the current module for looking up predicates */ -#define Yap_CurrentModule() Yap_CurrentModule__ (PASS_REGS1) +#define Yap_CurrentModule() Yap_CurrentModule__(PASS_REGS1) -INLINE_ONLY inline EXTERN Term Yap_CurrentModule__ (USES_REGS1) ; +INLINE_ONLY inline EXTERN Term Yap_CurrentModule__(USES_REGS1); -INLINE_ONLY inline EXTERN Term -Yap_CurrentModule__ (USES_REGS1) -{ - if (CurrentModule) return CurrentModule; +INLINE_ONLY inline EXTERN Term Yap_CurrentModule__(USES_REGS1) { + if (CurrentModule) + return CurrentModule; return TermProlog; } - - /******************* these are the global variables: they need not be restored... ********************/ -#define UPDATE_MODE_IMMEDIATE 0 -#define UPDATE_MODE_LOGICAL 1 -#define UPDATE_MODE_LOGICAL_ASSERT 2 - - - +#define UPDATE_MODE_IMMEDIATE 0 +#define UPDATE_MODE_LOGICAL 1 +#define UPDATE_MODE_LOGICAL_ASSERT 2 /* initially allow for files with up to 1024 predicates. This number is extended whenever needed */ -#define InitialConsultCapacity 1024 +#define InitialConsultCapacity 1024 - -#if (defined(USE_SYSTEM_MALLOC) && HAVE_MALLINFO)||USE_DL_MALLOC +#if (defined(USE_SYSTEM_MALLOC) && HAVE_MALLINFO) || USE_DL_MALLOC UInt Yap_givemallinfo(void); #endif -ADDR Yap_ExpandPreAllocCodeSpace(UInt, void *, int); +ADDR Yap_ExpandPreAllocCodeSpace(UInt, void *, int); #define Yap_ReleasePreAllocCodeSpace(x) -ADDR Yap_InitPreAllocCodeSpace(int); +ADDR Yap_InitPreAllocCodeSpace(int); #include "inline-only.h" -INLINE_ONLY EXTERN inline ADDR -Yap_PreAllocCodeSpace(void); +INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void); -INLINE_ONLY EXTERN inline ADDR -Yap_PreAllocCodeSpace(void) -{ +INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void) { CACHE_REGS return AuxBase; } diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 640a30a92..6efa0cec4 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -22,7 +22,7 @@ YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, boolean, "false" , NULL ), YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ), -YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "text" , getenc ), +YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ), YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, boolean, "true" , NULL ), /**< `fileerrors` If `on` `fileerrors` is `on`, if `off` (default) diff --git a/H/YapText.h b/H/YapText.h index 68f9e45a1..37b624bff 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -56,7 +56,7 @@ typedef enum { extern char_kind_t Yap_chtype0[]; -#define Yap_chtype (Yap_chtype0+1) +#define Yap_chtype (Yap_chtype0 + 1) char_kind_t Yap_wide_chtype(int ch); @@ -483,8 +483,7 @@ static inline Term Yap_AtomToNumber(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM; out.val.uc = NULL; - out.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG; + out.type = YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; return out.val.t; @@ -1213,11 +1212,9 @@ static inline Term Yap_StringToNumber(Term t0 USES_REGS) { } static inline Term Yap_UTF8ToString(const char *s USES_REGS) { - return MkStringTerm( s ); + return MkStringTerm(s); } - - static inline Term Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS) { seq_tv_t inp, out; inp.val.w0 = s; diff --git a/H/Yapproto.h b/H/Yapproto.h index b4e6fd9a2..0e5bb1661 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -124,7 +124,7 @@ Atom Yap_ConsultingFile(USES_REGS1); struct pred_entry *Yap_PredForChoicePt(choiceptr bptr, op_numbers *op); void Yap_InitCdMgr(void); struct pred_entry *Yap_PredFromClause(Term t USES_REGS); -bool Yap_discontiguous(struct pred_entry *ap USES_REGS); +bool Yap_discontiguous(struct pred_entry *ap, Term mode USES_REGS); bool Yap_multiple(struct pred_entry *ap, int mode USES_REGS); void Yap_init_consult(int, const char *); void Yap_end_consult(void); @@ -136,6 +136,7 @@ void Yap_AssertzClause(struct pred_entry *, yamop *); void Yap_HidePred(struct pred_entry *pe); int Yap_SetNoTrace(char *name, UInt arity, Term tmod); bool Yap_unknown(Term tflagvalue); +struct pred_entry *Yap_MkLogPred(struct pred_entry *pe); /* cmppreds.c */ Int Yap_compare_terms(Term, Term); @@ -319,7 +320,7 @@ void Yap_InitModulesC(void); struct mod_entry *Yap_GetModuleEntry(Term tmod); Term Yap_GetModuleFromEntry(struct mod_entry *me); bool Yap_CharacterEscapes(Term mt); -bool Yap_constPred( struct pred_entry *pt); +bool Yap_constPred(struct pred_entry *pt); bool Yap_isSystemModule(Term mod); #if HAVE_MPI diff --git a/H/Yatom.h b/H/Yatom.h index 6fec98c1e..3cdffe2eb 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -22,521 +22,379 @@ #ifdef USE_OFFSETS -INLINE_ONLY inline EXTERN Atom AbsAtom (AtomEntry * p); +INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p); -INLINE_ONLY inline EXTERN Atom -AbsAtom (AtomEntry * p) -{ - return (Atom) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { + return (Atom)(Addr(p) - AtomBase); } +INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a); - -INLINE_ONLY inline EXTERN AtomEntry *RepAtom (Atom a); - -INLINE_ONLY inline EXTERN AtomEntry * -RepAtom (Atom a) -{ +INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) { return (AtomEntry *) (AtomBase + Unsigned (a); } - #else -INLINE_ONLY inline EXTERN Atom AbsAtom (AtomEntry * p); +INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p); -INLINE_ONLY inline EXTERN Atom -AbsAtom (AtomEntry * p) -{ - return (Atom) (p); +INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); } + +INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a); + +INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) { + return (AtomEntry *)(a); } - - -INLINE_ONLY inline EXTERN AtomEntry *RepAtom (Atom a); - -INLINE_ONLY inline EXTERN AtomEntry * -RepAtom (Atom a) -{ - return (AtomEntry *) (a); -} - - #endif #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN Prop AbsProp (PropEntry * p); +INLINE_ONLY inline EXTERN Prop AbsProp(PropEntry *p); -INLINE_ONLY inline EXTERN Prop -AbsProp (PropEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsProp(PropEntry *p) { + return (Prop)(Addr(p) - AtomBase); } +INLINE_ONLY inline EXTERN PropEntry *RepProp(Prop p); - -INLINE_ONLY inline EXTERN PropEntry *RepProp (Prop p); - -INLINE_ONLY inline EXTERN PropEntry * -RepProp (Prop p) -{ - return (PropEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN PropEntry *RepProp(Prop p) { + return (PropEntry *)(AtomBase + Unsigned(p)); } - #else -INLINE_ONLY inline EXTERN Prop AbsProp (PropEntry * p); +INLINE_ONLY inline EXTERN Prop AbsProp(PropEntry *p); -INLINE_ONLY inline EXTERN Prop -AbsProp (PropEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsProp(PropEntry *p) { return (Prop)(p); } + +INLINE_ONLY inline EXTERN PropEntry *RepProp(Prop p); + +INLINE_ONLY inline EXTERN PropEntry *RepProp(Prop p) { + return (PropEntry *)(p); } - - -INLINE_ONLY inline EXTERN PropEntry *RepProp (Prop p); - -INLINE_ONLY inline EXTERN PropEntry * -RepProp (Prop p) -{ - return (PropEntry *) (p); -} - - #endif #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp (Prop p); +INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp(Prop p); -INLINE_ONLY inline EXTERN FunctorEntry * -RepFunctorProp (Prop p) -{ - return (FunctorEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp(Prop p) { + return (FunctorEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsFunctorProp(FunctorEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsFunctorProp (FunctorEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsFunctorProp (FunctorEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsFunctorProp(FunctorEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp (Prop p); +INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp(Prop p); -INLINE_ONLY inline EXTERN FunctorEntry * -RepFunctorProp (Prop p) -{ - return (FunctorEntry *) (p); +INLINE_ONLY inline EXTERN FunctorEntry *RepFunctorProp(Prop p) { + return (FunctorEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsFunctorProp(FunctorEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsFunctorProp (FunctorEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsFunctorProp (FunctorEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsFunctorProp(FunctorEntry *p) { + return (Prop)(p); } - #endif +INLINE_ONLY inline EXTERN Int ArityOfFunctor(Functor); - INLINE_ONLY inline EXTERN Int ArityOfFunctor (Functor); - -INLINE_ONLY inline EXTERN Int -ArityOfFunctor (Functor Fun) -{ - return (Int) (((FunctorEntry *) Fun)->ArityOfFE); +INLINE_ONLY inline EXTERN Int ArityOfFunctor(Functor Fun) { + return (Int)(((FunctorEntry *)Fun)->ArityOfFE); } +INLINE_ONLY inline EXTERN Atom NameOfFunctor(Functor); - -INLINE_ONLY inline EXTERN Atom NameOfFunctor (Functor); - -INLINE_ONLY inline EXTERN Atom -NameOfFunctor (Functor Fun) -{ - return (Atom) (((FunctorEntry *) Fun)->NameOfFE); +INLINE_ONLY inline EXTERN Atom NameOfFunctor(Functor Fun) { + return (Atom)(((FunctorEntry *)Fun)->NameOfFE); } +INLINE_ONLY inline EXTERN PropFlags IsFunctorProperty(int); - - -INLINE_ONLY inline EXTERN PropFlags IsFunctorProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsFunctorProperty (int flags) -{ - return (PropFlags) ((flags == FunctorProperty)); +INLINE_ONLY inline EXTERN PropFlags IsFunctorProperty(int flags) { + return (PropFlags)((flags == FunctorProperty)); } - - /* summary of property codes used - 00 00 predicate entry - 80 00 db property - bb 00 functor entry - ff df sparse functor - ff ex arithmetic property - ff f4 translation - ff f5 blob - ff f6 hold - ff f7 array - ff f8 wide atom - ff fa module property - ff fb blackboard property - ff fc value property - ff fd global property - ff fe flag property - ff ff op property + 00 00 predicate entry + 80 00 db property + bb 00 functor entry + ff df sparse functor + ff ex arithmetic property + ff f4 translation + ff f5 blob + ff f6 hold + ff f7 array + ff f8 wide atom + ff fa module property + ff fb blackboard property + ff fc value property + ff fd global property + ff fe flag property + ff ff op property */ - -/* Global Variable property */ -typedef struct global_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +/* Global Variable property */ +typedef struct global_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t GRWLock; /* a simple lock to protect this entry */ + rwlock_t GRWLock; /* a simple lock to protect this entry */ #if THREADS - unsigned int owner_id; /* owner thread */ + unsigned int owner_id; /* owner thread */ #endif #endif struct AtomEntryStruct *AtomOfGE; /* parent atom for deletion */ - struct global_entry *NextGE; /* linked list of global entries */ - Term global; /* index in module table */ - Term AttChain; /* index in module table */ + struct global_entry *NextGE; /* linked list of global entries */ + Term global; /* index in module table */ + Term AttChain; /* index in module table */ } GlobalEntry; - #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp (Prop p); +INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp(Prop p); -INLINE_ONLY inline EXTERN GlobalEntry * -RepGlobalProp (Prop p) -{ - return (GlobalEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp(Prop p) { + return (GlobalEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsGlobalProp(GlobalEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsGlobalProp (GlobalEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsGlobalProp (GlobalEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsGlobalProp(GlobalEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp (Prop p); +INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp(Prop p); -INLINE_ONLY inline EXTERN GlobalEntry * -RepGlobalProp (Prop p) -{ - return (GlobalEntry *) (p); +INLINE_ONLY inline EXTERN GlobalEntry *RepGlobalProp(Prop p) { + return (GlobalEntry *)(p); } -INLINE_ONLY inline EXTERN Prop AbsGlobalProp (GlobalEntry * p); +INLINE_ONLY inline EXTERN Prop AbsGlobalProp(GlobalEntry *p); -INLINE_ONLY inline EXTERN Prop -AbsGlobalProp (GlobalEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsGlobalProp(GlobalEntry *p) { + return (Prop)(p); } - #endif -#define GlobalProperty ((PropFlags)0xfffd) +#define GlobalProperty ((PropFlags)0xfffd) -INLINE_ONLY inline EXTERN PropFlags IsGlobalProperty (int); +INLINE_ONLY inline EXTERN PropFlags IsGlobalProperty(int); -INLINE_ONLY inline EXTERN PropFlags -IsGlobalProperty (int flags) -{ - return (PropFlags) ((flags == GlobalProperty)); +INLINE_ONLY inline EXTERN PropFlags IsGlobalProperty(int flags) { + return (PropFlags)((flags == GlobalProperty)); } - /* Wide Atom property */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - UInt SizeOfAtom; /* index in module table */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + UInt SizeOfAtom; /* index in module table */ } WideAtomEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp (Prop p); +INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p); -INLINE_ONLY inline EXTERN WideAtomEntry * -RepWideAtomProp (Prop p) -{ - return (WideAtomEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p) { + return (WideAtomEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsWideAtomProp (WideAtomEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsWideAtomProp (WideAtomEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp (Prop p); +INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p); -INLINE_ONLY inline EXTERN WideAtomEntry * -RepWideAtomProp (Prop p) -{ - return (WideAtomEntry *) (p); +INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p) { + return (WideAtomEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsWideAtomProp (WideAtomEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsWideAtomProp (WideAtomEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p) { + return (Prop)(p); } - #endif -#define WideAtomProperty ((PropFlags)0xfff8) +#define WideAtomProperty ((PropFlags)0xfff8) +INLINE_ONLY inline EXTERN PropFlags IsWideAtomProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsWideAtomProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsWideAtomProperty (int flags) -{ - return (PropFlags) ((flags == WideAtomProperty)); +INLINE_ONLY inline EXTERN PropFlags IsWideAtomProperty(int flags) { + return (PropFlags)((flags == WideAtomProperty)); } -INLINE_ONLY inline EXTERN int IsWideAtom (Atom); +INLINE_ONLY inline EXTERN int IsWideAtom(Atom); -INLINE_ONLY inline EXTERN int -IsWideAtom (Atom at) -{ +INLINE_ONLY inline EXTERN int IsWideAtom(Atom at) { return RepAtom(at)->PropsOfAE && - IsWideAtomProperty(RepWideAtomProp(RepAtom(at)->PropsOfAE)->KindOfPE); + IsWideAtomProperty(RepWideAtomProp(RepAtom(at)->PropsOfAE)->KindOfPE); } - /* Module property */ -typedef struct mod_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - struct pred_entry *PredForME; /* index in module table */ - Atom AtomOfME; /* module's name */ +typedef struct mod_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + struct pred_entry *PredForME; /* index in module table */ + Atom AtomOfME; /* module's name */ + Atom OwnerFile; /* module's owner file */ #if defined(YAPOR) || defined(THREADS) - rwlock_t ModRWLock; /* a read-write lock to protect the entry */ + rwlock_t ModRWLock; /* a read-write lock to protect the entry */ #endif - unsigned int flags; /* Module local flags (from SWI compat) */ - struct mod_entry *NextME; /* next module */ + unsigned int flags; /* Module local flags (from SWI compat) */ + struct mod_entry *NextME; /* next module */ } ModEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN ModEntry *RepModProp (Prop p); +INLINE_ONLY inline EXTERN ModEntry *RepModProp(Prop p); -INLINE_ONLY inline EXTERN ModEntry * -RepModProp (Prop p) -{ - return (ModEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN ModEntry *RepModProp(Prop p) { + return (ModEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsModProp(ModEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsModProp (ModEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsModProp (ModEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsModProp(ModEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN ModEntry *RepModProp (Prop p); +INLINE_ONLY inline EXTERN ModEntry *RepModProp(Prop p); -INLINE_ONLY inline EXTERN ModEntry * -RepModProp (Prop p) -{ - return (ModEntry *) (p); +INLINE_ONLY inline EXTERN ModEntry *RepModProp(Prop p) { + return (ModEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsModProp(ModEntry *p); +INLINE_ONLY inline EXTERN Prop AbsModProp(ModEntry *p) { return (Prop)(p); } -INLINE_ONLY inline EXTERN Prop AbsModProp (ModEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsModProp (ModEntry * p) -{ - return (Prop) (p); -} - -#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m ) +#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m) #endif -#define ModProperty ((PropFlags)0xfffa) +#define ModProperty ((PropFlags)0xfffa) +INLINE_ONLY inline EXTERN PropFlags IsModProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsModProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsModProperty (int flags) -{ - return (PropFlags) ((flags == ModProperty)); +INLINE_ONLY inline EXTERN PropFlags IsModProperty(int flags) { + return (PropFlags)((flags == ModProperty)); } /* Flags on module. Most of these flags are copied to the read context in pl-read.c. */ -#define M_SYSTEM (0x0001) /* system module */ -#define M_CHARESCAPE (0x0002) /* module */ -#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */ -#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */ -#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */ -#define DBLQ_CODES (0x0020) /* "ab" --> [0'a, 0'b] */ -#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING|DBLQ_CODES) -#define BCKQ_CHARS (0x0040) /* `ab` --> ['a', 'b'] */ -#define BCKQ_ATOM (0x0080) /* `ab` --> 'ab' */ -#define BCKQ_STRING (0x0100) /* `ab` --> "ab" */ -#define BCKQ_CODES (0x0200) /* `ab` --> [0'a, 0'b] */ -#define BCKQ_MASK (BCKQ_CHARS|BCKQ_ATOM|BCKQ_STRING|BCKQ_CODES) -#define UNKNOWN_FAIL (0x0400) /* module */ -#define UNKNOWN_WARNING (0x0800) /* module */ -#define UNKNOWN_ERROR (0x1000) /* module */ -#define UNKNOWN_FAST_FAIL (0x2000) /* module */ -#define UNKNOWN_ABORT (0x4000) /* module */ -#define UNKNOWN_HALT (0x8000) /* module */ -#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL|UNKNOWN_FAST_FAIL|UNKNOWN_ABORT|UNKNOWN_HALT ) +#define M_SYSTEM (0x0001) /* system module */ +#define M_CHARESCAPE (0x0002) /* module */ +#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */ +#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */ +#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */ +#define DBLQ_CODES (0x0020) /* "ab" --> [0'a, 0'b] */ +#define DBLQ_MASK (DBLQ_CHARS | DBLQ_ATOM | DBLQ_STRING | DBLQ_CODES) +#define BCKQ_CHARS (0x0040) /* `ab` --> ['a', 'b'] */ +#define BCKQ_ATOM (0x0080) /* `ab` --> 'ab' */ +#define BCKQ_STRING (0x0100) /* `ab` --> "ab" */ +#define BCKQ_CODES (0x0200) /* `ab` --> [0'a, 0'b] */ +#define BCKQ_MASK (BCKQ_CHARS | BCKQ_ATOM | BCKQ_STRING | BCKQ_CODES) +#define UNKNOWN_FAIL (0x0400) /* module */ +#define UNKNOWN_WARNING (0x0800) /* module */ +#define UNKNOWN_ERROR (0x1000) /* module */ +#define UNKNOWN_FAST_FAIL (0x2000) /* module */ +#define UNKNOWN_ABORT (0x4000) /* module */ +#define UNKNOWN_HALT (0x8000) /* module */ +#define UNKNOWN_MASK \ + (UNKNOWN_ERROR | UNKNOWN_WARNING | UNKNOWN_FAIL | UNKNOWN_FAST_FAIL | \ + UNKNOWN_ABORT | UNKNOWN_HALT) + +Term Yap_getUnknownModule(ModEntry *m); +void Yap_setModuleFlags(ModEntry *n, ModEntry *o); -Term Yap_getUnknownModule(ModEntry *m); -void Yap_setModuleFlags(ModEntry *n, ModEntry *o); - /* operator property entry structure */ -typedef struct operator_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +typedef struct operator_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t OpRWLock; /* a read-write lock to protect the entry */ + rwlock_t OpRWLock; /* a read-write lock to protect the entry */ #endif - Atom OpName; /* atom name */ - Term OpModule; /* module of predicate */ - struct operator_entry *OpNext; /* next in list of operators */ - BITS16 Prefix, Infix, Posfix; /* precedences */ + Atom OpName; /* atom name */ + Term OpModule; /* module of predicate */ + struct operator_entry *OpNext; /* next in list of operators */ + BITS16 Prefix, Infix, Posfix; /* precedences */ } OpEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN OpEntry *RepOpProp (Prop p); +INLINE_ONLY inline EXTERN OpEntry *RepOpProp(Prop p); -INLINE_ONLY inline EXTERN OpEntry * -RepOpProp (Prop p) -{ - return (OpEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN OpEntry *RepOpProp(Prop p) { + return (OpEntry *)(AtomBase + Unsigned(p)); } -INLINE_ONLY inline EXTERN Prop AbsOpProp (OpEntry * p); +INLINE_ONLY inline EXTERN Prop AbsOpProp(OpEntry *p); -INLINE_ONLY inline EXTERN Prop -AbsOpProp (OpEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsOpProp(OpEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN OpEntry *RepOpProp (Prop p); +INLINE_ONLY inline EXTERN OpEntry *RepOpProp(Prop p); -INLINE_ONLY inline EXTERN OpEntry * -RepOpProp (Prop p) -{ - return (OpEntry *) (p); -} +INLINE_ONLY inline EXTERN OpEntry *RepOpProp(Prop p) { return (OpEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsOpProp(OpEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsOpProp (OpEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsOpProp (OpEntry * p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsOpProp(OpEntry *p) { return (Prop)(p); } #endif -#define OpProperty ((PropFlags)0xffff) +#define OpProperty ((PropFlags)0xffff) +INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsOpProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsOpProperty (int flags) -{ - return (PropFlags) ((flags == OpProperty)); +INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int flags) { + return (PropFlags)((flags == OpProperty)); } -typedef enum -{ - INFIX_OP = 0, - POSFIX_OP = 1, - PREFIX_OP = 2 -} op_type; +typedef enum { INFIX_OP = 0, POSFIX_OP = 1, PREFIX_OP = 2 } op_type; +OpEntry *Yap_GetOpProp(Atom, op_type CACHE_TYPE); - OpEntry *Yap_GetOpProp(Atom, op_type CACHE_TYPE); - -int Yap_IsPrefixOp(Atom,int *,int *); -int Yap_IsOp(Atom); -int Yap_IsInfixOp(Atom,int *,int *,int *); -int Yap_IsPosfixOp(Atom,int *,int *); +int Yap_IsPrefixOp(Atom, int *, int *); +int Yap_IsOp(Atom); +int Yap_IsInfixOp(Atom, int *, int *, int *); +int Yap_IsPosfixOp(Atom, int *, int *); /* defines related to operator specifications */ -#define MaskPrio 0x0fff -#define DcrlpFlag 0x1000 -#define DcrrpFlag 0x2000 +#define MaskPrio 0x0fff +#define DcrlpFlag 0x1000 +#define DcrrpFlag 0x2000 typedef union arith_ret *eval_ret; /* expression property entry structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ unsigned int ArityOfEE; BITS16 ENoOfEE; BITS16 FlagsOfEE; @@ -545,205 +403,189 @@ typedef struct } ExpEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN ExpEntry *RepExpProp (Prop p); +INLINE_ONLY inline EXTERN ExpEntry *RepExpProp(Prop p); -INLINE_ONLY inline EXTERN ExpEntry * -RepExpProp (Prop p) -{ - return (ExpEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN ExpEntry *RepExpProp(Prop p) { + return (ExpEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsExpProp(ExpEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsExpProp (ExpEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsExpProp (ExpEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsExpProp(ExpEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN ExpEntry *RepExpProp (Prop p); +INLINE_ONLY inline EXTERN ExpEntry *RepExpProp(Prop p); -INLINE_ONLY inline EXTERN ExpEntry * -RepExpProp (Prop p) -{ - return (ExpEntry *) (p); +INLINE_ONLY inline EXTERN ExpEntry *RepExpProp(Prop p) { + return (ExpEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsExpProp(ExpEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsExpProp (ExpEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsExpProp (ExpEntry * p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsExpProp(ExpEntry *p) { return (Prop)(p); } #endif -#define ExpProperty 0xffe0 +#define ExpProperty 0xffe0 /* only unary and binary expressions are acceptable */ -INLINE_ONLY inline EXTERN PropFlags IsExpProperty (int); +INLINE_ONLY inline EXTERN PropFlags IsExpProperty(int); -INLINE_ONLY inline EXTERN PropFlags -IsExpProperty (int flags) -{ - return (PropFlags) ((flags == ExpProperty)); +INLINE_ONLY inline EXTERN PropFlags IsExpProperty(int flags) { + return (PropFlags)((flags == ExpProperty)); } - - - /* value property entry structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t VRWLock; /* a read-write lock to protect the entry */ + rwlock_t VRWLock; /* a read-write lock to protect the entry */ #endif - Term ValueOfVE; /* (atomic) value associated with the atom */ + Term ValueOfVE; /* (atomic) value associated with the atom */ } ValEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN ValEntry *RepValProp (Prop p); +INLINE_ONLY inline EXTERN ValEntry *RepValProp(Prop p); -INLINE_ONLY inline EXTERN ValEntry * -RepValProp (Prop p) -{ - return (ValEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN ValEntry *RepValProp(Prop p) { + return (ValEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsValProp(ValEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsValProp (ValEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsValProp (ValEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsValProp(ValEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN ValEntry *RepValProp (Prop p); +INLINE_ONLY inline EXTERN ValEntry *RepValProp(Prop p); -INLINE_ONLY inline EXTERN ValEntry * -RepValProp (Prop p) -{ - return (ValEntry *) (p); +INLINE_ONLY inline EXTERN ValEntry *RepValProp(Prop p) { + return (ValEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsValProp(ValEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsValProp (ValEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsValProp (ValEntry * p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsValProp(ValEntry *p) { return (Prop)(p); } #endif -#define ValProperty ((PropFlags)0xfffc) - - +#define ValProperty ((PropFlags)0xfffc) /* predicate property entry structure */ /* AsmPreds are things like var, nonvar, atom ...which are implemented - through dedicated machine instructions. In this case the 8 lower - bits of PredFlags are used to hold the machine instruction code - for the pred. + through dedicated machine instructions. In this case the 8 lower + bits of PredFlags are used to hold the machine instruction code + for the pred. C_Preds are things write, read, ... implemented in C. In this case - CodeOfPred holds the address of the correspondent C-function. + CodeOfPred holds the address of the correspondent C-function. don't forget to also add in qly.h */ - typedef uint64_t pred_flags_t; +typedef uint64_t pred_flags_t; - -#define DiscontiguousPredFlag ((pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over the place.. */ +#define DiscontiguousPredFlag \ + (( \ + pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over \ + the place.. */ #define SysExportPredFlag ((pred_flags_t)0x800000000) /* reuse export list to prolog module. */ -#define NoTracePredFlag ((pred_flags_t)0x400000000) /* cannot trace this predicate */ -#define NoSpyPredFlag ((pred_flags_t)0x200000000) /* cannot spy this predicate */ -#define QuasiQuotationPredFlag ((pred_flags_t)0x100000000) /* SWI-like quasi quotations */ -#define MegaClausePredFlag ((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */ -#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */ -#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */ -#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user */ -#define LogUpdatePredFlag ((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */ -#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */ -#define CountPredFlag ((pred_flags_t)0x02000000) /* count calls to pred */ -#define HiddenPredFlag ((pred_flags_t)0x01000000) /* invisible predicate */ -#define CArgsPredFlag ((pred_flags_t)0x00800000) /* SWI-like C-interface pred. */ -#define SourcePredFlag ((pred_flags_t)0x00400000) /* static predicate with source declaration */ -#define MetaPredFlag ((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */ -#define SyncPredFlag ((pred_flags_t)0x00100000) /* has to synch before it can execute */ -#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for a number key */ -#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for an atom key */ - // #define GoalExPredFlag ((pred_flags_t)0x00020000) /* predicate that is called by goal_expand */ -#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */ -#define AsmPredFlag ((pred_flags_t)0x00008000) /* inline */ -#define StandardPredFlag ((pred_flags_t)0x00004000) /* system predicate */ -#define DynamicPredFlag ((pred_flags_t)0x00002000) /* dynamic predicate */ -#define CPredFlag ((pred_flags_t)0x00001000) /* written in C */ -#define SafePredFlag ((pred_flags_t)0x00000800) /* does not alter arguments */ -#define CompiledPredFlag ((pred_flags_t)0x00000400) /* is static */ -#define IndexedPredFlag ((pred_flags_t)0x00000200) /* has indexing code */ -#define SpiedPredFlag ((pred_flags_t)0x00000100) /* is a spy point */ -#define BinaryPredFlag ((pred_flags_t)0x00000080) /* test predicate */ -#define TabledPredFlag ((pred_flags_t)0x00000040) /* is tabled */ -#define SequentialPredFlag ((pred_flags_t)0x00000020) /* may not create parallel choice points! */ -#define ProfiledPredFlag ((pred_flags_t)0x00000010) /* pred is being profiled */ -#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred */ -#define ModuleTransparentPredFlag ((pred_flags_t)0x00000004) /* ModuleTransparent pred */ -#define SWIEnvPredFlag ((pred_flags_t)0x00000002) /* new SWI interface */ -#define UDIPredFlag ((pred_flags_t)0x00000001) /* User Defined Indexing */ +#define NoTracePredFlag \ + ((pred_flags_t)0x400000000) /* cannot trace this predicate */ +#define NoSpyPredFlag \ + ((pred_flags_t)0x200000000) /* cannot spy this predicate */ +#define QuasiQuotationPredFlag \ + ((pred_flags_t)0x100000000) /* SWI-like quasi quotations */ +#define MegaClausePredFlag \ + ((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */ +#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */ +#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */ +#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user \ + */ +#define LogUpdatePredFlag \ + ((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */ +#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */ +#define CountPredFlag ((pred_flags_t)0x02000000) /* count calls to pred */ +#define HiddenPredFlag ((pred_flags_t)0x01000000) /* invisible predicate */ +#define CArgsPredFlag \ + ((pred_flags_t)0x00800000) /* SWI-like C-interface pred. */ +#define SourcePredFlag \ + ((pred_flags_t)0x00400000) /* static predicate with source declaration */ +#define MetaPredFlag \ + ((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */ +#define SyncPredFlag \ + ((pred_flags_t)0x00100000) /* has to synch before it can execute */ +#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for an atom key \ + */ +#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for a number key */ +// #define GoalExPredFlag ((pred_flags_t)0x00020000) /// predicate that is +// called by goal_expand */ +#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */ +#define AsmPredFlag ((pred_flags_t)0x00008000) /* inline */ +#define StandardPredFlag ((pred_flags_t)0x00004000) /* system predicate */ +#define DynamicPredFlag ((pred_flags_t)0x00002000) /* dynamic predicate */ +#define CPredFlag ((pred_flags_t)0x00001000) /* written in C */ +#define SafePredFlag ((pred_flags_t)0x00000800) /* does not alter arguments */ +#define CompiledPredFlag ((pred_flags_t)0x00000400) /* is static */ +#define IndexedPredFlag ((pred_flags_t)0x00000200) /* has indexing code */ +#define SpiedPredFlag ((pred_flags_t)0x00000100) /* is a spy point */ +#define BinaryPredFlag ((pred_flags_t)0x00000080) /* test predicate */ +#define TabledPredFlag ((pred_flags_t)0x00000040) /* is tabled */ +#define SequentialPredFlag \ + ((pred_flags_t)0x00000020) /* may not create parallel choice points! */ +#define ProfiledPredFlag \ + ((pred_flags_t)0x00000010) /* pred is being profiled */ +#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred \ + */ +#define ModuleTransparentPredFlag \ + ((pred_flags_t)0x00000004) /* ModuleTransparent pred */ +#define SWIEnvPredFlag ((pred_flags_t)0x00000002) /* new SWI interface */ +#define UDIPredFlag ((pred_flags_t)0x00000001) /* User Defined Indexing */ + +#define SystemPredFlags \ + (AsmPredFlag | StandardPredFlag | CPredFlag | BinaryPredFlag | BackCPredFlag) +#define ForeignPredFlags \ + (AsmPredFlag | SWIEnvPredFlag | CPredFlag | BinaryPredFlag | UDIPredFlag | CArgsPredFlag | UserCPredFlag|SafePredFlag|BackCPredFlag) + +#define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag ) +#define is_system(pe) (pe->PredFlags & SystemPredFlags) +#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag) +#define is_static(pe) (pe->PredFlags & CompiledPredFlag) +#define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag) +#ifdef TABLING +#define is_tabled(pe) (pe->PredFlags & TabledPredFlag) +#endif /* TABLING */ /* profile data */ -typedef struct -{ - UInt NOfEntries; /* nbr of times head unification succeeded */ - UInt NOfHeadSuccesses; /* nbr of times head unification succeeded */ - UInt NOfRetries; /* nbr of times a clause for the pred - was retried */ +typedef struct { + UInt NOfEntries; /* nbr of times head unification succeeded */ + UInt NOfHeadSuccesses; /* nbr of times head unification succeeded */ + UInt NOfRetries; /* nbr of times a clause for the pred + was retried */ #if defined(YAPOR) || defined(THREADS) - lockvar lock; /* a simple lock to protect this entry */ + lockvar lock; /* a simple lock to protect this entry */ #endif } profile_data; -typedef enum { - LUCALL_EXEC, - LUCALL_ASSERT, - LUCALL_RETRACT -} timestamp_type; +typedef enum { LUCALL_EXEC, LUCALL_ASSERT, LUCALL_RETRACT } timestamp_type; -#define TIMESTAMP_EOT ((UInt)(~0L)) -#define TIMESTAMP_RESET (TIMESTAMP_EOT-1024) +#define TIMESTAMP_EOT ((UInt)(~0L)) +#define TIMESTAMP_RESET (TIMESTAMP_EOT - 1024) - typedef struct pred_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +typedef struct pred_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ struct yami *CodeOfPred; - OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ + OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ pred_flags_t PredFlags; - UInt ArityOfPE; /* arity of property */ - union - { - struct - { - struct yami *TrueCodeOfPred; /* code address */ + UInt ArityOfPE; /* arity of property */ + union { + struct { + struct yami *TrueCodeOfPred; /* code address */ struct yami *FirstClause; struct yami *LastClause; UInt NOfClauses; @@ -751,344 +593,274 @@ typedef enum { } p_code; CPredicate f_code; CmpPredicate d_code; - } cs; /* if needing to spy or to lock */ - Functor FunctorOfPred; /* functor for Predicate */ - union - { - Atom OwnerFile; /* File where the predicate was defined */ - Int IndxId; /* Index for a certain key */ + } cs; /* if needing to spy or to lock */ + Functor FunctorOfPred; /* functor for Predicate */ + union { + Atom OwnerFile; /* File where the predicate was defined */ + Int IndxId; /* Index for a certain key */ } src; #if defined(YAPOR) || defined(THREADS) - lockvar PELock; /* a simple lock to protect expansion */ + lockvar PELock; /* a simple lock to protect expansion */ #endif #ifdef TABLING tab_ent_ptr TableOfPred; -#endif /* TABLING */ +#endif /* TABLING */ #ifdef BEAM struct Predicates *beamTable; #endif - Term ModuleOfPred; /* module for this definition */ + Term ModuleOfPred; /* module for this definition */ UInt TimeStampOfPred; timestamp_type LastCallOfPred; /* This must be at an odd number of cells, otherwise it will not be aligned on RISC machines */ - profile_data *StatisticsForPred; /* enable profiling for predicate */ - struct pred_entry *NextPredOfModule; /* next pred for same module */ - struct pred_entry *NextPredOfHash ; /* next pred for same module */ - } PredEntry; -#define PEProp ((PropFlags)(0x0000)) + profile_data *StatisticsForPred; /* enable profiling for predicate */ + struct pred_entry *NextPredOfModule; /* next pred for same module */ + struct pred_entry *NextPredOfHash; /* next pred for same module */ +} PredEntry; +#define PEProp ((PropFlags)(0x0000)) #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN PredEntry *RepPredProp (Prop p); +INLINE_ONLY inline EXTERN PredEntry *RepPredProp(Prop p); -INLINE_ONLY inline EXTERN PredEntry * -RepPredProp (Prop p) -{ - return (PredEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN PredEntry *RepPredProp(Prop p) { + return (PredEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsPredProp(PredEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsPredProp (PredEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsPredProp (PredEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsPredProp(PredEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN PredEntry *RepPredProp (Prop p); +INLINE_ONLY inline EXTERN PredEntry *RepPredProp(Prop p); -INLINE_ONLY inline EXTERN PredEntry * -RepPredProp (Prop p) -{ +INLINE_ONLY inline EXTERN PredEntry *RepPredProp(Prop p) { - return (PredEntry *) (p); + return (PredEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsPredProp(PredEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsPredProp (PredEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsPredProp (PredEntry * p) -{ - - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsPredProp(PredEntry *p) { return (Prop)(p); } #endif +INLINE_ONLY inline EXTERN PropFlags IsPredProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsPredProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsPredProperty (int flags) -{ - return (PropFlags) ((flags == PEProp)); +INLINE_ONLY inline EXTERN PropFlags IsPredProperty(int flags) { + return (PropFlags)((flags == PEProp)); } - - /* Flags for code or dbase entry */ /* There are several flags for code and data base entries */ -typedef enum -{ - ExoMask = 0x1000000, /* is exo code */ - FuncSwitchMask = 0x800000, /* is a switch of functors */ - HasDBTMask = 0x400000, /* includes a pointer to a DBTerm */ - MegaMask = 0x200000, /* mega clause */ - FactMask = 0x100000, /* a fact */ - SwitchRootMask = 0x80000, /* root for the index tree */ - SwitchTableMask = 0x40000, /* switch table */ - HasBlobsMask = 0x20000, /* blobs which may be in use */ - ProfFoundMask = 0x10000, /* clause is being counted by profiler */ - DynamicMask = 0x8000, /* dynamic predicate */ - InUseMask = 0x4000, /* this block is being used */ - ErasedMask = 0x2000, /* this block has been erased */ - IndexMask = 0x1000, /* indexing code */ - DBClMask = 0x0800, /* data base structure */ - LogUpdRuleMask = 0x0400, /* code is for a log upd rule with env */ - LogUpdMask = 0x0200, /* logic update index. */ - StaticMask = 0x0100, /* static predicates */ - DirtyMask = 0x0080, /* LUIndices */ - HasCutMask = 0x0040, /* ! */ - SrcMask = 0x0020, /* has a source term, only for static references */ -/* other flags belong to DB */ +typedef enum { + ExoMask = 0x1000000, /* is exo code */ + FuncSwitchMask = 0x800000, /* is a switch of functors */ + HasDBTMask = 0x400000, /* includes a pointer to a DBTerm */ + MegaMask = 0x200000, /* mega clause */ + FactMask = 0x100000, /* a fact */ + SwitchRootMask = 0x80000, /* root for the index tree */ + SwitchTableMask = 0x40000, /* switch table */ + HasBlobsMask = 0x20000, /* blobs which may be in use */ + ProfFoundMask = 0x10000, /* clause is being counted by profiler */ + DynamicMask = 0x8000, /* dynamic predicate */ + InUseMask = 0x4000, /* this block is being used */ + ErasedMask = 0x2000, /* this block has been erased */ + IndexMask = 0x1000, /* indexing code */ + DBClMask = 0x0800, /* data base structure */ + LogUpdRuleMask = 0x0400, /* code is for a log upd rule with env */ + LogUpdMask = 0x0200, /* logic update index. */ + StaticMask = 0x0100, /* static predicates */ + DirtyMask = 0x0080, /* LUIndices */ + HasCutMask = 0x0040, /* ! */ + SrcMask = 0x0020, /* has a source term, only for static references */ + /* other flags belong to DB */ } dbentry_flags; /* predicate initialization */ - void Yap_InitCPred(const char *, UInt, CPredicate, pred_flags_t); - void Yap_InitAsmPred(const char *, UInt, int, CPredicate, pred_flags_t); - void Yap_InitCmpPred(const char *, UInt, CmpPredicate, pred_flags_t); - void Yap_InitCPredBack(const char *, UInt, unsigned int, CPredicate,CPredicate,pred_flags_t); - void Yap_InitCPredBackCut(const char *, UInt, unsigned int, CPredicate,CPredicate,CPredicate,pred_flags_t); - void Yap_InitCPredBack_(const char *, UInt, unsigned int, CPredicate,CPredicate,CPredicate,pred_flags_t); +void Yap_InitCPred(const char *, UInt, CPredicate, pred_flags_t); +void Yap_InitAsmPred(const char *, UInt, int, CPredicate, pred_flags_t); +void Yap_InitCmpPred(const char *, UInt, CmpPredicate, pred_flags_t); +void Yap_InitCPredBack(const char *, UInt, unsigned int, CPredicate, CPredicate, + pred_flags_t); +void Yap_InitCPredBackCut(const char *, UInt, unsigned int, CPredicate, + CPredicate, CPredicate, pred_flags_t); +void Yap_InitCPredBack_(const char *, UInt, unsigned int, CPredicate, + CPredicate, CPredicate, pred_flags_t); /* *********************** DBrefs **************************************/ -typedef struct DB_TERM -{ +typedef struct DB_TERM { #ifdef COROUTINING union { - CELL attachments; /* attached terms */ + CELL attachments; /* attached terms */ Int line_number; struct DB_TERM *NextDBT; } ag; #endif - struct DB_STRUCT **DBRefs; /* pointer to other references */ - CELL NOfCells; /* Size of Term */ - CELL Entry; /* entry point */ - Term Contents[MIN_ARRAY]; /* stored term */ + struct DB_STRUCT **DBRefs; /* pointer to other references */ + CELL NOfCells; /* Size of Term */ + CELL Entry; /* entry point */ + Term Contents[MIN_ARRAY]; /* stored term */ } DBTerm; INLINE_ONLY inline EXTERN DBTerm *TermToDBTerm(Term); -INLINE_ONLY inline EXTERN DBTerm *TermToDBTerm(Term X) -{ +INLINE_ONLY inline EXTERN DBTerm *TermToDBTerm(Term X) { if (IsPairTerm(X)) { - return(DBTerm *)((unsigned char *)RepPair(X) - (CELL) &(((DBTerm *) NULL)->Contents)); + return (DBTerm *)((unsigned char *)RepPair(X) - (CELL) & + (((DBTerm *)NULL)->Contents)); } else { - return(DBTerm *)((unsigned char *)RepAppl(X) - (CELL) &(((DBTerm *) NULL)->Contents)); + return (DBTerm *)((unsigned char *)RepAppl(X) - (CELL) & + (((DBTerm *)NULL)->Contents)); } } - /* The ordering of the first 3 fields should be compatible with lu_clauses */ -typedef struct DB_STRUCT -{ - Functor id; /* allow pointers to this struct to id */ +typedef struct DB_STRUCT { + Functor id; /* allow pointers to this struct to id */ /* as dbref */ - CELL Flags; /* Term Flags */ + CELL Flags; /* Term Flags */ #if defined(YAPOR) || defined(THREADS) - lockvar lock; /* a simple lock to protect this entry */ + lockvar lock; /* a simple lock to protect this entry */ #endif #if MULTIPLE_STACKS - Int ref_count; /* how many branches are using this entry */ + Int ref_count; /* how many branches are using this entry */ #endif - CELL NOfRefsTo; /* Number of references pointing here */ - struct struct_dbentry *Parent; /* key of DBase reference */ - struct yami *Code; /* pointer to code if this is a clause */ - struct DB_STRUCT *Prev; /* Previous element in chain */ - struct DB_STRUCT *Next; /* Next element in chain */ - struct DB_STRUCT *p, *n; /* entry's age, negative if from recorda, - positive if it was recordz */ - CELL Mask; /* parts that should be cleared */ - CELL Key; /* A mask that can be used to check before - you unify */ + CELL NOfRefsTo; /* Number of references pointing here */ + struct struct_dbentry *Parent; /* key of DBase reference */ + struct yami *Code; /* pointer to code if this is a clause */ + struct DB_STRUCT *Prev; /* Previous element in chain */ + struct DB_STRUCT *Next; /* Next element in chain */ + struct DB_STRUCT *p, *n; /* entry's age, negative if from recorda, + positive if it was recordz */ + CELL Mask; /* parts that should be cleared */ + CELL Key; /* A mask that can be used to check before + you unify */ DBTerm DBT; } DBStruct; -#define DBStructFlagsToDBStruct(X) ((DBRef)((unsigned char *)(X) - (CELL) &(((DBRef) NULL)->Flags))) +#define DBStructFlagsToDBStruct(X) \ + ((DBRef)((unsigned char *)(X) - (CELL) & (((DBRef)NULL)->Flags))) #if MULTIPLE_STACKS #define INIT_DBREF_COUNT(X) (X)->ref_count = 0 -#define INC_DBREF_COUNT(X) (X)->ref_count++ -#define DEC_DBREF_COUNT(X) (X)->ref_count-- -#define DBREF_IN_USE(X) ((X)->ref_count != 0) +#define INC_DBREF_COUNT(X) (X)->ref_count++ +#define DEC_DBREF_COUNT(X) (X)->ref_count-- +#define DBREF_IN_USE(X) ((X)->ref_count != 0) #else #define INIT_DBREF_COUNT(X) -#define INC_DBREF_COUNT(X) -#define DEC_DBREF_COUNT(X) -#define DBREF_IN_USE(X) ((X)->Flags & InUseMask) +#define INC_DBREF_COUNT(X) +#define DEC_DBREF_COUNT(X) +#define DBREF_IN_USE(X) ((X)->Flags & InUseMask) #endif typedef DBStruct *DBRef; /* extern Functor FunctorDBRef; */ -INLINE_ONLY inline EXTERN int IsDBRefTerm (Term); +INLINE_ONLY inline EXTERN int IsDBRefTerm(Term); -INLINE_ONLY inline EXTERN int -IsDBRefTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef); +INLINE_ONLY inline EXTERN int IsDBRefTerm(Term t) { + return (int)(IsApplTerm(t) && FunctorOfTerm(t) == FunctorDBRef); } +INLINE_ONLY inline EXTERN Term MkDBRefTerm(DBRef); - -INLINE_ONLY inline EXTERN Term MkDBRefTerm (DBRef); - -INLINE_ONLY inline EXTERN Term -MkDBRefTerm (DBRef p) -{ - return (Term) ((AbsAppl (((CELL *) (p))))); +INLINE_ONLY inline EXTERN Term MkDBRefTerm(DBRef p) { + return (Term)((AbsAppl(((CELL *)(p))))); } +INLINE_ONLY inline EXTERN DBRef DBRefOfTerm(Term t); - -INLINE_ONLY inline EXTERN DBRef DBRefOfTerm (Term t); - -INLINE_ONLY inline EXTERN DBRef -DBRefOfTerm (Term t) -{ - return (DBRef) (((DBRef) (RepAppl (t)))); +INLINE_ONLY inline EXTERN DBRef DBRefOfTerm(Term t) { + return (DBRef)(((DBRef)(RepAppl(t)))); } +INLINE_ONLY inline EXTERN int IsRefTerm(Term); - - -INLINE_ONLY inline EXTERN int IsRefTerm (Term); - -INLINE_ONLY inline EXTERN int -IsRefTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef); +INLINE_ONLY inline EXTERN int IsRefTerm(Term t) { + return (int)(IsApplTerm(t) && FunctorOfTerm(t) == FunctorDBRef); } +INLINE_ONLY inline EXTERN CODEADDR RefOfTerm(Term t); - -INLINE_ONLY inline EXTERN CODEADDR RefOfTerm (Term t); - -INLINE_ONLY inline EXTERN CODEADDR -RefOfTerm (Term t) -{ - return (CODEADDR) (DBRefOfTerm (t)); +INLINE_ONLY inline EXTERN CODEADDR RefOfTerm(Term t) { + return (CODEADDR)(DBRefOfTerm(t)); } - - -typedef struct struct_dbentry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfDB; /* kind of property */ - Functor FunctorOfDB; /* functor for this property */ +typedef struct struct_dbentry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfDB; /* kind of property */ + Functor FunctorOfDB; /* functor for this property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t DBRWLock; /* a simple lock to protect this entry */ + rwlock_t DBRWLock; /* a simple lock to protect this entry */ #endif - DBRef First; /* first DBase entry */ - DBRef Last; /* last DBase entry */ - Term ModuleOfDB; /* module for this definition */ - DBRef F0, L0; /* everyone */ + DBRef First; /* first DBase entry */ + DBRef Last; /* last DBase entry */ + Term ModuleOfDB; /* module for this definition */ + DBRef F0, L0; /* everyone */ } DBEntry; typedef DBEntry *DBProp; -#define DBProperty ((PropFlags)0x8000) +#define DBProperty ((PropFlags)0x8000) -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfDB; /* kind of property */ - Functor FunctorOfDB; /* functor for this property */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfDB; /* kind of property */ + Functor FunctorOfDB; /* functor for this property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t DBRWLock; /* a simple lock to protect this entry */ + rwlock_t DBRWLock; /* a simple lock to protect this entry */ #endif - DBRef First; /* first DBase entry */ - DBRef Last; /* last DBase entry */ - Term ModuleOfDB; /* module for this definition */ - Int NOfEntries; /* age counter */ - DBRef Index; /* age counter */ + DBRef First; /* first DBase entry */ + DBRef Last; /* last DBase entry */ + Term ModuleOfDB; /* module for this definition */ + Int NOfEntries; /* age counter */ + DBRef Index; /* age counter */ } LogUpdDBEntry; typedef LogUpdDBEntry *LogUpdDBProp; -#define CodeDBBit 0x2 +#define CodeDBBit 0x2 -#define CodeDBProperty (DBProperty|CodeDBBit) +#define CodeDBProperty (DBProperty | CodeDBBit) +INLINE_ONLY inline EXTERN PropFlags IsDBProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsDBProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsDBProperty (int flags) -{ - return (PropFlags) ((flags & ~CodeDBBit) == DBProperty); +INLINE_ONLY inline EXTERN PropFlags IsDBProperty(int flags) { + return (PropFlags)((flags & ~CodeDBBit) == DBProperty); } - - #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN DBProp RepDBProp (Prop p); +INLINE_ONLY inline EXTERN DBProp RepDBProp(Prop p); -INLINE_ONLY inline EXTERN DBProp -RepDBProp (Prop p) -{ - return (DBProp) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN DBProp RepDBProp(Prop p) { + return (DBProp)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsDBProp(DBProp p); - -INLINE_ONLY inline EXTERN Prop AbsDBProp (DBProp p); - -INLINE_ONLY inline EXTERN Prop -AbsDBProp (DBProp p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsDBProp(DBProp p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN DBProp RepDBProp (Prop p); +INLINE_ONLY inline EXTERN DBProp RepDBProp(Prop p); -INLINE_ONLY inline EXTERN DBProp -RepDBProp (Prop p) -{ - return (DBProp) (p); -} +INLINE_ONLY inline EXTERN DBProp RepDBProp(Prop p) { return (DBProp)(p); } +INLINE_ONLY inline EXTERN Prop AbsDBProp(DBProp p); - -INLINE_ONLY inline EXTERN Prop AbsDBProp (DBProp p); - -INLINE_ONLY inline EXTERN Prop -AbsDBProp (DBProp p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsDBProp(DBProp p) { return (Prop)(p); } #endif - /* These are the actual flags for DataBase terms */ -typedef enum -{ +typedef enum { DBAtomic = 0x1, DBVar = 0x2, DBNoVars = 0x4, @@ -1098,295 +870,220 @@ typedef enum DBWithRefs = 0x40 } db_term_flags; -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Atom KeyOfBB; /* functor for this property */ - Term Element; /* blackboard element */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Atom KeyOfBB; /* functor for this property */ + Term Element; /* blackboard element */ #if defined(YAPOR) || defined(THREADS) - rwlock_t BBRWLock; /* a read-write lock to protect the entry */ + rwlock_t BBRWLock; /* a read-write lock to protect the entry */ #endif - Term ModuleOfBB; /* module for this definition */ + Term ModuleOfBB; /* module for this definition */ } BlackBoardEntry; typedef BlackBoardEntry *BBProp; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp (Prop p); +INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp(Prop p); -INLINE_ONLY inline EXTERN BlackBoardEntry * -RepBBProp (Prop p) -{ - return (BlackBoardEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp(Prop p) { + return (BlackBoardEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsBBProp(BlackBoardEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsBBProp (BlackBoardEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsBBProp (BlackBoardEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsBBProp(BlackBoardEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp (Prop p); +INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp(Prop p); -INLINE_ONLY inline EXTERN BlackBoardEntry * -RepBBProp (Prop p) -{ - return (BlackBoardEntry *) (p); +INLINE_ONLY inline EXTERN BlackBoardEntry *RepBBProp(Prop p) { + return (BlackBoardEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsBBProp(BlackBoardEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsBBProp (BlackBoardEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsBBProp (BlackBoardEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsBBProp(BlackBoardEntry *p) { + return (Prop)(p); } - #endif -#define BBProperty ((PropFlags)0xfffb) +#define BBProperty ((PropFlags)0xfffb) +INLINE_ONLY inline EXTERN PropFlags IsBBProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsBBProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsBBProperty (int flags) -{ - return (PropFlags) ((flags == BBProperty)); +INLINE_ONLY inline EXTERN PropFlags IsBBProperty(int flags) { + return (PropFlags)((flags == BBProperty)); } - /* hold property entry structure */ -typedef struct hold_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - UInt RefsOfPE; /* used to count the number of holds */ +typedef struct hold_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + UInt RefsOfPE; /* used to count the number of holds */ } HoldEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp (Prop p); +INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp(Prop p); -INLINE_ONLY inline EXTERN HoldEntry * -RepHoldProp (Prop p) -{ - return (HoldEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp(Prop p) { + return (HoldEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsHoldProp(HoldEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsHoldProp (HoldEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsHoldProp (HoldEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsHoldProp(HoldEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp (Prop p); +INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp(Prop p); -INLINE_ONLY inline EXTERN HoldEntry * -RepHoldProp (Prop p) -{ - return (HoldEntry *) (p); +INLINE_ONLY inline EXTERN HoldEntry *RepHoldProp(Prop p) { + return (HoldEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsHoldProp(HoldEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsHoldProp (HoldEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsHoldProp (HoldEntry * p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsHoldProp(HoldEntry *p) { return (Prop)(p); } #endif -#define HoldProperty 0xfff6 +#define HoldProperty 0xfff6 -/* translation property entry structure */ -typedef struct translation_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - arity_t arity; /* refers to atom (0) or functor(N > 0) */ - Int Translation; /* used to hash the atom as an integer; */ -} TranslationEntry; +/* translation property entry structure */ +typedef struct translation_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + arity_t arity; /* refers to atom (0) or functor(N > 0) */ + Int Translation; /* used to hash the atom as an integer; */ +} TranslationEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp (Prop p); +INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp(Prop p); -INLINE_ONLY inline EXTERN TranslationEntry * -RepTranslationProp (Prop p) -{ - return (TranslationEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp(Prop p) { + return (TranslationEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsTranslationProp(TranslationEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsTranslationProp (TranslationEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsTranslationProp (TranslationEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsTranslationProp(TranslationEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp (Prop p); +INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp(Prop p); -INLINE_ONLY inline EXTERN TranslationEntry * -RepTranslationProp (Prop p) -{ - return (TranslationEntry *) (p); +INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp(Prop p) { + return (TranslationEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsTranslationProp(TranslationEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsTranslationProp (TranslationEntry * p); - - INLINE_ONLY inline EXTERN Prop -AbsTranslationProp (TranslationEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsTranslationProp(TranslationEntry *p) { + return (Prop)(p); } - #endif -#define TranslationProperty 0xfff4 +#define TranslationProperty 0xfff4 - bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i); +bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i); /* get translation prop for atom; */ -static inline TranslationEntry * - Yap_GetTranslationProp(Atom at, arity_t arity) -{ +static inline TranslationEntry *Yap_GetTranslationProp(Atom at, arity_t arity) { Prop p0; AtomEntry *ae = RepAtom(at); TranslationEntry *p; READ_LOCK(ae->ARWLock); p = RepTranslationProp(p0 = ae->PropsOfAE); - while (p0 && (p->KindOfPE != TranslationProperty || - p->arity != arity)) + while (p0 && (p->KindOfPE != TranslationProperty || p->arity != arity)) p = RepTranslationProp(p0 = p->NextOfPE); READ_UNLOCK(ae->ARWLock); - if (p0 == NIL) return (TranslationEntry *)NULL; + if (p0 == NIL) + return (TranslationEntry *)NULL; p->arity = arity; return p; } -INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty (int); +INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty(int); -INLINE_ONLY inline EXTERN PropFlags -IsTranslationProperty (int flags) -{ - return (PropFlags) ((flags == TranslationProperty)); +INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty(int flags) { + return (PropFlags)((flags == TranslationProperty)); } /*** handle named mutexes */ -/* named mutex property entry structure */ - typedef struct mutex_entry - { - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - void *Mutex; /* used to hash the atom as an integer; */ - } MutexEntry; +/* named mutex property entry structure */ +typedef struct mutex_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + void *Mutex; /* used to hash the atom as an integer; */ +} MutexEntry; #if USE_OFFSETS_IN_PROPS - INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp (Prop p); +INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp(Prop p); - INLINE_ONLY inline EXTERN MutexEntry * - RepMutexProp (Prop p) - { - return (MutexEntry *) (AtomBase + Unsigned (p)); - } +INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp(Prop p) { + return (MutexEntry *)(AtomBase + Unsigned(p)); +} +INLINE_ONLY inline EXTERN Prop AbsMutexProp(MutexEntry *p); - - INLINE_ONLY inline EXTERN Prop AbsMutexProp (MutexEntry * p); - - INLINE_ONLY inline EXTERN Prop - AbsMutexProp (MutexEntry * p) - { - return (Prop) (Addr (p) - AtomBase); - } - +INLINE_ONLY inline EXTERN Prop AbsMutexProp(MutexEntry *p) { + return (Prop)(Addr(p) - AtomBase); +} #else - INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp (Prop p); +INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp(Prop p); - INLINE_ONLY inline EXTERN MutexEntry * - RepMutexProp (Prop p) - { - return (MutexEntry *) (p); - } +INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp(Prop p) { + return (MutexEntry *)(p); +} +INLINE_ONLY inline EXTERN Prop AbsMutexProp(MutexEntry *p); - - INLINE_ONLY inline EXTERN Prop AbsMutexProp (MutexEntry * p); - - INLINE_ONLY inline EXTERN Prop - AbsMutexProp (MutexEntry * p) - { - return (Prop) (p); - } - +INLINE_ONLY inline EXTERN Prop AbsMutexProp(MutexEntry *p) { return (Prop)(p); } #endif -#define MutexProperty 0xfff5 +#define MutexProperty 0xfff5 - bool Yap_PutAtomMutex(Atom a, void *ptr); +bool Yap_PutAtomMutex(Atom a, void *ptr); - /* get mutex prop for atom; */ - static inline void * - Yap_GetMutexFromProp(Atom at) - { - Prop p0; - AtomEntry *ae = RepAtom(at); - MutexEntry *p; +/* get mutex prop for atom; */ +static inline void *Yap_GetMutexFromProp(Atom at) { + Prop p0; + AtomEntry *ae = RepAtom(at); + MutexEntry *p; - READ_LOCK(ae->ARWLock); - p = RepMutexProp(p0 = ae->PropsOfAE); - while (p0 && p->KindOfPE != MutexProperty) - p = RepMutexProp(p0 = p->NextOfPE); - READ_UNLOCK(ae->ARWLock); - if (p0 == NIL) return NULL; - return p->Mutex; - } + READ_LOCK(ae->ARWLock); + p = RepMutexProp(p0 = ae->PropsOfAE); + while (p0 && p->KindOfPE != MutexProperty) + p = RepMutexProp(p0 = p->NextOfPE); + READ_UNLOCK(ae->ARWLock); + if (p0 == NIL) + return NULL; + return p->Mutex; +} - INLINE_ONLY inline EXTERN PropFlags IsMutexProperty (int); +INLINE_ONLY inline EXTERN PropFlags IsMutexProperty(int); - INLINE_ONLY inline EXTERN PropFlags - IsMutexProperty (int flags) - { - return (PropFlags) ((flags == MutexProperty)); - } +INLINE_ONLY inline EXTERN PropFlags IsMutexProperty(int flags) { + return (PropFlags)((flags == MutexProperty)); +} - /* end of code for named mutexes */ +/* end of code for named mutexes */ typedef enum { STATIC_ARRAY = 1, @@ -1395,35 +1092,31 @@ typedef enum { FIXED_ARRAY = 8 } array_type; - /* array property entry structure */ /* first case is for dynamic arrays */ -typedef struct array_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Int ArrayEArity; /* Arity of Array (positive) */ +typedef struct array_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Int ArrayEArity; /* Arity of Array (positive) */ array_type TypeOfAE; #if defined(YAPOR) || defined(THREADS) - rwlock_t ArRWLock; /* a read-write lock to protect the entry */ + rwlock_t ArRWLock; /* a read-write lock to protect the entry */ #if THREADS unsigned int owner_id; #endif #endif struct array_entry *NextAE; - Term ValueOfVE; /* Pointer to the actual array */ + Term ValueOfVE; /* Pointer to the actual array */ } ArrayEntry; /* second case is for static arrays */ -typedef struct { +typedef struct { Term tlive; Term tstore; } live_term; - -typedef union -{ +typedef union { Int *ints; char *chars; unsigned char *uchars; @@ -1436,280 +1129,191 @@ typedef union } statarray_elements; /* next, the actual data structure */ -typedef struct static_array_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Int ArrayEArity; /* Arity of Array (negative) */ +typedef struct static_array_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Int ArrayEArity; /* Arity of Array (negative) */ array_type TypeOfAE; #if defined(YAPOR) || defined(THREADS) - rwlock_t ArRWLock; /* a read-write lock to protect the entry */ + rwlock_t ArRWLock; /* a read-write lock to protect the entry */ #endif struct static_array_entry *NextAE; - static_array_types ArrayType; /* Type of Array Elements. */ - statarray_elements ValueOfVE; /* Pointer to the Array itself */ + static_array_types ArrayType; /* Type of Array Elements. */ + statarray_elements ValueOfVE; /* Pointer to the Array itself */ } StaticArrayEntry; - #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp (Prop p); +INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp(Prop p); -INLINE_ONLY inline EXTERN ArrayEntry * -RepArrayProp (Prop p) -{ - return (ArrayEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp(Prop p) { + return (ArrayEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsArrayProp(ArrayEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsArrayProp (ArrayEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsArrayProp (ArrayEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsArrayProp(ArrayEntry *p) { + return (Prop)(Addr(p) - AtomBase); } +INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp(Prop p); - -INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p); - -INLINE_ONLY inline EXTERN StaticArrayEntry * -RepStaticArrayProp (Prop p) -{ - return (StaticArrayEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp(Prop p) { + return (StaticArrayEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsStaticArrayProp (StaticArrayEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp (Prop p); +INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp(Prop p); -INLINE_ONLY inline EXTERN ArrayEntry * -RepArrayProp (Prop p) -{ - return (ArrayEntry *) (p); +INLINE_ONLY inline EXTERN ArrayEntry *RepArrayProp(Prop p) { + return (ArrayEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsArrayProp(ArrayEntry *p); +INLINE_ONLY inline EXTERN Prop AbsArrayProp(ArrayEntry *p) { return (Prop)(p); } -INLINE_ONLY inline EXTERN Prop AbsArrayProp (ArrayEntry * p); +INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp(Prop p); -INLINE_ONLY inline EXTERN Prop -AbsArrayProp (ArrayEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp(Prop p) { + return (StaticArrayEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry *p); - -INLINE_ONLY inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p); - -INLINE_ONLY inline EXTERN StaticArrayEntry * -RepStaticArrayProp (Prop p) -{ - return (StaticArrayEntry *) (p); +INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry *p) { + return (Prop)(p); } - - -INLINE_ONLY inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsStaticArrayProp (StaticArrayEntry * p) -{ - return (Prop) (p); -} - - #endif -#define ArrayProperty ((PropFlags)0xfff7) +#define ArrayProperty ((PropFlags)0xfff7) +INLINE_ONLY inline EXTERN int ArrayIsDynamic(ArrayEntry *); -INLINE_ONLY inline EXTERN int ArrayIsDynamic (ArrayEntry *); - -INLINE_ONLY inline EXTERN int -ArrayIsDynamic (ArrayEntry * are) -{ - return (int) (((are)->TypeOfAE & DYNAMIC_ARRAY)); +INLINE_ONLY inline EXTERN int ArrayIsDynamic(ArrayEntry *are) { + return (int)(((are)->TypeOfAE & DYNAMIC_ARRAY)); } +INLINE_ONLY inline EXTERN PropFlags IsArrayProperty(int); - - -INLINE_ONLY inline EXTERN PropFlags IsArrayProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsArrayProperty (int flags) -{ - return (PropFlags) ((flags == ArrayProperty)); +INLINE_ONLY inline EXTERN PropFlags IsArrayProperty(int flags) { + return (PropFlags)((flags == ArrayProperty)); } - - /* SWI Blob property */ -typedef struct YAP_blob_prop_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - struct YAP_blob_t *blob_type; /* type of blob */ +typedef struct YAP_blob_prop_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + struct YAP_blob_t *blob_type; /* type of blob */ } YAP_BlobPropEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp (Prop p); +INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp(Prop p); -INLINE_ONLY inline EXTERN YAP_BlobPropEntry * -RepBlobProp (Prop p) -{ - return (YAP_BlobPropEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp(Prop p) { + return (YAP_BlobPropEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN AtomEntry *AbsBlobProp(BlobPropEntry *p); - - -INLINE_ONLY inline EXTERN AtomEntry *AbsBlobProp (BlobPropEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsBlobProp (YAP_BlobPropEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsBlobProp(YAP_BlobPropEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp (Prop p); +INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp(Prop p); -INLINE_ONLY inline EXTERN YAP_BlobPropEntry * -RepBlobProp (Prop p) -{ - return (YAP_BlobPropEntry *) (p); +INLINE_ONLY inline EXTERN YAP_BlobPropEntry *RepBlobProp(Prop p) { + return (YAP_BlobPropEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsBlobProp(YAP_BlobPropEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsBlobProp (YAP_BlobPropEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsBlobProp (YAP_BlobPropEntry * p) -{ - return (Prop) (p); +INLINE_ONLY inline EXTERN Prop AbsBlobProp(YAP_BlobPropEntry *p) { + return (Prop)(p); } - #endif -#define BlobProperty ((PropFlags)0xfffe) +#define BlobProperty ((PropFlags)0xfffe) +INLINE_ONLY inline EXTERN PropFlags IsBlobProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsBlobProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsBlobProperty (int flags) -{ - return (PropFlags) ((flags == BlobProperty)); +INLINE_ONLY inline EXTERN PropFlags IsBlobProperty(int flags) { + return (PropFlags)((flags == BlobProperty)); } -INLINE_ONLY inline EXTERN int IsBlob (Atom); +INLINE_ONLY inline EXTERN int IsBlob(Atom); -INLINE_ONLY inline EXTERN int -IsBlob (Atom at) -{ +INLINE_ONLY inline EXTERN int IsBlob(Atom at) { return RepAtom(at)->PropsOfAE && - IsBlobProperty(RepBlobProp(RepAtom(at)->PropsOfAE)->KindOfPE); + IsBlobProperty(RepBlobProp(RepAtom(at)->PropsOfAE)->KindOfPE); } -INLINE_ONLY inline EXTERN PropFlags IsValProperty (int); +INLINE_ONLY inline EXTERN PropFlags IsValProperty(int); -INLINE_ONLY inline EXTERN PropFlags -IsValProperty (int flags) -{ - return (PropFlags) ((flags == ValProperty)); +INLINE_ONLY inline EXTERN PropFlags IsValProperty(int flags) { + return (PropFlags)((flags == ValProperty)); } - /* flag property entry structure */ typedef bool (*flag_func)(Term); - typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ #if defined(YAPOR) || defined(THREADS) - rwlock_t VRWLock; /* a read-write lock to protect the entry */ + rwlock_t VRWLock; /* a read-write lock to protect the entry */ #endif - int FlagOfVE; /* (atomic) value associated with the atom */ + int FlagOfVE; /* (atomic) value associated with the atom */ bool global, atomic, rw; flag_func type, helper; } FlagEntry; #if USE_OFFSETS_IN_PROPS -INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp (Prop p); +INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp(Prop p); -INLINE_ONLY inline EXTERN FlagEntry * -RepFlagProp (Prop p) -{ - return (FlagEntry *) (AtomBase + Unsigned (p)); +INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp(Prop p) { + return (FlagEntry *)(AtomBase + Unsigned(p)); } +INLINE_ONLY inline EXTERN Prop AbsFlagProp(FlagEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsFlagProp (FlagEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsValProp (FlagEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); +INLINE_ONLY inline EXTERN Prop AbsValProp(FlagEntry *p) { + return (Prop)(Addr(p) - AtomBase); } - #else -INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp (Prop p); +INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp(Prop p); -INLINE_ONLY inline EXTERN FlagEntry * -RepFlagProp (Prop p) -{ - return (FlagEntry *) (p); +INLINE_ONLY inline EXTERN FlagEntry *RepFlagProp(Prop p) { + return (FlagEntry *)(p); } +INLINE_ONLY inline EXTERN Prop AbsFlagProp(FlagEntry *p); - -INLINE_ONLY inline EXTERN Prop AbsFlagProp (FlagEntry * p); - -INLINE_ONLY inline EXTERN Prop -AbsFlagProp (FlagEntry * p) -{ - return (Prop) (p); -} - +INLINE_ONLY inline EXTERN Prop AbsFlagProp(FlagEntry *p) { return (Prop)(p); } #endif -#define FlagProperty ((PropFlags)0xfff9) +#define FlagProperty ((PropFlags)0xfff9) +INLINE_ONLY inline EXTERN PropFlags IsFlagProperty(int); -INLINE_ONLY inline EXTERN PropFlags IsFlagProperty (int); - -INLINE_ONLY inline EXTERN PropFlags -IsFlagProperty (int flags) -{ - return (PropFlags) ((flags == FlagProperty)); +INLINE_ONLY inline EXTERN PropFlags IsFlagProperty(int flags) { + return (PropFlags)((flags == FlagProperty)); } - /* Proto types */ /* cdmgr.c */ @@ -1732,12 +1336,12 @@ Atom Yap_GetOp(OpEntry *, int *, int); Prop Yap_GetAProp(Atom, PropFlags); Prop Yap_GetAPropHavingLock(AtomEntry *, PropFlags); -#define PROLOG_MODULE 0 +#define PROLOG_MODULE 0 #include "YapHeap.h" -#define PredHashInitialSize ((UInt)1039) -#define PredHashIncrement ((UInt)7919) +#define PredHashInitialSize ((UInt)1039) +#define PredHashIncrement ((UInt)7919) /************************************************************************************************* flag support @@ -1746,46 +1350,45 @@ Prop Yap_GetAPropHavingLock(AtomEntry *, PropFlags); #include "YapFlags.h" INLINE_ONLY EXTERN inline UInt PRED_HASH(FunctorEntry *, Term, UInt); -INLINE_ONLY EXTERN inline UInt -PRED_HASH(FunctorEntry *fe, Term cur_mod, UInt size) -{ - return (((CELL)fe+cur_mod)>>2) % size; +INLINE_ONLY EXTERN inline UInt PRED_HASH(FunctorEntry *fe, Term cur_mod, + UInt size) { + return (((CELL)fe + cur_mod) >> 2) % size; } -INLINE_ONLY EXTERN inline Prop GetPredPropByFuncAndModHavingLock(FunctorEntry *, Term); +INLINE_ONLY EXTERN inline Prop GetPredPropByFuncAndModHavingLock(FunctorEntry *, + Term); INLINE_ONLY EXTERN inline Prop PredPropByFuncAndMod(FunctorEntry *, Term); INLINE_ONLY EXTERN inline Prop PredPropByAtomAndMod(Atom, Term); -INLINE_ONLY EXTERN inline Prop GetPredPropByFuncHavingLock(FunctorEntry *, Term); -INLINE_ONLY EXTERN inline Prop PredPropByFunc (Functor fe, Term cur_mod); -INLINE_ONLY EXTERN inline Prop PredPropByAtom (Atom at, Term cur_mod); +INLINE_ONLY EXTERN inline Prop GetPredPropByFuncHavingLock(FunctorEntry *, + Term); +INLINE_ONLY EXTERN inline Prop PredPropByFunc(Functor fe, Term cur_mod); +INLINE_ONLY EXTERN inline Prop PredPropByAtom(Atom at, Term cur_mod); #ifdef THREADS -Prop Yap_NewThreadPred(struct pred_entry * CACHE_TYPE); +Prop Yap_NewThreadPred(struct pred_entry *CACHE_TYPE); Prop Yap_NewPredPropByFunctor(Functor, Term); -INLINE_ONLY EXTERN inline struct pred_entry *Yap_GetThreadPred(struct pred_entry * CACHE_TYPE); +INLINE_ONLY EXTERN inline struct pred_entry * +Yap_GetThreadPred(struct pred_entry *CACHE_TYPE); INLINE_ONLY EXTERN inline struct pred_entry * -Yap_GetThreadPred(struct pred_entry *ap USES_REGS) -{ +Yap_GetThreadPred(struct pred_entry *ap USES_REGS) { Functor f = ap->FunctorOfPred; - Term mod = ap->ModuleOfPred; + Term mod = ap->ModuleOfPred; Prop p0 = AbsPredProp(LOCAL_ThreadHandle.local_preds); - while(p0) { + while (p0) { PredEntry *ap = RepPredProp(p0); - if (ap->FunctorOfPred == f && - ap->ModuleOfPred == mod) return ap; + if (ap->FunctorOfPred == f && ap->ModuleOfPred == mod) + return ap; p0 = ap->NextOfPE; } return RepPredProp(Yap_NewThreadPred(ap PASS_REGS)); } #endif - -INLINE_ONLY EXTERN inline Prop -GetPredPropByFuncHavingLock (FunctorEntry *fe, Term cur_mod) -{ +INLINE_ONLY EXTERN inline Prop GetPredPropByFuncHavingLock(FunctorEntry *fe, + Term cur_mod) { PredEntry *p; if (!(p = RepPredProp(fe->PropsOfFE))) { @@ -1795,30 +1398,28 @@ GetPredPropByFuncHavingLock (FunctorEntry *fe, Term cur_mod) #ifdef THREADS /* Thread Local Predicates */ if (p->PredFlags & ThreadLocalPredFlag) { - return AbsPredProp (Yap_GetThreadPred (p INIT_REGS)); + return AbsPredProp(Yap_GetThreadPred(p INIT_REGS)); } #endif return AbsPredProp(p); } if (p->NextOfPE) { - UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize); + UInt hash = PRED_HASH(fe, cur_mod, PredHashTableSize); READ_LOCK(PredHashRWLock); p = PredHash[hash]; while (p) { - if (p->FunctorOfPred == fe && - p->ModuleOfPred == cur_mod) - { + if (p->FunctorOfPred == fe && p->ModuleOfPred == cur_mod) { #ifdef THREADS - /* Thread Local Predicates */ - if (p->PredFlags & ThreadLocalPredFlag) { - READ_UNLOCK(PredHashRWLock); - return AbsPredProp (Yap_GetThreadPred (p INIT_REGS)); - } + /* Thread Local Predicates */ + if (p->PredFlags & ThreadLocalPredFlag) { + READ_UNLOCK(PredHashRWLock); + return AbsPredProp(Yap_GetThreadPred(p INIT_REGS)); + } #endif - READ_UNLOCK(PredHashRWLock); - return AbsPredProp(p); - } + READ_UNLOCK(PredHashRWLock); + return AbsPredProp(p); + } p = p->NextPredOfHash; } READ_UNLOCK(PredHashRWLock); @@ -1826,24 +1427,22 @@ GetPredPropByFuncHavingLock (FunctorEntry *fe, Term cur_mod) return NIL; } -INLINE_ONLY EXTERN inline Prop -PredPropByFunc (Functor fe, Term cur_mod) +INLINE_ONLY EXTERN inline Prop PredPropByFunc(Functor fe, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; - FUNC_WRITE_LOCK (fe); + FUNC_WRITE_LOCK(fe); p0 = GetPredPropByFuncHavingLock(fe, cur_mod); if (p0) { - FUNC_WRITE_UNLOCK (fe); + FUNC_WRITE_UNLOCK(fe); return p0; } - return Yap_NewPredPropByFunctor (fe, cur_mod); + return Yap_NewPredPropByFunctor(fe, cur_mod); } INLINE_ONLY EXTERN inline Prop -GetPredPropByFuncAndModHavingLock (FunctorEntry *fe, Term cur_mod) -{ +GetPredPropByFuncAndModHavingLock(FunctorEntry *fe, Term cur_mod) { PredEntry *p; if (!(p = RepPredProp(fe->PropsOfFE))) { @@ -1853,30 +1452,28 @@ GetPredPropByFuncAndModHavingLock (FunctorEntry *fe, Term cur_mod) #ifdef THREADS /* Thread Local Predicates */ if (p->PredFlags & ThreadLocalPredFlag) { - return AbsPredProp (Yap_GetThreadPred (p INIT_REGS)); + return AbsPredProp(Yap_GetThreadPred(p INIT_REGS)); } #endif return AbsPredProp(p); } if (p->NextOfPE) { - UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize); + UInt hash = PRED_HASH(fe, cur_mod, PredHashTableSize); READ_LOCK(PredHashRWLock); p = PredHash[hash]; while (p) { - if (p->FunctorOfPred == fe && - p->ModuleOfPred == cur_mod) - { + if (p->FunctorOfPred == fe && p->ModuleOfPred == cur_mod) { #ifdef THREADS - /* Thread Local Predicates */ - if (p->PredFlags & ThreadLocalPredFlag) { - READ_UNLOCK(PredHashRWLock); - return AbsPredProp (Yap_GetThreadPred (p INIT_REGS)); - } + /* Thread Local Predicates */ + if (p->PredFlags & ThreadLocalPredFlag) { + READ_UNLOCK(PredHashRWLock); + return AbsPredProp(Yap_GetThreadPred(p INIT_REGS)); + } #endif - READ_UNLOCK(PredHashRWLock); - return AbsPredProp(p); - } + READ_UNLOCK(PredHashRWLock); + return AbsPredProp(p); + } p = p->NextPredOfHash; } READ_UNLOCK(PredHashRWLock); @@ -1884,102 +1481,93 @@ GetPredPropByFuncAndModHavingLock (FunctorEntry *fe, Term cur_mod) return NIL; } -INLINE_ONLY EXTERN inline Prop -PredPropByFuncAndMod (Functor fe, Term cur_mod) +INLINE_ONLY EXTERN inline Prop PredPropByFuncAndMod(Functor fe, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; - FUNC_WRITE_LOCK (fe); + FUNC_WRITE_LOCK(fe); p0 = GetPredPropByFuncAndModHavingLock(fe, cur_mod); if (p0) { - FUNC_WRITE_UNLOCK (fe); + FUNC_WRITE_UNLOCK(fe); return p0; } - return Yap_NewPredPropByFunctor (fe, cur_mod); + return Yap_NewPredPropByFunctor(fe, cur_mod); } -INLINE_ONLY EXTERN inline Prop -PredPropByAtom (Atom at, Term cur_mod) +INLINE_ONLY EXTERN inline Prop PredPropByAtom(Atom at, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; - AtomEntry *ae = RepAtom (at); + AtomEntry *ae = RepAtom(at); - WRITE_LOCK (ae->ARWLock); + WRITE_LOCK(ae->ARWLock); p0 = ae->PropsOfAE; - while (p0) - { - PredEntry *pe = RepPredProp (p0); - if (pe->KindOfPE == PEProp && - (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) - { + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp && + (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { #ifdef THREADS - /* Thread Local Predicates */ - if (pe->PredFlags & ThreadLocalPredFlag) - { - WRITE_UNLOCK (ae->ARWLock); - return AbsPredProp (Yap_GetThreadPred (pe INIT_REGS)); - } + /* Thread Local Predicates */ + if (pe->PredFlags & ThreadLocalPredFlag) { + WRITE_UNLOCK(ae->ARWLock); + return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); + } #endif - WRITE_UNLOCK (ae->ARWLock); - return (p0); - } - p0 = pe->NextOfPE; + WRITE_UNLOCK(ae->ARWLock); + return (p0); } - return Yap_NewPredPropByAtom (ae, cur_mod); + p0 = pe->NextOfPE; + } + return Yap_NewPredPropByAtom(ae, cur_mod); } -INLINE_ONLY EXTERN inline Prop -PredPropByAtomAndMod (Atom at, Term cur_mod) +INLINE_ONLY EXTERN inline Prop PredPropByAtomAndMod(Atom at, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; - AtomEntry *ae = RepAtom (at); + AtomEntry *ae = RepAtom(at); - WRITE_LOCK (ae->ARWLock); + WRITE_LOCK(ae->ARWLock); p0 = ae->PropsOfAE; - while (p0) - { - PredEntry *pe = RepPredProp (p0); - if (pe->KindOfPE == PEProp && - (pe->ModuleOfPred == cur_mod)) - { + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp && (pe->ModuleOfPred == cur_mod)) { #ifdef THREADS - /* Thread Local Predicates */ - if (pe->PredFlags & ThreadLocalPredFlag) - { - WRITE_UNLOCK (ae->ARWLock); - return AbsPredProp (Yap_GetThreadPred (pe INIT_REGS)); - } + /* Thread Local Predicates */ + if (pe->PredFlags & ThreadLocalPredFlag) { + WRITE_UNLOCK(ae->ARWLock); + return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); + } #endif - WRITE_UNLOCK (ae->ARWLock); - return (p0); - } - p0 = pe->NextOfPE; + WRITE_UNLOCK(ae->ARWLock); + return (p0); } - return Yap_NewPredPropByAtom (ae, cur_mod); + p0 = pe->NextOfPE; + } + return Yap_NewPredPropByAtom(ae, cur_mod); } - #if DEBUG_PELOCKING -#define PELOCK(I,Z) \ - { LOCK((Z)->PELock); (Z)->StatisticsForPred->NOfEntries=(I);(Z)->StatisticsForPred->NOfHeadSuccesses=pthread_self(); } -#define UNLOCKPE(I,Z) \ - ( (Z)->StatisticsForPred->NOfRetries=(I), UNLOCK((Z)->PELock) ) +#define PELOCK(I, Z) \ + { \ + LOCK((Z)->PELock); \ + (Z)->StatisticsForPred->NOfEntries = (I); \ + (Z)->StatisticsForPred->NOfHeadSuccesses = pthread_self(); \ + } +#define UNLOCKPE(I, Z) \ + ((Z)->StatisticsForPred->NOfRetries = (I), UNLOCK((Z)->PELock)) #elif YAPOR || THREADS -#define PELOCK(I,Z) (LOCK((Z)->PELock)) -#define UNLOCKPE(I,Z) (UNLOCK((Z)->PELock)) +#define PELOCK(I, Z) (LOCK((Z)->PELock)) +#define UNLOCKPE(I, Z) (UNLOCK((Z)->PELock)) #else -#define PELOCK(I,Z) -#define UNLOCKPE(I,Z) +#define PELOCK(I, Z) +#define UNLOCKPE(I, Z) #endif INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *, PropEntry *p); -INLINE_ONLY EXTERN inline void -AddPropToAtom(AtomEntry *ae, PropEntry *p) -{ +INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) { /* old properties should be always last, and wide atom properties should always be first */ if (ae->PropsOfAE != NIL && @@ -1995,39 +1583,34 @@ AddPropToAtom(AtomEntry *ae, PropEntry *p) // auxiliary functions - -INLINE_ONLY inline EXTERN const char *AtomName (Atom at); +INLINE_ONLY inline EXTERN const char *AtomName(Atom at); -/** - * AtomName: get a string with the name of an Atom. Assumes 8 bit representation. - * +/** + * AtomName: get a string with the name of an Atom. Assumes 8 bit + *representation. + * * @param at the atom - * - * @return a ponter to an immutable sequence of characters. + * + * @return a ponter to an immutable sequence of characters. */ -INLINE_ONLY inline EXTERN const char * -AtomName (Atom at) -{ - return RepAtom(at) -> rep.uStrOfAE; +INLINE_ONLY inline EXTERN const char *AtomName(Atom at) { + return RepAtom(at)->rep.uStrOfAE; } +INLINE_ONLY inline EXTERN const char *AtomTermName(Term t); -INLINE_ONLY inline EXTERN const char *AtomTermName (Term t); - -/** - * AtomTermName: get a string with the name of a term storing an Atom. Assumes 8 bit representation. - * +/** + * AtomTermName: get a string with the name of a term storing an Atom. Assumes 8 + *bit representation. + * * @param t the atom term - * + * * @return a ponter to an immutable sequence of characters. - * + * * @note: this routine does not support wide chars. */ -INLINE_ONLY inline EXTERN const char* -AtomTermName (Term t) -{ - return RepAtom(AtomOfTerm(t)) -> rep.uStrOfAE; +INLINE_ONLY inline EXTERN const char *AtomTermName(Term t) { + return RepAtom(AtomOfTerm(t))->rep.uStrOfAE; } - #endif diff --git a/H/clause.h b/H/clause.h index 1b1cb9c8e..a72be97d7 100644 --- a/H/clause.h +++ b/H/clause.h @@ -26,127 +26,126 @@ typedef union CONSULT_OBJ { const unsigned char *filename; int mode; - Prop p; + Prop p; UInt c; } consult_obj; /* Either we are assembling clauses or indexing code */ -#define ASSEMBLING_CLAUSE 0 -#define ASSEMBLING_INDEX 1 -#define ASSEMBLING_EINDEX 2 +#define ASSEMBLING_CLAUSE 0 +#define ASSEMBLING_INDEX 1 +#define ASSEMBLING_EINDEX 2 -#define NextDynamicClause(X) (((yamop *)X)->y_u.Otapl.d) +#define NextDynamicClause(X) (((yamop *)X)->y_u.Otapl.d) -#define PredFirstClause 0 -#define PredMiddleClause 1 -#define PredLastClause 2 +#define PredFirstClause 0 +#define PredMiddleClause 1 +#define PredLastClause 2 typedef struct logic_upd_index { - CELL ClFlags; - UInt ClRefCount; + CELL ClFlags; + UInt ClRefCount; #if defined(YAPOR) || defined(THREADS) - /* A lock for manipulating the clause */ - // lockvar ClLock; +/* A lock for manipulating the clause */ +// lockvar ClLock; #endif - UInt ClSize; + UInt ClSize; struct logic_upd_index *ParentIndex; struct logic_upd_index *SiblingIndex; struct logic_upd_index *PrevSiblingIndex; struct logic_upd_index *ChildIndex; /* The instructions, at least one of the form sl */ PredEntry *ClPred; - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } LogUpdIndex; /* The ordering of the first 3 fields should be compatible with dbrefs */ typedef struct logic_upd_clause { - Functor Id; /* allow pointers to this struct to id */ - /* as dbref */ + Functor Id; /* allow pointers to this struct to id */ + /* as dbref */ /* A set of flags describing info on the clause */ /* A set of flags describing info on the clause */ - CELL ClFlags; + CELL ClFlags; #if defined(YAPOR) || defined(THREADS) - /* A lock for manipulating the clause */ - // lockvar ClLock; +/* A lock for manipulating the clause */ +// lockvar ClLock; #endif - UInt ClSize; + UInt ClSize; /* extra clause information for logical update indices and facts */ /* indices that may still backtrack to this clause */ - UInt ClRefCount; + UInt ClRefCount; /* data for clauses with environments */ - yamop *ClExt; + yamop *ClExt; union { - DBTerm *ClSource; - Int ClLine; + DBTerm *ClSource; + Int ClLine; } lusl; /* doubly linked list of clauses */ - struct logic_upd_clause *ClPrev, *ClNext; + struct logic_upd_clause *ClPrev, *ClNext; /* parent pointer */ - PredEntry *ClPred; - UInt ClTimeStart, ClTimeEnd; + PredEntry *ClPred; + UInt ClTimeStart, ClTimeEnd; /* The instructions, at least one of the form sl */ - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } LogUpdClause; #include "inline-only.h" INLINE_ONLY inline EXTERN int VALID_TIMESTAMP(UInt, struct logic_upd_clause *); -INLINE_ONLY inline EXTERN int -VALID_TIMESTAMP(UInt timestamp, struct logic_upd_clause *cl) -{ +INLINE_ONLY inline EXTERN int VALID_TIMESTAMP(UInt timestamp, + struct logic_upd_clause *cl) { return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd); } typedef struct dynamic_clause { /* A set of flags describing info on the clause */ - CELL ClFlags; + CELL ClFlags; #if defined(YAPOR) || defined(THREADS) /* A lock for manipulating the clause */ - lockvar ClLock; + lockvar ClLock; #endif - UInt ClSize; - Int ClLine; - UInt ClRefCount; - yamop *ClPrevious; /* immediate update clause */ + UInt ClSize; + Int ClLine; + UInt ClRefCount; + yamop *ClPrevious; /* immediate update clause */ /* The instructions, at least one of the form sl */ - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } DynamicClause; typedef struct static_index { /* A set of flags describing info on the clause */ - CELL ClFlags; - UInt ClSize; + CELL ClFlags; + UInt ClSize; struct static_index *SiblingIndex; struct static_index *ChildIndex; /* The instructions, at least one of the form sl */ PredEntry *ClPred; - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } StaticIndex; typedef struct static_clause { /* A set of flags describing info on the clause */ - CELL ClFlags; - UInt ClSize; + CELL ClFlags; + UInt ClSize; union { - DBTerm *ClSource; - Int ClLine; + DBTerm *ClSource; + Int ClLine; } usc; - struct static_clause *ClNext; + struct static_clause *ClNext; /* The instructions, at least one of the form sl */ - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } StaticClause; typedef struct static_mega_clause { /* A set of flags describing info on the clause */ - CELL ClFlags; - UInt ClSize; - PredEntry *ClPred; - UInt ClItemSize; - Int ClLine; - struct static_mega_clause *ClNext; + CELL ClFlags; + UInt ClSize; + PredEntry *ClPred; + UInt ClItemSize; + Int ClLine; + struct static_mega_clause *ClNext; /* The instructions, at least one of the form sl */ - yamop ClCode[MIN_ARRAY]; + yamop ClCode[MIN_ARRAY]; } MegaClause; typedef union clause_obj { @@ -191,43 +190,43 @@ typedef struct index_t { UInt udi_arg; } Index_t; -INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr); +INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, + CELL *ptr); -INLINE_ONLY EXTERN inline BITS32 -EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL* ptr) -{ - return (ptr-it->cls)/it->arity+1; +INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, + CELL *ptr) { + return (ptr - it->cls) / it->arity + 1; } -INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS32 off); +INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, + BITS32 off); -INLINE_ONLY EXTERN inline CELL * -EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS32 off) -{ +INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, + BITS32 off) { if (off == 0L) return (CELL *)NULL; - return (it->cls)+(off-1)*it->arity; + return (it->cls) + (off - 1) * it->arity; } -INLINE_ONLY EXTERN inline BITS32 ADDRESS_TO_LINK(struct index_t *it, BITS32 *ptr); +INLINE_ONLY EXTERN inline BITS32 ADDRESS_TO_LINK(struct index_t *it, + BITS32 *ptr); -INLINE_ONLY EXTERN inline BITS32 -ADDRESS_TO_LINK(struct index_t *it, BITS32* ptr) -{ - return ptr-it->links; +INLINE_ONLY EXTERN inline BITS32 ADDRESS_TO_LINK(struct index_t *it, + BITS32 *ptr) { + return ptr - it->links; } -INLINE_ONLY EXTERN inline BITS32 *LINK_TO_ADDRESS(struct index_t *it, BITS32 off); +INLINE_ONLY EXTERN inline BITS32 *LINK_TO_ADDRESS(struct index_t *it, + BITS32 off); -INLINE_ONLY EXTERN inline BITS32 * -LINK_TO_ADDRESS(struct index_t *it, BITS32 off) -{ - return it->links+off; +INLINE_ONLY EXTERN inline BITS32 *LINK_TO_ADDRESS(struct index_t *it, + BITS32 off) { + return it->links + off; } typedef void (*CRefitExoIndex)(struct index_t **ip, UInt b[] USES_REGS); -typedef yamop * (*CEnterExoIndex)(struct index_t *it USES_REGS); -typedef int (*CRetryExoIndex)(struct index_t *it USES_REGS); +typedef yamop *(*CEnterExoIndex)(struct index_t *it USES_REGS); +typedef int (*CRetryExoIndex)(struct index_t *it USES_REGS); typedef struct dbterm_list { /* a list of dbterms associated with a clause */ @@ -237,72 +236,81 @@ typedef struct dbterm_list { struct dbterm_list *next_dbl; } DBTermList; -#define ClauseCodeToDynamicClause(p) ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode))) -#define ClauseCodeToStaticClause(p) ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode))) -#define ClauseCodeToLogUpdClause(p) ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode))) -#define ClauseCodeToMegaClause(p) ((MegaClause *)((CODEADDR)(p)-(CELL)(((MegaClause *)NULL)->ClCode))) -#define ClauseCodeToLogUpdIndex(p) ((LogUpdIndex *)((CODEADDR)(p)-(CELL)(((LogUpdIndex *)NULL)->ClCode))) -#define ClauseCodeToStaticIndex(p) ((StaticIndex *)((CODEADDR)(p)-(CELL)(((StaticIndex *)NULL)->ClCode))) +#define ClauseCodeToDynamicClause(p) \ + ((DynamicClause *)((CODEADDR)(p) - (CELL)(((DynamicClause *)NULL)->ClCode))) +#define ClauseCodeToStaticClause(p) \ + ((StaticClause *)((CODEADDR)(p) - (CELL)(((StaticClause *)NULL)->ClCode))) +#define ClauseCodeToLogUpdClause(p) \ + ((LogUpdClause *)((CODEADDR)(p) - (CELL)(((LogUpdClause *)NULL)->ClCode))) +#define ClauseCodeToMegaClause(p) \ + ((MegaClause *)((CODEADDR)(p) - (CELL)(((MegaClause *)NULL)->ClCode))) +#define ClauseCodeToLogUpdIndex(p) \ + ((LogUpdIndex *)((CODEADDR)(p) - (CELL)(((LogUpdIndex *)NULL)->ClCode))) +#define ClauseCodeToStaticIndex(p) \ + ((StaticIndex *)((CODEADDR)(p) - (CELL)(((StaticIndex *)NULL)->ClCode))) -#define ClauseFlagsToDynamicClause(p) ((DynamicClause *)(p)) -#define ClauseFlagsToLogUpdClause(p) ((LogUpdClause *)((CODEADDR)(p)-(CELL)(&(((LogUpdClause *)NULL)->ClFlags)))) -#define ClauseFlagsToLogUpdIndex(p) ((LogUpdIndex *)((CODEADDR)(p)-(CELL)(&(((LogUpdIndex *)NULL)->ClFlags)))) -#define ClauseFlagsToStaticClause(p) ((StaticClause *)(p)) +#define ClauseFlagsToDynamicClause(p) ((DynamicClause *)(p)) +#define ClauseFlagsToLogUpdClause(p) \ + ((LogUpdClause *)((CODEADDR)(p) - (CELL)(&(((LogUpdClause *)NULL)->ClFlags)))) +#define ClauseFlagsToLogUpdIndex(p) \ + ((LogUpdIndex *)((CODEADDR)(p) - (CELL)(&(((LogUpdIndex *)NULL)->ClFlags)))) +#define ClauseFlagsToStaticClause(p) ((StaticClause *)(p)) -#define DynamicFlags(X) (ClauseCodeToDynamicClause(X)->ClFlags) +#define DynamicFlags(X) (ClauseCodeToDynamicClause(X)->ClFlags) -#define DynamicLock(X) (ClauseCodeToDynamicClause(X)->ClLock) +#define DynamicLock(X) (ClauseCodeToDynamicClause(X)->ClLock) #if MULTIPLE_STACKS #define INIT_CLREF_COUNT(X) (X)->ClRefCount = 0 -#define INC_CLREF_COUNT(X) (X)->ClRefCount++ -#define DEC_CLREF_COUNT(X) (X)->ClRefCount-- +#define INC_CLREF_COUNT(X) (X)->ClRefCount++ +#define DEC_CLREF_COUNT(X) (X)->ClRefCount-- -#define CL_IN_USE(X) ((X)->ClRefCount) +#define CL_IN_USE(X) ((X)->ClRefCount) #else #define INIT_CLREF_COUNT(X) -#define INC_CLREF_COUNT(X) -#define DEC_CLREF_COUNT(X) -#define CL_IN_USE(X) ((X)->ClFlags & InUseMask || (X)->ClRefCount) +#define INC_CLREF_COUNT(X) +#define DEC_CLREF_COUNT(X) +#define CL_IN_USE(X) ((X)->ClFlags & InUseMask || (X)->ClRefCount) #endif /* amasm.c */ -wamreg Yap_emit_x(CELL); -COUNT Yap_compile_cmp_flags(PredEntry *); -void Yap_InitComma(void); +wamreg Yap_emit_x(CELL); +COUNT Yap_compile_cmp_flags(PredEntry *); +void Yap_InitComma(void); /* cdmgr.c */ -void Yap_IPred(PredEntry *, UInt, yamop *); -int Yap_addclause(Term,yamop *,int,Term,Term*); -void Yap_add_logupd_clause(PredEntry *,LogUpdClause *,int); -void Yap_kill_iblock(ClauseUnion *,ClauseUnion *,PredEntry *); -void Yap_EraseStaticClause(StaticClause *, PredEntry *, Term); +void Yap_IPred(PredEntry *, UInt, yamop *); +bool Yap_addclause(Term, yamop *, int, Term, Term *); +void Yap_add_logupd_clause(PredEntry *, LogUpdClause *, int); +void Yap_kill_iblock(ClauseUnion *, ClauseUnion *, PredEntry *); +void Yap_EraseStaticClause(StaticClause *, PredEntry *, Term); ClauseUnion *Yap_find_owner_index(yamop *, PredEntry *); /* dbase.c */ -void Yap_ErCl(DynamicClause *); -void Yap_ErLogUpdCl(LogUpdClause *); -void Yap_ErLogUpdIndex(LogUpdIndex *); -Int Yap_Recordz(Atom, Term); -Int Yap_db_nth_recorded( PredEntry *, Int USES_REGS ); -Int Yap_unify_immediate_ref(DBRef ref USES_REGS ); +void Yap_ErCl(DynamicClause *); +void Yap_ErLogUpdCl(LogUpdClause *); +void Yap_ErLogUpdIndex(LogUpdIndex *); +Int Yap_Recordz(Atom, Term); +Int Yap_db_nth_recorded(PredEntry *, Int USES_REGS); +Int Yap_unify_immediate_ref(DBRef ref USES_REGS); /* exec.c */ -Term Yap_cp_as_integer(choiceptr); +Term Yap_cp_as_integer(choiceptr); /* index.c */ -yamop *Yap_PredIsIndexable(PredEntry *, UInt, yamop *); -yamop *Yap_ExpandIndex(PredEntry *, UInt); -void Yap_CleanUpIndex(struct logic_upd_index *); -void Yap_CleanKids(struct logic_upd_index *); -void Yap_AddClauseToIndex(PredEntry *,yamop *,int); -void Yap_RemoveClauseFromIndex(PredEntry *,yamop *); -LogUpdClause *Yap_NthClause(PredEntry *,Int); -LogUpdClause *Yap_FollowIndexingCode(PredEntry *,yamop *, Term *, yamop *,yamop *); +yamop *Yap_PredIsIndexable(PredEntry *, UInt, yamop *); +yamop *Yap_ExpandIndex(PredEntry *, UInt); +void Yap_CleanUpIndex(struct logic_upd_index *); +void Yap_CleanKids(struct logic_upd_index *); +void Yap_AddClauseToIndex(PredEntry *, yamop *, int); +void Yap_RemoveClauseFromIndex(PredEntry *, yamop *); +LogUpdClause *Yap_NthClause(PredEntry *, Int); +LogUpdClause *Yap_FollowIndexingCode(PredEntry *, yamop *, Term *, yamop *, + yamop *); /* exo.c */ -yamop *Yap_ExoLookup(PredEntry *ap USES_REGS); -CELL Yap_NextExo(choiceptr cpt, struct index_t *it); +yamop *Yap_ExoLookup(PredEntry *ap USES_REGS); +CELL Yap_NextExo(choiceptr cpt, struct index_t *it); # #if USE_THREADED_CODE @@ -311,24 +319,21 @@ CELL Yap_NextExo(choiceptr cpt, struct index_t *it); INLINE_ONLY inline EXTERN int rtable_hash_op(OPCODE opc, int hash_mask); -INLINE_ONLY inline EXTERN int -rtable_hash_op(OPCODE opc, int hash_mask) { - return((((CELL)opc) >> 3) & hash_mask); +INLINE_ONLY inline EXTERN int rtable_hash_op(OPCODE opc, int hash_mask) { + return ((((CELL)opc) >> 3) & hash_mask); } INLINE_ONLY inline EXTERN op_numbers Yap_op_from_opcode(OPCODE opc); /* given an opcode find the corresponding opnumber. This should make switches on ops a much easier operation */ -INLINE_ONLY inline EXTERN op_numbers -Yap_op_from_opcode(OPCODE opc) -{ - int j = rtable_hash_op(opc,OP_HASH_SIZE-1); +INLINE_ONLY inline EXTERN op_numbers Yap_op_from_opcode(OPCODE opc) { + int j = rtable_hash_op(opc, OP_HASH_SIZE - 1); while (OP_RTABLE[j].opc != opc) { if (!OP_RTABLE[j].opc) return _Nstop; - if (j == OP_HASH_SIZE-1) { + if (j == OP_HASH_SIZE - 1) { j = 0; } else { j++; @@ -337,26 +342,23 @@ Yap_op_from_opcode(OPCODE opc) return OP_RTABLE[j].opnum; } #else -static inline op_numbers -Yap_op_from_opcode(OPCODE opc) -{ - return((op_numbers)opc); +static inline op_numbers Yap_op_from_opcode(OPCODE opc) { + return ((op_numbers)opc); } #endif /* USE_THREADED_CODE */ #if defined(YAPOR) || defined(THREADS) static inline int same_lu_block(yamop **, yamop *); -static inline int -same_lu_block(yamop **paddr, yamop *p) -{ +static inline int same_lu_block(yamop **paddr, yamop *p) { yamop *np = *paddr; if (np != p) { OPCODE jmp_op = Yap_opcode(_jump_if_nonvar); while (np->opc == jmp_op) { np = NEXTOP(np, xll); - if (np == p) return TRUE; + if (np == p) + return TRUE; } return FALSE; } else { @@ -365,86 +367,69 @@ same_lu_block(yamop **paddr, yamop *p) } #endif -#define Yap_MkStaticRefTerm(cp, ap) __Yap_MkStaticRefTerm((cp), (ap) PASS_REGS) +#define Yap_MkStaticRefTerm(cp, ap) __Yap_MkStaticRefTerm((cp), (ap)PASS_REGS) -static inline Term -__Yap_MkStaticRefTerm(StaticClause *cp, PredEntry *ap USES_REGS) -{ +static inline Term __Yap_MkStaticRefTerm(StaticClause *cp, + PredEntry *ap USES_REGS) { Term t[2]; t[0] = MkIntegerTerm((Int)cp); t[1] = MkIntegerTerm((Int)ap); - return Yap_MkApplTerm(FunctorStaticClause,2,t); + return Yap_MkApplTerm(FunctorStaticClause, 2, t); } -static inline StaticClause * -Yap_ClauseFromTerm(Term t) -{ - return (StaticClause *)IntegerOfTerm(ArgOfTerm(1,t)); +static inline StaticClause *Yap_ClauseFromTerm(Term t) { + return (StaticClause *)IntegerOfTerm(ArgOfTerm(1, t)); } -#define Yap_MkMegaRefTerm(ap, ipc) __Yap_MkMegaRefTerm((ap), (ipc) PASS_REGS) +#define Yap_MkMegaRefTerm(ap, ipc) __Yap_MkMegaRefTerm((ap), (ipc)PASS_REGS) -static inline Term -__Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc USES_REGS) -{ +static inline Term __Yap_MkMegaRefTerm(PredEntry *ap, yamop *ipc USES_REGS) { Term t[2]; t[0] = MkIntegerTerm((Int)ap); t[1] = MkIntegerTerm((Int)ipc); - return Yap_MkApplTerm(FunctorMegaClause,2,t); + return Yap_MkApplTerm(FunctorMegaClause, 2, t); } -static inline yamop * -Yap_MegaClauseFromTerm(Term t) -{ - return (yamop *)IntegerOfTerm(ArgOfTerm(2,t)); +static inline yamop *Yap_MegaClauseFromTerm(Term t) { + return (yamop *)IntegerOfTerm(ArgOfTerm(2, t)); } -static inline PredEntry * -Yap_MegaClausePredicateFromTerm(Term t) -{ - return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t)); +static inline PredEntry *Yap_MegaClausePredicateFromTerm(Term t) { + return (PredEntry *)IntegerOfTerm(ArgOfTerm(1, t)); } -#define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i) PASS_REGS) +#define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i)PASS_REGS) -static inline Term -__Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS) -{ +static inline Term __Yap_MkExoRefTerm(PredEntry *ap, Int i USES_REGS) { Term t[2]; t[0] = MkIntegerTerm((Int)ap); t[1] = MkIntegerTerm((Int)i); - return Yap_MkApplTerm(FunctorExoClause,2,t); + return Yap_MkApplTerm(FunctorExoClause, 2, t); } -static inline Int -Yap_ExoClauseFromTerm(Term t) -{ - return IntegerOfTerm(ArgOfTerm(2,t)); +static inline Int Yap_ExoClauseFromTerm(Term t) { + return IntegerOfTerm(ArgOfTerm(2, t)); } -static inline PredEntry * -Yap_ExoClausePredicateFromTerm(Term t) -{ - return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t)); +static inline PredEntry *Yap_ExoClausePredicateFromTerm(Term t) { + return (PredEntry *)IntegerOfTerm(ArgOfTerm(1, t)); } /****************************************************************** - EXECUTING PROLOG CLAUSES + EXECUTING PROLOG CLAUSES ******************************************************************/ -bool -Yap_search_for_static_predicate_in_use(PredEntry *p, bool check_everything); +bool Yap_search_for_static_predicate_in_use(PredEntry *p, + bool check_everything); -static inline bool -Yap_static_in_use(PredEntry *p, bool check_everything) -{ +static inline bool Yap_static_in_use(PredEntry *p, bool check_everything) { #if defined(YAPOR) || defined(THREADS) return TRUE; #else pred_flags_t pflags = p->PredFlags; - if (pflags & (DynamicPredFlag|LogUpdatePredFlag)) { + if (pflags & (DynamicPredFlag | LogUpdatePredFlag)) { return FALSE; } if (STATIC_PREDICATES_MARKED) { @@ -464,24 +449,24 @@ typedef enum { FIND_PRED_FROM_ENV } find_pred_type; -Int Yap_PredForCode(yamop *, find_pred_type, Atom *, UInt *, Term *); -PredEntry *Yap_PredEntryForCode(yamop *, find_pred_type, void* *, void* *); -LogUpdClause *Yap_new_ludbe(Term, PredEntry *, UInt); -Term Yap_LUInstance(LogUpdClause *, UInt); +Int Yap_PredForCode(yamop *, find_pred_type, Atom *, UInt *, Term *); +PredEntry *Yap_PredEntryForCode(yamop *, find_pred_type, void **, void **); +LogUpdClause *Yap_new_ludbe(Term, PredEntry *, UInt); +Term Yap_LUInstance(LogUpdClause *, UInt); /* udi.c */ -int Yap_new_udi_clause(PredEntry *, yamop *, Term); -yamop *Yap_udi_search(PredEntry *); +int Yap_new_udi_clause(PredEntry *, yamop *, Term); +yamop *Yap_udi_search(PredEntry *); -Term Yap_bug_location(yamop *p, yamop *cp, choiceptr b_ptr, CELL *env); -Term Yap_pc_location(yamop *p, choiceptr b_ptr, CELL *env); -Term Yap_env_location(yamop *p, choiceptr b_ptr, CELL *env, Int ignore_first); +Term Yap_bug_location(yamop *p, yamop *cp, choiceptr b_ptr, CELL *env); +Term Yap_pc_location(yamop *p, choiceptr b_ptr, CELL *env); +Term Yap_env_location(yamop *p, choiceptr b_ptr, CELL *env, Int ignore_first); -#if LOW_PROF -void Yap_InformOfRemoval(void *); -void Yap_dump_code_area_for_profiler(void); +#if LOW_PROF +void Yap_InformOfRemoval(void *); +void Yap_dump_code_area_for_profiler(void); #else -#define Yap_InformOfRemoval(X) +#define Yap_InformOfRemoval(X) #endif #endif diff --git a/H/dglobals.h b/H/dglobals.h deleted file mode 100644 index 1d787b765..000000000 --- a/H/dglobals.h +++ /dev/null @@ -1,146 +0,0 @@ - - /* This file, dglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ - - - - - - - - - - - - - - - - - - - -#define GLOBAL_Initialised Yap_global->Initialised_ -#define GLOBAL_InitialisedFromPL Yap_global->InitialisedFromPL_ -#define GLOBAL_PL_Argc Yap_global->PL_Argc_ -#define GLOBAL_PL_Argv Yap_global->PL_Argv_ -#define GLOBAL_FAST_BOOT_FLAG Yap_global->FAST_BOOT_FLAG_ - -#define GLOBAL_HaltHooks Yap_global->HaltHooks_ -#define GLOBAL_JIT_finalizer Yap_global->JIT_finalizer_ - -#define GLOBAL_AllowLocalExpansion Yap_global->AllowLocalExpansion_ -#define GLOBAL_AllowGlobalExpansion Yap_global->AllowGlobalExpansion_ -#define GLOBAL_AllowTrailExpansion Yap_global->AllowTrailExpansion_ -#define GLOBAL_SizeOfOverflow Yap_global->SizeOfOverflow_ - -#define GLOBAL_AGcThreshold Yap_global->AGcThreshold_ -#define GLOBAL_AGCHook Yap_global->AGCHook_ -#if __ANDROID__ - -#define GLOBAL_assetManager Yap_global->assetManager_ -#define GLOBAL_AssetsWD Yap_global->AssetsWD_ -#endif - -#if THREADS - -#define GLOBAL_NOfThreads Yap_global->NOfThreads_ - -#define GLOBAL_NOfThreadsCreated Yap_global->NOfThreadsCreated_ - -#define GLOBAL_ThreadsTotalTime Yap_global->ThreadsTotalTime_ - -#define GLOBAL_ThreadHandlesLock Yap_global->ThreadHandlesLock_ -#endif -#if defined(YAPOR) || defined(THREADS) - -#define GLOBAL_BGL Yap_global->BGL_ -#endif -#if defined(YAPOR) || defined(TABLING) -#define GLOBAL_optyap_data Yap_global->optyap_data_ -#endif /* YAPOR || TABLING */ - -#define GLOBAL_PrologShouldHandleInterrupts Yap_global->PrologShouldHandleInterrupts_ - -#if defined(THREADS) -#define GLOBAL_master_thread Yap_global->master_thread_ -#define GLOBAL_named_mboxes Yap_global->named_mboxes_ -#define GLOBAL_mboxq_lock Yap_global->mboxq_lock_ -#define GLOBAL_mbox_count Yap_global->mbox_count_ -#define GLOBAL_WithMutex Yap_global->WithMutex_ -#endif /* THREADS */ - -#define GLOBAL_Stream Yap_global->Stream_ -#if defined(THREADS)||defined(YAPOR) -#define GLOBAL_StreamDescLock Yap_global->StreamDescLock_ -#endif - -#define GLOBAL_argv Yap_global->argv_ -#define GLOBAL_argc Yap_global->argc_ - -#ifdef COROUTINING - -#define GLOBAL_attas Yap_global->attas_ -#endif - -#define GLOBAL_agc_calls Yap_global->agc_calls_ -#define GLOBAL_agc_collected Yap_global->agc_collected_ - -#define GLOBAL_tot_agc_time Yap_global->tot_agc_time_ - -#define GLOBAL_tot_agc_recovered Yap_global->tot_agc_recovered_ - -#if HAVE_MMAP -#define GLOBAL_mmap_arrays Yap_global->mmap_arrays_ -#endif -#ifdef DEBUG - -#define GLOBAL_Option Yap_global->Option_ -#define GLOBAL_logfile Yap_global->logfile_ - - -#endif -#if defined(COFF) || defined(A_OUT) - -#define GLOBAL_Executable Yap_global->Executable_ -#endif -#define GLOBAL_OpaqueHandlersCount Yap_global->OpaqueHandlersCount_ -#define GLOBAL_OpaqueHandlers Yap_global->OpaqueHandlers_ -#if __simplescalar__ -#define GLOBAL_pwd Yap_global->pwd_ -#endif - - -#define GLOBAL_RestoreFile Yap_global->RestoreFile_ - -#define GLOBAL_ProfCalls Yap_global->ProfCalls_ -#define GLOBAL_ProfGCs Yap_global->ProfGCs_ -#define GLOBAL_ProfHGrows Yap_global->ProfHGrows_ -#define GLOBAL_ProfSGrows Yap_global->ProfSGrows_ -#define GLOBAL_ProfMallocs Yap_global->ProfMallocs_ -#define GLOBAL_ProfIndexing Yap_global->ProfIndexing_ -#define GLOBAL_ProfOn Yap_global->ProfOn_ -#define GLOBAL_ProfOns Yap_global->ProfOns_ -#define GLOBAL_ProfilerRoot Yap_global->ProfilerRoot_ -#define GLOBAL_ProfilerNil Yap_global->ProfilerNil_ -#define GLOBAL_DIRNAME Yap_global->DIRNAME_ -#if LOW_PROF -#define GLOBAL_ProfilerOn Yap_global->ProfilerOn_ -#define GLOBAL_FProf Yap_global->FProf_ -#define GLOBAL_FPreds Yap_global->FPreds_ -#endif /* LOW_PROF */ - -#if THREADS -#define GLOBAL_FreeMutexes Yap_global->FreeMutexes_ -#define GLOBAL_mutex_backbone Yap_global->mutex_backbone_ -#define GLOBAL_MUT_ACCESS Yap_global->MUT_ACCESS_ -#endif -#define GLOBAL_Home Yap_global->Home_ - -#define GLOBAL_CharConversionTable Yap_global->CharConversionTable_ -#define GLOBAL_CharConversionTable2 Yap_global->CharConversionTable2_ - -#define GLOBAL_LastWTimePtr Yap_global->LastWTimePtr_ - -#define GLOBAL_MaxPriority Yap_global->MaxPriority_ - diff --git a/H/dlocals.h b/H/dlocals.h deleted file mode 100644 index 56e3e0da2..000000000 --- a/H/dlocals.h +++ /dev/null @@ -1,493 +0,0 @@ - - /* This file, dlocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ - - - - -#define LOCAL_FileAliases LOCAL->FileAliases_ -#define REMOTE_FileAliases(wid) REMOTE(wid)->FileAliases_ -#define LOCAL_NOfFileAliases LOCAL->NOfFileAliases_ -#define REMOTE_NOfFileAliases(wid) REMOTE(wid)->NOfFileAliases_ -#define LOCAL_SzOfFileAliases LOCAL->SzOfFileAliases_ -#define REMOTE_SzOfFileAliases(wid) REMOTE(wid)->SzOfFileAliases_ -#define LOCAL_c_input_stream LOCAL->c_input_stream_ -#define REMOTE_c_input_stream(wid) REMOTE(wid)->c_input_stream_ -#define LOCAL_c_output_stream LOCAL->c_output_stream_ -#define REMOTE_c_output_stream(wid) REMOTE(wid)->c_output_stream_ -#define LOCAL_c_error_stream LOCAL->c_error_stream_ -#define REMOTE_c_error_stream(wid) REMOTE(wid)->c_error_stream_ -#define LOCAL_sockets_io LOCAL->sockets_io_ -#define REMOTE_sockets_io(wid) REMOTE(wid)->sockets_io_ -#define LOCAL_within_print_message LOCAL->within_print_message_ -#define REMOTE_within_print_message(wid) REMOTE(wid)->within_print_message_ - - - - -#define LOCAL_newline LOCAL->newline_ -#define REMOTE_newline(wid) REMOTE(wid)->newline_ -#define LOCAL_AtPrompt LOCAL->AtPrompt_ -#define REMOTE_AtPrompt(wid) REMOTE(wid)->AtPrompt_ -#define LOCAL_Prompt LOCAL->Prompt_ -#define REMOTE_Prompt(wid) REMOTE(wid)->Prompt_ -#define LOCAL_encoding LOCAL->encoding_ -#define REMOTE_encoding(wid) REMOTE(wid)->encoding_ -#define LOCAL_quasi_quotations LOCAL->quasi_quotations_ -#define REMOTE_quasi_quotations(wid) REMOTE(wid)->quasi_quotations_ -#define LOCAL_default_priority LOCAL->default_priority_ -#define REMOTE_default_priority(wid) REMOTE(wid)->default_priority_ -#define LOCAL_eot_before_eof LOCAL->eot_before_eof_ -#define REMOTE_eot_before_eof(wid) REMOTE(wid)->eot_before_eof_ -#define LOCAL_max_depth LOCAL->max_depth_ -#define REMOTE_max_depth(wid) REMOTE(wid)->max_depth_ -#define LOCAL_max_list LOCAL->max_list_ -#define REMOTE_max_list(wid) REMOTE(wid)->max_list_ -#define LOCAL_max_write_args LOCAL->max_write_args_ -#define REMOTE_max_write_args(wid) REMOTE(wid)->max_write_args_ - -#define LOCAL_OldASP LOCAL->OldASP_ -#define REMOTE_OldASP(wid) REMOTE(wid)->OldASP_ -#define LOCAL_OldLCL0 LOCAL->OldLCL0_ -#define REMOTE_OldLCL0(wid) REMOTE(wid)->OldLCL0_ -#define LOCAL_OldTR LOCAL->OldTR_ -#define REMOTE_OldTR(wid) REMOTE(wid)->OldTR_ -#define LOCAL_OldGlobalBase LOCAL->OldGlobalBase_ -#define REMOTE_OldGlobalBase(wid) REMOTE(wid)->OldGlobalBase_ -#define LOCAL_OldH LOCAL->OldH_ -#define REMOTE_OldH(wid) REMOTE(wid)->OldH_ -#define LOCAL_OldH0 LOCAL->OldH0_ -#define REMOTE_OldH0(wid) REMOTE(wid)->OldH0_ -#define LOCAL_OldTrailBase LOCAL->OldTrailBase_ -#define REMOTE_OldTrailBase(wid) REMOTE(wid)->OldTrailBase_ -#define LOCAL_OldTrailTop LOCAL->OldTrailTop_ -#define REMOTE_OldTrailTop(wid) REMOTE(wid)->OldTrailTop_ -#define LOCAL_OldHeapBase LOCAL->OldHeapBase_ -#define REMOTE_OldHeapBase(wid) REMOTE(wid)->OldHeapBase_ -#define LOCAL_OldHeapTop LOCAL->OldHeapTop_ -#define REMOTE_OldHeapTop(wid) REMOTE(wid)->OldHeapTop_ -#define LOCAL_ClDiff LOCAL->ClDiff_ -#define REMOTE_ClDiff(wid) REMOTE(wid)->ClDiff_ -#define LOCAL_GDiff LOCAL->GDiff_ -#define REMOTE_GDiff(wid) REMOTE(wid)->GDiff_ -#define LOCAL_HDiff LOCAL->HDiff_ -#define REMOTE_HDiff(wid) REMOTE(wid)->HDiff_ -#define LOCAL_GDiff0 LOCAL->GDiff0_ -#define REMOTE_GDiff0(wid) REMOTE(wid)->GDiff0_ -#define LOCAL_GSplit LOCAL->GSplit_ -#define REMOTE_GSplit(wid) REMOTE(wid)->GSplit_ -#define LOCAL_LDiff LOCAL->LDiff_ -#define REMOTE_LDiff(wid) REMOTE(wid)->LDiff_ -#define LOCAL_TrDiff LOCAL->TrDiff_ -#define REMOTE_TrDiff(wid) REMOTE(wid)->TrDiff_ -#define LOCAL_XDiff LOCAL->XDiff_ -#define REMOTE_XDiff(wid) REMOTE(wid)->XDiff_ -#define LOCAL_DelayDiff LOCAL->DelayDiff_ -#define REMOTE_DelayDiff(wid) REMOTE(wid)->DelayDiff_ -#define LOCAL_BaseDiff LOCAL->BaseDiff_ -#define REMOTE_BaseDiff(wid) REMOTE(wid)->BaseDiff_ - -#define LOCAL_ReductionsCounter LOCAL->ReductionsCounter_ -#define REMOTE_ReductionsCounter(wid) REMOTE(wid)->ReductionsCounter_ -#define LOCAL_PredEntriesCounter LOCAL->PredEntriesCounter_ -#define REMOTE_PredEntriesCounter(wid) REMOTE(wid)->PredEntriesCounter_ -#define LOCAL_RetriesCounter LOCAL->RetriesCounter_ -#define REMOTE_RetriesCounter(wid) REMOTE(wid)->RetriesCounter_ -#define LOCAL_ReductionsCounterOn LOCAL->ReductionsCounterOn_ -#define REMOTE_ReductionsCounterOn(wid) REMOTE(wid)->ReductionsCounterOn_ -#define LOCAL_PredEntriesCounterOn LOCAL->PredEntriesCounterOn_ -#define REMOTE_PredEntriesCounterOn(wid) REMOTE(wid)->PredEntriesCounterOn_ -#define LOCAL_RetriesCounterOn LOCAL->RetriesCounterOn_ -#define REMOTE_RetriesCounterOn(wid) REMOTE(wid)->RetriesCounterOn_ - - -#define LOCAL_ConsultSp LOCAL->ConsultSp_ -#define REMOTE_ConsultSp(wid) REMOTE(wid)->ConsultSp_ - -#define LOCAL_ConsultCapacity LOCAL->ConsultCapacity_ -#define REMOTE_ConsultCapacity(wid) REMOTE(wid)->ConsultCapacity_ - -#define LOCAL_ConsultBase LOCAL->ConsultBase_ -#define REMOTE_ConsultBase(wid) REMOTE(wid)->ConsultBase_ - -#define LOCAL_ConsultLow LOCAL->ConsultLow_ -#define REMOTE_ConsultLow(wid) REMOTE(wid)->ConsultLow_ -#define LOCAL_VarNames LOCAL->VarNames_ -#define REMOTE_VarNames(wid) REMOTE(wid)->VarNames_ -#define LOCAL_SourceFileName LOCAL->SourceFileName_ -#define REMOTE_SourceFileName(wid) REMOTE(wid)->SourceFileName_ -#define LOCAL_SourceFileLineno LOCAL->SourceFileLineno_ -#define REMOTE_SourceFileLineno(wid) REMOTE(wid)->SourceFileLineno_ - -#define LOCAL_GlobalArena LOCAL->GlobalArena_ -#define REMOTE_GlobalArena(wid) REMOTE(wid)->GlobalArena_ -#define LOCAL_GlobalArenaOverflows LOCAL->GlobalArenaOverflows_ -#define REMOTE_GlobalArenaOverflows(wid) REMOTE(wid)->GlobalArenaOverflows_ -#define LOCAL_ArenaOverflows LOCAL->ArenaOverflows_ -#define REMOTE_ArenaOverflows(wid) REMOTE(wid)->ArenaOverflows_ -#define LOCAL_DepthArenas LOCAL->DepthArenas_ -#define REMOTE_DepthArenas(wid) REMOTE(wid)->DepthArenas_ -#define LOCAL_ArithError LOCAL->ArithError_ -#define REMOTE_ArithError(wid) REMOTE(wid)->ArithError_ -#define LOCAL_LastAssertedPred LOCAL->LastAssertedPred_ -#define REMOTE_LastAssertedPred(wid) REMOTE(wid)->LastAssertedPred_ -#define LOCAL_TmpPred LOCAL->TmpPred_ -#define REMOTE_TmpPred(wid) REMOTE(wid)->TmpPred_ -#define LOCAL_ScannerStack LOCAL->ScannerStack_ -#define REMOTE_ScannerStack(wid) REMOTE(wid)->ScannerStack_ -#define LOCAL_ScannerExtraBlocks LOCAL->ScannerExtraBlocks_ -#define REMOTE_ScannerExtraBlocks(wid) REMOTE(wid)->ScannerExtraBlocks_ -#define LOCAL_BallTerm LOCAL->BallTerm_ -#define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_ -#define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_ -#define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_ -#define LOCAL_Signals LOCAL->Signals_ -#define REMOTE_Signals(wid) REMOTE(wid)->Signals_ -#define LOCAL_IPredArity LOCAL->IPredArity_ -#define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_ -#define LOCAL_ProfEnd LOCAL->ProfEnd_ -#define REMOTE_ProfEnd(wid) REMOTE(wid)->ProfEnd_ -#define LOCAL_UncaughtThrow LOCAL->UncaughtThrow_ -#define REMOTE_UncaughtThrow(wid) REMOTE(wid)->UncaughtThrow_ -#define LOCAL_DoingUndefp LOCAL->DoingUndefp_ -#define REMOTE_DoingUndefp(wid) REMOTE(wid)->DoingUndefp_ -#define LOCAL_StartCharCount LOCAL->StartCharCount_ -#define REMOTE_StartCharCount(wid) REMOTE(wid)->StartCharCount_ -#define LOCAL_StartLineCount LOCAL->StartLineCount_ -#define REMOTE_StartLineCount(wid) REMOTE(wid)->StartLineCount_ -#define LOCAL_StartLinePos LOCAL->StartLinePos_ -#define REMOTE_StartLinePos(wid) REMOTE(wid)->StartLinePos_ -#define LOCAL_ScratchPad LOCAL->ScratchPad_ -#define REMOTE_ScratchPad(wid) REMOTE(wid)->ScratchPad_ -#ifdef COROUTINING -#define LOCAL_WokenGoals LOCAL->WokenGoals_ -#define REMOTE_WokenGoals(wid) REMOTE(wid)->WokenGoals_ -#define LOCAL_AttsMutableList LOCAL->AttsMutableList_ -#define REMOTE_AttsMutableList(wid) REMOTE(wid)->AttsMutableList_ -#endif - -#define LOCAL_GcGeneration LOCAL->GcGeneration_ -#define REMOTE_GcGeneration(wid) REMOTE(wid)->GcGeneration_ -#define LOCAL_GcPhase LOCAL->GcPhase_ -#define REMOTE_GcPhase(wid) REMOTE(wid)->GcPhase_ -#define LOCAL_GcCurrentPhase LOCAL->GcCurrentPhase_ -#define REMOTE_GcCurrentPhase(wid) REMOTE(wid)->GcCurrentPhase_ -#define LOCAL_GcCalls LOCAL->GcCalls_ -#define REMOTE_GcCalls(wid) REMOTE(wid)->GcCalls_ -#define LOCAL_TotGcTime LOCAL->TotGcTime_ -#define REMOTE_TotGcTime(wid) REMOTE(wid)->TotGcTime_ -#define LOCAL_TotGcRecovered LOCAL->TotGcRecovered_ -#define REMOTE_TotGcRecovered(wid) REMOTE(wid)->TotGcRecovered_ -#define LOCAL_LastGcTime LOCAL->LastGcTime_ -#define REMOTE_LastGcTime(wid) REMOTE(wid)->LastGcTime_ -#define LOCAL_LastSSTime LOCAL->LastSSTime_ -#define REMOTE_LastSSTime(wid) REMOTE(wid)->LastSSTime_ -#define LOCAL_OpenArray LOCAL->OpenArray_ -#define REMOTE_OpenArray(wid) REMOTE(wid)->OpenArray_ - -#define LOCAL_total_marked LOCAL->total_marked_ -#define REMOTE_total_marked(wid) REMOTE(wid)->total_marked_ -#define LOCAL_total_oldies LOCAL->total_oldies_ -#define REMOTE_total_oldies(wid) REMOTE(wid)->total_oldies_ -#define LOCAL_current_B LOCAL->current_B_ -#define REMOTE_current_B(wid) REMOTE(wid)->current_B_ -#define LOCAL_prev_HB LOCAL->prev_HB_ -#define REMOTE_prev_HB(wid) REMOTE(wid)->prev_HB_ -#define LOCAL_HGEN LOCAL->HGEN_ -#define REMOTE_HGEN(wid) REMOTE(wid)->HGEN_ -#define LOCAL_iptop LOCAL->iptop_ -#define REMOTE_iptop(wid) REMOTE(wid)->iptop_ -#if defined(GC_NO_TAGS) -#define LOCAL_bp LOCAL->bp_ -#define REMOTE_bp(wid) REMOTE(wid)->bp_ -#endif -#define LOCAL_sTR LOCAL->sTR_ -#define REMOTE_sTR(wid) REMOTE(wid)->sTR_ -#define LOCAL_sTR0 LOCAL->sTR0_ -#define REMOTE_sTR0(wid) REMOTE(wid)->sTR0_ -#define LOCAL_new_TR LOCAL->new_TR_ -#define REMOTE_new_TR(wid) REMOTE(wid)->new_TR_ -#define LOCAL_cont_top0 LOCAL->cont_top0_ -#define REMOTE_cont_top0(wid) REMOTE(wid)->cont_top0_ -#define LOCAL_cont_top LOCAL->cont_top_ -#define REMOTE_cont_top(wid) REMOTE(wid)->cont_top_ -#define LOCAL_discard_trail_entries LOCAL->discard_trail_entries_ -#define REMOTE_discard_trail_entries(wid) REMOTE(wid)->discard_trail_entries_ -#define LOCAL_gc_ma_hash_table LOCAL->gc_ma_hash_table_ -#define REMOTE_gc_ma_hash_table(wid) REMOTE(wid)->gc_ma_hash_table_ -#define LOCAL_gc_ma_h_top LOCAL->gc_ma_h_top_ -#define REMOTE_gc_ma_h_top(wid) REMOTE(wid)->gc_ma_h_top_ -#define LOCAL_gc_ma_h_list LOCAL->gc_ma_h_list_ -#define REMOTE_gc_ma_h_list(wid) REMOTE(wid)->gc_ma_h_list_ -#define LOCAL_gc_timestamp LOCAL->gc_timestamp_ -#define REMOTE_gc_timestamp(wid) REMOTE(wid)->gc_timestamp_ -#define LOCAL_db_vec LOCAL->db_vec_ -#define REMOTE_db_vec(wid) REMOTE(wid)->db_vec_ -#define LOCAL_db_vec0 LOCAL->db_vec0_ -#define REMOTE_db_vec0(wid) REMOTE(wid)->db_vec0_ -#define LOCAL_db_root LOCAL->db_root_ -#define REMOTE_db_root(wid) REMOTE(wid)->db_root_ -#define LOCAL_db_nil LOCAL->db_nil_ -#define REMOTE_db_nil(wid) REMOTE(wid)->db_nil_ -#define LOCAL_gc_restore LOCAL->gc_restore_ -#define REMOTE_gc_restore(wid) REMOTE(wid)->gc_restore_ -#define LOCAL_extra_gc_cells LOCAL->extra_gc_cells_ -#define REMOTE_extra_gc_cells(wid) REMOTE(wid)->extra_gc_cells_ -#define LOCAL_extra_gc_cells_base LOCAL->extra_gc_cells_base_ -#define REMOTE_extra_gc_cells_base(wid) REMOTE(wid)->extra_gc_cells_base_ -#define LOCAL_extra_gc_cells_top LOCAL->extra_gc_cells_top_ -#define REMOTE_extra_gc_cells_top(wid) REMOTE(wid)->extra_gc_cells_top_ -#define LOCAL_extra_gc_cells_size LOCAL->extra_gc_cells_size_ -#define REMOTE_extra_gc_cells_size(wid) REMOTE(wid)->extra_gc_cells_size_ -#define LOCAL_DynamicArrays LOCAL->DynamicArrays_ -#define REMOTE_DynamicArrays(wid) REMOTE(wid)->DynamicArrays_ -#define LOCAL_StaticArrays LOCAL->StaticArrays_ -#define REMOTE_StaticArrays(wid) REMOTE(wid)->StaticArrays_ -#define LOCAL_GlobalVariables LOCAL->GlobalVariables_ -#define REMOTE_GlobalVariables(wid) REMOTE(wid)->GlobalVariables_ -#define LOCAL_AllowRestart LOCAL->AllowRestart_ -#define REMOTE_AllowRestart(wid) REMOTE(wid)->AllowRestart_ - -#define LOCAL_CMemFirstBlock LOCAL->CMemFirstBlock_ -#define REMOTE_CMemFirstBlock(wid) REMOTE(wid)->CMemFirstBlock_ -#define LOCAL_CMemFirstBlockSz LOCAL->CMemFirstBlockSz_ -#define REMOTE_CMemFirstBlockSz(wid) REMOTE(wid)->CMemFirstBlockSz_ - -#define LOCAL_nperm LOCAL->nperm_ -#define REMOTE_nperm(wid) REMOTE(wid)->nperm_ - -#define LOCAL_LabelFirstArray LOCAL->LabelFirstArray_ -#define REMOTE_LabelFirstArray(wid) REMOTE(wid)->LabelFirstArray_ -#define LOCAL_LabelFirstArraySz LOCAL->LabelFirstArraySz_ -#define REMOTE_LabelFirstArraySz(wid) REMOTE(wid)->LabelFirstArraySz_ - - -#ifdef THREADS -#define LOCAL_ThreadHandle LOCAL->ThreadHandle_ -#define REMOTE_ThreadHandle(wid) REMOTE(wid)->ThreadHandle_ -#endif /* THREADS */ -#if defined(YAPOR) || defined(TABLING) -#define LOCAL_optyap_data LOCAL->optyap_data_ -#define REMOTE_optyap_data(wid) REMOTE(wid)->optyap_data_ -#define LOCAL_TabMode LOCAL->TabMode_ -#define REMOTE_TabMode(wid) REMOTE(wid)->TabMode_ -#endif /* YAPOR || TABLING */ -#define LOCAL_InterruptsDisabled LOCAL->InterruptsDisabled_ -#define REMOTE_InterruptsDisabled(wid) REMOTE(wid)->InterruptsDisabled_ -#define LOCAL_execution LOCAL->execution_ -#define REMOTE_execution(wid) REMOTE(wid)->execution_ -#if LOW_LEVEL_TRACER -#define LOCAL_total_choicepoints LOCAL->total_choicepoints_ -#define REMOTE_total_choicepoints(wid) REMOTE(wid)->total_choicepoints_ -#endif -#define LOCAL_consult_level LOCAL->consult_level_ -#define REMOTE_consult_level(wid) REMOTE(wid)->consult_level_ - -#define LOCAL_LocalBase LOCAL->LocalBase_ -#define REMOTE_LocalBase(wid) REMOTE(wid)->LocalBase_ -#define LOCAL_GlobalBase LOCAL->GlobalBase_ -#define REMOTE_GlobalBase(wid) REMOTE(wid)->GlobalBase_ -#define LOCAL_TrailBase LOCAL->TrailBase_ -#define REMOTE_TrailBase(wid) REMOTE(wid)->TrailBase_ -#define LOCAL_TrailTop LOCAL->TrailTop_ -#define REMOTE_TrailTop(wid) REMOTE(wid)->TrailTop_ -#define LOCAL_ErrorMessage LOCAL->ErrorMessage_ -#define REMOTE_ErrorMessage(wid) REMOTE(wid)->ErrorMessage_ -#define LOCAL_Error_Term LOCAL->Error_Term_ -#define REMOTE_Error_Term(wid) REMOTE(wid)->Error_Term_ -#define LOCAL_Error_TYPE LOCAL->Error_TYPE_ -#define REMOTE_Error_TYPE(wid) REMOTE(wid)->Error_TYPE_ -#define LOCAL_Error_File LOCAL->Error_File_ -#define REMOTE_Error_File(wid) REMOTE(wid)->Error_File_ -#define LOCAL_Error_Function LOCAL->Error_Function_ -#define REMOTE_Error_Function(wid) REMOTE(wid)->Error_Function_ -#define LOCAL_Error_Lineno LOCAL->Error_Lineno_ -#define REMOTE_Error_Lineno(wid) REMOTE(wid)->Error_Lineno_ -#define LOCAL_Error_Size LOCAL->Error_Size_ -#define REMOTE_Error_Size(wid) REMOTE(wid)->Error_Size_ -#define LOCAL_ErrorSay LOCAL->ErrorSay_ -#define REMOTE_ErrorSay(wid) REMOTE(wid)->ErrorSay_ -#define LOCAL_IOBotch LOCAL->IOBotch_ -#define REMOTE_IOBotch(wid) REMOTE(wid)->IOBotch_ -#define LOCAL_tokptr LOCAL->tokptr_ -#define REMOTE_tokptr(wid) REMOTE(wid)->tokptr_ -#define LOCAL_toktide LOCAL->toktide_ -#define REMOTE_toktide(wid) REMOTE(wid)->toktide_ -#define LOCAL_VarTable LOCAL->VarTable_ -#define REMOTE_VarTable(wid) REMOTE(wid)->VarTable_ -#define LOCAL_AnonVarTable LOCAL->AnonVarTable_ -#define REMOTE_AnonVarTable(wid) REMOTE(wid)->AnonVarTable_ -#define LOCAL_Comments LOCAL->Comments_ -#define REMOTE_Comments(wid) REMOTE(wid)->Comments_ -#define LOCAL_CommentsTail LOCAL->CommentsTail_ -#define REMOTE_CommentsTail(wid) REMOTE(wid)->CommentsTail_ -#define LOCAL_CommentsNextChar LOCAL->CommentsNextChar_ -#define REMOTE_CommentsNextChar(wid) REMOTE(wid)->CommentsNextChar_ -#define LOCAL_CommentsBuff LOCAL->CommentsBuff_ -#define REMOTE_CommentsBuff(wid) REMOTE(wid)->CommentsBuff_ -#define LOCAL_CommentsBuffPos LOCAL->CommentsBuffPos_ -#define REMOTE_CommentsBuffPos(wid) REMOTE(wid)->CommentsBuffPos_ -#define LOCAL_CommentsBuffLim LOCAL->CommentsBuffLim_ -#define REMOTE_CommentsBuffLim(wid) REMOTE(wid)->CommentsBuffLim_ -#define LOCAL_RestartEnv LOCAL->RestartEnv_ -#define REMOTE_RestartEnv(wid) REMOTE(wid)->RestartEnv_ -#define LOCAL_FileNameBuf LOCAL->FileNameBuf_ -#define REMOTE_FileNameBuf(wid) REMOTE(wid)->FileNameBuf_ -#define LOCAL_FileNameBuf2 LOCAL->FileNameBuf2_ -#define REMOTE_FileNameBuf2(wid) REMOTE(wid)->FileNameBuf2_ - -#define LOCAL_BreakLevel LOCAL->BreakLevel_ -#define REMOTE_BreakLevel(wid) REMOTE(wid)->BreakLevel_ -#define LOCAL_PrologMode LOCAL->PrologMode_ -#define REMOTE_PrologMode(wid) REMOTE(wid)->PrologMode_ -#define LOCAL_CritLocks LOCAL->CritLocks_ -#define REMOTE_CritLocks(wid) REMOTE(wid)->CritLocks_ - -#define LOCAL_Flags LOCAL->Flags_ -#define REMOTE_Flags(wid) REMOTE(wid)->Flags_ -#define LOCAL_flagCount LOCAL->flagCount_ -#define REMOTE_flagCount(wid) REMOTE(wid)->flagCount_ - - -#ifdef ANALYST -#define LOCAL_opcount LOCAL->opcount_ -#define REMOTE_opcount(wid) REMOTE(wid)->opcount_ -#define LOCAL_2opcount LOCAL->2opcount_ -#define REMOTE_2opcount(wid) REMOTE(wid)->2opcount_ -#endif /* ANALYST */ - -#define LOCAL_s_dbg LOCAL->s_dbg_ -#define REMOTE_s_dbg(wid) REMOTE(wid)->s_dbg_ - -#define LOCAL_matherror LOCAL->matherror_ -#define REMOTE_matherror(wid) REMOTE(wid)->matherror_ -#define LOCAL_mathtt LOCAL->mathtt_ -#define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_ -#define LOCAL_mathstring LOCAL->mathstring_ -#define REMOTE_mathstring(wid) REMOTE(wid)->mathstring_ -#define LOCAL_CurrentError LOCAL->CurrentError_ -#define REMOTE_CurrentError(wid) REMOTE(wid)->CurrentError_ - -#define LOCAL_heap_overflows LOCAL->heap_overflows_ -#define REMOTE_heap_overflows(wid) REMOTE(wid)->heap_overflows_ -#define LOCAL_total_heap_overflow_time LOCAL->total_heap_overflow_time_ -#define REMOTE_total_heap_overflow_time(wid) REMOTE(wid)->total_heap_overflow_time_ -#define LOCAL_stack_overflows LOCAL->stack_overflows_ -#define REMOTE_stack_overflows(wid) REMOTE(wid)->stack_overflows_ -#define LOCAL_total_stack_overflow_time LOCAL->total_stack_overflow_time_ -#define REMOTE_total_stack_overflow_time(wid) REMOTE(wid)->total_stack_overflow_time_ -#define LOCAL_delay_overflows LOCAL->delay_overflows_ -#define REMOTE_delay_overflows(wid) REMOTE(wid)->delay_overflows_ -#define LOCAL_total_delay_overflow_time LOCAL->total_delay_overflow_time_ -#define REMOTE_total_delay_overflow_time(wid) REMOTE(wid)->total_delay_overflow_time_ -#define LOCAL_trail_overflows LOCAL->trail_overflows_ -#define REMOTE_trail_overflows(wid) REMOTE(wid)->trail_overflows_ -#define LOCAL_total_trail_overflow_time LOCAL->total_trail_overflow_time_ -#define REMOTE_total_trail_overflow_time(wid) REMOTE(wid)->total_trail_overflow_time_ -#define LOCAL_atom_table_overflows LOCAL->atom_table_overflows_ -#define REMOTE_atom_table_overflows(wid) REMOTE(wid)->atom_table_overflows_ -#define LOCAL_total_atom_table_overflow_time LOCAL->total_atom_table_overflow_time_ -#define REMOTE_total_atom_table_overflow_time(wid) REMOTE(wid)->total_atom_table_overflow_time_ - -#ifdef LOAD_DYLD -#define LOCAL_dl_errno LOCAL->dl_errno_ -#define REMOTE_dl_errno(wid) REMOTE(wid)->dl_errno_ -#endif - -#ifdef LOW_LEVEL_TRACER -#define LOCAL_do_trace_primitives LOCAL->do_trace_primitives_ -#define REMOTE_do_trace_primitives(wid) REMOTE(wid)->do_trace_primitives_ -#endif - -#define LOCAL_ExportAtomHashChain LOCAL->ExportAtomHashChain_ -#define REMOTE_ExportAtomHashChain(wid) REMOTE(wid)->ExportAtomHashChain_ -#define LOCAL_ExportAtomHashTableSize LOCAL->ExportAtomHashTableSize_ -#define REMOTE_ExportAtomHashTableSize(wid) REMOTE(wid)->ExportAtomHashTableSize_ -#define LOCAL_ExportAtomHashTableNum LOCAL->ExportAtomHashTableNum_ -#define REMOTE_ExportAtomHashTableNum(wid) REMOTE(wid)->ExportAtomHashTableNum_ -#define LOCAL_ExportFunctorHashChain LOCAL->ExportFunctorHashChain_ -#define REMOTE_ExportFunctorHashChain(wid) REMOTE(wid)->ExportFunctorHashChain_ -#define LOCAL_ExportFunctorHashTableSize LOCAL->ExportFunctorHashTableSize_ -#define REMOTE_ExportFunctorHashTableSize(wid) REMOTE(wid)->ExportFunctorHashTableSize_ -#define LOCAL_ExportFunctorHashTableNum LOCAL->ExportFunctorHashTableNum_ -#define REMOTE_ExportFunctorHashTableNum(wid) REMOTE(wid)->ExportFunctorHashTableNum_ -#define LOCAL_ExportPredEntryHashChain LOCAL->ExportPredEntryHashChain_ -#define REMOTE_ExportPredEntryHashChain(wid) REMOTE(wid)->ExportPredEntryHashChain_ -#define LOCAL_ExportPredEntryHashTableSize LOCAL->ExportPredEntryHashTableSize_ -#define REMOTE_ExportPredEntryHashTableSize(wid) REMOTE(wid)->ExportPredEntryHashTableSize_ -#define LOCAL_ExportPredEntryHashTableNum LOCAL->ExportPredEntryHashTableNum_ -#define REMOTE_ExportPredEntryHashTableNum(wid) REMOTE(wid)->ExportPredEntryHashTableNum_ -#define LOCAL_ExportDBRefHashChain LOCAL->ExportDBRefHashChain_ -#define REMOTE_ExportDBRefHashChain(wid) REMOTE(wid)->ExportDBRefHashChain_ -#define LOCAL_ExportDBRefHashTableSize LOCAL->ExportDBRefHashTableSize_ -#define REMOTE_ExportDBRefHashTableSize(wid) REMOTE(wid)->ExportDBRefHashTableSize_ -#define LOCAL_ExportDBRefHashTableNum LOCAL->ExportDBRefHashTableNum_ -#define REMOTE_ExportDBRefHashTableNum(wid) REMOTE(wid)->ExportDBRefHashTableNum_ -#define LOCAL_ImportAtomHashChain LOCAL->ImportAtomHashChain_ -#define REMOTE_ImportAtomHashChain(wid) REMOTE(wid)->ImportAtomHashChain_ -#define LOCAL_ImportAtomHashTableSize LOCAL->ImportAtomHashTableSize_ -#define REMOTE_ImportAtomHashTableSize(wid) REMOTE(wid)->ImportAtomHashTableSize_ -#define LOCAL_ImportAtomHashTableNum LOCAL->ImportAtomHashTableNum_ -#define REMOTE_ImportAtomHashTableNum(wid) REMOTE(wid)->ImportAtomHashTableNum_ -#define LOCAL_ImportFunctorHashChain LOCAL->ImportFunctorHashChain_ -#define REMOTE_ImportFunctorHashChain(wid) REMOTE(wid)->ImportFunctorHashChain_ -#define LOCAL_ImportFunctorHashTableSize LOCAL->ImportFunctorHashTableSize_ -#define REMOTE_ImportFunctorHashTableSize(wid) REMOTE(wid)->ImportFunctorHashTableSize_ -#define LOCAL_ImportFunctorHashTableNum LOCAL->ImportFunctorHashTableNum_ -#define REMOTE_ImportFunctorHashTableNum(wid) REMOTE(wid)->ImportFunctorHashTableNum_ -#define LOCAL_ImportOPCODEHashChain LOCAL->ImportOPCODEHashChain_ -#define REMOTE_ImportOPCODEHashChain(wid) REMOTE(wid)->ImportOPCODEHashChain_ -#define LOCAL_ImportOPCODEHashTableSize LOCAL->ImportOPCODEHashTableSize_ -#define REMOTE_ImportOPCODEHashTableSize(wid) REMOTE(wid)->ImportOPCODEHashTableSize_ -#define LOCAL_ImportPredEntryHashChain LOCAL->ImportPredEntryHashChain_ -#define REMOTE_ImportPredEntryHashChain(wid) REMOTE(wid)->ImportPredEntryHashChain_ -#define LOCAL_ImportPredEntryHashTableSize LOCAL->ImportPredEntryHashTableSize_ -#define REMOTE_ImportPredEntryHashTableSize(wid) REMOTE(wid)->ImportPredEntryHashTableSize_ -#define LOCAL_ImportPredEntryHashTableNum LOCAL->ImportPredEntryHashTableNum_ -#define REMOTE_ImportPredEntryHashTableNum(wid) REMOTE(wid)->ImportPredEntryHashTableNum_ -#define LOCAL_ImportDBRefHashChain LOCAL->ImportDBRefHashChain_ -#define REMOTE_ImportDBRefHashChain(wid) REMOTE(wid)->ImportDBRefHashChain_ -#define LOCAL_ImportDBRefHashTableSize LOCAL->ImportDBRefHashTableSize_ -#define REMOTE_ImportDBRefHashTableSize(wid) REMOTE(wid)->ImportDBRefHashTableSize_ -#define LOCAL_ImportDBRefHashTableNum LOCAL->ImportDBRefHashTableNum_ -#define REMOTE_ImportDBRefHashTableNum(wid) REMOTE(wid)->ImportDBRefHashTableNum_ -#define LOCAL_ImportFAILCODE LOCAL->ImportFAILCODE_ -#define REMOTE_ImportFAILCODE(wid) REMOTE(wid)->ImportFAILCODE_ -#if __ANDROID__ - -#define LOCAL_assetManager LOCAL->assetManager_ -#define REMOTE_assetManager(wid) REMOTE(wid)->assetManager_ -#define LOCAL_InAssetDir LOCAL->InAssetDir_ -#define REMOTE_InAssetDir(wid) REMOTE(wid)->InAssetDir_ -#endif - -#define LOCAL_ibnds LOCAL->ibnds_ -#define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_ -#define LOCAL_exo_it LOCAL->exo_it_ -#define REMOTE_exo_it(wid) REMOTE(wid)->exo_it_ -#define LOCAL_exo_base LOCAL->exo_base_ -#define REMOTE_exo_base(wid) REMOTE(wid)->exo_base_ -#define LOCAL_exo_arity LOCAL->exo_arity_ -#define REMOTE_exo_arity(wid) REMOTE(wid)->exo_arity_ -#define LOCAL_exo_arg LOCAL->exo_arg_ -#define REMOTE_exo_arg(wid) REMOTE(wid)->exo_arg_ - -#define LOCAL_search_atoms LOCAL->search_atoms_ -#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_ - -#define LOCAL_CurSlot LOCAL->CurSlot_ -#define REMOTE_CurSlot(wid) REMOTE(wid)->CurSlot_ -#define LOCAL_NSlots LOCAL->NSlots_ -#define REMOTE_NSlots(wid) REMOTE(wid)->NSlots_ -#define LOCAL_SlotBase LOCAL->SlotBase_ -#define REMOTE_SlotBase(wid) REMOTE(wid)->SlotBase_ - -#define LOCAL_Mutexes LOCAL->Mutexes_ -#define REMOTE_Mutexes(wid) REMOTE(wid)->Mutexes_ -#define LOCAL_SourceModule LOCAL->SourceModule_ -#define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_ -#define LOCAL_Including LOCAL->Including_ -#define REMOTE_Including(wid) REMOTE(wid)->Including_ -#define LOCAL_MAX_SIZE LOCAL->MAX_SIZE_ -#define REMOTE_MAX_SIZE(wid) REMOTE(wid)->MAX_SIZE_ - diff --git a/H/iatoms.h b/H/iatoms.h index 343fae683..a5f029789 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -20,6 +20,7 @@ AtomArrayOverflow = Yap_LookupAtom("array_overflow"); AtomArrayType = Yap_LookupAtom("array_type"); AtomArrow = Yap_LookupAtom("->"); + AtomAttributedModule = Yap_LookupAtom("attributes_module"); AtomDoubleArrow = Yap_LookupAtom("-->"); AtomAssert = Yap_LookupAtom(":-"); AtomEmptyBrackets = Yap_LookupAtom("()"); @@ -509,6 +510,7 @@ FunctorPlus = Yap_MkFunctor(AtomPlus,2); FunctorPortray = Yap_MkFunctor(AtomPortray,1); FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2); + FunctorProcedure = Yap_MkFunctor(AtomProcedure,5); FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2); FunctorQuery = Yap_MkFunctor(AtomQuery,1); FunctorRecordedWithKey = Yap_MkFunctor(AtomRecordedWithKey,6); diff --git a/H/ihstruct.h b/H/ihstruct.h deleted file mode 100644 index 12477e027..000000000 --- a/H/ihstruct.h +++ /dev/null @@ -1,301 +0,0 @@ - - /* This file, ihstruct.h, was generated automatically by "yap -L misc/buildheap" - please do not update, update misc/HEAPFIELDS instead */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if USE_DL_MALLOC - - -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(DLMallocLock); -#endif -#endif -#if USE_DL_MALLOC || (USE_SYSTEM_MALLOC && HAVE_MALLINFO) -#ifndef HeapUsed -#define HeapUsed Yap_givemallinfo() -#endif - -#else - -#endif - - - - -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(FreeBlocksLock); - INIT_LOCK(HeapUsedLock); - INIT_LOCK(HeapTopLock); - HeapTopOwner = -1; -#endif - MaxStack = 0; - MaxTrail = 0; - - -#if USE_THREADED_CODE - -#endif - - EXECUTE_CPRED_OP_CODE = Yap_opcode(_execute_cpred); - EXPAND_OP_CODE = Yap_opcode(_expand_index); - FAIL_OPCODE = Yap_opcode(_op_fail); - INDEX_OPCODE = Yap_opcode(_index_pred); - LOCKPRED_OPCODE = Yap_opcode(_lock_pred); - ORLAST_OPCODE = Yap_opcode(_or_last); - UNDEF_OPCODE = Yap_opcode(_undef_p); - RETRY_USERC_OPCODE = Yap_opcode(_retry_userc); - EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred); - - - - - - InitInvisibleAtoms(); - InitWideAtoms(); - InitAtoms(); - -#include "iatoms.h" -#ifdef EUROTRA - TermDollarU = MkAtomTerm(AtomDollarU); -#endif - - USER_MODULE = MkAtomTerm(AtomUser); - IDB_MODULE = MkAtomTerm(AtomIDB); - ATTRIBUTES_MODULE = MkAtomTerm(AtomAttributes); - CHARSIO_MODULE = MkAtomTerm(AtomCharsio); - CHTYPE_MODULE = MkAtomTerm(AtomChType); - TERMS_MODULE = MkAtomTerm(AtomTerms); - SYSTEM_MODULE = MkAtomTerm(AtomSystem); - READUTIL_MODULE = MkAtomTerm(AtomReadutil); - HACKS_MODULE = MkAtomTerm(AtomYapHacks); - ARG_MODULE = MkAtomTerm(AtomArg); - GLOBALS_MODULE = MkAtomTerm(AtomNb); - SWI_MODULE = MkAtomTerm(AtomSwi); - DBLOAD_MODULE = MkAtomTerm(AtomDBLoad); - RANGE_MODULE = MkAtomTerm(AtomRange); - ERROR_MODULE = MkAtomTerm(AtomError); - - - - CurrentModules = NULL; - - - Yap_InitModules(); - - HIDDEN_PREDICATES = NULL; - - - Yap_InitPlIO(); - GLOBAL_Flags = 0; - Yap_InitFlags(true); - - Yap_ExecutionMode = INTERPRETED; - - InitPredHash(); -#if defined(YAPOR) || defined(THREADS) - -#endif - PredsInHashTable = 0; - - - CreepCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomCreep,1),PROLOG_MODULE)); - UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp,2),PROLOG_MODULE)); - SpyCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomSpy,1),PROLOG_MODULE)); - PredFail = RepPredProp(PredPropByAtom(AtomFail,PROLOG_MODULE)); - PredTrue = RepPredProp(PredPropByAtom(AtomTrue,PROLOG_MODULE)); -#ifdef COROUTINING - WakeUpCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomWakeUpGoal,2),PROLOG_MODULE)); -#endif - PredGoalExpansion = RepPredProp(PredPropByFunc(FunctorGoalExpansion,USER_MODULE)); - PredMetaCall = RepPredProp(PredPropByFunc(FunctorMetaCall,PROLOG_MODULE)); - PredTraceMetaCall = RepPredProp(PredPropByFunc(FunctorTraceMetaCall,PROLOG_MODULE)); - PredDollarCatch = RepPredProp(PredPropByFunc(FunctorCatch,PROLOG_MODULE)); - PredRecordedWithKey = RepPredProp(PredPropByFunc(FunctorRecordedWithKey,PROLOG_MODULE)); - PredLogUpdClause = RepPredProp(PredPropByFunc(FunctorDoLogUpdClause,PROLOG_MODULE)); - PredLogUpdClauseErase = RepPredProp(PredPropByFunc(FunctorDoLogUpdClauseErase,PROLOG_MODULE)); - PredLogUpdClause0 = RepPredProp(PredPropByFunc(FunctorDoLogUpdClause,PROLOG_MODULE)); - PredStaticClause = RepPredProp(PredPropByFunc(FunctorDoStaticClause,PROLOG_MODULE)); - PredThrow = RepPredProp(PredPropByFunc(FunctorThrow,PROLOG_MODULE)); - PredHandleThrow = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE)); - PredIs = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE)); - PredSafeCallCleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE)); - PredRestoreRegs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE)); - PredCommentHook = RepPredProp(PredPropByFunc(FunctorCommentHook,PROLOG_MODULE)); -#ifdef YAPOR - PredGetwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE)); - PredGetworkSeq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE)); -#endif /* YAPOR */ - -#ifdef LOW_LEVEL_TRACER - Yap_do_low_level_trace = FALSE; -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(Yap_low_level_trace_lock); -#endif -#endif - - Yap_ClauseSpace = 0; - Yap_IndexSpace_Tree = 0; - Yap_IndexSpace_EXT = 0; - Yap_IndexSpace_SW = 0; - Yap_LUClauseSpace = 0; - Yap_LUIndexSpace_Tree = 0; - Yap_LUIndexSpace_CP = 0; - Yap_LUIndexSpace_EXT = 0; - Yap_LUIndexSpace_SW = 0; - - - DUMMYCODE->opc = Yap_opcode(_op_fail); - FAILCODE->opc = Yap_opcode(_op_fail); - NOCODE->opc = Yap_opcode(_Nstop); - InitEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail); - - InitEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail); - - InitOtaplInst(RTRYCODE,_retry_and_mark,PredFail); -#ifdef BEAM - BEAM_RETRY_CODE->opc = Yap_opcode(_beam_retry_code); -#endif /* BEAM */ -#ifdef YAPOR - InitOtaplInst(GETWORK,_getwork,PredGetwork); - InitOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq); - GETWORK_FIRST_TIME->opc = Yap_opcode(_getwork_first_time); -#endif /* YAPOR */ -#ifdef TABLING - InitOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail); - InitOtaplInst(TRY_ANSWER,_table_try_answer,PredFail); - InitOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail); - InitOtaplInst(COMPLETION,_table_completion,PredFail); -#ifdef THREADS_CONSUMER_SHARING - InitOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail); -#endif /* THREADS_CONSUMER_SHARING */ -#endif /* TABLING */ - - - - - P_before_spy = NULL; - - RETRY_C_RECORDEDP_CODE = NULL; - RETRY_C_RECORDED_K_CODE = NULL; - - PROFILING = FALSE; - CALL_COUNTING = FALSE; - optimizer_on = TRUE; - compile_mode = 0; - profiling = FALSE; - call_counting = FALSE; - - compile_arrays = FALSE; - -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(DBTermsListLock); -#endif - DBTermsList = NULL; - - ExpandClausesFirst = NULL; - ExpandClausesLast = NULL; - Yap_ExpandClauses = 0; -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(ExpandClausesListLock); - INIT_LOCK(OpListLock); -#endif - -#ifdef DEBUG - Yap_NewCps = 0L; - Yap_LiveCps = 0L; - Yap_DirtyCps = 0L; - Yap_FreedCps = 0L; -#endif - Yap_expand_clauses_sz = 0L; - - UdiControlBlocks = NULL; - - - STATIC_PREDICATES_MARKED = FALSE; - - INT_KEYS = NULL; - INT_LU_KEYS = NULL; - INT_BB_KEYS = NULL; - - INT_KEYS_SIZE = INT_KEYS_DEFAULT_SIZE; - INT_KEYS_TIMESTAMP = 0L; - INT_BB_KEYS_SIZE = INT_KEYS_DEFAULT_SIZE; - - UPDATE_MODE = UPDATE_MODE_LOGICAL; - - InitDBErasedMarker(); - InitLogDBErasedMarker(); - - DeadStaticClauses = NULL; - DeadMegaClauses = NULL; - DeadStaticIndices = NULL; - DBErasedList = NULL; - DBErasedIList = NULL; -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(DeadStaticClausesLock); - INIT_LOCK(DeadMegaClausesLock); - INIT_LOCK(DeadStaticIndicesLock); -#endif -#ifdef COROUTINING - - NUM_OF_ATTS = 1; - - -#endif - - OpList = NULL; - - ForeignCodeLoaded = NULL; - ForeignCodeBase = NULL; - ForeignCodeTop = NULL; - ForeignCodeMax = NULL; - - Yap_Records = NULL; - - InitSWIAtoms(); - - - - - - - - - InitEmptyWakeups(); - MaxEmptyWakeups = 0; - - BlobTypes = NULL; - Blobs = NULL; - NOfBlobs = 0; - NOfBlobsMax = 256; -#if defined(YAPOR) || defined(THREADS) - INIT_LOCK(Blobs_Lock); -#endif diff --git a/H/ilocals.h b/H/ilocals.h deleted file mode 100755 index fa53fe070..000000000 --- a/H/ilocals.h +++ /dev/null @@ -1,277 +0,0 @@ - - /* This file, ilocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ - - -static void InitWorker(int wid) { - - REMOTE_FileAliases(wid) = Yap_InitStandardAliases(); - - - REMOTE_c_input_stream(wid) = 0; - REMOTE_c_output_stream(wid) = 1; - REMOTE_c_error_stream(wid) = 2; - REMOTE_sockets_io(wid) = false; - REMOTE_within_print_message(wid) = false; - - - - - REMOTE_newline(wid) = true; - REMOTE_AtPrompt(wid) = AtomNil; - - REMOTE_encoding(wid) = Yap_DefaultEncoding(); - REMOTE_quasi_quotations(wid) = false; - REMOTE_default_priority(wid) = 1200; - REMOTE_eot_before_eof(wid) = false; - REMOTE_max_depth(wid) = 0; - REMOTE_max_list(wid) = 0; - REMOTE_max_write_args(wid) = 0; - - REMOTE_OldASP(wid) = NULL; - REMOTE_OldLCL0(wid) = NULL; - REMOTE_OldTR(wid) = NULL; - REMOTE_OldGlobalBase(wid) = NULL; - REMOTE_OldH(wid) = NULL; - REMOTE_OldH0(wid) = NULL; - REMOTE_OldTrailBase(wid) = NULL; - REMOTE_OldTrailTop(wid) = NULL; - REMOTE_OldHeapBase(wid) = NULL; - REMOTE_OldHeapTop(wid) = NULL; - REMOTE_ClDiff(wid) = 0L; - REMOTE_GDiff(wid) = 0L; - REMOTE_HDiff(wid) = 0L; - REMOTE_GDiff0(wid) = 0L; - REMOTE_GSplit(wid) = NULL; - REMOTE_LDiff(wid) = 0L; - REMOTE_TrDiff(wid) = 0L; - REMOTE_XDiff(wid) = 0L; - REMOTE_DelayDiff(wid) = 0L; - REMOTE_BaseDiff(wid) = 0L; - - REMOTE_ReductionsCounter(wid) = 0L; - REMOTE_PredEntriesCounter(wid) = 0L; - REMOTE_RetriesCounter(wid) = 0L; - REMOTE_ReductionsCounterOn(wid) = 0L; - REMOTE_PredEntriesCounterOn(wid) = 0L; - REMOTE_RetriesCounterOn(wid) = 0L; - - - REMOTE_ConsultSp(wid) = NULL; - - - - REMOTE_ConsultBase(wid) = NULL; - - REMOTE_ConsultLow(wid) = NULL; - REMOTE_VarNames(wid) = ((Term)0); - REMOTE_SourceFileName(wid) = NULL; - REMOTE_SourceFileLineno(wid) = 0; - - REMOTE_GlobalArena(wid) = 0L; - REMOTE_GlobalArenaOverflows(wid) = 0L; - REMOTE_ArenaOverflows(wid) = 0L; - REMOTE_DepthArenas(wid) = 0; - REMOTE_ArithError(wid) = FALSE; - REMOTE_LastAssertedPred(wid) = NULL; - REMOTE_TmpPred(wid) = NULL; - REMOTE_ScannerStack(wid) = NULL; - REMOTE_ScannerExtraBlocks(wid) = NULL; - REMOTE_BallTerm(wid) = NULL; - REMOTE_MaxActiveSignals(wid) = 64L; - REMOTE_Signals(wid) = 0L; - REMOTE_IPredArity(wid) = 0L; - REMOTE_ProfEnd(wid) = NULL; - REMOTE_UncaughtThrow(wid) = FALSE; - REMOTE_DoingUndefp(wid) = FALSE; - REMOTE_StartCharCount(wid) = 0L; - REMOTE_StartLineCount(wid) = 0L; - REMOTE_StartLinePos(wid) = 0L; - InitScratchPad(wid); -#ifdef COROUTINING - REMOTE_WokenGoals(wid) = 0L; - REMOTE_AttsMutableList(wid) = 0L; -#endif - - REMOTE_GcGeneration(wid) = 0L; - REMOTE_GcPhase(wid) = 0L; - REMOTE_GcCurrentPhase(wid) = 0L; - REMOTE_GcCalls(wid) = 0L; - REMOTE_TotGcTime(wid) = 0L; - REMOTE_TotGcRecovered(wid) = 0L; - REMOTE_LastGcTime(wid) = 0L; - REMOTE_LastSSTime(wid) = 0L; - REMOTE_OpenArray(wid) = NULL; - - REMOTE_total_marked(wid) = 0L; - REMOTE_total_oldies(wid) = 0L; - REMOTE_current_B(wid) = NULL; - REMOTE_prev_HB(wid) = NULL; - REMOTE_HGEN(wid) = NULL; - REMOTE_iptop(wid) = NULL; -#if defined(GC_NO_TAGS) - REMOTE_bp(wid) = NULL; -#endif - REMOTE_sTR(wid) = NULL; - REMOTE_sTR0(wid) = NULL; - REMOTE_new_TR(wid) = NULL; - REMOTE_cont_top0(wid) = NULL; - REMOTE_cont_top(wid) = NULL; - REMOTE_discard_trail_entries(wid) = 0; - - REMOTE_gc_ma_h_top(wid) = NULL; - REMOTE_gc_ma_h_list(wid) = NULL; - REMOTE_gc_timestamp(wid) = 0L; - REMOTE_db_vec(wid) = NULL; - REMOTE_db_vec0(wid) = NULL; - REMOTE_db_root(wid) = NULL; - REMOTE_db_nil(wid) = NULL; - - - - - REMOTE_extra_gc_cells_size(wid) = 256; - REMOTE_DynamicArrays(wid) = NULL; - REMOTE_StaticArrays(wid) = NULL; - REMOTE_GlobalVariables(wid) = NULL; - REMOTE_AllowRestart(wid) = FALSE; - - REMOTE_CMemFirstBlock(wid) = NULL; - REMOTE_CMemFirstBlockSz(wid) = 0L; - - REMOTE_nperm(wid) = 0L; - - REMOTE_LabelFirstArray(wid) = NULL; - REMOTE_LabelFirstArraySz(wid) = 0L; - - -#ifdef THREADS - InitThreadHandle(wid); -#endif /* THREADS */ -#if defined(YAPOR) || defined(TABLING) - Yap_init_local_optyap_data(wid); - REMOTE_TabMode(wid) = 0L; -#endif /* YAPOR || TABLING */ - REMOTE_InterruptsDisabled(wid) = FALSE; - REMOTE_execution(wid) = NULL; -#if LOW_LEVEL_TRACER - REMOTE_total_choicepoints(wid) = 0; -#endif - REMOTE_consult_level(wid) = 0; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REMOTE_BreakLevel(wid) = 0; - REMOTE_PrologMode(wid) = BootMode; - REMOTE_CritLocks(wid) = 0; - - - - - -#ifdef ANALYST - - -#endif /* ANALYST */ - - - - REMOTE_matherror(wid) = YAP_NO_ERROR; - - REMOTE_mathstring(wid) = NULL; - REMOTE_CurrentError(wid) = YAP_NO_ERROR; - - REMOTE_heap_overflows(wid) = 0; - REMOTE_total_heap_overflow_time(wid) = 0; - REMOTE_stack_overflows(wid) = 0; - REMOTE_total_stack_overflow_time(wid) = 0; - REMOTE_delay_overflows(wid) = 0; - REMOTE_total_delay_overflow_time(wid) = 0; - REMOTE_trail_overflows(wid) = 0; - REMOTE_total_trail_overflow_time(wid) = 0; - REMOTE_atom_table_overflows(wid) = 0; - REMOTE_total_atom_table_overflow_time(wid) = 0; - -#ifdef LOAD_DYLD - REMOTE_dl_errno(wid) = 0; -#endif - -#ifdef LOW_LEVEL_TRACER - REMOTE_do_trace_primitives(wid) = TRUE; -#endif - - REMOTE_ExportAtomHashChain(wid) = NULL; - REMOTE_ExportAtomHashTableSize(wid) = 0; - REMOTE_ExportAtomHashTableNum(wid) = 0; - REMOTE_ExportFunctorHashChain(wid) = NULL; - REMOTE_ExportFunctorHashTableSize(wid) = 0; - REMOTE_ExportFunctorHashTableNum(wid) = 0; - REMOTE_ExportPredEntryHashChain(wid) = NULL; - REMOTE_ExportPredEntryHashTableSize(wid) = 0; - REMOTE_ExportPredEntryHashTableNum(wid) = 0; - REMOTE_ExportDBRefHashChain(wid) = NULL; - REMOTE_ExportDBRefHashTableSize(wid) = 0; - REMOTE_ExportDBRefHashTableNum(wid) = 0; - REMOTE_ImportAtomHashChain(wid) = NULL; - REMOTE_ImportAtomHashTableSize(wid) = 0; - REMOTE_ImportAtomHashTableNum(wid) = 0; - REMOTE_ImportFunctorHashChain(wid) = NULL; - REMOTE_ImportFunctorHashTableSize(wid) = 0; - REMOTE_ImportFunctorHashTableNum(wid) = 0; - REMOTE_ImportOPCODEHashChain(wid) = NULL; - REMOTE_ImportOPCODEHashTableSize(wid) = 0; - REMOTE_ImportPredEntryHashChain(wid) = NULL; - REMOTE_ImportPredEntryHashTableSize(wid) = 0; - REMOTE_ImportPredEntryHashTableNum(wid) = 0; - REMOTE_ImportDBRefHashChain(wid) = NULL; - REMOTE_ImportDBRefHashTableSize(wid) = 0; - REMOTE_ImportDBRefHashTableNum(wid) = 0; - REMOTE_ImportFAILCODE(wid) = NULL; -#if __ANDROID__ - - REMOTE_assetManager(wid) = GLOBAL_assetManager; - REMOTE_InAssetDir(wid) = NULL; -#endif - - - REMOTE_exo_it(wid) = NULL; - REMOTE_exo_base(wid) = NULL; - REMOTE_exo_arity(wid) = 0; - REMOTE_exo_arg(wid) = 0; - - - - REMOTE_CurSlot(wid) = 0; - REMOTE_NSlots(wid) = 0; - REMOTE_SlotBase(wid) = InitHandles(wid); - - REMOTE_Mutexes(wid) = NULL; - REMOTE_SourceModule(wid) = 0; - REMOTE_Including(wid) = TermNil; - REMOTE_MAX_SIZE(wid) = 1024L; -} diff --git a/H/qly.h b/H/qly.h index 271e65fab..273a757ad 100644 --- a/H/qly.h +++ b/H/qly.h @@ -104,7 +104,7 @@ typedef enum { #define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag) #define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag|NoSpyPredFlag) -#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag|StandardPredFlag) +#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag) #define CHECK(F) { size_t r = (F); if (!r) return r; } #define RCHECK(F) if(!(F)) { QLYR_ERROR(MISMATCH); return; } diff --git a/H/ratoms.h b/H/ratoms.h index 28a5efb06..ddfb43e1d 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -20,6 +20,7 @@ AtomArrayOverflow = AtomAdjust(AtomArrayOverflow); AtomArrayType = AtomAdjust(AtomArrayType); AtomArrow = AtomAdjust(AtomArrow); + AtomAttributedModule = AtomAdjust(AtomAttributedModule); AtomDoubleArrow = AtomAdjust(AtomDoubleArrow); AtomAssert = AtomAdjust(AtomAssert); AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets); @@ -509,6 +510,7 @@ FunctorPlus = FuncAdjust(FunctorPlus); FunctorPortray = FuncAdjust(FunctorPortray); FunctorPrintMessage = FuncAdjust(FunctorPrintMessage); + FunctorProcedure = FuncAdjust(FunctorProcedure); FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint); FunctorQuery = FuncAdjust(FunctorQuery); FunctorRecordedWithKey = FuncAdjust(FunctorRecordedWithKey); diff --git a/H/rglobals.h b/H/rglobals.h deleted file mode 100644 index ac1994536..000000000 --- a/H/rglobals.h +++ /dev/null @@ -1,146 +0,0 @@ - - /* This file, rglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/GLOBALS instead */ - - - - - - - - - - - - - - - - - -static void RestoreGlobal(void) { - - - - - - - - - - - - - - - - - -#if __ANDROID__ - - - -#endif - -#if THREADS - - - - - - - - REINIT_LOCK(GLOBAL_ThreadHandlesLock); -#endif -#if defined(YAPOR) || defined(THREADS) - - REINIT_LOCK(GLOBAL_BGL); -#endif -#if defined(YAPOR) || defined(TABLING) - -#endif /* YAPOR || TABLING */ - - - -#if defined(THREADS) - - - REINIT_LOCK(GLOBAL_mboxq_lock); - - -#endif /* THREADS */ - - -#if defined(THREADS)||defined(YAPOR) - REINIT_LOCK(GLOBAL_StreamDescLock); -#endif - - - - -#ifdef COROUTINING - - -#endif - - - - - - - - -#if HAVE_MMAP - -#endif -#ifdef DEBUG - - - - - -#endif -#if defined(COFF) || defined(A_OUT) - - -#endif - - -#if __simplescalar__ - -#endif - - - - - - - - - - - - - - - -#if LOW_PROF - - - -#endif /* LOW_PROF */ - -#if THREADS - - - REINIT_LOCK(GLOBAL_MUT_ACCESS); -#endif - - - - - - - - -} diff --git a/H/rheap.h b/H/rheap.h index dc8c3d214..20b7d8467 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,7 +11,8 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2008-08-07 20:51:23 $,$Author: vsc $ * +* Last rev: $Date: 2008-08-07 20:51:23 $,$Author: vsc $ +** * $Log: not supported by cvs2svn $ * Revision 1.99 2008/07/22 23:34:49 vsc * SWI and module fixes @@ -172,7 +173,8 @@ * TABLING NEW: better support for incomplete tabling * * Revision 1.52 2005/07/06 19:34:11 ricroc -* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure. +* TABLING: answers for completed calls can now be obtained by loading (new +*option) or executing (default) them from the trie data structure. * * Revision 1.51 2005/07/06 15:10:15 vsc * improvements to compiler: merged instructions and fixes for -> @@ -233,51 +235,49 @@ * * *************************************************************************/ #ifdef SCCS -static char SccsId[] = "@(#)rheap.c 1.3 3/15/90"; +static char SccsId[] = "@(#)rheap.c 1.3 3/15/90"; #endif -#define Atomics 0 -#define Funcs 1 +#define Atomics 0 +#define Funcs 1 #define ConstantTermAdjust(P) ConstantTermAdjust__(P PASS_REGS) #define DBGroundTermAdjust(P) DBGroundTermAdjust__(P PASS_REGS) -#define AdjustDBTerm(P,A,B,C) AdjustDBTerm__(P,A,B,C PASS_REGS) -#define AdjustSwitchTable(op, table, i) AdjustSwitchTable__(op, table, i PASS_REGS) -#define RestoreOtaplInst(start, opc, pe) RestoreOtaplInst__(start, opc, pe PASS_REGS) -#define RestoreDBErasedMarker() RestoreDBErasedMarker__( PASS_REGS1 ) -#define RestoreLogDBErasedMarker() RestoreLogDBErasedMarker__( PASS_REGS1 ) -#define RestoreForeignCode() RestoreForeignCode__( PASS_REGS1 ) -#define RestoreEmptyWakeups() RestoreEmptyWakeups__( PASS_REGS1 ) -#define RestoreAtoms() RestoreAtoms__( PASS_REGS1 ) -#define RestoreWideAtoms() RestoreWideAtoms__( PASS_REGS1 ) -#define RestoreSWIBlobs() RestoreSWIBlobs__( PASS_REGS1 ) -#define RestoreSWIBlobTypes() RestoreSWIBlobTypes__( PASS_REGS1 ) -#define RestoreInvisibleAtoms() RestoreInvisibleAtoms__( PASS_REGS1 ) -#define RestorePredHash() RestorePredHash__( PASS_REGS1 ) -#define RestoreHiddenPredicates() RestoreHiddenPredicates__( PASS_REGS1 ) -#define RestoreDBTermsList() RestoreDBTermsList__( PASS_REGS1 ) -#define RestoreExpandList() RestoreExpandList__( PASS_REGS1 ) -#define RestoreIntKeys() RestoreIntKeys__( PASS_REGS1 ) -#define RestoreIntLUKeys() RestoreIntLUKeys__( PASS_REGS1 ) -#define RestoreIntBBKeys() RestoreIntBBKeys__( PASS_REGS1 ) -#define RestoreDeadStaticClauses() RestoreDeadStaticClauses__( PASS_REGS1 ) -#define RestoreDeadMegaClauses() RestoreDeadMegaClauses__( PASS_REGS1 ) -#define RestoreDeadStaticIndices() RestoreDeadStaticIndices__( PASS_REGS1 ) -#define RestoreDBErasedList() RestoreDBErasedList__( PASS_REGS1 ) -#define RestoreDBErasedIList() RestoreDBErasedIList__( PASS_REGS1 ) -#define RestoreYapRecords() RestoreYapRecords__( PASS_REGS1 ) -#define RestoreSWIAtoms() RestoreSWIAtoms__( PASS_REGS1 ) -static Term -ConstantTermAdjust__ (Term t USES_REGS) -{ +#define AdjustDBTerm(P, A, B, C) AdjustDBTerm__(P, A, B, C PASS_REGS) +#define AdjustSwitchTable(op, table, i) \ + AdjustSwitchTable__(op, table, i PASS_REGS) +#define RestoreOtaplInst(start, opc, pe) \ + RestoreOtaplInst__(start, opc, pe PASS_REGS) +#define RestoreDBErasedMarker() RestoreDBErasedMarker__(PASS_REGS1) +#define RestoreLogDBErasedMarker() RestoreLogDBErasedMarker__(PASS_REGS1) +#define RestoreForeignCode() RestoreForeignCode__(PASS_REGS1) +#define RestoreEmptyWakeups() RestoreEmptyWakeups__(PASS_REGS1) +#define RestoreAtoms() RestoreAtoms__(PASS_REGS1) +#define RestoreWideAtoms() RestoreWideAtoms__(PASS_REGS1) +#define RestoreSWIBlobs() RestoreSWIBlobs__(PASS_REGS1) +#define RestoreSWIBlobTypes() RestoreSWIBlobTypes__(PASS_REGS1) +#define RestoreInvisibleAtoms() RestoreInvisibleAtoms__(PASS_REGS1) +#define RestorePredHash() RestorePredHash__(PASS_REGS1) +#define RestoreHiddenPredicates() RestoreHiddenPredicates__(PASS_REGS1) +#define RestoreDBTermsList() RestoreDBTermsList__(PASS_REGS1) +#define RestoreExpandList() RestoreExpandList__(PASS_REGS1) +#define RestoreIntKeys() RestoreIntKeys__(PASS_REGS1) +#define RestoreIntLUKeys() RestoreIntLUKeys__(PASS_REGS1) +#define RestoreIntBBKeys() RestoreIntBBKeys__(PASS_REGS1) +#define RestoreDeadStaticClauses() RestoreDeadStaticClauses__(PASS_REGS1) +#define RestoreDeadMegaClauses() RestoreDeadMegaClauses__(PASS_REGS1) +#define RestoreDeadStaticIndices() RestoreDeadStaticIndices__(PASS_REGS1) +#define RestoreDBErasedList() RestoreDBErasedList__(PASS_REGS1) +#define RestoreDBErasedIList() RestoreDBErasedIList__(PASS_REGS1) +#define RestoreYapRecords() RestoreYapRecords__(PASS_REGS1) +#define RestoreSWIAtoms() RestoreSWIAtoms__(PASS_REGS1) +static Term ConstantTermAdjust__(Term t USES_REGS) { if (IsAtomTerm(t)) return AtomTermAdjust(t); return t; } -static Term -DBGroundTermAdjust__ (Term t USES_REGS) -{ +static Term DBGroundTermAdjust__(Term t USES_REGS) { /* The term itself is restored by dbtermlist */ if (IsPairTerm(t)) { return AbsPair(PtoHeapCellAdjust(RepPair(t))); @@ -288,10 +288,9 @@ DBGroundTermAdjust__ (Term t USES_REGS) /* Now, everything on its place so you must adjust the pointers */ -static void -do_clean_susp_clauses(yamop *ipc USES_REGS) { +static void do_clean_susp_clauses(yamop *ipc USES_REGS) { COUNT i; - yamop **st = (yamop **)NEXTOP(ipc,sssllp); + yamop **st = (yamop **)NEXTOP(ipc, sssllp); ipc->opc = Yap_opcode(_expand_clauses); ipc->y_u.sssllp.p = PtoPredAdjust(ipc->y_u.sssllp.p); @@ -308,150 +307,130 @@ do_clean_susp_clauses(yamop *ipc USES_REGS) { } } -static void -AdjustSwitchTable__(op_numbers op, yamop *table, COUNT i USES_REGS) -{ +static void AdjustSwitchTable__(op_numbers op, yamop *table, + COUNT i USES_REGS) { CELL *startcode = (CELL *)table; /* in case the table is already gone */ if (!table) return; switch (op) { - case _switch_on_func: - { - COUNT j; - CELL *oldcode; + case _switch_on_func: { + COUNT j; + CELL *oldcode; - oldcode = startcode; - for (j = 0; j < i; j++) { - Functor oldfunc = (Functor)(oldcode[0]); - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - if (oldfunc) { - oldcode[0] = (CELL)FuncAdjust(oldfunc); - } - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; + oldcode = startcode; + for (j = 0; j < i; j++) { + Functor oldfunc = (Functor)(oldcode[0]); + CODEADDR oldjmp = (CODEADDR)(oldcode[1]); + if (oldfunc) { + oldcode[0] = (CELL)FuncAdjust(oldfunc); } - rehash(startcode, i, Funcs PASS_REGS); + oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); + oldcode += 2; } - break; - case _switch_on_cons: - { - COUNT j; - CELL *oldcode; + rehash(startcode, i, Funcs PASS_REGS); + } break; + case _switch_on_cons: { + COUNT j; + CELL *oldcode; #if !defined(USE_OFFSETS) - oldcode = startcode; + oldcode = startcode; #endif - for (j = 0; j < i; j++) { - Term oldcons = oldcode[0]; - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - if (oldcons != 0x0 && IsAtomTerm(oldcons)) { - oldcode[0] = AtomTermAdjust(oldcons); - } - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; + for (j = 0; j < i; j++) { + Term oldcons = oldcode[0]; + CODEADDR oldjmp = (CODEADDR)(oldcode[1]); + if (oldcons != 0x0 && IsAtomTerm(oldcons)) { + oldcode[0] = AtomTermAdjust(oldcons); } + oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); + oldcode += 2; + } #if !USE_OFFSETS - rehash(startcode, i, Atomics PASS_REGS); + rehash(startcode, i, Atomics PASS_REGS); #endif + } break; + case _go_on_func: { + Functor oldfunc = (Functor)(startcode[0]); + + startcode[0] = (CELL)FuncAdjust(oldfunc); + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + } break; + case _go_on_cons: { + Term oldcons = startcode[0]; + + if (IsAtomTerm(oldcons)) { + startcode[0] = AtomTermAdjust(oldcons); } - break; - case _go_on_func: - { + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + } break; + case _if_func: { + Int j; + + for (j = 0; j < i; j++) { Functor oldfunc = (Functor)(startcode[0]); - + CODEADDR oldjmp = (CODEADDR)(startcode[1]); startcode[0] = (CELL)FuncAdjust(oldfunc); - startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); - startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + startcode[1] = (CELL)CodeAddrAdjust(oldjmp); + startcode += 2; } - break; - case _go_on_cons: - { + /* adjust fail code */ + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + } break; + case _if_cons: { + Int j; + + for (j = 0; j < i; j++) { Term oldcons = startcode[0]; - + CODEADDR oldjmp = (CODEADDR)(startcode[1]); if (IsAtomTerm(oldcons)) { - startcode[0] = AtomTermAdjust(oldcons); + startcode[0] = (CELL)AtomTermAdjust(oldcons); } - startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); - startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + startcode[1] = (CELL)CodeAddrAdjust(oldjmp); + startcode += 2; } - break; - case _if_func: - { - Int j; - - for (j = 0; j < i; j++) { - Functor oldfunc = (Functor)(startcode[0]); - CODEADDR oldjmp = (CODEADDR)(startcode[1]); - startcode[0] = (CELL)FuncAdjust(oldfunc); - startcode[1] = (CELL)CodeAddrAdjust(oldjmp); - startcode += 2; - } - /* adjust fail code */ - startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); - } - break; - case _if_cons: - { - Int j; - - for (j = 0; j < i; j++) { - Term oldcons = startcode[0]; - CODEADDR oldjmp = (CODEADDR)(startcode[1]); - if (IsAtomTerm(oldcons)) { - startcode[0] = (CELL)AtomTermAdjust(oldcons); - } - startcode[1] = (CELL)CodeAddrAdjust(oldjmp); - startcode += 2; - } - /* adjust fail code */ - startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); - } - break; + /* adjust fail code */ + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + } break; default: - Yap_Error(SYSTEM_ERROR_INTERNAL,0L,"Opcode Not Implemented in AdjustSwitchTable"); + Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, + "Opcode Not Implemented in AdjustSwitchTable"); } } -static void RestoreAtomList(Atom CACHE_TYPE); -static void RestoreAtom(AtomEntry * CACHE_TYPE); -static void RestoreHashPreds( CACHE_TYPE1 ); +static void RestoreAtomList(Atom CACHE_TYPE); +static void RestoreAtom(AtomEntry *CACHE_TYPE); +static void RestoreHashPreds(CACHE_TYPE1); -static void -RestoreAtoms__( USES_REGS1 ) -{ +static void RestoreAtoms__(USES_REGS1) { AtomHashEntry *HashPtr; - register int i; + register int i; - Yap_heap_regs->hash_chain = - PtoAtomHashEntryAdjust(Yap_heap_regs->hash_chain); + HashChain = PtoAtomHashEntryAdjust(HashChain); HashPtr = HashChain; for (i = 0; i < AtomHashTableSize; ++i) { HashPtr->Entry = NoAGCAtomAdjust(HashPtr->Entry); RestoreAtomList(HashPtr->Entry PASS_REGS); HashPtr++; - } + } } -static void -RestoreWideAtoms__( USES_REGS1 ) -{ +static void RestoreWideAtoms__(USES_REGS1) { AtomHashEntry *HashPtr; - register int i; + register int i; - Yap_heap_regs->wide_hash_chain = - PtoAtomHashEntryAdjust(Yap_heap_regs->wide_hash_chain); + WideHashChain = PtoAtomHashEntryAdjust(WideHashChain); HashPtr = WideHashChain; for (i = 0; i < WideAtomHashTableSize; ++i) { HashPtr->Entry = AtomAdjust(HashPtr->Entry); RestoreAtomList(HashPtr->Entry PASS_REGS); HashPtr++; - } + } } -static void -RestoreInvisibleAtoms__( USES_REGS1 ) -{ +static void RestoreInvisibleAtoms__(USES_REGS1) { INVISIBLECHAIN.Entry = AtomAdjust(INVISIBLECHAIN.Entry); RestoreAtomList(INVISIBLECHAIN.Entry PASS_REGS); RestoreAtom(RepAtom(AtomFoundVar) PASS_REGS); @@ -461,15 +440,14 @@ RestoreInvisibleAtoms__( USES_REGS1 ) #include "rclause.h" /* adjusts terms stored in the data base, when they have no variables */ -static Term -AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, Term *p_max USES_REGS) -{ +static Term AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, + Term *p_max USES_REGS) { if (IsVarTerm(trm)) return CodeVarAdjust(trm); if (IsAtomTerm(trm)) return AtomTermAdjust(trm); if (IsPairTerm(trm)) { - Term *p; + Term *p; Term out; p = PtoHeapCellAdjust(RepPair(trm)); @@ -478,41 +456,41 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, Term *p_max USES_REGS) if (p >= p_base || p < p_lim) { p[0] = AdjustDBTerm(p[0], p, p_lim, p_max); if (IsPairTerm(p[1])) { - /* avoid term recursion with very deep lists */ - Term *newp = PtoHeapCellAdjust(RepPair(p[1])); - p[1] = AbsPair(newp); - p_base = p; - p = newp; - goto loop; + /* avoid term recursion with very deep lists */ + Term *newp = PtoHeapCellAdjust(RepPair(p[1])); + p[1] = AbsPair(newp); + p_base = p; + p = newp; + goto loop; } else { - p[1] = AdjustDBTerm(p[1], p, p_lim, p_max); + p[1] = AdjustDBTerm(p[1], p, p_lim, p_max); } } return out; } if (IsApplTerm(trm)) { - Term *p; + Term *p; Functor f; Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm)); /* if it is before the current position, then we are looking at old code */ if (p >= p_base || p < p_lim) { if (p >= p_max || p < p_lim) { - if (DBRefOfTerm(trm)!=DBRefAdjust(DBRefOfTerm(trm),FALSE)) - /* external term pointer, has to be a DBRef */ - return MkDBRefTerm(DBRefAdjust(DBRefOfTerm(trm),FALSE)); + if (DBRefOfTerm(trm) != DBRefAdjust(DBRefOfTerm(trm), FALSE)) + /* external term pointer, has to be a DBRef */ + return MkDBRefTerm(DBRefAdjust(DBRefOfTerm(trm), FALSE)); } f = (Functor)p[0]; if (!IsExtensionFunctor(f)) { - UInt Arity, i; + UInt Arity, i; - f = FuncAdjust(f); - *p++ = (Term)f; - Arity = ArityOfFunctor(f); - for (i = 0; i < Arity; ++i) { - *p = AdjustDBTerm(*p, p0, p_lim, p_max); - p++; - } + f = FuncAdjust(f); + *p++ = (Term)f; + Arity = ArityOfFunctor(f); + for (i = 0; i < Arity; ++i) { + *p = AdjustDBTerm(*p, p0, p_lim, p_max); + p++; + } } else if (f == FunctorDBRef) { } } @@ -521,48 +499,46 @@ AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, Term *p_max USES_REGS) return trm; } -static void -RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS) -{ +static void RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS) { if (attachments) { #ifdef COROUTINING - if (attachments == 1 && dbr->ag.attachments ) - dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells); + if (attachments == 1 && dbr->ag.attachments) + dbr->ag.attachments = + AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents, + dbr->Contents + dbr->NOfCells); #endif } else { if (dbr->ag.NextDBT) dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT); - } + } if (dbr->DBRefs) { - DBRef *cp; - DBRef tm; + DBRef *cp; + DBRef tm; dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); cp = dbr->DBRefs; while ((tm = *--cp) != 0) { - *cp = DBRefAdjust(tm,TRUE); + *cp = DBRefAdjust(tm, TRUE); } } - dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells); + dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents, dbr->Contents, + dbr->Contents + dbr->NOfCells); } /* Restoring the heap */ -static void -RestoreEmptyWakeups__( USES_REGS1 ) -{ +static void RestoreEmptyWakeups__(USES_REGS1) { int i; - for (i=0; i < MaxEmptyWakeups; i++) { + for (i = 0; i < MaxEmptyWakeups; i++) { EmptyWakeups[i] = AtomAdjust(EmptyWakeups[i]); } } /* Restores a prolog clause, in its compiled form */ -static void -RestoreStaticClause(StaticClause *cl USES_REGS) +static void RestoreStaticClause(StaticClause *cl USES_REGS) /* * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not + * clause for this predicate or not */ { if (cl->ClFlags & SrcMask) { @@ -576,11 +552,10 @@ RestoreStaticClause(StaticClause *cl USES_REGS) } /* Restores a prolog clause, in its compiled form */ -static void -RestoreMegaClause(MegaClause *cl USES_REGS) +static void RestoreMegaClause(MegaClause *cl USES_REGS) /* * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not + * clause for this predicate or not */ { yamop *ptr, *max, *nextptr; @@ -589,19 +564,20 @@ RestoreMegaClause(MegaClause *cl USES_REGS) if (cl->ClNext) { cl->ClNext = (MegaClause *)AddrAdjust((ADDR)(cl->ClNext)); } - max = (yamop *)((CODEADDR)cl+cl->ClSize); + max = (yamop *)((CODEADDR)cl + cl->ClSize); if (cl->ClFlags & ExoMask) { - CELL *base = (CELL *)((ADDR)cl->ClCode+2*sizeof(struct index_t *)); - CELL *end = (CELL*)max, *ptr; + CELL *base = (CELL *)((ADDR)cl->ClCode + 2 * sizeof(struct index_t *)); + CELL *end = (CELL *)max, *ptr; for (ptr = base; ptr < end; ptr++) { Term t = *ptr; - if (IsAtomTerm(t)) *ptr = AtomTermAdjust(t); + if (IsAtomTerm(t)) + *ptr = AtomTermAdjust(t); /* don't handle other complex terms just yet, ints are ok */ } } else { - for (ptr = cl->ClCode; ptr < max; ) { + for (ptr = cl->ClCode; ptr < max;) { nextptr = (yamop *)((char *)ptr + cl->ClItemSize); restore_opcodes(ptr, nextptr PASS_REGS); ptr = nextptr; @@ -610,11 +586,10 @@ RestoreMegaClause(MegaClause *cl USES_REGS) } /* Restores a prolog clause, in its compiled form */ -static void -RestoreDynamicClause(DynamicClause *cl, PredEntry *pp USES_REGS) +static void RestoreDynamicClause(DynamicClause *cl, PredEntry *pp USES_REGS) /* * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not + * clause for this predicate or not */ { if (cl->ClPrevious != NULL) { @@ -625,11 +600,10 @@ RestoreDynamicClause(DynamicClause *cl, PredEntry *pp USES_REGS) } /* Restores a prolog clause, in its compiled form */ -static void -RestoreLUClause(LogUpdClause *cl, PredEntry *pp USES_REGS) +static void RestoreLUClause(LogUpdClause *cl, PredEntry *pp USES_REGS) /* * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not + * clause for this predicate or not */ { // INIT_LOCK(cl->ClLock); @@ -650,8 +624,7 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp USES_REGS) restore_opcodes(cl->ClCode, NULL PASS_REGS); } -static void -RestoreDBTermEntry(struct dbterm_list *dbl USES_REGS) { +static void RestoreDBTermEntry(struct dbterm_list *dbl USES_REGS) { DBTerm *dbt; if (dbl->dbterms) @@ -668,9 +641,7 @@ RestoreDBTermEntry(struct dbterm_list *dbl USES_REGS) { } } -static void -CleanLUIndex(LogUpdIndex *idx, int recurse USES_REGS) -{ +static void CleanLUIndex(LogUpdIndex *idx, int recurse USES_REGS) { // INIT_LOCK(idx->ClLock); idx->ClPred = PtoPredAdjust(idx->ClPred); if (idx->ParentIndex) @@ -693,10 +664,8 @@ CleanLUIndex(LogUpdIndex *idx, int recurse USES_REGS) } } -static void -CleanSIndex(StaticIndex *idx, int recurse USES_REGS) -{ - beginning: +static void CleanSIndex(StaticIndex *idx, int recurse USES_REGS) { +beginning: if (!(idx->ClFlags & SwitchTableMask)) { restore_opcodes(idx->ClCode, NULL PASS_REGS); } @@ -710,64 +679,50 @@ CleanSIndex(StaticIndex *idx, int recurse USES_REGS) idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex); /* use loop to avoid recursion with very complex indices */ if (recurse) { - idx = idx->SiblingIndex; + idx = idx->SiblingIndex; goto beginning; } } } - -static void -RestoreSWIAtoms__( USES_REGS1 ) -{ +static void RestoreSWIAtoms__(USES_REGS1) { int i, j; - for (i=0; i < AtomTranslations; i++) { + for (i = 0; i < AtomTranslations; i++) { SWI_Atoms[i] = AtomAdjust(SWI_Atoms[i]); } - for (j=0; j < FunctorTranslations; j++) { + for (j = 0; j < FunctorTranslations; j++) { SWI_Functors[j] = FuncAdjust(SWI_Functors[j]); } RestoreSWIHash(); } -#define RestoreBlobTypes() RestoreBlobTypes__( PASS_REGS1 ) -#define RestoreBlobs() RestoreBlobs__( PASS_REGS1); +#define RestoreBlobTypes() RestoreBlobTypes__(PASS_REGS1) +#define RestoreBlobs() RestoreBlobs__(PASS_REGS1); +static void RestoreBlobTypes__(USES_REGS1) {} -static void -RestoreBlobTypes__( USES_REGS1 ) -{ -} - -static void -RestoreBlobs__( USES_REGS1 ) -{ +static void RestoreBlobs__(USES_REGS1) { Blobs = AtomAdjust(Blobs); RestoreAtomList(Blobs PASS_REGS); } -static void -RestoreHiddenPredicates__( USES_REGS1 ) -{ +static void RestoreHiddenPredicates__(USES_REGS1) { HIDDEN_PREDICATES = PropAdjust(HIDDEN_PREDICATES); RestoreEntries(HIDDEN_PREDICATES, TRUE PASS_REGS); } - -static void -RestorePredHash__( USES_REGS1 ) -{ +static void RestorePredHash__(USES_REGS1) { PredHash = PtoPtoPredAdjust(PredHash); if (PredHash == NULL) { - Yap_Error(SYSTEM_ERROR_FATAL,MkIntTerm(0),"restore should find predicate hash table"); + Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0), + "restore should find predicate hash table"); } REINIT_RWLOCK(PredHashRWLock); - RestoreHashPreds( PASS_REGS1 ); /* does most of the work */ + RestoreHashPreds(PASS_REGS1); /* does most of the work */ } -static void -RestoreEnvInst(yamop start[2], yamop **instp, op_numbers opc, PredEntry *pred) -{ +static void RestoreEnvInst(yamop start[2], yamop **instp, op_numbers opc, + PredEntry *pred) { yamop *ipc = start; ipc->opc = Yap_opcode(_call); @@ -780,9 +735,8 @@ RestoreEnvInst(yamop start[2], yamop **instp, op_numbers opc, PredEntry *pred) *instp = ipc; } -static void -RestoreOtaplInst__(yamop start[1], OPCODE opc, PredEntry *pe USES_REGS) -{ +static void RestoreOtaplInst__(yamop start[1], OPCODE opc, + PredEntry *pe USES_REGS) { yamop *ipc = start; /* this is a place holder, it should not really be used */ @@ -799,12 +753,10 @@ RestoreOtaplInst__(yamop start[1], OPCODE opc, PredEntry *pe USES_REGS) #endif /* TABLING */ } -static void -RestoreDBTermsList__( USES_REGS1 ) -{ - if (Yap_heap_regs->dbterms_list) { - struct dbterm_list *dbl = PtoDBTLAdjust(Yap_heap_regs->dbterms_list); - Yap_heap_regs->dbterms_list = dbl; +static void RestoreDBTermsList__(USES_REGS1) { + if (DBTermsList) { + struct dbterm_list *dbl = PtoDBTLAdjust(DBTermsList); + DBTermsList = dbl; while (dbl) { RestoreDBTermEntry(dbl PASS_REGS); dbl = dbl->next_dbl; @@ -812,15 +764,13 @@ RestoreDBTermsList__( USES_REGS1 ) } } -static void -RestoreExpandList__( USES_REGS1 ) -{ - if (Yap_heap_regs->expand_clauses_first) - Yap_heap_regs->expand_clauses_first = PtoOpAdjust(Yap_heap_regs->expand_clauses_first); - if (Yap_heap_regs->expand_clauses_last) - Yap_heap_regs->expand_clauses_last = PtoOpAdjust(Yap_heap_regs->expand_clauses_last); +static void RestoreExpandList__(USES_REGS1) { + if (ExpandClausesFirst) + ExpandClausesFirst = PtoOpAdjust(ExpandClausesFirst); + if (ExpandClausesLast) + ExpandClausesLast = PtoOpAdjust(ExpandClausesLast); { - yamop *ptr = Yap_heap_regs->expand_clauses_first; + yamop *ptr = ExpandClausesFirst; while (ptr) { do_clean_susp_clauses(ptr PASS_REGS); ptr = ptr->y_u.sssllp.snext; @@ -828,106 +778,88 @@ RestoreExpandList__( USES_REGS1 ) } } -static void -RestoreUdiControlBlocks(void) -{ -} +static void RestoreUdiControlBlocks(void) {} -static void -RestoreIntKeys__( USES_REGS1 ) -{ - if (Yap_heap_regs->IntKeys != NULL) { - Yap_heap_regs->IntKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntKeys)); +static void RestoreIntKeys__(USES_REGS1) { + if (INT_KEYS != NULL) { + INT_KEYS = (Prop *)AddrAdjust((ADDR)(INT_KEYS)); { UInt i; - for (i = 0; i < Yap_heap_regs->int_keys_size; i++) { - if (Yap_heap_regs->IntKeys[i] != NIL) { - Prop p0 = Yap_heap_regs->IntKeys[i] = PropAdjust(Yap_heap_regs->IntKeys[i]); - RestoreEntries(RepProp(p0), TRUE PASS_REGS); - } + for (i = 0; i < INT_KEYS_SIZE; i++) { + if (INT_KEYS[i] != NIL) { + Prop p0 = INT_KEYS[i] = PropAdjust(INT_KEYS[i]); + RestoreEntries(RepProp(p0), TRUE PASS_REGS); + } } } } } -static void -RestoreIntLUKeys__( USES_REGS1 ) -{ - if (Yap_heap_regs->IntLUKeys != NULL) { - Yap_heap_regs->IntLUKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntLUKeys)); +static void RestoreIntLUKeys__(USES_REGS1) { + if (INT_LU_KEYS != NULL) { + INT_LU_KEYS = (Prop *)AddrAdjust((ADDR)(INT_LU_KEYS)); { Int i; for (i = 0; i < INT_KEYS_SIZE; i++) { - Prop p0 = INT_LU_KEYS[i]; - if (p0) { - p0 = PropAdjust(p0); - INT_LU_KEYS[i] = p0; - while (p0) { - PredEntry *pe = RepPredProp(p0); - pe->NextOfPE = - PropAdjust(pe->NextOfPE); - CleanCode(pe PASS_REGS); - p0 = RepProp(pe->NextOfPE); - } - } + Prop p0 = INT_LU_KEYS[i]; + if (p0) { + p0 = PropAdjust(p0); + INT_LU_KEYS[i] = p0; + while (p0) { + PredEntry *pe = RepPredProp(p0); + pe->NextOfPE = PropAdjust(pe->NextOfPE); + CleanCode(pe PASS_REGS); + p0 = RepProp(pe->NextOfPE); + } + } } } } } -static void -RestoreIntBBKeys__( USES_REGS1 ) -{ - if (Yap_heap_regs->IntBBKeys != NULL) { - Yap_heap_regs->IntBBKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntBBKeys)); +static void RestoreIntBBKeys__(USES_REGS1) { + if (INT_BB_KEYS != NULL) { + INT_BB_KEYS = (Prop *)AddrAdjust((ADDR)(INT_BB_KEYS)); { UInt i; - for (i = 0; i < Yap_heap_regs->int_bb_keys_size; i++) { - if (Yap_heap_regs->IntBBKeys[i] != NIL) { - Prop p0 = Yap_heap_regs->IntBBKeys[i] = PropAdjust(Yap_heap_regs->IntBBKeys[i]); - RestoreEntries(RepProp(p0), TRUE PASS_REGS); - } + for (i = 0; i < INT_BB_KEYS_SIZE; i++) { + if (INT_BB_KEYS[i] != NIL) { + Prop p0 = INT_BB_KEYS[i] = PropAdjust(INT_BB_KEYS[i]); + RestoreEntries(RepProp(p0), TRUE PASS_REGS); + } } } } } -static void -RestoreDBErasedMarker__( USES_REGS1 ) -{ - Yap_heap_regs->db_erased_marker = - DBRefAdjust(Yap_heap_regs->db_erased_marker,TRUE); - Yap_heap_regs->db_erased_marker->id = FunctorDBRef; - Yap_heap_regs->db_erased_marker->Flags = ErasedMask; - Yap_heap_regs->db_erased_marker->Code = NULL; - Yap_heap_regs->db_erased_marker->DBT.DBRefs = NULL; - Yap_heap_regs->db_erased_marker->Parent = NULL; +static void RestoreDBErasedMarker__(USES_REGS1) { + DBErasedMarker = DBRefAdjust(DBErasedMarker, TRUE); + DBErasedMarker->id = FunctorDBRef; + DBErasedMarker->Flags = ErasedMask; + DBErasedMarker->Code = NULL; + DBErasedMarker->DBT.DBRefs = NULL; + DBErasedMarker->Parent = NULL; } -static void -RestoreLogDBErasedMarker__( USES_REGS1 ) -{ - Yap_heap_regs->logdb_erased_marker = - PtoLUCAdjust(Yap_heap_regs->logdb_erased_marker); - Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef; - Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask; - Yap_heap_regs->logdb_erased_marker->lusl.ClSource = NULL; - Yap_heap_regs->logdb_erased_marker->ClRefCount = 0; - Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause; - Yap_heap_regs->logdb_erased_marker->ClExt = NULL; - Yap_heap_regs->logdb_erased_marker->ClPrev = NULL; - Yap_heap_regs->logdb_erased_marker->ClNext = NULL; - Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e); - Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail); - INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker); +static void RestoreLogDBErasedMarker__(USES_REGS1) { + LogDBErasedMarker = PtoLUCAdjust(LogDBErasedMarker); + LogDBErasedMarker->Id = FunctorDBRef; + LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask; + LogDBErasedMarker->lusl.ClSource = NULL; + LogDBErasedMarker->ClRefCount = 0; + LogDBErasedMarker->ClPred = PredLogUpdClause; + LogDBErasedMarker->ClExt = NULL; + LogDBErasedMarker->ClPrev = NULL; + LogDBErasedMarker->ClNext = NULL; + LogDBErasedMarker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e); + LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail); + INIT_CLREF_COUNT(LogDBErasedMarker); } -static void -RestoreDeadStaticClauses__( USES_REGS1 ) -{ - if (Yap_heap_regs->dead_static_clauses) { - StaticClause *sc = PtoStCAdjust(Yap_heap_regs->dead_static_clauses); - Yap_heap_regs->dead_static_clauses = sc; +static void RestoreDeadStaticClauses__(USES_REGS1) { + if (DeadStaticClauses) { + StaticClause *sc = PtoStCAdjust(DeadStaticClauses); + DeadStaticClauses = sc; while (sc) { RestoreStaticClause(sc PASS_REGS); sc = sc->ClNext; @@ -935,12 +867,10 @@ RestoreDeadStaticClauses__( USES_REGS1 ) } } -static void -RestoreDeadMegaClauses__( USES_REGS1 ) -{ - if (Yap_heap_regs->dead_mega_clauses) { - MegaClause *mc = (MegaClause *)AddrAdjust((ADDR)(Yap_heap_regs->dead_mega_clauses)); - Yap_heap_regs->dead_mega_clauses = mc; +static void RestoreDeadMegaClauses__(USES_REGS1) { + if (DeadMegaClauses) { + MegaClause *mc = (MegaClause *)AddrAdjust((ADDR)(DeadMegaClauses)); + DeadMegaClauses = mc; while (mc) { RestoreMegaClause(mc PASS_REGS); mc = mc->ClNext; @@ -948,12 +878,10 @@ RestoreDeadMegaClauses__( USES_REGS1 ) } } -static void -RestoreDeadStaticIndices__( USES_REGS1 ) -{ - if (Yap_heap_regs->dead_static_indices) { - StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(Yap_heap_regs->dead_static_indices)); - Yap_heap_regs->dead_static_indices = si; +static void RestoreDeadStaticIndices__(USES_REGS1) { + if (DeadStaticIndices) { + StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(DeadStaticIndices)); + DeadStaticIndices = si; while (si) { CleanSIndex(si, FALSE PASS_REGS); si = si->SiblingIndex; @@ -961,12 +889,9 @@ RestoreDeadStaticIndices__( USES_REGS1 ) } } -static void -RestoreDBErasedList__( USES_REGS1 ) -{ - if (Yap_heap_regs->db_erased_list) { - LogUpdClause *lcl = Yap_heap_regs->db_erased_list = - PtoLUCAdjust(Yap_heap_regs->db_erased_list); +static void RestoreDBErasedList__(USES_REGS1) { + if (DBErasedList) { + LogUpdClause *lcl = DBErasedList = PtoLUCAdjust(DBErasedList); while (lcl) { RestoreLUClause(lcl, FALSE PASS_REGS); lcl = lcl->ClNext; @@ -974,12 +899,9 @@ RestoreDBErasedList__( USES_REGS1 ) } } -static void -RestoreDBErasedIList__( USES_REGS1 ) -{ - if (Yap_heap_regs->db_erased_ilist) { - LogUpdIndex *icl = Yap_heap_regs->db_erased_ilist = - LUIndexAdjust(Yap_heap_regs->db_erased_ilist); +static void RestoreDBErasedIList__(USES_REGS1) { + if (DBErasedIList) { + LogUpdIndex *icl = DBErasedIList = LUIndexAdjust(DBErasedIList); while (icl) { CleanLUIndex(icl, FALSE PASS_REGS); icl = icl->SiblingIndex; @@ -987,14 +909,12 @@ RestoreDBErasedIList__( USES_REGS1 ) } } -static void -RestoreForeignCode__( USES_REGS1 ) -{ +static void RestoreForeignCode__(USES_REGS1) { ForeignObj *f_code; if (!ForeignCodeLoaded) return; - if (ForeignCodeLoaded != NULL) + if (ForeignCodeLoaded != NULL) ForeignCodeLoaded = (void *)AddrAdjust((ADDR)ForeignCodeLoaded); f_code = ForeignCodeLoaded; while (f_code != NULL) { @@ -1004,8 +924,8 @@ RestoreForeignCode__( USES_REGS1 ) objs = f_code->objs; while (objs != NULL) { if (objs->next != NULL) - objs->next = (StringList)AddrAdjust((ADDR)objs->next); - objs->name = AtomAdjust(objs->name); + objs->next = (StringList)AddrAdjust((ADDR)objs->next); + objs->name = AtomAdjust(objs->name); objs = objs->next; } if (f_code->libs != NULL) @@ -1013,7 +933,7 @@ RestoreForeignCode__( USES_REGS1 ) libs = f_code->libs; while (libs != NULL) { if (libs->next != NULL) - libs->next = (StringList)AddrAdjust((ADDR)libs->next); + libs->next = (StringList)AddrAdjust((ADDR)libs->next); libs->name = AtomAdjust(libs->name); libs = libs->next; } @@ -1026,9 +946,7 @@ RestoreForeignCode__( USES_REGS1 ) } } -static void -RestoreYapRecords__( USES_REGS1 ) -{ +static void RestoreYapRecords__(USES_REGS1) { struct record_list *ptr; Yap_Records = DBRecordAdjust(Yap_Records); @@ -1042,37 +960,29 @@ RestoreYapRecords__( USES_REGS1 ) } } -static void -RestoreBallTerm(int wid) -{ +static void RestoreBallTerm(int wid) { CACHE_REGS if (LOCAL_BallTerm) { - LOCAL_BallTerm = DBTermAdjust(LOCAL_BallTerm); + LOCAL_BallTerm = DBTermAdjust(LOCAL_BallTerm); RestoreDBTerm(LOCAL_BallTerm, 1 PASS_REGS); } } -#include "rglobals.h" -#include "rlocals.h" +#include "heap/rglobals.h" + +#include "heap/rlocals.h" /* restore the failcodes */ -static void -restore_codes(void) -{ +static void restore_codes(void) { CACHE_REGS - Yap_heap_regs->heap_top = AddrAdjust(LOCAL_OldHeapTop); -#include "rhstruct.h" - RestoreGlobal(); -#ifndef worker_id -#define worker_id 0 -#endif - RestoreWorker(worker_id PASS_REGS); - } + HeapTop = AddrAdjust(LOCAL_OldHeapTop); +#include "heap/rhstruct.h" -static void -RestoreDBEntry(DBRef dbr USES_REGS) -{ + RestoreWorker(worker_id PASS_REGS); +} + +static void RestoreDBEntry(DBRef dbr USES_REGS) { #ifdef DEBUG_RESTORE fprintf(stderr, "Restoring at %x", dbr); if (dbr->Flags & DBAtomic) @@ -1093,9 +1003,9 @@ RestoreDBEntry(DBRef dbr USES_REGS) if (dbr->Code != NULL) dbr->Code = PtoOpAdjust(dbr->Code); if (dbr->Prev != NULL) - dbr->Prev = DBRefAdjust(dbr->Prev,TRUE); + dbr->Prev = DBRefAdjust(dbr->Prev, TRUE); if (dbr->Next != NULL) - dbr->Next = DBRefAdjust(dbr->Next,TRUE); + dbr->Next = DBRefAdjust(dbr->Next, TRUE); #ifdef DEBUG_RESTORE2 fprintf(stderr, "Recomputing masks\n"); #endif @@ -1103,19 +1013,17 @@ RestoreDBEntry(DBRef dbr USES_REGS) } /* Restores a DB structure, as it was saved in the heap */ -static void -RestoreDB(DBEntry *pp USES_REGS) -{ - register DBRef dbr; +static void RestoreDB(DBEntry *pp USES_REGS) { + register DBRef dbr; if (pp->First != NULL) - pp->First = DBRefAdjust(pp->First,TRUE); + pp->First = DBRefAdjust(pp->First, TRUE); if (pp->Last != NULL) pp->Last = DBRefAdjust(pp->Last, TRUE); if (pp->ArityOfDB) pp->FunctorOfDB = FuncAdjust(pp->FunctorOfDB); else - pp->FunctorOfDB = (Functor) AtomAdjust((Atom)(pp->FunctorOfDB)); + pp->FunctorOfDB = (Functor)AtomAdjust((Atom)(pp->FunctorOfDB)); if (pp->F0 != NULL) pp->F0 = DBRefAdjust(pp->F0, TRUE); if (pp->L0 != NULL) @@ -1135,13 +1043,11 @@ RestoreDB(DBEntry *pp USES_REGS) /* * Restores a group of clauses for the same predicate, starting with First - * and ending with Last, First may be equal to Last + * and ending with Last, First may be equal to Last */ -static void -CleanClauses(yamop *First, yamop *Last, PredEntry *pp USES_REGS) -{ - if (!First) - return; +static void CleanClauses(yamop *First, yamop *Last, PredEntry *pp USES_REGS) { + if (!First) + return; if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(First); while (cl != NULL) { @@ -1157,7 +1063,8 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp USES_REGS) do { RestoreDynamicClause(ClauseCodeToDynamicClause(cl), pp PASS_REGS); - if (cl == Last) return; + if (cl == Last) + return; cl = NextDynamicClause(cl); } while (TRUE); } else { @@ -1165,27 +1072,24 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp USES_REGS) do { RestoreStaticClause(cl PASS_REGS); - if (cl->ClCode == Last) return; + if (cl->ClCode == Last) + return; cl = cl->ClNext; } while (TRUE); } } - - /* Restores a DB structure, as it was saved in the heap */ -static void -RestoreBB(BlackBoardEntry *pp, int int_key USES_REGS) -{ +static void RestoreBB(BlackBoardEntry *pp, int int_key USES_REGS) { Term t = pp->Element; if (t) { if (!IsVarTerm(t)) { if (IsAtomicTerm(t)) { - if (IsAtomTerm(t)) { - pp->Element = AtomTermAdjust(t); - } + if (IsAtomTerm(t)) { + pp->Element = AtomTermAdjust(t); + } } else { - RestoreLUClause((LogUpdClause *)DBRefOfTerm(t),NULL PASS_REGS); + RestoreLUClause((LogUpdClause *)DBRefOfTerm(t), NULL PASS_REGS); } } } @@ -1197,151 +1101,141 @@ RestoreBB(BlackBoardEntry *pp, int int_key USES_REGS) } } -static void -restore_static_array(StaticArrayEntry *ae USES_REGS) -{ +static void restore_static_array(StaticArrayEntry *ae USES_REGS) { Int sz = -ae->ArrayEArity; switch (ae->ArrayType) { case array_of_ints: case array_of_doubles: case array_of_chars: case array_of_uchars: - return; - case array_of_ptrs: - { - AtomEntry **base = (AtomEntry **)AddrAdjust((ADDR)(ae->ValueOfVE.ptrs)); - Int i; - ae->ValueOfVE.ptrs = base; - if (ae != NULL) { - for (i=0; iValueOfVE.ptrs)); + Int i; + ae->ValueOfVE.ptrs = base; + if (ae != NULL) { + for (i = 0; i < sz; i++) { + AtomEntry *reg = *base; + if (reg == NULL) { + base++; + } else if (IsOldCode((CELL)reg)) { + *base++ = AtomEntryAdjust(reg); + } else if (IsOldLocalInTR((CELL)reg)) { + *base++ = (AtomEntry *)LocalAddrAdjust((ADDR)reg); + } else if (IsOldGlobal((CELL)reg)) { + *base++ = (AtomEntry *)GlobalAddrAdjust((ADDR)reg); + } else if (IsOldTrail((CELL)reg)) { + *base++ = (AtomEntry *)TrailAddrAdjust((ADDR)reg); + } else { + /* oops */ + base++; + } } } - return; - case array_of_atoms: - { - Term *base = (Term *)AddrAdjust((ADDR)(ae->ValueOfVE.atoms)); - Int i; - ae->ValueOfVE.atoms = base; - if (ae != 0L) { - for (i=0; iValueOfVE.atoms)); + Int i; + ae->ValueOfVE.atoms = base; + if (ae != 0L) { + for (i = 0; i < sz; i++) { + Term reg = *base; + if (reg == 0L) { + base++; + } else { + *base++ = AtomTermAdjust(reg); + } } } - return; - case array_of_dbrefs: - { - Term *base = (Term *)AddrAdjust((ADDR)(ae->ValueOfVE.dbrefs)); - Int i; + } + return; + case array_of_dbrefs: { + Term *base = (Term *)AddrAdjust((ADDR)(ae->ValueOfVE.dbrefs)); + Int i; - ae->ValueOfVE.dbrefs = base; - if (ae != 0L) { - for (i=0; iValueOfVE.dbrefs = base; + if (ae != 0L) { + for (i = 0; i < sz; i++) { + Term reg = *base; + if (reg == 0L) { + base++; + } else { + *base++ = AbsAppl(PtoHeapCellAdjust(RepAppl(reg))); + } } } - return; - case array_of_nb_terms: - { - live_term *base = (live_term *)AddrAdjust((ADDR)(ae->ValueOfVE.lterms)); - Int i; + } + return; + case array_of_nb_terms: { + live_term *base = (live_term *)AddrAdjust((ADDR)(ae->ValueOfVE.lterms)); + Int i; - ae->ValueOfVE.lterms = base; - if (ae != 0L) { - for (i=0; i < sz; i++,base++) { - Term reg = base->tlive; - if (IsVarTerm(reg)) { - CELL *var = (CELL *)reg; + ae->ValueOfVE.lterms = base; + if (ae != 0L) { + for (i = 0; i < sz; i++, base++) { + Term reg = base->tlive; + if (IsVarTerm(reg)) { + CELL *var = (CELL *)reg; - if (IsOldGlobalPtr(var)) { - base->tlive = (CELL)PtoGloAdjust(var); - } else { - base->tlive = (CELL)PtoHeapCellAdjust(var); - } - } else if (IsAtomTerm(reg)) { - base->tlive = AtomTermAdjust(reg); - } else if (IsApplTerm(reg)) { - CELL *db = RepAppl(reg); - db = PtoGloAdjust(db); - base->tlive = AbsAppl(db); - } else if (IsApplTerm(reg)) { - CELL *db = RepPair(reg); - db = PtoGloAdjust(db); - base->tlive = AbsPair(db); - } + if (IsOldGlobalPtr(var)) { + base->tlive = (CELL)PtoGloAdjust(var); + } else { + base->tlive = (CELL)PtoHeapCellAdjust(var); + } + } else if (IsAtomTerm(reg)) { + base->tlive = AtomTermAdjust(reg); + } else if (IsApplTerm(reg)) { + CELL *db = RepAppl(reg); + db = PtoGloAdjust(db); + base->tlive = AbsAppl(db); + } else if (IsApplTerm(reg)) { + CELL *db = RepPair(reg); + db = PtoGloAdjust(db); + base->tlive = AbsPair(db); + } - reg = base->tstore; - if (IsVarTerm(reg)) { - base->tstore = (Term)GlobalAddrAdjust((ADDR)reg); - } else if (IsAtomTerm(reg)) { - base->tstore = AtomTermAdjust(reg); - } else { - DBTerm *db = (DBTerm *)RepAppl(reg); - db = DBTermAdjust(db); - RestoreDBTerm(db, 1 PASS_REGS); - base->tstore = AbsAppl((CELL *)db); - } - } + reg = base->tstore; + if (IsVarTerm(reg)) { + base->tstore = (Term)GlobalAddrAdjust((ADDR)reg); + } else if (IsAtomTerm(reg)) { + base->tstore = AtomTermAdjust(reg); + } else { + DBTerm *db = (DBTerm *)RepAppl(reg); + db = DBTermAdjust(db); + RestoreDBTerm(db, 1 PASS_REGS); + base->tstore = AbsAppl((CELL *)db); + } } } - case array_of_terms: - { - DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms)); - Int i; + } + case array_of_terms: { + DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms)); + Int i; - ae->ValueOfVE.terms = base; - if (ae != 0L) { - for (i=0; iValueOfVE.terms = base; + if (ae != 0L) { + for (i = 0; i < sz; i++) { + DBTerm *reg = *base; + if (reg == NULL) { + base++; + } else { + *base++ = reg = DBTermAdjust(reg); + RestoreDBTerm(reg, 1 PASS_REGS); + } } } - return; + } + return; } } /* * Clean all the code for a particular predicate, this can get a bit tricky, - * because of the indexing code + * because of the indexing code */ -static void -CleanCode(PredEntry *pp USES_REGS) -{ - pred_flags_t flag; - +static void CleanCode(PredEntry *pp USES_REGS) { + pred_flags_t flag; /* Init takes care of the first 2 cases */ if (pp->ModuleOfPred) { @@ -1350,11 +1244,11 @@ CleanCode(PredEntry *pp USES_REGS) if (pp->ArityOfPE) { if (pp->ModuleOfPred == IDB_MODULE) { if (pp->PredFlags & NumberDBPredFlag) { - /* it's an integer, do nothing */ + /* it's an integer, do nothing */ } else if (pp->PredFlags & AtomDBPredFlag) { - pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred)); + pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred)); } else { - pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred); + pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred); } } else { pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred); @@ -1371,20 +1265,20 @@ CleanCode(PredEntry *pp USES_REGS) if (pp->NextPredOfModule) { pp->NextPredOfModule = PtoPredAdjust(pp->NextPredOfModule); } - if (pp->PredFlags & (AsmPredFlag|CPredFlag)) { + if (pp->PredFlags & (AsmPredFlag | CPredFlag)) { /* assembly */ if (pp->CodeOfPred) { pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred); CleanClauses(pp->CodeOfPred, pp->CodeOfPred, pp PASS_REGS); } } else { - yamop *FirstC, *LastC; + yamop *FirstC, *LastC; /* Prolog code */ if (pp->cs.p_code.FirstClause) pp->cs.p_code.FirstClause = PtoOpAdjust(pp->cs.p_code.FirstClause); if (pp->cs.p_code.LastClause) pp->cs.p_code.LastClause = PtoOpAdjust(pp->cs.p_code.LastClause); - pp->CodeOfPred =PtoOpAdjust(pp->CodeOfPred); + pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred); pp->cs.p_code.TrueCodeOfPred = PtoOpAdjust(pp->cs.p_code.TrueCodeOfPred); pp->cs.p_code.ExpandCode = Yap_opcode(_expand_index); flag = pp->PredFlags; @@ -1394,24 +1288,29 @@ CleanCode(PredEntry *pp USES_REGS) if (FirstC == NULL && LastC == NULL) { return; } -#ifdef DEBUG_RESTORE2 - fprintf(stderr, "at %lx Correcting clauses from %p to %p\n", *(OPCODE *) FirstC, FirstC, LastC); +#ifdef DEBUG_RESTORE2 + fprintf(stderr, "at %lx Correcting clauses from %p to %p\n", + *(OPCODE *)FirstC, FirstC, LastC); #endif CleanClauses(FirstC, LastC, pp PASS_REGS); if (flag & IndexedPredFlag) { -#ifdef DEBUG_RESTORE2 +#ifdef DEBUG_RESTORE2 fprintf(stderr, "Correcting indexed code\n"); #endif if (flag & LogUpdatePredFlag) { - CleanLUIndex(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), TRUE PASS_REGS); + CleanLUIndex(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), + TRUE PASS_REGS); } else { - CleanSIndex(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), TRUE PASS_REGS); - } + CleanSIndex(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), + TRUE PASS_REGS); + } } else if (flag & DynamicPredFlag) { -#ifdef DEBUG_RESTORE2 +#ifdef DEBUG_RESTORE2 fprintf(stderr, "Correcting dynamic code\n"); #endif - RestoreDynamicClause(ClauseCodeToDynamicClause(pp->cs.p_code.TrueCodeOfPred),pp PASS_REGS); + RestoreDynamicClause( + ClauseCodeToDynamicClause(pp->cs.p_code.TrueCodeOfPred), + pp PASS_REGS); } } /* we are pointing at ourselves */ @@ -1419,237 +1318,183 @@ CleanCode(PredEntry *pp USES_REGS) /* * Restores all of the entries, for a particular atom, we only have problems - * if we find code or data bases + * if we find code or data bases */ -static void -RestoreEntries(PropEntry *pp, int int_key USES_REGS) -{ +static void RestoreEntries(PropEntry *pp, int int_key USES_REGS) { while (!EndOfPAEntr(pp)) { - switch(pp->KindOfPE) { - case FunctorProperty: - { - FunctorEntry *fe = (FunctorEntry *)pp; - Prop p0; - fe->NextOfPE = - PropAdjust(fe->NextOfPE); - fe->NameOfFE = - AtomAdjust(fe->NameOfFE); - p0 = fe->PropsOfFE = - PropAdjust(fe->PropsOfFE); - if (!EndOfPAEntr(p0)) { - /* at most one property */ - CleanCode(RepPredProp(p0) PASS_REGS); - RepPredProp(p0)->NextOfPE = - PropAdjust(RepPredProp(p0)->NextOfPE); - } + switch (pp->KindOfPE) { + case FunctorProperty: { + FunctorEntry *fe = (FunctorEntry *)pp; + Prop p0; + fe->NextOfPE = PropAdjust(fe->NextOfPE); + fe->NameOfFE = AtomAdjust(fe->NameOfFE); + p0 = fe->PropsOfFE = PropAdjust(fe->PropsOfFE); + if (!EndOfPAEntr(p0)) { + /* at most one property */ + CleanCode(RepPredProp(p0) PASS_REGS); + RepPredProp(p0)->NextOfPE = PropAdjust(RepPredProp(p0)->NextOfPE); } - break; - case ValProperty: - { - ValEntry *ve = (ValEntry *)pp; - Term tv = ve->ValueOfVE; - ve->NextOfPE = - PropAdjust(ve->NextOfPE); - if (IsAtomTerm(tv)) - ve->ValueOfVE = AtomTermAdjust(tv); + } break; + case ValProperty: { + ValEntry *ve = (ValEntry *)pp; + Term tv = ve->ValueOfVE; + ve->NextOfPE = PropAdjust(ve->NextOfPE); + if (IsAtomTerm(tv)) + ve->ValueOfVE = AtomTermAdjust(tv); + } break; + case HoldProperty: { + HoldEntry *he = (HoldEntry *)pp; + he->NextOfPE = PropAdjust(he->NextOfPE); + } break; + case MutexProperty: { + HoldEntry *he = (HoldEntry *)pp; + he->NextOfPE = PropAdjust(he->NextOfPE); + } break; + case TranslationProperty: { + TranslationEntry *he = (TranslationEntry *)pp; + he->NextOfPE = PropAdjust(he->NextOfPE); + } break; + case FlagProperty: { + FlagEntry *he = (FlagEntry *)pp; + he->NextOfPE = PropAdjust(he->NextOfPE); + } break; + case ArrayProperty: { + ArrayEntry *ae = (ArrayEntry *)pp; + ae->NextOfPE = PropAdjust(ae->NextOfPE); + if (ae->TypeOfAE == STATIC_ARRAY) { + /* static array entry */ + StaticArrayEntry *sae = (StaticArrayEntry *)ae; + if (sae->NextAE) + sae->NextAE = PtoArraySAdjust(sae->NextAE); + restore_static_array(sae PASS_REGS); + } else { + if (ae->NextAE) + ae->NextAE = PtoArrayEAdjust(ae->NextAE); + if (IsVarTerm(ae->ValueOfVE)) + RESET_VARIABLE(&(ae->ValueOfVE)); + else { + CELL *ptr = RepAppl(ae->ValueOfVE); + /* in fact it should just be a pointer to the global, + but we'll be conservative. + Notice that the variable should have been reset in restore_program + mode. + */ + if (IsOldGlobalPtr(ptr)) { + ae->ValueOfVE = AbsAppl(PtoGloAdjust(ptr)); + } else if (IsOldCodeCellPtr(ptr)) { + ae->ValueOfVE = AbsAppl(PtoHeapCellAdjust(ptr)); + } else if (IsOldLocalInTRPtr(ptr)) { + ae->ValueOfVE = AbsAppl(PtoLocAdjust(ptr)); + } else if (IsOldTrailPtr(ptr)) { + ae->ValueOfVE = AbsAppl(CellPtoTRAdjust(ptr)); + } + } } - break; - case HoldProperty: - { - HoldEntry *he = (HoldEntry *)pp; - he->NextOfPE = - PropAdjust(he->NextOfPE); - } - break; - case MutexProperty: - { - HoldEntry *he = (HoldEntry *)pp; - he->NextOfPE = - PropAdjust(he->NextOfPE); - } - break; - case TranslationProperty: - { - TranslationEntry *he = (TranslationEntry *)pp; - he->NextOfPE = - PropAdjust(he->NextOfPE); - } - break; - case FlagProperty: - { - FlagEntry *he = (FlagEntry *)pp; - he->NextOfPE = - PropAdjust(he->NextOfPE); - } - break; - case ArrayProperty: - { - ArrayEntry *ae = (ArrayEntry *)pp; - ae->NextOfPE = - PropAdjust(ae->NextOfPE); - if (ae->TypeOfAE == STATIC_ARRAY) { - /* static array entry */ - StaticArrayEntry *sae = (StaticArrayEntry *)ae; - if (sae->NextAE) - sae->NextAE = PtoArraySAdjust(sae->NextAE); - restore_static_array(sae PASS_REGS); - } else { - if (ae->NextAE) - ae->NextAE = PtoArrayEAdjust(ae->NextAE); - if (IsVarTerm(ae->ValueOfVE)) - RESET_VARIABLE(&(ae->ValueOfVE)); - else { - CELL *ptr = RepAppl(ae->ValueOfVE); - /* in fact it should just be a pointer to the global, - but we'll be conservative. - Notice that the variable should have been reset in restore_program mode. - */ - if (IsOldGlobalPtr(ptr)) { - ae->ValueOfVE = AbsAppl(PtoGloAdjust(ptr)); - } else if (IsOldCodeCellPtr(ptr)) { - ae->ValueOfVE = AbsAppl(PtoHeapCellAdjust(ptr)); - } else if (IsOldLocalInTRPtr(ptr)) { - ae->ValueOfVE = AbsAppl(PtoLocAdjust(ptr)); - } else if (IsOldTrailPtr(ptr)) { - ae->ValueOfVE = AbsAppl(CellPtoTRAdjust(ptr)); - } - } - } - } - break; - case PEProp: - { - PredEntry *pe = (PredEntry *) pp; - pe->NextOfPE = - PropAdjust(pe->NextOfPE); - CleanCode(pe PASS_REGS); - } - break; + } break; + case PEProp: { + PredEntry *pe = (PredEntry *)pp; + pe->NextOfPE = PropAdjust(pe->NextOfPE); + CleanCode(pe PASS_REGS); + } break; case DBProperty: case CodeDBProperty: #ifdef DEBUG_RESTORE2 fprintf(stderr, "Correcting data base clause at %p\n", pp); #endif { - DBEntry *de = (DBEntry *) pp; - de->NextOfPE = - PropAdjust(de->NextOfPE); - RestoreDB(de PASS_REGS); + DBEntry *de = (DBEntry *)pp; + de->NextOfPE = PropAdjust(de->NextOfPE); + RestoreDB(de PASS_REGS); } break; - case BBProperty: - { - BlackBoardEntry *bb = (BlackBoardEntry *) pp; - bb->NextOfPE = - PropAdjust(bb->NextOfPE); - RestoreBB(bb, int_key PASS_REGS); - } - break; - case GlobalProperty: - { - GlobalEntry *gb = (GlobalEntry *) pp; - Term gbt = gb->global; + case BBProperty: { + BlackBoardEntry *bb = (BlackBoardEntry *)pp; + bb->NextOfPE = PropAdjust(bb->NextOfPE); + RestoreBB(bb, int_key PASS_REGS); + } break; + case GlobalProperty: { + GlobalEntry *gb = (GlobalEntry *)pp; + Term gbt = gb->global; - gb->NextOfPE = - PropAdjust(gb->NextOfPE); - gb->AtomOfGE = - AtomEntryAdjust(gb->AtomOfGE); - if (gb->NextGE) { - gb->NextGE = - GlobalEntryAdjust(gb->NextGE); - } - if (IsVarTerm(gbt)) { - CELL *gbp = VarOfTerm(gbt); - if (IsOldGlobalPtr(gbp)) - gbp = PtoGloAdjust(gbp); - else - gbp = CellPtoHeapAdjust(gbp); - gb->global = (CELL)gbp; - } else if (IsPairTerm(gbt)) { - gb->global = AbsPair(PtoGloAdjust(RepPair(gbt))); - } else if (IsApplTerm(gbt)) { - CELL *gbp = RepAppl(gbt); - if (IsOldGlobalPtr(gbp)) - gbp = PtoGloAdjust(gbp); - else - gbp = CellPtoHeapAdjust(gbp); - gb->global = AbsAppl(gbp); - } else if (IsAtomTerm(gbt)) { - gb->global = AtomTermAdjust(gbt); - } /* numbers need no adjusting */ + gb->NextOfPE = PropAdjust(gb->NextOfPE); + gb->AtomOfGE = AtomEntryAdjust(gb->AtomOfGE); + if (gb->NextGE) { + gb->NextGE = GlobalEntryAdjust(gb->NextGE); } - break; - case OpProperty: - { - OpEntry *opp = (OpEntry *)pp; - if (opp->NextOfPE) { - opp->NextOfPE = - PropAdjust(opp->NextOfPE); - } - opp->OpName = - AtomAdjust(opp->OpName); - if (opp->OpModule) { - opp->OpModule = AtomTermAdjust(opp->OpModule); - } - if (opp->OpNext) { - opp->OpNext = OpEntryAdjust(opp->OpNext); - } + if (IsVarTerm(gbt)) { + CELL *gbp = VarOfTerm(gbt); + if (IsOldGlobalPtr(gbp)) + gbp = PtoGloAdjust(gbp); + else + gbp = CellPtoHeapAdjust(gbp); + gb->global = (CELL)gbp; + } else if (IsPairTerm(gbt)) { + gb->global = AbsPair(PtoGloAdjust(RepPair(gbt))); + } else if (IsApplTerm(gbt)) { + CELL *gbp = RepAppl(gbt); + if (IsOldGlobalPtr(gbp)) + gbp = PtoGloAdjust(gbp); + else + gbp = CellPtoHeapAdjust(gbp); + gb->global = AbsAppl(gbp); + } else if (IsAtomTerm(gbt)) { + gb->global = AtomTermAdjust(gbt); + } /* numbers need no adjusting */ + } break; + case OpProperty: { + OpEntry *opp = (OpEntry *)pp; + if (opp->NextOfPE) { + opp->NextOfPE = PropAdjust(opp->NextOfPE); } - break; - case ModProperty: - { - ModEntry *me = (ModEntry *)pp; - if (me->NextOfPE) { - me->NextOfPE = - PropAdjust(me->NextOfPE); - } - if (me->PredForME) { - me->PredForME = - PtoPredAdjust(me->PredForME); - } - me->AtomOfME = - AtomAdjust(me->AtomOfME); - if (me->NextME) - me->NextME = (struct mod_entry *) - AddrAdjust((ADDR)me->NextME); + opp->OpName = AtomAdjust(opp->OpName); + if (opp->OpModule) { + opp->OpModule = AtomTermAdjust(opp->OpModule); } - break; + if (opp->OpNext) { + opp->OpNext = OpEntryAdjust(opp->OpNext); + } + } break; + case ModProperty: { + ModEntry *me = (ModEntry *)pp; + if (me->NextOfPE) { + me->NextOfPE = PropAdjust(me->NextOfPE); + } + if (me->PredForME) { + me->PredForME = PtoPredAdjust(me->PredForME); + } + me->AtomOfME = AtomAdjust(me->AtomOfME); + if (me->NextME) + me->NextME = (struct mod_entry *)AddrAdjust((ADDR)me->NextME); + } break; case ExpProperty: - pp->NextOfPE = - PropAdjust(pp->NextOfPE); + pp->NextOfPE = PropAdjust(pp->NextOfPE); break; case WideAtomProperty: - pp->NextOfPE = - PropAdjust(pp->NextOfPE); + pp->NextOfPE = PropAdjust(pp->NextOfPE); break; case BlobProperty: - pp->NextOfPE = - PropAdjust(pp->NextOfPE); + pp->NextOfPE = PropAdjust(pp->NextOfPE); { YAP_BlobPropEntry *bpe = (YAP_BlobPropEntry *)pp; - bpe->blob_type = - BlobTypeAdjust(bpe->blob_type); + bpe->blob_type = BlobTypeAdjust(bpe->blob_type); } break; default: /* OOPS */ Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "Invalid Atom Property %d at %p", pp->KindOfPE, pp); + "Invalid Atom Property %d at %p", pp->KindOfPE, pp); return; } pp = RepProp(pp->NextOfPE); } } - -static void -RestoreAtom(AtomEntry *at USES_REGS) -{ +static void RestoreAtom(AtomEntry *at USES_REGS) { AtomEntry *nat; /* this should be done before testing for wide atoms */ at->PropsOfAE = PropAdjust(at->PropsOfAE); -#if DEBUG_RESTORE2 /* useful during debug */ +#if DEBUG_RESTORE2 /* useful during debug */ if (IsWideAtom(AbsAtom(at))) fprintf(stderr, "Restoring %S\n", at->WStrOfAE); else @@ -1661,4 +1506,3 @@ RestoreAtom(AtomEntry *at USES_REGS) if (nat) at->NextOfAE = AbsAtom(AtomEntryAdjust(nat)); } - diff --git a/H/rhstruct.h b/H/rhstruct.h deleted file mode 100644 index 84543d436..000000000 --- a/H/rhstruct.h +++ /dev/null @@ -1,301 +0,0 @@ - - /* This file, rhstruct.h, was generated automatically by "yap -L misc/buildheap" - please do not update, update misc/HEAPFIELDS instead */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if USE_DL_MALLOC - - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(DLMallocLock); -#endif -#endif -#if USE_DL_MALLOC || (USE_SYSTEM_MALLOC && HAVE_MALLINFO) -#ifndef HeapUsed -#define HeapUsed Yap_givemallinfo() -#endif - -#else - -#endif - - - - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(FreeBlocksLock); - REINIT_LOCK(HeapUsedLock); - REINIT_LOCK(HeapTopLock); - -#endif - - - - -#if USE_THREADED_CODE - OP_RTABLE = OpRTableAdjust(OP_RTABLE); -#endif - - EXECUTE_CPRED_OP_CODE = Yap_opcode(_execute_cpred); - EXPAND_OP_CODE = Yap_opcode(_expand_index); - FAIL_OPCODE = Yap_opcode(_op_fail); - INDEX_OPCODE = Yap_opcode(_index_pred); - LOCKPRED_OPCODE = Yap_opcode(_lock_pred); - ORLAST_OPCODE = Yap_opcode(_or_last); - UNDEF_OPCODE = Yap_opcode(_undef_p); - RETRY_USERC_OPCODE = Yap_opcode(_retry_userc); - EXECUTE_CPRED_OPCODE = Yap_opcode(_execute_cpred); - - - - - - RestoreInvisibleAtoms(); - RestoreWideAtoms(); - RestoreAtoms(); - -#include "ratoms.h" -#ifdef EUROTRA - TermDollarU = AtomTermAdjust(TermDollarU); -#endif - - USER_MODULE = AtomTermAdjust(USER_MODULE); - IDB_MODULE = AtomTermAdjust(IDB_MODULE); - ATTRIBUTES_MODULE = AtomTermAdjust(ATTRIBUTES_MODULE); - CHARSIO_MODULE = AtomTermAdjust(CHARSIO_MODULE); - CHTYPE_MODULE = AtomTermAdjust(CHTYPE_MODULE); - TERMS_MODULE = AtomTermAdjust(TERMS_MODULE); - SYSTEM_MODULE = AtomTermAdjust(SYSTEM_MODULE); - READUTIL_MODULE = AtomTermAdjust(READUTIL_MODULE); - HACKS_MODULE = AtomTermAdjust(HACKS_MODULE); - ARG_MODULE = AtomTermAdjust(ARG_MODULE); - GLOBALS_MODULE = AtomTermAdjust(GLOBALS_MODULE); - SWI_MODULE = AtomTermAdjust(SWI_MODULE); - DBLOAD_MODULE = AtomTermAdjust(DBLOAD_MODULE); - RANGE_MODULE = AtomTermAdjust(RANGE_MODULE); - ERROR_MODULE = AtomTermAdjust(ERROR_MODULE); - - - - CurrentModules = ModEntryPtrAdjust(CurrentModules); - - - - - RestoreHiddenPredicates(); - - - - - RestoreFlags(GLOBAL_flagCount); - - - - RestorePredHash(); -#if defined(YAPOR) || defined(THREADS) - -#endif - - - - CreepCode = PtoPredAdjust(CreepCode); - UndefCode = PtoPredAdjust(UndefCode); - SpyCode = PtoPredAdjust(SpyCode); - PredFail = PtoPredAdjust(PredFail); - PredTrue = PtoPredAdjust(PredTrue); -#ifdef COROUTINING - WakeUpCode = PtoPredAdjust(WakeUpCode); -#endif - PredGoalExpansion = PtoPredAdjust(PredGoalExpansion); - PredMetaCall = PtoPredAdjust(PredMetaCall); - PredTraceMetaCall = PtoPredAdjust(PredTraceMetaCall); - PredDollarCatch = PtoPredAdjust(PredDollarCatch); - PredRecordedWithKey = PtoPredAdjust(PredRecordedWithKey); - PredLogUpdClause = PtoPredAdjust(PredLogUpdClause); - PredLogUpdClauseErase = PtoPredAdjust(PredLogUpdClauseErase); - PredLogUpdClause0 = PtoPredAdjust(PredLogUpdClause0); - PredStaticClause = PtoPredAdjust(PredStaticClause); - PredThrow = PtoPredAdjust(PredThrow); - PredHandleThrow = PtoPredAdjust(PredHandleThrow); - PredIs = PtoPredAdjust(PredIs); - PredSafeCallCleanup = PtoPredAdjust(PredSafeCallCleanup); - PredRestoreRegs = PtoPredAdjust(PredRestoreRegs); - PredCommentHook = PtoPredAdjust(PredCommentHook); -#ifdef YAPOR - PredGetwork = PtoPredAdjust(PredGetwork); - PredGetworkSeq = PtoPredAdjust(PredGetworkSeq); -#endif /* YAPOR */ - -#ifdef LOW_LEVEL_TRACER - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(Yap_low_level_trace_lock); -#endif -#endif - - - - - - - - - - - - - DUMMYCODE->opc = Yap_opcode(_op_fail); - FAILCODE->opc = Yap_opcode(_op_fail); - NOCODE->opc = Yap_opcode(_Nstop); - RestoreEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail); - - RestoreEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail); - - RestoreOtaplInst(RTRYCODE,_retry_and_mark,PredFail); -#ifdef BEAM - BEAM_RETRY_CODE->opc = Yap_opcode(_beam_retry_code); -#endif /* BEAM */ -#ifdef YAPOR - RestoreOtaplInst(GETWORK,_getwork,PredGetwork); - RestoreOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq); - GETWORK_FIRST_TIME->opc = Yap_opcode(_getwork_first_time); -#endif /* YAPOR */ -#ifdef TABLING - RestoreOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail); - RestoreOtaplInst(TRY_ANSWER,_table_try_answer,PredFail); - RestoreOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail); - RestoreOtaplInst(COMPLETION,_table_completion,PredFail); -#ifdef THREADS_CONSUMER_SHARING - RestoreOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail); -#endif /* THREADS_CONSUMER_SHARING */ -#endif /* TABLING */ - - - - - P_before_spy = PtoOpAdjust(P_before_spy); - - RETRY_C_RECORDEDP_CODE = PtoOpAdjust(RETRY_C_RECORDEDP_CODE); - RETRY_C_RECORDED_K_CODE = PtoOpAdjust(RETRY_C_RECORDED_K_CODE); - - - - - - - - - - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(DBTermsListLock); -#endif - RestoreDBTermsList(); - - - RestoreExpandList(); - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(ExpandClausesListLock); - REINIT_LOCK(OpListLock); -#endif - -#ifdef DEBUG - - - - -#endif - - - RestoreUdiControlBlocks(); - - - - - RestoreIntKeys(); - RestoreIntLUKeys(); - RestoreIntBBKeys(); - - - - - - - - RestoreDBErasedMarker(); - RestoreLogDBErasedMarker(); - - RestoreDeadStaticClauses(); - RestoreDeadMegaClauses(); - RestoreDeadStaticIndices(); - RestoreDBErasedList(); - RestoreDBErasedIList(); -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(DeadStaticClausesLock); - REINIT_LOCK(DeadMegaClausesLock); - REINIT_LOCK(DeadStaticIndicesLock); -#endif -#ifdef COROUTINING - - - - -#endif - - OpList = OpListAdjust(OpList); - - RestoreForeignCode(); - - - - - RestoreYapRecords(); - - RestoreSWIAtoms(); - - - - - - - - - RestoreEmptyWakeups(); - - - RestoreBlobTypes(); - RestoreBlobs(); - - -#if defined(YAPOR) || defined(THREADS) - REINIT_LOCK(Blobs_Lock); -#endif diff --git a/H/rlocals.h b/H/rlocals.h deleted file mode 100644 index 7eef90296..000000000 --- a/H/rlocals.h +++ /dev/null @@ -1,277 +0,0 @@ - - /* This file, rlocals.h, was generated automatically by "yap -L misc/buildlocalglobal" - please do not update, update misc/LOCALS instead */ - - -static void RestoreWorker(int wid USES_REGS) { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REMOTE_GlobalArena(wid) = TermToGlobalOrAtomAdjust(REMOTE_GlobalArena(wid)); - - - - - - - - - RestoreBallTerm(wid); - - - - - - - - - - -#ifdef COROUTINING - REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid)); - REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid)); -#endif - - REMOTE_GcGeneration(wid) = TermToGlobalAdjust(REMOTE_GcGeneration(wid)); - REMOTE_GcPhase(wid) = TermToGlobalAdjust(REMOTE_GcPhase(wid)); - - - - - - - - - - - - - - -#if defined(GC_NO_TAGS) - -#endif - - - - - - - - - - - - - - - - - - - - REMOTE_DynamicArrays(wid) = PtoArrayEAdjust(REMOTE_DynamicArrays(wid)); - REMOTE_StaticArrays(wid) = PtoArraySAdjust(REMOTE_StaticArrays(wid)); - REMOTE_GlobalVariables(wid) = PtoGlobalEAdjust(REMOTE_GlobalVariables(wid)); - - - - - - - - - - - -#ifdef THREADS - -#endif /* THREADS */ -#if defined(YAPOR) || defined(TABLING) - - -#endif /* YAPOR || TABLING */ - - -#if LOW_LEVEL_TRACER - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef ANALYST - - -#endif /* ANALYST */ - - - - - - - - - - - - - - - - - - - -#ifdef LOAD_DYLD - -#endif - -#ifdef LOW_LEVEL_TRACER - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if __ANDROID__ - - - -#endif - - - - - - - - - - - - - - - - - -} diff --git a/H/tatoms.h b/H/tatoms.h index 8a3eaa45f..acce48440 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -56,6 +56,9 @@ Atom AtomArrow_; #define AtomArrow Yap_heap_regs->AtomArrow_ #define TermArrow MkAtomTerm( Yap_heap_regs->AtomArrow_ ) + Atom AtomAttributedModule_; +#define AtomAttributedModule Yap_heap_regs->AtomAttributedModule_ +#define TermAttributedModule MkAtomTerm( Yap_heap_regs->AtomAttributedModule_ ) Atom AtomDoubleArrow_; #define AtomDoubleArrow Yap_heap_regs->AtomDoubleArrow_ #define TermDoubleArrow MkAtomTerm( Yap_heap_regs->AtomDoubleArrow_ ) @@ -1426,6 +1429,8 @@ #define FunctorPortray Yap_heap_regs->FunctorPortray_ Functor FunctorPrintMessage_; #define FunctorPrintMessage Yap_heap_regs->FunctorPrintMessage_ + Functor FunctorProcedure_; +#define FunctorProcedure Yap_heap_regs->FunctorProcedure_ Functor FunctorPrologConstraint_; #define FunctorPrologConstraint Yap_heap_regs->FunctorPrologConstraint_ Functor FunctorQuery_; diff --git a/OPTYap/CMakeLists.txt b/OPTYap/CMakeLists.txt index 549cf86a1..7574d279f 100644 --- a/OPTYap/CMakeLists.txt +++ b/OPTYap/CMakeLists.txt @@ -35,7 +35,8 @@ if (WITH_TABLING) #this macro should realy be in config.h or other like it #and it is used across several files outside OPTYap set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS TABLING=1) - include_directories (OPTYap) + include_directories (OPTYap ) + set(YAP_SYSTEM_OPTIONS "tabling " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) endif(WITH_TABLING) option (WITH_YAPOR "Experimental Support for Or-parallelism" OFF) @@ -43,33 +44,37 @@ option (WITH_YAPOR "Experimental Support for Or-parallelism" OFF) OPTION (WITH_YAPOR_COPY "Copy-based Or-parallelism" OFF) if (WITH_YAPOR_COPY) set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR_COPY=1;USE_DL_MALLOC=1) - set(WITH_YAPOR ON) -endif (WITH_YAPOR_COPY) + set(WITH_YAPOR ON) + set(YAP_SYSTEM_OPTIONS "or_parallelism " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) + endif (WITH_YAPOR_COPY) OPTION (WITH_YAPOR_THOR "Thread-based Or-parallelism" OFF) if (WITH_YAPOR_THOR) set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR_THREADS=1;USE_SYSTEM_MALLOC=1) - set(WITH_YAPOR ON) + set(WITH_YAPOR ON) + set(YAP_SYSTEM_OPTIONS "or_parallelism " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) endif (WITH_YAPOR_THOR) OPTION (WITH_YAPOR_ACOW "Process-based Copy-On-Write Or-parallelism" OFF) if (WITH_YAPOR_ACOW) set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR_COW=1;USE_SYSTEM_MALLOC=1) - set(WITH_YAPOR ON) + set(WITH_YAPOR ON) + set(YAP_SYSTEM_OPTIONS "or_parallelism " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) endif (WITH_YAPOR_ACOW) OPTION (WITH_YAPOR_SBA "Sparse Bind Array-based Or-parallelism" OFF) if (WITH_YAPOR_SBA) set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR_SBA=1;USE_SYSTEM_MALLOC=1) - set(WITH_YAPOR ON) + set(WITH_YAPOR ON) + set(YAP_SYSTEM_OPTIONS "or_parallelism, " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) endif (WITH_YAPOR_SBA) if (WITH_YAPOR) - set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR=1) + set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS YAPOR=1) else() - set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS USE_SYSTEM_MALLOC=1) + set_property(DIRECTORY .. APPEND PROPERTY COMPILE_DEFINITIONS USE_SYSTEM_MALLOC=1) endif () @@ -77,7 +82,8 @@ endif () set (POSITION_INDEPENDENT_CODE TRUE) add_library (libOPTYap OBJECT - ${OPTYap_SOURCES} ) + ${OPTYap_SOURCES} ) + set_target_properties(libOPTYap PROPERTIES diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index aee3ab6b3..f3d2d9842 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -24,7 +24,7 @@ #include #ifdef YAPOR #include "or.macros.h" -#endif /* YAPOR */ +#endif /* YAPOR */ #ifdef TABLING #include "tab.macros.h" #elif !defined(YAPOR_COW) @@ -34,43 +34,42 @@ #include "sys/wait.h" #endif /* YAPOR_COW */ - - /********************* ** Macros ** *********************/ #ifdef USE_PAGES_MALLOC -#define STRUCTS_PER_PAGE(STR_TYPE) ((Yap_page_size - ADJUST_SIZE(sizeof(struct page_header))) / ADJUST_SIZE(sizeof(STR_TYPE))) +#define STRUCTS_PER_PAGE(STR_TYPE) \ + ((Yap_page_size - ADJUST_SIZE(sizeof(struct page_header))) / \ + ADJUST_SIZE(sizeof(STR_TYPE))) -#define INIT_GLOBAL_PAGE_ENTRY(PG,STR_TYPE) \ - INIT_LOCK(PgEnt_lock(PG)); \ - PgEnt_pages_in_use(PG) = 0; \ - PgEnt_strs_in_use(PG) = 0; \ - PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \ - PgEnt_first(PG) = NULL; \ - PgEnt_last(PG) = NULL; -#define INIT_LOCAL_PAGE_ENTRY(PG,STR_TYPE) \ - PgEnt_pages_in_use(PG) = 0; \ - PgEnt_strs_in_use(PG) = 0; \ - PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \ - PgEnt_first(PG) = NULL; \ - PgEnt_last(PG) = NULL; +#define INIT_GLOBAL_PAGE_ENTRY(PG, STR_TYPE) \ + INIT_LOCK(PgEnt_lock(PG)); \ + PgEnt_pages_in_use(PG) = 0; \ + PgEnt_strs_in_use(PG) = 0; \ + PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \ + PgEnt_first(PG) = NULL; \ + PgEnt_last(PG) = NULL; +#define INIT_LOCAL_PAGE_ENTRY(PG, STR_TYPE) \ + PgEnt_pages_in_use(PG) = 0; \ + PgEnt_strs_in_use(PG) = 0; \ + PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \ + PgEnt_first(PG) = NULL; \ + PgEnt_last(PG) = NULL; #else -#define INIT_GLOBAL_PAGE_ENTRY(PG,STR_TYPE) PgEnt_strs_in_use(PG) = 0 -#define INIT_LOCAL_PAGE_ENTRY(PG,STR_TYPE) PgEnt_strs_in_use(PG) = 0 +#define INIT_GLOBAL_PAGE_ENTRY(PG, STR_TYPE) PgEnt_strs_in_use(PG) = 0 +#define INIT_LOCAL_PAGE_ENTRY(PG, STR_TYPE) PgEnt_strs_in_use(PG) = 0 #endif /* USE_PAGES_MALLOC */ - - /******************************* ** Global functions ** *******************************/ -void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop, int delay_load) { +void Yap_init_global_optyap_data(int max_table_size, int n_workers, + int sch_loop, int delay_load) { int i; - /* global data related to memory management */ +/* global data related to memory management */ #ifdef USE_PAGES_MALLOC INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_alloc, void *); INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_void, void *); @@ -94,29 +93,34 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop #endif /* TABLING */ #ifdef YAPOR INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_or_fr, struct or_frame); - INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_sol_fr, struct query_goal_solution_frame); - INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_ans_fr, struct query_goal_answer_frame); + INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_sol_fr, + struct query_goal_solution_frame); + INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_ans_fr, + struct query_goal_answer_frame); #ifdef TABLING INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_susp_fr, struct suspension_frame); #endif #ifdef TABLING_INNER_CUTS - INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_sol_fr, struct table_subgoal_solution_frame); - INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_ans_fr, struct table_subgoal_answer_frame); + INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_sol_fr, + struct table_subgoal_solution_frame); + INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_ans_fr, + struct table_subgoal_answer_frame); #endif #endif /* YAPOR */ #ifdef YAPOR /* global static data */ - GLOBAL_number_workers= n_workers; + GLOBAL_number_workers = n_workers; GLOBAL_worker_pid(0) = getpid(); - for (i = 1; i < GLOBAL_number_workers; i++) GLOBAL_worker_pid(i) = 0; + for (i = 1; i < GLOBAL_number_workers; i++) + GLOBAL_worker_pid(i) = 0; GLOBAL_scheduler_loop = sch_loop; GLOBAL_delayed_release_load = delay_load; /* global data related to or-parallelism */ ALLOC_OR_FRAME(GLOBAL_root_or_fr); BITMAP_clear(GLOBAL_bm_present_workers); - for (i = 0; i < GLOBAL_number_workers; i++) + for (i = 0; i < GLOBAL_number_workers; i++) BITMAP_insert(GLOBAL_bm_present_workers, i); BITMAP_copy(GLOBAL_bm_idle_workers, GLOBAL_bm_present_workers); BITMAP_clear(GLOBAL_bm_root_cp_workers); @@ -146,7 +150,8 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop GLOBAL_root_tab_ent = NULL; #ifdef LIMIT_TABLING if (max_table_size) - GLOBAL_max_pages = ((max_table_size - 1) * 1024 * 1024 / SHMMAX + 1) * SHMMAX / Yap_page_size; + GLOBAL_max_pages = ((max_table_size - 1) * 1024 * 1024 / SHMMAX + 1) * + SHMMAX / Yap_page_size; else GLOBAL_max_pages = -1; GLOBAL_first_sg_fr = NULL; @@ -154,7 +159,8 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop GLOBAL_check_sg_fr = NULL; #endif /* LIMIT_TABLING */ #ifdef YAPOR - new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, FALSE, NULL); + new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, FALSE, + NULL); #endif /* YAPOR */ for (i = 0; i < MAX_TABLE_VARS; i++) { CELL *pt = GLOBAL_table_var_enumerator_addr(i); @@ -169,14 +175,13 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop return; } - void Yap_init_local_optyap_data(int wid) { #if defined(YAPOR_THREADS) || defined(THREADS_CONSUMER_SHARING) CACHE_REGS #endif /* YAPOR_THREADS || THREADS_CONSUMER_SHARING */ #if defined(TABLING) && (defined(YAPOR) || defined(THREADS)) - /* local data related to memory management */ +/* local data related to memory management */ #ifdef YAPOR REMOTE_next_free_ans_node(wid) = NULL; #elif THREADS @@ -203,7 +208,7 @@ void Yap_init_local_optyap_data(int wid) { #ifdef YAPOR /* local data related to or-parallelism */ - Set_REMOTE_top_cp(wid, (choiceptr) LOCAL_LocalBase); + Set_REMOTE_top_cp(wid, (choiceptr)LOCAL_LocalBase); REMOTE_top_or_fr(wid) = GLOBAL_root_or_fr; REMOTE_load(wid) = 0; REMOTE_share_request(wid) = MAX_WORKERS; @@ -217,11 +222,11 @@ void Yap_init_local_optyap_data(int wid) { #ifdef TABLING /* local data related to tabling */ - REMOTE_top_sg_fr(wid) = NULL; - REMOTE_top_dep_fr(wid) = NULL; + REMOTE_top_sg_fr(wid) = NULL; + REMOTE_top_dep_fr(wid) = NULL; #ifdef YAPOR - REMOTE_top_dep_fr(wid) = GLOBAL_root_dep_fr; - Set_REMOTE_top_cp_on_stack(wid, (choiceptr) LOCAL_LocalBase); /* ??? */ + REMOTE_top_dep_fr(wid) = GLOBAL_root_dep_fr; + Set_REMOTE_top_cp_on_stack(wid, (choiceptr)LOCAL_LocalBase); /* ??? */ REMOTE_top_susp_or_fr(wid) = GLOBAL_root_or_fr; #endif /* YAPOR */ #ifdef THREADS_CONSUMER_SHARING @@ -234,7 +239,6 @@ void Yap_init_local_optyap_data(int wid) { return; } - void Yap_init_root_frames(void) { CACHE_REGS @@ -244,7 +248,7 @@ void Yap_init_root_frames(void) { INIT_LOCK(OrFr_lock(or_fr)); OrFr_alternative(or_fr) = NULL; BITMAP_copy(OrFr_members(or_fr), GLOBAL_bm_present_workers); - SetOrFr_node(or_fr, (choiceptr) LOCAL_LocalBase); + SetOrFr_node(or_fr, (choiceptr)LOCAL_LocalBase); OrFr_nearest_livenode(or_fr) = NULL; OrFr_depth(or_fr) = 0; Set_OrFr_pend_prune_cp(or_fr, NULL); @@ -265,23 +269,26 @@ void Yap_init_root_frames(void) { #ifdef TABLING /* root global trie node */ new_global_trie_node(GLOBAL_root_gt, 0, NULL, NULL, NULL); - /* root dependency frame */ +/* root dependency frame */ #ifdef YAPOR - DepFr_cons_cp(GLOBAL_root_dep_fr) = B; /* with YAPOR, at that point, LOCAL_top_dep_fr shouldn't be the same as GLOBAL_root_dep_fr ? */ + DepFr_cons_cp(GLOBAL_root_dep_fr) = B; /* with YAPOR, at that point, + LOCAL_top_dep_fr shouldn't be the + same as GLOBAL_root_dep_fr ? */ #else - new_dependency_frame(LOCAL_top_dep_fr, FALSE, NULL, NULL, B, NULL, FALSE, NULL); + new_dependency_frame(LOCAL_top_dep_fr, FALSE, NULL, NULL, B, NULL, FALSE, + NULL); #endif /* YAPOR */ #endif /* TABLING */ } - void itos(int i, char *s) { - int n,r,j; + int n, r, j; n = 10; - while (n <= i) n *= 10; + while (n <= i) + n *= 10; j = 0; while (n > 1) { - n = n / 10; + n = n / 10; r = i / n; i = i - r * n; s[j++] = r + '0'; diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index a024de42a..ffb243a65 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -34,36 +34,36 @@ #include "iopreds.h" #ifdef TABLING -static Int p_freeze_choice_point( USES_REGS1 ); -static Int p_wake_choice_point( USES_REGS1 ); -static Int p_abolish_frozen_choice_points_until( USES_REGS1 ); -static Int p_abolish_frozen_choice_points_all( USES_REGS1 ); -static Int p_table( USES_REGS1 ); -static Int p_tabling_mode( USES_REGS1 ); -static Int p_abolish_table( USES_REGS1 ); -static Int p_abolish_all_tables( USES_REGS1 ); -static Int p_show_tabled_predicates( USES_REGS1 ); -static Int p_show_table( USES_REGS1 ); -static Int p_show_all_tables( USES_REGS1 ); -static Int p_show_global_trie( USES_REGS1 ); -static Int p_show_statistics_table( USES_REGS1 ); -static Int p_show_statistics_tabling( USES_REGS1 ); -static Int p_show_statistics_global_trie( USES_REGS1 ); +static Int p_freeze_choice_point(USES_REGS1); +static Int p_wake_choice_point(USES_REGS1); +static Int p_abolish_frozen_choice_points_until(USES_REGS1); +static Int p_abolish_frozen_choice_points_all(USES_REGS1); +static Int p_table(USES_REGS1); +static Int p_tabling_mode(USES_REGS1); +static Int p_abolish_table(USES_REGS1); +static Int p_abolish_all_tables(USES_REGS1); +static Int p_show_tabled_predicates(USES_REGS1); +static Int p_show_table(USES_REGS1); +static Int p_show_all_tables(USES_REGS1); +static Int p_show_global_trie(USES_REGS1); +static Int p_show_statistics_table(USES_REGS1); +static Int p_show_statistics_tabling(USES_REGS1); +static Int p_show_statistics_global_trie(USES_REGS1); #endif /* TABLING */ -static Int p_yapor_workers( USES_REGS1 ); +static Int p_yapor_workers(USES_REGS1); #ifdef YAPOR -static Int p_parallel_mode( USES_REGS1 ); -static Int p_yapor_start( USES_REGS1 ); -static Int p_worker( USES_REGS1 ); -static Int p_parallel_new_answer( USES_REGS1 ); -static Int p_parallel_get_answers( USES_REGS1 ); -static Int p_show_statistics_or( USES_REGS1 ); +static Int p_parallel_mode(USES_REGS1); +static Int p_yapor_start(USES_REGS1); +static Int p_worker(USES_REGS1); +static Int p_parallel_new_answer(USES_REGS1); +static Int p_parallel_get_answers(USES_REGS1); +static Int p_show_statistics_or(USES_REGS1); #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) -static Int p_show_statistics_opt( USES_REGS1 ); +static Int p_show_statistics_opt(USES_REGS1); #endif /* YAPOR && TABLING */ -static Int p_get_optyap_statistics( USES_REGS1 ); +static Int p_get_optyap_statistics(USES_REGS1); #ifdef YAPOR static inline realtime current_time(void); @@ -75,171 +75,210 @@ static inline struct page_statistics show_statistics_table_entries(FILE *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(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); +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(FILE *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(FILE *out); -static inline struct page_statistics show_statistics_global_trie_hashes(FILE *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(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); +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(FILE *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(FILE *out); -static inline struct page_statistics show_statistics_table_subgoal_answer_frames(FILE *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 */ - - /************************************ ** Macros & Declarations ** ************************************/ struct page_statistics { #ifdef USE_PAGES_MALLOC - long pages_in_use; /* same as struct pages (opt.structs.h) */ -#endif /* USE_PAGES_MALLOC */ - long structs_in_use; /* same as struct pages (opt.structs.h) */ + long pages_in_use; /* same as struct pages (opt.structs.h) */ +#endif /* USE_PAGES_MALLOC */ + long structs_in_use; /* same as struct pages (opt.structs.h) */ long bytes_in_use; }; -#define PgEnt_bytes_in_use(STATS) STATS.bytes_in_use +#define PgEnt_bytes_in_use(STATS) STATS.bytes_in_use #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING -#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) \ - { pg_hd_ptr pg_hd; \ - STR_TYPE *aux_ptr; \ - long cont = 0; \ - pg_hd = PgEnt_first(PAGE); \ - while (pg_hd) { \ - aux_ptr = PgHd_first_str(pg_hd); \ - while (aux_ptr) { \ - cont++; \ - aux_ptr = aux_ptr->next; \ - } \ - pg_hd = PgHd_next(pg_hd); \ - } \ - TABLING_ERROR_CHECKING(CHECK_PAGE_FREE_STRUCTS, PgEnt_strs_free(PAGE) != cont); \ - } +#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) \ + { \ + pg_hd_ptr pg_hd; \ + STR_TYPE *aux_ptr; \ + long cont = 0; \ + pg_hd = PgEnt_first(PAGE); \ + while (pg_hd) { \ + aux_ptr = PgHd_first_str(pg_hd); \ + while (aux_ptr) { \ + cont++; \ + aux_ptr = aux_ptr->next; \ + } \ + pg_hd = PgHd_next(pg_hd); \ + } \ + TABLING_ERROR_CHECKING(CHECK_PAGE_FREE_STRUCTS, \ + PgEnt_strs_free(PAGE) != cont); \ + } #else #define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) #endif /* DEBUG_TABLING */ -#define INIT_PAGE_STATS(STATS) \ - PgEnt_pages_in_use(STATS) = 0; \ - PgEnt_strs_in_use(STATS) = 0 -#define INCREMENT_PAGE_STATS(STATS, PAGE) \ - PgEnt_pages_in_use(STATS) += PgEnt_pages_in_use(PAGE); \ - PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE) -#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \ - BYTES += PgEnt_bytes_in_use(STATS); \ - PAGES += PgEnt_pages_in_use(STATS) -#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld pages and %ld structs in use)\n" -#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_pages_in_use(STATS), PgEnt_strs_in_use(STATS) +#define INIT_PAGE_STATS(STATS) \ + PgEnt_pages_in_use(STATS) = 0; \ + PgEnt_strs_in_use(STATS) = 0 +#define INCREMENT_PAGE_STATS(STATS, PAGE) \ + PgEnt_pages_in_use(STATS) += PgEnt_pages_in_use(PAGE); \ + PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE) +#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \ + BYTES += PgEnt_bytes_in_use(STATS); \ + PAGES += PgEnt_pages_in_use(STATS) +#define SHOW_PAGE_STATS_MSG(STR_NAME) \ + " " STR_NAME " %10ld bytes (%ld pages and %ld structs in use)\n" +#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) \ + PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_pages_in_use(STATS), \ + PgEnt_strs_in_use(STATS) #else /* !USE_PAGES_MALLOC */ #define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) -#define INIT_PAGE_STATS(STATS) \ - PgEnt_strs_in_use(STATS) = 0 -#define INCREMENT_PAGE_STATS(STATS, PAGE) \ - PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE) -#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \ - BYTES += PgEnt_bytes_in_use(STATS) -#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld structs in use)\n" -#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_strs_in_use(STATS) +#define INIT_PAGE_STATS(STATS) PgEnt_strs_in_use(STATS) = 0 +#define INCREMENT_PAGE_STATS(STATS, PAGE) \ + PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE) +#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \ + BYTES += PgEnt_bytes_in_use(STATS) +#define SHOW_PAGE_STATS_MSG(STR_NAME) \ + " " STR_NAME " %10ld bytes (%ld structs in use)\n" +#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) \ + PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_strs_in_use(STATS) #endif /* USE_PAGES_MALLOC */ - #if defined(THREADS) && defined(TABLING) -#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ - LOCK(GLOBAL_ThreadHandlesLock); \ - CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \ - INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES); \ - { int wid; \ - for (wid = 0; wid < MAX_THREADS; wid++) { \ - if (! Yap_local[wid]) \ - break; \ - if (REMOTE_ThreadHandle(wid).in_use) { \ - CHECK_PAGE_FREE_STRUCTS(STR_TYPE, REMOTE##_PAGES(wid)); \ - INCREMENT_PAGE_STATS(STATS, REMOTE##_PAGES(wid)); \ - } \ - } \ - } \ - UNLOCK(GLOBAL_ThreadHandlesLock) +#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ + LOCK(GLOBAL_ThreadHandlesLock); \ + CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \ + INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES); \ + { \ + int wid; \ + for (wid = 0; wid < MAX_THREADS; wid++) { \ + if (!Yap_local[wid]) \ + break; \ + if (REMOTE_ThreadHandle(wid).in_use) { \ + CHECK_PAGE_FREE_STRUCTS(STR_TYPE, REMOTE##_PAGES(wid)); \ + INCREMENT_PAGE_STATS(STATS, REMOTE##_PAGES(wid)); \ + } \ + } \ + } \ + UNLOCK(GLOBAL_ThreadHandlesLock) #else -#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ - CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \ - INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES) +#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ + CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \ + INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES) #endif -#define GET_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ - INIT_PAGE_STATS(STATS); \ - GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES); \ - PgEnt_bytes_in_use(STATS) = PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE) -#define SHOW_PAGE_STATS(OUT_STREAM, STR_TYPE, _PAGES, STR_NAME) \ - { struct page_statistics stats; \ - GET_PAGE_STATS(stats, STR_TYPE, _PAGES); \ - fprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \ - return stats; \ - } - - +#define GET_PAGE_STATS(STATS, STR_TYPE, _PAGES) \ + INIT_PAGE_STATS(STATS); \ + GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES); \ + PgEnt_bytes_in_use(STATS) = PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE) +#define SHOW_PAGE_STATS(OUT_STREAM, STR_TYPE, _PAGES, STR_NAME) \ + { \ + struct page_statistics stats; \ + GET_PAGE_STATS(stats, STR_TYPE, _PAGES); \ + fprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), \ + SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \ + return stats; \ + } /******************************* ** Global functions ** *******************************/ void Yap_init_optyap_preds(void) { - Yap_InitCPred("$c_yapor_workers", 1, p_yapor_workers, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$c_yapor_workers", 1, p_yapor_workers, + SafePredFlag | SyncPredFlag); #ifdef TABLING - Yap_InitCPred("freeze_choice_point", 1, p_freeze_choice_point, SafePredFlag|SyncPredFlag); - Yap_InitCPred("wake_choice_point", 1, p_wake_choice_point, SafePredFlag|SyncPredFlag); - Yap_InitCPred("abolish_frozen_choice_points", 1, p_abolish_frozen_choice_points_until, SafePredFlag|SyncPredFlag); - Yap_InitCPred("abolish_frozen_choice_points", 0, p_abolish_frozen_choice_points_all, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_table", 3, p_table, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_tabling_mode", 3, p_tabling_mode, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_abolish_table", 2, p_abolish_table, SafePredFlag|SyncPredFlag); - Yap_InitCPred("abolish_all_tables", 0, p_abolish_all_tables, SafePredFlag|SyncPredFlag); -/** @pred abolish_all_tables/0 + Yap_InitCPred("freeze_choice_point", 1, p_freeze_choice_point, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("wake_choice_point", 1, p_wake_choice_point, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("abolish_frozen_choice_points", 1, + p_abolish_frozen_choice_points_until, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("abolish_frozen_choice_points", 0, + p_abolish_frozen_choice_points_all, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_table", 3, p_table, SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_tabling_mode", 3, p_tabling_mode, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_abolish_table", 2, p_abolish_table, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("abolish_all_tables", 0, p_abolish_all_tables, + SafePredFlag | SyncPredFlag); + /** @pred abolish_all_tables/0 -Removes all the entries from the table space for all tabled -predicates. The predicates remain as tabled predicates. + Removes all the entries from the table space for all tabled + predicates. The predicates remain as tabled predicates. - -*/ - Yap_InitCPred("show_tabled_predicates", 1, p_show_tabled_predicates, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_show_table", 3, p_show_table, SafePredFlag|SyncPredFlag); - Yap_InitCPred("show_all_tables", 1, p_show_all_tables, SafePredFlag|SyncPredFlag); - Yap_InitCPred("show_global_trie", 1, p_show_global_trie, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_table_statistics", 3, p_show_statistics_table, SafePredFlag|SyncPredFlag); - Yap_InitCPred("tabling_statistics", 1, p_show_statistics_tabling, SafePredFlag|SyncPredFlag); - Yap_InitCPred("global_trie_statistics", 1, p_show_statistics_global_trie, SafePredFlag|SyncPredFlag); + + */ + Yap_InitCPred("show_tabled_predicates", 1, p_show_tabled_predicates, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_show_table", 3, p_show_table, SafePredFlag | SyncPredFlag); + Yap_InitCPred("show_all_tables", 1, p_show_all_tables, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("show_global_trie", 1, p_show_global_trie, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_table_statistics", 3, p_show_statistics_table, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("tabling_statistics", 1, p_show_statistics_tabling, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("global_trie_statistics", 1, p_show_statistics_global_trie, + SafePredFlag | SyncPredFlag); #endif /* TABLING */ #ifdef YAPOR - Yap_InitCPred("parallel_mode", 1, p_parallel_mode, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_yapor_start", 0, p_yapor_start, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_worker", 0, p_worker, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_parallel_get_answers", 1, p_parallel_get_answers, SafePredFlag|SyncPredFlag); - Yap_InitCPred("or_statistics", 1, p_show_statistics_or, SafePredFlag|SyncPredFlag); + Yap_InitCPred("parallel_mode", 1, p_parallel_mode, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_yapor_start", 0, p_yapor_start, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_worker", 0, p_worker, SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_parallel_new_answer", 1, p_parallel_new_answer, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$c_parallel_get_answers", 1, p_parallel_get_answers, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("or_statistics", 1, p_show_statistics_or, + SafePredFlag | SyncPredFlag); #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) - Yap_InitCPred("opt_statistics", 1, p_show_statistics_opt, SafePredFlag|SyncPredFlag); + Yap_InitCPred("opt_statistics", 1, p_show_statistics_opt, + SafePredFlag | SyncPredFlag); #endif /* YAPOR && TABLING */ - Yap_InitCPred("$c_get_optyap_statistics", 3, p_get_optyap_statistics, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$c_get_optyap_statistics", 3, p_get_optyap_statistics, + SafePredFlag | SyncPredFlag); } - #ifdef YAPOR void finish_yapor(void) { GLOBAL_execution_time = current_time() - GLOBAL_execution_time; @@ -248,14 +287,12 @@ void finish_yapor(void) { } #endif /* YAPOR */ - - /*********************************** ** Tabling C Predicates ** ***********************************/ #ifdef TABLING -static Int p_freeze_choice_point( USES_REGS1 ) { +static Int p_freeze_choice_point(USES_REGS1) { if (IsVarTerm(Deref(ARG1))) { Int offset = freeze_current_cp(); return Yap_unify(ARG1, MkIntegerTerm(offset)); @@ -263,39 +300,35 @@ static Int p_freeze_choice_point( USES_REGS1 ) { return (FALSE); } - -static Int p_wake_choice_point( USES_REGS1 ) { +static Int p_wake_choice_point(USES_REGS1) { Term term_offset = Deref(ARG1); if (IsIntegerTerm(term_offset)) wake_frozen_cp(IntegerOfTerm(term_offset)); return (FALSE); } - -static Int p_abolish_frozen_choice_points_until( USES_REGS1 ) { +static Int p_abolish_frozen_choice_points_until(USES_REGS1) { Term term_offset = Deref(ARG1); if (IsIntegerTerm(term_offset)) abolish_frozen_cps_until(IntegerOfTerm(term_offset)); return (TRUE); } - -static Int p_abolish_frozen_choice_points_all( USES_REGS1 ) { +static Int p_abolish_frozen_choice_points_all(USES_REGS1) { abolish_frozen_cps_all(); return (TRUE); } - -static Int p_table( USES_REGS1 ) { +static Int p_table(USES_REGS1) { Term mod, t, list; PredEntry *pe; Atom at; int arity; tab_ent_ptr tab_ent; #ifdef MODE_DIRECTED_TABLING - int* mode_directed = NULL; + int *mode_directed = NULL; #endif /* MODE_DIRECTED_TABLING */ - + mod = Deref(ARG1); t = Deref(ARG2); list = Deref(ARG3); @@ -310,15 +343,19 @@ static Int p_table( USES_REGS1 ) { arity = ArityOfFunctor(FunctorOfTerm(t)); } else return (FALSE); - if (list != TermNil) { /* non-empty list */ + if (list != TermNil) { /* non-empty list */ #ifndef MODE_DIRECTED_TABLING - Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity); - return(FALSE); -#else + Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, "invalid tabling declaration for " + "%s/%d (mode directed tabling " + "not enabled)", + AtomName(at), arity); + return (FALSE); +#else /************************************************************************************* The mode operator declaration is reordered as follows: 1. arguments with mode 'index' (any number) - 2. arguments with mode 'min' and 'max' (any number, following the original order) + 2. arguments with mode 'min' and 'max' (any number, following the + original order) 3. arguments with mode 'all' (any number) 4. arguments with mode 'sum' or 'last' (only one of the two is allowed) 5. arguments with mode 'first' (any number) @@ -343,8 +380,11 @@ static Int p_table( USES_REGS1 ) { else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) { if (pos_sum_last) { free(aux_mode_directed); - Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity); - return(FALSE); + Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, + "invalid tabling declaration for %s/%d (more than one " + "argument with modes 'sum' and/or 'last')", + AtomName(at), arity); + return (FALSE); } else pos_sum_last = 1; } @@ -360,14 +400,16 @@ static Int p_table( USES_REGS1 ) { for (i = 0; i < arity; i++) { int aux_pos = 0; if (aux_mode_directed[i] == MODE_DIRECTED_INDEX) - aux_pos = pos_index++; - else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX) + aux_pos = pos_index++; + else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || + aux_mode_directed[i] == MODE_DIRECTED_MAX) aux_pos = pos_min_max++; else if (aux_mode_directed[i] == MODE_DIRECTED_ALL) - aux_pos = pos_all++; - else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST) - aux_pos = pos_sum_last++; - else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST) + aux_pos = pos_all++; + else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || + aux_mode_directed[i] == MODE_DIRECTED_LAST) + aux_pos = pos_sum_last++; + else if (aux_mode_directed[i] == MODE_DIRECTED_FIRST) aux_pos = pos_first++; mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]); } @@ -375,19 +417,18 @@ static Int p_table( USES_REGS1 ) { #endif /* MODE_DIRECTED_TABLING */ } if (pe->PredFlags & TabledPredFlag) - return (TRUE); /* predicate already tabled */ + return (TRUE); /* predicate already tabled */ if (pe->cs.p_code.FirstClause) - return (FALSE); /* predicate already compiled */ + return (FALSE); /* predicate already compiled */ if (!(pe->PredFlags & TabledPredFlag)) { - pe->PredFlags |= TabledPredFlag; - new_table_entry(tab_ent, pe, at, arity, mode_directed); - pe->TableOfPred = tab_ent; - } + pe->PredFlags |= TabledPredFlag; + new_table_entry(tab_ent, pe, at, arity, mode_directed); + pe->TableOfPred = tab_ent; + } return (TRUE); } - -static Int p_tabling_mode( USES_REGS1 ) { +static Int p_tabling_mode(USES_REGS1) { Term mod, t, tvalue; tab_ent_ptr tab_ent; @@ -430,56 +471,56 @@ static Int p_tabling_mode( USES_REGS1 ) { t = MkPairTerm(MkAtomTerm(AtomBatched), t); else if (IsMode_Local(TabEnt_mode(tab_ent))) t = MkPairTerm(MkAtomTerm(AtomLocal), t); - YapBind((CELL *) tvalue, t); - return(TRUE); + YapBind((CELL *)tvalue, t); + return (TRUE); } else if (IsIntTerm(tvalue)) { Int value = IntOfTerm(tvalue); - if (value == 1) { /* batched */ + if (value == 1) { /* batched */ SetMode_Batched(TabEnt_flags(tab_ent)); - if (! IsMode_Local(LOCAL_TabMode)) { + if (!IsMode_Local(LOCAL_TabMode)) { SetMode_Batched(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 2) { /* local */ + } else if (value == 2) { /* local */ SetMode_Local(TabEnt_flags(tab_ent)); - if (! IsMode_Batched(LOCAL_TabMode)) { + if (!IsMode_Batched(LOCAL_TabMode)) { SetMode_Local(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 3) { /* exec_answers */ + } else if (value == 3) { /* exec_answers */ SetMode_ExecAnswers(TabEnt_flags(tab_ent)); - if (! IsMode_LoadAnswers(LOCAL_TabMode)) { + if (!IsMode_LoadAnswers(LOCAL_TabMode)) { SetMode_ExecAnswers(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 4) { /* load_answers */ + } else if (value == 4) { /* load_answers */ SetMode_LoadAnswers(TabEnt_flags(tab_ent)); - if (! IsMode_ExecAnswers(LOCAL_TabMode)) { + if (!IsMode_ExecAnswers(LOCAL_TabMode)) { SetMode_LoadAnswers(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 5) { /* local_trie */ + } else if (value == 5) { /* local_trie */ SetMode_LocalTrie(TabEnt_flags(tab_ent)); - if (! IsMode_GlobalTrie(LOCAL_TabMode)) { + if (!IsMode_GlobalTrie(LOCAL_TabMode)) { SetMode_LocalTrie(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 6) { /* global_trie */ + } else if (value == 6) { /* global_trie */ SetMode_GlobalTrie(TabEnt_flags(tab_ent)); - if (! IsMode_LocalTrie(LOCAL_TabMode)) { + if (!IsMode_LocalTrie(LOCAL_TabMode)) { SetMode_GlobalTrie(TabEnt_mode(tab_ent)); - return(TRUE); + return (TRUE); } - } else if (value == 7) { /* coinductive */ //only affect the predicate flag. Also it cant be unset + } else if (value == 7) { + /* coinductive */ // only affect the predicate flag. Also it cant be unset SetMode_CoInductive(TabEnt_flags(tab_ent)); - return(TRUE); + return (TRUE); } } return (FALSE); } - -static Int p_abolish_table( USES_REGS1 ) { +static Int p_abolish_table(USES_REGS1) { Term mod, t; tab_ent_ptr tab_ent; @@ -495,8 +536,7 @@ static Int p_abolish_table( USES_REGS1 ) { return (TRUE); } - -static Int p_abolish_all_tables( USES_REGS1 ) { +static Int p_abolish_all_tables(USES_REGS1) { tab_ent_ptr tab_ent; tab_ent = GLOBAL_root_tab_ent; @@ -507,8 +547,7 @@ static Int p_abolish_all_tables( USES_REGS1 ) { return (TRUE); } - -static Int p_show_tabled_predicates( USES_REGS1 ) { +static Int p_show_tabled_predicates(USES_REGS1) { FILE *out; tab_ent_ptr tab_ent; Term t = Deref(ARG1); @@ -521,16 +560,17 @@ static Int p_show_tabled_predicates( USES_REGS1 ) { fprintf(out, "Tabled predicates\n"); if (tab_ent == NULL) fprintf(out, " NONE\n"); - else while(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); + else + while (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); return (TRUE); } - -static Int p_show_table( USES_REGS1 ) { +static Int p_show_table(USES_REGS1) { Term mod, t; tab_ent_ptr tab_ent; Term t1 = Deref(ARG1); @@ -553,8 +593,7 @@ static Int p_show_table( USES_REGS1 ) { return (TRUE); } - -static Int p_show_all_tables( USES_REGS1 ) { +static Int p_show_all_tables(USES_REGS1) { tab_ent_ptr tab_ent; Term t = Deref(ARG1); FILE *out; @@ -564,19 +603,18 @@ static Int p_show_all_tables( USES_REGS1 ) { if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; tab_ent = GLOBAL_root_tab_ent; - while(tab_ent) { + while (tab_ent) { showTable(tab_ent, SHOW_MODE_STRUCTURE, out); tab_ent = TabEnt_next(tab_ent); } return (TRUE); } - -static Int p_show_global_trie( USES_REGS1 ) { +static Int p_show_global_trie(USES_REGS1) { Term t = Deref(ARG1); FILE *out; - if (!IsStreamTerm(t)) + if (!IsStreamTerm(t)) return FALSE; if (!(out = Yap_GetStreamHandle(t)->file)) return FALSE; @@ -584,33 +622,31 @@ static Int p_show_global_trie( USES_REGS1 ) { return (TRUE); } - -static Int p_show_statistics_table( USES_REGS1 ) { +static Int p_show_statistics_table(USES_REGS1) { Term mod, t; tab_ent_ptr tab_ent; Term t1 = Deref(ARG1); FILE *out; - if (!IsStreamTerm(t1)) + if (!IsStreamTerm(t1)) return FALSE; 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); } showTable(tab_ent, SHOW_MODE_STATISTICS, out); return (TRUE); } - -static Int p_show_statistics_tabling( USES_REGS1 ) { +static Int p_show_statistics_tabling(USES_REGS1) { struct page_statistics stats; long bytes, total_bytes = 0; #ifdef USE_PAGES_MALLOC @@ -662,19 +698,22 @@ static Int p_show_statistics_tabling( USES_REGS1 ) { fprintf(out, " Memory in use (III): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - fprintf(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); - 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 + 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 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 ) { +static Int p_show_statistics_global_trie(USES_REGS1) { Term t = Deref(ARG1); FILE *out; @@ -687,45 +726,42 @@ static Int p_show_statistics_global_trie( USES_REGS1 ) { } #endif /* TABLING */ - - /********************************* ** YapOr C Predicates ** *********************************/ #ifdef YAPOR -static Int p_parallel_mode( USES_REGS1 ) { +static Int p_parallel_mode(USES_REGS1) { Term t; t = Deref(ARG1); if (IsVarTerm(t)) { Term ta; - if (GLOBAL_parallel_mode == PARALLEL_MODE_OFF) + if (GLOBAL_parallel_mode == PARALLEL_MODE_OFF) ta = MkAtomTerm(Yap_LookupAtom("off")); - else if (GLOBAL_parallel_mode == PARALLEL_MODE_ON) + else if (GLOBAL_parallel_mode == PARALLEL_MODE_ON) ta = MkAtomTerm(Yap_LookupAtom("on")); else /* PARALLEL_MODE_RUNNING */ ta = MkAtomTerm(Yap_LookupAtom("running")); YapBind((CELL *)t, ta); - return(TRUE); + return (TRUE); } if (IsAtomTerm(t) && GLOBAL_parallel_mode != PARALLEL_MODE_RUNNING) { char *s; s = RepAtom(AtomOfTerm(t))->StrOfAE; - if (strcmp(s,"on") == 0) { + if (strcmp(s, "on") == 0) { GLOBAL_parallel_mode = PARALLEL_MODE_ON; - return(TRUE); + return (TRUE); } - if (strcmp(s,"off") == 0) { + if (strcmp(s, "off") == 0) { GLOBAL_parallel_mode = PARALLEL_MODE_OFF; - return(TRUE); + return (TRUE); } - return(FALSE); /* PARALLEL_MODE_RUNNING */ + return (FALSE); /* PARALLEL_MODE_RUNNING */ } - return(FALSE); + return (FALSE); } - -static Int p_yapor_start( USES_REGS1 ) { +static Int p_yapor_start(USES_REGS1) { #ifdef TIMESTAMP_CHECK GLOBAL_timestamp = 0; #endif /* TIMESTAMP_CHECK */ @@ -742,24 +778,21 @@ static Int p_yapor_start( USES_REGS1 ) { return (TRUE); } - -static Int p_yapor_workers( USES_REGS1 ) { +static Int p_yapor_workers(USES_REGS1) { #ifdef YAPOR_THREADS - return Yap_unify(MkIntegerTerm(GLOBAL_number_workers),ARG1); + return Yap_unify(MkIntegerTerm(GLOBAL_number_workers), ARG1); #else return FALSE; #endif /* YAPOR_THREADS */ } - -static Int p_worker( USES_REGS1 ) { +static Int p_worker(USES_REGS1) { CurrentModule = USER_MODULE; P = GETWORK_FIRST_TIME; return TRUE; } - -static Int p_parallel_new_answer( USES_REGS1 ) { +static Int p_parallel_new_answer(USES_REGS1) { qg_ans_fr_ptr actual_answer; or_fr_ptr leftmost_or_fr; @@ -778,8 +811,7 @@ static Int p_parallel_new_answer( USES_REGS1 ) { return (TRUE); } - -static Int p_parallel_get_answers( USES_REGS1 ){ +static Int p_parallel_get_answers(USES_REGS1) { Term t = TermNil; if (OrFr_qg_solutions(LOCAL_top_or_fr)) { @@ -798,8 +830,7 @@ static Int p_parallel_get_answers( USES_REGS1 ){ return (TRUE); } - -static Int p_show_statistics_or( USES_REGS1 ) { +static Int p_show_statistics_or(USES_REGS1) { struct page_statistics stats; long bytes, total_bytes = 0; #ifdef USE_PAGES_MALLOC @@ -809,7 +840,8 @@ static Int p_show_statistics_or( USES_REGS1 ) { if (!IsStreamTerm(t)) return FALSE; -\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ bytes = 0; + \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ bytes = + 0; fprintf(out, "Execution data structures\n"); stats = show_statistics_or_frames(out); INCREMENT_AUX_STATS(stats, bytes, total_pages); @@ -824,11 +856,15 @@ static Int p_show_statistics_or( USES_REGS1 ) { fprintf(out, " Memory in use (II): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - fprintf(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); - 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 + 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 fprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ PL_release_stream(out); @@ -837,19 +873,15 @@ static Int p_show_statistics_or( USES_REGS1 ) { #else -static Int p_yapor_workers( USES_REGS1 ) { - return FALSE; -} +static Int p_yapor_workers(USES_REGS1) { return FALSE; } #endif /* YAPOR */ - - /********************************** ** OPTYap C Predicates ** **********************************/ #if defined(YAPOR) && defined(TABLING) -static Int p_show_statistics_opt( USES_REGS1 ) { +static Int p_show_statistics_opt(USES_REGS1) { struct page_statistics stats; long bytes, total_bytes = 0; #ifdef USE_PAGES_MALLOC @@ -919,11 +951,15 @@ static Int p_show_statistics_opt( USES_REGS1 ) { fprintf(out, " Memory in use (IV): %10ld bytes\n\n", bytes); total_bytes += bytes; #ifdef USE_PAGES_MALLOC - fprintf(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); - 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 + 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 fprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ PL_release_stream(out); @@ -931,112 +967,129 @@ static Int p_show_statistics_opt( USES_REGS1 ) { } #endif /* YAPOR && TABLING */ - -static Int p_get_optyap_statistics( USES_REGS1 ) { +static Int p_get_optyap_statistics(USES_REGS1) { struct page_statistics stats; Int value, bytes = 0, structs = -1; Term tbytes, tstructs; value = IntOfTerm(Deref(ARG1)); #ifdef TABLING - if (value == 0 || value == 1) { /* table_entries */ + if (value == 0 || value == 1) { /* table_entries */ GET_PAGE_STATS(stats, struct table_entry, _pages_tab_ent); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) - if (value == 0 || value == 16) { /* subgoal_entries */ + if (value == 0 || value == 16) { /* subgoal_entries */ GET_PAGE_STATS(stats, struct subgoal_entry, _pages_sg_ent); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #endif - if (value == 0 || value == 2) { /* subgoal_frames */ + if (value == 0 || value == 2) { /* subgoal_frames */ GET_PAGE_STATS(stats, struct subgoal_frame, _pages_sg_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 3) { /* dependency_frames */ + if (value == 0 || value == 3) { /* dependency_frames */ GET_PAGE_STATS(stats, struct dependency_frame, _pages_dep_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 6) { /* subgoal_trie_nodes */ + if (value == 0 || value == 6) { /* subgoal_trie_nodes */ GET_PAGE_STATS(stats, struct subgoal_trie_node, _pages_sg_node); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 8) { /* subgoal_trie_hashes */ + if (value == 0 || value == 8) { /* subgoal_trie_hashes */ GET_PAGE_STATS(stats, struct subgoal_trie_hash, _pages_sg_hash); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 7) { /* answer_trie_nodes */ + if (value == 0 || value == 7) { /* answer_trie_nodes */ GET_PAGE_STATS(stats, struct answer_trie_node, _pages_ans_node); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 9) { /* answer_trie_hashes */ + if (value == 0 || value == 9) { /* answer_trie_hashes */ GET_PAGE_STATS(stats, struct answer_trie_hash, _pages_ans_hash); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #if defined(THREADS_FULL_SHARING) - if (value == 0 || value == 17) { /* answer_ref_nodes */ + if (value == 0 || value == 17) { /* answer_ref_nodes */ GET_PAGE_STATS(stats, struct answer_ref_node, _pages_ans_ref_node); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #endif - if (value == 0 || value == 10) { /* global_trie_nodes */ + if (value == 0 || value == 10) { /* global_trie_nodes */ GET_PAGE_STATS(stats, struct global_trie_node, _pages_gt_node); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 11) { /* global_trie_hashes */ + if (value == 0 || value == 11) { /* global_trie_hashes */ GET_PAGE_STATS(stats, struct global_trie_hash, _pages_gt_hash); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #endif /* TABLING */ #ifdef YAPOR - if (value == 0 || value == 4) { /* or_frames */ + if (value == 0 || value == 4) { /* or_frames */ GET_PAGE_STATS(stats, struct or_frame, _pages_or_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 12) { /* query_goal_solution_frames */ + if (value == 0 || value == 12) { /* query_goal_solution_frames */ GET_PAGE_STATS(stats, struct query_goal_solution_frame, _pages_qg_sol_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 13) { /* query_goal_answer_frames */ + if (value == 0 || value == 13) { /* query_goal_answer_frames */ GET_PAGE_STATS(stats, struct query_goal_answer_frame, _pages_qg_ans_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) - if (value == 0 || value == 5) { /* suspension_frames */ + if (value == 0 || value == 5) { /* suspension_frames */ GET_PAGE_STATS(stats, struct suspension_frame, _pages_susp_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #ifdef TABLING_INNER_CUTS - if (value == 0 || value == 14) { /* table_subgoal_solution_frames */ - GET_PAGE_STATS(stats, struct table_subgoal_solution_frame, _pages_tg_sol_fr); + if (value == 0 || value == 14) { /* table_subgoal_solution_frames */ + GET_PAGE_STATS(stats, struct table_subgoal_solution_frame, + _pages_tg_sol_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } - if (value == 0 || value == 15) { /* table_subgoal_answer_frames */ + if (value == 0 || value == 15) { /* table_subgoal_answer_frames */ GET_PAGE_STATS(stats, struct table_subgoal_answer_frame, _pages_tg_ans_fr); bytes += PgEnt_bytes_in_use(stats); - if (value != 0) structs = PgEnt_strs_in_use(stats); + if (value != 0) + structs = PgEnt_strs_in_use(stats); } #endif /* TABLING_INNER_CUTS */ #endif /* YAPOR && TABLING */ - if (value == 0) { /* total_memory */ + if (value == 0) { /* total_memory */ #ifdef USE_PAGES_MALLOC structs = PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size; #else @@ -1048,18 +1101,16 @@ static Int p_get_optyap_statistics( USES_REGS1 ) { tbytes = Deref(ARG2); tstructs = Deref(ARG3); if (IsVarTerm(tbytes)) { - YapBind((CELL *) tbytes, MkIntTerm(bytes)); - } else if (IsIntTerm(tbytes) && IntOfTerm(tbytes) != bytes) + YapBind((CELL *)tbytes, MkIntTerm(bytes)); + } else if (IsIntTerm(tbytes) && IntOfTerm(tbytes) != bytes) return (FALSE); if (IsVarTerm(tstructs)) { - YapBind((CELL *) tstructs, MkIntTerm(structs)); - } else if (IsIntTerm(tstructs) && IntOfTerm(tstructs) != structs) + YapBind((CELL *)tstructs, MkIntTerm(structs)); + } else if (IsIntTerm(tstructs) && IntOfTerm(tstructs) != structs) return (FALSE); return (TRUE); } - - /****************************** ** Local functions ** ******************************/ @@ -1079,99 +1130,113 @@ static inline realtime current_time(void) { } #endif /* YAPOR */ - #ifdef TABLING static inline struct page_statistics show_statistics_table_entries(FILE *out) { - SHOW_PAGE_STATS(out, struct table_entry, _pages_tab_ent, "Table entries: "); + 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(FILE *out) { - SHOW_PAGE_STATS(out, struct subgoal_entry, _pages_sg_ent, "Subgoal entries: "); +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(FILE *out) { - SHOW_PAGE_STATS(out, struct subgoal_frame, _pages_sg_fr, "Subgoal frames: "); + SHOW_PAGE_STATS(out, struct subgoal_frame, _pages_sg_fr, + "Subgoal frames: "); } - -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_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(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_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(FILE *out) { - SHOW_PAGE_STATS(out, struct subgoal_trie_hash, _pages_sg_hash, "Subgoal trie hashes: "); +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(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_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(FILE *out) { - SHOW_PAGE_STATS(out, struct answer_trie_hash, _pages_ans_hash, "Answer trie hashes: "); +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(FILE *out) { - SHOW_PAGE_STATS(out, struct answer_ref_node, _pages_ans_ref_node, "Answer ref nodes: "); +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(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_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(FILE *out) { - SHOW_PAGE_STATS(out, struct global_trie_hash, _pages_gt_hash, "Global trie hashes: "); +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(FILE *out) { - SHOW_PAGE_STATS(out, struct or_frame, _pages_or_fr, "Or-frames: "); + SHOW_PAGE_STATS(out, struct or_frame, _pages_or_fr, + "Or-frames: "); } - -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_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(FILE *out) { - SHOW_PAGE_STATS(out, struct query_goal_answer_frame, _pages_qg_ans_fr, "Query goal answer frames: "); +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(FILE *out) { - SHOW_PAGE_STATS(out, struct suspension_frame, _pages_susp_fr, "Suspension frames: "); +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(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_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(FILE *out) { - SHOW_PAGE_STATS(out, struct table_subgoal_answer_frame, _pages_tg_ans_fr, "Table subgoal answer frames: "); +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 */ #endif /* YAPOR && TABLING */ diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 39ff91f2b..bec10386d 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -22,31 +22,48 @@ #include "eval.h" #include "tab.macros.h" -static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS); -static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS); -static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS); -static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS); -static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, Term USES_REGS); +static inline sg_node_ptr +subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS); +static inline sg_node_ptr +subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS); +static inline ans_node_ptr +answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS); +static inline ans_node_ptr +answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS); +static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, + Term USES_REGS); #ifdef GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, Term USES_REGS); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL ** USES_REGS); -static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL ** USES_REGS); -static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, int * USES_REGS); -static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr, Term, int * USES_REGS); +static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, + Term USES_REGS); +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ +static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, + int *, CELL **USES_REGS); +static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr, + Term, int *, + CELL **USES_REGS); +static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, + int *USES_REGS); +static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr, + Term, int *USES_REGS); #ifdef GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL * USES_REGS); -static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *, CELL * USES_REGS); +static inline gt_node_ptr +subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL *USES_REGS); +static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *, + CELL *USES_REGS); #else -static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *, CELL ** USES_REGS); -static inline gt_node_ptr answer_search_global_trie_loop(Term, int * USES_REGS); -#endif /* GLOBAL_TRIE_MODE */ +static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *, + CELL **USES_REGS); +static inline gt_node_ptr answer_search_global_trie_loop(Term, int *USES_REGS); +#endif /* GLOBAL_TRIE_MODE */ static inline CELL *load_answer_loop(ans_node_ptr USES_REGS); -static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL * USES_REGS); -static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, CELL * USES_REGS); +static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *USES_REGS); +static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, + CELL *USES_REGS); #ifdef MODE_DIRECTED_TABLING -static inline ans_node_ptr answer_search_min_max(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS); -static inline ans_node_ptr answer_search_sum(sg_fr_ptr, ans_node_ptr, Term USES_REGS); +static inline ans_node_ptr answer_search_min_max(sg_fr_ptr, ans_node_ptr, Term, + int USES_REGS); +static inline ans_node_ptr answer_search_sum(sg_fr_ptr, ans_node_ptr, + Term USES_REGS); static void invalidate_answer_trie(ans_node_ptr, sg_fr_ptr, int USES_REGS); #endif /* MODE_DIRECTED_TABLING */ @@ -64,20 +81,23 @@ static void free_global_trie_branch(gt_node_ptr, int USES_REGS); #else static void free_global_trie_branch(gt_node_ptr USES_REGS); #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int USES_REGS); -static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, int USES_REGS); -static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int USES_REGS); -static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, int *, int USES_REGS); -static inline void traverse_trie_node(Term, char *, int *, int *, int *, int USES_REGS); +static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, + int USES_REGS); +static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, + int USES_REGS); +static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, + int USES_REGS); +static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, + int *, int USES_REGS); +static inline void traverse_trie_node(Term, char *, int *, int *, int *, + int USES_REGS); static inline void traverse_update_arity(char *, int *, int *); - - /******************************* ** Structs & Macros ** *******************************/ -static struct trie_statistics{ +static struct trie_statistics { FILE *out; int show; long subgoals; @@ -95,73 +115,79 @@ static struct trie_statistics{ long global_trie_references; } #ifdef THREADS - trie_stats[MAX_THREADS]; +trie_stats[MAX_THREADS]; -#define TrStat_out trie_stats[worker_id].out -#define TrStat_show trie_stats[worker_id].show -#define TrStat_subgoals trie_stats[worker_id].subgoals -#define TrStat_sg_incomplete trie_stats[worker_id].subgoals_incomplete -#define TrStat_sg_nodes trie_stats[worker_id].subgoal_trie_nodes -#define TrStat_answers trie_stats[worker_id].answers -#define TrStat_answers_true trie_stats[worker_id].answers_true -#define TrStat_answers_no trie_stats[worker_id].answers_no -#define TrStat_answers_pruned trie_stats[worker_id].answers_pruned -#define TrStat_ans_nodes trie_stats[worker_id].answer_trie_nodes -#define TrStat_gt_terms trie_stats[worker_id].global_trie_terms -#define TrStat_gt_nodes trie_stats[worker_id].global_trie_nodes -#define TrStat_gt_refs trie_stats[worker_id].global_trie_references -#else /*!THREADS */ - trie_stats; +#define TrStat_out trie_stats[worker_id].out +#define TrStat_show trie_stats[worker_id].show +#define TrStat_subgoals trie_stats[worker_id].subgoals +#define TrStat_sg_incomplete trie_stats[worker_id].subgoals_incomplete +#define TrStat_sg_nodes trie_stats[worker_id].subgoal_trie_nodes +#define TrStat_answers trie_stats[worker_id].answers +#define TrStat_answers_true trie_stats[worker_id].answers_true +#define TrStat_answers_no trie_stats[worker_id].answers_no +#define TrStat_answers_pruned trie_stats[worker_id].answers_pruned +#define TrStat_ans_nodes trie_stats[worker_id].answer_trie_nodes +#define TrStat_gt_terms trie_stats[worker_id].global_trie_terms +#define TrStat_gt_nodes trie_stats[worker_id].global_trie_nodes +#define TrStat_gt_refs trie_stats[worker_id].global_trie_references +#else /*!THREADS */ +trie_stats; -#define TrStat_out trie_stats.out -#define TrStat_show trie_stats.show -#define TrStat_subgoals trie_stats.subgoals -#define TrStat_sg_incomplete trie_stats.subgoals_incomplete -#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes -#define TrStat_answers trie_stats.answers -#define TrStat_answers_true trie_stats.answers_true -#define TrStat_answers_no trie_stats.answers_no -#define TrStat_answers_pruned trie_stats.answers_pruned -#define TrStat_ans_nodes trie_stats.answer_trie_nodes -#define TrStat_gt_terms trie_stats.global_trie_terms -#define TrStat_gt_nodes trie_stats.global_trie_nodes -#define TrStat_gt_refs trie_stats.global_trie_references +#define TrStat_out trie_stats.out +#define TrStat_show trie_stats.show +#define TrStat_subgoals trie_stats.subgoals +#define TrStat_sg_incomplete trie_stats.subgoals_incomplete +#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes +#define TrStat_answers trie_stats.answers +#define TrStat_answers_true trie_stats.answers_true +#define TrStat_answers_no trie_stats.answers_no +#define TrStat_answers_pruned trie_stats.answers_pruned +#define TrStat_ans_nodes trie_stats.answer_trie_nodes +#define TrStat_gt_terms trie_stats.global_trie_terms +#define TrStat_gt_nodes trie_stats.global_trie_nodes +#define TrStat_gt_refs trie_stats.global_trie_references #endif /*THREADS */ -#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) -#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES if (GLOBAL_NOfThreads == 1) +#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || \ + defined(THREADS_CONSUMER_SHARING) +#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES \ + if (GLOBAL_NOfThreads == 1) #else #define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES -#endif /* THREADS_SUBGOAL_SHARING || THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ +#endif /* THREADS_SUBGOAL_SHARING || THREADS_FULL_SHARING || \ + THREADS_CONSUMER_SHARING */ #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) -#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES if (GLOBAL_NOfThreads == 1) +#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES \ + if (GLOBAL_NOfThreads == 1) #else #define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ -#define SHOW_TABLE_STR_ARRAY_SIZE 100000 +#define SHOW_TABLE_STR_ARRAY_SIZE 100000 #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 -#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ - if (TrStat_show == SHOW_MODE_STRUCTURE) \ - fprintf(TrStat_out, MESG, ##ARGS) +#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ + if (TrStat_show == SHOW_MODE_STRUCTURE) \ + 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)) { \ - register gt_node_ptr gt_node = (gt_node_ptr) (REF); \ - TrNode_child(gt_node) = (gt_node_ptr) ((uintptr_t) TrNode_child(gt_node) - 1); \ - if (TrNode_child(gt_node) == 0) \ - FREE_GLOBAL_TRIE_BRANCH(gt_node,TRAVERSE_MODE_NORMAL); \ - } +#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) \ + if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && \ + REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \ + register gt_node_ptr gt_node = (gt_node_ptr)(REF); \ + TrNode_child(gt_node) = \ + (gt_node_ptr)((uintptr_t)TrNode_child(gt_node) - 1); \ + if (TrNode_child(gt_node) == 0) \ + FREE_GLOBAL_TRIE_BRANCH(gt_node, TRAVERSE_MODE_NORMAL); \ + } #ifdef GLOBAL_TRIE_FOR_SUBTERMS -#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE) \ - CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) -#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ - free_global_trie_branch(NODE,MODE PASS_REGS) +#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE) \ + CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) +#define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE) \ + free_global_trie_branch(NODE, MODE PASS_REGS) #else -#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE) -#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ - free_global_trie_branch(NODE PASS_REGS) +#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE) +#define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE) \ + free_global_trie_branch(NODE PASS_REGS) #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ /****************************** @@ -171,42 +197,45 @@ static struct trie_statistics{ #include "tab.rational.h" #endif /* RATIONAL TERM SUPPORT FOR TRIES */ - /****************************** ** Local functions ** ******************************/ -#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry */ -#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_entry */ -#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_entry */ +#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry \ + */ +#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_entry */ +#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_entry */ #include "tab.tries.h" #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT #define MODE_GLOBAL_TRIE_ENTRY -#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry */ -#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_entry */ +#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry \ + */ +#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_entry \ + */ #ifdef GLOBAL_TRIE_FOR_SUBTERMS -#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry */ -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ +#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry \ + */ +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ #include "tab.tries.h" #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT #undef MODE_GLOBAL_TRIE_ENTRY -#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */ -#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop */ -#define INCLUDE_LOAD_ANSWER_LOOP /* load_answer_loop */ +#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */ +#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop */ +#define INCLUDE_LOAD_ANSWER_LOOP /* load_answer_loop */ #include "tab.tries.h" #undef INCLUDE_LOAD_ANSWER_LOOP #undef INCLUDE_ANSWER_SEARCH_LOOP #undef INCLUDE_SUBGOAL_SEARCH_LOOP #define MODE_TERMS_LOOP -#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_terms_loop */ -#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_terms_loop */ +#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_terms_loop */ +#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_terms_loop */ #ifdef TRIE_RATIONAL_TERMS #undef TRIE_RATIONAL_TERMS #include "tab.tries.h" @@ -219,9 +248,11 @@ static struct trie_statistics{ #undef MODE_TERMS_LOOP #define MODE_GLOBAL_TRIE_LOOP -#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_global_trie_(terms)_loop */ -#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_global_trie_(terms)_loop */ -#define INCLUDE_LOAD_ANSWER_LOOP /* load_substitution_loop */ +#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_global_trie_(terms)_loop \ + */ +#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_global_trie_(terms)_loop \ + */ +#define INCLUDE_LOAD_ANSWER_LOOP /* load_substitution_loop */ #ifdef TRIE_RATIONAL_TERMS #undef TRIE_RATIONAL_TERMS #include "tab.tries.h" @@ -236,54 +267,55 @@ static struct trie_statistics{ #ifdef MODE_DIRECTED_TABLING #define INCLUDE_ANSWER_SEARCH_MODE_DIRECTED -#include "tab.tries.h" /* answer_search_min_max + answer_search_sum + invalidate_answer_trie */ +#include "tab.tries.h" /* answer_search_min_max + answer_search_sum + invalidate_answer_trie */ #undef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED #endif /* MODE_DIRECTED_TABLING */ - - -static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms USES_REGS) { -/************************************************************************ - =========== - | | - | ... | - | | - ----------- - YENV --> | N+1 | <-- stack_vars - ----------- - | VAR_N | - ----------- - | ... | - ----------- - | VAR_0 | - ----------- - | | - | ... | - | | - =========== - | | - | ... | - | | - ----------- - TR --> | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) - | TERM_1 | \|/ - =========== * - LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) - ----------- -************************************************************************/ +static inline CELL *exec_substitution_loop(gt_node_ptr current_node, + CELL **stack_vars_ptr, + CELL *stack_terms USES_REGS) { + /************************************************************************ + =========== + | | + | ... | + | | + ----------- + YENV --> | N+1 | <-- stack_vars + ----------- + | VAR_N | + ----------- + | ... | + ----------- + | VAR_0 | + ----------- + | | + | ... | + | | + =========== + | | + | ... | + | | + ----------- + TR --> | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | stack_terms_pair_offset + (TRIE_COMPACT_PAIRS) + | TERM_1 | \|/ + =========== * + LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) + ----------- + ************************************************************************/ CELL *stack_vars = *stack_vars_ptr; - CELL *stack_terms_limit = (CELL *) TR; + CELL *stack_terms_limit = (CELL *)TR; #ifdef TRIE_COMPACT_PAIRS -#define stack_terms_base ((CELL *) LOCAL_TrailTop) +#define stack_terms_base ((CELL *)LOCAL_TrailTop) int stack_terms_pair_offset = 0; #endif /* TRIE_COMPACT_PAIRS */ Term t = TrNode_entry(current_node); @@ -293,54 +325,55 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac if (IsVarTerm(t)) { #ifdef GLOBAL_TRIE_FOR_SUBTERMS if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { - stack_terms = exec_substitution_loop((gt_node_ptr) t, &stack_vars, stack_terms PASS_REGS); - } else + stack_terms = exec_substitution_loop((gt_node_ptr)t, &stack_vars, + stack_terms PASS_REGS); + } else #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ { - int var_index = VarIndexOfTableTerm(t); + int var_index = VarIndexOfTableTerm(t); int vars_arity = *stack_vars; - t = MkVarTerm(); - if (var_index >= vars_arity) { - while (vars_arity < var_index) { - *stack_vars-- = 0; - vars_arity++; - } - *stack_vars-- = t; - vars_arity++; - *stack_vars = vars_arity; - } else { - /* do the same as in macro stack_trie_val_instr() */ - CELL aux_sub, aux_var, *vars_ptr; - vars_ptr = stack_vars + vars_arity - var_index; - aux_sub = *((CELL *) t); - aux_var = *vars_ptr; - if (aux_var == 0) { - *vars_ptr = t; - } else { - if (aux_sub > aux_var) { - if ((CELL *) aux_sub <= HR) { - Bind_Global((CELL *) aux_sub, aux_var); - } else if ((CELL *) aux_var <= HR) { - Bind_Local((CELL *) aux_sub, aux_var); - } else { - Bind_Local((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } - } else { - if ((CELL *) aux_var <= HR) { - Bind_Global((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } else if ((CELL *) aux_sub <= HR) { - Bind_Local((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } else { - Bind_Local((CELL *) aux_sub, aux_var); - } - } - } - } - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); - STACK_PUSH_UP(t, stack_terms); + t = MkVarTerm(); + if (var_index >= vars_arity) { + while (vars_arity < var_index) { + *stack_vars-- = 0; + vars_arity++; + } + *stack_vars-- = t; + vars_arity++; + *stack_vars = vars_arity; + } else { + /* do the same as in macro stack_trie_val_instr() */ + CELL aux_sub, aux_var, *vars_ptr; + vars_ptr = stack_vars + vars_arity - var_index; + aux_sub = *((CELL *)t); + aux_var = *vars_ptr; + if (aux_var == 0) { + *vars_ptr = t; + } else { + if (aux_sub > aux_var) { + if ((CELL *)aux_sub <= HR) { + Bind_Global((CELL *)aux_sub, aux_var); + } else if ((CELL *)aux_var <= HR) { + Bind_Local((CELL *)aux_sub, aux_var); + } else { + Bind_Local((CELL *)aux_var, aux_sub); + *vars_ptr = aux_sub; + } + } else { + if ((CELL *)aux_var <= HR) { + Bind_Global((CELL *)aux_var, aux_sub); + *vars_ptr = aux_sub; + } else if ((CELL *)aux_sub <= HR) { + Bind_Local((CELL *)aux_var, aux_sub); + *vars_ptr = aux_sub; + } else { + Bind_Local((CELL *)aux_sub, aux_var); + } + } + } + } + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); } } else if (IsAtomOrIntTerm(t)) { AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); @@ -348,24 +381,24 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac } else if (IsPairTerm(t)) { #ifdef TRIE_COMPACT_PAIRS if (t == CompactPairInit) { - Term *stack_aux = stack_terms_base - stack_terms_pair_offset; - Term head, tail = STACK_POP_UP(stack_aux); - while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { - head = STACK_POP_UP(stack_aux); - tail = MkPairTerm(head, tail); - } - stack_terms = stack_terms_base - stack_terms_pair_offset; - stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(tail, stack_terms); - } else { /* CompactPairEndList / CompactPairEndTerm */ - Term last; - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); - last = STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); - stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); - if (t == CompactPairEndList) - STACK_PUSH_UP(TermNil, stack_terms); - STACK_PUSH_UP(last, stack_terms); + Term *stack_aux = stack_terms_base - stack_terms_pair_offset; + Term head, tail = STACK_POP_UP(stack_aux); + while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { + head = STACK_POP_UP(stack_aux); + tail = MkPairTerm(head, tail); + } + stack_terms = stack_terms_base - stack_terms_pair_offset; + stack_terms_pair_offset = (int)STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(tail, stack_terms); + } else { /* CompactPairEndList / CompactPairEndTerm */ + Term last; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + last = STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); + stack_terms_pair_offset = (int)(stack_terms_base - stack_terms); + if (t == CompactPairEndList) + STACK_PUSH_UP(TermNil, stack_terms); + STACK_PUSH_UP(last, stack_terms); } #else Term head = STACK_POP_DOWN(stack_terms); @@ -374,31 +407,31 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac STACK_PUSH_UP(t, stack_terms); #endif /* TRIE_COMPACT_PAIRS */ } else if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); + Functor f = (Functor)RepAppl(t); if (f == FunctorDouble) { - union { - Term t_dbl[sizeof(Float)/sizeof(Term)]; - Float dbl; - } u; - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - u.t_dbl[0] = t; + union { + Term t_dbl[sizeof(Float) / sizeof(Term)]; + Float dbl; + } u; + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + u.t_dbl[0] = t; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - u.t_dbl[1] = t; + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + u.t_dbl[1] = t; #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - current_node = TrNode_parent(current_node); - t = MkFloatTerm(u.dbl); + current_node = TrNode_parent(current_node); + t = MkFloatTerm(u.dbl); } else if (f == FunctorLongInt) { - Int li = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - current_node = TrNode_parent(current_node); - t = MkLongIntTerm(li); + Int li = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + current_node = TrNode_parent(current_node); + t = MkLongIntTerm(li); } else { - int f_arity = ArityOfFunctor(f); - t = Yap_MkApplTerm(f, f_arity, stack_terms); - stack_terms += f_arity; + int f_arity = ArityOfFunctor(f); + t = Yap_MkApplTerm(f, f_arity, stack_terms); + stack_terms += f_arity; } AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); STACK_PUSH_UP(t, stack_terms); @@ -415,14 +448,14 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac #endif /* TRIE_COMPACT_PAIRS */ } - #ifdef YAPOR #ifdef TABLING_INNER_CUTS -static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr current_node) { +static int update_answer_trie_branch(ans_node_ptr previous_node, + ans_node_ptr current_node) { int ltt; - if (! IS_ANSWER_LEAF_NODE(current_node)) { + if (!IS_ANSWER_LEAF_NODE(current_node)) { if (TrNode_child(current_node)) { - TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */ + TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */ update_answer_trie_branch(NULL, TrNode_child(current_node)); if (TrNode_child(current_node)) goto update_next_trie_branch; @@ -432,16 +465,17 @@ static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr cu TrNode_next(previous_node) = TrNode_next(current_node); FREE_ANSWER_TRIE_NODE(current_node); if (TrNode_next(previous_node)) { - return update_answer_trie_branch(previous_node, TrNode_next(previous_node)); + return update_answer_trie_branch(previous_node, + TrNode_next(previous_node)); } else { - TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */ + TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */ return 0; } } else { TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node); if (TrNode_next(current_node)) { - TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */ - update_answer_trie_branch(NULL, TrNode_next(current_node)); + TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */ + update_answer_trie_branch(NULL, TrNode_next(current_node)); } FREE_ANSWER_TRIE_NODE(current_node); return 0; @@ -449,9 +483,10 @@ static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr cu } update_next_trie_branch: if (TrNode_next(current_node)) { - ltt = 1 + update_answer_trie_branch(current_node, TrNode_next(current_node)); + ltt = + 1 + update_answer_trie_branch(current_node, TrNode_next(current_node)); } else { - TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */ + TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */ ltt = 1; } @@ -462,14 +497,14 @@ update_next_trie_branch: #else /* YAPOR && ! TABLING_INNER_CUTS */ static int update_answer_trie_branch(ans_node_ptr current_node) { int ltt; - if (! IS_ANSWER_LEAF_NODE(current_node)) { - TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */ + if (!IS_ANSWER_LEAF_NODE(current_node)) { + TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */ update_answer_trie_branch(TrNode_child(current_node)); } if (TrNode_next(current_node)) { ltt = 1 + update_answer_trie_branch(TrNode_next(current_node)); } else { - TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */ + TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */ ltt = 1; } TrNode_or_arg(current_node) = ltt; @@ -479,28 +514,32 @@ static int update_answer_trie_branch(ans_node_ptr current_node) { #endif #else /* ! YAPOR */ static void update_answer_trie_branch(ans_node_ptr current_node, int position) { - if (! IS_ANSWER_LEAF_NODE(current_node)) - update_answer_trie_branch(TrNode_child(current_node), TRAVERSE_POSITION_FIRST); /* retry --> try */ + if (!IS_ANSWER_LEAF_NODE(current_node)) + update_answer_trie_branch(TrNode_child(current_node), + TRAVERSE_POSITION_FIRST); /* retry --> try */ if (position == TRAVERSE_POSITION_FIRST) { ans_node_ptr next = TrNode_next(current_node); if (next) { while (TrNode_next(next)) { - update_answer_trie_branch(next, TRAVERSE_POSITION_NEXT); /* retry --> retry */ - next = TrNode_next(next); + update_answer_trie_branch(next, + TRAVERSE_POSITION_NEXT); /* retry --> retry */ + next = TrNode_next(next); } - update_answer_trie_branch(next, TRAVERSE_POSITION_LAST); /* retry --> trust */ + update_answer_trie_branch(next, + TRAVERSE_POSITION_LAST); /* retry --> trust */ } else - position += TRAVERSE_POSITION_LAST; /* try --> do */ + position += TRAVERSE_POSITION_LAST; /* try --> do */ } - TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node) - position); + TrNode_instr(current_node) = + Yap_opcode(TrNode_instr(current_node) - position); return; } #endif /* YAPOR */ - #ifdef GLOBAL_TRIE_FOR_SUBTERMS -static void free_global_trie_branch(gt_node_ptr current_node, int mode USES_REGS) { +static void free_global_trie_branch(gt_node_ptr current_node, + int mode USES_REGS) { Term t = TrNode_entry(current_node); #else static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) { @@ -508,15 +547,17 @@ static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) { gt_node_ptr parent_node, child_node; parent_node = TrNode_parent(current_node); - child_node = TrNode_child(parent_node); + child_node = TrNode_child(parent_node); if (IS_GLOBAL_TRIE_HASH(child_node)) { - gt_hash_ptr hash = (gt_hash_ptr) child_node; - gt_node_ptr *bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(current_node), Hash_num_buckets(hash)); + gt_hash_ptr hash = (gt_hash_ptr)child_node; + gt_node_ptr *bucket = + Hash_buckets(hash) + + HASH_ENTRY(TrNode_entry(current_node), Hash_num_buckets(hash)); int num_nodes = --Hash_num_nodes(hash); child_node = *bucket; if (child_node != current_node) { while (TrNode_next(child_node) != current_node) - child_node = TrNode_next(child_node); + child_node = TrNode_next(child_node); TrNode_next(child_node) = TrNode_next(current_node); CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); FREE_GLOBAL_TRIE_NODE(current_node); @@ -525,112 +566,117 @@ static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) { CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); FREE_GLOBAL_TRIE_NODE(current_node); if (num_nodes == 0) { - FREE_BUCKETS(Hash_buckets(hash)); - FREE_GLOBAL_TRIE_HASH(hash); - if (parent_node != GLOBAL_root_gt) { + FREE_BUCKETS(Hash_buckets(hash)); + FREE_GLOBAL_TRIE_HASH(hash); + if (parent_node != GLOBAL_root_gt) { #ifdef GLOBAL_TRIE_FOR_SUBTERMS - if (mode == TRAVERSE_MODE_NORMAL) { - if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) - mode = TRAVERSE_MODE_DOUBLE; - else if (f == FunctorLongInt) - mode = TRAVERSE_MODE_LONGINT; - else if (f == FunctorBigInt || f == FunctorString) - mode = TRAVERSE_MODE_BIGINT_OR_STRING; - else - mode = TRAVERSE_MODE_NORMAL; - } else - mode = TRAVERSE_MODE_NORMAL; - } else if (mode == TRAVERSE_MODE_LONGINT) - mode = TRAVERSE_MODE_LONGINT_END; - } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) - mode = TRAVERSE_MODE_BIGINT_OR_STRING_END; - else if (mode == TRAVERSE_MODE_DOUBLE) + if (mode == TRAVERSE_MODE_NORMAL) { + if (IsApplTerm(t)) { + Functor f = (Functor)RepAppl(t); + if (f == FunctorDouble) + mode = TRAVERSE_MODE_DOUBLE; + else if (f == FunctorLongInt) + mode = TRAVERSE_MODE_LONGINT; + else if (f == FunctorBigInt || f == FunctorString) + mode = TRAVERSE_MODE_BIGINT_OR_STRING; + else + mode = TRAVERSE_MODE_NORMAL; + } else + mode = TRAVERSE_MODE_NORMAL; + } else if (mode == TRAVERSE_MODE_LONGINT) + mode = TRAVERSE_MODE_LONGINT_END; + } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) + mode = TRAVERSE_MODE_BIGINT_OR_STRING_END; + else if (mode == TRAVERSE_MODE_DOUBLE) #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - mode = TRAVERSE_MODE_DOUBLE2; - else if (mode == TRAVERSE_MODE_DOUBLE2) + mode = TRAVERSE_MODE_DOUBLE2; + else if (mode == TRAVERSE_MODE_DOUBLE2) #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - mode = TRAVERSE_MODE_DOUBLE_END; - else - mode = TRAVERSE_MODE_NORMAL; + mode = TRAVERSE_MODE_DOUBLE_END; + else + mode = TRAVERSE_MODE_NORMAL; #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - FREE_GLOBAL_TRIE_BRANCH(parent_node, mode); - } else - TrNode_child(parent_node) = NULL; - } + FREE_GLOBAL_TRIE_BRANCH(parent_node, mode); + } else + TrNode_child(parent_node) = NULL; } - } else if (child_node != current_node) { - while (TrNode_next(child_node) != current_node) - child_node = TrNode_next(child_node); - TrNode_next(child_node) = TrNode_next(current_node); - CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); - FREE_GLOBAL_TRIE_NODE(current_node); - } else if (TrNode_next(current_node) == NULL) { - CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); - FREE_GLOBAL_TRIE_NODE(current_node); - if (parent_node != GLOBAL_root_gt) { -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - if (mode == TRAVERSE_MODE_NORMAL) { - if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) - mode = TRAVERSE_MODE_DOUBLE; - else if (f == FunctorLongInt) - mode = TRAVERSE_MODE_LONGINT; - else if (f == FunctorBigInt || f == FunctorString) - mode = TRAVERSE_MODE_BIGINT_OR_STRING; - else - mode = TRAVERSE_MODE_NORMAL; - } else - mode = TRAVERSE_MODE_NORMAL; - } else if (mode == TRAVERSE_MODE_LONGINT) { - mode = TRAVERSE_MODE_LONGINT_END; - } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { - mode = TRAVERSE_MODE_BIGINT_OR_STRING_END; - } else if (mode == TRAVERSE_MODE_DOUBLE) -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - mode = TRAVERSE_MODE_DOUBLE2; - else if (mode == TRAVERSE_MODE_DOUBLE2) -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - mode = TRAVERSE_MODE_DOUBLE_END; - else - mode = TRAVERSE_MODE_NORMAL; -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - FREE_GLOBAL_TRIE_BRANCH(parent_node, mode); - } else - TrNode_child(parent_node) = NULL; - } else { - TrNode_child(parent_node) = TrNode_next(current_node); - CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); - FREE_GLOBAL_TRIE_NODE(current_node); } - return; +} +else if (child_node != current_node) { + while (TrNode_next(child_node) != current_node) + child_node = TrNode_next(child_node); + TrNode_next(child_node) = TrNode_next(current_node); + CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); + FREE_GLOBAL_TRIE_NODE(current_node); +} +else if (TrNode_next(current_node) == NULL) { + CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); + FREE_GLOBAL_TRIE_NODE(current_node); + if (parent_node != GLOBAL_root_gt) { +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (mode == TRAVERSE_MODE_NORMAL) { + if (IsApplTerm(t)) { + Functor f = (Functor)RepAppl(t); + if (f == FunctorDouble) + mode = TRAVERSE_MODE_DOUBLE; + else if (f == FunctorLongInt) + mode = TRAVERSE_MODE_LONGINT; + else if (f == FunctorBigInt || f == FunctorString) + mode = TRAVERSE_MODE_BIGINT_OR_STRING; + else + mode = TRAVERSE_MODE_NORMAL; + } else + mode = TRAVERSE_MODE_NORMAL; + } else if (mode == TRAVERSE_MODE_LONGINT) { + mode = TRAVERSE_MODE_LONGINT_END; + } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { + mode = TRAVERSE_MODE_BIGINT_OR_STRING_END; + } else if (mode == TRAVERSE_MODE_DOUBLE) +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + mode = TRAVERSE_MODE_DOUBLE2; + else if (mode == TRAVERSE_MODE_DOUBLE2) +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + mode = TRAVERSE_MODE_DOUBLE_END; + else + mode = TRAVERSE_MODE_NORMAL; +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + FREE_GLOBAL_TRIE_BRANCH(parent_node, mode); + } else + TrNode_child(parent_node) = NULL; +} +else { + TrNode_child(parent_node) = TrNode_next(current_node); + CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode); + FREE_GLOBAL_TRIE_NODE(current_node); +} +return; } - -static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position USES_REGS) { +static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, + int str_index, int *arity, int mode, + int position USES_REGS) { int *current_arity = NULL, current_str_index = 0, current_mode = 0; /* test if hashing */ if (IS_SUBGOAL_TRIE_HASH(current_node)) { sg_node_ptr *bucket, *last_bucket; sg_hash_ptr hash; - hash = (sg_hash_ptr) current_node; + hash = (sg_hash_ptr)current_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); do { if (*bucket) { - traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS); - memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); + traverse_subgoal_trie(*bucket, str, str_index, arity, mode, + TRAVERSE_POSITION_FIRST PASS_REGS); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS - if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + if (arity[arity[0]] == -2 && str[str_index - 1] != '[') + str[str_index - 1] = ','; #else - if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ } } while (++bucket != last_bucket); @@ -640,7 +686,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i /* save current state if first sibling node */ if (position == TRAVERSE_POSITION_FIRST) { - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); current_str_index = str_index; current_mode = mode; @@ -648,7 +694,8 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i /* process current trie node */ TrStat_sg_nodes++; - traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL PASS_REGS); + traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, + TRAVERSE_TYPE_SUBGOAL PASS_REGS); /* show answers ... */ if (IS_SUBGOAL_LEAF_NODE(current_node)) { @@ -659,28 +706,31 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i SHOW_TABLE_STRUCTURE("%s.\n", str); TrStat_ans_nodes++; if (SgFr_first_answer(sg_fr) == NULL) { - if (SgFr_state(sg_fr) < complete) { - TrStat_sg_incomplete++; - SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); - } else { - TrStat_answers_no++; - SHOW_TABLE_STRUCTURE(" NO\n"); - } + if (SgFr_state(sg_fr) < complete) { + TrStat_sg_incomplete++; + SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); + } else { + TrStat_answers_no++; + SHOW_TABLE_STRUCTURE(" NO\n"); + } } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) { - TrStat_answers_true++; - SHOW_TABLE_STRUCTURE(" TRUE\n"); + TrStat_answers_true++; + SHOW_TABLE_STRUCTURE(" TRUE\n"); } else { - arity[0] = 0; - traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS); - if (SgFr_state(sg_fr) < complete) { - TrStat_sg_incomplete++; - SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); - } + arity[0] = 0; + traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), + &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, + TRAVERSE_POSITION_FIRST PASS_REGS); + if (SgFr_state(sg_fr) < complete) { + TrStat_sg_incomplete++; + SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); + } } } } else - /* ... or continue with child node */ - traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS); + /* ... or continue with child node */ + traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, + mode, TRAVERSE_POSITION_FIRST PASS_REGS); /* restore the initial state and continue with sibling nodes */ if (position == TRAVERSE_POSITION_FIRST) { str_index = current_str_index; @@ -690,12 +740,13 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + str[str_index - 1] = ','; #else if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ - traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT PASS_REGS); + traverse_subgoal_trie(current_node, str, str_index, arity, mode, + TRAVERSE_POSITION_NEXT PASS_REGS); current_node = TrNode_next(current_node); } free(current_arity); @@ -703,29 +754,32 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i return; } - -static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position USES_REGS) { - int *current_arity = NULL, current_str_index = 0, current_var_index = 0, current_mode = 0; +static void traverse_answer_trie(ans_node_ptr current_node, char *str, + int str_index, int *arity, int var_index, + int mode, int position USES_REGS) { + int *current_arity = NULL, current_str_index = 0, current_var_index = 0, + current_mode = 0; /* test if hashing */ if (IS_ANSWER_TRIE_HASH(current_node)) { ans_node_ptr *bucket, *last_bucket; ans_hash_ptr hash; - hash = (ans_hash_ptr) current_node; + hash = (ans_hash_ptr)current_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); do { if (*bucket) { - traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS); - memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); + traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, + TRAVERSE_POSITION_FIRST PASS_REGS); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS - if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + if (arity[arity[0]] == -2 && str[str_index - 1] != '[') + str[str_index - 1] = ','; #else - if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ } } while (++bucket != last_bucket); @@ -735,7 +789,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i /* save current state if first sibling node */ if (position == TRAVERSE_POSITION_FIRST) { - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); current_str_index = str_index; current_var_index = var_index; @@ -744,13 +798,14 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i /* print VAR if starting a term */ if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) { - str_index += sprintf(& str[str_index], " VAR%d: ", var_index); + str_index += sprintf(&str[str_index], " VAR%d: ", var_index); var_index++; } /* process current trie node */ TrStat_ans_nodes++; - traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER PASS_REGS); + traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, + TRAVERSE_TYPE_ANSWER PASS_REGS); /* show answer .... */ if (IS_ANSWER_LEAF_NODE(current_node)) { @@ -767,7 +822,8 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i #endif /* TABLING_INNER_CUTS */ /* ... or continue with child node */ else - traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS); + traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, + var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS); /* restore the initial state and continue with sibling nodes */ if (position == TRAVERSE_POSITION_FIRST) { @@ -779,12 +835,13 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + str[str_index - 1] = ','; #else if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ - traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT PASS_REGS); + traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, + TRAVERSE_POSITION_NEXT PASS_REGS); current_node = TrNode_next(current_node); } free(current_arity); @@ -793,29 +850,31 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i return; } - -static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position USES_REGS) { +static void traverse_global_trie(gt_node_ptr current_node, char *str, + int str_index, int *arity, int mode, + int position USES_REGS) { int *current_arity = NULL, current_str_index = 0, current_mode = 0; /* test if hashing */ if (IS_GLOBAL_TRIE_HASH(current_node)) { gt_node_ptr *bucket, *last_bucket; gt_hash_ptr hash; - hash = (gt_hash_ptr) current_node; + hash = (gt_hash_ptr)current_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); do { if (*bucket) { - traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS); - memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); + traverse_global_trie(*bucket, str, str_index, arity, mode, + TRAVERSE_POSITION_FIRST PASS_REGS); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS - if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + if (arity[arity[0]] == -2 && str[str_index - 1] != '[') + str[str_index - 1] = ','; #else - if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ } } while (++bucket != last_bucket); @@ -825,7 +884,7 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in /* save current state if first sibling node */ if (position == TRAVERSE_POSITION_FIRST) { - current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); current_str_index = str_index; current_mode = mode; @@ -833,16 +892,19 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in /* process current trie node */ TrStat_gt_nodes++; - traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_GT_SUBGOAL PASS_REGS); + traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, + TRAVERSE_TYPE_GT_SUBGOAL PASS_REGS); /* continue with child node ... */ if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL) - traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS); + traverse_global_trie(TrNode_child(current_node), str, str_index, arity, + mode, TRAVERSE_POSITION_FIRST PASS_REGS); /* ... or show term */ else { TrStat_gt_terms++; str[str_index] = 0; - SHOW_TABLE_STRUCTURE(" TERMx" UInt_FORMAT ": %s\n", (CELL) TrNode_child(current_node), str); + SHOW_TABLE_STRUCTURE(" TERMx" UInt_FORMAT ": %s\n", + (CELL)TrNode_child(current_node), str); } /* restore the initial state and continue with sibling nodes */ @@ -854,12 +916,13 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); #ifdef TRIE_COMPACT_PAIRS if (arity[arity[0]] == -2 && str[str_index - 1] != '[') - str[str_index - 1] = ','; + str[str_index - 1] = ','; #else if (arity[arity[0]] == -1) - str[str_index - 1] = '|'; + str[str_index - 1] = '|'; #endif /* TRIE_COMPACT_PAIRS */ - traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT PASS_REGS); + traverse_global_trie(current_node, str, str_index, arity, mode, + TRAVERSE_POSITION_NEXT PASS_REGS); current_node = TrNode_next(current_node); } free(current_arity); @@ -868,16 +931,20 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in return; } - -static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type USES_REGS) { +static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, + int *str_index, int *arity, int *mode, + int type USES_REGS) { if (TrNode_parent(current_node) != GLOBAL_root_gt) - traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type PASS_REGS); - traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type PASS_REGS); + traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, + arity, mode, type PASS_REGS); + traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, + type PASS_REGS); return; } - -static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type USES_REGS) { +static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, + int *arity, int *mode_ptr, + int type USES_REGS) { int mode = *mode_ptr; int str_index = *str_index_ptr; @@ -885,73 +952,81 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int if (mode == TRAVERSE_MODE_DOUBLE) { #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P arity[0]++; - arity[arity[0]] = (int) t; + arity[arity[0]] = (int)t; mode = TRAVERSE_MODE_DOUBLE2; } else if (mode == TRAVERSE_MODE_DOUBLE2) { union { - Term t_dbl[sizeof(Float)/sizeof(Term)]; + Term t_dbl[sizeof(Float) / sizeof(Term)]; Float dbl; } u; u.dbl = 0.0; u.t_dbl[0] = t; - u.t_dbl[1] = (Term) arity[arity[0]]; + u.t_dbl[1] = (Term)arity[arity[0]]; arity[0]--; -#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ +#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ union { - Term t_dbl[sizeof(Float)/sizeof(Term)]; + Term t_dbl[sizeof(Float) / sizeof(Term)]; Float dbl; } u; u.t_dbl[0] = t; #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - str_index += sprintf(& str[str_index], "%.15g", u.dbl); + str_index += sprintf(&str[str_index], "%.15g", u.dbl); traverse_update_arity(str, &str_index, arity); if (type == TRAVERSE_TYPE_SUBGOAL) mode = TRAVERSE_MODE_NORMAL; - else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */ + else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || + TRAVERSE_TYPE_GT_ANSWER */ mode = TRAVERSE_MODE_DOUBLE_END; } else if (mode == TRAVERSE_MODE_DOUBLE_END) { mode = TRAVERSE_MODE_NORMAL; } else if (mode == TRAVERSE_MODE_LONGINT) { - Int li = (Int) t; - str_index += sprintf(& str[str_index], Int_FORMAT, li); + Int li = (Int)t; + str_index += sprintf(&str[str_index], Int_FORMAT, li); traverse_update_arity(str, &str_index, arity); if (type == TRAVERSE_TYPE_SUBGOAL) mode = TRAVERSE_MODE_NORMAL; - else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */ + else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || + TRAVERSE_TYPE_GT_ANSWER */ mode = TRAVERSE_MODE_LONGINT_END; } else if (mode == TRAVERSE_MODE_LONGINT_END) { mode = TRAVERSE_MODE_NORMAL; - } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { - str_index += Yap_OpaqueTermToString(AbsAppl((CELL *)t), str+str_index, 0); + } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { + str_index += Yap_OpaqueTermToString(AbsAppl((CELL *)t), str + str_index, 0); traverse_update_arity(str, &str_index, arity); if (type == TRAVERSE_TYPE_SUBGOAL) mode = TRAVERSE_MODE_NORMAL; - else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */ + else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || + TRAVERSE_TYPE_GT_ANSWER */ mode = TRAVERSE_MODE_BIGINT_OR_STRING_END; } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING_END) { mode = TRAVERSE_MODE_NORMAL; } else if (IsVarTerm(t)) { #ifdef TRIE_RATIONAL_TERMS - if (t > VarIndexOfTableTerm(MAX_TABLE_VARS) && TrNode_child((gt_node_ptr) t) != (gt_node_ptr)1) { //TODO: substitute the != 1 test to something more appropriate + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS) && + TrNode_child((gt_node_ptr)t) != + (gt_node_ptr)1) { // TODO: substitute the != 1 test to something + // more appropriate /* Rational term */ - str_index += sprintf(& str[str_index], "**"); + str_index += sprintf(&str[str_index], "**"); traverse_update_arity(str, &str_index, arity); - } else + } else #endif /* RATIONAL TERM SUPPORT FOR TRIES */ - if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { TrStat_gt_refs++; /* (type % 2 + 2): TRAVERSE_TYPE_ANSWER --> TRAVERSE_TYPE_GT_ANSWER */ /* (type % 2 + 2): TRAVERSE_TYPE_SUBGOAL --> TRAVERSE_TYPE_GT_SUBGOAL */ - traverse_global_trie_for_term((gt_node_ptr) t, str, &str_index, arity, &mode, type % 2 + 2 PASS_REGS); + traverse_global_trie_for_term((gt_node_ptr)t, str, &str_index, arity, + &mode, type % 2 + 2 PASS_REGS); } else { if (type == TRAVERSE_TYPE_SUBGOAL || type == TRAVERSE_TYPE_GT_SUBGOAL) - str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); - else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_ANSWER */ - str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); + str_index += sprintf(&str[str_index], "VAR%d", VarIndexOfTableTerm(t)); + else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_ANSWER */ + str_index += + sprintf(&str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); traverse_update_arity(str, &str_index, arity); } } else if (IsIntTerm(t)) { - str_index += sprintf(& str[str_index], Int_FORMAT, IntOfTerm(t)); + str_index += sprintf(&str[str_index], Int_FORMAT, IntOfTerm(t)); traverse_update_arity(str, &str_index, arity); } else if (IsAtomTerm(t)) { #ifndef TRIE_COMPACT_PAIRS @@ -960,7 +1035,7 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int arity[0]--; } else #endif /* TRIE_COMPACT_PAIRS */ - str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); + str_index += sprintf(&str[str_index], "%s", AtomName(AtomOfTerm(t))); traverse_update_arity(str, &str_index, arity); } else if (IsPairTerm(t)) { #ifdef TRIE_COMPACT_PAIRS @@ -975,12 +1050,12 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int arity[arity[0]] = -2; #endif /* TRIE_COMPACT_PAIRS */ } else { - str_index += sprintf(& str[str_index], "["); + str_index += sprintf(&str[str_index], "["); arity[0]++; arity[arity[0]] = -2; } } else if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); + Functor f = (Functor)RepAppl(t); if (f == FunctorDouble) { mode = TRAVERSE_MODE_DOUBLE; } else if (f == FunctorLongInt) { @@ -989,12 +1064,12 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int mode = TRAVERSE_MODE_BIGINT_OR_STRING; } else if (f == FunctorComma) { if (arity[arity[0]] != -3) { - str_index += sprintf(& str[str_index], "("); - arity[0]++; + str_index += sprintf(&str[str_index], "("); + arity[0]++; } arity[arity[0]] = -4; } else { - str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); + str_index += sprintf(&str[str_index], "%s(", AtomName(NameOfFunctor(f))); arity[0]++; arity[arity[0]] = ArityOfFunctor(f); } @@ -1005,46 +1080,44 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int return; } - -static inline void traverse_update_arity(char *str, int *str_index_ptr, int *arity) { +static inline void traverse_update_arity(char *str, int *str_index_ptr, + int *arity) { int str_index = *str_index_ptr; while (arity[0]) { if (arity[arity[0]] > 0) { arity[arity[0]]--; if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; + str_index += sprintf(&str[str_index], ")"); + arity[0]--; } else { - str_index += sprintf(& str[str_index], ","); - break; + str_index += sprintf(&str[str_index], ","); + break; } } else { if (arity[arity[0]] == -4) { - str_index += sprintf(& str[str_index], ","); - arity[arity[0]] = -3; - break; + str_index += sprintf(&str[str_index], ","); + arity[arity[0]] = -3; + break; } else if (arity[arity[0]] == -3) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; + str_index += sprintf(&str[str_index], ")"); + arity[0]--; } else if (arity[arity[0]] == -2) { #ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); #else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; + str_index += sprintf(&str[str_index], "|"); + arity[arity[0]] = -1; #endif /* TRIE_COMPACT_PAIRS */ - break; + break; } else if (arity[arity[0]] == -1) { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; + str_index += sprintf(&str[str_index], "]"); + arity[0]--; } } } *str_index_ptr = str_index; } - - /******************************* ** Global functions ** *******************************/ @@ -1073,28 +1146,40 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { if (mode_directed) { int old_subs_arity = subs_arity; for (i = 1; i <= pred_arity; i++) { - int j = MODE_DIRECTED_GET_ARG(mode_directed[i-1]) + 1; - current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]), &subs_arity, &stack_vars PASS_REGS); + int j = MODE_DIRECTED_GET_ARG(mode_directed[i - 1]) + 1; + current_sg_node = + subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]), + &subs_arity, &stack_vars PASS_REGS); if (subs_arity != old_subs_arity) { - if (subs_pos && MODE_DIRECTED_GET_MODE(aux_mode_directed[subs_pos-1]) == MODE_DIRECTED_GET_MODE(mode_directed[i-1])) { - /* same mode as before -> use the current entry in the aux_mode_directed[] array */ - aux_mode_directed[subs_pos-1] += MODE_DIRECTED_SET(subs_arity - old_subs_arity, 0); - } else { - /* new mode -> init a new entry in the aux_mode_directed[] array */ - aux_mode_directed[subs_pos] = MODE_DIRECTED_SET(subs_arity - old_subs_arity, MODE_DIRECTED_GET_MODE(mode_directed[i-1])); - subs_pos++; - } - old_subs_arity = subs_arity; + if (subs_pos && + MODE_DIRECTED_GET_MODE(aux_mode_directed[subs_pos - 1]) == + MODE_DIRECTED_GET_MODE(mode_directed[i - 1])) { + /* same mode as before -> use the current entry in the + * aux_mode_directed[] array */ + aux_mode_directed[subs_pos - 1] += + MODE_DIRECTED_SET(subs_arity - old_subs_arity, 0); + } else { + /* new mode -> init a new entry in the aux_mode_directed[] array */ + aux_mode_directed[subs_pos] = + MODE_DIRECTED_SET(subs_arity - old_subs_arity, + MODE_DIRECTED_GET_MODE(mode_directed[i - 1])); + subs_pos++; + } + old_subs_arity = subs_arity; } } } else #endif /* MODE_DIRECTED_TABLING */ - if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) { + if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) { for (i = 1; i <= pred_arity; i++) - current_sg_node = subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars PASS_REGS); + current_sg_node = + subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]), + &subs_arity, &stack_vars PASS_REGS); } else { for (i = 1; i <= pred_arity; i++) - current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars PASS_REGS); + current_sg_node = + subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), + &subs_arity, &stack_vars PASS_REGS); } STACK_PUSH_UP(subs_arity, stack_vars); @@ -1105,16 +1190,18 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { RESET_VARIABLE(t); } - sg_fr_ptr *sg_fr_end = get_insert_subgoal_frame_addr(current_sg_node PASS_REGS); + sg_fr_ptr *sg_fr_end = + get_insert_subgoal_frame_addr(current_sg_node PASS_REGS); #ifndef THREADS LOCK_SUBGOAL_NODE(current_sg_node); #endif /* !THREADS */ if (*sg_fr_end == NULL) { - /* new tabled subgoal */ +/* new tabled subgoal */ #ifdef MODE_DIRECTED_TABLING if (subs_pos) { - ALLOC_BLOCK(mode_directed, subs_pos*sizeof(int), int); - memcpy((void *)mode_directed, (void *)aux_mode_directed, subs_pos*sizeof(int)); + ALLOC_BLOCK(mode_directed, subs_pos * sizeof(int), int); + memcpy((void *)mode_directed, (void *)aux_mode_directed, + subs_pos * sizeof(int)); } else mode_directed = NULL; #endif /* MODE_DIRECTED_TABLING */ @@ -1125,7 +1212,8 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node); UNLOCK_SUBGOAL_NODE(current_sg_node); #else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ - sg_ent_ptr sg_ent = (sg_ent_ptr) UNTAG_SUBGOAL_NODE(TrNode_sg_ent(current_sg_node)); + sg_ent_ptr sg_ent = + (sg_ent_ptr)UNTAG_SUBGOAL_NODE(TrNode_sg_ent(current_sg_node)); new_subgoal_frame(sg_fr, sg_ent); #ifdef THREADS_CONSUMER_SHARING SgFr_state(sg_fr) = ready_external; @@ -1135,12 +1223,12 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { if (SgEnt_sg_ent_state(sg_ent) == ready) { LOCK(SgEnt_lock(sg_ent)); if (SgEnt_sg_ent_state(sg_ent) == ready) { - SgEnt_code(sg_ent) = preg; - SgEnt_init_mode_directed_fields(sg_ent, mode_directed); - SgEnt_sg_ent_state(sg_ent) = evaluating; + SgEnt_code(sg_ent) = preg; + SgEnt_init_mode_directed_fields(sg_ent, mode_directed); + SgEnt_sg_ent_state(sg_ent) = evaluating; #ifdef THREADS_CONSUMER_SHARING - SgEnt_gen_worker(sg_ent) = worker_id; - SgFr_state(sg_fr) = ready; + SgEnt_gen_worker(sg_ent) = worker_id; + SgFr_state(sg_fr) = ready; #endif /* THREADS_CONSUMER_SHARING */ } UNLOCK(SgEnt_lock(sg_ent)); @@ -1148,13 +1236,13 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { *sg_fr_end = sg_fr; #endif /* !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */ } else { - /* repeated tabled subgoal */ +/* repeated tabled subgoal */ #ifndef THREADS UNLOCK_SUBGOAL_NODE(current_sg_node); #endif /* !THREADS */ - sg_fr = (sg_fr_ptr) UNTAG_SUBGOAL_NODE(*sg_fr_end); + sg_fr = (sg_fr_ptr)UNTAG_SUBGOAL_NODE(*sg_fr_end); #ifdef LIMIT_TABLING - if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */ + if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */ remove_from_global_sg_fr_list(sg_fr); } #endif /* LIMIT_TABLING */ @@ -1163,7 +1251,6 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { return sg_fr; } - ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { #define subs_arity *subs_ptr CACHE_REGS @@ -1177,17 +1264,19 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { if (IsMode_GlobalTrie(TabEnt_mode(SgFr_tab_ent(sg_fr)))) { for (i = subs_arity; i >= 1; i--) { TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i])); - current_ans_node = answer_search_terms_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); + current_ans_node = answer_search_terms_loop( + sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); } } else { for (i = subs_arity; i >= 1; i--) { TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i])); - current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); + current_ans_node = answer_search_loop( + sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); } } /* reset variables */ - stack_vars = (CELL *) TR; + stack_vars = (CELL *)TR; while (vars_arity--) { Term t = STACK_POP_DOWN(stack_vars); RESET_VARIABLE(t); @@ -1197,7 +1286,6 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { #undef subs_arity } - #ifdef MODE_DIRECTED_TABLING ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { #define subs_arity *subs_ptr @@ -1219,65 +1307,84 @@ ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { do { TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i])); if (mode == MODE_DIRECTED_INDEX || mode == MODE_DIRECTED_ALL) { - current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); + current_ans_node = answer_search_loop( + sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); } else { - LOCK_ANSWER_NODE(current_ans_node); - if (TrNode_child(current_ans_node) == NULL) { + LOCK_ANSWER_NODE(current_ans_node); + if (TrNode_child(current_ans_node) == NULL) { #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) - struct answer_trie_node virtual_ans_node; /* necessary because the answer_search_loop() procedure also locks the parent node */ - ans_node_ptr parent_ans_node = current_ans_node; - AnsNode_init_lock_field(&virtual_ans_node); - TrNode_parent(&virtual_ans_node) = NULL; - TrNode_child(&virtual_ans_node) = NULL; - current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); - TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node); - TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node; + struct answer_trie_node + virtual_ans_node; /* necessary because the answer_search_loop() + procedure also locks the parent node */ + ans_node_ptr parent_ans_node = current_ans_node; + AnsNode_init_lock_field(&virtual_ans_node); + TrNode_parent(&virtual_ans_node) = NULL; + TrNode_child(&virtual_ans_node) = NULL; + current_ans_node = + answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), + &vars_arity PASS_REGS); + TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node); + TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node; #else - current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); + current_ans_node = + answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), + &vars_arity PASS_REGS); #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ - } else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX) { - ans_node_ptr parent_ans_node = current_ans_node; - invalid_ans_node = TrNode_child(parent_ans_node); /* by default, assume a better answer */ - current_ans_node = answer_search_min_max(sg_fr, current_ans_node, Deref(subs_ptr[i]), mode PASS_REGS); - if (invalid_ans_node == TrNode_child(parent_ans_node)) /* worse or equal answer */ - invalid_ans_node = NULL; - } else if (mode == MODE_DIRECTED_SUM) { - invalid_ans_node = TrNode_child(current_ans_node); - current_ans_node = answer_search_sum(sg_fr, current_ans_node, Deref(subs_ptr[i]) PASS_REGS); - } else if (mode == MODE_DIRECTED_LAST) { + } else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX) { + ans_node_ptr parent_ans_node = current_ans_node; + invalid_ans_node = TrNode_child( + parent_ans_node); /* by default, assume a better answer */ + current_ans_node = answer_search_min_max( + sg_fr, current_ans_node, Deref(subs_ptr[i]), mode PASS_REGS); + if (invalid_ans_node == + TrNode_child(parent_ans_node)) /* worse or equal answer */ + invalid_ans_node = NULL; + } else if (mode == MODE_DIRECTED_SUM) { + invalid_ans_node = TrNode_child(current_ans_node); + current_ans_node = answer_search_sum(sg_fr, current_ans_node, + Deref(subs_ptr[i]) PASS_REGS); + } else if (mode == MODE_DIRECTED_LAST) { #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) - struct answer_trie_node virtual_ans_node; /* necessary because the answer_search_loop() procedure also locks the parent node */ - ans_node_ptr parent_ans_node = current_ans_node; - invalid_ans_node = TrNode_child(parent_ans_node); - AnsNode_init_lock_field(&virtual_ans_node); - TrNode_parent(&virtual_ans_node) = NULL; - TrNode_child(&virtual_ans_node) = NULL; - current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); - TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node); - TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node; + struct answer_trie_node + virtual_ans_node; /* necessary because the answer_search_loop() + procedure also locks the parent node */ + ans_node_ptr parent_ans_node = current_ans_node; + invalid_ans_node = TrNode_child(parent_ans_node); + AnsNode_init_lock_field(&virtual_ans_node); + TrNode_parent(&virtual_ans_node) = NULL; + TrNode_child(&virtual_ans_node) = NULL; + current_ans_node = + answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), + &vars_arity PASS_REGS); + TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node); + TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node; #else - invalid_ans_node = TrNode_child(current_ans_node); - TrNode_child(current_ans_node) = NULL; - current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS); + invalid_ans_node = TrNode_child(current_ans_node); + TrNode_child(current_ans_node) = NULL; + current_ans_node = + answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), + &vars_arity PASS_REGS); #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ - } else if (mode == MODE_DIRECTED_FIRST) { - current_ans_node = NULL; - } else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "mode_directed_answer_search: unknown mode"); - UNLOCK_ANSWER_NODE(current_ans_node); + } else if (mode == MODE_DIRECTED_FIRST) { + current_ans_node = NULL; + } else + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "mode_directed_answer_search: unknown mode"); + UNLOCK_ANSWER_NODE(current_ans_node); } n_subs--; i--; } while (n_subs && current_ans_node); - if (current_ans_node == NULL) /* no answer inserted */ + if (current_ans_node == NULL) /* no answer inserted */ break; j++; } if (invalid_ans_node) - invalidate_answer_trie(invalid_ans_node, sg_fr, TRAVERSE_POSITION_FIRST PASS_REGS); - + invalidate_answer_trie(invalid_ans_node, sg_fr, + TRAVERSE_POSITION_FIRST PASS_REGS); + /* reset variables */ - stack_vars = (CELL *) TR; + stack_vars = (CELL *)TR; while (vars_arity--) { Term t = STACK_POP_DOWN(stack_vars); RESET_VARIABLE(t); @@ -1288,7 +1395,6 @@ ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { } #endif /* MODE_DIRECTED_TABLING */ - void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { CACHE_REGS #define subs_arity *subs_ptr @@ -1303,7 +1409,7 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { for (i = subs_arity; i >= 1; i--) { Term t = STACK_POP_DOWN(stack_terms); - YapBind((CELL *) subs_ptr[i], t); + YapBind((CELL *)subs_ptr[i], t); } TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)LOCAL_TrailTop); @@ -1311,40 +1417,42 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { #undef subs_arity } - CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) { CACHE_REGS #define subs_arity *subs_ptr CELL *stack_terms, *subs_ptr; Term t; - ++aux_stack; /* skip the heap_arity entry */ - stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) LOCAL_TrailTop PASS_REGS); - *--aux_stack = 0; /* restore the heap_arity entry */ + ++aux_stack; /* skip the heap_arity entry */ + stack_terms = exec_substitution_loop(current_node, &aux_stack, + (CELL *)LOCAL_TrailTop PASS_REGS); + *--aux_stack = 0; /* restore the heap_arity entry */ subs_ptr = aux_stack + aux_stack[1] + 2; t = STACK_POP_DOWN(stack_terms); - YapBind((CELL *) subs_ptr[subs_arity], t); - TABLING_ERROR_CHECKING(exec_substitution, stack_terms != (CELL *)LOCAL_TrailTop); + YapBind((CELL *)subs_ptr[subs_arity], t); + TABLING_ERROR_CHECKING(exec_substitution, + stack_terms != (CELL *)LOCAL_TrailTop); *subs_ptr = subs_arity - 1; return aux_stack; #undef subs_arity } - void update_answer_trie(sg_fr_ptr sg_fr) { ans_node_ptr current_node; free_answer_hash_chain(SgFr_hash_chain(sg_fr)); SgFr_hash_chain(sg_fr) = NULL; - SgFr_state(sg_fr) += 2; /* complete --> compiled : complete_in_use --> compiled_in_use */ + SgFr_state(sg_fr) += + 2; /* complete --> compiled : complete_in_use --> compiled_in_use */ #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) - SgFr_sg_ent_state(sg_fr) += 2; /* complete --> compiled */ + SgFr_sg_ent_state(sg_fr) += 2; /* complete --> compiled */ #ifdef THREADS_FULL_SHARING if (IsMode_Batched(TabEnt_mode(SgFr_tab_ent(sg_fr)))) { - /* cleaning bits used by batched mode and shifting the instruction back to the original place */ + /* cleaning bits used by batched mode and shifting the instruction back to + * the original place */ ans_node_ptr leaf_ans_trie_node = SgFr_first_answer(sg_fr); while (TrNode_child(leaf_ans_trie_node) != NULL) { ANSWER_LEAF_NODE_INSTR_ABSOLUTE(leaf_ans_trie_node); @@ -1363,31 +1471,30 @@ void update_answer_trie(sg_fr_ptr sg_fr) { #else update_answer_trie_branch(current_node); #endif /* TABLING_INNER_CUTS */ -#else /* TABLING */ +#else /* TABLING */ update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST); #endif /* YAPOR */ } return; } - void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) { CACHE_REGS if (IS_SUBGOAL_TRIE_HASH(current_node)) { sg_node_ptr *bucket, *last_bucket; sg_hash_ptr hash; - hash = (sg_hash_ptr) current_node; + hash = (sg_hash_ptr)current_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); do { if (*bucket) { - sg_node_ptr next_node = *bucket; - do { - current_node = next_node; - next_node = TrNode_next(current_node); - free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT); - } while (next_node); + sg_node_ptr next_node = *bucket; + do { + current_node = next_node; + next_node = TrNode_next(current_node); + free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT); + } while (next_node); } } while (++bucket != last_bucket); IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES { @@ -1396,22 +1503,22 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) { } return; } - if (! IS_SUBGOAL_LEAF_NODE(current_node)) { + if (!IS_SUBGOAL_LEAF_NODE(current_node)) { int child_mode; if (mode == TRAVERSE_MODE_NORMAL) { Term t = TrNode_entry(current_node); if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) - child_mode = TRAVERSE_MODE_DOUBLE; - else if (f == FunctorLongInt) - child_mode = TRAVERSE_MODE_LONGINT; - else if (f == FunctorBigInt || f == FunctorString) - child_mode = TRAVERSE_MODE_BIGINT_OR_STRING; - else - child_mode = TRAVERSE_MODE_NORMAL; + Functor f = (Functor)RepAppl(t); + if (f == FunctorDouble) + child_mode = TRAVERSE_MODE_DOUBLE; + else if (f == FunctorLongInt) + child_mode = TRAVERSE_MODE_LONGINT; + else if (f == FunctorBigInt || f == FunctorString) + child_mode = TRAVERSE_MODE_BIGINT_OR_STRING; + else + child_mode = TRAVERSE_MODE_NORMAL; } else - child_mode = TRAVERSE_MODE_NORMAL; + child_mode = TRAVERSE_MODE_NORMAL; } else if (mode == TRAVERSE_MODE_LONGINT) { child_mode = TRAVERSE_MODE_LONGINT_END; } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { @@ -1426,7 +1533,8 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) { } else { child_mode = TRAVERSE_MODE_NORMAL; } - free_subgoal_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST); + free_subgoal_trie(TrNode_child(current_node), child_mode, + TRAVERSE_POSITION_FIRST); } else { sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(current_node PASS_REGS); if (sg_fr) { @@ -1434,35 +1542,38 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) { free_answer_hash_chain(SgFr_hash_chain(sg_fr)); ans_node = SgFr_answer_trie(sg_fr); if (TrNode_child(ans_node)) - free_answer_trie(TrNode_child(ans_node), TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); + free_answer_trie(TrNode_child(ans_node), TRAVERSE_MODE_NORMAL, + TRAVERSE_POSITION_FIRST); IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES { - FREE_ANSWER_TRIE_NODE(ans_node); + FREE_ANSWER_TRIE_NODE(ans_node); #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) #ifdef MODE_DIRECTED_TABLING - if (SgEnt_mode_directed(SgFr_sg_ent(sg_fr))) - FREE_BLOCK(SgEnt_mode_directed(SgFr_sg_ent(sg_fr))); - if (SgFr_invalid_chain(sg_fr)) { - ans_node_ptr current_node, next_node; - /* free invalid answer nodes */ - current_node = SgFr_invalid_chain(sg_fr); - SgFr_invalid_chain(sg_fr) = NULL; - while (current_node) { - next_node = TrNode_next(current_node); - FREE_ANSWER_TRIE_NODE(current_node); - current_node = next_node; - } - } + if (SgEnt_mode_directed(SgFr_sg_ent(sg_fr))) + FREE_BLOCK(SgEnt_mode_directed(SgFr_sg_ent(sg_fr))); + if (SgFr_invalid_chain(sg_fr)) { + ans_node_ptr current_node, next_node; + /* free invalid answer nodes */ + current_node = SgFr_invalid_chain(sg_fr); + SgFr_invalid_chain(sg_fr) = NULL; + while (current_node) { + next_node = TrNode_next(current_node); + FREE_ANSWER_TRIE_NODE(current_node); + current_node = next_node; + } + } #endif /* MODE_DIRECTED_TABLING */ - FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr)); + FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr)); #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ } #ifdef LIMIT_TABLING remove_from_global_sg_fr_list(sg_fr); #endif /* LIMIT_TABLING */ -#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING) +#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && \ + !defined(THREADS_CONSUMER_SHARING) if (SgFr_mode_directed(sg_fr)) - FREE_BLOCK(SgFr_mode_directed(sg_fr)); -#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */ + FREE_BLOCK(SgFr_mode_directed(sg_fr)); +#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && \ + !THREADS_CONSUMER_SHARING */ FREE_SUBGOAL_FRAME(sg_fr); } } @@ -1486,30 +1597,29 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) { return; } - void free_answer_trie(ans_node_ptr current_node, int mode, int position) { CACHE_REGS #ifdef TABLING_INNER_CUTS - if (! IS_ANSWER_LEAF_NODE(current_node) && TrNode_child(current_node)) { + if (!IS_ANSWER_LEAF_NODE(current_node) && TrNode_child(current_node)) { #else - if (! IS_ANSWER_LEAF_NODE(current_node)) { + if (!IS_ANSWER_LEAF_NODE(current_node)) { #endif /* TABLING_INNER_CUTS */ int child_mode; if (mode == TRAVERSE_MODE_NORMAL) { Term t = TrNode_entry(current_node); if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) - child_mode = TRAVERSE_MODE_DOUBLE; - else if (f == FunctorLongInt) - child_mode = TRAVERSE_MODE_LONGINT; - else if (f == FunctorBigInt || f == FunctorString) - child_mode = TRAVERSE_MODE_BIGINT_OR_STRING; - else - child_mode = TRAVERSE_MODE_NORMAL; + Functor f = (Functor)RepAppl(t); + if (f == FunctorDouble) + child_mode = TRAVERSE_MODE_DOUBLE; + else if (f == FunctorLongInt) + child_mode = TRAVERSE_MODE_LONGINT; + else if (f == FunctorBigInt || f == FunctorString) + child_mode = TRAVERSE_MODE_BIGINT_OR_STRING; + else + child_mode = TRAVERSE_MODE_NORMAL; } else - child_mode = TRAVERSE_MODE_NORMAL; + child_mode = TRAVERSE_MODE_NORMAL; } else if (mode == TRAVERSE_MODE_LONGINT) { child_mode = TRAVERSE_MODE_LONGINT_END; } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) { @@ -1524,7 +1634,8 @@ void free_answer_trie(ans_node_ptr current_node, int mode, int position) { } else { child_mode = TRAVERSE_MODE_NORMAL; } - free_answer_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST); + free_answer_trie(TrNode_child(current_node), child_mode, + TRAVERSE_POSITION_FIRST); } if (position == TRAVERSE_POSITION_FIRST) { ans_node_ptr next_node = TrNode_next(current_node); @@ -1546,7 +1657,6 @@ void free_answer_trie(ans_node_ptr current_node, int mode, int position) { return; } - void free_answer_hash_chain(ans_hash_ptr hash) { #if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING) CACHE_REGS @@ -1558,10 +1668,11 @@ void free_answer_hash_chain(ans_hash_ptr hash) { bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); - while (! *bucket) + while (!*bucket) bucket++; chain_node = *bucket; - TrNode_child((ans_node_ptr) UNTAG_ANSWER_NODE(TrNode_parent(chain_node))) = chain_node; + TrNode_child((ans_node_ptr)UNTAG_ANSWER_NODE(TrNode_parent(chain_node))) = + chain_node; while (++bucket != last_bucket) { if (*bucket) { while (TrNode_next(chain_node)) @@ -1578,10 +1689,11 @@ void free_answer_hash_chain(ans_hash_ptr hash) { return; } - /***************************************************************************************** -** all threads abolish their local data structures, and the main thread also abolishes ** -** all shared data structures, if no other thread is running (GLOBAL_NOfThreads == 1). ** +** all threads abolish their local data structures, and the main thread also +*abolishes ** +** all shared data structures, if no other thread is running (GLOBAL_NOfThreads +*== 1). ** *****************************************************************************************/ void abolish_table(tab_ent_ptr tab_ent) { CACHE_REGS @@ -1610,24 +1722,25 @@ void abolish_table(tab_ent_ptr tab_ent) { if (sg_node) { if (TrNode_child(sg_node)) { if (TabEnt_arity(tab_ent)) { - free_subgoal_trie(TrNode_child(sg_node), TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); + free_subgoal_trie(TrNode_child(sg_node), TRAVERSE_MODE_NORMAL, + TRAVERSE_POSITION_FIRST); } else { - sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(sg_node PASS_REGS); - if (sg_fr) { - IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES { - FREE_ANSWER_TRIE_NODE(SgFr_answer_trie(sg_fr)); + sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(sg_node PASS_REGS); + if (sg_fr) { + IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES { + FREE_ANSWER_TRIE_NODE(SgFr_answer_trie(sg_fr)); #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING) - FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr)); + FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr)); #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ - } + } #ifdef LIMIT_TABLING - remove_from_global_sg_fr_list(sg_fr); + remove_from_global_sg_fr_list(sg_fr); #endif /* LIMIT_TABLING */ - FREE_SUBGOAL_FRAME(sg_fr); - } + FREE_SUBGOAL_FRAME(sg_fr); + } } IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES - TrNode_child(sg_node) = NULL; + TrNode_child(sg_node) = NULL; } #ifdef THREADS_NO_SHARING FREE_SUBGOAL_TRIE_NODE(sg_node); @@ -1636,7 +1749,6 @@ void abolish_table(tab_ent_ptr tab_ent) { return; } - void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { CACHE_REGS sg_node_ptr sg_node; @@ -1655,9 +1767,11 @@ void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { TrStat_ans_nodes = 0; TrStat_gt_refs = 0; if (show_mode == SHOW_MODE_STATISTICS) - fprintf(TrStat_out, "Table statistics for predicate '%s", AtomName(TabEnt_atom(tab_ent))); - else /* SHOW_MODE_STRUCTURE */ - fprintf(TrStat_out, "Table structure 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 */ + 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); @@ -1665,25 +1779,26 @@ void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { for (i = 0; i < TabEnt_arity(tab_ent); i++) { int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]); if (mode == MODE_DIRECTED_INDEX) { - fprintf(TrStat_out, "index"); + fprintf(TrStat_out, "index"); } else if (mode == MODE_DIRECTED_MIN) { - fprintf(TrStat_out, "min"); + fprintf(TrStat_out, "min"); } else if (mode == MODE_DIRECTED_MAX) { - fprintf(TrStat_out, "max"); + fprintf(TrStat_out, "max"); } else if (mode == MODE_DIRECTED_ALL) { - fprintf(TrStat_out, "all"); + fprintf(TrStat_out, "all"); } else if (mode == MODE_DIRECTED_SUM) { - fprintf(TrStat_out, "sum"); + fprintf(TrStat_out, "sum"); } else if (mode == MODE_DIRECTED_LAST) { - fprintf(TrStat_out, "last"); + fprintf(TrStat_out, "last"); } else if (mode == MODE_DIRECTED_FIRST) { - fprintf(TrStat_out, "first"); + fprintf(TrStat_out, "first"); } else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "show_table: unknown mode"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "show_table: unknown mode"); if (i != MODE_DIRECTED_GET_ARG(mode_directed[i])) - fprintf(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)) - fprintf(TrStat_out, ","); + fprintf(TrStat_out, ","); } fprintf(TrStat_out, ")'\n"); } else @@ -1693,33 +1808,36 @@ void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { if (sg_node) { if (TrNode_child(sg_node)) { if (TabEnt_arity(tab_ent)) { - char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); - int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); - arity[0] = 1; - arity[1] = TabEnt_arity(tab_ent); - int str_index = sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent))); - traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS); - free(str); - free(arity); + char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); + int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); + arity[0] = 1; + arity[1] = TabEnt_arity(tab_ent); + int str_index = + sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent))); + traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, + TRAVERSE_MODE_NORMAL, + TRAVERSE_POSITION_FIRST PASS_REGS); + free(str); + free(arity); } else { - sg_fr_ptr sg_fr = get_subgoal_frame(sg_node); - if (sg_fr) { - TrStat_subgoals++; - SHOW_TABLE_STRUCTURE(" ?- %s.\n", AtomName(TabEnt_atom(tab_ent))); - TrStat_ans_nodes++; - if (SgFr_first_answer(sg_fr) == NULL) { - if (SgFr_state(sg_fr) < complete) { - TrStat_sg_incomplete++; - SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); - } else { - TrStat_answers_no++; - SHOW_TABLE_STRUCTURE(" NO\n"); - } - } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */ - TrStat_answers_true++; - SHOW_TABLE_STRUCTURE(" TRUE\n"); - } - } + sg_fr_ptr sg_fr = get_subgoal_frame(sg_node); + if (sg_fr) { + TrStat_subgoals++; + SHOW_TABLE_STRUCTURE(" ?- %s.\n", AtomName(TabEnt_atom(tab_ent))); + TrStat_ans_nodes++; + if (SgFr_first_answer(sg_fr) == NULL) { + if (SgFr_state(sg_fr) < complete) { + TrStat_sg_incomplete++; + SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n"); + } else { + TrStat_answers_no++; + SHOW_TABLE_STRUCTURE(" NO\n"); + } + } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */ + TrStat_answers_true++; + SHOW_TABLE_STRUCTURE(" TRUE\n"); + } + } } } } @@ -1727,11 +1845,13 @@ void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { SHOW_TABLE_STRUCTURE(" EMPTY\n"); if (show_mode == SHOW_MODE_STATISTICS) { fprintf(TrStat_out, " Subgoal trie structure\n"); - fprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete); + 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 - fprintf(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 fprintf(TrStat_out, " Answers: %ld\n", TrStat_answers); #endif /* TABLING_INNER_CUTS */ @@ -1743,7 +1863,6 @@ void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) { return; } - void showGlobalTrie(int show_mode, FILE *out) { CACHE_REGS @@ -1754,13 +1873,15 @@ void showGlobalTrie(int show_mode, FILE *out) { TrStat_gt_refs = 0; if (show_mode == SHOW_MODE_STATISTICS) fprintf(TrStat_out, "Global trie statistics\n"); - else /* SHOW_MODE_STRUCTURE */ + else /* SHOW_MODE_STRUCTURE */ 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); + char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); + int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); arity[0] = 0; - traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS); + traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, + TRAVERSE_MODE_NORMAL, + TRAVERSE_POSITION_FIRST PASS_REGS); free(str); free(arity); } else diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index f52e9a00b..ce735dc05 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -128,26 +128,26 @@ set(C_INTERFACE_SOURCES H/compile.h H/corout.h H/dlmalloc.h - H/dglobals.h - H/dlocals.h - H/dhstruct.h + H/heap/dglobals.h + H/heap/dlocals.h + H/heap/dhstruct.h H/eval.h H/heapgc.h - H/hglobals.h - H/hlocals.h - H/hstruct.h - H/iglobals.h - H/ihstruct.h - H/ilocals.h + H/heap/hglobals.h + H/heap/hlocals.h + H/heap/hstruct.h + H/heap/iglobals.h + H/heap/ihstruct.h + H/heap/ilocals.h H/index.h H/inline-only.h H/iswiatoms.h H/qly.h H/rclause.h - H/rglobals.h - H/rlocals.h + H/heap/rglobals.h + H/heap/rlocals.h H/rheap.h - H/rhstruct.h + H/heap/rhstruct.h H/threads.h H/tracer.h H/trim_trail.h diff --git a/config.h.cmake b/config.h.cmake index 67af7a831..11b4b1e4e 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -8,6 +8,7 @@ #define CONFIG_H /* config.h.in. Generated from configure.in by autoheader. */ + #define SYSTEM_OPTIONS "${YAP_SYSTEM_OPTIONS}" /* Define if building universal (internal helper macro) */ #ifndef AC_APPLE_UNIVERSAL_BUILD diff --git a/include/YapErrors.h b/include/YapErrors.h index 7d31d6354..ab05c44af 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -1,156 +1,153 @@ BEGIN_ERROR_CLASSES() - ECLASS(NO_ERROR, "no_error", 0) - ECLASS(DOMAIN_ERROR, "domain_error", 2) - ECLASS(EVALUATION_ERROR, "evaluation_error", 2) - ECLASS(EXISTENCE_ERROR, "existence_error", 2) - ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0) - ECLASS(PERMISSION_ERROR, "permission_error", 3) - ECLASS(REPRESENTATION_ERROR, "representation_error", 2) - ECLASS(RESOURCE_ERROR, "resource_error", 2) - ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 2) - ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2) - ECLASS(TYPE_ERROR, "type_error", 2) - ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1) - ECLASS(EVENT, "event", 2) +ECLASS(NO_ERROR, "no_error", 0) +ECLASS(DOMAIN_ERROR, "domain_error", 2) +ECLASS(EVALUATION_ERROR, "evaluation_error", 2) +ECLASS(EXISTENCE_ERROR, "existence_error", 2) +ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0) +ECLASS(PERMISSION_ERROR, "permission_error", 3) +ECLASS(REPRESENTATION_ERROR, "representation_error", 2) +ECLASS(RESOURCE_ERROR, "resource_error", 2) +ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 2) +ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2) +ECLASS(TYPE_ERROR, "type_error", 2) +ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1) +ECLASS(EVENT, "event", 2) - END_ERROR_CLASSES(); +END_ERROR_CLASSES(); BEGIN_ERRORS() /* ISO_ERRORS */ - E0(YAP_NO_ERROR, NO_ERROR) +E0(YAP_NO_ERROR, NO_ERROR) - E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR, "absolute_file_name_option") - E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow") - E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type") - E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors") - E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type") - E(DOMAIN_ERROR_IO_MODE, DOMAIN_ERROR, "io_mode") - E(DOMAIN_ERROR_MUTABLE, DOMAIN_ERROR, "mutable") - E(DOMAIN_ERROR_NON_EMPTY_LIST, DOMAIN_ERROR, "non_empty_list") - E(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, DOMAIN_ERROR, "not_less_than_zero") - E(DOMAIN_ERROR_NOT_NL, DOMAIN_ERROR, "not_nl") - E(DOMAIN_ERROR_NOT_ZERO, DOMAIN_ERROR, "not_zero") - E(DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR, "out_of_range") - E(DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR, "operator_priority") - E(DOMAIN_ERROR_OPERATOR_SPECIFIER, DOMAIN_ERROR, "operator_specifier") - E(DOMAIN_ERROR_PROLOG_FLAG, DOMAIN_ERROR, "prolog_flag") - E(DOMAIN_ERROR_RADIX, DOMAIN_ERROR, "radix") - E(DOMAIN_ERROR_READ_OPTION, DOMAIN_ERROR, "read_option") - E(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, DOMAIN_ERROR, "shift_count_overflow") - E(DOMAIN_ERROR_SOURCE_SINK, DOMAIN_ERROR, "source_sink") - E(DOMAIN_ERROR_SOLUTIONS, DOMAIN_ERROR, "solutions") - E(DOMAIN_ERROR_STREAM, DOMAIN_ERROR, "stream") - E(DOMAIN_ERROR_STREAM_ENCODING, DOMAIN_ERROR, "stream_encoding") - E(DOMAIN_ERROR_STREAM_OR_ALIAS, DOMAIN_ERROR, "stream_or_alias") - E(DOMAIN_ERROR_STREAM_POSITION, DOMAIN_ERROR, "stream_position") - E(DOMAIN_ERROR_TIMEOUT_SPEC, DOMAIN_ERROR, "timeout_spec") - E(DOMAIN_ERROR_SYNTAX_ERROR_HANDLER, DOMAIN_ERROR, "syntax_error_handler") - E(DOMAIN_ERROR_WRITE_OPTION, DOMAIN_ERROR, "write_option") +E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR, + "absolute_file_name_option") +E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow") +E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type") +E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors") +E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type") +E(DOMAIN_ERROR_IO_MODE, DOMAIN_ERROR, "io_mode") +E(DOMAIN_ERROR_MUTABLE, DOMAIN_ERROR, "mutable") +E(DOMAIN_ERROR_NON_EMPTY_LIST, DOMAIN_ERROR, "non_empty_list") +E(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, DOMAIN_ERROR, "not_less_than_zero") +E(DOMAIN_ERROR_NOT_NL, DOMAIN_ERROR, "not_nl") +E(DOMAIN_ERROR_NOT_ZERO, DOMAIN_ERROR, "not_zero") +E(DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR, "out_of_range") +E(DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR, "operator_priority") +E(DOMAIN_ERROR_OPERATOR_SPECIFIER, DOMAIN_ERROR, "operator_specifier") +E(DOMAIN_ERROR_PROLOG_FLAG, DOMAIN_ERROR, "prolog_flag") +E(DOMAIN_ERROR_RADIX, DOMAIN_ERROR, "radix") +E(DOMAIN_ERROR_READ_OPTION, DOMAIN_ERROR, "read_option") +E(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, DOMAIN_ERROR, "shift_count_overflow") +E(DOMAIN_ERROR_SOURCE_SINK, DOMAIN_ERROR, "source_sink") +E(DOMAIN_ERROR_SOLUTIONS, DOMAIN_ERROR, "solutions") +E(DOMAIN_ERROR_STREAM, DOMAIN_ERROR, "stream") +E(DOMAIN_ERROR_STREAM_ENCODING, DOMAIN_ERROR, "stream_encoding") +E(DOMAIN_ERROR_STREAM_OR_ALIAS, DOMAIN_ERROR, "stream_or_alias") +E(DOMAIN_ERROR_STREAM_POSITION, DOMAIN_ERROR, "stream_position") +E(DOMAIN_ERROR_TIMEOUT_SPEC, DOMAIN_ERROR, "timeout_spec") +E(DOMAIN_ERROR_SYNTAX_ERROR_HANDLER, DOMAIN_ERROR, "syntax_error_handler") +E(DOMAIN_ERROR_WRITE_OPTION, DOMAIN_ERROR, "write_option") - E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow") - E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow") - E(EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR, "int_overflow") - E(EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR, "undefined") - E(EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR, "underflow") - E(EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR, "zero_divisor") +E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow") +E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow") +E(EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR, "int_overflow") +E(EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR, "undefined") +E(EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR, "underflow") +E(EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR, "zero_divisor") - E(EXISTENCE_ERROR_ARRAY, EXISTENCE_ERROR, "array") - E(EXISTENCE_ERROR_KEY, EXISTENCE_ERROR, "key, ") - E(EXISTENCE_ERROR_MUTEX, EXISTENCE_ERROR, "mutex, ") - E(EXISTENCE_ERROR_SOURCE_SINK, EXISTENCE_ERROR, "source_sink") - E(EXISTENCE_ERROR_STREAM, EXISTENCE_ERROR, "stream") - E(EXISTENCE_ERROR_VARIABLE, EXISTENCE_ERROR, "variable") +E(EXISTENCE_ERROR_ARRAY, EXISTENCE_ERROR, "array") +E(EXISTENCE_ERROR_KEY, EXISTENCE_ERROR, "key, ") +E(EXISTENCE_ERROR_MUTEX, EXISTENCE_ERROR, "mutex, ") +E(EXISTENCE_ERROR_SOURCE_SINK, EXISTENCE_ERROR, "source_sink") +E(EXISTENCE_ERROR_STREAM, EXISTENCE_ERROR, "stream") +E(EXISTENCE_ERROR_VARIABLE, EXISTENCE_ERROR, "variable") - E0(INSTANTIATION_ERROR, INSTANTIATION_ERROR_CLASS) +E0(INSTANTIATION_ERROR, INSTANTIATION_ERROR_CLASS) - E2(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, PERMISSION_ERROR, "access","private_procedure") - E2(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, PERMISSION_ERROR, - "add_alias", "stream") - E2(PERMISSION_ERROR_CREATE_ARRAY, PERMISSION_ERROR, "create", "array") - E2(PERMISSION_ERROR_CREATE_OPERATOR, PERMISSION_ERROR, "create", "operator") - E2(PERMISSION_ERROR_INPUT_BINARY_STREAM, PERMISSION_ERROR, - "input", "binary_stream") - E2(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, PERMISSION_ERROR, - "input", "past_end_of_stream") - E2(PERMISSION_ERROR_INPUT_STREAM, PERMISSION_ERROR, "input","stream") - E2(PERMISSION_ERROR_INPUT_TEXT_STREAM, PERMISSION_ERROR, - "input","text_stream") - E2(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR, - "modify","static_procedure") - E2(PERMISSION_ERROR_OPEN_SOURCE_SINK, PERMISSION_ERROR, "open","source_sink") - E2(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, PERMISSION_ERROR, - "output","binary_stream") - E2(PERMISSION_ERROR_OUTPUT_STREAM, PERMISSION_ERROR, "output","stream") - E2(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, PERMISSION_ERROR, - "output","text_stream") - E2(PERMISSION_ERROR_READ_ONLY_FLAG, PERMISSION_ERROR, "read_only","flag") - E2(PERMISSION_ERROR_RESIZE_ARRAY, PERMISSION_ERROR, "resize","array") - E2(PERMISSION_ERROR_REPOSITION_STREAM, PERMISSION_ERROR, - "reposition","stream") +E2(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, PERMISSION_ERROR, "access", + "private_procedure") +E2(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, PERMISSION_ERROR, "add_alias", + "stream") +E2(PERMISSION_ERROR_CREATE_ARRAY, PERMISSION_ERROR, "create", "array") +E2(PERMISSION_ERROR_CREATE_OPERATOR, PERMISSION_ERROR, "create", "operator") +E2(PERMISSION_ERROR_INPUT_BINARY_STREAM, PERMISSION_ERROR, "input", + "binary_stream") +E2(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, PERMISSION_ERROR, "input", + "past_end_of_stream") +E2(PERMISSION_ERROR_INPUT_STREAM, PERMISSION_ERROR, "input", "stream") +E2(PERMISSION_ERROR_INPUT_TEXT_STREAM, PERMISSION_ERROR, "input", "text_stream") +E2(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR, "modify", + "static_procedure") +E2(PERMISSION_ERROR_OPEN_SOURCE_SINK, PERMISSION_ERROR, "open", "source_sink") +E2(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, PERMISSION_ERROR, "output", + "binary_stream") +E2(PERMISSION_ERROR_OUTPUT_STREAM, PERMISSION_ERROR, "output", "stream") +E2(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, PERMISSION_ERROR, "output", + "text_stream") +E2(PERMISSION_ERROR_READ_ONLY_FLAG, PERMISSION_ERROR, "read_only", "flag") +E2(PERMISSION_ERROR_RESIZE_ARRAY, PERMISSION_ERROR, "resize", "array") +E2(PERMISSION_ERROR_REPOSITION_STREAM, PERMISSION_ERROR, "reposition", "stream") - E(REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR, "character") - E(REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR, - "character_code") - E(REPRESENTATION_ERROR_INT, REPRESENTATION_ERROR, "int") - E(REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR, "max_arity") - E(REPRESENTATION_ERROR_VARIABLE, REPRESENTATION_ERROR, "variable") +E(REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR, "character") +E(REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR, "character_code") +E(REPRESENTATION_ERROR_INT, REPRESENTATION_ERROR, "int") +E(REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR, "max_arity") +E(REPRESENTATION_ERROR_VARIABLE, REPRESENTATION_ERROR, "variable") - E(RESOURCE_ERROR_HUGE_INT, RESOURCE_ERROR, "huge_int") - E(RESOURCE_ERROR_MAX_STREAMS, RESOURCE_ERROR, "max_streams") - E(RESOURCE_ERROR_MAX_THREADS, RESOURCE_ERROR, "max_threads") - E(RESOURCE_ERROR_AUXILIARY_STACK, RESOURCE_ERROR, "auxiliary_stack") - E(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, RESOURCE_ERROR, - "attributed_variables") - E(RESOURCE_ERROR_HEAP, RESOURCE_ERROR, "database_space") - E(RESOURCE_ERROR_TRAIL, RESOURCE_ERROR, "trail_space") - E(RESOURCE_ERROR_STACK, RESOURCE_ERROR, "stack_space") +E(RESOURCE_ERROR_HUGE_INT, RESOURCE_ERROR, "huge_int") +E(RESOURCE_ERROR_MAX_STREAMS, RESOURCE_ERROR, "max_streams") +E(RESOURCE_ERROR_MAX_THREADS, RESOURCE_ERROR, "max_threads") +E(RESOURCE_ERROR_AUXILIARY_STACK, RESOURCE_ERROR, "auxiliary_stack") +E(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, RESOURCE_ERROR, "attributed_variables") +E(RESOURCE_ERROR_HEAP, RESOURCE_ERROR, "database_space") +E(RESOURCE_ERROR_TRAIL, RESOURCE_ERROR, "trail_space") +E(RESOURCE_ERROR_STACK, RESOURCE_ERROR, "stack_space") - E(SYNTAX_ERROR, SYNTAX_ERROR_CLASS, "syntax_error") +E(SYNTAX_ERROR, SYNTAX_ERROR_CLASS, "syntax_error") - E(SYSTEM_ERROR_INTERNAL, SYSTEM_ERROR_CLASS, "internal") - E(SYSTEM_ERROR_COMPILER, SYSTEM_ERROR_CLASS, "compiler") - E(SYSTEM_ERROR_FATAL, SYSTEM_ERROR_CLASS, "fatal") - E(SYSTEM_ERROR_JIT_NOT_AVAILABLE, SYSTEM_ERROR_CLASS, "jit_not_available") - E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error") - E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error") +E(SYSTEM_ERROR_INTERNAL, SYSTEM_ERROR_CLASS, "internal") +E(SYSTEM_ERROR_COMPILER, SYSTEM_ERROR_CLASS, "compiler") +E(SYSTEM_ERROR_FATAL, SYSTEM_ERROR_CLASS, "fatal") +E(SYSTEM_ERROR_JIT_NOT_AVAILABLE, SYSTEM_ERROR_CLASS, "jit_not_available") +E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error") +E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error") - E(ABORT_EVENT, EVENT, "abort") - E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow") - E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, - "pred_entry_counter_underflow") - E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow") - E(INTERRUPT_EVENT, EVENT, "interrupt") +E(ABORT_EVENT, EVENT, "abort") +E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow") +E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow") +E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow") +E(INTERRUPT_EVENT, EVENT, "interrupt") - E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array") - E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom") - E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic") - E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum") - E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte") - E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable") - E(TYPE_ERROR_CHAR, TYPE_ERROR, "char") - E(TYPE_ERROR_CHARACTER, TYPE_ERROR, "character") - E(TYPE_ERROR_CHARACTER_CODE, TYPE_ERROR, "character_code") - E(TYPE_ERROR_COMPOUND, TYPE_ERROR, "compound") - E(TYPE_ERROR_DBREF, TYPE_ERROR, "dbref") - E(TYPE_ERROR_DBTERM, TYPE_ERROR, "dbterm") - E(TYPE_ERROR_EVALUABLE, TYPE_ERROR, "evaluable") - E(TYPE_ERROR_FLOAT, TYPE_ERROR, "float") - E(TYPE_ERROR_INTEGER, TYPE_ERROR, "integer") - E(TYPE_ERROR_KEY, TYPE_ERROR, "key") - E(TYPE_ERROR_LIST, TYPE_ERROR, "list") - E(TYPE_ERROR_NUMBER, TYPE_ERROR, "number") - E(TYPE_ERROR_PARAMETER, TYPE_ERROR, "parameter") - E(TYPE_ERROR_PREDICATE_INDICATOR, TYPE_ERROR, "predicate_indicator") - E(TYPE_ERROR_PTR, TYPE_ERROR, "pointer") - E(TYPE_ERROR_REFERENCE, TYPE_ERROR, "reference") - E(TYPE_ERROR_STRING, TYPE_ERROR, "string") - E(TYPE_ERROR_TEXT, TYPE_ERROR, "text") - E(TYPE_ERROR_UBYTE, TYPE_ERROR, "ubyte") - E(TYPE_ERROR_UCHAR, TYPE_ERROR, "uchar") - - E0(UNINSTANTIATION_ERROR, UNINSTANTIATION_ERROR_CLASS) +E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array") +E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom") +E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic") +E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum") +E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte") +E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable") +E(TYPE_ERROR_CHAR, TYPE_ERROR, "char") +E(TYPE_ERROR_CHARACTER, TYPE_ERROR, "character") +E(TYPE_ERROR_CHARACTER_CODE, TYPE_ERROR, "character_code") +E(TYPE_ERROR_COMPOUND, TYPE_ERROR, "compound") +E(TYPE_ERROR_DBREF, TYPE_ERROR, "dbref") +E(TYPE_ERROR_DBTERM, TYPE_ERROR, "dbterm") +E(TYPE_ERROR_EVALUABLE, TYPE_ERROR, "evaluable") +E(TYPE_ERROR_FLOAT, TYPE_ERROR, "float") +E(TYPE_ERROR_INTEGER, TYPE_ERROR, "integer") +E(TYPE_ERROR_KEY, TYPE_ERROR, "key") +E(TYPE_ERROR_LIST, TYPE_ERROR, "list") +E(TYPE_ERROR_NUMBER, TYPE_ERROR, "number") +E(TYPE_ERROR_PARAMETER, TYPE_ERROR, "parameter") +E(TYPE_ERROR_PREDICATE_INDICATOR, TYPE_ERROR, "predicate_indicator") +E(TYPE_ERROR_PTR, TYPE_ERROR, "pointer") +E(TYPE_ERROR_REFERENCE, TYPE_ERROR, "reference") +E(TYPE_ERROR_STRING, TYPE_ERROR, "string") +E(TYPE_ERROR_TEXT, TYPE_ERROR, "text") +E(TYPE_ERROR_UBYTE, TYPE_ERROR, "ubyte") +E(TYPE_ERROR_UCHAR, TYPE_ERROR, "uchar") - END_ERRORS(); +E0(UNINSTANTIATION_ERROR, UNINSTANTIATION_ERROR_CLASS) + +END_ERRORS(); diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index d9569f133..0c6c46956 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -9,11 +9,11 @@ set (LIBRARY_PL avl.yap bhash.yap charsio.yap + clauses.yap coinduction.yap dbqueues.yap dbusage.yap dgraphs.yap - error.yap exo_interval.yap expand_macros.yap gensym.yap @@ -70,6 +70,7 @@ add_subdirectory(regex) add_subdirectory(rltree) add_subdirectory(system) add_subdirectory(tries) +add_subdirectory(ytest) add_custom_target (library SOURCES ${LIBRARY_PL} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} ) diff --git a/library/dbqueues.yap b/library/dbqueues.yap index 63da9f62f..34bc48580 100644 --- a/library/dbqueues.yap +++ b/library/dbqueues.yap @@ -1,4 +1,4 @@ -/** +s/** * @file dbqueues.yap * @author VITOR SANTOS COSTA * @date Tue Nov 17 15:01:49 2015 @@ -25,9 +25,9 @@ A library to implement queues of NB Terms */ -:- unhide('$init_nb_queue'). -:- unhide('$nb_enqueue'). -:- unhide('$nb_dequeue'). +:- unhide_atom('$init_nb_queue'). +:- unhide_atom('$nb_enqueue'). +:- unhide_atom('$nb_dequeue'). nb_enqueue(Name,El) :- var(Name), diff --git a/library/dialect/#swi.yap# b/library/dialect/#swi.yap# deleted file mode 100644 index 4860f244f..000000000 --- a/library/dialect/#swi.yap# +++ /dev/null @@ -1,324 +0,0 @@ - -% SWI emulation. -% written in an on-demand basis. - -%% @defgroup swi Compatibility with SWI-Prolog and Other Prolog systems - -/** - -@defgroup System SWI Dialect Support - - -This library provides a number of SWI-Prolog builtins that are not by -default in YAP. This support is loaded with the -~~~~~ -expects_dialect(swi) -~~~~~ - - command. - -@{ - -*/ - -/** @pred time_file(+ _File_,- _Time_) - - -Unify the last modification time of _File_ with - _Time_. _Time_ is a floating point number expressing the seconds -elapsed since Jan 1, 1970. - - -*/ -/** @pred concat_atom(+ _List_,- _Atom_) - - - - _List_ is a list of atoms, integers or floating point numbers. Succeeds -if _Atom_ can be unified with the concatenated elements of _List_. If - _List_ has exactly 2 elements it is equivalent to `atom_concat/3`, -allowing for variables in the list. - - -*/ - -:- module(system, [concat_atom/2, - concat_atom/3, - read_clause/1, - chdir/1, - compile_aux_clauses/1, - convert_time/2, - convert_time/8, - '$declare_module'/5, - '$set_predicate_attribute'/3, - stamp_date_time/3, - date_time_stamp/2, - time_file/2, - flag/3, - require/1, - normalize_space/2, - current_flag/1 - ]). - -:- reexport(library(charsio),[ - write_to_chars/2, - read_from_chars/2 - ]). - -:- reexport(library(lists),[append/2, - append/3, - delete/3, - member/2, - flatten/2, - intersection/3, - last/2, - memberchk/2, - max_list/2, - min_list/2, - nextto/3, - permutation/2, - reverse/2, - select/3, - selectchk/3, - sublist/2, - sumlist/2, - nth1/4, - nth0/4, - nth1/3, - nth0/3]). - -:- reexport(library(apply),[maplist/2, - maplist/3, - maplist/4, - maplist/5, - include/3, - exclude/3, - partition/4, - partition/5 - ]). - -:- reexport(library(system), - [datime/1, - mktime/2, - file_property/2, - delete_file/1]). - -:- reexport(library(arg), - [genarg/3]). - -:- reexport(library(apply_macros), - []). - -:- reexport(library(terms), - [subsumes/2, - subsumes_chk/2, - term_hash/2, - unifiable/3, - cyclic_term/1, - variant/2]). - -:- use_module(library(error),[must_be/2]). - - -:- source. - -:- style_check(all). - -:- yap_flag(unknown,error). - -:- yap_flag(open_expands_filename,false). - -:- yap_flag(autoload,true). - -:- set_prolog_flag(user_flags,silent). - - -% Time is given as a float in SWI-Prolog. -swi_get_time(FSecs) :- datime(Datime), mktime(Datime, Secs), FSecs is Secs*1.0. - -goal_expansion(atom_concat(A,B),atomic_concat(A,B)). -/** @pred atom_concat(? _A1_,? _A2_,? _A12_) is iso - -The predicate holds when the third argument unifies with an atom, and -the first and second unify with atoms such that their representations -concatenated are the representation for _A12_. - -If _A1_ and _A2_ are unbound, the built-in will find all the atoms -that concatenated give _A12_. - - -*/ - -goal_expansion(atom_concat(A,B,C),atomic_concat(A,B,C)). -%goal_expansion(arg(A,_,_),_) :- nonvar(A), !, fail. -goal_expansion(arg(A,B,C),genarg(A,B,C)). - -% make sure we also use -:- user:library_directory(X), - atom(X), - atom_concat([X,'/dialect/swi'],SwiDir), - \+ user:library_directory(SwiDir), - asserta(user:library_directory(SwiDir)), - fail - ; - true. - -:- multifile - user:file_search_path/2. - -:- dynamic - user:file_search_path/2. - -/** @pred concat_atom(? _List_,+ _Separator_,? _Atom_) - - -Creates an atom just like concat_atom/2, but inserts _Separator_ -between each pair of atoms. For example: - -~~~~~ -?- concat_atom([gnu, gnat], ', ', A). - -A = 'gnu, gnat' -~~~~~ - -(Unimplemented) This predicate can also be used to split atoms by -instantiating _Separator_ and _Atom_: - -~~~~~ -?- concat_atom(L, -, 'gnu-gnat'). - -L = [gnu, gnat] -~~~~~ - - -*/ -concat_atom([A|List], Separator, New) :- var(List), !, - atom_codes(Separator,[C]), - atom_codes(New, NewChars), - split_atom_by_chars(NewChars,C,L,L,A,List). -concat_atom(List, Separator, New) :- - add_separator_to_list(List, Separator, NewList), - atomic_concat(NewList, New). - - -split_atom_by_chars([],_,[],L,A,[]):- - atom_codes(A,L). -split_atom_by_chars([C|NewChars],C,[],L,A,[NA|Atoms]) :- !, - atom_codes(A,L), - split_atom_by_chars(NewChars,C,NL,NL,NA,Atoms). -split_atom_by_chars([C1|NewChars],C,[C1|LF],LAtom,Atom,Atoms) :- - split_atom_by_chars(NewChars,C,LF,LAtom,Atom,Atoms). - -add_separator_to_list([], _, []). -add_separator_to_list([T], _, [T]) :- !. -add_separator_to_list([H|T], Separator, [H,Separator|NT]) :- - add_separator_to_list(T, Separator, NT). - -concat_atom(List, New) :- - atomic_concat(List, New). - - -bindings_message(V) --> - { cvt_bindings(V, Bindings) }, - prolog:message(query(_YesNo,Bindings)), !. - -cvt_bindings([],[]). -cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :- - atom_codes(AName, Name), - cvt_bindings(L,Bindings). - -/** @pred chdir(+ _Dir_) - -Compatibility predicate. New code should use working_directory/2. -*/ -chdir(X) :- cd(X). - -%% convert_time(+Stamp, -String) -% -% Convert a time-stamp as obtained though get_time/1 into a textual -% representation using the C-library function ctime(). The value is -% returned as a SWI-Prolog string object (see section 4.23). See -% also convert_time/8. -% -% @deprecated Use format_time/3. - - -convert_time(Stamp, String) :- - format_time(string(String), '%+', Stamp). - -%% convert_time(+Stamp, -Y, -Mon, -Day, -Hour, -Min, -Sec, -MilliSec) -% -% Convert a time stamp, provided by get_time/1, time_file/2, -% etc. Year is unified with the year, Month with the month number -% (January is 1), Day with the day of the month (starting with 1), -% Hour with the hour of the day (0--23), Minute with the minute -% (0--59). Second with the second (0--59) and MilliSecond with the -% milliseconds (0--999). Note that the latter might not be accurate -% or might always be 0, depending on the timing capabilities of the -% system. See also convert_time/2. -% -% @deprecated Use stamp_date_time/3. - -convert_time(Stamp, Y, Mon, Day, Hour, Min, Sec, MilliSec) :- - stamp_date_time(Stamp, - date(Y, Mon, Day, - Hour, Min, FSec, - _, _, _), - local), - Sec is integer(float_integer_part(FSec)), - MilliSec is integer(float_fractional_part(FSec)*1000). - - -compile_aux_clauses([]). -compile_aux_clauses([(:- G)|Cls]) :- !, - prolog_load_context(module, M), - once(M:G), - compile_aux_clauses(Cls). -compile_aux_clauses([Cl|Cls]) :- - prolog_load_context(module, M), - assert_static(M:Cl), - compile_aux_clauses(Cls). - - -flag(Key, Old, New) :- - recorded(Key, Old, R), !, - ( - Old \== New - -> - erase(R), - recorda(Key, New, _) - ; - true - ). -flag(Key, 0, New) :- - functor(Key, N, Ar), - functor(K, N, Ar), - assert(flag(K)), - recorda(K, New, _). - -current_flag(Key) :- - swi:flag(Key). - -require(F) :- - must_be(list, F), - % notice that this must be used as a declaration. - prolog_load_context(module, Mod), - required_predicates(F, Mod). - -required_predicates([], _). -required_predicates([F|Fs], M) :- - required_predicate(F, M), - required_predicates(Fs, M). - -required_predicate(Na/Ar, M) :- - functor(G, Na, Ar), - ( - predicate_property(M:G, _) -> - true - ; - autoloader:find_predicate(G, _) - ). - -/** -@} -*/ diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index a60708a11..3a75daf58 100644 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -117,9 +117,6 @@ allowing for variables in the list. cyclic_term/1, variant/2]). -:- use_module(library(error),[must_be/2]). - - :- source. :- style_check(all). diff --git a/library/dialect/swi/fli/blobs.c b/library/dialect/swi/fli/blobs.c index f52055119..69a3a65e7 100644 --- a/library/dialect/swi/fli/blobs.c +++ b/library/dialect/swi/fli/blobs.c @@ -102,7 +102,7 @@ PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type) if (type->acquire) { type->acquire(AtomToSWIAtom(AbsAtom(ae))); } - Yap_PutInSlot(t, MkAtomTerm(AbsAtom(ae)) PASS_REGS); + Yap_PutInSlot(t, MkAtomTerm(AbsAtom(ae))); return ret; } diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 64aba7357..15958b5d4 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -371,7 +371,7 @@ X_API void PL_reset_term_refs(term_t after) { CACHE_REGS term_t new = Yap_NewSlots(1); - Yap_RecoverSlots(after-new, new PASS_REGS); + Yap_RecoverSlots(after-new, new); } /** @} @@ -430,10 +430,10 @@ X_API int PL_get_arg(int index, term_t ts, term_t a) if ( !IsApplTerm(t) ) { if (IsPairTerm(t)) { if (index == 1){ - Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS); + Yap_PutInSlot(a,HeadOfTerm(t)); return 1; } else if (index == 2) { - Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS); + Yap_PutInSlot(a,TailOfTerm(t)); return 1; } } @@ -444,7 +444,7 @@ X_API int PL_get_arg(int index, term_t ts, term_t a) return 0; if (index < 1 || index > ArityOfFunctor(f)) return 0; - Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS); + Yap_PutInSlot(a,ArgOfTerm(index, t)); return 1; } } @@ -792,8 +792,8 @@ X_API int PL_get_list(term_t ts, term_t h, term_t tl) if (IsVarTerm(t) || !IsPairTerm(t) ) { return 0; } - Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS); - Yap_PutInSlot(tl,TailOfTerm(t) PASS_REGS); + Yap_PutInSlot(h,HeadOfTerm(t)); + Yap_PutInSlot(tl,TailOfTerm(t)); return 1; } @@ -808,7 +808,7 @@ X_API int PL_get_head(term_t ts, term_t h) if (!YAP_IsPairTerm(t) ) { return 0; } - Yap_PutInSlot(h,YAP_HeadOfTerm(t) PASS_REGS); + Yap_PutInSlot(h,YAP_HeadOfTerm(t)); return 1; } @@ -925,7 +925,7 @@ X_API int PL_get_tail(term_t ts, term_t tl) if (!YAP_IsPairTerm(t) ) { return 0; } - Yap_PutInSlot(tl,YAP_TailOfTerm(t) PASS_REGS); + Yap_PutInSlot(tl,YAP_TailOfTerm(t) ); return 1; } @@ -1035,7 +1035,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...) Functor ff = SWIFunctorToFunctor(f); if (IsAtomTerm((Term)ff)) { - Yap_PutInSlot(d, (YAP_Term)f PASS_REGS); + Yap_PutInSlot(d, (YAP_Term)f ); return TRUE; } arity = ArityOfFunctor(ff); @@ -1056,7 +1056,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...) Yap_unify(tmp[i],Yap_GetFromSlot(va_arg(ap, term_t))); } va_end (ap); - Yap_PutInSlot(d,t PASS_REGS); + Yap_PutInSlot(d,t ); return TRUE; } @@ -1068,7 +1068,7 @@ X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0) Functor ff = SWIFunctorToFunctor(f); if (IsAtomTerm((Term)ff)) { - Yap_PutInSlot(d, (YAP_Term)f PASS_REGS); + Yap_PutInSlot(d, (YAP_Term)f ); return TRUE; } arity = ArityOfFunctor(ff); @@ -1088,7 +1088,7 @@ X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0) Yap_unify(tmp[i] , Yap_GetFromSlot(a0 ) ); a0++; } - Yap_PutInSlot(d,t PASS_REGS); + Yap_PutInSlot(d,t ); return TRUE; } @@ -1101,14 +1101,14 @@ X_API int PL_cons_list(term_t d, term_t h, term_t t) return FALSE; } } - Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(h),Yap_GetFromSlot(t)) PASS_REGS); + Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(h),Yap_GetFromSlot(t))); return true; } X_API int PL_put_atom(term_t t, atom_t a) { CACHE_REGS - Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a)) PASS_REGS); + Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a))); return TRUE; } @@ -1121,7 +1121,8 @@ X_API int PL_put_atom_chars(term_t t, const char *s) return FALSE; } Yap_AtomIncreaseHold(at); - Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS); + Yap_PutInSlot(t,MkAtomTerm(at)); + return TRUE; } @@ -1134,14 +1135,14 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s) return FALSE; } Yap_AtomIncreaseHold(at); - Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS); + Yap_PutInSlot(t,MkAtomTerm(at)); return TRUE; } X_API int PL_put_float(term_t t, double fl) { CACHE_REGS - Yap_PutInSlot(t,YAP_MkFloatTerm(fl) PASS_REGS); + Yap_PutInSlot(t,YAP_MkFloatTerm(fl) ); return TRUE; } @@ -1152,7 +1153,7 @@ X_API int PL_put_functor(term_t t, functor_t f) CACHE_REGS if (IsAtomTerm((Term)ff)) { - Yap_PutInSlot(t,(Term)ff PASS_REGS); + Yap_PutInSlot(t,(Term)ff); } else { arity = ArityOfFunctor(ff); if (Unsigned(HR)+arity > Unsigned(ASP)-CreepFlag) { @@ -1160,10 +1161,9 @@ X_API int PL_put_functor(term_t t, functor_t f) return FALSE; } } - if (arity == 2 && ff == FunctorDot) - Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS); - else - Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity) PASS_REGS); + if (arity == 2 && ff == FunctorDot){ + } else + Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity) ); } return TRUE; } @@ -1171,14 +1171,14 @@ X_API int PL_put_functor(term_t t, functor_t f) X_API int PL_put_integer(term_t t, long n) { CACHE_REGS - Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS); + Yap_PutInSlot(t,YAP_MkIntTerm(n)); return TRUE; } X_API int PL_put_boolean(term_t t, uintptr_t n) { CACHE_REGS - Yap_PutInSlot(t,(n==0?TermFalse:TermTrue) PASS_REGS); + Yap_PutInSlot(t,(n==0?TermFalse:TermTrue)); return TRUE; } @@ -1186,7 +1186,7 @@ X_API int PL_put_int64(term_t t, int64_t n) { CACHE_REGS #if SIZEOF_INT_P==8 - Yap_PutInSlot(t,MkIntegerTerm(n) PASS_REGS); + Yap_PutInSlot(t,MkIntegerTerm(n) ); return TRUE; #elif USE_GMP char s[64]; @@ -1221,21 +1221,21 @@ X_API int PL_put_int64(term_t t, int64_t n) X_API int PL_put_intptr(term_t t, intptr_t n) { CACHE_REGS - Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS); + Yap_PutInSlot(t,YAP_MkIntTerm(n)); return TRUE; } X_API int PL_put_uintptr(term_t t, uintptr_t n) { CACHE_REGS - Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS); + Yap_PutInSlot(t,YAP_MkIntTerm(n) ); return TRUE; } X_API int PL_put_list(term_t t) { CACHE_REGS - Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS); + Yap_PutInSlot(t,YAP_MkNewPairTerm() ); if (Unsigned(HR) > Unsigned(ASP)-CreepFlag) { if (!do_gc(0)) { return FALSE; @@ -1252,14 +1252,14 @@ X_API int PL_put_list_chars(term_t t, const char *s) if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_put_string_nchars" )) return FALSE; } - Yap_PutInSlot(t, nt PASS_REGS); + Yap_PutInSlot(t, nt); return TRUE; } X_API void PL_put_nil(term_t t) { CACHE_REGS - Yap_PutInSlot(t,TermNil PASS_REGS); + Yap_PutInSlot(t,TermNil); } /* void PL_put_pointer(term_t -t, void *ptr) @@ -1269,7 +1269,7 @@ X_API int PL_put_pointer(term_t t, void *ptr) { CACHE_REGS YAP_Term tptr = YAP_MkIntTerm((YAP_Int)ptr); - Yap_PutInSlot(t,tptr PASS_REGS); + Yap_PutInSlot(t,tptr ); return TRUE; } @@ -1282,7 +1282,7 @@ X_API int PL_put_string_chars(term_t t, const char *chars) if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_putPL_put_string_chars" )) return FALSE; } - Yap_PutInSlot(t, nt PASS_REGS); + Yap_PutInSlot(t, nt); return TRUE; } @@ -1295,21 +1295,21 @@ X_API int PL_put_string_nchars(term_t t, size_t len, const char *chars) if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_putPL_put_string_chars" )) return FALSE; } - Yap_PutInSlot(t, nt PASS_REGS); + Yap_PutInSlot(t, nt); return TRUE; } X_API int PL_put_term(term_t d, term_t s) { CACHE_REGS - Yap_PutInSlot(d,Yap_GetFromSlot(s ) PASS_REGS); + Yap_PutInSlot(d,Yap_GetFromSlot(s ) ); return TRUE; } X_API int PL_put_variable(term_t t) { CACHE_REGS - Yap_PutInSlot(t,MkVarTerm() PASS_REGS); + Yap_PutInSlot(t,MkVarTerm()); return TRUE; } @@ -1518,8 +1518,8 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail) } else if (!IsPairTerm(t)) { return FALSE; } - Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS); - Yap_PutInSlot(tail,TailOfTerm(t) PASS_REGS); + Yap_PutInSlot(h,HeadOfTerm(t)); + Yap_PutInSlot(tail,TailOfTerm(t) ); return TRUE; } @@ -2207,7 +2207,7 @@ PL_recorded_external Term t = Yap_ImportTerm((void *)tp); if (t == 0) return FALSE; - Yap_PutInSlot(ts, t PASS_REGS); + Yap_PutInSlot(ts, t ); return TRUE; } @@ -2234,7 +2234,7 @@ PL_recorded(record_t db, term_t ts) Term t = YAP_Recorded((void *)db); if (t == ((CELL)0)) return FALSE; - Yap_PutInSlot(ts,t PASS_REGS); + Yap_PutInSlot(ts,t ); return TRUE; } @@ -2311,7 +2311,7 @@ PL_exception(qid_t q) if (YAP_GoalHasException(&t)) { CACHE_REGS term_t to = Yap_NewSlots(1); - Yap_PutInSlot(to,t PASS_REGS); + Yap_PutInSlot(to,t ); return to; } else { return 0L; @@ -2391,7 +2391,7 @@ PL_strip_module(term_t raw, module_t *m, term_t plain) if (!t) return FALSE; *m = Yap_GetModuleEntry(m0); - Yap_PutInSlot(plain, t PASS_REGS); + Yap_PutInSlot(plain, t ); return TRUE; } diff --git a/library/expand_macros.yap b/library/expand_macros.yap index a1bb54b28..6d4dcc68b 100644 --- a/library/expand_macros.yap +++ b/library/expand_macros.yap @@ -15,11 +15,22 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +:- module( expand_macros, + [compile_aux/2, + pred_name/4, + transformation_id/1, + allowed_expansion/1, + allowed_module/2] ). + + :- use_module(library(lists), [append/3]). :- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]). :- use_module(library(error), [must_be/2]). :- use_module(library(occurs), [sub_term/2]). +:- multifile allowed_module/2. + :- dynamic number_of_expansions/1. number_of_expansions(0). @@ -32,15 +43,18 @@ number_of_expansions(0). compile_aux([Clause|Clauses], Module) :- % compile the predicat declaration if needed - ( Clause = (Head :- _) - ; Clause = Head ), + ( + Clause = (Head :- _) + ; + Clause = Head + ), !, functor(Head, F, N), ( current_predicate(Module:F/N) -> true ; -% format("*** Creating auxiliary predicate ~q~n", [F/N]), +% format'*** Creating auxiliary predicate ~q~n', [F/N]), % checklist(portray_clause, [Clause|Clauses]), compile_term([Clause|Clauses], Module) ). @@ -84,15 +98,17 @@ harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L) harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L) -'$expand':allowed_expansion(QExpand) :- +allowed_expansion(QExpand) :- strip_module(QExpand, Mod, Pred), goal_expansion_allowed(Pred, Mod). goal_expansion_allowed(Pred, Mod) :- allowed_module(Pred,Mod), once( prolog_load_context(_, _) ), % make sure we are compiling. - \+ current_prolog_flag(xref, true). + + + allowed_module(checklist(_,_),expand_macros). allowed_module(checklist(_,_),apply_macros). allowed_module(checklist(_,_),maplist). @@ -147,5 +163,3 @@ allowed_module(checknodes(_,_),maplist). allowed_module(sumnodes(_,_,_,_),expand_macros). allowed_module(sumnodes(_,_,_,_),apply_macros). allowed_module(sumnodes(_,_,_,_),maplist). -allowed_module(phrase(_,_),_). -allowed_module(phrase(_,_,_),_). diff --git a/library/hacks.yap b/library/hacks.yap index 0136b0adf..5a6fd7944 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -2,10 +2,10 @@ * @file hacks.yap * @author VITOR SANTOS COSTA * @date Tue Nov 17 19:00:25 2015 - * + * * @brief Prolog hacking - * - * + * + * */ :- module(yap_hacks, [ @@ -21,7 +21,7 @@ enable_interrupts/0, disable_interrupts/0, virtual_alarm/3, - fully_strip_module/3, + fully_strip_module/3, context_variables/1 ]). @@ -31,7 +31,7 @@ * * Manipulate the Prolog stacks, including setting and resetting * choice-points. -* +* */ @@ -68,5 +68,3 @@ virtual_alarm(Interval.USecs, Goal, Left.LUSecs) :- fully_strip_module(T,M,S) :- '$hacks':fully_strip_module(T,M,S). - - diff --git a/library/lists.yap b/library/lists.yap index 0255bc806..5065b90bf 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -2,10 +2,10 @@ * @file library/lists.yap * @author Bob Welham, Lawrence Byrd, and R. A. O'Keefe. Contributions from Vitor Santos Costa, Jan Wielemaker and others. * @date 1999 - * + * * @brief List Manipulation Predicates - * - * + * + * */ % This file has been included as an YAP library by Vitor Santos Costa, 1999 @@ -48,55 +48,51 @@ ]). -:- use_module(library(error), - [must_be/2]). - - /** @defgroup lists List Manipulation @ingroup library @{ The following list manipulation routines are available once included -with the `use_module(library(lists))` command. +with the `use_module(library(lists))` command. */ -/** @pred list_concat(+ _Lists_,? _List_) +/** @pred list_concat(+ _Lists_,? _List_) True when _Lists_ is a list of lists and _List_ is the concatenation of _Lists_. - + */ -/** @pred max_list(? _Numbers_, ? _Max_) +/** @pred max_list(? _Numbers_, ? _Max_) True when _Numbers_ is a list of numbers, and _Max_ is the maximum. - + */ -/** @pred min_list(? _Numbers_, ? _Min_) +/** @pred min_list(? _Numbers_, ? _Min_) True when _Numbers_ is a list of numbers, and _Min_ is the minimum. - + */ -/** @pred nth(? _N_, ? _List_, ? _Elem_) +/** @pred nth(? _N_, ? _List_, ? _Elem_) The same as nth1/3. - + */ /** @pred nth(? _N_, ? _List_, ? _Elem_, ? _Rest_) Same as `nth1/4`. - + */ -/** @pred nth0(? _N_, ? _List_, ? _Elem_) +/** @pred nth0(? _N_, ? _List_, ? _Elem_) True when _Elem_ is the Nth member of _List_, @@ -105,7 +101,7 @@ N elements and unify _Elem_ with the next.) It can only be used to select a particular element given the list and index. For that task it is more efficient than member/2 - + */ /** @pred nth0(? _N_, ? _List_, ? _Elem_, ? _Rest_) @@ -117,9 +113,9 @@ it yields _List_, e.g. `nth0(2, List, c, [a,b,d,e])` unifies List with `[a,b,c,d,e]`. `nth/4` is the same except that it counts from 1. `nth0/4` can be used to insert _Elem_ after the Nth element of _Rest_. - + */ -/** @pred nth1(+ _Index_,? _List_,? _Elem_) +/** @pred nth1(+ _Index_,? _List_,? _Elem_) Succeeds when the _Index_-th element of _List_ unifies with @@ -130,15 +126,15 @@ instantiated to atoms or integers. The environment variable will be passed to `shell/[0-2]` and can be requested using `getenv/2`. They also influence expand_file_name/2. - + */ -/** @pred nth1(? _N_, ? _List_, ? _Elem_) +/** @pred nth1(? _N_, ? _List_, ? _Elem_) The same as nth0/3, except that it counts from 1, that is `nth(1, [H|_], H)`. - + */ /** @pred nth1(? _N_, ? _List_, ? _Elem_, ? _Rest_) @@ -149,33 +145,33 @@ insert _Elem_ before the Nth (counting from 1) element of _Rest_, when it yields _List_, e.g. `nth(3, List, c, [a,b,d,e])` unifies List with `[a,b,c,d,e]`. `nth/4` can be used to insert _Elem_ after the Nth element of _Rest_. - + */ -/** @pred numlist(+ _Low_, + _High_, + _List_) +/** @pred numlist(+ _Low_, + _High_, + _List_) If _Low_ and _High_ are integers with _Low_ =< _High_, unify _List_ to a list `[Low, Low+1, ...High]`. See also between/3. - + */ -/** @pred permutation(+ _List_,? _Perm_) +/** @pred permutation(+ _List_,? _Perm_) True when _List_ and _Perm_ are permutations of each other. - + */ -/** @pred remove_duplicates(+ _List_, ? _Pruned_) +/** @pred remove_duplicates(+ _List_, ? _Pruned_) Removes duplicated elements from _List_. Beware: if the _List_ has non-ground elements, the result may surprise you. - + */ -/** @pred same_length(? _List1_, ? _List2_) +/** @pred same_length(? _List1_, ? _List2_) True when _List1_ and _List2_ are both lists and have the same number @@ -192,7 +188,7 @@ in which case the arguments will be bound to lists of length 0, 1, 2, ... % % Concatenate a list of lists. Is true if Lists is a list of % lists, and List is the concatenation of these lists. -% +% % @param ListOfLists must be a list of -possibly- partial lists append(ListOfLists, List) :- @@ -207,7 +203,7 @@ append_([L1,L2|[L3|LL]], L) :- append(L1,L2,LI), append_([LI|[L3|LL]],L). -/** @pred last(+ _List_,? _Last_) +/** @pred last(+ _List_,? _Last_) True when _List_ is a list and _Last_ is identical to its last element. @@ -282,7 +278,7 @@ generate_nth(I, IN, [_|List], El) :- % nth0(+N, ?List, ?Elem, ?Rest) unifies Elem with the Nth element of List, % counting from 0, and Rest with the other elements. It can be used -% to select the Nth element of List (yielding Elem and Rest), or to +% to select the Nth element of List (yielding Elem and Rest), or to % insert Elem before the Nth (counting from 1) element of Rest, when % it yields List, e.g. nth0(2, List, c, [a,b,d,e]) unifies List with % [a,b,c,d,e]. nth is the same except that it counts from 1. nth @@ -348,7 +344,7 @@ permutation(List, [First|Perm]) :- % prefix(Part, Whole) iff Part is a leading substring of Whole prefix([], _). -prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :- +prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :- prefix(Rest_of_part, Rest_of_whole). % remove_duplicates(List, Pruned) @@ -385,7 +381,7 @@ same_length([_|List1], [_|List2]) :- same_length(List1, List2). -/** @pred selectchk(? _Element_, ? _List_, ? _Residue_) +/** @pred selectchk(? _Element_, ? _List_, ? _Residue_) Semi-deterministic selection from a list. Steadfast: defines as @@ -402,7 +398,7 @@ selectchk(Elem, List, Rest) :- -/** @pred select(? _Element_, ? _List_, ? _Residue_) +/** @pred select(? _Element_, ? _List_, ? _Residue_) True when _Set_ is a list, _Element_ occurs in _List_, and @@ -444,7 +440,7 @@ substitute2([X0|XList], X, Y, [Y|YList]) :- substitute2([X0|XList], X, Y, [X0|YList]) :- substitute2(XList, X, Y, YList). -/** @pred suffix(? _Suffix_, ? _List_) +/** @pred suffix(? _Suffix_, ? _List_) Holds when `append(_,Suffix,List)` holds. */ @@ -452,14 +448,14 @@ suffix(Suffix, Suffix). suffix(Suffix, [_|List]) :- suffix(Suffix,List). -/** @pred sumlist(? _Numbers_, ? _Total_) +/** @pred sumlist(? _Numbers_, ? _Total_) True when _Numbers_ is a list of integers, and _Total_ is their sum. The same as sum_list/2, please do use sum_list/2 instead. - + */ sumlist(Numbers, Total) :- sumlist(Numbers, 0, Total). @@ -471,7 +467,7 @@ True when _Numbers_ is a list of numbers, and _Total_ is the sum of their tota sum_list(Numbers, SoFar, Total) :- sumlist(Numbers, SoFar, Total). -/** @pred sum_list(? _Numbers_, ? _Total_) +/** @pred sum_list(? _Numbers_, ? _Total_) True when _Numbers_ is a list of numbers, and _Total_ is their sum. @@ -500,7 +496,7 @@ list_concat([H|T], [H|Lf], Li) :- -/** @pred flatten(+ _List_, ? _FlattenedList_) +/** @pred flatten(+ _List_, ? _FlattenedList_) Flatten a list of lists _List_ into a single list @@ -515,19 +511,19 @@ no ~~~~~ */ flatten(X,Y) :- flatten_list(X,Y,[]). - + flatten_list(V) --> {var(V)}, !, [V]. flatten_list([]) --> !. flatten_list([H|T]) --> !, flatten_list(H),flatten_list(T). flatten_list(H) --> [H]. - + max_list([H|L],Max) :- max_list(L,H,Max). max_list([],Max,Max). max_list([H|L],Max0,Max) :- ( - H > Max0 + H > Max0 -> max_list(L,H,Max) ; @@ -540,7 +536,7 @@ min_list([H|L],Max) :- min_list([],Max,Max). min_list([H|L],Max0,Max) :- ( - H < Max0 + H < Max0 -> min_list(L, H, Max) ; @@ -548,10 +544,10 @@ min_list([H|L],Max0,Max) :- ). %% numlist(+Low, +High, -List) is semidet. -% +% % List is a list [Low, Low+1, ... High]. Fails if High < Low.% % -% @error type_error(integer, Low) +% @error type_error(integer, Low) % @error type_error(integer, High) numlist(L, U, Ns) :- @@ -566,7 +562,7 @@ numlist_(L, U, [L|Ns]) :- numlist_(L2, U, Ns). -/** @pred intersection(+ _Set1_, + _Set2_, + _Set3_) +/** @pred intersection(+ _Set1_, + _Set2_, + _Set3_) Succeeds if _Set3_ unifies with the intersection of _Set1_ and @@ -574,14 +570,14 @@ Succeeds if _Set3_ unifies with the intersection of _Set1_ and need not be ordered. The code was copied from SWI-Prolog's list library. - + */ % copied from SWI lists library. intersection([], _, []) :- !. intersection([X|T], L, Intersect) :- - memberchk(X, L), !, - Intersect = [X|R], + memberchk(X, L), !, + Intersect = [X|R], intersection(T, L, R). intersection([_|T], L, R) :- intersection(T, L, R). @@ -624,4 +620,4 @@ close_list([_|T]) :- close_list(T). -%% @} \ No newline at end of file +%% @} diff --git a/library/maplist.yap b/library/maplist.yap index 07d826d62..87a384826 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -3,10 +3,10 @@ * @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA * @author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa * @date 4 August 1984 and Ken Johnson 11-8-87 - * + * * @brief Macros to apply a predicate to all elements of a list. - * - * + * + * */ :- module(maplist, @@ -156,7 +156,6 @@ triple. See the example above. :- use_module(library(maputils)). :- use_module(library(lists), [append/3]). :- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]). -:- use_module(library(error), [must_be/2]). :- use_module(library(occurs), [sub_term/2]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1245,4 +1244,3 @@ goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :- /** @} */ - diff --git a/library/random.yap b/library/random.yap index ba5752abf..fd5aca37a 100644 --- a/library/random.yap +++ b/library/random.yap @@ -20,10 +20,10 @@ * @author original code from RA O'Keefe. * @author VITOR SANTOS COSTA * @date Wed Nov 18 00:05:21 2015 - * + * * @brief Integer Random Number Generator - * - * + * + * */ :- module(random, [ @@ -54,13 +54,13 @@ In ROK's words: ``This is algorithm AS 183 from Applied Statistics. I also have */ -/** @pred getrand(- _Key_) +/** @pred getrand(- _Key_) Unify _Key_ with a term of the form `rand(X,Y,Z)` describing the current state of the random number generator. - + */ @@ -71,7 +71,7 @@ Unify _Number_ with a number in the range integers then _NUMBER_ will also be an integer, otherwise _NUMBER_ will be a floating-point number. - + */ @@ -85,34 +85,34 @@ The following routines produce random non-negative integers in the range generated by this random number generator are repeatable. This generator was originally written by Allen Van Gelder and is based on Knuth Vol 2. - + */ -/** @pred random(- _Number_) +/** @pred random(- _Number_) Unify _Number_ with a floating-point number in the range `[0...1)`. - + */ -/** @pred randseq(+ _LENGTH_, + _MAX_, - _Numbers_) +/** @pred randseq(+ _LENGTH_, + _MAX_, - _Numbers_) Unify _Numbers_ with a list of _LENGTH_ unique random integers in the range `[1... _MAX_)`. - + */ -/** @pred randset(+ _LENGTH_, + _MAX_, - _Numbers_) +/** @pred randset(+ _LENGTH_, + _MAX_, - _Numbers_) Unify _Numbers_ with an ordered list of _LENGTH_ unique random integers in the range `[1... _MAX_)`. - + */ -/** @pred setrand(+ _Key_) +/** @pred setrand(+ _Key_) Use a term of the form `rand(X,Y,Z)` to set a new state for the @@ -126,7 +126,6 @@ random number generator. The integer `X` must be in the range */ :- use_module(library(pairs)). -:- use_module(library(error)). :- use_module(library(lists)). @@ -152,25 +151,25 @@ random(L, U, R) :- ). /* There are two versions of this operation. - + randset(K, N, S) - + generates a random set of K integers in the range 1..N. The result is an ordered list, such as setof might produce. - + randseq(K, N, L) - + generates a random sequence of K integers, the order is as random as we can make it. */ - - + + randset(K, N, S) :- K >= 0, K =< N, randset(K, N, [], S). - - + + randset(0, _, S, S) :- !. randset(K, N, Si, So) :- random(X), @@ -181,13 +180,13 @@ randset(K, N, Si, So) :- randset(K, N, Si, So) :- M is N-1, randset(K, M, Si, So). - - + + randseq(K, N, S) :- randseq(K, N, L, []), keysort(L, R), strip_keys(R, S). - + randseq(0, _, S, S) :- !. randseq(K, N, [Y-N|Si], So) :- random(X), @@ -199,8 +198,8 @@ randseq(K, N, [Y-N|Si], So) :- randseq(K, N, Si, So) :- M is N-1, randseq(K, M, Si, So). - - + + strip_keys([], []) :- !. strip_keys([_-K|L], [K|S]) :- strip_keys(L, S). @@ -212,14 +211,10 @@ setrand(rand(X,Y,Z)) :- X > 0, X < 30269, Y > 0, - Y < 30307, + Y < 30307, Z > 0, Z < 30323, setrand(X,Y,Z). getrand(rand(X,Y,Z)) :- getrand(X,Y,Z). - - - - diff --git a/library/ytest.yap b/library/ytest.yap index b5929d2cb..0b7a60f72 100644 --- a/library/ytest.yap +++ b/library/ytest.yap @@ -3,9 +3,13 @@ run_tests/0, test_mode/0, op(1150, fx, test), - op(999, xfx, returns)] ). + op(995, xfx, given), + op(990, xfx, returns)] ). -:- use_module( clauses ). +:- use_module( library(clauses) ). +:- use_module( library(maplist) ). +:- use_module( library(gensym) ). +:- use_module( library(lists) ). :- multifile test/1. @@ -17,37 +21,47 @@ user:term_expansion( test( (A, B) ), ytest:test( Lab, Cond, Done ) ) :- info((A,B), Lab, Cond , Done ). run_tests :- - run_test(_Lab), + source_module(M), + run_test(_Lab,M), fail. run_tests :- show_bad. -run_test(Lab) :- - current_module(M,M), +run_test(Lab, M) :- + test(Lab, (G returns Sols given Program ), Done), + ensure_ground( Done), + format('~w : ',[ Lab ]), + reset( Streams ), + assertall(Program, Refs), + conj2list( Sols, LSols ), +% trace, + catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ), + shutdown( Streams, Refs ). +run_test(Lab,M) :- test(Lab, (G returns Sols ), Done), - ground( Done), + ensure_ground( Done), format('~w : ',[ Lab ]), reset( Streams ), conj2list( Sols, LSols ), % trace, catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ), - shutdown( Streams ). + shutdown( Streams, _ ). info((A,B), Lab, Cl, G) :- !, info(A, Lab, Cl, G), info(B, Lab, Cl, G). info(A, _, _, _) :- var(A), !. -info(A returns B, _, (A returns B), g(_,ok)) :- !. +info(A returns B, _, (A returns B), g(_,ok)) :- !. info(A, A, _, g(ok,_)) :- primitive(A), !. info(_A, _, _, _). do_returns(G0 , Sols0, Lab ) :- counter(I), fetch(I, Sols0, Pattern0, Next), - Pattern0 = ( V0 =@= Target0), - copy_term(G0-V0, G-VGF), - catch( answer(G, VGF, Target0, Lab, Sol) , Error, Sol = error(G, Error) ), - step( _I, Sols, G0, Sol, Lab ), + Pattern0 = ( V0 =@= Target0 ), + copy_term(G0-V0, G-VGF), + catch( answer(G, VGF, Target0, Lab, Sol) , Error, Sol = error(G, Error) ), + step( _I, Sols, G0, Sol, Lab ), !. answer(G, V, Target0, Lab, answer(G)) :- @@ -56,7 +70,7 @@ answer(G, V, Target0, Lab, answer(G)) :- -> success(Lab, V) ; - failure(V, Target0, Lab) + failure(V, Target0, Lab) ). step( I, Sols , G0, Sol, Lab ) :- @@ -107,14 +121,14 @@ inc( I ) :- nb_getval( counter,( I ) ), I1 is I+1, nb_setval( counter,( I1 ) ). - + counter( I ) :- nb_getval( counter,( I ) ). - -shutdown( _Streams ) :- + +shutdown( _Streams, Refs ) :- % close_io( Streams ). - true. + maplist( erase, Refs ). test_error( Ball, e( Ball ) ). @@ -148,3 +162,13 @@ end(done) :- end(Ball) :- writeln( bad:Ball ). +assertall(Cls, REfs) :- + conj2list(Cls, LCls), + maplist( assert, LCls, Refs). + +ensure_ground( g(Lab,Ok)) :- + ground(Ok), + gensym( tmp_, Lab ). +ensure_ground( g(Lab,Ok)) :- + ground(Ok), + ground(Lab). diff --git a/library/ytest/preds.yap b/library/ytest/preds.yap index 977f38bd2..251d7aad5 100644 --- a/library/ytest/preds.yap +++ b/library/ytest/preds.yap @@ -1,3 +1,5 @@ +:- [library(hacks)]. + '$predicate_flags'(P, M, Flags0, Flags1) :- var(Flags0), Flags0 == Flags1, @@ -14,7 +16,7 @@ true ; Flags1 /\ 0x200000 =\= 0, - Flags0 /\ 0x200000 =\= 0 + Flags0 /\ 0x200000 =\= 0 ). '$get_undefined_pred'(G,M,G,M0) :- @@ -55,7 +57,6 @@ user:term_expansion( ( :- '$meta_predicate'( _ ) ), [] ). user:goal_expansion(_:'_user_expand_goal'(A, M, B), user:user_expand_goal(A, M, B) ). - user_expand_goal(A, M, B) :- ( current_predicate(M:goal_expansion/2), @@ -70,8 +71,8 @@ user:goal_expansion(prolog:'$meta_predicate'(N,M,A,D) , user:mt( N, M, A, D) ). mt(N,M,A,D) :- functor(D,N,A), predicate_property(M:D, meta_predicate(D)). - - + + '$full_clause_optimisation'(_H, _M, B, B). '$c_built_in'(G, _SM, _H, G). @@ -85,6 +86,4 @@ mt(N,M,A,D) :- :- hide( expand_goal ). -:- include('pl/meta'). - - +:- include(library(boot/meta)). diff --git a/misc/ATOMS b/misc/ATOMS index ee2586dac..efb2b6cea 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -1,6 +1,6 @@ // // Fields are TAB spaced -// Atoms are of the form A Name Normal,FullLookup String +// Atoms are of the form A Name Normal,FullLookup String // Functors are of the form F Name Atom Arity // Terms are of the form T FullName Atom // @@ -25,6 +25,7 @@ A ArrayAccess F "$array_arg" A ArrayOverflow N "array_overflow" A ArrayType N "array_type" A Arrow N "->" +A AttributedModule N "attributes_module" A DoubleArrow N "-->" A Assert N ":-" A EmptyBrackets N "()" @@ -514,6 +515,7 @@ F PermissionError PermissionError 3 F Plus Plus 2 F Portray Portray 1 F PrintMessage PrintMessage 2 +F Procedure Procedure 5 F PrologConstraint Prolog 2 F Query Query 1 F RecordedWithKey RecordedWithKey 6 @@ -545,4 +547,3 @@ F UMinus Minus 1 F UPlus Plus 1 F VBar VBar 2 F HiddenVar HiddenVar 1 - diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index ae14d2b51..c28079154 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -25,193 +25,195 @@ // Restore... sets up call to RestoreFunc // +START_HEAP + /* memory management */ -UInt hole_size Yap_HoleSize void void -struct malloc_state *av_ Yap_av void void +UInt Yap_HoleSize void void +struct malloc_state *Yap_av void void #if USE_DL_MALLOC -struct memory_hole memory_holes[MAX_DLMALLOC_HOLES] Yap_MemoryHoles void void -UInt nof_memory_holes Yap_NOfMemoryHoles void void +struct Yap_MemoryHoles[MAX_DLMALLOC_HOLES] void void +UInt Yap_NOfMemoryHoles void void #if defined(YAPOR) || defined(THREADS) -lockvar dlmalloc_lock DLMallocLock MkLock +lockvar DLMallocLock MkLock #endif #endif #if USE_DL_MALLOC || (USE_SYSTEM_MALLOC && HAVE_MALLINFO) #ifndef HeapUsed #define HeapUsed Yap_givemallinfo() #endif -Int heap_used NotHeapUsed void void +Int NotHeapUsed void void #else -Int heap_used HeapUsed void void +Int HeapUsed void void #endif -Int heap_max HeapMax void void -ADDR heap_top HeapTop void void -ADDR heap_lim HeapLim void void -struct FREEB *free_blocks FreeBlocks void void +Int HeapMax void void +ADDR HeapTop void void +ADDR HeapLim void void +struct FREEB *FreeBlocks void void #if defined(YAPOR) || defined(THREADS) -lockvar free_blocks_lock FreeBlocksLock MkLock -lockvar heap_used_lock HeapUsedLock MkLock -lockvar heap_top_lock HeapTopLock MkLock -int heap_top_owner HeapTopOwner =-1 void +lockvar FreeBlocksLock MkLock +lockvar HeapUsedLock MkLock +lockvar HeapTopLock MkLock +int HeapTopOwner =-1 void #endif -UInt MaxStack_ MaxStack =0 void -UInt MaxTrail_ MaxTrail =0 void +UInt MaxStack =0 void +UInt MaxTrail =0 void /* execution info */ /* OPCODE REVERSE TABLE, needed to recover op tables */ #if USE_THREADED_CODE -op_entry *op_rtable OP_RTABLE void OpRTableAdjust +op_entry *OP_RTABLE void OpRTableAdjust #endif /* popular opcodes */ -OPCODE execute_cpred_op_code EXECUTE_CPRED_OP_CODE MkOp _execute_cpred -OPCODE expand_op_code EXPAND_OP_CODE MkOp _expand_index -OPCODE fail_op FAIL_OPCODE MkOp _op_fail -OPCODE index_op INDEX_OPCODE MkOp _index_pred -OPCODE lockpred_op LOCKPRED_OPCODE MkOp _lock_pred -OPCODE orlast_op ORLAST_OPCODE MkOp _or_last -OPCODE undef_op UNDEF_OPCODE MkOp _undef_p -OPCODE retry_userc_op RETRY_USERC_OPCODE MkOp _retry_userc -OPCODE execute_cpred_op EXECUTE_CPRED_OPCODE MkOp _execute_cpred +OPCODE EXECUTE_CPRED_OP_CODE MkOp _execute_cpred +OPCODE EXPAND_OP_CODE MkOp _expand_index +OPCODE FAIL_OPCODE MkOp _op_fail +OPCODE INDEX_OPCODE MkOp _index_pred +OPCODE LOCKPRED_OPCODE MkOp _lock_pred +OPCODE ORLAST_OPCODE MkOp _or_last +OPCODE UNDEF_OPCODE MkOp _undef_p +OPCODE RETRY_USERC_OPCODE MkOp _retry_userc +OPCODE EXECUTE_CPRED_OPCODE MkOp _execute_cpred /* atom tables */ -UInt n_of_atoms NOfAtoms void void -UInt atom_hash_table_size AtomHashTableSize void void -UInt wide_atom_hash_table_size WideAtomHashTableSize void void -UInt n_of_wide_atoms NOfWideAtoms void void -AtomHashEntry invisiblechain INVISIBLECHAIN InitInvisibleAtoms() RestoreInvisibleAtoms() -AtomHashEntry *wide_hash_chain WideHashChain InitWideAtoms() RestoreWideAtoms() -AtomHashEntry *hash_chain HashChain InitAtoms() RestoreAtoms() +UInt NOfAtoms void void +UInt AtomHashTableSize void void +UInt WideAtomHashTableSize void void +UInt NOfWideAtoms void void +AtomHashEntry INVISIBLECHAIN InitInvisibleAtoms() RestoreInvisibleAtoms() +AtomHashEntry *WideHashChain InitWideAtoms() RestoreWideAtoms() +AtomHashEntry *HashChain InitAtoms() RestoreAtoms() /* use atom defs here */ ATOMS #ifdef EUROTRA -Term term_dollar_u TermDollarU MkAT AtomDollarU +Term TermDollarU MkAT AtomDollarU #endif //modules -Term user_module USER_MODULE MkAT AtomUser -Term idb_module IDB_MODULE MkAT AtomIDB -Term attributes_module ATTRIBUTES_MODULE MkAT AtomAttributes -Term charsio_module CHARSIO_MODULE MkAT AtomCharsio -Term chtype_module CHTYPE_MODULE MkAT AtomChType -Term terms_module TERMS_MODULE MkAT AtomTerms -Term system_module SYSTEM_MODULE MkAT AtomSystem -Term readutil_module READUTIL_MODULE MkAT AtomReadutil -Term hacks_module HACKS_MODULE MkAT AtomYapHacks -Term arg_module ARG_MODULE MkAT AtomArg -Term globals_module GLOBALS_MODULE MkAT AtomNb -Term swi_module SWI_MODULE MkAT AtomSwi -Term dbload_module DBLOAD_MODULE MkAT AtomDBLoad -Term range_module RANGE_MODULE MkAT AtomRange -Term error_module ERROR_MODULE MkAT AtomError +Term USER_MODULE MkAT AtomUser +Term IDB_MODULE MkAT AtomIDB +Term ATTRIBUTES_MODULE MkAT AtomAttributes +Term CHARSIO_MODULE MkAT AtomCharsio +Term CHTYPE_MODULE MkAT AtomChType +Term TERMS_MODULE MkAT AtomTerms +Term SYSTEM_MODULE MkAT AtomSystem +Term READUTIL_MODULE MkAT AtomReadutil +Term HACKS_MODULE MkAT AtomYapHacks +Term ARG_MODULE MkAT AtomArg +Term GLOBALS_MODULE MkAT AtomNb +Term SWI_MODULE MkAT AtomSwi +Term DBLOAD_MODULE MkAT AtomDBLoad +Term RANGE_MODULE MkAT AtomRange +Term ERROR_MODULE MkAT AtomError // // Module list // -struct mod_entry *current_modules CurrentModules =NULL ModEntryPtrAdjust +struct mod_entry *CurrentModules =NULL ModEntryPtrAdjust // make sure we have the modules set at this point. // don't actually want to define a field -void void void Yap_InitModules() void +void void Yap_InitModules() void // hidden predicates -Prop hidden_predicates HIDDEN_PREDICATES =NULL RestoreHiddenPredicates() +Prop HIDDEN_PREDICATES =NULL RestoreHiddenPredicates() // make sure we have the streams set at this point. // don't actually want to define a field -void void void Yap_InitPlIO() void +void void Yap_InitPlIO() void -union flagTerm* GLOBAL_Flags_ GLOBAL_Flags =0 void -UInt GLOBAL_flagCount_ GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount) +union flagTerm* GLOBAL_Flags =0 void +UInt GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount) /* Anderson's JIT */ -yap_exec_mode execution_mode Yap_ExecutionMode =INTERPRETED void +yap_exec_mode Yap_ExecutionMode =INTERPRETED void /* The Predicate Hash Table: fast access to predicates. */ -struct pred_entry **pred_hash PredHash InitPredHash() RestorePredHash() +struct pred_entry **PredHash InitPredHash() RestorePredHash() #if defined(YAPOR) || defined(THREADS) -rwlock_t pred_hash_rw_lock PredHashRWLock void +rwlock_t PredHashRWLock void #endif -UInt preds_in_hash_table PredsInHashTable =0 void -UInt pred_hash_table_size PredHashTableSize void +UInt PredsInHashTable =0 void +uint64_t PredHashTableSize =0 void /* Well-Known Predicates */ -struct pred_entry *creep_code CreepCode MkPred AtomCreep 1 PROLOG_MODULE -struct pred_entry *undef_code UndefCode MkPred AtomUndefp 2 PROLOG_MODULE -struct pred_entry *spy_code SpyCode MkPred AtomSpy 1 PROLOG_MODULE -struct pred_entry *pred_fail PredFail MkPred AtomFail 0 PROLOG_MODULE -struct pred_entry *pred_true PredTrue MkPred AtomTrue 0 PROLOG_MODULE +struct pred_entry *CreepCode MkPred AtomCreep 1 PROLOG_MODULE +struct pred_entry *UndefCode MkPred AtomUndefp 2 PROLOG_MODULE +struct pred_entry *SpyCode MkPred AtomSpy 1 PROLOG_MODULE +struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE +struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE #ifdef COROUTINING -struct pred_entry *wake_up_code WakeUpCode MkPred AtomWakeUpGoal 2 PROLOG_MODULE +struct pred_entry *WakeUpCode MkPred AtomWakeUpGoal 2 PROLOG_MODULE #endif -struct pred_entry *pred_goal_expansion PredGoalExpansion MkPred FunctorGoalExpansion USER_MODULE -struct pred_entry *pred_meta_call PredMetaCall MkPred FunctorMetaCall PROLOG_MODULE -struct pred_entry *pred_trace_meta_call PredTraceMetaCall MkPred FunctorTraceMetaCall PROLOG_MODULE -struct pred_entry *pred_dollar_catch PredDollarCatch MkPred FunctorCatch PROLOG_MODULE -struct pred_entry *pred_recorded_with_key PredRecordedWithKey MkPred FunctorRecordedWithKey PROLOG_MODULE -struct pred_entry *pred_log_upd_clause PredLogUpdClause MkPred FunctorDoLogUpdClause PROLOG_MODULE -struct pred_entry *pred_log_upd_clause_erase PredLogUpdClauseErase MkPred FunctorDoLogUpdClauseErase PROLOG_MODULE -struct pred_entry *pred_log_upd_clause0 PredLogUpdClause0 MkPred FunctorDoLogUpdClause PROLOG_MODULE -struct pred_entry *pred_static_clause PredStaticClause MkPred FunctorDoStaticClause PROLOG_MODULE -struct pred_entry *pred_throw PredThrow MkPred FunctorThrow PROLOG_MODULE -struct pred_entry *pred_handle_throw PredHandleThrow MkPred FunctorHandleThrow PROLOG_MODULE -struct pred_entry *pred_is PredIs MkPred FunctorIs PROLOG_MODULE -struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup MkPred FunctorSafeCallCleanup PROLOG_MODULE -struct pred_entry *pred_restore_regs PredRestoreRegs MkPred FunctorRestoreRegs PROLOG_MODULE -struct pred_entry *pred_comment_hook PredCommentHook MkPred FunctorCommentHook PROLOG_MODULE +struct pred_entry *PredGoalExpansion MkPred FunctorGoalExpansion USER_MODULE +struct pred_entry *PredMetaCall MkPred FunctorMetaCall PROLOG_MODULE +struct pred_entry *PredTraceMetaCall MkPred FunctorTraceMetaCall PROLOG_MODULE +struct pred_entry *PredDollarCatch MkPred FunctorCatch PROLOG_MODULE +struct pred_entry *PredRecordedWithKey MkPred FunctorRecordedWithKey PROLOG_MODULE +struct pred_entry *PredLogUpdClause MkPred FunctorDoLogUpdClause PROLOG_MODULE +struct pred_entry *PredLogUpdClauseErase MkPred FunctorDoLogUpdClauseErase PROLOG_MODULE +struct pred_entry *PredLogUpdClause0 MkPred FunctorDoLogUpdClause PROLOG_MODULE +struct pred_entry *PredStaticClause MkPred FunctorDoStaticClause PROLOG_MODULE +struct pred_entry *PredThrow MkPred FunctorThrow PROLOG_MODULE +struct pred_entry *PredHandleThrow MkPred FunctorHandleThrow PROLOG_MODULE +struct pred_entry *PredIs MkPred FunctorIs PROLOG_MODULE +struct pred_entry *PredSafeCallCleanup MkPred FunctorSafeCallCleanup PROLOG_MODULE +struct pred_entry *PredRestoreRegs MkPred FunctorRestoreRegs PROLOG_MODULE +struct pred_entry *PredCommentHook MkPred FunctorCommentHook PROLOG_MODULE #ifdef YAPOR -struct pred_entry *pred_getwork PredGetwork MkPred AtomGetwork 0 PROLOG_MODULE -struct pred_entry *pred_getwork_seq PredGetworkSeq MkPred AtomGetworkSeq 0 PROLOG_MODULE +struct pred_entry *PredGetwork MkPred AtomGetwork 0 PROLOG_MODULE #endif /* YAPOR */ +struct pred_entry *PredProcedure MkLogPred FunctorProcedure PROLOG_MODULE /* low-level tracer */ #ifdef LOW_LEVEL_TRACER -int yap_do_low_level_trace Yap_do_low_level_trace =FALSE void +int Yap_do_low_level_trace =FALSE void #if defined(YAPOR) || defined(THREADS) -lockvar low_level_trace_lock Yap_low_level_trace_lock MkLock +lockvar Yap_low_level_trace_lock MkLock #endif #endif /* code management info */ -UInt clause_space Yap_ClauseSpace =0 void -UInt index_space_Tree Yap_IndexSpace_Tree =0 void -UInt index_space_EXT Yap_IndexSpace_EXT =0 void -UInt index_space_SW Yap_IndexSpace_SW =0 void -UInt lu_clause_space Yap_LUClauseSpace =0 void -UInt lu_index_space_Tree Yap_LUIndexSpace_Tree =0 void -UInt lu_index_space_CP Yap_LUIndexSpace_CP =0 void -UInt lu_index_space_EXT Yap_LUIndexSpace_EXT =0 void -UInt lu_index_space_SW Yap_LUIndexSpace_SW =0 void +UInt Yap_ClauseSpace =0 void +UInt Yap_IndexSpace_Tree =0 void +UInt Yap_IndexSpace_EXT =0 void +UInt Yap_IndexSpace_SW =0 void +UInt Yap_LUClauseSpace =0 void +UInt Yap_LUIndexSpace_Tree =0 void +UInt Yap_LUIndexSpace_CP =0 void +UInt Yap_LUIndexSpace_EXT =0 void +UInt Yap_LUIndexSpace_SW =0 void /* static code: may be shared by many predicate or may be used for meta-execution */ -yamop comma_code[5] COMMA_CODE void void -yamop dummycode[1] DUMMYCODE MkInstE _op_fail -yamop failcode[1] FAILCODE MkInstE _op_fail -yamop nocode[1] NOCODE MkInstE _Nstop +yamop COMMA_CODE[5] void void +yamop DUMMYCODE[1] MkInstE _op_fail +yamop FAILCODE[1] MkInstE _op_fail +yamop NOCODE[1] MkInstE _Nstop -yamop env_for_trustfail[2] ENV_FOR_TRUSTFAIL InitEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail) RestoreEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail) -yamop *trustfailcode TRUSTFAILCODE void -yamop env_for_yescode[2] ENV_FOR_YESCODE InitEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail) RestoreEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail) -yamop *yescode YESCODE void +yamop ENV_FOR_TRUSTFAIL[2] InitEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail) RestoreEnvInst(ENV_FOR_TRUSTFAIL,&TRUSTFAILCODE,_trust_fail,PredFail) +yamop *TRUSTFAILCODE void +yamop ENV_FOR_YESCODE[2] InitEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail) RestoreEnvInst(ENV_FOR_YESCODE,&YESCODE,_Ystop,PredFail) +yamop *YESCODE void - yamop rtrycode[1] RTRYCODE InitOtaplInst(RTRYCODE,_retry_and_mark,PredFail) RestoreOtaplInst(RTRYCODE,_retry_and_mark,PredFail) +yamop RTRYCODE[1] InitOtaplInst(RTRYCODE,_retry_and_mark,PredFail) RestoreOtaplInst(RTRYCODE,_retry_and_mark,PredFail) #ifdef BEAM -yamop beam_retry_code[1] BEAM_RETRY_CODE MkInstE _beam_retry_code +yamop BEAM_RETRY_CODE[1] MkInstE _beam_retry_code #endif /* BEAM */ #ifdef YAPOR -yamop getwork_code[1] GETWORK InitOtaplInst(GETWORK,_getwork,PredGetwork) RestoreOtaplInst(GETWORK,_getwork,PredGetwork) -yamop getwork_seq_code[1] GETWORK_SEQ InitOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq) RestoreOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq) -yamop getwork_first_time[1] GETWORK_FIRST_TIME MkInstE _getwork_first_time +yamop GETWORK[1] InitOtaplInst(GETWORK,_getwork,PredGetwork) RestoreOtaplInst(GETWORK,_getwork,PredGetwork) +yamop GETWORK_SEQ[1] InitOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq) RestoreOtaplInst(GETWORK_SEQ,_getwork_seq,PredGetworkSeq) +yamop GETWORK_FIRST_TIME[1] MkInstE _getwork_first_time #endif /* YAPOR */ #ifdef TABLING -yamop table_load_answer_code[1] LOAD_ANSWER InitOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail) RestoreOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail) -yamop table_try_answer_code[1] TRY_ANSWER InitOtaplInst(TRY_ANSWER,_table_try_answer,PredFail) RestoreOtaplInst(TRY_ANSWER,_table_try_answer,PredFail) -yamop table_answer_resolution_code[1] ANSWER_RESOLUTION InitOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail) RestoreOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail) -yamop table_completion_code[1] COMPLETION InitOtaplInst(COMPLETION,_table_completion,PredFail) RestoreOtaplInst(COMPLETION,_table_completion,PredFail) +yamop LOAD_ANSWER[1] InitOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail) RestoreOtaplInst(LOAD_ANSWER,_table_load_answer,PredFail) +yamop TRY_ANSWER[1] InitOtaplInst(TRY_ANSWER,_table_try_answer,PredFail) RestoreOtaplInst(TRY_ANSWER,_table_try_answer,PredFail) +yamop ANSWER_RESOLUTION[1] InitOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail) RestoreOtaplInst(ANSWER_RESOLUTION,_table_answer_resolution,PredFail) +yamop COMPLETION[1] InitOtaplInst(COMPLETION,_table_completion,PredFail) RestoreOtaplInst(COMPLETION,_table_completion,PredFail) #ifdef THREADS_CONSUMER_SHARING -yamop table_answer_resolution_completion_code[1] ANSWER_RESOLUTION_COMPLETION InitOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail) RestoreOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail) +yamop ANSWER_RESOLUTION_COMPLETION[1] InitOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail) RestoreOtaplInst(ANSWER_RESOLUTION_COMPLETION,_table_answer_resolution_completion,PredFail) #endif /* THREADS_CONSUMER_SHARING */ #endif /* TABLING */ @@ -219,123 +221,125 @@ yamop table_answer_resolution_completion_code[1] ANSWER_RESOLUTIO /* PREG just before we enter $spy. We use that to find out the clause which */ /* was calling the debugged goal. */ /* */ -yamop *debugger_p_before_spy P_before_spy =NULL PtoOpAdjust +yamop *P_before_spy =NULL PtoOpAdjust /* support recorded_k */ -yamop *retry_recordedp_code RETRY_C_RECORDEDP_CODE =NULL PtoOpAdjust -yamop *retry_recorded_k_code RETRY_C_RECORDED_K_CODE =NULL PtoOpAdjust - +yamop *RETRY_C_RECORDEDP_CODE =NULL PtoOpAdjust +yamop *RETRY_C_RECORDED_K_CODE =NULL PtoOpAdjust +R /* compiler flags */ -int system_profiling PROFILING =FALSE void -int system_call_counting CALL_COUNTING =FALSE void -int compiler_optimizer_on optimizer_on =TRUE void -int compiler_compile_mode compile_mode =0 void -int compiler_profiling profiling =FALSE void -int compiler_call_counting call_counting =FALSE void +int PROFILING =FALSE void +int CALL_COUNTING =FALSE void +int optimizer_on =TRUE void +int compile_mode =0 void +int profiling =FALSE void +int call_counting =FALSE void /********* whether we should try to compile array references ******************/ -int compiler_compile_arrays compile_arrays =FALSE void +int compile_arrays =FALSE void /* DBTerms: pre-compiled ground terms */ #if defined(YAPOR) || defined(THREADS) -lockvar dbterms_list_lock DBTermsListLock MkLock +lockvar DBTermsListLock MkLock #endif -struct dbterm_list *dbterms_list DBTermsList =NULL RestoreDBTermsList() +struct dbterm_list *DBTermsList =NULL RestoreDBTermsList() /* JITI support */ -yamop *expand_clauses_first ExpandClausesFirst =NULL void -yamop *expand_clauses_last ExpandClausesLast =NULL RestoreExpandList() -UInt expand_clauses Yap_ExpandClauses =0 void +yamop *ExpandClausesFirst =NULL void +yamop *ExpandClausesLast =NULL RestoreExpandList() +UInt Yap_ExpandClauses =0 void #if defined(YAPOR) || defined(THREADS) -lockvar expand_clauses_list_lock ExpandClausesListLock MkLock -lockvar op_list_lock OpListLock MkLock +lockvar ExpandClausesListLock MkLock +lockvar OpListLock MkLock #endif /* instrumentation */ #ifdef DEBUG -UInt new_cps Yap_NewCps =0L void -UInt live_cps Yap_LiveCps =0L void -UInt dirty_cps Yap_DirtyCps =0L void -UInt freed_cps Yap_FreedCps =0L void +UInt Yap_NewCps =0L void +UInt Yap_LiveCps =0L void +UInt Yap_DirtyCps =0L void +UInt Yap_FreedCps =0L void #endif -UInt expand_clauses_sz Yap_expand_clauses_sz =0L void +UInt Yap_expand_clauses_sz =0L void /* UDI support */ -struct udi_info *udi_control_blocks UdiControlBlocks =NULL RestoreUdiControlBlocks() +struct udi_info *UdiControlBlocks =NULL RestoreUdiControlBlocks() /* data-base statistics */ /* system boots in compile mode */ -Int static_predicates_marked STATIC_PREDICATES_MARKED =FALSE void +Int STATIC_PREDICATES_MARKED =FALSE void /* Internal Database */ -Prop *IntKeys INT_KEYS =NULL RestoreIntKeys() -Prop *IntLUKeys INT_LU_KEYS =NULL RestoreIntLUKeys() -Prop *IntBBKeys INT_BB_KEYS =NULL RestoreIntBBKeys() +Prop *INT_KEYS =NULL RestoreIntKeys() +Prop *INT_LU_KEYS =NULL RestoreIntLUKeys() +Prop *INT_BB_KEYS =NULL RestoreIntBBKeys() /* Internal Database Statistics */ -UInt int_keys_size INT_KEYS_SIZE =INT_KEYS_DEFAULT_SIZE void -UInt int_keys_timestamp INT_KEYS_TIMESTAMP =0L void -UInt int_bb_keys_size INT_BB_KEYS_SIZE =INT_KEYS_DEFAULT_SIZE void +UInt INT_KEYS_SIZE =INT_KEYS_DEFAULT_SIZE void +UInt INT_KEYS_TIMESTAMP =0L void +UInt INT_BB_KEYS_SIZE =INT_KEYS_DEFAULT_SIZE void /* Internal Data-Base Control */ -int update_mode UPDATE_MODE =UPDATE_MODE_LOGICAL void +int UPDATE_MODE =UPDATE_MODE_LOGICAL void /* nasty IDB stuff */ -struct DB_STRUCT *db_erased_marker DBErasedMarker InitDBErasedMarker() RestoreDBErasedMarker() -struct logic_upd_clause *logdb_erased_marker LogDBErasedMarker InitLogDBErasedMarker() RestoreLogDBErasedMarker() +struct DB_STRUCT *DBErasedMarker InitDBErasedMarker() RestoreDBErasedMarker() +struct logic_upd_clause *LogDBErasedMarker InitLogDBErasedMarker() RestoreLogDBErasedMarker() /* Dead clauses and IDB entries */ -struct static_clause *dead_static_clauses DeadStaticClauses =NULL RestoreDeadStaticClauses() -struct static_mega_clause *dead_mega_clauses DeadMegaClauses =NULL RestoreDeadMegaClauses() -struct static_index *dead_static_indices DeadStaticIndices =NULL RestoreDeadStaticIndices() -struct logic_upd_clause *db_erased_list DBErasedList =NULL RestoreDBErasedList() -struct logic_upd_index *db_erased_ilist DBErasedIList =NULL RestoreDBErasedIList() +struct static_clause *DeadStaticClauses =NULL RestoreDeadStaticClauses() +struct static_mega_clause *DeadMegaClauses =NULL RestoreDeadMegaClauses() +struct static_index *DeadStaticIndices =NULL RestoreDeadStaticIndices() +struct logic_upd_clause *DBErasedList =NULL RestoreDBErasedList() +struct logic_upd_index *DBErasedIList =NULL RestoreDBErasedIList() #if defined(YAPOR) || defined(THREADS) -lockvar dead_static_clauses_lock DeadStaticClausesLock MkLock -lockvar dead_mega_clauses_lock DeadMegaClausesLock MkLock -lockvar dead_static_indices_lock DeadStaticIndicesLock MkLock +lockvar DeadStaticClausesLock MkLock +lockvar DeadMegaClausesLock MkLock +lockvar DeadStaticIndicesLock MkLock #endif #ifdef COROUTINING /* number of attribute modules */ -int num_of_atts NUM_OF_ATTS =1 void +int NUM_OF_ATTS =1 void /* initialised by memory allocator */ -UInt atts_size Yap_AttsSize void void +UInt Yap_AttsSize void void #endif /* Operators */ -struct operator_entry *op_list OpList =NULL OpListAdjust +struct operator_entry *OpList =NULL OpListAdjust /* foreign code loaded */ -struct ForeignLoadItem *foreign_code_loaded ForeignCodeLoaded =NULL RestoreForeignCode() -ADDR foreign_code_base ForeignCodeBase =NULL void -ADDR foreign_code_top ForeignCodeTop =NULL void -ADDR foreign_code_max ForeignCodeMax =NULL void +struct ForeignLoadItem *ForeignCodeLoaded =NULL RestoreForeignCode() +ADDR ForeignCodeBase =NULL void +ADDR ForeignCodeTop =NULL void +ADDR ForeignCodeMax =NULL void /* recorded terms */ -struct record_list *yap_records Yap_Records =NULL RestoreYapRecords() +struct record_list *Yap_Records =NULL RestoreYapRecords() /* SWI atoms and functors */ -Atom *swi_atoms SWI_Atoms InitSWIAtoms() RestoreSWIAtoms() -Functor *swi_functors SWI_Functors void void +Atom *SWI_Atoms InitSWIAtoms() RestoreSWIAtoms() +Functor *SWI_Functors void void -struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash void void +swi_rev_hash SWI_ReverseHash[N_SWI_HASH] void void /* integer access to atoms */ -Int atom_translations AtomTranslations void void -Int max_atom_translations MaxAtomTranslations void void +Int AtomTranslations void void +Int MaxAtomTranslations void void /* integer access to functors */ -Int functor_translations FunctorTranslations void void -Int max_functor_translations MaxFunctorTranslations void void +Int FunctorTranslations void void +Int MaxFunctorTranslations void void -Atom empty_wakeups[MAX_EMPTY_WAKEUPS] EmptyWakeups InitEmptyWakeups() RestoreEmptyWakeups() -int max_empty_wakeups MaxEmptyWakeups =0 +Atom EmptyWakeups[MAX_EMPTY_WAKEUPS] InitEmptyWakeups() RestoreEmptyWakeups() +int MaxEmptyWakeups =0 /* SWI blobs */ -struct YAP_blob_t *swi_blob_types BlobTypes =NULL RestoreBlobTypes() -struct AtomEntryStruct *swi_blobs Blobs =NULL RestoreBlobs() -UInt nofblobs NOfBlobs =0 -UInt nofblobsmax NOfBlobsMax =256 +struct YAP_blob_t *BlobTypes =NULL RestoreBlobTypes() +struct AtomEntryStruct *Blobs =NULL RestoreBlobs() +UInt NOfBlobs =0 +UInt NOfBlobsMax =256 #if defined(YAPOR) || defined(THREADS) -lockvar blobs_lock Blobs_Lock MkLock +lockvar Blobs_Lock MkLock #endif + +END_HEAP diff --git a/misc/buildheap b/misc/buildheap index 048080992..fa2d306cc 100644 --- a/misc/buildheap +++ b/misc/buildheap @@ -30,11 +30,9 @@ main :- %file_filter_with_initialization('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']), %file_filter_with_initialization('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']), %file_filter_with_initialization('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']). - + warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildheap\"~n please do not update, update misc/~a instead */~n~n'). - - /* define the field */ gen_struct(Inp,"") :- Inp = [0'/,0'/|_], !. @@ -50,6 +48,12 @@ gen_struct(Inp,Out) :- gen_struct(Inp,Out) :- Inp = "END_WORKER_LOCAL", !, Out = "} w_local;". +gen_struct(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "typedef struct worker_local {". +gen_struct(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "} w_local;". gen_struct(Inp,Out) :- Inp = "START_GLOBAL_DATA", !, Out = "typedef struct global_data {". @@ -76,7 +80,7 @@ gen_struct(Inp,Out) :- gen_struct(Inp,_) :- split(Inp," ",[_, _, _| _]), format(user_error,"OOPS: could not gen_struct for ~s~n",[Inp]). - + gen_dstruct(Inp,"") :- Inp = [0'/,0'/|_], !. gen_dstruct(Inp,"") :- @@ -145,8 +149,8 @@ cut_c_stuff(Name, RName) :- cut_mat(Name, RName). cut_mat([], []). -cut_mat([0'[|_], []) :- !. %' -cut_mat(H.Name, H.RName) :- +cut_mat([0'[|_], []) :- !. %' +cut_mat([H|Name], [H|RName]) :- cut_mat(Name, RName). gen_hstruct(Inp,"") :- @@ -185,9 +189,9 @@ gen_hstruct(Inp,Out) :- glue(Inp2, " ", Inp3), gen_hstruct(Inp3,Out). gen_hstruct(Inp,Out) :- - split(Inp," ",["const"|Inp2]), !, - glue(Inp2, " ", Inp3), - gen_hstruct(Inp3,Out). + split(Inp," ",["const"|Inp2]), !, + glue(Inp2, " ", Inp3), + gen_hstruct(Inp3,Out). gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field, MacroName, "MkAT", _]), !, fetch_name(Global,Field,MacroName), @@ -257,6 +261,14 @@ gen_init(Inp,Out) :- Inp = "END_GLOBAL_DATA", !, Out = "}", retract(globals(all)). +gen_init(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "static void InitGlobal(void) {", + assert(globals(heap)). +gen_init(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "}", + retract(globals(heap)). gen_init(Inp,Out) :- split(Inp," ",["struct"|Inp2]), !, glue(Inp2, " ", Inp3), @@ -306,20 +318,20 @@ gen_init(Inp,Out) :- fetch_name(Global,RField,MacroName), append([" ",Global,"->opc = Yap_opcode(",OP,");"], Out). gen_init(Inp,Out) :- - split(Inp," ",[_, Field, MacroName, "MkPred", Atom, "0", Module]), !, + split(Inp," ",[_, Field, MacroName, "MkLogPred", Atom, "0", Module]), !, cut_c_stuff(Field, RField), fetch_name(Global,RField,MacroName), - append([" ",Global," = RepPredProp(PredPropByAtom(",Atom,",",Module,"));"], Out). + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByAtom(",Atom,",",Module,")));"], Out). gen_init(Inp,Out) :- - split(Inp," ",[_, Field, MacroName, "MkPred", Atom, Arity, Module]), !, + split(Inp," ",[_, Field, MacroName, "MkLogPred", Atom, Arity, Module]), !, cut_c_stuff(Field, RField), fetch_name(Global,RField,MacroName), - append([" ",Global," = RepPredProp(PredPropByFunc(Yap_MkFunctor(",Atom,",",Arity,"),",Module,"));"], Out). + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByFunc(Yap_MkFunctor(",Atom,",",Arity,"),",Module,")));"], Out). gen_init(Inp,Out) :- - split(Inp," ",[_, Field, MacroName, "MkPred", Fun, Module]), !, + split(Inp," ",[_, Field, MacroName, "MkLogPred", Fun, Module]), !, cut_c_stuff(Field, RField), fetch_name(Global,RField,MacroName), - append([" ",Global," = RepPredProp(PredPropByFunc(",Fun,",",Module,"));"], Out). + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByFunc(",Fun,",",Module,")));"], Out). gen_init(Inp,Out) :- split(Inp," ",[_, Field, MacroName, F0|_]), append("=",F,F0), !, @@ -329,4 +341,3 @@ gen_init(Inp,Out) :- gen_init(Inp,_) :- split(Inp," ",[_, _, _| _]), format(user_error,"OOPS: could not gen_init for ~s~n",[Inp]). - diff --git a/misc/buildlocalglobal b/misc/buildlocalglobal index 629bebf26..b16b6a3ff 100644 --- a/misc/buildlocalglobal +++ b/misc/buildlocalglobal @@ -1,12 +1,12 @@ :- use_module(library(lineutils), - [file_filter_with_init/5, - split/3, - glue/3]). + [file_filter_with_init/5, + split/3, + glue/3]). :- use_module(library(lists), - [append/2, - append/3]). + [append/2, + append/3]). :- initialization(main). @@ -17,31 +17,33 @@ :- style_check(all). file_filter_with_initialization(A,B,C,D,E) :- - file_filter_with_init(A,B,C,D,E). + file_filter_with_init(A,B,C,D,E). main :- warning(Warning), - %file_filter_with_initialization('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']), - %file_filter_with_initialization('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']), - %file_filter_with_initialization('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']), - %file_filter_with_initialization('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']), - file_filter_with_initialization('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']), - file_filter_with_initialization('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']), - file_filter_with_initialization('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']), - file_filter_with_initialization('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']), - file_filter_with_initialization('misc/LOCALS','H/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']), - file_filter_with_initialization('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']), - file_filter_with_initialization('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']), - file_filter_with_initialization('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']). - + file_filter_with_initialization('misc/HEAPFIELDS','H/heap/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']), + file_filter_with_initialization('misc/HEAPFIELDS','H/heap/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']), + file_filter_with_initialization('misc/HEAPFIELDS','H/heap/h0struct.h',gen_0struct,Warning,['d0hstruct.h','HEAPFIELDS']), + file_filter_with_initialization('misc/HEAPFIELDS','H/heap/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']), + file_filter_with_initialization('misc/HEAPFIELDS','H/heap/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']), + file_filter_with_initialization('misc/GLOBALS','H/heap/h0globals.h',gen_0struct,Warning,['hglobals.h','GLOBALS']), + file_filter_with_initialization('misc/GLOBALS','H/heap/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']), + file_filter_with_initialization('misc/GLOBALS','H/heap/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']), + file_filter_with_initialization('misc/GLOBALS','H/heap/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']), + file_filter_with_initialization('misc/GLOBALS','H/heap/i0globals.h',gen_0init,Warning,['iglobals.h','GLOBALS']), + file_filter_with_initialization('misc/LOCALS','H/heap/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']), + file_filter_with_initialization('misc/LOCALS','H/heap/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']), + file_filter_with_initialization('misc/LOCALS','H/heap/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']), + file_filter_with_initialization('misc/LOCALS','H/heap/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']). + warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildlocalglobal\"~n please do not update, update misc/~a instead */~n~n'). /* define the field */ -gen_struct(Inp,"") :- +gen_struct(Inp,Inp) :- Inp = [0'/,0'/|_], !. -gen_struct(Inp,"") :- +gen_struct(Inp,Inp) :- Inp = [0'/,0'*|_], !. gen_struct(Inp, Out) :- Inp = [0'#|_], !, Out = Inp. % ' @@ -59,6 +61,12 @@ gen_struct(Inp,Out) :- gen_struct(Inp,Out) :- Inp = "END_GLOBAL_DATA", !, Out = "} w_shared;". +gen_struct(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "". +gen_struct(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "". gen_struct(Inp,Out) :- Inp = "ATOMS", !, Out = "#include \"tatoms.h\"". @@ -74,7 +82,7 @@ gen_struct(Inp,Out) :- gen_struct(Inp,"") :- split(Inp," ",["void","void"|_]), !. gen_struct(Inp,Out) :- - split(Inp," ",[Type, Field|_]), + split(Inp," ",[Type, Field|_]), split(Field,"[",[RField,VECField]), !, append([" ",Type," ",RField,"_","[",VECField,";"], Out). gen_struct(Inp,Out) :- @@ -83,7 +91,68 @@ gen_struct(Inp,Out) :- gen_struct(Inp,_) :- split(Inp," ",[_, _, _| _]), format(user_error,"OOPS: could not gen_struct for ~s~n",[Inp]). - + +/* define the field */ +gen_0struct(Inp,Inp) :- + Inp = [0'/,0'/|_], !. +gen_0struct(Inp,Inp) :- + Inp = [0'/,0'*|_], !. +gen_0struct(Inp, Out) :- + Inp = [0'#|_], !, Out = Inp. % ' +gen_0struct(Inp,"") :- + Inp = [0'.|_], !. %' +gen_0struct(Inp,Out) :- + Inp = "START_GLOBAL_DATA", !, + Out = "", + assert(globals(all)). +gen_0struct(Inp,Out) :- + Inp = "END_GLOBAL_DATA", !, + Out = "", + retract(globals(all)). +gen_0struct(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "", + assert(globals(heap)). +gen_0struct(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "", + retract(globals(heap)). +gen_0struct(Inp,Out) :- + Inp = "ATOMS", !, + Out = "#include \"tatoms.h\"". +gen_0struct(Inp,Out) :- + split(Inp," ",["struct",Type, Field|L]), !, + extract("struct", Inp, NInp), + gen_0struct( NInp, NOut ), + extract("EXTERNAL", NOut, IOut), + append("EXTERNAL struct ", IOut, Out). +gen_0struct(Inp,Out) :- + split(Inp," ",["const",Type, Field|L]), !, + extract("const", Inp, NInp), + gen_0struct( NInp, NOut ), + extract("EXTERNAL", NOut, IOut), + append("EXTERNAL const ", IOut, Out). +gen_0struct(Inp,Out) :- + split(Inp," ",["union",Type, Field|L]), !, + extract("union", Inp, NInp), + gen_0struct( NInp, NOut ), + extract("EXTERNAL", NOut, IOut), + append("EXTERNAL union ", IOut, Out). +gen_0struct(Inp,"") :- + split(Inp," ",["void","void"|_]), !. +gen_0struct(Inp,Out) :- + split(Inp," ",[Type, Field|_]), + split(Field,"[",[RField,VECField]), !, + fetch_name(Name, RField), + append(["EXTERNAL ",Type," ",Name,"[",VECField,";"], Out). +gen_0struct(Inp,Out) :- + split(Inp," ",[Type, Field|_]), !, + fetch_name(Name, Field), + append(["EXTERNAL ",Type," ",Name,";"], Out). +gen_0struct(Inp,_) :- + split(Inp," ",[_, _, _| _]), + format(user_error,"OOPS: could not gen_0struct for ~s~n",[Inp]). + gen_dstruct(Inp,"") :- Inp = [0'/,0'/|_], !. gen_dstruct(Inp,"") :- @@ -102,6 +171,12 @@ gen_dstruct(Inp,"") :- gen_dstruct(Inp,"") :- Inp = "END_GLOBAL_DATA", !, retract(globals(all)). +gen_dstruct(Inp,"") :- + Inp = "START_HEAP", !, + assert(globals(heap)). +gen_dstruct(Inp,"") :- + Inp = "END_HEAP", !, + retract(globals(heap)). gen_dstruct(Inp,Out) :- Inp = "ATOMS", !, Out = "". @@ -138,6 +213,9 @@ fetch_name(Global,Global2,RField," ") :- globals(all), !, append(["GLOBAL_", RField],Global), append(["Yap_global->", RField,"_"],Global2). +fetch_name(RField,Global2,RField," ") :- + globals(heap), !, + append(["Yap_heap_regs->", RField,"_"],Global2). fetch_name(Global,Global2,RField," ") :- globals(worker), append(["LOCAL_", RField],Global), @@ -161,16 +239,18 @@ fetch_name(Global, RField) :- fetch_name(Global, RField) :- globals(all), !, append(["GLOBAL_", RField],Global). +fetch_name(RField, RField) :- + globals(heap), !. -% handle *field[4] + % handle *field[4] cut_c_stuff([0'*|Name], RName) :- !, % 'cut * cut_c_stuff(Name, RName). cut_c_stuff(Name, RName) :- cut_mat(Name, RName). cut_mat([], []). -cut_mat([0'[|_], []) :- !. %' -cut_mat(H.Name, H.RName) :- +cut_mat([0'[|_], []) :- !. %' +cut_mat(H.Name, H.RName) :- cut_mat(Name, RName). gen_hstruct(Inp,"") :- @@ -191,13 +271,21 @@ gen_hstruct(Inp,Out) :- Out = "}", retract(globals(worker_init)). gen_hstruct(Inp,Out) :- - Inp = "START_GLOBAL_DATA", !, - Out = "static void RestoreGlobal(void) {", - assert(globals(all)). + Inp = "START_GLOBAL_DATA", !, + Out = "static void RestoreGlobal(void) {", + assert(globals(all)). gen_hstruct(Inp,Out) :- - Inp = "END_GLOBAL_DATA", !, - Out = "}", - retract(globals(all)). + Inp = "END_GLOBAL_DATA", !, + Out = "}", + retract(globals(all)). +gen_hstruct(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "", + assert(globals(heap)). +gen_hstruct(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "", + retract(globals(heap)). gen_hstruct(Inp, Out) :- Inp = [0'#|_], !, Out = Inp. % ' gen_hstruct(Inp,Out) :- @@ -213,18 +301,28 @@ gen_hstruct(Inp,Out) :- glue(Inp2, " ", Inp3), gen_hstruct(Inp3,Out). gen_hstruct(Inp,Out) :- - split(Inp," ",[_, Field, "MkAT", _]), !, + split(Inp," ",[_, Field, "MkAT", _]), + globals(heap), + !, fetch_name(Global,Field), - append([" ",Global,Field," = AtomTermAdjust(Yap_heap_regs->",Field,");"], Out). + append([" ",Global," = AtomTermAdjust(",Global,");"], Out). gen_hstruct(Inp,Out) :- - split(Inp," ",[_, Field, "MkPred"| _]), !, + globals(heap), + split(Inp," ",[_, Field, "MkPred"| _]), + !, cut_c_stuff(Field, RField), fetch_name(Global,RField), - append([" ",Global,RField," = PtoPredAdjust(Yap_heap_regs->",RField,");"], Out). + append([" ",Global," = PtoPredAdjust(",Global,");"], Out). +gen_hstruct(Inp,Out) :- + globals(heap), + split(Inp," ",[_, Field, "MkLogPred"| _]), !, + cut_c_stuff(Field, RField), + fetch_name(Global,RField), + append([" ",Global," = PtoPredAdjust(",Global,");"], Out). gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field, "MkOp", Name]), !, fetch_name(Global,Field), - append([" ",Global,Field," = Yap_opcode(",Name,");"], Out). + append([" ",Global," = Yap_opcode(",Name,");"], Out). gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field, "MkLock"]), !, fetch_name(Global,Field), @@ -232,12 +330,12 @@ gen_hstruct(Inp,Out) :- gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field,"MkRWLock"]), !, fetch_name(Global,Field), - append([" REINIT_RWLOCK(",Global,Field,");"], Out). + append([" REINIT_RWLOCK(",Global,");"], Out). gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field,"MkInstE",OP]), !, cut_c_stuff(Field, RField), fetch_name(Global,RField), - append([" ",Global,RField,"->opc = Yap_opcode(",OP,");"], Out). + append([" ",Global,"->opc = Yap_opcode(",OP,");"], Out). gen_hstruct(Inp,"") :- split(Inp," ",[_, _, _]), !. gen_hstruct(Inp,"") :- @@ -246,6 +344,10 @@ gen_hstruct(Inp,Restore) :- split(Inp," ",[_, _, _, Restore0]), append("Restore",_,Restore0), !, append([" ",Restore0,";"],Restore). %' +gen_hstruct(Inp,Restore) :- + split(Inp," ",[_, _, _, Restore0]), + append("Restore",_,Restore0), !, + append([" ",Restore0,";"],Restore). %' gen_hstruct(Inp,Out) :- split(Inp," ",[_, Field, _, Adjust]), append(Adjust,"Adjust",_), !, @@ -274,13 +376,21 @@ gen_init(Inp,Out) :- Out = "}", retract(globals(worker_init)). gen_init(Inp,Out) :- - Inp = "START_GLOBAL_DATA", !, - Out = "static void InitGlobal(void) {", - assert(globals(all)). + Inp = "START_GLOBAL_DATA", !, + Out = "static void InitGlobal(void) {", + assert(globals(all)). gen_init(Inp,Out) :- - Inp = "END_GLOBAL_DATA", !, - Out = "}", - retract(globals(all)). + Inp = "END_GLOBAL_DATA", !, + Out = "}", + retract(globals(all)). +gen_init(Inp,Out) :- + Inp = "START_HEAP", !, + Out = "", + assert(globals(heap)). +gen_init(Inp,Out) :- + Inp = "END_HEAP", !, + Out = "", + retract(globals(heap)). gen_init(Inp,Out) :- split(Inp," ",["struct"|Inp2]), !, glue(Inp2, " ", Inp3), @@ -342,6 +452,21 @@ gen_init(Inp,Out) :- cut_c_stuff(Field, RField), fetch_name(Global,RField), append([" ",Global," = RepPredProp(PredPropByFunc(",Fun,",",Module,"));"], Out). +gen_init(Inp,Out) :- + split(Inp," ",[_, Field, "MkLogPred", Atom, "0", Module]), !, + cut_c_stuff(Field, RField), + fetch_name(Global,RField), + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByAtom(",Atom,",",Module,")));"], Out). +gen_init(Inp,Out) :- + split(Inp," ",[_, Field, "MkLogPred", Atom, Arity, Module]), !, + cut_c_stuff(Field, RField), + fetch_name(Global,RField), + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByFunc(Yap_MkFunctor(",Atom,",",Arity,"),",Module,")));"], Out). +gen_init(Inp,Out) :- + split(Inp," ",[_, Field, "MkLogPred", Fun, Module]), !, + cut_c_stuff(Field, RField), + fetch_name(Global,RField), + append([" ",Global," = Yap_MkLogPred(RepPredProp(PredPropByFunc(",Fun,",",Module,")));"], Out). gen_init(Inp,Out) :- split(Inp," ",[".", Field,F0|_]), !, cut_c_stuff(Field, RField), @@ -359,3 +484,18 @@ gen_init(Inp,_) :- split(Inp," ",[_, _, _| _]), format(user_error,"OOPS: could not gen_init for ~s~n",[Inp]). +extract(X, Y, F) :- + append(X, R, Y), + !, + extract(R, F). + +extract([0' |H], IF) :- !, + extract( H, IF). +extract([0'\t |H], IF) :- !, + extract( H, IF). +extract(H,H). + + + + + diff --git a/misc/prolog.el b/misc/prolog.el index 03b7ba8ff..75258756f 100644 --- a/misc/prolog.el +++ b/misc/prolog.el @@ -69,6 +69,7 @@ ;; ; see `prolog-system' below for possible values ;; (setq auto-mode-alist (append '(("\\.pl$" . prolog-mode) ;; ("\\.yap$" . prolog-mode) +;; ("\\.ypp$" . prolog-mode) ;; ("\\.prolog$" . prolog-mode) ;; ("\\.m$" . mercury-mode)) ;; auto-mode-alist)) @@ -447,9 +448,10 @@ Legal values: "meta_predicate" "module" "module_transparent" "multifile" "require" "use_module" "volatile")) (yap - ("discontiguous" "dynamic" "ensure_loaded" "export" "export_list" "import" + ("block" "char_conversion" "discontiguous" "dynamic" "encoding" + "ensure_loaded" "export" "expects_dialect" "export_list" "import" "meta_predicate" "module" "module_transparent" "multifile" "require" - "table" "use_module" "volatile")) + "table" "thread_local" "use_module" "wait")) (gnu ("built_in" "char_conversion" "discontiguous" "dynamic" "ensure_linked" "ensure_loaded" "foreign" "include" "initialization" "multifile" "op" @@ -650,6 +652,7 @@ nil means send actual operating system end of file." '((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:") (sicstus "| [ ?][- ] *") (swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") + (yap "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") (t "^ *\\?-")) "*Alist of prompts of the prolog system command line." :group 'prolog-inferior @@ -657,6 +660,7 @@ nil means send actual operating system end of file." (defcustom prolog-continued-prompt-regexp '((sicstus "^\\(| +\\| +\\)") + (yap` "^\\(| +\\| +\\)") (t "^|: +")) "*Alist of regexps matching the prompt when consulting `user'." :group 'prolog-inferior diff --git a/misc/sysgraph b/misc/sysgraph deleted file mode 100755 index f06a7d2ee..000000000 --- a/misc/sysgraph +++ /dev/null @@ -1,831 +0,0 @@ -#!/usr/local/bin/yap -L -- $* -#. - -:- style_check(all). - -:- yap_flag( write_strings, on). -:- yap_flag( gc_trace, verbose ). - -:- use_module(library(readutil)). -:- use_module(library(lineutils)). -:- use_module(library(lists)). -:- use_module(library(maplist)). -:- use_module(library(system)). - -:- use_module(library(analysis/graphs)). -:- use_module(library(analysis/load)). - -:- initialization(main). - -:- style_check(all). - -:- yap_flag( double_quotes, string ). -%:- yap_flag( dollar_as_lower_case, on ). - -:- dynamic - node/4, - edge/1, - public/2, - private/2, - module_on/3, - exported/1, - dir/2, - consulted/2, - op_export/3, - library/1, - undef/2, - c_dep/2, - do_comment/5, - module_file/2. - -% @short node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet -% - - -inline( !/0 ). -inline( (\+)/1 ). -inline( (fail)/0 ). -inline( (false)/0 ). -inline( (repeat)/0 ). -inline( (true)/0 ). -inline( []/0 ). - -% @short edge(+SourceModule:module, +SourcePredicate:pred_indicator, +TargetPredicate:pred_indicator, +InFile:file) is nondet -% - -main :- - init, - fail. -main :- - unix(argv([D])), - Dirs = ['C'-prolog, - 'os'-prolog, - 'pl'-prolog, - 'OPTYap'-prolog, - 'library'-user, -% 'swi/console'-user - 'packages'-user - ], -% maplist(distribute(D), Dirs, Paths), - load( D, Dirs ), - maplist( pl_graphs, Dirs ), - fail. -main :- - %%% phase 4: construct graph - retractall( consulted(_,_) ), - undefs, - doubles, - % pl_exported(pl). - c_links, - mkdocs. - -distribute( Root, File-Class, Path-Class) :- - sub_atom(Root,_,_,1,/), - !, - atom_concat(Root, File, Path ). -distribute( Root, File-Class, Path-Class) :- - atom_concat([Root, /, File], Path ). - -init :- - retractall(dir(_)), - retractall(edge(_)), - retractall(private(_,_)), - retractall(public(_,_)), - retractall(undef(_,_)), - retractall(consulted(_,_)), - retractall(module_on(_,_,_)), - retractall(op_export(_,_,_)), - retractall(exported(_)), - retractall(do_comment(_,_,_,_,_)). -init :- - user_c_dep(A,B), - do_user_c_dep(A,B), - fail. -init :- - user_skip(A), - do_user_skip(A), - fail. -init :- - user_expand(N,A), - do_user_expand(N,A), - fail. -init :- - catch( make_directory(tmp), _, fail), - fail. -init. - -init_loop( _Dirs ). - -doubles :- - node(M, P, F-_, _), - node(M1, P, F1-_, _), - M @< M1, - is_public( P, M, F), - is_public( P, M1, F1), - format('~w vs ~w~n', [M:P,M1:P]), - fail. -doubles. - -undefs :- - trace, - format('UNDEFINED procedure calls:~n',[]), - setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ), - member( Mod, Ms ), - format(' module ~a:~n',[Mod]), - setof(NA, Target^F^Line^undef( ( Target :- F-Mod:NA ), Line ), Ns ), - member( NA, Ns ), - \+ node( Mod , NA , _File1, _ ), - \+ node( prolog , NA , _File2, _ ), - format(' predicate ~w:~n',[NA]), - ( - setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ), - member(F-L, FLs ), - format(' line ~w, file ~a~n',[L,F]), - fail - ; - setof(F-M,Type^node( M, NA, F, Type ) , FMs ), - format(' same name at:~n',[]), - member((F-L)-M, FMs ), - format(' module ~a, file ~a, line ~d~n',[M,F,L]), - fail - ). -undefs. - -out_list([]) :- - format('[]', []). -out_list([El]) :- - format('[~q]', [El]). -out_list([E1,E2|Es]) :- - format('[~q', [E1]), - maplist(out_el, [E2|Es]), - format(']', []). - -out_el( El ) :- - format(',~n ~q',[El]). - -pub(M, P) :- - node(M, P, _, _), - P = N/_A, - \+ sub_atom(N,0,1,_,'$'). - -has_edge(M1, P1, M, F) :- - edge(M1:P1, _P, F:_), - node(M1, P1, _, _), - M1 \= prolog, - M1 \= M, - \+ is_public(P1, M1, _). - -mod_priv(M, P) :- - node(M, P, _, _), - node(M, P, _, _), - \+ is_public(P, M, _), - edge(M1:P, _P0, _), M1 \= M. - -priv(M, P) :- - node(M, P, F:_, _), - \+ is_public(P, M, _), - edge(_:P, _P1, F1:_), F1 \= F. - -% utilities - -split_string( S , Cs, N) :- - string_codes(S, S1), - string_codes(Cs, NCs), - split(S1, NCs, Ncs0), - maplist(remove_escapes, Ncs0, Ncs), - maplist(string_codes, N, Ncs). - -remove_escapes([0'\\ ,A|Cs], [A|NCs]) :- !, %' - remove_escapes(Cs, NCs). -remove_escapes([A|Cs], [A|NCs]) :- - remove_escapes(Cs, NCs). -remove_escapes( [], [] ). - -always_strip_module(V, M, V1) :- var(V), !, - V = M:call(V1). -always_strip_module(M0:A, M0, call(A)) :- var(A), !. -always_strip_module(_:M0:A, M1, B) :- !, - always_strip_module(M0:A, M1, B). -always_strip_module(M0:A, M0, call(A)) :- var(A),!. -always_strip_module(M0:A, M0, A). - -c_links :- - open('tmp/foreigns.yap', write, S), - clinks(S), - fail. -c_links :- - open('tmp/foreigns.c', write, S), - cclinks(S), - fail. - -clinks(S) :- - module_file( F, NM ), - format( S, 'mod( ~q , ~q ).~n', [NM, F] ), - fail. -clinks(S) :- - system_predicate(C), - functor(C, N, A), - format( S, 'sys ~q/~d.~n', [N, A] ), - fail. -clinks(S) :- - exported( ( Fi0-M:F/A :- Fi1-M1:F1/A ) ), - ( M \= M1 -> M \= prolog ; F \= F1 ), -% functor(S0, F, A), -% S0 =.. [F| Args], -% S1 =.. [F1| Args], -% numbervars(Args, 0, _), - format( S, '% ~q <- ~q.~n~q:~q imports ~q:~q. ~n', [Fi0, Fi1, M,F/A, M1,F1/A] ), - fail. -clinks(S) :- - close(S). - -cclinks(S) :- - node( M, F/A, File-_Line, c(F)), -% functor( S0, F, A), -% S0 =.. [F| Args], -% S1 =.. [foreign, F| Args], -% numbervars(Args, 0, _), - format( S, '/// @file ~a~n', [File] ), - format( S, '/// @memberof ~a ~a:~a/~d~n', [F, M, F, A] ), - fail. -cclinks(S) :- - close(S). - -warn_singletons(_Vars, _Pos). - -%% -% comment( +Comment ) -% -% Handle documentation comments -% -comment( _Pos - Comment) :- - skip_blanks(1, Comment, N), - doc( Comment, N ), - format( "%s\n", [Comment] ), - !. -comment( _Pos - _Comment). - -skip_blanks(I, Comment, N) :- - get_string_code( I, Comment, Code ), - code_type( Code, space ), - I1 is I+1, - skip_blanks(I1, Comment, N). -skip_blanks(N, _Comment, N). - -doc( Comment , N ) :- - N1 is N+1, - sub_string( Comment, N1, 3, _, Header ), - ( Header == "/**" -> true ; Header == "/*!" ), !, % */ - N4 is N+4, - get_string_code( N4, Comment, Code ), - code_type( Code, space ). -doc( Comment, N ) :- - N1 is N+1, - sub_string( Comment, N1, 2, _, Header ), - ( Header == "%%" -> true ; Header == "%!" ), - N3 is N+3, - get_string_code( N3, Comment, Code ), - code_type( Code, space ). - - -%% -% search_file( +Target, +Location, +FileType, -File ) -% -% -% Directories into atoms -search_file( Loc , F, Type, FN ) :- - search_file0( Loc , F, Type, FN ), - !. -search_file( Loc , F, _FN ) :- - format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]), - fail. - -% -% handle some special cases. -% -search_file0( F, _, _Type, FN ) :- - doexpand(F, FN), !. -search_file0( A/B, F, Type, FN ) :- !, - term_to_atom(A/B, AB), - search_file0( AB, F, Type, FN ). -% libraries can be anywhere in the source. -search_file0( LibLoc, F, Type, FN ) :- - LibLoc =.. [Dir,File], - !, - ( term_to_atom( Dir/File, Full ) ; Full = File ), - search_file0( Full, F, Type, FN ). -%try to use your base -search_file0( Loc , F, c, FN ) :- - atom_concat( D, '.yap', F), - atom_concat( [ D, '/', Loc], F1), - check_suffix( F1 , c, NLoc ), - absolute_file_name( NLoc, FN), - file_base_name( FN, LocNam), - file_directory_name( FN, D), - dir( D, LocNam ). -search_file0( Loc , F, Type, FN ) :- - file_directory_name( F, FD), - check_suffix( Loc , Type, LocS ), - atom_concat( [ FD, '/', LocS], NLoc), - absolute_file_name( NLoc, FN), - file_base_name( FN, LocNam), - file_directory_name( FN, D), - dir( D, LocNam). -search_file0( Loc , _F, Type, FN ) :- - file_base_name( Loc, Loc0), - file_directory_name( Loc, LocD), - check_suffix( Loc0 , Type, LocS ), - dir( D, LocS), - sub_dir( D, DD), - atom_concat( [ DD, '/', LocD], NLoc), - absolute_file_name( NLoc, D), - atom_concat( [D,'/', LocS], FN). -search_file0( Loc , _F, Type, FN ) :- - file_base_name( Loc, Loc0), - check_suffix( Loc0 , Type, LocS ), - dir( D, LocS), - atom_concat( [D,'/', LocS], FN). -% you try using the parent - -sub_dir( D, D ). -sub_dir( D, DD) :- - D \= '/', - atom_concat( D, '/..', DD0), - absolute_file_name( DD0, DDA), - sub_dir( DDA, DD). - -% files must be called .yap or .pl -% if it is .yap... -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.yap', Loc ), !. -%, otherwise, .pl -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.pl', Loc ), !. -%, otherwise, .prolog -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.prolog', Loc ), !. -%, otherwise, .P -% try adding suffix -check_suffix( Loc0 , pl, Loc ) :- - member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']), - atom_concat( Loc0, Suf, Loc ). -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.c', Loc ), !. -%, otherwise, .pl -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.icc', Loc ), !. -%, otherwise, .prolog -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.cpp', Loc ), !. -%, otherwise, .P -% try adding suffix -check_suffix( Loc0 , c, Loc ) :- - member( Suf , ['.c', '.icc' , '.cpp']), - atom_concat( Loc0, Suf, Loc ). - - - -match_file( LocD, Loc0, Type, FN ) :- - var(LocD), !, - dir( LocD, Loc0 ), - atom_concat( [LocD, '/', Loc0], F ), - absolute_file_name( F, Type, FN ), - exists( FN ). -match_file( SufLocD, Loc0, Type, FN ) :- - dir( LocD, Loc0 ), - atom_concat(_, SufLocD, LocD ), - atom_concat( [LocD, '/', Loc0], Type, FN ). - - -new_op( F, M, op(X,Y,Z) ) :- - nb_getval( private, true ), - !, - private( F, M, op(X,Y,Z) ), - op( X, Y, Z). -new_op( F, M, op( X, Y, Z) ) :- - public( F, M, op( X, Y, Z) ). - - -ypp(F, error(syntax_error(syntax_error),[syntax_error(read(_228515),between(K,L,M),_,_L,_)-_]) ) :- - format('SYNTAX ERROR at file ~a, line ~d (~d - ~d).~n', [F,L,K,M] ), - break. - -preprocess_file(F,NF) :- - atom_concat(_, '.ypp', F ), !, - atom_concat( [ 'cpp -CC -w -DMYDDAS_MYSQL -DMYDDAS_ODBC -DMYDDAS_STATS -DMYDDAS_TOP_LEVEL -P ',F], OF ), - NF = pipe( OF ). -preprocess_file(F,F). - - -%%%%%%% -%% declare a concept export1able -public( F, M, op(X,Y,Z) ) :- - retract( private( F, M:op(X,Y,Z) ) ), - fail. -public( F, M, op(X,Y,Z) ) :- !, - assert( op_export(F, _M, op(X,Y,Z) ) ), - assert_new( public( F, M:op(X,Y,Z) ) ), - ( - ( M == user ; M == prolog ) - -> - op( X, Y, prolog:Z ) - ; - op( X, Y, M:Z ) - ). -public( F, M, M:N/Ar ) :- - retract( private( F, M:N/Ar ) ), - fail. -public( F, M, N/Ar ) :- - assert_new( public( F, M:N/Ar ) ), - \+ node( M, N/Ar, F-_, _ ), - nb_getval( line, L ), - assert( node( M, N/Ar, F-L, prolog ) ), !. -public( _F, _M, _/_Ar ). -public( F, M, M:N//Ar ) :- - Ar2 is Ar+2, - retract( private( F, M:N/Ar2 ) ), - fail. -public( F, M, N//Ar ) :- - Ar2 is Ar+2, - assert_new( public( F, M:N/Ar2 ) ), - \+ node( M, N/Ar2, F-_, _ ), - nb_getval( line, L ), - assert( node( M, N/Ar2, F-L, prolog ) ), !. -public( _F, _M, _//_Ar ). - -private( F, M, op(X,Y,Z) ) :- - assert_new( private( F, M:op(X,Y,Z) ) ), - ( - ( M == user ; M == prolog ) - -> - op( X, Y, prolog:Z ) - ; - op( X, Y, M:Z ) - ), !. -private( _F, _M, op(_X,_Y,_Z) ). -private( F, M, N/Ar ) :- - assert_new( private( F, M:N/Ar ) ), - \+ node( M, N/Ar, F-_, _ ), - nb_getval( line, L ), - assert( node( M, N/Ar, F-L, prolog ) ), !. -private( _F, _M, _N/_Ar ). -private( F, M, N//Ar ) :- - Ar2 is Ar+2, - assert_new( private( F, M:N/Ar2 ) ), - \+ node( M, N/Ar2, F-_, _ ), - nb_getval( line, L ), - assert_new( node( M, N/Ar2, F-L, prolog ) ), !. -private( _F, _M, _N//_Ar ). - -is_public( F, M, OP ) :- - public( F, M:OP ). - -is_private( F, M, OP ) :- - private( F, M :OP ). - -assert_new( G ) :- G, !. -assert_new( G ) :- assert( G ). - -error( Error ) :- throw(Error ). - - -%% mkdocs inserts a file with a sequence of comments into a sequence of Prolog/C files. -% -% -mkdocs :- - open( 'tmp/pages', write, S1), - close( S1 ), - open( 'tmp/bads', write, S2), - close( S2 ), - open( 'tmp/groups', write, S3), - close( S3 ), - open( 'tmp/groups.yap', write, S4), - close( S4 ), - open( 'docs/yapdocs.yap', read, S), - repeat, - ( - blanks(S, Comment, Rest) - -> - get_comment(S, Rest), - store_comment( Comment ), - fail - ; - close(S), - !, - add_comments - ). - -blanks( S , T, TF) :- - read_line_to_codes(S, T1, T2), - ( T1 == end_of_file -> fail; - T2 == [] -> fail; - T1 \== T2, foldl( check, [0'/,0'*,0'*],T1, _) -> TF = T2, T = T1 ; % ' - blanks( S , T, TF) ). - -get_comment( S , T) :- - read_line_to_codes(S, T, T0), - ( T == end_of_file -> T = []; - T0 == [] -> T=[]; - diff_end( [0'*,0'/,10],T, T0 ) -> true ; - get_comment( S , T0) ). - -check(C, [C0|L], L) :- - C == C0. - -diff_end( L, T, [] ) :- - append(_, L, T). - -store_comment(Comment) :- - header( Pred, A, Comment, _ ), - atom_codes( P, Pred), - ( node( Mod, P/A, File-Line, Type) -> - true - ; - format('Missing definition for ~q.~n', [P/A] ), - node( Mod, P/Ar, File-Line, Type), - format(' ~w exists.~n',[Mod:P/Ar]), - fail - ), - ( node( M1, P/A, _, _), M1 \= Mod -> Dup = true ; Dup = false), - !, - string_codes( C, Comment ), - assert( do_comment( File, Line, C, Type, Dup ) ). -store_comment(Comment) :- - page( Comment, _ ), !, - open( 'tmp/pages', append, S), - format(S, '*******************************~n~n~s~n~n', [Comment]), - close(S). -store_comment(Comment) :- - defgroup( Comment, _ ), !, - open( 'tmp/groups', append, S), - format(S, '*******************************~n~n~s~n~n', [Comment]), - close(S). -store_comment(Comment) :- - open( 'tmp/bads', append, S), - format(S, '*******************************~n~n~s~n~n', [Comment]), - close(S). - -defgroup --> - "/**", % */ - blanks_or_stars, - "@defgroup". -defgroup --> - "%%", % */ - blanks_or_percs, - "@defgroup". - -page --> - "/**", % */ - blanks, - "@page". - -header(Pred, Arity) --> - "/**", % */ - blanks, - "@pred", - blanks, - atom(_), - ":", - !, - atom(Pred), - atom_pred(Arity). -header(Pred, Arity) --> - "/**", % */ - blanks, - "@pred", - blanks, - atom(Pred), - atom_pred(Arity), - !. -header(Pred, 2, Comment, _) :- - split(Comment, [[0'/,0'*,0'*],[0'@,0'p,0'r,0'e,0'd],_,Pred,_,[0'i,0's]|_]), !. - - -atom_pred(Arity) --> - "/", !, - int( 0, Arity ). -atom_pred(N) --> - "(", - !, - decl(1,N). -atom_pred(0) --> - blanks, !. - -int(I0, I) --> - [A], - { A >= "0", A =< "9" }, - !, - { I1 is I0*10+(A-"0") }, - int(I1, I). -int( I, I ) --> []. - -decl(I, I) --> - ")", !. -decl(I0, I) --> - ",", !, - { I1 is I0+1 }, - decl(I1, I). -decl(I0, I) --> - [_], - decl( I0, I). - - skip_early_comment(C) --> - [C], !, - skip_early_comment(C). -skip_early_comment(C) --> - ( " " ; "\t" ; "\n" ), !, - skip_early_comment(C). - skip_early_comment(C) --> - "@", ( "{" ; "}" ), !, - skip_early_comment(C). - skip_early_comment(_) --> []. - - blanks --> " ", !, blanks. - blanks --> "\t", !, blanks. - blanks --> []. - - atom([A|As]) --> - [A], - { A >= "a", A =< "z" }, - atom2( As ). - -atom2([A|As]) --> - [A], - { A >= "a", A =< "z" -> true ; - A >= "A", A =< "Z" -> true ; - A >= "0", A =< "9" -> true ; - A =:= "_" - }, - !, - atom2( As ). -atom2([]) --> []. - -add_comments :- - open('tmp/comments.yap', write, S), - findall(File, do_comment( File, Line, C, Type, Dup), Fs0 ), - ( - sort(Fs0, Fs), - member( File, Fs ), - setof(Line-C-Type-Dup, do_comment( File, Line, C, Type, Dup) , Lines0 ), - reverse( Lines0, Lines), - member(Line-Comment-Type-Dup, Lines), - check_comment( Comment, CN, Line, File ), - Line1 is Line-1, - format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\ - mv x ~a~n~n',[Dup,CN, Line1, File, File]) - ; - close(S) - ), - fail. -add_comments :- - listing( open_comment ). - -check_comment( Comment, CN, _Line, _qFile ) :- - string_codes( Comment, [_,_,_|C]), - check_groups(0,_C,[]), - check_quotes(0,C,[]), - ( - append(C0,[0'@,0'},0' ,0'*,0'/,10], C) -> %' - append(C0,[0'*,0'/,10], CN) - ; - CN = C - ), - !. -check_comment( Comment, Comment, Line, File ) :- - format(user_error,'*** bad comment ~a ~d~n~n~s~n~', [File,Line,Comment]). - -check_groups(0) --> []. - - -check_quotes( 0 ) --> []. -check_quotes( 0 ) --> - "`", !, - check_quotes( 1 ). -check_quotes( 1 ) --> - "`", !, - check_quotes( 0 ). -check_quotes( 1 ) --> - "\"", !, { fail }. -check_quotes( 1 ) --> - "'", !, { fail }. %' -check_quotes( N ) --> - [_], - check_quotes( N ). - - -%%% -% ops_default sets operators back to YAP default. -% -ops_default :- - abolish( default_ops/1 ), - A = (_,_), functor(A,Comma,2), - findall(op(X,Y,prolog:Z), ( current_op(X,Y,prolog:Z), Z\= Comma ), L), - assert_static( default_ops(L) ). - -:- initialization(ops_default, now). - -ops_restore :- - A = (_,_), functor(A,Comma,2), - current_op(_X,Y,prolog:Z), - Z\= Comma, - op(0,Y,prolog:Z), - fail. -ops_restore :- - default_ops(L), - maplist( call, L ). - -do_user_c_dep(F1, F2) :- - absolute_file_name(F1, A1), - absolute_file_name(F2, A2), - assert(c_dep(A1, A2)). -do_user_skip(F1) :- - absolute_file_name(F1, A1), - assert(doskip(A1)). -do_user_expand(F, F1) :- - absolute_file_name(F1, A1), - assert(doexpand(F, A1)). - -user_deps( F, M ) :- - c_dep(F, A2), - c_file(A2 , M), - fail. -user_deps( _F, _M ). - -user_c_dep( 'packages/jpl/jpl.pl', 'packages/jpl/src/c/jpl.c' ). -user_c_dep( 'packages/real/real.pl', 'packages/real/real.c' ). -user_c_dep( 'packages/odbc/odbc.pl', 'packages/odbc/odbc.c' ). -user_c_dep( 'packages/clib/unix.pl', 'packages/clib/unix.c' ). -user_c_dep( 'packages/clib/cgi.pl', 'packages/clib/cgi.c' ). -user_c_dep( 'packages/clib/crypt.pl', 'packages/clib/crypt.c' ). -user_c_dep( 'packages/clib/filesex.pl', 'packages/clib/files.c' ). -user_c_dep( 'packages/clib/mime.pl', 'packages/clib/mime.c' ). -user_c_dep( 'packages/clib/socket.pl', 'packages/clib/socket.c' ). -user_c_dep( 'packages/clib/socket.pl', 'packages/clib/winpipe.c' ). -user_c_dep( 'packages/http/http_stream.pl', 'packages/http/cgi_stream.c' ). -user_c_dep( 'packages/http/http_stream.pl', 'packages/http/stream_range.c' ). -user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_chunked.c' ). -user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_error.c' ). -user_c_dep( 'packages/swi-minisat2/minisat.pl', 'packages/swi-minisat2/C/pl-minisat.C' ). -user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/gecode4_yap.cc' ). -user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_forward_auto_generated.icc' ). -user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_init_auto_generated.icc' ). -user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_impl_auto_generated.icc' ). -user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/atom_map.c' ). -user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/resource.c' ). -user_c_dep( 'packages/sgml/sgml.pl', 'packages/sgml/quote.c' ). -user_c_dep( 'swi/library/readutil.pl', 'packages/clib/readutil.c' ). -user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_shared.c' ). -user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_odbc.c' ). -user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_mysql.c' ). -user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_top_level.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/bpx.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/error.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/fputil.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/gamma.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/glue.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable_preds.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/random.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/termpool.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/vector.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/xmalloc.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_ml.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_vb.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_ml.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_preds.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/flags.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph_aux.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/hindsight.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/util.c' ). -user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/viterbi.c' ). - -doskip( D):- sub_atom( D, _, _, 0, '~' ). -doskip( D):- sub_atom( D, _, _, 0, '/.' ). -doskip( D):- sub_atom( D, _, _, 0, '/..' ). -doskip( D):- sub_atom( D, _, _, 0, '/.git' ). -doskip( D):- sub_atom( D, _, _, _, '/.#' ). -doskip( D):- sub_atom( D, _, _, 0, '#' ). -doskip( D):- user_skip( D ). - -user_skip( 'packages/gecode/3.6.0'). -user_skip( 'packages/gecode/3.7.0'). -user_skip( 'packages/gecode/3.7.1'). -user_skip( 'packages/gecode/3.7.2'). -user_skip( 'packages/gecode/3.7.3'). -user_skip( 'packages/gecode/4.0.0'). -user_skip( 'packages/gecode/4.2.0'). -user_skip( 'packages/gecode/4.2.1'). -user_skip( 'packages/gecode/gecode3.yap' ). -user_skip( 'packages/gecode/gecode3_yap.cc' ). -user_skip( 'packages/gecode/gecode3_yap_hand_written.yap'). -user_skip( 'packages/gecode/gecode3.yap-common.icc'). -user_skip( 'packages/prism/src/prolog/core'). -user_skip( 'packages/prism/src/prolog/up'). -user_skip( 'packages/prism/src/prolog/mp'). -user_skip( 'packages/prism/src/prolog/trans'). -user_skip( 'packages/prism/src/prolog/bp'). -user_skip( 'packages/prism/src/c'). - -user_expand( library(clpfd), 'library/clp/clpfd.pl' ). diff --git a/misc/tests b/misc/tests index 86bbccc11..8c2418ea4 100644 --- a/misc/tests +++ b/misc/tests @@ -1,3 +1,34 @@ -current_predicate 2 - X Y _ - goal_expansion Y goal_expansion(_) + +:- op(test, fx, 1200). + +test_mode. + +test( ( G :- Sols ) :- + reset_sols, + init_io( Streams ), + catch( do_test(G, Sols), Done, handler( Done ) ). + close_io( Streams ). + +do_test(G0, Sols) + copy_term(G0, G), + catch( ( G, answer(G, Sol) ) , Error, test_error(Error, Sol) ), + next_solution( I, Sol, G0, Sol ), + !. +do_test(G, Sols) :- + counter(I), + failure(G, Sols, I). + +next_solution( I, Sol , G0, Sols ) :- + inc(I), + fetch(I, Sols, Pattern, Next), + ( + Sol =@= Pattern + -> + success(I, G0) + ; + error(I, G0, Sol ) + ), + ( var(Next) -> throw( done ) ). + + + \ No newline at end of file diff --git a/os/CMakeLists.txt b/os/CMakeLists.txt index 54ce0b4ff..f05d49a72 100644 --- a/os/CMakeLists.txt +++ b/os/CMakeLists.txt @@ -53,7 +53,9 @@ if (READLINE_FOUND) # READLINE_readline_LIBRARY, where to find the READLINE library. # READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] - set( CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR} ${CMAKE_REQUIRED_INCLUDES} ) + include_directories (BEFORE ${READLINE_INCLUDE_DIR}) + + set(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) check_include_files( "stdio.h;readline/readline.h" HAVE_READLINE_READLINE_H ) check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H ) @@ -81,15 +83,17 @@ endif (READLINE_FOUND) set (POSITION_INDEPENDENT_CODE TRUE) add_library (libYAPOs OBJECT - ${YAPOS_SOURCES} ) - + ${YAPOS_SOURCES} + ) set_target_properties(libYAPOs PROPERTIES + # RPATH ${libdir} VERSION ${LIBYAPTAI_FULL_VERSION} # SOVERSION ${LIBYAPTAI_MAJOR_VERSION}.${LIBYAPTAI_MINOR_VERSION} POSITION_INDEPENDENT_CODE TRUE OUTPUT_NAME YAPOs + depends dheap ) configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake" @@ -97,6 +101,6 @@ configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake" set( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE) - + #set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) diff --git a/os/charsio.c b/os/charsio.c index 48def71e7..4761e2e64 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -105,8 +105,8 @@ Int Yap_peek(int sno) { Int ch; s = GLOBAL_Stream + sno; - if ( s->status & Readline_Stream_f) { - ch = Yap_ReadlinePeekChar( sno ); + if (s->status & Readline_Stream_f) { + ch = Yap_ReadlinePeekChar(sno); if (ch == EOFCHAR) { s->stream_getc = EOFPeek; s->stream_wgetc = EOFWPeek; @@ -118,12 +118,12 @@ Int Yap_peek(int sno) { olinecount = s->linecount; olinepos = s->linepos; ch = s->stream_wgetc(sno); - s ->och = ch; + s->och = ch; if (ch == EOFCHAR) { s->stream_getc = EOFPeek; s->stream_wgetc = EOFWPeek; s->status |= Push_Eof_Stream_f; - return ch; + return ch; } s->charcount = ocharcount; s->linecount = olinecount; @@ -131,40 +131,39 @@ Int Yap_peek(int sno) { /* buffer the character */ if (s->encoding == LOCAL_encoding) { ungetwc(ch, s->file); - } else if (s->encoding == ENC_OCTET || - s->encoding == ENC_ISO_LATIN1|| - s->encoding == ENC_ISO_ASCII) { + } else if (s->encoding == ENC_OCTET || s->encoding == ENC_ISO_LATIN1 || + s->encoding == ENC_ISO_ASCII) { ungetc(ch, s->file); } else if (s->encoding == ENC_ISO_UTF8) { unsigned char cs[8]; - size_t n = put_utf8(cs, ch ); + size_t n = put_utf8(cs, ch); while (n--) { - ungetc(cs[n-1], s->file); + ungetc(cs[n - 1], s->file); } } else if (s->encoding == ENC_UTF16_BE) { /* do the ungetc as if a write .. */ unsigned long int c = ch; - if (c >((1<<16)-1)) { - ungetc(c/1<<16, s->file); - c %= 1<< 16; + if (c > ((1 << 16) - 1)) { + ungetc(c / 1 << 16, s->file); + c %= 1 << 16; } ungetc(c, s->file); } else if (s->encoding == ENC_UTF16_BE) { /* do the ungetc as if a write .. */ unsigned long int c = ch; - if (c > ((1<<16)-1)) { - ungetc(c/1<<16, s->file); - c %= 1<< 16; - } + if (c > ((1 << 16) - 1)) { + ungetc(c / 1 << 16, s->file); + c %= 1 << 16; + } } else if (s->encoding == ENC_UTF16_LE) { /* do the ungetc as if a write .. */ unsigned long int c = ch; - if (c >(( 1<<16)-1)) { - ungetc(c%1<<16, s->file); - c /= 1<< 16; + if (c > ((1 << 16) - 1)) { + ungetc(c % 1 << 16, s->file); + c /= 1 << 16; } ungetc(c, s->file); - } else { + } else { int (*f)(int, int) = s->stream_putc; s->stream_putc = plUnGetc; put_wchar(sno, ch); @@ -512,7 +511,7 @@ static Int put_code(USES_REGS1) { /* '$put'(Stream,N) */ return (FALSE); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2"); return (FALSE); } @@ -552,7 +551,7 @@ static Int put_char_1(USES_REGS1) { /* '$put'(,N) */ LOCK(GLOBAL_Stream[sno].streamlock); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2"); return (FALSE); } GLOBAL_Stream[sno].stream_wputc(sno, ch); @@ -590,7 +589,7 @@ static Int put_char(USES_REGS1) { /* '$put'(Stream,N) */ return (FALSE); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2"); return (FALSE); } GLOBAL_Stream[sno].stream_wputc(sno, (int)IntegerOfTerm(Deref(ARG2))); @@ -627,7 +626,7 @@ static Int tab_1(USES_REGS1) { /* nl */ LOCK(GLOBAL_Stream[sno].streamlock); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "nl/0"); return (FALSE); } @@ -667,7 +666,7 @@ static Int tab(USES_REGS1) { /* nl(Stream) */ if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "nl/0"); return (FALSE); } @@ -755,7 +754,7 @@ static Int put_byte(USES_REGS1) { /* '$put_byte'(Stream,N) */ // && strictISOFlag() ) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, NULL); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, NULL); return false; } GLOBAL_Stream[sno].stream_putc(sno, ch); @@ -794,7 +793,7 @@ static Int put_byte_1(USES_REGS1) { /* '$put_byte'(Stream,N) */ //&& strictISOFlag() ) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "get0/2"); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "get0/2"); return (FALSE); } GLOBAL_Stream[sno].stream_putc(sno, ch); @@ -937,7 +936,7 @@ static Int peek_code(USES_REGS1) { /* at_end_of_stream */ return FALSE; if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2"); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2"); return FALSE; } if ((ch = Yap_peek(sno)) < 0) { @@ -967,7 +966,7 @@ static Int peek_code_1(USES_REGS1) { /* at_end_of_stream */ LOCK(GLOBAL_Stream[sno].streamlock); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2"); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2"); return FALSE; } if ((ch = Yap_peek(sno)) < 0) { @@ -996,7 +995,7 @@ static Int peek_byte(USES_REGS1) { /* at_end_of_stream */ return (FALSE); if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_STREAM, ARG1, "peek_byte/2"); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_byte/2"); return (FALSE); } if ((ch = dopeek_byte(sno)) < 0) { @@ -1026,7 +1025,7 @@ static Int peek_byte_1(USES_REGS1) { /* at_end_of_stream */ LOCK(GLOBAL_Stream[sno].streamlock); if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_byte/2"); return (FALSE); } if ((ch = dopeek_byte(sno)) < 0) { diff --git a/os/format.c b/os/format.c index 84fa5ab01..f8269f805 100644 --- a/os/format.c +++ b/os/format.c @@ -1220,7 +1220,7 @@ static Int format(Term tout, Term tf, Term tas USES_REGS) { return false; UNLOCK(GLOBAL_Stream[output_stream].streamlock); } else { - yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); + yhandle_t sls = Yap_CurrentSlot(); out = doformat(tf, tas, output_stream PASS_REGS); diff --git a/os/iopreds.c b/os/iopreds.c index 09ebd9951..39effb412 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -573,7 +573,7 @@ static int EOFWGetc(int sno) { return EOF; } if (ResetEOF(s)) { - Yap_ConsoleOps(s); + Yap_ConsoleOps(s); return (s->stream_wgetc(sno)); } return EOF; @@ -589,7 +589,7 @@ static int EOFGetc(int sno) { return EOF; } if (ResetEOF(s)) { - Yap_ConsoleOps(s); + Yap_ConsoleOps(s); return s->stream_getc(sno); } return EOF; @@ -646,20 +646,17 @@ int post_process_weof(StreamDesc *s) { return EOFCHAR; } -/** - * caled after EOF found a peek, it just calls console_post_process to conclude the job. - * - * @param sno - * +/** + * caled after EOF found a peek, it just calls console_post_process to conclude + *the job. + * + * @param sno + * * @return EOF */ -int EOFPeek(int sno) { - return EOFGetc( sno ); -} +int EOFPeek(int sno) { return EOFGetc(sno); } -int EOFWPeek(int sno) { - return EOFWGetc( sno ); -} +int EOFWPeek(int sno) { return EOFWGetc(sno); } /* standard routine, it should read from anything pointed by a FILE *. It could be made more efficient by doing our own buffering and avoiding @@ -841,7 +838,7 @@ static int get_wchar(int sno) { if (how_many) { /* error */ } - return post_process_weof(GLOBAL_Stream+sno); + return post_process_weof(GLOBAL_Stream + sno); } wide_char(); } @@ -1383,10 +1380,8 @@ do_open(Term file_name, Term t2, } } // BOM mess - if ((encoding == ENC_OCTET || - encoding == ENC_ISO_ASCII || - encoding == ENC_ISO_LATIN1 || - encoding == ENC_ISO_UTF8 || bin)) { + if ((encoding == ENC_OCTET || encoding == ENC_ISO_ASCII || + encoding == ENC_ISO_LATIN1 || encoding == ENC_ISO_UTF8 || bin)) { avoid_bom = true; } if (args[OPEN_BOM].used) { @@ -1546,7 +1541,7 @@ static int CheckStream__(const char *file, const char *f, int line, Term arg, if (sname == AtomUser) { if (kind & Input_Stream_f) { if (kind & (Output_Stream_f | Append_Stream_f)) { - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, "ambiguous use of 'user' as a stream"); return (-1); } @@ -1581,12 +1576,12 @@ static int CheckStream__(const char *file, const char *f, int line, Term arg, if ((GLOBAL_Stream[sno].status & Input_Stream_f) && !(kind & Input_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); } if ((GLOBAL_Stream[sno].status & (Append_Stream_f | Output_Stream_f)) && !(kind & Output_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); + PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); } return (sno); } @@ -1602,7 +1597,12 @@ int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg, if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0) return -1; if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, msg); + if (kind == Input_Stream_f) + PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, + msg); + else + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, arg, + msg); UNLOCK(GLOBAL_Stream[sno].streamlock); return -1; } diff --git a/os/readterm.c b/os/readterm.c index 6e08e7218..ba392f3d7 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -351,12 +351,12 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) { tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr); tn[1] = TermNil; terr = Yap_MkApplTerm(FunctorError, 2, tn); - #if DEBUG - if (Yap_ExecutionMode == YAP_BOOT_MODE) { - fprintf(stderr, "SYNTAX ERROR while booting: "); - Yap_DebugPlWriteln( terr ); - } - #endif +#if DEBUG + if (Yap_ExecutionMode == YAP_BOOT_MODE) { + fprintf(stderr, "SYNTAX ERROR while booting: "); + Yap_DebugPlWriteln(terr); + } +#endif return terr; } @@ -400,6 +400,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { if (args == NULL) { return NULL; } + re->bq = getBackQuotesFlag(); if (args[READ_MODULE].used) { CurrentModule = args[READ_MODULE].tvalue; @@ -456,7 +457,8 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue); if (re->prio > GLOBAL_MaxPriority) { Yap_Error(DOMAIN_ERROR_OPERATOR_PRIORITY, opts, - "max priority in Prolog is %d, not %ld", GLOBAL_MaxPriority, re->prio); + "max priority in Prolog is %d, not %ld", GLOBAL_MaxPriority, + re->prio); } } else { re->prio = LOCAL_default_priority; @@ -660,7 +662,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { and floats */ LOCAL_tokptr = LOCAL_toktide = - Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos); + Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos); if (LOCAL_ErrorMessage) return YAP_SCANNING_ERROR; if (LOCAL_tokptr->Tok != Ord(eot_tok)) { @@ -809,6 +811,16 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { return fe.t; } } + if (fe.t) { + if (fe.reading_clause && + !complete_clause_processing(&fe, LOCAL_tokptr, fe.t)) + fe.t = 0; + else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr)) + fe.t = 0; + } +#if EMACS + first_char = tokstart->TokPos; +#endif /* EMACS */ return fe.t; } @@ -819,7 +831,7 @@ static Int if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0) return FALSE; Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h PASS_REGS); + Yap_RecoverSlots(1, h); return Yap_unify(tf, rc); } @@ -837,7 +849,7 @@ static Int read_term( out = Yap_read_term(inp_stream, ARG3, 3); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h PASS_REGS); + Yap_RecoverSlots(1, h); return out != 0L && Yap_unify(tf, out); } @@ -987,7 +999,7 @@ static Int read_clause2(USES_REGS1) { yhandle_t h = Yap_InitSlot(ARG1); rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), -2); Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h PASS_REGS); + Yap_RecoverSlots(1, h); return rc && Yap_unify(tf, rc); } @@ -1025,7 +1037,7 @@ static Int read_clause( out = Yap_read_term(inp_stream, t3, -3); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h PASS_REGS); + Yap_RecoverSlots(1, h); return out && Yap_unify(tf, out); } @@ -1181,7 +1193,7 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, *bindings = Yap_GetFromSlot(sl); } if (bindings) { - Yap_RecoverSlots(sl, 1 PASS_REGS); + Yap_RecoverSlots(sl, 1); } return rval; } diff --git a/os/readutil.c b/os/readutil.c index 27af13f78..76e4fd441 100644 --- a/os/readutil.c +++ b/os/readutil.c @@ -241,7 +241,7 @@ read_stream_to_terms(USES_REGS1) RESET_VARIABLE(HR); RESET_VARIABLE(HR+1); hd = (CELL)HR; - Yap_PutInSlot(news, (CELL)(HR+1) PASS_REGS); + Yap_PutInSlot(news, (CELL)(HR+1)); HR += 2; while ((hd=Yap_read_term(sno, TermNil, 2)) == 0L) ; @@ -253,7 +253,7 @@ read_stream_to_terms(USES_REGS1) } else { CELL *newpt = (CELL*)Yap_GetFromSlot(news); *pt =AbsPair(newpt-1); - Yap_PutInSlot(tails, (CELL)newpt PASS_REGS); + Yap_PutInSlot(tails, (CELL)newpt); } } UNLOCK(GLOBAL_Stream[sno].streamlock); diff --git a/os/time.c b/os/time.c index f5f2bf719..ef1227a7f 100644 --- a/os/time.c +++ b/os/time.c @@ -718,8 +718,8 @@ void Yap_walltime_interval(Int *now,Int *interval) Yap_ReInitWTime (void) { Yap_InitWTime(); - if (Yap_global->LastWTimePtr_ != NULL) - Yap_FreeCodeSpace(Yap_global->LastWTimePtr_); + if (GLOBAL_LastWTimePtr != NULL) + Yap_FreeCodeSpace(GLOBAL_LastWTimePtr); Yap_InitLastWTime(); } diff --git a/os/write.c b/os/write.c index 9f0260c4e..e510ef0b0 100644 --- a/os/write.c +++ b/os/write.c @@ -20,7 +20,7 @@ static char SccsId[] = "%W% %G%"; /* * This file includes the definition of a miscellania of standard predicates - * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, + * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * */ @@ -49,7 +49,7 @@ static char SccsId[] = "%W% %G%"; #ifdef HAVE_SYS_STAT_H #include #endif -#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) +#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) #include #endif #ifdef HAVE_UNISTD_H @@ -77,7 +77,7 @@ static char SccsId[] = "%W% %G%"; #if !HAVE_STRNCPY #define strncpy(X,Y,Z) strcpy(X,Y) #endif -#if _MSC_VER || defined(__MINGW32__) +#if _MSC_VER || defined(__MINGW32__) #if HAVE_SOCKET #include #endif @@ -88,7 +88,7 @@ static char SccsId[] = "%W% %G%"; #endif #include "iopreds.h" -#if _MSC_VER || defined(__MINGW32__) +#if _MSC_VER || defined(__MINGW32__) #define SYSTEM_STAT _stat #else #define SYSTEM_STAT stat @@ -102,7 +102,7 @@ static char SccsId[] = "%W% %G%"; int beam_write ( USES_REGS1 ) { Yap_StartSlots(); - Yap_plwrite (ARG1, GLOBAL_Stream+LOCAL_output_stream, 0, 0, 1200); + Yap_plwrite (ARG1, GLOBAL_Stream+LOCAL_output_stream, 0, 0, GLOBAL_MaxPriority); Yap_CloseSlots(); if (EX != 0L) { Term ball = Yap_PopTermFromDB(EX); @@ -122,7 +122,7 @@ p_write ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ yhandle_t mySlots = Yap_StartSlots(); - Yap_plwrite (ARG2, GLOBAL_Stream+LOCAL_output_stream, 0, flags, 1200); + Yap_plwrite (ARG2, GLOBAL_Stream+LOCAL_output_stream, 0, flags, GLOBAL_MaxPriority); Yap_CloseSlots( mySlots ); if (EX != 0L) { Term ball = Yap_PopTermFromDB(EX); @@ -159,8 +159,7 @@ p_write2_prio ( USES_REGS1 ) Int flags = IntegerOfTerm(Deref(ARG2)); int stream_f; - stream_f = Output_Stream_f; - LOCAL_output_stream = CheckStream (ARG1, stream_f, "write/2"); + LOCAL_output_stream = CheckTextStream(ARG1, Output_Stream_f, "write/2"); if (LOCAL_output_stream == -1) { LOCAL_output_stream = old_output_stream; return(FALSE); @@ -185,7 +184,7 @@ static Int p_write2 ( USES_REGS1 ) { /* '$write'(+Stream,+Flags,?Term) */ int old_output_stream = LOCAL_output_stream; - LOCAL_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2"); + LOCAL_output_stream = CheckTextStream(ARG1, Output_Stream_f, "write/2"); if (LOCAL_output_stream == -1) { LOCAL_output_stream = old_output_stream; return(FALSE); @@ -194,7 +193,7 @@ p_write2 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ yhandle_t myslots = Yap_StartSlots(); - Yap_plwrite (ARG3, GLOBAL_Stream+LOCAL_output_stream, 0, (int) IntOfTerm (Deref (ARG2)), 1200); + Yap_plwrite (ARG3, GLOBAL_Stream+LOCAL_output_stream, 0, (int) IntOfTerm (Deref (ARG2)), GLOBAL_MaxPriority); Yap_CloseSlots(myslots); LOCAL_output_stream = old_output_stream; if (EX != 0L) { diff --git a/os/yapio.h b/os/yapio.h index b6d92f58d..a5ec8c83a 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -148,36 +148,8 @@ void Yap_init_socks(char *host, long interface_port); extern int errno; #endif -INLINE_ONLY EXTERN UInt inline HashFunction(const unsigned char *); -INLINE_ONLY EXTERN UInt inline WideHashFunction(wchar_t *); - -INLINE_ONLY EXTERN inline UInt HashFunction(const unsigned char *CHP) { - /* djb2 */ - UInt hash = 5381; - UInt c; - - while ((c = (UInt)(*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; -} +uint64_t HashFunction(const unsigned char *); +uint64_t WideHashFunction(wchar_t *); INLINE_ONLY inline EXTERN Term MkCharTerm(Int c); diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index ec1c4dc3a..d7d93d03b 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -21,6 +21,7 @@ :- use_module(library(atts)). + :- use_module(library(bhash)). :- use_module(library(lists)). @@ -33,7 +34,7 @@ :- attribute key/1, dist/2, evidence/1. -:- use_module('clpbn/ve', +:- use_module(clpbn/ve, [ve/3, check_if_ve_done/1, init_ve_solver/4, @@ -198,7 +199,7 @@ clpbn_flag(parameter_softening,Before,After) :- !, retract(parameter_softening(Before)), assert(parameter_softening(After)). -clpbn_flag(use_factors,Before,After) :- !, +clpbn_flag(use_parfactors,Before,After) :- !, retract(use_parfactors(Before)), assert(use_parfactors(After)). diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index 8bd5069ce..a9b5855f1 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -248,7 +248,7 @@ This option allows exporting the current model to the href{http://graphmod.ics.u + export_graphviz -This option allows exporting the factor graph's structure into a format that can be parsed by href{http://www.graphviz.org/}{Graphviz}. +This option allows exporting the factor graph's structure into a format that xocan be parsed by href{http://www.graphviz.org/}{Graphviz}. + Values: `true` or `false` (default). + Affects: `hve`, `bp`, and `cbp`. @@ -362,7 +362,7 @@ The options that are available with the `set_pfl_flag/2` predicate can be used i -> % we're using factor language % set appropriate flag - set_pfl_flag(use_factors,on) + set_pfl_flag(use_parfactors,on) ; % we're within clp(bn), no need to do anything true @@ -504,7 +504,11 @@ new_skolem(Sk, D) :- functor(Sk, N, A), functor(NSk, N, A), % [f,t] is special for evidence - ( D = [f,t] -> assert((evidence(NSk, 1) :- user:NSk)) ; true ), + ( D = [f,t] -> + dynamic(N/A), + assert((evidence(NSk, 1) :- user:NSk)) + ; + true ), interface_predicate(NSk), assert(skolem(NSk, D)). diff --git a/packages/ProbLog/problog/grounder.yap b/packages/ProbLog/problog/grounder.yap index 4121b8e92..bc4722787 100644 --- a/packages/ProbLog/problog/grounder.yap +++ b/packages/ProbLog/problog/grounder.yap @@ -75,7 +75,8 @@ grounder_compute_reachable_atoms(A,ID,Success) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ( % go over all proofs for A in interpretation ID - tabled_meta_interpreter(A,ID), + tabled_meta_interpreter(A,ID), + writeln(A), bb_put(dep_proven,true), fail; % go to next proof @@ -100,6 +101,8 @@ grounder_compute_reachable_atoms(A,ID,Success) :- %======================================================================== +tabled_meta_interpreter(X,ID) :- + writeln(ID:X), fail. tabled_meta_interpreter((X,Y),ID) :- !, tabled_meta_interpreter(X,ID), @@ -143,9 +146,9 @@ tabled_meta_interpreter(Atom,ID) :- % we can ignore probabilistic facts and only look for myclauses % since in ProbLog the requirement is that non-ground facts have to be % ground at query time - current_predicate(user:myclause/3), user:myclause(ID,Atom,Body), + writeln(Atom:Body), tabled_meta_interpreter(Body,ID), diff --git a/packages/ProbLog/problog/logger.yap b/packages/ProbLog/problog/logger.yap index c74360a5b..4d7dc7f0d 100644 --- a/packages/ProbLog/problog/logger.yap +++ b/packages/ProbLog/problog/logger.yap @@ -228,8 +228,9 @@ :- initialization(( bb_put(logger_filename,'out.dat'), bb_put(logger_delimiter,';'), - bb_put(logger_variables,[]) -)). + bb_put(logger_variables,[]) + )). + %======================================================================== %= Defines a new variable, possible types are: int, float and time diff --git a/packages/ProbLog/problog_examples/alarm.pl b/packages/ProbLog/problog_examples/alarm.pl index 41dfc7c0b..7eb4bdca6 100644 --- a/packages/ProbLog/problog_examples/alarm.pl +++ b/packages/ProbLog/problog_examples/alarm.pl @@ -53,7 +53,7 @@ myclause(calls(Person), (person(Person),alarm,hears_alarm(Person))). %%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Training examples % -%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%l example(1). example(2). @@ -64,4 +64,3 @@ known(1,alarm,true). %%%% Example 2 known(2,earthquake,false). known(2,calls(mary),true). - diff --git a/packages/ProbLog/problog_lfi.yap b/packages/ProbLog/problog_lfi.yap index 59513ec77..705f49145 100644 --- a/packages/ProbLog/problog_lfi.yap +++ b/packages/ProbLog/problog_lfi.yap @@ -10,71 +10,71 @@ % http://dtai.cs.kuleuven.be/problog % % ProbLog was developed at Katholieke Universiteit Leuven -% +% % Copyright 2009 % Angelika Kimmig, Vitor Santos Costa, Bernd Gutmann -% +% % Main author of this file: % Bernd Gutmann % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % 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. @@ -82,34 +82,34 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % 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) @@ -128,7 +128,7 @@ % % 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 @@ -139,13 +139,13 @@ % 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 @@ -153,7 +153,7 @@ % 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 @@ -161,7 +161,7 @@ % 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 @@ -169,21 +169,21 @@ % 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 @@ -193,7 +193,7 @@ % 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 @@ -312,7 +312,7 @@ print_ad_intern(_::Fact,[],Mass,Handle) :- P2 is 1.0 - Mass, format(Handle,'~f :: ~q',[P2,Fact]). print_ad_intern_one(_::Fact,_::AuxFact,Mass,NewMass,Handle) :- - % ask problog to get the fact_id + % ask problog to get the fact_id once(probabilistic_fact(_,AuxFact,FactID)), % look in our table for the probability array_element(factprob,FactID,P), @@ -342,7 +342,7 @@ do_learning_intern(0,_) :- do_learning_intern(Iterations,Epsilon) :- Iterations>0, logger_start_timer(duration), - + current_iteration(CurrentIteration), !, retractall(current_iteration(_)), @@ -350,7 +350,7 @@ do_learning_intern(Iterations,Epsilon) :- NextIteration is CurrentIteration+1, assertz(current_iteration(NextIteration)), EndIteration is CurrentIteration+Iterations-1, - + format_learning(1,'~nIteration ~d of ~d~n',[CurrentIteration,EndIteration]), logger_set_variable(iteration,CurrentIteration), @@ -358,7 +358,7 @@ do_learning_intern(Iterations,Epsilon) :- once(llh_testset), - once(ground_truth_difference), + once(ground_truth_difference), once(em_one_iteration), problog_flag(log_frequency,Log_Frequency), @@ -381,11 +381,11 @@ do_learning_intern(Iterations,Epsilon) :- LLH_Diff is abs(Last_LLH-Current_LLH) ); ( logger_get_variable(llh_training_set,Current_LLH), - assertz(last_llh(Current_LLH)), + assertz(last_llh(Current_LLH)), LLH_Diff is Epsilon+1 ) ), - + logger_stop_timer(duration), logger_write_data, RemainingIterations is Iterations-1, @@ -424,12 +424,12 @@ init_learning :- check_theory, - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Delete the stuff from the previous run + % Delete the stuff from the previous run %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% problog_flag(reuse_initialized_bdds,Re_Use_Flag), - + ( Re_Use_Flag==false -> @@ -438,7 +438,7 @@ init_learning :- ), empty_output_directory, - + logger_write_header, format_learning(1,'Initializing everything~n',[]), @@ -471,7 +471,7 @@ init_learning :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % build BDD script for every example %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - + once(init_queries), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -492,7 +492,7 @@ init_learning :- %======================================================================== %= This predicate checks some aspects of the data given by the user. %= You know folks: Garbage in, garbage out. -%= +%= %======================================================================== check_theory :- ( @@ -510,7 +510,7 @@ check_theory :- ); true ), - + ( (current_predicate(user:example/1),user:example(_)) -> @@ -584,7 +584,7 @@ check_theory :- %= %======================================================================== -initialize_fact_probabilities :- +initialize_fact_probabilities :- problog:probclause_id(N), static_array(factprob,N,float), @@ -658,7 +658,7 @@ init_queries :- assertz(test_set_cluster_list(Test_Set_Cluster_List)). %======================================================================== -%= +%= %======================================================================== init_one_query(QueryID,_Query_Type) :- @@ -689,10 +689,8 @@ create_test_query_cluster_list(L2) :- calc_all_md5(AllCluster,AllCluster2), findall(a(QueryID1,ClusterID1,Len),(bagof(a(QueryID,ClusterID),member(a(QueryID,ClusterID,_MD5),AllCluster2),L),nth1(1,L,a(QueryID1,ClusterID1)),length(L,Len)),L2), !, - length(AllCluster,Len1), length(L2,Len2), - ( Len1>0 -> @@ -717,25 +715,22 @@ create_training_query_cluster_list(L2) :- ), AllCluster), calc_all_md5(AllCluster,AllCluster2), - - findall(a(QueryID1,ClusterID1,Len), ( bagof(a(QueryID,ClusterID),member(a(QueryID,ClusterID,_MD5),AllCluster2),L), nth1(1,L,a(QueryID1,ClusterID1)), length(L,Len) ),L2), - length(AllCluster,Len1), length(L2,Len2), Reduction is Len2/Len1, - + format_learning(3,' ~d cluster after splitting, ~d unique cluster ==> reduction factor of ~4f~n',[Len1,Len2,Reduction]). %======================================================================== -%= +%= %======================================================================== reset_learning :- @@ -751,7 +746,7 @@ reset_learning :- close_static_array(factprob), close_static_array(factprob_temp), close_static_array(factusage), - + close_static_array(known_count_true_training), close_static_array(known_count_false_training), close_static_array(known_count_true_test), @@ -760,14 +755,14 @@ reset_learning :- reset_completion, empty_bdd_directory, empty_output_directory, - + logger_reset_all_variables ); true ). %======================================================================== -%= calculate the LLH on the test set and set the variable +%= calculate the LLH on the test set and set the variable %= in the logger module %======================================================================== @@ -863,7 +858,7 @@ write_probabilities_file :- forall(get_fact_probability(ID,_), ( array_element(factprob,ID,Prob), - + ( non_ground_fact(ID) -> @@ -885,17 +880,17 @@ write_probabilities_file :- update_query(QueryID,ClusterID ,Method,Command,PID,Output_File_Name) :- current_iteration(Iteration), - + create_bdd_input_file_name(Iteration,Input_File_Name), create_bdd_output_file_name(QueryID,ClusterID,Iteration,Output_File_Name), create_bdd_file_name(QueryID,ClusterID,BDD_File_Name), convert_filename_to_problog_path('problogbdd_lfi',Absolute_Name), - + atomic_concat([Absolute_Name, ' -i "', Input_File_Name, '"', ' -l "', BDD_File_Name, '"', - ' -m ', Method, + ' -m ', Method, ' -id ', QueryID],Command), open( Output_File_Name, write, Stream ), exec(Command,[std, Stream ,std],PID), @@ -914,7 +909,7 @@ update_query_wait(QueryID,_ClusterID,Count,Symbol,Command,PID,OutputFilename,BDD ); true ), - + once(my_load_allinone(OutputFilename,QueryID,Count,BDD_Probability)), problog_flag(retain_bdd_output,Retain_BDD_Output), @@ -1019,7 +1014,7 @@ em_one_iteration :- KK_Sum is KK_True+KK_False, KK_Sum>0, - + % add counts add_to_array_element(factprob_temp,FactID,KK_True,_NewValue), add_to_array_element(factusage,FactID,KK_Sum,_NewCount), @@ -1038,7 +1033,7 @@ em_one_iteration :- LProb is Part1 + KK_False*log(1-P); LProb is Part1 ), - + bb_get(dummy,Old), New is Old+LProb, bb_put(dummy,New), @@ -1056,7 +1051,7 @@ em_one_iteration :- evaluate_bdds(AllCluster,Handle,Parallel_Processes,'e','.',LLH_From_True_BDDs,LLH), logger_set_variable(llh_training_set,LLH), - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop calculate new values %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1065,7 +1060,7 @@ em_one_iteration :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % start copy new values %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - + problog_flag(pc_numerator,Pseudo_Counts_Numerator), problog_flag(pc_denominator,Pseudo_Counts_Denominator), @@ -1098,7 +1093,7 @@ em_one_iteration :- %= S : symbol to print after a process finished %= OldLLH : accumulator for LLH %= LLH : resulting LLH -%= +%= %= evaluate_bdds(+L,+H,+P,+T,+S,+OldLLH,-LLH) %======================================================================== @@ -1107,7 +1102,7 @@ evaluate_bdds([H|T],Handle,Parallel_Processes,Type,Symbol,OldLLH,LLH) :- once(slice_n([H|T],Parallel_Processes,ForNow,Later)), logger_start_timer(bdd_evaluation), once(evaluate_bdds_start(ForNow,Type,ForNow_Jobs)), - once(evaluate_bdds_stop(ForNow_Jobs,Handle,Symbol,OldLLH,NewLLH)), + once(evaluate_bdds_stop(ForNow_Jobs,Handle,Symbol,OldLLH,NewLLH)), logger_stop_timer(bdd_evaluation), evaluate_bdds(Later,Handle,Parallel_Processes,Type,Symbol,NewLLH,LLH). @@ -1142,7 +1137,7 @@ init_flags :- problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), problog_define_flag(retain_bdd_output,problog_flag_validate_boolean,'Keep output files from BDD tool',false,learning_general), problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), - problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), + problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), problog_define_flag(pc_numerator,problog_flag_validate_in_interval_right_open([0.0,+inf]),'Add X to numerator (Pseudocounts)',0.0,learning_general), problog_define_flag(pc_denominator,problog_flag_validate_in_interval_right_open([0.0,+inf]),'Add X to denominator (Pseudocounts)',0.0,learning_general), problog_define_flag(parallel_processes,problog_flag_validate_posint,'Number of parallel BDD processes',8,learning_general), @@ -1156,7 +1151,7 @@ init_logger :- logger_define_variable(llh_training_set,float), logger_define_variable(llh_test_set,float), - + logger_define_variable(bdd_evaluation,time), logger_define_variable(ground_truth_diff,float), @@ -1186,6 +1181,3 @@ init_logger :- %:- initialization(do_learning(100) ). - - - diff --git a/packages/bdd/CMakeLists.txt b/packages/bdd/CMakeLists.txt index 9e57f3441..3a3c29b2d 100644 --- a/packages/bdd/CMakeLists.txt +++ b/packages/bdd/CMakeLists.txt @@ -35,12 +35,12 @@ IF (CUDD_FOUND) ${CUDD_INCLUDE_DIR} ${CMAKE_CURRENT_BINARY_DIR} ) - + check_include_files( util.h HAVE_UTIL_H ) check_include_files( cudd/util.h HAVE_CUDD_UTIL_H ) check_include_files( cudd.h HAVE_CUDD_H ) check_include_files( "stdio.h;cudd/cudd.h" HAVE_CUDD_CUDD_H ) - check_include_files( cuddInt.h HAVE_CUDDINT_H ) + check_include_files( cuddInt.h HAVE_CUDDINT_H ) check_include_files( "stdio.h;cudd/cudd.h;cudd/cuddInt.h" HAVE_CUDD_CUDDINT_H ) configure_file ("${PROJECT_SOURCE_DIR}/cudd_config.h.cmake" @@ -63,6 +63,7 @@ IF (CUDD_FOUND) add_subdirectory(simplecudd) add_subdirectory(simplecudd_lfi) + set(YAP_SYSTEM_OPTIONS "cudd " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) install(TARGETS cudd LIBRARY DESTINATION ${dlls} @@ -72,7 +73,7 @@ IF (CUDD_FOUND) INSTALL(FILES ddnnf.yap DESTINATION ${libpl}) INSTALL(FILES simpbool.yap DESTINATION ${libpl}) INSTALL(FILES trie_sp.yap DESTINATION ${libpl}) - + ENDIF (CUDD_FOUND) SET (CUDD_FOUND_EXPORT ${CUDD_FOUND} PARENT_SCOPE) diff --git a/packages/bdd/cudd_config.h b/packages/bdd/cudd_config.h index dc11ed637..efdb27e2e 100644 --- a/packages/bdd/cudd_config.h +++ b/packages/bdd/cudd_config.h @@ -2,7 +2,7 @@ /* Define to 1 if you have the header file. */ #ifndef HAVE_CUDDINT_H -#define HAVE_CUDDINT_H +/* #undef HAVE_CUDDINT_H */ #endif /* Define to 1 if you have the header file. */ @@ -15,9 +15,9 @@ #define HAVE_CUDD_CUDD_H 1 #endif -/* Define to 1 if you have the header file. */ +/*Define to 1 if you have the header file. */ #ifndef HAVE_CUDD_H -#define HAVE_CUDD_H +/* #undef HAVE_CUDD_H */ #endif /* Define to 1 if you have the header file. */ diff --git a/packages/bdd/simplecudd_lfi/general.c b/packages/bdd/simplecudd_lfi/general.c index 658ad6d2c..d29398b75 100644 --- a/packages/bdd/simplecudd_lfi/general.c +++ b/packages/bdd/simplecudd_lfi/general.c @@ -254,7 +254,7 @@ int CharIn(const char c, const char *in) { /* string handling */ -int patternmatch(char *pattern, char *thestr) { +int patternmatch(const char *pattern, const char *thestr) { int i, j = -1, pl = strlen(pattern), sl = strlen(thestr); for(i = 0; i < pl; i++) { if (pattern[i] == '*') { diff --git a/packages/bdd/simplecudd_lfi/general.h b/packages/bdd/simplecudd_lfi/general.h index ed176f7c3..5f3292c34 100644 --- a/packages/bdd/simplecudd_lfi/general.h +++ b/packages/bdd/simplecudd_lfi/general.h @@ -200,5 +200,5 @@ int IsRealNumber(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); +int patternmatch(const char *pattern, const char *thestr); diff --git a/packages/bdd/simplecudd_lfi/problogbdd_lfi.c b/packages/bdd/simplecudd_lfi/problogbdd_lfi.c index 6377935eb..667d8aa0e 100644 --- a/packages/bdd/simplecudd_lfi/problogbdd_lfi.c +++ b/packages/bdd/simplecudd_lfi/problogbdd_lfi.c @@ -241,7 +241,7 @@ double CalcExpectedCountsUp(extmanager * MyManager, DdNode *Current, char *query double CalcExpectedCountsDown(extmanager * MyManager, DdNode *Current, char *query_id); double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_id, int calcdown_needed); int patterncalculated(char *pattern, extmanager MyManager, int loc); -char * extractpattern(char *thestr); +char * extractpattern(const char *thestr); int main(int argc, char **arg) { extmanager MyManager; @@ -476,7 +476,7 @@ int main(int argc, char **arg) { free(MyManager.varmap.dynvalue); } for (i = 0; i < MyManager.varmap.varcnt; i++) - free(MyManager.varmap.vars[i]); + free((const char *)MyManager.varmap.vars[i]); free(MyManager.varmap.vars); } if (params.error != NULL) free(params.error); @@ -1168,7 +1168,7 @@ gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, return tvalue; } -char * extractpattern(char *thestr) { +char * extractpattern(const char *thestr) { char *p; int i = 0, sl = strlen(thestr); while((thestr[i] != '_') && (i < sl)) i++; diff --git a/packages/bdd/simplecudd_lfi/simplecudd.c b/packages/bdd/simplecudd_lfi/simplecudd.c index 7370401c5..a48abc52a 100644 --- a/packages/bdd/simplecudd_lfi/simplecudd.c +++ b/packages/bdd/simplecudd_lfi/simplecudd.c @@ -370,7 +370,7 @@ int CheckFileVersion(const char *version) { return -1; } -int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename) { +int simpleBDDtoDot(DdManager *manager, DdNode *bdd, const char *filename) { DdNode *f[1]; int ret; FILE *fd; @@ -385,8 +385,8 @@ int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename) { return ret; } -int simpleNamedBDDtoDot(DdManager *manager, const namedvars varmap, DdNode *bdd, - char *filename) { +int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, + const char *filename) { DdNode *f[1]; int ret; FILE *fd; @@ -435,7 +435,7 @@ void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile) { DdNode *h, *l; hisnode *Found; - char *curnode; + const char *curnode; int inode; if (Current != HIGH(manager) && Current != LOW(manager)) { if ((Found = GetNode(Nodes, varmap.varstart, Current)) == NULL) { @@ -917,7 +917,7 @@ namedvars InitNamedVars(int varcnt, int varstart) { int i; temp.varcnt = varcnt; temp.varstart = varstart; - temp.vars = (char **)malloc(sizeof(char *) * varcnt); + temp.vars = (const char **)malloc(sizeof(char *) * varcnt); temp.loaded = (int *)malloc(sizeof(int) * varcnt); temp.dvalue = (double *)malloc(sizeof(double) * varcnt); temp.ivalue = (int *)malloc(sizeof(int) * varcnt); @@ -934,7 +934,7 @@ namedvars InitNamedVars(int varcnt, int varstart) { void EnlargeNamedVars(namedvars *varmap, int newvarcnt) { int i; - varmap->vars = (char **)realloc(varmap->vars, sizeof(char *) * newvarcnt); + varmap->vars = (const char **)realloc(varmap->vars, sizeof(const char *) * newvarcnt); varmap->loaded = (int *)realloc(varmap->loaded, sizeof(int) * newvarcnt); varmap->dvalue = (double *)realloc(varmap->dvalue, sizeof(double) * newvarcnt); @@ -954,7 +954,7 @@ void EnlargeNamedVars(namedvars *varmap, int newvarcnt) { int AddNamedVarAt(namedvars varmap, const char *varname, int index) { if (varmap.varcnt > index) { varmap.vars[index] = (char *)malloc(sizeof(char) * (strlen(varname) + 1)); - strcpy(varmap.vars[index], varname); + strcpy(varmap.vars[index], (char *)varname); return index; } return -1; @@ -1010,7 +1010,7 @@ int GetNamedVarIndex(const namedvars varmap, const char *varname) { return -1 * varmap.varcnt; } -char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node) { +const char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node) { if (node == NULL) return NULL; if (node == HIGH(manager)) @@ -1020,7 +1020,7 @@ char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node) { return varmap.vars[GetIndex(node) - varmap.varstart]; } -char *GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node) { +const char *GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node) { if (HIGH(manager) == node) return "TRUE"; if (LOW(manager) == node) diff --git a/packages/bdd/simplecudd_lfi/simplecudd.h b/packages/bdd/simplecudd_lfi/simplecudd.h index 38ae6b8ca..8fd18359e 100644 --- a/packages/bdd/simplecudd_lfi/simplecudd.h +++ b/packages/bdd/simplecudd_lfi/simplecudd.h @@ -249,7 +249,7 @@ typedef struct _bddfileheader { typedef struct _namedvars { int varcnt; int varstart; - char **vars; + const char ** vars; int *loaded; double *dvalue; int *ivalue; @@ -317,8 +317,8 @@ void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue); int GetNamedVarIndex(const namedvars varmap, const char *varname); int RepairVarcnt(namedvars *varmap); -char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); -char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); +const char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); +const char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); int all_loaded(namedvars varmap, int disp); int all_loaded_for_deterministic_variables(namedvars varmap, int disp); @@ -351,6 +351,6 @@ void ExpandNodes(hisqueue *Nodes, int index, int nodenum); /* Export */ -int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename); -int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); +int simpleBDDtoDot(DdManager *manager, DdNode *bdd, const char *filename); +int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, const char *filename); diff --git a/packages/bdd/simplecudd_lfi/simplecudd_lfi b/packages/bdd/simplecudd_lfi/simplecudd_lfi index 85b567bec42e2265873d672ca09cd55507b51ce4..0e16181b077588d0e97fcb994f5da9b8ee0af1fd 100755 GIT binary patch delta 137 zcmX?ck@dty)(IkvGd7B@W|fP1kX!fTmet;QX-2wY4LuGj3=9kcK+M3+1;m^0u|_d6 zGcul>Y|XA||vXEIKJpje!wBoWWLRu@q{4&oi->zls%Rl{BLpB{)T4AH1pVPIeo0AdC%E+F1~k2Q*s znSo*NWNUWK$xGM+{3C!;5YfsYS*5WyQ(*k%A3~EW_kvC2Kq^* snK>!C6&7akW+wVMnMoiFl+`md&`YTVvKbgQzh?id*JQrUobiMq0LP*&DF6Tf diff --git a/packages/cplint/lpadclpbn.pl b/packages/cplint/lpadclpbn.pl index 42e15c5b5..5f830c877 100644 --- a/packages/cplint/lpadclpbn.pl +++ b/packages/cplint/lpadclpbn.pl @@ -22,7 +22,6 @@ :-set_clpbn_flag(bnt_model,propositional). - /* start of list of parameters that can be set by the user with set(Parameter,Value) */ setting(epsilon_parsing,0.00001). diff --git a/packages/jpl/CMakeLists.txt b/packages/jpl/CMakeLists.txt index 21c5ac6eb..b1f131a1a 100644 --- a/packages/jpl/CMakeLists.txt +++ b/packages/jpl/CMakeLists.txt @@ -56,6 +56,8 @@ if (Java_Development_FOUND) set_target_properties(jplYap PROPERTIES OUTPUT_NAME jpl ) + set(YAP_SYSTEM_OPTIONS "jpl " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) + install(TARGETS jplYap LIBRARY DESTINATION ${dlls} ) diff --git a/packages/jpl/jpl.pl b/packages/jpl/jpl.pl index 159ceba65..0f52acd8a 100644 --- a/packages/jpl/jpl.pl +++ b/packages/jpl/jpl.pl @@ -81,14 +81,14 @@ jpl_set_element/2 ]). -:- expects_dialect(swi). +%:- expects_dialect(swi). :- use_module(library(lists)). :- use_module(library(apply)). :- use_module(library(shlib)). % suppress debugging this library -:- set_prolog_flag(generate_debug_info, false). +%:- set_prolog_flag(generate_debug_info, false). %------------------------------------------------------------------------------ diff --git a/packages/jpl/jpl/jpl.pl b/packages/jpl/jpl/jpl.pl index 208506f4f..58e82a031 100644 --- a/packages/jpl/jpl/jpl.pl +++ b/packages/jpl/jpl/jpl.pl @@ -81,8 +81,6 @@ jpl_set_element/2 ]). -:- expects_dialect(swi). - :- use_module(library(lists)). :- use_module(library(apply)). :- use_module(library(shlib)). @@ -157,6 +155,8 @@ jpl_tidy_iref_type_cache( Iref) :- % % finally, an attempt will be made to unify Result with the returned result +:- stop_low_level_trace. + jpl_call(X, Mspec, Params, R) :- ( jpl_object_to_type(X, Type) % the usual case (goal fails safely if X is var or rubbish) -> Obj = X, diff --git a/packages/myddas/#MyddasProto.h# b/packages/myddas/#MyddasProto.h# deleted file mode 100644 index 13b08eb81..000000000 --- a/packages/myddas/#MyddasProto.h# +++ /dev/null @@ -1,79 +0,0 @@ -/* MYDDAS */ - -#ifdef USE_MYDDAS - -/* myddas_initialization.c */ -MYDDAS_GLOBAL myddas_init_initialize_myddas(void); -MYDDAS_UTIL_CONNECTION myddas_init_initialize_connection(void *,void *,MYDDAS_API,MYDDAS_UTIL_CONNECTION); -MYDDAS_UTIL_PREDICATE myddas_init_initialize_predicate(char *, int, char *,MYDDAS_UTIL_PREDICATE); - -#ifdef MYDDAS_STATS -/* myddas_statistics.c */ -MYDDAS_GLOBAL myddas_stats_initialize_global_stats(MYDDAS_GLOBAL); -MYDDAS_STATS_STRUCT myddas_stats_initialize_connection_stats(void); -void myddas_stats_delete_stats_list(MYDDAS_STATS_STRUCT); -#endif /* MYDDAS_STATS */ - -#ifdef MYDDAS_MYSQL -/* myddas_util.c */ -void myddas_util_table_write(MYSQL_RES *); -#endif -MYDDAS_API myddas_util_connection_type(void *); -MYDDAS_UTIL_CONNECTION myddas_util_add_connection(void *,void *,MYDDAS_API); -MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *); -void myddas_util_delete_connection(void *); -MYDDAS_UTIL_CONNECTION myddas_util_add_predicate(char * ,Int , char *,void *); -MYDDAS_UTIL_PREDICATE myddas_util_search_predicate(char * ,Int , char *); -void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE); - -/* Get's the number of queries to save */ -UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION); -void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION,UInt); -#ifdef MYDDAS_ODBC -/* Return enviromment identifier*/ -SQLHENV myddas_util_get_odbc_enviromment(SQLHDBC); -#endif - -void * myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION); -void * myddas_util_get_pred_next(void *); -char * myddas_util_get_pred_module(void *); -char * myddas_util_get_pred_name(void *); -MyddasInt myddas_util_get_pred_arity(void *); -//DELETE THIS WHEN DB_STATS IS COMPLETED -MyddasInt get_myddas_top(void); - -#ifdef DEBUG -void check_int(void); -#endif - -#endif /* MYDDAS_MYSQL || MYDDAS_ODBC */ - -/* myddas_mysql.c */ -#if defined MYDDAS_MYSQL -void Yap_InitMYDDAS_MySQLPreds(void); -void Yap_InitBackMYDDAS_MySQLPreds(void); -#endif - -/* myddas_odbc.c */ -#if defined MYDDAS_ODBC -void Yap_InitMYDDAS_ODBCPreds(void); -void Yap_InitBackMYDDAS_ODBCPreds(void); -#endif - -/* myddas_odbc.c */ -#if defined MYDDAS_SQLITE3 -void Yap_InitMYDDAS_SQLITE3Preds(void); -void Yap_InitBackMYDDAS_SQLITE3Preds(void); -#endif - -/* Myddas_shared.c */ -#if defined USE_MYDDAS -void Yap_MYDDAS_delete_all_myddas_structs(void); -void Yap_InitMYDDAS_SharedPreds(void); -void Yap_InitBackMYDDAS_SharedPreds(void); -#endif - -/* myddas_top_level.c */ -#if defined MYDDAS_TOP_LEVEL && defined MYDDAS_MYSQL //&& defined HAVE_LIBREADLINE -void Yap_InitMYDDAS_TopLevelPreds(void); -#endif diff --git a/packages/myddas/CMakeLists.txt b/packages/myddas/CMakeLists.txt index ef14e8701..cf8e71c81 100644 --- a/packages/myddas/CMakeLists.txt +++ b/packages/myddas/CMakeLists.txt @@ -13,7 +13,7 @@ set( MYDDAS_SOURCES myddas_shared.c myddas_statistics.c myddas_top_level.c - myddas_wkb2prolog.c ) + ) set( MYDDAS_HEADERS myddas.h @@ -21,8 +21,7 @@ set( MYDDAS_HEADERS myddas_statistics_structs.h myddas_structs.h myddas_top_level.c - myddas_types.h - myddas_wkb2prolog.c ) + myddas_types.h ) set( MYDDAS_UTIL_SOURCES myddas_util.c diff --git a/packages/myddas/MyddasProto.h b/packages/myddas/MyddasProto.h index d23babf56..08f525e08 100644 --- a/packages/myddas/MyddasProto.h +++ b/packages/myddas/MyddasProto.h @@ -3,44 +3,46 @@ #ifdef USE_MYDDAS /* myddas_initialization.c */ -MYDDAS_GLOBAL myddas_init_initialize_myddas(void); -MYDDAS_UTIL_CONNECTION myddas_init_initialize_connection(void *,void *,MYDDAS_API,MYDDAS_UTIL_CONNECTION); -MYDDAS_UTIL_PREDICATE myddas_init_initialize_predicate(const char *, int, const char *,MYDDAS_UTIL_PREDICATE); +MYDDAS_GLOBAL myddas_init_initialize_myddas(void); +MYDDAS_UTIL_CONNECTION +myddas_init_initialize_connection(void *, void *, MYDDAS_API, + MYDDAS_UTIL_CONNECTION); +MYDDAS_UTIL_PREDICATE myddas_init_initialize_predicate(const char *, int, + const char *, + MYDDAS_UTIL_PREDICATE); #ifdef MYDDAS_STATS /* myddas_statistics.c */ -MYDDAS_GLOBAL myddas_stats_initialize_global_stats(MYDDAS_GLOBAL); -MYDDAS_STATS_STRUCT myddas_stats_initialize_connection_stats(void); -void myddas_stats_delete_stats_list(MYDDAS_STATS_STRUCT); +MYDDAS_GLOBAL myddas_stats_initialize_global_stats(MYDDAS_GLOBAL); +MYDDAS_STATS_STRUCT myddas_stats_initialize_connection_stats(void); +void myddas_stats_delete_stats_list(MYDDAS_STATS_STRUCT); #endif /* MYDDAS_STATS */ #ifdef MYDDAS_MYSQL /* myddas_util.c */ -void myddas_util_table_write(MYSQL_RES *); +void myddas_util_table_write(MYSQL_RES *); #endif -Short myddas_util_connection_type(void *); -MYDDAS_UTIL_CONNECTION myddas_util_add_connection(void *,void *,MYDDAS_API); +MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *con); +MYDDAS_UTIL_CONNECTION myddas_util_add_connection(void *, void *, MYDDAS_API); MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *); -void myddas_util_delete_connection(void *); -MYDDAS_UTIL_CONNECTION myddas_util_add_predicate(const char * ,Int , const char *,void *); -MYDDAS_UTIL_PREDICATE myddas_util_search_predicate(const char * ,Int , const char *); -void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE); +void myddas_util_delete_connection(void *); +MYDDAS_UTIL_CONNECTION myddas_util_add_predicate(const char *, Int, + const char *, void *); +MYDDAS_UTIL_PREDICATE myddas_util_search_predicate(const char *, Int, + const char *); +void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE); /* Get's the number of queries to save */ -UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION); -void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION,UInt); -#ifdef MYDDAS_ODBC -/* Return enviromment identifier*/ -SQLHENV myddas_util_get_odbc_enviromment(SQLHDBC); -#endif +UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION); +void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION, UInt); -void * myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION); -void * myddas_util_get_pred_next(void *); -const char * myddas_util_get_pred_module(void *); -const char * myddas_util_get_pred_name(void *); -MyddasInt myddas_util_get_pred_arity(void *); -//DELETE THIS WHEN DB_STATS IS COMPLETED -MyddasInt get_myddas_top(void); +void *myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION); +void *myddas_util_get_pred_next(void *); +const char *myddas_util_get_pred_module(void *); +const char *myddas_util_get_pred_name(void *); +MyddasInt myddas_util_get_pred_arity(void *); +// DELETE THIS WHEN DB_STATS IS COMPLETED +MyddasInt get_myddas_top(void); #ifdef DEBUG void check_int(void); @@ -50,30 +52,31 @@ void check_int(void); /* myddas_mysql.c */ #if defined MYDDAS_MYSQL -void Yap_InitMYDDAS_MySQLPreds(void); -void Yap_InitBackMYDDAS_MySQLPreds(void); +void Yap_InitMYDDAS_MySQLPreds(void); +void Yap_InitBackMYDDAS_MySQLPreds(void); #endif /* myddas_odbc.c */ #if defined MYDDAS_ODBC -void Yap_InitMYDDAS_ODBCPreds(void); -void Yap_InitBackMYDDAS_ODBCPreds(void); +void Yap_InitMYDDAS_ODBCPreds(void); +void Yap_InitBackMYDDAS_ODBCPreds(void); #endif /* myddas_odbc.c */ #if defined MYDDAS_SQLITE3 -void Yap_InitMYDDAS_SQLITE3Preds(void); -void Yap_InitBackMYDDAS_SQLITE3Preds(void); +void Yap_InitMYDDAS_SQLITE3Preds(void); +void Yap_InitBackMYDDAS_SQLITE3Preds(void); #endif /* Myddas_shared.c */ #if defined USE_MYDDAS -void Yap_MYDDAS_delete_all_myddas_structs(void); -void Yap_InitMYDDAS_SharedPreds(void); -void Yap_InitBackMYDDAS_SharedPreds(void); +void Yap_MYDDAS_delete_all_myddas_structs(void); +void Yap_InitMYDDAS_SharedPreds(void); +void Yap_InitBackMYDDAS_SharedPreds(void); #endif /* myddas_top_level.c */ -#if defined MYDDAS_TOP_LEVEL && defined MYDDAS_MYSQL //&& defined HAVE_LIBREADLINE -void Yap_InitMYDDAS_TopLevelPreds(void); +#if defined MYDDAS_TOP_LEVEL && \ + defined MYDDAS_MYSQL //&& defined HAVE_LIBREADLINE +void Yap_InitMYDDAS_TopLevelPreds(void); #endif diff --git a/packages/myddas/myddas_initialization.c b/packages/myddas/myddas_initialization.c index 8a1ebd0d4..ee130760a 100644 --- a/packages/myddas/myddas_initialization.c +++ b/packages/myddas/myddas_initialization.c @@ -11,32 +11,34 @@ #endif MYDDAS_GLOBAL -myddas_init_initialize_myddas(void){ +myddas_init_initialize_myddas(void) { MYDDAS_GLOBAL global = NULL; /* We cannot call MYDDAS_MALLOC were because the global register isn't yet initialized */ - global = (MYDDAS_GLOBAL) malloc (sizeof(struct myddas_global)); + global = (MYDDAS_GLOBAL)malloc(sizeof(struct myddas_global)); #ifdef DEBUGX - printf ("MALLOC %p %s %d\n",global,__FILE__,__LINE__); + printf("MALLOC %p %s %d\n", global, __FILE__, __LINE__); #endif global->myddas_top_connections = NULL; #ifdef MYDDAS_TOP_LEVEL global->myddas_top_level_connection = NULL; #endif #ifdef MYDDAS_STATS - global->myddas_statistics = (MYDDAS_GLOBAL_STATS) malloc (sizeof(struct myddas_global_stats)); + global->myddas_statistics = + (MYDDAS_GLOBAL_STATS)malloc(sizeof(struct myddas_global_stats)); #ifdef DEBUG - printf ("MALLOC %p %s %d\n",global->myddas_statistics,__FILE__,__LINE__); + printf("MALLOC %p %s %d\n", global->myddas_statistics, __FILE__, __LINE__); #endif global->myddas_statistics->stats = NULL; #endif #ifdef DEBUG - /* We first malloc for this struct and the stats struct */ +/* We first malloc for this struct and the stats struct */ #ifdef MYDDAS_STATS global->malloc_called = 2; - global->memory_allocated = sizeof(struct myddas_global) + sizeof(struct myddas_global_stats); + global->memory_allocated = + sizeof(struct myddas_global) + sizeof(struct myddas_global_stats); #else global->malloc_called = 1; global->memory_allocated = sizeof(struct myddas_global); @@ -50,34 +52,32 @@ myddas_init_initialize_myddas(void){ /* Inserts the new node on the front of the list */ MYDDAS_UTIL_CONNECTION -myddas_init_initialize_connection(void *conn,void *enviromment, - MYDDAS_API api, - MYDDAS_UTIL_CONNECTION next){ +myddas_init_initialize_connection(void *conn, void *enviromment, MYDDAS_API api, + MYDDAS_UTIL_CONNECTION next) { CACHE_REGS MYDDAS_UTIL_CONNECTION new = NULL; - MYDDAS_MALLOC(new,struct myddas_list_connection); + MYDDAS_MALLOC(new, struct myddas_list_connection); - if (new == NULL) - { - return NULL; - } + if (new == NULL) { + return NULL; + } new->api = api; - new->predicates=NULL; - new->connection=conn; - new->odbc_enviromment=enviromment; + new->predicates = NULL; + new->connection = conn; + new->odbc_enviromment = enviromment; /* It saves n queries, doing at once n+1 queries */ - new->total_number_queries=0; //Default - new->actual_number_queries=0; + new->total_number_queries = 0; // Default + new->actual_number_queries = 0; new->queries = NULL; /* List integrity */ - new->next=next; - new->previous=NULL; + new->next = next; + new->previous = NULL; /* If there's already at least one node on the list */ if (next != NULL) - next->previous=new; + next->previous = new; #ifdef MYDDAS_STATS new->stats = NULL; @@ -88,26 +88,26 @@ myddas_init_initialize_connection(void *conn,void *enviromment, MYDDAS_UTIL_PREDICATE myddas_init_initialize_predicate(const char *pred_name, int pred_arity, - const char *pred_module, MYDDAS_UTIL_PREDICATE next){ + const char *pred_module, + MYDDAS_UTIL_PREDICATE next) { CACHE_REGS MYDDAS_UTIL_PREDICATE new = NULL; - MYDDAS_MALLOC(new,struct myddas_list_preds); + MYDDAS_MALLOC(new, struct myddas_list_preds); - if (new == NULL) - { - return NULL; - } - new->pred_name=pred_name; - new->pred_arity=pred_arity; - new->pred_module=pred_module; + if (new == NULL) { + return NULL; + } + new->pred_name = pred_name; + new->pred_arity = pred_arity; + new->pred_module = pred_module; /* List integrity */ - new->next=next; - new->previous=NULL; + new->next = next; + new->previous = NULL; /* If there's already at least one node on the list */ if (next != NULL) - next->previous=new; + next->previous = new; return new; } diff --git a/packages/myddas/myddas_shared.c b/packages/myddas/myddas_shared.c index 60805836f..759fbcb76 100644 --- a/packages/myddas/myddas_shared.c +++ b/packages/myddas/myddas_shared.c @@ -706,9 +706,6 @@ void init_myddas(void) { CACHE_REGS -#if defined MYDDAS_MYSQL - Yap_InitBackMYDDAS_MySQLPreds(); -#endif #if defined MYDDAS_ODBC Yap_InitBackMYDDAS_ODBCPreds(); #endif @@ -733,21 +730,6 @@ init_myddas(void) #if defined MYDDAS_TOP_LEVEL && defined MYDDAS_MYSQL // && defined HAVE_LIBREADLINE Yap_InitMYDDAS_TopLevelPreds(); #endif -#ifdef MYDDAS_MYSQL_INIT - if (yap_init->myddas) { - Yap_PutValue(AtomMyddasGoal,MkIntegerTerm(yap_init->myddas)); - - /* Mandatory Fields */ - Yap_PutValue(AtomMyddasUser,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_user))); - Yap_PutValue(AtomMyddasDB,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_db))); - - /* Non-Mandatory Fields */ - if (yap_init->myddas_pass != NULL) - Yap_PutValue(AtomMyddasPass,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_pass))); - if (yap_init->myddas_host != NULL) - Yap_PutValue(AtomMyddasHost,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_host))); - } -#endif #if USE_MYDDAS #define stringify(X) _stringify(X) #define _stringify(X) #X diff --git a/packages/myddas/myddas_util.c b/packages/myddas/myddas_util.c index dca06f78e..eeac54726 100644 --- a/packages/myddas/myddas_util.c +++ b/packages/myddas/myddas_util.c @@ -12,374 +12,265 @@ #include #endif /*MYDDAS_MYSQL*/ +#include "myddas.h" #include "myddas_util.h" - -#ifdef MYDDAS_MYSQL -/* Auxilary function to table_write*/ -static void -n_print(Int , char ); -#endif - /* Type: MYSQL->1 ODBC->2*/ -Short -myddas_util_connection_type(void *con){ - - MYDDAS_UTIL_CONNECTION con_node = - myddas_util_search_connection(con); - +Short myddas_util_connection_type(void *con) { + + MYDDAS_UTIL_CONNECTION con_node = myddas_util_search_connection(con); + if (con_node == NULL) return 0; return con_node->api; - // if (con_node->odbc_enviromment != NULL) /* ODBC */ + // if (con_node->odbc_enviromment != NULL) /* ODBC */ // return 2; - //else + // else // return 1; } - MYDDAS_UTIL_PREDICATE myddas_util_search_predicate(const char *pred_name, Int pred_arity, - const char *pred_module){ + const char *pred_module) { CACHE_REGS - MYDDAS_UTIL_PREDICATE pred=NULL; - MYDDAS_UTIL_CONNECTION top = Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; + MYDDAS_UTIL_PREDICATE pred = NULL; + MYDDAS_UTIL_CONNECTION top = + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; - for (;top!=NULL;top=top->next) - { - if ((pred=myddas_util_find_predicate(pred_name,pred_arity,pred_module,top->predicates))) - return pred; - } + for (; top != NULL; top = top->next) { + if ((pred = myddas_util_find_predicate(pred_name, pred_arity, pred_module, + top->predicates))) + return pred; + } return NULL; } /* When using this function, we must guarante that this predicate it's unique */ -MYDDAS_UTIL_CONNECTION +MYDDAS_UTIL_CONNECTION myddas_util_add_predicate(const char *pred_name, Int pred_arity, - const char *pred_module, void *con){ - - MYDDAS_UTIL_CONNECTION node_con = - myddas_util_search_connection(con); - - MYDDAS_UTIL_PREDICATE new = - myddas_init_initialize_predicate(pred_name,pred_arity,pred_module,node_con->predicates); - - if (new == NULL) - { - myddas_util_error_message("Could not initialize predicate node",__LINE__,__FILE__); - return NULL; - } - - node_con->predicates=new; - return node_con; -} + const char *pred_module, void *con) { -void -myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE to_delete){ + MYDDAS_UTIL_CONNECTION node_con = myddas_util_search_connection(con); + + MYDDAS_UTIL_PREDICATE new = myddas_init_initialize_predicate( + pred_name, pred_arity, pred_module, node_con->predicates); + + if (new == NULL) { + myddas_util_error_message("Could not initialize predicate node", __LINE__, + __FILE__); + return NULL; + } + + node_con->predicates = new; + return node_con; +} + +void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE to_delete) { CACHE_REGS if (to_delete->next != NULL) to_delete->next->previous = to_delete->previous; if (to_delete->previous != NULL) to_delete->previous->next = to_delete->next; - else //First predicate of the predicate list - { - MYDDAS_UTIL_CONNECTION con_node = Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; - for(;con_node != NULL; con_node = con_node->next) - if (con_node->predicates == to_delete) - break; - con_node->predicates = to_delete->next; - } - MYDDAS_FREE(to_delete,struct myddas_list_preds); + else // First predicate of the predicate list + { + MYDDAS_UTIL_CONNECTION con_node = + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; + for (; con_node != NULL; con_node = con_node->next) + if (con_node->predicates == to_delete) + break; + con_node->predicates = to_delete->next; + } + MYDDAS_FREE(to_delete, struct myddas_list_preds); } -void -myddas_util_delete_connection(void *conn){ +void myddas_util_delete_connection(void *conn) { CACHE_REGS MYDDAS_UTIL_CONNECTION to_delete = myddas_util_search_connection(conn); - - if (to_delete == NULL) + + if (to_delete == NULL) return; - else - { - /* Removes the predicates list */ - myddas_util_delete_predicate_list(to_delete->predicates); - + else { + /* Removes the predicates list */ + myddas_util_delete_predicate_list(to_delete->predicates); + #ifdef MYDDAS_STATS - /* Removes the stats list */ - myddas_stats_delete_stats_list(to_delete->stats); + /* Removes the stats list */ + myddas_stats_delete_stats_list(to_delete->stats); #endif - /* List Integrety */ - /* Is the last element of the list */ - if ((to_delete->next) != NULL) - to_delete->next->previous = to_delete->previous; - - /* Is the first element of the list */ - if (to_delete == (Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections)) - Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections = to_delete->next; - else - to_delete->previous->next=to_delete->next; - - MYDDAS_FREE(to_delete,struct myddas_list_connection); - return; - } + /* List Integrety */ + /* Is the last element of the list */ + if ((to_delete->next) != NULL) + to_delete->next->previous = to_delete->previous; + + /* Is the first element of the list */ + if (to_delete == (Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections)) + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections = to_delete->next; + else + to_delete->previous->next = to_delete->next; + + MYDDAS_FREE(to_delete, struct myddas_list_connection); + return; + } } -MYDDAS_UTIL_CONNECTION -myddas_util_search_connection(void *conn){ +MYDDAS_UTIL_CONNECTION +myddas_util_search_connection(void *conn) { CACHE_REGS - MYDDAS_UTIL_CONNECTION list = Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; - + MYDDAS_UTIL_CONNECTION list = + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; + #ifdef MYDDAS_STATS if (conn == 0) { /* We want all the statistics */ return list; } #endif - - for (;list!=NULL;list=list->next) + + for (; list != NULL; list = list->next) if (list->connection == conn) return list; return NULL; } - -MYDDAS_UTIL_CONNECTION -myddas_util_add_connection(void *conn, void *enviromment, MYDDAS_API api){ - CACHE_REGS - MYDDAS_UTIL_CONNECTION node=NULL; - MYDDAS_UTIL_CONNECTION temp=NULL; - if ((node = myddas_util_search_connection(conn)) != NULL) - { - return node; - } - //put the new connection node on the top of the list - temp = myddas_init_initialize_connection(conn,enviromment,api,Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections); - if (temp == NULL) - { +MYDDAS_UTIL_CONNECTION +myddas_util_add_connection(void *conn, void *enviromment, MYDDAS_API api) { + CACHE_REGS + MYDDAS_UTIL_CONNECTION node = NULL; + MYDDAS_UTIL_CONNECTION temp = NULL; + + if ((node = myddas_util_search_connection(conn)) != NULL) { + return node; + } + // put the new connection node on the top of the list + temp = myddas_init_initialize_connection( + conn, enviromment, api, + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections); + if (temp == NULL) { #ifdef DEBUG - myddas_util_error_message("Could not initialize connection node",__LINE__,__FILE__); -#endif - return NULL; - } + myddas_util_error_message("Could not initialize connection node", __LINE__, + __FILE__); +#endif + return NULL; + } Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections = temp; return Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; } -#ifdef MYDDAS_ODBC -/* This function searches the MYDDAS list for odbc connections - If there isn't any, it returns NULL. This is a nice way to know - if there is any odbc connections left on the list*/ -SQLHENV -myddas_util_get_odbc_enviromment(SQLHDBC connection){ - CACHE_REGS - MYDDAS_UTIL_CONNECTION top = Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; - - for (;top != NULL;top=top->next) - if (top->connection == ((void *)connection)) - return top->odbc_enviromment; - - return NULL; -} -#endif - -UInt -myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con){ +UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con) { return con->total_number_queries; } -void -myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con, - UInt number){ +void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con, + UInt number) { con->total_number_queries = number; } #ifdef MYDDAS_MYSQL /* Auxilary function to table_write*/ -static void -n_print(Int n, char c) -{ - for(;n>0;n--) printf("%c",c); +static void n_print(Int n, char c) { + for (; n > 0; n--) + printf("%c", c); } #endif -void myddas_util_error_message(char *message ,Int line,char *file){ +void myddas_util_error_message(char *message, Int line, char *file) { #ifdef DEBUG - printf ("ERROR: %s at line %d in file %s\n",message,(int)line,file); + printf("ERROR: %s at line %d in file %s\n", message, (int)line, file); #else - printf ("ERROR: %s\n",message); + printf("ERROR: %s\n", message); #endif } MYDDAS_UTIL_PREDICATE myddas_util_find_predicate(const char *pred_name, Int pred_arity, - const char *pred_module, MYDDAS_UTIL_PREDICATE list){ + const char *pred_module, + MYDDAS_UTIL_PREDICATE list) { - for(;list != NULL ; list = list->next) - if (pred_arity == list->pred_arity && - !strcmp(pred_name,list->pred_name) && - !strcmp(pred_module,list->pred_module)) + for (; list != NULL; list = list->next) + if (pred_arity == list->pred_arity && !strcmp(pred_name, list->pred_name) && + !strcmp(pred_module, list->pred_module)) return list; - + return NULL; } -void -myddas_util_delete_predicate_list(MYDDAS_UTIL_PREDICATE preds_list){ +void myddas_util_delete_predicate_list(MYDDAS_UTIL_PREDICATE preds_list) { CACHE_REGS MYDDAS_UTIL_PREDICATE to_delete = NULL; - - for (;preds_list != NULL;) - { - to_delete = preds_list; - preds_list = preds_list->next; - MYDDAS_FREE(to_delete,struct myddas_list_preds); - } + for (; preds_list != NULL;) { + to_delete = preds_list; + preds_list = preds_list->next; + + MYDDAS_FREE(to_delete, struct myddas_list_preds); + } return; } -#ifdef MYDDAS_MYSQL -void -myddas_util_table_write(MYSQL_RES *res_set){ - - MYSQL_ROW row; - MYSQL_FIELD *fields; - Int i,f; - - if (mysql_num_rows(res_set) == 0) - { - printf ("Empty Set\n"); - return; - } - - f = mysql_num_fields(res_set); - - fields = mysql_fetch_field(res_set); - for(i=0;ifields[i].max_length) fields[i].max_length=strlen(fields[i].name); - n_print(fields[i].max_length+2,'-'); - } - printf("+\n"); - - for(i=0;imyddas_top_connections; } -void * -myddas_util_get_pred_next(void *pointer){ - MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; - return (void *) (temp->next); +void *myddas_util_get_pred_next(void *pointer) { + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE)pointer; + return (void *)(temp->next); } -MyddasInt -myddas_util_get_pred_arity(void *pointer){ - MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; +MyddasInt myddas_util_get_pred_arity(void *pointer) { + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE)pointer; return temp->pred_arity; } -const char * -myddas_util_get_pred_name(void *pointer){ - MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; +const char *myddas_util_get_pred_name(void *pointer) { + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE)pointer; return temp->pred_name; } -const char * -myddas_util_get_pred_module(void *pointer){ - MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; +const char *myddas_util_get_pred_module(void *pointer) { + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE)pointer; return temp->pred_module; } -void * -myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION node){ +void *myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION node) { return (void *)(node->predicates); } #ifdef DEBUG -void check_int( void ){ +void check_int(void) { CACHE_REGS MYDDAS_UTIL_PREDICATE pred = NULL; - MYDDAS_UTIL_CONNECTION top = Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; - for ( ; top!=NULL ; top=top->next) - { - printf ("***************\n"); - printf ("===== top =====\n"); - printf ("======= %p =====\n",top); - printf ("CONN: = %p =====\n",top->connection); - printf ("ENV : = %p =====\n",top->odbc_enviromment); - printf ("PRED: = %p =====\n",top->predicates); - printf ("======= %p =====\n",top->previous); - printf ("======= %p =====\n",top->next); - if (top->predicates != NULL) - { - printf ("\t******\n"); - printf ("\t===== PREDICATES =====\n"); - for (pred = top->predicates ; pred != NULL ; pred = pred->next) - { - printf ("\t--------------\n"); - printf ("\t===== %p =====\n",pred); - printf ("\t===== %s =====\n",pred->pred_name); - printf ("\t===== %d =====\n",pred->pred_arity); - printf ("\t===== %s =====\n",pred->pred_module); - printf ("\t===== %p =====\n",pred->previous); - printf ("\t===== %p =====\n",pred->next); - } - } - + MYDDAS_UTIL_CONNECTION top = + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; + for (; top != NULL; top = top->next) { + printf("***************\n"); + printf("===== top =====\n"); + printf("======= %p =====\n", top); + printf("CONN: = %p =====\n", top->connection); + printf("ENV : = %p =====\n", top->odbc_enviromment); + printf("PRED: = %p =====\n", top->predicates); + printf("======= %p =====\n", top->previous); + printf("======= %p =====\n", top->next); + if (top->predicates != NULL) { + printf("\t******\n"); + printf("\t===== PREDICATES =====\n"); + for (pred = top->predicates; pred != NULL; pred = pred->next) { + printf("\t--------------\n"); + printf("\t===== %p =====\n", pred); + printf("\t===== %s =====\n", pred->pred_name); + printf("\t===== %d =====\n", pred->pred_arity); + printf("\t===== %s =====\n", pred->pred_module); + printf("\t===== %p =====\n", pred->previous); + printf("\t===== %p =====\n", pred->next); + } } - + } + return; } #endif diff --git a/packages/myddas/myddas_util.h b/packages/myddas/myddas_util.h index d75adea43..3a0fdb617 100644 --- a/packages/myddas/myddas_util.h +++ b/packages/myddas/myddas_util.h @@ -1,32 +1,14 @@ #include "myddas_structs.h" -void myddas_util_error_message(char *message ,Int line,char *file); +void myddas_util_error_message(char *message, Int line, char *file); -/* Search for the predicate in the given predicate list*/ -MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *conn); +UInt myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con); -MYDDAS_UTIL_CONNECTION -myddas_init_initialize_connection(void *conn,void *enviromment, - MYDDAS_API api, - MYDDAS_UTIL_CONNECTION next); +void myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con, + UInt number); -MYDDAS_UTIL_CONNECTION -myddas_util_add_connection(void *conn, void *enviromment, MYDDAS_API api); - -MYDDAS_UTIL_PREDICATE -myddas_init_initialize_predicate(const char *pred_name, int pred_arity, - const char *pred_module, MYDDAS_UTIL_PREDICATE next); - -MYDDAS_UTIL_PREDICATE -myddas_util_find_predicate(const char *pred_name, Int pred_arity, - const char *pred_module, MYDDAS_UTIL_PREDICATE list); - -UInt -myddas_util_get_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con); - -void -myddas_util_set_total_multi_queries_number(MYDDAS_UTIL_CONNECTION con, UInt number); +//void myddas_util_table_write(MYSQL_RES *res_set); void *myddas_util_get_pred_next(void *pointer); @@ -34,8 +16,30 @@ MyddasInt myddas_util_get_pred_arity(void *pointer); const char *myddas_util_get_pred_name(void *pointer); +void myddas_util_delete_predicate(MYDDAS_UTIL_PREDICATE to_delete); + const char *myddas_util_get_pred_module(void *pointer); void *myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION node); void myddas_util_delete_predicate_list(MYDDAS_UTIL_PREDICATE preds_list); + +MYDDAS_UTIL_CONNECTION myddas_util_search_connection(void *con); + +MYDDAS_UTIL_PREDICATE myddas_util_find_predicate(const char *pred_name, + Int pred_arity, + const char *pred_module, + MYDDAS_UTIL_PREDICATE list); + +MYDDAS_UTIL_CONNECTION myddas_util_add_connection(void *conn, void *enviromment, + MYDDAS_API api); +void myddas_util_delete_connection(void *conn); + +MYDDAS_UTIL_PREDICATE +myddas_init_initialize_predicate(const char *pred_name, int pred_arity, + const char *pred_module, + MYDDAS_UTIL_PREDICATE next); + +MYDDAS_UTIL_CONNECTION +myddas_init_initialize_connection(void *conn, void *enviromment, MYDDAS_API api, + MYDDAS_UTIL_CONNECTION next); diff --git a/packages/myddas/myddas_util_connection.c b/packages/myddas/myddas_util_connection.c index 90e4564f2..41c65af6f 100644 --- a/packages/myddas/myddas_util_connection.c +++ b/packages/myddas/myddas_util_connection.c @@ -1,6 +1,21 @@ -#include +p#include #include #include "Yap.h" #include "cut_c.h" +MYDDAS_UTIL_CONNECTION +myddas_init_initialize_connection(void *conn, void *enviromment, MYDDAS_API api, + MYDDAS_UTIL_CONNECTION next); + +MYDDAS_UTIL_CONNECTION +myddas_util_add_connection(void *conn, void *enviromment, MYDDAS_API api); + +MYDDAS_UTIL_PREDICATE +myddas_init_initialize_predicate(const char *pred_name, int pred_arity, + const char *pred_module, + MYDDAS_UTIL_PREDICATE next); + +MYDDAS_UTIL_PREDICATE +myddas_util_find_predicate(const char *pred_name, Int pred_arity, + const char *pred_module, MYDDAS_UTIL_PREDICATE list); diff --git a/packages/myddas/myddas_wkb.h b/packages/myddas/myddas_wkb.h deleted file mode 100644 index 3ecfa04f3..000000000 --- a/packages/myddas/myddas_wkb.h +++ /dev/null @@ -1,25 +0,0 @@ -#ifndef MYDDAS_WKB_H_ -#define MYDDAS_WKB_H_ - -typedef char byte; - -typedef unsigned int uint32; - -#define WKBXDR 0 -#define WKBNDR 1 - -#define WKBMINTYPE 1 - -#define WKBPOINT 1 -#define WKBLINESTRING 2 -#define WKBPOLYGON 3 -#define WKBMULTIPOINT 4 -#define WKBMULTILINESTRING 5 -#define WKBMULTIPOLYGON 6 -#define WKBGEOMETRYCOLLECTION 7 - -#define WKBMAXTYPE 7 - -#define WKBGEOMETRY 0 - -#endif /* MYDDAS_WKB_H_ */ diff --git a/packages/myddas/myddas_wkb2prolog.c b/packages/myddas/myddas_wkb2prolog.c deleted file mode 100644 index 44af8ae3a..000000000 --- a/packages/myddas/myddas_wkb2prolog.c +++ /dev/null @@ -1,382 +0,0 @@ -#if defined MYDDAS_MYSQL - -#include -#include -#include "Yap.h" -#include -#include "myddas_wkb.h" -#include "myddas_wkb2prolog.h" - -static void readswap4(uint32 *buf); -static void readswap8(double *buf); - -static byte get_hostbyteorder(void); -static byte get_inbyteorder(void); -static uint32 get_wkbType(void); -static Term get_point(char *functor USES_REGS); -static Term get_linestring(char *functor); -static Term get_polygon(char *functor); -static Term get_geometry(uint32 type); - -static int swaporder; -static byte inbyteorder, hostbyteorder; -static byte *cursor; - -Term wkb2prolog(char *wkb) { - uint32 type; - - cursor = wkb; - - /*ignore the SRID 4 bytes*/ - cursor += 4; - - /*byteorder*/ - hostbyteorder = get_hostbyteorder(); - inbyteorder = get_inbyteorder(); - - swaporder = 0; - if ( hostbyteorder != inbyteorder ) - swaporder = 1; - - type = get_wkbType(); - - return get_geometry(type); -} - -static byte get_hostbyteorder(void){ - uint16_t host = 5; - uint16_t net; - - net = htons(host); - if ( net == host ) - return(WKBXDR); - else - return(WKBNDR); -} - -static byte get_inbyteorder(void){ - byte b = cursor[0]; - - if (b != WKBNDR && b != WKBXDR) { - fprintf(stderr, "Unknown byteorder: %d\n",b); - exit(0); - } - - cursor++; - - return(b); -} - -static uint32 get_wkbType(void){ - uint32 u; - - /* read the type */ - readswap4(&u); - - if (u > WKBMAXTYPE || u < WKBMINTYPE) { - fprintf(stderr, "Unknown type: %d\n",u); - exit(0); - } - - return(u); -} - -static void readswap4(uint32 *buf){ - ((byte *) buf)[0] = cursor[0]; - ((byte *) buf)[1] = cursor[1]; - ((byte *) buf)[2] = cursor[2]; - ((byte *) buf)[3] = cursor[3]; - - if ( swaporder ) { - if ( inbyteorder == WKBXDR ) { - *buf = (uint32)ntohl((u_long)*buf); - } else { - byte u[4]; - - u[0] = ((byte *) buf)[3]; - u[1] = ((byte *) buf)[2]; - u[2] = ((byte *) buf)[1]; - u[3] = ((byte *) buf)[0]; - ((byte *) buf)[0] = u[0]; - ((byte *) buf)[1] = u[1]; - ((byte *) buf)[2] = u[2]; - ((byte *) buf)[3] = u[3]; - } - } - - cursor += 4; -} - -static void readswap8(double *buf) { - ((byte *) buf)[0] = cursor[0]; - ((byte *) buf)[1] = cursor[1]; - ((byte *) buf)[2] = cursor[2]; - ((byte *) buf)[3] = cursor[3]; - ((byte *) buf)[4] = cursor[4]; - ((byte *) buf)[5] = cursor[5]; - ((byte *) buf)[6] = cursor[6]; - ((byte *) buf)[7] = cursor[7]; - - if ( swaporder ) { - if ( inbyteorder == WKBXDR ) { - u_long u[2]; - - u[0] = ((u_long *) buf)[0]; - u[1] = ((u_long *) buf)[1]; - ((u_long *) buf)[1] = ntohl(u[0]); - ((u_long *) buf)[0] = ntohl(u[1]); - } else { - byte u[8]; - - u[0] = ((byte *) buf)[7]; - u[1] = ((byte *) buf)[6]; - u[2] = ((byte *) buf)[5]; - u[3] = ((byte *) buf)[4]; - u[4] = ((byte *) buf)[3]; - u[5] = ((byte *) buf)[2]; - u[6] = ((byte *) buf)[1]; - u[7] = ((byte *) buf)[0]; - ((byte *) buf)[0] = u[0]; - ((byte *) buf)[1] = u[1]; - ((byte *) buf)[2] = u[2]; - ((byte *) buf)[3] = u[3]; - ((byte *) buf)[4] = u[4]; - ((byte *) buf)[5] = u[5]; - ((byte *) buf)[6] = u[6]; - ((byte *) buf)[7] = u[7]; - } - } - - cursor += 8; -} - -static Term get_point(char *func USES_REGS){ - Term args[2]; - Functor functor; - double d; - - if(func == NULL) - /*functor "," => (_,_)*/ - functor = Yap_MkFunctor(Yap_LookupAtom(","), 2); - else - functor = Yap_MkFunctor(Yap_LookupAtom(func), 2); - - /* read the X */ - readswap8(&d); - args[0] = MkFloatTerm(d); - - /* read the Y */ - readswap8(&d); - args[1] = MkFloatTerm(d); - - return Yap_MkApplTerm(functor, 2, args); -} - -static Term get_linestring(char *func){ - CACHE_REGS - - Term *c_list; - Term list; - Functor functor; - uint32 n; - int i; - - /* read the number of vertices */ - readswap4(&n); - - /* space for arguments */ - c_list = (Term *) calloc(sizeof(Term),n); - - for ( i = 0; i < n; i++) { - c_list[i] = get_point(NULL PASS_REGS); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = n - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - if(func == NULL) - return list; - else{ - functor = Yap_MkFunctor(Yap_LookupAtom(func), 1); - return Yap_MkApplTerm(functor, 1, &list); - } -} - -static Term get_polygon(char *func){ - CACHE_REGS - - uint32 r; - int i; - Functor functor; - Term *c_list; - Term list; - - /* read the number of rings */ - readswap4(&r); - - /* space for rings */ - c_list = (Term *) calloc(sizeof(Term),r); - - for ( i = 0; i < r; i++ ) { - c_list[i] = get_linestring(NULL); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = r - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - if(func == NULL) - return list; - else{ - functor = Yap_MkFunctor(Yap_LookupAtom("polygon"), 1); - return Yap_MkApplTerm(functor, 1, &list); - } -} - -static Term get_geometry(uint32 type){ - CACHE_REGS - - switch(type) { - case WKBPOINT: - return get_point("point" PASS_REGS); - case WKBLINESTRING: - return get_linestring("linestring"); - case WKBPOLYGON: - return get_polygon("polygon"); - case WKBMULTIPOINT: - { - uint32 n; - int i; - Functor functor; - Term *c_list; - Term list; - - - /* read the number of points */ - readswap4(&n); - - /* space for points */ - c_list = (Term *) calloc(sizeof(Term),n); - - for ( i = 0; i < n; i++ ) { - /* read (and ignore) the byteorder and type */ - get_inbyteorder(); - get_wkbType(); - - c_list[i] = get_point(NULL PASS_REGS); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = n - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - functor = Yap_MkFunctor(Yap_LookupAtom("multipoint"), 1); - - return Yap_MkApplTerm(functor, 1, &list); - - } - case WKBMULTILINESTRING: - { - uint32 n; - int i; - Functor functor; - Term *c_list; - Term list; - - - /* read the number of polygons */ - readswap4(&n); - - /* space for polygons*/ - c_list = (Term *) calloc(sizeof(Term),n); - - for ( i = 0; i < n; i++ ) { - /* read (and ignore) the byteorder and type */ - get_inbyteorder(); - get_wkbType(); - - c_list[i] = get_linestring(NULL); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = n - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - functor = Yap_MkFunctor(Yap_LookupAtom("multilinestring"), 1); - - return Yap_MkApplTerm(functor, 1, &list); - - } - case WKBMULTIPOLYGON: - { - uint32 n; - int i; - Functor functor; - Term *c_list; - Term list; - - - /* read the number of polygons */ - readswap4(&n); - - /* space for polygons*/ - c_list = (Term *) calloc(sizeof(Term),n); - - for ( i = 0; i < n; i++ ) { - /* read (and ignore) the byteorder and type */ - get_inbyteorder(); - get_wkbType(); - - c_list[i] = get_polygon(NULL); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = n - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - functor = Yap_MkFunctor(Yap_LookupAtom("multipolygon"), 1); - - return Yap_MkApplTerm(functor, 1, &list); - - } - case WKBGEOMETRYCOLLECTION: - { - uint32 n; - int i; - Functor functor; - Term *c_list; - Term list; - - /* read the number of geometries */ - readswap4(&n); - - /* space for geometries*/ - c_list = (Term *) calloc(sizeof(Term),n); - - - for ( i = 0; i < n; i++ ) { - get_inbyteorder(); - c_list[i] = get_geometry(get_wkbType()); - } - - list = MkAtomTerm(Yap_LookupAtom("[]")); - for (i = n - 1; i >= 0; i--) { - list = MkPairTerm(c_list[i],list); - } - - functor = Yap_MkFunctor(Yap_LookupAtom("geometrycollection"), 1); - - return Yap_MkApplTerm(functor, 1, &list); - } - } - - return MkAtomTerm(Yap_LookupAtom("[]")); -} - -#endif /*MYDDAS_MYSQL*/ diff --git a/packages/myddas/myddas_wkb2prolog.h b/packages/myddas/myddas_wkb2prolog.h deleted file mode 100644 index b6a399085..000000000 --- a/packages/myddas/myddas_wkb2prolog.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef MYDDAS_WKB2PROLOG_H_ -# define MYDDAS_WKB2PROLOG_H_ - -Term wkb2prolog(char *wkb) ; - -#endif /* !MYDDAS_WKB2PROLOG_H_ */ diff --git a/packages/myddas/mysql/CMakeLists.txt b/packages/myddas/mysql/CMakeLists.txt index 465bd3fda..b0df2d85d 100644 --- a/packages/myddas/mysql/CMakeLists.txt +++ b/packages/myddas/mysql/CMakeLists.txt @@ -1,7 +1,10 @@ set( YAPMYSQL_SOURCES myddas_mysql.c -) + myddas_util.c + myddas_util.c + myddas_wkb2prolog.c + ) set(SO_MAJOR 1) set(SO_MINOR 0) @@ -19,12 +22,8 @@ macro_log_feature (MYSQL_FOUND "MySQL" # MYSQL_FOUND - True if MySQL found. add_definitions (-DMYDDAS_MYSQL=1) add_library (Yapmysql SHARED ${YAPMYSQL_SOURCES}) -target_link_libraries(Yapmysql myddas libYap) +target_link_libraries(Yapmysql ${MYSQL_LIBRARIES} libYap) include_directories (${MYSQL_INCLUDE_DIR} ..) -else() - add_definitions (-DMYDDAS_MYSQL=0) - endif (MYSQL_FOUND) - set_target_properties (Yapmysql PROPERTIES POSITION_INDEPENDENT_CODE ON VERSION "${SO_MAJOR}.${SO_MINOR}.${SO_PATCH}" @@ -36,6 +35,10 @@ set_target_properties (Yapmysql PROPERTIES LIBRARY DESTINATION ${libdir} ) +else() + add_definitions (-DMYDDAS_MYSQL=0) + endif (MYSQL_FOUND) + cmake_dependent_option (USE_MYDDAS_top_level "enable the MYDDAS top-level (REPL) support for MySQL" OFF 'USE_MYDDAS AND MYSQL_FOUND' OFF) diff --git a/packages/myddas/mysql/myddas_mysql.c b/packages/myddas/mysql/myddas_mysql.c index 72884db5d..136f9ef8a 100644 --- a/packages/myddas/mysql/myddas_mysql.c +++ b/packages/myddas/mysql/myddas_mysql.c @@ -25,6 +25,7 @@ #include "Yatom.h" #include "cut_c.h" #include "myddas_structs.h" +#include "myddas_util.h" #ifdef MYDDAS_STATS #include "myddas_statistics.h" #endif diff --git a/packages/myddas/mysql/myddas_util.c b/packages/myddas/mysql/myddas_util.c index 4145e2a01..95b40312e 100644 --- a/packages/myddas/mysql/myddas_util.c +++ b/packages/myddas/mysql/myddas_util.c @@ -15,87 +15,75 @@ * * *************************************************************************/ +#include "Yap.h" #include #include #include +#include + +#ifdef MYDDAS_MYSQL +/* Auxilary function to table_write*/ +static void n_print(Int, char); +#endif /* Auxilary function to table_write*/ -static void -n_print(Int , char ); - -/* Auxilary function to table_write*/ -static void -n_print(Int n, char c) -{ - for(;n>0;n--) printf("%c",c); +static void n_print(Int n, char c) { + for (; n > 0; n--) + printf("%c", c); } -void -myddas_util_table_write(MYSQL_RES *res_set){ - +void myddas_util_table_write(MYSQL_RES *res_set) { + MYSQL_ROW row; MYSQL_FIELD *fields; - Int i,f; + Int i, f; - if (mysql_num_rows(res_set) == 0) - { - printf ("Empty Set\n"); - return; - } + if (mysql_num_rows(res_set) == 0) { + printf("Empty Set\n"); + return; + } f = mysql_num_fields(res_set); fields = mysql_fetch_field(res_set); - for(i=0;ifields[i].max_length) fields[i].max_length=strlen(fields[i].name); - n_print(fields[i].max_length+2,'-'); + if (strlen(fields[i].name) > fields[i].max_length) + fields[i].max_length = strlen(fields[i].name); + n_print(fields[i].max_length + 2, '-'); } printf("+\n"); - - for(i=0;i #include #include #include "Yap.h" #include "Yatom.h" #include "myddas.h" +#include "../myddas_util.h" #include "cut_c.h" #include #include +/* Return enviromment identifier*/ +SQLHENV myddas_util_get_odbc_enviromment(SQLHDBC); + static Int null_id = 0; -static Int c_db_odbc_connect( USES_REGS1 ); -static Int c_db_odbc_disconnect( USES_REGS1 ); -static Int c_db_odbc_number_of_fields( USES_REGS1 ); -static Int c_db_odbc_get_attributes_types( USES_REGS1 ); -static Int c_db_odbc_query( USES_REGS1 ); -static Int c_db_odbc_row( USES_REGS1 ); -static Int c_db_odbc_row_cut( USES_REGS1 ); -static Int c_db_odbc_get_fields_properties( USES_REGS1 ); -static Int c_db_odbc_number_of_fields_in_query( USES_REGS1 ); +static Int c_db_odbc_connect(USES_REGS1); +static Int c_db_odbc_disconnect(USES_REGS1); +static Int c_db_odbc_number_of_fields(USES_REGS1); +static Int c_db_odbc_get_attributes_types(USES_REGS1); +static Int c_db_odbc_query(USES_REGS1); +static Int c_db_odbc_row(USES_REGS1); +static Int c_db_odbc_row_cut(USES_REGS1); +static Int c_db_odbc_get_fields_properties(USES_REGS1); +static Int c_db_odbc_number_of_fields_in_query(USES_REGS1); -static int -odbc_error(SQLSMALLINT type, SQLHANDLE hdbc, char *msg, char *print) -{ - SQLCHAR SqlState[6], Msg[SQL_MAX_MESSAGE_LENGTH]; - SQLINTEGER NativeError; - SQLSMALLINT i=1, MsgLen; +static int odbc_error(SQLSMALLINT type, SQLHANDLE hdbc, char *msg, + char *print) { + SQLCHAR SqlState[6], Msg[SQL_MAX_MESSAGE_LENGTH]; + SQLINTEGER NativeError; + SQLSMALLINT i = 1, MsgLen; - SQLGetDiagRec(type, hdbc,i,SqlState,&NativeError,Msg, sizeof(Msg), &MsgLen); - fprintf(stderr,"%% error in SQLConnect: %s got error code %s\n%% SQL Message: %s\n", print, SqlState, Msg); - return FALSE; + SQLGetDiagRec(type, hdbc, i, SqlState, &NativeError, Msg, sizeof(Msg), + &MsgLen); + fprintf(stderr, + "%% error in SQLConnect: %s got error code %s\n%% SQL Message: %s\n", + print, SqlState, Msg); + return FALSE; } -static int -SQLALLOCHANDLE(SQLSMALLINT HandleType, SQLHANDLE hdbc, SQLHANDLE *outHandle, char *print) -{ - SQLRETURN retcode; +static int SQLALLOCHANDLE(SQLSMALLINT HandleType, SQLHANDLE hdbc, + SQLHANDLE *outHandle, char *print) { + SQLRETURN retcode; - retcode = SQLAllocHandle(HandleType,hdbc,outHandle); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - { - return odbc_error(HandleType, hdbc, "SQLAllocHandle(ENV)", print); - } + retcode = SQLAllocHandle(HandleType, hdbc, outHandle); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) { + return odbc_error(HandleType, hdbc, "SQLAllocHandle(ENV)", print); + } return TRUE; } -static int -SQLSETENVATTR(SQLHENV henv, SQLINTEGER att, SQLPOINTER p, SQLINTEGER len, char *print) -{ - SQLRETURN retcode; +static int SQLSETENVATTR(SQLHENV henv, SQLINTEGER att, SQLPOINTER p, + SQLINTEGER len, char *print) { + SQLRETURN retcode; - retcode = SQLSetEnvAttr(henv,att,p,len); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - { - return odbc_error(SQL_HANDLE_ENV, henv, "SQLSetEnvAttr", print); - } + retcode = SQLSetEnvAttr(henv, att, p, len); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) { + return odbc_error(SQL_HANDLE_ENV, henv, "SQLSetEnvAttr", print); + } return TRUE; } -static int SQLCONNECT(SQLHDBC hdbc, - SQLCHAR *driver, - SQLCHAR *user, - SQLCHAR *password, - char *print) -{ - SQLRETURN retcode; +static int SQLCONNECT(SQLHDBC hdbc, SQLCHAR *driver, SQLCHAR *user, + SQLCHAR *password, char *print) { + SQLRETURN retcode; - retcode = SQLConnect(hdbc,driver,SQL_NTS,user,SQL_NTS,password,SQL_NTS); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + retcode = SQLConnect(hdbc, driver, SQL_NTS, user, SQL_NTS, password, SQL_NTS); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_DBC, hdbc, "SQLConnect", print); return TRUE; } -static int SQLEXECDIRECT(SQLHSTMT StatementHandle, - SQLCHAR * StatementText, - char *print) -{ - SQLRETURN retcode; - retcode = SQLExecDirect(StatementHandle,StatementText,SQL_NTS); - - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) +static int SQLEXECDIRECT(SQLHSTMT StatementHandle, SQLCHAR *StatementText, + char *print) { + SQLRETURN retcode; + retcode = SQLExecDirect(StatementHandle, StatementText, SQL_NTS); + + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLExecDirect", print); return TRUE; } -static int SQLDESCRIBECOL(SQLHSTMT sth, - SQLSMALLINT colno, - SQLCHAR * colname, - SQLSMALLINT bflength, - SQLSMALLINT * nmlengthp, - SQLSMALLINT * dtptr, - SQLULEN * colszptr, - SQLSMALLINT * ddptr, - SQLSMALLINT * nullableptr, - char * print) -{ - SQLRETURN retcode; - retcode = SQLDescribeCol(sth, colno, colname, bflength, - nmlengthp, dtptr, colszptr, ddptr, - nullableptr); +static int SQLDESCRIBECOL(SQLHSTMT sth, SQLSMALLINT colno, SQLCHAR *colname, + SQLSMALLINT bflength, SQLSMALLINT *nmlengthp, + SQLSMALLINT *dtptr, SQLULEN *colszptr, + SQLSMALLINT *ddptr, SQLSMALLINT *nullableptr, + char *print) { + SQLRETURN retcode; + retcode = SQLDescribeCol(sth, colno, colname, bflength, nmlengthp, dtptr, + colszptr, ddptr, nullableptr); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, sth, "SQLDescribeCol", print); return TRUE; } -static int SQLSETCONNECTATTR(SQLHDBC hdbc, - SQLINTEGER attr, - SQLPOINTER vptr, - SQLINTEGER slen, - char * print) -{ - SQLRETURN retcode; +static int SQLSETCONNECTATTR(SQLHDBC hdbc, SQLINTEGER attr, SQLPOINTER vptr, + SQLINTEGER slen, char *print) { + SQLRETURN retcode; retcode = SQLSetConnectAttr(hdbc, attr, vptr, slen); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, hdbc, "SQLSetConnectAttr", print); return TRUE; } -static int SQLBINDCOL(SQLHSTMT sthandle, - SQLUSMALLINT colno, - SQLSMALLINT tt, - SQLPOINTER tvptr, - SQLLEN blen, - SQLLEN * strl, - char * print) -{ - SQLRETURN retcode; - retcode = SQLBindCol(sthandle,colno,tt,tvptr,blen,strl); +static int SQLBINDCOL(SQLHSTMT sthandle, SQLUSMALLINT colno, SQLSMALLINT tt, + SQLPOINTER tvptr, SQLLEN blen, SQLLEN *strl, + char *print) { + SQLRETURN retcode; + retcode = SQLBindCol(sthandle, colno, tt, tvptr, blen, strl); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, sthandle, "SQLBindCol", print); return TRUE; } -static int SQLNUMRESULTCOLS(SQLHSTMT sthandle, - SQLSMALLINT * ncols, - char * print) -{ - SQLRETURN retcode; - retcode = SQLNumResultCols(sthandle,ncols); +static int SQLNUMRESULTCOLS(SQLHSTMT sthandle, SQLSMALLINT *ncols, + char *print) { + SQLRETURN retcode; + retcode = SQLNumResultCols(sthandle, ncols); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, sthandle, "SQLNumResultCols", print); return TRUE; } -static int SQLCLOSECURSOR(SQLHSTMT sthandle, - char * print) -{ - SQLRETURN retcode; +static int SQLCLOSECURSOR(SQLHSTMT sthandle, char *print) { + SQLRETURN retcode; retcode = SQLCloseCursor(sthandle); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, sthandle, "SQLCloseCursor", print); return TRUE; } +#define SQLFETCH(A, print) \ + { \ + SQLRETURN retcode; \ + retcode = SQLFetch(A); \ + if (retcode == SQL_NO_DATA) \ + break; \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) { \ + printf("Error in SQLFETCH: %s\n", print); \ + return FALSE; \ + } \ + } -#define SQLFETCH(A,print) \ -{ \ - SQLRETURN retcode; \ - retcode = SQLFetch(A); \ - if (retcode == SQL_NO_DATA) \ - break; \ - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ - { \ - printf("Error in SQLFETCH: %s\n",print); \ - return FALSE; \ - } \ -} +static int SQLGETDATA(SQLHSTMT sthandle, SQLUSMALLINT Col_or_Param_Num, + SQLSMALLINT TargetType, SQLPOINTER TargetValuePtr, + SQLLEN BufferLength, SQLLEN *StrLen_or_IndPtr, + char *print) { + SQLRETURN retcode; + retcode = SQLGetData(sthandle, Col_or_Param_Num, TargetType, TargetValuePtr, + BufferLength, StrLen_or_IndPtr); -static int SQLGETDATA(SQLHSTMT sthandle, - SQLUSMALLINT Col_or_Param_Num, - SQLSMALLINT TargetType, - SQLPOINTER TargetValuePtr, - SQLLEN BufferLength, - SQLLEN * StrLen_or_IndPtr, - char * print) -{ - SQLRETURN retcode; - retcode = SQLGetData(sthandle, Col_or_Param_Num, - TargetType, TargetValuePtr, - BufferLength, StrLen_or_IndPtr); - - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_STMT, sthandle, "SQLGetData", print); return TRUE; } -static int SQLDISCONNECT(SQLHSTMT sthandle, - char * print) -{ - SQLRETURN retcode; +static int SQLDISCONNECT(SQLHSTMT sthandle, char *print) { + SQLRETURN retcode; retcode = SQLDisconnect(sthandle); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(SQL_HANDLE_DBC, sthandle, "SQLDisconnect", print); return TRUE; } -static int SQLFREEHANDLE(SQLSMALLINT HandleType, - SQLHANDLE Handle, - char * print) -{ - SQLRETURN retcode; +static int SQLFREEHANDLE(SQLSMALLINT HandleType, SQLHANDLE Handle, + char *print) { + SQLRETURN retcode; retcode = SQLFreeHandle(HandleType, Handle); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) return odbc_error(HandleType, Handle, "SQLDisconnect", print); return TRUE; } -static int SQLPRIMARYKEYS(SQLHSTMT StatementHandle, - SQLCHAR * CatalogName, - SQLSMALLINT NameLength1, - SQLCHAR * SchemaName, - SQLSMALLINT NameLength2, - SQLCHAR * TableName, - SQLSMALLINT NameLength3, - char * print) -{ - SQLRETURN retcode; - retcode = SQLPrimaryKeys(StatementHandle, - CatalogName, NameLength1, - SchemaName, NameLength2, - TableName, NameLength3 - ); +static int SQLPRIMARYKEYS(SQLHSTMT StatementHandle, SQLCHAR *CatalogName, + SQLSMALLINT NameLength1, SQLCHAR *SchemaName, + SQLSMALLINT NameLength2, SQLCHAR *TableName, + SQLSMALLINT NameLength3, char *print) { + SQLRETURN retcode; + retcode = SQLPrimaryKeys(StatementHandle, CatalogName, NameLength1, + SchemaName, NameLength2, TableName, NameLength3); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLPrimaryKeys", print); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLPrimaryKeys", + print); return TRUE; } /******************************************** NOT IN USE static int SQLGETTYPEINFO(SQLHSTMT StatementHandle, - SQLSMALLINT DataType, - char * print) -{ - SQLRETURN retcode; + SQLSMALLINT DataType, + char * print) +{ + SQLRETURN retcode; retcode = SQLGetTypeInfo(StatementHandle, DataType); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLGetTypeInfo", print); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLGetTypeInfo", +print); return TRUE; } ********************************************/ -static int SQLCOLATTRIBUTE( SQLHSTMT StatementHandle, - SQLUSMALLINT ColumnNumber, - SQLUSMALLINT FieldIdentifier, - SQLPOINTER CharacterAttributePtr, - SQLSMALLINT BufferLength, - SQLSMALLINT * StringLengthPtr, - SQLLEN * NumericAttributePtr, - char * print) -{ - SQLRETURN retcode; - retcode = SQLColAttribute(StatementHandle, - ColumnNumber, - FieldIdentifier, - CharacterAttributePtr, - BufferLength, - StringLengthPtr, - NumericAttributePtr -); +static int SQLCOLATTRIBUTE(SQLHSTMT StatementHandle, SQLUSMALLINT ColumnNumber, + SQLUSMALLINT FieldIdentifier, + SQLPOINTER CharacterAttributePtr, + SQLSMALLINT BufferLength, + SQLSMALLINT *StringLengthPtr, + SQLLEN *NumericAttributePtr, char *print) { + SQLRETURN retcode; + retcode = SQLColAttribute(StatementHandle, ColumnNumber, FieldIdentifier, + CharacterAttributePtr, BufferLength, + StringLengthPtr, NumericAttributePtr); - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLColAttribute", print); + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + return odbc_error(SQL_HANDLE_STMT, StatementHandle, "SQLColAttribute", + print); return TRUE; } - /* Verificar tipo de dados*/ -#define IS_SQL_INT(FIELD) FIELD == SQL_DECIMAL || \ - FIELD == SQL_NUMERIC || \ - FIELD == SQL_SMALLINT || \ - FIELD == SQL_INTEGER || \ - FIELD == SQL_TINYINT || \ - FIELD == SQL_BIGINT +#define IS_SQL_INT(FIELD) \ + FIELD == SQL_DECIMAL || FIELD == SQL_NUMERIC || FIELD == SQL_SMALLINT || \ + FIELD == SQL_INTEGER || FIELD == SQL_TINYINT || FIELD == SQL_BIGINT -#define IS_SQL_FLOAT(FIELD) FIELD == SQL_FLOAT || \ - FIELD == SQL_DOUBLE || \ - FIELD == SQL_REAL +#define IS_SQL_FLOAT(FIELD) \ + FIELD == SQL_FLOAT || FIELD == SQL_DOUBLE || FIELD == SQL_REAL - - - -static Int -c_db_odbc_connect( USES_REGS1 ) { - Term arg_driver = Deref(ARG1); +static Int c_db_odbc_connect(USES_REGS1) { + Term arg_driver = Deref(ARG1); Term arg_user = Deref(ARG2); Term arg_passwd = Deref(ARG3); - Term arg_conn = Deref(ARG4); + Term arg_conn = Deref(ARG4); MYDDAS_UTIL_CONNECTION new = NULL; const char *driver = AtomName(AtomOfTerm(arg_driver)); const char *user = AtomName(AtomOfTerm(arg_user)); const char *passwd = AtomName(AtomOfTerm(arg_passwd)); - - SQLHENV henv; - SQLHDBC hdbc; - + + SQLHENV henv; + SQLHDBC hdbc; + /*Allocate environment handle */ if (!SQLALLOCHANDLE(SQL_HANDLE_ENV, SQL_NULL_HANDLE, &henv, "connect")) return FALSE; /* Set the ODBC version environment attribute */ - if (!SQLSETENVATTR(henv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER)SQL_OV_ODBC3, 0, "connect")) - return FALSE; + if (!SQLSETENVATTR(henv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER)SQL_OV_ODBC3, 0, + "connect")) + return FALSE; /* Allocate connection handle */ if (!SQLALLOCHANDLE(SQL_HANDLE_DBC, henv, &hdbc, "connect")) - return FALSE; + return FALSE; /* Set login timeout to 6 seconds. */ - if (!SQLSETCONNECTATTR(hdbc, SQL_LOGIN_TIMEOUT,(SQLPOINTER) 6, 0, "connect")) + if (!SQLSETCONNECTATTR(hdbc, SQL_LOGIN_TIMEOUT, (SQLPOINTER)6, 0, "connect")) return FALSE; /* Connect to data source */ - if (!SQLCONNECT(hdbc, - (SQLCHAR*) driver, - (SQLCHAR*) user, - (SQLCHAR*) passwd, "connect")) + if (!SQLCONNECT(hdbc, (SQLCHAR *)driver, (SQLCHAR *)user, (SQLCHAR *)passwd, + "connect")) return FALSE; if (!Yap_unify(arg_conn, MkIntegerTerm((Int)(hdbc)))) return FALSE; - else - { - /* Criar um novo no na lista de ligacoes*/ - //new = add_connection(&TOP,hdbc,henv); - new = myddas_util_add_connection(hdbc,henv,MYDDAS_ODBC); - if (new == NULL){ - fprintf(stderr,"Error: could not allocate list memory\n"); - return FALSE; - } - return TRUE; + else { + /* Criar um novo no na lista de ligacoes*/ + // new = add_connection(&TOP,hdbc,henv); + new = myddas_util_add_connection(hdbc, henv, MYDDAS_ODBC); + if (new == NULL) { + fprintf(stderr, "Error: could not allocate list memory\n"); + return FALSE; } + return TRUE; + } } /* db_query: SQLQuery x ResultSet x Arity x BindList x Connection */ -static Int -c_db_odbc_query( USES_REGS1 ) { +static Int c_db_odbc_query(USES_REGS1) { Term arg_sql_query = Deref(ARG1); Term arg_result_set = Deref(ARG2); Term arg_arity = Deref(ARG3); @@ -367,174 +311,173 @@ c_db_odbc_query( USES_REGS1 ) { Term arg_conn = Deref(ARG5); SQLCHAR *sql = (SQLCHAR *)AtomName(AtomOfTerm(arg_sql_query)); - - - SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + + SQLHDBC hdbc = (SQLHDBC)(IntegerOfTerm(arg_conn)); SQLHSTMT hstmt; SQLSMALLINT type; Int arity; Int i; - - /*Allocate an handle for the query*/ + + /*Allocate an handle for the query*/ if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_query")) return FALSE; - /* Executes the query*/ + /* Executes the query*/ if (!SQLEXECDIRECT(hstmt, sql, "db_query")) return FALSE; - - if (IsNonVarTerm(arg_arity)){ + + if (IsNonVarTerm(arg_arity)) { arity = IntegerOfTerm(arg_arity); - - - char *bind_space=NULL; - //const Int functor_arity=3; - const Short functor_arity=3; - Functor functor = Yap_MkFunctor(Yap_LookupAtom("bind"),functor_arity); + char *bind_space = NULL; + + // const Int functor_arity=3; + const Short functor_arity = 3; + Functor functor = Yap_MkFunctor(Yap_LookupAtom("bind"), functor_arity); Term properties[functor_arity]; - - Term head,list=arg_bind_list; - SQLULEN ColumnSizePtr; - SQLLEN *data_info=NULL; + Term head, list = arg_bind_list; - for (i=1;i<=arity;i++) - { - head = HeadOfTerm(list); - list = TailOfTerm(list); - - if (!SQLDESCRIBECOL(hstmt,i,NULL,0,NULL,&type,&ColumnSizePtr,NULL,NULL,"db_query")) - return FALSE; - - /* +1 because of '\0' */ - bind_space = malloc(sizeof(char)*(ColumnSizePtr+1)); - data_info = malloc(sizeof(SQLINTEGER)); - if (!SQLBINDCOL(hstmt,i,SQL_C_CHAR,bind_space,(ColumnSizePtr+1),data_info,"db_query")) { - return FALSE; - } - - properties[0] = MkIntegerTerm((Int)bind_space); - properties[2] = MkIntegerTerm((Int)data_info); - - if (IS_SQL_INT(type)) - properties[1]=MkAtomTerm(Yap_LookupAtom("integer")); - else if (IS_SQL_FLOAT(type)) - properties[1]=MkAtomTerm(Yap_LookupAtom("real")); - else - properties[1]=MkAtomTerm(Yap_LookupAtom("string")); - - Yap_unify(head,Yap_MkApplTerm(functor,functor_arity,properties)); - continue; - + SQLULEN ColumnSizePtr; + SQLLEN *data_info = NULL; + + for (i = 1; i <= arity; i++) { + head = HeadOfTerm(list); + list = TailOfTerm(list); + + if (!SQLDESCRIBECOL(hstmt, i, NULL, 0, NULL, &type, &ColumnSizePtr, NULL, + NULL, "db_query")) + return FALSE; + + /* +1 because of '\0' */ + bind_space = malloc(sizeof(char) * (ColumnSizePtr + 1)); + data_info = malloc(sizeof(SQLINTEGER)); + if (!SQLBINDCOL(hstmt, i, SQL_C_CHAR, bind_space, (ColumnSizePtr + 1), + data_info, "db_query")) { + return FALSE; } - } - - if (!Yap_unify(arg_result_set, MkIntegerTerm((Int) hstmt))) - { - if (!SQLCLOSECURSOR(hstmt,"db_query")) - return FALSE; - if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_query")) - return FALSE; - return FALSE; + + properties[0] = MkIntegerTerm((Int)bind_space); + properties[2] = MkIntegerTerm((Int)data_info); + + if (IS_SQL_INT(type)) + properties[1] = MkAtomTerm(Yap_LookupAtom("integer")); + else if (IS_SQL_FLOAT(type)) + properties[1] = MkAtomTerm(Yap_LookupAtom("real")); + else + properties[1] = MkAtomTerm(Yap_LookupAtom("string")); + + Yap_unify(head, Yap_MkApplTerm(functor, functor_arity, properties)); + continue; } + } + + if (!Yap_unify(arg_result_set, MkIntegerTerm((Int)hstmt))) { + if (!SQLCLOSECURSOR(hstmt, "db_query")) + return FALSE; + if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_query")) + return FALSE; + return FALSE; + } return TRUE; } -static Int -c_db_odbc_number_of_fields( USES_REGS1 ) { +static Int c_db_odbc_number_of_fields(USES_REGS1) { Term arg_relation = Deref(ARG1); Term arg_conn = Deref(ARG2); Term arg_fields = Deref(ARG3); - const char *relation = AtomName(AtomOfTerm(arg_relation)); - SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHDBC hdbc = (SQLHDBC)(IntegerOfTerm(arg_conn)); SQLHSTMT hstmt; - + char sql[256]; SQLSMALLINT number_fields; - sprintf(sql,"SELECT column_name from INFORMATION_SCHEMA.COLUMNS where table_name = \'%s\' GROUP BY column_name, dtd_identifier ORDER BY CAST(dtd_identifier AS INTEGER)",relation); - + sprintf(sql, "SELECT column_name from INFORMATION_SCHEMA.COLUMNS where " + "table_name = \'%s\' GROUP BY column_name, dtd_identifier ORDER " + "BY CAST(dtd_identifier AS INTEGER)", + relation); + if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_number_of_fields")) return FALSE; if (!SQLEXECDIRECT(hstmt, (SQLCHAR *)sql, "db_number_of_fields")) - return FALSE; - + return FALSE; + /* Calcula o numero de campos*/ - number_fields=0; - while(TRUE) { - SQLFETCH(hstmt,"db_number_of_fields"); + number_fields = 0; + while (TRUE) { + SQLFETCH(hstmt, "db_number_of_fields"); number_fields++; } - - if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields")) + + if (!SQLCLOSECURSOR(hstmt, "db_number_of_fields")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields")) return FALSE; - + if (!Yap_unify(arg_fields, MkIntegerTerm(number_fields))) return FALSE; return TRUE; } - /* db_get_attributes_types: RelName x Connection -> TypesList */ -static Int -c_db_odbc_get_attributes_types( USES_REGS1 ) { +static Int c_db_odbc_get_attributes_types(USES_REGS1) { Term arg_relation = Deref(ARG1); Term arg_conn = Deref(ARG2); Term arg_types_list = Deref(ARG3); const char *relation = AtomName(AtomOfTerm(arg_relation)); - SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHDBC hdbc = (SQLHDBC)(IntegerOfTerm(arg_conn)); SQLHSTMT hstmt; - + char sql[256]; Term head, list; list = arg_types_list; - sprintf(sql,"SELECT column_name,data_type from INFORMATION_SCHEMA.COLUMNS WHERE table_name = \'%s\' GROUP BY column_name, dtd_identifier ORDER BY CAST(dtd_identifier AS INTEGER)",relation); + sprintf(sql, "SELECT column_name,data_type from INFORMATION_SCHEMA.COLUMNS " + "WHERE table_name = \'%s\' GROUP BY column_name, dtd_identifier " + "ORDER BY CAST(dtd_identifier AS INTEGER)", + relation); if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_get_attributes_types")) return FALSE; if (!SQLEXECDIRECT(hstmt, (SQLCHAR *)sql, "db_get_attributes_types")) return FALSE; - - while (TRUE) - { - SQLFETCH(hstmt, "db_get_attributes_types"); - - /* Tentar fazer de uma maneira que a gente consiga calcular o tamanho que o - nome do campo vai ocupar, assim podemos alocar memoria dinamicamente*/ - sql[0]='\0'; - if (!SQLGETDATA(hstmt, 1, SQL_C_CHAR, sql, 256, NULL, "db_get_attributes_types")) - return FALSE; - - head = HeadOfTerm(list); - Yap_unify(head, MkAtomTerm(Yap_LookupAtom(sql))); - list = TailOfTerm(list); - head = HeadOfTerm(list); - list = TailOfTerm(list); - - sql[0]='\0'; - if (!SQLGETDATA(hstmt, 2, SQL_C_CHAR, sql, 256, NULL, "db_get_attributes_types")) - return FALSE; - - if (strncmp(sql, "smallint",8) == 0 || strncmp(sql,"int",3) == 0 || - strncmp(sql, "mediumint",9) == 0 || strncmp(sql, "tinyint",7) == 0 || - strncmp(sql, "bigint",6) == 0 || strcmp(sql, "year") == 0) - Yap_unify(head, MkAtomTerm(Yap_LookupAtom("integer"))); - else - if (strcmp(sql, "float") == 0 || strncmp(sql, "double",6) == 0 - || strcmp(sql, "real") == 0) - Yap_unify(head, MkAtomTerm(Yap_LookupAtom("real"))); - else - Yap_unify(head, MkAtomTerm(Yap_LookupAtom("string"))); - } - - if (!SQLCLOSECURSOR(hstmt,"db_get_attributes_types")) + + while (TRUE) { + SQLFETCH(hstmt, "db_get_attributes_types"); + + /* Tentar fazer de uma maneira que a gente consiga calcular o tamanho que o + nome do campo vai ocupar, assim podemos alocar memoria dinamicamente*/ + sql[0] = '\0'; + if (!SQLGETDATA(hstmt, 1, SQL_C_CHAR, sql, 256, NULL, + "db_get_attributes_types")) + return FALSE; + + head = HeadOfTerm(list); + Yap_unify(head, MkAtomTerm(Yap_LookupAtom(sql))); + list = TailOfTerm(list); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + sql[0] = '\0'; + if (!SQLGETDATA(hstmt, 2, SQL_C_CHAR, sql, 256, NULL, + "db_get_attributes_types")) + return FALSE; + + if (strncmp(sql, "smallint", 8) == 0 || strncmp(sql, "int", 3) == 0 || + strncmp(sql, "mediumint", 9) == 0 || strncmp(sql, "tinyint", 7) == 0 || + strncmp(sql, "bigint", 6) == 0 || strcmp(sql, "year") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("integer"))); + else if (strcmp(sql, "float") == 0 || strncmp(sql, "double", 6) == 0 || + strcmp(sql, "real") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("real"))); + else + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("string"))); + } + + if (!SQLCLOSECURSOR(hstmt, "db_get_attributes_types")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_get_attributes_types")) return FALSE; @@ -542,190 +485,188 @@ c_db_odbc_get_attributes_types( USES_REGS1 ) { } /* db_disconnect */ -static Int -c_db_odbc_disconnect( USES_REGS1 ) { +static Int c_db_odbc_disconnect(USES_REGS1) { Term arg_conn = Deref(ARG1); - SQLHDBC conn = (SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHDBC conn = (SQLHDBC)(IntegerOfTerm(arg_conn)); SQLHENV henv = myddas_util_get_odbc_enviromment(conn); - - if ((myddas_util_search_connection(conn)) != NULL) - { - myddas_util_delete_connection(conn); - /* More information about this process on - msdn.microsoft.com*/ - if (!SQLDISCONNECT(conn,"db_disconnect")) - return FALSE; - if (!SQLFREEHANDLE(SQL_HANDLE_DBC,conn,"db_disconnect")) - return FALSE; - if (!SQLFREEHANDLE(SQL_HANDLE_ENV,henv,"db_disconnect")) - return FALSE; - - return TRUE; - } - else + + if ((myddas_util_search_connection(conn)) != NULL) { + myddas_util_delete_connection(conn); + /* More information about this process on + msdn.microsoft.com*/ + if (!SQLDISCONNECT(conn, "db_disconnect")) + return FALSE; + if (!SQLFREEHANDLE(SQL_HANDLE_DBC, conn, "db_disconnect")) + return FALSE; + if (!SQLFREEHANDLE(SQL_HANDLE_ENV, henv, "db_disconnect")) + return FALSE; + + return TRUE; + } else return FALSE; } -static Int -c_db_odbc_row_cut( USES_REGS1 ) { - - SQLHSTMT hstmt = (SQLHSTMT) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1)); - - if (!SQLCLOSECURSOR(hstmt,"db_row_cut")) - return FALSE; +static Int c_db_odbc_row_cut(USES_REGS1) { + + SQLHSTMT hstmt = (SQLHSTMT)IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term, 1)); + + if (!SQLCLOSECURSOR(hstmt, "db_row_cut")) + return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_row_cut")) - return FALSE; - + return FALSE; + return TRUE; } -static int -release_list_args(Term arg_list_args, Term arg_bind_list, const char *error_msg) -{ +static int release_list_args(Term arg_list_args, Term arg_bind_list, + const char *error_msg) { Term list = arg_list_args; Term list_bind = arg_bind_list; - - while (IsPairTerm(list_bind)) - { - Term head_bind = HeadOfTerm(list_bind); - list = TailOfTerm(list); - list_bind = TailOfTerm(list_bind); - - free((char *)IntegerOfTerm(ArgOfTerm(1,head_bind))); - free((SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3,head_bind))); - } + while (IsPairTerm(list_bind)) { + Term head_bind = HeadOfTerm(list_bind); + + list = TailOfTerm(list); + list_bind = TailOfTerm(list_bind); + + free((char *)IntegerOfTerm(ArgOfTerm(1, head_bind))); + free((SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3, head_bind))); + } return TRUE; } /* db_row: ResultSet x BindList x ListOfArgs -> */ -static Int -c_db_odbc_row( USES_REGS1 ) { +static Int c_db_odbc_row(USES_REGS1) { Term arg_result_set = Deref(ARG1); Term arg_bind_list = Deref(ARG2); Term arg_list_args = Deref(ARG3); - SQLHSTMT hstmt = (SQLHSTMT) IntegerOfTerm(arg_result_set); - + SQLHSTMT hstmt = (SQLHSTMT)IntegerOfTerm(arg_result_set); + /* EXTRA_CBACK_ARG(ARIDADE,LOCAL_ONDE_COLOCAR_VALOR)*/ - EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((Int)hstmt); + EXTRA_CBACK_ARG(3, 1) = (CELL)MkIntegerTerm((Int)hstmt); Term head, list, null_atom[1]; Term head_bind, list_bind; - + SQLRETURN retcode = SQLFetch(hstmt); - if (retcode == SQL_NO_DATA) - { - if (!SQLCLOSECURSOR(hstmt,"db_row")) - return FALSE; - if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_row")) - return FALSE; - if (!release_list_args(arg_list_args, arg_bind_list, "db_row")) { - return FALSE; - } - - cut_fail(); + if (retcode == SQL_NO_DATA) { + if (!SQLCLOSECURSOR(hstmt, "db_row")) + return FALSE; + if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_row")) + return FALSE; + if (!release_list_args(arg_list_args, arg_bind_list, "db_row")) { return FALSE; } - if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) - { - printf("erro no SQLFETCH number of fields\n"); - return FALSE; - } - - char *bind_value=NULL; + + cut_fail(); + return FALSE; + } + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) { + printf("erro no SQLFETCH number of fields\n"); + return FALSE; + } + + char *bind_value = NULL; Term type; list = arg_list_args; list_bind = arg_bind_list; - SQLINTEGER *data_info=NULL; - - while (IsPairTerm(list_bind)) - { - head = HeadOfTerm(list); - list = TailOfTerm(list); - - head_bind = HeadOfTerm(list_bind); - list_bind = TailOfTerm(list_bind); - - bind_value = (char *)IntegerOfTerm(ArgOfTerm(1,head_bind)); - type = ArgOfTerm(2,head_bind); - data_info = (SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3,head_bind)); + SQLINTEGER *data_info = NULL; - if ((*data_info) == SQL_NULL_DATA){ - null_atom[0] = MkIntegerTerm(null_id++); - if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom))) - continue; + while (IsPairTerm(list_bind)) { + head = HeadOfTerm(list); + list = TailOfTerm(list); + + head_bind = HeadOfTerm(list_bind); + list_bind = TailOfTerm(list_bind); + + bind_value = (char *)IntegerOfTerm(ArgOfTerm(1, head_bind)); + type = ArgOfTerm(2, head_bind); + data_info = (SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3, head_bind)); + + if ((*data_info) == SQL_NULL_DATA) { + null_atom[0] = MkIntegerTerm(null_id++); + if (!Yap_unify(head, + Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"), 1), 1, + null_atom))) + continue; + } else { + + if (!strcmp(AtomName(AtomOfTerm(type)), "integer")) { + if (!Yap_unify(head, MkIntegerTerm(atol(bind_value)))) + continue; + } else if (!strcmp(AtomName(AtomOfTerm(type)), "real")) { + if (!Yap_unify(head, MkFloatTerm(atof(bind_value)))) + continue; + } else if (!strcmp(AtomName(AtomOfTerm(type)), "string")) { + if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(bind_value)))) + continue; } - else - { - - if (!strcmp(AtomName(AtomOfTerm(type)),"integer")) - { - if (!Yap_unify(head, MkIntegerTerm(atol(bind_value)))) - continue; - } - else if (!strcmp(AtomName(AtomOfTerm(type)),"real")) - { - if (!Yap_unify(head, MkFloatTerm(atof(bind_value)))) - continue; - } - else if (!strcmp(AtomName(AtomOfTerm(type)),"string")) - { - if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(bind_value)))) - continue; - } - } } + } return TRUE; } - -/* Mudar esta funcao de forma a nao fazer a consulta, pois - no predicate db_sql_selet vai fazer duas vezes a mesma consutla*/ -static Int -c_db_odbc_number_of_fields_in_query( USES_REGS1 ) { +/* Mudar esta funcao de forma a nao fazer a consulta, pois + no predicate db_sql_selet vai fazer duas vezes a mesma consutla*/ +static Int c_db_odbc_number_of_fields_in_query(USES_REGS1) { Term arg_query = Deref(ARG1); Term arg_conn = Deref(ARG2); Term arg_fields = Deref(ARG3); const char *sql = AtomName(AtomOfTerm(arg_query)); - - SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); - SQLHSTMT hstmt; - SQLSMALLINT number_cols=0; - if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, - "db_number_of_fields_in_query")) + SQLHDBC hdbc = (SQLHDBC)(IntegerOfTerm(arg_conn)); + SQLHSTMT hstmt; + SQLSMALLINT number_cols = 0; + + if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, + "db_number_of_fields_in_query")) return FALSE; - if (!SQLEXECDIRECT(hstmt ,(SQLCHAR *)sql, - "db_number_of_fields_in_query")) + if (!SQLEXECDIRECT(hstmt, (SQLCHAR *)sql, "db_number_of_fields_in_query")) return FALSE; - - if (!SQLNUMRESULTCOLS(hstmt,&number_cols, - "db_number_of_fields_in_query")) + + if (!SQLNUMRESULTCOLS(hstmt, &number_cols, "db_number_of_fields_in_query")) return FALSE; - - if (!Yap_unify(arg_fields, MkIntegerTerm(number_cols))){ - if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields_in_query")) + + if (!Yap_unify(arg_fields, MkIntegerTerm(number_cols))) { + if (!SQLCLOSECURSOR(hstmt, "db_number_of_fields_in_query")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields_in_query")) return FALSE; - + return FALSE; } - - if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields_in_query")) + + if (!SQLCLOSECURSOR(hstmt, "db_number_of_fields_in_query")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields_in_query")) return FALSE; - + return TRUE; } -static Int -c_db_odbc_get_fields_properties( USES_REGS1 ) { +#ifdef MYDDAS_ODBC +/* This function searches the MYDDAS list for odbc connections + If there isn't any, it returns NULL. This is a nice way to know + if there is any odbc connections left on the list*/ +SQLHENV +myddas_util_get_odbc_enviromment(SQLHDBC connection) { + CACHE_REGS + MYDDAS_UTIL_CONNECTION top = + Yap_REGS.MYDDAS_GLOBAL_POINTER->myddas_top_connections; + + for (; top != NULL; top = top->next) + if (top->connection == ((void *)connection)) + return top->odbc_enviromment; + + return NULL; +} +#endif + +static Int c_db_odbc_get_fields_properties(USES_REGS1) { Term nome_relacao = Deref(ARG1); Term arg_conn = Deref(ARG2); Term fields_properties_list = Deref(ARG3); @@ -735,140 +676,130 @@ c_db_odbc_get_fields_properties( USES_REGS1 ) { char sql[256]; char name[200]; Int i; - - - SQLSMALLINT num_fields=0; - SQLSMALLINT NullablePtr=0; - SQLLEN AutoIncrementPointer=0; - SQLHSTMT hstmt,hstmt2; - SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLSMALLINT num_fields = 0; + SQLSMALLINT NullablePtr = 0; + SQLLEN AutoIncrementPointer = 0; + SQLHSTMT hstmt, hstmt2; + SQLHDBC hdbc = (SQLHDBC)(IntegerOfTerm(arg_conn)); - /* LIMIT 0 -> We don't need the results of the query, + /* LIMIT 0 -> We don't need the results of the query, only the information about the fields of the relation*/ - sprintf (sql,"SELECT * FROM `%s` LIMIT 0",relacao); + sprintf(sql, "SELECT * FROM `%s` LIMIT 0", relacao); - /*Allocate an handle for the query*/ - if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_get_fields_properties")) + /*Allocate an handle for the query*/ + if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, + "db_get_fields_properties")) return FALSE; - /* Executes the query*/ - if (!SQLEXECDIRECT(hstmt ,(SQLCHAR *)sql, "db_get_fields_properties")) + /* Executes the query*/ + if (!SQLEXECDIRECT(hstmt, (SQLCHAR *)sql, "db_get_fields_properties")) return FALSE; - - Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"),4); + + Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"), 4); Term properties[4]; - - if (!SQLNUMRESULTCOLS(hstmt,&num_fields, - "db_get_fields_properties")) + + if (!SQLNUMRESULTCOLS(hstmt, &num_fields, "db_get_fields_properties")) return FALSE; - + list = fields_properties_list; - + SQLSMALLINT bind_prim_key; // rows in odbc start at 1 :) - Short *null=(Short *)malloc(sizeof(Short)*(1+num_fields)); - - if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt2, "db_get_fields_properties")) + Short *null = (Short *)malloc(sizeof(Short) * (1 + num_fields)); + + if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt2, + "db_get_fields_properties")) return FALSE; - /* Executes the query*/ - if (!SQLPRIMARYKEYS(hstmt2,NULL,0,NULL,0,relacao,SQL_NTS, "db_get_fields_properties")) + /* Executes the query*/ + if (!SQLPRIMARYKEYS(hstmt2, NULL, 0, NULL, 0, relacao, SQL_NTS, + "db_get_fields_properties")) return FALSE; /* Associates bind value for the 5 column*/ - if (!SQLBINDCOL(hstmt2,5,SQL_C_SSHORT,&bind_prim_key,sizeof(SQLSMALLINT),NULL, - "db_get_fields_properties")) + if (!SQLBINDCOL(hstmt2, 5, SQL_C_SSHORT, &bind_prim_key, sizeof(SQLSMALLINT), + NULL, "db_get_fields_properties")) return FALSE; - - while(1) - { - SQLFETCH(hstmt2,"db_get_fields_properties"); - null[bind_prim_key]=1; - } - if (!SQLCLOSECURSOR(hstmt2,"db_get_fields_properties")) + while (1) { + SQLFETCH(hstmt2, "db_get_fields_properties"); + null[bind_prim_key] = 1; + } + + if (!SQLCLOSECURSOR(hstmt2, "db_get_fields_properties")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt2, "db_get_fields_properties")) return FALSE; - - for (i=1;i<=num_fields;i++) - { - head = HeadOfTerm(list); - name[0]='\0'; - SQLDESCRIBECOL(hstmt,i,(SQLCHAR *)name,200,NULL,NULL,NULL,NULL,&NullablePtr, - "db_get_fields_properties"); - if (!SQLCOLATTRIBUTE(hstmt,i,SQL_DESC_AUTO_UNIQUE_VALUE,NULL,0,NULL,&AutoIncrementPointer, - "db_get_fields_properties")) - return FALSE; - - properties[0] = MkAtomTerm(Yap_LookupAtom(name)); - - - if (NullablePtr & SQL_NULLABLE) - properties[1] = MkIntegerTerm(1); //Can't be NULL - else - properties[1] = MkIntegerTerm(0); - - if (null[i] == 1) - properties[2] = MkIntegerTerm(1); //It''s a primary key - else - properties[2] = MkIntegerTerm(0); - - if (AutoIncrementPointer & SQL_TRUE) - properties[3] = MkIntegerTerm(1); //It's auto_incremented field - else - properties[3] = MkIntegerTerm(0); - - - list = TailOfTerm(list); - if (!Yap_unify(head, Yap_MkApplTerm(functor,4,properties))){ - return FALSE; - } + for (i = 1; i <= num_fields; i++) { + head = HeadOfTerm(list); + name[0] = '\0'; + SQLDESCRIBECOL(hstmt, i, (SQLCHAR *)name, 200, NULL, NULL, NULL, NULL, + &NullablePtr, "db_get_fields_properties"); + + if (!SQLCOLATTRIBUTE(hstmt, i, SQL_DESC_AUTO_UNIQUE_VALUE, NULL, 0, NULL, + &AutoIncrementPointer, "db_get_fields_properties")) + return FALSE; + + properties[0] = MkAtomTerm(Yap_LookupAtom(name)); + + if (NullablePtr & SQL_NULLABLE) + properties[1] = MkIntegerTerm(1); // Can't be NULL + else + properties[1] = MkIntegerTerm(0); + + if (null[i] == 1) + properties[2] = MkIntegerTerm(1); // It''s a primary key + else + properties[2] = MkIntegerTerm(0); + + if (AutoIncrementPointer & SQL_TRUE) + properties[3] = MkIntegerTerm(1); // It's auto_incremented field + else + properties[3] = MkIntegerTerm(0); + + list = TailOfTerm(list); + if (!Yap_unify(head, Yap_MkApplTerm(functor, 4, properties))) { + return FALSE; } - - if (!SQLCLOSECURSOR(hstmt,"db_get_fields_properties")) + } + + if (!SQLCLOSECURSOR(hstmt, "db_get_fields_properties")) return FALSE; if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt2, "db_get_fields_properties")) return FALSE; return TRUE; } - - -void Yap_InitMYDDAS_ODBCPreds(void) -{ +void Yap_InitMYDDAS_ODBCPreds(void) { /* db_connect: Host x User x Passwd x Database x Connection */ Yap_InitCPred("c_db_odbc_connect", 4, c_db_odbc_connect, 0); - + /* db_number_of_fields: Relation x Connection x NumberOfFields */ - Yap_InitCPred("c_db_odbc_number_of_fields",3, c_db_odbc_number_of_fields, 0); + Yap_InitCPred("c_db_odbc_number_of_fields", 3, c_db_odbc_number_of_fields, 0); /* db_number_of_fields_in_query: SQLQuery x Connection x NumberOfFields */ - Yap_InitCPred("c_db_odbc_number_of_fields_in_query",3, c_db_odbc_number_of_fields_in_query, 0); - + Yap_InitCPred("c_db_odbc_number_of_fields_in_query", 3, + c_db_odbc_number_of_fields_in_query, 0); + /* db_get_attributes_types: Relation x TypesList */ - Yap_InitCPred("c_db_odbc_get_attributes_types", 3, c_db_odbc_get_attributes_types, 0); - + Yap_InitCPred("c_db_odbc_get_attributes_types", 3, + c_db_odbc_get_attributes_types, 0); + /* db_query: SQLQuery x ResultSet x Connection */ Yap_InitCPred("c_db_odbc_query", 5, c_db_odbc_query, 0); - - /* db_disconnect: Connection */ - Yap_InitCPred("c_db_odbc_disconnect", 1,c_db_odbc_disconnect, 0); - - /* db_get_fields_properties: PredName x Connnection x PropertiesList */ - Yap_InitCPred("c_db_odbc_get_fields_properties",3,c_db_odbc_get_fields_properties,0); + /* db_disconnect: Connection */ + Yap_InitCPred("c_db_odbc_disconnect", 1, c_db_odbc_disconnect, 0); + + /* db_get_fields_properties: PredName x Connnection x PropertiesList */ + Yap_InitCPred("c_db_odbc_get_fields_properties", 3, + c_db_odbc_get_fields_properties, 0); } +void Yap_InitBackMYDDAS_ODBCPreds(void) { -void Yap_InitBackMYDDAS_ODBCPreds(void) -{ - /* db_row: ResultSet x ListOfArgs */ - Yap_InitCPredBackCut("c_db_odbc_row", 3, sizeof(Int), - c_db_odbc_row, - c_db_odbc_row, - c_db_odbc_row_cut, 0); - + Yap_InitCPredBackCut("c_db_odbc_row", 3, sizeof(Int), c_db_odbc_row, + c_db_odbc_row, c_db_odbc_row_cut, 0); } #endif /*MYDDAS_ODBC*/ diff --git a/packages/myddas/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp index b10c228a6..22a2f8ca1 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -806,6 +806,8 @@ ]). #ifdef MYDDAS_MYSQL +:- load_foreign_files([], [], init_mysql). + :- use_module(myddas_mysql,[ db_my_result_set/1, db_datalog_describe/1, diff --git a/packages/myddas/postgres/CMakeLists.txt b/packages/myddas/postgres/CMakeLists.txt index af871d11c..b8aff3efc 100644 --- a/packages/myddas/postgres/CMakeLists.txt +++ b/packages/myddas/postgres/CMakeLists.txt @@ -21,16 +21,16 @@ if (POSTGRES_FOUND) add_definitions (-DMYDDAS_POSTGRES=1) target_link_libraries(Yappostgres libYap ${POSTGRES_LIBRARIES}) include_directories (${POSTGRES_INCLUDE_DIRECTORIES} ..) -else() - add_definitions (-DMYDDAS_POSTGRES=0) -endif (POSTGRES_FOUND) - -set_target_properties (Yappostgres PROPERTIES - POSITION_INDEPENDENT_CODE ON - VERSION "${SO_MAJOR}.${SO_MINOR}.${SO_PATCH}" - SOVERSION ${SO_MAJOR} + set_target_properties (Yappostgres PROPERTIES + POSITION_INDEPENDENT_CODE ON + VERSION "${SO_MAJOR}.${SO_MINOR}.${SO_PATCH}" + SOVERSION ${SO_MAJOR} ) install(TARGETS Yappostgres LIBRARY DESTINATION ${libdir} ) +else() + add_definitions (-DMYDDAS_POSTGRES=0) +endif (POSTGRES_FOUND) + diff --git a/packages/myddas/sqlite3/CMakeLists.txt b/packages/myddas/sqlite3/CMakeLists.txt index ef6a95170..167257bc5 100644 --- a/packages/myddas/sqlite3/CMakeLists.txt +++ b/packages/myddas/sqlite3/CMakeLists.txt @@ -3,7 +3,6 @@ set( YAPSQLITE3_SOURCES myddas_sqlite3.c ) -add_library (Yapsqlite3 SHARED ${YAPSQLITE3_SOURCES}) macro_optional_find_package(SQLITE3 ON) macro_log_feature (SQLITE3_FOUND "Sqlite3" @@ -14,19 +13,19 @@ if (SQLITE3_FOUND) # SQLITE3_INCLUDE_DIRECTORIES, where to find sql.h # SQLITE3_LIBRARIES, the libraries to link against to use SQLITE3 # SQLITE3_FOUND. If false, you cannot build anything that requires Sqlite3. - add_definitions (target PUBLIC YapMyddasUtils Yapsqlite3 MYDDAS_SQLITE3=1) + add_library (Yapsqlite3 SHARED ${YAPSQLITE3_SOURCES}) + add_definitions (-DMYDDAS_SQLITE3=1) target_link_libraries(Yapsqlite3 ${SQLITE3_LIBRARIES} libYap) - include_directories (${SQLITE3_INCLUDE_DIRECTORIES} ..) + include_directories (${SQLITE3_INCLUDE_DIRECTORIES} .. ) -endif (SQLITE3_FOUND) - -set_target_properties (Yapsqlite3 PROPERTIES + set_target_properties (Yapsqlite3 PROPERTIES POSITION_INDEPENDENT_CODE ON VERSION "${SO_MAJOR}.${SO_MINOR}.${SO_PATCH}" SOVERSION ${SO_MAJOR} -) + ) install(TARGETS Yapsqlite3 LIBRARY DESTINATION ${libdir} ) +endif (SQLITE3_FOUND) diff --git a/packages/myddas/sqlite3/myddas_sqlite3.c b/packages/myddas/sqlite3/myddas_sqlite3.c index b5b19a6fe..d1a2989d1 100644 --- a/packages/myddas/sqlite3/myddas_sqlite3.c +++ b/packages/myddas/sqlite3/myddas_sqlite3.c @@ -8,7 +8,7 @@ * * ************************************************************************** * * -* File: myddas_sqlite3.c * +* File: myddas_sqlite3.c * * Last rev: 22/03/05 * * mods: * * comments: Predicates for comunicating with a sqlite3 database system * @@ -31,29 +31,29 @@ #include "myddas_structs.h" #include "myddas_statistics.h" #endif -#include "myddas_wkb2prolog.h" +//#include "myddas_wkb2prolog.h" -#define CALL_SQLITE(f) \ -{ \ - int i; \ - i = sqlite3_ ## f; \ - if (i != SQLITE_OK) { \ - fprintf (stderr, "%s failed with status %d: %s\n", \ - #f, i, sqlite3_errmsg (db)); \ - exit (1); \ - } \ -} \ +#define CALL_SQLITE(f) \ + { \ + int i; \ + i = sqlite3_##f; \ + if (i != SQLITE_OK) { \ + fprintf(stderr, "%s failed with status %d: %s\n", #f, i, \ + sqlite3_errmsg(db)); \ + exit(1); \ + } \ + } -#define CALL_SQLITE_EXPECT(f,x) \ -{ \ - int i; \ - i = sqlite3_ ## f; \ - if (i != SQLITE_ ## x) { \ - fprintf (stderr, "%s failed with status %d: %s\n", \ - #f, i, sqlite3_errmsg (db)); \ - exit (1); \ - } \ -} \ +#define CALL_SQLITE_EXPECT(f, x) \ + { \ + int i; \ + i = sqlite3_##f; \ + if (i != SQLITE_##x) { \ + fprintf(stderr, "%s failed with status %d: %s\n", #f, i, \ + sqlite3_errmsg(db)); \ + exit(1); \ + } \ + } static Int null_id = 0; @@ -68,66 +68,60 @@ typedef struct result_set { void Yap_InitMYDDAS_SQLITE3Preds(void); void Yap_InitBackMYDDAS_SQLITE3Preds(void); +static Int c_sqlite3_connect(USES_REGS1); +static Int c_sqlite3_disconnect(USES_REGS1); +static Int c_sqlite3_number_of_fields(USES_REGS1); +static Int c_sqlite3_get_attributes_types(USES_REGS1); +static Int c_sqlite3_query(USES_REGS1); +static Int c_sqlite3_table_write(USES_REGS1); +static Int c_sqlite3_row(USES_REGS1); +static Int c_sqlite3_row_cut(USES_REGS1); +static Int c_sqlite3_get_fields_properties(USES_REGS1); +static Int c_sqlite3_get_next_result_set(USES_REGS1); +static Int c_sqlite3_get_database(USES_REGS1); +static Int c_sqlite3_change_database(USES_REGS1); -static Int c_sqlite3_connect( USES_REGS1 ); -static Int c_sqlite3_disconnect( USES_REGS1 ); -static Int c_sqlite3_number_of_fields( USES_REGS1 ); -static Int c_sqlite3_get_attributes_types( USES_REGS1 ); -static Int c_sqlite3_query( USES_REGS1 ); -static Int c_sqlite3_table_write( USES_REGS1 ); -static Int c_sqlite3_row( USES_REGS1 ); -static Int c_sqlite3_row_cut( USES_REGS1 ); -static Int c_sqlite3_get_fields_properties( USES_REGS1 ); -static Int c_sqlite3_get_next_result_set( USES_REGS1 ); -static Int c_sqlite3_get_database( USES_REGS1 ); -static Int c_sqlite3_change_database( USES_REGS1 ); - -void Yap_InitMYDDAS_SQLITE3Preds(void) -{ +void Yap_InitMYDDAS_SQLITE3Preds(void) { /* db_dbect: Host x User x Passwd x Database x dbection x ERROR_CODE */ - Yap_InitCPred("c_sqlite3_connect", 4, c_sqlite3_connect, 0); + Yap_InitCPred("c_sqlite3_connect", 4, c_sqlite3_connect, 0); /* db_number_of_fields: Relation x connection x NumberOfFields */ - Yap_InitCPred("c_sqlite3_number_of_fields",3, c_sqlite3_number_of_fields, 0); + Yap_InitCPred("c_sqlite3_number_of_fields", 3, c_sqlite3_number_of_fields, 0); /* db_get_attributes_types: Relation x TypesList */ - Yap_InitCPred("c_sqlite3_get_attributes_types", 3, c_sqlite3_get_attributes_types, 0); + Yap_InitCPred("c_sqlite3_get_attributes_types", 3, + c_sqlite3_get_attributes_types, 0); /* db_query: SQLQuery x ResultSet x conection */ Yap_InitCPred("c_sqlite3_query", 5, c_sqlite3_query, 0); /* db_disconnect: connection */ - Yap_InitCPred("c_sqlite3_disconnect", 1,c_sqlite3_disconnect, 0); + Yap_InitCPred("c_sqlite3_disconnect", 1, c_sqlite3_disconnect, 0); /* db_table_write: Result Set */ - Yap_InitCPred("c_sqlite3_table_write", 1, c_sqlite3_table_write, 0); + Yap_InitCPred("c_sqlite3_table_write", 1, c_sqlite3_table_write, 0); /* db_get_fields_properties: PredName x connection x PropertiesList*/ - Yap_InitCPred("c_sqlite3_get_fields_properties",3,c_sqlite3_get_fields_properties,0); + Yap_InitCPred("c_sqlite3_get_fields_properties", 3, + c_sqlite3_get_fields_properties, 0); - Yap_InitCPred("c_sqlite3_get_next_result_set",2,c_sqlite3_get_next_result_set,0); + Yap_InitCPred("c_sqlite3_get_next_result_set", 2, + c_sqlite3_get_next_result_set, 0); /* c_sqlite3_get_database: connection x DataBaseName */ - Yap_InitCPred("c_sqlite3_get_database",2,c_sqlite3_get_database,0); + Yap_InitCPred("c_sqlite3_get_database", 2, c_sqlite3_get_database, 0); /* c_sqlite3_change_database: connection x DataBaseName */ - Yap_InitCPred("c_sqlite3_change_database",2,c_sqlite3_change_database,0); - - + Yap_InitCPred("c_sqlite3_change_database", 2, c_sqlite3_change_database, 0); } -void Yap_InitBackMYDDAS_SQLITE3Preds(void) -{ - /* db_row: ResultSet x Arity x ListOfArgs */ - Yap_InitCPredBackCut("c_sqlite3_row", 3, sizeof(Int), - c_sqlite3_row, - c_sqlite3_row, - c_sqlite3_row_cut, 0); - +void Yap_InitBackMYDDAS_SQLITE3Preds(void) { + /* db_row: ResultSet x Arity x ListOfArgs */ + Yap_InitCPredBackCut("c_sqlite3_row", 3, sizeof(Int), c_sqlite3_row, + c_sqlite3_row, c_sqlite3_row_cut, 0); } -static Int -c_sqlite3_connect( USES_REGS1 ) { +static Int c_sqlite3_connect(USES_REGS1) { Term arg_file = Deref(ARG1); Term arg_db = ARG4; @@ -135,86 +129,73 @@ c_sqlite3_connect( USES_REGS1 ) { MYDDAS_UTIL_CONNECTION new = NULL; sqlite3 *db; - char *file = AtomName(AtomOfTerm(arg_file)); + const char *file = AtomName(AtomOfTerm(arg_file)); - CALL_SQLITE( open(file, &db) ); + CALL_SQLITE(open(file, &db)); if (!Yap_unify(arg_db, MkAddressTerm(db))) - return FALSE; - else - { - /* Criar um novo no na lista de ligacoes*/ - new = myddas_util_add_connection(db,NULL,API_SQLITE3); + return FALSE; + else { + /* Criar um novo no na lista de ligacoes*/ + new = myddas_util_add_connection(db, NULL, API_SQLITE3); - if (new == NULL){ + if (new == NULL) { #ifdef DEBUG - fprintf(stderr, "ERROR: ** c_db_my_connect ** Error allocating memory\n"); + fprintf(stderr, "ERROR: ** c_db_my_connect ** Error allocating memory\n"); #endif - return FALSE; - } - return TRUE; + return FALSE; } - + return TRUE; + } } -static MYDDAS_STATS_TIME -myddas_stat_init_query( sqlite3 *db ) -{ #ifdef MYDDAS_STATS +static MYDDAS_STATS_TIME myddas_stat_init_query(sqlite3 *db) { MYDDAS_UTIL_connecTION node = myddas_util_search_connection(db); MyddasULInt count = 0; /* Count the number of querys made to the server */ MyddasULInt number_querys; - MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE(node,number_querys); - MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE(node,++number_querys); - MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE_COUNT(node,count); - MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE_COUNT(node,++count); + MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE(node, number_querys); + MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE(node, ++number_querys); + MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE_COUNT(node, count); + MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE_COUNT(node, ++count); /* Measure time spent by the sqlite3 Server processing the SQL Query */ return myddas_stats_walltime(); -#else return NULL; -#endif } - static MYDDAS_STATS_TIME -myddas_stat_end_query( MYDDAS_STATS_TIME start ) -{ +myddas_stat_end_query(MYDDAS_STATS_TIME start) { MYDDAS_STATS_TIME diff = NULL; -#ifdef MYDDAS_STATS /* Measure time spent by the sqlite3 Server processing the SQL Query */ end = myddas_stats_walltime(); - MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy); - myddas_stats_subtract_time(diff,end,start); + MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff, time_copy); + myddas_stats_subtract_time(diff, end, start); diff = myddas_stats_time_copy_to_final(diff); - MYDDAS_FREE(end,struct myddas_stats_time_struct); - MYDDAS_FREE(start,struct myddas_stats_time_struct); + MYDDAS_FREE(end, struct myddas_stats_time_struct); + MYDDAS_FREE(start, struct myddas_stats_time_struct); - MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER(node,total_time); + MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER(node, total_time); /* Automacally updates the MYDDAS_STRUCTURE */ - myddas_stats_add_time(total_time,diff,total_time); - MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER_COUNT(node,count); - MYDDAS_STATS_CON_SET_TOTAL_TIME_DBSERVER_COUNT(node,++count); + myddas_stats_add_time(total_time, diff, total_time); + MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER_COUNT(node, count); + MYDDAS_STATS_CON_SET_TOTAL_TIME_DBSERVER_COUNT(node, ++count); MYDDAS_STATS_TIME time = NULL; - MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER(node,time); - myddas_stats_move_time(diff,time); - MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER_COUNT(node,count); - MYDDAS_STATS_CON_SET_LAST_TIME_DBSERVER_COUNT(node,++count); -#endif + MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER(node, time); + myddas_stats_move_time(diff, time); + MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER_COUNT(node, count); + MYDDAS_STATS_CON_SET_LAST_TIME_DBSERVER_COUNT(node, ++count); return diff; } -#ifdef MYDDAS_STATS /* measure transfer time */ -static void -myddas_stat_transfer_query( MYDDAS_STATS_TIME diff ) -{ +static void myddas_stat_transfer_query(MYDDAS_STATS_TIME diff) { /* Measure time spent by the sqlite3 Server transferring the result of the last query back to the client */ @@ -224,133 +205,137 @@ myddas_stat_transfer_query( MYDDAS_STATS_TIME diff ) back to the client */ end = myddas_stats_walltime(); - MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy); - myddas_stats_subtract_time(diff,end,start); + MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff, time_copy); + myddas_stats_subtract_time(diff, end, start); diff = MYDDAS_STATS_TIME_copy_to_final(diff); - MYDDAS_FREE(end,struct myddas_stats_time_struct); - MYDDAS_FREE(start,struct myddas_stats_time_struct); + MYDDAS_FREE(end, struct myddas_stats_time_struct); + MYDDAS_FREE(start, struct myddas_stats_time_struct); - MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING(node,total_time); + MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING(node, total_time); /* Automacally updates the MYDDAS_STRUCTURE */ - myddas_stats_add_time(total_time,diff,total_time); - MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING_COUNT(node,count); - MYDDAS_STATS_CON_SET_TOTAL_TIME_TRANSFERING_COUNT(node,++count); + myddas_stats_add_time(total_time, diff, total_time); + MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING_COUNT(node, count); + MYDDAS_STATS_CON_SET_TOTAL_TIME_TRANSFERING_COUNT(node, ++count); time = NULL; - MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING(node,time); - MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING_COUNT(node,count); - MYDDAS_STATS_CON_SET_LAST_TIME_TRANSFERING_COUNT(node,++count); - myddas_stats_move_time(diff,time); + MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING(node, time); + MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING_COUNT(node, count); + MYDDAS_STATS_CON_SET_LAST_TIME_TRANSFERING_COUNT(node, ++count); + myddas_stats_move_time(diff, time); /* Measure the number of Rows returned from the server */ - if (res_set != NULL) - { - /* With an INSERT statement, sqlite3_(use or store)_result() - returns a NULL pointer*/ + if (res_set != NULL) { + /* With an INSERT statement, sqlite3_(use or store)_result() + returns a NULL pointer*/ - /* This is only works if we use sqlite3_store_result */ - MyddasUInt numberRows = sqlite3_num_rows(res_set); - MyddasUInt rows; - myddas_stat_transfer_query( diff ); + /* This is only works if we use sqlite3_store_result */ + MyddasUInt numberRows = sqlite3_num_rows(res_set); + MyddasUInt rows; + myddas_stat_transfer_query(diff); - MYDDAS_STATS_CON_GET_TOTAL_ROWS(node,rows); - numberRows = numberRows + rows; - MYDDAS_STATS_CON_SET_TOTAL_ROWS(node,numberRows); - MYDDAS_STATS_CON_GET_TOTAL_ROWS_COUNT(node,count); - MYDDAS_STATS_CON_SET_TOTAL_ROWS_COUNT(node,++count); + MYDDAS_STATS_CON_GET_TOTAL_ROWS(node, rows); + numberRows = numberRows + rows; + MYDDAS_STATS_CON_SET_TOTAL_ROWS(node, numberRows); + MYDDAS_STATS_CON_GET_TOTAL_ROWS_COUNT(node, count); + MYDDAS_STATS_CON_SET_TOTAL_ROWS_COUNT(node, ++count); - /* Calculate the ammount of data sent by the server */ - MyddasUInt total,number_fields = sqlite3_num_fields(res_set); - sqlite3_ROW row; - MyddasULInt i; - total=0; - while ((row = sqlite3_fetch_row(res_set)) != NULL){ - sqlite3_field_seek(res_set,0); + /* Calculate the ammount of data sent by the server */ + MyddasUInt total, number_fields = sqlite3_num_fields(res_set); + sqlite3_ROW row; + MyddasULInt i; + total = 0; + while ((row = sqlite3_fetch_row(res_set)) != NULL) { + sqlite3_field_seek(res_set, 0); - for(i=0;idb = db; - start = myddas_stat_init_query( db ); + #if MYDDAS_STATS + start = myddas_stat_init_query(db); + #endif - /* Send query to server and process it */ - if (strcmp(mode,"store_result")!=0) { + /* Send query to server and process it */ + if (strcmp(mode, "store_result") != 0) { // Leave data for extraction printf(" SQL 0: %s\n", sql); - CALL_SQLITE (prepare_v2(db, sql, -1, &stmt, NULL) ); + CALL_SQLITE(prepare_v2(db, sql, -1, &stmt, NULL)); rs->stmt = stmt; rs->res_set = NULL; rs->nrows = -1; - rs->length = sqlite3_column_count( stmt ); - if (!Yap_unify(arg_arity, MkIntegerTerm(rs->length))) - { - free(rs); - return FALSE; - } - if (!Yap_unify(arg_result_set, MkAddressTerm( rs))) - { - free(rs); - return FALSE; - } - return TRUE; - } else{ + rs->length = sqlite3_column_count(stmt); + if (!Yap_unify(arg_arity, MkIntegerTerm(rs->length))) { + free(rs); + return FALSE; + } + if (!Yap_unify(arg_result_set, MkAddressTerm(rs))) { + free(rs); + return FALSE; + } + return true; + } else { // construct an intermediate table, res_set char **res_set; char *msg; int nrows; - CALL_SQLITE (get_table(db, sql, &res_set, &nrows, &length, &msg) ); + CALL_SQLITE(get_table(db, sql, &res_set, &nrows, &length, &msg)); - //end = myddas_stat_end_query( start ); - if (res_set == NULL) - { + // end = myddas_stat_end_query( start ); + if (res_set == NULL) { #ifdef DEBUG - printf("Empty Query!\n"); + printf("Empty Query!\n"); #endif - return TRUE; - } - //INSERT statements don't return any res_set + return TRUE; + } + // INSERT statements don't return any res_set if (nrows == 0) { return TRUE; } - if (!Yap_unify(arg_arity, MkIntegerTerm(nrows))){ + if (!Yap_unify(arg_arity, MkIntegerTerm(nrows))) { free(rs); sqlite3_free_table(res_set); return FALSE; @@ -359,85 +344,78 @@ c_sqlite3_query( USES_REGS1 ) { rs->res_set = res_set; rs->nrows = nrows; rs->length = length; - if (!Yap_unify(arg_result_set, MkAddressTerm( rs))) - { - free(rs); - sqlite3_free_table(res_set); - return FALSE; - } + if (!Yap_unify(arg_result_set, MkAddressTerm(rs))) { + free(rs); + sqlite3_free_table(res_set); + return FALSE; + } } return TRUE; } - -static Int -c_sqlite3_number_of_fields( USES_REGS1 ) { +static Int c_sqlite3_number_of_fields(USES_REGS1) { Term arg_relation = Deref(ARG1); Term arg_db = Deref(ARG2); Term arg_fields = ARG3; - char *relation = AtomName(AtomOfTerm(arg_relation)); + const char *relation = AtomName(AtomOfTerm(arg_relation)); sqlite3 *db = AddressOfTerm(arg_db); sqlite3_stmt *stmt; char sql[256]; - sprintf(sql,"SELECT * FROM `%s`",relation); + sprintf(sql, "SELECT * FROM `%s`", relation); /* executar a query SQL */ printf(" SQL 1: %s\n", sql); -CALL_SQLITE (prepare_v2(db, sql, -1, &stmt, NULL) ); + CALL_SQLITE(prepare_v2(db, sql, -1, &stmt, NULL)); - int fields = sqlite3_column_count( stmt ); + int fields = sqlite3_column_count(stmt); - CALL_SQLITE (finalize( stmt ) ); + CALL_SQLITE(finalize(stmt)); - return Yap_unify(arg_fields, MkIntegerTerm( fields )); + return Yap_unify(arg_fields, MkIntegerTerm(fields)); } - /* db_get_attributes_types: RelName x connection -> TypesList */ -static Int -c_sqlite3_get_attributes_types( USES_REGS1 ) { +static Int c_sqlite3_get_attributes_types(USES_REGS1) { Term arg_relation = Deref(ARG1); Term arg_db = Deref(ARG2); Term arg_types_list = Deref(ARG3); Term list, head; - char *relation = AtomName(AtomOfTerm(arg_relation)); - sqlite3 *db = (sqlite3 *) IntegerOfTerm(arg_db); + const char *relation = AtomName(AtomOfTerm(arg_relation)); + sqlite3 *db = (sqlite3 *)IntegerOfTerm(arg_db); char sql[256]; int row; sqlite3_stmt *stmt; Int rc = TRUE; - sprintf(sql,"SELECT * FROM `%s`",relation); + sprintf(sql, "SELECT * FROM `%s`", relation); /* executar a query SQL */ printf(" SQL 3: %s\n", sql); - CALL_SQLITE (prepare_v2(db, sql, -1, &stmt, NULL) ); + CALL_SQLITE(prepare_v2(db, sql, -1, &stmt, NULL)); - int fields = sqlite3_column_count( stmt ); + int fields = sqlite3_column_count(stmt); list = arg_types_list; - for (row = 0; row < fields; row++) - { + for (row = 0; row < fields; row++) { const char *tm; - head = HeadOfTerm(list); - rc = ( - rc && Yap_unify(head, MkAtomTerm(Yap_LookupAtom(sqlite3_column_name(stmt, row))) ) ); + rc = (rc && Yap_unify(head, MkAtomTerm(Yap_LookupAtom( + sqlite3_column_name(stmt, row))))); list = TailOfTerm(list); head = HeadOfTerm(list); list = TailOfTerm(list); - int type = sqlite3_column_type(stmt,row ); - switch(type) { - case SQLITE_INTEGER: - tm = "integer"; + int type = sqlite3_column_type(stmt, row); + switch (type) { + case SQLITE_INTEGER: + tm = "integer"; break; case SQLITE_FLOAT: tm = "real"; @@ -453,38 +431,32 @@ c_sqlite3_get_attributes_types( USES_REGS1 ) { tm = ""; break; } - if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(tm))) ) + if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(tm)))) rc = FALSE; } - CALL_SQLITE (finalize( stmt ) ); + CALL_SQLITE(finalize(stmt)); return rc; - } /* db_disconnect */ -static Int -c_sqlite3_disconnect( USES_REGS1 ) { +static Int c_sqlite3_disconnect(USES_REGS1) { Term arg_db = Deref(ARG1); - sqlite3 *db = (sqlite3 *) IntegerOfTerm(arg_db); + sqlite3 *db = (sqlite3 *)IntegerOfTerm(arg_db); - if ((myddas_util_search_connection(db)) != NULL) - { - myddas_util_delete_connection(db); - sqlite3_close(db); - return TRUE; - } - else - { - return FALSE; - } + if ((myddas_util_search_connection(db)) != NULL) { + myddas_util_delete_connection(db); + sqlite3_close(db); + return TRUE; + } else { + return FALSE; + } } /* db_table_write: Result Set */ -static Int -c_sqlite3_table_write( USES_REGS1 ) { +static Int c_sqlite3_table_write(USES_REGS1) { /* Term arg_res_set = Deref(ARG1); sqlite3_RES *res_set = (sqlite3_RES *) IntegerOfTerm(arg_res_set); @@ -495,56 +467,54 @@ c_sqlite3_table_write( USES_REGS1 ) { return TRUE; } -static Int -c_sqlite3_get_fields_properties( USES_REGS1 ) { +static Int c_sqlite3_get_fields_properties(USES_REGS1) { Term nome_relacao = Deref(ARG1); Term arg_db = Deref(ARG2); Term fields_properties_list = Deref(ARG3); Term head, list; - char *relation = AtomName(AtomOfTerm(nome_relacao)); + const char *relation = AtomName(AtomOfTerm(nome_relacao)); char sql[256]; - Int num_fields,i; - sqlite3 *db = (sqlite3 *) (IntegerOfTerm(arg_db)); + Int num_fields, i; + sqlite3 *db = (sqlite3 *)(IntegerOfTerm(arg_db)); sqlite3_stmt *stmt; - sprintf(sql,"SELECT * FROM `%s`",relation); + sprintf(sql, "SELECT * FROM `%s`", relation); /* executar a query SQL */ - printf(" SQL 4: %s\n", sql); - CALL_SQLITE (prepare_v2(db, sql, -1, &stmt, NULL) ); + // printf(" SQL 4: %s\n", sql); + CALL_SQLITE(prepare_v2(db, sql, -1, &stmt, NULL)); - Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"),4); + Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"), 4); Term properties[4]; list = fields_properties_list; - num_fields = sqlite3_column_count( stmt ); + num_fields = sqlite3_column_count(stmt); - for (i=0;istmt = stmt; rs->res_set = NULL; rs->nrows = -1; - rs->length = sqlite3_column_count( stmt ); + rs->length = sqlite3_column_count(stmt); rs->db = db; Yap_unify(arg_next_res_set, MkAddressTerm(rs)); } return TRUE; } -static Int -c_sqlite3_get_database( USES_REGS1 ) { +static Int c_sqlite3_get_database(USES_REGS1) { Term arg_con = Deref(ARG1); Term arg_database = Deref(ARG2); - if (!Yap_unify(arg_database,arg_con)) + if (!Yap_unify(arg_database, arg_con)) return FALSE; return TRUE; - } -static Int -c_sqlite3_change_database( USES_REGS1 ) { +static Int c_sqlite3_change_database(USES_REGS1) { /* no-op for now */ return TRUE; } -static Int -c_sqlite3_row_cut( USES_REGS1 ) { - struct result_set *res_set=NULL; +static Int c_sqlite3_row_cut(USES_REGS1) { + struct result_set *res_set = NULL; res_set = AddressOfTerm(CBACK_CUT_ARG(1)); sqlite3 *db = res_set->db; - CALL_SQLITE( finalize( res_set->stmt ) ); + CALL_SQLITE(finalize(res_set->stmt)); free(res_set); return TRUE; } -#define cvt( s ) cvt__( s PASS_REGS ) +#define cvt(s) cvt__(s PASS_REGS) -static Term -cvt__(const char *s USES_REGS) { - return Yap_CharsToTDQ( s, CurrentModule PASS_REGS); +static Term cvt__(const char *s USES_REGS) { + return Yap_CharsToTDQ(s, CurrentModule, LOCAL_encoding PASS_REGS); } /* db_row: ResultSet x Arity_ListOfArgs x ListOfArgs -> */ -static Int -c_sqlite3_row( USES_REGS1 ) { +static Int c_sqlite3_row(USES_REGS1) { #ifdef MYDDAS_STATS /* Measure time used by the */ /* c_sqlite3_row function */ - //MYDDAS_STATS_TIME start,end,total_time,diff; + // MYDDAS_STATS_TIME start,end,total_time,diff; MyddasULInt count = 0; start = myddas_stats_walltime(); #endif @@ -625,13 +588,13 @@ c_sqlite3_row( USES_REGS1 ) { Term arg_list_args = Deref(ARG3); Int rc = TRUE; - if (IsVarTerm( arg_result_set ) ) { - if (!c_sqlite3_query( PASS_REGS1 ) ) { + if (IsVarTerm(arg_result_set)) { + if (!c_sqlite3_query(PASS_REGS1)) { cut_fail(); } arg_result_set = Deref(ARG1); - EXTRA_CBACK_ARG(3,1)= arg_result_set ; - EXTRA_CBACK_ARG(3,2)= MkIntegerTerm(0) ; + EXTRA_CBACK_ARG(3, 1) = arg_result_set; + EXTRA_CBACK_ARG(3, 2) = MkIntegerTerm(0); } struct result_set *res_set = AddressOfTerm(arg_result_set); @@ -640,131 +603,125 @@ c_sqlite3_row( USES_REGS1 ) { list = arg_list_args; arity = IntegerOfTerm(arg_arity); sqlite3 *db = res_set->db; - if (res_set->stmt == NULL ) { + if (res_set->stmt == NULL) { CACHE_REGS - Int indx = IntegerOfTerm(EXTRA_CBACK_ARG(3,2)); + Int indx = IntegerOfTerm(EXTRA_CBACK_ARG(3, 2)); Int rc = true; - // data needs to be copied to Prolog - // row by row +// data needs to be copied to Prolog +// row by row #ifdef MYDDAS_STATS MYDDAS_STATS_TIME diff; - MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy); + MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff, time_copy); #endif - while (indx/arity < res_set->nrows) - { - for (i = 0; i < arity; i++) - { - /* Ts -> List */ - const char *field = res_set->res_set[indx++]; - head = HeadOfTerm(list); - list = TailOfTerm(list); - rc = (rc && Yap_unify(head, cvt( field )) ); - } - if (rc) - return rc; + while (indx / arity < res_set->nrows) { + for (i = 0; i < arity; i++) { + /* Ts -> List */ + const char *field = res_set->res_set[indx++]; + head = HeadOfTerm(list); + list = TailOfTerm(list); + rc = (rc && Yap_unify(head, cvt(field))); } + if (rc) + return rc; + } #ifdef MYDDAS_STATS - myddas_stat_transfer_query( diff ); + myddas_stat_transfer_query(diff); #endif cut_fail(); } // busy-waiting int res; - while((res = sqlite3_step(res_set->stmt)) == SQLITE_BUSY); + while ((res = sqlite3_step(res_set->stmt)) == SQLITE_BUSY) + ; if (res == SQLITE_DONE) { // no more data - CALL_SQLITE (finalize( res_set->stmt ) ); + CALL_SQLITE(finalize(res_set->stmt)); free(res_set); #ifdef MYDDAS_STATS end = myddas_stats_walltime(); - MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy); - myddas_stats_subtract_time(diff,end,start); + MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff, time_copy); + myddas_stats_subtract_time(diff, end, start); diff = myddas_stats_time_copy_to_final(diff); - MYDDAS_FREE(end,struct myddas_stats_time_struct); - MYDDAS_FREE(start,struct myddas_stats_time_struct); + MYDDAS_FREE(end, struct myddas_stats_time_struct); + MYDDAS_FREE(start, struct myddas_stats_time_struct); MYDDAS_STATS_GET_DB_ROW_FUNCTION(total_time); - myddas_stats_add_time(total_time,diff,total_time); + myddas_stats_add_time(total_time, diff, total_time); MYDDAS_STATS_GET_DB_ROW_FUNCTION_COUNT(count); MYDDAS_STATS_SET_DB_ROW_FUNCTION_COUNT(++count); - MYDDAS_FREE(diff,struct myddas_stats_time_struct); -#endif /* MYDDAS_STATS */ - cut_fail(); /* This macro already does a return FALSE */ + MYDDAS_FREE(diff, struct myddas_stats_time_struct); +#endif /* MYDDAS_STATS */ + cut_fail(); /* This macro already does a return FALSE */ } else if (res == SQLITE_ROW) { list = arg_list_args; Term tf; - for (i = 0; i < arity; i++) - { - /* convert data types here */ - head = HeadOfTerm(list); - list = TailOfTerm(list); + for (i = 0; i < arity; i++) { + /* convert data types here */ + head = HeadOfTerm(list); + list = TailOfTerm(list); - int type = sqlite3_column_type(res_set->stmt, i); - switch(type) { - case SQLITE_INTEGER: - tf = Yap_Mk64IntegerTerm( sqlite3_column_int64(res_set->stmt, i)); - break; - case SQLITE_FLOAT: - tf = MkFloatTerm( sqlite3_column_double(res_set->stmt, i)); - break; - case SQLITE_TEXT: - tf = MkAtomTerm( Yap_LookupAtom((const char *)sqlite3_column_text(res_set->stmt, i) )); - break; - case SQLITE_BLOB: - { - size_t bytes = sqlite3_column_bytes(res_set->stmt, i); - tf = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes); - memcpy( ExternalBlobFromTerm( tf ), sqlite3_column_blob(res_set->stmt, i), bytes ); - } - break; - case SQLITE_NULL: - null_atom[0] = MkIntegerTerm(null_id++); - tf = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom); - break; - } - if (!Yap_unify(head, tf)) - rc = FALSE; + int type = sqlite3_column_type(res_set->stmt, i); + switch (type) { + case SQLITE_INTEGER: + tf = Yap_Mk64IntegerTerm(sqlite3_column_int64(res_set->stmt, i)); + break; + case SQLITE_FLOAT: + tf = MkFloatTerm(sqlite3_column_double(res_set->stmt, i)); + break; + case SQLITE_TEXT: + tf = MkAtomTerm(Yap_LookupAtom( + (const char *)sqlite3_column_text(res_set->stmt, i))); + break; + case SQLITE_BLOB: { + size_t bytes = sqlite3_column_bytes(res_set->stmt, i); + tf = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes); + memcpy(ExternalBlobFromTerm(tf), sqlite3_column_blob(res_set->stmt, i), + bytes); + } break; + case SQLITE_NULL: + null_atom[0] = MkIntegerTerm(null_id++); + tf = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"), 1), 1, + null_atom); + break; } + if (!Yap_unify(head, tf)) + rc = FALSE; + } #ifdef MYDDAS_STATS end = myddas_stats_walltime(); - myddas_stats_subtract_time(diff,end,start); + myddas_stats_subtract_time(diff, end, start); diff = myddas_stats_time_copy_to_final(diff); - MYDDAS_FREE(end,struct myddas_stats_time_struct); - MYDDAS_FREE(start,struct myddas_stats_time_struct); + MYDDAS_FREE(end, struct myddas_stats_time_struct); + MYDDAS_FREE(start, struct myddas_stats_time_struct); MYDDAS_STATS_GET_DB_ROW_FUNCTION(total_time); - myddas_stats_add_time(total_time,diff,total_time); + myddas_stats_add_time(total_time, diff, total_time); MYDDAS_STATS_GET_DB_ROW_FUNCTION_COUNT(count); MYDDAS_STATS_SET_DB_ROW_FUNCTION_COUNT(++count); - MYDDAS_FREE(diff,struct myddas_stats_time_struct); + MYDDAS_FREE(diff, struct myddas_stats_time_struct); #endif /* MYDDAS_STATS */ - } else - { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sqlite3: %s", sqlite3_errmsg( db ) ); - } - return rc; + } else { + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sqlite3: %s", + sqlite3_errmsg(db)); + } + return rc; } #else - void Yap_InitMYDDAS_SQLITE3Preds(void); void Yap_InitBackMYDDAS_SQLITE3Preds(void); - -void Yap_InitMYDDAS_SQLITE3Preds(void) -{} -void Yap_InitBackMYDDAS_SQLITE3Preds(void) -{} - +void Yap_InitMYDDAS_SQLITE3Preds(void) {} +void Yap_InitBackMYDDAS_SQLITE3Preds(void) {} #endif diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 94a145620..523775d73 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -26,11 +26,13 @@ set(PL_SOURCES init.yap listing.yap lists.yap - messages.yap load_foreign.yap + messages.yap + meta.yap modules.yap os.yap preddecls.yap + preddyns.yap preds.yap profile.yap protect.yap diff --git a/pl/absf.yap b/pl/absf.yap index 78b6c9871..aa12815ce 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -133,6 +133,7 @@ user:prolog_file_type(qly, qly). user:prolog_file_type(A, executable) :- current_prolog_flag(shared_object_extension, A). + /** @pred user:file_search_path(+Name:atom, -Directory:atom) is nondet diff --git a/pl/arith.yap b/pl/arith.yap index eba41dad0..9448ad320 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -155,35 +155,8 @@ do_c_built_in(X is Y, _, _, P) :- do_c_built_in(phrase(NT,Xs), Mod, H, NTXsNil) :- '$_arith':do_c_built_in(phrase(NT,Xs,[]), Mod, H, NTXsNil). do_c_built_in(phrase(NT,Xs0,Xs), Mod, _, NewGoal) :- - nonvar(NT), nonvar(Mod), - '$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod), - Goal = phrase(NT,Xs0,Xs), - catch(prolog:'$translate_rule'((pseudo_nt --> Mod:NT), Rule), - error(Pat,ImplDep), - ( \+ '$harmless_dcgexception'(Pat), - throw(error(Pat,ImplDep)) - ) - ), - Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0), - Goal \== NewGoal0, - % apply translation only if we are safe - \+ '$contains_illegal_dcgnt'(NT), !, - ( var(Xsc), Xsc \== Xs0c - -> Xs = Xsc, NewGoal1 = NewGoal0 - ; NewGoal1 = (NewGoal0, Xsc = Xs) - ), - ( var(Xs0c) - -> Xs0 = Xs0c, - NewGoal2 = NewGoal1 - ; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2 - ), - '$yap_strip_module'(Mod:NewGoal2, M, NewGoal3), - (nonvar(NewGoal3) -> NewGoal == M:NewGoal3 - ; - var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M) - ; - NewGoal = '$execute_in_mod'(NewGoal3,M) - ). + '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal ). + do_c_built_in(Comp0, _, _, R) :- % now, do it for comparisons '$compop'(Comp0, Op, E, F), !, @@ -267,7 +240,7 @@ expand_expr(T, E, V) :- % after having expanded into Q % and giving as result P (the last argument) expand_expr(Op, X, O, Q, Q) :- - number(X), + number(X), catch(is( O, Op, X),_,fail), !. % do not do error handling at compile time expand_expr(Op, X, O, Q, P) :- '$unary_op_as_integer'(Op,IOp), @@ -362,7 +335,7 @@ expand_expr(Op, X, Y, O, Q, P) :- '$do_and'(Z = X, Y = W, E). -'$goal_expansion_allowed'(phrase(_NT,_Xs0,_Xs), _Mod). +'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod). %% contains_illegal_dcgnt(+Term) is semidet. % diff --git a/pl/attributes.yap b/pl/attributes.yap index 1960d4ff1..2c798d6e3 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -45,6 +45,10 @@ unbind_attvar/1, woken_att_do/4]). +:- dynamic attributes:existing_attribute/4. +:- dynamic attributes:modules_with_attributes/1. +:- dynamic attributes:attributed_module/3. + /** @pred get_attr(+ _Var_,+ _Module_,- _Value_) @@ -426,7 +430,7 @@ prolog:call_residue(Goal,Residue) :- call_residue(Goal,Module,Residue) :- prolog:call_residue_vars(Module:Goal,NewAttVars), ( - attributes:has_modules_with_attributes([_|_]) + attributes:modules_with_attributes([_|_]) -> project_attributes(NewAttVars, Module:Goal) ; @@ -444,7 +448,7 @@ project_delayed_goals(G) :- % just try to simplify store by projecting constraints % over query variables. % called by top_level to find out about delayed goals - attributes:has_modules_with_attributes([_|_]), !, + attributes:modules_with_attributes([_|_]), !, attributes:all_attvars(LAV), LAV = [_|_], project_attributes(LAV, G), !. @@ -487,7 +491,7 @@ attribute_goal/2 handler. */ project_attributes(AllVs, G) :- - attributes:has_modules_with_attributes(LMods), + attributes:modules_with_attributes(LMods), LMods = [_|_], term_variables(G, InputVs), pick_att_vars(InputVs, AttIVs), diff --git a/pl/boot.yap b/pl/boot.yap index c31ee3e5f..e62dd092b 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -186,7 +186,7 @@ list, since backtracking could not "pass through" the cut. */ system_module(Mod, _SysExps, _Decls) :- !, - system_module(Mod). + new_system_module(Mod). use_system_module(_init, _SysExps) :- !. @@ -325,8 +325,6 @@ private(_). Succeed. Succeeds once. - - */ true :- true. @@ -341,7 +339,7 @@ true :- true. repeat, '$current_module'(Module), ( Module==user -> - '$compile_mode'(_,0) + true % '$compile_mode'(_,0) ; format(user_error,'[~w]~n', [Module]) ), @@ -618,11 +616,17 @@ number of steps. % % - '$execute_command'(C,_,_,top,Source) :- var(C), !, - '$do_error'(instantiation_error,meta_call(Source)). -'$execute_command'(C,_,_,top,Source) :- number(C), !, - '$do_error'(type_error(callable,C),meta_call(Source)). - '$execute_command'(R,_,_,top,Source) :- db_reference(R), !, +'$execute_command'(C,_,_,top,Source) :- + var(C), + !, + '$do_error'(instantiation_error,meta_call(Source)). +'$execute_command'(C,_,_,top,Source) :- + number(C), + !, + '$do_error'(type_error(callable,C),meta_call(Source)). + '$execute_command'(R,_,_,top,Source) :- + db_reference(R), + !, '$do_error'(type_error(callable,R),meta_call(Source)). '$execute_command'(end_of_file,_,_,_,_) :- !. '$execute_command'(Command,_,_,_,_) :- @@ -639,11 +643,12 @@ number of steps. O = (:- G1) -> '$process_directive'(G1, Option, M, VL, Pos) - ; + ; '$execute_commands'(O,VL,Pos,Option,O) ). '$execute_command'((?-G), VL, Pos, Option, Source) :- - Option \= top, !, + Option \= top, + !, '$execute_command'(G, VL, Pos, top, Source). '$execute_command'(G, VL, Pos, Option, Source) :- '$continue_with_command'(Option, VL, Pos, G, Source). @@ -658,7 +663,8 @@ number of steps. '$process_directive'(G, top, M, VL, Pos) :- current_prolog_flag(language_mode, yap), !, /* strict_iso on */ '$process_directive'(G, consult, M, VL, Pos). - '$process_directive'(G, top, _, _, _) :- !, + '$process_directive'(G, top, _, _, _) :- + !, '$do_error'(context_error((:- G),clause),query). % % allow modules @@ -676,34 +682,42 @@ number of steps. % ISO does not allow goals (use initialization). % '$process_directive'(D, _, M, _VL, _Pos) :- - current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it, - '$do_error'(context_error((:- M:D),query),directive). + current_prolog_flag(language_mode, iso), + !, % ISO Prolog mode, go in and do it, + '$do_error'(context_error((:- M:D),query),directive). % % but YAP and SICStus does. % '$process_directive'(G, Mode, M, VL, Pos) :- ( '$undefined'('$save_directive'(G, Mode, M, VL, Pos),prolog) -> true - ; + ; '$save_directive'(G, Mode, M, VL, Pos) - -> + -> true - ; + ; true ), - ( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ). + ( + '$execute'(M:G) + -> + true + ; + format(user_error,':- ~w:~w failed.~n',[M,G]) + ). -'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, - '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). +'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- + !, + '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(reconsult,V,Pos,G,Source) :- % writeln(G), - '$go_compile_clause'(G,V,Pos,reconsult,Source), - fail. + '$go_compile_clause'(G,V,Pos,reconsult,Source), + fail. '$continue_with_command'(consult,V,Pos,G,Source) :- '$go_compile_clause'(G,V,Pos,consult,Source), - fail. + fail. '$continue_with_command'(top,V,_,G,_) :- - '$query'(G,V). + '$query'(G,V). % % not 100% compatible with SICStus Prolog, as SICStus Prolog would put @@ -714,13 +728,13 @@ number of steps. % Pos the source position % N where to add first or last % Source the original clause - '$go_compile_clause'(G,Vs,Pos, Where, Source) :- +'$go_compile_clause'(G,Vs,Pos, Where, Source) :- '$precompile_term'(G, G0, G1), !, '$$compile'(G1, Where, G0, _). '$go_compile_clause'(G,Vs,Pos, Where, Source) :- throw(error(system, compilation_failed(G))). - + '$$compile'(C, Where, C0, R) :- '$head_and_body'( C, MH, B ), strip_module( MH, Mod, H), @@ -731,7 +745,6 @@ number of steps. ; true ), - % writeln(Mod:((H:-B))), '$compile'((H:-B), Where, C0, Mod, R). @@ -751,9 +764,10 @@ number of steps. '$init_as_dynamic'( asserta ). '$init_as_dynamic'( assertz ). -'$init_as_dynamic'( consult ) :- '$nb_getval'('$assert_all',on,fail). -'$init_as_dynamic'( reconsult ) :- '$nb_getval'('$assert_all',on,fail). - +'$init_as_dynamic'( consult ) :- + '$nb_getval'('$assert_all',on,fail). +'$init_as_dynamic'( reconsult ) :- + '$nb_getval'('$assert_all',on,fail). '$check_if_reconsulted'(N,A) :- once(recorded('$reconsulted',N/A,_)), @@ -769,7 +783,8 @@ number of steps. '$clear_reconsulting' :- recorded('$reconsulted',X,Ref), erase(Ref), - X == '$', !, + X == '$', + !, ( recorded('$reconsulting',_,R) -> erase(R) ). '$prompt_alternatives_on'(determinism). @@ -777,10 +792,10 @@ number of steps. /* Executing a query */ '$query'(end_of_file,_). - '$query'(G,[]) :- '$prompt_alternatives_on'(OPT), - ( OPT = groundness ; OPT = determinism), !, + ( OPT = groundness ; OPT = determinism), + !, '$yes_no'(G,(?-)). '$query'(G,V) :- ( @@ -827,17 +842,17 @@ number of steps. '$delayed_goals'(G, V, NV, LGs, NCP) :- ( CP is '$last_choice_pt', - '$current_choice_point'(NCP1), + '$current_choice_point'(NCP1), '$attributes':delayed_goals(G, V, NV, LGs), - '$current_choice_point'(NCP2), - '$clean_ifcp'(CP), - NCP is NCP2-NCP1 + '$current_choice_point'(NCP2), + '$clean_ifcp'(CP), + NCP is NCP2-NCP1 ; copy_term_nat(V, NV), LGs = [], % term_factorized(V, NV, LGs), NCP = 0 - ). + ). '$out_neg_answer' :- '$early_print'( help, false), @@ -851,7 +866,7 @@ number of steps. '$user_call'(G, M). '$write_query_answer_true'([]) :- !, - format(user_error,'true',[]). + format(user_error,true,[]). '$write_query_answer_true'(_). @@ -883,18 +898,25 @@ number of steps. % '$add_nl_outside_console', fail ; - C== 10 -> '$add_nl_outside_console', - ( '$undefined'('$early_print'(_,_),prolog) -> - format(user_error,'yes~n', []) - ; - '$early_print'(help,yes) + C== 10 + -> + '$add_nl_outside_console', + ( + '$undefined'('$early_print'(_,_),prolog) + -> + format(user_error,'yes~n', []) + ; + '$early_print'(help,yes) ) ; - C== 13 -> + C== 13 + -> get0(user_input,NC), '$do_another'(NC) ; - C== -1 -> halt + C== -1 + -> + halt ; skip(user_input,10), '$ask_again_for_another' ). @@ -909,7 +931,7 @@ number of steps. '$another'. '$write_answer'(_,_,_) :- - flush_output, + flush_output, fail. '$write_answer'(Vs, LBlk, FLAnsw) :- '$purge_dontcares'(Vs,IVs), @@ -969,7 +991,7 @@ number of steps. format(codes(String),Format,G). '$write_goal_output'(var([V|VL]), First, [var([V|VL])|L], next, L) :- !, - ( First = first -> true ; format(user_error,',~n',[]) ), + ( First = first -> true ; format(user_error,',~n',[]) ), format(user_error,'~a',[V]), '$write_output_vars'(VL). '$write_goal_output'(nonvar([V|VL],B), First, [nonvar([V|VL],B)|L], next, L) :- !, @@ -1281,7 +1303,9 @@ not(G) :- \+ '$execute'(G). ( '$is_metapredicate'(G,CurMod) -> - '$expand_meta_call'(CurMod:G, [], NG) + '$disable_debugging', + ( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ), + '$enable_debugging' ; NG = G ), @@ -1331,6 +1355,11 @@ bootstrap(F) :- !, close(Stream). +% '$undefp'([M0|G0], Default) :- +% writeln(M0:G0), +% fail. + + '$loop'(Stream,exo) :- prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), @@ -1382,10 +1411,15 @@ This predicate is used by YAP for preprocessingStatus) :- % % split head and body, generate an error if body is unbound. % -'$check_head_and_body'((M:H:-B),M,H,B,P) :- +'$check_head_and_body'(C,M,H,B,P) :- + '$yap_strip_module'(C,M1,(MH:-B0)), !, + '$yap_strip_module'(M1:MH,M,H), + ( M == M1 -> B = B0 ; B = M1:B0), error:is_callable(M:H,P). -'$check_head_and_body'(M:H, M, H, true, P) :- + +'$check_head_and_body'(MH, M, H, true, P) :- + '$yap_strip_module'(MH,M,H), error:is_callable(M:H,P). % term expansion % @@ -1428,10 +1462,11 @@ whenever the compilation of arithmetic expressions is in progress. */ expand_term(Term,Expanded) :- - ( '$do_term_expansion'(Term,Expanded) - -> - true - ; + ( + '$do_term_expansion'(Term,Expanded) + -> + true + ; '$expand_term_grammar'(Term,Expanded) ). diff --git a/pl/consult.yap b/pl/consult.yap index 07b2269b8..a709ea63e 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -825,7 +825,6 @@ nb_setval('$if_le1vel',0). true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ), - stop_low_level_trace, fail. '$exec_initialization_goals'. @@ -884,7 +883,7 @@ nb_setval('$if_le1vel',0). '$init_win_graphics', fail. '$do_startup_reconsult'(X) :- - catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error)), + catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)), !, ( current_prolog_flag(halt_after_consult, false) -> true ; halt). '$do_startup_reconsult'(_). @@ -1411,14 +1410,16 @@ Similar to initialization/1, but allows for specifying when */ initialization(G0,OPT) :- expand_goal(G0, G), - catch('$initialization'(G, OPT), Error, '$LoopError'( Error ) ), + catch('$initialization'(G, OPT), Error, '$LoopError'( Error, consult ) ), fail. -initialization(_G,_OPT). +initialization(_G,_OPT) :- + stop_low_level_trace. '$initialization'(G,OPT) :- - error:must_be_of_type(callable, G, initialization(G,OPT)), - error:must_be_of_type(oneof([after_load, now, restore]), OPT, initialization(G0,OPT)), - ( + error:must_be_of_type(callable, G, initialization(G,OPT)), + error:must_be_of_type(oneof([after_load, now, restore]), + OPT, initialization(G0,OPT)), + ( OPT == now -> ( call(G) -> true ; format(user_error,':- ~w:~w failed.~n',[G]) ) @@ -1431,7 +1432,7 @@ initialization(_G,_OPT). -> recordz('$call_at_restore', G, _ ) ). - +:- . /** @} diff --git a/pl/debug.yap b/pl/debug.yap index 263818670..2e1a0aca2 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -301,13 +301,14 @@ be lost. '$trace_meta_call'( G, M, CP ) :- '$do_spy'(G, M, CP, spy ). - + % last argument to do_spy says that we are at the end of a context. It % is required to know whether we are controlled by the debugger. %'$do_spy'(V, M, CP, Flag) :- % writeln('$do_spy'(V, M, CP, Flag)), fail. '$do_spy'(V, M, CP, Flag) :- - '$stop_creeping', +'$stop_low_level_trace', + '$stop_creeping'(_), var(V), !, '$do_spy'(call(V), M, CP, Flag). '$do_spy'(!, _, CP, _) :- @@ -324,7 +325,7 @@ be lost. '$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !, ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ; - + '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !, @@ -333,7 +334,7 @@ be lost. -> '$do_spy'(A, M, CP, CalledFromDebugger) ; - '$stop_creeping', + 'stop_creeping'(_), '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((T->A), M, CP, CalledFromDebugger) :- !, @@ -342,14 +343,14 @@ be lost. ( '$do_spy'(A, M, CP, CalledFromDebugger) ; - '$stop_creeping', + '$stop_creeping'(_), '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((A|B), M, CP, CalledFromDebugger) :- !, ( '$do_spy'(A, M, CP, CalledFromDebugger ) ; - '$stop_creeping', + '$stop_creeping'(_) , '$do_spy'(B, M, CP, CalledFromDebugger ) ). '$do_spy'((\+G), M, CP, CalledFromDebugger) :- !, @@ -412,17 +413,17 @@ be lost. '$continue_debugging'(fail, CalledFromDebugger), fail. -/** +/** * core routine for the debugger - * + * * @param _ GoalNumbera id * @param _ S9c - * @param _ - * @param Retry - * @param Det - * @param false - * - * @return + * @param _ + * @param Retry + * @param Det + * @param false + * + * @return */ '$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :- /* the following choice point is where the predicate is called */ @@ -432,7 +433,7 @@ be lost. /* call port */ '$enter_goal'(GoalNumber, G, Module), '$spycall'(G, Module, CalledFromDebugger, Retry), - '$stop_creeping', + '$stop_creeping'(_) , % make sure we are in system mode when running the debugger. ( '$debugger_deterministic_goal'(G) -> @@ -465,7 +466,7 @@ be lost. ( arg(6, Info, true) -> - '$stop_creeping', + '$stop_creeping'(_) , '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ nb_setarg(6, Info, false) ; @@ -475,7 +476,7 @@ be lost. fail /* to backtrack to spycall */ ) ; - '$stop_creeping', + '$stop_creeping'(_) , '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ '$continue_debugging'(fail, CalledFromDebugger), /* fail port */ @@ -532,54 +533,45 @@ be lost. ), '$execute_nonstop'(G1,M). '$spycall'(G, M, _, _) :- - ( - '$system_predicate'(G,M) - ; - '$system_module'(M) - ), + '$is_metapredicate'(G, M), !, - ( '$is_metapredicate'(G, M) - -> - '$expand_meta_call'(M:G, [], G10), - '$debugger_process_meta_arguments'(G10, M, G1), - '$execute'(M:G1) - ; - '$execute'(M:G) - ). + '$expand_meta_call'(M:G, [], G10), + G10 \== M:G, + CP is '$last_choice_pt', + '$debugger_input', + G10 = NM:NG, + '$do_spy'(NG, NM, CP, spy). '$spycall'(G, M, _, _) :- '$tabled_predicate'(G,M), !, '$continue_debugging_goal'(no, '$execute_nonstop'(G,M)). -'$spycall'(G, M, CalledFromDebugger, InRedo) :- - '$is_metapredicate'(G, M), !, - '$expand_meta_call'(M:G, [], G1), - '$spycall_expanded'(G1, M, CalledFromDebugger, InRedo). '$spycall'(G, M, CalledFromDebugger, InRedo) :- '$spycall_expanded'(G, M, CalledFromDebugger, InRedo). -'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :- - '$predicate_flags'(G,M,F,F), - F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source - % use the interpreter - CP is '$last_choice_pt', - '$clause'(G, M, Cl, _), - % I may backtrack to here from far away - ( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ). '$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :- '$undefined'(G, M), !, '$get_undefined_pred'(G, M, Goal, NM), NM \= M, '$spycall'(Goal, NM, CalledFromDebugger, InRedo). -'$spycall_expanded'(G, M, _, InRedo) :- - % I lost control here. +'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :- CP is '$last_choice_pt', - '$static_clause'(G,M,_,R), - '$stop_creeping', - % I may backtrack to here from far away ( - '$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) - ; - InRedo = true - ). + '$is_source'( G, M ) % use the interpreter + -> + '$clause'(G, M, Cl, _), + % I may backtrack to here from far away + ( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ) + ; + ( + '$static_clause'(G,M,_,R), + '$stop_creeping'(_) , + % I may backtrack to here from far away + ( + '$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) + ; + InRedo = true + ) + ) + ). % % @@ -590,9 +582,9 @@ be lost. '$execute_clause'(G,Mod,Ref,CP), '$$save_by'(CP2), (CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ), - '$stop_creeping' + '$stop_creeping'(_) ; - '$stop_creeping', + '$stop_creeping'(_) , fail ). '$creep'(G,M) :- @@ -602,17 +594,17 @@ be lost. '$execute_nonstop'(G,M), '$$save_by'(CP2), (CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ), - '$stop_creeping' + '$stop_creeping'(_) ; fail ). -/** +/** * call predicate M:G within the ddebugger - * - * - * @return + * + * + * @return */ '$trace'(G,M) :- ( @@ -711,10 +703,17 @@ be lost. set_prolog_flag(debug, OldDeb), % '$skipeol'(0'!), % ' fail. -'$action'(0'<,_,_,_,_,_) :- !, % <'Depth - '$new_deb_depth', - '$skipeol'(0'<), - fail. + '$action'(0'<,_,_,_,_,_) :- !, % <'Depth + '$new_deb_depth', + '$skipeol'(0'<), + fail. + '$action'(0'C,_,_,_,_,_) :- + yap_flag(system_options, Opts), + memberchk( call_tracer, Opts), + !, % <'Depth + '$skipeol'(0'C), + '$start_low_level_trace', + '__NB_setval__'('$debug_jump',false). '$action'(0'^,_,_,G,_,_) :- !, % ' '$print_deb_sterm'(G), '$skipeol'(0'^), diff --git a/pl/error.yap b/pl/error.yap index e750251c5..c02925c0b 100644 --- a/pl/error.yap +++ b/pl/error.yap @@ -17,7 +17,7 @@ domain_error/3, % +Domain, +Values, +Term existence_error/2, % +Type, +Term permission_error/3, % +Action, +Type, +Term - must_be_instantiated/1, % +Term + must_be_instantiated/1, % +Term instantiation_error/1, % +Term representation_error/1, % +Reason is_of_type/2 % +Type, +Term @@ -106,7 +106,7 @@ must_be_of_type(Type, X) :- ; is_not(Type, X) ). -inline(must_be_of_type( callable, X ), error:is_callable(X, _) ). +inline(must_be_of_type( callable, X ), error:is_callable(X, _) ). must_be_of_type(callable, X, Comment) :- !, diff --git a/pl/grammar.yap b/pl/grammar.yap index 79abed62a..824895154 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -85,6 +85,8 @@ Grammar related built-in predicates: :- use_system_module( '$_errors', ['$do_error'/2]). +:- use_module( library( expand_macros ) ). + % :- meta_predicate ^(?,0,?). % ^(Xs, Goal, Xs) :- call(Goal). @@ -100,15 +102,15 @@ Grammar related built-in predicates: prolog:'$translate_rule'(Rule, (NH :- B) ) :- source_module( SM ), '$yap_strip_module'( SM:Rule, M0, (LP-->RP) ), - t_head(LP, NH0, NGs, S, SR, (LP-->M:RP)), + t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)), '$yap_strip_module'( M0:NH0, M, NH1 ), - ( M == SM -> NH = NH1, B = B0 ; NH = M:NH1, B = M:B0 ), + ( M == SM -> NH = NH1 ; NH = M:NH1 ), (var(NGs) -> t_body(RP, _, last, S, SR, B1) ; t_body((RP,{NGs}), _, last, S, SR, B1) ), - t_tidy(B1, B0). + t_tidy(B1, B). t_head(V, _, _, _, _, G0) :- var(V), !, @@ -265,6 +267,55 @@ prolog:'\\+'(A, S0, S) :- t_body(\+ A, _, last, S0, S, Goal), '$execute'(Goal). +:- multifile system:goal_expansion/2. + +:- dynamic system:goal_expansion/2. + +'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :- + catch(prolog:'$translate_rule'( + (pseudo_nt --> Mod:NT), Rule), + error(Pat,ImplDep), + ( \+ '$harmless_dcgexception'(Pat), + throw(error(Pat,ImplDep)) + ) + ), + Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0), + Goal \== NewGoal0, + % apply translation only if we are safe + \+ '$contains_illegal_dcgnt'(NT), + !, + ( var(Xsc), Xsc \== Xs0c + -> Xs = Xsc, NewGoal1 = NewGoal0 + ; NewGoal1 = (NewGoal0, Xsc = Xs) + ), + ( var(Xs0c) + -> Xs0 = Xs0c, + NewGoal2 = NewGoal1 + ; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2 + ), + '$yap_strip_module'(Mod:NewGoal2, M, NewGoal3), + (nonvar(NewGoal3) -> NewGoal = M:NewGoal3 + ; + var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M) + ; + NewGoal = '$execute_in_mod'(NewGoal3,M) + ). + +allowed_module(phrase(_,_),_). +allowed_module(phrase(_,_,_),_). + + +system:goal_expansion(Mod:phrase(NT,Xs, Xs),Mod:NewGoal) :- + source_module(M), + nonvar(NT), nonvar(Mod), + '$goal_expansion_allowed', + '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal). + +system:goal_expansion(Mod:phrase(NT,Xs0),Mod:NewGoal) :- + source_module(M), + nonvar(NT), nonvar(Mod), + '$goal_expansion_allowed', + '$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal). /** @} diff --git a/pl/init.yap b/pl/init.yap index 4e3f97369..e126353c9 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -22,7 +22,6 @@ @{ */ - :- system_module( '$_init', [!/0, (:-)/1, (?-)/1, @@ -44,17 +43,18 @@ :- use_system_module( '$_boot', ['$cut_by'/1]). -% This is yap's init file +% This is the YAP init file % should be consulted first step after booting % These are pseudo declarations % so that the user will get a redefining system predicate + + +:- '$init_pred_flag_vals'('$flag_info'(a,0), prolog). + /** @pred fail is iso - Always fails. - - */ fail :- fail. @@ -160,7 +160,6 @@ print_message(Level, Msg) :- 'preds.yap', 'modules.yap' ]. -:- stop_low_level_trace. :- use_module('error.yap'). :- use_module('grammar.yap'). @@ -281,7 +280,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP). :- set_prolog_flag(generate_debug_info,true). - % % cleanup ensure loaded and recover some data-base space. % @@ -291,7 +289,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP). :- set_value('$user_module',user), '$protect'. -:- style_check([-discontiguous,-multiple,-single_var]). +:- style_check([+discontiguous,+multiple,+single_var]). % % moved this to init_gc in gc.c to separate the alpha @@ -376,6 +374,7 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th Add some tests */ + :- yap_flag(user:unknown,error). :- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true. diff --git a/pl/listing.yap b/pl/listing.yap index d3929a77c..0c5e4fe0b 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -59,9 +59,10 @@ name starts with a `$` character. listing :- current_output(Stream), '$current_module'(Mod), + \+ system_module(Mod), Mod \= prolog, Mod \= system, - \+ '$hidden'( Mod ), + \+ '$hidden_atom'( Mod ), '$current_predicate'(_,Mod,Pred, user), '$undefined'(Pred, prolog), % skip predicates exported from prolog. functor(Pred,Name,Arity), diff --git a/pl/lists.yap b/pl/lists.yap index ea0e69657..cad749eef 100644 --- a/pl/lists.yap +++ b/pl/lists.yap @@ -2,9 +2,9 @@ * @file pl/lists.yap * @author VITOR SANTOS COSTA * @date Thu Nov 19 09:54:00 2015 - * - * @brief core lisy operations - * + * + * @brief core list operations + * * @ingroup lists * @{ */ @@ -17,41 +17,40 @@ % means the same thing, but may only be used to test whether a known % Element occurs in a known Set. In return for this limited use, it % is more efficient when it is applicable. - -/** @pred memberchk(+ _Element_, + _Set_) +/** @pred memberchk(+ _Element_, + _Set_) As member/2, but may only be used to test whether a known _Element_ occurs in a known Set. In return for this limited use, it is more efficient when it is applicable. - + */ lists:memberchk(X,[X|_]) :- !. lists:memberchk(X,[_|L]) :- lists:memberchk(X,L). -% member(?Element, ?Set) +%% member(?Element, ?Set) % is true when Set is a list, and Element occurs in it. It may be used % to test for an element or to enumerate all the elements by backtracking. % Indeed, it may be used to generate the Set! -/** @pred member(? _Element_, ? _Set_) +/** @pred member(? _Element_, ? _Set_) True when _Set_ is a list, and _Element_ occurs in it. It may be used to test for an element or to enumerate all the elements by backtracking. - + */ lists:member(X,[X|_]). lists:member(X,[_|L]) :- lists:member(X,L). - + %% @pred identical_member(?Element, ?Set) is nondet % % identical_member holds true when Set is a list, and Element is -% exactly identical to one of the elements that occurs in it. +% exactly identical to one of the elements that occurs in it. lists:identical_member(X,[Y|M]) :- ( @@ -60,14 +59,14 @@ lists:identical_member(X,[Y|M]) :- M \= [], lists:identical_member(X,M) ). -/** @pred append(? _List1_,? _List2_,? _List3_) +/** @pred append(? _List1_,? _List2_,? _List3_) Succeeds when _List3_ unifies with the concatenation of _List1_ and _List2_. The predicate can be used with any instantiation pattern (even three variables). - + */ lists:append([], L, L). lists:append([H|T], L, [H|R]) :- @@ -80,14 +79,14 @@ lists:append([H|T], L, [H|R]) :- % is true when List is a list, in which Elem may or may not occur, and % Residue is a copy of List with all elements identical to Elem lists:deleted. -/** @pred delete(+ _List_, ? _Element_, ? _Residue_) +/** @pred delete(+ _List_, ? _Element_, ? _Residue_) eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee True when _List_ is a list, in which _Element_ may or may not occur, and _Residue_ is a copy of _List_ with all elements identical to _Element_ deleted. -eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee */ lists:delete([], _, []). lists:delete([Head|List], Elem, Residue) :- @@ -140,4 +139,3 @@ prolog:length(L, M) :- M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ). %% @} - diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 6dcb483b5..cf0b344ed 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -52,6 +52,7 @@ YAP also supports the SWI-Prolog interface to loading foreign code: */ load_foreign_files(Objs,Libs,Entry) :- + source_module(M), '$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)), '$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)), '$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)), diff --git a/pl/meta.yap b/pl/meta.yap index 4aa3bf615..79132a1f3 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -64,7 +64,7 @@ meta_predicate declaration '$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :- '$yap_strip_module'(HM:H, M, NH), '$module_transparent'(_, M, _, NH), !. -'$is_mt'(_H, B, HM, _SM, BM, B, BM). +'$is_mt'(_H, B, _HM, _SM, BM, B, BM). @@ -115,7 +115,7 @@ meta_predicate declaration '$do_module_u_vars'(0,_,_,[]) :- !. '$do_module_u_vars'(I,D,H,LF) :- - arg(I,D,X), ( X=':' ; integer(X)), + arg(I,D,X), ( X=':' -> true ; integer(X)), arg(I,H,A), '$uvar'(A, LF, L), !, I1 is I-1, '$do_module_u_vars'(I1,D,H,L). @@ -130,6 +130,50 @@ meta_predicate declaration '$uvar'('^'( _, G), LF, L) :- '$uvar'(G, LF, L). +/** + * @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_) + * + * expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore + * + * @return +*/ +'$meta_expand'(G, _, CM, HVars, OG) :- + var(G), + !, + ( + lists:identical_member(G, HVars) + -> + OG = G + ; + OG = CM:G + ). +% nothing I can do here: +'$meta_expand'(G0, PredDef, CM, HVars, NG) :- + G0 =.. [Name|GArgs], + PredDef =.. [Name|GDefs], + functor(PredDef, Name, Arity ), + length(NGArgs, Arity), + NG =.. [Name|NGArgs], + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). + +'$expand_args'([], _, [], _, []). +'$expand_args'([A|GArgs], CM, [M|GDefs], HVars, [NA|NGArgs]) :- + ( M == ':' -> true ; number(M) ), + !, + '$expand_arg'(A, CM, HVars, NA), + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). +'$expand_args'([A|GArgs], CM, [_|GDefs], HVars, [A|NGArgs]) :- + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). + + +% check if an argument should be expanded +'$expand_arg'(G, CM, HVars, OG) :- + var(G), + !, + ( lists:identical_member(G, HVars) -> OG = G; OG = CM:G). +'$expand_arg'(G, CM, _HVars, NCM:NG) :- + '$yap_strip_module'(CM:G, NCM, NG). + % expand module names in a body % args are: % goals to expand @@ -171,25 +215,31 @@ meta_predicate declaration !, ( lists:identical_member(V, HVars) -> - '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) + '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) ; ( atom(BM) -> NG = call(BM:V), NGO = '$execute_in_mod'(V,BM) - ; - '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H) + ; + '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H) ) - ). + ). '$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :- - !, - '$yap_strip_module'( BM:V, CM, G), - '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH). + '$yap_strip_module'( BM:V, CM, G), + nonvar(CM), + !, + '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH). + +'$expand_goals'(CM0:V,NG,NGO,HM,SM,BM,HVarsH) :- + strip_module( CM0:V, CM, G), + !, + '$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH). % if I don't know what the module is, I cannot do anything to the goal, % so I just put a call for later on. '$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :- var(BM), - !, + !, NG = call(BM:V), NGO = '$execute_wo_mod'(V,BM). '$expand_goals'(depth_bound_call(G,D), @@ -268,21 +318,30 @@ meta_predicate declaration '$expand_goals'(true,true,true,_,_,_,_) :- !. '$expand_goals'(fail,fail,fail,_,_,_,_) :- !. '$expand_goals'(false,false,false,_,_,_,_) :- !. -'$expand_goals'(M:G,call(M:G), - '$execute_wo_mod'(G,M),_,_,_,_) :- - var(M), - !. '$expand_goals'(G, G1, GO, HM, SM, BM, HVars) :- '$yap_strip_module'(BM:G, NBM, GM), - '$do_expand_goals'(NBM:GM, G1, GO, HM, SM, BM, HVars). + '$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars). -'$do_expand_goals'(V:G, call(V:G), call(V:G), HM, SM, BM, HVars) :- - var(V), !. -'$do_expand_goals'(G, G1, GO, HM, SM, BM, HVarsH) :- - '$yap_strip_module'(BM:G, NBM, GM), - '$do_expand_goal'(GM, G1, GO, HM, SM, NBM, HVarsH). +'$user_expansion'(MG, M2:G2) :- + '_user_expand_goal'(MG, MG2), + !, + '$yap_strip_module'( MG2, M2, G2). +'$user_expansion'(MG, MG). - /** + +'$import_expansion'(M:G, M1:G1) :- + '$imported_predicate'(G, M, G1, M1), + !. +'$import_expansion'(MG, MG). + +'$meta_expansion'(GM:G, BM, HVars, GM:GF) :- + functor(G, F, Arity ), + '$meta_predicate'(F, GM, Arity, PredDef), + !, + '$meta_expand'(G, PredDef, BM, HVars, GF). + '$meta_expansion'(GM:G, _BM, _HVars, GM:G). + + /** * @brief Perform meta-variable and user expansion on a goal _G_ * * given the example @@ -300,99 +359,36 @@ o:p(B) :- n:g, X is 2+3, call(B). * @param HM source module, input, m * @param M current module, input, `n`, `m`, `m` * @param HVars-H, list of meta-variables and initial head, `[]` and `p(B)` - * - * + * + * */ -'$expand_goal'(GM, G1F, GOF, HM, SM, BM, HVarsH) :- - '$yap_strip_module'(BM:GM, M, G), - '$do_expand_goal'(G, G1F, GOF, HM, SM, M, HVarsH). +'$expand_goal'(G0, G1F, GOF, HM, SM, BM, HVars-H) :- + '$yap_strip_module'( BM:G0, M0N, G0N), + '$user_expansion'(M0N:G0N, M1:G1), + '$import_expansion'(M1:G1, M2:G2), + '$meta_expansion'(M2:G2, M1, HVars, M2:B1F), + '$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M2, H). -'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVarsH) :- - '_user_expand_goal'(BM:G, BMG2), !, - '$yap_strip_module'( BMG2, BM2, G2), - '$new_cycle_of_goal_expansion'( G2, BM:G, G1F, GOF, HM, SM, BM2, HVarsH). -'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVars-H) :- - % expand import table, to avoid overheads - ( - '$imported_predicate'(G, BM, GI, MI) - -> - true - ; - GI = G, - MI = BM - ), - % expand meta-arguments using the call module, BM, not the actual built-in module, MI - ( - functor(GI, F, Arity ), - '$meta_predicate'(F,MI,Arity,PredDef) - -> - '$meta_expand'(GI, PredDef, HM, SM, BM, HVars, GG) - ; - GI = GG - ), - '$end_goal_expansion'(GG, G1F, GOF, HM, SM, MI, H). - - -/** - * @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_) -1 * - * expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore - * - * @return -*/ -'$meta_expand'(G, _, _HM, _SM, CM, HVars, OG) :- - var(G), - !, - ( - lists:identical_member(G, HVars) - -> - OG = G - ; - OG = CM:G - ). -% nothing I can do here: -'$meta_expand'(G0, PredDef, HM, SM, CM, HVars, NG) :- - G0 =.. [Name|GArgs], - PredDef =.. [Name|GDefs], - functor(PredDef, Name, Arity ), - length(NGArgs, Arity), - NG =.. [Name|NGArgs], - '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs). - -'$expand_args'([], _, _ , _, [], _, []). -'$expand_args'([A|GArgs], HM, SM, CM, [M|GDefs], HVars, [NA|NGArgs]) :- - ( M == ':' -> true ; number(M) ), - !, - '$expand_arg'(A, HM, SM, CM, HVars, NA), - '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs). -'$expand_args'([A|GArgs], HM, SM, CM, [_|GDefs], HVars, [A|NGArgs]) :- - '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs). - - -% check if an argument should be expanded -'$expand_arg'(G, _HM, _SM, CM, HVars, OG) :- - var(G), - !, - ( lists:identical_member(G, HVars) -> OG = G; OG = CM:G). -'$expand_arg'(G, _HM, _SM, CM, _HVars, NCM:NG) :- - '$yap_strip_module'(CM:G, NCM, NG). - '$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :- '$match_mod'(G, HM, SM, BM, G1F), '$c_built_in'(G1F, BM, H, GO), '$yap_strip_module'(BM:GO, MO, IGO), '$match_mod'(IGO, HM, SM, MO, GOF). -'$new_cycle_of_goal_expansion'( G, BM:G1, G1F, GOF, HM, SM, M, HVarsH) :- - BM:G1 \== M:G, - !, - '$expand_goals'(G, G1F, GOF, HM, SM, BM, HVarsH). +'$user_expansion'(M0N:G0N, M1:G1) :- + '_user_expand_goal'(M0N:G0N, M:G), + ( M:G == M0N:G0N + -> + M1:G1 = M:G + ; + '$user_expansion'(M:G, M1:G1) + ). -'$match_mod'(G, HMod, SMod, M, O) :- + '$match_mod'(G, HMod, SMod, M, O) :- ( % \+ '$is_multifile'(G1,M), %-> - '$system_predicate'(G,prolog) + '$is_system_predicate'(G,prolog) -> O = G ; @@ -403,20 +399,11 @@ o:p(B) :- n:g, X is 2+3, call(B). O = M:G ). -expand_goal(Input, Output) :- - '$expand_meta_call'(Input, [], Output ). - -'$expand_meta_call'(G, HVars, MF:GF ) :- - source_module(SM), - '$yap_strip_module'(SM:G, M, IG), - '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), - '$yap_strip_module'(M:GF0, MF, GF). - '$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !. '$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !. '$build_up'(HM, NH, SM, B1, (NH :- B1), BO, ( NH :- BO)) :- HM == SM, !. '$build_up'(HM, NH, _SM, B1, (HM:NH :- B1), BO, ( HM:NH :- BO)) :- !. - + '$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !. '$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :- '$module_u_vars'(HM , H, UVars), % collect head variables in @@ -447,7 +434,7 @@ expand_goal(Input, Output) :- '$verify_import'(_M:G, prolog:G) :- - '$system_predicate'(G, prolog). + '$is_system_predicate'(G, prolog). '$verify_import'(M:G, NM:NG) :- '$get_undefined_pred'(G, M, NG, NM), !. @@ -480,6 +467,15 @@ expand_goal(Input, Output) :- '$build_up'(HM, NH, SM0, B1, Cl1, BO, ClO). +expand_goal(Input, Output) :- + '$expand_meta_call'(Input, [], Output ). + +'$expand_meta_call'(G, HVars, MF:GF ) :- + source_module(SM), + '$yap_strip_module'(SM:G, M, IG), + '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), + '$yap_strip_module'(M:GF0, MF, GF). + :- '$meta_predicate'(prolog:( abolish(:), abolish(:,+), diff --git a/pl/modules.yap b/pl/modules.yap index 36a0ca5cf..0dd221d66 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -230,7 +230,6 @@ Unfortunately it is still not possible to change argument order. use_module(F,Is) :- '$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)). - '$module'(O,N,P,Opts) :- !, '$module'(O,N,P), '$process_module_decls_options'(Opts,module(Opts,N,P)). @@ -303,16 +302,20 @@ module is called, or as soon as it becomes the current type-in module. */ current_module(Mod) :- '$all_current_modules'(Mod), - \+ prolog:'$system_module'(Mod). + \+ '$hidden_atom'(Mod). /** @pred current_module( ? Mod:atom, ? _F_ : file ) is nondet Succeeds if _M_ is a module associated with the file _F_, that is, if _File_ is the source for _M_. If _M_ is not declared in a file, _F_ unifies with `user`. */ current_module(Mod,TFN) :- - '$all_current_modules'(Mod), + ( atom(Mod) -> true ; '$all_current_modules'(Mod) ), ( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ). +system_module(Mod) :- + ( atom(Mod) -> true ; '$all_current_modules'(Mod) ), + '$is_system_module'(Mod). + '$trace_module'(X) :- telling(F), tell('P0:debug'), @@ -345,7 +348,7 @@ current_module(Mod,TFN) :- % be careful here not to generate an undefined exception. '$imported_predicate'(G, ImportingMod, G, prolog) :- - '$system_predicate'(G, prolog), !. + nonvar(G), '$is_system_predicate'(G, prolog), !. '$imported_predicate'(G, ImportingMod, G0, ExportingMod) :- ( var(G) -> true ; var(ImportingMod) -> true ; @@ -365,7 +368,7 @@ current_module(Mod,TFN) :- '$pred_exists'(G, user), !. '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- recorded('$dialect',swi,_), - get_prolog_flag(autoload, true), + prolog_flag(autoload, true), prolog_flag(unknown, OldUnk, fail), ( '$autoload'(G, ImportingMod, ExportingModI, swi) @@ -385,6 +388,7 @@ current_module(Mod,TFN) :- '$autoload'(G, _ImportingMod, ExportingMod, Dialect) :- functor(G, Name, Arity), + '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect), call(Dialect:index(Name,Arity,ExportingMod,_)), !. '$autoload'(G, ImportingMod, ExportingMod, _Dialect) :- @@ -400,7 +404,7 @@ current_module(Mod,TFN) :- autoloader:find_predicate(G,ExportingModI). '$autoloader_find_predicate'(G,ExportingModI) :- yap_flag(autoload, true, false), - yap_flag( unknown, Unknown, fast_fail), + yap_flag( unknown, Unknown, fail), yap_flag(debug, Debug, false), !, load_files([library(autoloader), autoloader:library('INDEX'), @@ -427,7 +431,6 @@ be associated to a new file. '$declare_module'(Name, _Super, Context, _File, _Line) :- add_import_module(Name, Context, start). - /** \pred abolish_module( + Mod) is det get rid of a module and of all predicates included in the module. @@ -762,6 +765,8 @@ unload_module(Mod) :- /* debug */ module_state :- recorded('$module','$module'(HostF,HostM,SourceF, Everything, Line),_), - format('HostF ~a, HostM ~a, SourceF ~w, Everything ~w, Line ~d.~n', [HostF,HostM,SourceF, Everything, Line]), + format('HostF ~a, HostM ~a, SourceF ~w, Line ~d,~n Everything ~w.~n', [HostF,HostM,SourceF, Line, Everything]), + recorded('$import','$import'(HostM,M,G0,G,_N,_K),R), + format(' ~w:~w :- ~w:~w.~n',[M,G,HostM,G0]), fail. module_state. diff --git a/pl/newmod.yap b/pl/newmod.yap index 158cea28d..94377f91e 100644 --- a/pl/newmod.yap +++ b/pl/newmod.yap @@ -43,7 +43,7 @@ name with the `:/2` operator. **/ '$module_dec'(system(N), Ps) :- !, - '$system_module'(N), + new_system_module(N), recordz('$system_initialization', prolog:'$mk_system_predicates'( Ps , N ), _), '$current_module'(_,N). '$module_dec'(N, Ps) :- diff --git a/pl/preddecls.yap b/pl/preddecls.yap index 05467f39a..4b938f790 100644 --- a/pl/preddecls.yap +++ b/pl/preddecls.yap @@ -25,6 +25,8 @@ :- use_system_module( '$_errors', ['$do_error'/2]). +'$log_upd'(1). + /** @defgroup YAPPredDecls Declaring Properties of Predicates @ingroup YAPCompilerSettings diff --git a/pl/preddyns.yap b/pl/preddyns.yap index 1bc3496ec..3d8e198af 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -177,8 +177,8 @@ source/0 ( (see Setting the Compiler)). */ retract( C ) :- - strip_module( C, M, H0), - '$check_head_and_body'(M:H0,_M,H,B,retract(M:C)), + strip_module( C, M, C0), + '$check_head_and_body'(C0,M,H,B,retract(M:C)), '$predicate_flags'(H, M, F, F), '$retract2'(F, H,M,B,_). @@ -214,28 +214,29 @@ database reference is _R_. The predicate must be dynamic. */ retract(M:C,R) :- !, - strip_module( C, M, H0), + '$yap_strip_module'( C, M, H0), '$retract'(H0, M, R). -'$retract'(C, M, R) :- +'$retract'(C, M0, R) :- db_reference(R), !, '$is_dynamic'(H,M), - '$check_head_and_body'(M:C,_M,H,B,retract(C,R)), + '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), instance(R,(H:-B)), erase(R). -'$retract'(C,M,R) :- - '$check_head_and_body'(C,_M,H,B,retract(C,R)), +'$retract'(C,M0,R) :- + '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), var(R), !, '$retract2'(H, M, B, R). '$retract'(C,M,_) :- - '$fetch_predicate_indicator_from_clause'(C, PI), - \+ '$dynamic'(Na/Ar,M), + '$fetch_predicate_indicator_from_clause'(C, M, PI), + \+ '$dynamic'(PI), '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). -'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !, -functor(C, Na, Ar). -'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :- +'$fetch_predicate_indicator_from_clause'((C :- _), M:Na/Ar) :- + !, + functor(C, Na, Ar). +'$fetch_predicate_indicator_from_clause'(C, M:Na/Ar) :- functor(C, Na, Ar). diff --git a/pl/preds.yap b/pl/preds.yap index 24cc76dad..250ccf9ee 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -117,7 +117,7 @@ Adds clause _C_ as the first clause for a static procedure. */ -asserta_static(CI) :- +asserta_static(CI) :- '$assert'(C , asserta_static, _ ). @@ -137,7 +137,7 @@ static predicates, if source mode was on when they were compiled: */ -assertz_static(CI) :- +assertz_static(CI) :- '$assert'(C , assertz_static, _ ). /** @pred clause(+ _H_, _B_) is iso @@ -165,7 +165,7 @@ reference to the clause in the database. You can use instance/2 to access the reference's value. Note that you may not use erase/1 on the reference on static procedures. */ -clause(P,Q,R) :- +clause(P,Q,R) :- '$instance_module'(R,M0), !, instance(R,T0), ( T0 = (H :- B) -> Q = B ; H=T0, Q = true), @@ -175,7 +175,7 @@ clause(P,Q,R) :- M == M1 -> H1 = T - ; + ; M1:H1 = T ). clause(V0,Q,R) :- @@ -188,18 +188,18 @@ clause(V0,Q,R) :- Q = true, R = '$exo_clause'(M,P), '$execute0'(P, M). -'$clause'(P,M,Q,R) :- - '$is_source'(P, M), !, - '$static_clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- '$is_log_updatable'(P, M), !, '$log_update_clause'(P,M,Q,R). +'$clause'(P,M,Q,R) :- + '$is_source'(P, M), !, + '$static_clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- '$some_recordedp'(M:P), !, '$recordedp'(M:P,(P:-Q),R). '$clause'(P,M,Q,R) :- \+ '$undefined'(P,M), - ( '$system_predicate'(P,M) -> true ; + ( '$is_system_predicate'(P,M) -> true ; '$number_of_clauses'(P,M,N), N > 0 ), functor(P,Name,Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity), @@ -533,7 +533,7 @@ predicate_property(Pred,Prop) :- '$pred_exists'(Orig, SourceMod). '$predicate_property'(P,M,_,built_in) :- - '$system_predicate'(P,M). + '$is_system_predicate'(P,M). '$predicate_property'(P,M,_,source) :- '$predicate_flags'(P,M,F,F), F /\ 0x00400000 =\= 0. @@ -584,7 +584,7 @@ predicate_statistics(P0,NCls,Sz,ISz) :- '$is_log_updatable'(P, M), !, '$lu_statistics'(P,NCls,Sz,ISz,M). '$predicate_statistics'(P,M,_,_,_) :- - '$system_predicate'(P,M), !, fail. + '$is_system_predicate'(P,M), !, fail. '$predicate_statistics'(P,M,_,_,_) :- '$undefined'(P,M), !, fail. '$predicate_statistics'(P,M,NCls,Sz,ISz) :- @@ -613,36 +613,12 @@ Defines the relation: _P_ is a currently defined predicate whose name is the at */ current_predicate(A,T0) :- '$yap_strip_module'(T0, M, T), - ( - '$current_predicate'(A, M, T, user) - ; - '$imported_predicate'(T, M, SourceT, SourceMod), - functor(T, A, _), - \+ '$system_predicate'(SourceT, SourceMod) - ). - -/** @pred system_predicate( _A_, _P_) - - Defines the relation: _P_ is a built-in predicate whose name -is the atom _A_. - -*/ -system_predicate(A,T1) :- - '$yap_strip_module'( T1, M, T), - '$system_predicate3'( A, M, T). - -'$system_predicate3'( A, M, T) :- - ( - M \= prolog, - '$current_predicate'(A, M, T, system) - ; - '$imported_predicate'(T, M, SourceT, SourceMod), - M \= prolog, - functor(T, A, _), - '$system_predicate'(SourceT, SourceMod) - ; - '$current_predicate'(A, prolog, T, system) - ). + ( + '$current_predicate'(A,M, T, user) + ; + '$imported_predicate'(T, M, T1, M1), + \+ '$is_system_predicate'(T1,M1) + ). /** @pred system_predicate( ?_P_ ) @@ -652,22 +628,32 @@ system_predicate(P0) :- strip_module(P0, M, P), ( - var(P) + P = A/Arity, ground(P) -> - P = A/Arity, - '$system_predicate3'( A, M, T), + functor(T, A, Arity), + '$current_predicate'(A, M, T, _system), + '$is_system_predicate'( T, M) + ; + P = A//Arity2, ground(P) + -> + Arity is Arity2-2, + functor(T, A, Arity), + '$current_predicate'(A, M, T, _system), + '$is_system_predicate'( T, M) + ; + P = A/Arity + -> + '$current_predicate'(A, M, T, _system), + '$is_system_predicate'( T, M), functor(T, A, Arity) ; P = A//Arity2 -> - '$system_predicate3'( A, M, T), + '$current_predicate'(A, M, T, _system), + '$is_system_predicate'( T, M), functor(T, A, Arity), - Arity2 is Arity+2 - ; - P = A/Arity - -> - '$system_predicate3'( A, M, T), - functor(T, A, Arity) + Arity >= 2, + Arity2 is Arity-2 ; '$do_error'(type_error(predicate_indicator,P), system_predicate(P0)) diff --git a/pl/protect.yap b/pl/protect.yap index b4c4d17e2..f6d65049f 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -19,33 +19,21 @@ xc/************************************************************************* % This protects all code from further changes % and also makes it impossible from some predicates to be seen -'$protect' :- - '$current_predicate'(_A, M, T0, all), - %format(' ~a ~n', [M]) , - '$system_module'(M), - '$predicate_flags'(T0, M, Flags, Flags), - % not multifile, dynamic, or logical updates. - Flags /\ (0x20000000\/0x08000000\/0x00002000) =\= 0, - NFlags is Flags \/ 0x00004000, - '$predicate_flags'(T0, M, _Flags, NFlags), - %format('~w ~16r ~16r~n', [T0,Flags, NFlags]) , - fail. '$protect' :- current_atom(Name), - atom_codes(Name,[0'$|_]), %' - '$hide_predicates'(Name), - '$hide'(Name), - fail. + sub_atom(Name,0,1,_, '$'), + '$hide'(Name), + fail. '$protect' :- - '$hide_predicates'(bootstrap), - hide(bootstrap). + '$all_current_modules'(M), + M \= user, + '$current_predicate'(_,M,P,_), + functor(P,N,A), + '$new_system_predicate'(N,A,M), + % writeln(N/A), + fail. '$protect'. -'$hide_predicates'(Name) :- - '$current_predicate'(Name, Mod, P, all), - '$hide_predicate'(P,Mod), - fail. -'$hide_predicates'(_). % hide all atoms who start by '$' '$hide'('$VAR') :- !, fail. /* not $VAR */ @@ -66,5 +54,5 @@ xc/************************************************************************* '$hide'('$parse_quasi_quotations') :- !, fail. '$hide'('$quasi_quotation') :- !, fail. '$hide'('$qq_open') :- !, fail. -'$hide'(Name) :- hide(Name), fail. +%'$hide'(Name) :- hide_atom(Name), fail. diff --git a/pl/qly.yap b/pl/qly.yap index 9ac8b8bfb..6563c645e 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -259,7 +259,7 @@ qend_program :- fail. '$do_init_state' :- set_value('$user_module',user), - '$protect', +% '$protect', fail. '$do_init_state' :- '$current_module'(prolog), diff --git a/pl/signals.yap b/pl/signals.yap index cefc04855..1117a3abd 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -355,5 +355,6 @@ read_sig. :- '$set_no_trace'('$execute_nonstop'(_,_), prolog). :- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog). :- '$set_no_trace'('$restore_regs'(_,_), prolog). +:- '$set_no_trace'('$expand_meta_call'(_,_,_), prolog). %%! @} diff --git a/pl/spy.yap b/pl/spy.yap index a57ffc710..525343d17 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -252,7 +252,7 @@ Switches on the debugger and enters tracing mode. */ trace :- '$init_debugger', - '__NB_getval__'('$trace', on, fail), !. + fail. trace :- '__NB_setval__'('$trace',on), '$start_debugging'(on), diff --git a/pl/strict_iso.yap b/pl/strict_iso.yap index de85088b4..0bf0d3638 100644 --- a/pl/strict_iso.yap +++ b/pl/strict_iso.yap @@ -63,7 +63,7 @@ '$iso_check_a_goal'((_|_),_,_) :- !. '$iso_check_a_goal'(G,_,G0) :- current_prolog_flag(language, iso), - '$system_predicate'(G,prolog), + '$is+system_predicate'(G,prolog), ( '$iso_builtin'(G) -> @@ -90,7 +90,7 @@ '$check_iso_strict_goal'(B). '$check_iso_strict_goal'(G) :- - '$system_predicate'(G,prolog), !, + '$is_system_predicate'(G,prolog), !, '$check_iso_system_goal'(G). '$check_iso_strict_goal'(_). diff --git a/pl/undefined.yap b/pl/undefined.yap index 45d7c24f1..2b3ce3a96 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -37,88 +37,7 @@ with SICStus Prolog. */ - - -/** - * @pred '$undefp_expand'(+ M0:G0, -MG) - * - * @param G0 input goal - * @param M0 current module - * @param G1 new goal - * - * @return succeeds on finding G1, otherwise fails. - * - * Tries: - * 1 - `user:unknown_predicate_handler` - * 2 - `goal_expansion` - * 1 - `import` mechanism` -*/ -'$undefp_expand'(M0:G0, MG) :- - user:unknown_predicate_handler(G0,M0,M1:G1), - M0:G0 \== M1:G1, - !, - ( - '$pred_exists'(G1, M1) - -> - MG = M1:G1 - ; - '$undefp_expand_user'(M1:G1, MG) - ). -'$undefp_expand'(MG0, MG) :- - '$undefp_expand_user'(MG0, MG). - -'$undefp_expand_user'(M0:G0, MG) :- - '_user_expand_goal'(M0:G0, MG1), - M0:G0 \== MG1, - !, - '$yap_strip_module'( MG1, M1, G1), - ( - '$pred_exists'(G1, M1) - -> - MG = M1:G1 - ; - '$undefp_expand_import'(M1:G1, MG) - ). -'$undefp_expand_user'(MG0, MG) :- - '$undefp_expand_import'(MG0, MG). - -'$undefp_expand_import'(M0:G0, M1:G1) :- - '$get_undefined_pred'(G0, M0, G1, M1), - M0:G0 \== M1:G1. - -'$undefp'([M0|G0], Default) :- - % make sure we do not loop on undefined predicates - yap_flag( unknown, Unknown, fast_fail), - yap_flag( debug, Debug, false), - ( - '$undefp_expand'(M0:G0, NM:Goal), - Goal \= fail, - '$complete_goal'(M0, G0, Goal, NM, NG) - -> - yap_flag( unknown, _, Unknown), - yap_flag( debug, _, Debug), - '$execute0'(NG, NM) - ; - yap_flag( unknown, _, Unknown), - yap_flag( debug, _, Debug), - '$handle_error'(Default,G0,M0) - ). - -/** @pred unknown(- _O_,+ _N_) - -The unknown predicate, informs about what the user wants to be done - when there are no clauses for a certain predicate. - -This predicate is strongly deprecated. Use prolog_flag for generic -behaviour, and user:unknown_predicate_handler/3 for flexible behaviour -on undefined goals. - -*/ - -unknown(P, NP) :- - prolog_flag( unknown, P, NP ). - -/** @pred user:unknown_predicate_handler(+ _Call_, + _M_, - _N_) +/** @pred user:unknown_predicate_handler(+ _Call_, + _M_, - _N_) In YAP, the default action on undefined predicates is to output an `error` message. Alternatives are to silently `fail`, or to print a @@ -150,7 +69,8 @@ followed by the failure of that call. '$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)). + '$do_error'(existence_error(procedure,Name/Arity), + context(Mod:Goal,PMod:PName/PAr)). '$handle_error'(warning,Goal,Mod) :- functor(Goal,Name,Arity), 'program_continuation'(PMod,PName,PAr), @@ -161,14 +81,69 @@ followed by the failure of that call. :- '$set_no_trace'('$handle_error'(_,_,_), prolog). -'$complete_goal'(M, _G, CurG, CurMod, NG) :- - ( - '$is_metapredicate'(CurG,CurMod) - -> - '$expand_meta_call'(CurMod:CurG, [], NG) - ; - NG = CurG - ). +/** +Z * @pred '$undefp_expand'(+ M0:G0, -MG) + * + * @param G0 input goal + * @param M0 current module + * @param G1 new goal + * + * @return succeeds on finding G1, otherwise fails. + * + * Tries: + * 1 - `user:unknown_predicate_handler` + * 2 - `goal_expansion` + * 1 - `import` mechanism` +*/ +'$undefp_search'(M0:G0, MG) :- + '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), + '$yap_strip_module'(M0:G0, EM0, GM0), + user:unknown_predicate_handler(GM0,EM0,M1:G1), + !, + expand_goal(M1:G1, MG). +'$undefp_search'(MG, FMG) :- + expand_goal(MG, FMG). + +'$undefp'([M0|G0], Action) :- + % make sure we do not loop on undefined predicates + '$stop_creeping'(Current), + yap_flag( unknown, _, fail), + yap_flag( debug, Debug, false), + ( + '$undefp_search'(M0:G0, NM:NG), + ( M0 \== NM -> true ; G0 \== NG ), + NG \= fail, + '$pred_exists'(NG,NM) + -> + yap_flag( unknown, _, Action), + yap_flag( debug, _, Debug), + ( + Current == true + -> + % carry on signal processing + '$start_creep'([NM|NG], creep) + ; + '$execute0'(NG, NM) + ) + ; + yap_flag( unknown, _, Action), + yap_flag( debug, _, Debug), + '$handle_error'(Action,G0,M0) + ). + +/** @pred unknown(- _O_,+ _N_) + +The unknown predicate, informs about what the user wants to be done + when there are no clauses for a predicate. Using unknown/3 is + strongly deprecated. We recommend setting the `unknown` prolog + flag for generic behaviour, and calling the hook + user:unknown_predicate_handler/3 to fine-tune specific cases + undefined goals. + +*/ + +unknown(P, NP) :- + prolog_flag( unknown, P, NP ). /** @}