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

replace locks by critical sections in interrupt handling

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-09-02 14:19:23 -05:00
parent 863a4c53fc
commit 99713d81a6
30 changed files with 626 additions and 810 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
C/absmi.c
View File

@ -606,16 +606,15 @@ check_alarm_fail_int(int CONT USES_REGS)
return CONT;
}
#endif
if (Yap_has_signals( YAP_INT_SIGNAL, YAP_FAIL_SIGNAL ) ) {
if (Yap_undo_signal( YAP_INT_SIGNAL ) ) {
if (Yap_get_signal( YAP_INT_SIGNAL ) ) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
(void)Yap_undo_signal( YAP_FAIL_SIGNAL );
return FALSE;
}
if (Yap_get_signal( YAP_FAIL_SIGNAL )) {
return FALSE;
}
if (!Yap_has_a_signal()) {
/* no need to look into GC */
CalculateStackGap( PASS_REGS1 );
/* no need to look into GC */
CalculateStackGap( PASS_REGS1 );
}
// fail even if there are more signals, they will have to be dealt later.
return -1;
@ -625,7 +624,7 @@ static int
stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS )
{
if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) ||
Yap_undo_signal( YAP_STOVF_SIGNAL )) {
Yap_get_signal( YAP_STOVF_SIGNAL )) {
S = (CELL *)pe;
if (!Yap_locked_gc(pe->ArityOfPE, env, cp)) {
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
@ -639,7 +638,7 @@ stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS )
static int
code_overflow( CELL *yenv USES_REGS )
{
if (Yap_undo_signal( YAP_CDOVF_SIGNAL )) {
if (Yap_get_signal( YAP_CDOVF_SIGNAL )) {
CELL cut_b = LCL0-(CELL *)(yenv[E_CB]);
/* do a garbage collection first to check if we can recover memory */
@ -711,7 +710,7 @@ interrupt_handler( PredEntry *pe USES_REGS )
HR += 2;
#ifdef COROUTINING
if (Yap_undo_signal( YAP_WAKEUP_SIGNAL )) {
if (Yap_get_signal( YAP_WAKEUP_SIGNAL )) {
CalculateStackGap( PASS_REGS1 );
ARG2 = Yap_ListOfWokenGoals();
pe = WakeUpCode;
@ -724,7 +723,6 @@ interrupt_handler( PredEntry *pe USES_REGS )
pe = CreepCode;
}
P = pe->CodeOfPred;
UNLOCK(LOCAL_SignalLock);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pe,XREGS+1);
@ -788,7 +786,7 @@ safe_interrupt_handler( PredEntry *pe USES_REGS )
HR += 2;
#ifdef COROUTINING
if (Yap_undo_signal( YAP_WAKEUP_SIGNAL )) {
if (Yap_get_signal( YAP_WAKEUP_SIGNAL )) {
CalculateStackGap( PASS_REGS1 );
ARG2 = Yap_ListOfWokenGoals();
pe = WakeUpCode;
@ -800,8 +798,7 @@ safe_interrupt_handler( PredEntry *pe USES_REGS )
CalculateStackGap( PASS_REGS1 );
pe = CreepCode;
}
UNLOCK(LOCAL_SignalLock);
// allocate an fill out an environment
// allocate and fill out an environment
YENV = ASP;
CACHE_Y_AS_ENV(YREG);
ENV_YREG[E_CP] = (CELL) CP;
@ -904,7 +901,6 @@ interrupt_fail( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
check_alarm_fail_int( FALSE PASS_REGS );
/* don't do debugging and stack expansion here: space will
be recovered. automatically by fail, so
@ -912,7 +908,6 @@ interrupt_fail( USES_REGS1 )
*/
if (!Yap_has_a_signal() ||
Yap_has_signals( YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
/* make sure we have the correct environment for continuation */
@ -930,23 +925,18 @@ interrupt_execute( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( TRUE PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
PP = P->y_u.pp.p0;
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
SET_ASP(YENV, E_CB*sizeof(CELL));
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if ((v = stack_overflow(P->y_u.pp.p, ENV, CP PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
return interrupt_handler( P->y_u.pp.p PASS_REGS );
@ -961,24 +951,19 @@ interrupt_call( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( TRUE PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
PP = P->y_u.Osbpp.p0;
if (Yap_only_has_signal(YAP_CREEP_SIGNAL) &&
(PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
SET_ASP(YENV, P->y_u.Osbpp.s);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
return interrupt_handlerc( P->y_u.Osbpp.p PASS_REGS );
@ -993,25 +978,20 @@ interrupt_pexecute( PredEntry *pen USES_REGS )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
PP = NULL;
if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
UNLOCK(LOCAL_SignalLock);
return 2; /* keep on creeping */
}
SET_ASP(YENV, E_CB*sizeof(CELL));
/* setup GB */
YENV[E_CB] = (CELL) B;
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp) PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
CP = NEXTOP(P, Osbmp);
@ -1031,9 +1011,7 @@ interrupt_deallocate( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( TRUE PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
/*
@ -1043,7 +1021,6 @@ interrupt_deallocate( USES_REGS1 )
/* keep on going if there is something else */
(P->opc != Yap_opcode(_procceed) &&
P->opc != Yap_opcode(_cut_e))) {
UNLOCK(LOCAL_SignalLock);
return 1;
} else {
CELL cut_b = LCL0-(CELL *)(S[E_CB]);
@ -1053,7 +1030,6 @@ interrupt_deallocate( USES_REGS1 )
/* cut_e */
SET_ASP(YENV, E_CB*sizeof(CELL));
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (Yap_has_a_signal()) {
@ -1074,7 +1050,6 @@ interrupt_deallocate( USES_REGS1 )
S = ASP;
S[E_CB] = (CELL)(LCL0-cut_b);
}
UNLOCK(LOCAL_SignalLock);
return 1;
}
@ -1088,12 +1063,10 @@ interrupt_cut( USES_REGS1 )
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (!Yap_has_a_signal()
|| Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
/* find something to fool S */
@ -1110,14 +1083,11 @@ interrupt_cut_t( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (!Yap_has_a_signal()
|| Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
/* find something to fool S */
@ -1134,14 +1104,10 @@ interrupt_cut_e( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (!Yap_has_a_signal()
|| Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
return 2;
}
/* find something to fool S */
@ -1159,14 +1125,11 @@ interrupt_commit_y( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (!Yap_has_a_signal()
|| Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
/* find something to fool S */
@ -1184,14 +1147,10 @@ interrupt_commit_x( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (!Yap_has_a_signal()
|| Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
UNLOCK(LOCAL_SignalLock);
if (Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) {
return 2;
}
PP = P->y_u.xps.p0;
@ -1219,13 +1178,10 @@ interrupt_either( USES_REGS1 )
if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \
__FUNCTION__, __LINE__,YENV,ENV,ASP);
#endif
LOCK(LOCAL_SignalLock);
if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
PP = P->y_u.Osblp.p0;
@ -1234,11 +1190,9 @@ interrupt_either( USES_REGS1 )
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
return interrupt_handler_either( MkIntTerm(0), RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)) PASS_REGS );
@ -1256,10 +1210,8 @@ interrupt_dexecute( USES_REGS1 )
#endif
PP = P->y_u.pp.p0;
pe = P->y_u.pp.p;
LOCK(LOCAL_SignalLock);
if (Yap_has_signal(YAP_CREEP_SIGNAL) &&
if (Yap_get_signal(YAP_CREEP_SIGNAL) &&
(PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag))) {
UNLOCK(LOCAL_SignalLock);
return 2;
}
/* set S for next instructions */
@ -1267,11 +1219,9 @@ interrupt_dexecute( USES_REGS1 )
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP] PASS_REGS )) >= 0) {
UNLOCK(LOCAL_SignalLock);
return v;
}
/* first, deallocate */
@ -11898,9 +11848,7 @@ Yap_absmi(int inp)
/* now restore Woken Goals to its old value */
Yap_UpdateTimedVar(LOCAL_WokenGoals, OldWokenGoals);
if (OldWokenGoals == TermNil) {
LOCK(LOCAL_SignalLock);
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
UNLOCK(LOCAL_SignalLock);
Yap_get_signal(YAP_WAKEUP_SIGNAL);
}
#endif
/* restore B */

6
C/adtdefs.c
View File

@ -26,8 +26,6 @@ static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
static Prop PredPropByFunc(Functor, Term);
static Prop PredPropByAtom(Atom, Term);
#include "Yatom.h"
#include "yapio.h"
#include "pl-shared.h"
@ -206,11 +204,9 @@ LookupAtom(const char *atom)
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock);
CACHE_REGS
LOCK(LOCAL_SignalLock);
if (NOfAtoms > 2*AtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
return na;
}
@ -276,11 +272,9 @@ LookupWideAtom(const wchar_t *atom)
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(WideHashChain[hash].AERWLock);
CACHE_REGS
LOCK(LOCAL_SignalLock);
if (NOfWideAtoms > 2*WideAtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
return na;
}

2
C/alloc.c
View File

@ -714,9 +714,7 @@ AllocHeap(unsigned long int size)
HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
UNLOCK(HeapUsedLock);
UNLOCK(HeapTopLock);
LOCK(LOCAL_SignalLock);
Yap_signal(YAP_CDOVF_SIGNAL);
UNLOCK(LOCAL_SignalLock);
} else {
if (size > GLOBAL_SizeOfOverflow)
GLOBAL_SizeOfOverflow = size*sizeof(CELL) + sizeof(YAP_SEG_SIZE);

6
C/arith1.c
View File

@ -324,13 +324,16 @@ msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int out = 0;
int off = sizeof(CELL)*4;
if (inp < 0) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
"msb/1 received %d", inp);
}
#if 0
#else
int off = sizeof(CELL)*4;
while (off) {
Int limit = ((CELL)1) << (off);
if (inp >= limit) {
@ -339,6 +342,7 @@ msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */
}
off >>= 1;
}
#endif
return(out);
}

4
C/attvar.c
View File

@ -46,10 +46,8 @@ AddToQueue(attvar_record *attv USES_REGS)
Yap_UpdateTimedVar(LOCAL_WokenGoals, MkPairTerm(ng, WGs));
if ((Term)WGs == TermNil) {
LOCK(LOCAL_SignalLock);
/* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL);
UNLOCK(LOCAL_SignalLock);
}
return(RepAppl(ng)+2);
}
@ -63,12 +61,10 @@ AddFailToQueue( USES_REGS1 )
WGs = Yap_ReadTimedVar(LOCAL_WokenGoals);
Yap_UpdateTimedVar(LOCAL_WokenGoals, MkPairTerm(MkAtomTerm(AtomFail), WGs));
LOCK(LOCAL_SignalLock);
if ((Term)WGs == TermNil) {
/* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
}
static attvar_record *

21
C/c_interface.c
View File

@ -780,14 +780,11 @@ YAP_LookupAtom(const char *c)
while (TRUE) {
a = Yap_LookupAtom((char *)c);
LOCK(LOCAL_SignalLock);
if (a == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) {
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage);
}
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
return a;
}
}
@ -802,14 +799,11 @@ YAP_LookupWideAtom(const wchar_t *c)
while (TRUE) {
a = Yap_LookupWideAtom((wchar_t *)c);
LOCK(LOCAL_SignalLock);
if (a == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) {
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage);
}
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
return a;
}
}
@ -824,14 +818,11 @@ YAP_FullLookupAtom(const char *c)
while (TRUE) {
at = Yap_FullLookupAtom((char *)c);
LOCK(LOCAL_SignalLock);
if (at == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) {
if (at == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage);
}
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
return at;
}
}
@ -2859,13 +2850,11 @@ YAP_CompileClause(Term t)
}
YAPLeaveCriticalSection();
LOCK(LOCAL_SignalLock);
if (Yap_has_signal( YAP_CDOVF_SIGNAL ) ) {
if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) {
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage);
}
}
UNLOCK(LOCAL_SignalLock);
RECOVER_MACHINE_REGS();
return(LOCAL_ErrorMessage);
}
@ -3912,9 +3901,7 @@ X_API void
YAP_signal(int sig)
{
CACHE_REGS
LOCK(LOCAL_SignalLock);
Yap_signal(sig);
UNLOCK(LOCAL_SignalLock);
}
X_API int

6
C/cdmgr.c
View File

@ -3849,7 +3849,7 @@ p_toggle_static_predicates_in_use( USES_REGS1 )
}
static void
clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) {
clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) {
if (pp->ModuleOfPred == IDB_MODULE) {
if (pp->PredFlags & NumberDBPredFlag) {
*parity = 0;
@ -4024,7 +4024,7 @@ static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
Int out;
PELOCK(40,pp);
// PELOCK(40,pp); this is deadlocking...
/* check if the codeptr comes from the indexing code */
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
@ -4044,7 +4044,7 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
if ((out = find_code_in_clause(pp, codeptr, NULL, NULL))) {
clause_was_found(pp, pat, parity);
}
UNLOCK(pp->PELock);
UNLOCK(pp->PELock);
return out;
}

2
C/dlmalloc.c
View File

@ -210,9 +210,7 @@ yapsbrk(long size)
/* small allocations, we can wait */
HeapTop += size;
UNLOCK(HeapTopLock);
LOCK(LOCAL_SignalLock);
Yap_signal(YAP_CDOVF_SIGNAL);
UNLOCK(LOCAL_SignalLock);
} else {
if (size > GLOBAL_SizeOfOverflow)
GLOBAL_SizeOfOverflow = size;

25
C/errors.c
View File

@ -356,8 +356,9 @@ handled_exception( USES_REGS1 )
static void
dump_stack( USES_REGS1 )
dump_stack( void )
{
CACHE_REGS
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
char tp[256];
@ -458,7 +459,7 @@ error_exit_yap (int value)
{
CACHE_REGS
if (!(LOCAL_PrologMode & BootMode)) {
dump_stack( PASS_REGS1 );
dump_stack( );
#if DEBUG
#endif
}
@ -475,7 +476,7 @@ Yap_bug_location(yamop *pc)
CACHE_REGS
detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf(stderr,"%s\n",(char *)HR);
dump_stack( PASS_REGS1 );
dump_stack( );
}
#endif
@ -588,10 +589,9 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
LOCAL_CurrentError = type;
LOCAL_PrologMode |= InErrorMode;
/* make sure failure will be seen at next port */
LOCK(LOCAL_SignalLock);
// no need to lock & unlock
if (LOCAL_PrologMode & AsyncIntMode)
Yap_signal(YAP_FAIL_SIGNAL);
UNLOCK(LOCAL_SignalLock);
P = FAILCODE;
} else {
if (IsVarTerm(where)) {
@ -1151,7 +1151,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
dump_stack( PASS_REGS1 );
dump_stack();
ti[0] = MkAtomTerm(AtomCodeSpace);
i = strlen(tmpbuf);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
@ -1165,7 +1165,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
dump_stack( PASS_REGS1 );
dump_stack( );
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
@ -1179,7 +1179,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
dump_stack( PASS_REGS1 );
dump_stack( );
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomAttributes);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
@ -1193,7 +1193,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
dump_stack( PASS_REGS1 );
dump_stack( );
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomUnificationStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
@ -1207,7 +1207,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
dump_stack( PASS_REGS1 );
dump_stack( );
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomTrail);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
@ -1983,18 +1983,15 @@ E);
}
if (serious) {
/* disable active signals at this point */
LOCAL_FirstActiveSignal = LOCAL_LastActiveSignal = 0;
LOCAL_Signals = 0;
CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode &= ~InErrorMode;
LOCK(LOCAL_SignalLock);
/* we might be in the middle of a critical region */
if (LOCAL_InterruptsDisabled) {
LOCAL_InterruptsDisabled = 0;
LOCAL_UncaughtThrow = TRUE;
UNLOCK(LOCAL_SignalLock);
Yap_RestartYap( 1 );
}
UNLOCK(LOCAL_SignalLock);
#if DEBUG
DumpActiveGoals( PASS_REGS1 );
#endif

62
C/exec.c
View File

@ -158,21 +158,18 @@ do_execute(Term t, Term mod USES_REGS)
Term t0 = t;
/* first do predicate expansion, even before you process signals.
This way you don't get to spy goal_expansion(). */
LOCK(LOCAL_SignalLock);
if (PRED_GOAL_EXPANSION_ALL) {
/* disable creeping when we do goal expansion */
if (!LOCAL_InterruptsDisabled &&
Yap_undo_signal( YAP_CREEP_SIGNAL ) ) {
Yap_get_signal( YAP_CREEP_SIGNAL ) ) {
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
return CallMetaCall(ARG1, mod PASS_REGS);
} else if (Yap_has_a_signal() &&
!LOCAL_InterruptsDisabled &&
!(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) {
return EnterCreepMode(t, mod PASS_REGS);
}
UNLOCK(LOCAL_SignalLock);
restart_exec:
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
@ -333,22 +330,18 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
if (IsExtensionFunctor(f)) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod PASS_REGS);
}
LOCK(LOCAL_SignalLock);
if (PRED_GOAL_EXPANSION_ALL) {
/* disable creeping when we do goal expansion */
if (Yap_has_signal( YAP_CREEP_SIGNAL ) &&
if (Yap_get_signal( YAP_CREEP_SIGNAL ) &&
!LOCAL_InterruptsDisabled) {
Yap_undo_signal( YAP_CREEP_SIGNAL );
CalculateStackGap( PASS_REGS1 );
}
t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return CallMetaCall(t, mod PASS_REGS);
} else if (Yap_has_a_signal() &&
!LOCAL_InterruptsDisabled) {
return EnterCreepMode(copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), mod PASS_REGS);
}
UNLOCK(LOCAL_SignalLock);
if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod PASS_REGS);
}
@ -385,13 +378,12 @@ static Int
EnterCreepMode(Term t, Term mod USES_REGS) {
PredEntry *PredCreep;
if (Yap_has_signal( YAP_CDOVF_SIGNAL ) ) {
if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) {
ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call");
}
if (!Yap_has_a_signal()) {
UNLOCK(LOCAL_SignalLock);
return do_execute(ARG1, mod PASS_REGS);
}
}
@ -407,7 +399,6 @@ EnterCreepMode(Term t, Term mod USES_REGS) {
}
}
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
P_before_spy = P;
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
}
@ -642,11 +633,9 @@ p_execute_clause( USES_REGS1 )
} else {
code = Yap_ClauseFromTerm(clt)->ClCode;
}
LOCK(LOCAL_SignalLock);
if (Yap_undo_signal(YAP_CREEP_SIGNAL)) {
if (Yap_get_signal(YAP_CREEP_SIGNAL)) {
Yap_signal(YAP_CREEP_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
}
@ -659,17 +648,12 @@ p_execute_in_mod( USES_REGS1 )
static Int
p_do_goal_expansion( USES_REGS1 )
{
Int creeping = Yap_has_signal(YAP_CREEP_SIGNAL);
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = Deref(ARG2);
ARG2 = ARG3;
if (creeping) {
LOCK(LOCAL_SignalLock);
Yap_undo_signal(YAP_CREEP_SIGNAL);
UNLOCK(LOCAL_SignalLock);
}
/* CurMod:goal_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) &&
@ -710,29 +694,20 @@ p_do_goal_expansion( USES_REGS1 )
out = TRUE;
}
complete:
LOCK(LOCAL_SignalLock);
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
}
UNLOCK(LOCAL_SignalLock);
return out;
}
static Int
p_do_term_expansion( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
Int creeping = Yap_has_signal(YAP_CREEP_SIGNAL);
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = CurrentModule;
/* disable creeping */
if (creeping)
Yap_undo_signal(YAP_CREEP_SIGNAL);
UNLOCK(LOCAL_SignalLock);
/* CurMod:term_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
@ -758,11 +733,9 @@ p_do_term_expansion( USES_REGS1 )
out = TRUE;
}
complete:
LOCK(LOCAL_SignalLock);
if (creeping) {
Yap_signal(YAP_CREEP_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
return out;
}
@ -774,12 +747,10 @@ p_execute0( USES_REGS1 )
unsigned int arity;
Prop pe;
LOCK(LOCAL_SignalLock);
if (Yap_has_a_signal() &&
!LOCAL_InterruptsDisabled) {
return EnterCreepMode(t, mod PASS_REGS);
}
UNLOCK(LOCAL_SignalLock);
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
@ -906,10 +877,9 @@ p_execute_nonstop( USES_REGS1 )
}
/* N = arity; */
/* call may not define new system predicates!! */
LOCK(LOCAL_SignalLock);
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled &&
Yap_undo_signal(YAP_CREEP_SIGNAL)) {
Yap_get_signal(YAP_CREEP_SIGNAL)) {
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
@ -917,16 +887,14 @@ p_execute_nonstop( USES_REGS1 )
PP = RepPredProp(pe);
PELOCK(80,PP);
}
UNLOCK(LOCAL_SignalLock);
#endif
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
} else { if (Yap_has_signal( YAP_CREEP_SIGNAL ) &&
} else { if (Yap_get_signal( YAP_CREEP_SIGNAL ) &&
!LOCAL_InterruptsDisabled &&
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS);
}
}
@ -1097,12 +1065,10 @@ exec_absmi(int top USES_REGS)
restore_H();
/* set stack */
ASP = (CELL *)PROTECT_FROZEN_B(B);
LOCK(LOCAL_SignalLock);
/* forget any signals active, we're reborne */
LOCAL_FirstActiveSignal = LOCAL_LastActiveSignal;
LOCAL_Signals = 0;
CalculateStackGap( PASS_REGS1 );
LOCAL_PrologMode = UserMode;
UNLOCK(LOCAL_SignalLock);
P = (yamop *)FAILCODE;
}
break;
@ -1132,11 +1098,9 @@ exec_absmi(int top USES_REGS)
YENV[E_CB] = Unsigned (B);
out = Yap_absmi(0);
/* make sure we don't leave a FAIL signal hanging around */
LOCK(LOCAL_SignalLock);
Yap_undo_signal( YAP_FAIL_SIGNAL );
Yap_get_signal( YAP_FAIL_SIGNAL );
if (!Yap_has_a_signal())
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
return out;
}
@ -1657,11 +1621,9 @@ JumpToEnv(Term t USES_REGS) {
LOCAL_BallTerm = NULL;
P = (yamop *)FAILCODE;
/* make sure failure will be seen at next port */
LOCK(LOCAL_SignalLock);
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
HB = B->cp_h;
return TRUE;
}
@ -1707,11 +1669,9 @@ JumpToEnv(Term t USES_REGS) {
/* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
LOCK(LOCAL_SignalLock);
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
P = (yamop *)FAILCODE;
HB = B->cp_h;
/* try to recover space */
@ -1799,7 +1759,6 @@ Yap_InitYaamRegs( int myworker_id )
BBREG = B_FZ = (choiceptr) REMOTE_LocalBase(myworker_id);
TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */
LOCK(REMOTE_SignalLock(myworker_id));
CalculateStackGap( PASS_REGS1 );
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
@ -1828,7 +1787,6 @@ Yap_InitYaamRegs( int myworker_id )
if (REMOTE_top_dep_fr(myworker_id))
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
#endif
UNLOCK(REMOTE_SignalLock(myworker_id));
// make sure we have slots in case we don go through the top-level */
Yap_StartSlots( PASS_REGS1 );

18
C/grow.c
View File

@ -1314,7 +1314,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip, tr_fr_ptr *ol
fix_tabling_info( PASS_REGS1 );
#endif /* TABLING */
if (sz >= sizeof(CELL) * K16) {
Yap_undo_signal( YAP_CDOVF_SIGNAL );
Yap_get_signal( YAP_CDOVF_SIGNAL );
return TRUE;
}
/* failed */
@ -1367,7 +1367,7 @@ growatomtable( USES_REGS1 )
if (nsize -AtomHashTableSize > 4*1024*1024)
nsize = AtomHashTableSize+4*1024*1024+7919;
Yap_undo_signal( YAP_CDOVF_SIGNAL );
Yap_get_signal( YAP_CDOVF_SIGNAL );
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
#if !USE_SYSTEM_MALLOC
@ -1429,8 +1429,7 @@ Yap_locked_growheap(int fix_code, size_t in_size, void *cip)
#endif
res = FALSE;
if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
Yap_undo_signal( YAP_CDOVF_SIGNAL );
UNLOCK(LOCAL_SignalLock);
Yap_get_signal( YAP_CDOVF_SIGNAL );
return TRUE;
}
}
@ -1446,7 +1445,6 @@ Yap_locked_growheap(int fix_code, size_t in_size, void *cip)
NOfAtoms+1 > 2*AtomHashTableSize)) {
res = growatomtable( PASS_REGS1 );
} else {
Yap_undo_signal( YAP_CDOVF_SIGNAL );
#ifdef THREADS
UNLOCK(GLOBAL_ThreadHandlesLock);
#endif
@ -1478,9 +1476,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
{
CACHE_REGS
int rc;
LOCK(LOCAL_SignalLock);
rc = Yap_locked_growheap(fix_code, in_size, cip);
UNLOCK(LOCAL_SignalLock);
return rc;
}
@ -1525,9 +1521,7 @@ Yap_growglobal(CELL **ptr)
{
CACHE_REGS
int rc;
LOCK(LOCAL_SignalLock);
rc = Yap_locked_growglobal(ptr);
UNLOCK(LOCAL_SignalLock);
return rc;
}
@ -1563,10 +1557,8 @@ Yap_growstack(size_t size)
int res;
LOCAL_PrologMode |= GrowStackMode;
LOCK(LOCAL_SignalLock);
res=growstack(size PASS_REGS);
LeaveGrowMode(GrowStackMode);
UNLOCK(LOCAL_SignalLock);
return res;
}
@ -1821,7 +1813,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
Sfprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000);
Sfprintf(GLOBAL_stderr, "%% Total of %g sec expanding trail \n", (double)LOCAL_total_trail_overflow_time/1000);
}
Yap_undo_signal( YAP_TROVF_SIGNAL );
Yap_get_signal( YAP_TROVF_SIGNAL );
return TRUE;
}
@ -1832,9 +1824,7 @@ Yap_growtrail(long size, int contiguous_only)
{
int rc;
CACHE_REGS
LOCK(LOCAL_SignalLock);
rc = do_growtrail(size, contiguous_only, FALSE, NULL, NULL, NULL PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return rc;
}

4
C/heapgc.c
View File

@ -4265,9 +4265,7 @@ Yap_gc(Int predarity, CELL *current_env, yamop *nextop)
{
CACHE_REGS
int rc;
LOCK(LOCAL_SignalLock);
rc = Yap_locked_gc(predarity, current_env, nextop);
UNLOCK(LOCAL_SignalLock);
return rc;
}
@ -4295,7 +4293,6 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
int res;
UInt min;
LOCK(LOCAL_SignalLock);
CalculateStackGap( PASS_REGS1 );
min = EventFlag*sizeof(CELL);
LOCAL_PrologMode |= GCMode;
@ -4303,7 +4300,6 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
gc_lim = min;
res = call_gc(gc_lim, predarity, current_env, nextop PASS_REGS);
LeaveGCMode( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
return res;
}

4
C/inlines.c
View File

@ -432,11 +432,9 @@ p_dif( USES_REGS1 )
#ifdef COROUTINING
/* now restore Woken Goals to its old value */
Yap_UpdateTimedVar(LOCAL_WokenGoals, OldWokenGoals);
LOCK(LOCAL_SignalLock);
if (OldWokenGoals == TermNil) {
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
Yap_get_signal(YAP_WAKEUP_SIGNAL);
}
UNLOCK(LOCAL_SignalLock);
#endif
/* restore B */
B = pt1;

12
C/pl-yap.c
View File

@ -557,14 +557,7 @@ PL_unify_chars(term_t t, int flags, size_t len, const char *s)
X_API int PL_handle_signals(void)
{
GET_LD
if ( !LD || LD->critical || !LD->signal.pending )
return 0;
if (LD->signal.pending == 2) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
// fprintf(stderr,"PL_handle_signals not implemented\n");
return 1;
return Yap_HandleInterrupts( );
}
void
@ -1215,7 +1208,6 @@ PL_w32thread_raise(DWORD id, int sig)
return FALSE; /* illegal signal */
PL_LOCK(L_PLFLAG);
// LOCK(LOCAL_SignalLock);
for(i = 0; i <= thread_highest_id; i++)
{ PL_thread_info_t *info = GD->thread.threads[i];
@ -1225,13 +1217,11 @@ PL_w32thread_raise(DWORD id, int sig)
Yap_external_signal(i, sig); //raiseSignal(info->thread_data, sig);
if ( info->w32id )
PostThreadMessage(info->w32id, WM_SIGNALLED, 0, 0L);
//UNLOCK(LOCAL_SignalLock);
PL_UNLOCK(L_PLFLAG);
DEBUG(1, Sdprintf("Signalled %d to thread %d\n", sig, i));
return TRUE;
}
}
// UNLOCK(LOCAL_SignalLock);
PL_UNLOCK(L_PLFLAG);
return FALSE; /* can't find thread */

510
C/signals.c
View File

@ -1,19 +1,19 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: signal.c *
* comments: Signal Handling & Debugger Support *
* *
* *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: signal.c *
* comments: Signal Handling & Debugger Support *
* *
* *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
@ -36,91 +36,166 @@ static char SccsId[] = "%W% %G%";
#include <malloc.h>
#endif
#include <wchar.h>
#ifdef LOW_LEVEL_TRACER
#include <tracer.h>
#endif
#ifndef THREADS
#define worker_id 0
#endif
/*
* 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) {
#ifdef HAVE_SETBUF
/* make sure we are not waiting for the end of line */
YP_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 */
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;
#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;
}
}
/*
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)
{
CACHE_REGS
int ch, out;
printf("H\n");
#if HAVE_ISATTY
if (!isatty(0)) {
return YAP_INT_SIGNAL;
}
#endif
LOCAL_PrologMode |= AsyncIntMode;
do {
ch = Yap_GetCharForSIGINT();
} while (!(out = InteractSIGINT(ch)));
LOCAL_PrologMode &= ~AsyncIntMode;
return(out);
}
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));
if (!REMOTE_InterruptsDisabled(wid)) {
REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_);
if (sig != YAP_CREEP_SIGNAL)
REMOTE_ThreadHandle(wid).current_yaam_regs->EventFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_);
REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_);
}
UInt i = REMOTE_FirstActiveSignal(wid);
if (REMOTE_FirstActiveSignal(wid) != REMOTE_LastActiveSignal(wid)) {
do {
if (sig == REMOTE_ActiveSignals(wid)[i]) {
return;
}
i++;
if (i == REMOTE_MaxActiveSignals(wid))
i = 0;
} while (i != REMOTE_LastActiveSignal(wid));
}
REMOTE_ActiveSignals(wid)[i] = sig;
REMOTE_LastActiveSignal(wid)++;
if (REMOTE_LastActiveSignal(wid) == REMOTE_MaxActiveSignals(wid))
REMOTE_LastActiveSignal(wid) = 0;
#else
LOCAL_Signals += SIGNAL_TO_BIT(sig);
if (!LOCAL_InterruptsDisabled) {
CreepFlag =
Unsigned(LCL0);
if (sig != YAP_CREEP_SIGNAL)
EventFlag =
Unsigned(LCL0);
CreepFlag =
Unsigned(LCL0);
}
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig == LOCAL_ActiveSignals[i]) {
return;
}
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
}
LOCAL_ActiveSignals[i] = sig;
LOCAL_LastActiveSignal++;
if (LOCAL_LastActiveSignal == LOCAL_MaxActiveSignals)
LOCAL_LastActiveSignal = 0;
#endif
}
inline static int
undo_signal(yap_signals sig USES_REGS)
get_signal(yap_signals sig USES_REGS)
{
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig == LOCAL_ActiveSignals[i])
break;
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
}
if (i == LOCAL_LastActiveSignal) {
return FALSE;
}
while ((i+1) % LOCAL_MaxActiveSignals != LOCAL_LastActiveSignal) {
LOCAL_ActiveSignals[i] = LOCAL_ActiveSignals[(i+1) % LOCAL_MaxActiveSignals];
i++;
}
if (LOCAL_LastActiveSignal == 0)
LOCAL_LastActiveSignal = LOCAL_MaxActiveSignals-1;
else
LOCAL_LastActiveSignal--;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
CalculateStackGap( PASS_REGS1 );
#if THREADS
uint64_t old;
// first, clear the Creep Flag, now if someone sets it it is their problem
CalculateStackGap( PASS_REGS1 );
// reset the flag
if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) !=
SIGNAL_TO_BIT(sig)) {
if (!(old & SIGNAL_TO_BIT(sig)) ) {
// weird, it was consumed?
return FALSE;
}
if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) {
CreepFlag = (CELL)LCL0;
}
// more likely case, we have other interrupts.
return TRUE;
}
// success, we are good
return TRUE;
// should we set the flag?
#else
if (LOCAL_Signals & 1LL<sig) {
LOCAL_Signals &= ~(1LL<sig);
if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) {
Creep Flag = (CELL)LCL0;
} else {
CalculateStackGap( PASS_REGS1 );
}
return TRUE;
} else {
return FALSE;
}
#endif
}
/**
Function called to handle delayed interrupts.
*/
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;
}
return 0;
}
static Int
@ -132,9 +207,7 @@ p_creep( USES_REGS1 )
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
LOCK(LOCAL_SignalLock);
do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
@ -147,35 +220,24 @@ p_creep_fail( USES_REGS1 )
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
LOCK(LOCAL_SignalLock);
do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
static Int
p_stop_creeping( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
undo_signal( YAP_CREEP_SIGNAL PASS_REGS );
UNLOCK(LOCAL_SignalLock);
get_signal( YAP_CREEP_SIGNAL PASS_REGS );
return TRUE;
}
static Int
p_creep_allowed( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
if (PP != NULL) {
undo_signal(YAP_CREEP_SIGNAL PASS_REGS);
if (!LOCAL_InterruptsDisabled) {
if (LOCAL_FirstActiveSignal == LOCAL_LastActiveSignal)
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
get_signal(YAP_CREEP_SIGNAL PASS_REGS);
return TRUE;
}
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
@ -183,9 +245,12 @@ void
Yap_signal(yap_signals sig)
{
CACHE_REGS
do_signal(worker_id, sig PASS_REGS);
do_signal(worker_id, sig PASS_REGS);
}
static Int
p_debug( USES_REGS1 );
void
Yap_external_signal(int wid, yap_signals sig)
{
@ -193,100 +258,58 @@ Yap_external_signal(int wid, yap_signals sig)
REGSTORE *regcache = REMOTE_ThreadHandle(wid).current_yaam_regs;
#endif
do_signal(wid, sig PASS_REGS);
LOCAL_PrologMode &= ~InterruptMode;
p_debug( PASS_REGS1 );
}
int
Yap_undo_signal__(yap_signals sig USES_REGS)
Yap_get_signal__(yap_signals sig USES_REGS)
{
return undo_signal(sig PASS_REGS);
}
int
Yap_has_signal__(yap_signals sig USES_REGS)
{
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig == LOCAL_ActiveSignals[i]) {
return TRUE;
}
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
}
return FALSE;
return get_signal(sig PASS_REGS);
}
// the caller holds the lock.
int
Yap_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS)
{
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig1 == LOCAL_ActiveSignals[i] ||
sig2 == LOCAL_ActiveSignals[i]) {
return TRUE;
}
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
}
return FALSE;
return LOCAL_Signals & (1LL<sig1|1LL<sig2);
}
int
Yap_only_has_signal__(yap_signals sig USES_REGS)
{
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig != LOCAL_ActiveSignals[i]) {
return FALSE;
}
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
} else {
return FALSE;
}
return TRUE;
}
int
Yap_only_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS)
{
UInt i = LOCAL_FirstActiveSignal;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
do {
if (sig1 != LOCAL_ActiveSignals[i] &&
sig2 != LOCAL_ActiveSignals[i]) {
return FALSE;
}
i++;
if (i == LOCAL_MaxActiveSignals)
i = 0;
} while (i != LOCAL_LastActiveSignal);
} else {
return FALSE;
}
return TRUE;
uint64_t sigs = LOCAL_Signals;
return sigs & (1LL<sig1 | 1LL<sig2) &&
! (sigs & ~(1LL<sig1 | 1LL<sig2)) ;
}
#ifdef DEBUG
volatile int volat = 0;
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);
}
void Yap_loop(void);
void Yap_debug_end_loop(void);
void Yap_loop(void)
{
while (volat == 0);
}
void Yap_debug_end_loop(void)
{
volat = 1;
}
#endif
static Int
@ -295,106 +318,105 @@ p_first_signal( USES_REGS1 )
Atom at;
yap_signals sig;
LOCK(LOCAL_SignalLock);
/* always do wakeups first, because you don't want to keep the
non-backtrackable variable bad */
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
sig = LOCAL_ActiveSignals[LOCAL_FirstActiveSignal];
LOCAL_FirstActiveSignal++;
if (LOCAL_FirstActiveSignal == LOCAL_MaxActiveSignals)
LOCAL_FirstActiveSignal = 0;
} else {
sig = YAP_NO_SIGNAL;
}
while (TRUE) {
uint64_t mask = LOCAL_Signals;
if (mask == 0)
return FALSE;
sig = ffsll(mask);
if (get_signal(sig PASS_REGS)) {
break;
}
}
loop:
switch (sig) {
case YAP_INT_SIGNAL:
at = AtomSigInt;
break;
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;
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(PURE_ABORT, 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_WAKEUP_SIGNAL:
at = AtomSigWakeUp;
break;
case YAP_ITI_SIGNAL:
at = AtomSigIti;
break;
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
default:
UNLOCK(LOCAL_SignalLock);
return FALSE;
default:
return FALSE;
}
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(at));
}
static Int
p_continue_signals( USES_REGS1 )
{
yap_signals sig;
/* hack to force the signal anew */
LOCK(LOCAL_SignalLock);
if (LOCAL_InterruptsDisabled) {
return TRUE;
}
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
sig = LOCAL_ActiveSignals[LOCAL_FirstActiveSignal];
CreepFlag =
Unsigned(LCL0);
if (sig != YAP_CREEP_SIGNAL)
EventFlag =
Unsigned(LCL0);
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
return p_first_signal( PASS_REGS1 );
}
void
@ -408,7 +430,7 @@ Yap_InitSignalCPreds(void)
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0);
#ifdef DEBUG
Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag);
Yap_InitCPred("sys_debug", 1, p_debug, SafePredFlag|SyncPredFlag);
#endif
}

200
C/sysbits.c
View File

@ -1514,165 +1514,29 @@ my_signal_info(int sig, void (*handler)(int, void *, void *))
#endif
static int
InteractSIGINT(int ch) {
CACHE_REGS
switch (ch) {
case 'a':
/* abort computation */
if (LOCAL_PrologMode & (GCMode|ConsoleGetcMode|CritMode)) {
LOCAL_PrologMode |= AbortMode;
return -1;
} else {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_PrologMode &= ~AsyncIntMode;
Yap_RestartYap( 1 );
return -1;
case 'b':
/* continue */
Yap_signal (YAP_BREAK_SIGNAL);
return 1;
case 'c':
/* continue */
return 1;
case 'd':
Yap_signal (YAP_DEBUG_SIGNAL);
/* enter debug mode */
return 1;
case 'e':
/* exit */
Yap_exit(0);
return -1;
case 'g':
/* exit */
Yap_signal (YAP_STACK_DUMP_SIGNAL);
return -1;
case 't':
/* start tracing */
Yap_signal (YAP_TRACE_SIGNAL);
return 1;
#ifdef LOW_LEVEL_TRACER
case 'T':
toggle_low_level_trace();
return 1;
#endif
case 's':
/* show some statistics */
Yap_signal (YAP_STATISTICS_SIGNAL);
return 1;
case EOF:
return(0);
break;
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(0);
}
}
/*
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 int
ProcessSIGINT(void)
{
CACHE_REGS
int ch, out;
LOCAL_PrologMode |= AsyncIntMode;
do {
ch = Yap_GetCharForSIGINT();
} while (!(out = InteractSIGINT(ch)));
LOCAL_PrologMode &= ~AsyncIntMode;
LOCAL_PrologMode &= ~InterruptMode;
return(out);
}
#if !_MSC_VER && !defined(__MINGW32__)
/* This function is called from the signal handler to process signals.
We assume we are within the context of the signal handler, whatever
that might be
*/
static void
HandleSIGINT (int sig, void *x, void *y)
{
CACHE_REGS
/* fprintf(stderr,"mode = %x\n",LOCAL_PrologMode); */
my_signal(SIGINT, HandleSIGINT);
/* do this before we act */
#if HAVE_ISATTY
if (!isatty(0)) {
Yap_Error(INTERRUPT_ERROR,MkIntTerm(SIGINT),NULL);
return;
}
#endif
if (LOCAL_InterruptsDisabled) {
return;
}
if (LOCAL_PrologMode & ConsoleGetcMode) {
LOCAL_PrologMode |= InterruptMode;
return;
}
#ifdef HAVE_SETBUF
/* make sure we are not waiting for the end of line */
YP_setbuf (stdin, NULL);
#endif
ProcessSIGINT();
}
#endif
#if !defined(_WIN32)
/* this routine is called if the system activated the alarm */
static RETSIGTYPE
HandleALRM (int s, void *x, void *y)
{
my_signal (SIGALRM, HandleALRM);
/* force the system to creep */
Yap_signal (YAP_ALARM_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
}
#endif
#if !defined(_WIN32)
/* this routine is called if the system activated the alarm */
static RETSIGTYPE
HandleVTALRM (int s, void *x, void *y)
{
my_signal (SIGVTALRM, HandleVTALRM);
/* force the system to creep */
Yap_signal (YAP_VTALARM_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
}
#endif
/*
* This function is called after a normal interrupt had been caught.
* It allows 6 possibilities: abort, continue, trace, debug, help, exit.
*/
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
static RETSIGTYPE
ReceiveSignal (int s, void *x, void *y)
{
CACHE_REGS
LOCAL_PrologMode |= InterruptMode;
switch (s)
{
case SIGINT:
// always direct SIGINT to console
Yap_external_signal( 0, YAP_INT_SIGNAL );
break;
case SIGALRM:
Yap_external_signal( worker_id, YAP_ALARM_SIGNAL );
break;
case SIGVTALRM:
Yap_external_signal( worker_id, YAP_VTALARM_SIGNAL );
break;
#ifndef MPW
#ifdef HAVE_SIGFPE
case SIGFPE:
set_fpu_exceptions(FALSE);
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error (SYSTEM_ERROR, TermNil, "floating point exception ]");
break;
#endif
@ -1681,24 +1545,26 @@ ReceiveSignal (int s, void *x, void *y)
/* These signals are not handled by WIN32 and not the Macintosh */
case SIGQUIT:
case SIGKILL:
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error(INTERRUPT_ERROR,MkIntTerm(s),NULL);
break;
#endif
#ifdef SIGUSR1
case SIGUSR1:
/* force the system to creep */
Yap_signal (YAP_USR1_SIGNAL);
Yap_external_signal ( worker_id, YAP_USR1_SIGNAL);
break;
#endif /* defined(SIGUSR1) */
#ifdef SIGUSR2
case SIGUSR2:
/* force the system to creep */
Yap_signal (YAP_USR2_SIGNAL);
Yap_external_signal ( worker_id, YAP_USR2_SIGNAL);
break;
#endif /* defined(SIGUSR2) */
#ifdef SIGPIPE
case SIGPIPE:
/* force the system to creep */
Yap_signal (YAP_PIPE_SIGNAL);
Yap_external_signal ( worker_id, YAP_PIPE_SIGNAL);
break;
#endif /* defined(SIGPIPE) */
#ifdef SIGHUP
@ -1709,7 +1575,7 @@ ReceiveSignal (int s, void *x, void *y)
#endif /* defined(SIGHUP) */
default:
fprintf(stderr, "\n[ Unexpected signal ]\n");
exit (EXIT_FAILURE);
exit (s);
}
}
#endif
@ -1728,11 +1594,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
case CTRL_C_EVENT:
case CTRL_BREAK_EVENT:
#if THREADS
Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
REMOTE_PrologMode(0) |= InterruptMode;
#else
Yap_signal(YAP_WINTIMER_SIGNAL);
LOCAL_PrologMode |= InterruptMode;
Yap_signal(YAP_WINTIMER_SIGNAL);
LOCAL_PrologMode |= InterruptMode;
#endif
return(TRUE);
default:
@ -1752,8 +1618,8 @@ InitSignals (void)
my_signal (SIGUSR1, ReceiveSignal);
my_signal (SIGUSR2, ReceiveSignal);
my_signal (SIGHUP, ReceiveSignal);
my_signal (SIGALRM, HandleALRM);
my_signal (SIGVTALRM, HandleVTALRM);
my_signal (SIGALRM, ReceiveSignal);
my_signal (SIGVTALRM, ReceiveSignal);
#endif
#ifdef SIGPIPE
my_signal (SIGPIPE, ReceiveSignal);
@ -1762,7 +1628,7 @@ InitSignals (void)
signal (SIGINT, SIG_IGN);
SetConsoleCtrlHandler(MSCHandleSignal,TRUE);
#else
my_signal (SIGINT, HandleSIGINT);
my_signal (SIGINT, ReceiveSignal);
#endif
#ifdef HAVE_SIGFPE
my_signal (SIGFPE, HandleMatherr);
@ -1961,7 +1827,7 @@ TrueFileName (char *source, char *root, char *result, int in_lib, int expand_roo
strncpy (result, ares1, YAP_FILENAME_MAX);
}
} else {
strncpy (result, ares1, YAP_FILENAME_MAX);
strncpy (result, ares1, YAP_FILENAME_MAX);
close(tmpf);
}
} else {
@ -2483,9 +2349,9 @@ p_alarm( USES_REGS1 )
i2 = IntegerOfTerm(t2);
if (i1 == 0 && i2 == 0) {
#if _WIN32
Yap_undo_signal( YAP_WINTIMER_SIGNAL );
Yap_get_signal( YAP_WINTIMER_SIGNAL );
#else
Yap_undo_signal( YAP_ALARM_SIGNAL );
Yap_get_signal( YAP_ALARM_SIGNAL );
#endif
}
#if _MSC_VER || defined(__MINGW32__)
@ -2844,26 +2710,20 @@ p_win32( USES_REGS1 )
static Int
p_enable_interrupts( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled--;
if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) {
if (LOCAL_Signals && !LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0);
if ( !Yap_only_has_signal( YAP_CREEP_SIGNAL ) )
EventFlag = Unsigned( LCL0 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
static Int
p_disable_interrupts( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled++;
if (LOCAL_ActiveSignals) {
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
CalculateStackGap( PASS_REGS1 );
return TRUE;
}

2
C/threads.c
View File

@ -208,7 +208,7 @@ kill_thread_engine (int wid, int always_die)
gl = gl->NextGE;
}
Yap_KillStacks(wid);
REMOTE_ActiveSignals(wid) = 0L;
REMOTE_Signals(wid) = 0L;
if (REMOTE_ScratchPad(wid).ptr)
free(REMOTE_ScratchPad(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache =

8
C/tracer.c
View File

@ -133,6 +133,8 @@ check_area(void)
PredEntry *old_p[10000];
Term old_x1[10000], old_x2[10000], old_x3[10000];
static CELL oldv;
void
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
{
@ -143,6 +145,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
if (vsc_count == 2956635LL) jmp_deb(1);
if (HR >= H0+(248348-10) && H0[248348] != oldv) {
printf("%lld HR=%p %lx\n", vsc_count, HR, H0[248348]);
oldv = H0[248348];
}
if (vsc_count < 2950305LL || vsc_count > 2960485LL) return;
// if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;

62
H/YapSignals.h
View File

@ -45,28 +45,36 @@ typedef enum
#ifdef SIGVTALRM
YAP_VTALARM_SIGNAL = SIGVTALRM, /* received SIGVTALARM */
#endif
YAP_CREEP_SIGNAL = NSIG+1, /* received a creep */
YAP_WAKEUP_SIGNAL = NSIG+2, /* goals to wake up */
YAP_ITI_SIGNAL = NSIG+3, /* received inter thread signal */
YAP_TROVF_SIGNAL = NSIG+4, /* received trail overflow */
YAP_CDOVF_SIGNAL = NSIG+5, /* received code overflow */
YAP_STOVF_SIGNAL = NSIG+6, /* received stack overflow */
YAP_TRACE_SIGNAL = NSIG+7, /* received start trace */
YAP_DEBUG_SIGNAL = NSIG+8, /* received start debug */
YAP_BREAK_SIGNAL = NSIG+9, /* received break signal */
YAP_STACK_DUMP_SIGNAL = NSIG+10, /* received stack dump signal */
YAP_STATISTICS_SIGNAL = NSIG+11, /* received statistics */
YAP_AGC_SIGNAL = NSIG+12, /* call atom garbage collector asap */
YAP_WINTIMER_SIGNAL = NSIG+13, /* windows alarm */
YAP_FAIL_SIGNAL = NSIG+14 /* P = FAILCODE */
YAP_CREEP_SIGNAL = (NSIG+1), /* received a creep */
YAP_WAKEUP_SIGNAL = (NSIG+2), /* goals to wake up */
YAP_ITI_SIGNAL = (NSIG+3), /* received inter thread signal */
YAP_TROVF_SIGNAL = (NSIG+4), /* received trail overflow */
YAP_CDOVF_SIGNAL = (NSIG+5), /* received code overflow */
YAP_STOVF_SIGNAL = (NSIG+6), /* received stack overflow */
YAP_TRACE_SIGNAL = (NSIG+7), /* received start trace */
YAP_DEBUG_SIGNAL = (NSIG+8), /* received start debug */
YAP_BREAK_SIGNAL = (NSIG+9), /* received break signal */
YAP_STACK_DUMP_SIGNAL = (NSIG+10), /* received stack dump signal */
YAP_STATISTICS_SIGNAL = (NSIG+11), /* received statistics */
YAP_AGC_SIGNAL = (NSIG+12), /* call atom garbage collector asap */
YAP_WINTIMER_SIGNAL = (NSIG+13), /* windows alarm */
YAP_FAIL_SIGNAL = (NSIG+14), /* P = FAILCODE */
YAP_ABORT_SIGNAL = (NSIG+15), /* P = FAILCODE */
YAP_EXIT_SIGNAL = (NSIG+16) /* P = FAILCODE */
} yap_signals;
#define Yap_undo_signal(S) Yap_undo_signal__(S PASS_REGS)
#define Yap_get_signal(S) Yap_get_signal__(S PASS_REGS)
#define Yap_has_a_signal() Yap_has_a_signal__(PASS_REGS1)
#define Yap_has_signal(S) Yap_has_signal__(S PASS_REGS)
#define Yap_has_signals(S1, S2) Yap_has_signals__(S1, S2 PASS_REGS)
#define Yap_only_has_signal(S) Yap_only_has_signal__(S PASS_REGS)
#define Yap_only_has_signals(S1, S2) Yap_only_has_signals__(S1, S2 PASS_REGS)
#define Yap_has_signal(S) Yap_has_signal__(S PASS_REGS)
#define Yap_only_has_signal(S) Yap_only_has_signal__(S PASS_REGS)
inline static uint64_t
SIGNAL_TO_BIT( yap_signals sig)
{
return ((uint64_t)1 << (sig-1));
}
INLINE_ONLY inline EXTERN int Yap_has_a_signal__ ( USES_REGS1 );
@ -74,15 +82,27 @@ INLINE_ONLY inline EXTERN int Yap_has_a_signal__ ( USES_REGS1 );
INLINE_ONLY inline EXTERN int
Yap_has_a_signal__ (USES_REGS1)
{
return LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal;
return LOCAL_Signals != ((uint64_t)0);
}
INLINE_ONLY inline EXTERN int
Yap_has_signal__(yap_signals sig USES_REGS)
{
return (LOCAL_Signals & SIGNAL_TO_BIT(sig)) != ((uint64_t)0);
}
INLINE_ONLY inline EXTERN int
Yap_only_has_signal__(yap_signals sig USES_REGS)
{
return (LOCAL_Signals & SIGNAL_TO_BIT(sig)) == SIGNAL_TO_BIT(sig);
}
void Yap_signal(yap_signals);
void Yap_external_signal(int, yap_signals);
int Yap_undo_signal__(yap_signals USES_REGS);
int Yap_get_signal__(yap_signals USES_REGS);
int Yap_has_a_signal__( USES_REGS1 );
int Yap_has_signal__(yap_signals USES_REGS);
int Yap_has_signals__(yap_signals,yap_signals USES_REGS);
int Yap_only_has_signal__(yap_signals USES_REGS);
int Yap_only_has_signals__(yap_signals,yap_signals USES_REGS);
int Yap_HandleInterrupts( void );

12
H/dlocals.h
View File

@ -99,12 +99,8 @@
#define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_
#define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_
#define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_
#define LOCAL_FirstActiveSignal LOCAL->FirstActiveSignal_
#define REMOTE_FirstActiveSignal(wid) REMOTE(wid)->FirstActiveSignal_
#define LOCAL_LastActiveSignal LOCAL->LastActiveSignal_
#define REMOTE_LastActiveSignal(wid) REMOTE(wid)->LastActiveSignal_
#define LOCAL_ActiveSignals LOCAL->ActiveSignals_
#define REMOTE_ActiveSignals(wid) REMOTE(wid)->ActiveSignals_
#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_
@ -239,10 +235,6 @@
#endif
#define LOCAL_consult_level LOCAL->consult_level_
#define REMOTE_consult_level(wid) REMOTE(wid)->consult_level_
#if defined(YAPOR) || defined(THREADS)
#define LOCAL_SignalLock LOCAL->SignalLock_
#define REMOTE_SignalLock(wid) REMOTE(wid)->SignalLock_
#endif
#define LOCAL_LocalBase LOCAL->LocalBase_
#define REMOTE_LocalBase(wid) REMOTE(wid)->LocalBase_

7
H/hlocals.h
View File

@ -56,9 +56,7 @@ typedef struct worker_local {
struct scanner_extra_alloc* ScannerExtraBlocks_;
struct DB_TERM* BallTerm_;
UInt MaxActiveSignals_;
UInt FirstActiveSignal_;
UInt LastActiveSignal_;
UInt* ActiveSignals_;
uint64_t Signals_;
UInt IPredArity_;
yamop* ProfEnd_;
int UncaughtThrow_;
@ -134,9 +132,6 @@ typedef struct worker_local {
Int total_choicepoints_;
#endif
int consult_level_;
#if defined(YAPOR) || defined(THREADS)
lockvar SignalLock_;
#endif
ADDR LocalBase_;
ADDR GlobalBase_;

7
H/ilocals.h
View File

@ -56,9 +56,7 @@ static void InitWorker(int wid) {
REMOTE_ScannerExtraBlocks(wid) = NULL;
REMOTE_BallTerm(wid) = NULL;
REMOTE_MaxActiveSignals(wid) = 64L;
REMOTE_FirstActiveSignal(wid) = 0L;
REMOTE_LastActiveSignal(wid) = 0L;
REMOTE_ActiveSignals(wid) = Yap_InitSignals(wid);
REMOTE_Signals(wid) = 0L;
REMOTE_IPredArity(wid) = 0L;
REMOTE_ProfEnd(wid) = NULL;
REMOTE_UncaughtThrow(wid) = FALSE;
@ -134,9 +132,6 @@ static void InitWorker(int wid) {
REMOTE_total_choicepoints(wid) = 0;
#endif
REMOTE_consult_level(wid) = 0;
#if defined(YAPOR) || defined(THREADS)
INIT_LOCK(REMOTE_SignalLock(wid));
#endif

5
H/rlocals.h
View File

@ -63,8 +63,6 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef COROUTINING
REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid));
REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid));
@ -134,9 +132,6 @@ static void RestoreWorker(int wid USES_REGS) {
#endif
#if defined(YAPOR) || defined(THREADS)
REINIT_LOCK(REMOTE_SignalLock(wid));
#endif

12
config.h.in
View File

@ -216,6 +216,12 @@
/* Define to 1 if you have the `fetestexcept' function. */
#undef HAVE_FETESTEXCEPT
/* Define to 1 if you have the `ffsl' function. */
#undef HAVE_FFSL
/* Define to 1 if you have the `ffsll' function. */
#undef HAVE_FFSLL
/* Define to 1 if you have the `fgetpos' function. */
#undef HAVE_FGETPOS
@ -225,6 +231,12 @@
/* Define to 1 if you have the <float.h> header file. */
#undef HAVE_FLOAT_H
/* Define to 1 if you have the `flsl' function. */
#undef HAVE_FLSL
/* Define to 1 if you have the `flsll' function. */
#undef HAVE_FLSLL
/* Define to 1 if you have the `fpclass' function. */
#undef HAVE_FPCLASS

38
library/dialect/swi/fli/swi.c
View File

@ -272,23 +272,29 @@ X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity)
X_API int PL_get_arg(int index, term_t ts, term_t a)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm( t ))
return 0;
return 0;
if ( !IsApplTerm(t) ) {
if (IsPairTerm(t)) {
if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1;
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1;
} else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1;
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1;
}
}
return 0;
} else {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f))
return 0;
if (index < 1 || index > ArityOfFunctor(f))
return 0;
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
/** @brief *ap is assigned the name and *ip the arity from term ts
@ -3138,18 +3144,8 @@ X_API int
PL_raise(int sig)
{
CACHE_REGS
LOCK(LOCAL_SignalLock);
if (sig < SIG_PROLOG_OFFSET) {
Yap_signal(YAP_INT_SIGNAL);
UNLOCK(LOCAL_SignalLock);
return 1;
} else if (sig == SIG_PLABORT) {
Yap_signal(0x40); /* YAP_INT_SIGNAL */
LOCK(LOCAL_SignalLock);
return 1;
}
UNLOCK(LOCAL_SignalLock);
return 0;
Yap_signal(YAP_INT_SIGNAL);
return 1;
}
int
@ -3158,9 +3154,7 @@ raiseSignal(PL_local_data_t *ld, int sig)
#if THREADS
CACHE_REGS
if (sig == SIG_THREAD_SIGNAL) {
LOCK(LOCAL_SignalLock);
Yap_signal(YAP_ITI_SIGNAL);
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
#endif

8
misc/LOCALS
View File

@ -58,9 +58,7 @@ char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid)
UInt MaxActiveSignals =64L
UInt FirstActiveSignal =0L
UInt LastActiveSignal =0L
UInt* ActiveSignals =Yap_InitSignals(wid)
uint64_t Signals =0L
UInt IPredArity =0L
yamop* ProfEnd =NULL
int UncaughtThrow =FALSE
@ -151,10 +149,6 @@ Int total_choicepoints =0
int consult_level =0
#if defined(YAPOR) || defined(THREADS)
lockvar SignalLock MkLock
#endif
// Variables related to memory allocation
ADDR LocalBase void
ADDR GlobalBase void

306
misc/sysgraph
View File

@ -16,7 +16,7 @@
public/2,
private/2,
module_on/3,
exported/1,
exported/1,
dir/2,
consulted/2,
op_export/3,
@ -136,7 +136,7 @@ c_preds(Dir - Mod) :-
expand_file_name( Pattern, Files ),
member( File0, Files ),
absolute_file_name( File0, File ),
( ( sub_atom(File,_,_,0,'.c')
( ( sub_atom(File,_,_,0,'.c')
;
sub_atom(File,_,_,0,'.i')
;
@ -162,11 +162,11 @@ c_preds(_).
c_file(F, _Mod) :-
consulted( F, _ ),
consulted( F, _ ),
!.
c_file(F, Mod) :-
% writeln(F),
assert( consulted( F, Mod ) ),
assert( consulted( F, Mod ) ),
nb_setval( current_module, Mod ),
open(F, read, S, [alias(c_file)]),
repeat,
@ -190,11 +190,11 @@ c_file(F, Mod) :-
c_line(["}"], Mod, _) :- !,
nb_setval( current_module, Mod ).
c_line(Line, _Mod, _) :-
c_line(Line, _Mod, _) :-
append( _, [ "CurrentModule", "=", M|_], Line),
system_mod(M, _Mod, Mod, _),
nb_setval( current_module, Mod ).
c_line(Line, Mod, F: LineP) :-
c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ).
@ -224,7 +224,7 @@ c_ext( S, Mod, F ) :-
assert( node( Mod, N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
).
break_line( Line, N/A, c(Fu)) :-
take_line( Line, NS, AS, FS ), !,
@ -247,7 +247,7 @@ break_line( Line, N/A, c(FuE, FuB)) :-
atom_string(FuE,FSE),
atom_string(FuB,FSB),
number_string(A, AS).
take_line( Line, NS, AS, FS ) :-
append( _, [ "Yap_InitCPred", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
@ -337,19 +337,19 @@ pl_interfs(_).
%
% main side-effect facts like edge( F0-Mod:File )
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
% module_on ( M, File )
% module_on ( M, File )
%
pl_interf(F, _Mod) :-
module_on( F , _M, _Is),
!.
pl_interf(F, Mod) :-
consulted(F, Mod ),
consulted(F, Mod ),
!.
pl_interf(F, Mod) :-
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
 ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
writeln( +F:Mod ),
assert_new(consulted(F, Mod ) ),
assert_new(consulted(F, Mod ) ),
nb_getval( private, Default ),
nb_setval( private, false ),
nb_getval( file_entry, OF:OMod ),
@ -358,9 +358,9 @@ writeln( +F:Mod ),
catch( open(PF, read, S, [scripting(true)]) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ),
%( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)),
(
(
T == end_of_file
->
!,
@ -392,44 +392,44 @@ writeln( +F:Mod ),
fail
).
get_interf( T, _F, _M0 ) :-
var(T),
!.
get_interf( T, _F, _M0 ) :-
var(T),
!.
get_interf( T, _F, _M0 ) :-
% ( T = (:- op(_,_,_)) -> trace ; true ),
var(T),
!.
var(T),
!.
get_interf( M:T, F, _M0 ) :- !,
get_interf( T, F, M ).
get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
get_interf( T, F, M ).
get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
nonvar( G ),
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( goal_expansion(G, _) , F, _M0 ) :-
get_interf( goal_expansion(G, _) , F, _M0 ) :-
nonvar( G ),
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H :- _B), F, _M ) :-
get_interf( ( M:H :- _B), F, _M ) :-
!,
get_interf( H, F, M ).
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
nonvar( G ),
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
nonvar( G ),
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H --> _B), F, _ ) :-
get_interf( ( M:H --> _B), F, _ ) :-
!,
get_interf( ( H --> _B), F, M ).
get_interf( ( A, _ --> _B), F, M ) :-
get_interf( ( A, _ --> _B), F, M ) :-
get_interf( ( A --> _B), F, M ).
get_interf( (H --> _B), F, M ) :-
!,
@ -449,8 +449,8 @@ get_interf( (:- module( NM, Is ) ), F, _M ) :-
nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ),
maplist( public(F, NM), Is ),
nb_setval( private, true ).
get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
nb_setval( private, true ).
get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
!,
% find the file
search_file( Loc, F, pl, NF ),
@ -470,56 +470,56 @@ get_interf( (:- use_module( Loc ) ), F, M ) :- !,
get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
!,
include_files( F, M, Is, Loc ).
get_interf( (:- consult( Files ) ), F, M ) :-
get_interf( (:- consult( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- reconsult( Files ) ), F, M ) :-
get_interf( (:- reconsult( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- include( Files ) ), F, M ) :-
get_interf( (:- include( Files ) ), F, M ) :-
!,
source_files( F, M, Files ).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :-
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- catch( G , _, _ ) ) , F, M) :-
get_interf( (:- catch( G , _, _ ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- initialization( G , now ) ) , F, M) :-
get_interf( (:- initialization( G , now ) ) , F, M) :-
!,
get_interf( (:- G ) , F, M).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
!,
include_files( F, M, Files ).
get_interf( (:- [F1|Fs] ), F, M ) :-
get_interf( (:- [F1|Fs] ), F, M ) :-
!,
include_files( F, M, [F1|Fs] ).
% don't actually use this one.
get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :-
get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :-
!,
call_c_files( F, M, Fun, Fs ).
get_interf( (:- load_foreign_library(F) ), F0, M ) :-
get_interf( (:- load_foreign_library(F) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :-
get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, Fun, F1 ).
get_interf( (:- use_foreign_library(F) ), F0, M ) :-
get_interf( (:- use_foreign_library(F) ), F0, M ) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :-
get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :-
!.
get_interf( (:- style_checker( _ ) ), _F, _M ) :-
!.
get_interf( (:- style_checker( _ ) ), _F, _M ) :-
!.
get_interf( (:- dynamic T), F, M ) :-
!,
declare_functors( T, F, M ).
@ -535,14 +535,14 @@ get_interf( (:- '$install_meta_predicate'( H, M) ), F, __M ) :-
get_interf( (:- thread_local T), F, M ) :-
!,
declare_functors( T, F, M ).
get_interf( (:- op( X, Y, Z) ), F, M ) :-
get_interf( (:- op( X, Y, Z) ), F, M ) :-
!,
always_strip_module(M:Z, M1, Z1),
handle_op( F, M1, op( X, Y, Z1) ).
get_interf( (:- record( Records ) ), F, M ) :-
get_interf( (:- record( Records ) ), F, M ) :-
!,
handle_record( Records, F, M).
get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :-
get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :-
!,
set_prolog_flag(dollar_as_lower_case,On).
get_interf( (:- _ ), _F, _M ) :- !.
@ -599,7 +599,7 @@ handle_record_field_name( Constructor, F, M, Name) :-
handle_pred( M, Set, 2, F),
atom_concat([ nb_set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F).
handle_pred( M, Set, 2, F).
handle_pred( M, N, A, F ) :-
(
@ -636,7 +636,7 @@ handle_op( F, M, Op ) :-
op( X, Y, M:Z )
).
exported( NF, F, NM, M, op(X,Y,Z)) :-
exported( NF, F, NM, M, op(X,Y,Z)) :-
!,
public( NF , NM:op(X,Y,Z) ),
handle_op( F, M , op(X,Y,Z) ).
@ -677,11 +677,11 @@ include_files( F, M, Is, Files ) :-
include_files( F, M, Is, -Files ) :-
!,
include_files( F, M, Is, Files).
include_files( F, M, Is, Files ) :-
include_files( F, M, Is, Files ) :-
!,
always_strip_module(M:Files, M1, NFiles),
include_file( F, M1, Is, NFiles ).
include_files( F, M, Is, Loc ) :-
include_files( F, M, Is, Loc ) :-
include_file( F, M, Is, Loc ).
include_file( F, M, Is, Loc ) :-
@ -707,7 +707,7 @@ include_file( F, M, Is0, Loc ) :-
source_files( F, M, Files ) :-
maplist( source_files( F, M ), Files ),
!.
source_files( F, M, Loc ) :-
source_files( F, M, Loc ) :-
source_file( F, M, Loc ).
source_file( F, M, Loc ) :-
@ -721,9 +721,9 @@ pl_source(F, F0, Mod) :-
catch( open(PF, read, S, []) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)),
(
(
T == end_of_file
->
!,
@ -744,9 +744,9 @@ declare_functors( M:T, F, _M1) :- !,
declare_functors( (T1,T2), F, M1) :- !,
declare_functors( T1, F, M1),
declare_functors( T2, F, M1).
declare_functors( Ts, F, M1) :-
declare_functors( Ts, F, M1) :-
maplist( declare_functor( F, M1), Ts ), !.
declare_functors( T, F, M1) :-
declare_functors( T, F, M1) :-
declare_functor( F, M1, T).
declare_functor(File, M, N/A) :-
@ -756,7 +756,7 @@ declare_terms( T, _F, _M1) :- var(T), !,
error( unbound_variable ).
declare_terms( M:T, F, _M1) :- !,
declare_functors( T, F, M).
declare_terms( (N1,N2), F, M) :-
declare_terms( (N1,N2), F, M) :-
number(N1),
number(N2),
!,
@ -764,9 +764,9 @@ declare_terms( (N1,N2), F, M) :-
declare_terms( (T1,T2), F, M1) :- !,
declare_terms( T1, F, M1),
declare_terms( T2, F, M1).
declare_terms( Ts, F, M1) :-
declare_terms( Ts, F, M1) :-
maplist( declare_term( F, M1), Ts ), !.
declare_terms( T, F, M1) :-
declare_terms( T, F, M1) :-
declare_term( F, M1, T).
declare_term(F, M, S) :-
@ -797,8 +797,8 @@ pl_graphs(_).
%
% main side-effect facts like edge( F0-Mod:File )
% exported( F-M , N/A ) ou exported(F- M. Op ),
% module_on ( M, File )
% pred ( M :N/A )
% module_on ( M, File )
% pred ( M :N/A )
%
build_graph(F, Mod) :-
% writeln(F),
@ -807,12 +807,12 @@ build_graph(F, Mod) :-
repeat,
nb_getval( current_module, MR ),
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))),
(
(
T == end_of_file
->
!,
% also, clo ops defined in the module M, if M \= Mod
% ( sub_atom(F,_,_,_,'/matrix.yap') -> start_low_level_trace ; nospyall ),
% ( sub_atom(F,_,_,_,'/matrix.yap') -> start_low_level_trace ; nospyall ),
close(S)
;
stream_position_data( line_count, Pos, Line ),
@ -829,18 +829,18 @@ get_graph( V , _F, _Pos, _M ) :-
var( V ),
!,
error( instantiation_error ).
get_graph( T, _F, _Pos, _M0 ) :-
var(T),
!.
get_graph( T, _F, _Pos, _M0 ) :-
var(T),
!.
get_graph( M:T, F, _Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ).
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
get_graph( T, F, _Pos, M ).
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
!,
get_graph( (H :- M0:B), F, _Pos, M ).
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
!,
get_graph( ( H --> M0:B), F, _Pos, M ).
get_graph( ( A, _ --> B), F, _Pos, M ) :-
get_graph( ( A, _ --> B), F, _Pos, M ) :-
get_graph( ( A --> B), F, _Pos, M ).
get_graph( (H --> B), F, _Pos, M ) :-
!,
@ -864,13 +864,13 @@ source_graphs( M, F, Fs ) :-
search_file( Fs, F, pl, NF ),
build_graph( NF , M ), !.
add_deps(V, _M, _P, _F, _Pos, _) :-
add_deps(V, _M, _P, _F, _Pos, _) :-
var(V), !.
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
!,
always_strip_module(M1:G, M2, G2),
add_deps(G2, M2, _P, _F, _Pos, L).
add_deps((A,B), M, P, F, _Pos, L) :-
add_deps((A,B), M, P, F, _Pos, L) :-
!,
add_deps(A, M, P, F, _Pos, L),
add_deps(B, M, P, F, _Pos, L).
@ -890,7 +890,7 @@ add_deps(once(A), M, P, F, _Pos, L) :- !,
add_deps(A, M, P, F, _Pos, L).
add_deps({A}, M, P, F, _Pos, 2) :- !,
add_deps(A, M, P, F, _Pos, 0).
add_deps([_|_], M, P, F, Pos, 2) :-
add_deps([_|_], M, P, F, Pos, 2) :-
!,
put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !.
@ -906,18 +906,18 @@ add_deps(A, M, P, F, Pos, L) :-
Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), Pos ) :-
put_dep( (Target :- F0-M:Goal ), Pos ) :-
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
%follow ancestor chain
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
% the base case, copying from the same module ( but maybe not same file 0.
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
m_exists(M:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
% prolog is visible ( but maybe not same file ).
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
m_exists(prolog:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
@ -928,7 +928,7 @@ put_dep( ( Target :- F-Mod:N/Ar ), Pos) :-
stream_position_data( line_count, Pos, Line ),
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
ancestor( ( Younger :- Older) ) :-
ancestor( ( Younger :- Older) ) :-
exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ).
@ -956,7 +956,7 @@ undefs :-
\+ 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]),
@ -979,7 +979,7 @@ out_list([E1,E2|Es]) :-
maplist(out_el, [E2|Es]),
format(']', []).
out_el( El ) :-
out_el( El ) :-
format(',~n ~q',[El]).
pub(M, P) :-
@ -1006,7 +1006,7 @@ priv(M, P) :-
edge(_:P, _P1, F1:_), F1 \= F.
% utilities
split_string( S , Cs, N) :-
string_codes(S, S1),
string_codes(Cs, NCs),
@ -1044,8 +1044,8 @@ warn_singletons(_Vars, _Pos).
% comment( +Comment )
%
% Handle documentation comments
%
comment( _Pos - Comment) :-
%
comment( _Pos - Comment) :-
skip_blanks(1, Comment, N),
doc( Comment, N ), !,
format( "%s\n", [Comment] ).
@ -1096,14 +1096,14 @@ search_file0( A/B, F, Type, FN ) :- !,
search_file0( AB, F, Type, FN ).
% libraries can be anywhere in the source.
search_file0( LibLoc, F, Type, FN ) :-
LibLoc =.. [Dir,File],
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),
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),
@ -1142,47 +1142,47 @@ sub_dir( D, DD) :-
% files must be called .yap or .pl
% if it is .yap...
check_suffix( Loc , pl, Loc ) :-
check_suffix( Loc , pl, Loc ) :-
atom_concat( _, '.yap', Loc ), !.
%, otherwise, .pl
check_suffix( Loc , pl, Loc ) :-
check_suffix( Loc , pl, Loc ) :-
atom_concat( _, '.pl', Loc ), !.
%, otherwise, .prolog
check_suffix( Loc , pl, Loc ) :-
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']),
check_suffix( Loc0 , pl, Loc ) :-
member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']),
atom_concat( Loc0, Suf, Loc ).
check_suffix( Loc , c, Loc ) :-
check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.c', Loc ), !.
%, otherwise, .pl
check_suffix( Loc , c, Loc ) :-
check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.icc', Loc ), !.
%, otherwise, .prolog
check_suffix( Loc , c, Loc ) :-
check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.cpp', Loc ), !.
%, otherwise, .P
% try adding suffix
check_suffix( Loc0 , c, Loc ) :-
member( Suf , ['.c', '.icc' , '.cpp']),
check_suffix( Loc0 , c, Loc ) :-
member( Suf , ['.c', '.icc' , '.cpp']),
atom_concat( Loc0, Suf, Loc ).
match_file( LocD, Loc0, Type, FN ) :-
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 ) :-
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 ),
!,
@ -1200,7 +1200,7 @@ 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).
preprocess_file(F,F).
%%%%%%%
@ -1211,7 +1211,7 @@ public( F, M, op(X,Y,Z) ) :-
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 )
@ -1239,9 +1239,9 @@ public( F, M, N//Ar ) :-
assert( node( M, N/Ar2, F-L, prolog ) ), !.
public( _F, _M, _//_Ar ).
private( F, M, op(X,Y,Z) ) :-
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 )
@ -1251,7 +1251,7 @@ private( F, M, op(X,Y,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-_, _ ),
\+ node( M, N/Ar, F-_, _ ),
nb_getval( line, L ),
assert( node( M, N/Ar, F-L, prolog ) ), !.
private( _F, _M, _N/_Ar ).
@ -1274,6 +1274,7 @@ 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.
%
%
@ -1281,10 +1282,10 @@ mkdocs :-
open( 'docs/yapdocs.yap', read, S),
repeat,
(
skip_blanks(S)
skip_blanks(S, Comment, Rest)
->
get_comment(S, Comment, Owner),
store_comment( Comment, Owner ),
get_comment(S, Rest),
store_comment( Comment ),
fail
;
close(S),
@ -1292,6 +1293,81 @@ mkdocs :-
).
skip_blanks( S , T) :-
read_line_to_codes(S, T, TF),
( T == end_of_file -> fail;
foldl( check, "/**",T, TF) -> true ;
skip_blanks( S , TF) ).
get_comment( S , T) :-
read_line_to_codes(S, T, T0),
( T == end_of_file -> fail;
diff_end( "*/",T ) -> T0 = [] ;
get_comment( S , [10|T0]) ).
check(C, [C0|L], L) :-
C == C0.
diff_end( [], T ) :- var(T), !.
diff_end( [H|L], [H1|L1]) :-
H == H1, !,
diff_end( L, L1 ).
diff_end( L, [_|L1]) :-
diff_end( L, L1 ).
store_comment(Comment) :-
header( Pred, Arity, Comment, [] ),
atom_codes( P, Pred),
number_codes( A, Arity ),
node( Mod, P/A, File-Line, Type),
\+ ( node( M1, P/A, _, _), M1 \= Mod ), !,
string_codes( C, Comment ),
assert( do_comment( File, Line, C, Type) ).
store_comment(Comment) :-
assert(open_comment(Comment)).
header(Pred, Arity) -->
"/**",
blank,
"@pred",
blank,
atom(Pred),
"/",
int(Arity).
blank --> " ", !, blank.
blank --> "\t", !, blank.
blank --> [].
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 ).
add_comments :-
findall(File, do_comment( File, Line, C, Type), Fs ),
member( F, Fs ),
format('File ~a', [F]),
setof(Line-C-Type, do_comment( File, Line, C, Type) , Lines ),
member(Line-Comment-Type, Lines),
format('% line ~d ~w~n~s~n', [Line, Type, Comment]),
fail.
add_comments :-
listing( open_comment ).
%%%
% ops_default sets operators back to YAP default.
%
ops_default :-
abolish( default_ops/1 ),
A = (_,_), functor(A,Comma,2),
@ -1302,7 +1378,7 @@ ops_default :-
ops_restore :-
A = (_,_), functor(A,Comma,2),
current_op(_X,Y,prolog:Z),
current_op(_X,Y,prolog:Z),
Z\= Comma,
op(0,Y,prolog:Z),
fail.
@ -1311,14 +1387,14 @@ ops_restore :-
maplist( call, L ).
do_user_c_dep(F1, F2) :-
absolute_file_name(F1, A1),
absolute_file_name(F1, A1),
absolute_file_name(F2, A2),
assert(c_dep(A1, A2)).
do_user_skip(F1) :-
absolute_file_name(F1, A1),
absolute_file_name(F1, A1),
assert(doskip(A1)).
do_user_expand(F, F1) :-
absolute_file_name(F1, A1),
absolute_file_name(F1, A1),
assert(doexpand(F, A1)).
user_deps( F, M ) :-
@ -1397,5 +1473,3 @@ user_skip( 'packages/prism/src/prolog/bp').
user_skip( 'packages/prism/src/c').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ).

2
packages/real

@ -1 +1 @@
Subproject commit 8fce081eea0393bfcf831445cf8d6e15e647e63f
Subproject commit e5bbf54db21189a5c56e0201433cffbf7e959147

2
packages/zlib

@ -1 +1 @@
Subproject commit 72c25dd4d953745e3e77826c7b6cde0f63cb07d9
Subproject commit d9488412c50ea2f9df0747ec100737808cd71a5b

1
pl/qly.yap
View File

@ -218,6 +218,7 @@ save_program(File, _Goal) :-
'$x_yap_flag'(X, V) :-
yap_flag(X, V),
X \= gc_margin, % different machines will have different needs,
X \= os_argv,
X \= language,
X \= max_threads,
X \= max_workers,