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

6
C/adtdefs.c
View File

@ -26,8 +26,6 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include "Yap.h" #include "Yap.h"
static Prop PredPropByFunc(Functor, Term);
static Prop PredPropByAtom(Atom, Term);
#include "Yatom.h" #include "Yatom.h"
#include "yapio.h" #include "yapio.h"
#include "pl-shared.h" #include "pl-shared.h"
@ -206,11 +204,9 @@ LookupAtom(const char *atom)
INIT_RWLOCK(ae->ARWLock); INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock); WRITE_UNLOCK(HashChain[hash].AERWLock);
CACHE_REGS CACHE_REGS
LOCK(LOCAL_SignalLock);
if (NOfAtoms > 2*AtomHashTableSize) { if (NOfAtoms > 2*AtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL); Yap_signal(YAP_CDOVF_SIGNAL);
} }
UNLOCK(LOCAL_SignalLock);
return na; return na;
} }
@ -276,11 +272,9 @@ LookupWideAtom(const wchar_t *atom)
INIT_RWLOCK(ae->ARWLock); INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(WideHashChain[hash].AERWLock); WRITE_UNLOCK(WideHashChain[hash].AERWLock);
CACHE_REGS CACHE_REGS
LOCK(LOCAL_SignalLock);
if (NOfWideAtoms > 2*WideAtomHashTableSize) { if (NOfWideAtoms > 2*WideAtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL); Yap_signal(YAP_CDOVF_SIGNAL);
} }
UNLOCK(LOCAL_SignalLock);
return na; 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); HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
UNLOCK(HeapUsedLock); UNLOCK(HeapUsedLock);
UNLOCK(HeapTopLock); UNLOCK(HeapTopLock);
LOCK(LOCAL_SignalLock);
Yap_signal(YAP_CDOVF_SIGNAL); Yap_signal(YAP_CDOVF_SIGNAL);
UNLOCK(LOCAL_SignalLock);
} else { } else {
if (size > GLOBAL_SizeOfOverflow) if (size > GLOBAL_SizeOfOverflow)
GLOBAL_SizeOfOverflow = size*sizeof(CELL) + sizeof(YAP_SEG_SIZE); 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 */ /* the obvious solution: do it by using binary search */
Int out = 0; Int out = 0;
int off = sizeof(CELL)*4;
if (inp < 0) { if (inp < 0) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
"msb/1 received %d", inp); "msb/1 received %d", inp);
} }
#if 0
#else
int off = sizeof(CELL)*4;
while (off) { while (off) {
Int limit = ((CELL)1) << (off); Int limit = ((CELL)1) << (off);
if (inp >= limit) { if (inp >= limit) {
@ -339,6 +342,7 @@ msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */
} }
off >>= 1; off >>= 1;
} }
#endif
return(out); 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)); Yap_UpdateTimedVar(LOCAL_WokenGoals, MkPairTerm(ng, WGs));
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
LOCK(LOCAL_SignalLock);
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL); Yap_signal(YAP_WAKEUP_SIGNAL);
UNLOCK(LOCAL_SignalLock);
} }
return(RepAppl(ng)+2); return(RepAppl(ng)+2);
} }
@ -63,12 +61,10 @@ AddFailToQueue( USES_REGS1 )
WGs = Yap_ReadTimedVar(LOCAL_WokenGoals); WGs = Yap_ReadTimedVar(LOCAL_WokenGoals);
Yap_UpdateTimedVar(LOCAL_WokenGoals, MkPairTerm(MkAtomTerm(AtomFail), WGs)); Yap_UpdateTimedVar(LOCAL_WokenGoals, MkPairTerm(MkAtomTerm(AtomFail), WGs));
LOCK(LOCAL_SignalLock);
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL); Yap_signal(YAP_WAKEUP_SIGNAL);
} }
UNLOCK(LOCAL_SignalLock);
} }
static attvar_record * static attvar_record *

21
C/c_interface.c
View File

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

6
C/cdmgr.c
View File

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

2
C/dlmalloc.c
View File

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

25
C/errors.c
View File

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

62
C/exec.c
View File

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

4
C/heapgc.c
View File

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

4
C/inlines.c
View File

@ -432,11 +432,9 @@ p_dif( USES_REGS1 )
#ifdef COROUTINING #ifdef COROUTINING
/* now restore Woken Goals to its old value */ /* now restore Woken Goals to its old value */
Yap_UpdateTimedVar(LOCAL_WokenGoals, OldWokenGoals); Yap_UpdateTimedVar(LOCAL_WokenGoals, OldWokenGoals);
LOCK(LOCAL_SignalLock);
if (OldWokenGoals == TermNil) { if (OldWokenGoals == TermNil) {
Yap_undo_signal(YAP_WAKEUP_SIGNAL); Yap_get_signal(YAP_WAKEUP_SIGNAL);
} }
UNLOCK(LOCAL_SignalLock);
#endif #endif
/* restore B */ /* restore B */
B = pt1; 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) X_API int PL_handle_signals(void)
{ {
GET_LD return Yap_HandleInterrupts( );
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;
} }
void void
@ -1215,7 +1208,6 @@ PL_w32thread_raise(DWORD id, int sig)
return FALSE; /* illegal signal */ return FALSE; /* illegal signal */
PL_LOCK(L_PLFLAG); PL_LOCK(L_PLFLAG);
// LOCK(LOCAL_SignalLock);
for(i = 0; i <= thread_highest_id; i++) for(i = 0; i <= thread_highest_id; i++)
{ PL_thread_info_t *info = GD->thread.threads[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); Yap_external_signal(i, sig); //raiseSignal(info->thread_data, sig);
if ( info->w32id ) if ( info->w32id )
PostThreadMessage(info->w32id, WM_SIGNALLED, 0, 0L); PostThreadMessage(info->w32id, WM_SIGNALLED, 0, 0L);
//UNLOCK(LOCAL_SignalLock);
PL_UNLOCK(L_PLFLAG); PL_UNLOCK(L_PLFLAG);
DEBUG(1, Sdprintf("Signalled %d to thread %d\n", sig, i)); DEBUG(1, Sdprintf("Signalled %d to thread %d\n", sig, i));
return TRUE; return TRUE;
} }
} }
// UNLOCK(LOCAL_SignalLock);
PL_UNLOCK(L_PLFLAG); PL_UNLOCK(L_PLFLAG);
return FALSE; /* can't find thread */ return FALSE; /* can't find thread */

510
C/signals.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- * * Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: signal.c * * File: signal.c *
* comments: Signal Handling & Debugger Support * * comments: Signal Handling & Debugger Support *
* * * *
* * * *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -36,91 +36,166 @@ static char SccsId[] = "%W% %G%";
#include <malloc.h> #include <malloc.h>
#endif #endif
#include <wchar.h> #include <wchar.h>
#ifdef LOW_LEVEL_TRACER
#include <tracer.h>
#endif
#ifndef THREADS #ifndef THREADS
#define worker_id 0 #define worker_id 0
#endif #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 inline static void
do_signal(int wid, yap_signals sig USES_REGS) do_signal(int wid, yap_signals sig USES_REGS)
{ {
#if THREADS #if THREADS
__sync_fetch_and_or ( &REMOTE(wid)->Signals_, SIGNAL_TO_BIT(sig));
if (!REMOTE_InterruptsDisabled(wid)) { if (!REMOTE_InterruptsDisabled(wid)) {
REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ = REMOTE_ThreadHandle(wid).current_yaam_regs->CreepFlag_ =
Unsigned(REMOTE_ThreadHandle(wid).current_yaam_regs->LCL0_); 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_);
} }
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 #else
LOCAL_Signals += SIGNAL_TO_BIT(sig);
if (!LOCAL_InterruptsDisabled) { if (!LOCAL_InterruptsDisabled) {
CreepFlag = CreepFlag =
Unsigned(LCL0); Unsigned(LCL0);
if (sig != YAP_CREEP_SIGNAL)
EventFlag =
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 #endif
} }
inline static int inline static int
undo_signal(yap_signals sig USES_REGS) get_signal(yap_signals sig USES_REGS)
{ {
UInt i = LOCAL_FirstActiveSignal; #if THREADS
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) { uint64_t old;
do {
if (sig == LOCAL_ActiveSignals[i]) // first, clear the Creep Flag, now if someone sets it it is their problem
break; CalculateStackGap( PASS_REGS1 );
i++; // reset the flag
if (i == LOCAL_MaxActiveSignals) if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) !=
i = 0; SIGNAL_TO_BIT(sig)) {
} while (i != LOCAL_LastActiveSignal); if (!(old & SIGNAL_TO_BIT(sig)) ) {
} // weird, it was consumed?
if (i == LOCAL_LastActiveSignal) { return FALSE;
return FALSE; }
} if (!LOCAL_InterruptsDisabled && LOCAL_Signals != 0) {
while ((i+1) % LOCAL_MaxActiveSignals != LOCAL_LastActiveSignal) { CreepFlag = (CELL)LCL0;
LOCAL_ActiveSignals[i] = LOCAL_ActiveSignals[(i+1) % LOCAL_MaxActiveSignals]; }
i++; // more likely case, we have other interrupts.
} return TRUE;
if (LOCAL_LastActiveSignal == 0)
LOCAL_LastActiveSignal = LOCAL_MaxActiveSignals-1;
else
LOCAL_LastActiveSignal--;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) {
CalculateStackGap( PASS_REGS1 );
} }
// success, we are good
return TRUE; 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 static Int
@ -132,9 +207,7 @@ p_creep( USES_REGS1 )
at = AtomCreep; at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred; CreepCode = pred;
LOCK(LOCAL_SignalLock);
do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS); do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
@ -147,35 +220,24 @@ p_creep_fail( USES_REGS1 )
at = AtomCreep; at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred; CreepCode = pred;
LOCK(LOCAL_SignalLock);
do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS); do_signal(worker_id, YAP_CREEP_SIGNAL PASS_REGS);
UNLOCK(LOCAL_SignalLock);
return FALSE; return FALSE;
} }
static Int static Int
p_stop_creeping( USES_REGS1 ) p_stop_creeping( USES_REGS1 )
{ {
LOCK(LOCAL_SignalLock); get_signal( YAP_CREEP_SIGNAL PASS_REGS );
undo_signal( YAP_CREEP_SIGNAL PASS_REGS );
UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
static Int static Int
p_creep_allowed( USES_REGS1 ) p_creep_allowed( USES_REGS1 )
{ {
LOCK(LOCAL_SignalLock);
if (PP != NULL) { if (PP != NULL) {
undo_signal(YAP_CREEP_SIGNAL PASS_REGS); get_signal(YAP_CREEP_SIGNAL PASS_REGS);
if (!LOCAL_InterruptsDisabled) { return TRUE;
if (LOCAL_FirstActiveSignal == LOCAL_LastActiveSignal)
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
} }
UNLOCK(LOCAL_SignalLock);
return FALSE; return FALSE;
} }
@ -183,9 +245,12 @@ void
Yap_signal(yap_signals sig) Yap_signal(yap_signals sig)
{ {
CACHE_REGS CACHE_REGS
do_signal(worker_id, sig PASS_REGS); do_signal(worker_id, sig PASS_REGS);
} }
static Int
p_debug( USES_REGS1 );
void void
Yap_external_signal(int wid, yap_signals sig) 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; REGSTORE *regcache = REMOTE_ThreadHandle(wid).current_yaam_regs;
#endif #endif
do_signal(wid, sig PASS_REGS); do_signal(wid, sig PASS_REGS);
LOCAL_PrologMode &= ~InterruptMode;
p_debug( PASS_REGS1 );
} }
int int
Yap_undo_signal__(yap_signals sig USES_REGS) Yap_get_signal__(yap_signals sig USES_REGS)
{ {
return undo_signal(sig PASS_REGS); return get_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;
} }
// the caller holds the lock. // the caller holds the lock.
int int
Yap_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) Yap_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS)
{ {
UInt i = LOCAL_FirstActiveSignal; return LOCAL_Signals & (1LL<sig1|1LL<sig2);
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;
} }
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 int
Yap_only_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS) Yap_only_has_signals__(yap_signals sig1, yap_signals sig2 USES_REGS)
{ {
UInt i = LOCAL_FirstActiveSignal; uint64_t sigs = LOCAL_Signals;
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) { return sigs & (1LL<sig1 | 1LL<sig2) &&
do { ! (sigs & ~(1LL<sig1 | 1LL<sig2)) ;
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;
} }
#ifdef DEBUG #ifdef DEBUG
volatile int volat = 0;
static Int static Int
p_debug( USES_REGS1 ) p_debug( USES_REGS1 )
{ /* $debug(+Flag) */ { /* $debug(+Flag) */
int i = IntOfTerm(Deref(ARG1)); int i = IntOfTerm(Deref(ARG1));
while (volat == 0) {
}
if (i >= 'a' && i <= 'z') if (i >= 'a' && i <= 'z')
GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96]; 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_debug_end_loop(void)
{
volat = 1;
}
#endif #endif
static Int static Int
@ -295,106 +318,105 @@ p_first_signal( USES_REGS1 )
Atom at; Atom at;
yap_signals sig; yap_signals sig;
LOCK(LOCAL_SignalLock); while (TRUE) {
/* always do wakeups first, because you don't want to keep the uint64_t mask = LOCAL_Signals;
non-backtrackable variable bad */ if (mask == 0)
if (LOCAL_FirstActiveSignal != LOCAL_LastActiveSignal) { return FALSE;
sig = LOCAL_ActiveSignals[LOCAL_FirstActiveSignal]; sig = ffsll(mask);
LOCAL_FirstActiveSignal++; if (get_signal(sig PASS_REGS)) {
if (LOCAL_FirstActiveSignal == LOCAL_MaxActiveSignals) break;
LOCAL_FirstActiveSignal = 0; }
} else { }
sig = YAP_NO_SIGNAL; loop:
}
switch (sig) { switch (sig) {
case YAP_INT_SIGNAL: case YAP_INT_SIGNAL:
at = AtomSigInt; sig = ProcessSIGINT();
break; if (sig == YAP_INT_SIGNAL) {
case YAP_CREEP_SIGNAL: at = AtomSigInt;
at = AtomSigCreep; break;
break; }
case YAP_TRACE_SIGNAL: if (sig != YAP_NO_SIGNAL)
at = AtomSigTrace; goto loop;
break; return FALSE;
case YAP_DEBUG_SIGNAL: case YAP_ABORT_SIGNAL:
at = AtomSigDebug; /* abort computation */
break; LOCAL_PrologMode &= ~AsyncIntMode;
case YAP_BREAK_SIGNAL: if (LOCAL_PrologMode & (GCMode|ConsoleGetcMode|CritMode)) {
at = AtomSigBreak; LOCAL_PrologMode |= AbortMode;
break; return -1;
case YAP_FAIL_SIGNAL: } else {
at = AtomFail; Yap_Error(PURE_ABORT, TermNil, "abort from console");
break; }
case YAP_STACK_DUMP_SIGNAL: Yap_RestartYap( 1 );
at = AtomSigStackDump; return FALSE;
break; case YAP_CREEP_SIGNAL:
case YAP_STATISTICS_SIGNAL: at = AtomSigCreep;
at = AtomSigStatistics; break;
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 #ifdef SIGALRM
case YAP_ALARM_SIGNAL: case YAP_ALARM_SIGNAL:
#endif #endif
case YAP_WINTIMER_SIGNAL: case YAP_WINTIMER_SIGNAL:
at = AtomSigAlarm; at = AtomSigAlarm;
break; break;
#ifdef SIGVTALRM #ifdef SIGVTALRM
case YAP_VTALARM_SIGNAL: case YAP_VTALARM_SIGNAL:
at = AtomSigVTAlarm; at = AtomSigVTAlarm;
break; break;
#endif #endif
case YAP_WAKEUP_SIGNAL: case YAP_WAKEUP_SIGNAL:
at = AtomSigWakeUp; at = AtomSigWakeUp;
break; break;
case YAP_ITI_SIGNAL: case YAP_ITI_SIGNAL:
at = AtomSigIti; at = AtomSigIti;
break; break;
#ifdef SIGPIPE #ifdef SIGPIPE
case YAP_PIPE_SIGNAL: case YAP_PIPE_SIGNAL:
at = AtomSigPipe; at = AtomSigPipe;
break; break;
#endif #endif
#ifdef SIGHUP #ifdef SIGHUP
case YAP_HUP_SIGNAL: case YAP_HUP_SIGNAL:
at = AtomSigHup; at = AtomSigHup;
break; break;
#endif #endif
#ifdef SIGUSR1 #ifdef SIGUSR1
case YAP_USR1_SIGNAL: case YAP_USR1_SIGNAL:
at = AtomSigUsr1; at = AtomSigUsr1;
break; break;
#endif #endif
#ifdef SIGUSR2 #ifdef SIGUSR2
case YAP_USR2_SIGNAL: case YAP_USR2_SIGNAL:
at = AtomSigUsr2; at = AtomSigUsr2;
break; break;
#endif #endif
default: default:
UNLOCK(LOCAL_SignalLock); return FALSE;
return FALSE;
} }
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(at)); return Yap_unify(ARG1, MkAtomTerm(at));
} }
static Int static Int
p_continue_signals( USES_REGS1 ) p_continue_signals( USES_REGS1 )
{ {
yap_signals sig; return p_first_signal( PASS_REGS1 );
/* 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;
} }
void void
@ -408,7 +430,7 @@ Yap_InitSignalCPreds(void)
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0); Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0);
#ifdef DEBUG #ifdef DEBUG
Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag); Yap_InitCPred("sys_debug", 1, p_debug, SafePredFlag|SyncPredFlag);
#endif #endif
} }

200
C/sysbits.c
View File

@ -1514,165 +1514,29 @@ my_signal_info(int sig, void (*handler)(int, void *, void *))
#endif #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) #if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
static RETSIGTYPE static RETSIGTYPE
ReceiveSignal (int s, void *x, void *y) ReceiveSignal (int s, void *x, void *y)
{ {
CACHE_REGS
LOCAL_PrologMode |= InterruptMode;
switch (s) 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 #ifndef MPW
#ifdef HAVE_SIGFPE #ifdef HAVE_SIGFPE
case SIGFPE: case SIGFPE:
set_fpu_exceptions(FALSE); set_fpu_exceptions(FALSE);
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error (SYSTEM_ERROR, TermNil, "floating point exception ]"); Yap_Error (SYSTEM_ERROR, TermNil, "floating point exception ]");
break; break;
#endif #endif
@ -1681,24 +1545,26 @@ ReceiveSignal (int s, void *x, void *y)
/* These signals are not handled by WIN32 and not the Macintosh */ /* These signals are not handled by WIN32 and not the Macintosh */
case SIGQUIT: case SIGQUIT:
case SIGKILL: case SIGKILL:
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error(INTERRUPT_ERROR,MkIntTerm(s),NULL); Yap_Error(INTERRUPT_ERROR,MkIntTerm(s),NULL);
break;
#endif #endif
#ifdef SIGUSR1 #ifdef SIGUSR1
case SIGUSR1: case SIGUSR1:
/* force the system to creep */ /* force the system to creep */
Yap_signal (YAP_USR1_SIGNAL); Yap_external_signal ( worker_id, YAP_USR1_SIGNAL);
break; break;
#endif /* defined(SIGUSR1) */ #endif /* defined(SIGUSR1) */
#ifdef SIGUSR2 #ifdef SIGUSR2
case SIGUSR2: case SIGUSR2:
/* force the system to creep */ /* force the system to creep */
Yap_signal (YAP_USR2_SIGNAL); Yap_external_signal ( worker_id, YAP_USR2_SIGNAL);
break; break;
#endif /* defined(SIGUSR2) */ #endif /* defined(SIGUSR2) */
#ifdef SIGPIPE #ifdef SIGPIPE
case SIGPIPE: case SIGPIPE:
/* force the system to creep */ /* force the system to creep */
Yap_signal (YAP_PIPE_SIGNAL); Yap_external_signal ( worker_id, YAP_PIPE_SIGNAL);
break; break;
#endif /* defined(SIGPIPE) */ #endif /* defined(SIGPIPE) */
#ifdef SIGHUP #ifdef SIGHUP
@ -1709,7 +1575,7 @@ ReceiveSignal (int s, void *x, void *y)
#endif /* defined(SIGHUP) */ #endif /* defined(SIGHUP) */
default: default:
fprintf(stderr, "\n[ Unexpected signal ]\n"); fprintf(stderr, "\n[ Unexpected signal ]\n");
exit (EXIT_FAILURE); exit (s);
} }
} }
#endif #endif
@ -1728,11 +1594,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
case CTRL_C_EVENT: case CTRL_C_EVENT:
case CTRL_BREAK_EVENT: case CTRL_BREAK_EVENT:
#if THREADS #if THREADS
Yap_external_signal(0, YAP_WINTIMER_SIGNAL); Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
REMOTE_PrologMode(0) |= InterruptMode; REMOTE_PrologMode(0) |= InterruptMode;
#else #else
Yap_signal(YAP_WINTIMER_SIGNAL); Yap_signal(YAP_WINTIMER_SIGNAL);
LOCAL_PrologMode |= InterruptMode; LOCAL_PrologMode |= InterruptMode;
#endif #endif
return(TRUE); return(TRUE);
default: default:
@ -1752,8 +1618,8 @@ InitSignals (void)
my_signal (SIGUSR1, ReceiveSignal); my_signal (SIGUSR1, ReceiveSignal);
my_signal (SIGUSR2, ReceiveSignal); my_signal (SIGUSR2, ReceiveSignal);
my_signal (SIGHUP, ReceiveSignal); my_signal (SIGHUP, ReceiveSignal);
my_signal (SIGALRM, HandleALRM); my_signal (SIGALRM, ReceiveSignal);
my_signal (SIGVTALRM, HandleVTALRM); my_signal (SIGVTALRM, ReceiveSignal);
#endif #endif
#ifdef SIGPIPE #ifdef SIGPIPE
my_signal (SIGPIPE, ReceiveSignal); my_signal (SIGPIPE, ReceiveSignal);
@ -1762,7 +1628,7 @@ InitSignals (void)
signal (SIGINT, SIG_IGN); signal (SIGINT, SIG_IGN);
SetConsoleCtrlHandler(MSCHandleSignal,TRUE); SetConsoleCtrlHandler(MSCHandleSignal,TRUE);
#else #else
my_signal (SIGINT, HandleSIGINT); my_signal (SIGINT, ReceiveSignal);
#endif #endif
#ifdef HAVE_SIGFPE #ifdef HAVE_SIGFPE
my_signal (SIGFPE, HandleMatherr); 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); strncpy (result, ares1, YAP_FILENAME_MAX);
} }
} else { } else {
strncpy (result, ares1, YAP_FILENAME_MAX); strncpy (result, ares1, YAP_FILENAME_MAX);
close(tmpf); close(tmpf);
} }
} else { } else {
@ -2483,9 +2349,9 @@ p_alarm( USES_REGS1 )
i2 = IntegerOfTerm(t2); i2 = IntegerOfTerm(t2);
if (i1 == 0 && i2 == 0) { if (i1 == 0 && i2 == 0) {
#if _WIN32 #if _WIN32
Yap_undo_signal( YAP_WINTIMER_SIGNAL ); Yap_get_signal( YAP_WINTIMER_SIGNAL );
#else #else
Yap_undo_signal( YAP_ALARM_SIGNAL ); Yap_get_signal( YAP_ALARM_SIGNAL );
#endif #endif
} }
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
@ -2844,26 +2710,20 @@ p_win32( USES_REGS1 )
static Int static Int
p_enable_interrupts( USES_REGS1 ) p_enable_interrupts( USES_REGS1 )
{ {
LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled--; LOCAL_InterruptsDisabled--;
if (LOCAL_ActiveSignals && !LOCAL_InterruptsDisabled) { if (LOCAL_Signals && !LOCAL_InterruptsDisabled) {
CreepFlag = Unsigned(LCL0); CreepFlag = Unsigned(LCL0);
if ( !Yap_only_has_signal( YAP_CREEP_SIGNAL ) ) if ( !Yap_only_has_signal( YAP_CREEP_SIGNAL ) )
EventFlag = Unsigned( LCL0 ); EventFlag = Unsigned( LCL0 );
} }
UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
static Int static Int
p_disable_interrupts( USES_REGS1 ) p_disable_interrupts( USES_REGS1 )
{ {
LOCK(LOCAL_SignalLock);
LOCAL_InterruptsDisabled++; LOCAL_InterruptsDisabled++;
if (LOCAL_ActiveSignals) { CalculateStackGap( PASS_REGS1 );
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }

2
C/threads.c
View File

@ -208,7 +208,7 @@ kill_thread_engine (int wid, int always_die)
gl = gl->NextGE; gl = gl->NextGE;
} }
Yap_KillStacks(wid); Yap_KillStacks(wid);
REMOTE_ActiveSignals(wid) = 0L; REMOTE_Signals(wid) = 0L;
if (REMOTE_ScratchPad(wid).ptr) if (REMOTE_ScratchPad(wid).ptr)
free(REMOTE_ScratchPad(wid).ptr); free(REMOTE_ScratchPad(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache = 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]; PredEntry *old_p[10000];
Term old_x1[10000], old_x2[10000], old_x3[10000]; Term old_x1[10000], old_x2[10000], old_x3[10000];
static CELL oldv;
void void
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) 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; */ /* extern int gc_calls; */
vsc_count++; 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; // if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs; sc = Yap_heap_regs;

62
H/YapSignals.h
View File

@ -45,28 +45,36 @@ typedef enum
#ifdef SIGVTALRM #ifdef SIGVTALRM
YAP_VTALARM_SIGNAL = SIGVTALRM, /* received SIGVTALARM */ YAP_VTALARM_SIGNAL = SIGVTALRM, /* received SIGVTALARM */
#endif #endif
YAP_CREEP_SIGNAL = NSIG+1, /* received a creep */ YAP_CREEP_SIGNAL = (NSIG+1), /* received a creep */
YAP_WAKEUP_SIGNAL = NSIG+2, /* goals to wake up */ YAP_WAKEUP_SIGNAL = (NSIG+2), /* goals to wake up */
YAP_ITI_SIGNAL = NSIG+3, /* received inter thread signal */ YAP_ITI_SIGNAL = (NSIG+3), /* received inter thread signal */
YAP_TROVF_SIGNAL = NSIG+4, /* received trail overflow */ YAP_TROVF_SIGNAL = (NSIG+4), /* received trail overflow */
YAP_CDOVF_SIGNAL = NSIG+5, /* received code overflow */ YAP_CDOVF_SIGNAL = (NSIG+5), /* received code overflow */
YAP_STOVF_SIGNAL = NSIG+6, /* received stack overflow */ YAP_STOVF_SIGNAL = (NSIG+6), /* received stack overflow */
YAP_TRACE_SIGNAL = NSIG+7, /* received start trace */ YAP_TRACE_SIGNAL = (NSIG+7), /* received start trace */
YAP_DEBUG_SIGNAL = NSIG+8, /* received start debug */ YAP_DEBUG_SIGNAL = (NSIG+8), /* received start debug */
YAP_BREAK_SIGNAL = NSIG+9, /* received break signal */ YAP_BREAK_SIGNAL = (NSIG+9), /* received break signal */
YAP_STACK_DUMP_SIGNAL = NSIG+10, /* received stack dump signal */ YAP_STACK_DUMP_SIGNAL = (NSIG+10), /* received stack dump signal */
YAP_STATISTICS_SIGNAL = NSIG+11, /* received statistics */ YAP_STATISTICS_SIGNAL = (NSIG+11), /* received statistics */
YAP_AGC_SIGNAL = NSIG+12, /* call atom garbage collector asap */ YAP_AGC_SIGNAL = (NSIG+12), /* call atom garbage collector asap */
YAP_WINTIMER_SIGNAL = NSIG+13, /* windows alarm */ YAP_WINTIMER_SIGNAL = (NSIG+13), /* windows alarm */
YAP_FAIL_SIGNAL = NSIG+14 /* P = FAILCODE */ YAP_FAIL_SIGNAL = (NSIG+14), /* P = FAILCODE */
YAP_ABORT_SIGNAL = (NSIG+15), /* P = FAILCODE */
YAP_EXIT_SIGNAL = (NSIG+16) /* P = FAILCODE */
} yap_signals; } 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_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_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_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 ); 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 INLINE_ONLY inline EXTERN int
Yap_has_a_signal__ (USES_REGS1) 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_signal(yap_signals);
void Yap_external_signal(int, 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_a_signal__( USES_REGS1 );
int Yap_has_signal__(yap_signals USES_REGS);
int Yap_has_signals__(yap_signals,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_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 REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_
#define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_ #define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_
#define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_ #define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_
#define LOCAL_FirstActiveSignal LOCAL->FirstActiveSignal_ #define LOCAL_Signals LOCAL->Signals_
#define REMOTE_FirstActiveSignal(wid) REMOTE(wid)->FirstActiveSignal_ #define REMOTE_Signals(wid) REMOTE(wid)->Signals_
#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_IPredArity LOCAL->IPredArity_ #define LOCAL_IPredArity LOCAL->IPredArity_
#define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_ #define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_
#define LOCAL_ProfEnd LOCAL->ProfEnd_ #define LOCAL_ProfEnd LOCAL->ProfEnd_
@ -239,10 +235,6 @@
#endif #endif
#define LOCAL_consult_level LOCAL->consult_level_ #define LOCAL_consult_level LOCAL->consult_level_
#define REMOTE_consult_level(wid) REMOTE(wid)->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 LOCAL_LocalBase LOCAL->LocalBase_
#define REMOTE_LocalBase(wid) REMOTE(wid)->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 scanner_extra_alloc* ScannerExtraBlocks_;
struct DB_TERM* BallTerm_; struct DB_TERM* BallTerm_;
UInt MaxActiveSignals_; UInt MaxActiveSignals_;
UInt FirstActiveSignal_; uint64_t Signals_;
UInt LastActiveSignal_;
UInt* ActiveSignals_;
UInt IPredArity_; UInt IPredArity_;
yamop* ProfEnd_; yamop* ProfEnd_;
int UncaughtThrow_; int UncaughtThrow_;
@ -134,9 +132,6 @@ typedef struct worker_local {
Int total_choicepoints_; Int total_choicepoints_;
#endif #endif
int consult_level_; int consult_level_;
#if defined(YAPOR) || defined(THREADS)
lockvar SignalLock_;
#endif
ADDR LocalBase_; ADDR LocalBase_;
ADDR GlobalBase_; ADDR GlobalBase_;

7
H/ilocals.h
View File

@ -56,9 +56,7 @@ static void InitWorker(int wid) {
REMOTE_ScannerExtraBlocks(wid) = NULL; REMOTE_ScannerExtraBlocks(wid) = NULL;
REMOTE_BallTerm(wid) = NULL; REMOTE_BallTerm(wid) = NULL;
REMOTE_MaxActiveSignals(wid) = 64L; REMOTE_MaxActiveSignals(wid) = 64L;
REMOTE_FirstActiveSignal(wid) = 0L; REMOTE_Signals(wid) = 0L;
REMOTE_LastActiveSignal(wid) = 0L;
REMOTE_ActiveSignals(wid) = Yap_InitSignals(wid);
REMOTE_IPredArity(wid) = 0L; REMOTE_IPredArity(wid) = 0L;
REMOTE_ProfEnd(wid) = NULL; REMOTE_ProfEnd(wid) = NULL;
REMOTE_UncaughtThrow(wid) = FALSE; REMOTE_UncaughtThrow(wid) = FALSE;
@ -134,9 +132,6 @@ static void InitWorker(int wid) {
REMOTE_total_choicepoints(wid) = 0; REMOTE_total_choicepoints(wid) = 0;
#endif #endif
REMOTE_consult_level(wid) = 0; 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 #ifdef COROUTINING
REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid)); REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid));
REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid)); REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid));
@ -134,9 +132,6 @@ static void RestoreWorker(int wid USES_REGS) {
#endif #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. */ /* Define to 1 if you have the `fetestexcept' function. */
#undef HAVE_FETESTEXCEPT #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. */ /* Define to 1 if you have the `fgetpos' function. */
#undef HAVE_FGETPOS #undef HAVE_FGETPOS
@ -225,6 +231,12 @@
/* Define to 1 if you have the <float.h> header file. */ /* Define to 1 if you have the <float.h> header file. */
#undef HAVE_FLOAT_H #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. */ /* Define to 1 if you have the `fpclass' function. */
#undef HAVE_FPCLASS #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) X_API int PL_get_arg(int index, term_t ts, term_t a)
{ {
CACHE_REGS CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm( t )) if (IsVarTerm( t ))
return 0; return 0;
if ( !IsApplTerm(t) ) { if ( !IsApplTerm(t) ) {
if (IsPairTerm(t)) { if (IsPairTerm(t)) {
if (index == 1){ if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS); Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1; return 1;
} else if (index == 2) { } else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS); Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1; return 1;
} }
} }
return 0; 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 /** @brief *ap is assigned the name and *ip the arity from term ts
@ -3138,18 +3144,8 @@ X_API int
PL_raise(int sig) PL_raise(int sig)
{ {
CACHE_REGS CACHE_REGS
LOCK(LOCAL_SignalLock); Yap_signal(YAP_INT_SIGNAL);
if (sig < SIG_PROLOG_OFFSET) { return 1;
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;
} }
int int
@ -3158,9 +3154,7 @@ raiseSignal(PL_local_data_t *ld, int sig)
#if THREADS #if THREADS
CACHE_REGS CACHE_REGS
if (sig == SIG_THREAD_SIGNAL) { if (sig == SIG_THREAD_SIGNAL) {
LOCK(LOCAL_SignalLock);
Yap_signal(YAP_ITI_SIGNAL); Yap_signal(YAP_ITI_SIGNAL);
UNLOCK(LOCAL_SignalLock);
return TRUE; return TRUE;
} }
#endif #endif

8
misc/LOCALS
View File

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

306
misc/sysgraph
View File

@ -16,7 +16,7 @@
public/2, public/2,
private/2, private/2,
module_on/3, module_on/3,
exported/1, exported/1,
dir/2, dir/2,
consulted/2, consulted/2,
op_export/3, op_export/3,
@ -136,7 +136,7 @@ c_preds(Dir - Mod) :-
expand_file_name( Pattern, Files ), expand_file_name( Pattern, Files ),
member( File0, Files ), member( File0, Files ),
absolute_file_name( File0, File ), absolute_file_name( File0, File ),
( ( sub_atom(File,_,_,0,'.c') ( ( sub_atom(File,_,_,0,'.c')
; ;
sub_atom(File,_,_,0,'.i') sub_atom(File,_,_,0,'.i')
; ;
@ -162,11 +162,11 @@ c_preds(_).
c_file(F, _Mod) :- c_file(F, _Mod) :-
consulted( F, _ ), consulted( F, _ ),
!. !.
c_file(F, Mod) :- c_file(F, Mod) :-
% writeln(F), % writeln(F),
assert( consulted( F, Mod ) ), assert( consulted( F, Mod ) ),
nb_setval( current_module, Mod ), nb_setval( current_module, Mod ),
open(F, read, S, [alias(c_file)]), open(F, read, S, [alias(c_file)]),
repeat, repeat,
@ -190,11 +190,11 @@ c_file(F, Mod) :-
c_line(["}"], Mod, _) :- !, c_line(["}"], Mod, _) :- !,
nb_setval( current_module, Mod ). nb_setval( current_module, Mod ).
c_line(Line, _Mod, _) :- c_line(Line, _Mod, _) :-
append( _, [ "CurrentModule", "=", M|_], Line), append( _, [ "CurrentModule", "=", M|_], Line),
system_mod(M, _Mod, Mod, _), system_mod(M, _Mod, Mod, _),
nb_setval( current_module, Mod ). nb_setval( current_module, Mod ).
c_line(Line, Mod, F: LineP) :- c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu), break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ), assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ). handle_pred( Mod, N, A, F ).
@ -224,7 +224,7 @@ c_ext( S, Mod, F ) :-
assert( node( Mod, N/A, F-Line, Fu ) ), assert( node( Mod, N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F ) handle_pred( Mod, N, A, F )
). ).
break_line( Line, N/A, c(Fu)) :- break_line( Line, N/A, c(Fu)) :-
take_line( Line, NS, AS, FS ), !, take_line( Line, NS, AS, FS ), !,
@ -247,7 +247,7 @@ break_line( Line, N/A, c(FuE, FuB)) :-
atom_string(FuE,FSE), atom_string(FuE,FSE),
atom_string(FuB,FSB), atom_string(FuB,FSB),
number_string(A, AS). number_string(A, AS).
take_line( Line, NS, AS, FS ) :- take_line( Line, NS, AS, FS ) :-
append( _, [ "Yap_InitCPred", NS, AS, FS|_], Line), !. append( _, [ "Yap_InitCPred", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :- take_line( Line, NS, AS, FS ) :-
@ -337,19 +337,19 @@ pl_interfs(_).
% %
% main side-effect facts like edge( F0-Mod:File ) % main side-effect facts like edge( F0-Mod:File )
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ), % exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
% module_on ( M, File ) % module_on ( M, File )
% %
pl_interf(F, _Mod) :- pl_interf(F, _Mod) :-
module_on( F , _M, _Is), module_on( F , _M, _Is),
!. !.
pl_interf(F, Mod) :- pl_interf(F, Mod) :-
consulted(F, Mod ), consulted(F, Mod ),
!. !.
pl_interf(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 ),  ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
writeln( +F:Mod ), writeln( +F:Mod ),
assert_new(consulted(F, Mod ) ), assert_new(consulted(F, Mod ) ),
nb_getval( private, Default ), nb_getval( private, Default ),
nb_setval( private, false ), nb_setval( private, false ),
nb_getval( file_entry, OF:OMod ), nb_getval( file_entry, OF:OMod ),
@ -358,9 +358,9 @@ writeln( +F:Mod ),
catch( open(PF, read, S, [scripting(true)]) , _, fail ), catch( open(PF, read, S, [scripting(true)]) , _, fail ),
repeat, repeat,
nb_getval( current_module, MR ), 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)), catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)),
( (
T == end_of_file T == end_of_file
-> ->
!, !,
@ -392,44 +392,44 @@ writeln( +F:Mod ),
fail fail
). ).
get_interf( T, _F, _M0 ) :- get_interf( T, _F, _M0 ) :-
var(T), var(T),
!. !.
get_interf( T, _F, _M0 ) :- get_interf( T, _F, _M0 ) :-
% ( T = (:- op(_,_,_)) -> trace ; true ), % ( T = (:- op(_,_,_)) -> trace ; true ),
var(T), var(T),
!. !.
get_interf( M:T, F, _M0 ) :- !, get_interf( M:T, F, _M0 ) :- !,
get_interf( T, F, M ). get_interf( T, F, M ).
get_interf( goal_expansion(G, M, _) , F, _M0 ) :- get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
nonvar( G ), nonvar( G ),
!, !,
( var( M ) -> M1 = prolog ; M = M1 ), ( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ), functor( G, N, A ),
handle_pred( M1, N, A, F ). handle_pred( M1, N, A, F ).
get_interf( goal_expansion(G, _) , F, _M0 ) :- get_interf( goal_expansion(G, _) , F, _M0 ) :-
nonvar( G ), nonvar( G ),
!, !,
functor( G, N, A ), functor( G, N, A ),
handle_pred( prolog, N, A, F ). 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( H, F, M ).
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :- get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
nonvar( G ), nonvar( G ),
!, !,
( var( M ) -> M1 = prolog ; M = M1 ), ( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ), functor( G, N, A ),
handle_pred( M1, N, A, F ). handle_pred( M1, N, A, F ).
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :- get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
nonvar( G ), nonvar( G ),
!, !,
functor( G, N, A ), functor( G, N, A ),
handle_pred( prolog, N, A, F ). 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( ( H --> _B), F, M ).
get_interf( ( A, _ --> _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 ) :- get_interf( (H --> _B), F, M ) :-
!, !,
@ -449,8 +449,8 @@ get_interf( (:- module( NM, Is ) ), F, _M ) :-
nb_setval( current_module, NM ), nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ), assert( module_on( F , NM, Is) ),
maplist( public(F, NM), Is ), maplist( public(F, NM), Is ),
nb_setval( private, true ). nb_setval( private, true ).
get_interf( (:- reexport( Loc, Is ) ), F, M ) :- get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
!, !,
% find the file % find the file
search_file( Loc, F, pl, NF ), 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 ) :- !, get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
!, !,
include_files( F, M, Is, Loc ). include_files( F, M, Is, Loc ).
get_interf( (:- consult( Files ) ), F, M ) :- get_interf( (:- consult( Files ) ), F, M ) :-
!, !,
include_files( F, M, Files ). include_files( F, M, Files ).
get_interf( (:- reconsult( Files ) ), F, M ) :- get_interf( (:- reconsult( Files ) ), F, M ) :-
!, !,
include_files( F, M, Files ). include_files( F, M, Files ).
get_interf( (:- ensure_loaded( Files ) ), F, M ) :- get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
!, !,
include_files( F, M, Files ). include_files( F, M, Files ).
get_interf( (:- include( Files ) ), F, M ) :- get_interf( (:- include( Files ) ), F, M ) :-
!, !,
source_files( F, M, Files ). source_files( F, M, Files ).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :- get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
!, !,
include_files( F, M, Files ). include_files( F, M, Files ).
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :- 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( (:- G ) , F, M).
get_interf( (:- initialization( G , now ) ) , F, M) :- get_interf( (:- initialization( G , now ) ) , F, M) :-
!, !,
get_interf( (:- G ) , 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 ). include_files( F, M, Files ).
get_interf( (:- [F1|Fs] ), F, M ) :- get_interf( (:- [F1|Fs] ), F, M ) :-
!, !,
include_files( F, M, [F1|Fs] ). include_files( F, M, [F1|Fs] ).
% don't actually use this one. % 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 ). 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), always_strip_module(M:F, M1, F1),
call_c_files( F0, 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), always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, Fun, 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), always_strip_module(M:F, M1, F1),
call_c_files( F0, 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 ) :- get_interf( (:- dynamic T), F, M ) :-
!, !,
declare_functors( 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 ) :- get_interf( (:- thread_local T), F, M ) :-
!, !,
declare_functors( 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), always_strip_module(M:Z, M1, Z1),
handle_op( F, M1, op( X, Y, 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). 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). set_prolog_flag(dollar_as_lower_case,On).
get_interf( (:- _ ), _F, _M ) :- !. get_interf( (:- _ ), _F, _M ) :- !.
@ -599,7 +599,7 @@ handle_record_field_name( Constructor, F, M, Name) :-
handle_pred( M, Set, 2, F), handle_pred( M, Set, 2, F),
atom_concat([ nb_set_, Name, '_of_', Constructor ], Set), atom_concat([ nb_set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F), handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F). handle_pred( M, Set, 2, F).
handle_pred( M, N, A, F ) :- handle_pred( M, N, A, F ) :-
( (
@ -636,7 +636,7 @@ handle_op( F, M, Op ) :-
op( X, Y, M:Z ) 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) ), public( NF , NM:op(X,Y,Z) ),
handle_op( F, M , 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).
include_files( F, M, Is, Files ) :- include_files( F, M, Is, Files ) :-
!, !,
always_strip_module(M:Files, M1, NFiles), always_strip_module(M:Files, M1, NFiles),
include_file( F, M1, Is, 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 ).
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 ) :- source_files( F, M, Files ) :-
maplist( 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 ).
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 ), catch( open(PF, read, S, []) , _, fail ),
repeat, repeat,
nb_getval( current_module, MR ), 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)), catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)),
( (
T == end_of_file T == end_of_file
-> ->
!, !,
@ -744,9 +744,9 @@ declare_functors( M:T, F, _M1) :- !,
declare_functors( (T1,T2), F, M1) :- !, declare_functors( (T1,T2), F, M1) :- !,
declare_functors( T1, F, M1), declare_functors( T1, F, M1),
declare_functors( T2, F, M1). declare_functors( T2, F, M1).
declare_functors( Ts, F, M1) :- declare_functors( Ts, F, M1) :-
maplist( declare_functor( F, M1), Ts ), !. maplist( declare_functor( F, M1), Ts ), !.
declare_functors( T, F, M1) :- declare_functors( T, F, M1) :-
declare_functor( F, M1, T). declare_functor( F, M1, T).
declare_functor(File, M, N/A) :- declare_functor(File, M, N/A) :-
@ -756,7 +756,7 @@ declare_terms( T, _F, _M1) :- var(T), !,
error( unbound_variable ). error( unbound_variable ).
declare_terms( M:T, F, _M1) :- !, declare_terms( M:T, F, _M1) :- !,
declare_functors( T, F, M). declare_functors( T, F, M).
declare_terms( (N1,N2), F, M) :- declare_terms( (N1,N2), F, M) :-
number(N1), number(N1),
number(N2), number(N2),
!, !,
@ -764,9 +764,9 @@ declare_terms( (N1,N2), F, M) :-
declare_terms( (T1,T2), F, M1) :- !, declare_terms( (T1,T2), F, M1) :- !,
declare_terms( T1, F, M1), declare_terms( T1, F, M1),
declare_terms( T2, F, M1). declare_terms( T2, F, M1).
declare_terms( Ts, F, M1) :- declare_terms( Ts, F, M1) :-
maplist( declare_term( F, M1), Ts ), !. maplist( declare_term( F, M1), Ts ), !.
declare_terms( T, F, M1) :- declare_terms( T, F, M1) :-
declare_term( F, M1, T). declare_term( F, M1, T).
declare_term(F, M, S) :- declare_term(F, M, S) :-
@ -797,8 +797,8 @@ pl_graphs(_).
% %
% main side-effect facts like edge( F0-Mod:File ) % main side-effect facts like edge( F0-Mod:File )
% exported( F-M , N/A ) ou exported(F- M. Op ), % exported( F-M , N/A ) ou exported(F- M. Op ),
% module_on ( M, File ) % module_on ( M, File )
% pred ( M :N/A ) % pred ( M :N/A )
% %
build_graph(F, Mod) :- build_graph(F, Mod) :-
% writeln(F), % writeln(F),
@ -807,12 +807,12 @@ build_graph(F, Mod) :-
repeat, repeat,
nb_getval( current_module, MR ), nb_getval( current_module, MR ),
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))), catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))),
( (
T == end_of_file T == end_of_file
-> ->
!, !,
% also, clo ops defined in the module M, if M \= Mod % 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) close(S)
; ;
stream_position_data( line_count, Pos, Line ), stream_position_data( line_count, Pos, Line ),
@ -829,18 +829,18 @@ get_graph( V , _F, _Pos, _M ) :-
var( V ), var( V ),
!, !,
error( instantiation_error ). error( instantiation_error ).
get_graph( T, _F, _Pos, _M0 ) :- get_graph( T, _F, _Pos, _M0 ) :-
var(T), var(T),
!. !.
get_graph( M:T, F, _Pos, _M0 ) :- !, get_graph( M:T, F, _Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ). get_graph( T, 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( (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( ( 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( ( A --> B), F, _Pos, M ).
get_graph( (H --> 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 ), search_file( Fs, F, pl, NF ),
build_graph( NF , M ), !. build_graph( NF , M ), !.
add_deps(V, _M, _P, _F, _Pos, _) :- add_deps(V, _M, _P, _F, _Pos, _) :-
var(V), !. 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), always_strip_module(M1:G, M2, G2),
add_deps(G2, M2, _P, _F, _Pos, L). 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(A, M, P, F, _Pos, L),
add_deps(B, 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, L).
add_deps({A}, M, P, F, _Pos, 2) :- !, add_deps({A}, M, P, F, _Pos, 2) :- !,
add_deps(A, M, P, F, _Pos, 0). 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 ). put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !. 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, Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ). 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 ) ), !, exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
%follow ancestor chain %follow ancestor chain
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ), ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ). put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
% the base case, copying from the same module ( but maybe not same file 0. % 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), m_exists(M:N/Ar, F0),
!, !,
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ). assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
% prolog is visible ( but maybe not same file ). % 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), m_exists(prolog:N/Ar, F0),
!, !,
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ). 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 ), stream_position_data( line_count, Pos, Line ),
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ). assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
ancestor( ( Younger :- Older) ) :- ancestor( ( Younger :- Older) ) :-
exported( ( Mid :- Older ) ), !, exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ). ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ). ancestor( (Older :- Older) ).
@ -956,7 +956,7 @@ undefs :-
\+ node( Mod , NA , _File1, _ ), \+ node( Mod , NA , _File1, _ ),
\+ node( prolog , NA , _File2, _ ), \+ node( prolog , NA , _File2, _ ),
format(' predicate ~w:~n',[NA]), format(' predicate ~w:~n',[NA]),
( (
setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ), setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ),
member(F-L, FLs ), member(F-L, FLs ),
format(' line ~w, file ~a~n',[L,F]), format(' line ~w, file ~a~n',[L,F]),
@ -979,7 +979,7 @@ out_list([E1,E2|Es]) :-
maplist(out_el, [E2|Es]), maplist(out_el, [E2|Es]),
format(']', []). format(']', []).
out_el( El ) :- out_el( El ) :-
format(',~n ~q',[El]). format(',~n ~q',[El]).
pub(M, P) :- pub(M, P) :-
@ -1006,7 +1006,7 @@ priv(M, P) :-
edge(_:P, _P1, F1:_), F1 \= F. edge(_:P, _P1, F1:_), F1 \= F.
% utilities % utilities
split_string( S , Cs, N) :- split_string( S , Cs, N) :-
string_codes(S, S1), string_codes(S, S1),
string_codes(Cs, NCs), string_codes(Cs, NCs),
@ -1044,8 +1044,8 @@ warn_singletons(_Vars, _Pos).
% comment( +Comment ) % comment( +Comment )
% %
% Handle documentation comments % Handle documentation comments
% %
comment( _Pos - Comment) :- comment( _Pos - Comment) :-
skip_blanks(1, Comment, N), skip_blanks(1, Comment, N),
doc( Comment, N ), !, doc( Comment, N ), !,
format( "%s\n", [Comment] ). format( "%s\n", [Comment] ).
@ -1096,14 +1096,14 @@ search_file0( A/B, F, Type, FN ) :- !,
search_file0( AB, F, Type, FN ). search_file0( AB, F, Type, FN ).
% libraries can be anywhere in the source. % libraries can be anywhere in the source.
search_file0( LibLoc, F, Type, FN ) :- search_file0( LibLoc, F, Type, FN ) :-
LibLoc =.. [Dir,File], LibLoc =.. [Dir,File],
!, !,
( term_to_atom( Dir/File, Full ) ; Full = File ), ( term_to_atom( Dir/File, Full ) ; Full = File ),
search_file0( Full, F, Type, FN ). search_file0( Full, F, Type, FN ).
%try to use your base %try to use your base
search_file0( Loc , F, c, FN ) :- search_file0( Loc , F, c, FN ) :-
atom_concat( D, '.yap', F), atom_concat( D, '.yap', F),
atom_concat( [ D, '/', Loc], F1), atom_concat( [ D, '/', Loc], F1),
check_suffix( F1 , c, NLoc ), check_suffix( F1 , c, NLoc ),
absolute_file_name( NLoc, FN), absolute_file_name( NLoc, FN),
file_base_name( FN, LocNam), file_base_name( FN, LocNam),
@ -1142,47 +1142,47 @@ sub_dir( D, DD) :-
% files must be called .yap or .pl % files must be called .yap or .pl
% if it is .yap... % if it is .yap...
check_suffix( Loc , pl, Loc ) :- check_suffix( Loc , pl, Loc ) :-
atom_concat( _, '.yap', Loc ), !. atom_concat( _, '.yap', Loc ), !.
%, otherwise, .pl %, otherwise, .pl
check_suffix( Loc , pl, Loc ) :- check_suffix( Loc , pl, Loc ) :-
atom_concat( _, '.pl', Loc ), !. atom_concat( _, '.pl', Loc ), !.
%, otherwise, .prolog %, otherwise, .prolog
check_suffix( Loc , pl, Loc ) :- check_suffix( Loc , pl, Loc ) :-
atom_concat( _, '.prolog', Loc ), !. atom_concat( _, '.prolog', Loc ), !.
%, otherwise, .P %, otherwise, .P
% try adding suffix % try adding suffix
check_suffix( Loc0 , pl, Loc ) :- check_suffix( Loc0 , pl, Loc ) :-
member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']), member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']),
atom_concat( Loc0, Suf, Loc ). atom_concat( Loc0, Suf, Loc ).
check_suffix( Loc , c, Loc ) :- check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.c', Loc ), !. atom_concat( _, '.c', Loc ), !.
%, otherwise, .pl %, otherwise, .pl
check_suffix( Loc , c, Loc ) :- check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.icc', Loc ), !. atom_concat( _, '.icc', Loc ), !.
%, otherwise, .prolog %, otherwise, .prolog
check_suffix( Loc , c, Loc ) :- check_suffix( Loc , c, Loc ) :-
atom_concat( _, '.cpp', Loc ), !. atom_concat( _, '.cpp', Loc ), !.
%, otherwise, .P %, otherwise, .P
% try adding suffix % try adding suffix
check_suffix( Loc0 , c, Loc ) :- check_suffix( Loc0 , c, Loc ) :-
member( Suf , ['.c', '.icc' , '.cpp']), member( Suf , ['.c', '.icc' , '.cpp']),
atom_concat( Loc0, Suf, Loc ). atom_concat( Loc0, Suf, Loc ).
match_file( LocD, Loc0, Type, FN ) :- match_file( LocD, Loc0, Type, FN ) :-
var(LocD), !, var(LocD), !,
dir( LocD, Loc0 ), dir( LocD, Loc0 ),
atom_concat( [LocD, '/', Loc0], F ), atom_concat( [LocD, '/', Loc0], F ),
absolute_file_name( F, Type, FN ), absolute_file_name( F, Type, FN ),
exists( FN ). exists( FN ).
match_file( SufLocD, Loc0, Type, FN ) :- match_file( SufLocD, Loc0, Type, FN ) :-
dir( LocD, Loc0 ), dir( LocD, Loc0 ),
atom_concat(_, SufLocD, LocD ), atom_concat(_, SufLocD, LocD ),
atom_concat( [LocD, '/', Loc0], Type, FN ). atom_concat( [LocD, '/', Loc0], Type, FN ).
new_op( F, M, op(X,Y,Z) ) :- new_op( F, M, op(X,Y,Z) ) :-
nb_getval( private, true ), nb_getval( private, true ),
!, !,
@ -1200,7 +1200,7 @@ preprocess_file(F,NF) :-
atom_concat(_, '.ypp', F ), !, atom_concat(_, '.ypp', F ), !,
atom_concat( [ 'cpp -CC -w -DMYDDAS_MYSQL -DMYDDAS_ODBC -DMYDDAS_STATS -DMYDDAS_TOP_LEVEL -P ',F], OF ), atom_concat( [ 'cpp -CC -w -DMYDDAS_MYSQL -DMYDDAS_ODBC -DMYDDAS_STATS -DMYDDAS_TOP_LEVEL -P ',F], OF ),
NF = pipe( 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) ) :- !, public( F, M, op(X,Y,Z) ) :- !,
assert( op_export(F, _M, op(X,Y,Z) ) ), assert( op_export(F, _M, op(X,Y,Z) ) ),
assert_new( public( F, M:op(X,Y,Z) ) ), assert_new( public( F, M:op(X,Y,Z) ) ),
( (
( M == user ; M == prolog ) ( M == user ; M == prolog )
-> ->
op( X, Y, prolog:Z ) op( X, Y, prolog:Z )
@ -1239,9 +1239,9 @@ public( F, M, N//Ar ) :-
assert( node( M, N/Ar2, F-L, prolog ) ), !. assert( node( M, N/Ar2, F-L, prolog ) ), !.
public( _F, _M, _//_Ar ). 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) ) ), assert_new( private( F, M:op(X,Y,Z) ) ),
( (
( M == user ; M == prolog ) ( M == user ; M == prolog )
-> ->
op( X, Y, prolog:Z ) 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, op(_X,_Y,_Z) ).
private( F, M, N/Ar ) :- private( F, M, N/Ar ) :-
assert_new( 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 ), nb_getval( line, L ),
assert( node( M, N/Ar, F-L, prolog ) ), !. assert( node( M, N/Ar, F-L, prolog ) ), !.
private( _F, _M, _N/_Ar ). private( _F, _M, _N/_Ar ).
@ -1274,6 +1274,7 @@ assert_new( G ) :- assert( G ).
error( Error ) :- throw(Error ). error( Error ) :- throw(Error ).
%% mkdocs inserts a file with a sequence of comments into a sequence of Prolog/C files. %% 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), open( 'docs/yapdocs.yap', read, S),
repeat, repeat,
( (
skip_blanks(S) skip_blanks(S, Comment, Rest)
-> ->
get_comment(S, Comment, Owner), get_comment(S, Rest),
store_comment( Comment, Owner ), store_comment( Comment ),
fail fail
; ;
close(S), 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 :- ops_default :-
abolish( default_ops/1 ), abolish( default_ops/1 ),
A = (_,_), functor(A,Comma,2), A = (_,_), functor(A,Comma,2),
@ -1302,7 +1378,7 @@ ops_default :-
ops_restore :- ops_restore :-
A = (_,_), functor(A,Comma,2), A = (_,_), functor(A,Comma,2),
current_op(_X,Y,prolog:Z), current_op(_X,Y,prolog:Z),
Z\= Comma, Z\= Comma,
op(0,Y,prolog:Z), op(0,Y,prolog:Z),
fail. fail.
@ -1311,14 +1387,14 @@ ops_restore :-
maplist( call, L ). maplist( call, L ).
do_user_c_dep(F1, F2) :- do_user_c_dep(F1, F2) :-
absolute_file_name(F1, A1), absolute_file_name(F1, A1),
absolute_file_name(F2, A2), absolute_file_name(F2, A2),
assert(c_dep(A1, A2)). assert(c_dep(A1, A2)).
do_user_skip(F1) :- do_user_skip(F1) :-
absolute_file_name(F1, A1), absolute_file_name(F1, A1),
assert(doskip(A1)). assert(doskip(A1)).
do_user_expand(F, F1) :- do_user_expand(F, F1) :-
absolute_file_name(F1, A1), absolute_file_name(F1, A1),
assert(doexpand(F, A1)). assert(doexpand(F, A1)).
user_deps( F, M ) :- user_deps( F, M ) :-
@ -1397,5 +1473,3 @@ user_skip( 'packages/prism/src/prolog/bp').
user_skip( 'packages/prism/src/c'). user_skip( 'packages/prism/src/c').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ). 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) :- '$x_yap_flag'(X, V) :-
yap_flag(X, V), yap_flag(X, V),
X \= gc_margin, % different machines will have different needs, X \= gc_margin, % different machines will have different needs,
X \= os_argv,
X \= language, X \= language,
X \= max_threads, X \= max_threads,
X \= max_workers, X \= max_workers,