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

bug fices

Browse Source
This commit is contained in:
Vítor Santos Costa
2016-01-03 02:06:09 +00:00
parent 7a7354fb2b
commit 661f33ac7e
133 changed files with 6000 additions and 9890 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
C/modules.c
View File

@@ -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,

18
C/parser.c
View File

@@ -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;

41
C/qlyr.c
View File

@@ -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

9
C/qlyw.c
View File

@@ -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);
}

6
C/save.c
View File

@@ -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;
}

466
C/signals.c
View File

@@ -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 <tracer.h>
#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;
}

54
C/stdpreds.c
View File

@@ -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();

5
C/threads.c
View File

@@ -30,6 +30,7 @@ static char SccsId[] = "%W% %G%";
#include "yapio.h"
#include "blobs.h"
#include <stdio.h>
#include <unistd.h>
#if HAVE_STRING_H
#include <string.h>
#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);

22
C/tracer.c
View File

@@ -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

20
C/write.c
View File

@@ -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